Artifact d76347de5083a89fe905219c341b4ff0527e28a2edde9a573043d0313ff0cfd5:
- File
r30/rend.red
— part of check-in
[eb17ceb7f6]
at
2020-04-21 19:40:01
on branch master
— Add Reduce 3.0 to the historical section of the archive, and some more
files relating to version sof PSL from the early 1980s. Thanks are due to
Paul McJones and Nelson Beebe for these, as well as to all the original
authors.git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 9947) [annotate] [blame] [check-ins using] [more...]
COMMENT The following is needed to get string case correct; FLAG('(OFF),'EVAL); OFF RAISE; COMMENT The following functions, which are referenced in the basic REDUCE source (RLISP, ALG1, ALG2, MATR and PHYS) should be defined to complete the definition of REDUCE: BYE DELCP ERROR1 FILETYPE MKFIL ORDERP QUIT SEPRP SETPCHAR. Prototypical descriptions of these functions are as follows; SYMBOLIC PROCEDURE BYE; %Returns control to the computer's operating system command level. %The current REDUCE job cannot be restarted; EVAL '(QUIT); SYMBOLIC PROCEDURE DELCP U; %Returns true if U is a semicolon, dollar sign, or other delimiter. %This definition replaces the one in the BOOT file; U EQ '!; OR U EQ '!$ OR U EQ INTERN ASCII 125; SYMBOLIC PROCEDURE ERROR1; %This is the only call to an error function in the REDUCE source. It %should cause an error return, but NOT print anything, as preceding %statements have already done that. In terms of the LISP error %function it can be defined as follows; ERROR(99,NIL); SYMBOLIC PROCEDURE FILETYPE U; %determines the extension of a file U; IF ATOM U THEN NIL ELSE IF NOT ATOM CAR U AND NULL CDR U THEN FILETYPE CAR U ELSE IF DEVP CAR U THEN IF CAR U EQ 'DIR!: THEN FILETYPE CADDR U ELSE FILETYPE CADR U ELSE IF NOT IDP CDR U THEN NIL ELSE CDR U; SYMBOLIC PROCEDURE DEVP U; %determines if U is a file device type. NOT ATOM U OR IDP U AND CAR REVERSIP EXPLODE U EQ '!:; %SYMBOLIC PROCEDURE MKFIL U; %converts file descriptor U into valid system filename; %U; %this is the simplest one can do; %SYMBOLIC PROCEDURE ORDERP(U,V); %Returns true if U has same or higher order than id V by some %consistent convention (eg unique position in memory); %It must usually be defined in LAP, as in following DEC 10 version; %It must also be loaded BEFORE ALG2.RED; LAP '((ORDERP EXPR 2) (104960 1 2) (112640 1 (C 0)) (MOVEI 1 (QUOTE T)) (POPJ P)); %SYMBOLIC PROCEDURE QUIT; %Returns control to the computer's operating system command level. %The current REDUCE job can however be restarted; GLOBAL '(!$EOL!$); SYMBOLIC PROCEDURE SEPRP U; %returns true if U is a blank or other separator (eg, tab or ff). %This definition replaces one in the BOOT file; U EQ '! OR U EQ '! OR U EQ !$EOL!$ OR U EQ INTERN ASCII 12; %SYMBOLIC PROCEDURE SETPCHAR U; %This function sets the terminal prompt character to U and returns %the previous value; %U; COMMENT The following functions are only referenced if various flags are set, or the functions are actually defined. They are defined in another module, which is not needed to build the basic system. The name of the flag follows the function name, enclosed in parentheses: BFQUOTIENT!: (BIGFLOAT) CEDIT (?) COMPD (COMP) EDIT1 This function provides a link to an editor. However, a definition is not necessary, since REDUCE checks to see if it has a function value. EMBFN (?) EZGCDF (EZGCD) FACTORF (FACTOR) LOAD!-MODULE (property list attribute MODULE-NAME) This function is used to load an external module into the system. It is only called if an attribute DOMAIN-MODE is given to a domain mode tag PRETTYPRINT (DEFN --- also called by DFPRINT) This function is used in particular for output of RLISP expressions in LISP syntax. If that feature is needed, and the prettyprint module is not available, then it should be defined as PRINT RPRINT (PRET) TEXPT!: (BIGFLOAT) TEXPT!:ANY (BIGFLOAT) TIME (TIME) returns elapsed time from some arbitrary initial point in milliseconds; COMMENT The FACTOR module also requires a definition for GCTIME, the time taken for garbage collection. If this is not defined in the given system, the following definition may be used; SYMBOLIC PROCEDURE GCTIME; 0; COMMENT The following definition overrides the standard source version; REMFLAG('(PRINTPROMPT),'LOSE); SYMBOLIC PROCEDURE PRINTPROMPT U; NIL; FLAG('(PRINTPROMPT),'LOSE); COMMENT There is also one global variable in the system which must be set independent of the sources, namely **ESC. This variable is used to "escape" from an input sequence to the top level of REDUCE. For complete flexibility, it should be defined as a global. Otherwise, a NEWNAM statement can be used. However, it MUST be defined in LISP before RLISP is loaded, and cannot be left until this file is defined. At the moment, this feature is not supported, as it interferes with the editing facilities; GLOBAL '(!*!*ESC); !*!*ESC := '!*ESC!*; COMMENT In addition, the global variable ESC* is used by the interactive string editor (defined in CEDIT) as a terminator for input strings. On ASCII terminals, <escape> is a good candidate; GLOBAL '(ESC!*); ESC!* := INTERN ASCII 125; %escape character; COMMENT We also need to define a function BEGIN, which acts as the top-level call to REDUCE, and sets the appropriate variables. The following is a minimum definition; REMFLAG('(BEGIN),'GO); FLUID '(LREADFN!* !*ECHO !*MODE !*SLIN); GLOBAL '(CRCHAR!* DATE!* ORIG!* !*EXTRAECHO !*HELP !*INT); GLOBAL '(CONTL!* IFL!* IPL!* OFL!* OPL!*); COMMENT The following two variables are DEC 10 specific; GLOBAL '(SYSTEM!* !*BAKGAG); SYMBOLIC PROCEDURE BEGIN; BEGIN SCALAR A1; ORIG!* := 0; !*ECHO := NOT !*INT; % !*EXTRAECHO := T; %this is needed in systems which do not %have the "standard" eol convention; CONTL!* := IFL!* := IPL!* := OFL!* := OPL!* := NIL; A1 := !*SLIN; !*SLIN := NIL; %shows we have entered this BEGIN; %The next eight lines are DEC 10 specific; !*BAKGAG := NIL; %turn off backtrace; LREADFN!* := NIL; %define a special reading function; RDSLSH NIL; %modify reader for Rlisp token handling; SCANSET T; %use table driven scanner; % IF SYSTEM!* NEQ 0 THEN CHKLEN(); % IF SYSTEM!*=1 THEN BEGIN SCALAR A2; % SETSYS % IF PAIRP(A2:=ERRORSET('(JSYS 32 0 "<REDUCE>" 0 1),NIL,NIL)) % THEN BOOLE(1,CAR A2,262143) ELSE 0 END; %end of DEC 10 specific code; IF NULL DATE!* THEN <<IF A1 THEN PRIN2T "Reduce Parsing ..."; GO TO A>>; IF FILEP '((REDUCE . INI)) THEN <<IN "REDUCE.INI"; TERPRI()>>; %allows for the automatic load of an initialization file; LINELENGTH IF !*INT THEN 72 ELSE 115; PRIN2 "REDUCE 3.0, "; PRIN2 DATE!*; PRIN2T " ..."; !*MODE := IF GETD 'ADDSQ THEN 'ALGEBRAIC ELSE 'SYMBOLIC; DATE!* := NIL; IF !*HELP THEN PRIN2 "For help, type HELP<escape>"; TERPRI(); A: CRCHAR!* := '! ; %necessary initialization of CRCHAR!*; BEGIN1(); !*SLIN := T; RESETPARSER(); %in case *SLIN affects this; PRIN2T "Entering LISP ..."; SETPCHAR '!* END; FLAG('(BEGIN),'GO); COMMENT And now to set some system dependent variables; DATE!* := "15-Apr-83"; %!*INT := T; %sets the appropriate interactive mode. %Needs to be suppressed during bootstrapping %to avoid CRBUF!* being used; COMMENT on the DEC 10, the end-of-file condition is not handled in quite the way described in the Standard LISP Report. The following statement is necessary to solve this problem; %!$EOF!$ := '!$EOF!$; COMMENT And finally ...; %REMD 'BEGIN2; %used in full bootstrap and needed later; COMMENT Definitions needed to support Norman-Moore factorizer on the PDP-10; FLUID '(LARGEST!-SMALL!-MODULUS); LARGEST!-SMALL!-MODULUS := 2**32; SYMBOLIC PROCEDURE LOGAND2(M,N); BOOLE(1,M,N); SYMBOLIC PROCEDURE LOGOR2(M,N); BOOLE(7,M,N); SYMBOLIC PROCEDURE LOGXOR2(M,N); BOOLE(6,M,N); REMFLAG('(IRIGHTSHIFT), 'LOSE); SYMBOLIC SMACRO PROCEDURE IRIGHTSHIFT(U,N); LSH(U,-N); FLAG('(IRIGHTSHIFT), 'LOSE); SYMBOLIC SMACRO PROCEDURE LEFTSHIFT(U,N); LSH(U,N); COMMENT Definition of MKFIL to handle string file names properly; SYMBOLIC PROCEDURE MKFIL U; %U is an ID or string. Result is a permissible LISP 1.6 filename. BEGIN SCALAR FILE,V,Y,Y1,Z; IF NULL U THEN FILERR U ELSE IF NOT STRINGP U THEN RETURN IF IDP U THEN U ELSE FILERR U; V := EXPLODEC U; A: Z := NEXTELM V; V := CDR Z; Z := CAR Z; IF NULL V THEN NIL ELSE IF CAR V EQ '!: THEN <<FILE := MKFRAG('!: . '!! . Z) . FILE; V := CDR V>> ELSE IF CAR V EQ '!. THEN IF NULL Z THEN FILERR U ELSE <<Y := NEXTELM CDR V; V := CDR Y; FILE := (MKFRAG Z . MKFRAG CAR Y) . FILE; Z := NIL>> ELSE IF CAR V EQ '!< THEN <<Y := NEXTELM CDR V; V := CDR Y; IF NOT EQCAR(V,'!>) THEN FILERR U; FILE := MKFRAG CAR Y . 'DIR!: . FILE; V := CDR V>> ELSE IF CAR V EQ '!> THEN FILERR U ELSE IF CAR V EQ '![ THEN <<Y := NEXTELM CDR V; V := CDR Y; IF NOT EQCAR(V,'!,) THEN FILERR U; Y1 := MKFRAG CAR Y; Y := NEXTELM CDR V; V := CDR Y; IF NOT EQCAR(V,'!]) THEN FILERR U; FILE := LIST(Y1,MKFRAG CAR Y) . FILE; V := CDR V>> ELSE IF CAR V EQ '!, OR CAR V EQ '!] THEN FILERR U; IF V THEN GO TO A ELSE IF Z THEN FILE := MKFRAG Z . IF NULL FILE THEN '(DSK!:) ELSE FILE; RETURN REVERSE FILE END; GLOBAL '(LITERS!*); SYMBOLIC PROCEDURE NEXTELM U; BEGIN SCALAR X,Y; WHILE U AND NOT(CAR U MEMQ '(!. !: !< !> ![ !, !])) DO <<IF LITER CAR U THEN IF Y := ATSOC(CAR U,LITERS!*) THEN X := CDR Y . X ELSE X := CAR U . X ELSE IF DIGIT CAR U THEN X := CAR U . X ELSE X := CAR U . '!! . X; U := CDR U>>; RETURN X . U END; LITERS!* := '((!a . A) (!b . B) (!c . C) (!d . D) (!e . E) (!f . F) (!g . G) (!h . H) (!i . I) (!j . J) (!k . K) (!l . L) (!m . M) (!n . N) (!o . O) (!p . P) (!q . Q) (!r . R) (!s . S) (!t . T) (!u . U) (!v . V) (!w . W) (!x . X) (!y . Y) (!z . Z)); SYMBOLIC PROCEDURE FILERR U; TYPERR(U,"file name"); SYMBOLIC PROCEDURE MKFRAG U; (LAMBDA X; IF NUMBERP X THEN X ELSE INTERN X) COMPRESS REVERSIP U; END;