Added INQUIR, the user account management program.

src/nilcom/evonce.14

@@ -0,0 +1,97 @@
+;;;   EVONCE 	-*-MODE:LISP;PACKAGE:SI-*- 		  -*-LISP-*-
+;;;   **************************************************************
+;;;   ***** MACLISP ******* Macro for Defining SETF Structures *****
+;;;   **************************************************************
+;;;   ** (C) COPYRIGHT 1980 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
+;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
+;;;   **************************************************************
+
+
+(eval-when (eval compile)
+	   (cond ((and (status feature MACLISP) (status nofeature FOR-NIL)) 
+		  (sstatus feature FM)
+		  (sstatus feature FOR-MACLISP)))
+	   )
+
+#-FM (globalize "EVAL-ORDERED" "EVAL-ORDERED*")
+
+
+(herald EVONCE /14)
+
+#-For-NIL (eval-when (eval compile)
+  (macro lispdir (x)
+	(setq x (cadr x))
+	#+Pdp10   `(QUOTE ((LISP) ,x))
+	#+Lispm   (string-append "lisp;" (get-pname x) "qfasl")
+	#+Multics (catenate ">exl>lisp_dir>object" (get_pname x))
+	#+For-NIL (string-append "lisp:" (get-pname x) "vasl")
+	)
+  (macro subload (x)
+	(setq x (cadr x))
+	`(OR (GET ',x 'VERSION) (LOAD #%(LISPDIR ,x))))
+  (subload DEFSETF)
+  )
+
+
+
+(defmacro EVAL-ORDERED (bvl forms &rest body)
+  (eval-ordered* bvl forms body))
+
+; (not (null (SETF-gensyms expf))) is not really the right
+; predicate.  Consider where one side-effectible and rest all constant.
+; the right thing to do is to use SETF-SIDE-EFFECT-SCAN rather than SIMPLEP
+; since we aren't worried about multiple evaluation, just ordering.
+; Don't forget to write SETF-SIDE-EFFECT-SCAN first!
+
+(defun eval-ordered* (bvl forms body)
+   (let ((expf (SETF-struct () () () forms)))
+     (SETF-simplep-scan expf ())
+     (progv bvl (SETF-compute expf) 
+	    (cond ((not (null (SETF-gensyms expf)))
+		   `((lambda ,(SETF-gensyms expf)
+			     ,@(eval body))
+		     ,@(setf-genvals expf)))
+		  ('T `(progn ,@(eval body)))))))
+
+
+
+
+;; The following is not yet complete...make it invisible
+
+#+EVAL-ONCE-TEST
+
+(defmacro eval-once (bvl . body)
+  (do ((ibvl bvl (cdr ibvl))
+       (expfsym (gensym) (gensym))
+       (expf-bvl) (nbvl))
+      ((null ibvl)
+       `(let ,expf-bvl
+	   (let ,nbvl ,@body)))
+   (desetq (bindform expf-form) (car ibvl))
+   (push `(,expfsym (+internal-setf-x-1 ',expf-form)) expf-bvl)
+   (cond ((not (and (get (cons () bindform) 'genvals)
+		    (get (cons () bindform) 'gensyms)))
+	  (error '|GENVALS and GENSYMS are required information -- EVAL-ONCE|
+		 bindform)))
+   (do ((form bindform (cddr form)))
+       ((null form))
+     (cond ((setq temp
+		  (cdr (assq (car form)
+			     '((COMPUTE      . SETF-compute)
+			       (I-COMPUTE    . SETF-i-compute)
+			       (SIDE-EFFECTS . SETF-side-effects)
+			       (RET-OK	     . SETF-ret-ok)
+			       (ACCESS-FUN   . SETF-access)
+			       (ACCESS	     . SETF-access-expanded)
+			       (INVERT-FUN   . SETF-invert)
+			       (GENVALS	     . SETF-genvals)
+			       (GENSYMS	     . SETF-gensyms)))))
+	    (push `(,(cadr form) (,temp ,expfsym)) nbvl))
+	   (T (error '|Unknown info name -- EVAL-ONCE| (car form)
+		     'wrng-type-arg))))))
+
+#+EVAL-ONCE-TEST
+(defmacro SETF-access-expanded (expf)
+  `(apply (setf-access ,expf) (setf-compute ,expf)))
+
+

src/nilcom/subloa.3

@@ -0,0 +1,45 @@
+;;;  SUBLOAD 				-*-mode:lisp;package:si;lowercase:T-*-
+;;;  **************************************************************************
+;;;  ***** NIL ****** NIL/MacLISP/LISPM Preamble for Autoloadings *************
+;;;  **************************************************************************
+;;;  ******** (c) Copyright 1981 Massachusetts Institute of Technology ********
+;;;  **************************************************************************
+
+#+Compile-Subload 
+  (herald SUBLOAD /3)	 ;DONT USE HERALD!! this file usually gets included
+
+#+(or Compile-Subload
+      #.(if (fboundp 'SUBLOAD) 		;How to say "Flush this stuff if merely
+	    'THIS-AINT-NO-FEATURE 	; INCLUDEing it into a lisp/compiler
+	    'PAGING 			; which already have these  loaded"
+	    ))
+
+(eval-when (eval compile #+Compile-Subload load)
+
+(defun (AUTOLOAD-FILENAME macro) (x)
+  (let (((() module-name) x)
+	(more (and (if (get 'SHARPCONDITIONALS 'VERSION) 
+		       (featurep '(and MacLISP (not For-NIL)))
+		       (status nofeature For-NIL))
+		   '(FASL))))
+    `'((LISP) ,module-name ,.more)))
+
+(defun (SUBLOAD macro) (x)
+  (let ((module-name (cadr x)))
+    `(OR (GET ',module-name 'VERSION) 
+	 (LOAD ,(macroexpand `(AUTOLOAD-FILENAME ,module-name))))))
+
+(defun (SUBLOAD-FUNCTION macro) (x)
+  (let ((fun-name (cadr x)))
+    `(OR (FBOUNDP ',fun-name) 
+	 (+INTERNAL-TRY-AUTOLOADP ',fun-name))))
+
+(defun (DEF-OR-AUTOLOADABLE macro) (x)
+  (let (((() function-name module-name) x))
+    `(OR (FBOUNDP ',function-name)
+	 (GET ',function-name 'AUTOLOAD) 
+	 ,`(DEFPROP ,function-name  
+		    ,(eval `(AUTOLOAD-FILENAME ,module-name))
+	 	    AUTOLOAD))))
+
+)