AI Memo 39, on the Hart & Levin compiler for LISP 1.5, describes part of
the first compiler pass as follows:
3. Recursive functions that would be more effective if written
with iterative loops are rewritten using the PROG feature.
See: ftp://publications.ai.mit.edu/ai-publications/pdf/AIM-039.pdf
The PROG feature, among other things, enables the use of GO tags, and an
example is given of this very usage earlier in the memo. So the act of
rewriting recursive calls using iterative loops in PROG sounds to me a
hell of a lot like tail-call optimization.
It would be interesting to know if this is what's meant ... since it
would mean that this optimization, which is usually associated with
Scheme, actually dates back to the first Lisp compiler ever.
Anyone know for sure?
--
Karl A. Krueger <········@example.edu> { s/example/whoi/ }
From: Marcin 'Qrczak' Kowalczyk
Subject: Re: Did LISP 1.5 do tail-call optimization?
Date:
Message-ID: <87acdye42k.fsf@qrnik.zagroda>
"Karl A. Krueger" <········@example.edu> writes:
> It would be interesting to know if this is what's meant ... since it
> would mean that this optimization, which is usually associated with
> Scheme, actually dates back to the first Lisp compiler ever.
The wording suggests that it applies only to tail recursion, not to
all tail calls like in Scheme.
--
__("< Marcin Kowalczyk
\__/ ······@knm.org.pl
^^ http://qrnik.knm.org.pl/~qrczak/
From: Karl A. Krueger
Subject: Re: Did LISP 1.5 do tail-call optimization?
Date:
Message-ID: <dqcpkc$fk3$1@baldur.whoi.edu>
Marcin 'Qrczak' Kowalczyk <······@knm.org.pl> wrote:
> "Karl A. Krueger" <········@example.edu> writes:
>> It would be interesting to know if this is what's meant ... since it
>> would mean that this optimization, which is usually associated with
>> Scheme, actually dates back to the first Lisp compiler ever.
>
> The wording suggests that it applies only to tail recursion, not to
> all tail calls like in Scheme.
You're right ... ah well, it's better than no optimization.
--
Karl A. Krueger <········@example.edu> { s/example/whoi/ }
"Karl A. Krueger" <········@example.edu> writes:
> AI Memo 39, on the Hart & Levin compiler for LISP 1.5, describes part of
> the first compiler pass as follows:
>
> 3. Recursive functions that would be more effective if written
> with iterative loops are rewritten using the PROG feature.
>
> See: ftp://publications.ai.mit.edu/ai-publications/pdf/AIM-039.pdf
>
> The PROG feature, among other things, enables the use of GO tags, and an
> example is given of this very usage earlier in the memo. So the act of
> rewriting recursive calls using iterative loops in PROG sounds to me a
> hell of a lot like tail-call optimization.
>
> It would be interesting to know if this is what's meant ... since it
> would mean that this optimization, which is usually associated with
> Scheme, actually dates back to the first Lisp compiler ever.
>
> Anyone know for sure?
Is the source of the LISP 1.5 compiler available?
The assembler source we have for LISP 1.5 includes just the
interpreter and the LAP assembler. The compiler was loaded
separately, AFAIK it was written in LISP.
In the interpreter, here is the source of the APPLY and EVAL
functions. I see no specific test of the function being called to
avoid stacking a new frame (note the calls to $SAVE and UNSAVE that
implement the stacking).
EJECT PAGE 147
REM APPLY
REM
REM APPLY(F,L,A) =
REM SELECT(CAR(L).,
REM -1,APP2(F,L,A).,
REM LAMBDA,EVAL(F,APPEND(PAIR(CADR(F),L),A)).,
REM LABEL,APPLY(CADDR(F),L,APPEND(
REM PAIR1(CADR(F),CADDR(F))),A).,
REM APPLY(EVAL(F,A),L,A))
REM
A HED
APPLY SXD ASS1,4
TZE 1,4
STO AST1 F
PDX 0,4
SXA ASS1,4 SAVE FUNCTION ALONG WITH INDEX REGISTE
CLA 0,4 CWR(F)
PAX 0,4 CAR(F)
TXH ASP1,4,-2 =-1
PXD 0,4
CAS ASLMD = LAMBDA
TRA *+2
TRA ASP2
CAS ASFUN
TRA *+2
TRA ASP4
CAS ASLBL = LABEL
TRA *+2
TRA ASP3
TSX $SAVE,4
TXL $END3,,ASSA+2 SAVE 3 ITEMS
STQ ASSL
LDQ $ARG3
STQ ASSA
CLA AST1 F
TSX $EVAL,4 EVAL(F,A)
LDQ ASSA
STQ $ARG3
LDQ ASSL
TSX UNSAVE,4
LXD ASS1,4
TRA APPLY APPLY(EVAL(F,A),L,A)
REM
ASP1 CLA AST1 F
LXD ASS1,4
TRA $APP2 P APP29F,L,A)
* LAMBDA BRANCH
ASP2 LXD AST1,4 F
CLA $ARG3
STO AST3
CLA 0,4 CWR(F)
PDX 0,4 CDR(F)
CLA 0,4 CWDR(F)
STO AST4 PAGE 148
PAX 0,4 CADR(F)
PXD 0,4
TSX $PAIR,4 PAIR(CADR(F),L)
LDQ AST3 A
TSX $NCONC,4
XCA
LXD AST4,4 CDDR(F)
CLA 0,4
PAX 0,4
PXD 0,4
LXD ASS1,4
TRA $EVAL EVAL(CADDR(F),APPEND(PAIR(CADR(F),L),A))
REM
* LABEL BRANCH
ASP3 LXD AST1,4 F
STQ AST2 L
LDQ $ARG3 A
STQ AST3
CLA 0,4 CWR(F)
PDX 0,4 CDR(F)
CLA 0,4
STO AST4 CWDR(F)
PDX 0,4 CDDR(F)
CLA 0,4
PAX 0,4 CADDR(F)
PXD 0,4
STO AST1
XCA
LXA AST4,4
PXD 0,4 CADR(F)
TSX $CONS,4 CONS(CADR(F),CONS(CADDR(F),0))
LDQ AST3 A
TSX $CONS,4 APPEND( ABOVE,A)
STO $ARG3
LDQ AST2
CLA AST1 CADDR(F)
LXD ASS1,4
TRA APPLY APPLY(CADDR(F),L,APPEND(PAIR(CADR(F),CADDR(F)),A))
REM
* FUNARG BRANCH
ASP4 LXD AST1,4 F
CLA ,4
PDX ,4 CDR(F)
CLA ,4
STO AST1 CWDR(F)
PDX ,4 CDDR(F)
CLA ,4
PAX ,4 CADDR(F)
PXD ,4
STO $ARG3 A
LXA AST1,4 CADR(F)
PXD ,4 F
LXD ASS1,4
TRA $APPLY PAGE 149
REM
ASLBL SYN LABELD
ASLMD SYN LAMDAD
ASFUN SYN FNARGD
ASZRO SYN $ZERO
REM
REM APP2(F,L,A)=SELECT(F.,CAR,CAAR(L).,CDR,
REM CDAR(L).,CONS,CONS(CAR(L),CADR(L)).,LIST,COPY(L).,SEARCH(F,
REM LAMBDA(J,CAR(J)=SUBR OR CAR(J)=EXP),
REM LAMBDA(J,CAR(J)=SUBR YIELDS APP3(CWADR
REM (J),DISTRIB(L)),1 YIELDS APPLY(CADR(J),L,A)))
REM ERROR)
REM
A HED
APP2 SXD AST1,4 SAVE LINK IR
LXD $ARG3,4 GET ALIST
SXD A,4 SAVE IT
STQ AL ARGUMENT LIST
STO F FUNCTION (IS ATOMIC SYMBOL)
STZ APTRT INITIALIZE TRACE TEST CELL
APSES PDX 0,4 ARG TO IR
TXL APSAL,4,0 GO IF NO MORE PROPERTY LIST
CLA 0,4 FIRST WORD
PAX 0,4 CAR
TXL *+2,4,$TRACE-1
TXL APTRK,4,$TRACE LOOK FOR TRACE
TXL *+2,4,$SUBR-1 LOOK FOR
TXL R2,4,$SUBR $SUBR OR
TXL APSES,4,$EXPR-1 $EXPR
TXH APSES,4,$EXPR
* EXPR BRANCH IN APPLY
R21 PDX 0,4 POINTER TO NEXT WORD AFTER $EXPR
CLA 0,4 NEXT WORD
PAX 0,4 CAR
PXD 0,4 IS FUNCTION
ZET APTRT TEST FOR TRACE MODE
TRA APTXP TRACE THIS EXPRESSION
LXD ATS1,4 RESTORE LINK IR
TRA $APPLY GO TO APPLY
* RZ THE SUBR BRANCH OF APPLY
R2 PDX 0,4 GET THE TXL INSTRUCTION BT TAKING
CLA 0,4 CWR (CADR L))
PAX 0,4
CLA 0,4
STO CWADR TXL INSTRUCTION
CLA ASS1
STO CSV
CLA AL GET THE ARGUMENT LIST
TSX SPREAD,4 SPREAD IT INTO AC, MQ, ARG3, ETC.
ZET APTRT TEST FOR TRACE MODE
TRA APTSB TRACE THIS SUBROUTINE
TSX $SAVE,4
TXL $END2,,$ALIST+2
LXD A,4 PAGE 150
SXD $ALIST,4
TSX CWADR,4
TSX UNSAVE,4
LXD CSV,4
TRA 1,4
*
APSAL CLA FAS WHERE TO GO IF NOT FOUND ON PAIR LIST
STO $ARG3
CLA F ATOMIC FUNCTION
LDQ A
TSX SASSOC,4 SEARCH PAIR LIST FOR LABEL DEFINITION
PDX 0,4 POINTER TO ASSOCIATED ITEM
CLA 0,4
PDX 0,4 POINTER TO ITEM
PXD 0,4
LDQ A RESTORE PAIR LIST
STQ $ARG3
LDQ AL RESTORE ARGUMENT LIST
ZET APTRT TEST FOR TRACE MODE
TRA APTXP TRACE THIS EXPRESSION
LXD ATS1,4 RESTORE LINK IR
TRA $APPLY GO TO APPLY WITH ITEM ASSOCIATED WITH
* THE ATOMIC FUNCTION
APTXP TSX $SAVE,4 TRACE EXPR
TXL $END1,,CSV+2
TSX $APPLY,4
TRA APEXC FINISH UP
*
R33 SXD $ERROR,4
CLA F PICK UP FUNCTION
TSX $ERROR+1,4 GO TO ERROR
BCI 1,*A 2* FUNCTION OBJECT HAS NO DEFINITION
*
APTRK STL APTRT
STO APA SAVE THE AC
LXA ASS1,4 ATOM NAME
PXD 0,4
TSX ARGOF,4 PRINT ARGUMETNS OF
LDQ AL RESTORE MQ AFTER PRINTING
CLA APA RESTORE AC
TRA APSES CONTINUE PROPERTY LIST SEARCH
*
APTSB TSX $SAVE,4 TRACE SUBR
TXL $END2,,$ALIST+2
LXD A,4
SXD $ALIST,4
TSX CWADR,4
APEXC TSX UNSAVE,4
XCA VALUE TO MQ
LXA CSV,4
PXD 0,4 TO AC
LXD CSV,4
TRA VALOF PRINT VALUE OF
* PAGE 151
APA AC STORAGE
APTRT TRACE MODE TEST SWITCH
CWADR TXL INSTRUCTION FOR SUBR
ATS1 LINK INDEX REGISTER
FAS TXL R33,,0 NOT FOUND ON PAIR LIST SO CALL ERROR
F ATOMIC FUNCTION GOES HERE
AL ARGUMENT LIST
A A OR PAIR LIST
*
REM
REM
A HED
EVCON TZE E3
SXD ECS1,4
TSX $SAVE,4
TXL $END4,,ECS4+2 SAVE 4 ITEMS
STQ ECS2
PDX 0,4
E1 CLA 0,4
STO ECS3
PAX 0,4
CLA 0,4
STO ECS4
PAX 0,4
PXD 0,4
TSX $EVAL,4
LDQ ECS2
TZE E2
LXD ECS4,4
CLA 0,2
PAX 0,2
PXD 0,4
TSX UNSAVE,4
LXD ECS1,4
TRA $EVAL
E2 LXD ECS3,4
TXH E1,4,0
E3 SXD $ERROR,4
LXA ECS3,4
PXD 0,4 PRINT LAST CONDITION
TSX $ERROR+1,4
BCI 1,*A 3* CONDITIONAL UNSATISFIED
REM BASIC LISP FUNCTIONS FOR APPLY
REM
REM
R HED
REM CAR
REM
CARP SXA CARX,4
PDX ,4
CAL ,4
PAX ,4
PXD ,4
CARX AXT **,4 PAGE 152
TRA 1,4
BFS1
REM
CDRP SXA CDRX,4
PDX ,4
CLA ,4
ANA BFDM
CDRX AXT **,4
TRA 1,4
BFDM SYN $DMASK
REM
REM
ATOMP SXA ATMX,4
TZE ATP1
PDX ,4
CLA ,4
PAX ,4
TXL *+3,4,-2
ATP1 CLA BFQ1
TRA *+2
PXD ,2
ATMX AXT **,4
TRA 1,4
BFQ1 SYN $QD1
REM
NULLP TZE *+3
PXD ,0
TRA 1,4
CLA BFQ1
TRA 1,4
REM
REM
REM
REM LAMBDA FOR FUNCTIONAL ARGUMENTS
REM
LAMP SXD BFS1,4
STO BFS2 L
XCA
LDQ BFZRO
TSX $CONS,4 CONS(A,0)
XCA
CLA BFS2
TSX APPEND,4
XCA
CLA BFFAG
LXD BFS1,4
TRA $CONS LIST(FUNARG,L,A)
BFFAG SYN FNARGD
BFZRO SYN $ZERO
REM
REM LABEL FSUBR
REM
LABP SXD BFS1,4
STQ BFS3 A PAGE 153
PDX ,4 L
CLA ,4
STO BFS2 CWR(L)
PDX ,4 CDR(L)
CLA ,4
PAX ,4 CADR(L)
PXD ,4
STO BFS4
XCA
LXA BFS2,4 CAR(L)
XCA
PXD ,4
TSX $COND,4 LIST(CAR(L),CADR(L))
LDQ BFS3
TSX $CONS,4 CONS(LIST,A)
XCA
CLA BFS4 CADR(L)
LXD BFS1,4
TRA $EVAL
REM
REM
REM
REM SETQ
REM
SETQP SXD REPS1,4
TSX $SAVE,4
TXL $END2,,REPV+2
PDX ,4 L
CLA ,4
PAX ,4 CAR(L)
SXD REPV,4
PDX ,4 CDR(L)
CLA ,4
PAX ,4 CADR(L)
PXD ,4
TSX $EVAL,4 EVAL(CADR(L),A)
STO REPT1
CLA REPP1
STO $ARG3
LDQ PRGVAR
CLA REPV
TSX SASSOC,4 SASSOC(CAR(L),PV,ERROR)
PDX ,4
CLA REPT1
STD 0,4 REPLACE DECREMENT
TSX UNSAVE,4
LXD REPS1,4
TRA 1,4
REM
REPP1 TXL *+1,,0
SXD $ERROR,4
CLA REPV
TSX $ERROR+1,4
BCI 1,*A 4* SETQ GIVEN ON NON-EXISTENT VARIABLE PAGE 154
REM
REM
REM SET
REM
SETP SXD BFS1,4
STO BFS5
STQ BFS2
LDQ SETP1
STQ $ARG3
LDQ PRGVAR
TSX SASSOC,4
PDX ,4
CLA BFS2
STD 0,4
LXD BFS1,4
TRA 1,4
REM
SETP1 TXL *+1,,0
SXD $ERROR,4
CLA BFS5
TSX $ERROR+1,4
BCI 1,*A 5* SET GIVEN ON NON EXISTENT VARIABLE
BFS5
REM
* AND SPECIAL FORM
EVA8 TNZ EVA6
CLA EVCT
TRA 1,4
EVA6 SXD EVA1,4
TSX $SAVE,4
TXL $END3,,EVA9+2 SAVE 3 ITEMS
PDX ,4
EVA4 CLA ,4
STO EVA2
PAX ,4
PXD ,4
STQ EVA9
TSX $EVAL,4
LDQ EVA9
TNZ EVA3
EVA5 TSX UNSAVE,4
LXD EVA1,4
TRA 1,4
EVA3 LXD EVA2,4
TXH EVA4,4,0
CLA EVCT
TRA EVA5
* OR SPECIAL FORM
EVR8 TNZ EVR6
CLA EVCF
TRA 1,4
EVR6 SXD EVR1,4
TSX $SAVE,4
TXL $END3,,EVR9+2 SAVE 3 ITEMS PAGE 155
PDX ,4
EVR4 CLA ,4
STO EVR2
PAX ,4
PXD ,4
STQ EVR9
TSX $EVAL,4
LDQ EVR9
TZE EVR3
CLA EVCT
EVR5 TSX UNSAVE,4
LXD EVR1,4
TRA 1,4
EVR3 LXD EVR2,4
TXH EVR4,4,0
CLA EVCF
TRA EVR5
EVCT SYN $QD1
EVCF SYN $ZERO
REM
EQP STQ BFS1
SUB BFS1
TNZ *+3
CLA BFQ1
TRA 1,4
PXD ,0
TRA 1,4
REM
REM EVAL(E,A) 5/6/59
REM
A HED
EVAL SXD EVS1,4
TZE 1,4
STO EVTE E
PDX ,4
CLA ,4
STT EVLNS SEE IF A NUMBER
ZET EVLNS SKIP IF NOT A NUMBER
TRA EV1N IS A NUMBER(CONSTANT)
PAX ,4 CAR(E)
TXH EVP1,4,-2 = - 1
SXD EVTAE,4 CAR(E)
SXA EVS1,4 SAVE FUNCTION WITH INDEX REGISTER
STD EVTDE CDR(E)
CLA ,4
STT EVLNS SEE IF A NUMBER
ZET EVLNS TEST FOR A NUMBER
TRA EVP26 UNDEFINED FUNCTION IF A NUMBER
PAX ,4 CAAR(E)
TXL EVP27,4,-2 GO IF CAR(E) NOT AN ATOM
*
* CAAR(E) = -1
*
SXA EVTRK,0 ZERO THE ADDRESS PAGE 156
SXD EVTRK,0 ZERO DECREMENT
EVP2 PDX ,4 CDAR(E)
TXL EVP25,4,0 NULL(J)
CLA ,4
PAX ,4 CAR(J)
TXH *+2,4,$TRACE
TXH EVTRT,4,$TRACE-1 =TRACE
TXH *+2,4,$SUBR
TXH EVP27,4,$SUBR-1 OF IF A SUBR
TXH *+2,4,$FSUBR
TXH EVP22,4,$FSUBR-1 =FSUBR
TXH *+2,4,$EXPR
TXH EVP23,4,$EXPR-1 =EXPR
TXH EVP2,4,$FEXPR
TXL EVP2,4,$FEXPR-1 /= FEXPR
STD EVD2 CDR(J)
STQ $ARG3 A
CLA $ARG3
LDQ EVZRO 0
TSX $CONS,4 CONS(A,0)
XCA
CLA EVTDE
TSX $CONS,4 LIST(CDR(E),A)
XCA
LXD EVD2,4 CDR(J)
CLA ,4
PAX ,4 CADR(J)
PXD ,4
ZET EVTRK TEST FOR TRACE MODE
TRA EVTXP
LXD EVS1,4
TRA $APPLY APPLY(CADR(J),LIST(CDR(E),A),A)
*
EVTRT STL EVTRK SET THE TRACE SWITCH
TRA EVP2 GO SEARCH MORE
*
*
* CAR(E) = -1
*
EV1N CLA EVTE GET THE NUMBER
LXD EVS1,4 RESTORE LINK INDEX
TRA 1,4
*
EVP1 PDX ,4 J
TXL EVP11,4,0 = 0
CLA ,4
PAX ,4 CAR(J)
TXH EVP1,4,$APVAL = APVAL
TXL EVP1,4,$APVAL-1
EVP13 PDX ,4 CDR(J)
CLA ,4
PAX ,4 CADR(J)
CLA ,4
PAX ,4 CAADR(J) PAGE 157
PXD ,4
LXD EVS1,4
TRA 1,4
*
EVP11 STQ EVTA A
CLA EVTE E
STD EVI1
SUB EVQD1
STD EVI2
SXD EVD1,2
LXD EVTA,4
EVL1 TXL EVP12,4,0 NULL(J)
CLA ,4
PAX ,2 CAR(J)
PDX ,4 CDR(J)
CLA ,2
PAX ,2 CAAR(J)
EVI1 TXH EVL1,2,** CAAR(J) = E
EVI2 TXL EVL1,2,**
PDX ,4 CDAR(J)
PXD ,4
LXD EVD1,2
LXD EVS1,4
TRA 1,4
*
EVP12 SXD $ERROR,4
CLA EVTE
TSX $ERROR+1,4
BCI 1,*A 8* UNBOUND VARIBLE MENTIONED -EVAL-
*
EVP22 PDX ,4 CDR(J) FSUBR
CLA ,4
PAX ,4 CADR(J)
CLA ,4 CWADR(J)
STO EVT1
CLA EVS1 ATOM AN DIR4 FOR SAVING $ALIST
STO CSV
TSX $SAVE,4
TXL $END2,,$ALIST+2
STQ $ALIST
ZET EVTRK TEST WHETERT TO TRACT
TRA EVTFS YES,TRACE FSUBR
CLA EVTDE GET BACK ARGUMENTS
TSX EVT1,4
TSX UNSAVE,4
LXD CSV,4
TRA 1,4
*
* EVP23 THE EXPR BRANCH FOR EVAL
*
EVP23 PDX 0,4 REST OF PROPERTY LIST
CLA 0,4 GET THE EXPR
PAX 0,4
SXD EVTAE,4 SAVE IN TEMPORARY STORAGE PAGE 158
LXD $CPPI,4 PUSH DOWN COUNTER
TXI EVP28,4,-5 SAVE 5 ITEMS
*
EVP25 CLA EVTAE CAR(E)
STD EVI3 TXH
SUB EVQD1
STD EVI4 TXL
SXD EVT1,2
STQ EVD1
LXD EVD1,4 A
EVL2 TXL EVP26,4,0 NULL(J)
CLA ,4
PDX ,4 CDR(J)
PAX ,2 CAR(J)
CLA ,2
PAX ,2 CAAR(J)
EVI3 TXH EVL2,2,** /= CAR(E)
EVI4 TXL EVL2,2,**
LXD EVT1,2
STD EVTAE SAVE FUNCTION
EV27 LXD $CPPI,4
TXI *+1,4,-5 SAVE TOTAL OF 4 ITEMS
EVP28 XEC ENDPDL TEST FOR OUT OF PUSH DOWN LIST
SXD $CPPI,4
CLA EVS1
STO -5,4
CLA EVSE
STO -4,4
CLA EVSA
STO -3,4
CLA EVTRK
STO -2,4
CLA EVCM
STO -1,4
CLA EVTAE GET THE FUNCTION
STD EVSE
STQ EVSA A
CLA EVTDE CDR(E)
LDQ ELP1 FUNCTIONAL ARGUMENT
TSX MAPLIS,4 MAPLIST(L,EVAL(CAR(L),A))
STO EVT1
CLA EVSA
STO $ARG3
CLA EVSE
LXD $CPPI,4 START OPEN UNSAVE
LDQ -5,4
STQ EVS1
LDQ -4,4
STQ EVSE
LDQ -3,4
STQ EVSA
LDQ -2,4
STQ EVTRK
TXI *+1,4,5 PAGE 159
SXD $CPPI,4
LDQ EVT1
ZET EVTRK TEST RACE SWITCH
TRA EVDCO DECODE EVTRAK
EVAPG LXD EVS1,4
TRA $APPLY APPLY(CADAR(J),EVLIS(CDR(E),A),A)
*
* IF CAR E IS A SUBR, THE POINTRE TO THE TXL INSTRUCTION
* IS SAVED IN THE DECREMENT OF VETRK. THE ADDRESS OF
* EVTRK IS THE TRACE SWITCH.
*
EVDCO LXD EVTRK,4 LOOK FOR SUBR POINTER
TXL EVTXP,4,0 THERE ISNT ANY. SO GO AND TRACE EXPR
LXA EVTRK,4 SEE IF THE SUBR IS TRACED
TXH EVAPG,4,0 YES IT IS. LET APPLY HANDLE IT
LXD EVTRK,4 GET THE TXL SUBR WORD
CLA 0,4
STO EVT1 READY TO EXECUTE
CLA EVS1 GET RETURN INDEX AND ATOM NAME
STO CSV AND SAVE THEM ALONG WITH $ALIST
TSX $SAVE,4
TXL $END2,,$ALIST+2
CLA $ARG3
STO $ALIST POST CURRENT ALIST
XCA ARGUMENT LIST TO AC
TSX $SPREAD,4 SMEAR IT OUT
TSX EVT1,4 EXECUTE SUBR
TSX UNSAVE,4 RESTORE ALIST AND IX
LXD CSV,4
TRA 1,4 AND RETURN
*
EVP27 PDX 0,4 SUBR BRANCH
CLA 0,4
PAX 0,4 POINTER TO TXL WORD
SXD EVTRK,4 TO SAVE POSITION
TRA EV27 EVALUATE ARGUMENTS
*
ELP1 TXL *+1,,0
SXA ELT1,4 SAVE LINK IR
PDX ,4 J
CLA ,4
PAX ,4
PXD ,4 CAR(J)
LDQ EVSA GET CURRENT A LIST
ELT1 AXT **,4 RESTORE LINK IR
TRA $EVAL
*
* EVLIS
*
EVLIS SXD EVS1,4 SAVE LINK IR
AXT EVLISL,4 ATOM EVLIS
SXA EVS1,4 FOR BACKTRACE
TSX $SAVE,4 SAVE EVAL STORAGE
TXL $END3,,EVSA+2 PAGE 160
STQ EVSA
LDQ ELP1
TSX MAPLIS,4
TSX UNSAVE,4
LXD EVS1,4
TRA 1,4
*
EVP26 SXD $ERROR,4
LXD EVT1,2
CLA EVTE
TSX $ERROR+1,4
BCI 1,*A 9* FUNCTION OBJECT HAS NO DEFINITION EVAL
*
EVTFS PAX 0,4 ATOM NAME
PXD 0,4 TO PRINT POSITION
LDQ EVTDE
TSX ARGOF,4 PRINT ARGUMENT MESSAGE
LDQ $ALIST RESTORE ALIST AFTER ARGOF
CLA EVTDE AND ARGUMENT LIST
TSX EVT1,4 DO THE FSUBR
TSX UNSAVE,4 RESTORE THE IR
XCA VALUE TO MQ
LXA CSV,4 GET ATOM NAME FOR VALUE MESSAGE
PXD 0,4 TO AC
LXD CSV,4 AND RETURN IR4
TRA VALOF PRINT VALUE MESSAGE
*
EVTXP STD EVTDE SAVE LAMBDA EXPRESSION
LXA EVS1,4 GET ATOMIC FUNCTION
PXD 0,4 TO PRINT POSITION
TSX ARGOF,4 PRINT ARGUMENT MESSAGE
TSX $SAVE,4 SAVE THERETURN IX
TXL $END1,,EVS1+2
LDQ EVT1 RESTORE THE LIST OF ARGUMENTS
CLA EVTDE AND THE LAMBDA EXPRESSION
TSX $APPLY,4 APPLY THE FUNCTION TO ITS ARGS
TSX UNSAVE,4
XCA PUT VALUE IN AC
LXA EVS1,4 NAME OF ROUTINE TRACED
PXD 0,4 PUT IN AC
LXD EVS1,4 LINK IR
TRA VALOF PRINT VALUE OF STATEMETN
*
* ARGOF PRINTS ARGUMENTS OF NAME FOLLOWED BY THE LIST OF ARGUMEN
*
ARGOF SXA PRX,4 SAVE INDEX REGISTERS
SXA PRY,2
STO AGA SAVE ATOM NAME
STQ AGQ SAVE LIST OF ARGUMENTS
TSX TERPRI,4 PRINT A BLANK LINE
AXT 3,2 PRINT2 OUT 3 WORDS
CLA AGM+3,2
TSX $PRINT2,4
TIX *-2,2,1 LOOP PAGE 161
CLA AGA
TSX $PRINT,4 PRINT OUT THE LINE
LXD AGQ,2 START THE PRINLIS
PLL TXL PRY,2,0 EXIT IF END OF LIST
CLA 0,2 NEXT ITEM
PDX 0,2 CDR OF LIST
PAX 0,4 CAR
PXD 0,4
TSX $PRINT,4
TRA PLL GET NEXT ITEM
PRY AXT **,2 RESTORE INDEX REGISTERS
PRX AXT **,4
TRA 1,4 EXIT
*
AGA TEMPORARY STORAGE
AGQ
AGM BCI 1,ARGUME
OCT 456362607777 ARGUMENTS
AGO OCT 462640777777 OF
VALV BCI 1,VALUE
*
* VALOF PRINTS VALUE OF NAME FOLLOWED BY ONE LIST
* SHARES STORAGE WITH ARGOF ROUTINE
*
VALOF SXA VAX,4 SAVE LINK IR
STO AGA ATOM NAME
STQ AGQ VALUE OF EXPRESSION
TSX TERPRI,4 PRINT A BLANK LINE
CLA VALV WORD VALUE
TSX $PRIN2,4 PUT IN OUTPUT LINE
CLA AGO WORD OF
TSX $PRIN2,4
CLA AGA ATOM
TSX $PRINT,4 PRINT OUT THE LINE
CLA AGQ VALUE
VAX AXT **,4 RESTORE LINK IR
TRA $PRINT PRINT OUT VALUE AND RETURN
EVTE E
EVTAE CAR(E)
EVTA A
EVT1
EVD1
EVLNS TST CELL FOR NUMBERS
EVCM TXL $END4,,EVTRK+2
EVZRO SYN $ZERO
EVQD1 SYN $QD1
--
__Pascal Bourguignon__ http://www.informatimago.com/
COMPONENT EQUIVALENCY NOTICE: The subatomic particles (electrons,
protons, etc.) comprising this product are exactly the same in every
measurable respect as those used in the products of other
manufacturers, and no claim to the contrary may legitimately be
expressed or implied.