Chaitin. Algorithmic information theory

4.2. EVAL IN REGISTER MACHINE LANGUAGE

109

*

/ If

POPL EXPRESSION,ARGUMENTS

pick up "if" clause

PUSH ARGUMENTS

remember "then" & "else" clauses

L59: SET SOURCE ARGUMENTS

L60: JUMP LINKREG2 PUSH_ROUTINE

JUMP LINKREG,EVAL

evaluate predicate

L61: JUMP LINKREG EVAL

POP ARGUMENTS

pick up "then" & "else" clauses

L62: JUMP LINKREG2 POP_ROUTINE

L63: SET ARGUMENTS TARGET

EQ VALUE,C')',UNWIND

abort ?

L64: EQ VALUE C')' UNWIND

NEQ VALUE,C'0',THEN_CLAUSE predicate considered true

*

if not 0

L65: NEQ VALUE C'0' THEN_CLAUSE

TL ARGUMENTS,ARGUMENTS

if false, skip "then" clause

THEN_CLAUSE LABEL

HD EXPRESSION,ARGUMENTS

pick up "then" or "else" clause

JUMP LINKREG,EVAL

evaluate it

L72: JUMP LINKREG EVAL

110

CHAPTER 4. THE LISP INTERPRETER EVAL

GOTO UNWIND

return value "as is"

EQ VALUE,C')',UNWIND

abort ?

L79: EQ VALUE C')' UNWIND

SET ARGUMENTS,VALUE

remember argument values

L80: SET ARGUMENTS VALUE

SPLIT X,Y,ARGUMENTS

pick up first argument in x

L81: SET SOURCE ARGUMENTS

L82: JUMP LINKREG3 SPLIT_ROUTINE

L83: SET X TARGET

L84: SET Y TARGET2

HD Y,Y

& second argument in y

*

. Atom

ATOM X,RETURN1

if argument is atomic return true

4.2. EVAL IN REGISTER MACHINE LANGUAGE

111

GOTO RETURN0

otherwise return nil

L93: GOTO RETURN0

*

NOT_ATOM LABEL

*

NEQ FUNCTION,C'=',NOT_EQUAL

NOT_ATOM: NEQ FUNCTION C'=' NOT_EQUAL

*

= Equal

COMPARE LABEL

NEQ X,Y,RETURN0

not equal !

COMPARE: NEQ X Y RETURN0

RIGHT X

L96: RIGHT X

RIGHT Y

L97: RIGHT Y

NEQ X,X'00',COMPARE

L98: NEQ X X'00' COMPARE

GOTO RETURN1

equal !

L99: GOTO RETURN1

*

NOT_EQUAL LABEL

*

* Head, Tail & Join ..........................................

*

SPLIT TARGET,TARGET2,X

get head & tail of argument

NOT_EQUAL: SET SOURCE X

L101: JUMP LINKREG3 SPLIT_ROUTINE

SET VALUE,TARGET

L102: SET VALUE TARGET

EQ FUNCTION,C'+',UNWIND

+ pick Head

L103: EQ FUNCTION C'+' UNWIND

SET VALUE,TARGET2

L104: SET VALUE TARGET2

EQ FUNCTION,C'-',UNWIND

- pick Tail

L105: EQ FUNCTION C'-' UNWIND

*

JN VALUE,X,Y

* Join first argument

*

to second argument

L106: SET SOURCE X

*

, Output

OUT X

write argument

L112: OUT X

SET VALUE,X

identity function!

L113: SET VALUE X

GOTO UNWIND

L114: GOTO UNWIND

SET VALUE,C')'

L116: SET VALUE C')'

ATOM DEPTH,UNWIND

if limit exceeded, unwind

L117: NEQ DEPTH C'(' UNWIND

L118: SET WORK DEPTH

L119: RIGHT WORK

L120: EQ WORK C')' UNWIND

NO_LIMIT LABEL

PUSH DEPTH

push limit before decrementing it

NO_LIMIT: SET SOURCE DEPTH

L122: JUMP LINKREG2 PUSH_ROUTINE

TL DEPTH,DEPTH

decrement it

L123: SET SOURCE DEPTH

