fcall.c
Go to the documentation of this file.
1 /****************************************************************/
2 /* machine dependent compiled code runtime routines
3 /* for sun3, sun4 and vax ultrix
4 /* 1987-Dec-23
5 /* Copyright Toshihiro MATSUI
6 /****************************************************************/
7 static char *rcsid="@(#)$Id$";
8 
9 #include "../c/eus.h"
10 
11 /*
12 /* s u n 4 / S P A R C
13 */
14 
15 pointer fcallx(ctx,n,argv,fslot,sym)
16 register context *ctx;
17 int n;
18 pointer *argv,sym;
19 pointer (**fslot)();
20 { eusinteger_t x;
21  pointer fn;
22  pointer (*subr)();
23 
24  fn=getfunc(ctx,sym);
25 
26  if (ispointer(fn) && (fn->cix==codecp.cix)) {
27 #if (WORD_SIZE == 64)
28  x= (eusinteger_t)(fn->c.code.entry); x &= ~3L;
29 #else
30  x= (eusinteger_t)(fn->c.code.entry); x &= ~3;
31 #endif
32 #if ARM
33  if (fn->c.code.entry2 != NIL) {
34 #if (WORD_SIZE == 64)
35  x = x | (intval(fn->c.code.entry2)&0x00000000ffffffff);
36 #else
37  x = x | (intval(fn->c.code.entry2)&0x0000ffff);
38 #endif
39  }
40 #endif
41  subr=(pointer (*)())(x);
42  *fslot= subr;
43  return((*subr)(ctx,n,argv));
44  }
45  else return(ufuncall(ctx,sym,sym,(pointer)argv,0,n));}
46 
47 /*
48 /* s u n 3 / M 6 8 0 2 0
49 */
50 
51 #if sun3 || news || sanyo
52 pointer fcall(n,argv,sym)
53 int n;
54 pointer argv[];
55 pointer sym;
56 { register int *r= &n;
57  int x;
58  pointer fn,result;
59  pointer (*subr)();
60 
61  fn=getfunc(sym);
62 
63  if (ispointer(fn) && (fn->cix==codecp.cix)) {
64  subr=(pointer (*)())
65  ((int)(fn->c.code.codevec)+(intval(fn->c.code.entry)));
66  x=r[-1]; /*return addr .i.e. next instruction address to be executed*/
67  r=(int *)(x-4); /*operand for the bsrl inst.*/
68  if ((r[-1] & 0x0000ff00) == 0x6100) *r = (int)subr-x+4; /*bsr.l*/
69  else *r = (int)subr; /*news and SunOS4.0 uses jsr.l instead of bsr.l*/
70 /* assembler format slightly differs between sun3 and news*/
71 #if sun3
72  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
73  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
74  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
75  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
76  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
77  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
78  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
79  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
80  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
81  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
82  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
83  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
84  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
85  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
86  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
87  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
88  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
89  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
90  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
91  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
92  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
93  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
94  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
95  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
96  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
97  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
98  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
99  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
100  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
101  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
102  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
103  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
104  asm(" cmpl #0x12345678,d0\n"); /*purge cache*/
105 #endif
106 #if news
107  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
108  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
109  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
110  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
111  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
112  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
113  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
114  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
115  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
116  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
117  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
118  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
119  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
120  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
121  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
122  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
123  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
124  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
125  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
126  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
127  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
128  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
129  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
130  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
131  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
132  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
133  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
134  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
135  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
136  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
137  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
138  asm(" cmp.l #0x12345678,d0"); /*purge cache*/
139 #endif
140 #if sanyo
141  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
142  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
143  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
144  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
145  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
146  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
147  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
148  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
149  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
150  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
151  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
152  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
153  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
154  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
155  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
156  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
157  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
158  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
159  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
160  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
161  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
162  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
163  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
164  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
165  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
166  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
167  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
168  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
169  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
170  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
171  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
172  asm(" cmp.l %d0,&0x12345678"); /*purge cache*/
173 #endif
174  return((*subr)(n,argv)); }
175  else return(ufuncall(sym,sym,argv,0,n));}
176 
177 #endif
178 
179 /*
180 /* V A X
181 */
182 
183 #if vax
184 pointer fcall(n,argv,sym)
185 int n;
186 pointer argv[];
187 pointer sym;
188 { pointer fn;
189  pointer (*subr)();
190  int *stackframe;
191  int *returnaddress;
192 
193  fn=getfunc(sym);
194 
195  if (ispointer(fn) && (fn->cix==codecp.cix)) {
196 
197  subr=(pointer (*)())
198  ((int)(fn->c.code.codevec)
199  +((int)(fn->c.code.entry)>>2));
200 
201  stackframe= &n;
202  returnaddress=(int *)stackframe[-2];
203  returnaddress[-1]=(int)subr-(int)returnaddress;
204  fn=(*subr)(n,argv);
205  return(fn); }
206  else return(ufuncall(sym,sym,argv,0,n));}
207 
208 #endif
209 
210 /*
211 #if mips && !IRIX
212 pointer fcall(n,argv,sym)
213 int n;
214 register pointer argv[];
215 register pointer sym;
216 { pointer fn;
217  pointer (*subr)();
218 
219  fn=getfunc(sym);
220 
221  if (ispointer(fn) && (fn->cix==codecp.cix)) {
222 
223  subr=(pointer (*)())
224  ((int)(fn->c.code.codevec)
225  +((int)(fn->c.code.entry)>>2));
226 
227  fn=(*subr)(n,argv);
228  return(fn); }
229  else return(ufuncall(sym,sym,argv,0,n));}
230 
231 #endif
232 */
233 
NIL
pointer NIL
Definition: eus.c:110
context
Definition: eus.h:524
code::codevec
pointer codevec
Definition: eus.h:231
codecp
cixpair codecp
Definition: eus.c:79
intval
#define intval(p)
Definition: sfttest.c:1
pointer
struct cell * pointer
Definition: eus.h:165
rcsid
static char * rcsid
Definition: fcall.c:7
code::entry2
pointer entry2
Definition: eus.h:236
cell::c
union cell::cellunion c
cell::cellunion::code
struct code code
Definition: eus.h:408
fcall
pointer fcall(int n, argv, pointer sym)
Definition: fcall.c:52
code::entry
pointer entry
Definition: eus.h:234
cell::cix
short cix
Definition: eus.h:398
cixpair::cix
short cix
Definition: eus.h:453
getfunc
pointer getfunc(context *, pointer)
Definition: eval.c:97
cell
Definition: eus.h:381
eusinteger_t
long eusinteger_t
Definition: eus.h:19
ufuncall
pointer ufuncall(context *, pointer, pointer, pointer, struct bindframe *, int)
Definition: eval.c:1469
fcallx
pointer fcallx(context *ctx, int n, pointer *argv, pointer(**fslot)(), pointer sym)
Definition: fcall.c:15
n
GLfloat n[6][3]
Definition: cube.c:15

euslisp
Author(s): Toshihiro Matsui
autogenerated on Thu Jun 15 2023 02:06:43