Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
00010
00020
00030 (DEFPROP &CONTVAR
00040 T
00050 SPECIAL)
00060
00070 (DEFPROP &FOR
00080 (LAMBDA (&CONTVAR &L &LST &FUNCT &BE)
00090 (PROG (&V &X &NOTNEW &UNBOUND &IN &DO)
00100 (COND ((ATOM &CONTVAR) (SETQ &NOTNEW T))
00110 (T
00120 (PROG2 (SETQ &CONTVAR (CAR &CONTVAR))
00130 (COND ((SETQ &X (ERRSET (EVAL &CONTVAR) NIL)) (SETQ &X (CAR &X)))
00140 (T (SETQ &UNBOUND T))))))
00150 (SETQ &IN (CAR &L))
00160 (SETQ &DO (CDR &L))
00170 L (COND
00180 ((NULL &LST)
00190 (RETURN
00200 (PROG2 (COND (&NOTNEW (SET &CONTVAR NIL))
00210 (&UNBOUND (REMPROP &CONTVAR (QUOTE VALUE)))
00220 (T (SET &CONTVAR &X)))
00230 &V))))
00240 (SET &CONTVAR (COND (&IN (CAR &LST)) (T &LST)))
00250 (SETQ &V (COND (&DO (EVAL &FUNCT)) (T (APPEND &V (EVAL &FUNCT)))))
00260 (COND
00270 ((EVAL &BE)
00280 (RETURN
00290 (PROG2 (COND (&UNBOUND (REMPROP &CONTVAR (QUOTE VALUE))) ((NOT &NOTNEW) (SET &CONTVAR &X))) &V))))
00300 (SETQ &LST (CDR &LST))
00310 (GO L)))
00320 EXPR)
00330
00340 (DEFPROP &DOUNTIL
00350 (LAMBDA (&EX &BE) (PROG (&V) L (SETQ &V (EVAL &EX)) (COND ((EVAL &BE) (RETURN &V))) (GO L)))
00360 EXPR)
00370
00380 (DEFPROP &LISTUNTIL
00390 (LAMBDA (&EX &BE) (PROG (&V) L (SETQ &V (APPEND &V (EVAL &EX))) (COND ((EVAL &BE) (RETURN &V))) (GO L)))
00400 EXPR)
00410
00420 (DEFPROP &WHILEDO
00430 (LAMBDA (&BE &EX) (PROG (&V) L (COND ((EVAL &BE) (SETQ &V (EVAL &EX))) (T (RETURN &V))) (GO L)))
00440 EXPR)
00450
00460 (DEFPROP &WHILELIST
00470 (LAMBDA (&BE &EX) (PROG (&V) L (COND ((EVAL &BE) (SETQ &V (APPEND &V (EVAL &EX)))) (T (RETURN &V))) (GO L)))
00480 EXPR)
00490
00500 (DEFPROP &FORLOOP
00510 (LAMBDA (&CONTVAR &RANGELIST &DO &EX &BE)
00520 (PROG (&UPPER &INC &POS &V &X &NOTNEW &UNBOUND)
00530 (COND ((ATOM &CONTVAR) (SETQ &NOTNEW T))
00540 (T
00550 (PROG2 (SETQ &CONTVAR (CAR &CONTVAR))
00560 (COND ((SETQ &X (ERRSET (EVAL &CONTVAR) NIL)) (SETQ &X (CAR &X)))
00570 (T (SETQ &UNBOUND T))))))
00580 (SET &CONTVAR (EVAL (CAR &RANGELIST)))
00590 (SETQ &UPPER (EVAL (CADR &RANGELIST)))
00600 (SETQ &INC (EVAL (CADDR &RANGELIST)))
00610 (COND
00620 ((ZEROP &INC)
00630 (RETURN
00640 (PRINTSTR
00650 (CAT (QUOTE "*** RUN ERROR IN FOR-LOOP: ZERO INCREMENT; CONTROL VARIABLE IS ") &CONTVAR))))
00660 ((GREATERP &INC 0.) (SETQ &POS T)))
00670 L (COND
00680 (&POS
00690 (COND
00700 ((GREATERP (EVAL &CONTVAR) &UPPER)
00710 (RETURN
00720 (PROG2 (COND (&NOTNEW (SET &CONTVAR NIL))
00730 (&UNBOUND (REMPROP &CONTVAR (QUOTE VALUE)))
00740 (T (SET &CONTVAR &X)))
00750 &V)))))
00760 (T
00770 (COND
00780 ((LESSP (EVAL &CONTVAR) &UPPER)
00790 (RETURN
00800 (PROG2 (COND (&NOTNEW (SET &CONTVAR NIL))
00810 (&UNBOUND (REMPROP &CONTVAR (QUOTE VALUE)))
00820 (T (SET &CONTVAR &X)))
00830 &V))))))
00840 (SETQ &V (COND (&DO (EVAL &EX)) (T (APPEND &V (EVAL &EX)))))
00850 (COND
00860 ((EVAL &BE)
00870 (RETURN
00880 (PROG2 (COND (&UNBOUND (REMPROP &CONTVAR (QUOTE VALUE))) ((NOT &NOTNEW) (SET &CONTVAR &X))) &V))))
00890 (SET &CONTVAR (PLUS (EVAL &CONTVAR) &INC))
00900 (GO L)))
00910 EXPR)
00920
00930 (DEFPROP F1
00940 (LAMBDA (X) (CAR X))
00950 EXPR)
00960
00970 (DEFPROP F2
00980 (LAMBDA (X) (CADR X))
00990 EXPR)
01000
01010 (DEFPROP F3
01020 (LAMBDA (X) (CADDR X))
01030 EXPR)
01040
01050 (DEFPROP F4
01060 (LAMBDA (X) (CADDDR X))
01070 EXPR)