home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / snobol / aisnobol / spitlib.spt < prev    next >
Text File  |  1987-10-12  |  43KB  |  1,505 lines
  1. * SPITLIB.SPT - SPITBOL-68K VERSION
  2. *
  3. * An auxiliary file, SPITLIB.IDX, maintains a table of pointers to
  4. * the functions in this file.
  5. *
  6. * AFTER MAKING ANY ALTERATION TO THIS FILE, BE SURE TO RUN THE BUILDLIB
  7. * PROGRAM TO CREATE A CURRENT VERSION OF SPITLIB.IDX.
  8. *
  9.  DEFINE('ABS(X)')     :(ABS.END)
  10. ABS
  11.        NUMARG( .ABS, 1,   .X)
  12.        ABS = GE(X,0) X    :S(RETURN)
  13.        ABS = -X      :(RETURN)
  14. ABS.END
  15. *
  16.  DEFINE('ACOS(X)K,TERM,T')     :(ACOS.END)
  17. ACOS
  18.        NUMARG( .ACOS, 1,  .X)
  19.        (LT(X,-1) TDUMP( .ACOS,  1))
  20.        (GT(X,1) TDUMP( .ACOS,  1))
  21.        ACOS = LT(X,0) P...I. - ACOS( -X)  :S(RETURN)
  22.        ACOS = 1.0
  23.        TERM = 1.0
  24.        X = DFLOAT(1 - X)
  25.        K = 1
  26. ACOS1
  27. +      TERM = DIV(TERM *  (2 * K - 1) * X,
  28. +               4 * K)
  29.        ACOS = ACOS + DIV(TERM, 2 *  K + 1)
  30.        K = K + 1
  31.        T = NE(ACOS,T) ACOS     :S(ACOS1)
  32.        ACOS = SQRT(2 * X) * ACOS    :(RETURN)
  33. ACOS.END
  34. *
  35.  DEFINE('ADD(X,Y)')      :(ADD.END)
  36. ADD
  37.        ADD =
  38. +         ( NUMARG(.ADD,1,.X) NUMARG(.ADD,2,.Y) )
  39. +         X + Y           :(RETURN)
  40. ADD.END
  41. *
  42.  DEFINE('ADDPROP(UNAME,VAL,PROP)PLT,LST,ELEM,FLAG')
  43.        :(ADDPROP.END)
  44. ADDPROP
  45.        UNAME = CONVERT(UNAME,'NAME')     :F(ADDPROP.ERROR1)
  46.        (IDENT(PROP)  TDUMP(.ADDPROP,2))
  47.        ( ~ATOM(PROP) NULL(PROP) TDUMP(.ADDPROP,2))
  48.        VAL = IDENT(VAL) NIL
  49.        ADDPROP = NIL
  50.        FLAG = ''
  51.        PLT = $'   PrOpErTy  LiSt  TaBlE   '
  52.        LST = ITEM(PLT,UNAME)
  53.        IDENT(LST)         :S(ADDPROP2)
  54.        ATOM(LST)          :S(ADDPROP.ERROR2)
  55.        NULL(LST)          :S(ADDPROP2)
  56. ADDPROP1
  57.        ELEM = POP( .LST)            :F(ADDPROP2)
  58.        ATOM(ELEM)         :S(ADDPROP.ERROR2)
  59.        ADDPROP = ~EQUAL(CAR(ELEM),PROP)
  60. +         ELEM ~ ADDPROP            :S(ADDPROP1)
  61.        DIFFER(FLAG)            :S(ADDPROP1)
  62.        FLAG = 1
  63.        ADDPROP = MEMQ(VAL,ELEM)
  64. +         ELEM ~ ADDPROP            :S(ADDPROP1)
  65.        ADDPROP = ?( ~ATOM(VAL) NULL(VAL) )
  66. +         ELEM ~ ADDPROP       :S(ADDPROP1)
  67.        ADDPROP = (PROP ~  VAL ~ CDR(ELEM)) ~ ADDPROP
  68. +         :(ADDPROP1)
  69. ADDPROP2
  70.        ADDPROP = DIFFER(FLAG)
  71. +         LREVERSE(ADDPROP)         :S(ADDPROP4)
  72.        ADDPROP = ?( ~ATOM(VAL) NULL(VAL) )
  73. +         (PROP ~ NIL) ~ LREVERSE(ADDPROP)    :S(ADDPROP4)
  74.        ADDPROP = (PROP ~ VAL ~ NIL) ~ LREVERSE(ADDPROP)
  75. ADDPROP4
  76.        ITEM(PLT,UNAME) = ADDPROP   :(RETURN)
  77. ADDPROP.ERROR1
  78.        TDUMP(.ADDPROP,1)
  79. ADDPROP.ERROR2
  80.        |''
  81.        |'Program error:  In ADDPROP,'
  82.        |'a property list is not a list of lists.'
  83.        |'The offending object is '
  84.        |LST
  85.        |''
  86.        TDUMP(.ADDPROP)
  87. ADDPROP.END
  88. *
  89.  DEFINE('ADD1(X)')        :(ADD1.END)
  90. ADD1
  91.       ADD1 = NUMARG(.ADD1,1,.X)    X + 1           :(RETURN)
  92. ADD1.END
  93. *
  94.  DEFINE('APPEND(LOL)L,A')      :(APPEND.END)
  95. APPEND
  96.       APPEND = LISTARG(.APPEND,1,.LOL)    NIL
  97. APPEND1  L = POP( .LOL)       :F(APPEND3)
  98.        LISTARG( .APPEND,  1, .L)
  99. APPEND2  APPEND = POP( .L) ~ APPEND
  100. +    :S(APPEND2)F(APPEND1)
  101. APPEND3   APPEND = LREVERSE(APPEND)       :(RETURN)
  102. APPEND.END
  103. *
  104.  DEFINE('ARITH(OP,ALIST)A')   :(ARITH.END)
  105. ARITH
  106.        (STRINGARG(.ARITH,1,.OP) LISTARG(.ARITH,2,.ALIST))
  107.        ( NULL(ALIST)    TDUMP( .ARITH, 2) )
  108.        ARITH = POP( .ALIST)
  109.        NUMARG( .ARITH, 2, .ARITH)
  110. ARITH1    A = POP( .ALIST)     :F(RETURN)
  111.        NUMARG( .ARITH, 2, .A)
  112.        ARITH = APPLY(OP,ARITH,A)    :S(ARITH1)
  113.        TDUMP( .ARITH)
  114. ARITH.END
  115. *
  116.  DEFINE('ASIN(X)')        :(ASIN.END)
  117. ASIN
  118.        NUMARG( .AS1N,  1, .X)
  119.        (LT(X,-1) TDUMP(.ASIN,1))
  120.        (GT(X,1) TDUMP(.ASIN, 1))
  121.        ASIN = DIV(P...I.,2) - ACOS(X)   :(RETURN)
  122. ASIN.END
  123. *
  124.  DEFINE('ASSOC(TG,L)C')         :(ASSOC.END)
  125. ASSOC
  126.        ASSOC = LISTARG(.ASSOC,2,.L)    NIL
  127. ASSOC1    C = POP( .L) :F(RETURN)
  128.        LISTARG( .ASSOC, 2, .C)
  129.        ASSOC = EQUAL(TG,CAR(C)) C ~ L
  130. +        :S(RETURN)F(ASSOC1)
  131. ASSOC.END
  132. *
  133.  DEFINE('ASSOCL(LTG,L)A')      :(ASSOCL.END)
  134. ASSOCL
  135.        ASSOCL =
  136. +         ( LISTARG(.ASSOCL,1,.LTG) LISTARG(.ASSOCL,2,.L) )
  137. +         NIL
  138. ASSOCL1
  139.        A = POP( .L)        :F(RETURN)
  140.        LISTARG( .ASSOCL,  2, .A)
  141.        ASSOCL = MEMQ(CAR(A),LTG)
  142. +        A ~ L           :S(RETURN)F(ASSOCL1)
  143. ASSOCL.END
  144. *
  145.  DEFINE('ATAN(X)')        :(ATAN.END)
  146. ATAN
  147.        NUMARG( .ATAN, 1,  .X)
  148.        ATAN = LT(X,0) -ATAN( -X)    :S(RETURN)
  149.        ATAN = ACOS(DIV(1, SQRT(1 + X * X)))   :(RETURN)
  150. ATAN.END
  151. *
  152.  DEFINE('ATOMP(A)')       :(ATOMP.END)
  153. ATOMP
  154.        ATOMP = NIL
  155.        ATOMP = ATOM(A) T       :(RETURN)
  156. ATOMP.END
  157. *
  158.  DEFINE('CAAAAR(L)')     :(CAAAAR.END)
  159. CAAAAR
  160.        LISTARG( .CAAAAR,  1, .L)
  161.        CAAAAR =
  162. +        (~ATOM(CAR(L))  ~ATOM(CAR(CAR(L))) ~ATOM(CAR(CAR(CAR(L)))))
  163. +             CAR(CAR(CAR(CAR(L))))     :S(RETURN)
  164.        TDUMP(.CAAAAR, 1)
  165. CAAAAR.END
  166. *
  167.  DEFINE('CAAADR(L)')     :(CAAADR.END)
  168. CAAADR
  169.        LISTARG( .CAAADR,  1, .L)
  170.        CAAADR =
  171. +        (~ATOM(CDR(L))  ~ATOM(CAR(CDR(L))) ~ATOM(CAR(CAR(CDR(L)))))
  172. +             CAR(CAR(CAR(CDR(L))))     :S(RETURN)
  173.        TDUMP(.CAAADR, 1)
  174. CAAADR.END
  175. *
  176.  DEFINE('CAAAR(L)')       :(CAAAR.END)
  177. CAAAR
  178.        LISTARG( .CAAAR, 1, .L)
  179.        ( ATOM(CAR(L)) TDUMP( .CAAAR, 1))
  180.        ( ATOM(CAR(CAR(L))) TDUMP(   .CAAAR, 1))
  181.        CAAAR = CAR(CAR(CAR(L)))     :(RETURN)
  182. CAAAR.END
  183. *
  184.  DEFINE('CAADAR(L)')     :(CAADAR.END)
  185. CAADAR
  186.        LISTARG( .CAADAR,  1, .L)
  187.        CAADAR =
  188. +       (~ATOM(CAR(L)) ~ATOM(CDR(CAR(L))) ~ATOM(CAR(CDR(CAR(L)))))
  189. +            CAR(CAR(CDR(CAR(L))))     :S(RETURN)
  190.        TDUMP(.CAADAR, 1)
  191. CAADAR.END
  192. *
  193.  DEFINE('CAADDR(L)')      :(CAADDR.END)
  194. CAADDR
  195.        LISTARG( .CAADDR, 1,  .L)
  196.        CAADDR =
  197. +       (~ATOM(CDR(L))  ~ATOM(CDR(CDR(L))) ~ATOM(CAR(CDR(CDR(L)))))
  198. +            CAR(CAR(CDR(CDR(L))))     :S(RETURN)
  199.        TDUMP(.CAADDR, 1)
  200. CAADDR.END
  201. *
  202.  DEFINE('CAADR(L)')       :(CAADR.END)
  203. CAADR
  204.        LISTARG(  .CAADR, 1, .L)
  205.        ( ATOM(CDR(L)) TDUMP( .CAADR, 1))
  206.        ( ATOM(CAR(CDR(L))) TDUMP(   .CAADR, 1))
  207.        CAADR = CAR(CAR(CDR(L)))     :(RETURN)
  208. CAADR.END
  209. *
  210.  DEFINE('CAAR(L)')       :(CAAR.END)
  211. CAAR
  212.        LISTARG(  .CAAR, 1, .L)
  213.        ( ATOM(CAR(L)) TDUMP(  .CAAR, 1))
  214.        CAAR =  CAR(CAR(L))      :(RETURN)
  215. CAAR.END
  216. *
  217.  DEFINE('CADAAR(L)')    :(CADAAR.END)
  218. CADAAR
  219.        LISTARG(  .CADAAR, 1, .L)
  220.        CADAAR =
  221. +       (~ATOM(CAR(L)) ~ATOM(CAR(CAR(L))) ~ATOM(CDR(CAR(CAR(L)))))
  222. +            CAR(CDR(CAR(CAR(L))))     :S(RETURN)
  223.        TDUMP( .CADAAR, 1)
  224. CADAAR.END
  225. *
  226.  DEFINE('CADADR(L)')      :(CADADR.END)
  227. CADADR
  228.        LISTARG( .CADADR,   1, .L)
  229.        CADADR =
  230. +       (~ATOM(CDR(L))  ~ATOM(CAR(CDR(L))) ~ATOM(CDR(CAR(CDR(L)))))
  231. +            CAR(CDR(CAR(CDR(L))))     :S(RETURN)
  232.        TDUMP(.CADADR, 1)
  233. CADADR.END
  234. *
  235.  DEFINE('CADAR(L)')       :(CADAR.END)
  236. CADAR
  237.        LISTARG(  .CADAR, 1, .L)
  238.        ( ATOM(CAR(L)) TDUMP(  .CADAR, 1))
  239.        ( ATOM(CDR(CAR(L))) TDUMP(   .CADAR, 1))
  240.        CADAR = CAR(CDR(CAR(L)))     :(RETURN)
  241. CADAR.END
  242. *
  243.  DEFINE('CADDAR(L)')       :(CADDAR.END)
  244. CADDAR
  245.        LISTARG(.CADDAR,1,.L)
  246.        CADDAR =
  247. +         (~ATOM(CAR(L))  ~ATOM(CDR(CAR(L))) ~ATOM(CDR(CDR(CAR(L)))))
  248. +              CAR(CDR(CDR(CAR(L))))     :S(RETURN)
  249.        TDUMP(.CADDAR, 1)
  250. CADDAR.END
  251. *
  252.  DEFINE('CADDDR(L)')       :(CADDDR.END)
  253. CADDDR
  254.        LISTARG(.CADDDR, 1, .L)
  255.        CADDDR =
  256. +         (~ATOM(CDR(L))  ~ATOM(CDR(CDR(L))) ~ATOM(CDR(CDR(CDR(L)))))
  257. +              CAR(CDR(CDR(CDR(L))))     :S(RETURN)
  258.        TDUMP(.CADDDR,1)
  259. CADDDR.END
  260. *
  261.  DEFINE('CADDR(L)')        :(CADDR.END)
  262. CADDR
  263.        LISTARG( .CADDR, 1, .L)
  264.        ( ATOM(CDR(L)) TDUMP( .CADDR,  1))
  265.        ( ATOM(CDR(CDR(L))) TDUMP( .CADDR, 1))
  266.        CADDR = CAR(CDR(CDR(L)))    :(RETURN)
  267. CADDR.END
  268. *
  269.  DEFINE('CADR(L)')       :(CADR.END)
  270. CADR
  271.        LISTARG( .CADR, 1, .L)
  272.        ( ATOM(CDR(L)) TDUMP( .CADR,  1))
  273.        CADR =  CAR(CDR(L))      :(RETURN)
  274. CADR.END
  275. *
  276.  DEFINE('CAL(A)N')        :(CAL.END)
  277. CAL
  278.        (DIFFER('ARRAY',DATATYPE(A)) TDUMP( .CAL, 1))
  279.        CAL = NIL
  280.        N  = PROTOTYPE(A)
  281.        N  = CONVERT(N,'INTEGER')    :S(CAL1)
  282.        TDUMP( .CAL, 1)
  283. CAL1   GT(N,0)        :F(RETURN)
  284.        CAL = A<N> ~ CAL
  285.        N = N -  1          :(CAL1)
  286. CAL.END
  287. *
  288.  DEFINE('CDAAAR(L)')      :(CDAAAR.END)
  289. CDAAAR
  290.        LISTARG( .CDAAAR,  1, .L)
  291.        CDAAAR =
  292. +         (~ATOM(CAR(L)) ~ATOM(CAR(CAR(L))) ~ATOM(CAR(CAR(CAR(L)))))
  293. +             CDR(CAR(CAR(CAR(L))))     :S(RETURN)
  294.        TDUMP(.CDAAAR,1)
  295. CDAAAR.END
  296. *
  297.  DEFINE('CDAADR(L)')      :(CDAADR.END)
  298. CDAADR
  299.        LISTARG(.CDAADR,1,.L)
  300.        CDAADR =
  301. +         (~ATOM(CDR(L)) ~ATOM(CAR(CDR(L))) ~ATOM(CAR(CAR(CDR(L)))))
  302. +             CDR(CAR(CAR(CDR(L))))     :S(RETURN)
  303.        TDUMP(.CDAADR,1)
  304. CDAADR.END
  305. *
  306.  DEFINE('CDAAR(L)')       :(CDAAR.END)
  307. CDAAR
  308.        LISTARG( .CDAAR, 1, .L)
  309.        ( ATOM(CAR(L)) TDUMP( .CDAAR,  1))
  310.        ( ATOM(CAR(CAR(L))) TDUMP( .CDAAR, 1))
  311.        CDAAR = CDR(CAR(CAR(L)))     :(RETURN)
  312. CDAAR.END
  313. *
  314.  DEFINE('CDADAR(L)')      :(CDADAR.END)
  315. CDADAR
  316.        LISTARG(.CDADAR,1,.L)
  317.        CDADAR =
  318. +         (~ATOM(CAR(L)) ~ATOM(CDR(CAR(L))) ~ATOM(CAR(CDR(CAR(L)))))
  319. +             CDR(CAR(CDR(CAR(L))))     :S(RETURN)
  320.        TDUMP(.CDADAR,1)
  321. CDADAR.END
  322. *
  323.  DEFINE('CDADDR(L)')      :(CDADDR.END)
  324. CDADDR
  325.        LISTARG(.CDADDR, 1, .L)
  326.        CDADDR =
  327. +         (~ATOM(CDR(L)) ~ATOM(CDR(CDR(L))) ~ATOM(CAR(CDR(CDR(L)))))
  328. +             CDR(CAR(CDR(CDR(L))))     :S(RETURN)
  329.        TDUMP(.CDADDR,1)
  330. CDADDR.END
  331. *
  332.  DEFINE('CDADR(L)')     :(CDADR.END)
  333. CDADR
  334.        LISTARG( .CDADR, 1, .L)
  335.        ( ATOM(CDR(L)) TDUMP( .CDADR, 1))
  336.        ( ATOM(CAR(CDR(L))) TDUMP( .CDADR, 1))
  337.        CDADR = CDR(CAR(CDR(L)))      :(RETURN)
  338. CDADR.END
  339. *
  340.  DEFINE('CDAR(L)')        :(CDAR.END)
  341. CDAR
  342.        LISTARG( .CDAR, 1, .L)
  343.        ( ATOM(CAR(L)) TDUMP( .CDAR,  1))
  344.        CDAR =  CDR(CAR(L))      :(RETURN)
  345. CDAR.END
  346. *
  347.  DEFINE('CDDAAR(L)')     :(CDDAAR.END)
  348. CDDAAR
  349.        LISTARG(.CDDAAR,1,.L)
  350.        CDDAAR =
  351. +         (~ATOM(CAR(L)) ~ATOM(CAR(CAR(L))) ~ATOM(CDR(CAR(CAR(L)))))
  352. +              CDR(CDR(CAR(CAR(L))))     :S(RETURN)
  353.        TDUMP(.CDDAAR,1)
  354. CDDAAR.END
  355. *
  356.  DEFINE('CDDADR(L)')      :(CDDADR.END)
  357. CDDADR
  358.        LISTARG(.CDDADR, 1, .L)
  359.        CDDADR =
  360. +         (~ATOM(CDR(L)) ~ATOM(CAR(CDR(L))) ~ATOM(CDR(CAR(CDR(L)))))
  361. +              CDR(CDR(CAR(CDR(L))))     :S(RETURN)
  362.        TDUMP(.CDDADR,1)
  363. CDDADR.END
  364. *
  365.  DEFINE('CDDAR(L)')      :(CDDAR.END)
  366. CDDAR
  367.        LISTARG( .CDDAR, 1, .L)
  368.        ( ATOM(CAR(L)) TDUMP( .CDDAR, 1))
  369.        ( ATOM(CDR(CAR(L))) TDUMP( .CDDAR, 1))
  370.        CDDAR = CDR(CDR(CAR(L)))     :(RETURN)
  371. CDDAR.END
  372. *
  373.  DEFINE('CDDDAR(L)')     :(CDDDAR.END)
  374. CDDDAR
  375.        LISTARG(.CDDDAR, 1, .L)
  376.        CDDDAR =
  377. +         (~ATOM(CAR(L)) ~ATOM(CDR(CAR(L))) ~ATOM(CDR(CDR(CAR(L)))))
  378. +              CDR(CDR(CDR(CAR(L))))     :S(RETURN)
  379.        TDUMP(.CDDDAR,1)
  380. CDDDAR.END
  381. *
  382.  DEFINE('CDDDDR(L)')      :(CDDDDR.END)
  383. CDDDDR
  384.        LISTARG(.CDDDDR,1,.L)
  385.        CDDDDR =
  386. +         (~ATOM(CDR(L)) ~ATOM(CDR(CDR(L))) ~ATOM(CDR(CDR(CDR(L)))))
  387. +              CDR(CDR(CDR(CDR(L))))     :S(RETURN)
  388.        TDUMP(.CDDDDR,1)
  389. CDDDDR.END
  390. *
  391.  DEFINE('CDDDR(L)')       :(CDDDR.END)
  392. CDDDR
  393.        LISTARG( .CDDDR, 1, .L)
  394.        ( ATOM(CDR(L)) TDUMP( .CDDDR, 1))
  395.        ( ATOM(CDR(CDR(L))) TDUMP( .CDDDR, 1))
  396.        CDDDR = CDR(CDR(CDR(L)))     :(RETURN)
  397. CDDDR.END
  398. *
  399.  DEFINE('CDDR(L)')        :(CDDR.END)
  400. CDDR
  401.        LISTARG( .CDDR, 1, .L)
  402.        ( ATOM(CDR(L)) TDUMP( .CDDR, 1))
  403.        CDDR = CDR(CDR(L))      :(RETURN)
  404. CDDR.END
  405. *
  406.  DEFINE('CEIL(X)')       :(CEIL.END)
  407. CEIL
  408.        NUMARG( .CEIL, 1, .X)
  409.        CEIL = -FLOOR( -X) :(RETURN)
  410. CEIL.END
  411. *
  412.  DEFINE('CLA(L)N')        :(CLA.END)
  413. CLA
  414.        N = LISTARG(.CLA,1,.L)   LENGTH(L)
  415.        ( LE(N,0)   TDUMP( .CLA, 1)  )
  416.        CLA = ARRAY(N)
  417.        N = 1
  418. CLA1  CLA<N> = POP( .L)        :F(RETURN)
  419.        N = N + 1     :(CLA1)
  420. CLA.END
  421. *
  422.  DEFINE('CLOG(X)FACTOR,T,K')        :(CLOG.END)
  423. CLOG
  424.        NUMARG( .CLOG, 1, .X)
  425.        (LE(X,0) TDUMP( .CLOG, 1))
  426.        X = DFLOAT(X)
  427.        FACTOR = DIV(X,X)
  428. CLOG1
  429.        X = LT(X,1) DIV(1,X)    :F(CLOG2)
  430.        FACTOR = -FACTOR
  431. CLOG2
  432.        CLOG = EQ(X,1.0)   0.0       :S(RETURN)
  433.        K = SIZE(FIX(X))  -  1       :F(CLOG4)
  434.        EQ(K)    :S(CLOG3)
  435.        CLOG = CLOG + K * FACTOR
  436.        T = NE(CLOG,T) CLOG     :F(CLOG5)
  437.        X = DIV(X,10.0 ** K)
  438. CLOG3
  439.        FACTOR = DIV(FACTOR,10)
  440.        X = X ** 10  :(CLOG1)
  441. CLOG4
  442.        K = 10
  443.        X = DIV(X,10.0 ** K)
  444.        CLOG = CLOG + K * FACTOR    :(CLOG2)
  445. CLOG5
  446.        :(RETURN)
  447. CLOG.END
  448. *
  449.  DEFINE('COS(A,S)K')         :(COS.END)
  450. COS    DEFINE('COS.(A,S)P2')
  451.        DEFINE('COS(A,S)K','COS0')
  452. COS0       ( NUMARG(.COS,1,.A) DIFFER(S) NUMARG(.COS,2,.S) )
  453.        (LT(S, -1) TDUMP( .COS, 2))
  454.        (GT(S, 1) TDUMP( .COS, 2))
  455.        COS = LT(A,0) COS( -A, S)   :S(RETURN)
  456.        COS = LT(A, 2 * P...I.) COS.( A, S)    :S(RETURN)
  457.        K = FIX( DIV( A, 2 * P...I.))
  458.        COS = COS.( A - K  * 2  * P...I., S)   :(RETURN)
  459. COS.
  460.        S = IDENT(S)  SIN(A)
  461.        COS. = SQRT( 1  - S * S)
  462.        P2 = DIV( P...I., 2)
  463.        COS. = (GT(A,P2) LT(A,3 * P2)) -COS.   :(RETURN)
  464. COS.END
  465. *
  466.  DEFINE('DEFPROP(A1,EXP,A2)')       :(DEFPROP.END)
  467. DEFPROP
  468.        DEFPROP = PUT(A1,A2,EXP)     :(RETURN)
  469. DEFPROP.END
  470. *
  471.  DEFINE('DEG(R)')    :(DEG.END)
  472. DEG
  473.        DEG = NUMARG(.DEG,1,.R)   R * 57.2957795131        :(RETURN)
  474. DEG.END
  475. *
  476.  DEFINE('DFLOAT(N)')      :(DFLOAT.END)
  477. DFLOAT
  478.        NUMARG( .DFLOAT, 1, .N)
  479.        DFLOAT = CONVERT(N,"REAL")   :(RETURN)
  480. DFLOAT.END
  481. *
  482.  DEFINE('DIFFERENCE(L)')       :(DIFFERENCE.END)
  483. DIFFERENCE
  484.        DIFFERENCE =  LISTARG(.DIFFERENCE,1,.L)
  485. +         ARITH(.SUB,L)        :(RETURN)
  486. DIFFERENCE.END
  487. *
  488.  DEFINE('DIV(X,Y)')       :(DIV.END)
  489. DIV
  490.        (NUMARG(.DIV,1,.X) NUMARG(.DIV,2,.Y))
  491. *      (EQ(Y,0) TDUMP(.DIV,2))      :S(FRETURN)
  492.        DIV = DFLOAT(X) /  DFLOAT(Y)      :(RETURN)
  493. DIV.END
  494. *
  495.  DEFINE('EQP(A1,A2)')       :(EQP.END)
  496. EQP
  497.        EQP = NIL
  498.        EQP = EQU(A1,A2) T      :(RETURN)
  499. EQP.END
  500. *
  501.  DEFINE('EQU(A1,A2)')     :(EQU.END)
  502. EQU    IDENT(A1,A2)       :S(RETURN)
  503.        ( ATOM(A1)    ATOM(A2) )          :F(FRETURN)
  504.        A1 = CONVERT(A1,"NUMERIC") :F(EQU1)
  505.        A2 = CONVERT(A2,"NUMERIC") :F(FRETURN)
  506.        EQ(A1,A2)               :S(RETURN)F(FRETURN)
  507. EQU1   LEQ(A1,A2)              :S(RETURN)F(FRETURN)
  508. EQU.END
  509. *
  510.  DEFINE('EQUAL(X,Y)')   :(EQUAL.END)
  511. EQUAL  EQU(X,Y)      :S(RETURN)
  512.        ATOM(X)                 :S(FRETURN)
  513.        ATOM(Y)                 :S(FRETURN)
  514.        EQUAL(CAR(X),CAR(Y))    :F(FRETURN)
  515.        EQUAL(CDR(X),CDR(Y))         :S(RETURN)F(FRETURN)
  516. EQUAL.END
  517. *
  518.  DEFINE('EQUALP(A1,A2)')       :(EQUALP.END)
  519. EQUALP
  520.        EQUALP = NIL
  521.        EQUALP = EQUAL(A1,A2) T      :(RETURN)
  522. EQUALP.END
  523. *
  524.  DEFINE('EVALCODE(S)')   :(EVALCODE.END)
  525. EVALCODE
  526.        S = CONVERT(S,"EXPRESSION")    :F(EVALCODE1)
  527.        EVALCODE = EVAL(S)      :S(RETURN)F(FRETURN)
  528. EVALCODE1
  529.        TDUMP('EVALCODE',1)
  530. EVALCODE.END
  531. *
  532.  DEFINE('EVERY(FN,L)A,V')   :(EVERY.END)
  533. EVERY
  534.        EVERY =
  535. +         (STRINGARG(.EVERY,1,.FN) LISTARG(.EVERY,2,.L))
  536. +         T
  537. EVERY1  A = POP( .L)   :F(RETURN)
  538.        %APPLY(FN,A)       :S(EVERY1)
  539.        EVERY = NIL  :(RETURN)
  540. EVERY.END
  541. *
  542.  DEFINE('EVLIS(EV...L.)EV...T.')         :(EVLIS.END)
  543. EVLIS
  544.        EVLIS = LISTARG( .EVLIS, 1, .EV...L. )   NIL
  545. EVLIS1
  546.        EV...T.  = POP( .EV...L. )        :F(EVLIS2)
  547.        EVLIS = $EV...T. ~ EVLIS          :(EVLIS1)
  548. EVLIS2
  549.        EVLIS = LREVERSE(EVLIS)           :(RETURN)
  550. EVLIS.END
  551. *
  552.  DEFINE('EXP(X)TERM,K,T')    :(EXP.END)
  553. EXP
  554.        NUMARG( .EXP, 1, .X)
  555.        EXP = LT(X) DIV(1,EXP(-X))  :S(RETURN)
  556.        X = DFLOAT(X)
  557.        K = GT(X,1) FIX(X)     :F(EXP1)
  558.        EXP = EXP(X - K) * NAT...BASE. **  K       :(RETURN)
  559. EXP1
  560. +      TERM = 1.0
  561. EXP2
  562. +      EXP = EXP + TERM
  563.        K = K + 1.0
  564.        TERM = DIV(TERM * X,K)
  565.        T = NE(T,EXP) EXP       :S(EXP2)F(RETURN)
  566. EXP.END
  567. *
  568.  DEFINE('EXPLODE(A)CH')       :(EXPLODE.END)
  569. EXPLODE
  570.        EXPLODE = NIL
  571.        A = ~ATOM(A) UNREAD(A)
  572.        A = REVERSE(A)       :F(EXPLODE2)
  573. EXPLODE1
  574.        A LEN(1) . CH =    :F(RETURN)
  575.        EXPLODE = LIST(CH,EXPLODE)    :(EXPLODE1)
  576. EXPLODE2
  577.        TDUMP( .EXPLODE, 1)
  578. EXPLODE.END
  579. *
  580.  DEFINE('FIND(TG,L)')    :(FIND.END)
  581. FIND
  582.        ATOM(L)       :F(FIND1)
  583.        FIND = EQU(L,TG) L      :S(RETURN)
  584.        FIND = NIL    :(RETURN)
  585. FIND1  FIND = NULL(L) NIL  :S(RETURN)
  586.        FIND = EQUAL(L,TG) L    :S(RETURN)
  587.        FIND = /FIND(TG,CAR(L))       :S(RETURN)
  588.        FIND = FIND(TG,CDR(L))        :(RETURN)
  589. FIND.END
  590. *
  591.  DEFINE('FIX(X)')   :(FIX.END)
  592. FIX
  593.        FIX = NUMARG(.FIX,1,.X) CONVERT(X,'INTEGER')
  594. +         :S(RETURN)F(FRETURN)
  595. FIX.END
  596. *
  597.  DEFINE('FLOAT(N)')      :(FLOAT.END)
  598. FLOAT
  599.        FLOAT = NUMARG(.FLOAT,1,.N)   CONVERT(N,'REAL')    :(RETURN)
  600. FLOAT.END
  601. *
  602.  DEFINE('FLOOR(X)')      :(FLOOR.END)
  603. FLOOR
  604.        NUMARG( .FLOOR, 1, .X)
  605.        FLOOR = FIX(X)
  606.        GE(X)    :S(RETURN)
  607.        FLOOR = NE(X,FLOOR) FLOOR - 1     :(RETURN)
  608. FLOOR.END
  609. *
  610.  DEFINE('GET(UNAME,PROP)PLT,LST,ELEM')       :(GET.END)
  611. GET
  612.        UNAME = CONVERT(UNAME,'NAME')    :F(GET.ERROR1)
  613.        (IDENT(PROP) TDUMP(.GET,2))
  614.        ( ~ATOM(PROP) NULL(PROP) TDUMP(.GET,2) )
  615.        GET = NIL
  616.        PLT = $'   PrOpErTy  LiSt  TaBlE   '
  617.        LST = ITEM(PLT,UNAME)
  618.        IDENT(LST)         :S(RETURN)
  619.        ATOM(LST)          :S(GET.ERROR2)
  620.        NULL(LST)          :S(RETURN)
  621. GET1
  622.        ELEM = POP( .LST)            :F(RETURN)
  623.        ATOM(ELEM)         :S(GET.ERROR2)
  624.        GET = EQUAL(CAR(ELEM),PROP)
  625. +         CDR(ELEM)             :S(RETURN)F(GET1)
  626. GET.ERROR1
  627.        TDUMP(.GET,1)
  628. GET.ERROR2
  629.        |''
  630.        |'Program error:  In GET,'
  631.        |'a property list is not a list of lists.'
  632.        |'The offending object is'
  633.        |LST
  634.        |''
  635.        TDUMP(.GET)
  636. GET.END
  637. *
  638.  DEFINE('GETL(UNAME,LPROP)PLT,LST,ELEM')       :(GETL.END)
  639. GETL
  640.        UNAME = CONVERT(UNAME,'NAME')     :F(GETL.ERROR1)
  641.        LISTARG( .GETL, 2, .LPROP)
  642.        GETL = NIL
  643.        PLT = $'   PrOpErTy  LiSt  TaBlE   '
  644.        LST = ITEM(PLT,UNAME)
  645.        IDENT(LST)         :S(RETURN)
  646.        ATOM(LST)          :S(GETL.ERROR2)
  647.        NULL(LST)          :S(RETURN)
  648. GETL1
  649.        ELEM = POP( .LST)            :F(RETURN)
  650.        ATOM(ELEM)         :S(GETL.ERROR2)
  651.        GETL = MEMQ(CAR(ELEM),LPROP)
  652. +         ELEM ~ LST             :S(RETURN)F(GETL1)
  653. GETL.ERROR1
  654.        TDUMP(.GETL,1)
  655. GETL.ERROR2
  656.        |''
  657.        |'Program error:   In GETL,'
  658.        |'a property list is not a list of lists.'
  659.        |'The offending object is'
  660.        |LST
  661.        |''
  662.        TDUMP(.GETL)
  663. GETL.END
  664. *
  665.  DEFINE('GETPROP(UNAME,PROP)PLT,LST,ELEM,FLAG,NEW') :(GETPROP.END)
  666. GETPROP
  667.        UNAME = CONVERT(UNAME,'NAME')    :F(GETPROP.ERROR1)
  668.        (IDENT(PROP) TDUMP(.GETPROP,2))
  669.        ( ~ATOM(PROP) NULL(PROP) TDUMP(.GETPROP,2) )
  670.        PLT = $'   PrOpErTy  LiSt  TaBlE   '
  671.        GETPROP = NIL
  672.        FLAG = ''
  673.        LST = ITEM(PLT,UNAME)
  674.        IDENT(LST)         :S(RETURN)
  675.        ATOM(LST)          :S(GETPROP.ERROR2)
  676.        NULL(LST)          :S(RETURN)
  677.        NEW = NIL
  678. GETPROP1
  679.        ELEM = POP( .LST)            :F(GETPROP2)
  680.        ATOM(ELEM)         :S(GETPROP.ERROR2)
  681.        NEW = ~EQUAL(CAR(ELEM),PROP)
  682. +         ELEM ~ NEW      :S(GETPROP1)
  683.        DIFFER(FLAG)       :S(GETPROP1)
  684.        FLAG = 1
  685.        ELEM = CDR(ELEM)
  686.        GETPROP = POP( .ELEM)
  687.        NEW = (PROP ~ ELEM) ~ NEW    :(GETPROP1)
  688. GETPROP2
  689.        ITEM(PLT,UNAME) = LREVERSE(NEW)  :(RETURN)
  690. GETPROP.ERROR1
  691.        TDUMP(.GETPROP,1)
  692. GETPROP.ERROR2
  693.        |''
  694.        |'Program error:   In GETPROP,'
  695.        |'a property list is not a list of lists.'
  696.        |'The offending object is'
  697.        |LST
  698.        |''
  699.        TDUMP(.GETPROP)
  700. GETPROP.END
  701. *
  702.  DEFINE('GREATER(L)A,B')       :(GREATER.END)
  703. GREATER
  704.        LISTARG( .GREATER, 1, .L)
  705.        A = POP( .L)       :F(RETURN)
  706.        NUMARG( .GREATER,  1, .A)
  707.        B = POP( .L)       :F(RETURN)
  708.        NUMARG( .GREATER,  1, .B)
  709. GREATER1     GT(A,B)      :F(FRETURN)
  710.        A = B
  711.        B = POP( .L)       :F(RETURN)
  712.        NUMARG( .GREATER,  1, .B)    :S(GREATER1)
  713. GREATER.END
  714. *
  715.  DEFINE('GREATERP(L)')    :(GREATERP.END)
  716. GREATERP
  717.        GREATERP =
  718. +         (LISTARG(.GREATERP,1,.L)  GREATER(L))
  719. +         T          :S(RETURN)
  720.        GREATERP = NIL          :(RETURN)
  721. GREATERP.END
  722. *
  723.  DEFINE('INSERT(S,L)')    :(INSERT.END)
  724. INSERT
  725.        LISTARG(.INSERT,2,.L)
  726.        INSERT = MEMQ(S,L) L    :S(RETURN)
  727.        INSERT = S ~ L          :(RETURN)
  728. INSERT.END
  729. *
  730.  DEFINE('INTERSECT(L1,L2)L,A')     :(INTERSECT.END)
  731. INTERSECT
  732.        INTERSECT =
  733. +         (LISTARG(.INTERSECT,1,.L1) LISTARG(.INTERSECT,2,.L2))
  734. +         NIL
  735. INTERSECT1    A = POP( .L1)      :F(INTERSECT2)
  736.        INTERSECT = MEMQ(A,L2) INSERT(A,INTERSECT)      :(INTERSECT1)
  737. INTERSECT2     INTERSECT = LREVERSE(INTERSECT)     :(RETURN)
  738. INTERSECT.END
  739. *
  740.  DEFINE('LAST(L)')        :(LAST.END)
  741. LAST
  742.        LISTARG( .LAST, 1, .L)
  743.        LAST = NULL(L) NIL      :S(RETURN)
  744.        LAST = ATOM( CDR(L)) L       :S(RETURN)
  745.        LAST = NULL( CDR(L)) L       :S(RETURN)
  746.        L = CDR(L)    :(LAST)
  747. LAST.END
  748. *
  749.  DEFINE('LCOPY(L)CA,CD')       :(LCOPY.END)
  750. LCOPY
  751.        LCOPY = ATOM(L) L       :S(RETURN)
  752.        LCOPY = NULL(L) NIL     :S(RETURN)
  753.        LCOPY = EQUAL(L,T) T    :S(RETURN)
  754.        CA = LCOPY(CAR(L))
  755.        CD = LCOPY(CDR(L))
  756.        LCOPY = CA ~ CD         :(RETURN)
  757. LCOPY.END
  758. *
  759.  DEFINE('LENGTH(L)')     :(LENGTH.END)
  760. LENGTH    LENGTH = ATOM(L) SIZE(L)        :S(RETURN)
  761.        LENGTH = 0
  762. LENGTH1  LENGTH = ?POP( .L)    LENGTH + 1
  763. +      :S(LENGTH1)F(RETURN)
  764. LENGTH.END
  765. *
  766.  DEFINE('LESS(L)A,B')     :(LESS.END)
  767. LESS
  768.        LISTARG( .LESS, 1, .L)
  769.        A = POP( .L)        :F(RETURN)
  770.        NUMARG( .LESS, 1, .A)
  771.        B = POP( .L)        :F(RETURN)
  772.        NUMARG( .LESS, 1, .B)
  773. LESS1     LT(A,B)    :F(FRETURN)
  774.        A = B
  775.        B = POP( .L)      :F(RETURN)
  776.        NUMARG( .LESS, 1, .B)  :S(LESS1)
  777. LESS.END
  778. *
  779.  DEFINE('LESSP(L)')       :(LESSP.END)
  780. LESSP
  781.        LISTARG( .LESSP, 1, .L)
  782.        LESSP = NIL
  783.        LESSP = LESS(L) T       :(RETURN)
  784. LESSP.END
  785. *
  786.  DEFINE('LOG(X,B)')      :(LOG.END)
  787. LOG
  788.        NUMARG(.LOG,1,.X)
  789.        (DIFFER(B) NUMARG(.LOG,2,.B))
  790.        (LE(X,0) TDUMP(.LOG,1))
  791.        (LT(B,0) TDUMP(.LOG,2))
  792.        (EQ(B,1) TDUMP(.LOG,2))
  793.        LOG = NE(B) DIV(CLOG(X),CLOG(B))       :S(RETURN)
  794.        LOG = EQ(B) MULT(CLOG(X),LN...10.)     :(RETURN)
  795. LOG.END
  796. *
  797.  DEFINE('LREVERSE(LST)')      :(LREVERSE.END)
  798. LREVERSE
  799.        LREVERSE = LISTARG(.LREVERSE,1,.LST)   NIL
  800. LREVERSE1 LREVERSE = POP( .LST) ~ LREVERSE
  801. +      :S(LREVERSE1)F(RETURN)
  802. LREVERSE.END
  803. *
  804.  DEFINE('LTRACE(PARAM,L)F,TFNAME')      :(LTRACE.END)
  805. LTRACE DEFINE('LTRACE1(LTRACE1...F.,LTRACE1...T.,LTRACE1...L.)'
  806. +     'LTRACE1...I.,LTRACE1...N.')
  807.       DEFINE('LTRACE(PARAM,L)F,TFNAME','LTRACE0')
  808. LTRACE0
  809.        L = IDENT(L) PARAM
  810.        PARAM = ~INTEGER(PARAM) 3
  811.        INTARG( .LTRACE, 1, .PARAM)
  812.        LISTARG( .LTRACE, 2, .L)
  813.        F = POP( .L)       :F(RETURN)
  814.        STRINGARG( .LTRACE, 2, .F)
  815.        F POS(0) 'LAMBDA'     :S(LTRACE)
  816.        F POS(0)
  817. +         (
  818. +             'LTRACE' |
  819. +             'LTRACE1' |
  820. +             'POP' |
  821. +             'PRT.VIA.OUTPUT' |
  822. +             'PRINT' |
  823. +             'ATOM' |
  824. +             ('C' SPAN('AD') 'R') |
  825. +             'TDUMP' |
  826. +             'INTARG' |
  827. +             'NUMARG' |
  828. +             'LISTARG' |
  829. +             'STRINGARG' |
  830. +             'PRINT.IN.FIELD' |
  831. +             'UNREAD' |
  832. +             'NULL' |
  833. +             'UNCONS' |
  834. +             'IN' |
  835. +             'CONCAT' |
  836. +             'MAPCAR' |
  837. +             'LIST' |
  838. +             'UNREAD.NIL' |
  839. +             'UNREAD.DOTPAIR' |
  840. +             'UNREAD.SINGLETON' |
  841. +             'UNREAD.REGULAR' |
  842. +             'UNREAD.ATOM'
  843. +         ) RPOS(0)            :S(LTRACE)
  844.        ( EQ(PARAM,0) STOPTR(F,'CALL') STOPTR(F,'RETURN') )    :S(LTRACE)
  845. LTRACE.A
  846.        TRACE(F,"CALL",,
  847. +         DEXP('LAMBDA() = LTRACE1(.' F ',"CALL",' PARAM ')'))
  848.        TRACE(F,"RETURN",,
  849. +         DEXP('LAMBDA() = LTRACE1(.' F ',"RETURN",' PARAM ')'))
  850. +         :(LTRACE)
  851. *
  852. LTRACE1
  853.        IDENT(LTRACE1...T.,"RETURN")    :S(LTRACE1.B)
  854.        |""
  855.        |(">>> " &LASTNO " ==> " &STNO " ==> " )
  856.        |(" " LTRACE1...F.)
  857.        LTRACE1...I. = 1
  858. LTRACE1.A     LTRACE1...N. = ARG(LTRACE1...F.,LTRACE1...I.)  :F(LTRACE1.F)
  859.        |(5 % " " LTRACE1...N. " = ")
  860.        |(7 % " " !($LTRACE1...N.))
  861.        LTRACE1...I. = LTRACE1...I. + 1     :(LTRACE1.A)
  862. LTRACE1.B |""
  863.        |("<<< " &RTNTYPE " <== " &STNO " <== " &LASTNO)
  864.        |(" " LTRACE1...F. " = ")
  865.        |(5 % " " !($LTRACE1...F.))     LE(LTRACE1...L.,1)   :S(RETURN)
  866.        LTRACE1...I. = 1
  867. LTRACE1.C     LTRACE1...N. = ARG(LTRACE1...F.,LTRACE1...I.)  :F(LTRACE1.D)
  868.        LEQ(LTRACE1...N.,LTRACE1...F.)      :S(LTRACE1.C)
  869.        |(5 % " " LTRACE1...N. " = ")
  870.        |(7 % " " !($LTRACE1...N.))
  871.        LTRACE1...I. = LTRACE1...I. + 1     :(LTRACE1.C)
  872. LTRACE1.D LTRACE1...I. = 1
  873. LTRACE1.E LTRACE1...N. = LOCAL(LTRACE1...F.,LTRACE1...I.)  :F(LTRACE1.F)
  874.        LEQ(LTRACE1...N.,LTRACE1...F.)      :S(LTRACE1.E)
  875.        |(5 % " " LTRACE1...N. " = ")
  876.        |(7 % " " !($LTRACE1...N.))
  877.        LTRACE1...I. = LTRACE1...I. + 1     :(LTRACE1.E)
  878. LTRACE1.F      ( GE(LTRACE1...L.,3) ?EVAL(IN()) )      :(RETURN)
  879. LTRACE.END
  880. *
  881.  DEFINE('MAP(FN,L)')     :(MAP.END)
  882. MAP
  883.        MAP =
  884. +         (STRINGARG(.MAP,1,.FN) LISTARG(.MAP,2,.L))
  885. +         NIL
  886. MAP1   NULL(L)       :S(RETURN)
  887.        APPLY(FN,L)   :F(FRETURN)
  888.        L = CDR(L)    :(MAP1)
  889. MAP.END
  890. *
  891.  DEFINE('MAPC(FN,L)')     :(MAPC.END)
  892. MAPC
  893.        MAPC =
  894. +         (STRINGARG(.MAPC,1,.FN) LISTARG(.MAPC,2,.L))
  895. +         NIL
  896. MAPC1     NULL(L)    :S(RETURN)
  897.        APPLY(FN, POP( .L))   :F(FRETURN)S(MAPC1)
  898. MAPC.END
  899. *
  900.  DEFINE('MAPCAN(FN,L)')       :(MAPCAN.END)
  901. MAPCAN
  902.        (STRINGARG(.MAPCAN,1,.FN) LISTARG(.MAPCAN,2,.L))
  903.        MAPCAN = NCONC(MAPCAR(FN,L))     :(RETURN)
  904. MAPCAN.END
  905. *
  906.  DEFINE('MAPCON(FN,L)')       :(MAPCON.END)
  907. MAPCON
  908.        MAPCON  = NCONC(MAPLIST(FN,L))     :(RETURN)
  909. MAPCON.END
  910. *
  911.  DEFINE('MAPLIST(FN,L)R')     :(MAPLIST.END)
  912. MAPLIST
  913.        MAPLIST =
  914. +      (STRINGARG(.MAPLIST,1,.FN) LISTARG(.MAPLIST,2,.L))
  915. +      NIL
  916. MAPLIST1       NULL(L)    :S(MAPLIST2)
  917.        R  = APPLY(FN,L)     :F(FRETURN)
  918.        MAPLIST = R ~ MAPLIST
  919.        L  = CDR(L)   :(MAPLIST1)
  920. MAPLIST2       MAPLIST = LREVERSE(MAPLIST)     :(RETURN)
  921. MAPLIST.END
  922. *
  923.  DEFINE('MAX(X,Y)')       :(MAX.END)
  924. MAX
  925.        (NUMARG(.MAX,1,.X) NUMARG(.MAX,2,.Y))
  926.        MAX = GE(X,Y) X    :S(RETURN)
  927.        MAX = Y       :(RETURN)
  928. MAX.END
  929. *
  930.  DEFINE('MEMBER(A,MBR)') :(MEMBER.END)
  931. MEMBER
  932.        MEMBER = LISTARG(.MEMBER,2,.MBR)    NIL
  933. MEMBER1  EQUAL(A,CAR(MBR))    :S(MEMBER2)
  934.        POP( .MBR)   :S(MEMBER1)F(RETURN)
  935. MEMBER2   MEMBER = MBR    :(RETURN)
  936. MEMBER.END
  937. *
  938.  DEFINE('MEMQ(A,L)')     :(MEMQ.END)
  939. MEMQ
  940.        (LISTARG( .MEMQ, 2, .L)
  941. +      %MEMBER(A,L))      :S(RETURN)F(FRETURN)
  942. MEMQ.END
  943. *
  944.  DEFINE('MIN(X,Y)')       :(MIN.END)
  945. MIN
  946.        (NUMARG(.MIN,1,.X) NUMARG(.MIN,2,.Y))
  947.        MIN = LE(X,Y) X    :S(RETURN)
  948.        MIN = Y       :(RETURN)
  949. MIN.END
  950. *
  951.  DEFINE('MINUS(X)')     :(MINUS.END)
  952. MINUS
  953.        MINUS = NUMARG(.MINUS,1,.X)   -X       :(RETURN)
  954. MINUS.END
  955. *
  956.  DEFINE('MULT(X,Y)')      :(MULT.END)
  957. MULT
  958.        MULT =
  959. +         (NUMARG(.MULT,1,.X)  NUMARG(.MULT,2,.Y))
  960. +         X * Y           :(RETURN)
  961. MULT.END
  962. *
  963.  DEFINE('NCONC(LOL)LN,L')      :(NCONC.END)
  964. NCONC
  965.        NCONC = LISTARG(.NCONC,1,.LOL)   NIL
  966. NCONC1
  967.        NCONC = POP( .LOL)     :F(RETURN)
  968.        LISTARG( .NCONC, 1, .NCONC)
  969.        LN = ~NULL(LOL) LAST(NCONC)       :F(RETURN)
  970.        NULL(LN)      :S(NCONC1)
  971. NCONC2    L = POP( .LOL)
  972.        LISTARG( .NCONC, 1, .L)
  973.        (~NULL(L)   %RPLACD(LN,L))    :F(NCONC2)
  974.        LN = ~NULL(LOL) LAST(L)      :S(NCONC2)F(RETURN)
  975. NCONC.END
  976. *
  977.  DEFINE('NEG(X)')   :(NEG.END)
  978. NEG
  979.        (NUMARG(.NEG,1,.X) LT(X,0))
  980. +          :S(RETURN)F(FRETURN)
  981. NEG.END
  982. *
  983.  DEFINE('NEGP(X)')        :(NEGP.END)
  984. NEGP
  985.        NEGP = (NUMARG(.NEGP,1,.X) NEG(X))   T      :S(RETURN)
  986.        NEGP = NIL         :(RETURN)
  987. NEGP.END
  988. *
  989.  DEFINE('NTH(L,N)I')      :(NTH.END)
  990. NTH
  991.        (LISTARG(.NTH,1,.L) INTARG(.NTH,2,.N))
  992.        NTH = NEG(N) NTH(L,LENGTH(L) + N + 1)       :S(RETURN)
  993.        NTH = GT(N,LENGTH(L)) NIL    :S(RETURN)
  994.        NTH = L
  995.        I = 1
  996. NTH1   I = LT(I,N) I + 1       :F(RETURN)
  997.        NTH = CDR(NTH) :(NTH1)
  998. NTH.END
  999. *
  1000.  DEFINE('NUMBERP(A)')     :(NUMBERP.END)
  1001. NUMBERP
  1002.        NUMBERP = NUMBER(A) T        :S(RETURN)
  1003.        NUMBERP = NIL          :(RETURN)
  1004. NUMBERP.END
  1005. *
  1006.  DEFINE('PLUS(L)')        :(PLUS.END)
  1007. PLUS
  1008.        PLUS = LISTARG(.PLUS,1,.L)
  1009. +         ARITH(.ADD,L)        :(RETURN)
  1010. PLUS.END
  1011. *
  1012.  DEFINE('PRELIST(L,N)')        :(PRELIST.END)
  1013. PRELIST
  1014.        (LISTARG(.PRELIST,1,.L) INTARG(.PRELIST,2,.N))
  1015.        PRELIST = LREVERSE(SUFLIST(LREVERSE(L),-N))
  1016. +          :(RETURN)
  1017. PRELIST.END
  1018. *
  1019.  DEFINE('PUT(UNAME,PROP,VAL)PLT,LST,ELEM')   :(PUT.END)
  1020. PUT
  1021.        UNAME = CONVERT(UNAME,'NAME')     :F(PUT.ERROR1)
  1022.        (IDENT(PROP) TDUMP(.PUT,2))
  1023.        ( ~ATOM(PROP) NULL(PROP) TDUMP(.PUT,2) )
  1024.        VAL = IDENT(VAL) NIL
  1025.        PLT = $'   PrOpErTy  LiSt  TaBlE   '
  1026.        PUT = ?( ~ATOM(VAL) NULL(VAL) )
  1027. +         (PROP ~ NIL) ~ NIL
  1028. +         :S(PUT1)
  1029.        PUT = (PROP ~ VAL ~ NIL) ~ NIL
  1030. PUT1
  1031.        LST = ITEM(PLT,UNAME)
  1032.        IDENT(LST)         :S(PUT4)
  1033.        ATOM(LST)          :S(PUT.ERROR2)
  1034.        NULL(LST)          :S(PUT4)
  1035. PUT2
  1036.        ELEM = POP( .LST)            :F(PUT3)
  1037.        ATOM(ELEM)         :S(PUT.ERROR2)
  1038.        PUT = ~EQUAL(CAR(ELEM),PROP)
  1039. +         ELEM ~ PUT          :(PUT2)
  1040. PUT3
  1041.        PUT = LREVERSE(PUT)
  1042. PUT4
  1043.        ITEM(PLT,UNAME) = PUT        :(RETURN)
  1044. PUT.ERROR1
  1045.        TDUMP(.PUT,1)
  1046. PUT.ERROR2
  1047.        |''
  1048.        |'Program error: In PUT,'
  1049.        |'a property list is not a list of lists.'
  1050.        |'The offending object is '
  1051.        |LST
  1052.        |''
  1053.        TDUMP(.PUT)
  1054. PUT.END
  1055. *
  1056.  DEFINE('PUTL(UNL,PROP,VAL)U...NAME.')      :(PUTL.END)
  1057. PUTL
  1058.        LISTARG( .PUTL, 1, .UNL)
  1059.        PUTL = NIL
  1060. PUTL1
  1061.        U...NAME. = POP( .UNL)      :F(RETURN)
  1062.        PUT(U...NAME.,PROP,VAL)       :(PUTL1)
  1063. PUTL.END
  1064. *
  1065.  DEFINE('PUTPROP(UNAME,VAL,PROP)PLT,LST,ELEM,FLAG')
  1066.        :(PUTPROP.END)
  1067. PUTPROP
  1068.        UNAME = CONVERT(UNAME,'NAME')     :F(PUTPROP.ERROR1)
  1069.        (IDENT(PROP) TDUMP(.PUTPROP,2))
  1070.        ( ~ATOM(PROP) NULL(PROP) TDUMP(.PUTPROP,2))
  1071.        VAL = IDENT(VAL) NIL
  1072.        PUTPROP = NIL
  1073.        FLAG = ''
  1074.        PLT = $'   PrOpErTy  LiSt  TaBlE   '
  1075.        LST = ITEM(PLT,UNAME)
  1076.        IDENT(LST)         :S(PUTPROP2)
  1077.        ATOM(LST)          :S(PUTPROP.ERROR2)
  1078.        NULL(LST)          :S(PUTPROP2)
  1079. PUTPROP1
  1080.        ELEM = POP( .LST)             :F(PUTPROP2)
  1081.        ATOM(ELEM)         :S(PUTPROP.ERROR2)
  1082.        PUTPROP = ~EQUAL(CAR(ELEM),PROP)
  1083. +         ELEM ~ PUTPROP            :S(PUTPROP1)
  1084.        DIFFER(FLAG)            :S(PUTPROP1)
  1085.        FLAG = 1
  1086.        PUTPROP = ?( ~ATOM(VAL) NULL(VAL) )
  1087. +         ELEM ~ PUTPROP      :S(PUTPROP1)
  1088.        PUTPROP = (PROP ~ VAL ~ CDR(ELEM)) ~ PUTPROP
  1089. +         :(PUTPROP1)
  1090. PUTPROP2
  1091.        PUTPROP = DIFFER(FLAG)
  1092. +         LREVERSE(PUTPROP)         :S(PUTPROP4)
  1093.        PUTPROP = ?( ~ATOM(VAL) NULL(VAL) )
  1094. +         (PROP ~ NIL) ~ LREVERSE(PUTPROP)    :S(PUTPROP4)
  1095.        PUTPROP = (PROP ~ VAL ~ NIL) ~ LREVERSE(PUTPROP)
  1096. PUTPROP4
  1097.        ITEM(PLT,UNAME) = PUTPROP   :(RETURN)
  1098. PUTPROP.ERROR1
  1099.        TDUMP(.PUTPROP,1)
  1100. PUTPROP.ERROR2
  1101.        |''
  1102.        |'Program error:  In PUTPROP,'
  1103.        |'a property list is not a list of lists.'
  1104.        |'The offending object is '
  1105.        |LST
  1106.        |''
  1107.        TDUMP(.PUTPROP)
  1108. PUTPROP.END
  1109. *
  1110.  DEFINE('QUOTIENT(L)')        :(QUOTIENT.END)
  1111. QUOTIENT
  1112.        QUOTIENT = LISTARG(.QUOTIENT,1,.L)
  1113. +         ARITH(.DIV,L)       :(RETURN)
  1114. QUOTIENT.END
  1115. *
  1116.  DEFINE('RAC(L)')    :(RAC.END)
  1117. RAC
  1118.        RAC = LISTARG(.RAC,1,.L)
  1119. +         CAR(LREVERSE(L))          :(RETURN)
  1120. RAC.END
  1121. *
  1122.  DEFINE('RAD(D)')    :(RAD.END)
  1123. RAD
  1124.        RAD = NUMARG(.RAD,1,.D)  D * 0.017453292519943      :(RETURN)
  1125. RAD.END
  1126. *
  1127.  DEFINE('RAISE(X,Y)')    :(RAISE.END)
  1128. RAISE
  1129.        (NUMARG(.RAISE,1,.X) NUMARG(.RAISE,2,.Y))
  1130.        (LT(X,0) TDUMP(.RAISE,2))
  1131.        RAISE = EQ(X,0)   0.0       :S(RETURN)
  1132.        RAISE = EXP(Y * LOG(X))     :(RETURN)
  1133. RAISE.END
  1134. *
  1135.  DEFINE('RDC(L)')    :(RDC.END)
  1136. RDC
  1137.        LISTARG( .RDC, 1, .L)
  1138.        RDC = LREVERSE(CDR(LREVERSE(L)))       :(RETURN)
  1139. RDC.END
  1140. *
  1141.  DEFINE('READLIST(L)')        :(READLIST.END)
  1142. READLIST
  1143.        READLIST = LISTARG(.READLIST,1,.L)
  1144. +         READ(CONCAT(L))           :(RETURN)
  1145. READLIST.END
  1146. *
  1147.  DEFINE('REMOVE(L,OLD)PCA,PCD')     :(REMOVE.END)
  1148. REMOVE
  1149.        ATOM(L)       :F(REMOVE1)
  1150.        REMOVE = EQU(OLD,L) NIL      :S(RETURN)
  1151.        REMOVE = L    :(RETURN)
  1152. REMOVE1  REMOVE = NULL(L) NIL       :S(RETURN)
  1153.        REMOVE = EQUAL(L,OLD) NIL    :S(RETURN)
  1154.        PCA = REMOVE(CAR(L),OLD)
  1155.        PCD = REMOVE(CDR(L),OLD)
  1156.        REMOVE = (~ATOM(PCA) NULL(PCA))    PCD      :S(RETURN)
  1157.        REMOVE = PCA ~ PCD            :(RETURN)
  1158. REMOVE.END
  1159. *
  1160.  DEFINE('REMPROP(UNAME,PROP)PLT,LST,ELEM,NEW')    :(REMPROP.END)
  1161. REMPROP
  1162.        UNAME = CONVERT(UNAME,'NAME')      :F(REMPROP.ERROR1)
  1163.        (IDENT(PROP) TDUMP(.REMPROP,2))
  1164.        ( ~ATOM(PROP) NULL(PROP) TDUMP(.REMPROP,2))
  1165.        PLT = $'   PrOpErTy  LiSt  TaBlE   '
  1166.        REMPROP = NIL
  1167.        LST = ITEM(PLT,UNAME)
  1168.        IDENT(LST)         :S(RETURN)
  1169.        ATOM(LST)          :S(REMPROP.ERROR2)
  1170.        NULL(LST)          :S(RETURN)
  1171.        NEW = NIL
  1172. REMPROP1
  1173.        ELEM = POP( .LST)             :F(REMPROP2)
  1174.        ATOM(ELEM)         :S(REMPROP.ERROR2)
  1175.        NEW = ~EQUAL(CAR(ELEM),PROP)
  1176. +         ELE ~ NEW            :S(REMPROP1)
  1177.        REMPROP = T        :(REMPROP1)
  1178. REMPROP2
  1179.        ITEM(PLT,UNAME) = LREVERSE(NEW)   :(RETURN)
  1180. REMPROP.ERROR1
  1181.        TDUMP(.REMPROP,1)
  1182. REMPROP.ERROR2
  1183.        |''
  1184.        |'Program error: In REMPROP,'
  1185.        |'a property list is not a list of lists.'
  1186.        |'The offending object is'
  1187.        |LST
  1188.        |''
  1189.        TDUMP(.REMPROP)
  1190. REMPROP.END
  1191. *
  1192.  DEFINE('ROUND(X)')      :(ROUND.END)
  1193. ROUND
  1194.        NUMARG( .ROUND, 1, .X)
  1195.        ROUND = LT(X,0) -FIX( -X + 0.5)   :S(RETURN)
  1196.        ROUND = FIX(X + 0.5)     :(RETURN)
  1197. ROUND.END
  1198. *
  1199.  DEFINE('RPLACA(L,A)')   :(RPLACA.END)
  1200. RPLACA
  1201.        CAR(L) = LISTARG(.RPLACA,1,.L)   A
  1202.        RPLACA = L    :(RETURN)
  1203. RPLACA.END
  1204. *
  1205.  DEFINE('RPLACD(L,A)')  :(RPLACD.END)
  1206. RPLACD
  1207.        CDR(L) = LISTARG(.RPLACD,1,.L)   A
  1208.        RPLACD = L    :(RETURN)
  1209. RPLACD.END
  1210. *
  1211.  DEFINE('RPLACN(L,N,S)I')      :(RPLACN.END)
  1212. RPLACN
  1213.        (LISTARG(.RPLACN,1,.L)  INTARG(.RPLACN,2,.N))
  1214.        RPLACN = NEG(N)
  1215. +         RPLACN(L,LENGTH(L) + N + 1,S)       :S(RETURN)
  1216.        RPLACN = GT(N,LENGTH(L))
  1217. +         NCONC( L ~ (S ~ NIL) ~ NIL)    :S(RETURN)
  1218.        RPLACN = ZERO(N)
  1219. +         S ~ L           :S(RETURN)
  1220.        I = 1
  1221. RPLACN1   I = LT(I,N) I + 1     :F(RPLACN2)
  1222.        L  = CDR(L)   :(RPLACN1)
  1223. RPLACN2   RPLACN = RPLACA(L,S)      :(RETURN)
  1224. RPLACN.END
  1225. *
  1226.  DEFINE('SET.(SET...N,V)')   :(SET..END)
  1227. SET.
  1228.        STRINGARG(.SET., 1, .SET...N)
  1229.        $SET...N = V
  1230.        SET. = V       :(RETURN)
  1231. SET..END
  1232. *
  1233.  DEFINE('SETL(LNV)')       :(SETL.END)
  1234. SETL
  1235.        SETL = LISTARG(.SETL,1,.LNV)    NIL
  1236.        EQ(REMDR(LENGTH(LNV),2),1)      :F(SETL1)
  1237.        TDUMP('SETL',1)
  1238. SETL1
  1239. +      SETL =  %LNV %CDR(LNV)
  1240. +         SET.(CAR(LNV),CADR(LNV)) ~ SETL      :F(SETL2)
  1241.        LNV = CDDR(LNV)    :(SETL1)
  1242. SETL2
  1243. +      SETL = LREVERSE(SETL)   :(RETURN)
  1244. SETL.END
  1245. *
  1246.  DEFINE('SIGN(X)')         :(SIGN.END)
  1247. SIGN
  1248.        NUMARG( .SIGN, 1, .X)
  1249.        SIGN = GT(X,0) 1  :S(RETURN)
  1250.        SIGN = LT(X,0) -1      :S(RETURN)
  1251.        SIGN = 0     :(RETURN)
  1252. SIGN.END
  1253. *
  1254.  DEFINE('SIN(A)K')             :(SIN.END)
  1255. SIN    DEFINE('SIN.(A)K')
  1256.        DEFINE('SIN(A)K','SIN0')
  1257. SIN0   NUMARG( .SIN, 1, .A)
  1258.        SIN = LT(A) -SIN( -A)   :S(RETURN)
  1259.        SIN = LT(A, 2 * P...I.) SIN.(A)   :S(RETURN)
  1260.        K = FIX(DIV(A,2 * P...I.))
  1261.        SIN = SIN.(A - K * 2 * P...I.)    :(RETURN)
  1262. SIN.
  1263.        A = DFLOAT(A)
  1264.        SIN. = EQ(27., 27. - 4 * A * A)  A
  1265. +         :S(RETURN)
  1266.        A = SIN.(DIV(A,3))
  1267.        SIN. = A * (3 - 4  * A * A)             :(RETURN)
  1268. SIN.END
  1269. *
  1270.  DEFINE('SNOC(L,S)')       :(SNOC.END)
  1271. SNOC
  1272.        LISTARG( .SNOC, 1, .L)
  1273.        SNOC = APPEND(L ~ (S ~ NIL) ~ NIL)   :(RETURN)
  1274. SNOC.END
  1275. *
  1276.  DEFINE('SOME(FN,L)A,V')       :(SOME.END)
  1277. SOME
  1278.        SOME =
  1279. +         (STRINGARG(.SOME,1,.FN) LISTARG(.SOME,2,.L))
  1280. +         NIL
  1281. SOME1    A = POP( .L)  :F(RETURN)
  1282.        %APPLY(FN,A)       :F(SOME1)
  1283.        SOME = A ~ L       :(RETURN)
  1284. SOME.END
  1285. *
  1286.  DEFINE('SORT.(A,II,JJ,P)IU,IL,M,I,J,K,IJ,T,L,TT')
  1287.            :(SORT..END)
  1288. SORT.  DEFINE('SORT.LE(X,Y)')
  1289.        DEFINE('SORT.GE(X,Y)')
  1290.        DEFINE('SORT.LT(X,Y)')
  1291.        DEFINE('SORT.GT(X,Y)')
  1292.        DEFINE('SORT.(A,II,JJ,P)IU,IL,M,I,J,K,IJ,T,L,TT','SORT0')
  1293. SORT0  (DIFFER('ARRAY',DATATYPE(A)) TDUMP(.SORT., 1))
  1294.        (INTARG( .SORT., 2, .II)  INTARG( .SORT., 3, .JJ))
  1295.        P POS(0) ('LE' | 'GE' | 'LLE' | 'LGE') RPOS(0)
  1296. +          :S(SORT1)
  1297.        TDUMP( .SORT., 4)
  1298. SORT1
  1299.        IU = ARRAY(21)
  1300.        IL = COPY(IU)
  1301.        M = 1
  1302.        I = II
  1303.        J = JJ
  1304. SORT5  GE(I,J)       :S(SORT70)
  1305. SORT10    K = I
  1306.        IJ = CONVERT( (J + I) / 2, 'INTEGER' )
  1307.        T = A<IJ>
  1308.        SORT.LE(A<I>,T)    :S(SORT20)
  1309.        A<IJ> = A<I>
  1310.        A<I> = T
  1311.        T = A<IJ>
  1312. SORT20    L = J
  1313.        SORT.GE(A<J>,T)    :S(SORT40)
  1314.        A<IJ> = A<J>
  1315.        A<J> = T
  1316.        T = A<IJ>
  1317.        SORT.LE(A<I>,T)    :S(SORT40)
  1318.        A<IJ> = A<I>
  1319.        A<I> = T
  1320.        T = A<IJ>      :(SORT40)
  1321. SORT30    A<L> = A<K>
  1322.        A<K> = TT
  1323. SORT40     L = L - 1
  1324.        SORT.GT(A<L>,T)    :S(SORT40)
  1325.        TT = A<L>
  1326. SORT50    K = K + 1
  1327.        SORT.LT(A<K>,T)    :S(SORT50)
  1328.        LE(K,L)       :S(SORT30)
  1329.        LE( L - I, J - K)       :S(SORT60)
  1330.        IL<M> = I
  1331.        IU<M> = L
  1332.        I = K
  1333.        M = M + 1    :(SORT80)
  1334. SORT60   IL<M> = K
  1335.        IU<M> = J
  1336.        J = L
  1337.        M = M + 1    :(SORT80)
  1338. SORT70   M = M - 1
  1339.        SORT. = LE(M,0) A        :S(RETURN)
  1340.        I = IL<M>
  1341.        J = IU<M>
  1342. SORT80   GE( J - I, II)        :S(SORT10)
  1343.        EQ(I,II)      :S(SORT5)
  1344.        I = I - 1
  1345. SORT90    I = I + 1
  1346.        EQ(I,J)       :S(SORT70)
  1347.        T = A<I + 1>
  1348.        SORT.LE(A<I>,T)    :S(SORT90)
  1349.        K = I
  1350. SORT100  A<K + 1> = A<K>
  1351.        K = K - 1
  1352.        SORT.LT(T,A<K>)    :S(SORT100)
  1353.        A<K + 1> = T       :(SORT90)
  1354. *
  1355. SORT.LE  APPLY(P,X,Y)     :S(RETURN)F(FRETURN)
  1356. SORT.GE  APPLY(P,Y,X)     :S(RETURN)F(FRETURN)
  1357. SORT.LT  APPLY(P,Y,X)     :S(FRETURN)F(RETURN)
  1358. SORT.GT  APPLY(P,X,Y)     :S(FRETURN)F(RETURN)
  1359. SORT..END
  1360. *
  1361.  DEFINE('SQRT(Y)T')       :(SQRT.END)
  1362. SQRT
  1363.        NUMARG( .SQRT, 1, .Y)
  1364.        (LT(Y,0) TDUMP(.SQRT,1))
  1365.        SQRT = EQ(Y)    0.0     :S(RETURN)
  1366.        Y = DFLOAT(Y)
  1367.        SQRT = LT(Y,0.05) DIV(1,SQRT(DIV(1,Y)))
  1368. +         :S(RETURN)
  1369.        SQRT = GT(Y,4096) SQRT(DIV(Y,4096)) * 64.0
  1370. +         :S(RETURN)
  1371.        SQRT = GT(Y,16) SQRT(DIV(Y,16)) * 4.0
  1372. +         :S(RETURN)
  1373.        SQRT = DIV(Y + 1,2)
  1374.        T = SQRT
  1375. SQRT1
  1376. +      SQRT = SQRT -
  1377. +         DIV(
  1378. +             SQRT * SQRT - Y,
  1379. +             2 * SQRT)
  1380.        T = LT(SQRT,T) SQRT     :S(SQRT1)F(RETURN)
  1381. SQRT.END
  1382. *
  1383.  DEFINE('SUB(X,Y)')     :(SUB.END)
  1384. SUB
  1385.        SUB =
  1386. +         (NUMARG(.SUB,1,.X) NUMARG(.SUB,2,.Y))
  1387. +         X - Y           :(RETURN)
  1388. SUB.END
  1389. *
  1390.  DEFINE('SUBSET(FN,L)A,V')   :(SUBSET.END)
  1391. SUBSET
  1392.        SUBSET =
  1393. +         (STRINGARG(.SUBSET,1,.FN) LISTARG(.SUBSET,2,.L))
  1394. +         NIL
  1395. SUBSET1   A = POP( .L) :F(SUBSET2)
  1396.        %APPLY(FN,A)       :F(SUBSET1)
  1397.        SUBSET = A ~ SUBSET         :(SUBSET1)
  1398. SUBSET2   SUBSET = LREVERSE(SUBSET)       :(RETURN)
  1399. SUBSET.END
  1400. *
  1401.  DEFINE('SUBST(L,OLD,NEW)PCA,PCD')      :(SUBST.END)
  1402. SUBST
  1403.        ATOM(L)       :F(SUBST1)
  1404.        SUBST = EQU(OLD,L) NEW       :S(RETURN)
  1405.        SUBST = L     :(RETURN)
  1406. SUBST1   SUBST = EQUAL(OLD,L) NEW        :S(RETURN)
  1407.        PCA = SUBST(CAR(L),OLD,NEW)
  1408.        PCD = SUBST(CDR(L),OLD,NEW)
  1409.        SUBST = PCA ~ PCD            :(RETURN)
  1410. SUBST.END
  1411. *
  1412.  DEFINE('SUB1(X)')       :(SUB1.END)
  1413. SUB1
  1414.        NUMARG( .SUB1, 1, .X)
  1415.        SUB1 = X - 1       :(RETURN)
  1416. SUB1.END
  1417. *
  1418.  DEFINE('SUFLIST(L,N)I')     :(SUFLIST.END)
  1419. SUFLIST
  1420.        (LISTARG(.SUFLIST,1,.L) INTARG(.SUFLIST,2,.N))
  1421.        SUFLIST = EQ(N,0)  L    :S(RETURN)
  1422.        SUFLIST = LT(N,0) SUFLIST(L,LENGTH(L) + N)
  1423. +         :S(RETURN)
  1424.        I = 0
  1425.        SUFLIST = L
  1426. SUFLIST1
  1427. +      I = ( LT(I,N) ?POP( .SUFLIST))    I + 1
  1428. +          :S(SUFLIST1)F(RETURN)
  1429. SUFLIST.END
  1430. *
  1431.  DEFINE('TAN(Z)')   :(TAN.END)
  1432. TAN
  1433.        NUMARG( .TAN, 1, .Z)
  1434.        TAN = SIN(Z)
  1435.        (GT(ABS(TAN),1) TDUMP( .TAN, 1))
  1436.        TAN = DIV(TAN,COS(Z,TAN))    :(RETURN)
  1437. TAN.END
  1438. *
  1439.   DEFINE('TDUMP(TDUMP...FN.,TDUMP...AN.)'
  1440. +      'TDUMP...I.,TDUMP...A.')      :(TDUMP.END)
  1441. TDUMP
  1442.        ||''
  1443.        |(6 % '* ' 'Terminal Error in ' TDUMP...FN.) |""
  1444.        |(12 % ' '   'Arguments') |""
  1445.        TDUMP...I. = 1
  1446. TDUMP1
  1447.        TDUMP...A. = ARG(TDUMP...FN.,TDUMP...I.)
  1448. +         :F(TDUMP2)
  1449.        $TDUMP...A. = ~ATOM($TDUMP...A.) UNREAD($TDUMP...A.)
  1450.        EQ(TDUMP...AN.,TDUMP...I.)   :F(TDUMP1.A)
  1451.        |(6 % '* ' TDUMP...A.  ' = ' $TDUMP...A.)
  1452.        TDUMP...I. = TDUMP...I. + 1        :(TDUMP1)
  1453. TDUMP1.A
  1454.        |(12 % ' ' TDUMP...A.  ' = ' $TDUMP...A.)
  1455.        TDUMP...I. = TDUMP...I. + 1
  1456. +         :(TDUMP1)
  1457. TDUMP2
  1458.        |''
  1459.        |(12 % ' '  'Locals') |""
  1460.        TDUMP...I. = 1
  1461. TDUMP3
  1462.        TDUMP...A. = LOCAL(TDUMP...FN.,TDUMP...I.)
  1463. +         :F(TDUMP4)
  1464.        $TDUMP...A. = ~ATOM($TDUMP...A.) UNREAD($TDUMP...A.)
  1465.        |(12 % ' ' TDUMP...A. ' = ' $TDUMP...A.)
  1466.        TDUMP...I.  = TDUMP...I. + 1        :(TDUMP3)
  1467. TDUMP4
  1468.        |''
  1469.        $TDUMP...FN. = ~ATOM($TDUMP...FN.) UNREAD($TDUMP...FN.)
  1470.        |(12 % ' ' TDUMP...FN. ' = ' $TDUMP...FN.) |""
  1471.        |(6 % '* '  'End of SNOLISPIST dump from ' TDUMP...FN.)
  1472.        |(6 % '  '  'You can get a SPITBOL dump:')
  1473.        |(6 % '  '  'Enter 0 for no dump, 1 for short dump, 2 for long dump')
  1474.        &DUMP = MIN(2,MAX(0,CONVERT(IN(),'INTEGER')))
  1475.            :(END)
  1476. TDUMP.END
  1477. *
  1478.  DEFINE('TIMES(L)')       :(TIMES.END)
  1479. TIMES
  1480.        TIMES = LISTARG(.TIMES,1,.L) ARITH(.MULT,L)      :(RETURN)
  1481. TIMES.END
  1482. *
  1483.  DEFINE('UNION(L1,L2)A')      :(UNION.END)
  1484. UNION
  1485.        UNION =
  1486. +         (LISTARG(.UNION,1,.L1) LISTARG(.UNION,2,.L2))
  1487. +         NIL
  1488.        IDENT(L1,L2)       :S(UNION2)
  1489. UNION1    A = POP( .L1)       :F(UNION2)
  1490.        UNION = INSERT(A,UNION)   :(UNION1)
  1491. UNION2    A = POP( .L2)       :F(RETURN)
  1492.        UNION = INSERT(A,UNION)   :(UNION2)
  1493. UNION.END
  1494. *
  1495.  DEFINE('ZERO(X)')       :(ZERO.END)
  1496. ZERO
  1497.        (NUMARG(.ZERO,1,.X) EQ(X,0))      :S(RETURN)F(FRETURN)
  1498. ZERO.END
  1499. *
  1500.  DEFINE('ZEROP(A)')       :(ZEROP.END)
  1501. ZEROP
  1502.        ZEROP = (NUMARG(.ZEROP,1,.A) ZERO(A)) T     :S(RETURN)
  1503.        ZEROP = NIL        :(RETURN)
  1504. ZEROP.END
  1505.