Forgot your password?
Document Actions
TORECREATE/ASSEMBLER.sqd_m is an RLISP program that converts LAP (LISP assembly code as output by the compiler) to a Burroughs ALGOL program.
TORECREATE/ASSEMBLER.sqd_m is an RLISP program that converts LAP (LISP assembly code as output by the compiler) to a Burroughs ALGOL program. See GENERATED/LISP/ALGOL.alg_m for an example of its output.
Size 41.2 kB - File type text/plain
Click here to get the file
File contents
% THIS FILE CONTAINS THE CODE TO CHANGE "LAP" TO ALGOL. IT ALSO 00000100
CONTAINS CODE WHICH MAKES MODIFICATIONS TO THE STANDARD REDUCE 00000200
COMPILER WHICH IMPROVES THE B6000/7000 OBJECT CODE; %PPDMTL99; 00000300
00000400
SYMBOLIC; 00000500
00000600
!*NOLINKE:=T$ MAXNARGS:=14$ !*SAVEDEF:=NIL$ !*R2I:=T$ !*ORD:=NIL$ 00000700
REMFLAG('(ATSOC),'LOSE); 00000800
GLOBAL '(!$QPROG!.PTR QUOTED !*PWDS GENCNT NUMERICONSTANT EXTRAS 00000900
!*FLINKLIST TRANSLIST YNUMBER YFUNCTIONS AFIL LFIL FFIL BASEQ); 00001000
FLUID '(SWITCH REGS1 REGS CODELIST FLAGG IREGS1 IREGS)$ 00001100
00001200
SMACRO PROCEDURE !&MKFUNC X; MKQUOTE X; 00001300
00001400
YNUMBER:=0; 00001500
QUOTED:=NIL$ 00001600
00001700
00001800
SYMBOLIC PROCEDURE B6700 X$ 00001900
IF ATOM X THEN NIL 00002000
ELSE IF EQ(CAR X,'DE) THEN <<LAP 00002100
(LIST('!*ENTRY,CAR CDR X,'SUBR,LENGTH CAR CDR CDR X) . 00002200
!&COMPROC(LIST('LAMBDA,CAR CDR CDR X,CAR CDR CDR CDR X),CAR 00002300
CDR X))$ '! >> %PPDMTL99; 00002400
ELSE IF EQ(CAR X,'DF) THEN <<LAP 00002500
(LIST('!*ENTRY,CAR CDR X,'FSUBR,LENGTH CAR CDR CDR X) . 00002600
!&COMPROC(LIST('LAMBDA,CAR CDR CDR X,CAR CDR CDR CDR X),CAR 00002700
CDR X))$ '! >> %PPDMTL99; 00002800
ELSE IF CAR X='QUOTE THEN NIL 00002900
ELSE <<EXTRAS:=NCONC(EXTRAS,IF CAR X='PROGN THEN CDR X ELSE LIST X)$ 00003000
IF FLAGP(CAR X,'EVAL) THEN EVAL X>>$ 00003100
00003200
SYMBOLIC PROCEDURE LAP A$ 00003300
BEGIN SCALAR LOCLIS,OFIL; 00003400
OFIL:=WRS AFIL; 00003500
LINELENGTH 70; 00003600
LOCLIS:=LIST 'EXIT; 00003700
FOREACH XX IN A DO 00003800
IF CAR XX EQ '!*LBL THEN LOCLIS:=CAR CDR XX.LOCLIS; 00003900
!*ENTRY(CAR CDR CAR A,CAR CDR CDR CAR A,CAR CDR CDR CDR CAR A); 00004000
PRIN2 " BEGIN LABEL "; PRINTLIST(LOCLIS,";"); 00004100
FOREACH XX IN CDR A DO 00004200
IF ATOM XX THEN << PRIN2 XX; PRIN2 '!: >> 00004300
ELSE APPLY(CAR XX,CDR XX); 00004400
TERPRI(); PRIN2 "EXIT: END "; PRIN2 ALGOLIZE CAR CAR YFUNCTIONS;00004500
PRIN2 ";"; TERPRI(); 00004600
WRS LFIL; 00004700
LINELENGTH 60; 00004800
PRIN1 CAR CAR YFUNCTIONS; PRIN2 " "; PRIN2 CAR CDR CDR CAR 00004900
YFUNCTIONS; %PPDMTL99; 00004901
PRIN2 " "; PRIN2 '!=; PRINT YNUMBER; YNUMBER:=YNUMBER+1; 00005000
FOR EACH XX IN QUOTED DO !$PLANTWORD XX; 00005100
PRIN2 '!); TERPRI(); 00005200
WRS OFIL 00005300
END$ 00005400
00005500
SYMBOLIC PROCEDURE GENERATEFORWARD(); 00005600
BEGIN SCALAR CHAR,OFIL; 00005700
OFIL:=WRS FFIL; CHAR:='! ; TERPRI(); 00005800
YFUNCTIONS := REVERSIP YFUNCTIONS; 00005900
%PRIN2 "DEFINE LISTOFARGNUM = "., TERPRI()., 00006000
%FOREACH XX IN YFUNCTIONS DO << 00006100
% PRIN2 CHAR., IF POSN()>45 THEN TERPRI()., TTAB()., 00006200
% PRIN2 CDR CDR CDR XX., CHAR:='!, 00006300
% >>., PRIN2 "#.,"., TERPRI(); 00006400
PRIN2 "DEFINE LISTOFPROCCALLS ="; CHAR:='! ; 00006500
FOREACH XX IN YFUNCTIONS DO << 00006600
PRIN2 CHAR; IF POSN()>45 THEN TERPRI(); TTAB(); 00006700
PRIN2 ALGOLIZE CAR XX; CHAR:='!; 00006800
>>; 00006900
PRIN2 "#;"; TERPRI(); 00007000
FOREACH XX IN YFUNCTIONS DO << 00007100
IF CAR XX NEQ 'EVAL AND NOT FLAGP(CAR XX,'NOFORWARD) THEN <<00007200
PRIN2 "PROCEDURE "; PRIN2 ALGOLIZE CAR XX; PRIN2 "; FORWARD;"; 00007300
TERPRI() >> >>; 00007400
WRS OFIL 00007500
END; 00007600
00007700
SYMBOLIC PROCEDURE MAKEINITIALIZE(); 00007800
LAP(LIST('!*ENTRY,'INITIALISE,'SUBR,0) . 00007900
!&COMPROC(LIST('LAMBDA,NIL,EXTRAS),'INITIALISE))$ 00008000
00008100
00008200
00008300
COMMENT LAP MACROS for new LAP$ 00008400
00008500
00008600
SYMBOLIC PROCEDURE !*ENTRY(!*NAME,TYPE,NARG)$ 00008700
BEGIN 00008800
BASEQSET()$ ALLOCQ(!*NAME)$ 00008900
TERPRI()$ 00009000
YFUNCTIONS:=CONS((!*NAME.YNUMBER.TYPE.NARG),YFUNCTIONS); 00009100
PRIN2 "PROCEDURE "; PRIN2 ALGOLIZE !*NAME; 00009200
PRIN2 '!; ; TERPRI(); 00009300
RETURN NIL 00009400
END$ 00009500
00009600
SYMBOLIC PROCEDURE !*ALLOC NW$ 00009700
EMIT3('KALLOC,NW,BASEQ,CDR CDR CDR CAR YFUNCTIONS); 00009800
00009900
SYMBOLIC PROCEDURE !*DEALLOC NW$ 00010000
EMIT0 "KDEALLOC"; 00010100
00010200
SYMBOLIC PROCEDURE !*EXIT$ NIL$ 00010300
00010400
SYMBOLIC PROCEDURE !*LOAD(REG,EXP)$ 00010500
<< IF POSN()>45 THEN TERPRI(); TTAB(); 00010600
PRIN2 "KLOAD(ARG"; PRIN2 REG; PRIN2 ","; 00010700
EMITN1 LOADANY EXP; PRIN2 ");" >>; 00010800
00010900
SYMBOLIC PROCEDURE !*STORE(REG,SLOC)$ 00011000
<<IF REG='NIL THEN REG:=16; 00011100
IF ATOM SLOC THEN EMITN('KSET,-SLOC,LOADANY REG) ELSE 00011200
IF EQCAR(SLOC,'GLOBAL) OR EQCAR(SLOC,'FLUID) THEN 00011300
EMITN('KSTORE,ALLOCQ CADR SLOC,LOADANY REG) 00011400
ELSE ERROR(200,"FUNNY STORE")>>$ 00011500
00011600
SYMBOLIC PROCEDURE !*LINK(FN,NOARGS); 00011700
BEGIN SCALAR FST; 00011800
IF !*FLINKLIST THEN 00011900
!*FLINKLIST := !*SETUP !*FLINKLIST; 00012000
IF FST:=GET(FN,'ALGOLMACRO) THEN 00012100
EMIT0 FST 00012200
ELSE EMIT('KLINK,NOARGS,ALGOLIZE FN); 00012300
END; 00012400
00012500
SYMBOLIC PROCEDURE !*LAMBIND(RGLST,ALST)$ 00012600
BEGIN 00012700
SCALAR N$ N:=LENGTH QUOTED$ 00012800
QUOTED:=NCONC(QUOTED,LIST LENGTH ALST)$ 00012900
WHILE ALST DO << 00013000
QUOTED:=NCONC(QUOTED,LIST(CAR RGLST -1,CAR CAR ALST))$ 00013100
ALST:=CDR ALST$ RGLST:=CDR RGLST >>$ 00013200
RETURN EMIT1('KLAMBIND,N) 00013300
END$ 00013400
00013500
SYMBOLIC PROCEDURE !*PROGBIND ALST$ 00013600
!*PRBND ALST$ 00013700
SYMBOLIC PROCEDURE !*PRBND ALST$ 00013800
BEGIN SCALAR N$ N:=LENGTH QUOTED$ 00013900
QUOTED:=NCONC(QUOTED,LIST LENGTH ALST)$ 00014000
WHILE ALST DO << 00014100
QUOTED:=NCONC(QUOTED,LIST CAR CAR ALST)$ 00014200
ALST:=CDR ALST >>$ 00014300
RETURN EMIT1('KPROGBIND,N) 00014400
END$ 00014500
00014600
SYMBOLIC PROCEDURE !*FREERSTR ALST$ 00014700
EMIT0 'KFREERST$ 00014800
00014900
SYMBOLIC PROCEDURE !*LBL ADR$ 00015000
<< TERPRI(); PRIN2 ADR; PRIN2 ": " >>; 00015100
00015200
SYMBOLIC PROCEDURE !*JUMP ADR$ 00015300
EMIT1('KGOTO,ADR); 00015400
00015500
SYMBOLIC PROCEDURE !*JUMPT ADR$ 00015600
EMIT1('KJUMPT,ADR)$ 00015700
00015800
SYMBOLIC PROCEDURE !*JUMPNIL ADR$ 00015900
EMIT1('KJUMPNIL,ADR)$ 00016000
00016100
SYMBOLIC PROCEDURE !*TESTT(LAB,EXP,TST); 00016200
EMITN('IFTRUE,LAB,LIST(TST,LOADANY CAR EXP)); 00016300
00016400
SYMBOLIC PROCEDURE !*TESTN(LAB,EXP,TST); 00016500
EMITN('IFNOT,LAB,LIST(TST,LOADANY CAR EXP)); 00016600
00016700
SYMBOLIC PROCEDURE !*TEST2N(LAB,E1,E2,TST); 00016800
!*TEST2('IFNOT,LAB,E1,E2,TST); 00016900
00017000
SYMBOLIC PROCEDURE !*TEST2T(LAB,E1,E2,TST); 00017100
!*TEST2('IFTRUE,LAB,E1,E2,TST); 00017200
00017300
SYMBOLIC PROCEDURE !*TEST2(MAC,LAB,E1,E2,TST); 00017400
BEGIN SCALAR U,V; 00017500
U := LOADANY CAR E2; 00017600
IF TST EQ 'EQUAL OR TST EQ 'EQN THEN 00017700
<<TST:=IF NULL U OR U EQ T OR NUMERICONSTANT OR 00017800
(CAR U EQ 'QUOTE AND ATOM CADAR E2) 00017900
THEN 'ZEQ ELSE IF TST='EQN THEN 'ZEQN ELSE 'ZEQUAL>> 00018000
ELSE IF (V:=GET(TST,'MACFN)) THEN 00018100
TST := V 00018200
ELSE ERROR(201,LIST(TST," UNKNOWN TEST")); 00018300
IF POSN()>45 THEN TERPRI(); TTAB(); 00018400
PRIN2 MAC; PRIN2 "("; PRIN2 LAB; PRIN2 ","; 00018500
IF POSN()>45 THEN <<TERPRI(); TTAB()>>; 00018600
PRIN2 TST; PRIN2 "("; 00018700
IF POSN()>45 THEN <<TERPRI(); TTAB()>>; 00018800
EMITN1 LOADANY CAR E1; PRIN2 ","; EMITN1 U; 00018900
PRIN2 "));"; 00019000
END; 00019100
00019200
SYMBOLIC PROCEDURE !*1PARM(EXP,FN); 00019300
EMITN('KMOVE,0,LIST(FN,LOADANY CAR EXP)); 00019400
00019500
SYMBOLIC PROCEDURE !*2PARM(N,E1,E2,MAC); 00019600
BEGIN SCALAR U,V; 00019700
U := LOADANY CAR E2; 00019800
IF MAC EQ 'EQUAL OR MAC EQ 'EQN THEN 00019900
<<MAC:=IF NULL U OR U EQ T OR NUMERICONSTANT OR 00020000
(CAR U EQ 'QUOTE AND ATOM CADAR E2) 00020100
THEN 'VEQ ELSE IF MAC EQ 'EQN THEN 'VEQN ELSE 'VEQUAL>> 00020200
ELSE IF NUMERICONSTANT AND (MAC='PLUS2 OR MAC='DIFFERENCE) THEN 00020300
<<U := NUMERICONSTANT; 00020400
MAC := IF MAC='PLUS2 THEN 'LPLUS2 ELSE 'LDIFF>> 00020500
ELSE IF (V:=GET(MAC,'PARMFN)) THEN 00020600
MAC := V 00020700
ELSE ERROR(201,LIST(MAC," UNKNOWN FUNCTION")); 00020800
IF POSN()>45 THEN TERPRI(); TTAB(); 00020900
PRIN2 "KLOAD(ARG"; PRIN2 N; PRIN2 ","; 00021000
IF POSN()>45 THEN <<TERPRI(); TTAB()>>; 00021100
PRIN2 MAC; PRIN2 "("; 00021200
IF POSN()>45 THEN <<TERPRI(); TTAB()>>; 00021300
EMITN1 LOADANY CAR E1; PRIN2 ","; EMITN1 U; 00021400
PRIN2 "));"; 00021500
END; 00021600
00021700
00021800
00021900
COMMENT THIS SECTION CONTAINS VARIOUS SERVICE ROUTINES; 00022000
00022100
00022200
SYMBOLIC PROCEDURE LOADANY EXP$ 00022300
BEGIN SCALAR X; 00022400
IF NOT ATOM EXP AND NULL CDR EXP THEN EXP := CAR EXP; 00022500
NUMERICONSTANT := NIL; 00022600
RETURN 00022700
IF NUMBERP EXP THEN IF EXP<1 THEN LIST('LOCAL,-EXP) 00022800
ELSE LIST('ARGS,EXP-1) 00022900
ELSE IF EQCAR(EXP,'GLOBAL) THEN 00023000
LIST('GLOBAL,ALLOCQ CAR CDR EXP) 00023100
ELSE IF EQCAR(EXP,'FLUID) THEN 00023200
LIST('FLUID,ALLOCQ CAR CDR EXP) 00023300
ELSE IF EQCAR(EXP,'QUOTE) THEN 00023400
IF (X:=CAR CDR EXP)='NIL THEN NIL 00023500
ELSE 00023600
IF X='T THEN T 00023700
ELSE 00023800
IF NUMBERP X THEN 00023900
<<NUMERICONSTANT := X; 00024000
IF X=0 THEN 'ZERO ELSE 00024100
IF X=1 THEN 'ONE ELSE 00024200
IF X=2 THEN 'TWO ELSE 00024300
IF X=3 THEN 'THREE ELSE 00024400
LIST('NUMB,X)>> 00024500
ELSE 00024600
LIST('QUOTE,ALLOCQ X) 00024700
ELSE IF (X:=GET(CAR EXP,'ANYREG)) THEN 00024800
LIST(X,LOADANY CADR EXP) 00024900
ELSE ERROR(201,LIST(CAR EXP," UNKNOWN ANYREG")); 00025000
END; 00025100
00025200
00025300
SYMBOLIC PROCEDURE EMIT(NAME,A1,A2); 00025400
<< IF POSN()>45 THEN TERPRI(); TTAB(); 00025500
PRIN2 NAME; 00025600
PRIN2 "("; PRIN2 A1; PRIN2 ","; 00025700
PRIN2 A2; PRIN2 ");" >>; 00025800
00025900
SYMBOLIC PROCEDURE EMIT0 X; 00026000
<< IF POSN()>45 THEN TERPRI(); TTAB(); 00026100
PRIN2 X; PRIN2 ";" >>; 00026200
00026300
SYMBOLIC PROCEDURE EMIT1(NAME,A1); 00026400
<< IF POSN()>45 THEN TERPRI(); TTAB(); 00026500
PRIN2 NAME; 00026600
PRIN2 "("; PRIN2 A1; PRIN2 ");" >>; 00026700
00026800
SYMBOLIC PROCEDURE EMIT3(NAME,A1,A2,A3); 00026900
<< IF POSN()>45 THEN TERPRI(); TTAB(); 00027000
PRIN2 NAME; 00027100
PRIN2 "("; PRIN2 A1; PRIN2 ","; 00027200
IF POSN()>45 THEN << TERPRI(); TTAB(); TTAB() >>; 00027300
PRIN2 A2; PRIN2 ","; 00027400
IF POSN()>45 THEN << TERPRI(); TTAB(); TTAB() >>; 00027500
PRIN2 A3; PRIN2 ");" >>; 00027600
00027700
SYMBOLIC PROCEDURE EMITN(MAC,RG,LL); 00027800
<< IF POSN()>45 THEN TERPRI(); TTAB(); 00027900
PRIN2 MAC; PRIN2 "("; PRIN2 RG; PRIN2 ","; 00028000
EMITN1 LL; PRIN2 ");" >>; 00028100
00028200
SYMBOLIC PROCEDURE EMITN1 LL; 00028300
IF ATOM LL THEN PRIN2 LL ELSE 00028400
IF CAR LL ='ARGS THEN 00028500
<<PRIN2 'ARG; PRIN2((CADR LL)+1)>> 00028600
ELSE << IF POSN()>45 THEN <<TERPRI(); TTAB() >>; 00028700
PRIN2 CAR LL; PRIN2 "["; EMITN1 CAR CDR LL; 00028800
PRIN2 "]" >>; 00028900
00029000
SYMBOLIC PROCEDURE TTAB(); 00029100
BEGIN SCALAR I; 00029200
I:=REMAINDER(POSN(),6); 00029300
PRIN2 IF I<3 THEN << 00029400
IF I=0 THEN " " ELSE IF I=1 THEN " " ELSE " ">> 00029500
ELSE << IF I=3 THEN " " ELSE IF I=4 THEN " " ELSE " ">>; 00029600
%PPDMTL99; 00029601
END; 00029700
00029800
SYMBOLIC PROCEDURE PRINTLIST(X,CHAR); 00029900
<< 00030000
IF POSN()>60 THEN <<TERPRI(); TTAB() >>; 00030100
PRIN2 CAR X; 00030200
IF CDR X THEN <<PRIN2 ","; 00030300
PRINTLIST(CDR X,CHAR) >> 00030400
ELSE <<PRIN2 CHAR; TERPRI() >> >>$ 00030500
00030600
SYMBOLIC PROCEDURE ALGOLIZE X; 00030700
INTERN COMPRESS ('Y . INSERTESC EXPLODE X)$ 00030800
00030900
SYMBOLIC PROCEDURE INSERTESC X; 00031000
IF NULL X THEN NIL 00031100
ELSE IF CAR X EQ 'Q THEN APPEND('(Q 9 9),INSERTESC CDR X) 00031200
ELSE IF CAR X EQ '!! THEN 00031300
APPEND(CDR ASSOC(CAR CDR X,TRANSLIST),INSERTESC CDR CDR X) 00031400
ELSE CONS(CAR X,INSERTESC CDR X)$ 00031500
00031600
00031700
SYMBOLIC PROCEDURE ALLOCQ N$ 00031800
ALLOCQ1(N,0,QUOTED)$ 00031900
00032000
SYMBOLIC PROCEDURE BASEQSET$ 00032100
BEGIN SCALAR N$ 00032200
QUOTED:=NIL$ 00032300
BASEQ:= !$QPROG!.PTR 00032400
END$ 00032500
00032600
SYMBOLIC PROCEDURE !$PLANTWORD N$ 00032700
<< !$QPROG!.PTR:=!$QPROG!.PTR+1$ PRINT N >>$ 00032800
00032900
SYMBOLIC PROCEDURE ALLOCQ1(N,L,Q)$ 00033000
IF NULL Q THEN BEGIN QUOTED:=NCONC(QUOTED,LIST N)$ 00033100
RETURN L$ END 00033200
ELSE IF CAR Q = N THEN L 00033300
ELSE ALLOCQ1(N,PLUS2(L,1),CDR Q)$ 00033400
00033500
SYMBOLIC PROCEDURE !*SETUP U; 00033600
IF U THEN 00033700
<<PUT(CAAR U,'ALGOLMACRO,CDAR U); !*SETUP CDR U>> 00033800
ELSE NIL; 00033900
00034000
00034100
00034200
COMMENT THIS SECTION CONTAINS THE MODIFICATION TO THE COMPILER TO 00034300
GENERATE CODE MORE REASONABLE FOR THE B6700; 00034400
00034500
00034600
SYMBOLIC PROCEDURE !&COMTST(EXP,LABL); 00034700
%compiles boolean expression EXP. 00034800
%If EXP has the same value as SWITCH then branch to LABL, 00034900
%otherwise fall through; 00035000
%REGS/IREGS are active registers for fall through, 00035100
%REGS1/IREGS1 for branch; 00035200
BEGIN SCALAR X; 00035300
WHILE EQCAR(EXP,'NULL) DO 00035400
<<SWITCH := NOT SWITCH; EXP := CADR EXP>>; 00035500
IF NOT ATOM EXP AND ATOM CAR EXP 00035600
AND (X := GET(CAR EXP,'COMTST)) 00035700
THEN APPLY(X,LIST(EXP,LABL)) 00035800
ELSE IF (X := GET('NULL,'COMTST)) AND NOT EXP = '(QUOTE T) THEN 00035900
<<SWITCH := NOT SWITCH; APPLY(X,LIST(LIST('NULL,EXP),LABL)) >> 00036000
ELSE <<IF EXP = '(QUOTE T) 00036100
THEN IF SWITCH THEN !&ATTJMP LABL 00036200
ELSE FLAGG := T 00036300
ELSE <<!&COMVAL(EXP,1); 00036400
!&ATTACH LIST(IF SWITCH THEN '!*JUMPT ELSE '!*JUMPNIL, 00036500
CAR LABL); 00036600
!&ADDJMP CODELIST>>; 00036700
REGS1 := REGS; IREGS1 :=IREGS>>; 00036800
IF EQCAR(CAR CODELIST,'!*JUMPT) 00036900
THEN REGS := (1 . '(QUOTE NIL) . CDAR REGS) . CDR REGS 00037000
ELSE IF EQCAR(CAR CODELIST,'!*JUMPNIL) 00037100
THEN REGS1 := (1 . '(QUOTE NIL) . CDAR REGS1) . CDR REGS1 00037200
END; 00037300
00037400
SYMBOLIC PROCEDURE !&CALL1(FN,ARGS,STATUS); 00037500
BEGIN INTEGER ARGNO; 00037600
ARGNO := LENGTH ARGS; 00037700
!&LOADARGS(ARGS,STATUS); 00037800
!&ATTACH LIST('!*LINK,FN,ARGNO); 00037900
IF FLAGP(FN,'ONEREG) THEN REGS := (1 .NIL) . CDR REGS 00038000
ELSE IF FLAGP(FN,'TWOREG) 00038100
THEN REGS := (1 . NIL) . DELASC(2,CDR REGS) 00038200
ELSE REGS := LIST (1 . NIL) 00038300
END; 00038400
00038500
SYMBOLIC PROCEDURE !&COMSETQ(EXP,STATUS); 00038600
BEGIN SCALAR X,Y; 00038700
EXP := CDR EXP; 00038800
IF STATUS>1 AND (NULL CADR EXP OR CADR EXP='(QUOTE NIL)) 00038900
THEN !&STORE2(CAR EXP,NIL) 00039000
ELSE << 00039100
IF STATUS>1 AND !&ANYREG(CADR EXP,NIL) THEN 00039200
<< X:=!&LOCATE CADR EXP; 00039300
>> ELSE << X:=1; !&COMVAL(CADR EXP,1)>>; 00039400
!&STORE2(CAR EXP,X); 00039500
IF Y := !&RASSOC(CAR EXP,IREGS) 00039600
THEN IREGS := DELETE(Y,IREGS); 00039700
REGS:=!&PPP(REGS,X,EXP ); 00039800
>>; 00039900
END; 00040000
00040100
SYMBOLIC PROCEDURE !&PPP(L,R,E); 00040200
<< 00040300
IF NULL L THEN NIL 00040400
ELSE IF CAAR L EQ R THEN 00040500
(R . CAR E . CDAR L) . CDR L 00040600
ELSE CONS(CAR L, !&PPP(CDR L,R,E)) 00040700
>>; 00040800
00040900
SYMBOLIC PROCEDURE !&TEST(EXP,LABL); 00041000
BEGIN SCALAR X; 00041100
IF NOT (X := !&ANYREG(CADR EXP,NIL)) 00041200
THEN !&COMVAL(CADR EXP,1); 00041300
!&CLRREGS(); 00041400
!&ATTACH LIST(IF SWITCH THEN '!*TESTT ELSE '!*TESTN, 00041500
CAR LABL, 00041600
IF X THEN !&LOCATE CADR EXP ELSE LIST(1), 00041700
GET(CAR EXP,'MACFN)); 00041800
REGS1 := REGS; 00041900
!&ADDJMP CODELIST 00042000
END; 00042100
00042200
SYMBOLIC PROCEDURE !&TEST2(EXP,LABL); 00042300
BEGIN 00042400
SCALAR REG,U,V,W,X; 00042500
U := CADR EXP; 00042600
V := CADDR EXP; 00042700
!&CLRREGS(); 00042800
IF !&ANYREG(U,LIST V) THEN 00042900
IF !&ANYREG(V,NIL) 00043000
THEN <<U := !&LOCATE U; V := !&LOCATE V>> 00043100
ELSE <<!&COMVAL(V,1); U := !&LOCATE U; V := LIST(1)>> 00043200
ELSE IF !&ANYREG(V,NIL) 00043300
THEN <<!&COMVAL(U,1); U := LIST(1); V:= !&LOCATE V>> 00043400
ELSE <<U := !&COMLIS CDR EXP; U := !&LOCATE CADR U; 00043500
V := LIST(1)>>; 00043600
!&ATTACH LIST ((IF SWITCH THEN 00043700
'!*TEST2T ELSE '!*TEST2N), 00043800
CAR LABL,U,V,CAR EXP); 00043900
REGS1 := REGS; 00044000
!&ADDJMP CODELIST 00044100
END; 00044200
00044300
SYMBOLIC PROCEDURE !&1PARM(EXP,STATUS); 00044400
BEGIN SCALAR X; 00044500
IF NOT (X := !&ANYREG(CADR EXP,NIL)) 00044600
THEN !&COMVAL(CADR EXP,1); 00044700
!&CLRREGS(); 00044800
!&ATTACH LIST('!*1PARM, 00044900
IF X THEN !&LOCATE CADR EXP ELSE LIST(1), 00045000
GET(CAR EXP,'PARMFN)); 00045100
REGS := (1 . NIL) . CDR REGS; 00045200
END; 00045300
00045400
SYMBOLIC PROCEDURE !&2PARM(EXP,STATUS); 00045500
BEGIN 00045600
SCALAR REG,U,V,W,X; 00045700
U := CADR EXP; 00045800
V := CADDR EXP; 00045900
!&CLRREGS(); 00046000
IF !&ANYREG(U,LIST V) THEN 00046100
IF !&ANYREG(V,NIL) 00046200
THEN <<U := !&LOCATE U; V := !&LOCATE V>> 00046300
ELSE <<!&COMVAL(V,1); U := !&LOCATE U; V := LIST(1)>> 00046400
ELSE IF !&ANYREG(V,NIL) 00046500
THEN <<!&COMVAL(U,1); U := LIST(1); V:= !&LOCATE V>> 00046600
ELSE <<U := !&COMLIS CDR EXP; U := !&LOCATE CADR U; 00046700
V := LIST(1)>>; 00046800
!&ATTACH LIST ('!*2PARM,1,U,V,CAR EXP); 00046900
REGS := (1 . NIL) . CDR REGS; 00047000
END; 00047100
00047200
00047300
END; 00047400
% 10000100
% 10000200
%********************************************************************* 10000300
%** ** 10000400
%** COMMENTS ON THE PATCHES WRITTEN BY MONTREAL PPD ** 10000500
%** ** 10000600
%********************************************************************* 10000700
% 10000800
%PPDMTL99 08/28/85 L. SANS CARTIER 10002000
%THESE ARE ONLY MINOR MODIFICATIONS THAT HAD TO BE MADE WHEN WE DECIDED 10002100
%TO CHANGE THE FILE TYPE FROM "DATA" (80 CHAR./REC.) TO "SEQ" (ONLY 10002200
%72 CHAR./REC.). CHANGING THE FILE TYPE WAS NECESSARY IN ORDER TO BE 10002300
%ABLE TO MANAGE PATCHES. 10002400
% 10002500