4.2. EVAL IN REGISTER MACHINE LANGUAGE

113

*

* Eval .......................................................

*

NEQ FUNCTION,C'!',NOT_EVAL

L126: NEQ FUNCTION C'!' NOT_EVAL

*

! Eval

SET EXPRESSION,X

pick up argument

L127: SET EXPRESSION X

PUSH ALIST

push alist

L128: SET SOURCE ALIST

L129: JUMP LINKREG2 PUSH_ROUTINE

EMPTY ALIST

fresh environment

L130: SET ALIST C')'

L131: LEFT ALIST C'('

JUMP LINKREG,EVAL

evaluate argument again

L132: JUMP LINKREG EVAL

POP ALIST

restore old environment

L133: JUMP LINKREG2 POP_ROUTINE

L134: SET ALIST TARGET

POP DEPTH

restore old depth limit

L135: JUMP LINKREG2 POP_ROUTINE

L136: SET DEPTH TARGET

GOTO UNWIND

L137: GOTO UNWIND

*

NOT_EVAL LABEL

*

* Evald ......................................................

*

NEQ FUNCTION,C'?',NOT_EVALD

NOT_EVAL: NEQ FUNCTION C'?' NOT_EVALD

*

? Eval depth limited

SET VALUE,X

pick up first argument

L139: SET VALUE X

SET EXPRESSION,Y

pick up second argument

L140: SET EXPRESSION Y

114

CHAPTER 4. THE LISP INTERPRETER EVAL

* second argument is expression to safely eval.

PUSH ALIST

save old environment

L141: SET SOURCE ALIST

L142: JUMP LINKREG2 PUSH_ROUTINE

EMPTY ALIST

fresh environment

L143: SET ALIST C')'

L144: LEFT ALIST C'('

* Decide whether old or new depth restriction is stronger

SET X,DEPTH

pick up old depth limit

L145: SET X DEPTH

SET Y,VALUE

pick up new depth limit

L146: SET Y VALUE

EQ X,C'_',NEW_DEPTH

no previous limit,

*

so switch to new one

L147: EQ X C'_' NEW_DEPTH

CHOOSE LABEL

ATOM X,OLD_DEPTH

old limit smaller, so keep it

CHOOSE: NEQ X C'(' OLD_DEPTH

L149: SET WORK X

L150: RIGHT WORK

L151: EQ WORK C')' OLD_DEPTH

ATOM Y,NEW_DEPTH

new limit smaller, so switch

L152: NEQ Y C'(' NEW_DEPTH

L153: SET WORK Y

L154: RIGHT WORK

L155: EQ WORK C')' NEW_DEPTH

TL X,X

L156: SET SOURCE X

L157: JUMP LINKREG3 SPLIT_ROUTINE

L158: SET X TARGET2

TL Y,Y

L159: SET SOURCE Y

L160: JUMP LINKREG3 SPLIT_ROUTINE

L161: SET Y TARGET2

GOTO CHOOSE

L162: GOTO CHOOSE

*

NEW_DEPTH LABEL

NEW depth limit more restrictive

SET DEPTH,VALUE

pick up new depth limit

4.2. EVAL IN REGISTER MACHINE LANGUAGE

115

NEW_DEPTH: SET DEPTH VALUE

NEQ DEPTH,C'_',DEPTH_OKAY

L164: NEQ DEPTH C'_' DEPTH_OKAY

SET DEPTH,C'0'

only top level has no depth limit

L165: SET DEPTH C'0'

DEPTH_OKAY LABEL

JUMP LINKREG,EVAL

evaluate second argument

*

of ? again

DEPTH_OKAY: JUMP LINKREG EVAL

POP ALIST

restore environment

L167: JUMP LINKREG2 POP_ROUTINE

L168: SET ALIST TARGET

POP DEPTH

restore depth limit

L169: JUMP LINKREG2 POP_ROUTINE

L170: SET DEPTH TARGET

EQ VALUE,C')',RETURNQ

convert "no value" to ?

L171: EQ VALUE C')' RETURNQ

WRAP LABEL

EMPTY SOURCE2

WRAP: SET SOURCE2 C')'

L173: LEFT SOURCE2 C'('

