1/* BEGIN LICENSE BLOCK
2 * Version: CMPL 1.1
3 *
4 * The contents of this file are subject to the Cisco-style Mozilla Public
5 * License Version 1.1 (the "License"); you may not use this file except
6 * in compliance with the License.  You may obtain a copy of the License
7 * at www.eclipse-clp.org/license.
8 *
9 * Software distributed under the License is distributed on an "AS IS"
10 * basis, WITHOUT WARRANTY OF ANY KIND, either express or implied.  See
11 * the License for the specific language governing rights and limitations
12 * under the License.
13 *
14 * The Original Code is  The ECLiPSe Constraint Logic Programming System.
15 * The Initial Developer of the Original Code is  Cisco Systems, Inc.
16 * Portions created by the Initial Developer are
17 * Copyright (C) 1989-2006 Cisco Systems, Inc.  All Rights Reserved.
18 *
19 * Contributor(s):
20 *
21 * END LICENSE BLOCK */
22
23
24/*
25 * SEPIA INCLUDE FILE
26 *
27 * VERSION	$Id: external.h,v 1.2 2012/02/25 13:36:44 jschimpf Exp $
28 */
29
30/*
31 * IDENTIFICATION	external.h
32 *
33 * DESCRIPTION   	Contains Macros for externals
34 *
35 * CONTENTS:
36 *			Current_Error
37 *			Current_Input
38 *			Current_Output
39 *			Debug_Input
40 *			Debug_Output
41 *			Delay
42 *			Dereference(x)
43 *			Did(string, arity)
44 *			Error(code)
45 *			Fail
46 *			Fprintf
47 *			Get_Array_Address(adid, address)
48 *			Get_Visible_Array_Address(adid, module,mod_tag,address)
49 *			Get_Array_Header(adid, address)
50 *			Get_Visible_Array_Header(adid, module, mod_tag,address)
51 *			Get_Stream(stream_val, stream_tag, type, stream)
52 *			Mark_Suspending_Variable(var)
53 *			Mark_Suspending_Variable_Inst(var)
54 *			Prolog_Call(goal_val, goal_tag, mod_val, mod_tag)
55 *			Prolog_Call_Nobind(goal_val, goal_tag, mod_val, mod_tag)
56 *			Succeed
57 *			Toplevel_Input
58 *			Toplevel_Output
59 *			User
60 *			Write(val, tag, stream)
61 *			Writeq(val, tag, stream)
62 *
63 *
64 */
65
66#define EC_EXTERNAL
67
68/*
69 * INCLUDES
70 */
71#include "config.h"
72#include "sepia.h"
73#include "types.h"
74#include "error.h"
75#include "embed.h"
76
77/*
78 * DEFINES:
79 */
80#define	Succeed			Succeed_
81#define Fail			Fail_
82#define Error(code)		Bip_Error(code)
83#define Delay			return PDELAY;
84#define Dereference(x)		Dereference_(x)
85
86#define Fprintf			p_fprintf
87#define Write(val, tag, stream)					\
88	{							\
89		int	res;					\
90		res = ec_pwrite(2, stream, val, tag, 1200, PrintDepth,	\
91			d_.default_module, tdict, 0);		\
92		if (res != PSUCCEED)				\
93		    { Bip_Error(res);}				\
94	}
95
96#define Writeq(val, tag, stream)		\
97	{							\
98		int	res;					\
99		res = ec_pwrite(3, stream, val, tag, 1200, PrintDepth,	\
100			d_.default_module, tdict, 0);		\
101		if (res != PSUCCEED)				\
102		    { Bip_Error(res);}				\
103	}
104
105
106#define Get_Array_Address(adid, address)				\
107	Get_Array_Header(adid, address)					\
108	if (DidArity(adid) != 0)					\
109	{								\
110	    address = address->val.ptr;					\
111	    address = (pword *) ((uword *) address + 1 + DidArity(adid));\
112	}
113
114#define Get_Visible_Array_Address(adid, module, mod_tag, address)	\
115	Get_Visible_Array_Header(adid, module, mod_tag, address)	\
116	if (DidArity(adid) != 0)					\
117	{								\
118	    address = address->val.ptr;					\
119	    address = (pword *) ((uword *) address + 1 + DidArity(adid));\
120	}
121
122#define Get_Array_Header(adid, address)					\
123	address = get_array_header(adid);				\
124	if (address == 0)						\
125	{								\
126		Error(NOGLOBAL);					\
127	}
128
129#define Get_Visible_Array_Header(adid, module, mod_tag, address)	\
130	{								\
131	    int	res;							\
132	    address = get_visible_array_header(adid, module, mod_tag, &res);\
133	    if (address == 0)						\
134	    {								\
135		Error(res);						\
136	    }								\
137	}
138
139#define Mark_Suspending_Variable(vptr) {        \
140        register pword *pw = TG;                \
141        TG += 2;                                \
142        Check_Gc;                               \
143        pw[0].val.ptr = vptr;                   \
144        pw[0].tag.kernel = TREF;                \
145        if (SV) {                               \
146            pw[1].val.ptr = SV;                 \
147            pw[1].tag.kernel = TLIST;           \
148        } else                                  \
149            pw[1].tag.kernel = TNIL;            \
150        SV = pw;                                \
151    }
152
153#define Mark_Suspending_Variable_Inst(var)	\
154	Mark_Suspending_Variable(var)
155
156#define Check_Gc \
157	if (TG >= TG_LIM) global_ov();
158
159#define Prolog_Call(goal_val, goal_tag, mod_val, mod_tag) \
160	sub_emulc(goal_val, goal_tag, mod_val, mod_tag)
161
162#define Prolog_Call_Nobind(goal_val, goal_tag, mod_val, mod_tag) \
163	query_emulc(goal_val, goal_tag, mod_val, mod_tag)
164
165
166/*
167 * EXTERNAL FUNCTION DECLARATIONS:
168 */
169
170Extern dident	bitfield_did(Dots);
171Extern pword	*get_array_header(Dots),
172		*get_visible_array_header(Dots);
173Extern int	ec_pwrite(Dots),
174		sub_emulc(Dots),
175		query_emulc(Dots);
176
177Extern stream_id	get_stream_id();
178
179#define INPUT		0x0001
180#define OUTPUT		0x0002
181#define Get_Stream(vs, ts, typ, nst)				\
182	{							\
183	    int			res;				\
184	    nst = get_stream_id(vs, ts, typ, &res);		\
185	    if (nst == 0)					\
186		{ Error(res); }					\
187	}
188