euslisp: fcall.c Source File

Go to the documentation of this file.
00001 /****************************************************************/
00002 /* machine dependent compiled code runtime routines
00003 /*      for sun3, sun4 and vax ultrix
00004 /*      1987-Dec-23
00005 /*      Copyright Toshihiro MATSUI
00006 /****************************************************************/
00007 static char *rcsid="@(#)$Id$";
00008 
00009 #include "../c/eus.h"
00010 
00011 /* 
00012 /* s u n 4 / S P A R C
00013 */
00014 
00015 pointer fcallx(ctx,n,argv,fslot,sym)
00016 register context *ctx;
00017 int n;
00018 pointer *argv,sym;
00019 pointer (**fslot)();
00020 { eusinteger_t x;
00021   pointer fn;
00022   pointer (*subr)();
00023 
00024   fn=getfunc(ctx,sym);
00025 
00026   if (ispointer(fn) && (fn->cix==codecp.cix)) {
00027 #if (WORD_SIZE == 64)
00028     x= (eusinteger_t)(fn->c.code.entry); x &= ~3L;
00029 #else
00030     x= (eusinteger_t)(fn->c.code.entry); x &= ~3;
00031 #endif
00032 #if ARM
00033     if (fn->c.code.entry2 != NIL) {
00034 #if (WORD_SIZE == 64)
00035       x = x | (intval(fn->c.code.entry2)&0x00000000ffffffff);
00036 #else
00037       x = x | (intval(fn->c.code.entry2)&0x0000ffff);
00038 #endif
00039     }
00040 #endif
00041     subr=(pointer (*)())(x);
00042     *fslot= subr;
00043     return((*subr)(ctx,n,argv));
00044     }
00045   else return(ufuncall(ctx,sym,sym,(pointer)argv,0,n));}
00046 
00047 /*
00048 /*  s u n 3 / M 6 8 0 2 0 
00049 */
00050 
00051 #if sun3 || news || sanyo
00052 pointer fcall(n,argv,sym)
00053 int n;
00054 pointer argv[];
00055 pointer sym;
00056 { register int *r= &n;
00057   int x;
00058   pointer fn,result;
00059   pointer (*subr)();
00060 
00061   fn=getfunc(sym);
00062 
00063   if (ispointer(fn) && (fn->cix==codecp.cix)) {
00064     subr=(pointer (*)())
00065           ((int)(fn->c.code.codevec)+(intval(fn->c.code.entry)));
00066     x=r[-1];    /*return addr .i.e. next instruction address to be executed*/
00067     r=(int *)(x-4);     /*operand for the bsrl inst.*/
00068     if ((r[-1] & 0x0000ff00) == 0x6100) *r = (int)subr-x+4; /*bsr.l*/
00069     else  *r = (int)subr; /*news and SunOS4.0 uses jsr.l instead of bsr.l*/
00070 /* assembler format slightly differs between sun3 and news*/
00071 #if sun3
00072     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00073     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00074     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00075     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00076     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00077     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00078     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00079     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00080     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00081     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00082     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00083     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00084     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00085     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00086     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00087     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00088     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00089     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00090     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00091     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00092     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00093     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00094     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00095     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00096     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00097     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00098     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00099     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00100     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00101     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00102     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00103     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00104     asm("       cmpl    #0x12345678,d0\n");     /*purge cache*/
00105 #endif
00106 #if news
00107     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00108     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00109     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00110     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00111     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00112     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00113     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00114     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00115     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00116     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00117     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00118     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00119     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00120     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00121     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00122     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00123     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00124     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00125     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00126     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00127     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00128     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00129     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00130     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00131     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00132     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00133     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00134     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00135     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00136     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00137     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00138     asm("       cmp.l   #0x12345678,d0");       /*purge cache*/
00139 #endif
00140 #if sanyo
00141     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00142     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00143     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00144     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00145     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00146     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00147     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00148     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00149     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00150     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00151     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00152     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00153     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00154     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00155     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00156     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00157     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00158     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00159     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00160     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00161     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00162     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00163     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00164     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00165     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00166     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00167     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00168     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00169     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00170     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00171     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00172     asm("       cmp.l   %d0,&0x12345678");      /*purge cache*/
00173 #endif
00174     return((*subr)(n,argv)); }
00175   else return(ufuncall(sym,sym,argv,0,n));}
00176 
00177 #endif
00178 
00179 /*
00180 /*  V A X
00181 */
00182 
00183 #if vax
00184 pointer fcall(n,argv,sym)
00185 int n;
00186 pointer argv[];
00187 pointer sym;
00188 { pointer fn;
00189   pointer (*subr)();
00190   int *stackframe;
00191   int *returnaddress;
00192 
00193   fn=getfunc(sym);
00194 
00195   if (ispointer(fn) && (fn->cix==codecp.cix)) {
00196 
00197     subr=(pointer (*)())
00198           ((int)(fn->c.code.codevec)
00199            +((int)(fn->c.code.entry)>>2));
00200 
00201     stackframe= &n;
00202     returnaddress=(int *)stackframe[-2];
00203     returnaddress[-1]=(int)subr-(int)returnaddress;
00204     fn=(*subr)(n,argv);
00205     return(fn);    }
00206   else return(ufuncall(sym,sym,argv,0,n));}
00207 
00208 #endif
00209 
00210 /*
00211 #if mips && !IRIX
00212 pointer fcall(n,argv,sym)
00213 int n;
00214 register pointer argv[];
00215 register pointer sym;
00216 { pointer fn;
00217   pointer (*subr)();
00218 
00219   fn=getfunc(sym);
00220 
00221   if (ispointer(fn) && (fn->cix==codecp.cix)) {
00222 
00223     subr=(pointer (*)())
00224           ((int)(fn->c.code.codevec)
00225            +((int)(fn->c.code.entry)>>2));
00226 
00227     fn=(*subr)(n,argv);
00228     return(fn);    }
00229   else return(ufuncall(sym,sym,argv,0,n));}
00230 
00231 #endif
00232 */
00233