Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
00010 BEGIN
00020
00030 EXPR ?&FOR1 (CONTVAR,INDO,L,EX1,EX2);
00040 BEGIN NEW ATOMCONTVAR;
00050 IF NOT(ATOMCONTVAR _ ATOM CONTVAR) THEN CONTVAR _ CAR(CONTVAR);
00060 RETURN('PROG
00070 CONS (IF ATOMCONTVAR THEN '(?&LST ?&V) ELSE <'?&LST,'?&V,CONTVAR>)
00080 CONS <'SETQ,'?&LST,L>
00090 CONS 'L
00100 CONS <'COND,<'(NULL ?&LST),?&FOR2(CONTVAR,ATOMCONTVAR)>>
00110 CONS <'SETQ,CONTVAR,IF CAR(INDO) THEN '(CAR ?&LST) ELSE '?&LST>
00120 CONS (IF EX1 THEN <<'SETQ,'?&V,IF CDR(INDO) THEN CADR(EX1) ELSE <'APPEND,'?&V,CADR(EX1)>>>)
00130 @ (IF EX2 THEN <<'COND,<CADR(EX2),'(RETURN ?&V)>>>)
00140 @ '((SETQ ?&LST (CDR ?&LST)) (GO L))
00150 );
00160 END;
00170
00180 EXPR ?&FOR2 (CONTVAR,ATOMCONTVAR);
00190 IF ATOMCONTVAR THEN <'RETURN,<'PROG2,<'SETQ,CONTVAR,NIL>,'?&V>> ELSE '(RETURN ?&V);
00200
00210 EXPR ?&FORLOOP1 (CONTVAR,RANGELIST,ISDO,EX1,EX2);
00220 BEGIN NEW LOWER,UPPER,INC,ATOMCONTVAR;
00230 LOWER _ CAR(RANGELIST);
00240 UPPER _ CADR(RANGELIST);
00250 INC _ CADDR(RANGELIST);
00260 IF NOT(ATOMCONTVAR _ ATOM CONTVAR) THEN CONTVAR _ CAR(CONTVAR);
00270 RETURN('PROG
00280 CONS ((IF NUMBERP UPPER THEN NIL ELSE '(?&UPPER)) @
00290 (IF NUMBERP INC THEN '(?&V) ELSE '(?&V ?&INC ?&POS)) @
00300 (IF ATOMCONTVAR THEN NIL ELSE <CONTVAR>))
00310 CONS <'SETQ,CONTVAR,LOWER>
00320 CONS (IF NOT NUMBERP UPPER THEN <<'SETQ,'?&UPPER,UPPER>>)
00330 @ (IF NOT NUMBERP INC OR ZEROP(INC) THEN <<'SETQ,'?&INC,INC>,
00340 <'COND,<'(ZEROP ?&INC),<'RETURN,<'PRINTSTR,<'CAT,<'QUOTE,
00350 "RUN ERROR IN FOR-LOOP: ZERO INCREMENT; CONTROL VARIABLE IS ">,<'QUOTE,CONTVAR>>>>>
00360 ,'((GREATERP ?&INC 0) (SETQ ?&POS T))>>)
00370 @ 'L
00380 CONS (IF NUMBERP INC THEN
00390 <'COND,<<IF INC GREATERP 0 THEN 'GREATERP ELSE 'LESSP,CONTVAR,
00400 IF NUMBERP UPPER THEN UPPER ELSE'?&UPPER>,?&FOR2(CONTVAR,ATOMCONTVAR)>> ELSE
00410 <'COND,<'?&POS,<'COND,<<'GREATERP,CONTVAR,IF NUMBERP UPPER THEN UPPER ELSE '?&UPPER>,
00420 ?&FOR2(CONTVAR,ATOMCONTVAR)>>>
00430 ,<T,<'COND,<<'LESSP,CONTVAR,IF NUMBERP UPPER THEN UPPER ELSE '?&UPPER>,
00440 ?&FOR2(CONTVAR,ATOMCONTVAR)>>>>)
00450 CONS (IF EX1 THEN <<'SETQ,'?&V,IF ISDO THEN CADR(EX1) ELSE <'APPEND,'?&V,CADR(EX1)>>>)
00460 @ (IF EX2 THEN <<'COND,<CADR(EX2),'(RETURN ?&V)>>>)
00470 @ <'SETQ,CONTVAR,
00480 IF INC=1 THEN <'ADD1,CONTVAR> ELSE <'PLUS,CONTVAR,IF NUMBERP INC THEN INC ELSE '?&INC>>
00490 CONS '((GO L))
00500 );
00510 END;
00520
00530 EXPR ?&LOOP1 (FUNC,EX1,EX2);
00540 'PROG
00550 CONS '(?&V)
00560 CONS 'L
00570 CONS (IF FUNC EQ '?&DOUNTIL THEN <<'SETQ,'?&V,EX1>,<'COND,<EX2,'(RETURN ?&V)>>> ELSE
00580 IF FUNC EQ '?&LISTUNTIL THEN <<'SETQ,'?&V,<'APPEND,'?&V,EX1>>,<'COND,<EX2,'(RETURN ?&V)>>> ELSE
00590 IF FUNC EQ '?&WHILEDO THEN <<'COND,<EX1,<'SETQ,'?&V,EX2>>,'(T (RETURN ?&V))>> ELSE
00600 IF FUNC EQ '?&WHILELIST THEN <<'COND,<EX1,<'SETQ,'?&V,<'APPEND,'?&V,EX2>>>,'(T (RETURN ?&V))>>)
00610 @ '((GO L));
00620
00630 END.