Google
 

Trailing-Edge - PDP-10 Archives - clisp - clisp/upsala/symbol.lap
There are no other files named symbol.lap in the archive.
;;; CLC vP.U.V.1(2) compiling CARMEN::SS:<CLISP.UPSALA>SYMBOL.CLISP.4

(IN-PACKAGE (QUOTE LISP)) 
(EXPORT (QUOTE (GETF GET-PROPERTIES COPY-SYMBOL SAMENAMEP))) 
(%PUT (QUOTE GETF) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Searches the property list stored in Place for an indicator EQ to Indicator.
  If one is found, the corresponding value is returned, else the Default is
  returned.")) 

#_(LAP #0_GETF EXPR
       (ENTRY-POINTS (2-FEW 2-FEW 1 2 2-MANY 2-MANY 2-MANY))
       #0_("~S is a malformed property list.")
       (CODE-START)
(LABEL 1)    (MOVE O3 NIL)
(LABEL 2)    (ADDI Q 5)
             (MOVEM O1 -4 Q)
             (MOVEM O2 -3 Q)
             (MOVEM O3 -2 Q)
             (MOVE O5 O1)
             (MOVEM O5 -1 Q)
(LABEL 8)    (SKIPE NIL -1 Q)
             (JRST 9)
             (MOVE O1 -2 Q)
             (MOVEI N 1)
             (JRST 4)
(LABEL 9)    (MOVE O1 -1 Q)
             (MOVE O1 1 O1)
             (CALL ATOM 1)
             (JUMPE O1 12)
             (MOVE O2 -4 Q)
             (MOVE O1 (CONSTANT 0))
             (CALL ERROR 2)
             (JRST 11)
(LABEL 12)   (MOVE O1 -1 Q)
             (MOVE O5 0 O1)
             (MOVEM O5 0 Q)
             (MOVE O2 -3 Q)
             (CAME O2 0 Q)
             (JRST 13)
             (MOVE O1 1 O1)
             (MOVE O1 0 O1)
             (MOVEI N 1)
             (JRST 4)
(LABEL 13)
(LABEL 11)   (MOVE O1 -1 Q)
             (MOVE O1 1 O1)
             (MOVE O1 1 O1)
             (MOVEM O1 -1 Q)
             (JRST 8)
(LABEL 4)    (SUBI Q 5)
             (POPJ P)
)

