Artifact 7e17477bc01e64e533a9887bbc9a8cdcbbc2be2c43ed97951b3f55e47385c0f1:

• Executable file reduce2/reduce2.update.uu.3 — part of check-in [1b32ca91d4] at 2017-03-19 16:31:19 on branch master — Reduce2 and associated material retrieved from softwarepreservation.org

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@3962 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 7757) [annotate] [blame] [check-ins using] [more...]

%DELETE '00000020'
OPEN (COMPILE SYSFILE INPUT) RESTORE (COMPILE)
%DELETE '00000056'
$$$15-SEP-72 (UM 1-JUNE-73)$
%AFTER '00000220'
 
(DEFEXPR (LAMBDA (U)
   (DEF1 U (QUOTE FEXPR))))
%DELETE '00000480'
   ((AND V (GET U (QUOTE SPECIAL)))
%DELETE '00000570'
   ((AND V (EQ (CAR U) (QUOTE SETQ))
%DELETE '00000670' '00000740'
                              (T (CONS (TRANS (CAR U) V)
%DELETE '00001240'
 (**ESC $$$?$)
%DELETE '00001472'
%DELETE '00001740'
%DELETE '00002170' '00002190'
%DELETE '00002270' '00002281'
%AFTER '00002330'
 
DEFINE ((
(MKSTRING (LAMBDA (U)
   (LIST (QUOTE QUOTE) (COMPRESS (DELETE **SMARK (CDR U))))))
))
 
COMMENT ((FUNCTIONS FOR MTS IMPLEMENTATION ONLY))
 
DEFLIST (((PAUSE NORLIS) (CONT NORLIS)) STAT)
 
DEFINE ((
 
(PAUSE (LAMBDA NIL
   (PROG (Y Z)
   (COND ((BATCH) (RETURN NIL)))
   (PRINM (QUOTE ($$$CONT?$)))
   (COND ((YORN) (RETURN NIL)))
   (COND ((AND IFL* (NOT (EQ IFL* (CAR IPL*))))
           (SETQ IPL* (CONS IFL* IPL*))))
   (SETQ IFL* NIL)
   (SETQ Y *INT)
   (SETQ *INT T)
   (SETQ Z *ECHO)
   (SETQ *ECHO NIL)
   (RDS (OPEN (QUOTE GUSER) (QUOTE INPUT)))
   (BEGIN1 T)
   (SETQ *INT Y)
   (SETQ *ECHO Z)
   )))
 
(REDMSG1 (LAMBDA (U V)
   (PROG NIL
        (PRINM (LIST (QUOTE SHOULD) U (QUOTE BE) 
           (QUOTE DECLARED) V (QUOTE $$$?$)))
        (RETURN (YORN)) )))
 
(PRINM (LAMBDA (U)
   (PROG (V)
        (WRS (OPEN (QUOTE SERCOM) (QUOTE OUTPUT)))
        (SETQ V U)
A       (PRINC (CAR V))
        (PRINC **BLANK)
        (COND ((SETQ V (CDR V)) (GO A)))
        (TERPRI)
        (WRS OFL*) )))
 
(READM (LAMBDA NIL
   (PROG (U)
        (CLOSE (QUOTE GUSER))
        (RDS (OPEN (QUOTE GUSER) (QUOTE INPUT)))
        (SETQ U (READ))
        (RDS IFL*)
        (RETURN U) )))
 
(YORN (LAMBDA NIL
   (PROG (U)
A       (SETQ U (READM))
        (COND ((EQ U (QUOTE Y)) (RETURN T))
              ((EQ U (QUOTE N)) (RETURN NIL)))
        (PRINM (QUOTE (ILLEGAL $$$RESPONSE.$ ENTER Y OR N)))
        (GO A) )))
))
%DELETE '00002440' 2
 (SETQ *INT (NULL (BATCH)))
 (SETQ *ECHO (BATCH))
 (*WRS NIL)
%DELETE '00002520'
 (EXITERR (BATCH))
%DELETE '00002570'
 (RETURN (BEGIN1 NIL)))))
%DELETE '00002701' '00002702'
%DELETE '00002935' '00002950'
(*OPEN  (LAMBDA (U V) (PROG2 (OPEN U NIL V) U)))
%DELETE '00003010' '00003030'
(*WRS (LAMBDA (U)
   (PROG NIL
         (WRS (QUOTE LISPOUT))
         (COND (U (PROG2 (ASA NIL) (WRS U))))
         (OTLL (OTLLNG))
         (PTS (QUOTE LLENGTH*) (DIFFERENCE (OTLLNG) 7)))))
%DELETE '00003060'
LOSE ((ASSOC* REMK*))
%BEFORE '00004110'
    (COND ((NOT (ATOMLIS U)) (REDERR (QUOTE (ILLEGAL FILE NAME)))))
%DELETE '00004230'
  F (BEGIN1 T)
%DELETE '00004370'
    (SETQ *INT (NOT (BATCH)))
    (SETQ *ECHO (BATCH))
    (GO F)
%AFTER '00004840'
 ($$$&$ NIL AND NIL)
 ($$$|$ NIL OR NIL)
 ($$$~$ $$$=$ NOT UNEQ)
%AFTER '00011890'
            (SETQ POSN* 0)
            (COND ((NULL FORTVAR*) (GO A)))
%AFTER '00011900'
            (SETQ POSN* 6)
%DELETE '00011910'
            (PRINC* FORTVAR*)
%DELETE '00011930'
            (PRINC* FORTVAR*)
%DELETE '00011941'
%AFTER '00013690'
             ((EQ CRCHAR* **EOF) (GO EOF))
%DELETE '00013800'
    D    (COND ((OR ECHO* *NAT) (SYMPRI CURSYM*)))
%DELETE '00014170'
       (COND ((OR ECHO* *NAT) (MAPRIN CURSYM*)))
%DELETE '00014180'
         (GO D1)
    EOF (SETQ CURSYM* (QUOTE END))
        (SETQ CRCHAR* **SEMICOL)
        (GO D) )))
