.TITLE CAR ; JEFFREY KODOSKY ARL NOV75 ; ; SUBR ; ENTRY: 1 ARG ; EXIT: 1 ARG CAR[] ; ERRORS: A10, CAR OF AN ATOM (SUPPRESSED WITH X SW) ; CALLS: GETC, FETCH A FREE CELL ; GET, SEARCH PROPERTY LIST ; R2,R3 PRESERVED .GLOBL CAR,ZCAR,QGETC,QGET,QA10ERR,XSW,APVAL CAR: MOV @R5,R0 ;GET ARG MOV @R0,R1 ;GET CAR (ASSUMING NON-ATOMIC) BIT #3,R1 ;IS ARG NUMERIC? BNE CAR01 ;JUMP IF SO BIT #3,2(R0);IS IT ATOMIC? BNE CAR02 ;JUMP IF SO MOV R1,@R5 ;OTHERWISE RETURN CAR CAR01: JMP @-(R4) ;CAR OF NUMBER OR STRING IS ITSELF CAR02: BIT @PC,2(R0) ;IS ARG A LITATM? BNE CAR01 ;JUMP IF NOT ROOM 3 ;CHECK FOR ADEQUATE STACK SPACE MOV APVAL,-(R5) ;CHECK X SWITCH MOV XSW,-(R5) QGET TST (R5)+ BNE CAR03 ;JUMP IF IT IS ON QA10ERR ;OTHERWISE A10 ERROR TRAP CAR03: QGETC ;FETCH A NEW CELL MOV (R5)+,R0;POINT TO IT MOV @R5,R1 ;POINT TO MOV R0,@R5 ;RETURN A NEW STRING ATOM WHICH MOV @R1,(R0)+ ;IS THE ATOM'S PNAME MOV #3,@R0 ;FLAG IT A STRING JMP @-(R4) ZCAR=.-CAR .END