Skip to content

Commit f9e1a59

Browse files
k-okadak-okada
committed
add call_foreigin for 32bit arm code
1 parent 2dfde2e commit f9e1a59

File tree

1 file changed

+257
-1
lines changed

1 file changed

+257
-1
lines changed

‎lisp/c/eval.c

Lines changed: 257 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -980,7 +980,263 @@ pointer args[];
980980
} else error(E_USER,(pointer)"result type?");
981981
}
982982
}
983-
#else /* not x86_64 */
983+
984+
#elif defined(ARM) /* not (defined(x86_64) || defined(aarch64)) */
985+
986+
extern int exec_function_i(void (*)(), int *, int *, int, int *);
987+
extern int exec_function_f(void (*)(), int *, int *, int, int *);
988+
989+
__asm__ (".align 4\n"
990+
".global exec_function_i\n\t"
991+
".type exec_function_i, %function\n"
992+
"exec_function_i:\n\t"
993+
"push {r7, lr}\n\t"
994+
"sub sp, sp, #136\n\t"
995+
"add r7, sp, #64\n\t"
996+
"str r0, [r7, #12]\n\t" // fc
997+
"str r1, [r7, #8]\n\t" // iargv
998+
"str r2, [r7, #4]\n\t" // fargv
999+
"str r3, [r7]\n\t" // vcntr
1000+
// vargv -> stack
1001+
"movs r1, #0\n\t"
1002+
"ldr r2, [r7, #80]\n\t" // vargv
1003+
"b .FUNCII_LPCK\n\t"
1004+
".FUNCII_LP:\n\t"
1005+
"lsl r0, r1, #2\n\t"
1006+
"add r3, r2, r0\n\t" // vargv[i]
1007+
"add r5, sp, r0\n\t" // stack[i] // using v4 cause segfault.
1008+
"ldr r0, [r3]\n\t"
1009+
"str r0, [r5]\n\t" // push stack
1010+
"adds r1, r1, #1\n\t"
1011+
".FUNCII_LPCK:\n\t"
1012+
"ldr r5, [r7]\n\t"
1013+
"cmp r1, r5\n\t"
1014+
"blt .FUNCII_LP\n\t"
1015+
// fargv -> register
1016+
"ldr r0, [r7,#4]\n\t"
1017+
"vldr.32 s0, [r0]\n\t"
1018+
"vldr.32 s1, [r0,#4]\n\t"
1019+
"vldr.32 s2, [r0,#8]\n\t"
1020+
"vldr.32 s3, [r0,#12]\n\t"
1021+
"vldr.32 s4, [r0,#16]\n\t"
1022+
"vldr.32 s5, [r0,#20]\n\t"
1023+
"vldr.32 s6, [r0,#24]\n\t"
1024+
"vldr.32 s7, [r0,#28]\n\t"
1025+
"vldr.32 s8, [r0,#32]\n\t"
1026+
"vldr.32 s9, [r0,#36]\n\t"
1027+
"vldr.32 s10, [r0,#40]\n\t"
1028+
"vldr.32 s11, [r0,#44]\n\t"
1029+
"vldr.32 s12, [r0,#48]\n\t"
1030+
"vldr.32 s13, [r0,#52]\n\t"
1031+
"vldr.32 s14, [r0,#56]\n\t"
1032+
"vldr.32 s15, [r0,#60]\n\t"
1033+
// iargv -> register
1034+
"ldr r0, [r7,#8]\n\t"
1035+
"ldr r0, [r0]\n\t"
1036+
"ldr r1, [r7,#8]\n\t"
1037+
"ldr r1, [r1,#4]\n\t"
1038+
"ldr r2, [r7,#8]\n\t"
1039+
"ldr r2, [r2,#8]\n\t"
1040+
"ldr r3, [r7,#8]\n\t"
1041+
"ldr r3, [r3,#12]\n\t"
1042+
// funcall
1043+
"ldr r6, [r7, #12]\n\t"
1044+
"blx r6\n\t"
1045+
// retval
1046+
"adds r7, r7, #72\n\t"
1047+
"mov sp, r7\n\t"
1048+
"@ sp needed @\n\t"
1049+
"pop {r7, pc}\n\t"
1050+
".size exec_function_i, .-exec_function_i\n\t"
1051+
);
1052+
1053+
__asm__ (".align 4\n"
1054+
".global exec_function_f\n\t"
1055+
".type exec_function_f, %function\n"
1056+
"exec_function_f:\n\t"
1057+
"push {r7, lr}\n\t"
1058+
"sub sp, sp, #136\n\t"
1059+
"add r7, sp, #64\n\t"
1060+
"str r0, [r7, #12]\n\t" // fc
1061+
"str r1, [r7, #8]\n\t" // iargv
1062+
"str r2, [r7, #4]\n\t" // fargv
1063+
"str r3, [r7]\n\t" // vcntr
1064+
// vargv -> stack
1065+
"movs r1, #0\n\t"
1066+
"ldr r2, [r7, #80]\n\t" // vargv
1067+
"b .FUNCFF_LPCK\n\t"
1068+
".FUNCFF_LP:\n\t"
1069+
"lsl r0, r1, #2\n\t"
1070+
"add r3, r2, r0\n\t" // vargv[i]
1071+
"add r4, sp, r0\n\t" // stack[i]
1072+
"ldr r0, [r3]\n\t"
1073+
"str r0, [r4]\n\t" // push stack
1074+
"adds r1, r1, #1\n\t"
1075+
".FUNCFF_LPCK:\n\t"
1076+
"ldr r5, [r7]\n\t"
1077+
"cmp r1, r5\n\t"
1078+
"blt .FUNCFF_LP\n\t"
1079+
// fargv -> register
1080+
"ldr r0, [r7,#4]\n\t"
1081+
"vldr.32 s0, [r0]\n\t"
1082+
"vldr.32 s1, [r0,#4]\n\t"
1083+
"vldr.32 s2, [r0,#8]\n\t"
1084+
"vldr.32 s3, [r0,#12]\n\t"
1085+
"vldr.32 s4, [r0,#16]\n\t"
1086+
"vldr.32 s5, [r0,#20]\n\t"
1087+
"vldr.32 s6, [r0,#24]\n\t"
1088+
"vldr.32 s7, [r0,#28]\n\t"
1089+
"vldr.32 s8, [r0,#32]\n\t"
1090+
"vldr.32 s9, [r0,#36]\n\t"
1091+
"vldr.32 s10, [r0,#40]\n\t"
1092+
"vldr.32 s11, [r0,#44]\n\t"
1093+
"vldr.32 s12, [r0,#48]\n\t"
1094+
"vldr.32 s13, [r0,#52]\n\t"
1095+
"vldr.32 s14, [r0,#56]\n\t"
1096+
"vldr.32 s15, [r0,#60]\n\t"
1097+
// iargv -> register
1098+
"ldr r0, [r7,#8]\n\t"
1099+
"ldr r0, [r0]\n\t"
1100+
"ldr r1, [r7,#8]\n\t"
1101+
"ldr r1, [r1,#4]\n\t"
1102+
"ldr r2, [r7,#8]\n\t"
1103+
"ldr r2, [r2,#8]\n\t"
1104+
"ldr r3, [r7,#8]\n\t"
1105+
"ldr r3, [r3,#12]\n\t"
1106+
// funcall
1107+
"ldr r6, [r7, #12]\n\t"
1108+
"blx r6\n\t"
1109+
// retval
1110+
"vmov r0, s0 @ <retval>\n\t"
1111+
"adds r7, r7, #72\n\t"
1112+
"mov sp, r7\n\t"
1113+
"@ sp needed @\n\t"
1114+
"pop {r7, pc}\n\t"
1115+
".size exec_function_f, .-exec_function_f\n\t"
1116+
);
1117+
1118+
#define NUM_INT_ARGUMENTS 4
1119+
#define NUM_FLT_ARGUMENTS 16
1120+
#define NUM_EXTRA_ARGUMENTS 16
1121+
1122+
pointer call_foreign(ifunc,code,n,args)
1123+
eusinteger_t (*ifunc)(); /* ???? */
1124+
pointer code;
1125+
int n;
1126+
pointer args[];
1127+
{
1128+
pointer paramtypes=code->c.fcode.paramtypes;
1129+
pointer resulttype=code->c.fcode.resulttype;
1130+
pointer p,lisparg;
1131+
eusinteger_t iargv[NUM_INT_ARGUMENTS];
1132+
eusinteger_t fargv[NUM_FLT_ARGUMENTS];
1133+
eusinteger_t vargv[NUM_EXTRA_ARGUMENTS];
1134+
int icntr = 0, fcntr = 0, vcntr = 0;
1135+
1136+
numunion nu;
1137+
eusinteger_t j=0; /*lisp argument counter*//* ???? */
1138+
eusinteger_t c=0;
1139+
union {
1140+
double d;
1141+
float f;
1142+
long l;
1143+
struct {
1144+
int i1,i2;} i;
1145+
} numbox;
1146+
double f;
1147+
1148+
if (code->c.fcode.entry2 != NIL) {
1149+
ifunc = (eusinteger_t (*)())((((eusinteger_t)ifunc)&0xffffffff00000000)
1150+
| (intval(code->c.fcode.entry2)&0x00000000ffffffff));
1151+
/* R.Hanai 090726 */
1152+
}
1153+
1154+
while (iscons(paramtypes)) {
1155+
p=ccar(paramtypes); paramtypes=ccdr(paramtypes);
1156+
lisparg=args[j++];
1157+
if (p==K_INTEGER) {
1158+
c = isint(lisparg)?intval(lisparg):bigintval(lisparg);
1159+
if(icntr < NUM_INT_ARGUMENTS) iargv[icntr++] = c; else vargv[vcntr++] = c;
1160+
} else if (p==K_STRING) {
1161+
if (elmtypeof(lisparg)==ELM_FOREIGN) c=lisparg->c.ivec.iv[0];
1162+
else c=(eusinteger_t)(lisparg->c.str.chars);
1163+
if(icntr < NUM_INT_ARGUMENTS) iargv[icntr++] = c; else vargv[vcntr++] = c;
1164+
} else if (p==K_FLOAT32 || p==K_FLOAT) {
1165+
numbox.f=(float)ckfltval(lisparg);
1166+
c=((eusinteger_t)numbox.i.i1) & 0x00000000FFFFFFFF;
1167+
if(fcntr < NUM_FLT_ARGUMENTS) fargv[fcntr++] = c; else vargv[vcntr++] = c;
1168+
} else if (p==K_DOUBLE) {
1169+
numbox.f=ckfltval(lisparg);
1170+
//c=numbox.l;
1171+
c=((eusinteger_t)numbox.i.i1) & 0x00000000FFFFFFFF;
1172+
if(fcntr < NUM_FLT_ARGUMENTS) fargv[fcntr++] = c; else vargv[vcntr++] = c;
1173+
} else error(E_USER,(pointer)"unknown type specifier");
1174+
if (vcntr >= NUM_EXTRA_ARGUMENTS) {
1175+
error(E_USER,(pointer)"too many number of arguments");
1176+
}
1177+
}
1178+
/* &rest arguments? */
1179+
while (j<n) { /* j is the counter for the actual arguments*/
1180+
lisparg=args[j++];
1181+
if (isint(lisparg)) {
1182+
c=intval(lisparg);
1183+
if(icntr < NUM_INT_ARGUMENTS) iargv[icntr++] = c; else vargv[vcntr++] = c;
1184+
} else if (isflt(lisparg)) {
1185+
numbox.d=ckfltval(lisparg); /* i advances independently */
1186+
c=numbox.l;
1187+
if(fcntr < NUM_FLT_ARGUMENTS) fargv[fcntr++] = c; else vargv[vcntr++] = c;
1188+
} else if (isvector(lisparg)) {
1189+
if (elmtypeof(lisparg)==ELM_FOREIGN) c=lisparg->c.ivec.iv[0];
1190+
else c=(eusinteger_t)(lisparg->c.str.chars);
1191+
if(icntr < NUM_INT_ARGUMENTS) iargv[icntr++] = c; else vargv[vcntr++] = c;
1192+
} else if (isbignum(lisparg)){
1193+
if (bigsize(lisparg)==1){
1194+
eusinteger_t *xv = bigvec(lisparg);
1195+
c=(eusinteger_t)xv[0];
1196+
if(icntr < NUM_INT_ARGUMENTS) iargv[icntr++] = c; else vargv[vcntr++] = c;
1197+
}else{
1198+
fprintf(stderr, "bignum size!=1\n");
1199+
}
1200+
} else {
1201+
c=(eusinteger_t)(lisparg->c.obj.iv);
1202+
if(icntr < NUM_INT_ARGUMENTS) iargv[icntr++] = c; else vargv[vcntr++] = c;
1203+
}
1204+
if (vcntr >= NUM_EXTRA_ARGUMENTS) {
1205+
error(E_USER,(pointer)"too many number of arguments");
1206+
}
1207+
}
1208+
/**/
1209+
if (resulttype==K_FLOAT || resulttype==K_FLOAT32) {
1210+
numbox.l = exec_function_f((void (*)())ifunc, iargv, fargv, vcntr, vargv);
1211+
f = (double)numbox.f;
1212+
return(makeflt(f));
1213+
} else {
1214+
c = exec_function_i((void (*)())ifunc, iargv, fargv, vcntr, vargv);
1215+
if (resulttype==K_INTEGER) {
1216+
return(mkbigint(c));
1217+
} else if (resulttype==K_STRING) {
1218+
p=makepointer(c-2*sizeof(pointer));
1219+
if (isvector(p)) return(p);
1220+
else error(E_USER,(pointer)"illegal foreign string");
1221+
} else if (iscons(resulttype)) {
1222+
/* (:string [10]) (:foreign-string [20]) */
1223+
if (ccar(resulttype)==K_STRING) { /* R.Hanai 09/07/25 */
1224+
resulttype=ccdr(resulttype);
1225+
if (resulttype!=NIL) j=ckintval(ccar(resulttype));
1226+
else j=strlen((char *)c);
1227+
return(makestring((char *)c, j));
1228+
} else if (ccar(resulttype)==K_FOREIGN_STRING) { /* R.Hanai 09/07/25 */
1229+
resulttype=ccdr(resulttype);
1230+
if (resulttype!=NIL) j=ckintval(ccar(resulttype));
1231+
else j=strlen((char *)c);
1232+
return(make_foreign_string(c, j)); }
1233+
error(E_USER,(pointer)"unknown result type");
1234+
} else error(E_USER,(pointer)"result type?");
1235+
}
1236+
}
1237+
1238+
#else /* not ARM nor (defined(x86_64) || defined(aarch64)) */
1239+
9841240
pointer call_foreign(ifunc,code,n,args)
9851241
eusinteger_t (*ifunc)(); /* ???? */
9861242
pointer code;

0 commit comments

Comments
 (0)