.TITLE INTERN ; JEFFREY KODOSKY ARL NOV75 ; ; SUBR ; ENTRY: 1 ARG ; EXIT: 1 ARG ; ERRORS: NONE ; CALLS: ATMOBL .GLOBL INTERN,ZINTERN INTERN: MOV @R5,R0 BIT #2,(R0)+ BNE INTRN1 ;JUMP IF ILLEGAL ARG BIT #2,@R0 BNE INTRN3 ;JUMP IF STRING ARG BIT #1,@R0 BNE ATMOBL ;JUMP IF ALREADY LITATM TO INSTALL IT INTRN1: CLR @R5 ;ILLEGAL ARG: RETURN NIL JMP @-(R4) INTRN3: MOV #1,@R0 ;MAKE A LITATM WITH NULL PROPERTY LIST ; ; ; ; UTILITY: INSTALL ATOM ON OBLIST ; ENTRY: 1 ARG ; EXIT: 1 ARG ; R1:= PORTION OF OBLIST BUCKET WHOSE CADR IS ARG ; C BIT SET IF IS FIRST OBJECT IN BUCKET ; IN WHICH CASE CAAR OF R1 IS ; ERRORS: NONE ; CALLS: GETC, FETCH A FREE CELL ; EQN, COMPARE PNAMES ; HASH, HASH A PNAME ; NOTE: IF ARG ALREADY EXISTS ON OBLIST THE NEW ATOM ; IS DISCARDED AND A POINTER TO THE EXISTING ONE IS RETURNED. .GLOBL ATMOBL,QHASH,QEQN,QGETC,$OBLST ATMOBL: QHASH ;HASH THE PNAME MOV $OBLST,R1 ;POINT TO START OF OBLIST ADD (SP)+,R1;POINT TO BUCKET MOV @R1,R0 BEQ AOB10 ;JUMP IF BUCKET IS EMPTY ROOM 3 ;CHECK FOR ADEQUATE STACK SPACE AOB01: MOV R0,-(SP);SAVE POINTERS MOV R1,-(SP) MOV @R0,-(R5) ;PUSH NEXT ATOM IN BUCKET MOV 2(R5),-(R5) ;PUSH QEQN ;CHECK FOR EQUAL PNAMES MOV (SP)+,R1;RESTORE POINTERS MOV (SP)+,R0 TST (R5)+ BNE AOB20 ;JUMP IF EQUAL PNAMES MOV R0,R1 ;BUMP DOWN THE BUCKET MOV 2(R0),R0 BNE AOB01 ;LOOP BACK IF MORE OBJECTS MOV R1,-(SP);OTHERWISE SAVE POINTER TO LAST CELL QGETC ;OF BUCKET AND FETCH A NEW ONE CLC MOV (R5)+,R0;PUT POINTER IN CAR MOV @R5,@R0 MOV (SP)+,R1 ;POP POINTER TO PREVIOUS LAST MOV R0,2(R1);CELL AND CHAIN NEW ONE TO IT JMP @-(R4) AOB10: MOV R1,-(SP);SAVE POINTER TO BUCKET QGETC ;FETCH A NEW CELL SEC ;INDICATE FIRST OBJECT IN BUCKET MOV (R5)+,R0 MOV @R5,@R0 ;PUT POINTER IN CAR MOV (SP)+,R1 ;GET POINTER TO BUCKET MOV R0,@R1 ;INSERT NEW ATOM IN BUCKET JMP @-(R4) AOB20: CMP @R1,R0 ;CAR OF CELL AT R1 = R0 ONLY IF OBJECT BEQ AOB21 ;IS FIRST ON OBLIST BUCKET CLC BR .+4 AOB21: SEC ;SET C BIT IF OBJECT IS FIRST MOV @R0,@R5 ;RETURN POINTER TO EXISTING ATOM JMP @-(R4) ZINTERN=.-INTERN .END