JN VALUE,VALUE,SOURCE2

wrap good value in parentheses

L174: SET SOURCE VALUE

L175: JUMP LINKREG3 JN_ROUTINE

L176: SET VALUE TARGET

GOTO UNWIND

L177: GOTO UNWIND

*

OLD_DEPTH LABEL

OLD depth limit more restrictive

JUMP LINKREG,EVAL

evaluate second argument

*

of ? again

OLD_DEPTH: JUMP LINKREG EVAL

POP ALIST

restore environment

L179: JUMP LINKREG2 POP_ROUTINE

L180: SET ALIST TARGET

POP DEPTH

restore depth limit

L181: JUMP LINKREG2 POP_ROUTINE

L182: SET DEPTH TARGET

EQ VALUE,C')',UNWIND

if bad value, keep unwinding

116

CHAPTER 4. THE LISP INTERPRETER EVAL

L183:

EQ VALUE C')' UNWIND

GOTO WRAP

wrap good value in parentheses

L184:

GOTO WRAP

POPL VARIABLES,FUNCTION

pick

up variables

*

from

function definition

PUSH ALIST

save environment

L192: SET SOURCE ALIST

L193: JUMP LINKREG2 PUSH_ROUTINE

JUMP LINKREG,BIND

new environment

*

(preserves function)

L194: JUMP LINKREG BIND

*

* Evaluate Body

*

HD EXPRESSION,FUNCTION

pick up body of function

JUMP LINKREG,EVAL

evaluate body

L198: JUMP LINKREG EVAL

*

* Unbind

*

POP ALIST

restore environment

4.2. EVAL IN REGISTER MACHINE LANGUAGE

117

L199: JUMP LINKREG2 POP_ROUTINE

L200: SET ALIST TARGET

POP DEPTH

restore depth limit

EVALST LABEL

loop to eval arguments

PUSH LINKREG

push return address

EVALST: SET SOURCE LINKREG

L205: JUMP LINKREG2 PUSH_ROUTINE

SET VALUE,ARGUMENTS

null argument list has

L206: SET VALUE ARGUMENTS

ATOM ARGUMENTS,UNWIND

null list of values

L207: NEQ ARGUMENTS C'(' UNWIND

L208: SET WORK ARGUMENTS

L209: RIGHT WORK

L210: EQ WORK C')' UNWIND

POPL EXPRESSION,ARGUMENTS

pick up next argument

L213: SET

EXPRESSION TARGET

L214: SET ARGUMENTS TARGET2

PUSH ARGUMENTS

push remaining arguments

L215: SET SOURCE ARGUMENTS

L216: JUMP LINKREG2 PUSH_ROUTINE

JUMP LINKREG,EVAL

evaluate first argument

L217: JUMP LINKREG EVAL

POP ARGUMENTS

pop remaining arguments

L218: JUMP LINKREG2 POP_ROUTINE

L219: SET ARGUMENTS TARGET

EQ VALUE,C')',UNWIND

abort ?

L220: EQ VALUE C')' UNWIND

PUSH VALUE

push value of first argument

L221: SET SOURCE VALUE

118

CHAPTER 4. THE LISP INTERPRETER EVAL

L222: JUMP LINKREG2 PUSH_ROUTINE

JUMP LINKREG,EVALST

evaluate remaining arguments

L223: JUMP LINKREG EVALST

POP X

pop value of first argument

L224: JUMP LINKREG2 POP_ROUTINE

L225: SET X TARGET

EQ VALUE,C')',UNWIND

abort ?

L226: EQ VALUE C')' UNWIND

JN VALUE,X,VALUE

add first value to rest

L227: SET SOURCE X

L228: SET SOURCE2 VALUE

BIND LABEL

must not ruin FUNCTION

PUSH LINKREG

BIND: SET SOURCE LINKREG

L233: JUMP LINKREG2 PUSH_ROUTINE

ATOM VARIABLES,UNWIND

any variables left to bind?

POPL X,VARIABLES

pick up variable

L238: SET SOURCE VARIABLES

L239: JUMP LINKREG3 SPLIT_ROUTINE

L240: SET X TARGET

L241: SET VARIABLES TARGET2

PUSH X

save it