%DELETE '00014820' '00014840'
       (SETQ U (AND (NOT (EQ *MODE (QUOTE SYMBOLIC)))                          
                    (OR PRI* (EQ U (QUOTE TOP)) (EQ U (QUOTE PRI)))))
%DELETE '00014940'
    A    (COND ((AND U (OR PRI* (EQ SEMIC* **SEMICOL)))
%DELETE '00016740'
        (REMFLAG (LIST NAME) (QUOTE FNC))
%DELETE '00020010'
         (RETURN (COMMAND1 (QUOTE PRI)))))
%DELETE '00020290'
   (PROG (X Y Z)
%DELETE '00020300'
       (SETQ X ECHO*)
%DELETE '00020380'
   LOOP (COND ((EQ CRCHAR* **EOF) (GO RET))
            ((NULL U) (GO L1))
%DELETE '00020440'
   L1   (COND ((NULL X) (GO L3)))
        (COND ((NULL U) (PRINC* CRCHAR*)) 
              ((BREAKP CRCHAR*) (GO L2)) 
              (T (PROG2 (RLIT CRCHAR*) (SETQ Z T)))) 
   L3
%DELETE '00020590' '00020600'
   L2   (COND (Z (PRINC* (MKATOM))))
        (SETQ Z NIL)
        (PRINC* CRCHAR*)
        (COND ((NOT (EQ CRCHAR* **BLANK)) (GO L3))
              ((EQ U (QUOTE END)) (SETQ Y NIL)))
   L4   (COND ((EQ (READCH*) **BLANK) (GO L4)))
        (GO LOOP)
   RET  (COND ((AND X Z) (PROG2 (PRINC* (MKATOM)) (SETQ Z NIL))))
        (SCAN)
   RET1 (COND ((AND X Z) (PRINC* (MKATOM))))
        (RETURN (COND (X (TERPRI*)) (T NIL)))
%DELETE '00021240'
           (*APPLY (CONVRT (CDR X) T) NIL)))
%DELETE '00021485'
             (FUNCTION REVAL))))) (PROG2 (ERRPRI2 X) (ERROR*))))
