home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume23 / abc / part10 < prev    next >
Encoding:
Internet Message Format  |  1991-01-08  |  54.4 KB
  1. Subject:  v23i089:  ABC interactive programming environment, Part10/25
  2. Newsgroups: comp.sources.unix
  3. Approved: rsalz@uunet.UU.NET
  4. X-Checksum-Snefru: 35e25ae5 dfd092da 1106dd44 01d91f13
  5.  
  6. Submitted-by: Steven Pemberton <steven@cwi.nl>
  7. Posting-number: Volume 23, Issue 89
  8. Archive-name: abc/part10
  9.  
  10. #! /bin/sh
  11. # This is a shell archive.  Remove anything before this line, then feed it
  12. # into a shell via "sh file" or similar.  To overwrite existing files,
  13. # type "sh file -c".
  14. # The tool that generated this appeared in the comp.sources.unix newsgroup;
  15. # send mail to comp-sources-unix@uunet.uu.net if you want that tool.
  16. # Contents:  abc/abc.msg abc/bed/e1edoc.c abc/bint1/i1fun.c
  17. #   abc/ch_config
  18. # Wrapped by rsalz@litchi.bbn.com on Mon Dec 17 13:28:01 1990
  19. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  20. echo If this archive is complete, you will see the following message:
  21. echo '          "shar: End of archive 10 (of 25)."'
  22. if test -f 'abc/abc.msg' -a "${1}" != "-c" ; then 
  23.   echo shar: Will not clobber existing file \"'abc/abc.msg'\"
  24. else
  25.   echo shar: Extracting \"'abc/abc.msg'\" \(18006 characters\)
  26.   sed "s/^X//" >'abc/abc.msg' <<'END_OF_FILE'
  27. X100    removing non-existent list entry
  28. X101    cannot remove from large range
  29. X102    cannot insert in large range
  30. X103    in keys t, t is not a table
  31. X104    in t[k], t is not a table
  32. X105    in t[k], k is not a key of t
  33. X106*    comp_text (106)
  34. X200    in t|n, t is not a text
  35. X201    in t|n, n is not a number
  36. X202    in t|n, n is not an integer
  37. X203    in t|n, n is < 0
  38. X204    in t@n, t is not a text
  39. X205    in t@n, n is not a number
  40. X206    in t@n, n is not an integer
  41. X207    in t@n, n is > #t + 1
  42. X208    in t^u, t or u is not a text
  43. X209    in t^u, the result is too long
  44. X210    in t^^n, t is not a text
  45. X211    in t^^n, n is not a number
  46. X212    in t^^n, n is not an integer
  47. X213    in t^^n, n is negative
  48. X214    in t^^n, the result is too long
  49. X215*    charval on non-char (215)
  50. X216*    strval on big text (216)
  51. X217*    curtail on very big text (217)
  52. X218*    behead on very big text (218)
  53. X219*    concat on very big text (219)
  54. X300    in #t, t is not a text list or table
  55. X301    in e#t, t is not a text list or table
  56. X302    in e#t, t is a text, but e is not a character
  57. X303    in min t, t is not a text list or table
  58. X304    in min t, t is empty
  59. X305    in max t, t is not a text list or table
  60. X306    in max t, t is empty
  61. X307    in e min t, t is not a text list or table
  62. X308    in e min t, t is empty
  63. X309    in e min t, t is a text, but e is not a character
  64. X310    in e min t, no element of t exceeds e
  65. X311    in e max t, t is not a text list or table
  66. X312    in e max t, t is empty
  67. X313    in e max t, t is a text, but e is not a character
  68. X314    in e max t, no element of t is less than e
  69. X315    in t item n, t is not a text list or table
  70. X316    in t item n, t is empty
  71. X317    in t item n, n is not a number
  72. X318    in t item n, n is not an integer
  73. X319    in t item n, n is < 1
  74. X320    in t item n, n exceeds #t
  75. X321    in n th'of t, t is not a text list or table
  76. X322    in n th'of t, t is empty
  77. X323    in n th'of t, n is not a number
  78. X324    in n th'of t, n is not an integer
  79. X325    in n th'of t, n is < 1
  80. X326    in n th'of t, n exceeds #t
  81. X327*    Bigsize in Bottom or Crange (327)
  82. X400*    unknown flag in ccopybtreenode (400)
  83. X401*    releasing unreferenced btreenode (401)
  84. X402*    wrong flag in relbtree() (402)
  85. X500    incompatible types %s and %s
  86. X501*    comparison of unknown types (501)
  87. X502*    hash called with unknown type (502)
  88. X503*    unknown type in convert (503)
  89. X600    in x mod y, y is zero
  90. X601    in n round x, n is not an integer
  91. X602    in */n, n is an approximate number
  92. X603    in /*n, n is an approximate number
  93. X604    in n root x, n is zero
  94. X605    in root x, x is negative
  95. X606    result of math function too large
  96. X607    argument to math function too large
  97. X608    math library error
  98. X609    in log x, x <= 0
  99. X610    in b log x, b <= 0
  100. X611    in b log x, x <= 0
  101. X700    approximate number too large
  102. X701*    app_floor: result not integral (701)
  103. X800*    numconst: can't happen (800)
  104. X801    excessive exponent in e-notation
  105. X900*    dig_gcd of number(s) <= 0 (900)
  106. X901*    gcd_small of numbers > smallint (901)
  107. X902*    gcd of number(s) <= 0 (902)
  108. X903    exceptionally large rational number
  109. X1000*    dig_gadd: nto < nfrom (1000)
  110. X1001*    int_tento(-n) (1001)
  111. X1100*    zero division (int_ldiv) (1100)
  112. X1101*    int_ldiv internal failure (1101)
  113. X1200*    mk_rat(x, y) with y=0 (1200)
  114. X1300    number not an integer
  115. X1301    exceedingly large integer
  116. X1302*    intval on non-number (1302)
  117. X1303*    num_comp (1303)
  118. X1304    value not a number
  119. X1305    approximate number too large to be handled
  120. X1306    exceptionally large number
  121. X1400    in p..q, p is neither a text nor a number
  122. X1401    in p..q, p is a number but not an integer
  123. X1402    in p..q, p is a number, but q is not
  124. X1403    in p..q, q is a number but not an integer
  125. X1404    in p..q, p is a text but not a character
  126. X1405    in p..q, p is a text, but q is not
  127. X1406    in p..q, q is a text, but not a character
  128. X1500*    big grabber (1500)
  129. X1501*    big regrabber (1501)
  130. X1502*    getsyze called with unknown type (1502)
  131. X1503*    releasing unreferenced value (1503)
  132. X1600    in choice t, t is not a text list or table
  133. X1601    in choice t, t is empty
  134. X1700    Type '?' for help.\n
  135. X1800    in i/j, j is zero
  136. X1801    in 0**y or y root 0, y is negative
  137. X1802    in x**(p/q) or (q/p) root x, x is negative and q is even
  138. X1803    in x**y or y root x, x is negative and y is not exact
  139. X1804    ambiguous expression; please use ( and ) to resolve
  140. X1805    no expression where expected
  141. X1806    no test where expected
  142. X1807    something unexpected in expression
  143. X1808    something unexpected in test
  144. X1809    misformed address
  145. X1810    %s hasn't been initialised or (properly) defined
  146. X1811    %s hasn't been (properly) defined
  147. X1812    %s has not yet received a value
  148. X1813    function returns no value
  149. X1814    predicate reports no outcome
  150. X1815    a refinement may not be used as an address
  151. X1816    bad node in while
  152. X1817    bad node in testsuite
  153. X1818    indentation not used consistently
  154. X1819    indentation must be at least 2
  155. X1820    selection on non-table
  156. X1900*    a_fpr_formals (1900)
  157. X1901*    analyze bad tree (1901)
  158. X2000    no command suite where expected
  159. X2001    no command where expected
  160. X2002    something unexpected in this line
  161. X2003    no parameter where expected
  162. X2005    IN after colon
  163. X2006    no alternative suite for SELECT
  164. X2007    after ELSE no more alternatives allowed
  165. X2100    nothing instead of expected expression
  166. X2101    point without digits
  167. X2102    e not followed by exponent
  168. X2103    cannot find matching %s
  169. X2200*    fix bad tree (2200)
  170. X2201*    fix unparsed with bad flag (2201)
  171. X2202    command cannot be reached
  172. X2203    refinement returns no value or reports no outcome
  173. X2204    wrong keyword %s
  174. X2205    missing actual parameter after %s
  175. X2206    can't find expected %s
  176. X2207    unexpected actual parameter after %s
  177. X2208    unexpected keyword %s
  178. X2209    compound parameter has wrong length
  179. X2210    refinement with parameters
  180. X2211    you haven't told me HOW TO %s
  181. X2212*    f_fpr_formals (2212)
  182. X2213    %s cannot be used in an expression
  183. X2214    %s is neither a refined test nor a zeroadic predicate
  184. X2300    wrong argument of type_check()
  185. X2301    next line must be impossible as a refinement name, e.g. with a space:
  186. X2302    returned value
  187. X2303    RETURN not in function or expression refinement
  188. X2304    Empty polytype stack
  189. X2400    cannot find expected %s
  190. X2401    no name where expected
  191. X2402    no keyword where expected
  192. X2403    something unexpected following %s
  193. X2404    according to the syntax I expected %s
  194. X2500    nothing where address expected
  195. X2501    no address where expected
  196. X2502    something unexpected in address
  197. X2600    I found type 
  198. X2601    EG 
  199. X2602     where I expected 
  200. X2603    I thought 
  201. X2604     was of type 
  202. X2605    list or table of 
  203. X2606    list or table
  204. X2607    "", or list or table of ""
  205. X2608    text or list or table
  206. X2609    incompatible type for 
  207. X2610    incompatible types for 
  208. X2611     and 
  209. X2612    %s
  210. X2700    HAS follows colon
  211. X2701    nothing instead of expected test
  212. X2800    how-to starts with indentation
  213. X2801    no how-to name where expected
  214. X2802    no how-to keyword where expected
  215. X2803    %s is a reserved keyword
  216. X2804    %s is already a formal parameter or operand
  217. X2805    %s is already a shared name
  218. X2806    %s is already a refinement name
  219. X2807    cannot find function name
  220. X2808    user defined functions must be names
  221. X2809    something unexpected in formula template
  222. X2810    nothing instead of expected template operand
  223. X2811    no template operand where expected
  224. X2812    nothing instead of expected name
  225. X2813    no name where expected
  226. X2814    something unexpected in name
  227. X2900    change of workspace not allowed
  228. X2901    no previous workspace
  229. X2902    I find no workspace name here
  230. X2903    I can't goto/create workspace %s
  231. X2905    *** I cannot find parent directory\n
  232. X2906    *** I cannot find workspace\n
  233. X2907    *** I cannot find your home directory\n
  234. X2908    *** I shall use the current directory as your single workspace\n
  235. X2909    *** %s isn't an ABC name\n
  236. X2910    *** I shall try the default workspace\n
  237. X3000*    replacing in non-environment (3000)
  238. X3001*    deleting from non-environment (3001)
  239. X3002*    selection on non-environment (3002)
  240. X3100     in your command\n
  241. X3101     in your expression to be read\n
  242. X3102     in your edited value\n
  243. X3103     in your location %s\n
  244. X3104     in your permanent environment\n
  245. X3105     in your workspace index\n
  246. X3106     in your how-to %s\n
  247. X3107     in line %d of your how-to %s\n
  248. X3108    *** (detected after reading 1 line of your input file standard input)\n
  249. X3109    *** (detected after reading %d lines of your input file standard input)\n
  250. X3110    *** (detected after reading 1 line of your input file %s)\n
  251. X3111    *** (detected after reading %d lines of your input file %s)\n
  252. X3112    *** The problem is:
  253. X3113    *** Sorry, ABC system malfunction\n
  254. X3114    *** Sorry, memory exhausted
  255. X3115    *** There's something I don't understand
  256. X3116    *** There's something I can't resolve
  257. X3117    *** Can't cope with problem
  258. X3118    *** Cannot reconcile the types
  259. X3119    *** Your check failed
  260. X3120    *** interrupted\n
  261. X3200    in x %s y, x is not a number
  262. X3201    in x %s y, y is not a number
  263. X3202    in x %s y, y is not a compound of two numbers
  264. X3203    in c %s x, c is zero
  265. X3204    in %s x, x is not a number
  266. X3205    in %s y, y is not a compound of two numbers
  267. X3206    in %s t, t is not a text
  268. X3207*    pre-defined fpr wrong (3207)
  269. X3208    in the test exact x, x is not a number
  270. X3209    in the test e in t, t is not a text list or table
  271. X3210    in the test e in t, t is a text, but e is not a character
  272. X3211    in the test e not.in t, t is not a text list or table
  273. X3212    in the test e not.in t, t is a text, but e isn't a character
  274. X3213*    predicate not covered by proposition (3213)
  275. X3300    terminating commands only allowed in how-to's and refinements
  276. X3301    share-command only allowed in a how-to
  277. X3302    I don't recognise this as a command
  278. X3303    outer indentation not zero
  279. X3304    special commands only interactively
  280. X3305*    special (3305)
  281. X3400    in ... i IN e, e is not a text, list or table
  282. X3500    unexpected program halt
  283. X3501*    run: bad thread (3501)
  284. X3502    none of the alternative tests of SELECT succeeds
  285. X3503    test refinement reports no outcome
  286. X3504    refinement returns no value
  287. X3505    run-time error %s
  288. X3506    run: cannot execute how-to definition
  289. X3507*    bad FPR_FORMAL (3507)
  290. X3508    QUIT may only occur in a command or command-refinement
  291. X3509    RETURN may only occur in a function or expression-refinement
  292. X3510    REPORT may only occur in a predicate or test-refinement
  293. X3511    SUCCEED may only occur in a predicate or test-refinement
  294. X3512    FAIL may only occur in a predicate or test-refinement
  295. X3513*    run: bad node type (3513)
  296. X3600    location not initialised
  297. X3601    %s hasn't been initialised
  298. X3602    key not in table
  299. X3603    inserting in non-list
  300. X3604    removing from non-list
  301. X3605    removing from empty list
  302. X3606    selection on empty table
  303. X3607*    call of location with improper type (3607)
  304. X3608*    uniquifying text-selection location (3608)
  305. X3609*    uniquifying comploc (3609)
  306. X3610*    uniquifying non-location (3610)
  307. X3611    text-selection (@ or |) on non-text
  308. X3612    in the location t@p or t|p, t does not contain a text
  309. X3613    in the location t@p or t|p, p is out of bounds
  310. X3614    selection on location of improper type
  311. X3615    text-selection (@ or |) out of bounds
  312. X3616    putting non-text in text-selection (@ or |)
  313. X3617    putting non-compound in compound location
  314. X3618    putting compound in compound location of different length
  315. X3619    putting in non-location
  316. X3620    putting different values in same location
  317. X3621    deleting non-location
  318. X3622    deleting text-selection (@ or |) location
  319. X3623    deleting non-existent location
  320. X3624    binding non-location
  321. X3625    unbinding non-location
  322. X3700    write error (disk full?)
  323. X3800    value too big to output
  324. X3801*    writing value of unknown type (3801)
  325. X3802    *** Please answer with '%c' or '%c'\n
  326. X3803    *** Just '%c' or '%c', please\n
  327. X3804    *** This is your last chance. Take it. I really don't know what you want.\n    So answer the question\n
  328. X3805    *** Well, I shall assume that your refusal to answer the question means '%c'!\n
  329. X3806    End of input encountered during READ command
  330. X3807    End of input encountered during READ t RAW
  331. X3808    type of expression does not agree with that of EG sample
  332. X3809    *** Please try again\n
  333. X3900    *** abc: killed by signal\n
  334. X3901    *** Oops, I feel suddenly (BURP!) indisposed. I'll call it a day. Sorry.\n
  335. X3902    *** Oops, an act of God has occurred compelling me to discontinue service.\n
  336. X3903    unexpected arithmetic overflow
  337. X4000    cannot create file name for %s
  338. X4001    filename and how-to name incompatible for %s
  339. X4002    cannot create file %s; need write permission in directory
  340. X4003    unable to find file
  341. X4004*    wrong nodetype of how-to (4004)
  342. X4005    there is already a how-to with this name
  343. X4006    there is already a permanent location with this name
  344. X4007    *** the how-to name is already in use;\n*** should the old how-to be discarded?\n*** (if not you have to change the how-to name)\n
  345. X4008    *** the how-to name is already in use for a permanent location;\n*** should that location be deleted?\n*** (if not you have to change the how-to name)\n
  346. X4009    I find nothing editible here
  347. X4010    no current how-to
  348. X4011    *** do you want to visit the version with %c or %c operands?\n
  349. X4012    *** you have no write permission in this workspace:\n*** you may not change the how-to\n*** do you still want to display the how-to?\n
  350. X4013    *** cannot create file name;\n*** you have to change the how-to name\n
  351. X4014    %s isn't a how-to in this workspace
  352. X4015*    ens_filed() (4015)
  353. X4016    no current location
  354. X4017    *** you have no write permission in this workspace:\n*** you may not change the location\n*** do you still want to display the location?\n
  355. X4018    %s isn't a location in this workspace
  356. X4019    value is not a table
  357. X4020    in t[k], k is not a text
  358. X4021    Press [SPACE] for more, [RETURN] to exit list
  359. X4100*    stack underflow (4100)
  360. X4101*    bad call type (4101)
  361. X4102*    stack clobbered (4102)
  362. X4103    You haven't told me HOW TO REPORT %s
  363. X4104    You haven't told me HOW TO RETURN %s
  364. X4105*    invoked how-to has other adicity than invoker (4105)
  365. X4106*    udfpr with predefined how-to (4106)
  366. X4107*    formula called with non-function (4107)
  367. X4108*    proposition called with non-predicate (4108)
  368. X4109*    extract (4109)
  369. X4110    putting non-compound in compound parameter
  370. X4111    parameter has wrong length
  371. X4112*    not a compound in sub_epibreer (4112)
  372. X4113*    bad nodetype in sub_epibreer (4113)
  373. X4114*    too many tags in sub_putback (4114)
  374. X4115*    not a compound in sub_putback (4115)
  375. X4116*    bad node type in sub_putback (4116)
  376. X4117*    not a compound in collect_value (4117)
  377. X4118*    bad node type in collect_value (4118)
  378. X4119    on return, part of compound holds no value
  379. X4120    value of expression parameter changed
  380. X4121*    bad def in x_user_command (4121)
  381. X4122    You haven't told me HOW TO %s
  382. X4200*    loctype asked of non-location (4200)
  383. X4201*    valtype called with unknown type (4201)
  384. X4400    in ... i IN e, i contains a non-local name
  385. X4500*    in cmdline() (4500)
  386. X4600    *** %s isn't the name of a location\n
  387. X4601    *** %s hasn't been initialised\n
  388. X4602    *** %s isn't a table\n
  389. X4603    *** Errors while recovering workspace:\n
  390. X4604    *** %s: cannot derive a location name\n
  391. X4605    *** %s: cannot read this file\n
  392. X4606    *** %s: cannot derive a how-to name\n
  393. X4607    *** %s: cannot rename this file\n
  394. X4608    *** %s: the ABC name for this file is already in use\n
  395. X4609    *** %s: cannot create this file\n
  396. X4610    *** Errors while recovering the workspace index\n
  397. X4611    *** %s: cannot derive an ABC name for this workspace\n
  398. X4612    *** %s: the ABC name for this workspace is already in use\n
  399. X4700    *** Interrupted\n
  400. X6000    Empty copy buffer
  401. X6001    Trouble with your how-to, see last line. Hit [interrupt] if you don't want this
  402. X6002    Spaces and tabs mixed for indentation; check your program layout
  403. X6003    There are still holes left.  Please fill or delete these first.
  404. X6004    I cannot [goto] that position
  405. X6005    Sorry, I could not [goto] that position
  406. X6006    You can't use [goto] in recording mode
  407. X6007    Cannot insert '%c'
  408. X6008    No keystrokes recorded
  409. X6009    Keystrokes recorded, use [play] to play back
  410. X6010    This redo brought you to an older version.  Use [undo] to cancel
  411. X6200    Sorry, I can't edit file \"%s\"
  412. X6201    excessively nested indentation
  413. X6202    indentation messed up
  414. X6203    unexpected indentation increase
  415. X6204*    readsym: ungetc failed (6204)
  416. X6300    Cannot save how-to on file \"%s\"
  417. X6400    Recording
  418. X6401    Copy buffer
  419. X6500    Errors in key definitions file:\n
  420. X6501    Definition for command %s starts with '%c'.
  421. X6502    Definition for command %s would produce an interrupt or suspend.
  422. X6503    Definition for command %s would produce an interrupt.
  423. X6504    Too many key definitions
  424. X6505    no '[' before name
  425. X6506    No name after '['
  426. X6507    no ']' after name
  427. X6508    opening string quote not found
  428. X6509    closing string quote not found in definition
  429. X6510    definition string too long
  430. X6511    opening string quote not found in representation
  431. X6512    closing string quote not found in representation
  432. X6513    unprintable character in representation
  433. X6514    representation string too long
  434. X6515    Name %s not followed by '='
  435. X6516    Unknown command name: %s
  436. X6517    Cannot rebind %s in keysfile
  437. X6518    No '=' after definition for name %s
  438. X6519*    too many predefined keys (6519)
  439. X6600    *** Bad $TERM or termcap, or dumb terminal\n
  440. X6601    *** Bad SCREEN environment\n
  441. X6602    *** Cannot reach keyboard or screen\n
  442. X6700    Press [SPACE] for more, [RETURN] to exit help
  443. X6701    Press [SPACE] or [RETURN] to exit help
  444. X6702    *** Cannot find or read help file [%s]
  445. X6800    *** Bad tgetent() return value.\n
  446. X6801    *** Can't read termcap.\n
  447. X6802    *** No description for your terminal.\n
  448. X6900    \nUsage:  abc [-W ws.group] [-w ws.name]\n
  449. X6901                [ -e | -i tab | -o tab | -l | -r | -R | file ...]\n
  450. X6902    \nWorkspace Options:\n
  451. X6903         -W dir        use group of workspaces in 'dir' (default $HOME/abc)\n
  452. X6904         -w name       start in workspace 'name' (default: last workspace)\n
  453. X6905         -w path       use 'path' as current workspace (no -W option allowed)\n
  454. X6906    \nOther Options:\n
  455. X6907         -e            Use ${EDITOR} as editor to edit definitions\n
  456. X6908         file ...      Read commands from file(s)\n
  457. X6909    \nSpecial tasks:\n
  458. X6910         -i tab        Fill table 'tab' with text lines from standard input\n
  459. X6911         -o tab        Write text lines from table 'tab' to standard output\n
  460. X6912         -l            List the how-to's in a workspace on standard output\n
  461. X6913         -r            Recover a workspace when its index is lost\n
  462. X6914         -R            Recover the index of a group of workspaces\n
  463. X6915    \nUse 'abckeys' to change key bindings\n
  464. X6916    *** incompatible workspace options\n
  465. X6917    *** you have not set your environment variable EDITOR\n
  466. X7000    *** can't finish writing suggestion file [%s]
  467. X7100*    s_up failed (7100)
  468. X7101*    s_downi failed (7101)
  469. X7102*    s_down failed (7102)
  470. X7103*    s_downrite failed (7103)
  471. X8000    argument to graphics command not a vector
  472. X8001    no graphics hardware available
  473. END_OF_FILE
  474.   if test 18006 -ne `wc -c <'abc/abc.msg'`; then
  475.     echo shar: \"'abc/abc.msg'\" unpacked with wrong size!
  476.   fi
  477.   # end of 'abc/abc.msg'
  478. fi
  479. if test -f 'abc/bed/e1edoc.c' -a "${1}" != "-c" ; then 
  480.   echo shar: Will not clobber existing file \"'abc/bed/e1edoc.c'\"
  481. else
  482.   echo shar: Extracting \"'abc/bed/e1edoc.c'\" \(15951 characters\)
  483.   sed "s/^X//" >'abc/bed/e1edoc.c' <<'END_OF_FILE'
  484. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
  485. X
  486. X#include "b.h"
  487. X#include "bedi.h"
  488. X#include "etex.h"
  489. X#include "feat.h"
  490. X#include "bobj.h"
  491. X#include "defs.h"
  492. X#include "node.h"
  493. X#include "erro.h"
  494. X#include "gram.h"
  495. X#include "keys.h"
  496. X#include "queu.h"
  497. X#include "supr.h"
  498. X#include "tabl.h"
  499. X
  500. Xextern bool io_exit;
  501. Xextern bool slowterminal;
  502. X
  503. X#define Mod(k) (((k)+MAXHIST) % MAXHIST)
  504. X#define Succ(k) (((k)+1) % MAXHIST)
  505. X#define Pred(k) (((k)+MAXHIST-1) % MAXHIST)
  506. X
  507. X#define    CANT_SAVE   MESS(6300, "Cannot save how-to on file \"%s\"")
  508. X
  509. Xextern environ *tobesaved;
  510. Xextern string savewhere;
  511. X
  512. XHidden int highwatmark = Maxintlet;
  513. X
  514. XVisible bool lefttorite;
  515. X    /* Saves some time in nosuggtoqueue() for read from file */
  516. X
  517. X/*
  518. X * Edit a unit or target, using the environment offered as a parameter.
  519. X */
  520. X
  521. XVisible bool
  522. Xdofile(ep, filename, linenumber, kind, creating)
  523. X    environ *ep;
  524. X    string filename;
  525. X    int linenumber;
  526. X    literal kind;
  527. X    bool creating;
  528. X{
  529. X    bool read_bad= No;
  530. X    bool readfile();
  531. X    
  532. X#ifdef SAVEPOS
  533. X    if (linenumber <= 0)
  534. X        linenumber = getpos(filename);
  535. X#endif /* SAVEPOS */
  536. X    setroot(kind == '=' ? Target_edit : Unit_edit);
  537. X    savewhere = filename;
  538. X    tobesaved = (environ*)NULL;
  539. X
  540. X    lefttorite = Yes;
  541. X    if (!readfile(ep, filename, linenumber, creating)) {
  542. X        ederr(READ_BAD);
  543. X        read_bad = Yes;
  544. X    }
  545. X#ifdef USERSUGG
  546. X    readsugg(ep->focus);
  547. X#endif /* USERSUGG */
  548. X    lefttorite = No;
  549. X
  550. X    ep->generation = 0;
  551. X    if (!editdocument(ep, read_bad))
  552. X        return No;
  553. X    if (ep->generation > 0) {
  554. X        if (!save(ep->focus, filename))
  555. X            ederrS(CANT_SAVE, filename);
  556. X#ifdef USERSUGG
  557. X        writesugg(ep->focus);
  558. X#endif /* USERSUGG */
  559. X    }
  560. X#ifdef SAVEPOS
  561. X    savpos(filename, ep);
  562. X#endif /* SAVEPOS */
  563. X    savewhere = (char*)NULL;
  564. X    tobesaved = (environ*)NULL;
  565. X    return Yes;
  566. X}
  567. X
  568. X
  569. X/*
  570. X * Call the editor for a given document.
  571. X */
  572. X
  573. XVisible bool
  574. Xeditdocument(ep, bad_file)
  575. X    environ *ep;
  576. X    bool bad_file;
  577. X{
  578. X    int k;
  579. X    int first = 0;
  580. X    int last = 0;
  581. X    int current = 0;
  582. X    int onscreen = -1;
  583. X    bool reverse = No;
  584. X    environ newenv;
  585. X    int cmd;
  586. X    bool errors = No;
  587. X    int undoage = 0;
  588. X    bool done = No;
  589. X    int height;
  590. X    environ history[MAXHIST];
  591. X
  592. X    Ecopy(*ep, history[0]);
  593. X
  594. X    for (;;) { /* Command interpretation loop */
  595. X        if (reverse && onscreen >= 0)
  596. X            height = history[onscreen].highest;
  597. X        else
  598. X            height = history[current].highest;
  599. X        if (height < highwatmark) highwatmark = height;
  600. X        if (done)
  601. X            break;
  602. X        if (!interrupted && trmavail() <= 0) {
  603. X            if (onscreen != current)
  604. X                virtupdate(onscreen < 0 ? (environ*)NULL : &history[onscreen],
  605. X                    &history[current],
  606. X                    reverse && onscreen >= 0 ?
  607. X                        history[onscreen].highest : history[current].highest);
  608. X            onscreen = current;
  609. X            highwatmark = Maxintlet;
  610. X            actupdate(history[current].copyflag ?
  611. X                history[current].copybuffer : Vnil,
  612. X#ifdef RECORDING
  613. X                history[current].newmacro != Vnil,
  614. X#else /* !RECORDING */
  615. X                No,
  616. X#endif /* !RECORDING */
  617. X                No);
  618. X        }
  619. X        if (interrupted) break;
  620. X#ifdef MENUS
  621. X        adjusteditmenu(
  622. X            (bool) (ishole(&history[current])),
  623. X            (bool) (history[current].copybuffer != Vnil),
  624. X            (bool) (history[current].copyflag),
  625. X            (bool) (current != first),
  626. X            (bool) (current != last)
  627. X        );
  628. X#endif
  629. X        cmd = inchar();
  630. X        
  631. X        errors = No;
  632. X        switch (cmd) {
  633. X
  634. X        case UNDO:
  635. X            if (current == first)
  636. X                errors = Yes;
  637. X            else {
  638. X                if (onscreen == current)
  639. X                    reverse = Yes;
  640. X                current = Pred(current);
  641. X                undoage = Mod(last-current);
  642. X            }
  643. X            break;
  644. X
  645. X        case REDO:
  646. X            if (current == last)
  647. X                errors = Yes;
  648. X            else {
  649. X                if (current == onscreen)
  650. X                    reverse = No;
  651. X                if (history[Succ(current)].generation <
  652. X                        history[current].generation)
  653. X                    ederr(REDO_OLD); /***** Should refuse altogether??? *****/
  654. X                current = Succ(current);
  655. X                undoage = Mod(last-current);
  656. X            }
  657. X            break;
  658. X
  659. X#ifdef HELPFUL
  660. X        case HELP:
  661. X            if (help())
  662. X                onscreen = -1;
  663. X            break;
  664. X#endif /* HELPFUL */
  665. X
  666. X        case SUSPEND:
  667. X            /* after suspend handled by susphandler() */
  668. X            onscreen= -1;
  669. X            trmundefined();
  670. X            if (doctype == D_immcmd)
  671. X                cmdprompt(CMDPROMPT);
  672. X            break;
  673. X            
  674. X        case REDRAW:
  675. X            onscreen = -1;
  676. X            trmundefined();
  677. X            break;
  678. X
  679. X        case EOF:
  680. X            done = Yes;
  681. X            break;
  682. X
  683. X        case CANCEL:
  684. X            if (bad_file) {
  685. X#ifdef MENUS
  686. X                unhilite();
  687. X#endif
  688. X                return No;
  689. X            }
  690. X            else if (doctype == D_input ||
  691. X                    (doctype == D_immcmd && current == first))
  692. X                interrupted= Yes;
  693. X            else
  694. X                errors= Yes;
  695. X            break;
  696. X
  697. X        default:
  698. X            Ecopy(history[current], newenv);
  699. X            newenv.highest = Maxintlet;
  700. X            newenv.changed = No;
  701. X            if (cmd != EXIT)
  702. X                errors = !execute(&newenv, cmd) || !checkep(&newenv);
  703. X            else {
  704. X                done = Yes;
  705. X                io_exit= Yes;
  706. X            }
  707. X#ifdef EDITRACE
  708. X    dumpev(&newenv, "AFTER EXECUTE");
  709. X#endif
  710. X            if (errors) {
  711. X                switch (cmd) {
  712. X                case NEWLINE:
  713. X                    if (newenv.mode == ATEND && !parent(newenv.focus)) {
  714. X                        errors = !checkep(&newenv);
  715. X                        if (!errors) {
  716. X#ifdef USERSUGG
  717. X                            check_last_unit(&newenv, current);
  718. X#endif
  719. X                            done = Yes;
  720. X                        }
  721. X                    }
  722. X                    break;
  723. X#ifdef HELPFUL
  724. X                case '?':
  725. X                    cmd = HELP;
  726. X                    /* FALL THROUGH: */
  727. X                case HELP:
  728. X                    if (help())
  729. X                        onscreen = -1;
  730. X#endif /* HELPFUL */
  731. X                }
  732. X            }
  733. X            if (errors)
  734. X                Erelease(newenv);
  735. X            else {
  736. X#ifndef SMALLSYS
  737. X                if (done)
  738. X#ifdef MENUS
  739. X                    if (!terminated)
  740. X#endif
  741. X                        done = canexit(&newenv);
  742. X                if (!done)
  743. X                    io_exit= No;
  744. X#endif /* SMALLSYS */
  745. X                if (!done && ev_eq(&newenv, &history[current])) {
  746. X                    errors= Yes;
  747. X                    Erelease(newenv);
  748. X                    break; /* don't remember no.ops */
  749. X                }
  750. X                if (newenv.changed)
  751. X                    ++newenv.generation;
  752. X                last = Succ(last);
  753. X                current = Succ(current);
  754. X                if (last == first) {
  755. X                    /* Array full (always after a while). Discard "oldest". */
  756. X                    if (current == last
  757. X                        || undoage < Mod(current-first)) {
  758. X                        Erelease(history[first]);
  759. X                        first = Succ(first);
  760. X                        if (undoage < MAXHIST)
  761. X                            ++undoage;
  762. X                    }
  763. X                    else {
  764. X                        last = Pred(last);
  765. X                        Erelease(history[last]);
  766. X                    }
  767. X                }
  768. X                if (current != last
  769. X                    && newenv.highest < history[current].highest)
  770. X                    history[current].highest = newenv.highest;
  771. X                /* Move entries beyond current one up. */
  772. X                for (k = last; k != current; k = Pred(k)) {
  773. X                    if (Pred(k) == onscreen)
  774. X                        onscreen = k;
  775. X                    Emove(history[Pred(k)], history[k]);
  776. X                }
  777. X                Ecopy(newenv, history[current]);
  778. X                Erelease(history[current]);
  779. X            }
  780. X            break; /* default */
  781. X
  782. X        } /* switch */
  783. X
  784. X        if (errors
  785. X#ifdef HELPFUL
  786. X            && cmd != HELP
  787. X#endif
  788. X            ) {
  789. X            if (!slowterminal && isascii(cmd)
  790. X                && (isprint(cmd) || cmd == ' '))
  791. X                ederrC(INS_BAD, cmd);
  792. X            else
  793. X                ederr(0);
  794. X        }
  795. X        if (savewhere)
  796. X            tobesaved = &history[current];
  797. X    } /* for (;;) */
  798. X
  799. X    if (onscreen != current)
  800. X        virtupdate(onscreen < 0 ? (environ*)NULL : &history[onscreen],
  801. X            &history[current], highwatmark);
  802. X    actupdate(Vnil, No, Yes);
  803. X    Erelease(*ep);
  804. X    Ecopy(history[current], *ep);
  805. X    if (savewhere)
  806. X        tobesaved = ep;
  807. X    for (current = first; current != last; current = Succ(current))
  808. X        Erelease(history[current]);
  809. X    Erelease(history[last]);
  810. X#ifdef MENUS
  811. X    unhilite();
  812. X#endif
  813. X    return Yes;
  814. X}
  815. X
  816. X/*
  817. X * Execute a command, return success or failure.
  818. X */
  819. X
  820. Xextern bool justgoon;
  821. X
  822. XHidden bool
  823. Xexecute(ep, cmd)
  824. X    register environ *ep;
  825. X    register int cmd;
  826. X{
  827. X    register bool spflag = ep->spflag;
  828. X    register int i;
  829. X    environ ev;
  830. X    char buf[2];
  831. X    char ch;
  832. X    int len;
  833. X#ifdef USERSUGG
  834. X    bool sugg;
  835. X    int sym= symbol(tree(ep->focus));
  836. X    
  837. X    sugg = sym == Suggestion;
  838. X#define ACKSUGG(ep) if (sugg) acksugg(ep)
  839. X#define KILLSUGG(ep) if (sugg) killsugg(ep, (string*)NULL); \
  840. X             else if (sym==Sugghowname) ackhowsugg(ep)
  841. X#else /* !USERSUGG */
  842. X#define ACKSUGG(ep) /* NULL */
  843. X#define KILLSUGG(ep) /* NULL */
  844. X#endif /* !USERSUGG */
  845. X
  846. X    if (justgoon)
  847. X        justgoon = isascii(cmd) && islower(cmd);
  848. X    
  849. X#ifdef RECORDING
  850. X    if (ep->newmacro && cmd != RECORD && cmd != PLAYBACK) {
  851. X        value t;
  852. X        buf[0] = cmd; buf[1] = 0;
  853. X        e_concto(&ep->newmacro, t= mk_etext(buf));
  854. X        release(t);
  855. X    }
  856. X#endif /* RECORDING */
  857. X    ep->spflag = No;
  858. X
  859. X    switch (cmd) {
  860. X
  861. X#ifdef RECORDING
  862. X    case RECORD:
  863. X        ep->spflag = spflag;
  864. X        if (ep->newmacro) { /* End definition */
  865. X            release(ep->oldmacro);
  866. X            if (ep->newmacro && e_length(ep->newmacro) > 0) {
  867. X                ep->oldmacro = ep->newmacro;
  868. X                edmessage(getmess(REC_OK));
  869. X            }
  870. X            else {
  871. X                release(ep->newmacro);
  872. X                ep->oldmacro = Vnil;
  873. X            }
  874. X            ep->newmacro = Vnil;
  875. X        }
  876. X        else /* Start definition */
  877. X            ep->newmacro = mk_etext("");
  878. X        return Yes;
  879. X
  880. X    case PLAYBACK:
  881. X        if (!ep->oldmacro || e_length(ep->oldmacro) <= 0) {
  882. X            ederr(PLB_NOK);
  883. X            return No;
  884. X        }
  885. X        ep->spflag = spflag;
  886. X        len= e_length(ep->oldmacro);
  887. X        for (i = 0; i < len; ++i) {
  888. X            ch= e_ncharval(i+1, ep->oldmacro);
  889. X            Ecopy(*ep, ev);
  890. X            if (execute(ep, ch&0377) && checkep(ep))
  891. X                Erelease(ev);
  892. X            else {
  893. X                Erelease(*ep);
  894. X                Emove(ev, *ep);
  895. X                if (!i)
  896. X                    return No;
  897. X                ederr(0); /* Just a bell */
  898. X                /* The error must be signalled here, because the overall
  899. X                   command (PLAYBACK) succeeds, so the main loop
  900. X                   doesn't ring the bell; but we want to inform the
  901. X                   that not everything was done either. */
  902. X                return Yes;
  903. X            }
  904. X        }
  905. X        return Yes;
  906. X#endif /* RECORDING */
  907. X
  908. X#ifdef GOTOCURSOR
  909. X    case GOTO:
  910. X        ACKSUGG(ep);
  911. X#ifdef RECORDING
  912. X        if (ep->newmacro) {
  913. X            ederr(GOTO_REC);
  914. X            return No;
  915. X        }
  916. X#endif /* RECORDING */
  917. X        return gotocursor(ep);
  918. X#endif /* GOTOCURSOR */
  919. X
  920. X    case NEXT:
  921. X        ACKSUGG(ep);
  922. X        return nextarrow(ep);
  923. X
  924. X    case PREVIOUS:
  925. X        ACKSUGG(ep);
  926. X        return previous(ep);
  927. X
  928. X    case LEFTARROW:
  929. X        ACKSUGG(ep);
  930. X        return leftarrow(ep);
  931. X
  932. X    case RITEARROW:
  933. X        ACKSUGG(ep);
  934. X        return ritearrow(ep);
  935. X
  936. X    case WIDEN:
  937. X        ACKSUGG(ep);
  938. X        return widen(ep, No);
  939. X
  940. X    case EXTEND:
  941. X        ACKSUGG(ep);
  942. X        return extend(ep);
  943. X
  944. X    case FIRST:
  945. X        ACKSUGG(ep);
  946. X        return narrow(ep);
  947. X
  948. X    case LAST:
  949. X        ACKSUGG(ep);
  950. X        return rnarrow(ep);
  951. X
  952. X    case UPARROW:
  953. X        ACKSUGG(ep);
  954. X        return uparrow(ep);
  955. X
  956. X    case DOWNARROW:
  957. X        ACKSUGG(ep);
  958. X        return downarrow(ep);
  959. X
  960. X    case UPLINE:
  961. X        ACKSUGG(ep);
  962. X        return upline(ep);
  963. X
  964. X    case DOWNLINE:
  965. X        ACKSUGG(ep);
  966. X        return downline(ep);
  967. X
  968. X
  969. X    case PASTE:
  970. X    case COPY:
  971. X        ACKSUGG(ep);
  972. X        ep->spflag = spflag;
  973. X        return copyinout(ep);
  974. X
  975. X    case CUT:
  976. X    case DELETE:
  977. X        ACKSUGG(ep);
  978. X        return deltext(ep);
  979. X
  980. X    case ACCEPT:
  981. X        ACKSUGG(ep);
  982. X        return accept(ep);
  983. X
  984. X    default:
  985. X        if (!isascii(cmd) || !isprint(cmd))
  986. X            return No;
  987. X        ep->spflag = spflag;
  988. X        return ins_char(ep, cmd, islower(cmd) ? toupper(cmd) : -1);
  989. X
  990. X    case ' ':
  991. X        ep->spflag = spflag;
  992. X        return ins_char(ep, ' ', -1);
  993. X
  994. X    case NEWLINE:
  995. X        KILLSUGG(ep);
  996. X        return ins_newline(ep);
  997. X    }
  998. X}
  999. X
  1000. X
  1001. X/*
  1002. X * Initialize an environment variable.    Most things are set to 0 or NULL.
  1003. X */
  1004. X
  1005. XVisible Procedure
  1006. Xclrenv(ep)
  1007. X    environ *ep;
  1008. X{
  1009. X    ep->focus = newpath(NilPath, gram(Optional), 1);
  1010. X    ep->mode = WHOLE;
  1011. X    ep->copyflag = ep->spflag = ep->changed = No;
  1012. X    ep->s1 = ep->s2 = ep->s3 = 0;
  1013. X    ep->highest = Maxintlet;
  1014. X    ep->copybuffer = Vnil;
  1015. X#ifdef RECORDING
  1016. X    ep->oldmacro = ep->newmacro = Vnil;
  1017. X#endif /* RECORDING */
  1018. X    ep->generation = 0;
  1019. X    ep->changed = No;
  1020. X}
  1021. X
  1022. X/*
  1023. X * Find out if the current position is higher in the tree
  1024. X * than `ever' before (as remembered in ep->highest).
  1025. X * The algorithm of pathlength() is repeated here to gain
  1026. X * some efficiency by stopping as soon as it is clear
  1027. X * no change can occur.
  1028. X * (Higher() is called VERY often, so this pays).
  1029. X */
  1030. X
  1031. XVisible Procedure
  1032. Xhigher(ep)
  1033. X    register environ *ep;
  1034. X{
  1035. X    register path p = ep->focus;
  1036. X    register int pl = 0;
  1037. X    register int max = ep->highest;
  1038. X
  1039. X    while (p) {
  1040. X        ++pl;
  1041. X        if (pl >= max)
  1042. X            return;
  1043. X        p = parent(p);
  1044. X    }
  1045. X    ep->highest = pl;
  1046. X}
  1047. X
  1048. X#ifndef NDEBUG
  1049. X
  1050. X/*
  1051. X * Issue debug status message.
  1052. X */
  1053. X
  1054. XVisible Procedure
  1055. Xdbmess(ep)
  1056. X    register environ *ep;
  1057. X{
  1058. X#ifndef SMALLSYS
  1059. X    char stuff[80];
  1060. X    register string str = stuff;
  1061. X
  1062. X    switch (ep->mode) {
  1063. X    case VHOLE:
  1064. X        sprintf(stuff, "VHOLE:%d.%d", ep->s1, ep->s2);
  1065. X        break;
  1066. X    case FHOLE:
  1067. X        sprintf(stuff, "FHOLE:%d.%d", ep->s1, ep->s2);
  1068. X        break;
  1069. X    case ATBEGIN:
  1070. X        str = "ATBEGIN";
  1071. X        break;
  1072. X    case ATEND:
  1073. X        str = "ATEND";
  1074. X        break;
  1075. X    case WHOLE:
  1076. X        str = "WHOLE";
  1077. X        break;
  1078. X    case SUBRANGE:
  1079. X        sprintf(stuff, "SUBRANGE:%d.%d-%d", ep->s1, ep->s2, ep->s3);
  1080. X        break;
  1081. X    case SUBSET:
  1082. X        sprintf(stuff, "SUBSET:%d-%d", ep->s1, ep->s2);
  1083. X        break;
  1084. X    case SUBLIST:
  1085. X        sprintf(stuff, "SUBLIST...%d", ep->s3);
  1086. X        break;
  1087. X    default:
  1088. X        sprintf(stuff, "UNKNOWN:%d,%d,%d,%d",
  1089. X            ep->mode, ep->s1, ep->s2, ep->s3);
  1090. X    }
  1091. X    sprintf(messbuf,
  1092. X#ifdef SAVEBUF
  1093. X        "%s, %s, wi=%d, hi=%d, (y,x,l)=(%d,%d,%d) %s",
  1094. X        symname(symbol(tree(ep->focus))),
  1095. X#else /* !SAVEBUF */
  1096. X        "%d, %s, wi=%d, hi=%d, (y,x,l)=(%d,%d,%d) %s",
  1097. X        symbol(tree(ep->focus)),
  1098. X#endif /* SAVEBUF */
  1099. X        str, nodewidth(tree(ep->focus)), ep->highest,
  1100. X        Ycoord(ep->focus), Xcoord(ep->focus), Level(ep->focus),
  1101. X            ep->spflag ? "spflag on" : "");
  1102. X#endif /* !SMALLSYS */
  1103. X    edmessage(messbuf);
  1104. X}
  1105. X
  1106. X#endif /* NDEBUG */
  1107. X
  1108. X#ifndef SMALLSYS
  1109. X
  1110. XHidden bool
  1111. Xcanexit(ep)
  1112. X    environ *ep;
  1113. X{
  1114. X    environ ev;
  1115. X
  1116. X    shrink(ep);
  1117. X    if (ishole(ep))
  1118. X        VOID deltext(ep);
  1119. X    Ecopy(*ep, ev);
  1120. X    top(&ep->focus);
  1121. X    higher(ep);
  1122. X    ep->mode = WHOLE;
  1123. X    if (findhole(&ep->focus)) {
  1124. X        Erelease(ev);
  1125. X        ederr(EXIT_HOLES); /* There are holes left */
  1126. X        return No;
  1127. X    }
  1128. X    Erelease(*ep);
  1129. X    Emove(ev, *ep);
  1130. X    return Yes;
  1131. X}
  1132. X
  1133. X
  1134. XHidden bool
  1135. Xfindhole(pp)
  1136. X    register path *pp;
  1137. X{
  1138. X    register node n = tree(*pp);
  1139. X
  1140. X    if (Is_etext(n))
  1141. X        return No;
  1142. X    if (symbol(n) == Hole)
  1143. X        return Yes;
  1144. X    if (!down(pp))
  1145. X        return No;
  1146. X    for (;;) {
  1147. X        if (findhole(pp))
  1148. X            return Yes;
  1149. X        if (!rite(pp))
  1150. X            break;
  1151. X
  1152. X    }
  1153. X    if (!up(pp)) Abort();
  1154. X    return No;
  1155. X}
  1156. X
  1157. X#endif /* !SMALLSYS */
  1158. X
  1159. X/* ------------------------------------------------------------------ */
  1160. X
  1161. X#ifdef SAVEBUF
  1162. X
  1163. X/*
  1164. X * Write a node.
  1165. X */
  1166. X
  1167. X#ifdef DUMPING_QUEUES
  1168. XVisible Procedure
  1169. X#else
  1170. XHidden Procedure
  1171. X#endif
  1172. Xwritenode(n, fp)
  1173. X    node n;
  1174. X    FILE *fp;
  1175. X{
  1176. X    int nch;
  1177. X    int i;
  1178. X
  1179. X    if (!n) {
  1180. X        fputs("(0)", fp);
  1181. X        return;
  1182. X    }
  1183. X    if (((value)n)->type == Etex) {
  1184. X        writetext((value)n, fp);
  1185. X        return;
  1186. X    }
  1187. X    nch = nchildren(n);
  1188. X    fprintf(fp, "(%s", symname(symbol(n)));
  1189. X    for (i = 1; i <= nch; ++i) {
  1190. X        putc(',', fp);
  1191. X        writenode(child(n, i), fp);
  1192. X    }
  1193. X    fputc(')', fp);
  1194. X}
  1195. X
  1196. X
  1197. XHidden Procedure
  1198. Xwritetext(v, fp)
  1199. X    value v;
  1200. X    FILE *fp;
  1201. X{
  1202. X    intlet k, len;
  1203. X    int c;
  1204. X
  1205. X    Assert(v && Is_etext(v));
  1206. X    len= e_length(v);
  1207. X    putc('\'', fp);
  1208. X    for (k= 0; k<len; ++k) {
  1209. X        c= e_ncharval(k+1, v);
  1210. X        if (c == ' ' || isprint(c)) {
  1211. X            putc(c, fp);
  1212. X            if (c == '\'' || c == '`')
  1213. X                putc(c, fp);
  1214. X        }
  1215. X        else if (isascii(c))
  1216. X            fprintf(fp, "`$%d`", c);
  1217. X    }
  1218. X    putc('\'', fp);
  1219. X}
  1220. X
  1221. X
  1222. XVisible bool
  1223. Xsavequeue(v, filename)
  1224. X    value v;
  1225. X    string filename;
  1226. X{
  1227. X    register FILE *fp;
  1228. X    auto queue q = (queue)v;
  1229. X    register node n;
  1230. X    register bool ok;
  1231. X    register int lines = 0;
  1232. X
  1233. X    fp = fopen(filename, "w");
  1234. X    if (!fp)
  1235. X        return No;
  1236. X    q = qcopy(q);
  1237. X    while (!emptyqueue(q)) {
  1238. X        n = queuebehead(&q);
  1239. X        writenode(n, fp);
  1240. X        putc('\n', fp);
  1241. X        ++lines;
  1242. X        noderelease(n);
  1243. X    }
  1244. X    ok = fclose(fp) != EOF;
  1245. X    if (!lines)
  1246. X        /* Try to */ unlink(filename); /***** UNIX! *****/
  1247. X    return ok;
  1248. X}
  1249. X#endif /* SAVEBUF */
  1250. X
  1251. X#ifdef SAVEBUF
  1252. X#ifdef EDITRACE
  1253. Xextern FILE *dumpfp;
  1254. X
  1255. XVisible Procedure dumpev(ep, m) register environ *ep; string m;
  1256. X{
  1257. X    char stuff[80];
  1258. X    register string str = stuff;
  1259. X    path pa;
  1260. X    node n;
  1261. X    int ich;
  1262. X    static int idump;
  1263. X    
  1264. X    if (dumpfp == NULL)
  1265. X        return;
  1266. X    
  1267. X    idump++;
  1268. X    fprintf(dumpfp, "+++ EV %d: %s +++\n", idump, m);
  1269. X    
  1270. X    switch (ep->mode) {
  1271. X    case VHOLE:
  1272. X        sprintf(str, "VHOLE:%d.%d", ep->s1, ep->s2);
  1273. X        break;
  1274. X    case FHOLE:
  1275. X        sprintf(str, "FHOLE:%d.%d", ep->s1, ep->s2);
  1276. X        break;
  1277. X    case ATBEGIN:
  1278. X        str = "ATBEGIN";
  1279. X        break;
  1280. X    case ATEND:
  1281. X        str = "ATEND";
  1282. X        break;
  1283. X    case WHOLE:
  1284. X        str = "WHOLE";
  1285. X        break;
  1286. X    case SUBRANGE:
  1287. X        sprintf(str, "SUBRANGE:%d.%d-%d", ep->s1, ep->s2, ep->s3);
  1288. X        break;
  1289. X    case SUBSET:
  1290. X        sprintf(str, "SUBSET:%d-%d", ep->s1, ep->s2);
  1291. X        break;
  1292. X    case SUBLIST:
  1293. X        sprintf(str, "SUBLIST...%d", ep->s3);
  1294. X        break;
  1295. X    default:
  1296. X        sprintf(str, "UNKNOWN:%d,%d,%d,%d",
  1297. X            ep->mode, ep->s1, ep->s2, ep->s3);
  1298. X    }
  1299. X    n= tree(ep->focus);
  1300. X    fprintf(dumpfp,
  1301. X        "%s, %s, wi=%d, hi=%d, (y,x,l)=(%d,%d,%d) %s %s\n",
  1302. X        (Is_etext(n) ? "<TEXT> " : symname(symbol(n))),
  1303. X        str, nodewidth(n), ep->highest,
  1304. X        Ycoord(ep->focus), Xcoord(ep->focus), Level(ep->focus),
  1305. X        ep->spflag ? "spflag on" : "",
  1306. X        ep->changed ? "changed" : "");
  1307. X    writenode(n, dumpfp);
  1308. X    pa= parent(ep->focus);
  1309. X    ich= ichild(ep->focus);
  1310. X    while (pa != NilPath) {
  1311. X        fprintf(dumpfp, " IN PARENT AT %d:\n", ich);
  1312. X        writenode(tree(pa), dumpfp);
  1313. X        ich= ichild(pa);
  1314. X        pa= parent(pa);
  1315. X    }
  1316. X    fprintf(dumpfp, "\n");
  1317. X    fflush(dumpfp);
  1318. X}
  1319. X#endif /*DUMPEV*/
  1320. X#endif /*SAVEBUF*/
  1321. END_OF_FILE
  1322.   if test 15951 -ne `wc -c <'abc/bed/e1edoc.c'`; then
  1323.     echo shar: \"'abc/bed/e1edoc.c'\" unpacked with wrong size!
  1324.   fi
  1325.   # end of 'abc/bed/e1edoc.c'
  1326. fi
  1327. if test -f 'abc/bint1/i1fun.c' -a "${1}" != "-c" ; then 
  1328.   echo shar: Will not clobber existing file \"'abc/bint1/i1fun.c'\"
  1329. else
  1330.   echo shar: Extracting \"'abc/bint1/i1fun.c'\" \(16456 characters\)
  1331.   sed "s/^X//" >'abc/bint1/i1fun.c' <<'END_OF_FILE'
  1332. X/* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1986. */
  1333. X
  1334. X/* Functions defined on numeric values. */
  1335. X
  1336. X#include <errno.h> /* For EDOM and ERANGE */
  1337. X
  1338. X#include "b.h"
  1339. X#include "feat.h"     /* for EXT_RANGE */
  1340. X#include "bobj.h"
  1341. X#include "i0err.h"
  1342. X#include "i1num.h"
  1343. X
  1344. X/*
  1345. X * The visible routines here implement predefined B arithmetic operators,
  1346. X * taking one or two numeric values as operands, and returning a numeric
  1347. X * value.
  1348. X * No type checking of operands is done: this must be done by the caller.
  1349. X */
  1350. X
  1351. Xtypedef value (*valfun)();
  1352. Xtypedef rational (*ratfun)();
  1353. Xtypedef real (*appfun)();
  1354. Xtypedef double (*mathfun)();
  1355. X
  1356. X/*
  1357. X * For the arithmetic functions (+, -, *, /) the same action is needed:
  1358. X * 1) if both operands are Integral, use function from int_* submodule;
  1359. X * 2) if both are Exact, use function from rat_* submodule (after possibly
  1360. X *    converting one of them from Integral to Rational);
  1361. X * 3) otherwise, make both approximate and use function from app_*
  1362. X *    submodule.
  1363. X * The functions performing the appropriate action for each of the submodules
  1364. X * are passed as parameters.
  1365. X * Division is a slight exception, since i/j can be a rational.
  1366. X * See `quot' below.
  1367. X */
  1368. X
  1369. XHidden value dyop(u, v, int_fun, rat_fun, app_fun)
  1370. X    value u, v;
  1371. X    valfun int_fun;
  1372. X    ratfun rat_fun;
  1373. X    appfun app_fun;
  1374. X{
  1375. X    if (Integral(u) && Integral(v))    /* Use integral operation */
  1376. X        return (*int_fun)(u, v);
  1377. X
  1378. X    if (Exact(u) && Exact(v)) {
  1379. X        rational u1, v1, a;
  1380. X
  1381. X        /* Use rational operation */
  1382. X
  1383. X        u1 = Integral(u) ? mk_rat((integer)u, int_1, 0, Yes) :
  1384. X                (rational) Copy(u);
  1385. X        v1 = Integral(v) ? mk_rat((integer)v, int_1, 0, Yes) :
  1386. X                (rational) Copy(v);
  1387. X        a = (*rat_fun)(u1, v1);
  1388. X        Release(u1);
  1389. X        Release(v1);
  1390. X
  1391. X        if (Denominator(a) == int_1 && Roundsize(a) == 0) {
  1392. X            integer b = (integer) Copy(Numerator(a));
  1393. X            Release(a);
  1394. X            return (value) b;
  1395. X        }
  1396. X
  1397. X        return (value) a;
  1398. X    }
  1399. X
  1400. X    /* Use approximate operation */
  1401. X
  1402. X    {
  1403. X        real u1, v1, a;
  1404. X        u1 = Approximate(u) ? (real) Copy(u) : (real) approximate(u);
  1405. X        v1 = Approximate(v) ? (real) Copy(v) : (real) approximate(v);
  1406. X        a = (*app_fun)(u1, v1);
  1407. X        Release(u1);
  1408. X        Release(v1);
  1409. X
  1410. X        return (value) a;
  1411. X    }
  1412. X}
  1413. X
  1414. X
  1415. XVisible value sum(u, v) value u, v; {
  1416. X    if (IsSmallInt(u) && IsSmallInt(v))
  1417. X        return (value) mk_int(
  1418. X            (double)SmallIntVal(u) + (double)SmallIntVal(v));
  1419. X    return dyop(u, v, (value (*)())int_sum, rat_sum, app_sum);
  1420. X}
  1421. X
  1422. XVisible value diff(u, v) value u, v; {
  1423. X    if (IsSmallInt(u) && IsSmallInt(v))
  1424. X        return (value) mk_int(
  1425. X            (double)SmallIntVal(u) - (double)SmallIntVal(v));
  1426. X    return dyop(u, v, (value (*)())int_diff, rat_diff, app_diff);
  1427. X}
  1428. X
  1429. XVisible value prod(u, v) value u, v; {
  1430. X    if (IsSmallInt(u) && IsSmallInt(v))
  1431. X        return (value) mk_int(
  1432. X            (double)SmallIntVal(u) * (double)SmallIntVal(v));
  1433. X    return dyop(u, v, (value (*)())int_prod, rat_prod, app_prod);
  1434. X}
  1435. X
  1436. X
  1437. X/*
  1438. X * We cannot use int_quot (which performs integer division with truncation).
  1439. X * Here is the routine we need.
  1440. X */
  1441. X
  1442. XHidden value xxx_quot(u, v) integer u, v; {
  1443. X
  1444. X    if (v == int_0) {
  1445. X        interr(ZERO_DIVIDE);
  1446. X        return (value) Copy(u);
  1447. X    }
  1448. X
  1449. X    return mk_exact(u, v, 0);
  1450. X}
  1451. X
  1452. XVisible value quot(u, v) value u, v; {
  1453. X    return dyop(u, v, xxx_quot, rat_quot, app_quot);
  1454. X}
  1455. X
  1456. X
  1457. X/*
  1458. X * Unary minus and abs follow the same principle but with only one operand.
  1459. X */
  1460. X
  1461. XVisible value negated(u) value u; {
  1462. X    if (IsSmallInt(u)) return mk_integer(-SmallIntVal(u));
  1463. X    if (Integral(u))
  1464. X        return (value) int_neg((integer)u);
  1465. X    if (Rational(u))
  1466. X        return (value) rat_neg((rational)u);
  1467. X    return (value) app_neg((real)u);
  1468. X}
  1469. X
  1470. X
  1471. XVisible value absval(u) value u; {
  1472. X    if (Integral(u)) {
  1473. X        if (Msd((integer)u) < 0)
  1474. X            return (value) int_neg((integer)u);
  1475. X    } else if (Rational(u)) {
  1476. X        if (Msd(Numerator((rational)u)) < 0)
  1477. X            return (value) rat_neg((rational)u);
  1478. X    } else if (Approximate(u) && Frac((real)u) < 0)
  1479. X        return (value) app_neg((real)u);
  1480. X
  1481. X    return Copy(u);
  1482. X}
  1483. X
  1484. X
  1485. X/*
  1486. X * The remaining operators follow less similar paths and some of
  1487. X * them contain quite subtle code.
  1488. X */
  1489. X
  1490. XVisible value mod(u, v) value u, v; {
  1491. X    value q, f, d, p;
  1492. X
  1493. X    if (v == (value)int_0 ||
  1494. X        Rational(v) && Numerator((rational)v) == int_0 ||
  1495. X        Approximate(v) && Frac((real)v) == 0) {
  1496. X        interr(MESS(600, "in x mod y, y is zero"));
  1497. X        return Copy(u);
  1498. X    }
  1499. X
  1500. X    if (Integral(u) && Integral(v))
  1501. X        return (value) int_mod((integer)u, (integer)v);
  1502. X
  1503. X    /* Compute `(u/v-floor(u/v))*v', which prevents loss of precision;
  1504. X       don't use `u-v*floor(u/v)', as in the formal definition of `mod'. */
  1505. X
  1506. X    q = quot(u, v);
  1507. X    f = floorf(q);
  1508. X    d = diff(q, f);
  1509. X    release(q);
  1510. X    release(f);
  1511. X    p = prod(d, v);
  1512. X    release(d);
  1513. X
  1514. X    return p;
  1515. X}
  1516. X
  1517. X
  1518. X/*
  1519. X * u**v has the most special cases of all the predefined arithmetic functions.
  1520. X */
  1521. X
  1522. XVisible value power(u, v) value u, v; {
  1523. X    real ru, rv, rw;
  1524. X    if (Exact(u) && (Integral(v) ||
  1525. X            /* Next check catches for integers disguised as rationals: */
  1526. X            Rational(v) && Denominator((rational)v) == int_1)) {
  1527. X        rational a;
  1528. X        integer b = Integral(v) ? (integer)v : Numerator((rational)v);
  1529. X            /* Now b is really an integer. */
  1530. X
  1531. X        u = Integral(u) ? (value) mk_rat((integer)u, int_1, 0, Yes) :
  1532. X                Copy(u);
  1533. X        a = rat_power((rational)u, b);
  1534. X        Release(u);
  1535. X        if (Denominator(a) == int_1) { /* Make integral result */
  1536. X            b = (integer) Copy(Numerator(a));
  1537. X            Release(a);
  1538. X            return (value)b;
  1539. X        }
  1540. X        return (value)a;
  1541. X    }
  1542. X
  1543. X    if (Exact(v)) {
  1544. X        integer vn, vd;
  1545. X        int s;
  1546. X        ru = (real) approximate(u);
  1547. X        if (v == (value) int_2) {
  1548. X            /* speed up common formula u**2 */
  1549. X            rw= app_prod(ru, ru);
  1550. X            Release(ru);
  1551. X            return (value) rw;
  1552. X        }
  1553. X        if (about2_to_integral(ru, v, &rv)) {
  1554. X            /* to speed up reading the value of an approximate
  1555. X             * from a file, the exponent part is stored as
  1556. X             * ~2**expo; 
  1557. X             * we want to return the value (0.5, expo+1) to 
  1558. X             * prevent loss of precision, but the normal way
  1559. X             * via app_power() isn't good enough;
  1560. X             */
  1561. X            Release(ru);
  1562. X            return (value) rv;
  1563. X        }
  1564. X        s = (Frac(ru) > 0) - (Frac(ru) < 0);
  1565. X
  1566. X        if (s < 0) rv = app_neg(ru), Release(ru), ru = rv;
  1567. X        if (Integral(v)) {
  1568. X            vn = (integer)v;
  1569. X            vd = int_1;
  1570. X        } else {
  1571. X            vd = Denominator((rational)v);
  1572. X            if (s < 0 && Even(Lsd(vd)))
  1573. X                interr(NEG_EVEN);
  1574. X            vn = Numerator((rational)v);
  1575. X        }
  1576. X        if (vn == int_0) {
  1577. X            Release(ru);
  1578. X            return one;
  1579. X        }
  1580. X        if (s == 0 && Msd(vn) < 0) {
  1581. X            interr(NEG_POWER);
  1582. X            return (value) ru;
  1583. X        }
  1584. X        if (s < 0 && Even(Lsd(vn)))
  1585. X            s = 1;
  1586. X        rv = (real) approximate(v);
  1587. X        rw = app_power(ru, rv);
  1588. X        Release(ru), Release(rv);
  1589. X        if (s < 0) ru = app_neg(rw), Release(rw), rw = ru;
  1590. X        return (value) rw;
  1591. X    }
  1592. X
  1593. X    /* Everything else: we now know u or v is approximate */
  1594. X
  1595. X    ru = (real) approximate(u);
  1596. X    if (Frac(ru) < 0) {
  1597. X        interr(NEG_EXACT);
  1598. X        return (value) ru;
  1599. X    }
  1600. X    rv = (real) approximate(v);
  1601. X    if (Frac(ru) == 0 && Frac(rv) < 0) {
  1602. X        interr(NEG_POWER);
  1603. X        Release(rv);
  1604. X        return (value) ru;
  1605. X    }
  1606. X    rw = app_power(ru, rv);
  1607. X    Release(ru), Release(rv);
  1608. X    return (value) rw;
  1609. X}
  1610. X
  1611. X
  1612. X/*
  1613. X * floor: for approximate numbers app_floor() is used;
  1614. X * for integers it is a no-op; other exact numbers effectively calculate
  1615. X * u - (u mod 1).
  1616. X */
  1617. X
  1618. XVisible value floorf(u) value u; {
  1619. X    integer quo, rem, v;
  1620. X    digit div;
  1621. X
  1622. X    if (Integral(u)) return Copy(u);
  1623. X    if (Approximate(u)) return (value) app_floor((real)u);
  1624. X
  1625. X    /* It is a rational number */
  1626. X
  1627. X    div = int_ldiv(Numerator((rational)u), Denominator((rational)u),
  1628. X        &quo, &rem);
  1629. X    if (div < 0 && rem != int_0) { /* Correction for negative noninteger */
  1630. X        v = int_diff(quo, int_1);
  1631. X        Release(quo);
  1632. X        quo = v;
  1633. X    }
  1634. X    Release(rem);
  1635. X    return (value) quo;
  1636. X}
  1637. X
  1638. X
  1639. X/*
  1640. X * ceiling x is defined as -floor(-x);
  1641. X * and that's how it's implemented, except for integers.
  1642. X */
  1643. X
  1644. XVisible value ceilf(u) value u; {
  1645. X    value v;
  1646. X    if (Integral(u)) return Copy(u);
  1647. X    u = negated(u);
  1648. X    v = floorf(u);
  1649. X    release(u);
  1650. X    u = negated(v);
  1651. X    release(v);
  1652. X    return u;
  1653. X}
  1654. X
  1655. X
  1656. X/*
  1657. X * round u is defined as floor(u+0.5), which is what is done here,
  1658. X * except for integers which are left unchanged;
  1659. X * for rationals the sum u+0.5 isn't normalized; there is no harm in
  1660. X * that because of the division in floorf()
  1661. X */
  1662. X
  1663. XVisible value round1(u) value u; {
  1664. X    value v, w; bool neg = No;
  1665. X
  1666. X    if (Integral(u)) return Copy(u);
  1667. X
  1668. X    if (numcomp(u, zero) < 0) {
  1669. X        neg = Yes;
  1670. X        u = negated(u);
  1671. X    }
  1672. X    
  1673. X    if (Approximate(u)) {
  1674. X        value w = approximate((value) rat_half);
  1675. X        v = (value) app_sum((real) u, (real) w);
  1676. X        release(w);
  1677. X    }
  1678. X    else v = (value) ratsumhalf((rational) u);
  1679. X
  1680. X    w = floorf(v);
  1681. X    release(v);
  1682. X    
  1683. X    if (neg) {
  1684. X        release(u);
  1685. X        w = negated(v=w);
  1686. X        release(v);
  1687. X    }
  1688. X
  1689. X    return w;
  1690. X}
  1691. X
  1692. X
  1693. X/*
  1694. X * u round v is defined as 10**-u * round(v*10**u).
  1695. X * A complication is that u round v is always printed with exactly u digits
  1696. X * after the decimal point, even if this involves trailing zeros,
  1697. X * or if v is an integer.
  1698. X * Consequently, the result is always kept as a rational, even if it can be
  1699. X * simplified to an integer, and the size field of the rational number
  1700. X * (which is made negative to distinguish it from integers, and < -1 to
  1701. X * distinguish it from approximate numbers) is used to store the number of
  1702. X * significant digits.
  1703. X * Thus a size of -2 means a normal rational number, and a size < -2
  1704. X * means a rounded number to be printed with (-2 - length) digits
  1705. X * after the decimal point.  This last expression can be retrieved using
  1706. X * the macro Roundsize(v) which should only be applied to Rational
  1707. X * numbers.
  1708. X *
  1709. X * prod10n() is a routine with does a fast multiplication with a ten power
  1710. X * and does not simplify a rational result sometimes.
  1711. X */
  1712. X
  1713. XVisible value round2(n, v) value n, v; {
  1714. X    value w;
  1715. X    int i;
  1716. X
  1717. X    if (!Integral(n)) {
  1718. X        interr(MESS(601, "in n round x, n is not an integer"));
  1719. X        i = 0;
  1720. X    } else
  1721. X        i = propintlet(intval(n));
  1722. X
  1723. X    w = Approximate(v) ? exactly(v) : copy(v);
  1724. X
  1725. X    v = prod10n(w, i, No);
  1726. X        /* v will be rounded, so it isn't simplified if a rational */
  1727. X    release(w);
  1728. X
  1729. X    v = round1(w = v);
  1730. X    release(w);
  1731. X
  1732. X    v = prod10n(w = v, -i, Yes);
  1733. X    release(w);
  1734. X
  1735. X    if (i > 0) {    /* Set number of digits to be printed */
  1736. X        if (propintlet(-2 - i) < -2) {
  1737. X            if (Rational(v))
  1738. X                Length(v) = -2 - i;
  1739. X            else if (Integral(v)) {
  1740. X                w = v;
  1741. X                v = mk_exact((integer) w, int_1, i);
  1742. X                release(w);
  1743. X            }
  1744. X        }
  1745. X    }
  1746. X
  1747. X    return v;
  1748. X}
  1749. X
  1750. X
  1751. X/*
  1752. X * sign u inspects the sign of either u, u's numerator or u's fractional part.
  1753. X */
  1754. X
  1755. XVisible value signum(u) value u; {
  1756. X    int s;
  1757. X
  1758. X    if (Exact(u)) {
  1759. X        if (Rational(u))
  1760. X            u = (value) Numerator((rational)u);
  1761. X        s = u==(value)int_0 ? 0 : Msd((integer)u) < 0 ? -1 : 1;
  1762. X    } else
  1763. X        s = Frac((real)u) > 0 ? 1 : Frac((real)u) < 0 ? -1 : 0;
  1764. X
  1765. X    return MkSmallInt(s);
  1766. X}
  1767. X
  1768. X
  1769. X/*
  1770. X * ~u makes an approximate number of any numerical value.
  1771. X */
  1772. X
  1773. XVisible value approximate(u) value u; {
  1774. X    if (Approximate(u))
  1775. X        return Copy(u);
  1776. X    else if (IsSmallInt(u))
  1777. X        return (value) mk_approx((double) SmallIntVal(u), 0.0);
  1778. X    else
  1779. X        return app_frexp(u);
  1780. X}
  1781. X
  1782. X
  1783. X/*
  1784. X * exact(v) returns whether a number isn'y approximate
  1785. X */
  1786. X
  1787. XVisible bool exact(v) value v; {
  1788. X    return (bool) Exact(v);
  1789. X}
  1790. X
  1791. X/*
  1792. X * numerator v returns the numerator of v, whenever v is an exact number.
  1793. X * For integers, that is v itself.
  1794. X */
  1795. X
  1796. XVisible value numerator(v) value v; {
  1797. X    if (!Exact(v)) {
  1798. X        interr(MESS(602, "in */n, n is an approximate number"));
  1799. X        return zero;
  1800. X    }
  1801. X
  1802. X    if (Integral(v)) return Copy(v);
  1803. X
  1804. X    return Copy(Numerator((rational)v));
  1805. X}
  1806. X
  1807. X
  1808. X/*
  1809. X * The denominator of v, whenever v is an exact number.
  1810. X * For integers, that is 1.
  1811. X */
  1812. X
  1813. XVisible value denominator(v) value v; {
  1814. X    if (!Exact(v)) {
  1815. X        interr(MESS(603, "in /*n, n is an approximate number"));
  1816. X        return zero;
  1817. X    }
  1818. X
  1819. X    if (Integral(v)) return one;
  1820. X
  1821. X    return Copy(Denominator((rational)v));
  1822. X}
  1823. X
  1824. X
  1825. X/*
  1826. X * u root v is defined as v**(1/u), where u is usually but need not be
  1827. X * an integer.
  1828. X */
  1829. X
  1830. XVisible value root2(u, v) value u, v; {
  1831. X    if (u == (value)int_0 ||
  1832. X        Rational(u) && Numerator((rational)u) == int_0 ||
  1833. X        Approximate(u) && Frac((real)u) == 0) {
  1834. X        interr(MESS(604, "in n root x, n is zero"));
  1835. X        v = Copy(v);
  1836. X    } else {
  1837. X        u = quot((value)int_1, u);
  1838. X        v = power(v, u);
  1839. X        release(u);
  1840. X    }
  1841. X
  1842. X    return v;
  1843. X}
  1844. X
  1845. X/* root x is computed more exactly than n root x, by doing
  1846. X   one iteration step extra.  This ~guarantees root(n**2) = n. */
  1847. X
  1848. XVisible value root1(v) value v; {
  1849. X    value r, v_over_r, theirsum, result;
  1850. X    if (numcomp(v, zero) < 0) {
  1851. X        interr(MESS(605, "in root x, x is negative"));
  1852. X        return Copy(v);
  1853. X    }
  1854. X    r = root2((value)int_2, v);
  1855. X    if (Approximate(r) && Frac((real)r) == 0.0) return (value)r;
  1856. X    v_over_r = quot(v, r);
  1857. X    theirsum = sum(r, v_over_r), release(r), release(v_over_r);
  1858. X    result = quot(theirsum, (value)int_2), release(theirsum);
  1859. X    return result;
  1860. X}
  1861. X
  1862. X/* The rest of the mathematical functions */
  1863. X
  1864. XVisible value pi() { return (value) mk_approx(3.141592653589793238463, 0.0); }
  1865. XVisible value e() { return (value) mk_approx(2.718281828459045235360, 0.0); }
  1866. X
  1867. XHidden real over_two_pi(v) value v; {
  1868. X    real two_pi = mk_approx(6.283185307179586476926, 0.0);
  1869. X    real w = (real) approximate(v);
  1870. X    real res = app_quot(w, two_pi);
  1871. X    Release(two_pi); Release(w);
  1872. X    return res;
  1873. X}
  1874. XHidden value trig(u, v, ffun, zeroflag)
  1875. X    value u, v;
  1876. X    mathfun ffun;
  1877. X    bool zeroflag;
  1878. X{
  1879. X    real w;
  1880. X    double expo, frac, x, result;
  1881. X    extern int errno;
  1882. X    
  1883. X    
  1884. X    if (u != Vnil) { /* dyadic version */
  1885. X        real f = over_two_pi(u);
  1886. X        real rv = (real) approximate(v);
  1887. X        w = app_quot(rv, f);    /* check on f<>0 (= u<>0) in i3fpr.c */
  1888. X        Release(f); Release(rv);
  1889. X    }
  1890. X    else {
  1891. X        w = (real) approximate(v);
  1892. X    }
  1893. X    expo = Expo(w); frac = Frac(w);
  1894. X    if (expo <= Minexpo/2) {
  1895. X        if (zeroflag) return (value) w; /* sin small x = x, etc. */
  1896. X        frac = 0, expo = 0;
  1897. X    }
  1898. X    Release(w);
  1899. X    if (expo > Maxexpo) errno = EDOM;
  1900. X    else {
  1901. X        x = ldexp(frac, (int)expo);
  1902. X        if (x >= Maxtrig || x <= -Maxtrig) errno = EDOM;
  1903. X        else {
  1904. X            errno = 0;
  1905. X            result = (*ffun)(x);
  1906. X        }
  1907. X    }
  1908. X    if (errno != 0) {
  1909. X        if (errno == ERANGE)
  1910. X            interr(MESS(606, "result of math function too large"));
  1911. X        else if (errno == EDOM)
  1912. X            interr(MESS(607, "argument to math function too large"));
  1913. X        else interr(MESS(608, "math library error"));
  1914. X        return Copy(app_0);
  1915. X    }
  1916. X    return (value) mk_approx(result, 0.0);
  1917. X}
  1918. X
  1919. XVisible value sin1(v) value v; { return trig(Vnil, v, sin, Yes); }
  1920. XVisible value cos1(v) value v; { return trig(Vnil, v, cos, No); }
  1921. XVisible value tan1(v) value v; { return trig(Vnil, v, tan, Yes); }
  1922. XVisible value sin2(u, v) value u, v; { return trig(u, v, sin, Yes); }
  1923. XVisible value cos2(u, v) value u, v; { return trig(u, v, cos, No); }
  1924. XVisible value tan2(u, v) value u, v; { return trig(u, v, tan, Yes); }
  1925. X
  1926. XVisible value arctan1(v) value v; {
  1927. X    real w = (real) approximate(v);
  1928. X    double expo = Expo(w), frac = Frac(w);
  1929. X    if (expo <= Minexpo + 2) return (value) w; /* atan of small x = x */
  1930. X    Release(w);
  1931. X    if (expo > Maxexpo) expo = Maxexpo;
  1932. X    return (value) mk_approx(atan(ldexp(frac, (int)expo)), 0.0);
  1933. X}
  1934. X
  1935. XVisible value arctan2(u, v) value u, v; {
  1936. X    real av = (real) arctan1(v);
  1937. X    real f = over_two_pi(u);
  1938. X    real r = app_prod(av, f);
  1939. X    Release(av); Release(f);
  1940. X    return (value) r;
  1941. X}
  1942. X
  1943. XHidden double atn2(x, y) double x, y; {
  1944. X    if (x == 0.0 && y == 0.0)
  1945. X        return 0.0;
  1946. X    else
  1947. X        return atan2(x, y);
  1948. X}
  1949. X
  1950. XVisible value angle1(u, v) value u, v; {
  1951. X    real ru = (real) approximate(u), rv = (real) approximate(v);
  1952. X    double uexpo = Expo(ru), ufrac = Frac(ru);
  1953. X    double vexpo = Expo(rv), vfrac = Frac(rv);
  1954. X    Release(ru), Release(rv);
  1955. X    if (uexpo > Maxexpo) uexpo = Maxexpo;
  1956. X    if (vexpo > Maxexpo) vexpo = Maxexpo;
  1957. X    return (value) mk_approx(
  1958. X        atn2(
  1959. X            vexpo < Minexpo ? 0.0 : ldexp(vfrac, (int)vexpo),
  1960. X            uexpo < Minexpo ? 0.0 : ldexp(ufrac, (int)uexpo)),
  1961. X        0.0);
  1962. X}
  1963. X
  1964. XVisible value angle2(c, u, v) value c, u, v; {
  1965. X    real av = (real) angle1(u, v);
  1966. X    real f = over_two_pi(c);
  1967. X    real r = app_prod(av, f);
  1968. X    Release(av); Release(f);
  1969. X    return (value) r;
  1970. X}
  1971. X
  1972. XVisible value radius(u, v) value u, v; {
  1973. X    real x = (real) approximate(u);
  1974. X    real y = (real) approximate(v);
  1975. X    real x2 = app_prod(x, x);
  1976. X    real y2 = app_prod(y, y);
  1977. X    real x2y2 = app_sum(x2, y2);
  1978. X    value rad = root1((value) x2y2);
  1979. X    Release(x); Release(y);
  1980. X    Release(x2); Release(y2); Release(x2y2);
  1981. X    return rad;
  1982. X}
  1983. X
  1984. XVisible value exp1(v) value v; {
  1985. X    real w = (real) approximate(v);
  1986. X    real x = app_exp(w);
  1987. X    Release(w);
  1988. X    return (value) x;
  1989. X}
  1990. X
  1991. XVisible value log1(v) value v; {
  1992. X    real w, x;
  1993. X    if (numcomp(v, zero) <= 0) {
  1994. X        interr(MESS(609, "in log x, x <= 0"));
  1995. X        return copy(zero);
  1996. X    }
  1997. X    w = (real) approximate(v);
  1998. X    x = app_log(w);
  1999. X    Release(w);
  2000. X    return (value) x;
  2001. X}
  2002. X
  2003. XVisible value log2(u, v) value u, v;{
  2004. X    value w;
  2005. X    if (numcomp(u, zero) <= 0) {
  2006. X        interr(MESS(610, "in b log x, b <= 0"));
  2007. X        return copy(zero);
  2008. X    }
  2009. X    if (numcomp(v, zero) <= 0) {
  2010. X        interr(MESS(611, "in b log x, x <= 0"));
  2011. X        return copy(zero);
  2012. X    }
  2013. X    u = log1(u);
  2014. X    v = log1(v);
  2015. X    w = quot(v, u);
  2016. X    release(u), release(v);
  2017. X    return w;
  2018. X}
  2019. X
  2020. X/* exactly() converts a approximate number to an exact number */
  2021. X
  2022. XVisible value exactly(v) value v; {
  2023. X    if (exact(v))
  2024. X        return Copy(v);
  2025. X    else
  2026. X        return app_exactly((real) v);
  2027. X}
  2028. END_OF_FILE
  2029.   if test 16456 -ne `wc -c <'abc/bint1/i1fun.c'`; then
  2030.     echo shar: \"'abc/bint1/i1fun.c'\" unpacked with wrong size!
  2031.   fi
  2032.   # end of 'abc/bint1/i1fun.c'
  2033. fi
  2034. if test -f 'abc/ch_config' -a "${1}" != "-c" ; then 
  2035.   echo shar: Will not clobber existing file \"'abc/ch_config'\"
  2036. else
  2037.   echo shar: Extracting \"'abc/ch_config'\" \(230 characters\)
  2038.   sed "s/^X//" >'abc/ch_config' <<'END_OF_FILE'
  2039. X: 'Check if we are cross compiling'
  2040. X
  2041. Xcase $1 in
  2042. X'')    exit 0;;
  2043. X*)    echo "Please compile and run mkconfig on the destination machine"
  2044. X    echo "and copy the results to ./$2."
  2045. X    echo "Then call 'make all install'"
  2046. X    echo " "
  2047. X    exit 1;;
  2048. Xesac
  2049. END_OF_FILE
  2050.   if test 230 -ne `wc -c <'abc/ch_config'`; then
  2051.     echo shar: \"'abc/ch_config'\" unpacked with wrong size!
  2052.   fi
  2053.   chmod +x 'abc/ch_config'
  2054.   # end of 'abc/ch_config'
  2055. fi
  2056. echo shar: End of archive 10 \(of 25\).
  2057. cp /dev/null ark10isdone
  2058. MISSING=""
  2059. for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 ; do
  2060.     if test ! -f ark${I}isdone ; then
  2061.     MISSING="${MISSING} ${I}"
  2062.     fi
  2063. done
  2064. if test "${MISSING}" = "" ; then
  2065.     echo You have unpacked all 25 archives.
  2066.     rm -f ark[1-9]isdone ark[1-9][0-9]isdone
  2067. else
  2068.     echo You still must unpack the following archives:
  2069.     echo "        " ${MISSING}
  2070. fi
  2071. exit 0 # Just in case...
  2072.