nag_d.c 68 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462
  1. /* Signature: 062f0fe1 08-Apr-2002 */
  2. Lisp_Object MS_CDECL Ld01ajf(Lisp_Object nil, int nargs, ...)
  3. {
  4. va_list args;
  5. Lisp_Object La, Lb, Lepsabs, Lepsrel, Llw, Lliw, Lifail, Lresult, Labserr,
  6. Lw, Liw;
  7. double a, b, epsabs, epsrel, result, abserr, *w;
  8. int32 ifail, lw, *iw, liw;
  9. extern double __stdcall asp1(double *);
  10. #ifdef LOADLIB
  11. typedef void (__stdcall *PD01AJF) (double __stdcall (*fst) (double *),
  12. double *, double *, double *, double *, double *, double *,
  13. double *, int32 *, int32 *, int32 *, int32 *);
  14. HINSTANCE hLib;
  15. PD01AJF d01ajf_proc;
  16. #else
  17. extern void __stdcall D01AJF(double __stdcall (*fst) (double *), double *,
  18. double *, double *, double *, double *, double *, double *,
  19. int32 *, int32 *, int32 *, int32 *);
  20. #endif
  21. /* Set up arguments as Lisp Objects */
  22. argcheck(nargs,7,"Ld01ajf");
  23. va_start(args,nargs);
  24. La = va_arg(args, Lisp_Object);
  25. Lb = va_arg(args, Lisp_Object);
  26. Lepsabs = va_arg(args, Lisp_Object);
  27. Lepsrel = va_arg(args, Lisp_Object);
  28. Llw = va_arg(args, Lisp_Object);
  29. Lliw = va_arg(args, Lisp_Object);
  30. Lifail = va_arg(args, Lisp_Object);
  31. va_end(args);
  32. /* Translate arguments into C objects */
  33. push4(La,Lb,Lepsabs,Lepsrel);
  34. push3(Llw,Lliw,Lifail);
  35. a = float_of_number(La);
  36. pop4(Lifail,Lliw,Llw,Lepsrel);
  37. pop3(Lepsabs,Lb,La);
  38. errexit();
  39. push4(La,Lb,Lepsabs,Lepsrel);
  40. push3(Llw,Lliw,Lifail);
  41. b = float_of_number(Lb);
  42. pop4(Lifail,Lliw,Llw,Lepsrel);
  43. pop3(Lepsabs,Lb,La);
  44. errexit();
  45. push4(La,Lb,Lepsabs,Lepsrel);
  46. push3(Llw,Lliw,Lifail);
  47. epsabs = float_of_number(Lepsabs);
  48. pop4(Lifail,Lliw,Llw,Lepsrel);
  49. pop3(Lepsabs,Lb,La);
  50. errexit();
  51. push4(La,Lb,Lepsabs,Lepsrel);
  52. push3(Llw,Lliw,Lifail);
  53. epsrel = float_of_number(Lepsrel);
  54. pop4(Lifail,Lliw,Llw,Lepsrel);
  55. pop3(Lepsabs,Lb,La);
  56. errexit();
  57. push4(La,Lb,Lepsabs,Lepsrel);
  58. push3(Llw,Lliw,Lifail);
  59. lw = thirty_two_bits(Llw);
  60. pop4(Lifail,Lliw,Llw,Lepsrel);
  61. pop3(Lepsabs,Lb,La);
  62. errexit();
  63. push4(La,Lb,Lepsabs,Lepsrel);
  64. push3(Llw,Lliw,Lifail);
  65. liw = thirty_two_bits(Lliw);
  66. pop4(Lifail,Lliw,Llw,Lepsrel);
  67. pop3(Lepsabs,Lb,La);
  68. errexit();
  69. push4(La,Lb,Lepsabs,Lepsrel);
  70. push3(Llw,Lliw,Lifail);
  71. ifail = thirty_two_bits(Lifail);
  72. pop4(Lifail,Lliw,Llw,Lepsrel);
  73. pop3(Lepsabs,Lb,La);
  74. errexit();
  75. /* Setup workspace arrays etc. */
  76. w = (double *)malloc(lw*sizeof(double));
  77. iw = (int32 *)malloc(liw*sizeof(int));
  78. /* Call NAG routine */
  79. push4(La,Lb,Lepsabs,Lepsrel);
  80. push3(Llw,Lliw,Lifail);
  81. #ifdef LOADLIB
  82. free_prevlib ();
  83. if ( (hLib = LoadLibrary ("nagfad01")) == NULL )
  84. {
  85. /* couldn't find DLL -- error handling here */
  86. ifail = -999;
  87. }
  88. else /* OK so far */
  89. {
  90. if ( (d01ajf_proc = (PD01AJF) GetProcAddress (hLib, "_D01AJF@48"))
  91. == NULL )
  92. {
  93. /* couldn't find function within DLL -- error handling here */
  94. ifail = -998;
  95. }
  96. else /* have found function in DLL */
  97. {
  98. (*d01ajf_proc) (&asp1, &a, &b, &epsabs, &epsrel, &result, &abserr, w,
  99. &lw, iw, &liw, &ifail);
  100. }
  101. }
  102. currlib = hLib;
  103. #else
  104. D01AJF (&asp1, &a, &b, &epsabs, &epsrel, &result, &abserr, w, &lw, iw,
  105. &liw, &ifail);
  106. #endif
  107. pop4(Lifail,Lliw,Llw,Lepsrel);
  108. pop3(Lepsabs,Lb,La);
  109. errexit();
  110. /* Translate return values to CCL */
  111. /* Copy result */
  112. Lresult = make_boxfloat(result,TYPE_DOUBLE_FLOAT);
  113. push(Lresult);
  114. Labserr = make_boxfloat(abserr,TYPE_DOUBLE_FLOAT);
  115. pop(Lresult);
  116. errexit();
  117. push2(Lresult,Labserr);
  118. Lw = mkFloatVector(w,lw,1);
  119. pop2(Labserr,Lresult);
  120. errexit();
  121. push3(Lresult,Labserr,Lw);
  122. Liw = mkIntVector(iw,liw,1);
  123. pop3(Lw,Labserr,Lresult);
  124. errexit();
  125. push4(Lresult,Labserr,Lw,Liw);
  126. Lifail = int2ccl(ifail);
  127. pop4(Liw,Lw,Labserr,Lresult);
  128. errexit();
  129. free (w);
  130. free (iw);
  131. return Llist(nil,5,Lresult,Labserr,Lw,Liw,Lifail);
  132. }
  133. Lisp_Object MS_CDECL Ld01akf(Lisp_Object nil, int nargs, ...)
  134. {
  135. va_list args;
  136. Lisp_Object La, Lb, Lepsabs, Lepsrel, Llw, Lliw, Lifail, Lresult, Labserr,
  137. Lw, Liw;
  138. double a, b, epsabs, epsrel, result, abserr, *w;
  139. int32 ifail, lw, *iw, liw;
  140. extern double __stdcall asp1(double *);
  141. #ifdef LOADLIB
  142. typedef void (__stdcall *PD01AKF) (double __stdcall (*fst) (double *),
  143. double *, double *, double *, double *, double *, double *,
  144. double *, int32 *, int32 *, int32 *, int32 *);
  145. HINSTANCE hLib;
  146. PD01AKF d01akf_proc;
  147. #else
  148. extern void __stdcall D01AKF(double __stdcall (*fst) (double *), double *,
  149. double *, double *, double *, double *, double *, double *,
  150. int32 *, int32 *, int32 *, int32 *);
  151. #endif
  152. /* Set up arguments as Lisp Objects */
  153. argcheck(nargs,7,"Ld01akf");
  154. va_start(args,nargs);
  155. La = va_arg(args, Lisp_Object);
  156. Lb = va_arg(args, Lisp_Object);
  157. Lepsabs = va_arg(args, Lisp_Object);
  158. Lepsrel = va_arg(args, Lisp_Object);
  159. Llw = va_arg(args, Lisp_Object);
  160. Lliw = va_arg(args, Lisp_Object);
  161. Lifail = va_arg(args, Lisp_Object);
  162. va_end(args);
  163. /* Translate arguments into C objects */
  164. push4(La,Lb,Lepsabs,Lepsrel);
  165. push3(Llw,Lliw,Lifail);
  166. a = float_of_number(La);
  167. pop4(Lifail,Lliw,Llw,Lepsrel);
  168. pop3(Lepsabs,Lb,La);
  169. errexit();
  170. push4(La,Lb,Lepsabs,Lepsrel);
  171. push3(Llw,Lliw,Lifail);
  172. b = float_of_number(Lb);
  173. pop4(Lifail,Lliw,Llw,Lepsrel);
  174. pop3(Lepsabs,Lb,La);
  175. errexit();
  176. push4(La,Lb,Lepsabs,Lepsrel);
  177. push3(Llw,Lliw,Lifail);
  178. epsabs = float_of_number(Lepsabs);
  179. pop4(Lifail,Lliw,Llw,Lepsrel);
  180. pop3(Lepsabs,Lb,La);
  181. errexit();
  182. push4(La,Lb,Lepsabs,Lepsrel);
  183. push3(Llw,Lliw,Lifail);
  184. epsrel = float_of_number(Lepsrel);
  185. pop4(Lifail,Lliw,Llw,Lepsrel);
  186. pop3(Lepsabs,Lb,La);
  187. errexit();
  188. push4(La,Lb,Lepsabs,Lepsrel);
  189. push3(Llw,Lliw,Lifail);
  190. lw = thirty_two_bits(Llw);
  191. pop4(Lifail,Lliw,Llw,Lepsrel);
  192. pop3(Lepsabs,Lb,La);
  193. errexit();
  194. push4(La,Lb,Lepsabs,Lepsrel);
  195. push3(Llw,Lliw,Lifail);
  196. liw = thirty_two_bits(Lliw);
  197. pop4(Lifail,Lliw,Llw,Lepsrel);
  198. pop3(Lepsabs,Lb,La);
  199. errexit();
  200. push4(La,Lb,Lepsabs,Lepsrel);
  201. push3(Llw,Lliw,Lifail);
  202. ifail = thirty_two_bits(Lifail);
  203. pop4(Lifail,Lliw,Llw,Lepsrel);
  204. pop3(Lepsabs,Lb,La);
  205. errexit();
  206. /* Setup workspace arrays etc. */
  207. w = (double *)malloc(lw*sizeof(double));
  208. iw = (int32 *)malloc(liw*sizeof(int));
  209. /* Call NAG routine */
  210. #ifdef LOADLIB
  211. free_prevlib ();
  212. if ( (hLib = LoadLibrary ("nagfad01")) == NULL )
  213. {
  214. /* couldn't find DLL -- error handling here */
  215. ifail = -999;
  216. }
  217. else /* OK so far */
  218. {
  219. if ( (d01akf_proc = (PD01AKF) GetProcAddress (hLib, "_D01AKF@48"))
  220. == NULL )
  221. {
  222. /* couldn't find function within DLL -- error handling here */
  223. ifail = -998;
  224. }
  225. else /* have found function in DLL */
  226. {
  227. (*d01akf_proc) (&asp1, &a, &b, &epsabs, &epsrel, &result, &abserr, w,
  228. &lw, iw, &liw, &ifail);
  229. }
  230. }
  231. currlib = hLib;
  232. #else
  233. D01AKF (&asp1, &a, &b, &epsabs, &epsrel, &result, &abserr, w, &lw, iw,
  234. &liw, &ifail);
  235. #endif
  236. /* Translate return values to CCL */
  237. /* Copy result */
  238. Lresult = make_boxfloat(result,TYPE_DOUBLE_FLOAT);
  239. push(Lresult);
  240. Labserr = make_boxfloat(abserr,TYPE_DOUBLE_FLOAT);
  241. pop(Lresult);
  242. errexit();
  243. push2(Lresult,Labserr);
  244. Lw = mkFloatVector(w,lw,1);
  245. pop2(Labserr,Lresult);
  246. errexit();
  247. push3(Lresult,Labserr,Lw);
  248. Liw = mkIntVector(iw,liw,1);
  249. pop3(Lw,Labserr,Lresult);
  250. errexit();
  251. push4(Lresult,Labserr,Lw,Liw);
  252. Lifail = int2ccl(ifail);
  253. pop4(Liw,Lw,Labserr,Lresult);
  254. errexit();
  255. free (w);
  256. free (iw);
  257. return Llist(nil,5,Lresult,Labserr,Lw,Liw,Lifail);
  258. }
  259. #if 1
  260. Lisp_Object MS_CDECL Ld01alf(Lisp_Object nil, int nargs, ...)
  261. {
  262. va_list args;
  263. Lisp_Object La, Lb, Lepsabs, Lepsrel, Llw, Lliw, Lifail, Lresult, Labserr,
  264. Lw, Liw, Lnpts, Lpoints;
  265. double a, b, epsabs, epsrel, result, abserr, *w, *points;
  266. int32 ifail, lw, *iw, liw, npts;
  267. extern double __stdcall asp1(double *);
  268. #ifdef LOADLIB
  269. typedef void (__stdcall *PD01ALF) (double __stdcall (*fst) (double *),
  270. double *, double *, int32 *, double *, double *, double *,
  271. double *, double *, double *, int32 *, int32 *, int32 *, int32 *);
  272. HINSTANCE hLib;
  273. PD01ALF d01alf_proc;
  274. #else
  275. extern void __stdcall D01ALF(double __stdcall (*fst) (double *), double *,
  276. double *, int32 *, double *, double *, double *, double *,
  277. double *, double *, int32 *, int32 *, int32 *, int32 *);
  278. #endif
  279. /* Set up arguments as Lisp Objects */
  280. argcheck(nargs,9,"Ld01alf");
  281. va_start(args,nargs);
  282. La = va_arg(args, Lisp_Object);
  283. Lb = va_arg(args, Lisp_Object);
  284. Lnpts = va_arg(args, Lisp_Object);
  285. Lpoints = va_arg(args, Lisp_Object);
  286. Lepsabs = va_arg(args, Lisp_Object);
  287. Lepsrel = va_arg(args, Lisp_Object);
  288. Llw = va_arg(args, Lisp_Object);
  289. Lliw = va_arg(args, Lisp_Object);
  290. Lifail = va_arg(args, Lisp_Object);
  291. va_end(args);
  292. /* Translate arguments into C objects */
  293. push5(La,Lb,Lnpts,Lpoints,Lepsabs);
  294. push4(Lepsrel,Llw,Lliw,Lifail);
  295. a = float_of_number(La);
  296. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  297. pop4(Lpoints,Lnpts,Lb,La);
  298. errexit();
  299. push5(La,Lb,Lnpts,Lpoints,Lepsabs);
  300. push4(Lepsrel,Llw,Lliw,Lifail);
  301. b = float_of_number(Lb);
  302. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  303. pop4(Lpoints,Lnpts,Lb,La);
  304. errexit();
  305. push5(La,Lb,Lnpts,Lpoints,Lepsabs);
  306. push4(Lepsrel,Llw,Lliw,Lifail);
  307. npts = thirty_two_bits(Lnpts);
  308. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  309. pop4(Lpoints,Lnpts,Lb,La);
  310. errexit();
  311. /* ndim = (length_of_header(vechdr(Lpoints)) - 4)/4; */
  312. points = (double *)malloc(npts*sizeof(double));
  313. push5(La,Lb,Lnpts,Lpoints,Lepsabs);
  314. push4(Lepsrel,Llw,Lliw,Lifail);
  315. mkFortranVectorDouble(points, Lpoints, npts);
  316. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  317. pop4(Lpoints,Lnpts,Lb,La);
  318. errexit();
  319. push5(La,Lb,Lnpts,Lpoints,Lepsabs);
  320. push4(Lepsrel,Llw,Lliw,Lifail);
  321. epsabs = float_of_number(Lepsabs);
  322. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  323. pop4(Lpoints,Lnpts,Lb,La);
  324. errexit();
  325. push5(La,Lb,Lnpts,Lpoints,Lepsabs);
  326. push4(Lepsrel,Llw,Lliw,Lifail);
  327. epsrel = float_of_number(Lepsrel);
  328. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  329. pop4(Lpoints,Lnpts,Lb,La);
  330. errexit();
  331. push5(La,Lb,Lnpts,Lpoints,Lepsabs);
  332. push4(Lepsrel,Llw,Lliw,Lifail);
  333. lw = thirty_two_bits(Llw);
  334. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  335. pop4(Lpoints,Lnpts,Lb,La);
  336. errexit();
  337. push5(La,Lb,Lnpts,Lpoints,Lepsabs);
  338. push4(Lepsrel,Llw,Lliw,Lifail);
  339. liw = thirty_two_bits(Lliw);
  340. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  341. pop4(Lpoints,Lnpts,Lb,La);
  342. errexit();
  343. push5(La,Lb,Lnpts,Lpoints,Lepsabs);
  344. push4(Lepsrel,Llw,Lliw,Lifail);
  345. ifail = thirty_two_bits(Lifail);
  346. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  347. pop4(Lpoints,Lnpts,Lb,La);
  348. errexit();
  349. /* Setup workspace arrays etc. */
  350. w = (double *)malloc(lw*sizeof(double));
  351. iw = (int32 *)malloc(liw*sizeof(int));
  352. /* Call NAG routine */
  353. #ifdef LOADLIB
  354. free_prevlib ();
  355. if ( (hLib = LoadLibrary ("nagfad01")) == NULL )
  356. {
  357. /* couldn't find DLL -- error handling here */
  358. ifail = -999;
  359. }
  360. else /* OK so far */
  361. {
  362. if ( (d01alf_proc = (PD01ALF) GetProcAddress (hLib, "_D01ALF@56"))
  363. == NULL )
  364. {
  365. /* couldn't find function within DLL -- error handling here */
  366. ifail = -998;
  367. }
  368. else /* have found function in DLL */
  369. {
  370. (*d01alf_proc) (&asp1, &a, &b, &npts, points, &epsabs, &epsrel,
  371. &result, &abserr, w, &lw, iw, &liw, &ifail);
  372. }
  373. }
  374. currlib = hLib;
  375. #else
  376. D01ALF (&asp1, &a, &b, &npts, points, &epsabs, &epsrel, &result, &abserr,
  377. w, &lw, iw, &liw, &ifail);
  378. #endif
  379. /* Translate return values to CCL */
  380. /* Copy result */
  381. Lresult = make_boxfloat(result,TYPE_DOUBLE_FLOAT);
  382. push(Lresult);
  383. Labserr = make_boxfloat(abserr,TYPE_DOUBLE_FLOAT);
  384. pop(Lresult);
  385. errexit();
  386. push2(Lresult,Labserr);
  387. Lw = mkFloatVector(w,lw,1);
  388. pop2(Labserr,Lresult);
  389. errexit();
  390. push3(Lresult,Labserr,Lw);
  391. Liw = mkIntVector(iw,liw,1);
  392. pop3(Lw,Labserr,Lresult);
  393. errexit();
  394. push4(Lresult,Labserr,Lw,Liw);
  395. Lifail = int2ccl(ifail);
  396. pop4(Liw,Lw,Labserr,Lresult);
  397. errexit();
  398. free (points);
  399. free (w);
  400. free (iw);
  401. return Llist(nil,5,Lresult,Labserr,Lw,Liw,Lifail);
  402. }
  403. #else
  404. Lisp_Object MS_CDECL Ld01alf(Lisp_Object nil, int nargs, ...)
  405. {
  406. return Llist(nil, 0);
  407. }
  408. #endif
  409. #if 1
  410. Lisp_Object MS_CDECL Ld01amf(Lisp_Object nil, int nargs, ...)
  411. {
  412. va_list args;
  413. Lisp_Object Lepsabs, Lepsrel, Llw, Lliw, Lifail, Lresult, Labserr, Lw, Liw,
  414. Lbound, Linf;
  415. double epsabs, epsrel, result, abserr, *w, bound;
  416. int32 ifail, lw, *iw, liw, inf;
  417. extern double __stdcall asp1(double *);
  418. #ifdef LOADLIB
  419. typedef void (__stdcall *PD01AMF) (double __stdcall (*fst) (double *),
  420. double *, int32 *, double *, double *, double *, double *,
  421. double *, int32 *, int32 *, int32 *, int32 *);
  422. HINSTANCE hLib;
  423. PD01AMF d01amf_proc;
  424. #else
  425. extern void __stdcall D01AMF(double __stdcall (*fst) (double *), double *,
  426. int32 *, double *, double *, double *, double *, double *, int32 *,
  427. int32 *, int32 *, int32 *);
  428. #endif
  429. /* Set up arguments as Lisp Objects */
  430. argcheck(nargs,7,"Ld01amf");
  431. va_start(args,nargs);
  432. Lbound = va_arg(args, Lisp_Object);
  433. Linf = va_arg(args, Lisp_Object);
  434. Lepsabs = va_arg(args, Lisp_Object);
  435. Lepsrel = va_arg(args, Lisp_Object);
  436. Llw = va_arg(args, Lisp_Object);
  437. Lliw = va_arg(args, Lisp_Object);
  438. Lifail = va_arg(args, Lisp_Object);
  439. va_end(args);
  440. /* Translate arguments into C objects */
  441. push4(Lbound,Linf,Lepsabs,Lepsrel);
  442. push3(Llw,Lliw,Lifail);
  443. bound = float_of_number(Lbound);
  444. pop4(Lifail,Lliw,Llw,Lepsrel);
  445. pop3(Lepsabs,Linf,Lbound);
  446. errexit();
  447. push4(Lbound,Linf,Lepsabs,Lepsrel);
  448. push3(Llw,Lliw,Lifail);
  449. inf = thirty_two_bits(Linf);
  450. pop4(Lifail,Lliw,Llw,Lepsrel);
  451. pop3(Lepsabs,Linf,Lbound);
  452. errexit();
  453. push4(Lbound,Linf,Lepsabs,Lepsrel);
  454. push3(Llw,Lliw,Lifail);
  455. epsabs = float_of_number(Lepsabs);
  456. pop4(Lifail,Lliw,Llw,Lepsrel);
  457. pop3(Lepsabs,Linf,Lbound);
  458. errexit();
  459. push4(Lbound,Linf,Lepsabs,Lepsrel);
  460. push3(Llw,Lliw,Lifail);
  461. epsrel = float_of_number(Lepsrel);
  462. pop4(Lifail,Lliw,Llw,Lepsrel);
  463. pop3(Lepsabs,Linf,Lbound);
  464. errexit();
  465. push4(Lbound,Linf,Lepsabs,Lepsrel);
  466. push3(Llw,Lliw,Lifail);
  467. lw = thirty_two_bits(Llw);
  468. pop4(Lifail,Lliw,Llw,Lepsrel);
  469. pop3(Lepsabs,Linf,Lbound);
  470. errexit();
  471. push4(Lbound,Linf,Lepsabs,Lepsrel);
  472. push3(Llw,Lliw,Lifail);
  473. liw = thirty_two_bits(Lliw);
  474. pop4(Lifail,Lliw,Llw,Lepsrel);
  475. pop3(Lepsabs,Linf,Lbound);
  476. errexit();
  477. push4(Lbound,Linf,Lepsabs,Lepsrel);
  478. push3(Llw,Lliw,Lifail);
  479. ifail = thirty_two_bits(Lifail);
  480. pop4(Lifail,Lliw,Llw,Lepsrel);
  481. pop3(Lepsabs,Linf,Lbound);
  482. errexit();
  483. /* Setup workspace arrays etc. */
  484. w = (double *)malloc(lw*sizeof(double));
  485. iw = (int32 *)malloc(liw*sizeof(int));
  486. push4(Lbound,Linf,Lepsabs,Lepsrel);
  487. push3(Llw,Lliw,Lifail);
  488. /* Call NAG routine */
  489. #ifdef LOADLIB
  490. free_prevlib ();
  491. if ( (hLib = LoadLibrary ("nagfad01")) == NULL )
  492. {
  493. /* couldn't find DLL -- error handling here */
  494. ifail = -999;
  495. }
  496. else /* OK so far */
  497. {
  498. if ( (d01amf_proc = (PD01AMF) GetProcAddress (hLib, "_D01AMF@48"))
  499. == NULL )
  500. {
  501. /* couldn't find function within DLL -- error handling here */
  502. ifail = -998;
  503. }
  504. else /* have found function in DLL */
  505. {
  506. (*d01amf_proc) (&asp1, &bound, &inf, &epsabs, &epsrel, &result,
  507. &abserr, w, &lw, iw, &liw, &ifail);
  508. }
  509. }
  510. currlib = hLib;
  511. #else
  512. D01AMF (&asp1, &bound, &inf, &epsabs, &epsrel, &result, &abserr, w, &lw,
  513. iw, &liw, &ifail);
  514. #endif
  515. pop4(Lifail,Lliw,Llw,Lepsrel);
  516. pop3(Lepsabs,Linf,Lbound);
  517. /* Translate return values to CCL */
  518. /* Copy result */
  519. Lresult = make_boxfloat(result,TYPE_DOUBLE_FLOAT);
  520. push(Lresult);
  521. Labserr = make_boxfloat(abserr,TYPE_DOUBLE_FLOAT);
  522. pop(Lresult);
  523. errexit();
  524. push2(Lresult,Labserr);
  525. Lw = mkFloatVector(w,lw,1);
  526. pop2(Labserr,Lresult);
  527. errexit();
  528. push3(Lresult,Labserr,Lw);
  529. Liw = mkIntVector(iw,liw,1);
  530. pop3(Lw,Labserr,Lresult);
  531. errexit();
  532. push4(Lresult,Labserr,Lw,Liw);
  533. Lifail = int2ccl(ifail);
  534. pop4(Liw,Lw,Labserr,Lresult);
  535. errexit();
  536. free (w);
  537. free (iw);
  538. return Llist(nil,5,Lresult,Labserr,Lw,Liw,Lifail);
  539. }
  540. #else
  541. Lisp_Object MS_CDECL Ld01amf(Lisp_Object nil, int nargs, ...)
  542. {
  543. return Llist(nil, 0);
  544. }
  545. #endif
  546. #if 1
  547. Lisp_Object MS_CDECL Ld01anf(Lisp_Object nil, int nargs, ...)
  548. {
  549. va_list args;
  550. Lisp_Object La, Lb, Lepsabs, Lepsrel, Llw, Lliw, Lifail, Lresult, Labserr,
  551. Lw, Liw, Lomega, Lkey;
  552. double a, b, epsabs, epsrel, result, abserr, *w, omega;
  553. int32 ifail, lw, *iw, liw, key;
  554. extern double __stdcall asp1(double *);
  555. #ifdef LOADLIB
  556. typedef void (__stdcall *PD01ANF) (double __stdcall (*fst) (double *),
  557. double *, double *, double *, int32 *, double *, double *,
  558. double *, double *, double *, int32 *, int32 *, int32 *, int32 *);
  559. HINSTANCE hLib;
  560. PD01ANF d01anf_proc;
  561. #else
  562. extern void __stdcall D01ANF(double __stdcall (*fst) (double *), double *,
  563. double *, double *, int32 *, double *, double *, double *,
  564. double *, double *, int32 *, int32 *, int32 *, int32 *);
  565. #endif
  566. /* Set up arguments as Lisp Objects */
  567. argcheck(nargs,9,"Ld01anf");
  568. va_start(args,nargs);
  569. La = va_arg(args, Lisp_Object);
  570. Lb = va_arg(args, Lisp_Object);
  571. Lomega = va_arg(args, Lisp_Object);
  572. Lkey = va_arg(args, Lisp_Object);
  573. Lepsabs = va_arg(args, Lisp_Object);
  574. Lepsrel = va_arg(args, Lisp_Object);
  575. Llw = va_arg(args, Lisp_Object);
  576. Lliw = va_arg(args, Lisp_Object);
  577. Lifail = va_arg(args, Lisp_Object);
  578. va_end(args);
  579. /* Translate arguments into C objects */
  580. push5(La,Lb,Lomega,Lkey,Lepsabs);
  581. push4(Lepsrel,Llw,Lliw,Lifail);
  582. a = float_of_number(La);
  583. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  584. pop4(Lkey,Lomega,Lb,La);
  585. errexit();
  586. push5(La,Lb,Lomega,Lkey,Lepsabs);
  587. push4(Lepsrel,Llw,Lliw,Lifail);
  588. b = float_of_number(Lb);
  589. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  590. pop4(Lkey,Lomega,Lb,La);
  591. errexit();
  592. push5(La,Lb,Lomega,Lkey,Lepsabs);
  593. push4(Lepsrel,Llw,Lliw,Lifail);
  594. omega = float_of_number(Lomega);
  595. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  596. pop4(Lkey,Lomega,Lb,La);
  597. errexit();
  598. push5(La,Lb,Lomega,Lkey,Lepsabs);
  599. push4(Lepsrel,Llw,Lliw,Lifail);
  600. key = thirty_two_bits(Lkey);
  601. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  602. pop4(Lkey,Lomega,Lb,La);
  603. errexit();
  604. push5(La,Lb,Lomega,Lkey,Lepsabs);
  605. push4(Lepsrel,Llw,Lliw,Lifail);
  606. epsabs = float_of_number(Lepsabs);
  607. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  608. pop4(Lkey,Lomega,Lb,La);
  609. errexit();
  610. push5(La,Lb,Lomega,Lkey,Lepsabs);
  611. push4(Lepsrel,Llw,Lliw,Lifail);
  612. epsrel = float_of_number(Lepsrel);
  613. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  614. pop4(Lkey,Lomega,Lb,La);
  615. errexit();
  616. push5(La,Lb,Lomega,Lkey,Lepsabs);
  617. push4(Lepsrel,Llw,Lliw,Lifail);
  618. lw = thirty_two_bits(Llw);
  619. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  620. pop4(Lkey,Lomega,Lb,La);
  621. errexit();
  622. push5(La,Lb,Lomega,Lkey,Lepsabs);
  623. push4(Lepsrel,Llw,Lliw,Lifail);
  624. liw = thirty_two_bits(Lliw);
  625. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  626. pop4(Lkey,Lomega,Lb,La);
  627. errexit();
  628. push5(La,Lb,Lomega,Lkey,Lepsabs);
  629. push4(Lepsrel,Llw,Lliw,Lifail);
  630. ifail = thirty_two_bits(Lifail);
  631. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  632. pop4(Lkey,Lomega,Lb,La);
  633. errexit();
  634. /* Setup workspace arrays etc. */
  635. w = (double *)malloc(lw*sizeof(double));
  636. iw = (int32 *)malloc(liw*sizeof(int));
  637. /* Call NAG routine */
  638. #ifdef LOADLIB
  639. free_prevlib ();
  640. if ( (hLib = LoadLibrary ("nagfad01")) == NULL )
  641. {
  642. /* couldn't find DLL -- error handling here */
  643. ifail = -999;
  644. }
  645. else /* OK so far */
  646. {
  647. if ( (d01anf_proc = (PD01ANF) GetProcAddress (hLib, "_D01ANF@56"))
  648. == NULL )
  649. {
  650. /* couldn't find function within DLL -- error handling here */
  651. ifail = -998;
  652. }
  653. else /* have found function in DLL */
  654. {
  655. (*d01anf_proc) (&asp1, &a, &b, &omega, &key, &epsabs, &epsrel, &result,
  656. &abserr, w, &lw, iw, &liw, &ifail);
  657. }
  658. }
  659. currlib = hLib;
  660. #else
  661. D01ANF (&asp1, &a, &b, &omega, &key, &epsabs, &epsrel, &result, &abserr, w,
  662. &lw, iw, &liw, &ifail);
  663. #endif
  664. /* Translate return values to CCL */
  665. /* Copy result */
  666. Lresult = make_boxfloat(result,TYPE_DOUBLE_FLOAT);
  667. push(Lresult);
  668. Labserr = make_boxfloat(abserr,TYPE_DOUBLE_FLOAT);
  669. pop(Lresult);
  670. errexit();
  671. push2(Lresult,Labserr);
  672. Lw = mkFloatVector(w,lw,1);
  673. pop2(Labserr,Lresult);
  674. errexit();
  675. push3(Lresult,Labserr,Lw);
  676. Liw = mkIntVector(iw,liw,1);
  677. pop3(Lw,Labserr,Lresult);
  678. errexit();
  679. push4(Lresult,Labserr,Lw,Liw);
  680. Lifail = int2ccl(ifail);
  681. pop4(Liw,Lw,Labserr,Lresult);
  682. errexit();
  683. free (w);
  684. free (iw);
  685. return Llist(nil,5,Lresult,Labserr,Lw,Liw,Lifail);
  686. }
  687. #else
  688. Lisp_Object MS_CDECL Ld01anf(Lisp_Object nil, int nargs, ...)
  689. {
  690. return Llist(nil, 0);
  691. }
  692. #endif
  693. #if 1
  694. Lisp_Object MS_CDECL Ld01apf(Lisp_Object nil, int nargs, ...)
  695. {
  696. va_list args;
  697. Lisp_Object La, Lb, Lepsabs, Lepsrel, Llw, Lliw, Lifail, Lresult, Labserr,
  698. Lw, Liw, Lalfa, Lbeta, Lkey;
  699. double a, b, epsabs, epsrel, result, abserr, *w, alfa, beta;
  700. int32 ifail, lw, *iw, liw, key;
  701. extern double __stdcall asp1(double *);
  702. #ifdef LOADLIB
  703. typedef void (__stdcall *PD01APF) (double __stdcall (*fst) (double *),
  704. double *, double *, double *, double *, int32 *, double *,
  705. double *, double *, double *, double *, int32 *, int32 *, int32 *,
  706. int32 *);
  707. HINSTANCE hLib;
  708. PD01APF d01apf_proc;
  709. #else
  710. extern void __stdcall D01APF(double __stdcall (*fst) (double *), double *,
  711. double *, double *, double *, int32 *, double *, double *,
  712. double *, double *, double *, int32 *, int32 *, int32 *, int32 *);
  713. #endif
  714. /* Set up arguments as Lisp Objects */
  715. argcheck(nargs,10,"Ld01apf");
  716. va_start(args,nargs);
  717. La = va_arg(args, Lisp_Object);
  718. Lb = va_arg(args, Lisp_Object);
  719. Lalfa = va_arg(args, Lisp_Object);
  720. Lbeta = va_arg(args, Lisp_Object);
  721. Lkey = va_arg(args, Lisp_Object);
  722. Lepsabs = va_arg(args, Lisp_Object);
  723. Lepsrel = va_arg(args, Lisp_Object);
  724. Llw = va_arg(args, Lisp_Object);
  725. Lliw = va_arg(args, Lisp_Object);
  726. Lifail = va_arg(args, Lisp_Object);
  727. va_end(args);
  728. /* Translate arguments into C objects */
  729. push5(La,Lb,Lalfa,Lbeta,Lkey);
  730. push5(Lepsabs,Lepsrel,Llw,Lliw,Lifail);
  731. a = float_of_number(La);
  732. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  733. pop5(Lkey,Lbeta,Lalfa,Lb,La);
  734. errexit();
  735. push5(La,Lb,Lalfa,Lbeta,Lkey);
  736. push5(Lepsabs,Lepsrel,Llw,Lliw,Lifail);
  737. b = float_of_number(Lb);
  738. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  739. pop5(Lkey,Lbeta,Lalfa,Lb,La);
  740. errexit();
  741. push5(La,Lb,Lalfa,Lbeta,Lkey);
  742. push5(Lepsabs,Lepsrel,Llw,Lliw,Lifail);
  743. alfa = float_of_number(Lalfa);
  744. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  745. pop5(Lkey,Lbeta,Lalfa,Lb,La);
  746. errexit();
  747. push5(La,Lb,Lalfa,Lbeta,Lkey);
  748. push5(Lepsabs,Lepsrel,Llw,Lliw,Lifail);
  749. beta = float_of_number(Lbeta);
  750. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  751. pop5(Lkey,Lbeta,Lalfa,Lb,La);
  752. errexit();
  753. push5(La,Lb,Lalfa,Lbeta,Lkey);
  754. push5(Lepsabs,Lepsrel,Llw,Lliw,Lifail);
  755. key = thirty_two_bits(Lkey);
  756. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  757. pop5(Lkey,Lbeta,Lalfa,Lb,La);
  758. errexit();
  759. push5(La,Lb,Lalfa,Lbeta,Lkey);
  760. push5(Lepsabs,Lepsrel,Llw,Lliw,Lifail);
  761. epsabs = float_of_number(Lepsabs);
  762. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  763. pop5(Lkey,Lbeta,Lalfa,Lb,La);
  764. errexit();
  765. push5(La,Lb,Lalfa,Lbeta,Lkey);
  766. push5(Lepsabs,Lepsrel,Llw,Lliw,Lifail);
  767. epsrel = float_of_number(Lepsrel);
  768. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  769. pop5(Lkey,Lbeta,Lalfa,Lb,La);
  770. errexit();
  771. push5(La,Lb,Lalfa,Lbeta,Lkey);
  772. push5(Lepsabs,Lepsrel,Llw,Lliw,Lifail);
  773. lw = thirty_two_bits(Llw);
  774. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  775. pop5(Lkey,Lbeta,Lalfa,Lb,La);
  776. errexit();
  777. push5(La,Lb,Lalfa,Lbeta,Lkey);
  778. push5(Lepsabs,Lepsrel,Llw,Lliw,Lifail);
  779. liw = thirty_two_bits(Lliw);
  780. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  781. pop5(Lkey,Lbeta,Lalfa,Lb,La);
  782. errexit();
  783. push5(La,Lb,Lalfa,Lbeta,Lkey);
  784. push5(Lepsabs,Lepsrel,Llw,Lliw,Lifail);
  785. ifail = thirty_two_bits(Lifail);
  786. pop5(Lifail,Lliw,Llw,Lepsrel,Lepsabs);
  787. pop5(Lkey,Lbeta,Lalfa,Lb,La);
  788. errexit();
  789. /* Setup workspace arrays etc. */
  790. w = (double *)malloc(lw*sizeof(double));
  791. iw = (int32 *)malloc(liw*sizeof(int));
  792. /* Call NAG routine */
  793. #ifdef LOADLIB
  794. free_prevlib ();
  795. if ( (hLib = LoadLibrary ("nagfad01")) == NULL )
  796. {
  797. /* couldn't find DLL -- error handling here */
  798. ifail = -999;
  799. }
  800. else /* OK so far */
  801. {
  802. if ( (d01apf_proc = (PD01APF) GetProcAddress (hLib, "_D01APF@60"))
  803. == NULL )
  804. {
  805. /* couldn't find function within DLL -- error handling here */
  806. ifail = -998;
  807. }
  808. else /* have found function in DLL */
  809. {
  810. (*d01apf_proc) (&asp1, &a, &b, &alfa, &beta, &key, &epsabs, &epsrel,
  811. &result, &abserr, w, &lw, iw, &liw, &ifail);
  812. }
  813. }
  814. currlib = hLib;
  815. #else
  816. D01APF (&asp1, &a, &b, &alfa, &beta, &key, &epsabs, &epsrel, &result,
  817. &abserr, w, &lw, iw, &liw, &ifail);
  818. #endif
  819. /* Translate return values to CCL */
  820. /* Copy result */
  821. Lresult = make_boxfloat(result,TYPE_DOUBLE_FLOAT);
  822. push(Lresult);
  823. Labserr = make_boxfloat(abserr,TYPE_DOUBLE_FLOAT);
  824. pop(Lresult);
  825. errexit();
  826. push2(Lresult,Labserr);
  827. Lw = mkFloatVector(w,lw,1);
  828. pop2(Labserr,Lresult);
  829. errexit();
  830. push3(Lresult,Labserr,Lw);
  831. Liw = mkIntVector(iw,liw,1);
  832. pop3(Lw,Labserr,Lresult);
  833. errexit();
  834. push4(Lresult,Labserr,Lw,Liw);
  835. Lifail = int2ccl(ifail);
  836. pop4(Liw,Lw,Labserr,Lresult);
  837. errexit();
  838. free (w);
  839. free (iw);
  840. return Llist(nil,5,Lresult,Labserr,Lw,Liw,Lifail);
  841. }
  842. #else
  843. Lisp_Object MS_CDECL Ld01apf(Lisp_Object nil, int nargs, ...)
  844. {
  845. return Llist(nil, 0);
  846. }
  847. #endif
  848. #if 1
  849. Lisp_Object MS_CDECL Ld01aqf(Lisp_Object nil, int nargs, ...)
  850. {
  851. va_list args;
  852. Lisp_Object La, Lb, Lepsabs, Lepsrel, Llw, Lliw, Lifail, Lresult, Labserr,
  853. Lw, Liw, Lc;
  854. double a, b, epsabs, epsrel, result, abserr, *w, c;
  855. int32 ifail, lw, *iw, liw;
  856. extern double __stdcall asp1(double *);
  857. #ifdef LOADLIB
  858. typedef void (__stdcall *PD01AQF) (double __stdcall (*fst) (double *),
  859. double *, double *, double *, double *, double *, double *,
  860. double *, double *, int32 *, int32 *, int32 *, int32 *);
  861. HINSTANCE hLib;
  862. PD01AQF d01aqf_proc;
  863. #else
  864. extern void __stdcall D01AQF(double __stdcall (*fst) (double *), double *,
  865. double *, double *, double *, double *, double *, double *,
  866. double *, int32 *, int32 *, int32 *, int32 *);
  867. #endif
  868. /* Set up arguments as Lisp Objects */
  869. argcheck(nargs,8,"Ld01aqf");
  870. va_start(args,nargs);
  871. La = va_arg(args, Lisp_Object);
  872. Lb = va_arg(args, Lisp_Object);
  873. Lc = va_arg(args, Lisp_Object);
  874. Lepsabs = va_arg(args, Lisp_Object);
  875. Lepsrel = va_arg(args, Lisp_Object);
  876. Llw = va_arg(args, Lisp_Object);
  877. Lliw = va_arg(args, Lisp_Object);
  878. Lifail = va_arg(args, Lisp_Object);
  879. va_end(args);
  880. /* Translate arguments into C objects */
  881. push4(La,Lb,Lc,Lepsabs);
  882. push4(Lepsrel,Llw,Lliw,Lifail);
  883. a = float_of_number(La);
  884. pop4(Lifail,Lliw,Llw,Lepsrel);
  885. pop4(Lepsabs,Lc,Lb,La);
  886. errexit();
  887. push4(La,Lb,Lc,Lepsabs);
  888. push4(Lepsrel,Llw,Lliw,Lifail);
  889. b = float_of_number(Lb);
  890. pop4(Lifail,Lliw,Llw,Lepsrel);
  891. pop4(Lepsabs,Lc,Lb,La);
  892. errexit();
  893. push4(La,Lb,Lc,Lepsabs);
  894. push4(Lepsrel,Llw,Lliw,Lifail);
  895. c = float_of_number(Lc);
  896. pop4(Lifail,Lliw,Llw,Lepsrel);
  897. pop4(Lepsabs,Lc,Lb,La);
  898. errexit();
  899. push4(La,Lb,Lc,Lepsabs);
  900. push4(Lepsrel,Llw,Lliw,Lifail);
  901. epsabs = float_of_number(Lepsabs);
  902. pop4(Lifail,Lliw,Llw,Lepsrel);
  903. pop4(Lepsabs,Lc,Lb,La);
  904. errexit();
  905. push4(La,Lb,Lc,Lepsabs);
  906. push4(Lepsrel,Llw,Lliw,Lifail);
  907. epsrel = float_of_number(Lepsrel);
  908. pop4(Lifail,Lliw,Llw,Lepsrel);
  909. pop4(Lepsabs,Lc,Lb,La);
  910. errexit();
  911. push4(La,Lb,Lc,Lepsabs);
  912. push4(Lepsrel,Llw,Lliw,Lifail);
  913. lw = thirty_two_bits(Llw);
  914. pop4(Lifail,Lliw,Llw,Lepsrel);
  915. pop4(Lepsabs,Lc,Lb,La);
  916. errexit();
  917. push4(La,Lb,Lc,Lepsabs);
  918. push4(Lepsrel,Llw,Lliw,Lifail);
  919. liw = thirty_two_bits(Lliw);
  920. pop4(Lifail,Lliw,Llw,Lepsrel);
  921. pop4(Lepsabs,Lc,Lb,La);
  922. errexit();
  923. push4(La,Lb,Lc,Lepsabs);
  924. push4(Lepsrel,Llw,Lliw,Lifail);
  925. ifail = thirty_two_bits(Lifail);
  926. pop4(Lifail,Lliw,Llw,Lepsrel);
  927. pop4(Lepsabs,Lc,Lb,La);
  928. errexit();
  929. /* Setup workspace arrays etc. */
  930. w = (double *)malloc(lw*sizeof(double));
  931. iw = (int32 *)malloc(liw*sizeof(int));
  932. /* Call NAG routine */
  933. #ifdef LOADLIB
  934. free_prevlib ();
  935. if ( (hLib = LoadLibrary ("nagfad01")) == NULL )
  936. {
  937. /* couldn't find DLL -- error handling here */
  938. ifail = -999;
  939. }
  940. else /* OK so far */
  941. {
  942. if ( (d01aqf_proc = (PD01AQF) GetProcAddress (hLib, "_D01AQF@52"))
  943. == NULL )
  944. {
  945. /* couldn't find function within DLL -- error handling here */
  946. ifail = -998;
  947. }
  948. else /* have found function in DLL */
  949. {
  950. (*d01aqf_proc) (&asp1, &a, &b, &c, &epsabs, &epsrel, &result, &abserr,
  951. w, &lw, iw, &liw, &ifail);
  952. }
  953. }
  954. currlib = hLib;
  955. #else
  956. D01AQF (&asp1, &a, &b, &c, &epsabs, &epsrel, &result, &abserr, w, &lw, iw,
  957. &liw, &ifail);
  958. #endif
  959. /* Translate return values to CCL */
  960. /* Copy result */
  961. Lresult = make_boxfloat(result,TYPE_DOUBLE_FLOAT);
  962. push(Lresult);
  963. Labserr = make_boxfloat(abserr,TYPE_DOUBLE_FLOAT);
  964. pop(Lresult);
  965. errexit();
  966. push2(Lresult,Labserr);
  967. Lw = mkFloatVector(w,lw,1);
  968. pop2(Labserr,Lresult);
  969. errexit();
  970. push3(Lresult,Labserr,Lw);
  971. Liw = mkIntVector(iw,liw,1);
  972. pop3(Lw,Labserr,Lresult);
  973. errexit();
  974. push4(Lresult,Labserr,Lw,Liw);
  975. Lifail = int2ccl(ifail);
  976. pop4(Liw,Lw,Labserr,Lresult);
  977. errexit();
  978. free (w);
  979. free (iw);
  980. return Llist(nil,5,Lresult,Labserr,Lw,Liw,Lifail);
  981. }
  982. #else
  983. Lisp_Object MS_CDECL Ld01aqf(Lisp_Object nil, int nargs, ...)
  984. {
  985. return Llist(nil, 0);
  986. }
  987. #endif
  988. #if 1
  989. Lisp_Object MS_CDECL Ld01asf(Lisp_Object nil, int nargs, ...)
  990. {
  991. va_list args;
  992. Lisp_Object La, Lepsabs, Llw, Lliw, Lifail, Lresult, Labserr, Liw, Lomega,
  993. Lkey, Llimlst, Llst, Lerlst, Lrslst, Lierlst;
  994. double a, epsabs, result, abserr, *w, omega, *erlst, *rslst;
  995. int32 ifail, lw, *iw, liw, key, limlst, lst, *ierlst;
  996. extern double __stdcall asp1(double *);
  997. #ifdef LOADLIB
  998. typedef void (__stdcall *PD01ASF) (double __stdcall (*fst) (double *),
  999. double *, double *, int32 *, double *, double *, double *, int32 *,
  1000. int32 *, double *, double *, int32 *, double *, int32 *, int32 *,
  1001. int32 *, int32 *);
  1002. HINSTANCE hLib;
  1003. PD01ASF d01asf_proc;
  1004. #else
  1005. extern void __stdcall D01ASF(double __stdcall (*fst) (double *), double *,
  1006. double *, int32 *, double *, double *, double *, int32 *, int32 *,
  1007. double *, double *, int32 *, double *, int32 *, int32 *, int32 *,
  1008. int32 *);
  1009. #endif
  1010. /* Set up arguments as Lisp Objects */
  1011. argcheck(nargs,8,"Ld01asf");
  1012. va_start(args,nargs);
  1013. La = va_arg(args, Lisp_Object);
  1014. Lomega = va_arg(args, Lisp_Object);
  1015. Lkey = va_arg(args, Lisp_Object);
  1016. Lepsabs = va_arg(args, Lisp_Object);
  1017. Llimlst = va_arg(args, Lisp_Object);
  1018. Llw = va_arg(args, Lisp_Object);
  1019. Lliw = va_arg(args, Lisp_Object);
  1020. Lifail = va_arg(args, Lisp_Object);
  1021. va_end(args);
  1022. /* Translate arguments into C objects */
  1023. push4(La,Lomega,Lkey,Lepsabs);
  1024. push4(Llimlst,Llw,Lliw,Lifail);
  1025. a = float_of_number(La);
  1026. pop4(Lifail,Lliw,Llw,Llimlst);
  1027. pop4(Lepsabs,Lkey,Lomega,La);
  1028. errexit();
  1029. push4(La,Lomega,Lkey,Lepsabs);
  1030. push4(Llimlst,Llw,Lliw,Lifail);
  1031. omega = float_of_number(Lomega);
  1032. pop4(Lifail,Lliw,Llw,Llimlst);
  1033. pop4(Lepsabs,Lkey,Lomega,La);
  1034. errexit();
  1035. push4(La,Lomega,Lkey,Lepsabs);
  1036. push4(Llimlst,Llw,Lliw,Lifail);
  1037. key = thirty_two_bits(Lkey);
  1038. pop4(Lifail,Lliw,Llw,Llimlst);
  1039. pop4(Lepsabs,Lkey,Lomega,La);
  1040. errexit();
  1041. push4(La,Lomega,Lkey,Lepsabs);
  1042. push4(Llimlst,Llw,Lliw,Lifail);
  1043. epsabs = float_of_number(Lepsabs);
  1044. pop4(Lifail,Lliw,Llw,Llimlst);
  1045. pop4(Lepsabs,Lkey,Lomega,La);
  1046. errexit();
  1047. push4(La,Lomega,Lkey,Lepsabs);
  1048. push4(Llimlst,Llw,Lliw,Lifail);
  1049. limlst = thirty_two_bits(Llw);
  1050. pop4(Lifail,Lliw,Llw,Llimlst);
  1051. pop4(Lepsabs,Lkey,Lomega,La);
  1052. errexit();
  1053. push4(La,Lomega,Lkey,Lepsabs);
  1054. push4(Llimlst,Llw,Lliw,Lifail);
  1055. lw = thirty_two_bits(Llw);
  1056. pop4(Lifail,Lliw,Llw,Llimlst);
  1057. pop4(Lepsabs,Lkey,Lomega,La);
  1058. errexit();
  1059. push4(La,Lomega,Lkey,Lepsabs);
  1060. push4(Llimlst,Llw,Lliw,Lifail);
  1061. liw = thirty_two_bits(Lliw);
  1062. pop4(Lifail,Lliw,Llw,Llimlst);
  1063. pop4(Lepsabs,Lkey,Lomega,La);
  1064. errexit();
  1065. push4(La,Lomega,Lkey,Lepsabs);
  1066. push4(Llimlst,Llw,Lliw,Lifail);
  1067. ifail = thirty_two_bits(Lifail);
  1068. pop4(Lifail,Lliw,Llw,Llimlst);
  1069. pop4(Lepsabs,Lkey,Lomega,La);
  1070. errexit();
  1071. /* Setup workspace arrays etc. */
  1072. erlst = (double *)malloc(limlst*sizeof(double));
  1073. rslst = (double *)malloc(limlst*sizeof(double));
  1074. ierlst = (int32 *)malloc(limlst*sizeof(int));
  1075. w = (double *)malloc(lw*sizeof(double));
  1076. iw = (int32 *)malloc(liw*sizeof(int));
  1077. /* Call NAG routine */
  1078. #ifdef LOADLIB
  1079. free_prevlib ();
  1080. if ( (hLib = LoadLibrary ("nagfad01")) == NULL )
  1081. {
  1082. /* couldn't find DLL -- error handling here */
  1083. ifail = -999;
  1084. }
  1085. else /* OK so far */
  1086. {
  1087. if ( (d01asf_proc = (PD01ASF) GetProcAddress (hLib, "_D01ASF@68"))
  1088. == NULL )
  1089. {
  1090. /* couldn't find function within DLL -- error handling here */
  1091. ifail = -998;
  1092. }
  1093. else /* have found function in DLL */
  1094. {
  1095. (*d01asf_proc) (&asp1, &a, &omega, &key, &epsabs, &result, &abserr,
  1096. &limlst, &lst, erlst, rslst, ierlst, w, &lw, iw, &liw, &ifail);
  1097. }
  1098. }
  1099. currlib = hLib;
  1100. #else
  1101. D01ASF (&asp1, &a, &omega, &key, &epsabs, &result, &abserr, &limlst, &lst,
  1102. erlst, rslst, ierlst, w, &lw, iw, &liw, &ifail);
  1103. #endif
  1104. /* Translate return values to CCL */
  1105. /* Copy result */
  1106. Lierlst = mkIntVector(ierlst,limlst,1);
  1107. push(Lierlst);
  1108. Lresult = make_boxfloat(result,TYPE_DOUBLE_FLOAT);
  1109. pop(Lierlst);
  1110. errexit();
  1111. push2(Lierlst,Lresult);
  1112. Labserr = make_boxfloat(abserr,TYPE_DOUBLE_FLOAT);
  1113. pop2(Lresult,Lierlst);
  1114. errexit();
  1115. push3(Lierlst,Lresult,Labserr);
  1116. Lerlst = mkFloatVector(erlst,limlst,1);
  1117. pop3(Labserr,Lresult,Lierlst);
  1118. errexit();
  1119. push4(Lierlst,Lresult,Labserr,Lerlst);
  1120. Lifail = int2ccl(ifail);
  1121. pop4(Lerlst,Labserr,Lresult,Lierlst);
  1122. errexit();
  1123. push5(Lierlst,Lresult,Labserr,Lerlst,Lifail);
  1124. Liw = mkIntVector(iw,liw,1);
  1125. pop5(Lifail,Lerlst,Labserr,Lresult,Lierlst);
  1126. errexit();
  1127. push3(Lierlst,Lresult,Labserr);
  1128. push3(Lerlst,Lifail,Liw);
  1129. Llst = int2ccl(lst);
  1130. pop3(Liw,Lifail,Lerlst);
  1131. pop3(Labserr,Lresult,Lierlst);
  1132. errexit();
  1133. push4(Lierlst,Lresult,Labserr,Lerlst);
  1134. push3(Lifail,Liw,Llst);
  1135. Lrslst = mkFloatVector(rslst,limlst,1);
  1136. pop4(Llst,Liw,Lifail,Lerlst);
  1137. pop3(Labserr,Lresult,Lierlst);
  1138. errexit();
  1139. free (erlst);
  1140. free (rslst);
  1141. free (ierlst);
  1142. free (w);
  1143. free (iw);
  1144. return Llist(nil,8,Lierlst,Lresult,Labserr,Lerlst,Lifail,Liw,Llst,Lrslst);
  1145. }
  1146. #else
  1147. Lisp_Object MS_CDECL Ld01asf(Lisp_Object nil, int nargs, ...)
  1148. {
  1149. return Llist(nil, 0);
  1150. }
  1151. #endif
  1152. #if 1
  1153. Lisp_Object MS_CDECL Ld01bbf(Lisp_Object nil, int nargs, ...)
  1154. {
  1155. va_list args;
  1156. Lisp_Object La, Lb, Litype, Ln, Lgtype, Lifail, Lweight, Labscis;
  1157. double a, b, *weight, *abscis;
  1158. int32 ifail, itype, n, gtype;
  1159. #ifdef LOADLIB
  1160. typedef void (__stdcall *PAD01BB) (double *, double *, int32 *, int32 *,
  1161. double *, double *, int32 *, int32 *);
  1162. HINSTANCE hLib;
  1163. PAD01BB ad01bb_proc;
  1164. #else
  1165. extern void __stdcall AD01BB(double *, double *, int32 *, int32 *,
  1166. double *, double *, int32 *, int32 *);
  1167. #endif
  1168. /* Set up arguments as Lisp Objects */
  1169. argcheck(nargs,6,"Ld01bbf");
  1170. va_start(args,nargs);
  1171. La = va_arg(args, Lisp_Object);
  1172. Lb = va_arg(args, Lisp_Object);
  1173. Litype = va_arg(args, Lisp_Object);
  1174. Ln = va_arg(args, Lisp_Object);
  1175. Lgtype = va_arg(args, Lisp_Object);
  1176. Lifail = va_arg(args, Lisp_Object);
  1177. va_end(args);
  1178. /* Translate arguments into C objects */
  1179. push3(La,Lb,Litype);
  1180. push3(Ln,Lgtype,Lifail);
  1181. a = float_of_number(La);
  1182. pop3(Lifail,Lgtype,Ln);
  1183. pop3(Litype,Lb,La);
  1184. errexit();
  1185. push3(La,Lb,Litype);
  1186. push3(Ln,Lgtype,Lifail);
  1187. b = float_of_number(Lb);
  1188. pop3(Lifail,Lgtype,Ln);
  1189. pop3(Litype,Lb,La);
  1190. errexit();
  1191. push3(La,Lb,Litype);
  1192. push3(Ln,Lgtype,Lifail);
  1193. itype = thirty_two_bits(Litype);
  1194. pop3(Lifail,Lgtype,Ln);
  1195. pop3(Litype,Lb,La);
  1196. errexit();
  1197. push3(La,Lb,Litype);
  1198. push3(Ln,Lgtype,Lifail);
  1199. n = thirty_two_bits(Ln);
  1200. pop3(Lifail,Lgtype,Ln);
  1201. pop3(Litype,Lb,La);
  1202. errexit();
  1203. push3(La,Lb,Litype);
  1204. push3(Ln,Lgtype,Lifail);
  1205. gtype = thirty_two_bits(Lgtype);
  1206. pop3(Lifail,Lgtype,Ln);
  1207. pop3(Litype,Lb,La);
  1208. errexit();
  1209. push3(La,Lb,Litype);
  1210. push3(Ln,Lgtype,Lifail);
  1211. ifail = thirty_two_bits(Lifail);
  1212. pop3(Lifail,Lgtype,Ln);
  1213. pop3(Litype,Lb,La);
  1214. errexit();
  1215. push3(La,Lb,Litype);
  1216. push3(Ln,Lgtype,Lifail);
  1217. /* Setup workspace arrays etc. */ /* return value arrays in this case */
  1218. weight = (double *)malloc(n*sizeof(double));
  1219. abscis = (double *)malloc(n*sizeof(double));
  1220. /* Call NAG routine */
  1221. #ifdef LOADLIB
  1222. free_prevlib ();
  1223. if ( (hLib = LoadLibrary ("nagfadj")) == NULL ) /* FIXME - DLL name? */
  1224. {
  1225. /* couldn't find DLL -- error handling here */
  1226. ifail = -999;
  1227. }
  1228. else /* OK so far */
  1229. {
  1230. if ( (ad01bb_proc = (PAD01BB) GetProcAddress (hLib, "_AD01BB@32"))
  1231. == NULL )
  1232. {
  1233. /* couldn't find function within DLL -- error handling here */
  1234. ifail = -998;
  1235. }
  1236. else /* have found function in DLL */
  1237. {
  1238. (*ad01bb_proc) (&a, &b, &itype, &n, weight, abscis, &gtype, &ifail);
  1239. }
  1240. }
  1241. currlib = hLib;
  1242. #else
  1243. AD01BB (&a, &b, &itype, &n, weight, abscis, &gtype, &ifail);
  1244. #endif
  1245. pop3(Lifail,Lgtype,Ln);
  1246. pop3(Litype,Lb,La);
  1247. errexit();
  1248. /* Translate return values to CCL */
  1249. /* Copy result */
  1250. Lweight = mkFloatVector(weight,n,1);
  1251. push(Lweight);
  1252. Labscis = mkFloatVector(abscis,n,1);
  1253. pop(Lweight);
  1254. errexit();
  1255. push2(Lweight,Labscis);
  1256. Lifail = int2ccl(ifail);
  1257. pop2(Labscis,Lweight);
  1258. errexit();
  1259. free (weight);
  1260. free (abscis);
  1261. return Llist(nil,3,Lweight,Labscis,Lifail);
  1262. }
  1263. #else
  1264. {
  1265. return Llist(nil, 0);
  1266. }
  1267. #endif
  1268. #if 1
  1269. Lisp_Object MS_CDECL Ld01fcf(Lisp_Object nil, int nargs, ...)
  1270. {
  1271. va_list args;
  1272. Lisp_Object La, Lb, Lndim, Leps, Lminpts, Lmaxpts, Lifail, Lfinval, Lacc,
  1273. Llenwrk;
  1274. double *a, *b, eps, finval, acc, *wrkstr;
  1275. int32 ifail, ndim, minpts, maxpts, lenwrk;
  1276. extern double __stdcall asp4(int32 *, double *);
  1277. #ifdef LOADLIB
  1278. typedef void (__stdcall *PD01FCF) (int32 *, double *, double *, int32 *,
  1279. int32 *, double __stdcall (*functn) (int32 *, double *), double *,
  1280. double *, int32 *, double *, double *, int32 *);
  1281. HINSTANCE hLib;
  1282. PD01FCF d01fcf_proc;
  1283. #else
  1284. extern void __stdcall D01FCF(int32 *, double *, double *, int32 *, int32 *,
  1285. double __stdcall (*functn) (int32 *, double *), double *, double *,
  1286. int32 *, double *, double *, int32 *);
  1287. #endif
  1288. /* Set up arguments as Lisp Objects */
  1289. argcheck(nargs,8,"Ld01fcf");
  1290. va_start(args,nargs);
  1291. Lndim = va_arg(args, Lisp_Object);
  1292. La = va_arg(args, Lisp_Object);
  1293. Lb = va_arg(args, Lisp_Object);
  1294. Lmaxpts = va_arg(args, Lisp_Object);
  1295. Leps = va_arg(args, Lisp_Object);
  1296. Llenwrk = va_arg(args, Lisp_Object);
  1297. Lminpts = va_arg(args, Lisp_Object);
  1298. Lifail = va_arg(args, Lisp_Object);
  1299. va_end(args);
  1300. /* Translate arguments into C objects */
  1301. push4(Lndim,La,Lb,Lmaxpts);
  1302. push4(Leps,Llenwrk,Lminpts,Lifail);
  1303. ndim = thirty_two_bits(Lndim);
  1304. pop4(Lifail,Lminpts,Llenwrk,Leps);
  1305. pop4(Lmaxpts,Lb,La,Lndim);
  1306. errexit();
  1307. a = (double *) malloc (ndim * sizeof(double));
  1308. push4(Lndim,La,Lb,Lmaxpts);
  1309. push4(Leps,Llenwrk,Lminpts,Lifail);
  1310. mkFortranVectorDouble(a, La, ndim);
  1311. pop4(Lifail,Lminpts,Llenwrk,Leps);
  1312. pop4(Lmaxpts,Lb,La,Lndim);
  1313. errexit();
  1314. b = (double *) malloc (ndim * sizeof(double));
  1315. push4(Lndim,La,Lb,Lmaxpts);
  1316. push4(Leps,Llenwrk,Lminpts,Lifail);
  1317. mkFortranVectorDouble(b, Lb, ndim);
  1318. pop4(Lifail,Lminpts,Llenwrk,Leps);
  1319. pop4(Lmaxpts,Lb,La,Lndim);
  1320. errexit();
  1321. push4(Lndim,La,Lb,Lmaxpts);
  1322. push4(Leps,Llenwrk,Lminpts,Lifail);
  1323. maxpts = thirty_two_bits(Lmaxpts);
  1324. pop4(Lifail,Lminpts,Llenwrk,Leps);
  1325. pop4(Lmaxpts,Lb,La,Lndim);
  1326. errexit();
  1327. push4(Lndim,La,Lb,Lmaxpts);
  1328. push4(Leps,Llenwrk,Lminpts,Lifail);
  1329. eps = float_of_number(Leps);
  1330. pop4(Lifail,Lminpts,Llenwrk,Leps);
  1331. pop4(Lmaxpts,Lb,La,Lndim);
  1332. errexit();
  1333. push4(Lndim,La,Lb,Lmaxpts);
  1334. push4(Leps,Llenwrk,Lminpts,Lifail);
  1335. lenwrk = thirty_two_bits(Llenwrk);
  1336. pop4(Lifail,Lminpts,Llenwrk,Leps);
  1337. pop4(Lmaxpts,Lb,La,Lndim);
  1338. errexit();
  1339. push4(Lndim,La,Lb,Lmaxpts);
  1340. push4(Leps,Llenwrk,Lminpts,Lifail);
  1341. minpts = thirty_two_bits(Lminpts);
  1342. pop4(Lifail,Lminpts,Llenwrk,Leps);
  1343. pop4(Lmaxpts,Lb,La,Lndim);
  1344. errexit();
  1345. push4(Lndim,La,Lb,Lmaxpts);
  1346. push4(Leps,Llenwrk,Lminpts,Lifail);
  1347. ifail = thirty_two_bits(Lifail);
  1348. pop4(Lifail,Lminpts,Llenwrk,Leps);
  1349. pop4(Lmaxpts,Lb,La,Lndim);
  1350. errexit();
  1351. /* Setup workspace arrays etc. */
  1352. wrkstr = (double *)malloc(lenwrk*sizeof(double));
  1353. push4(Lndim,La,Lb,Lmaxpts);
  1354. push4(Leps,Llenwrk,Lminpts,Lifail);
  1355. /* Call NAG routine */
  1356. #ifdef LOADLIB
  1357. free_prevlib ();
  1358. if ( (hLib = LoadLibrary ("nagfad01")) == NULL )
  1359. {
  1360. /* couldn't find DLL -- error handling here */
  1361. ifail = -999;
  1362. }
  1363. else /* OK so far */
  1364. {
  1365. if ( (d01fcf_proc = (PD01FCF) GetProcAddress (hLib, "_D01FCF@48"))
  1366. == NULL )
  1367. {
  1368. /* couldn't find function within DLL -- error handling here */
  1369. ifail = -998;
  1370. }
  1371. else /* have found function in DLL */
  1372. {
  1373. (*d01fcf_proc) (&ndim, a, b, &minpts, &maxpts, &asp4, &eps, &acc,
  1374. &lenwrk, wrkstr, &finval, &ifail);
  1375. }
  1376. }
  1377. currlib = hLib;
  1378. #else
  1379. D01FCF (&ndim, a, b, &minpts, &maxpts, &asp4, &eps, &acc, &lenwrk, wrkstr,
  1380. &finval, &ifail);
  1381. #endif
  1382. pop4(Lifail,Lminpts,Llenwrk,Leps);
  1383. pop4(Lmaxpts,Lb,La,Lndim);
  1384. errexit();
  1385. /* Translate return values to CCL */
  1386. /* Copy result */
  1387. Lfinval = make_boxfloat(finval,TYPE_DOUBLE_FLOAT);
  1388. push(Lfinval);
  1389. Lminpts = int2ccl(minpts);
  1390. pop(Lfinval);
  1391. errexit();
  1392. push2(Lfinval,Lminpts);
  1393. Lifail = int2ccl(ifail);
  1394. pop2(Lminpts,Lfinval);
  1395. errexit();
  1396. push3(Lfinval,Lminpts,Lifail);
  1397. Lacc = make_boxfloat(acc,TYPE_DOUBLE_FLOAT);
  1398. pop3(Lifail,Lminpts,Lfinval);
  1399. errexit();
  1400. free (a);
  1401. free (b);
  1402. free (wrkstr);
  1403. return Llist(nil,4,Lfinval,Lminpts,Lifail,Lacc);
  1404. }
  1405. #else
  1406. {
  1407. return Llist(nil, 0);
  1408. }
  1409. #endif
  1410. #if 1
  1411. Lisp_Object MS_CDECL Ld01gaf(Lisp_Object nil, int nargs, ...)
  1412. {
  1413. va_list args;
  1414. Lisp_Object Lx, Ly, Ln, Lans, Ler, Lifail;
  1415. double *x, *y, ans, er;
  1416. int32 ifail, n;
  1417. #ifdef LOADLIB
  1418. typedef void (__stdcall *PD01GAF) (double *, double *, int32 *, double *,
  1419. double *, int32 *);
  1420. HINSTANCE hLib;
  1421. PD01GAF d01gaf_proc;
  1422. #else
  1423. extern void __stdcall D01GAF(double *, double *, int32 *, double *,
  1424. double *, int32 *);
  1425. #endif
  1426. /* Set up arguments as Lisp Objects */
  1427. argcheck(nargs,4,"Ld01gaf");
  1428. va_start(args,nargs);
  1429. Lx = va_arg(args, Lisp_Object);
  1430. Ly = va_arg(args, Lisp_Object);
  1431. Ln = va_arg(args, Lisp_Object);
  1432. Lifail = va_arg(args, Lisp_Object);
  1433. va_end(args);
  1434. /* Translate arguments into C objects */
  1435. push4(Lx,Ly,Ln,Lifail);
  1436. n = thirty_two_bits(Ln);
  1437. pop4(Lifail,Ln,Ly,Lx);
  1438. errexit();
  1439. x = (double *) malloc (n * sizeof(double));
  1440. push4(Lx,Ly,Ln,Lifail);
  1441. mkFortranVectorDouble(x, Lx, n);
  1442. pop4(Lifail,Ln,Ly,Lx);
  1443. errexit();
  1444. y = (double *) malloc (n * sizeof(double));
  1445. push4(Lx,Ly,Ln,Lifail);
  1446. mkFortranVectorDouble(y, Ly, n);
  1447. pop4(Lifail,Ln,Ly,Lx);
  1448. errexit();
  1449. push4(Lx,Ly,Ln,Lifail);
  1450. ifail = thirty_two_bits(Lifail);
  1451. pop4(Lifail,Ln,Ly,Lx);
  1452. errexit();
  1453. push4(Lx,Ly,Ln,Lifail);
  1454. /* Call NAG routine */
  1455. #ifdef LOADLIB
  1456. free_prevlib ();
  1457. if ( (hLib = LoadLibrary ("nagfad01")) == NULL )
  1458. {
  1459. /* couldn't find DLL -- error handling here */
  1460. ifail = -999;
  1461. }
  1462. else /* OK so far */
  1463. {
  1464. if ( (d01gaf_proc = (PD01GAF) GetProcAddress (hLib, "_D01GAF@24"))
  1465. == NULL )
  1466. {
  1467. /* couldn't find function within DLL -- error handling here */
  1468. ifail = -998;
  1469. }
  1470. else /* have found function in DLL */
  1471. {
  1472. (*d01gaf_proc) (x, y, &n, &ans, &er, &ifail);
  1473. }
  1474. }
  1475. currlib = hLib;
  1476. #else
  1477. D01GAF (x, y, &n, &ans, &er, &ifail);
  1478. #endif
  1479. pop4(Lifail,Ln,Ly,Lx);
  1480. errexit();
  1481. /* Translate return values to CCL */
  1482. /* Copy result */
  1483. Lans = make_boxfloat(ans,TYPE_DOUBLE_FLOAT);
  1484. push(Lans);
  1485. Ler = make_boxfloat(er,TYPE_DOUBLE_FLOAT);
  1486. pop(Lans);
  1487. errexit();
  1488. push2(Lans,Ler);
  1489. Lifail = int2ccl(ifail);
  1490. pop2(Ler,Lans);
  1491. errexit();
  1492. free (x);
  1493. free (y);
  1494. return Llist(nil,3,Lans,Ler,Lifail);
  1495. }
  1496. #else
  1497. {
  1498. return Llist(nil, 0);
  1499. }
  1500. #endif
  1501. #if 1
  1502. Lisp_Object MS_CDECL Ld01gbf(Lisp_Object nil, int nargs, ...)
  1503. {
  1504. va_list args;
  1505. Lisp_Object La, Lb, Lndim, Leps, Lmincls, Lmaxcls, Lifail, Lfinval, Lacc,
  1506. Llenwrk, Lwrkstr;
  1507. double *a, *b, eps, finval, acc, *wrkstr;
  1508. int32 ifail, ndim, mincls, maxcls, lenwrk;
  1509. extern double __stdcall asp4(int32 *, double *);
  1510. #ifdef LOADLIB
  1511. typedef void (__stdcall *PD01GBF) (int32 *, double *, double *, int32 *,
  1512. int32 *, double __stdcall (*functn) (int32 *, double *), double *,
  1513. double *, int32 *, double *, double *, int32 *);
  1514. HINSTANCE hLib;
  1515. PD01GBF d01gbf_proc;
  1516. #else
  1517. extern void __stdcall D01GBF(int32 *, double *, double *, int32 *, int32 *,
  1518. double __stdcall (*functn) (int32 *, double *), double *, double *,
  1519. int32 *, double *, double *, int32 *);
  1520. #endif
  1521. /* Set up arguments as Lisp Objects */
  1522. argcheck(nargs,9,"Ld01gbf");
  1523. va_start(args,nargs);
  1524. Lndim = va_arg(args, Lisp_Object);
  1525. La = va_arg(args, Lisp_Object);
  1526. Lb = va_arg(args, Lisp_Object);
  1527. Lmaxcls = va_arg(args, Lisp_Object);
  1528. Leps = va_arg(args, Lisp_Object);
  1529. Llenwrk = va_arg(args, Lisp_Object);
  1530. Lmincls = va_arg(args, Lisp_Object);
  1531. Lwrkstr = va_arg(args, Lisp_Object);
  1532. Lifail = va_arg(args, Lisp_Object);
  1533. va_end(args);
  1534. /* Translate arguments into C objects */
  1535. push5(Lndim,La,Lb,Lmaxcls,Leps);
  1536. push4(Llenwrk,Lmincls,Lwrkstr,Lifail);
  1537. ndim = thirty_two_bits(Lndim);
  1538. pop5(Lifail,Lwrkstr,Lmincls,Llenwrk,Leps);
  1539. pop4(Lmaxcls,Lb,La,Lndim);
  1540. errexit();
  1541. a = (double *) malloc (ndim * sizeof(double));
  1542. push5(Lndim,La,Lb,Lmaxcls,Leps);
  1543. push4(Llenwrk,Lmincls,Lwrkstr,Lifail);
  1544. mkFortranVectorDouble(a, La, ndim);
  1545. pop5(Lifail,Lwrkstr,Lmincls,Llenwrk,Leps);
  1546. pop4(Lmaxcls,Lb,La,Lndim);
  1547. errexit();
  1548. b = (double *) malloc (ndim * sizeof(double));
  1549. push5(Lndim,La,Lb,Lmaxcls,Leps);
  1550. push4(Llenwrk,Lmincls,Lwrkstr,Lifail);
  1551. mkFortranVectorDouble(b, Lb, ndim);
  1552. pop5(Lifail,Lwrkstr,Lmincls,Llenwrk,Leps);
  1553. pop4(Lmaxcls,Lb,La,Lndim);
  1554. errexit();
  1555. push5(Lndim,La,Lb,Lmaxcls,Leps);
  1556. push4(Llenwrk,Lmincls,Lwrkstr,Lifail);
  1557. maxcls = thirty_two_bits(Lmaxcls);
  1558. pop5(Lifail,Lwrkstr,Lmincls,Llenwrk,Leps);
  1559. pop4(Lmaxcls,Lb,La,Lndim);
  1560. errexit();
  1561. push5(Lndim,La,Lb,Lmaxcls,Leps);
  1562. push4(Llenwrk,Lmincls,Lwrkstr,Lifail);
  1563. eps = float_of_number(Leps);
  1564. pop5(Lifail,Lwrkstr,Lmincls,Llenwrk,Leps);
  1565. pop4(Lmaxcls,Lb,La,Lndim);
  1566. errexit();
  1567. push5(Lndim,La,Lb,Lmaxcls,Leps);
  1568. push4(Llenwrk,Lmincls,Lwrkstr,Lifail);
  1569. lenwrk = thirty_two_bits(Llenwrk);
  1570. pop5(Lifail,Lwrkstr,Lmincls,Llenwrk,Leps);
  1571. pop4(Lmaxcls,Lb,La,Lndim);
  1572. errexit();
  1573. push5(Lndim,La,Lb,Lmaxcls,Leps);
  1574. push4(Llenwrk,Lmincls,Lwrkstr,Lifail);
  1575. mincls = thirty_two_bits(Lmincls);
  1576. pop5(Lifail,Lwrkstr,Lmincls,Llenwrk,Leps);
  1577. pop4(Lmaxcls,Lb,La,Lndim);
  1578. errexit();
  1579. wrkstr = (double *) malloc (lenwrk * sizeof(double));
  1580. push5(Lndim,La,Lb,Lmaxcls,Leps);
  1581. push4(Llenwrk,Lmincls,Lwrkstr,Lifail);
  1582. mkFortranVectorDouble(wrkstr, Lwrkstr, lenwrk);
  1583. pop5(Lifail,Lwrkstr,Lmincls,Llenwrk,Leps);
  1584. pop4(Lmaxcls,Lb,La,Lndim);
  1585. errexit();
  1586. push5(Lndim,La,Lb,Lmaxcls,Leps);
  1587. push4(Llenwrk,Lmincls,Lwrkstr,Lifail);
  1588. ifail = thirty_two_bits(Lifail);
  1589. pop5(Lifail,Lwrkstr,Lmincls,Llenwrk,Leps);
  1590. pop4(Lmaxcls,Lb,La,Lndim);
  1591. errexit();
  1592. push5(Lndim,La,Lb,Lmaxcls,Leps);
  1593. push4(Llenwrk,Lmincls,Lwrkstr,Lifail);
  1594. /* Call NAG routine */
  1595. #ifdef LOADLIB
  1596. free_prevlib ();
  1597. if ( (hLib = LoadLibrary ("nagfad01")) == NULL )
  1598. {
  1599. /* couldn't find DLL -- error handling here */
  1600. ifail = -999;
  1601. }
  1602. else /* OK so far */
  1603. {
  1604. if ( (d01gbf_proc = (PD01GBF) GetProcAddress (hLib, "_D01GBF@48"))
  1605. == NULL )
  1606. {
  1607. /* couldn't find function within DLL -- error handling here */
  1608. ifail = -998;
  1609. }
  1610. else /* have found function in DLL */
  1611. {
  1612. (*d01gbf_proc) (&ndim, a, b, &mincls, &maxcls, &asp4, &eps, &acc,
  1613. &lenwrk, wrkstr, &finval, &ifail);
  1614. }
  1615. }
  1616. currlib = hLib;
  1617. #else
  1618. D01GBF (&ndim, a, b, &mincls, &maxcls, &asp4, &eps, &acc, &lenwrk, wrkstr,
  1619. &finval, &ifail);
  1620. #endif
  1621. pop5(Lifail,Lwrkstr,Lmincls,Llenwrk,Leps);
  1622. pop4(Lmaxcls,Lb,La,Lndim);
  1623. errexit();
  1624. /* Translate return values to CCL */
  1625. /* Copy result */
  1626. Lfinval = make_boxfloat(finval,TYPE_DOUBLE_FLOAT);
  1627. push(Lfinval);
  1628. Lmincls = int2ccl(mincls);
  1629. pop(Lfinval);
  1630. errexit();
  1631. push2(Lfinval,Lmincls);
  1632. Lifail = int2ccl(ifail);
  1633. pop2(Lmincls,Lfinval);
  1634. errexit();
  1635. push3(Lfinval,Lmincls,Lifail);
  1636. Lwrkstr = mkFloatVector(wrkstr,lenwrk,1);
  1637. pop3(Lifail,Lmincls,Lfinval);
  1638. push4(Lfinval,Lmincls,Lifail,Lwrkstr);
  1639. Lacc = make_boxfloat(acc,TYPE_DOUBLE_FLOAT);
  1640. pop4(Lwrkstr,Lifail,Lmincls,Lfinval);
  1641. errexit();
  1642. free (a);
  1643. free (b);
  1644. free (wrkstr);
  1645. return Llist(nil,5,Lfinval,Lmincls,Lifail,Lwrkstr,Lacc);
  1646. }
  1647. #else
  1648. {
  1649. return Llist(nil, 0);
  1650. }
  1651. #endif
  1652. Lisp_Object MS_CDECL Ld02bbf(Lisp_Object nil, int nargs, ...)
  1653. #if 0
  1654. {
  1655. va_list args;
  1656. Lisp_Object Lx, Lxend, Lm, Ln, Ly, Ltol, Lirelab, Lresult, Lifail;
  1657. double x, xend, *y, tol, *w, *result;
  1658. int32 ifail, m, n, irelab;
  1659. extern void __stdcall asp7(double *, double *, double *);
  1660. extern void __stdcall asp8(double *, double *);
  1661. #ifdef LOADLIB
  1662. typedef void (__stdcall *PXD02BB) (double *, double *, int32 *, int32 *,
  1663. double *, double *, int32 *, double *,
  1664. void __stdcall (*fcn) (double *, double *, double *),
  1665. void __stdcall (*out) (double *, double *), double *, int32 *);
  1666. HINSTANCE hLib;
  1667. PXD02BB xd02bb_proc;
  1668. #else
  1669. extern void __stdcall XD02BB(double *, double *, int32 *, int32 *,
  1670. double *, double *, int32 *, double *,
  1671. void __stdcall (*fcn) (double *, double *, double *),
  1672. void __stdcall (*out) (double *, double *), double *, int32 *);
  1673. #endif
  1674. /* Set up arguments as Lisp Objects */
  1675. argcheck(nargs,8,"Ld02bbf");
  1676. va_start(args,nargs);
  1677. Lxend = va_arg(args, Lisp_Object);
  1678. Lm = va_arg(args, Lisp_Object);
  1679. Ln = va_arg(args, Lisp_Object);
  1680. Lirelab = va_arg(args, Lisp_Object);
  1681. Lx = va_arg(args, Lisp_Object);
  1682. Ly = va_arg(args, Lisp_Object);
  1683. Ltol = va_arg(args, Lisp_Object);
  1684. Lifail = va_arg(args, Lisp_Object);
  1685. va_end(args);
  1686. /* Translate arguments into C objects */
  1687. push4(Lxend,Lm,Ln,Lirelab);
  1688. push4(Lx,Ly,Ltol,Lifail);
  1689. xend = float_of_number(Lxend);
  1690. pop4(Lifail,Ltol,Ly,Lx);
  1691. pop4(Lirelab,Ln,Lm,Lxend);
  1692. errexit();
  1693. push4(Lxend,Lm,Ln,Lirelab);
  1694. push4(Lx,Ly,Ltol,Lifail);
  1695. m = thirty_two_bits(Lm);
  1696. pop4(Lifail,Ltol,Ly,Lx);
  1697. pop4(Lirelab,Ln,Lm,Lxend);
  1698. errexit();
  1699. push4(Lxend,Lm,Ln,Lirelab);
  1700. push4(Lx,Ly,Ltol,Lifail);
  1701. n = thirty_two_bits(Ln);
  1702. pop4(Lifail,Ltol,Ly,Lx);
  1703. pop4(Lirelab,Ln,Lm,Lxend);
  1704. errexit();
  1705. push4(Lxend,Lm,Ln,Lirelab);
  1706. push4(Lx,Ly,Ltol,Lifail);
  1707. irelab = thirty_two_bits(Lirelab);
  1708. pop4(Lifail,Ltol,Ly,Lx);
  1709. pop4(Lirelab,Ln,Lm,Lxend);
  1710. errexit();
  1711. push4(Lxend,Lm,Ln,Lirelab);
  1712. push4(Lx,Ly,Ltol,Lifail);
  1713. x = float_of_number(Lx);
  1714. pop4(Lifail,Ltol,Ly,Lx);
  1715. pop4(Lirelab,Ln,Lm,Lxend);
  1716. errexit();
  1717. y = (double *) malloc (n * sizeof(double));
  1718. push4(Lxend,Lm,Ln,Lirelab);
  1719. push4(Lx,Ly,Ltol,Lifail);
  1720. mkFortranVectorDouble(y, Ly, n);
  1721. pop4(Lifail,Ltol,Ly,Lx);
  1722. pop4(Lirelab,Ln,Lm,Lxend);
  1723. errexit();
  1724. push4(Lxend,Lm,Ln,Lirelab);
  1725. push4(Lx,Ly,Ltol,Lifail);
  1726. tol = float_of_number(Ltol);
  1727. pop4(Lifail,Ltol,Ly,Lx);
  1728. pop4(Lirelab,Ln,Lm,Lxend);
  1729. errexit();
  1730. push4(Lxend,Lm,Ln,Lirelab);
  1731. push4(Lx,Ly,Ltol,Lifail);
  1732. ifail = thirty_two_bits(Lifail);
  1733. pop4(Lifail,Ltol,Ly,Lx);
  1734. pop4(Lirelab,Ln,Lm,Lxend);
  1735. errexit();
  1736. /* Setup workspace arrays etc. */
  1737. w = (double *)malloc(n*7*sizeof(double));
  1738. result = (double *)malloc(m*n*sizeof(double));
  1739. /* Call NAG routine */
  1740. #ifdef LOADLIB
  1741. free_prevlib ();
  1742. if ( (hLib = LoadLibrary ("nagfadj")) == NULL ) /* FIXME - DLL name? */
  1743. {
  1744. /* couldn't find DLL -- error handling here */
  1745. ifail = -999;
  1746. }
  1747. else /* OK so far */
  1748. {
  1749. if ( (xd02bb_proc = (PXD02BB) GetProcAddress (hLib, "_XD02BB@48"))
  1750. == NULL )
  1751. {
  1752. /* couldn't find function within DLL -- error handling here */
  1753. ifail = -998;
  1754. }
  1755. else /* have found function in DLL */
  1756. {
  1757. (*xd02bb_proc) (&x, &xend, &m, &n, y, &tol, &irelab, result, &asp7,
  1758. &asp8, w, &ifail);
  1759. }
  1760. }
  1761. currlib = hLib;
  1762. #else
  1763. XD02BB (&x, &xend, &m, &n, y, &tol, &irelab, result, &asp7, &asp8, w,
  1764. &ifail);
  1765. #endif
  1766. /* Translate return values to CCL */
  1767. /* Copy result */
  1768. Lx = make_boxfloat(x,TYPE_DOUBLE_FLOAT);
  1769. push(Lx);
  1770. Ly = mkFloatVector(y,n,1);
  1771. pop(Lx);
  1772. errexit();
  1773. push2(Lx,Ly);
  1774. Lresult = mkFloatVector(result,m,n); /* FIXME: correct array ordering? */
  1775. pop2(Ly,Lx);
  1776. errexit();
  1777. push3(Lx,Ly,Lresult);
  1778. Lifail = int2ccl(ifail);
  1779. pop3(Lresult,Ly,Lx);
  1780. errexit();
  1781. push4(Lx,Ly,Lresult,Lifail);
  1782. Ltol = make_boxfloat(tol,TYPE_DOUBLE_FLOAT);
  1783. pop4(Lifail,Lresult,Ly,Lx);
  1784. errexit();
  1785. free (y);
  1786. free (w);
  1787. free (result);
  1788. return Llist(nil,5,Lx,Ly,Lresult,Lifail,Ltol);
  1789. }
  1790. #else
  1791. {
  1792. return Llist(nil, 0);
  1793. }
  1794. #endif
  1795. Lisp_Object MS_CDECL Ld02bhf(Lisp_Object nil, int nargs, ...)
  1796. #if 0
  1797. {
  1798. va_list args;
  1799. Lisp_Object Lx, Lxend, Ln, Ly, Ltol, Lirelab, Lhmax, Lifail;
  1800. double x, xend, *y, tol, *w, hmax;
  1801. int32 ifail, n, irelab;
  1802. extern void __stdcall asp7(double *, double *, double *);
  1803. extern double __stdcall asp9(double *, double *);
  1804. #ifdef LOADLIB
  1805. typedef void (__stdcall *PD02BHF) (double *, double *, int32 *, int32 *,
  1806. double *, double *, int32 *, double *,
  1807. void __stdcall (*fcn) (double *, double *, double *),
  1808. double __stdcall (*g) (double *, double *), double *, int32 *);
  1809. HINSTANCE hLib;
  1810. PD02BHF d02bhf_proc;
  1811. #else
  1812. extern void __stdcall D02BHF(double *, double *, int32 *, int32 *,
  1813. double *, double *, int32 *, double *,
  1814. void __stdcall (*fcn) (double *, double *, double *),
  1815. double __stdcall (*g) (double *, double *), double *, int32 *);
  1816. #endif
  1817. /* Set up arguments as Lisp Objects */
  1818. argcheck(nargs,8,"Ld02bhf");
  1819. va_start(args,nargs);
  1820. Lxend = va_arg(args, Lisp_Object);
  1821. Ln = va_arg(args, Lisp_Object);
  1822. Lirelab = va_arg(args, Lisp_Object);
  1823. Lhmax = va_arg(args, Lisp_Object);
  1824. Lx = va_arg(args, Lisp_Object);
  1825. Ly = va_arg(args, Lisp_Object);
  1826. Ltol = va_arg(args, Lisp_Object);
  1827. Lifail = va_arg(args, Lisp_Object);
  1828. va_end(args);
  1829. /* Translate arguments into C objects */
  1830. push4(Lxend,Ln,Lirelab,Lhmax);
  1831. push4(Lx,Ly,Ltol,Lifail);
  1832. xend = float_of_number(Lxend);
  1833. pop4(Lifail,Ltol,Ly,Lx);
  1834. pop4(Lhmax,Lirelab,Ln,Lxend);
  1835. errexit();
  1836. push4(Lxend,Ln,Lirelab,Lhmax);
  1837. push4(Lx,Ly,Ltol,Lifail);
  1838. n = thirty_two_bits(Ln);
  1839. pop4(Lifail,Ltol,Ly,Lx);
  1840. pop4(Lhmax,Lirelab,Ln,Lxend);
  1841. errexit();
  1842. push4(Lxend,Ln,Lirelab,Lhmax);
  1843. push4(Lx,Ly,Ltol,Lifail);
  1844. irelab = thirty_two_bits(Lirelab);
  1845. pop4(Lifail,Ltol,Ly,Lx);
  1846. pop4(Lhmax,Lirelab,Ln,Lxend);
  1847. errexit();
  1848. push4(Lxend,Ln,Lirelab,Lhmax);
  1849. push4(Lx,Ly,Ltol,Lifail);
  1850. hmax = float_of_number(Lhmax);
  1851. pop4(Lifail,Ltol,Ly,Lx);
  1852. pop4(Lhmax,Lirelab,Ln,Lxend);
  1853. errexit();
  1854. push4(Lxend,Ln,Lirelab,Lhmax);
  1855. push4(Lx,Ly,Ltol,Lifail);
  1856. x = float_of_number(Lx);
  1857. pop4(Lifail,Ltol,Ly,Lx);
  1858. pop4(Lhmax,Lirelab,Ln,Lxend);
  1859. errexit();
  1860. y = (double *) malloc (n * sizeof(double));
  1861. push4(Lxend,Ln,Lirelab,Lhmax);
  1862. push4(Lx,Ly,Ltol,Lifail);
  1863. mkFortranVectorDouble(y, Ly, n);
  1864. pop4(Lifail,Ltol,Ly,Lx);
  1865. pop4(Lhmax,Lirelab,Ln,Lxend);
  1866. errexit();
  1867. push4(Lxend,Ln,Lirelab,Lhmax);
  1868. push4(Lx,Ly,Ltol,Lifail);
  1869. tol = float_of_number(Ltol);
  1870. pop4(Lifail,Ltol,Ly,Lx);
  1871. pop4(Lhmax,Lirelab,Ln,Lxend);
  1872. errexit();
  1873. push4(Lxend,Ln,Lirelab,Lhmax);
  1874. push4(Lx,Ly,Ltol,Lifail);
  1875. ifail = thirty_two_bits(Lifail);
  1876. pop4(Lifail,Ltol,Ly,Lx);
  1877. pop4(Lhmax,Lirelab,Ln,Lxend);
  1878. errexit();
  1879. push4(Lxend,Ln,Lirelab,Lhmax);
  1880. push4(Lx,Ly,Ltol,Lifail);
  1881. /* Setup workspace arrays etc. */
  1882. w = (double *)malloc(n*7*sizeof(double));
  1883. /* Call NAG routine */
  1884. #ifdef LOADLIB
  1885. free_prevlib ();
  1886. if ( (hLib = LoadLibrary ("nagfad01")) == NULL )
  1887. {
  1888. /* couldn't find DLL -- error handling here */
  1889. ifail = -999;
  1890. }
  1891. else /* OK so far */
  1892. {
  1893. if ( (d02bhf_proc = (PD02BHF) GetProcAddress (hLib, "_D02BHF@44"))
  1894. == NULL )
  1895. {
  1896. /* couldn't find function within DLL -- error handling here */
  1897. ifail = -998;
  1898. }
  1899. else /* have found function in DLL */
  1900. {
  1901. (*d02bhf_proc) (&x, &xend, &n, y, &tol, &irelab, &hmax, &asp7, &asp9,
  1902. w, &ifail);
  1903. }
  1904. }
  1905. currlib = hLib;
  1906. #else
  1907. D02BHF (&x, &xend, &n, y, &tol, &irelab, &hmax, &asp7, &asp9, w, &ifail);
  1908. #endif
  1909. /* Translate return values to CCL */
  1910. /* Copy result */
  1911. Lx = make_boxfloat(x,TYPE_DOUBLE_FLOAT);
  1912. push(Lx);
  1913. Ly = mkFloatVector(y,n,1);
  1914. pop(Lx);
  1915. errexit();
  1916. push2(Lx,Ly);
  1917. Lifail = int2ccl(ifail);
  1918. pop2(Ly,Lx);
  1919. errexit();
  1920. push3(Lx,Ly,Lifail);
  1921. Ltol = make_boxfloat(tol,TYPE_DOUBLE_FLOAT);
  1922. pop3(Lifail,Ly,Lx);
  1923. errexit();
  1924. free (y);
  1925. free (w);
  1926. return Llist(nil,4,Lx,Ly,Lifail,Ltol);
  1927. }
  1928. #else
  1929. {
  1930. return Llist(nil, 0);
  1931. }
  1932. #endif
  1933. Lisp_Object MS_CDECL Ld02cjf(Lisp_Object nil, int nargs, ...)
  1934. #if 0
  1935. { /* FIXME: strings */
  1936. va_list args;
  1937. Lisp_Object Lx, Lxend, Lm, Ln, Ly, Ltol, Lrelabs, Lresult, Lifail;
  1938. double x, xend, *y, tol, *w, *result;
  1939. int32 ifail, m, n;
  1940. fstring1 relabs;
  1941. char srelabs[2];
  1942. extern void __stdcall asp7(double *, double *, double *);
  1943. extern void __stdcall asp8(double *, double *);
  1944. extern double __stdcall asp9(double *, double *);
  1945. #ifdef LOADLIB
  1946. typedef void (__stdcall *PXD02CJ) (double *, double *, int32 *, int32 *,
  1947. double *, void __stdcall (*fcn) (double *, double *, double *),
  1948. double *, fstring1, double *,
  1949. void __stdcall (*out) (double *, double *),
  1950. double __stdcall (*g) (double *, double *), double *, int32 *);
  1951. HINSTANCE hLib;
  1952. PXD02CJ xd02cj_proc;
  1953. #else
  1954. extern void __stdcall XD02CJ(double *, double *, int32 *, int32 *,
  1955. double *, void __stdcall (*fcn) (double *, double *, double *),
  1956. double *, fstring1, double *,
  1957. void __stdcall (*out) (double *, double *),
  1958. double __stdcall (*g) (double *, double *), double *, int32 *);
  1959. #endif
  1960. /* Set up arguments as Lisp Objects */
  1961. argcheck(nargs,8,"Ld02cjf");
  1962. va_start(args,nargs);
  1963. Lxend = va_arg(args, Lisp_Object);
  1964. Lm = va_arg(args, Lisp_Object);
  1965. Ln = va_arg(args, Lisp_Object);
  1966. Ltol = va_arg(args, Lisp_Object);
  1967. Lrelabs = va_arg(args, Lisp_Object);
  1968. Lx = va_arg(args, Lisp_Object);
  1969. Ly = va_arg(args, Lisp_Object);
  1970. Lifail = va_arg(args, Lisp_Object);
  1971. va_end(args);
  1972. /* Translate arguments into C objects */
  1973. push4(Lxend,Lm,Ln,Ltol);
  1974. push4(Lrelabs,Lx,Ly,Lifail);
  1975. xend = float_of_number(Lxend);
  1976. pop4(Lifail,Ly,Lx,Lrelabs);
  1977. pop4(Ltol,Ln,Lm,Lxend);
  1978. errexit();
  1979. push4(Lxend,Lm,Ln,Ltol);
  1980. push4(Lrelabs,Lx,Ly,Lifail);
  1981. m = thirty_two_bits(Lm);
  1982. pop4(Lifail,Ly,Lx,Lrelabs);
  1983. pop4(Ltol,Ln,Lm,Lxend);
  1984. errexit();
  1985. push4(Lxend,Lm,Ln,Ltol);
  1986. push4(Lrelabs,Lx,Ly,Lifail);
  1987. n = thirty_two_bits(Ln);
  1988. pop4(Lifail,Ly,Lx,Lrelabs);
  1989. pop4(Ltol,Ln,Lm,Lxend);
  1990. errexit();
  1991. push4(Lxend,Lm,Ln,Ltol);
  1992. push4(Lrelabs,Lx,Ly,Lifail);
  1993. tol = float_of_number(Ltol);
  1994. pop4(Lifail,Ly,Lx,Lrelabs);
  1995. pop4(Ltol,Ln,Lm,Lxend);
  1996. errexit();
  1997. push4(Lxend,Lm,Ln,Ltol);
  1998. push4(Lrelabs,Lx,Ly,Lifail);
  1999. // strncpy (srelabs, &celt(Lrelabs,0), 1);
  2000. srelabs[0] = celt(Lrelabs,0);
  2001. pop4(Lifail,Ly,Lx,Lrelabs);
  2002. pop4(Ltol,Ln,Lm,Lxend);
  2003. errexit();
  2004. srelabs[1] = '\0';
  2005. relabs.str = srelabs;
  2006. push4(Lxend,Lm,Ln,Ltol);
  2007. push4(Lrelabs,Lx,Ly,Lifail);
  2008. x = float_of_number(Lx);
  2009. pop4(Lifail,Ly,Lx,Lrelabs);
  2010. pop4(Ltol,Ln,Lm,Lxend);
  2011. errexit();
  2012. y = (double *) malloc (n * sizeof(double));
  2013. push4(Lxend,Lm,Ln,Ltol);
  2014. push4(Lrelabs,Lx,Ly,Lifail);
  2015. mkFortranVectorDouble(y, Ly, n);
  2016. pop4(Lifail,Ly,Lx,Lrelabs);
  2017. pop4(Ltol,Ln,Lm,Lxend);
  2018. errexit();
  2019. push4(Lxend,Lm,Ln,Ltol);
  2020. push4(Lrelabs,Lx,Ly,Lifail);
  2021. ifail = thirty_two_bits(Lifail);
  2022. pop4(Lifail,Ly,Lx,Lrelabs);
  2023. pop4(Ltol,Ln,Lm,Lxend);
  2024. errexit();
  2025. relabs.len = 1;
  2026. /* Setup workspace arrays etc. */
  2027. w = (double *)malloc((28+21*n)*sizeof(double));
  2028. result = (double *)malloc(m*n*sizeof(double));
  2029. /* Call NAG routine */
  2030. #ifdef LOADLIB
  2031. free_prevlib ();
  2032. if ( (hLib = LoadLibrary ("nagfadj")) == NULL ) /* FIXME - DLL name? */
  2033. {
  2034. /* couldn't find DLL -- error handling here */
  2035. ifail = -999;
  2036. }
  2037. else /* OK so far */
  2038. {
  2039. if ( (xd02cj_proc = (PXD02CJ) GetProcAddress (hLib, "_XD02CJ@56"))
  2040. == NULL )
  2041. {
  2042. /* couldn't find function within DLL -- error handling here */
  2043. ifail = -998;
  2044. }
  2045. else /* have found function in DLL */
  2046. {
  2047. (*xd02cj_proc) (&x, &xend, &m, &n, y, &asp7, &tol, relabs, result,
  2048. &asp8, &asp9, w, &ifail);
  2049. }
  2050. }
  2051. currlib = hLib;
  2052. #else
  2053. XD02CJ (&x, &xend, &m, &n, y, &asp7, &tol, relabs, result, &asp8, &asp9, w,
  2054. &ifail);
  2055. #endif
  2056. /* Translate return values to CCL */
  2057. /* Copy result */
  2058. Lx = make_boxfloat(x,TYPE_DOUBLE_FLOAT);
  2059. push(Lx);
  2060. Ly = mkFloatVector(y,n,1);
  2061. pop(Lx);
  2062. errexit();
  2063. push2(Lx,Ly);
  2064. Lresult = mkFloatVector(result,m,n); /* FIXME: correct array ordering? */
  2065. pop2(Ly,Lx);
  2066. errexit();
  2067. push3(Lx,Ly,Lresult);
  2068. Lifail = int2ccl(ifail);
  2069. pop3(Lresult,Ly,Lx);
  2070. errexit();
  2071. free (y);
  2072. free (w);
  2073. free (result);
  2074. return Llist(nil,4,Lx,Ly,Lresult,Lifail);
  2075. }
  2076. #else
  2077. {
  2078. return Llist(nil, 0);
  2079. }
  2080. #endif
  2081. Lisp_Object MS_CDECL Ld02ejf(Lisp_Object nil, int nargs, ...)
  2082. #if 0
  2083. { /* FIXME: strings */
  2084. va_list args;
  2085. Lisp_Object Lx, Lxend, Lm, Ln, Ly, Ltol, Lrelabs, Lresult, Lifail, Liw;
  2086. double x, xend, *y, tol, *w, *result;
  2087. int32 ifail, m, n, iw;
  2088. fstring1 relabs;
  2089. char srelabs[2];
  2090. extern void __stdcall asp7(double *, double *, double *);
  2091. extern void __stdcall asp8(double *, double *);
  2092. extern double __stdcall asp9(double *, double *);
  2093. extern void __stdcall asp31(double *, double *, double *);
  2094. #ifdef LOADLIB
  2095. typedef void (__stdcall *PXD02EJ) (double *, double *, int32 *, int32 *,
  2096. double *, void __stdcall (*fcn) (double *, double *, double *),
  2097. void __stdcall (*pederv) (double *, double *, double *), double *,
  2098. fstring1, void __stdcall (*out) (double *, double *),
  2099. double __stdcall (*g) (double *, double *), double *, int32 *,
  2100. double *, int32 *);
  2101. HINSTANCE hLib;
  2102. PXD02EJ xd02ej_proc;
  2103. #else
  2104. extern void __stdcall XD02EJ(double *, double *, int32 *, int32 *,
  2105. double *, void __stdcall (*fcn) (double *, double *, double *),
  2106. void __stdcall (*pederv) (double *, double *, double *), double *,
  2107. fstring1, void __stdcall (*out) (double *, double *),
  2108. double __stdcall (*g) (double *, double *), double *, int32 *,
  2109. double *, int32 *);
  2110. #endif
  2111. /* Set up arguments as Lisp Objects */
  2112. argcheck(nargs,9,"Ld02ejf");
  2113. va_start(args,nargs);
  2114. Lxend = va_arg(args, Lisp_Object);
  2115. Lm = va_arg(args, Lisp_Object);
  2116. Ln = va_arg(args, Lisp_Object);
  2117. Lrelabs = va_arg(args, Lisp_Object);
  2118. Liw = va_arg(args, Lisp_Object);
  2119. Lx = va_arg(args, Lisp_Object);
  2120. Ly = va_arg(args, Lisp_Object);
  2121. Ltol = va_arg(args, Lisp_Object);
  2122. Lifail = va_arg(args, Lisp_Object);
  2123. va_end(args);
  2124. /* Translate arguments into C objects */
  2125. push5(Lxend,Lm,Ln,Lrelabs,Liw);
  2126. push4(Lx,Ly,Ltol,Lifail);
  2127. xend = float_of_number(Lxend);
  2128. pop5(Lifail,Ltol,Ly,Lx,Liw);
  2129. pop4(Lrelabs,Ln,Lm,Lxend);
  2130. errexit();
  2131. push5(Lxend,Lm,Ln,Lrelabs,Liw);
  2132. push4(Lx,Ly,Ltol,Lifail);
  2133. m = thirty_two_bits(Lm);
  2134. pop5(Lifail,Ltol,Ly,Lx,Liw);
  2135. pop4(Lrelabs,Ln,Lm,Lxend);
  2136. errexit();
  2137. push5(Lxend,Lm,Ln,Lrelabs,Liw);
  2138. push4(Lx,Ly,Ltol,Lifail);
  2139. n = thirty_two_bits(Ln);
  2140. pop5(Lifail,Ltol,Ly,Lx,Liw);
  2141. pop4(Lrelabs,Ln,Lm,Lxend);
  2142. errexit();
  2143. push5(Lxend,Lm,Ln,Lrelabs,Liw);
  2144. push4(Lx,Ly,Ltol,Lifail);
  2145. // strncpy (srelabs, &celt(Lrelabs,0), 1);
  2146. srelabs[0] = celt(Lrelabs,0);
  2147. pop5(Lifail,Ltol,Ly,Lx,Liw);
  2148. pop4(Lrelabs,Ln,Lm,Lxend);
  2149. errexit();
  2150. srelabs[1] = '\0';
  2151. relabs.str = srelabs;
  2152. push5(Lxend,Lm,Ln,Lrelabs,Liw);
  2153. push4(Lx,Ly,Ltol,Lifail);
  2154. iw = thirty_two_bits(Liw);
  2155. pop5(Lifail,Ltol,Ly,Lx,Liw);
  2156. pop4(Lrelabs,Ln,Lm,Lxend);
  2157. errexit();
  2158. push5(Lxend,Lm,Ln,Lrelabs,Liw);
  2159. push4(Lx,Ly,Ltol,Lifail);
  2160. x = float_of_number(Lx);
  2161. pop5(Lifail,Ltol,Ly,Lx,Liw);
  2162. pop4(Lrelabs,Ln,Lm,Lxend);
  2163. errexit();
  2164. y = (double *) malloc (n * sizeof(double));
  2165. push5(Lxend,Lm,Ln,Lrelabs,Liw);
  2166. push4(Lx,Ly,Ltol,Lifail);
  2167. mkFortranVectorDouble(y, Ly, n);
  2168. pop5(Lifail,Ltol,Ly,Lx,Liw);
  2169. pop4(Lrelabs,Ln,Lm,Lxend);
  2170. errexit();
  2171. push5(Lxend,Lm,Ln,Lrelabs,Liw);
  2172. push4(Lx,Ly,Ltol,Lifail);
  2173. tol = float_of_number(Ltol);
  2174. pop5(Lifail,Ltol,Ly,Lx,Liw);
  2175. pop4(Lrelabs,Ln,Lm,Lxend);
  2176. errexit();
  2177. push5(Lxend,Lm,Ln,Lrelabs,Liw);
  2178. push4(Lx,Ly,Ltol,Lifail);
  2179. ifail = thirty_two_bits(Lifail);
  2180. pop5(Lifail,Ltol,Ly,Lx,Liw);
  2181. pop4(Lrelabs,Ln,Lm,Lxend);
  2182. errexit();
  2183. push5(Lxend,Lm,Ln,Lrelabs,Liw);
  2184. push4(Lx,Ly,Ltol,Lifail);
  2185. relabs.len = 1;
  2186. /* Setup workspace arrays etc. */
  2187. w = (double *)malloc(iw*sizeof(double));
  2188. result = (double *)malloc(m*n*sizeof(double));
  2189. /* Call NAG routine */
  2190. #ifdef LOADLIB
  2191. free_prevlib ();
  2192. if ( (hLib = LoadLibrary ("nagfadj")) == NULL ) /* FIXME - DLL name? */
  2193. {
  2194. /* couldn't find DLL -- error handling here */
  2195. ifail = -999;
  2196. }
  2197. else /* OK so far */
  2198. {
  2199. if ( (xd02ej_proc = (PXD02EJ) GetProcAddress (hLib, "_XD02EJ@64"))
  2200. == NULL )
  2201. {
  2202. /* couldn't find function within DLL -- error handling here */
  2203. ifail = -998;
  2204. }
  2205. else /* have found function in DLL */
  2206. {
  2207. (*xd02ej_proc) (&x, &xend, &m, &n, y, &asp7, &asp31, &tol, relabs,
  2208. &asp8, &asp9, w, &iw, result, &ifail);
  2209. }
  2210. }
  2211. currlib = hLib;
  2212. #else
  2213. XD02EJ (&x, &xend, &m, &n, y, &asp7, &asp31, &tol, relabs, &asp8, &asp9, w,
  2214. &iw, result, &ifail);
  2215. #endif
  2216. /* Translate return values to CCL */
  2217. /* Copy result */
  2218. Lx = make_boxfloat(x,TYPE_DOUBLE_FLOAT);
  2219. push(Lx);
  2220. Ly = mkFloatVector(y,n,1);
  2221. pop(Lx);
  2222. errexit();
  2223. push2(Lx,Ly);
  2224. Lresult = mkFloatVector(result,m,n); /* FIXME: correct array ordering? */
  2225. pop2(Ly,Lx);
  2226. errexit();
  2227. push3(Lx,Ly,Lresult);
  2228. Lifail = int2ccl(ifail);
  2229. pop3(Lresult,Ly,Lx);
  2230. errexit();
  2231. push4(Lx,Ly,Lresult,Lifail);
  2232. Ltol = make_boxfloat(tol,TYPE_DOUBLE_FLOAT);
  2233. pop4(Lifail,Lresult,Ly,Lx);
  2234. errexit();
  2235. free (y);
  2236. free (w);
  2237. free (result);
  2238. return Llist(nil,5,Lx,Ly,Lresult,Lifail,Ltol);
  2239. }
  2240. #else
  2241. {
  2242. return Llist(nil, 0);
  2243. }
  2244. #endif
  2245. /* ******************* GOT TO HERE ********************* */
  2246. Lisp_Object MS_CDECL Ld02gaf(Lisp_Object nil, int nargs, ...)
  2247. {
  2248. return Llist(nil, 0);
  2249. }
  2250. Lisp_Object MS_CDECL Ld02gbf(Lisp_Object nil, int nargs, ...)
  2251. {
  2252. return Llist(nil, 0);
  2253. }
  2254. Lisp_Object MS_CDECL Ld02kef(Lisp_Object nil, int nargs, ...)
  2255. {
  2256. return Llist(nil, 0);
  2257. }
  2258. Lisp_Object MS_CDECL Ld02raf(Lisp_Object nil, int nargs, ...)
  2259. {
  2260. return Llist(nil, 0);
  2261. }
  2262. Lisp_Object MS_CDECL Ld03edf(Lisp_Object nil, int nargs, ...)
  2263. {
  2264. return Llist(nil, 0);
  2265. }
  2266. Lisp_Object MS_CDECL Ld03eef(Lisp_Object nil, int nargs, ...)
  2267. {
  2268. return Llist(nil, 0);
  2269. }
  2270. Lisp_Object MS_CDECL Ld03faf(Lisp_Object nil, int nargs, ...)
  2271. {
  2272. return Llist(nil, 0);
  2273. }