.TITLE PROG ; JEFFREY KODOSKY ARL NOV75 ; ; FSUBR ; ENTRY: 1 ARG ; EXIT: 1 ARG NIL ; ERRORS: NONE ; CALLS: EVAL ; CDR ; CAR ; ATOM ; CONS .GLOBL PROG,ZPROG,QEVAL,QCAR,QCDR,QCONS .GLOBL QATOM,$ALIST,ADPROG PROG: ROOM 5 MOV @R5,-(R5) QCAR ;GET LOCAL VARIABLE LIST MOV @R5,R3 MOV $ALIST,@R5 ;DOT EACH VARIABLE WITH NIL 1$: CLR -(R5) ;AND PUT THEM AT THE FRONT OF THE ALIST MOV R3,-(R5) BEQ 2$ QCAR QCONS QCONS MOV R3,-(R5) QCDR MOV (R5)+,R3 BR 1$ 2$: CMP (R5)+,(R5)+ MOV 2(R5),-(R5) QCDR ;GET BODY OF PROGRAM MOV @R5,4(R5) ;SAVE CURRENT PROG PC MOV @R5,R3 CLR @R5 ;MAKE A GO-LIST PROG1: MOV R3,-(R5);IS CAR OF PROG BODY REMAINDER ATOMIC? BEQ PROG4 ;(JUMP IF END OF PROG) QCAR QATOM TST (R5)+ BEQ PROG2 ;JUMP IF NOT MOV R3,-(R5);YES: CONS IT TO GO-LIST QCONS PROG2: MOV R3,-(R5);GET CDR OF PROG BODY QCDR MOV (R5)+,R3 BR PROG1 PROG4: TST (R5)+ ;GO-LIST IS COMPLETE, POP NIL INC @R5 ;MARK STACK PROG6: MOV 4(R5),-(R5) ;GET NEXT EXPR TO EVAL BEQ PROG9 ;JUMP IF END OF PROG MOV @R5,-(R5) ;SOTRE UPDATED PROG PC QCDR MOV (R5)+,6(R5) QCAR MOV @R5,-(R5) ;IS THIS A LABEL OR EXPR? QATOM TST (R5)+ BNE ADPROG ;JUMP IF LABEL MOV 4(R5),$ALIST ;RESET CONTEXT QEVAL ;EVALUATE EXPRESSION ADPROG: TST (R5)+ ;IGNORE VALUE BR PROG6 PROG9: ADD #6,R5 ;POP GARBAGE CLR @R5 ;AND RETURN NIL JMP @-(R4) ZPROG=.-PROG .END