.TITLE SELECT ; JEFFREY KODOSKY ARL JUL76 ; ; FSUBR ; ENTRY: 1 ARG (,,...,,) ; EXIT: 1 ARG ; ERRORS: NONE ; CALLS: CAR ; CDR ; EVAL ; EQUAL ; PROGN .GLOBL SELECT,ZSELECT,$ALIST,QCAR,QCDR,QEVAL,QEQUAL,QPROGN SELECT: ROOM 6 MOV @R5,R3 MOV $ALIST,-(R5) MOV R3,-(R5) QCDR MOV R3,-(R5) QCAR QEVAL MOV (R5)+,4(R5) ;SAVE EVAL[] SEL04: MOV @R5,R3 QCDR TST @R5 BEQ SEL07 ;JUMP IF END OF ALL S MOV R3,-(R5) QCAR MOV @R5,-(R5) QCAR MOV 6(R5),$ALIST ;RESTORE ALIST QEVAL ;EVAL[CAR[]] MOV 10(R5),-(R5) QEQUAL TST (R5)+ ;EQUAL[EVAL[];EVAL[CAR[]]] BNE SEL10 ; ---->PROGN[] TST (R5)+ ;T---->SELECT[(,,...,, BR SEL04 ; )] SEL07: TST (R5)+ ;SELECT[(,)]--->EVAL[] MOV (R5)+,$ALIST MOV R3,@R5 QCAR QEVAL .WORD 0 SEL10: QCDR ;CDR[] MOV (R5)+,R3 BEQ SEL13 ;JUMP IF HAD JUST ONE EXPR TST (R5)+ ;ELSE--->PROGN[CDR[]] MOV (R5)+,$ALIST MOV R3,@R5 QPROGN .WORD 0 SEL13: CMP (R5)+,(R5)+ JMP @-(R4) ZSELECT=.-SELECT .END