externs.h 56 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337
  1. /* externs.h Copyright (C) Codemist 1989-2002 */
  2. /*
  3. * Main batch of extern declarations.
  4. *
  5. */
  6. /*
  7. * This code may be used and modified, and redistributed in binary
  8. * or source form, subject to the "CCL Public License", which should
  9. * accompany it. This license is a variant on the BSD license, and thus
  10. * permits use of code derived from this in either open and commercial
  11. * projects: but it does require that updates to this code be made
  12. * available back to the originators of the package.
  13. * Before merging other code in with this or linking this code
  14. * with other packages or libraries please check that the license terms
  15. * of the other material are compatible with those of this.
  16. */
  17. /* Signature: 1241cdfd 10-Oct-2002 */
  18. #ifndef header_externs_h
  19. #define header_externs_h 1
  20. #ifndef header_machine_h
  21. #include "machine.h"
  22. #endif
  23. #ifndef header_tags_h
  24. #include "tags.h"
  25. #endif
  26. #ifdef __cplusplus
  27. extern "C" {
  28. #endif
  29. #ifdef USE_MPI
  30. #include "mpi.h"
  31. extern int32 mpi_rank,mpi_size;
  32. #endif
  33. #ifdef MEMORY_TRACE
  34. #define my_pop() (memory_reference((int32)stack), (*stack--))
  35. #else
  36. #define my_pop() (*stack--)
  37. #endif
  38. extern void **pages,
  39. **heap_pages, **vheap_pages,
  40. **bps_pages, **native_pages;
  41. #ifndef NO_COPYING_GC
  42. extern void **new_heap_pages, **new_vheap_pages,
  43. **new_bps_pages, **new_native_pages;
  44. #endif
  45. extern int32 pages_count,
  46. heap_pages_count, vheap_pages_count,
  47. bps_pages_count, native_pages_count;
  48. #ifndef NO_COPYING_GC
  49. extern int32 new_heap_pages_count, new_vheap_pages_count,
  50. new_bps_pages_count, new_native_pages_count;
  51. #endif
  52. extern int native_pages_changed;
  53. extern int32 native_fringe;
  54. extern Lisp_Object *nilsegment, *stacksegment;
  55. extern Lisp_Object *stackbase;
  56. extern int32 stack_segsize; /* measured in units of one CSL page */
  57. extern DLLexport Lisp_Object *C_stack;
  58. #define stack C_stack
  59. #ifdef MEMORY_TRACE
  60. #define push(a) do { \
  61. *++stack = (a); \
  62. memory_reference((intxx)stack); } while (0)
  63. /* push2 etc are just like push, but grouped together */
  64. #define push2(a,b) do { \
  65. *++stack = (a); \
  66. memory_reference((intxx)stack); \
  67. *++stack = (b); \
  68. memory_reference((intxx)stack); } while (0)
  69. #define push3(a,b,c) do { \
  70. *++stack = (a); \
  71. memory_reference((intxx)stack); \
  72. *++stack = (b); \
  73. memory_reference((intxx)stack); \
  74. *++stack = (c); \
  75. memory_reference((intxx)stack); } while (0)
  76. #define push4(a,b,c,d) do { \
  77. *++stack = (a); \
  78. memory_reference((intxx)stack); \
  79. *++stack = (b); \
  80. memory_reference((intxx)stack); \
  81. *++stack = (c); \
  82. memory_reference((intxx)stack); \
  83. *++stack = (d); \
  84. memory_reference((intxx)stack); } while (0)
  85. #define push5(a,b,c,d,e)do { \
  86. *++stack = (a); \
  87. memory_reference((intxx)stack); \
  88. *++stack = (b); \
  89. memory_reference((intxx)stack); \
  90. *++stack = (c); \
  91. memory_reference((intxx)stack); \
  92. *++stack = (d); \
  93. memory_reference((intxx)stack); \
  94. *++stack = (e); \
  95. memory_reference((intxx)stack); } while (0)
  96. #define push6(a,b,c,d,e,f) do {push3(a,b,c); push3(d,e,f); } while (0)
  97. #define pop(a) { memory_reference((intxx)stack); (a) = *stack--; }
  98. #define pop2(a,b) { memory_reference((intxx)stack); (a) = *stack--; memory_reference((intxx)stack); (b) = *stack--; }
  99. #define pop3(a,b,c) { memory_reference((intxx)stack); (a) = *stack--; memory_reference((intxx)stack); (b) = *stack--; memory_reference((intxx)stack); (c) = *stack--; }
  100. #define pop4(a,b,c,d) { memory_reference((intxx)stack); (a) = *stack--; memory_reference((intxx)stack); (b) = *stack--; memory_reference((intxx)stack); (c) = *stack--; \
  101. memory_reference((intxx)stack); (d) = *stack--; }
  102. #define pop5(a,b,c,d,e) { memory_reference((intxx)stack); (a) = *stack--; memory_reference((intxx)stack); (b) = *stack--; memory_reference((intxx)stack); (c) = *stack--; \
  103. memory_reference((intxx)stack); (d) = *stack--; memory_reference((intxx)stack); (e) = *stack--; }
  104. #define pop6(a,b,c,d,e,f) {pop3(a,b,c); pop3(d,e,f)}
  105. #define popv(n) stack -= (n);
  106. #else /* MEMORY_TRACE */
  107. #define push(a) { *++stack = (a); }
  108. /* push2 etc are just like push, but grouped together */
  109. #ifdef USE_AUTOINDEX
  110. /*
  111. * Having inspected the code generated by one of the C compilers that
  112. * is frequently used with this Lisp it emerges that the multiple
  113. * push operations might sometimes be much better treated with
  114. * the increment parts explicitly consolidated into one. To leave
  115. * scope for fine-tuning to cmpiler and machine architecture the
  116. * USE_AUTOINDEX macro could be pre-defined and I suspect that on
  117. * VAX and ARM computers it may make good sense.
  118. */
  119. #define push2(a,b) { *++stack = (a); *++stack = (b); }
  120. #define push3(a,b,c) { *++stack = (a); *++stack = (b); *++stack = (c); }
  121. #define push4(a,b,c,d) { *++stack = (a); *++stack = (b); *++stack = (c); \
  122. *++stack = (d); }
  123. #define push5(a,b,c,d,e){ *++stack = (a); *++stack = (b); *++stack = (c); \
  124. *++stack = (d); *++stack = (e); }
  125. #define push6(a,b,c,d,e,f) {push3(a,b,c); push3(d,e,f)}
  126. #define pop(a) { (a) = *stack--; }
  127. #define pop2(a,b) { (a) = *stack--; (b) = *stack--; }
  128. #define pop3(a,b,c) { (a) = *stack--; (b) = *stack--; (c) = *stack--; }
  129. #define pop4(a,b,c,d) { (a) = *stack--; (b) = *stack--; (c) = *stack--; \
  130. (d) = *stack--; }
  131. #define pop5(a,b,c,d,e) { (a) = *stack--; (b) = *stack--; (c) = *stack--; \
  132. (d) = *stack--; (e) = *stack--; }
  133. #define pop6(a,b,c,d,e,f) {pop3(a,b,c); pop3(d,e,f)}
  134. #define popv(n) stack -= (n);
  135. #else /* USE_AUTOINDEX */
  136. #define push2(a,b) { stack[1] = (a); stack[2] = (b); stack += 2; }
  137. #define push3(a,b,c) { stack[1] = (a); stack[2] = (b); stack[3] = (c); \
  138. stack += 3; }
  139. #define push4(a,b,c,d) { stack[1] = (a); stack[2] = (b); stack[3] = (c); \
  140. stack[4] = (d); stack += 4; }
  141. #define push5(a,b,c,d,e){ stack[1] = (a); stack[2] = (b); stack[3] = (c); \
  142. stack[4] = (d); stack[5] = (e); stack += 5; }
  143. #define push6(a,b,c,d,e,f) { \
  144. stack[1] = (a); stack[2] = (b); stack[3] = (c); \
  145. stack[4] = (d); stack[5] = (e); stack[6] = (f); \
  146. stack += 6; }
  147. #define pop(a) { (a) = *stack--; }
  148. #define pop2(a,b) { stack -= 2; (a) = stack[2]; (b) = stack[1]; }
  149. #define pop3(a,b,c) { stack -= 3; (a) = stack[3]; (b) = stack[2]; \
  150. (c) = stack[1]; }
  151. #define pop4(a,b,c,d) { stack -= 4; (a) = stack[4]; (b) = stack[3]; \
  152. (c) = stack[2]; (d) = stack[1]; }
  153. #define pop5(a,b,c,d,e) { stack -= 5; (a) = stack[5]; (b) = stack[4]; \
  154. (c) = stack[3]; (d) = stack[2]; (e) = stack[1]; }
  155. #define pop6(a,b,c,d,e, f) { stack -= 6; \
  156. (a) = stack[6]; (b) = stack[5]; (c) = stack[4]; \
  157. (d) = stack[3]; (e) = stack[2]; (f) = stack[1]; }
  158. #define popv(n) stack -= (n);
  159. #endif /* USE_AUTOINDEX */
  160. #endif /* MEMORY_TRACE*/
  161. #define errexit() { nil = C_nil; if (exception_pending()) return nil; }
  162. #define errexitn(n) { nil = C_nil; \
  163. if (exception_pending()) { popv(n); return nil; } }
  164. #define errexitv() { nil = C_nil; if (exception_pending()) return; }
  165. #define errexitvn(n) { nil = C_nil; \
  166. if (exception_pending()) { popv(n); return; } }
  167. #define GC_USER_SOFT 0
  168. #define GC_USER_HARD 1
  169. #define GC_STACK 2
  170. #define GC_CONS 3
  171. #define GC_VEC 4
  172. #define GC_BPS 5
  173. #define GC_PRESERVE 6
  174. #define GC_NATIVE 7
  175. #ifdef CHECK_STACK
  176. #ifdef SOFTWARE_TICKS
  177. extern DLLexport int32 countdown;
  178. #ifdef INITIAL_SOFTWARE_TICKS
  179. extern DLLexport int32 software_ticks;
  180. #endif
  181. #define stackcheck0(k) \
  182. if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \
  183. if ((--countdown < 0 && deal_with_tick()) || \
  184. stack >= stacklimit) \
  185. { reclaim(nil, "stack", GC_STACK, 0); \
  186. nil = C_nil; \
  187. if (exception_pending()) { popv(k); return nil; } \
  188. }
  189. #define stackcheck1(k, a1) \
  190. if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \
  191. if ((--countdown < 0 && deal_with_tick()) || \
  192. stack >= stacklimit) \
  193. { a1 = reclaim(a1, "stack", GC_STACK, 0); \
  194. nil = C_nil; \
  195. if (exception_pending()) { popv(k); return nil; } \
  196. }
  197. #define stackcheck2(k, a1, a2) \
  198. if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \
  199. if ((--countdown < 0 && deal_with_tick()) || \
  200. stack >= stacklimit) \
  201. { push(a2); \
  202. a1 = reclaim(a1, "stack", GC_STACK, 0); pop(a2); \
  203. nil = C_nil; \
  204. if (exception_pending()) { popv(k); return nil; } \
  205. }
  206. #define stackcheck3(k, a1, a2, a3) \
  207. if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \
  208. if ((--countdown < 0 && deal_with_tick()) || \
  209. stack >= stacklimit) \
  210. { push2(a2, a3); \
  211. a1 = reclaim(a1, "stack", GC_STACK, 0); \
  212. pop2(a3, a2); \
  213. nil = C_nil; \
  214. if (exception_pending()) { popv(k); return nil; } \
  215. }
  216. #define stackcheck4(k, a1, a2, a3, a4) \
  217. if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \
  218. if ((--countdown < 0 && deal_with_tick()) || \
  219. stack >= stacklimit) \
  220. { push3(a2, a3, a4); \
  221. a1 = reclaim(a1, "stack", GC_STACK, 0); \
  222. pop3(a4, a3, a2); \
  223. nil = C_nil; \
  224. if (exception_pending()) { popv(k); return nil; } \
  225. }
  226. #else /* SOFTWARE_TICKS */
  227. #define stackcheck0(k) \
  228. if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \
  229. if (stack >= stacklimit) \
  230. { reclaim(nil, "stack", GC_STACK, 0); \
  231. nil = C_nil; \
  232. if (exception_pending()) { popv(k); return nil; } \
  233. }
  234. #define stackcheck1(k, a1) \
  235. if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \
  236. if (stack >= stacklimit) \
  237. { a1 = reclaim(a1, "stack", GC_STACK, 0); \
  238. nil = C_nil; \
  239. if (exception_pending()) { popv(k); return nil; } \
  240. }
  241. #define stackcheck2(k, a1, a2) \
  242. if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \
  243. if (stack >= stacklimit) \
  244. { push(a2); \
  245. a1 = reclaim(a1, "stack", GC_STACK, 0); pop(a2); \
  246. nil = C_nil; \
  247. if (exception_pending()) { popv(k); return nil; } \
  248. }
  249. #define stackcheck3(k, a1, a2, a3) \
  250. if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \
  251. if (stack >= stacklimit) \
  252. { push2(a2, a3); \
  253. a1 = reclaim(a1, "stack", GC_STACK, 0); \
  254. pop2(a3, a2); \
  255. nil = C_nil; \
  256. if (exception_pending()) { popv(k); return nil; } \
  257. }
  258. #define stackcheck4(k, a1, a2, a3, a4) \
  259. if (check_stack(__FILE__,__LINE__)) return aerror("stack overflow"); \
  260. if (stack >= stacklimit) \
  261. { push3(a2, a3, a4); \
  262. a1 = reclaim(a1, "stack", GC_STACK, 0); \
  263. pop3(a4, a3, a2); \
  264. nil = C_nil; \
  265. if (exception_pending()) { popv(k); return nil; } \
  266. }
  267. #endif /* SOFTWARE_TICKS */
  268. #else /* CHECK_STACK */
  269. #ifdef SOFTWARE_TICKS
  270. extern DLLexport int32 countdown;
  271. #ifdef INITIAL_SOFTWARE_TICKS
  272. extern DLLexport int32 software_ticks;
  273. #endif
  274. #define stackcheck0(k) \
  275. if ((--countdown < 0 && deal_with_tick()) || \
  276. stack >= stacklimit) \
  277. { reclaim(nil, "stack", GC_STACK, 0); \
  278. nil = C_nil; \
  279. if (exception_pending()) { popv(k); return nil; } \
  280. }
  281. #define stackcheck1(k, a1) \
  282. if ((--countdown < 0 && deal_with_tick()) || \
  283. stack >= stacklimit) \
  284. { a1 = reclaim(a1, "stack", GC_STACK, 0); \
  285. nil = C_nil; \
  286. if (exception_pending()) { popv(k); return nil; } \
  287. }
  288. #define stackcheck2(k, a1, a2) \
  289. if ((--countdown < 0 && deal_with_tick()) || \
  290. stack >= stacklimit) \
  291. { push(a2); \
  292. a1 = reclaim(a1, "stack", GC_STACK, 0); pop(a2); \
  293. nil = C_nil; \
  294. if (exception_pending()) { popv(k); return nil; } \
  295. }
  296. #define stackcheck3(k, a1, a2, a3) \
  297. if ((--countdown < 0 && deal_with_tick()) || \
  298. stack >= stacklimit) \
  299. { push2(a2, a3); \
  300. a1 = reclaim(a1, "stack", GC_STACK, 0); \
  301. pop2(a3, a2); \
  302. nil = C_nil; \
  303. if (exception_pending()) { popv(k); return nil; } \
  304. }
  305. #define stackcheck4(k, a1, a2, a3, a4) \
  306. if ((--countdown < 0 && deal_with_tick()) || \
  307. stack >= stacklimit) \
  308. { push3(a2, a3, a4); \
  309. a1 = reclaim(a1, "stack", GC_STACK, 0); \
  310. pop3(a4, a3, a2); \
  311. nil = C_nil; \
  312. if (exception_pending()) { popv(k); return nil; } \
  313. }
  314. #else /* SOFTWARE_TICKS */
  315. #define stackcheck0(k) \
  316. if (stack >= stacklimit) \
  317. { reclaim(nil, "stack", GC_STACK, 0); \
  318. nil = C_nil; \
  319. if (exception_pending()) { popv(k); return nil; } \
  320. }
  321. #define stackcheck1(k, a1) \
  322. if (stack >= stacklimit) \
  323. { a1 = reclaim(a1, "stack", GC_STACK, 0); \
  324. nil = C_nil; \
  325. if (exception_pending()) { popv(k); return nil; } \
  326. }
  327. #define stackcheck2(k, a1, a2) \
  328. if (stack >= stacklimit) \
  329. { push(a2); \
  330. a1 = reclaim(a1, "stack", GC_STACK, 0); pop(a2); \
  331. nil = C_nil; \
  332. if (exception_pending()) { popv(k); return nil; } \
  333. }
  334. #define stackcheck3(k, a1, a2, a3) \
  335. if (stack >= stacklimit) \
  336. { push2(a2, a3); \
  337. a1 = reclaim(a1, "stack", GC_STACK, 0); \
  338. pop2(a3, a2); \
  339. nil = C_nil; \
  340. if (exception_pending()) { popv(k); return nil; } \
  341. }
  342. #define stackcheck4(k, a1, a2, a3, a4) \
  343. if (stack >= stacklimit) \
  344. { push3(a2, a3, a4); \
  345. a1 = reclaim(a1, "stack", GC_STACK, 0); \
  346. pop3(a4, a3, a2); \
  347. nil = C_nil; \
  348. if (exception_pending()) { popv(k); return nil; } \
  349. }
  350. #endif /* SOFTWARE_TICKS */
  351. #endif /* CHECK_STACK */
  352. /*
  353. * As well as being used to point directly to the major Lisp item NIL,
  354. * this register is used as a base for a table of other critically
  355. * important other Lisp values. Offsets for at least some of these are
  356. * defined here.
  357. * I also need a proper C external variable holding the value of NIL since
  358. * when called from the C library (e.g. in a signal handler) the global
  359. * register variable will not be available!
  360. */
  361. extern DLLexport Lisp_Object C_nil;
  362. /*
  363. * In COMMON mode the symbol-head for NIL uses the first few offsets
  364. * from NIL here, so I start storing system variables at offset 12 so
  365. * that even if at some stage I expand the size of all identifiers from the
  366. * present state I will be safe.
  367. */
  368. #define first_nil_offset 50 /* GC collector marks from here up */
  369. /*
  370. * A vector of 50 words is used by the interpreter when preparing args
  371. * for functions and when handling multiple values.
  372. */
  373. #define work_0_offset 200
  374. /* Garbage collector marks up to but not including last_nil_offset */
  375. #define last_nil_offset 251
  376. /*
  377. * NIL_SEGMENT_SIZE must be over-large by enough to allow for
  378. * space lost while rounding nil up to be a multiple of 8. Also in the
  379. * Common Lisp case I need to give myself a spare word BEFORE the place
  380. * where C_nil points.
  381. */
  382. #define NIL_SEGMENT_SIZE (last_nil_offset*sizeof(Lisp_Object) + 32)
  383. /*
  384. * I give myself a margin of SPARE bytes at the end of a page so that I can
  385. * always CONS that amount (even without a garbage collection check) and not
  386. * corrupt anything. The main use for this is that sometimes I need to
  387. * convert a set of multiple values or of arguments from values on the
  388. * (C-) stack or wherever va_arg() can find them into a list structure, and
  389. * to avoid horrible potential problems with a garbage collection spotting]
  390. * an exception (notably a ^C interrupt), running arbitrary code in an
  391. * exception ghandler and then continuing, I need to cons those things up
  392. * without any possible GC. The function cons_no_gc does that, and
  393. * I should then call cons_gc_test() afterwards to regularise the situation.
  394. * 512 bytes here leaves room for 64 conses, and I support at most 50
  395. * (multiple-) values so I hope this is safe.
  396. */
  397. #define SPARE 512
  398. /*
  399. * I want my table of addresses here to be 8-byte aligned on 64-bit
  400. * machines...
  401. */
  402. #ifdef ADDRESS_64
  403. #ifdef COMMON
  404. #define BASE ((Lisp_Object *)nil)
  405. #else
  406. #define BASE ((Lisp_Object *)(nil+4))
  407. #endif
  408. #else
  409. #define BASE ((Lisp_Object *)nil)
  410. #endif
  411. #ifdef NILSEG_EXTERNS
  412. /*
  413. * One some computers (ones with plenty of registers, and where the
  414. * main addressing mode is register-indexed, and where optimising
  415. * an compiler can keep variables in registers all the time, it will
  416. * be most efficient to put major system variables addressed as offsets
  417. * from NIL, where I expect to keep nil in a register variable pretty
  418. * well always. On other machines (notable the Intel 80286) that policy
  419. * gives pretty disasterous code, and the use of direct simple external
  420. * variables will win. In PRESERVE and RESTORE I will have to copy
  421. * all the separate external variables into a compact block for
  422. * transfer to and from files. Actually on many (most?) machines the
  423. * choice of whether this option should be enabled or not will be pretty
  424. * marginal and should really be sorted out by building once with
  425. * NILSEG_EXTERNS and once without, and comparing the performance of the
  426. * two resulting systems.
  427. */
  428. #define nil_as_base
  429. extern unsigned32 byteflip;
  430. extern Lisp_Object codefringe;
  431. extern Lisp_Object volatile codelimit;
  432. extern Lisp_Object * volatile stacklimit;
  433. extern Lisp_Object fringe;
  434. extern Lisp_Object volatile heaplimit;
  435. extern Lisp_Object volatile vheaplimit;
  436. extern Lisp_Object vfringe;
  437. extern int32 nwork;
  438. extern int32 exit_reason;
  439. extern DLLexport int32 exit_count;
  440. extern unsigned32 gensym_ser, print_precision, miscflags;
  441. extern int32 current_modulus, fastget_size, package_bits;
  442. extern DLLexport Lisp_Object lisp_true, lambda, funarg, unset_var, opt_key, rest_key;
  443. extern DLLexport Lisp_Object quote_symbol, function_symbol, comma_symbol;
  444. extern DLLexport Lisp_Object comma_at_symbol, cons_symbol, eval_symbol;
  445. extern DLLexport Lisp_Object work_symbol, evalhook, applyhook, macroexpand_hook;
  446. extern DLLexport Lisp_Object append_symbol, exit_tag, exit_value, catch_tags;
  447. extern DLLexport Lisp_Object current_package, startfn;
  448. extern DLLexport Lisp_Object gensym_base, string_char_sym, boffo;
  449. extern DLLexport Lisp_Object err_table;
  450. extern DLLexport Lisp_Object progn_symbol;
  451. extern DLLexport Lisp_Object lisp_work_stream, charvec, raise_symbol, lower_symbol;
  452. extern DLLexport Lisp_Object echo_symbol, codevec, litvec, supervisor, B_reg;
  453. extern DLLexport Lisp_Object savedef, comp_symbol, compiler_symbol, faslvec;
  454. extern DLLexport Lisp_Object tracedfn, lisp_terminal_io;
  455. extern DLLexport Lisp_Object lisp_standard_output, lisp_standard_input, lisp_error_output;
  456. extern DLLexport Lisp_Object lisp_trace_output, lisp_debug_io, lisp_query_io;
  457. extern DLLexport Lisp_Object prompt_thing, faslgensyms;
  458. extern DLLexport Lisp_Object prinl_symbol, emsg_star, redef_msg;
  459. extern DLLexport Lisp_Object expr_symbol, fexpr_symbol, macro_symbol;
  460. extern DLLexport Lisp_Object cl_symbols, active_stream, current_module;
  461. extern DLLexport Lisp_Object features_symbol, lisp_package;
  462. extern DLLexport Lisp_Object sys_hash_table, help_index, cfunarg, lex_words;
  463. extern DLLexport Lisp_Object get_counts, fastget_names, input_libraries;
  464. extern DLLexport Lisp_Object output_library, current_file, break_function;
  465. extern DLLexport Lisp_Object standard_output, standard_input, debug_io;
  466. extern DLLexport Lisp_Object error_output, query_io, terminal_io;
  467. extern DLLexport Lisp_Object trace_output, fasl_stream;
  468. extern DLLexport Lisp_Object native_code, native_symbol, traceprint_symbol;
  469. extern DLLexport Lisp_Object loadsource_symbol;
  470. extern DLLexport Lisp_Object hankaku_symbol;
  471. #ifdef COMMON
  472. extern DLLexport Lisp_Object keyword_package;
  473. extern DLLexport Lisp_Object all_packages, package_symbol, internal_symbol;
  474. extern DLLexport Lisp_Object external_symbol, inherited_symbol;
  475. extern DLLexport Lisp_Object key_key, allow_other_keys, aux_key;
  476. extern DLLexport Lisp_Object format_symbol;
  477. extern DLLexport Lisp_Object expand_def_symbol, allow_key_key, declare_symbol;
  478. extern DLLexport Lisp_Object special_symbol;
  479. #endif
  480. #ifdef OPENMATH
  481. extern DLLexport Lisp_Object MS_CDECL om_openFileDev(Lisp_Object env, int nargs, ...);
  482. extern DLLexport Lisp_Object om_openStringDev(Lisp_Object nil, Lisp_Object lstr, Lisp_Object lenc);
  483. extern DLLexport Lisp_Object om_closeDev(Lisp_Object env, Lisp_Object dev);
  484. extern DLLexport Lisp_Object om_setDevEncoding(Lisp_Object nil, Lisp_Object ldev, Lisp_Object lenc);
  485. extern DLLexport Lisp_Object om_makeConn(Lisp_Object nil, Lisp_Object ltimeout);
  486. extern DLLexport Lisp_Object om_closeConn(Lisp_Object nil, Lisp_Object lconn);
  487. extern DLLexport Lisp_Object om_getConnInDevice(Lisp_Object nil, Lisp_Object lconn);
  488. extern DLLexport Lisp_Object om_getConnOutDevice(Lisp_Object nil, Lisp_Object lconn);
  489. extern DLLexport Lisp_Object MS_CDECL om_connectTCP(Lisp_Object nil, int nargs, ...);
  490. extern DLLexport Lisp_Object om_bindTCP(Lisp_Object nil, Lisp_Object lconn, Lisp_Object lport);
  491. extern DLLexport Lisp_Object om_putApp(Lisp_Object nil, Lisp_Object ldev);
  492. extern DLLexport Lisp_Object om_putEndApp(Lisp_Object nil, Lisp_Object ldev);
  493. extern DLLexport Lisp_Object om_putAtp(Lisp_Object nil, Lisp_Object ldev);
  494. extern DLLexport Lisp_Object om_putEndAtp(Lisp_Object nil, Lisp_Object ldev);
  495. extern DLLexport Lisp_Object om_putAttr(Lisp_Object nil, Lisp_Object ldev);
  496. extern DLLexport Lisp_Object om_putEndAttr(Lisp_Object nil, Lisp_Object ldev);
  497. extern DLLexport Lisp_Object om_putBind(Lisp_Object nil, Lisp_Object ldev);
  498. extern DLLexport Lisp_Object om_putEndBind(Lisp_Object nil, Lisp_Object ldev);
  499. extern DLLexport Lisp_Object om_putBVar(Lisp_Object nil, Lisp_Object ldev);
  500. extern DLLexport Lisp_Object om_putEndBVar(Lisp_Object nil, Lisp_Object ldev);
  501. extern DLLexport Lisp_Object om_putError(Lisp_Object nil, Lisp_Object ldev);
  502. extern DLLexport Lisp_Object om_putEndError(Lisp_Object nil, Lisp_Object ldev);
  503. extern DLLexport Lisp_Object om_putObject(Lisp_Object nil, Lisp_Object ldev);
  504. extern DLLexport Lisp_Object om_putEndObject(Lisp_Object nil, Lisp_Object ldev);
  505. extern DLLexport Lisp_Object om_putInt(Lisp_Object nil, Lisp_Object ldev, Lisp_Object val);
  506. extern DLLexport Lisp_Object om_putFloat(Lisp_Object nil, Lisp_Object ldev, Lisp_Object val);
  507. extern DLLexport Lisp_Object om_putByteArray(Lisp_Object nil, Lisp_Object ldev, Lisp_Object val);
  508. extern DLLexport Lisp_Object om_putVar(Lisp_Object nil, Lisp_Object ldev, Lisp_Object val);
  509. extern DLLexport Lisp_Object om_putString(Lisp_Object nil, Lisp_Object ldev, Lisp_Object val);
  510. extern DLLexport Lisp_Object om_putSymbol(Lisp_Object nil, Lisp_Object ldev, Lisp_Object val);
  511. extern DLLexport Lisp_Object MS_CDECL om_putSymbol2(Lisp_Object nil, int nargs, ...);
  512. extern DLLexport Lisp_Object om_getApp(Lisp_Object nil, Lisp_Object ldev);
  513. extern DLLexport Lisp_Object om_getEndApp(Lisp_Object nil, Lisp_Object ldev);
  514. extern DLLexport Lisp_Object om_getAtp(Lisp_Object nil, Lisp_Object ldev);
  515. extern DLLexport Lisp_Object om_getEndAtp(Lisp_Object nil, Lisp_Object ldev);
  516. extern DLLexport Lisp_Object om_getAttr(Lisp_Object nil, Lisp_Object ldev);
  517. extern DLLexport Lisp_Object om_getEndAttr(Lisp_Object nil, Lisp_Object ldev);
  518. extern DLLexport Lisp_Object om_getBind(Lisp_Object nil, Lisp_Object ldev);
  519. extern DLLexport Lisp_Object om_getEndBind(Lisp_Object nil, Lisp_Object ldev);
  520. extern DLLexport Lisp_Object om_getBVar(Lisp_Object nil, Lisp_Object ldev);
  521. extern DLLexport Lisp_Object om_getEndBVar(Lisp_Object nil, Lisp_Object ldev);
  522. extern DLLexport Lisp_Object om_getError(Lisp_Object nil, Lisp_Object ldev);
  523. extern DLLexport Lisp_Object om_getEndError(Lisp_Object nil, Lisp_Object ldev);
  524. extern DLLexport Lisp_Object om_getObject(Lisp_Object nil, Lisp_Object ldev);
  525. extern DLLexport Lisp_Object om_getEndObject(Lisp_Object nil, Lisp_Object ldev);
  526. extern DLLexport Lisp_Object om_getInt(Lisp_Object nil, Lisp_Object ldev);
  527. extern DLLexport Lisp_Object om_getFloat(Lisp_Object nil, Lisp_Object ldev);
  528. extern DLLexport Lisp_Object om_getByteArray(Lisp_Object nil, Lisp_Object ldev);
  529. extern DLLexport Lisp_Object om_getVar(Lisp_Object nil, Lisp_Object ldev);
  530. extern DLLexport Lisp_Object om_getString(Lisp_Object nil, Lisp_Object ldev);
  531. extern DLLexport Lisp_Object om_getSymbol(Lisp_Object nil, Lisp_Object ldev);
  532. extern DLLexport Lisp_Object om_getType(Lisp_Object nil, Lisp_Object ldev);
  533. extern DLLexport Lisp_Object om_stringToStringPtr(Lisp_Object nil, Lisp_Object lstr);
  534. extern DLLexport Lisp_Object om_stringPtrToString(Lisp_Object nil, Lisp_Object lpstr);
  535. extern DLLexport Lisp_Object om_read(Lisp_Object nil, Lisp_Object dev);
  536. extern DLLexport Lisp_Object om_supportsCD(Lisp_Object nil, Lisp_Object lcd);
  537. extern DLLexport Lisp_Object om_supportsSymbol(Lisp_Object nil, Lisp_Object lcd, Lisp_Object lsym);
  538. extern DLLexport Lisp_Object MS_CDECL om_listCDs(Lisp_Object nil, int nargs, ...);
  539. extern DLLexport Lisp_Object om_listSymbols(Lisp_Object nil, Lisp_Object lcd);
  540. extern DLLexport Lisp_Object om_whichCDs(Lisp_Object nil, Lisp_Object lsym);
  541. #endif
  542. extern Lisp_Object workbase[51];
  543. extern DLLexport Lisp_Object user_base_0, user_base_1, user_base_2;
  544. extern DLLexport Lisp_Object user_base_3, user_base_4, user_base_5;
  545. extern DLLexport Lisp_Object user_base_6, user_base_7, user_base_8;
  546. extern DLLexport Lisp_Object user_base_9;
  547. #define work_0 workbase[0]
  548. #define work_1 workbase[1]
  549. #define mv_1 workbase[1]
  550. #define mv_2 workbase[2]
  551. #define mv_3 workbase[3]
  552. #define work_50 workbase[50]
  553. #else /* NILSEG_EXTERNS */
  554. #define nil_as_base Lisp_Object nil = C_nil;
  555. #define byteflip (*(unsigned32 *)&BASE[12])
  556. #define codefringe BASE[13]
  557. #define codelimit (*(Lisp_Object volatile *)&BASE[14])
  558. /*
  559. * On a machine where sizeof(void *)=8 and alignment matters I need to arrange for
  560. * stacklimit to be properly aligned. Also I MUST do the address calculation
  561. * in a way that does not get muddled by the "sizeof(void *)" issue. I
  562. * reserve nilseg offsets 15, 16 and 17 for this.
  563. */
  564. #ifdef COMMON
  565. #define stacklimit (*(Lisp_Object * volatile *) \
  566. &BASE[16])
  567. #else
  568. #define stacklimit (*(Lisp_Object * volatile *)&BASE[15])
  569. #endif
  570. #define fringe BASE[18]
  571. #define heaplimit (*(Lisp_Object volatile *)&BASE[19])
  572. #define vheaplimit (*(Lisp_Object volatile *)&BASE[20])
  573. #define vfringe BASE[21]
  574. #define miscflags (*(unsigned32 *)&BASE[22])
  575. #define nwork (*(int32 *)&BASE[24])
  576. #define exit_reason (*(int32 *)&BASE[25])
  577. #define exit_count (*(int32 *)&BASE[26])
  578. #define gensym_ser (*(unsigned32 *)&BASE[27])
  579. #define print_precision (*(unsigned32 *)&BASE[28])
  580. #define current_modulus (*(int32 *)&BASE[29])
  581. #define fastget_size (*(int32 *)&BASE[30])
  582. #define package_bits (*(int32 *)&BASE[31])
  583. /* offsets 32-49 spare at present */
  584. /* Offset 50 used for EQ hash table list */
  585. /* Offset 51 used for EQUAL hash table list */
  586. #define current_package BASE[52]
  587. /* current_package is treated specially by the garbage collector */
  588. #define B_reg BASE[53]
  589. #define codevec BASE[54]
  590. #define litvec BASE[55]
  591. #define exit_tag BASE[56]
  592. #define exit_value BASE[57]
  593. #define catch_tags BASE[58]
  594. #define lisp_package BASE[59]
  595. #define boffo BASE[60]
  596. #define charvec BASE[61]
  597. #define sys_hash_table BASE[62]
  598. #define help_index BASE[63]
  599. #define gensym_base BASE[64]
  600. #define err_table BASE[65]
  601. #define supervisor BASE[66]
  602. #define startfn BASE[67]
  603. #define faslvec BASE[68]
  604. #define tracedfn BASE[69]
  605. #define prompt_thing BASE[70]
  606. #define faslgensyms BASE[71]
  607. #define cl_symbols BASE[72]
  608. #define active_stream BASE[73]
  609. #define current_module BASE[74]
  610. /*
  611. * 75-89 spare for workspace-style locations
  612. */
  613. #define append_symbol BASE[90]
  614. #define applyhook BASE[91]
  615. #define cfunarg BASE[92]
  616. #define comma_at_symbol BASE[93]
  617. #define comma_symbol BASE[94]
  618. #define compiler_symbol BASE[95]
  619. #define comp_symbol BASE[96]
  620. #define cons_symbol BASE[97]
  621. #define echo_symbol BASE[98]
  622. #define emsg_star BASE[99]
  623. #define evalhook BASE[100]
  624. #define eval_symbol BASE[101]
  625. #define expr_symbol BASE[102]
  626. #define features_symbol BASE[103]
  627. #define fexpr_symbol BASE[104]
  628. #define funarg BASE[105]
  629. #define function_symbol BASE[106]
  630. #define lambda BASE[107]
  631. #define lisp_true BASE[108]
  632. #define lower_symbol BASE[109]
  633. #define macroexpand_hook BASE[110]
  634. #define macro_symbol BASE[111]
  635. #define opt_key BASE[112]
  636. #define prinl_symbol BASE[113]
  637. #define progn_symbol BASE[114]
  638. #define quote_symbol BASE[115]
  639. #define raise_symbol BASE[116]
  640. #define redef_msg BASE[117]
  641. #define rest_key BASE[118]
  642. #define savedef BASE[119]
  643. #define string_char_sym BASE[120]
  644. #define unset_var BASE[121]
  645. #define work_symbol BASE[122]
  646. #define lex_words BASE[123]
  647. #define get_counts BASE[124]
  648. #define fastget_names BASE[125]
  649. #define input_libraries BASE[126]
  650. #define output_library BASE[127]
  651. #define current_file BASE[128]
  652. #define break_function BASE[129]
  653. #define lisp_work_stream BASE[130]
  654. #define lisp_standard_output BASE[131]
  655. #define lisp_standard_input BASE[132]
  656. #define lisp_debug_io BASE[133]
  657. #define lisp_error_output BASE[134]
  658. #define lisp_query_io BASE[135]
  659. #define lisp_terminal_io BASE[136]
  660. #define lisp_trace_output BASE[137]
  661. #define standard_output BASE[138]
  662. #define standard_input BASE[139]
  663. #define debug_io BASE[140]
  664. #define error_output BASE[141]
  665. #define query_io BASE[142]
  666. #define terminal_io BASE[143]
  667. #define trace_output BASE[144]
  668. #define fasl_stream BASE[145]
  669. #define native_code BASE[146]
  670. #define native_symbol BASE[147]
  671. #define traceprint_symbol BASE[148]
  672. #define loadsource_symbol BASE[149]
  673. #define hankaku_symbol BASE[150]
  674. #ifdef COMMON
  675. #define keyword_package BASE[170]
  676. #define all_packages BASE[171]
  677. #define package_symbol BASE[172]
  678. #define internal_symbol BASE[173]
  679. #define external_symbol BASE[174]
  680. #define inherited_symbol BASE[175]
  681. #define key_key BASE[176]
  682. #define allow_other_keys BASE[177]
  683. #define aux_key BASE[178]
  684. #define format_symbol BASE[179]
  685. #define expand_def_symbol BASE[180]
  686. #define allow_key_key BASE[181]
  687. #define declare_symbol BASE[182]
  688. #define special_symbol BASE[183]
  689. #endif
  690. /*
  691. * The next are intended for use by people building custom versions
  692. * of CSL. They are always handled as if NILSEG_EXTERNS had been set,
  693. * even if it had not, since that gives the user direct access to them as
  694. * simple C variables. Note that they must ALWAYS be kept with proper
  695. * valid Lisp objects in them.
  696. */
  697. /* #define user_base_0 BASE[190] */
  698. /* #define user_base_1 BASE[191] */
  699. /* #define user_base_2 BASE[192] */
  700. /* #define user_base_3 BASE[193] */
  701. /* #define user_base_4 BASE[194] */
  702. /* #define user_base_5 BASE[195] */
  703. /* #define user_base_6 BASE[196] */
  704. /* #define user_base_7 BASE[197] */
  705. /* #define user_base_8 BASE[198] */
  706. /* #define user_base_9 BASE[199] */
  707. extern DLLexport Lisp_Object user_base_0, user_base_1, user_base_2;
  708. extern DLLexport Lisp_Object user_base_3, user_base_4, user_base_5;
  709. extern DLLexport Lisp_Object user_base_6, user_base_7, user_base_8;
  710. extern DLLexport Lisp_Object user_base_9;
  711. #define work_0 BASE[200]
  712. #define work_1 BASE[201]
  713. #define mv_1 work_1
  714. #define mv_2 BASE[202]
  715. #define mv_3 BASE[203]
  716. #define work_50 BASE[250]
  717. #endif /*NILSEG_EXTERNS */
  718. /* dummy_function_call is only used to patch around C compiler bugs! */
  719. extern void MS_CDECL dummy_function_call(char *why, ...);
  720. extern void copy_into_nilseg(int fg);
  721. extern void copy_out_of_nilseg(int fg);
  722. #define eq_hash_table_list BASE[50] /* In heap image */
  723. #define equal_hash_table_list BASE[51] /* In heap image */
  724. #define current_package_offset 52
  725. extern void rehash_this_table(Lisp_Object v);
  726. extern Lisp_Object eq_hash_tables, equal_hash_tables;
  727. /*
  728. * The following are used to help <escape> processing.
  729. */
  730. extern Lisp_Object volatile savecodelimit;
  731. extern Lisp_Object * volatile savestacklimit;
  732. extern Lisp_Object volatile saveheaplimit;
  733. extern Lisp_Object volatile savevheaplimit;
  734. extern char *exit_charvec;
  735. #ifdef DEBUG
  736. extern int trace_all;
  737. #endif
  738. #define MAX_INPUT_FILES 40 /* limit on command-line length */
  739. #define MAX_SYMBOLS_TO_DEFINE 40
  740. #define MAX_FASL_PATHS 20
  741. extern char *files_to_read[MAX_INPUT_FILES],
  742. *symbols_to_define[MAX_SYMBOLS_TO_DEFINE],
  743. *fasl_paths[MAX_FASL_PATHS];
  744. extern int fasl_output_file, output_directory;
  745. extern FILE *binary_read_file;
  746. #ifndef COMMON
  747. #ifdef CWIN
  748. extern char **loadable_packages;
  749. extern char **switches;
  750. #endif
  751. #endif
  752. #ifdef SOCKETS
  753. extern int sockets_ready;
  754. extern void flush_socket(void);
  755. #endif
  756. extern CSLbool undefine_this_one[MAX_SYMBOLS_TO_DEFINE];
  757. extern int number_of_input_files,
  758. number_of_symbols_to_define,
  759. number_of_fasl_paths,
  760. init_flags;
  761. extern int native_code_tag;
  762. extern char *standard_directory;
  763. extern CSLbool gc_method_is_copying;
  764. extern int32 gc_number;
  765. #define INIT_QUIET 1
  766. #define INIT_VERBOSE 2
  767. #define INIT_EXPANDABLE 4
  768. #define Lispify_predicate(p) ((p) ? lisp_true : nil)
  769. /*
  770. * variables used by the IO system.
  771. */
  772. extern int tty_count;
  773. extern FILE *spool_file;
  774. extern char spool_file_name[32];
  775. typedef struct Ihandle
  776. {
  777. FILE *f; /* File within which this sub-file lives */
  778. long int o; /* Offset (as returned by ftell) */
  779. long int n; /* Number of bytes remaining unread here */
  780. unsigned32 chk; /* Checksum */
  781. int status; /* Reading or Writing */
  782. } Ihandle;
  783. /*
  784. * If there is no more than 100 bytes of data then I will deem
  785. * file compression frivolous. The compression code assumes that
  786. * it has at least 2 bytes to work on, so do NOT cut this limit down to zero.
  787. * Indeed more than that the limit must be greater than the length of
  788. * the initial header record (112 bytes).
  789. */
  790. extern int32 compression_worth_while;
  791. #define CODESIZE 0x1000
  792. typedef struct entry_point
  793. {
  794. void *p;
  795. char *s;
  796. } entry_point;
  797. #ifdef CJAVA
  798. #define entry_table_size 132
  799. #else
  800. #define entry_table_size 127
  801. #endif
  802. extern entry_point entries_table[];
  803. extern int doubled_execution;
  804. #ifdef MEMORY_TRACE
  805. extern intxx memory_base, memory_size;
  806. extern unsigned char *memory_map;
  807. extern FILE *memory_file;
  808. extern void memory_comment(int n);
  809. #endif
  810. #define ARG_CUT_OFF 25
  811. extern void push_args(va_list a, int nargs);
  812. extern void push_args_1(va_list a, int nargs);
  813. extern void Iinit(void);
  814. extern void IreInit(void);
  815. extern void Icontext(Ihandle *);
  816. extern void Irestore_context(Ihandle);
  817. extern void Ilist(void);
  818. extern CSLbool Iopen(char *name, int len, CSLbool dirn, char *expanded_name);
  819. extern CSLbool Iopen_from_stdin(void), Iopen_to_stdout(void);
  820. extern CSLbool IopenRoot(char *expanded_name, int hard);
  821. extern CSLbool Iwriterootp(char *expanded);
  822. extern CSLbool Iopen_help(int32 offset);
  823. extern CSLbool Iopen_banner(int code);
  824. extern CSLbool Imodulep(char *name, int len, char *datestamp, int32 *size,
  825. char *expanded_name);
  826. extern CSLbool Icopy(char *name, int len);
  827. extern CSLbool Idelete(char *name, int len);
  828. extern CSLbool IcloseInput(int check_checksum);
  829. extern CSLbool IcloseOutput(void);
  830. extern CSLbool Ifinished(void);
  831. extern int Igetc(void);
  832. extern int32 Iread(void *buff, int32 size);
  833. extern CSLbool Iputc(int ch);
  834. extern CSLbool Iwrite(void *buff, int32 size);
  835. extern long int Ioutsize(void);
  836. /*
  837. * I will allow myself 192 bytes to store registration information.
  838. * In my initial implementation I will only use a fraction of that
  839. * but it seems safer to design the structure with extra room for potential
  840. * enhancements. I will keep a version code in the data so that I can update
  841. * my methods but still preserve upwards compatibility when I do that.
  842. */
  843. #define REGISTRATION_SIZE 192
  844. #define REGISTRATION_VERSION "r1.0"
  845. extern unsigned char registration_data[REGISTRATION_SIZE];
  846. extern void MD5_Init(void);
  847. extern void MD5_Update(unsigned char *data, int len);
  848. extern void MD5_Final(unsigned char *md);
  849. extern CSLbool MD5_busy;
  850. extern unsigned char *MD5(unsigned char *data, int n, unsigned char *md);
  851. extern void checksum(Lisp_Object a);
  852. extern unsigned char unpredictable[256];
  853. extern void inject_randomness(int n);
  854. /*
  855. * crypt_init() seeds the encryption engine that I used, and then
  856. * crypt_get_block() gets a chunk of the sequence, which I can XOR with
  857. * text to mess it up.
  858. */
  859. extern void crypt_init(char *key);
  860. #define CRYPT_BLOCK 128
  861. extern void crypt_get_block(unsigned char result[CRYPT_BLOCK]);
  862. /*
  863. * crypt_active is -ve if none is in use, otherwise it is a key identifier
  864. * (to allow for possibly multiple keys). crypt_buffer & crypt_count are
  865. * things filled in by crypt_get_block(). The encryption stuff here is just
  866. * for protection of the software, and the code that does somewhat more
  867. * serious encryption to create the keys used with this stream cipher live
  868. * elsewhere. The crypto technology in CSL is only used on image files, ie
  869. * chunks of compiled code etc, and no provision has been made to use it
  870. * on user data-files. I can store up to CRYPT_KEYS different keys with
  871. * a CSL system and have different modules protected by different ones of
  872. * them.
  873. */
  874. #define CRYPT_KEYS 10
  875. extern char *crypt_keys[CRYPT_KEYS];
  876. extern int crypt_active;
  877. extern unsigned char *crypt_buffer;
  878. extern int crypt_count;
  879. extern void ensure_screen(void);
  880. extern int window_heading;
  881. #ifndef WINDOW_SYSTEM
  882. #ifdef BUFFERED_STDOUT
  883. extern clock_t last_flush;
  884. #define ensure_screen() fflush(stdout)
  885. #endif
  886. #define start_up_window_manager(a) {}
  887. #endif
  888. extern void my_exit(int n);
  889. extern void *my_malloc(size_t n);
  890. extern clock_t base_time;
  891. extern double *clock_stack;
  892. extern void push_clock(void);
  893. extern double pop_clock(void);
  894. extern double consolidated_time[10], gc_time;
  895. extern CSLbool volatile already_in_gc, tick_on_gc_exit;
  896. extern CSLbool volatile interrupt_pending, tick_pending, polltick_pending;
  897. extern DLLexport int deal_with_tick(void);
  898. extern int current_fp_rep;
  899. #ifndef __cplusplus
  900. extern jmp_buf *errorset_buffer;
  901. #endif
  902. extern char *errorset_msg;
  903. extern int errorset_code;
  904. extern void unwind_stack(Lisp_Object *, CSLbool findcatch);
  905. extern CSLbool segvtrap;
  906. extern CSLbool batch_flag;
  907. extern int escaped_printing;
  908. #ifdef __WATCOMC__
  909. extern void low_level_signal_handler(int code);
  910. #else
  911. extern void MS_CDECL low_level_signal_handler(int code);
  912. #endif
  913. extern void MS_CDECL sigint_handler(int code);
  914. #ifdef CHECK_STACK
  915. extern int check_stack(char *file, int line);
  916. #endif
  917. #ifdef RECORD_GET
  918. extern void record_get(Lisp_Object tag, CSLbool found);
  919. #endif
  920. /*
  921. * Functions used internally - not to be installed in Lisp function
  922. * cells, but some of these may end up getting called using special
  923. * non-standard conventions when the Lisp compiler has been at work.
  924. */
  925. extern void adjust_all(void);
  926. extern void set_up_functions(CSLbool restartp);
  927. extern void get_user_files_checksum(unsigned char *);
  928. extern DLLexport Lisp_Object acons(Lisp_Object a, Lisp_Object b, Lisp_Object c);
  929. extern DLLexport Lisp_Object ash(Lisp_Object a, Lisp_Object b);
  930. extern Lisp_Object bytestream_interpret(Lisp_Object code, Lisp_Object lit,
  931. Lisp_Object *entry_stack);
  932. extern CSLbool complex_stringp(Lisp_Object a);
  933. extern void freshline_trace(void);
  934. extern void freshline_debug(void);
  935. extern DLLexport Lisp_Object cons(Lisp_Object a, Lisp_Object b);
  936. extern Lisp_Object cons_no_gc(Lisp_Object a, Lisp_Object b);
  937. extern Lisp_Object cons_gc_test(Lisp_Object a);
  938. extern void convert_fp_rep(void *p, int old_rep, int new_rep, int type);
  939. extern DLLexport Lisp_Object Ceval(Lisp_Object u, Lisp_Object env);
  940. extern unsigned32 Crand(void);
  941. extern DLLexport Lisp_Object Cremainder(Lisp_Object a, Lisp_Object b);
  942. extern void Csrand(unsigned32 a, unsigned32 b);
  943. extern void discard(Lisp_Object a);
  944. extern DLLexport CSLbool eql_fn(Lisp_Object a, Lisp_Object b);
  945. extern DLLexport CSLbool cl_equal_fn(Lisp_Object a, Lisp_Object b);
  946. extern DLLexport CSLbool equal_fn(Lisp_Object a, Lisp_Object b);
  947. #ifdef TRACED_EQUAL
  948. extern DLLexport CSLbool traced_equal_fn(Lisp_Object a, Lisp_Object b,
  949. char *, int, int);
  950. #define equal_fn(a, b) traced_equal_fn(a, b, __FILE__, __LINE__, 0)
  951. extern void dump_equals();
  952. #endif
  953. extern DLLexport CSLbool equalp(Lisp_Object a, Lisp_Object b);
  954. extern DLLexport Lisp_Object apply(Lisp_Object fn, int nargs,
  955. Lisp_Object env, Lisp_Object fname);
  956. extern DLLexport Lisp_Object apply_lambda(Lisp_Object def, int nargs,
  957. Lisp_Object env, Lisp_Object name);
  958. extern void deallocate_pages(void);
  959. extern void drop_heap_segments(void);
  960. extern DLLexport Lisp_Object gcd(Lisp_Object a, Lisp_Object b);
  961. extern Lisp_Object get_pname(Lisp_Object a);
  962. #ifdef COMMON
  963. extern DLLexport Lisp_Object get(Lisp_Object a, Lisp_Object b, Lisp_Object c);
  964. #else
  965. extern DLLexport Lisp_Object get(Lisp_Object a, Lisp_Object b);
  966. #endif
  967. extern Lisp_Object getvector(int tag, int32 type, intxx length);
  968. extern Lisp_Object getvector_init(intxx n, Lisp_Object v);
  969. extern Lisp_Object getcodevector(int32 type, intxx size);
  970. extern unsigned32 hash_lisp_string(Lisp_Object s);
  971. extern void lose_C_def(Lisp_Object a);
  972. extern DLLexport CSLbool geq2(Lisp_Object a, Lisp_Object b);
  973. extern DLLexport CSLbool greaterp2(Lisp_Object a, Lisp_Object b);
  974. extern DLLexport CSLbool lesseq2(Lisp_Object a, Lisp_Object b);
  975. extern DLLexport CSLbool lessp2(Lisp_Object a, Lisp_Object b);
  976. extern DLLexport Lisp_Object list2(Lisp_Object a, Lisp_Object b);
  977. extern DLLexport Lisp_Object list2star(Lisp_Object a, Lisp_Object b, Lisp_Object c);
  978. extern DLLexport Lisp_Object list3(Lisp_Object a, Lisp_Object b, Lisp_Object c);
  979. extern DLLexport Lisp_Object lognot(Lisp_Object a);
  980. extern DLLexport Lisp_Object macroexpand(Lisp_Object form, Lisp_Object env);
  981. extern Lisp_Object make_one_word_bignum(int32 n);
  982. extern Lisp_Object make_package(Lisp_Object name);
  983. extern Lisp_Object make_string(char *b);
  984. extern Lisp_Object make_nstring(char *b, int32 n);
  985. extern Lisp_Object make_undefined_symbol(char const *s);
  986. extern Lisp_Object make_symbol(char const *s, int restartp,
  987. one_args *f1, two_args *f2, n_args *fn);
  988. extern DLLexport void MS_CDECL stdout_printf(char *fmt, ...);
  989. extern DLLexport void MS_CDECL term_printf(char *fmt, ...);
  990. extern DLLexport void MS_CDECL err_printf(char *fmt, ...);
  991. extern DLLexport void MS_CDECL debug_printf(char *fmt, ...);
  992. extern DLLexport void MS_CDECL trace_printf(char *fmt, ...);
  993. extern char *my_getenv(char *name);
  994. extern DLLexport Lisp_Object ncons(Lisp_Object a);
  995. extern DLLexport Lisp_Object ndelete(Lisp_Object a, Lisp_Object b);
  996. extern DLLexport Lisp_Object negate(Lisp_Object a);
  997. extern DLLexport Lisp_Object nreverse(Lisp_Object a);
  998. extern FILE *open_file(char *filename, char *original_name,
  999. size_t n, char *dirn, FILE *old_file);
  1000. extern DLLexport Lisp_Object plus2(Lisp_Object a, Lisp_Object b);
  1001. extern void preserve(char *msg);
  1002. extern void preserve_native_code(void);
  1003. extern void relocate_native_function(unsigned char *bps);
  1004. extern Lisp_Object prin(Lisp_Object u);
  1005. extern char *get_string_data(Lisp_Object a, char *why, int32 *len);
  1006. extern DLLexport void prin_to_stdout(Lisp_Object u);
  1007. extern DLLexport void prin_to_terminal(Lisp_Object u);
  1008. extern DLLexport void prin_to_debug(Lisp_Object u);
  1009. extern DLLexport void prin_to_query(Lisp_Object u);
  1010. extern DLLexport void prin_to_trace(Lisp_Object u);
  1011. extern DLLexport void prin_to_error(Lisp_Object u);
  1012. extern DLLexport void loop_print_stdout(Lisp_Object o);
  1013. extern DLLexport void loop_print_terminal(Lisp_Object o);
  1014. extern DLLexport void loop_print_debug(Lisp_Object o);
  1015. extern DLLexport void loop_print_query(Lisp_Object o);
  1016. extern DLLexport void loop_print_trace(Lisp_Object o);
  1017. extern DLLexport void loop_print_error(Lisp_Object o);
  1018. extern void internal_prin(Lisp_Object u, int prefix);
  1019. extern DLLexport Lisp_Object princ(Lisp_Object u);
  1020. extern DLLexport Lisp_Object print(Lisp_Object u);
  1021. extern DLLexport Lisp_Object printc(Lisp_Object u);
  1022. extern void print_bignum(Lisp_Object u, CSLbool blankp, int nobreak);
  1023. extern void print_bighexoctbin(Lisp_Object u,
  1024. int radix, int width, CSLbool blankp, int nobreak);
  1025. extern DLLexport Lisp_Object putprop(Lisp_Object a, Lisp_Object b,
  1026. Lisp_Object c);
  1027. extern DLLexport Lisp_Object quot2(Lisp_Object a, Lisp_Object b);
  1028. extern DLLexport Lisp_Object rational(Lisp_Object a);
  1029. extern void read_eval_print(int noisy);
  1030. extern DLLexport Lisp_Object reclaim(Lisp_Object value_to_return, char *why,
  1031. int stg_class, intxx size);
  1032. extern CSLbool do_not_kill_native_code;
  1033. extern void set_fns(Lisp_Object sym, one_args *f1,
  1034. two_args *f2, n_args *fn);
  1035. extern void setup(int restartp, double storesize);
  1036. extern Lisp_Object simplify_string(Lisp_Object s);
  1037. extern CSLbool stringp(Lisp_Object a);
  1038. extern DLLexport Lisp_Object times2(Lisp_Object a, Lisp_Object b);
  1039. extern int32 thirty_two_bits(Lisp_Object a);
  1040. #ifdef ADDRESS_64
  1041. extern int64 sixty_four_bits(Lisp_Object a);
  1042. #endif
  1043. #ifdef DEMO_MODE
  1044. extern void give_up();
  1045. #endif
  1046. #ifdef DEMO_BUILD
  1047. extern int32 demo_key1, demo_key2;
  1048. #endif
  1049. /*
  1050. * The next few provide support for multiple values.
  1051. */
  1052. #ifdef COMMON
  1053. #define onevalue(r) (exit_count=1, (r))
  1054. #define nvalues(r, n) (exit_count=(n), (r))
  1055. #else
  1056. #define onevalue(r) (r)
  1057. #define nvalues(r, n) (r)
  1058. #endif
  1059. #ifdef COMMON
  1060. #define eval(a, b) Ceval(a, b)
  1061. #define voideval(a, b) Ceval(a, b)
  1062. #else
  1063. /*
  1064. * I lift the top test from eval out to be in-line so that I can
  1065. * (rather often) avoid the overhead of a procedure call when return from
  1066. * it will be almost immediate. The effect is that in CSL mode Ceval is
  1067. * only ever called on a list. NB the first arg to eval gets evaluated
  1068. * several times here - maybe I will just hope that CSE optimisation picks
  1069. * up this sort of repetition...
  1070. */
  1071. #define eval(a, b) \
  1072. (is_cons(a) ? Ceval(a, b) : \
  1073. is_symbol(a) ? (qvalue(a) == unset_var ? error(1, err_unset_var, a) : \
  1074. onevalue(qvalue(a))) : \
  1075. onevalue(a))
  1076. /* voideval(a, b) is like (void)eval(a, b) */
  1077. #define voideval(a, b) \
  1078. if (is_cons(a)) Ceval(a, b) /* Beware "else" after this */
  1079. #endif
  1080. /*
  1081. * The function "equal" seems to be pretty critical (certainly for Standard
  1082. * Lisp mode and Reduce). So I write out the top-level part of it in-line
  1083. * and only call the (messy) function in cases where it might be worth-while.
  1084. * For Common Lisp I will presumably look at eql and cl_equal as well.
  1085. * The test here says:
  1086. * If a and b are EQ then they are EQUAL,
  1087. * else if a and b have different types they are not EQUAL
  1088. * else if a has type 1, 2, 3 or 4 (ie fixnum, odds, sfloat, symbol)
  1089. * then they are not EQUAL (those types need to be EQ to be EQUAL)
  1090. * otherwise call equal_fn(a, b) to decide the issue.
  1091. */
  1092. #define equal(a, b) \
  1093. ((a) == (b) || \
  1094. (((((a) ^ (b)) & TAG_BITS) == 0) && \
  1095. ((unsigned)(((a) & TAG_BITS) - 1) > 3) && \
  1096. equal_fn(a, b)))
  1097. #define cl_equal(a, b) \
  1098. ((a) == (b) || \
  1099. (((((a) ^ (b)) & TAG_BITS) == 0) && \
  1100. ((unsigned)(((a) & TAG_BITS) - 1) > 3) && \
  1101. cl_equal_fn(a, b)))
  1102. #define eql(a, b) \
  1103. ((a) == (b) || \
  1104. (((((a) ^ (b)) & TAG_BITS) == 0) && \
  1105. ((unsigned)(((a) & TAG_BITS) - 1) > 3) && \
  1106. eql_fn(a, b)))
  1107. /*
  1108. * Helpers for the bignum arithmetic code...
  1109. */
  1110. #ifndef IMULTIPLY
  1111. extern unsigned32 Imultiply(unsigned32 *rlow, unsigned32 a,
  1112. unsigned32 b, unsigned32 c);
  1113. #endif
  1114. #ifndef IDIVIDE
  1115. extern unsigned32 Idivide(unsigned32 *qp, unsigned32 a,
  1116. unsigned32 b, unsigned32 c);
  1117. extern unsigned32 Idiv10_9(unsigned32 *qp, unsigned32 a, unsigned32 b);
  1118. #endif
  1119. /*
  1120. * UNSAFE removes some checks - but it does noy seem to make much difference
  1121. * so I rather strongly suggest that you do not enable it!
  1122. */
  1123. #ifdef UNSAFE
  1124. # define argcheck(var, n, msg) (var) = (var);
  1125. #else
  1126. # define argcheck(var, n, msg) if ((var)!=(n)) return aerror(msg);
  1127. #endif
  1128. extern n_args *zero_arg_functions[];
  1129. extern one_args *one_arg_functions[];
  1130. extern two_args *two_arg_functions[];
  1131. extern n_args *three_arg_functions[];
  1132. extern void *useful_functions[];
  1133. extern char *address_of_var(int n);
  1134. typedef struct setup_type
  1135. {
  1136. char *name;
  1137. one_args *one;
  1138. two_args *two;
  1139. n_args *n;
  1140. } setup_type;
  1141. extern setup_type const
  1142. arith06_setup[], arith08_setup[], arith10_setup[], arith12_setup[],
  1143. char_setup[], eval1_setup[], eval2_setup[], eval3_setup[],
  1144. funcs1_setup[], funcs2_setup[], funcs3_setup[], print_setup[],
  1145. read_setup[], mpi_setup[];
  1146. extern setup_type const
  1147. u01_setup[], u02_setup[], u03_setup[], u04_setup[],
  1148. u05_setup[], u06_setup[], u07_setup[], u08_setup[],
  1149. u09_setup[], u10_setup[], u11_setup[], u12_setup[];
  1150. #ifdef NAG
  1151. extern setup_type const nag_setup[], asp_setup[];
  1152. extern setup_type const socket_setup[], xdr_setup[], grep_setup[];
  1153. extern setup_type const gr_setup[], axfns_setup[];
  1154. #endif
  1155. #ifdef OPENMATH
  1156. extern setup_type const om_setup[];
  1157. extern setup_type const om_parse_setup[];
  1158. #endif
  1159. extern char *find_image_directory(int argc, char *argv[]);
  1160. extern char program_name[64];
  1161. extern Lisp_Object declare_fn(Lisp_Object args, Lisp_Object env);
  1162. extern Lisp_Object function_fn(Lisp_Object args, Lisp_Object env);
  1163. extern Lisp_Object let_fn_1(Lisp_Object bvl, Lisp_Object body,
  1164. Lisp_Object env, int compilerp);
  1165. extern Lisp_Object mv_call_fn(Lisp_Object args, Lisp_Object env);
  1166. extern Lisp_Object progn_fn(Lisp_Object args, Lisp_Object env);
  1167. extern Lisp_Object quote_fn(Lisp_Object args, Lisp_Object env);
  1168. extern Lisp_Object tagbody_fn(Lisp_Object args, Lisp_Object env);
  1169. /*
  1170. * Flags used to toggle the protection or otherwise of symbols, and
  1171. * whether to warn about attempts to redefine them.
  1172. */
  1173. extern CSLbool symbol_protect_flag, warn_about_protected_symbols;
  1174. #ifdef __cplusplus
  1175. }
  1176. #endif
  1177. /*
  1178. * Now declare entrypoints to machine-dependent code fragments...
  1179. */
  1180. #include "sys.h"
  1181. #endif /* header_externs_h */
  1182. /* end of externs.h */