(%PUT (QUOTE GETF) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (PLACE INDICATOR &OPTIONAL (DEFAULT NIL)))) 
(%PUT (QUOTE GETF) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>SYMBOL.CLISP.4") (GET (QUOTE GETF) (QUOTE %SOURCE-DOCUMENTATION)))) 
(%PUT (QUOTE GET-PROPERTIES) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Like GETF, except that Indicator-List is a list of indicators which will
  be looked for in the property list stored in Place.  Three values are
  returned, see manual for details.")) 

#_(LAP #0_GET-PROPERTIES EXPR
       (ENTRY-POINTS (2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY))
       #0_("~S is a malformed proprty list.")
       (CODE-START)
(LABEL 1)    (ADDI Q 5)
             (MOVEM O1 -4 Q)
             (MOVEM O2 -3 Q)
             (MOVE O5 O1)
             (MOVEM O5 -2 Q)
(LABEL 7)    (SKIPE NIL -2 Q)
             (JRST 8)
             (MOVE O3 NIL)
             (MOVE O1 O3)
             (MOVE O2 O1)
             (MOVEI N 3)
             (JRST 3)
(LABEL 8)    (MOVE O1 -2 Q)
             (MOVE O1 1 O1)
             (CALL ATOM 1)
             (JUMPE O1 11)
             (MOVE O2 -4 Q)
             (MOVE O1 (CONSTANT 0))
             (CALL ERROR 2)
             (JRST 10)
(LABEL 11)   (MOVE O1 -2 Q)
             (MOVE O5 0 O1)
             (MOVEM O5 -1 Q)
             (MOVE O2 -3 Q)
             (MOVE O1 O5)
             (CALL MEMQ 2)
             (JUMPE O1 12)
             (MOVE O1 -2 Q)
             (MOVE O5 0 O1)
             (MOVEM O5 -1 Q)
             (MOVE O1 1 O1)
             (MOVE O5 0 O1)
             (MOVEM O5 0 Q)
             (MOVE O3 -2 Q)
             (MOVE O1 -1 Q)
             (MOVE O2 O5)
             (MOVEI N 3)
             (JRST 3)
(LABEL 12)
(LABEL 10)   (MOVE O1 -2 Q)
             (MOVE O1 1 O1)
             (MOVE O1 1 O1)
             (MOVEM O1 -2 Q)
             (JRST 7)
(LABEL 3)    (SUBI Q 5)
             (POPJ P)
)

(%PUT (QUOTE GET-PROPERTIES) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (PLACE INDICATOR-LIST))) 
(%PUT (QUOTE GET-PROPERTIES) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>SYMBOL.CLISP.4") (GET (QUOTE GET-PROPERTIES) (QUOTE %SOURCE-DOCUMENTATION)))) 
(%PUT (QUOTE SAMENAMEP) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Returns T if the two symbols have equal print names.  Case is
  distinguished by this predicate.")) 

#_(LAP #0_SAMENAMEP EXPR
       (ENTRY-POINTS (2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY))
       #0_NIL
       (CODE-START)
(LABEL 1)    (ADDI Q 3)
             (MOVEM O1 -2 Q)
             (MOVEM O2 -1 Q)
             (CALL SYMBOL-NAME 1)
             (MOVEM O1 0 Q)
             (MOVE O1 -1 Q)
             (CALL SYMBOL-NAME 1)
             (MOVE O2 O1)
             (MOVE O1 0 Q)
             (CALL STRING= 2)
             (SUBI Q 3)
             (POPJ P)
)

(%PUT (QUOTE SAMENAMEP) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (SYM1 SYM2))) 
(%PUT (QUOTE SAMENAMEP) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>SYMBOL.CLISP.4") (GET (QUOTE SAMENAMEP) (QUOTE %SOURCE-DOCUMENTATION)))) 
(%PUT (QUOTE COPY-SYMBOL) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Make and return a new uninterned symbol with the same print name
  as SYMBOL.  If COPY-PROPS is null, the new symbol has no properties.
  Else, it has a copy of SYMBOL's property list.")) 

#_(LAP #0_COPY-SYMBOL EXPR
       (ENTRY-POINTS (2-FEW 1 2 2-MANY 2-MANY 2-MANY 2-MANY))
       #0_NIL
       (CODE-START)
(LABEL 1)    (MOVE O2 NIL)
(LABEL 2)    (ADDI Q 3)
             (MOVEM O1 -1 Q)
             (MOVEM O2 0 Q)
             (MOVEM NIL -2 Q)
             (CALL SYMBOL-NAME 1)
             (CALL MAKE-SYMBOL 1)
             (MOVEM O1 -2 Q)
             (SKIPN NIL 0 Q)
             (JRST 4)
             (MOVE O1 -1 Q)
             (CALL SYMBOL-PLIST 1)
             (CALL COPY-LIST 1)
             (MOVE O2 O1)
             (MOVE O1 -2 Q)
             (CALL LISP::%SET-PLIST 2)
(LABEL 4)    (MOVE O1 -2 Q)
             (MOVEI N 1)
             (SUBI Q 3)
             (POPJ P)
)

(%PUT (QUOTE COPY-SYMBOL) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (SYMBOL &OPTIONAL (COPY-PROPS NIL) &AUX NEW-SYMBOL))) 
(%PUT (QUOTE COPY-SYMBOL) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>SYMBOL.CLISP.4") (GET (QUOTE COPY-SYMBOL) (QUOTE %SOURCE-DOCUMENTATION))))