Google
 

Trailing-Edge - PDP-10 Archives - -
There are no other files named in the archive.
(FILECREATED "24-DEC-81 00:39:26" <LISPUSERS>SMARTARG.;23 15640Q 

     changes to:  SMARTARGLIST

     previous date: " 9-APR-81 22:04:45" <LISPUSERS>SMARTARG.;22)


(* Copyright (c) 1981 Xerox Corporation)


(PRETTYCOMPRINT SMARTARGCOMS)

(RPAQQ SMARTARGCOMS ((FNS SMARTARGLIST)
		     (FILEVARS SMARTARGLIST)
		     (FILES (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
			    SWAPHASH)
		     [P (OR (BOUNDP (QUOTE SMARTARGARRAY))
			    (PROG ((ARR (SHARRAY 1000Q)))
				  [MAPC SMARTARGLIST (FUNCTION (LAMBDA
								 (X)
								 (MAPC (CDR X)
								       (FUNCTION
									 (LAMBDA (F)
										 (SPUTHASH
										   F
										   (CAR X)
										   ARR]
				  (RPAQ SMARTARGARRAY ARR]
		     (LOCALVARS . T)))
(DEFINEQ

(SMARTARGLIST
  [LAMBDA (FN EXPLAINFLG TAIL)     (* lmm "23-DEC-81 23:55")
                                   (* redefinition of SMARTARGLIST, uses swapped hash table)
    (PROG (TEM AT)
      RET [COND
	    ((NOT (LITATOM FN))
	      (RETURN (ARGLIST FN)))
	    ((SETQ TEM (FMEMB (QUOTE ARGNAMES)
			      (GETPROPLIST FN)))
	      (RETURN (COND
			((CAR (SETQ TEM (CADR TEM)))
			  TEM)
			(EXPLAINFLG (CADR TEM))
			(T (CDDR TEM]
          (SETQ AT (ARGTYPE FN))
          (RETURN (for X in COMPILERMACROPROPS
		     do [AND (SETQ TEM (GETPROP FN X))
			     (SELECTQ (CAR TEM)
				      ([LAMBDA NLAMBDA]
					(RETURN (CADR TEM)))
				      (COND
					((NULL (CAR TEM))
					  (RETURN))
					((LISTP (CAR TEM))
					  (RETURN (COND
						    [(CDR (LAST (CAR TEM)))
						      (APPEND (CAR TEM)
							      (LIST (QUOTE ...)
								    (CDR (LAST (CAR TEM]
						    (T (CAR TEM]
		     finally [COND
			       ((SELECTQ AT
					 ((0 1)
					   (SUBRP FN))
					 ((2 3)
					   EXPLAINFLG)
					 T)
                                   (* either a SUBR, a no-spread when EXPLAINFLG is T, or not defined)
				 [COND
				   ((SETQ TEM (SGETHASH FN SMARTARGARRAY))
				     [COND
				       ((IGREATERP (NARGS FN)
						   (LENGTH TEM))
					 (PROG [(L (QUOTE (X Y Z P D Q]
					       (FRPTQ (IDIFFERENCE (NARGS FN)
								   (LENGTH FN))
						      (NCONC1 TEM (pop L]
				     (RETURN TEM))
				   ([AND MSHASHFILENAME (SETQ TEM (GETTABLE FN (CADR MSARGTABLE]
				     (RETURN (AND (NEQ TEM T)
						  TEM]
				 (SELECTQ AT
					  ((0 1)
                                   (* must be a SUBR)
					    (SELECTQ (NARGS FN)
						     [2 (RETURN (QUOTE (X Y]
						     [1 (RETURN (QUOTE (X]
						     (0 (RETURN))
						     NIL))
					  [(2 3)
                                   (* no-spread function, will cause error)
					    (AND (SUBRP FN)
						 (RETURN (QUOTE (X1 X2 ... Xn]
					  [NIL (AND FILELST (SETQ TEM (GETDEF FN (QUOTE FNS)
									      FILELST 1))
						    (RETURN (CADR TEM]
					  (SHOULDNT]
			     (RETURN (ARGLIST FN])
)

(RPAQQ SMARTARGLIST (((A)
		      OPENR ARRAYBEG)
		     ((A N)
		      ELT ELTD CLOSER)
		     ((ADDRESS N)
		      RELBLK)
		     ((ATM)
		      GETTOPVAL GETATOMVAL)
		     ((ATM VAL)
		      SETTOPVAL SETATOMVAL)
		     ((ATOM POS)
		      FRAMESCAN)
		     ((BLIPTYP IPOS)
		      BLIPSCAN)
		     ((BLIPTYP IPOS FLG)
		      BLIPVAL)
		     ((BLIPTYP IPOS N VAL)
		      SETBLIPVAL)
		     ((CARN CDRN)
		      PRINTLEVEL)
		     ((DATUM)
		      NTYP TYPENAME)
		     ((FILE FLG)
		      CLEARBUF READP)
		     ((FILE ADR)
		      SETFILEPTR)
		     ((FILE RDTBL FLG)
		      READ)
		     ((FILE RDTBL)
		      PEEKC)
		     ((FILE ACCESS)
		      OPENP OPNJFN)
		     ((FILE N)
		      POSITION)
		     ((FILE)
		      GETEOFPTR OUTFILEP GETFILEPTR INFILEP IOFILE INPUT SYSIN LASTC TERPRI INFILE 
		      OUTPUT READC OUTFILE)
		     ((FILE OPENFBITS GTJFNBITS)
		      OPENF)
		     ((FILE RDTBL)
		      RATOM RSTRING)
		     ((FLG TTBL)
		      RAISE ECHOMODE)
		     ((FLG)
		      SETREADMACROFLG READMACROS ESCAPE CLEARSTK LINBUF SYSBUF)
		     ((FLG RDTBL)
		      CONTROL)
		     ((FN)
		      SUBRP CCODEP MAPATOMS ARGTYPE EXPRP SCODEP)
		     ((FN ARGS APOS CPOS AFLG CFLG)
		      ENVAPPLY)
		     ((FN ARGS -)
		      APPLY BLKAPPLY)
		     ((FN DEF)
		      PUTD)
		     ((FORM APOS CPOS AFLG CFLG)
		      ENVEVAL)
		     ((FORM FLG -)
		      ERRORSET)
		     ((FORMATBITS)
		      DATE)
		     ((FRAMENAME N IPOS OPOS)
		      STKPOS)
		     ((FROMPTR TOPTR VAL)
		      RESUME)
		     ((HARRAY)
		      CLRHASH)
		     ((IPOS EPOS FLAGS FILE PRINTFN)
		      BACKTRACE)
		     ((ITEM VAL HARRAY)
		      PUTHASH)
		     ((ITEM HARRAY)
		      GETHASH)
		     ((LST FLG RDTBL)
		      SETSEPR SETBRK)
		     ((MESSAGE# STRING)
		      GCMESS)
		     ((MODE RDTBL)
		      CONTROL)
		     ((N AC1 AC2 AC3 RESULTAC)
		      JSYS)
		     ((N POS VALUE)
		      SETSTKARG)
		     ((N POS)
		      STKNTHNAME)
		     ((N P V)
		      ARRAY SWPARRAY)
		     ((N M)
		      IEQP LLSH LSH)
		     ((N POS NAME)
		      SETSTKARGNAME)
		     ((N FILE)
		      SPACES)
		     ((N POS)
		      STKARG STKARGNAME)
		     ((N)
		      SETSBSIZE GCTRP CONSCOUNT CLOCK GETBLK RADIX CHARACTER LINELENGTH ERRORSTRING 
		      FCHARACTER HARRAY)
		     ((N IPOS OPOS)
		      STKNTH)
		     ((NUM MESS)
		      SETERRORN)
		     ((OLDAR NEWAR)
		      REHASH)
		     ((POS VAL FLG)
		      RETTO RETFROM)
		     ((POS)
		      STKNAME RELSTK STKNARGS)
		     ((POS NAME)
		      SETSTKNAME)
		     ((POS1 POS2)
		      COPYSTK)
		     ((RDTBL FROM)
		      RESETREADTABLE)
		     ((RDTBL FLG)
		      SETREADTABLE)
		     ((RDTBL)
		      GETBRK READTABLEP COPYREADTABLE GETSEPR GETREADTABLE)
		     ((STRING)
		      HERALD)
		     ((TTBL FROM)
		      RESETTERMTABLE)
		     ((TTBL)
		      COPYTERMTABLE SETTERMTABLE GETTERMTABLE TERMTABLEP)
		     ((TYPE N)
		      BOXCOUNT)
		     ((VAR M)
		      ARG)
		     ((VAR M X)
		      SETARG)
		     ((VAR IPOS OPOS)
		      STKSCAN)
		     ((VAR X)
		      SETN)
		     ((X N Y)
		      RPLSTRING)
		     ((X N FLG RDTBL)
		      NTHCHAR)
		     ((X A)
		      EVALA)
		     ((X FILE RDTBL)
		      PRIN4 PRIN2 PRINT)
		     ((X FLG RDTBL)
		      NCHARS CHCON UNPACK)
		     ((X POS)
		      EVALV)
		     ((X FILE)
		      PRIN3 PRIN1)
		     ((X N M OLDPTR)
		      SUBSTRING)
		     ((X -)
		      EVAL)
		     ((X)
		      GO DECLARE PACK*)
		     ((VARLST E1 E2 ... En)
		      PROG RESETVARS)
		     ((FN ARG1 ARG2 ... ARGn)
		      APPLY* BLKAPPLY*)
		     ((C1 C2 ... Cn)
		      COND)))
(FILESLOAD (SYSLOAD FROM VALUEOF LISPUSERSDIRECTORIES)
	   SWAPHASH)
(OR (BOUNDP (QUOTE SMARTARGARRAY))
    (PROG ((ARR (SHARRAY 1000Q)))
	  [MAPC SMARTARGLIST (FUNCTION (LAMBDA (X)
					       (MAPC (CDR X)
						     (FUNCTION (LAMBDA (F)
								       (SPUTHASH F (CAR X)
										 ARR]
	  (RPAQ SMARTARGARRAY ARR)))
(DECLARE: DOEVAL@COMPILE DONTCOPY

(LOCALVARS . T)
)
(DECLARE: DONTCOPY
  (FILEMAP (NIL (1373Q 5573Q (SMARTARGLIST 1407Q . 5570Q)))))
(DECLARE: DONTCOPY (PUTPROPS SMARTARG COPYRIGHT ("Xerox Corporation" 3675Q)))
STOP