#.file  #pure.s"
#.line 2
#
#       pure lisp functions
#       D.P.Mitchell  80/03/24.
#
#       Copyright © 1980, 2003 Don P. Mitchell.  All rights reserved.
#
#       This software is being provided "as is", without any express or implied
#       warranty.  I make no representation of warranty of any kind concerning the
#       merchantability of this software or its fitness for any particular purpose.
#
caaaar: movl    4(r0),r2        # the following generated by version 4 compiler
        movl    4(r2),r3
        movl    4(r3),r4
        movl    4(r4),r0
        movl    (sp)+,ap
        rsb

caaadr: movl    (r0),r5
        movl    4(r5),r6
        movl    4(r6),r7
        movl    4(r7),r0
        movl    (sp)+,ap
        rsb

caadar: movl    *4(r0),r8
        movl    4(r8),r9
        movl    4(r9),r0
        movl    (sp)+,ap
        rsb

caaddr: movl    *(r0),r8
        movl    4(r8),r9
        movl    4(r9),r0
        movl    (sp)+,ap
        rsb

cadaar: movl    4(r0),r1
        movl    *4(r1),r2
        movl    4(r2),r0
        movl    (sp)+,ap
        rsb

cadadr: movl    (r0),r3
        movl    *4(r3),r4
        movl    4(r4),r0
        movl    (sp)+,ap
        rsb

caddar: movl    *4(r0),r5
        movl    (r5),r6
        movl    4(r6),r0
        movl    (sp)+,ap
        rsb

cadddr: movl    *(r0),r7
        movl    (r7),r8
        movl    4(r8),r0
        movl    (sp)+,ap
        rsb

cdaaar: movl    4(r0),r9
        movl    4(r9),r8
        movl    *4(r8),r0
        movl    (sp)+,ap
        rsb

cdaadr: movl    (r0),r11
        movl    4(r11),r1
        movl    *4(r1),r0
        movl    (sp)+,ap
        rsb

cdadar: movl    *4(r0),r2
        movl    *4(r2),r0
        movl    (sp)+,ap
        rsb

cdaddr: movl    *(r0),r3
        movl    *4(r3),r0
        movl    (sp)+,ap
        rsb

cddaar: movl    4(r0),r4
        movl    *4(r4),r5
        movl    (r5),r0
        movl    (sp)+,ap
        rsb

cddadr: movl    (r0),r6
        movl    *4(r6),r7
        movl    (r7),r0
        movl    (sp)+,ap
        rsb

cdddar: movl    *4(r0),r8
        movl    *(r8),r0
        movl    (sp)+,ap
        rsb

cddddr: movl    *(r0),r9
        movl    *(r9),r0
        movl    (sp)+,ap
        rsb
# end
cadar:  movl    4(r0),r0
cadr:   movl    (r0),r0

        movl    4(r0),r0
        movl    (sp)+,ap
        rsb

        .align  2
car:    movl    4(r0),r0
        movl    (sp)+,ap
        rsb

cdddr:  movl    *(r0)+,r0
        movl    (r0),r0
        movl    (sp)+,ap
        rsb

cdr:    movl    (r0),r0
        movl    (sp)+,ap
        rsb

cdaar:  movl    4(r0),r0
cdar:   movl    *4(r0),r0
        movl    (sp)+,ap
        rsb

cddar:  movl    4(r0),r0
cddr:   movl    *(r0)+,r0
        movl    (sp)+,ap
        rsb

caaar:  movl    4(r0),r0
caar:   movl    4(r0),r0
        movl    4(r0),r0
        movl    (sp)+,ap
        rsb

caadr:  movl    (r0),r0
        movl    4(r0),r0
        movl    4(r0),r0
        movl    (sp)+,ap
        rsb

cdadr:  movl    (r0),r0
        movl    *4(r0),r0
        movl    (sp)+,ap
        rsb

