nag_s.c 66 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958
  1. /* Signature: 1b4f8465 08-Apr-2002 */
  2. #if 1
  3. Lisp_Object MS_CDECL Ls01eaf(Lisp_Object nil, int nargs, ...)
  4. {
  5. va_list args;
  6. Lisp_Object Lzr, Lzi, Lifail, Lwr, Lwi;
  7. double z[2], w[2];
  8. int32 ifail;
  9. /*
  10. * Returning DOUBLE COMPLEX objects via the function name is not portable
  11. * so we use a dummy subroutine as glue.
  12. */
  13. #ifdef LOADLIB
  14. typedef void (__stdcall *PSXXEAF) (double *, double *, int32 *);
  15. HINSTANCE hLib;
  16. PSXXEAF sxxeaf_proc;
  17. #else
  18. extern void __stdcall SXXEAF (double *, double *, int32 *);
  19. #endif
  20. /* Set up arguments as Lisp Objects */
  21. argcheck(nargs,3,"Ls01eaf");
  22. va_start(args,nargs);
  23. Lzr = va_arg(args, Lisp_Object);
  24. Lzi = va_arg(args, Lisp_Object);
  25. Lifail = va_arg(args, Lisp_Object);
  26. va_end(args);
  27. /* Translate arguments into C objects */
  28. push3(Lzr,Lzi,Lifail);
  29. z[0] = float_of_number(Lzr);
  30. pop3(Lifail,Lzi,Lzr);
  31. errexit();
  32. push3(Lzr,Lzi,Lifail);
  33. z[1] = float_of_number(Lzi);
  34. pop3(Lifail,Lzi,Lzr);
  35. errexit();
  36. push3(Lzr,Lzi,Lifail);
  37. ifail = thirty_two_bits(Lifail);
  38. pop3(Lifail,Lzi,Lzr);
  39. errexit();
  40. /* Call NAG routine */
  41. #ifdef LOADLIB
  42. free_prevlib ();
  43. if ( (hLib = LoadLibrary ("nagfasj")) == NULL ) /* FIXME (jackets) */
  44. {
  45. /* couldn't find DLL -- error handling here */
  46. ifail = -999;
  47. }
  48. else /* OK so far */
  49. {
  50. if ( (sxxeaf_proc = (PSXXEAF) GetProcAddress (hLib, "_SXXEAF@12"))
  51. == NULL )
  52. {
  53. /* couldn't find function within DLL -- error handling here */
  54. ifail = -998;
  55. }
  56. else /* have found function in DLL */
  57. {
  58. (*sxxeaf_proc) (z, w, &ifail);
  59. }
  60. }
  61. currlib = hLib;
  62. #else
  63. SXXEAF(z,w,&ifail);
  64. #endif
  65. /* Translate return values to CCL */
  66. /* Copy result */
  67. Lwr = make_boxfloat(w[0],TYPE_DOUBLE_FLOAT);
  68. push(Lwr);
  69. Lwi = make_boxfloat(w[1],TYPE_DOUBLE_FLOAT);
  70. pop(Lwr);
  71. errexit();
  72. push2(Lwr,Lwi);
  73. Lifail = int2ccl(ifail);
  74. pop2(Lwi,Lwr);
  75. errexit();
  76. return Llist(nil,3,Lwr,Lwi,Lifail);
  77. }
  78. Lisp_Object MS_CDECL Ls13aaf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  79. {
  80. Lisp_Object Ly;
  81. double x, y;
  82. int32 ifail;
  83. #ifdef LOADLIB
  84. typedef double (__stdcall *PS13AAF) (double *, int32 *);
  85. HINSTANCE hLib;
  86. PS13AAF s13aaf_proc;
  87. #else
  88. extern double __stdcall S13AAF (double *, int32 *);
  89. #endif
  90. /* Translate arguments into C objects */
  91. push2(Lx,Lifail);
  92. x = float_of_number(Lx);
  93. pop2(Lifail,Lx);
  94. errexit();
  95. push2(Lx,Lifail);
  96. ifail = thirty_two_bits(Lifail);
  97. pop2(Lifail,Lx);
  98. errexit();
  99. /* Call NAG routine */
  100. #ifdef LOADLIB
  101. free_prevlib ();
  102. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  103. {
  104. /* couldn't find DLL -- error handling here */
  105. ifail = -999;
  106. }
  107. else /* OK so far */
  108. {
  109. if ( (s13aaf_proc = (PS13AAF) GetProcAddress (hLib, "_S13AAF@8"))
  110. == NULL )
  111. {
  112. /* couldn't find function within DLL -- error handling here */
  113. ifail = -998;
  114. }
  115. else /* have found function in DLL */
  116. {
  117. y = (*s13aaf_proc) (&x, &ifail);
  118. }
  119. }
  120. currlib = hLib;
  121. #else
  122. y = S13AAF(&x,&ifail);
  123. #endif
  124. /* Translate return values to CCL */
  125. /* Copy result */
  126. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  127. push(Ly);
  128. Lifail = int2ccl(ifail);
  129. pop(Ly);
  130. errexit();
  131. return Llist(nil,2,Ly,Lifail);
  132. }
  133. #endif
  134. Lisp_Object MS_CDECL Ls13acf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  135. {
  136. Lisp_Object Ly;
  137. double x, y;
  138. int32 ifail;
  139. #ifdef LOADLIB
  140. typedef double (__stdcall *PS13ACF) (double *, int32 *);
  141. HINSTANCE hLib;
  142. PS13ACF s13acf_proc;
  143. #else
  144. extern double __stdcall S13ACF (double *, int32 *);
  145. #endif
  146. /* Translate arguments into C objects */
  147. push2(Lx,Lifail);
  148. x = float_of_number(Lx);
  149. pop2(Lifail,Lx);
  150. errexit();
  151. push2(Lx,Lifail);
  152. ifail = thirty_two_bits(Lifail);
  153. pop2(Lifail,Lx);
  154. errexit();
  155. /* Call NAG routine */
  156. #ifdef LOADLIB
  157. free_prevlib ();
  158. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  159. {
  160. /* couldn't find DLL -- error handling here */
  161. ifail = -999;
  162. }
  163. else /* OK so far */
  164. {
  165. if ( (s13acf_proc = (PS13ACF) GetProcAddress (hLib, "_S13ACF@8"))
  166. == NULL )
  167. {
  168. /* couldn't find function within DLL -- error handling here */
  169. ifail = -998;
  170. }
  171. else /* have found function in DLL */
  172. {
  173. y = (*s13acf_proc) (&x, &ifail);
  174. }
  175. }
  176. currlib = hLib;
  177. #else
  178. y = S13ACF(&x,&ifail);
  179. #endif
  180. /* Translate return values to CCL */
  181. /* Copy result */
  182. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  183. push(Ly);
  184. Lifail = int2ccl(ifail);
  185. pop(Ly);
  186. errexit();
  187. return Llist(nil,2,Ly,Lifail);
  188. }
  189. Lisp_Object MS_CDECL Ls13adf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  190. {
  191. Lisp_Object Ly;
  192. double x, y;
  193. int32 ifail;
  194. #ifdef LOADLIB
  195. typedef double (__stdcall *PS13ADF) (double *, int32 *);
  196. HINSTANCE hLib;
  197. PS13ADF s13adf_proc;
  198. #else
  199. extern double __stdcall S13ADF (double *, int32 *);
  200. #endif
  201. /* Translate arguments into C objects */
  202. push2(Lx,Lifail);
  203. x = float_of_number(Lx);
  204. pop2(Lifail,Lx);
  205. errexit();
  206. push2(Lx,Lifail);
  207. ifail = thirty_two_bits(Lifail);
  208. pop2(Lifail,Lx);
  209. errexit();
  210. /* Call NAG routine */
  211. #ifdef LOADLIB
  212. free_prevlib ();
  213. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  214. {
  215. /* couldn't find DLL -- error handling here */
  216. ifail = -999;
  217. }
  218. else /* OK so far */
  219. {
  220. if ( (s13adf_proc = (PS13ADF) GetProcAddress (hLib, "_S13ADF@8"))
  221. == NULL )
  222. {
  223. /* couldn't find function within DLL -- error handling here */
  224. ifail = -998;
  225. }
  226. else /* have found function in DLL */
  227. {
  228. y = (*s13adf_proc) (&x, &ifail);
  229. }
  230. }
  231. currlib = hLib;
  232. #else
  233. y = S13ADF(&x,&ifail);
  234. #endif
  235. /* Translate return values to CCL */
  236. /* Copy result */
  237. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  238. push(Ly);
  239. Lifail = int2ccl(ifail);
  240. pop(Ly);
  241. errexit();
  242. return Llist(nil,2,Ly,Lifail);
  243. }
  244. Lisp_Object MS_CDECL Ls14aaf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  245. {
  246. Lisp_Object Ly;
  247. double x, y;
  248. int32 ifail;
  249. #ifdef LOADLIB
  250. typedef double (__stdcall *PS14AAF) (double *, int32 *);
  251. HINSTANCE hLib;
  252. PS14AAF s14aaf_proc;
  253. #else
  254. extern double __stdcall S14AAF (double *, int32 *);
  255. #endif
  256. /* Translate arguments into C objects */
  257. push2(Lx,Lifail);
  258. x = float_of_number(Lx);
  259. pop2(Lifail,Lx);
  260. errexit();
  261. push2(Lx,Lifail);
  262. ifail = thirty_two_bits(Lifail);
  263. pop2(Lifail,Lx);
  264. errexit();
  265. /* Call NAG routine */
  266. #ifdef LOADLIB
  267. free_prevlib ();
  268. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  269. {
  270. /* couldn't find DLL -- error handling here */
  271. ifail = -999;
  272. }
  273. else /* OK so far */
  274. {
  275. if ( (s14aaf_proc = (PS14AAF) GetProcAddress (hLib, "_S14AAF@8"))
  276. == NULL )
  277. {
  278. /* couldn't find function within DLL -- error handling here */
  279. ifail = -998;
  280. }
  281. else /* have found function in DLL */
  282. {
  283. y = (*s14aaf_proc) (&x, &ifail);
  284. }
  285. }
  286. currlib = hLib;
  287. #else
  288. y = S14AAF(&x,&ifail);
  289. #endif
  290. /* Translate return values to CCL */
  291. /* Copy result */
  292. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  293. push(Ly);
  294. Lifail = int2ccl(ifail);
  295. pop(Ly);
  296. errexit();
  297. return Llist(nil,2,Ly,Lifail);
  298. }
  299. Lisp_Object MS_CDECL Ls14abf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  300. {
  301. Lisp_Object Ly;
  302. double x, y;
  303. int32 ifail;
  304. #ifdef LOADLIB
  305. typedef double (__stdcall *PS14ABF) (double *, int32 *);
  306. HINSTANCE hLib;
  307. PS14ABF s14abf_proc;
  308. #else
  309. extern double __stdcall S14ABF (double *, int32 *);
  310. #endif
  311. /* Translate arguments into C objects */
  312. push2(Lx,Lifail);
  313. x = float_of_number(Lx);
  314. pop2(Lifail,Lx);
  315. errexit();
  316. push2(Lx,Lifail);
  317. ifail = thirty_two_bits(Lifail);
  318. pop2(Lifail,Lx);
  319. errexit();
  320. /* Call NAG routine */
  321. #ifdef LOADLIB
  322. free_prevlib ();
  323. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  324. {
  325. /* couldn't find DLL -- error handling here */
  326. ifail = -999;
  327. }
  328. else /* OK so far */
  329. {
  330. if ( (s14abf_proc = (PS14ABF) GetProcAddress (hLib, "_S14ABF@8"))
  331. == NULL )
  332. {
  333. /* couldn't find function within DLL -- error handling here */
  334. ifail = -998;
  335. }
  336. else /* have found function in DLL */
  337. {
  338. y = (*s14abf_proc) (&x, &ifail);
  339. }
  340. }
  341. currlib = hLib;
  342. #else
  343. y = S14ABF(&x,&ifail);
  344. #endif
  345. /* Translate return values to CCL */
  346. /* Copy result */
  347. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  348. push(Ly);
  349. Lifail = int2ccl(ifail);
  350. pop(Ly);
  351. errexit();
  352. return Llist(nil,2,Ly,Lifail);
  353. }
  354. Lisp_Object MS_CDECL Ls14baf(Lisp_Object nil, int nargs, ...)
  355. {
  356. va_list args;
  357. Lisp_Object La, Lx, Ltol, Lp, Lq, Lifail;
  358. double a, x, tol, p, q;
  359. int32 ifail;
  360. #ifdef LOADLIB
  361. typedef void (__stdcall *PS14BAF) (double *, double *, double *, double *,
  362. double *, int32 *);
  363. HINSTANCE hLib;
  364. PS14BAF s14baf_proc;
  365. #else
  366. extern void __stdcall S14BAF (double *, double *, double *, double *,
  367. double *, int32 *);
  368. #endif
  369. /* Set up arguments as Lisp Objects */
  370. argcheck(nargs,4,"Ls14baf");
  371. va_start(args,nargs);
  372. La = va_arg(args, Lisp_Object);
  373. Lx = va_arg(args, Lisp_Object);
  374. Ltol = va_arg(args, Lisp_Object);
  375. Lifail = va_arg(args, Lisp_Object);
  376. va_end(args);
  377. /* Translate arguments into C objects */
  378. push4(La,Lx,Ltol,Lifail);
  379. a = float_of_number(La);
  380. pop4(Lifail,Ltol,Lx,La);
  381. errexit();
  382. push4(La,Lx,Ltol,Lifail);
  383. x = float_of_number(Lx);
  384. pop4(Lifail,Ltol,Lx,La);
  385. errexit();
  386. push4(La,Lx,Ltol,Lifail);
  387. tol = float_of_number(Ltol);
  388. pop4(Lifail,Ltol,Lx,La);
  389. errexit();
  390. push4(La,Lx,Ltol,Lifail);
  391. ifail = thirty_two_bits(Lifail);
  392. pop4(Lifail,Ltol,Lx,La);
  393. errexit();
  394. /* Call NAG routine */
  395. #ifdef LOADLIB
  396. free_prevlib ();
  397. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  398. {
  399. /* couldn't find DLL -- error handling here */
  400. ifail = -999;
  401. }
  402. else /* OK so far */
  403. {
  404. if ( (s14baf_proc = (PS14BAF) GetProcAddress (hLib, "_S14BAF@24"))
  405. == NULL )
  406. {
  407. /* couldn't find function within DLL -- error handling here */
  408. ifail = -998;
  409. }
  410. else /* have found function in DLL */
  411. {
  412. (*s14baf_proc) (&a, &x, &tol, &p, &q, &ifail);
  413. }
  414. }
  415. currlib = hLib;
  416. #else
  417. S14BAF (&a, &x, &tol, &p, &q, &ifail);
  418. #endif
  419. /* Translate return values to CCL */
  420. /* Copy result */
  421. Lp = make_boxfloat(p,TYPE_DOUBLE_FLOAT);
  422. push(Lp);
  423. Lq = make_boxfloat(q,TYPE_DOUBLE_FLOAT);
  424. pop(Lp);
  425. errexit();
  426. push2(Lp,Lq);
  427. Lifail = int2ccl(ifail);
  428. pop2(Lq,Lp);
  429. errexit();
  430. return Llist(nil,3,Lp,Lq,Lifail);
  431. }
  432. Lisp_Object MS_CDECL Ls15adf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  433. {
  434. Lisp_Object Ly;
  435. double x, y;
  436. int32 ifail;
  437. #ifdef LOADLIB
  438. typedef double (__stdcall *PS15ADF) (double *, int32 *);
  439. HINSTANCE hLib;
  440. PS15ADF s15adf_proc;
  441. #else
  442. extern double __stdcall S15ADF (double *, int32 *);
  443. #endif
  444. /* Translate arguments into C objects */
  445. push2(Lx,Lifail);
  446. x = float_of_number(Lx);
  447. pop2(Lifail,Lx);
  448. errexit();
  449. push2(Lx,Lifail);
  450. ifail = thirty_two_bits(Lifail);
  451. pop2(Lifail,Lx);
  452. errexit();
  453. /* Call NAG routine */
  454. #ifdef LOADLIB
  455. free_prevlib ();
  456. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  457. {
  458. /* couldn't find DLL -- error handling here */
  459. ifail = -999;
  460. }
  461. else /* OK so far */
  462. {
  463. if ( (s15adf_proc = (PS15ADF) GetProcAddress (hLib, "_S15ADF@8"))
  464. == NULL )
  465. {
  466. /* couldn't find function within DLL -- error handling here */
  467. ifail = -998;
  468. }
  469. else /* have found function in DLL */
  470. {
  471. y = (*s15adf_proc) (&x, &ifail);
  472. }
  473. }
  474. currlib = hLib;
  475. #else
  476. y = S15ADF(&x,&ifail);
  477. #endif
  478. /* Translate return values to CCL */
  479. /* Copy result */
  480. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  481. push(Ly);
  482. Lifail = int2ccl(ifail);
  483. pop(Ly);
  484. errexit();
  485. return Llist(nil,2,Ly,Lifail);
  486. }
  487. Lisp_Object MS_CDECL Ls15aef(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  488. {
  489. Lisp_Object Ly;
  490. double x, y;
  491. int32 ifail;
  492. #ifdef LOADLIB
  493. typedef double (__stdcall *PS15AEF) (double *, int32 *);
  494. HINSTANCE hLib;
  495. PS15AEF s15aef_proc;
  496. #else
  497. extern double __stdcall S15AEF (double *, int32 *);
  498. #endif
  499. /* Translate arguments into C objects */
  500. push2(Lx,Lifail);
  501. x = float_of_number(Lx);
  502. pop2(Lifail,Lx);
  503. errexit();
  504. push2(Lx,Lifail);
  505. ifail = thirty_two_bits(Lifail);
  506. pop2(Lifail,Lx);
  507. errexit();
  508. /* Call NAG routine */
  509. #ifdef LOADLIB
  510. free_prevlib ();
  511. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  512. {
  513. /* couldn't find DLL -- error handling here */
  514. ifail = -999;
  515. }
  516. else /* OK so far */
  517. {
  518. if ( (s15aef_proc = (PS15AEF) GetProcAddress (hLib, "_S15AEF@8"))
  519. == NULL )
  520. {
  521. /* couldn't find function within DLL -- error handling here */
  522. ifail = -998;
  523. }
  524. else /* have found function in DLL */
  525. {
  526. y = (*s15aef_proc) (&x, &ifail);
  527. }
  528. }
  529. currlib = hLib;
  530. #else
  531. y = S15AEF(&x,&ifail);
  532. #endif
  533. /* Translate return values to CCL */
  534. /* Copy result */
  535. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  536. push(Ly);
  537. Lifail = int2ccl(ifail);
  538. pop(Ly);
  539. errexit();
  540. return Llist(nil,2,Ly,Lifail);
  541. }
  542. Lisp_Object MS_CDECL Ls17acf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  543. {
  544. Lisp_Object Ly;
  545. double x, y;
  546. int32 ifail;
  547. #ifdef LOADLIB
  548. typedef double (__stdcall *PS17ACF) (double *, int32 *);
  549. HINSTANCE hLib;
  550. PS17ACF s17acf_proc;
  551. #else
  552. extern double __stdcall S17ACF (double *, int32 *);
  553. #endif
  554. /* Translate arguments into C objects */
  555. push2(Lx,Lifail);
  556. x = float_of_number(Lx);
  557. pop2(Lifail,Lx);
  558. errexit();
  559. push2(Lx,Lifail);
  560. ifail = thirty_two_bits(Lifail);
  561. pop2(Lifail,Lx);
  562. errexit();
  563. /* Call NAG routine */
  564. #ifdef LOADLIB
  565. free_prevlib ();
  566. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  567. {
  568. /* couldn't find DLL -- error handling here */
  569. ifail = -999;
  570. }
  571. else /* OK so far */
  572. {
  573. if ( (s17acf_proc = (PS17ACF) GetProcAddress (hLib, "_S17ACF@8"))
  574. == NULL )
  575. {
  576. /* couldn't find function within DLL -- error handling here */
  577. ifail = -998;
  578. }
  579. else /* have found function in DLL */
  580. {
  581. y = (*s17acf_proc) (&x, &ifail);
  582. }
  583. }
  584. currlib = hLib;
  585. #else
  586. y = S17ACF(&x,&ifail);
  587. #endif
  588. /* Translate return values to CCL */
  589. /* Copy result */
  590. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  591. push(Ly);
  592. Lifail = int2ccl(ifail);
  593. pop(Ly);
  594. errexit();
  595. return Llist(nil,2,Ly,Lifail);
  596. }
  597. Lisp_Object MS_CDECL Ls17adf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  598. {
  599. Lisp_Object Ly;
  600. double x, y;
  601. int32 ifail;
  602. #ifdef LOADLIB
  603. typedef double (__stdcall *PS17ADF) (double *, int32 *);
  604. HINSTANCE hLib;
  605. PS17ADF s17adf_proc;
  606. #else
  607. extern double __stdcall S17ADF (double *, int32 *);
  608. #endif
  609. /* Translate arguments into C objects */
  610. push2(Lx,Lifail);
  611. x = float_of_number(Lx);
  612. pop2(Lifail,Lx);
  613. errexit();
  614. push2(Lx,Lifail);
  615. ifail = thirty_two_bits(Lifail);
  616. pop2(Lifail,Lx);
  617. errexit();
  618. /* Call NAG routine */
  619. #ifdef LOADLIB
  620. free_prevlib ();
  621. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  622. {
  623. /* couldn't find DLL -- error handling here */
  624. ifail = -999;
  625. }
  626. else /* OK so far */
  627. {
  628. if ( (s17adf_proc = (PS17ADF) GetProcAddress (hLib, "_S17ADF@8"))
  629. == NULL )
  630. {
  631. /* couldn't find function within DLL -- error handling here */
  632. ifail = -998;
  633. }
  634. else /* have found function in DLL */
  635. {
  636. y = (*s17adf_proc) (&x, &ifail);
  637. }
  638. }
  639. currlib = hLib;
  640. #else
  641. y = S17ADF(&x,&ifail);
  642. #endif
  643. /* Translate return values to CCL */
  644. /* Copy result */
  645. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  646. push(Ly);
  647. Lifail = int2ccl(ifail);
  648. pop(Ly);
  649. errexit();
  650. return Llist(nil,2,Ly,Lifail);
  651. }
  652. Lisp_Object MS_CDECL Ls17aef(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  653. {
  654. Lisp_Object Ly;
  655. double x, y;
  656. int32 ifail;
  657. #ifdef LOADLIB
  658. typedef double (__stdcall *PS17AEF) (double *, int32 *);
  659. HINSTANCE hLib;
  660. PS17AEF s17aef_proc;
  661. #else
  662. extern double __stdcall S17AEF (double *, int32 *);
  663. #endif
  664. /* Translate arguments into C objects */
  665. push2(Lx,Lifail);
  666. x = float_of_number(Lx);
  667. pop2(Lifail,Lx);
  668. errexit();
  669. push2(Lx,Lifail);
  670. ifail = thirty_two_bits(Lifail);
  671. pop2(Lifail,Lx);
  672. errexit();
  673. /* Call NAG routine */
  674. #ifdef LOADLIB
  675. free_prevlib ();
  676. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  677. {
  678. /* couldn't find DLL -- error handling here */
  679. ifail = -999;
  680. }
  681. else /* OK so far */
  682. {
  683. if ( (s17aef_proc = (PS17AEF) GetProcAddress (hLib, "_S17AEF@8"))
  684. == NULL )
  685. {
  686. /* couldn't find function within DLL -- error handling here */
  687. ifail = -998;
  688. }
  689. else /* have found function in DLL */
  690. {
  691. y = (*s17aef_proc) (&x, &ifail);
  692. }
  693. }
  694. currlib = hLib;
  695. #else
  696. y = S17AEF(&x,&ifail);
  697. #endif
  698. /* Translate return values to CCL */
  699. /* Copy result */
  700. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  701. push(Ly);
  702. Lifail = int2ccl(ifail);
  703. pop(Ly);
  704. errexit();
  705. return Llist(nil,2,Ly,Lifail);
  706. }
  707. Lisp_Object MS_CDECL Ls17aff(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  708. {
  709. Lisp_Object Ly;
  710. double x, y;
  711. int32 ifail;
  712. #ifdef LOADLIB
  713. typedef double (__stdcall *PS17AFF) (double *, int32 *);
  714. HINSTANCE hLib;
  715. PS17AFF s17aff_proc;
  716. #else
  717. extern double __stdcall S17AFF (double *, int32 *);
  718. #endif
  719. /* Translate arguments into C objects */
  720. push2(Lx,Lifail);
  721. x = float_of_number(Lx);
  722. pop2(Lifail,Lx);
  723. errexit();
  724. push2(Lx,Lifail);
  725. ifail = thirty_two_bits(Lifail);
  726. pop2(Lifail,Lx);
  727. errexit();
  728. /* Call NAG routine */
  729. #ifdef LOADLIB
  730. free_prevlib ();
  731. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  732. {
  733. /* couldn't find DLL -- error handling here */
  734. ifail = -999;
  735. }
  736. else /* OK so far */
  737. {
  738. if ( (s17aff_proc = (PS17AFF) GetProcAddress (hLib, "_S17AFF@8"))
  739. == NULL )
  740. {
  741. /* couldn't find function within DLL -- error handling here */
  742. ifail = -998;
  743. }
  744. else /* have found function in DLL */
  745. {
  746. y = (*s17aff_proc) (&x, &ifail);
  747. }
  748. }
  749. currlib = hLib;
  750. #else
  751. y = S17AFF(&x,&ifail);
  752. #endif
  753. /* Translate return values to CCL */
  754. /* Copy result */
  755. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  756. push(Ly);
  757. Lifail = int2ccl(ifail);
  758. pop(Ly);
  759. errexit();
  760. return Llist(nil,2,Ly,Lifail);
  761. }
  762. Lisp_Object MS_CDECL Ls17agf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  763. {
  764. Lisp_Object Ly;
  765. double x, y;
  766. int32 ifail;
  767. #ifdef LOADLIB
  768. typedef double (__stdcall *PS17AGF) (double *, int32 *);
  769. HINSTANCE hLib;
  770. PS17AGF s17agf_proc;
  771. #else
  772. extern double __stdcall S17AGF (double *, int32 *);
  773. #endif
  774. /* Translate arguments into C objects */
  775. push2(Lx,Lifail);
  776. x = float_of_number(Lx);
  777. pop2(Lifail,Lx);
  778. errexit();
  779. push2(Lx,Lifail);
  780. ifail = thirty_two_bits(Lifail);
  781. pop2(Lifail,Lx);
  782. errexit();
  783. /* Call NAG routine */
  784. #ifdef LOADLIB
  785. free_prevlib ();
  786. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  787. {
  788. /* couldn't find DLL -- error handling here */
  789. ifail = -999;
  790. }
  791. else /* OK so far */
  792. {
  793. if ( (s17agf_proc = (PS17AGF) GetProcAddress (hLib, "_S17AGF@8"))
  794. == NULL )
  795. {
  796. /* couldn't find function within DLL -- error handling here */
  797. ifail = -998;
  798. }
  799. else /* have found function in DLL */
  800. {
  801. y = (*s17agf_proc) (&x, &ifail);
  802. }
  803. }
  804. currlib = hLib;
  805. #else
  806. y = S17AGF(&x,&ifail);
  807. #endif
  808. /* Translate return values to CCL */
  809. /* Copy result */
  810. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  811. push(Ly);
  812. Lifail = int2ccl(ifail);
  813. pop(Ly);
  814. errexit();
  815. return Llist(nil,2,Ly,Lifail);
  816. }
  817. Lisp_Object MS_CDECL Ls17ahf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  818. {
  819. Lisp_Object Ly;
  820. double x, y;
  821. int32 ifail;
  822. #ifdef LOADLIB
  823. typedef double (__stdcall *PS17AHF) (double *, int32 *);
  824. HINSTANCE hLib;
  825. PS17AHF s17ahf_proc;
  826. #else
  827. extern double __stdcall S17AHF (double *, int32 *);
  828. #endif
  829. /* Translate arguments into C objects */
  830. push2(Lx,Lifail);
  831. x = float_of_number(Lx);
  832. pop2(Lifail,Lx);
  833. errexit();
  834. push2(Lx,Lifail);
  835. ifail = thirty_two_bits(Lifail);
  836. pop2(Lifail,Lx);
  837. errexit();
  838. /* Call NAG routine */
  839. #ifdef LOADLIB
  840. free_prevlib ();
  841. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  842. {
  843. /* couldn't find DLL -- error handling here */
  844. ifail = -999;
  845. }
  846. else /* OK so far */
  847. {
  848. if ( (s17ahf_proc = (PS17AHF) GetProcAddress (hLib, "_S17AHF@8"))
  849. == NULL )
  850. {
  851. /* couldn't find function within DLL -- error handling here */
  852. ifail = -998;
  853. }
  854. else /* have found function in DLL */
  855. {
  856. y = (*s17ahf_proc) (&x, &ifail);
  857. }
  858. }
  859. currlib = hLib;
  860. #else
  861. y = S17AHF(&x,&ifail);
  862. #endif
  863. /* Translate return values to CCL */
  864. /* Copy result */
  865. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  866. push(Ly);
  867. Lifail = int2ccl(ifail);
  868. pop(Ly);
  869. errexit();
  870. return Llist(nil,2,Ly,Lifail);
  871. }
  872. Lisp_Object MS_CDECL Ls17ajf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  873. {
  874. Lisp_Object Ly;
  875. double x, y;
  876. int32 ifail;
  877. #ifdef LOADLIB
  878. typedef double (__stdcall *PS17AJF) (double *, int32 *);
  879. HINSTANCE hLib;
  880. PS17AJF s17ajf_proc;
  881. #else
  882. extern double __stdcall S17AJF (double *, int32 *);
  883. #endif
  884. /* Translate arguments into C objects */
  885. push2(Lx,Lifail);
  886. x = float_of_number(Lx);
  887. pop2(Lifail,Lx);
  888. errexit();
  889. push2(Lx,Lifail);
  890. ifail = thirty_two_bits(Lifail);
  891. pop2(Lifail,Lx);
  892. errexit();
  893. /* Call NAG routine */
  894. #ifdef LOADLIB
  895. free_prevlib ();
  896. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  897. {
  898. /* couldn't find DLL -- error handling here */
  899. ifail = -999;
  900. }
  901. else /* OK so far */
  902. {
  903. if ( (s17ajf_proc = (PS17AJF) GetProcAddress (hLib, "_S17AJF@8"))
  904. == NULL )
  905. {
  906. /* couldn't find function within DLL -- error handling here */
  907. ifail = -998;
  908. }
  909. else /* have found function in DLL */
  910. {
  911. y = (*s17ajf_proc) (&x, &ifail);
  912. }
  913. }
  914. currlib = hLib;
  915. #else
  916. y = S17AJF(&x,&ifail);
  917. #endif
  918. /* Translate return values to CCL */
  919. /* Copy result */
  920. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  921. push(Ly);
  922. Lifail = int2ccl(ifail);
  923. pop(Ly);
  924. errexit();
  925. return Llist(nil,2,Ly,Lifail);
  926. }
  927. Lisp_Object MS_CDECL Ls17akf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  928. {
  929. Lisp_Object Ly;
  930. double x, y;
  931. int32 ifail;
  932. #ifdef LOADLIB
  933. typedef double (__stdcall *PS17AKF) (double *, int32 *);
  934. HINSTANCE hLib;
  935. PS17AKF s17akf_proc;
  936. #else
  937. extern double __stdcall S17AKF (double *, int32 *);
  938. #endif
  939. /* Translate arguments into C objects */
  940. push2(Lx,Lifail);
  941. x = float_of_number(Lx);
  942. pop2(Lifail,Lx);
  943. errexit();
  944. push2(Lx,Lifail);
  945. ifail = thirty_two_bits(Lifail);
  946. pop2(Lifail,Lx);
  947. errexit();
  948. /* Call NAG routine */
  949. #ifdef LOADLIB
  950. free_prevlib ();
  951. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  952. {
  953. /* couldn't find DLL -- error handling here */
  954. ifail = -999;
  955. }
  956. else /* OK so far */
  957. {
  958. if ( (s17akf_proc = (PS17AKF) GetProcAddress (hLib, "_S17AKF@8"))
  959. == NULL )
  960. {
  961. /* couldn't find function within DLL -- error handling here */
  962. ifail = -998;
  963. }
  964. else /* have found function in DLL */
  965. {
  966. y = (*s17akf_proc) (&x, &ifail);
  967. }
  968. }
  969. currlib = hLib;
  970. #else
  971. y = S17AKF(&x,&ifail);
  972. #endif
  973. /* Translate return values to CCL */
  974. /* Copy result */
  975. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  976. push(Ly);
  977. Lifail = int2ccl(ifail);
  978. pop(Ly);
  979. errexit();
  980. return Llist(nil,2,Ly,Lifail);
  981. }
  982. #if 1
  983. Lisp_Object MS_CDECL Ls17dcf(Lisp_Object nil, int nargs, ...)
  984. { /* FIXME: strings */
  985. va_list args;
  986. Lisp_Object Lzr, Lzi, Lscale, Lifail, Ln, Lnz, Lfnu, Lcy;
  987. fstring1 scale;
  988. double z[2], *cy, *cwrk, fnu;
  989. int32 n, nz, ifail;
  990. char sscale[2];
  991. #ifdef LOADLIB
  992. typedef void (__stdcall *PS17DCF) (double *, double *, int32 *, fstring1,
  993. double *, int32 *, double *, int32 *);
  994. HINSTANCE hLib;
  995. PS17DCF s17dcf_proc;
  996. #else
  997. extern void __stdcall S17DCF (double *, double *, int32 *, fstring1,
  998. double *, int32 *, double *, int32 *);
  999. #endif
  1000. /* Set up arguments as Lisp Objects */
  1001. argcheck(nargs,6,"Ls17dcf");
  1002. va_start(args,nargs);
  1003. Lfnu = va_arg(args, Lisp_Object);
  1004. Lzr = va_arg(args, Lisp_Object);
  1005. Lzi = va_arg(args, Lisp_Object);
  1006. Ln = va_arg(args, Lisp_Object);
  1007. Lscale = va_arg(args, Lisp_Object);
  1008. Lifail = va_arg(args, Lisp_Object);
  1009. va_end(args);
  1010. /* Translate arguments into C objects */
  1011. push3(Lfnu,Lzr,Lzi);
  1012. push3(Ln,Lscale,Lifail);
  1013. fnu = float_of_number(Lfnu);
  1014. pop3(Lifail,Lscale,Ln);
  1015. pop3(Lzi,Lzr,Lfnu);
  1016. errexit();
  1017. push3(Lfnu,Lzr,Lzi);
  1018. push3(Ln,Lscale,Lifail);
  1019. z[0] = float_of_number(Lzr);
  1020. pop3(Lifail,Lscale,Ln);
  1021. pop3(Lzi,Lzr,Lfnu);
  1022. errexit();
  1023. push3(Lfnu,Lzr,Lzi);
  1024. push3(Ln,Lscale,Lifail);
  1025. z[1] = float_of_number(Lzi);
  1026. pop3(Lifail,Lscale,Ln);
  1027. pop3(Lzi,Lzr,Lfnu);
  1028. errexit();
  1029. push3(Lfnu,Lzr,Lzi);
  1030. push3(Ln,Lscale,Lifail);
  1031. n = thirty_two_bits(Ln);
  1032. pop3(Lifail,Lscale,Ln);
  1033. pop3(Lzi,Lzr,Lfnu);
  1034. errexit();
  1035. push3(Lfnu,Lzr,Lzi);
  1036. push3(Ln,Lscale,Lifail);
  1037. // strncpy (sscale, &celt(Lscale,0), 1);
  1038. sscale[0] = celt(Lscale,0);
  1039. pop3(Lifail,Lscale,Ln);
  1040. pop3(Lzi,Lzr,Lfnu);
  1041. errexit();
  1042. sscale[1] = '\0';
  1043. scale.str = sscale;
  1044. push3(Lfnu,Lzr,Lzi);
  1045. push3(Ln,Lscale,Lifail);
  1046. ifail = thirty_two_bits(Lifail);
  1047. pop3(Lifail,Lscale,Ln);
  1048. pop3(Lzi,Lzr,Lfnu);
  1049. errexit();
  1050. push3(Lfnu,Lzr,Lzi);
  1051. push3(Ln,Lscale,Lifail);
  1052. scale.len = 1;
  1053. /* Setup workspace arrays etc. */
  1054. cy = (double *)malloc(n*2*sizeof(double)); /* "complex" array */
  1055. cwrk = (double *)malloc(n*2*sizeof(double)); /* "complex" array */
  1056. /* Call NAG routine */
  1057. #ifdef LOADLIB
  1058. free_prevlib ();
  1059. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  1060. {
  1061. /* couldn't find DLL -- error handling here */
  1062. ifail = -999;
  1063. }
  1064. else /* OK so far */
  1065. {
  1066. if ( (s17dcf_proc = (PS17DCF) GetProcAddress (hLib, "_S17DCF@36"))
  1067. == NULL )
  1068. {
  1069. /* couldn't find function within DLL -- error handling here */
  1070. ifail = -998;
  1071. }
  1072. else /* have found function in DLL */
  1073. {
  1074. (*s17dcf_proc) (&fnu, z, &n, scale, cy, &nz, cwrk, &ifail);
  1075. }
  1076. }
  1077. currlib = hLib;
  1078. #else
  1079. S17DCF(&fnu, z, &n, scale, cy, &nz, cwrk, &ifail);
  1080. #endif
  1081. pop3(Lifail,Lscale,Ln);
  1082. pop3(Lzi,Lzr,Lfnu);
  1083. errexit();
  1084. /* Translate return values to CCL */
  1085. /* Copy result */
  1086. Lcy = mkComplexVector(cy,n,1);
  1087. push(Lcy);
  1088. Lifail = int2ccl(ifail);
  1089. pop(Lcy);
  1090. errexit();
  1091. push2(Lcy,Lifail);
  1092. Lnz = int2ccl(nz);
  1093. pop2(Lifail,Lcy);
  1094. errexit();
  1095. free (cy);
  1096. free (cwrk);
  1097. return Llist(nil,3,Lcy,Lifail,Lnz);
  1098. }
  1099. #else
  1100. {
  1101. return Llist(nil, 0);
  1102. }
  1103. #endif
  1104. #if 1
  1105. Lisp_Object MS_CDECL Ls17def(Lisp_Object nil, int nargs, ...)
  1106. { /* FIXME: strings */
  1107. va_list args;
  1108. Lisp_Object Lzr, Lzi, Lscale, Lifail, Ln, Lnz, Lfnu, Lcy;
  1109. fstring1 scale;
  1110. double z[2], *cy, fnu;
  1111. int32 n, nz, ifail;
  1112. char sscale[2];
  1113. #ifdef LOADLIB
  1114. typedef void (__stdcall *PS17DEF) (double *, double *, int32 *, fstring1,
  1115. double *, int32 *, int32 *);
  1116. HINSTANCE hLib;
  1117. PS17DEF s17def_proc;
  1118. #else
  1119. extern void __stdcall S17DEF (double *, double *, int32 *, fstring1,
  1120. double *, int32 *, int32 *);
  1121. #endif
  1122. /* Set up arguments as Lisp Objects */
  1123. argcheck(nargs,6,"Ls17def");
  1124. va_start(args,nargs);
  1125. Lfnu = va_arg(args, Lisp_Object);
  1126. Lzr = va_arg(args, Lisp_Object);
  1127. Lzi = va_arg(args, Lisp_Object);
  1128. Ln = va_arg(args, Lisp_Object);
  1129. Lscale = va_arg(args, Lisp_Object);
  1130. Lifail = va_arg(args, Lisp_Object);
  1131. va_end(args);
  1132. /* Translate arguments into C objects */
  1133. push3(Lfnu,Lzr,Lzi);
  1134. push3(Ln,Lscale,Lifail);
  1135. fnu = float_of_number(Lfnu);
  1136. pop3(Lifail,Lscale,Ln);
  1137. pop3(Lzi,Lzr,Lfnu);
  1138. errexit();
  1139. push3(Lfnu,Lzr,Lzi);
  1140. push3(Ln,Lscale,Lifail);
  1141. z[0] = float_of_number(Lzr);
  1142. pop3(Lifail,Lscale,Ln);
  1143. pop3(Lzi,Lzr,Lfnu);
  1144. errexit();
  1145. push3(Lfnu,Lzr,Lzi);
  1146. push3(Ln,Lscale,Lifail);
  1147. z[1] = float_of_number(Lzi);
  1148. pop3(Lifail,Lscale,Ln);
  1149. pop3(Lzi,Lzr,Lfnu);
  1150. errexit();
  1151. push3(Lfnu,Lzr,Lzi);
  1152. push3(Ln,Lscale,Lifail);
  1153. n = thirty_two_bits(Ln);
  1154. pop3(Lifail,Lscale,Ln);
  1155. pop3(Lzi,Lzr,Lfnu);
  1156. errexit();
  1157. push3(Lfnu,Lzr,Lzi);
  1158. push3(Ln,Lscale,Lifail);
  1159. // strncpy (sscale, &celt(Lscale,0), 1);
  1160. sscale[0] = celt(Lscale,0);
  1161. pop3(Lifail,Lscale,Ln);
  1162. pop3(Lzi,Lzr,Lfnu);
  1163. errexit();
  1164. sscale[1] = '\0';
  1165. scale.str = sscale;
  1166. push3(Lfnu,Lzr,Lzi);
  1167. push3(Ln,Lscale,Lifail);
  1168. ifail = thirty_two_bits(Lifail);
  1169. pop3(Lifail,Lscale,Ln);
  1170. pop3(Lzi,Lzr,Lfnu);
  1171. errexit();
  1172. push3(Lfnu,Lzr,Lzi);
  1173. push3(Ln,Lscale,Lifail);
  1174. scale.len = 1;
  1175. /* Setup workspace arrays etc. */
  1176. cy = (double *)malloc(n*2*sizeof(double)); /* "complex" array */
  1177. /* Call NAG routine */
  1178. #ifdef LOADLIB
  1179. free_prevlib ();
  1180. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  1181. {
  1182. /* couldn't find DLL -- error handling here */
  1183. ifail = -999;
  1184. }
  1185. else /* OK so far */
  1186. {
  1187. if ( (s17def_proc = (PS17DEF) GetProcAddress (hLib, "_S17DEF@32"))
  1188. == NULL )
  1189. {
  1190. /* couldn't find function within DLL -- error handling here */
  1191. ifail = -998;
  1192. }
  1193. else /* have found function in DLL */
  1194. {
  1195. (*s17def_proc) (&fnu, z, &n, scale, cy, &nz, &ifail);
  1196. }
  1197. }
  1198. currlib = hLib;
  1199. #else
  1200. S17DEF(&fnu, z, &n, scale, cy, &nz, &ifail);
  1201. #endif
  1202. pop3(Lifail,Lscale,Ln);
  1203. pop3(Lzi,Lzr,Lfnu);
  1204. errexit();
  1205. /* Translate return values to CCL */
  1206. /* Copy result */
  1207. Lcy = mkComplexVector(cy,n,1);
  1208. push(Lcy);
  1209. Lifail = int2ccl(ifail);
  1210. pop(Lcy);
  1211. errexit();
  1212. push2(Lcy,Lifail);
  1213. Lnz = int2ccl(nz);
  1214. pop2(Lifail,Lcy);
  1215. errexit();
  1216. free (cy);
  1217. return Llist(nil,3,Lcy,Lifail,Lnz);
  1218. }
  1219. #else
  1220. {
  1221. return Llist(nil, 0);
  1222. }
  1223. #endif
  1224. Lisp_Object MS_CDECL Ls17dgf(Lisp_Object nil, int nargs, ...)
  1225. { /* FIXME: strings */
  1226. va_list args;
  1227. Lisp_Object Lderiv, Lzr, Lzi, Lscale, Lifail, Lair, Laii, Lnz;
  1228. fstring1 deriv, scale;
  1229. double z[2], ai[2];
  1230. int32 nz, ifail;
  1231. char sderiv[2], sscale[2];
  1232. #ifdef LOADLIB
  1233. typedef void (__stdcall *PS17DGF) (fstring1, double *, fstring1, double *,
  1234. int32 *, int32 *);
  1235. HINSTANCE hLib;
  1236. PS17DGF s17dgf_proc;
  1237. #else
  1238. extern void __stdcall S17DGF (fstring1, double *, fstring1, double *,
  1239. int32 *, int32 *);
  1240. #endif
  1241. /* Set up arguments as Lisp Objects */
  1242. argcheck(nargs,5,"Ls17dgf");
  1243. va_start(args,nargs);
  1244. Lderiv = va_arg(args, Lisp_Object);
  1245. Lzr = va_arg(args, Lisp_Object);
  1246. Lzi = va_arg(args, Lisp_Object);
  1247. Lscale = va_arg(args, Lisp_Object);
  1248. Lifail = va_arg(args, Lisp_Object);
  1249. va_end(args);
  1250. /* Translate arguments into C objects */
  1251. push5(Lderiv,Lzr,Lzi,Lscale,Lifail);
  1252. // strncpy (sderiv, &celt(Lderiv,0), 1);
  1253. sderiv[0] = celt(Lderiv,0);
  1254. pop5(Lifail,Lscale,Lzi,Lzr,Lderiv);
  1255. errexit();
  1256. sderiv[1] = '\0';
  1257. deriv.str = sderiv;
  1258. push5(Lderiv,Lzr,Lzi,Lscale,Lifail);
  1259. z[0] = float_of_number(Lzr);
  1260. pop5(Lifail,Lscale,Lzi,Lzr,Lderiv);
  1261. errexit();
  1262. push5(Lderiv,Lzr,Lzi,Lscale,Lifail);
  1263. z[1] = float_of_number(Lzi);
  1264. pop5(Lifail,Lscale,Lzi,Lzr,Lderiv);
  1265. errexit();
  1266. push5(Lderiv,Lzr,Lzi,Lscale,Lifail);
  1267. // strncpy (sscale, &celt(Lscale,0), 1);
  1268. sscale[0] = celt(Lscale,0);
  1269. pop5(Lifail,Lscale,Lzi,Lzr,Lderiv);
  1270. errexit();
  1271. sscale[1] = '\0';
  1272. scale.str = sscale;
  1273. push5(Lderiv,Lzr,Lzi,Lscale,Lifail);
  1274. ifail = thirty_two_bits(Lifail);
  1275. pop5(Lifail,Lscale,Lzi,Lzr,Lderiv);
  1276. errexit();
  1277. deriv.len = 1;
  1278. scale.len = 1;
  1279. /* Call NAG routine */
  1280. #ifdef LOADLIB
  1281. free_prevlib ();
  1282. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  1283. {
  1284. /* couldn't find DLL -- error handling here */
  1285. ifail = -999;
  1286. }
  1287. else /* OK so far */
  1288. {
  1289. if ( (s17dgf_proc = (PS17DGF) GetProcAddress (hLib, "_S17DGF@32"))
  1290. == NULL )
  1291. {
  1292. /* couldn't find function within DLL -- error handling here */
  1293. ifail = -998;
  1294. }
  1295. else /* have found function in DLL */
  1296. {
  1297. (*s17dgf_proc) (deriv, z, scale, ai, &nz, &ifail);
  1298. }
  1299. }
  1300. currlib = hLib;
  1301. #else
  1302. S17DGF(deriv, z, scale, ai, &nz, &ifail);
  1303. #endif
  1304. /* Translate return values to CCL */
  1305. /* Copy result */
  1306. Lair = make_boxfloat(ai[0],TYPE_DOUBLE_FLOAT);
  1307. push(Lair);
  1308. Laii = make_boxfloat(ai[1],TYPE_DOUBLE_FLOAT);
  1309. pop(Lair);
  1310. errexit();
  1311. push2(Lair,Laii);
  1312. Lifail = int2ccl(ifail);
  1313. pop2(Laii,Lair);
  1314. errexit();
  1315. push3(Lair,Laii,Lifail);
  1316. Lnz = int2ccl(nz);
  1317. pop3(Lifail,Laii,Lair);
  1318. errexit();
  1319. return Llist(nil,4,Lair,Laii,Lifail,Lnz);
  1320. }
  1321. Lisp_Object MS_CDECL Ls17dhf(Lisp_Object nil, int nargs, ...)
  1322. { /* FIXME: strings */
  1323. va_list args;
  1324. Lisp_Object Lderiv, Lzr, Lzi, Lscale, Lifail, Lbir, Lbii;
  1325. fstring1 deriv, scale;
  1326. double z[2], bi[2];
  1327. int32 ifail;
  1328. char sderiv[2], sscale[2];
  1329. #ifdef LOADLIB
  1330. typedef void (__stdcall *PS17DHF) (fstring1, double *, fstring1, double *,
  1331. int32 *);
  1332. HINSTANCE hLib;
  1333. PS17DHF s17dhf_proc;
  1334. #else
  1335. extern void __stdcall S17DHF (fstring1, double *, fstring1, double *,
  1336. int32 *);
  1337. #endif
  1338. /* Set up arguments as Lisp Objects */
  1339. argcheck(nargs,5,"Ls17dhf");
  1340. va_start(args,nargs);
  1341. Lderiv = va_arg(args, Lisp_Object);
  1342. Lzr = va_arg(args, Lisp_Object);
  1343. Lzi = va_arg(args, Lisp_Object);
  1344. Lscale = va_arg(args, Lisp_Object);
  1345. Lifail = va_arg(args, Lisp_Object);
  1346. va_end(args);
  1347. /* Translate arguments into C objects */
  1348. push5(Lderiv,Lzr,Lzi,Lscale,Lifail);
  1349. // strncpy (sderiv, &celt(Lderiv,0), 1);
  1350. sderiv[0] = celt(Lderiv,0);
  1351. pop5(Lifail,Lscale,Lzi,Lzr,Lderiv);
  1352. errexit();
  1353. sderiv[1] = '\0';
  1354. deriv.str = sderiv;
  1355. push5(Lderiv,Lzr,Lzi,Lscale,Lifail);
  1356. z[0] = float_of_number(Lzr);
  1357. pop5(Lifail,Lscale,Lzi,Lzr,Lderiv);
  1358. errexit();
  1359. push5(Lderiv,Lzr,Lzi,Lscale,Lifail);
  1360. z[1] = float_of_number(Lzi);
  1361. pop5(Lifail,Lscale,Lzi,Lzr,Lderiv);
  1362. errexit();
  1363. push5(Lderiv,Lzr,Lzi,Lscale,Lifail);
  1364. // strncpy (sscale, &celt(Lscale,0), 1);
  1365. sscale[0] = celt(Lscale,0);
  1366. pop5(Lifail,Lscale,Lzi,Lzr,Lderiv);
  1367. errexit();
  1368. sscale[1] = '\0';
  1369. scale.str = sscale;
  1370. push5(Lderiv,Lzr,Lzi,Lscale,Lifail);
  1371. ifail = thirty_two_bits(Lifail);
  1372. pop5(Lifail,Lscale,Lzi,Lzr,Lderiv);
  1373. errexit();
  1374. deriv.len = 1;
  1375. scale.len = 1;
  1376. /* Call NAG routine */
  1377. #ifdef LOADLIB
  1378. free_prevlib ();
  1379. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  1380. {
  1381. /* couldn't find DLL -- error handling here */
  1382. ifail = -999;
  1383. }
  1384. else /* OK so far */
  1385. {
  1386. if ( (s17dhf_proc = (PS17DHF) GetProcAddress (hLib, "_S17DHF@28"))
  1387. == NULL )
  1388. {
  1389. /* couldn't find function within DLL -- error handling here */
  1390. ifail = -998;
  1391. }
  1392. else /* have found function in DLL */
  1393. {
  1394. (*s17dhf_proc) (deriv, z, scale, bi, &ifail);
  1395. }
  1396. }
  1397. currlib = hLib;
  1398. #else
  1399. S17DHF(deriv, z, scale, bi, &ifail);
  1400. #endif
  1401. /* Translate return values to CCL */
  1402. /* Copy result */
  1403. Lbir = make_boxfloat(bi[0],TYPE_DOUBLE_FLOAT);
  1404. push(Lbir);
  1405. Lbii = make_boxfloat(bi[1],TYPE_DOUBLE_FLOAT);
  1406. pop(Lbir);
  1407. errexit();
  1408. push2(Lbir,Lbii);
  1409. Lifail = int2ccl(ifail);
  1410. pop2(Lbii,Lbir);
  1411. errexit();
  1412. return Llist(nil,3,Lbir,Lbii,Lifail);
  1413. }
  1414. #if 1
  1415. Lisp_Object MS_CDECL Ls17dlf(Lisp_Object nil, int nargs, ...)
  1416. { /* FIXME: strings */
  1417. va_list args;
  1418. Lisp_Object Lzr, Lzi, Lscale, Lifail, Ln, Lnz, Lfnu, Lcy, Lm;
  1419. fstring1 scale;
  1420. double z[2], *cy, fnu;
  1421. int32 n, nz, ifail, m;
  1422. char sscale[2];
  1423. #ifdef LOADLIB
  1424. typedef void (__stdcall *PS17DLF) (int32 *, double *, double *, int32 *,
  1425. fstring1, double *, int32 *, int32 *);
  1426. HINSTANCE hLib;
  1427. PS17DLF s17dlf_proc;
  1428. #else
  1429. extern void __stdcall S17DLF (int32 *, double *, double *, int32 *,
  1430. fstring1, double *, int32 *, int32 *);
  1431. #endif
  1432. /* Set up arguments as Lisp Objects */
  1433. argcheck(nargs,7,"Ls17dlf");
  1434. va_start(args,nargs);
  1435. Lm = va_arg(args, Lisp_Object);
  1436. Lfnu = va_arg(args, Lisp_Object);
  1437. Lzr = va_arg(args, Lisp_Object);
  1438. Lzi = va_arg(args, Lisp_Object);
  1439. Ln = va_arg(args, Lisp_Object);
  1440. Lscale = va_arg(args, Lisp_Object);
  1441. Lifail = va_arg(args, Lisp_Object);
  1442. va_end(args);
  1443. /* Translate arguments into C objects */
  1444. push4(Lm,Lfnu,Lzr,Lzi);
  1445. push3(Ln,Lscale,Lifail);
  1446. m = thirty_two_bits(Lm);
  1447. pop4(Lifail,Lscale,Ln,Lzi);
  1448. pop3(Lzr,Lfnu,Lm);
  1449. errexit();
  1450. push4(Lm,Lfnu,Lzr,Lzi);
  1451. push3(Ln,Lscale,Lifail);
  1452. fnu = float_of_number(Lfnu);
  1453. pop4(Lifail,Lscale,Ln,Lzi);
  1454. pop3(Lzr,Lfnu,Lm);
  1455. errexit();
  1456. push4(Lm,Lfnu,Lzr,Lzi);
  1457. push3(Ln,Lscale,Lifail);
  1458. z[0] = float_of_number(Lzr);
  1459. pop4(Lifail,Lscale,Ln,Lzi);
  1460. pop3(Lzr,Lfnu,Lm);
  1461. errexit();
  1462. push4(Lm,Lfnu,Lzr,Lzi);
  1463. push3(Ln,Lscale,Lifail);
  1464. z[1] = float_of_number(Lzi);
  1465. pop4(Lifail,Lscale,Ln,Lzi);
  1466. pop3(Lzr,Lfnu,Lm);
  1467. errexit();
  1468. push4(Lm,Lfnu,Lzr,Lzi);
  1469. push3(Ln,Lscale,Lifail);
  1470. n = thirty_two_bits(Ln);
  1471. pop4(Lifail,Lscale,Ln,Lzi);
  1472. pop3(Lzr,Lfnu,Lm);
  1473. errexit();
  1474. push4(Lm,Lfnu,Lzr,Lzi);
  1475. push3(Ln,Lscale,Lifail);
  1476. // strncpy (sscale, &celt(Lscale,0), 1);
  1477. sscale[0] = celt(Lscale,0);
  1478. pop4(Lifail,Lscale,Ln,Lzi);
  1479. pop3(Lzr,Lfnu,Lm);
  1480. errexit();
  1481. sscale[1] = '\0';
  1482. scale.str = sscale;
  1483. push4(Lm,Lfnu,Lzr,Lzi);
  1484. push3(Ln,Lscale,Lifail);
  1485. ifail = thirty_two_bits(Lifail);
  1486. pop4(Lifail,Lscale,Ln,Lzi);
  1487. pop3(Lzr,Lfnu,Lm);
  1488. errexit();
  1489. push4(Lm,Lfnu,Lzr,Lzi);
  1490. push3(Ln,Lscale,Lifail);
  1491. scale.len = 1;
  1492. /* Setup workspace arrays etc. */
  1493. cy = (double *)malloc(n*2*sizeof(double)); /* "complex" array */
  1494. /* Call NAG routine */
  1495. #ifdef LOADLIB
  1496. free_prevlib ();
  1497. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  1498. {
  1499. /* couldn't find DLL -- error handling here */
  1500. ifail = -999;
  1501. }
  1502. else /* OK so far */
  1503. {
  1504. if ( (s17dlf_proc = (PS17DLF) GetProcAddress (hLib, "_S17DLF@36"))
  1505. == NULL )
  1506. {
  1507. /* couldn't find function within DLL -- error handling here */
  1508. ifail = -998;
  1509. }
  1510. else /* have found function in DLL */
  1511. {
  1512. (*s17dlf_proc) (&m, &fnu, z, &n, scale, cy, &nz, &ifail);
  1513. }
  1514. }
  1515. currlib = hLib;
  1516. #else
  1517. S17DLF(&m, &fnu, z, &n, scale, cy, &nz, &ifail);
  1518. #endif
  1519. pop4(Lifail,Lscale,Ln,Lzi);
  1520. pop3(Lzr,Lfnu,Lm);
  1521. errexit();
  1522. /* Translate return values to CCL */
  1523. /* Copy result */
  1524. Lcy = mkComplexVector(cy,n,1);
  1525. push(Lcy);
  1526. Lifail = int2ccl(ifail);
  1527. pop(Lcy);
  1528. errexit();
  1529. push2(Lcy,Lifail);
  1530. Lnz = int2ccl(nz);
  1531. pop2(Lifail,Lcy);
  1532. errexit();
  1533. free (cy);
  1534. return Llist(nil,3,Lcy,Lifail,Lnz);
  1535. }
  1536. #else
  1537. {
  1538. return Llist(nil, 0);
  1539. }
  1540. #endif
  1541. Lisp_Object MS_CDECL Ls18acf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  1542. {
  1543. Lisp_Object Ly;
  1544. double x, y;
  1545. int32 ifail;
  1546. #ifdef LOADLIB
  1547. typedef double (__stdcall *PS18ACF) (double *, int32 *);
  1548. HINSTANCE hLib;
  1549. PS18ACF s18acf_proc;
  1550. #else
  1551. extern double __stdcall S18ACF (double *, int32 *);
  1552. #endif
  1553. /* Translate arguments into C objects */
  1554. push2(Lx,Lifail);
  1555. x = float_of_number(Lx);
  1556. pop2(Lifail,Lx);
  1557. errexit();
  1558. push2(Lx,Lifail);
  1559. ifail = thirty_two_bits(Lifail);
  1560. pop2(Lifail,Lx);
  1561. errexit();
  1562. /* Call NAG routine */
  1563. #ifdef LOADLIB
  1564. free_prevlib ();
  1565. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  1566. {
  1567. /* couldn't find DLL -- error handling here */
  1568. ifail = -999;
  1569. }
  1570. else /* OK so far */
  1571. {
  1572. if ( (s18acf_proc = (PS18ACF) GetProcAddress (hLib, "_S18ACF@8"))
  1573. == NULL )
  1574. {
  1575. /* couldn't find function within DLL -- error handling here */
  1576. ifail = -998;
  1577. }
  1578. else /* have found function in DLL */
  1579. {
  1580. y = (*s18acf_proc) (&x, &ifail);
  1581. }
  1582. }
  1583. currlib = hLib;
  1584. #else
  1585. y = S18ACF(&x,&ifail);
  1586. #endif
  1587. /* Translate return values to CCL */
  1588. /* Copy result */
  1589. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  1590. push(Ly);
  1591. Lifail = int2ccl(ifail);
  1592. pop(Ly);
  1593. errexit();
  1594. return Llist(nil,2,Ly,Lifail);
  1595. }
  1596. Lisp_Object MS_CDECL Ls18adf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  1597. {
  1598. Lisp_Object Ly;
  1599. double x, y;
  1600. int32 ifail;
  1601. #ifdef LOADLIB
  1602. typedef double (__stdcall *PS18ADF) (double *, int32 *);
  1603. HINSTANCE hLib;
  1604. PS18ADF s18adf_proc;
  1605. #else
  1606. extern double __stdcall S18ADF (double *, int32 *);
  1607. #endif
  1608. /* Translate arguments into C objects */
  1609. push2(Lx,Lifail);
  1610. x = float_of_number(Lx);
  1611. pop2(Lifail,Lx);
  1612. errexit();
  1613. push2(Lx,Lifail);
  1614. ifail = thirty_two_bits(Lifail);
  1615. pop2(Lifail,Lx);
  1616. errexit();
  1617. /* Call NAG routine */
  1618. #ifdef LOADLIB
  1619. free_prevlib ();
  1620. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  1621. {
  1622. /* couldn't find DLL -- error handling here */
  1623. ifail = -999;
  1624. }
  1625. else /* OK so far */
  1626. {
  1627. if ( (s18adf_proc = (PS18ADF) GetProcAddress (hLib, "_S18ADF@8"))
  1628. == NULL )
  1629. {
  1630. /* couldn't find function within DLL -- error handling here */
  1631. ifail = -998;
  1632. }
  1633. else /* have found function in DLL */
  1634. {
  1635. y = (*s18adf_proc) (&x, &ifail);
  1636. }
  1637. }
  1638. currlib = hLib;
  1639. #else
  1640. y = S18ADF(&x,&ifail);
  1641. #endif
  1642. /* Translate return values to CCL */
  1643. /* Copy result */
  1644. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  1645. push(Ly);
  1646. Lifail = int2ccl(ifail);
  1647. pop(Ly);
  1648. errexit();
  1649. return Llist(nil,2,Ly,Lifail);
  1650. }
  1651. Lisp_Object MS_CDECL Ls18aef(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  1652. {
  1653. Lisp_Object Ly;
  1654. double x, y;
  1655. int32 ifail;
  1656. #ifdef LOADLIB
  1657. typedef double (__stdcall *PS18AEF) (double *, int32 *);
  1658. HINSTANCE hLib;
  1659. PS18AEF s18aef_proc;
  1660. #else
  1661. extern double __stdcall S18AEF (double *, int32 *);
  1662. #endif
  1663. /* Translate arguments into C objects */
  1664. push2(Lx,Lifail);
  1665. x = float_of_number(Lx);
  1666. pop2(Lifail,Lx);
  1667. errexit();
  1668. push2(Lx,Lifail);
  1669. ifail = thirty_two_bits(Lifail);
  1670. pop2(Lifail,Lx);
  1671. errexit();
  1672. /* Call NAG routine */
  1673. #ifdef LOADLIB
  1674. free_prevlib ();
  1675. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  1676. {
  1677. /* couldn't find DLL -- error handling here */
  1678. ifail = -999;
  1679. }
  1680. else /* OK so far */
  1681. {
  1682. if ( (s18aef_proc = (PS18AEF) GetProcAddress (hLib, "_S18AEF@8"))
  1683. == NULL )
  1684. {
  1685. /* couldn't find function within DLL -- error handling here */
  1686. ifail = -998;
  1687. }
  1688. else /* have found function in DLL */
  1689. {
  1690. y = (*s18aef_proc) (&x, &ifail);
  1691. }
  1692. }
  1693. currlib = hLib;
  1694. #else
  1695. y = S18AEF(&x,&ifail);
  1696. #endif
  1697. /* Translate return values to CCL */
  1698. /* Copy result */
  1699. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  1700. push(Ly);
  1701. Lifail = int2ccl(ifail);
  1702. pop(Ly);
  1703. errexit();
  1704. return Llist(nil,2,Ly,Lifail);
  1705. }
  1706. Lisp_Object MS_CDECL Ls18aff(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  1707. {
  1708. Lisp_Object Ly;
  1709. double x, y;
  1710. int32 ifail;
  1711. #ifdef LOADLIB
  1712. typedef double (__stdcall *PS18AFF) (double *, int32 *);
  1713. HINSTANCE hLib;
  1714. PS18AFF s18aff_proc;
  1715. #else
  1716. extern double __stdcall S18AFF (double *, int32 *);
  1717. #endif
  1718. /* Translate arguments into C objects */
  1719. push2(Lx,Lifail);
  1720. x = float_of_number(Lx);
  1721. pop2(Lifail,Lx);
  1722. errexit();
  1723. push2(Lx,Lifail);
  1724. ifail = thirty_two_bits(Lifail);
  1725. pop2(Lifail,Lx);
  1726. errexit();
  1727. /* Call NAG routine */
  1728. #ifdef LOADLIB
  1729. free_prevlib ();
  1730. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  1731. {
  1732. /* couldn't find DLL -- error handling here */
  1733. ifail = -999;
  1734. }
  1735. else /* OK so far */
  1736. {
  1737. if ( (s18aff_proc = (PS18AFF) GetProcAddress (hLib, "_S18AFF@8"))
  1738. == NULL )
  1739. {
  1740. /* couldn't find function within DLL -- error handling here */
  1741. ifail = -998;
  1742. }
  1743. else /* have found function in DLL */
  1744. {
  1745. y = (*s18aff_proc) (&x, &ifail);
  1746. }
  1747. }
  1748. currlib = hLib;
  1749. #else
  1750. y = S18AFF(&x,&ifail);
  1751. #endif
  1752. /* Translate return values to CCL */
  1753. /* Copy result */
  1754. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  1755. push(Ly);
  1756. Lifail = int2ccl(ifail);
  1757. pop(Ly);
  1758. errexit();
  1759. return Llist(nil,2,Ly,Lifail);
  1760. }
  1761. #if 1
  1762. Lisp_Object MS_CDECL Ls18dcf(Lisp_Object nil, int nargs, ...)
  1763. { /* FIXME: strings */
  1764. va_list args;
  1765. Lisp_Object Lzr, Lzi, Lscale, Lifail, Ln, Lnz, Lfnu, Lcy;
  1766. fstring1 scale;
  1767. double z[2], *cy, fnu;
  1768. int32 n, nz, ifail;
  1769. char sscale[2];
  1770. #ifdef LOADLIB
  1771. typedef void (__stdcall *PS18DCF) (double *, double *, int32 *, fstring1,
  1772. double *, int32 *, int32 *);
  1773. HINSTANCE hLib;
  1774. PS18DCF s18dcf_proc;
  1775. #else
  1776. extern void __stdcall S18DCF (double *, double *, int32 *, fstring1,
  1777. double *, int32 *, int32 *);
  1778. #endif
  1779. /* Set up arguments as Lisp Objects */
  1780. argcheck(nargs,6,"Ls18dcf");
  1781. va_start(args,nargs);
  1782. Lfnu = va_arg(args, Lisp_Object);
  1783. Lzr = va_arg(args, Lisp_Object);
  1784. Lzi = va_arg(args, Lisp_Object);
  1785. Ln = va_arg(args, Lisp_Object);
  1786. Lscale = va_arg(args, Lisp_Object);
  1787. Lifail = va_arg(args, Lisp_Object);
  1788. va_end(args);
  1789. /* Translate arguments into C objects */
  1790. push3(Lfnu,Lzr,Lzi);
  1791. push3(Ln,Lscale,Lifail);
  1792. fnu = float_of_number(Lfnu);
  1793. pop3(Lifail,Lscale,Ln);
  1794. pop3(Lzi,Lzr,Lfnu);
  1795. errexit();
  1796. push3(Lfnu,Lzr,Lzi);
  1797. push3(Ln,Lscale,Lifail);
  1798. z[0] = float_of_number(Lzr);
  1799. pop3(Lifail,Lscale,Ln);
  1800. pop3(Lzi,Lzr,Lfnu);
  1801. errexit();
  1802. push3(Lfnu,Lzr,Lzi);
  1803. push3(Ln,Lscale,Lifail);
  1804. z[1] = float_of_number(Lzi);
  1805. pop3(Lifail,Lscale,Ln);
  1806. pop3(Lzi,Lzr,Lfnu);
  1807. errexit();
  1808. push3(Lfnu,Lzr,Lzi);
  1809. push3(Ln,Lscale,Lifail);
  1810. n = thirty_two_bits(Ln);
  1811. pop3(Lifail,Lscale,Ln);
  1812. pop3(Lzi,Lzr,Lfnu);
  1813. errexit();
  1814. push3(Lfnu,Lzr,Lzi);
  1815. push3(Ln,Lscale,Lifail);
  1816. // strncpy (sscale, &celt(Lscale,0), 1);
  1817. sscale[0] = celt(Lscale,0);
  1818. pop3(Lifail,Lscale,Ln);
  1819. pop3(Lzi,Lzr,Lfnu);
  1820. errexit();
  1821. sscale[1] = '\0';
  1822. scale.str = sscale;
  1823. push3(Lfnu,Lzr,Lzi);
  1824. push3(Ln,Lscale,Lifail);
  1825. ifail = thirty_two_bits(Lifail);
  1826. pop3(Lifail,Lscale,Ln);
  1827. pop3(Lzi,Lzr,Lfnu);
  1828. errexit();
  1829. push3(Lfnu,Lzr,Lzi);
  1830. push3(Ln,Lscale,Lifail);
  1831. scale.len = 1;
  1832. /* Setup workspace arrays etc. */
  1833. cy = (double *)malloc(n*2*sizeof(double)); /* "complex" array */
  1834. /* Call NAG routine */
  1835. #ifdef LOADLIB
  1836. free_prevlib ();
  1837. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  1838. {
  1839. /* couldn't find DLL -- error handling here */
  1840. ifail = -999;
  1841. }
  1842. else /* OK so far */
  1843. {
  1844. if ( (s18dcf_proc = (PS18DCF) GetProcAddress (hLib, "_S18DCF@32"))
  1845. == NULL )
  1846. {
  1847. /* couldn't find function within DLL -- error handling here */
  1848. ifail = -998;
  1849. }
  1850. else /* have found function in DLL */
  1851. {
  1852. (*s18dcf_proc) (&fnu, z, &n, scale, cy, &nz, &ifail);
  1853. }
  1854. }
  1855. currlib = hLib;
  1856. #else
  1857. S18DCF(&fnu, z, &n, scale, cy, &nz, &ifail);
  1858. #endif
  1859. pop3(Lifail,Lscale,Ln);
  1860. pop3(Lzi,Lzr,Lfnu);
  1861. errexit();
  1862. /* Translate return values to CCL */
  1863. /* Copy result */
  1864. Lcy = mkComplexVector(cy,n,1);
  1865. push(Lcy);
  1866. Lifail = int2ccl(ifail);
  1867. pop(Lcy);
  1868. errexit();
  1869. push2(Lcy,Lifail);
  1870. Lnz = int2ccl(nz);
  1871. pop2(Lifail,Lcy);
  1872. errexit();
  1873. free (cy);
  1874. return Llist(nil,3,Lcy,Lifail,Lnz);
  1875. }
  1876. #else
  1877. {
  1878. return Llist(nil, 0);
  1879. }
  1880. #endif
  1881. #if 1
  1882. Lisp_Object MS_CDECL Ls18def(Lisp_Object nil, int nargs, ...)
  1883. { /* FIXME: strings */
  1884. va_list args;
  1885. Lisp_Object Lzr, Lzi, Lscale, Lifail, Ln, Lnz, Lfnu, Lcy;
  1886. fstring1 scale;
  1887. double z[2], *cy, fnu;
  1888. int32 n, nz, ifail;
  1889. char sscale[2];
  1890. #ifdef LOADLIB
  1891. typedef void (__stdcall *PS18DEF) (double *, double *, int32 *, fstring1,
  1892. double *, int32 *, int32 *);
  1893. HINSTANCE hLib;
  1894. PS18DEF s18def_proc;
  1895. #else
  1896. extern void __stdcall S18DEF (double *, double *, int32 *, fstring1,
  1897. double *, int32 *, int32 *);
  1898. #endif
  1899. /* Set up arguments as Lisp Objects */
  1900. argcheck(nargs,6,"Ls18def");
  1901. va_start(args,nargs);
  1902. Lfnu = va_arg(args, Lisp_Object);
  1903. Lzr = va_arg(args, Lisp_Object);
  1904. Lzi = va_arg(args, Lisp_Object);
  1905. Ln = va_arg(args, Lisp_Object);
  1906. Lscale = va_arg(args, Lisp_Object);
  1907. Lifail = va_arg(args, Lisp_Object);
  1908. va_end(args);
  1909. /* Translate arguments into C objects */
  1910. push3(Lfnu,Lzr,Lzi);
  1911. push3(Ln,Lscale,Lifail);
  1912. fnu = float_of_number(Lfnu);
  1913. pop3(Lifail,Lscale,Ln);
  1914. pop3(Lzi,Lzr,Lfnu);
  1915. errexit();
  1916. push3(Lfnu,Lzr,Lzi);
  1917. push3(Ln,Lscale,Lifail);
  1918. z[0] = float_of_number(Lzr);
  1919. pop3(Lifail,Lscale,Ln);
  1920. pop3(Lzi,Lzr,Lfnu);
  1921. errexit();
  1922. push3(Lfnu,Lzr,Lzi);
  1923. push3(Ln,Lscale,Lifail);
  1924. z[1] = float_of_number(Lzi);
  1925. pop3(Lifail,Lscale,Ln);
  1926. pop3(Lzi,Lzr,Lfnu);
  1927. errexit();
  1928. push3(Lfnu,Lzr,Lzi);
  1929. push3(Ln,Lscale,Lifail);
  1930. n = thirty_two_bits(Ln);
  1931. pop3(Lifail,Lscale,Ln);
  1932. pop3(Lzi,Lzr,Lfnu);
  1933. errexit();
  1934. push3(Lfnu,Lzr,Lzi);
  1935. push3(Ln,Lscale,Lifail);
  1936. // strncpy (sscale, &celt(Lscale,0), 1);
  1937. sscale[0] = celt(Lscale,0);
  1938. pop3(Lifail,Lscale,Ln);
  1939. pop3(Lzi,Lzr,Lfnu);
  1940. errexit();
  1941. sscale[1] = '\0';
  1942. scale.str = sscale;
  1943. push3(Lfnu,Lzr,Lzi);
  1944. push3(Ln,Lscale,Lifail);
  1945. ifail = thirty_two_bits(Lifail);
  1946. pop3(Lifail,Lscale,Ln);
  1947. pop3(Lzi,Lzr,Lfnu);
  1948. errexit();
  1949. push3(Lfnu,Lzr,Lzi);
  1950. push3(Ln,Lscale,Lifail);
  1951. scale.len = 1;
  1952. /* Setup workspace arrays etc. */
  1953. cy = (double *)malloc(n*2*sizeof(double)); /* "complex" array */
  1954. /* Call NAG routine */
  1955. #ifdef LOADLIB
  1956. free_prevlib ();
  1957. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  1958. {
  1959. /* couldn't find DLL -- error handling here */
  1960. ifail = -999;
  1961. }
  1962. else /* OK so far */
  1963. {
  1964. if ( (s18def_proc = (PS18DEF) GetProcAddress (hLib, "_S18DEF@32"))
  1965. == NULL )
  1966. {
  1967. /* couldn't find function within DLL -- error handling here */
  1968. ifail = -998;
  1969. }
  1970. else /* have found function in DLL */
  1971. {
  1972. (*s18def_proc) (&fnu, z, &n, scale, cy, &nz, &ifail);
  1973. }
  1974. }
  1975. currlib = hLib;
  1976. #else
  1977. S18DEF(&fnu, z, &n, scale, cy, &nz, &ifail);
  1978. #endif
  1979. pop3(Lifail,Lscale,Ln);
  1980. pop3(Lzi,Lzr,Lfnu);
  1981. errexit();
  1982. /* Translate return values to CCL */
  1983. /* Copy result */
  1984. Lcy = mkComplexVector(cy,n,1);
  1985. push(Lcy);
  1986. Lifail = int2ccl(ifail);
  1987. pop(Lcy);
  1988. errexit();
  1989. push2(Lcy,Lifail);
  1990. Lnz = int2ccl(nz);
  1991. pop2(Lifail,Lcy);
  1992. errexit();
  1993. free (cy);
  1994. return Llist(nil,3,Lcy,Lifail,Lnz);
  1995. }
  1996. #else
  1997. {
  1998. return Llist(nil, 0);
  1999. }
  2000. #endif
  2001. Lisp_Object MS_CDECL Ls19aaf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  2002. {
  2003. Lisp_Object Ly;
  2004. double x, y;
  2005. int32 ifail;
  2006. #ifdef LOADLIB
  2007. typedef double (__stdcall *PS19AAF) (double *, int32 *);
  2008. HINSTANCE hLib;
  2009. PS19AAF s19aaf_proc;
  2010. #else
  2011. extern double __stdcall S19AAF (double *, int32 *);
  2012. #endif
  2013. /* Translate arguments into C objects */
  2014. push2(Lx,Lifail);
  2015. x = float_of_number(Lx);
  2016. pop2(Lifail,Lx);
  2017. errexit();
  2018. push2(Lx,Lifail);
  2019. ifail = thirty_two_bits(Lifail);
  2020. pop2(Lifail,Lx);
  2021. errexit();
  2022. /* Call NAG routine */
  2023. #ifdef LOADLIB
  2024. free_prevlib ();
  2025. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  2026. {
  2027. /* couldn't find DLL -- error handling here */
  2028. ifail = -999;
  2029. }
  2030. else /* OK so far */
  2031. {
  2032. if ( (s19aaf_proc = (PS19AAF) GetProcAddress (hLib, "_S19AAF@8"))
  2033. == NULL )
  2034. {
  2035. /* couldn't find function within DLL -- error handling here */
  2036. ifail = -998;
  2037. }
  2038. else /* have found function in DLL */
  2039. {
  2040. y = (*s19aaf_proc) (&x, &ifail);
  2041. }
  2042. }
  2043. currlib = hLib;
  2044. #else
  2045. y = S19AAF(&x,&ifail);
  2046. #endif
  2047. /* Translate return values to CCL */
  2048. /* Copy result */
  2049. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  2050. push(Ly);
  2051. Lifail = int2ccl(ifail);
  2052. pop(Ly);
  2053. errexit();
  2054. return Llist(nil,2,Ly,Lifail);
  2055. }
  2056. Lisp_Object MS_CDECL Ls19abf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  2057. {
  2058. Lisp_Object Ly;
  2059. double x, y;
  2060. int32 ifail;
  2061. #ifdef LOADLIB
  2062. typedef double (__stdcall *PS19ABF) (double *, int32 *);
  2063. HINSTANCE hLib;
  2064. PS19ABF s19abf_proc;
  2065. #else
  2066. extern double __stdcall S19ABF (double *, int32 *);
  2067. #endif
  2068. /* Translate arguments into C objects */
  2069. push2(Lx,Lifail);
  2070. x = float_of_number(Lx);
  2071. pop2(Lifail,Lx);
  2072. errexit();
  2073. push2(Lx,Lifail);
  2074. ifail = thirty_two_bits(Lifail);
  2075. pop2(Lifail,Lx);
  2076. errexit();
  2077. /* Call NAG routine */
  2078. #ifdef LOADLIB
  2079. free_prevlib ();
  2080. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  2081. {
  2082. /* couldn't find DLL -- error handling here */
  2083. ifail = -999;
  2084. }
  2085. else /* OK so far */
  2086. {
  2087. if ( (s19abf_proc = (PS19ABF) GetProcAddress (hLib, "_S19ABF@8"))
  2088. == NULL )
  2089. {
  2090. /* couldn't find function within DLL -- error handling here */
  2091. ifail = -998;
  2092. }
  2093. else /* have found function in DLL */
  2094. {
  2095. y = (*s19abf_proc) (&x, &ifail);
  2096. }
  2097. }
  2098. currlib = hLib;
  2099. #else
  2100. y = S19ABF(&x,&ifail);
  2101. #endif
  2102. /* Translate return values to CCL */
  2103. /* Copy result */
  2104. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  2105. push(Ly);
  2106. Lifail = int2ccl(ifail);
  2107. pop(Ly);
  2108. errexit();
  2109. return Llist(nil,2,Ly,Lifail);
  2110. }
  2111. Lisp_Object MS_CDECL Ls19acf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  2112. {
  2113. Lisp_Object Ly;
  2114. double x, y;
  2115. int32 ifail;
  2116. #ifdef LOADLIB
  2117. typedef double (__stdcall *PS19ACF) (double *, int32 *);
  2118. HINSTANCE hLib;
  2119. PS19ACF s19acf_proc;
  2120. #else
  2121. extern double __stdcall S19ACF (double *, int32 *);
  2122. #endif
  2123. /* Translate arguments into C objects */
  2124. push2(Lx,Lifail);
  2125. x = float_of_number(Lx);
  2126. pop2(Lifail,Lx);
  2127. errexit();
  2128. push2(Lx,Lifail);
  2129. ifail = thirty_two_bits(Lifail);
  2130. pop2(Lifail,Lx);
  2131. errexit();
  2132. /* Call NAG routine */
  2133. #ifdef LOADLIB
  2134. free_prevlib ();
  2135. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  2136. {
  2137. /* couldn't find DLL -- error handling here */
  2138. ifail = -999;
  2139. }
  2140. else /* OK so far */
  2141. {
  2142. if ( (s19acf_proc = (PS19ACF) GetProcAddress (hLib, "_S19ACF@8"))
  2143. == NULL )
  2144. {
  2145. /* couldn't find function within DLL -- error handling here */
  2146. ifail = -998;
  2147. }
  2148. else /* have found function in DLL */
  2149. {
  2150. y = (*s19acf_proc) (&x, &ifail);
  2151. }
  2152. }
  2153. currlib = hLib;
  2154. #else
  2155. y = S19ACF(&x,&ifail);
  2156. #endif
  2157. /* Translate return values to CCL */
  2158. /* Copy result */
  2159. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  2160. push(Ly);
  2161. Lifail = int2ccl(ifail);
  2162. pop(Ly);
  2163. errexit();
  2164. return Llist(nil,2,Ly,Lifail);
  2165. }
  2166. Lisp_Object MS_CDECL Ls19adf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  2167. {
  2168. Lisp_Object Ly;
  2169. double x, y;
  2170. int32 ifail;
  2171. #ifdef LOADLIB
  2172. typedef double (__stdcall *PS19ADF) (double *, int32 *);
  2173. HINSTANCE hLib;
  2174. PS19ADF s19adf_proc;
  2175. #else
  2176. extern double __stdcall S19ADF (double *, int32 *);
  2177. #endif
  2178. /* Translate arguments into C objects */
  2179. push2(Lx,Lifail);
  2180. x = float_of_number(Lx);
  2181. pop2(Lifail,Lx);
  2182. errexit();
  2183. push2(Lx,Lifail);
  2184. ifail = thirty_two_bits(Lifail);
  2185. pop2(Lifail,Lx);
  2186. errexit();
  2187. /* Call NAG routine */
  2188. #ifdef LOADLIB
  2189. free_prevlib ();
  2190. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  2191. {
  2192. /* couldn't find DLL -- error handling here */
  2193. ifail = -999;
  2194. }
  2195. else /* OK so far */
  2196. {
  2197. if ( (s19adf_proc = (PS19ADF) GetProcAddress (hLib, "_S19ADF@8"))
  2198. == NULL )
  2199. {
  2200. /* couldn't find function within DLL -- error handling here */
  2201. ifail = -998;
  2202. }
  2203. else /* have found function in DLL */
  2204. {
  2205. y = (*s19adf_proc) (&x, &ifail);
  2206. }
  2207. }
  2208. currlib = hLib;
  2209. #else
  2210. y = S19ADF(&x,&ifail);
  2211. #endif
  2212. /* Translate return values to CCL */
  2213. /* Copy result */
  2214. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  2215. push(Ly);
  2216. Lifail = int2ccl(ifail);
  2217. pop(Ly);
  2218. errexit();
  2219. return Llist(nil,2,Ly,Lifail);
  2220. }
  2221. Lisp_Object MS_CDECL Ls20acf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  2222. {
  2223. Lisp_Object Ly;
  2224. double x, y;
  2225. int32 ifail;
  2226. #ifdef LOADLIB
  2227. typedef double (__stdcall *PS20ACF) (double *, int32 *);
  2228. HINSTANCE hLib;
  2229. PS20ACF s20acf_proc;
  2230. #else
  2231. extern double __stdcall S20ACF (double *, int32 *);
  2232. #endif
  2233. /* Translate arguments into C objects */
  2234. push2(Lx,Lifail);
  2235. x = float_of_number(Lx);
  2236. pop2(Lifail,Lx);
  2237. errexit();
  2238. push2(Lx,Lifail);
  2239. ifail = thirty_two_bits(Lifail);
  2240. pop2(Lifail,Lx);
  2241. errexit();
  2242. /* Call NAG routine */
  2243. #ifdef LOADLIB
  2244. free_prevlib ();
  2245. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  2246. {
  2247. /* couldn't find DLL -- error handling here */
  2248. ifail = -999;
  2249. }
  2250. else /* OK so far */
  2251. {
  2252. if ( (s20acf_proc = (PS20ACF) GetProcAddress (hLib, "_S20ACF@8"))
  2253. == NULL )
  2254. {
  2255. /* couldn't find function within DLL -- error handling here */
  2256. ifail = -998;
  2257. }
  2258. else /* have found function in DLL */
  2259. {
  2260. y = (*s20acf_proc) (&x, &ifail);
  2261. }
  2262. }
  2263. currlib = hLib;
  2264. #else
  2265. y = S20ACF(&x,&ifail);
  2266. #endif
  2267. /* Translate return values to CCL */
  2268. /* Copy result */
  2269. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  2270. push(Ly);
  2271. Lifail = int2ccl(ifail);
  2272. pop(Ly);
  2273. errexit();
  2274. return Llist(nil,2,Ly,Lifail);
  2275. }
  2276. Lisp_Object MS_CDECL Ls20adf(Lisp_Object nil, Lisp_Object Lx, Lisp_Object Lifail)
  2277. {
  2278. Lisp_Object Ly;
  2279. double x, y;
  2280. int32 ifail;
  2281. #ifdef LOADLIB
  2282. typedef double (__stdcall *PS20ADF) (double *, int32 *);
  2283. HINSTANCE hLib;
  2284. PS20ADF s20adf_proc;
  2285. #else
  2286. extern double __stdcall S20ADF (double *, int32 *);
  2287. #endif
  2288. /* Translate arguments into C objects */
  2289. push2(Lx,Lifail);
  2290. x = float_of_number(Lx);
  2291. pop2(Lifail,Lx);
  2292. errexit();
  2293. push2(Lx,Lifail);
  2294. ifail = thirty_two_bits(Lifail);
  2295. pop2(Lifail,Lx);
  2296. errexit();
  2297. /* Call NAG routine */
  2298. #ifdef LOADLIB
  2299. free_prevlib ();
  2300. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  2301. {
  2302. /* couldn't find DLL -- error handling here */
  2303. ifail = -999;
  2304. }
  2305. else /* OK so far */
  2306. {
  2307. if ( (s20adf_proc = (PS20ADF) GetProcAddress (hLib, "_S20ADF@8"))
  2308. == NULL )
  2309. {
  2310. /* couldn't find function within DLL -- error handling here */
  2311. ifail = -998;
  2312. }
  2313. else /* have found function in DLL */
  2314. {
  2315. y = (*s20adf_proc) (&x, &ifail);
  2316. }
  2317. }
  2318. currlib = hLib;
  2319. #else
  2320. y = S20ADF(&x,&ifail);
  2321. #endif
  2322. /* Translate return values to CCL */
  2323. /* Copy result */
  2324. Ly = make_boxfloat(y,TYPE_DOUBLE_FLOAT);
  2325. push(Ly);
  2326. Lifail = int2ccl(ifail);
  2327. pop(Ly);
  2328. errexit();
  2329. return Llist(nil,2,Ly,Lifail);
  2330. }
  2331. Lisp_Object MS_CDECL Ls21baf(Lisp_Object nil, int nargs, ...)
  2332. {
  2333. va_list args;
  2334. Lisp_Object Lx, Ly, Lifail, Lrc;
  2335. double x, y, rc;
  2336. int32 ifail;
  2337. #ifdef LOADLIB
  2338. typedef double (__stdcall *PS21BAF) (double *, double *, int32 *);
  2339. HINSTANCE hLib;
  2340. PS21BAF s21baf_proc;
  2341. #else
  2342. extern double __stdcall S21BAF (double *, double *, int32 *);
  2343. #endif
  2344. /* Set up arguments as Lisp Objects */
  2345. argcheck(nargs,3,"Ls21baf");
  2346. va_start(args,nargs);
  2347. Lx = va_arg(args, Lisp_Object);
  2348. Ly = va_arg(args, Lisp_Object);
  2349. Lifail = va_arg(args, Lisp_Object);
  2350. va_end(args);
  2351. /* Translate arguments into C objects */
  2352. push3(Lx,Ly,Lifail);
  2353. x = float_of_number(Lx);
  2354. pop3(Lifail,Ly,Lx);
  2355. errexit();
  2356. push3(Lx,Ly,Lifail);
  2357. y = float_of_number(Ly);
  2358. pop3(Lifail,Ly,Lx);
  2359. errexit();
  2360. push3(Lx,Ly,Lifail);
  2361. ifail = thirty_two_bits(Lifail);
  2362. pop3(Lifail,Ly,Lx);
  2363. errexit();
  2364. /* Call NAG routine */
  2365. #ifdef LOADLIB
  2366. free_prevlib ();
  2367. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  2368. {
  2369. /* couldn't find DLL -- error handling here */
  2370. ifail = -999;
  2371. }
  2372. else /* OK so far */
  2373. {
  2374. if ( (s21baf_proc = (PS21BAF) GetProcAddress (hLib, "_S21BAF@12"))
  2375. == NULL )
  2376. {
  2377. /* couldn't find function within DLL -- error handling here */
  2378. ifail = -998;
  2379. }
  2380. else /* have found function in DLL */
  2381. {
  2382. rc = (*s21baf_proc) (&x, &y, &ifail);
  2383. }
  2384. }
  2385. currlib = hLib;
  2386. #else
  2387. rc = S21BAF(&x,&y,&ifail);
  2388. #endif
  2389. /* Translate return values to CCL */
  2390. /* Copy result */
  2391. Lrc = make_boxfloat(rc,TYPE_DOUBLE_FLOAT);
  2392. push(Lrc);
  2393. Lifail = int2ccl(ifail);
  2394. pop(Lrc);
  2395. errexit();
  2396. return Llist(nil,2,Lrc,Lifail);
  2397. }
  2398. Lisp_Object MS_CDECL Ls21bbf(Lisp_Object nil, int nargs, ...)
  2399. {
  2400. va_list args;
  2401. Lisp_Object Lx, Ly, Lz, Lifail, Lrf;
  2402. double x, y, z, rf;
  2403. int32 ifail;
  2404. #ifdef LOADLIB
  2405. typedef double (__stdcall *PS21BBF) (double *, double *, double *, int32 *);
  2406. HINSTANCE hLib;
  2407. PS21BBF s21bbf_proc;
  2408. #else
  2409. extern double __stdcall S21BBF (double *, double *, double *, int32 *);
  2410. #endif
  2411. /* Set up arguments as Lisp Objects */
  2412. argcheck(nargs,4,"Ls21bbf");
  2413. va_start(args,nargs);
  2414. Lx = va_arg(args, Lisp_Object);
  2415. Ly = va_arg(args, Lisp_Object);
  2416. Lz = va_arg(args, Lisp_Object);
  2417. Lifail = va_arg(args, Lisp_Object);
  2418. va_end(args);
  2419. /* Translate arguments into C objects */
  2420. push4(Lx,Ly,Lz,Lifail);
  2421. x = float_of_number(Lx);
  2422. pop4(Lifail,Lz,Ly,Lx);
  2423. errexit();
  2424. push4(Lx,Ly,Lz,Lifail);
  2425. y = float_of_number(Ly);
  2426. pop4(Lifail,Lz,Ly,Lx);
  2427. errexit();
  2428. push4(Lx,Ly,Lz,Lifail);
  2429. z = float_of_number(Lz);
  2430. pop4(Lifail,Lz,Ly,Lx);
  2431. errexit();
  2432. push4(Lx,Ly,Lz,Lifail);
  2433. ifail = thirty_two_bits(Lifail);
  2434. pop4(Lifail,Lz,Ly,Lx);
  2435. errexit();
  2436. /* Call NAG routine */
  2437. #ifdef LOADLIB
  2438. free_prevlib ();
  2439. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  2440. {
  2441. /* couldn't find DLL -- error handling here */
  2442. ifail = -999;
  2443. }
  2444. else /* OK so far */
  2445. {
  2446. if ( (s21bbf_proc = (PS21BBF) GetProcAddress (hLib, "_S21BBF@16"))
  2447. == NULL )
  2448. {
  2449. /* couldn't find function within DLL -- error handling here */
  2450. ifail = -998;
  2451. }
  2452. else /* have found function in DLL */
  2453. {
  2454. rf = (*s21bbf_proc) (&x, &y, &z, &ifail);
  2455. }
  2456. }
  2457. currlib = hLib;
  2458. #else
  2459. rf = S21BBF(&x,&y,&z,&ifail);
  2460. #endif
  2461. /* Translate return values to CCL */
  2462. /* Copy result */
  2463. Lrf = make_boxfloat(rf,TYPE_DOUBLE_FLOAT);
  2464. push(Lrf);
  2465. Lifail = int2ccl(ifail);
  2466. pop(Lrf);
  2467. errexit();
  2468. return Llist(nil,2,Lrf,Lifail);
  2469. }
  2470. Lisp_Object MS_CDECL Ls21bcf(Lisp_Object nil, int nargs, ...)
  2471. {
  2472. va_list args;
  2473. Lisp_Object Lx, Ly, Lz, Lifail, Lrd;
  2474. double x, y, z, rd;
  2475. int32 ifail;
  2476. #ifdef LOADLIB
  2477. typedef double (__stdcall *PS21BCF) (double *, double *, double *, int32 *);
  2478. HINSTANCE hLib;
  2479. PS21BCF s21bcf_proc;
  2480. #else
  2481. extern double __stdcall S21BCF (double *, double *, double *, int32 *);
  2482. #endif
  2483. /* Set up arguments as Lisp Objects */
  2484. argcheck(nargs,4,"Ls21bcf");
  2485. va_start(args,nargs);
  2486. Lx = va_arg(args, Lisp_Object);
  2487. Ly = va_arg(args, Lisp_Object);
  2488. Lz = va_arg(args, Lisp_Object);
  2489. Lifail = va_arg(args, Lisp_Object);
  2490. va_end(args);
  2491. /* Translate arguments into C objects */
  2492. push4(Lx,Ly,Lz,Lifail);
  2493. x = float_of_number(Lx);
  2494. pop4(Lifail,Lz,Ly,Lx);
  2495. errexit();
  2496. push4(Lx,Ly,Lz,Lifail);
  2497. y = float_of_number(Ly);
  2498. pop4(Lifail,Lz,Ly,Lx);
  2499. errexit();
  2500. push4(Lx,Ly,Lz,Lifail);
  2501. z = float_of_number(Lz);
  2502. pop4(Lifail,Lz,Ly,Lx);
  2503. errexit();
  2504. push4(Lx,Ly,Lz,Lifail);
  2505. ifail = thirty_two_bits(Lifail);
  2506. pop4(Lifail,Lz,Ly,Lx);
  2507. errexit();
  2508. /* Call NAG routine */
  2509. #ifdef LOADLIB
  2510. free_prevlib ();
  2511. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  2512. {
  2513. /* couldn't find DLL -- error handling here */
  2514. ifail = -999;
  2515. }
  2516. else /* OK so far */
  2517. {
  2518. if ( (s21bcf_proc = (PS21BCF) GetProcAddress (hLib, "_S21BCF@16"))
  2519. == NULL )
  2520. {
  2521. /* couldn't find function within DLL -- error handling here */
  2522. ifail = -998;
  2523. }
  2524. else /* have found function in DLL */
  2525. {
  2526. rd = (*s21bcf_proc) (&x, &y, &z, &ifail);
  2527. }
  2528. }
  2529. currlib = hLib;
  2530. #else
  2531. rd = S21BCF(&x,&y,&z,&ifail);
  2532. #endif
  2533. /* Translate return values to CCL */
  2534. /* Copy result */
  2535. Lrd = make_boxfloat(rd,TYPE_DOUBLE_FLOAT);
  2536. push(Lrd);
  2537. Lifail = int2ccl(ifail);
  2538. pop(Lrd);
  2539. errexit();
  2540. return Llist(nil,2,Lrd,Lifail);
  2541. }
  2542. Lisp_Object MS_CDECL Ls21bdf(Lisp_Object nil, int nargs, ...)
  2543. {
  2544. va_list args;
  2545. Lisp_Object Lx, Ly, Lz, Lr, Lifail, Lrj;
  2546. double x, y, z, r, rj;
  2547. int32 ifail;
  2548. #ifdef LOADLIB
  2549. typedef double (__stdcall *PS21BDF) (double *, double *, double *, double *,
  2550. int32 *);
  2551. HINSTANCE hLib;
  2552. PS21BDF s21bdf_proc;
  2553. #else
  2554. extern double __stdcall S21BDF (double *, double *, double *, double *,
  2555. int32 *);
  2556. #endif
  2557. /* Set up arguments as Lisp Objects */
  2558. argcheck(nargs,5,"Ls21bdf");
  2559. va_start(args,nargs);
  2560. Lx = va_arg(args, Lisp_Object);
  2561. Ly = va_arg(args, Lisp_Object);
  2562. Lz = va_arg(args, Lisp_Object);
  2563. Lr = va_arg(args, Lisp_Object);
  2564. Lifail = va_arg(args, Lisp_Object);
  2565. va_end(args);
  2566. /* Translate arguments into C objects */
  2567. push5(Lx,Ly,Lz,Lr,Lifail);
  2568. x = float_of_number(Lx);
  2569. pop5(Lifail,Lr,Lz,Ly,Lx);
  2570. errexit();
  2571. push5(Lx,Ly,Lz,Lr,Lifail);
  2572. y = float_of_number(Ly);
  2573. pop5(Lifail,Lr,Lz,Ly,Lx);
  2574. errexit();
  2575. push5(Lx,Ly,Lz,Lr,Lifail);
  2576. z = float_of_number(Lz);
  2577. pop5(Lifail,Lr,Lz,Ly,Lx);
  2578. errexit();
  2579. push5(Lx,Ly,Lz,Lr,Lifail);
  2580. r = float_of_number(Lr);
  2581. pop5(Lifail,Lr,Lz,Ly,Lx);
  2582. errexit();
  2583. push5(Lx,Ly,Lz,Lr,Lifail);
  2584. ifail = thirty_two_bits(Lifail);
  2585. pop5(Lifail,Lr,Lz,Ly,Lx);
  2586. errexit();
  2587. /* Call NAG routine */
  2588. #ifdef LOADLIB
  2589. free_prevlib ();
  2590. if ( (hLib = LoadLibrary ("nagfas")) == NULL )
  2591. {
  2592. /* couldn't find DLL -- error handling here */
  2593. ifail = -999;
  2594. }
  2595. else /* OK so far */
  2596. {
  2597. if ( (s21bdf_proc = (PS21BDF) GetProcAddress (hLib, "_S21BDF@20"))
  2598. == NULL )
  2599. {
  2600. /* couldn't find function within DLL -- error handling here */
  2601. ifail = -998;
  2602. }
  2603. else /* have found function in DLL */
  2604. {
  2605. rj = (*s21bdf_proc) (&x, &y, &z, &r, &ifail);
  2606. }
  2607. }
  2608. currlib = hLib;
  2609. #else
  2610. rj = S21BDF(&x,&y,&z,&r,&ifail);
  2611. #endif
  2612. /* Translate return values to CCL */
  2613. /* Copy result */
  2614. Lrj = make_boxfloat(rj,TYPE_DOUBLE_FLOAT);
  2615. push(Lrj);
  2616. Lifail = int2ccl(ifail);
  2617. pop(Lrj);
  2618. errexit();
  2619. return Llist(nil,2,Lrj,Lifail);
  2620. }