Google
 

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

(IN-PACKAGE (QUOTE LISP)) 
(EXPORT (QUOTE (%GET-KEY))) 

#_(LAP #0_WITH-KEYWORDS-INTERNAL-49 EXPR
       (ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
       #0_(LET REST-OPTIONS MEMQ QUOTE IF (CADR REST-OPTIONS))
       (CODE-START)
(LABEL 1)    (ADDI Q 5)
             (MOVE O6 0 O6)
             (MOVEM O6 -4 Q)
             (MOVEM O1 -3 Q)
             (MOVE O1 1 O1)
             (MOVE O5 0 O1)
             (MOVEM O5 -2 Q)
             (MOVE O1 -3 Q)
             (MOVE O2 0 O1)
             (MOVE O1 (CONSTANT 3))
             (CALL LIST 2)
             (MOVEM O1 0 Q)
             (MOVE O6 -4 Q)
             (MOVE O3 1 O6)
             (MOVE O1 (CONSTANT 2))
             (MOVE O2 0 Q)
             (CALL LIST 3)
             (MOVE O2 O1)
             (MOVE O1 (CONSTANT 1))
             (CALL LIST 2)
             (CALL LIST 1)
             (MOVEM O1 -1 Q)
             (MOVE O1 -3 Q)
             (MOVE O1 1 O1)
             (MOVE O1 1 O1)
             (MOVE O4 0 O1)
             (MOVE O1 (CONSTANT 4))
             (MOVE O2 (CONSTANT 1))
             (MOVE O3 (CONSTANT 5))
             (CALL LIST 4)
             (MOVE O3 O1)
             (MOVE O1 (CONSTANT 0))
             (MOVE O2 -1 Q)
             (CALL LIST 3)
             (MOVE O2 O1)
             (MOVE O1 -2 Q)
             (CALL LIST 2)
             (SUBI Q 5)
             (POPJ P)
)


#_(LAP #0_WITH-KEYWORDS MACRO
       (ENTRY-POINTS (2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY 2-MANY))
       #0_(3 "Macro ~S cannot be called with ~S args." WITH-KEYWORDS LET WITH-KEYWORDS-INTERNAL-49 2 1)
       (CODE-START)
(LABEL 1)    (ADDI Q 6)
             (MOVE W2 (CONSTANT 6))
             (MOVE O6 NIL)
             (ICALL ALLOC-CLOSURE-VECTOR)
             (MOVEM W3 -5 Q)
             (MOVEM O1 -4 Q)
             (CALL LENGTH 1)
             (MOVEM O1 -3 Q)
             (MOVE O2 (CONSTANT 0))
             (CALL < 2)
             (JUMPE O1 4)
             (MOVE O1 -4 Q)
             (CALL LENGTH 1)
             (CALL 1- 1)
             (MOVE O3 O1)
             (MOVE O1 (CONSTANT 1))
             (MOVE O2 (CONSTANT 2))
             (CALL ERROR 3)
             (JRST 3)
(LABEL 4)    (SKIPA)
             (JRST 5)
             (MOVE W2 (CONSTANT 5))
             (MOVE O6 -5 Q)
             (ICALL ALLOC-CLOSURE-VECTOR)
             (MOVEM W3 -3 Q)
             (MOVE O1 -4 Q)
             (MOVE O1 1 O1)
             (MOVE O5 0 O1)
             (MOVE O6 W3)
             (MOVEM O5 1 O6)
             (MOVE O1 -4 Q)
             (MOVE O1 1 O1)
             (MOVE O1 1 O1)
             (MOVE O5 0 O1)
             (MOVEM O5 -2 Q)
             (MOVE O1 -4 Q)
             (MOVE O1 1 O1)
             (MOVE O1 1 O1)
             (MOVE O5 1 O1)
             (MOVEM O5 -1 Q)
             (MOVE O1 (CONSTANT 4))
             (MOVE O2 O6)
             (ICALL CLOGEN)
             (MOVEM O1 0 Q)
             (MOVE O2 -2 Q)
             (CALL MAPCAR 2)
             (MOVEM O1 0 Q)
             (MOVE O3 -1 Q)
             (MOVE O1 (CONSTANT 3))
             (MOVE O2 0 Q)
             (CALL LIST* 3)
(LABEL 5)
(LABEL 3)    (SUBI Q 6)
             (POPJ P)
)

(%PUT (QUOTE WITH-KEYWORDS) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (OPTION-LIST KEY-LIST &REST BODY))) 
(%PUT (QUOTE WITH-KEYWORDS) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>KEYWORD.CLISP.4") (GET (QUOTE WITH-KEYWORDS) (QUOTE %SOURCE-DOCUMENTATION)))) 
(%PUT (QUOTE %GET-KEY) (QUOTE %FUN-DOCUMENTATION) (QUOTE "Called by compiled functions with keyword args.  CDDR down List looking
  for KEY.  If it is found, return the list fragment following the keyword.
  Else, return NIL.")) 

#_(LAP #0_%GET-KEY EXPR
       (ENTRY-POINTS (2-FEW 2-FEW 1 2-MANY 2-MANY 2-MANY 2-MANY))
       #0_("Stick a NIL on the end and go on." "Unpaired item in keyword portion of call.")
       (CODE-START)
(LABEL 1)    (ADDI Q 4)
             (MOVEM O1 -3 Q)
             (MOVEM O2 -2 Q)
             (MOVE O5 O1)
             (MOVEM O5 -1 Q)
(LABEL 7)    (SKIPE NIL -1 Q)
             (JRST 8)
             (MOVE O1 NIL)
             (MOVEI N 1)
             (JRST 3)
(LABEL 8)    (MOVE O1 -1 Q)
             (SKIPE NIL 1 O1)
             (JRST 11)
             (MOVE O2 (CONSTANT 1))
             (MOVE O1 (CONSTANT 0))
             (CALL CERROR 2)
             (MOVE O1 NIL)
             (CALL LIST 1)
             (MOVE O2 O1)
             (MOVE O1 -1 Q)
             (CALL RPLACD 2)
             (MOVE O1 NIL)
             (MOVEI N 1)
             (JRST 3)
(LABEL 11)   (MOVE O1 -1 Q)
             (MOVE O5 0 O1)
             (MOVEM O5 0 Q)
             (MOVE O2 -2 Q)
             (CAME O2 0 Q)
             (JRST 12)
             (MOVE O1 1 O1)
             (MOVEI N 1)
             (JRST 3)
(LABEL 12)   (MOVE O1 -1 Q)
             (MOVE O1 1 O1)
             (MOVE O1 1 O1)
             (MOVEM O1 -1 Q)
             (JRST 7)
(LABEL 3)    (SUBI Q 4)
             (POPJ P)
)

(%PUT (QUOTE %GET-KEY) (QUOTE %ARGS-DOCUMENTATION) (QUOTE (LIST KEY))) 
(%PUT (QUOTE %GET-KEY) (QUOTE %SOURCE-DOCUMENTATION) (CONS (QUOTE "CARMEN::SS:<CLISP.UPSALA>KEYWORD.CLISP.4") (GET (QUOTE %GET-KEY) (QUOTE %SOURCE-DOCUMENTATION))))