%DELETE '00021680'
(BEGIN1 (LAMBDA (U)
%DELETE '00021730'
       (SETQ ECHO* (AND *ECHO (NOT (AND OFL* (OR *FORT (NULL *NAT))))))
%AFTER '00021840'
        ((EQ (CAR PROGRAM*) (QUOTE CONT)) (GO C))
%DELETE '00021852'
  B    (TERPRI*)
%DELETE '00021890'
              (ERRORSET (CONVRT (GTS (QUOTE PROGRAM*)) T) T))
%DELETE '00021960'
       (COND ((NULL (OR *INT OFL* *FORT)) (PRINTTY **STAR)))
%AFTER '00021970'
  C    (COND ((NOT U) (GO A)))
       (COND (IFL* (GO ND1)))
       (SETQ IFL* (COND (IPL* (CAR IPL*)) (T NIL)))
       (RDS IFL*)
       (TERPRI*)
       (RETURN NIL)
%DELETE '00022010'
       (RETURN (FINF U))
%AFTER '00022040'
       (SETP)
%DELETE '00022070'
        (LPRIE (QUOTE (COMMAND TERMINATED *****)) T)))
%DELETE '00022100'
        (COND (IFL* (PAUSE)))
%DELETE '00022130'
(FINF (LAMBDA (U)
%DELETE '00022150'
       (COND (U (GO A)))
%AFTER '00022160'
       (SETQ IFL* NIL)
%DELETE '00022220' '00022222'
    A  (COND ((NOT IFL*) (RETURN NIL)))
       (SHUT (LIST IFL*))
%AFTER '00022570'
 (MTS NORLIS)
%DELETE '00023960' '00023980'
                THE COMPUTING CENTER
%DELETE '00031230'
%DELETE '00032150'
   (PROG (V W X Y Z Q)
%DELETE '00032190'
    A  (SETQ Q (CAR W))
       (COND ((NULL W) (GO D))
%DELETE '00032210'
             ((NOT (ATOM (CAR U))) (GO A3))
%AFTER '00032231'
    A3   (COND ((NOT (ATOM (CAAR W))) (GO A1))
               ((AND (MEMBER (CDAR W) FRLIS*)
                     (EQ (CAAR U) (QUOTE EXPT))
                     (SETQ W (CONS (CONS (LIST (QUOTE EXPT) (CAAR W)
                                          (CDAR W)) 1) (CDR W))))
              (GO A1))
               ((MEMBER (CAAR W) FRLIS*) (GO A2))
               (T (GO D)))
%DELETE '00032380'
                                  (DELETE Q (CAR V)))
%AFTER '00034000'
       (RMSUBS)
%DELETE '00034670'
                ((ATOM P) (MKFR (TIMES P (CADDR Q)) (CADR Q)))
                ((ATOM Q) (MKFR (CADR P) (TIMES Q (CADDR P))))
                (T (MKFR (TIMES (CADR P) (CADDR Q))
                         (TIMES (CADR Q) (CADDR P)))) ))
%DELETE '00035880'
        ((AND *ALLFAC (NOT (EQUAL X (CAR U)))) (GO B))
%DELETE '00037220' '00037221'
    D  (COND ((NULL (OR W (EQ POSN* 0))) (PROG2 (SETQ POSN* 0)
                                            (TERPRI))))
       (COND ((EQ POSN* 0) (SETQ COUNT* 1)))
       (SETQ FORTVAR* NIL)
       (COND ((OR W (ATOM V) (NOT (EQ POSN* 0))) (GO A)))
%DELETE '00037270'
       (SETQ POSN* 6)
       (PRINC* FORTVAR*)
%DELETE '00037281'
%BEFORE '00037670'
        (SETQ ERFG* T)
%AFTER '00042660'
        (REMPROP X (QUOTE ARRAY))
%DELETE '00043411' '00043412'
%DELETE '00043860'
   (PROG2 (LET1 U (MK*SQ (CONS (CDR (SIMP *ANS)) 1)))
          (SETQ MCOND* (SETQ FRASC* NIL)))))
%DELETE '00043880'
(NUMER* (LAMBDA (U)
%DELETE '00043920'
   (PROG2 (NUMER* U) (DENOM V))))
  
(NUMER (LAMBDA (U)
   (PROG2 (NUMER* U) (SETQ MCOND* (SETQ FRASC* NIL)))))
%DELETE '00045321' '00045322'
%DELETE '00054950'
         ((AND (NOT (FLAGP L (QUOTE NOSPUR)))
%DELETE '00059381'
%DELETE '00060145'
%BEFORE FILEMARK