caddr:  movl    *(r0)+,r0
        movl    4(r0),r0
        movl    (sp)+,ap
        rsb

        .align  2
atom:   tstl    4(r0)
        jlss    atom1
        clrl    r0
        movl    (sp)+,ap
        rsb

        .align  2
atom1:  movl    $t,r0
        movl    (sp)+,ap
        rsb

ncons:  movl    r0,(ap)
        clrl    r0

cons:   movl    (ap),r1         # (rplaca freepointer x)
        movq    r0,(fp)+        # (rplacd freepointer y)
        subl3   $8,fp,r0
        movl    (sp)+,ap
        rsb

        .align  2
eq:     cmpl    (ap),r0
        jeql    atom1
        clrl    r0
        movl    (sp)+,ap
        rsb

        .align  2
null:   tstl    r0
        jeql    atom1
        clrl    r0
        movl    (sp)+,ap
        rsb

setq:   pushl   $set            # (set (car x) (eval (cadr x)))
        pushl   ap
        movq    (r0),r0
        movl    r1,(ap)+
        movl    4(r0),r0
        cmpl    ap,sp
        jlssu   eval
        jbr     crash

set:    movl    r0,*(ap)        # (return (eval (cadr x)))

cond2:  movl    (sp)+,ap
        rsb

cond3:  movl    (ap),r0
cond:   tstl    r0
        jeql    cond2           # return nil if no more pairs
        pushl   $cond1
        pushl   ap
        movq    (r0),r0         # r0 = ((p2 e21 e22 ...)...)
        movq    (r1),r1         # r1=(e11 e12 ...)  r2=p1
        movq    r0,(ap)+
        movl    r2,r0
        cmpl    ap,sp
        jlssu   eval
        jbr     crash

cond1:  tstl    r0
        jeql    cond3
        movl    4(ap),r1
        jeql    cond2           # no e's, return p
        movl    r1,r0
        jbr     progn

undeff: movl    $undef,r0
        movl    (sp)+,ap
        rsb

rplaca: movl    r0,r1
        movl    (ap),r0
        movl    r1,4(r0)
        movl    (sp)+,ap
        rsb

rplacd: movl    r0,*(ap)
        movl    (ap),r0
        movl    (sp)+,ap
        rsb

xchanga:movl    (ap),r1
        movl    4(r1),r2
        movl    r0,4(r1)
        movl    r2,r0
        movl    (sp)+,ap
        rsb

xchangd:movl    (ap),r1
        movl    (r1),r2
        movl    r0,(r1)
        movl    r2,r0
        movl    (sp)+,ap
        rsb

progn1: movl    (ap),r0

progn:  movq    (r0),r1
        movl    r2,r0
        tstl    r1
        jeql    eval
        pushl   $progn1
        pushl   ap
        movl    r1,(ap)+
        cmpl    ap,sp
        jlssu   eval
        jbr     crash



spread2:movl    -(ap),r1
        movl    r0,(ap)+
        movl    (ap),r2
        movl    r1,(ap)+
        movl    r2,r0

spread: tstl    r0
        jeql    spread1
        movq    (r0),r0
        pushl   $spread2
        pushl   ap
        movl    r0,(ap)+
        movl    r1,r0
        cmpl    ap,sp
        jlssu   eval
        jbr     crash

spread1:addl2   $4,sp           # (don't watch!)
        subl2   $4,ap
        movl    -8(ap),r0
        rsb

and1:   tstl    r0
        jeql    cond2
        movl    (ap),r0

and:    movq    (r0),r1
        movl    r2,r0
        tstl    r1
        jeql    eval
        pushl   $and1
        pushl   ap
        movl    r1,(ap)+
        jbr     eval

or1:    tstl    r0
        jneq    cond2
        movl    (ap),r0

or:     movq    (r0),r1
        movl    r2,r0
        tstl    r1
        jeql    eval
        pushl   $or1
        pushl   ap
        movl    r1,(ap)+
        jbr     eval