Commit 123f2400 authored by sof's avatar sof
Browse files

[project @ 1998-08-14 12:07:18 by sof]

Front end changes to handle foreign declarations
parent 132c92f7
......@@ -56,6 +56,17 @@ type binding;
gibindsource : long;
gibindline : long; >;
/* FFI declarations */
fobind : < gfobind_id : qid;
gfobind_ty : ttype;
gfobind_ext : maybe;
gfobind_flag : long;
gfobind_cc : long;
gfobind_kind : long;
gfobind_line : long; >;
/* user-specified pragmas:XXXX */
vspec_uprag : < gvspec_id : qid;
......
......@@ -5,15 +5,26 @@ in instead of the defaults.
*/
#include <stdio.h>
/* Included so as to bring the right prototypes into scope */
#include "rtsdefs.h"
#define W_ unsigned long int
#define I_ long int
#if __GLASGOW_HASKELL__ >= 303
void
ErrorHdrHook (long fd)
{
char msg[]="\n";
write(fd,msg,1);
}
#else
void
ErrorHdrHook (FILE *where)
{
fprintf(where, "\n"); /* no "Fail: " */
}
#endif
void
OutOfHeapHook (W_ request_size, W_ heap_size) /* both in bytes */
......@@ -29,6 +40,31 @@ StackOverflowHook (I_ stack_size) /* in bytes */
fprintf(stderr, "GHC stack-space overflow: current size %ld bytes.\nUse the `-K<size>' option to increase it.\n", stack_size);
}
#if __GLASGOW_HASKELL__ >= 303
void
PatErrorHdrHook (long fd)
{
const char msg[]="\n*** Pattern-matching error within GHC!\n\nThis is a compiler bug; please report it to glasgow-haskell-bugs@dcs.gla.ac.uk.\n\nFail:";
write(fd,msg,sizeof(msg)-1);
}
void
PreTraceHook (long fd)
{
const char msg[]="\n";
write(fd,msg,sizeof(msg)-1);
}
void
PostTraceHook (long fd)
{
#if 0
const char msg[]="\n";
write(fd,msg,sizeof(msg)-1);
#endif
}
#else
void
PatErrorHdrHook (FILE *where)
{
......@@ -46,3 +82,4 @@ PostTraceHook (FILE *where)
{
fprintf(where, "\n"); /* not "Trace Off" */
}
#endif
......@@ -399,6 +399,14 @@ NL [\n\r]
<GlaExt>"_ccall_GC_" { RETURN(CCALL_GC); }
<GlaExt>"_casm_" { RETURN(CASM); }
<GlaExt>"_casm_GC_" { RETURN(CASM_GC); }
<GlaExt>"foreign" { RETURN(FOREIGN); }
<GlaExt>"export" { RETURN(EXPORT); }
<GlaExt>"unsafe" { RETURN(UNSAFE); }
<GlaExt>"_stdcall" { RETURN(STDCALL); }
<GlaExt>"_ccall" { RETURN(C_CALL); }
<GlaExt>"_pascal" { RETURN(PASCAL); }
<GlaExt>"_fastcall" { RETURN(FASTCALL); }
<GlaExt>"dynamic" { RETURN(DYNAMIC); }
%{
/*
......
......@@ -161,7 +161,8 @@ BOOLEAN pat_check=TRUE;
%token SCC
%token CCALL CCALL_GC CASM CASM_GC
%token EXPORT UNSAFE STDCALL C_CALL
%token PASCAL FASTCALL FOREIGN DYNAMIC
/**********************************************************************
* *
......@@ -239,7 +240,8 @@ BOOLEAN pat_check=TRUE;
gdrhs gdpat valrhs
lampats cexps gd
%type <umaybe> maybeexports impspec deriving
%type <umaybe> maybeexports impspec deriving
ext_name
%type <uliteral> lit_constant
......@@ -261,10 +263,10 @@ BOOLEAN pat_check=TRUE;
qvar qcon qvarop qconop qop
qvark qconk qtycon qtycls
gcon gconk gtycon itycon qop1 qvarop1
ename iname
ename iname
%type <ubinding> topdecl topdecls letdecls
typed datad newtd classd instd defaultd
typed datad newtd classd instd defaultd foreignd
decl decls valdef instdef instdefs
maybe_where cbody rinst type_and_maybe_id
......@@ -284,6 +286,7 @@ BOOLEAN pat_check=TRUE;
%type <uentid> export import
%type <ulong> commas importkey get_line_no
unsafe_flag callconv
/**********************************************************************
* *
......@@ -482,6 +485,7 @@ topdecl : typed { $$ = $1; FN = NULL; SAMEFN = 0; }
| classd { $$ = $1; FN = NULL; SAMEFN = 0; }
| instd { $$ = $1; FN = NULL; SAMEFN = 0; }
| defaultd { $$ = $1; FN = NULL; SAMEFN = 0; }
| foreignd { $$ = $1; FN = NULL; SAMEFN = 0; }
| decl { $$ = $1; }
;
......@@ -540,6 +544,27 @@ defaultd: defaultkey OPAREN types CPAREN { $$ = mkdbind($3,startlineno);
| defaultkey OPAREN CPAREN { $$ = mkdbind(Lnil,startlineno); }
;
/* FFI primitive declarations - GHC/Hugs specific */
foreignd: foreignkey IMPORT callconv ext_name unsafe_flag qvarid DCOLON sigtype { $$ = mkfobind($6,$8,$4,$5,$3,FOREIGN_IMPORT,startlineno); }
| foreignkey EXPORT callconv ext_name qvarid DCOLON sigtype { $$ = mkfobind($5,$7,$4,0,$3,FOREIGN_EXPORT,startlineno); }
;
callconv: STDCALL { $$ = CALLCONV_STDCALL; }
| C_CALL { $$ = CALLCONV_CCALL; }
| PASCAL { $$ = CALLCONV_PASCAL; }
| FASTCALL { $$ = CALLCONV_FASTCALL; }
;
ext_name: STRING { $$ = mkjust(lsing($1)); }
| STRING STRING { $$ = mkjust(mklcons ($1,lsing($2))); }
| DYNAMIC { $$ = mknothing(); }
unsafe_flag: UNSAFE { $$ = 1; }
| /*empty*/ { $$ = 0; }
;
decls : decl
| decls SEMI decl
{
......@@ -1431,6 +1456,9 @@ instkey : INSTANCE { setstartlineno();
defaultkey: DEFAULT { setstartlineno(); }
;
foreignkey: FOREIGN { setstartlineno(); }
;
classkey: CLASS { setstartlineno();
if(etags)
#if 1/*etags*/
......
......@@ -114,6 +114,15 @@ void precparse PROTO((tree));
void checkprec PROTO((tree, qid, BOOLEAN));
*/
/* FFI predefines */
#define CALLCONV_STDCALL 0
#define CALLCONV_CCALL 1
#define CALLCONV_PASCAL 2
#define CALLCONV_FASTCALL 3
#define FOREIGN_IMPORT 0
#define FOREIGN_EXPORT 1
BOOLEAN isconstr PROTO((char *));
void setstartlineno PROTO((void));
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment