Added OPS4.

Makefile

@@ -55,7 +55,7 @@ SRC = syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa	\
       decus bsg muds54 hello rrs 2500 minsky danny survey librm3 librm4 \
       klotz atlogo clusys cprog r eb cpm mini nova sits nlogo bee gld mprog2 \
       cfs libmud librm1 librm2 mprog mprog1 mudbug mudsav _batch combat \
-      mits_b minits spacy _xgpr_
+      mits_b minits spacy _xgpr_ haunt
 DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \
       chprog sail draw wl pc tj6 share _glpr_ _xgpr_ inquir mudman system \
       xfont maxout ucode moon acount alan channa fonts games graphs humor \

build/build.tcl

@@ -171,6 +171,7 @@ if {$env(BASICS)!="yes"} {
     source $build/misc.tcl
     source $build/$cpu/processor.tcl
     source $build/lisp.tcl
+    source $build/haunt.tcl
     if {$env(MACSYMA)=="yes"} {
 	source $build/macsyma.tcl
     }

build/haunt.tcl

@@ -0,0 +1,17 @@
+log_progress "ENTERING BUILD SCRIPT: HAUNT"
+
+respond "*" ":cwd haunt\r"
+
+# build ops4
+respond "*" "complr\013"
+respond "_" "haunt;_haunt;ops4 lsp\r"
+respond "_" "\032"
+type ":kill\r"
+
+# dump ops4
+respond "*" "lisp\013"
+respond "Alloc?" "n\r"
+respond "*" "(load '((haunt) ops4 load))"
+respond "T" "(dump-it)"
+respond ":\$Job Suspended\$" ":pdump haunt;ts ops4\r"
+type ":kill\r"

build/timestamps.txt

@@ -766,6 +766,9 @@ gt40/bootvt.s09 197202050000.00
 gt40/vt07.bin29 197508142300.00
 gz/macn80.mid 198305031813.01
 gz/mmodem.181 198511261237.46
+haunt/ops4.load 202410180740.00
+haunt/ops4.lsp 198207011415.01
+haunt/user.lsp 198207011415.01
 humor/alices.pdp10 198505161952.01
 humor/dover.poem 198106262242.08
 humor/jargon.68 198308102314.15

doc/programs.md

@@ -262,6 +262,7 @@
 - OCTPUS, print character representations.
 - OINIT, init program reporting last login, email.
 - OS, realtime TTY spy.
+- OPS4, a production system that supports HAUNT.
 - OTHELLO, the original Othello game -- simpler than Go.
 - OTJ6, an old version of TJ6.
 - PALX, PDP-11 cross assembler.

src/haunt/ops4.load

@@ -0,0 +1,21 @@
+;; init file for OPS4
+
+(comment)
+
+(SETSYNTAX '/# (STATUS SYNTAX =) NIL)
+(ALLOC ''(LIST (20000. 177000. 4000.)
+          HUNK4 (24000. 24000. 0)
+          HUNK8 (24000. 24000. 0)
+          SYMBOL (3000. 24000. 50.)
+          FIXNUM (3000. 127000. 0.3)))
+(load "haunt;ops4 fasl")
+
+(defun dump-it () 
+ (setq *nopoint t)
+ (setq base 10.)
+ (setq ibase 10.)
+ (and (filep uread) (close uread))
+ (and (filep infile) (not (eq infile tyi)) (close infile))
+ (setq infile 'T)
+ (SAVEIT))
+

src/haunt/user.lsp

@@ -0,0 +1,101 @@
+; This is USER.LSP[A110PS99], a  basic set of extensions to OPS4
+; provided for  users  who  do not  wish  to provide  their  own
+; extensions.   It contains the necessary  calls to define seven
+; LHS functions, two new variable types, and five RHS functions.
+
+; The two  new variable  types are  the <  and >  types.  The  <
+; variable  will match numeric  atoms that are equal  to or less
+; than the  atoms matching the corresponding  = variable.  The >
+; variables  will match  numeric  atoms  that are  equal  to  or
+; greater than the  atoms matching the corresponding = variable.
+; In order not to  slow the execution, the functions that define
+; the  variable  types  are compiled.   (This  file  contains  a
+; command  to  read  in  the  compiled  code.)   The  uncompiled
+; functions are:
+;
+	(DEFUN L1ST (L G) 
+	  (AND (NUMBERP G) (NUMBERP L) (NOT (LESSP G L))))
+
+	(DEFUN L2ND (G L) 
+	  (AND (NUMBERP G) (NUMBERP L) (NOT (LESSP G L))))
+
+; The  seven new  LHS  functions  are  <<, >>,  <=,  >=,  <ANY>,
+; <NOTANY>,  and <TYPE>.   The first  four of  these are numeric
+; functions which take exactly one argument.  << matches numbers
+; that  are strictly  smaller  than  its argument.   >>  matches
+; numbers  that  are  strictly greater  than  its  argument.  <=
+; matches  numbers  that  are  equal  to  or  smaller  than  its
+; argument.   >= matches  numbers that  are equal  to or greater
+; than its argument.  The other three functions will accept more
+; than one  argument.  <ANY> will match any  atom which is equal
+; to one of its  arguments.  <NOTANY> will match any atom except
+; one which is equal to one of its arguments.  <TYPE> will match
+; any  element whose  type  is  listed in  its  argument.   This
+; function accepts  for arguments  one or  more of  ATOM,  LIST,
+; NUMBER, and SYMBOL.   Thus (<TYPE> SYMBOL) will match symbolic
+; atoms only,  and (<TYPE> LIST NUMBER)  will match anything but
+; symbolic atoms.   Note that <ANY> can be used  as a LHS quote:
+; in order to get an atom like  & or = in the LHS, one put it as
+; an argument  to  <ANY>.  For  example, the  condition  element
+; (<ANY> =X)  will match the atom =X.   The definitions of these
+; functions:
+;
+	(DEFUN << (CONST ELEM)
+	  (AND (NUMBERP ELEM) (LESSP ELEM (CAR CONST))))
+
+	(DEFUN >> (CONST ELEM)
+	  (AND (NUMBERP ELEM) (GREATERP ELEM (CAR CONST))))
+
+	(DEFUN >= (CONST ELEM)
+	  (AND (NUMBERP ELEM) (NOT (LESSP ELEM (CAR CONST)))))
+
+	(DEFUN <= (CONST ELEM)
+	  (AND (NUMBERP ELEM) (NOT (GREATERP ELEM (CAR CONST)))))
+
+	(DEFUN <ANY> (ARG ELM) (MEMBER ELM ARG))
+
+	(DEFUN <NOTANY> (ARG ELM) (NOT (MEMBER ELM ARG)))
+
+	(DEFUN <TYPE> (TYPES E)
+	  (OR (AND (MEMQ 'ATOM TYPES) (ATOM E))
+	      (AND (MEMQ 'LIST TYPES) (NOT (ATOM E)))
+	      (AND (MEMQ 'NUMBER TYPES) (NUMBERP E))
+	      (AND (MEMQ 'SYMBOL TYPES) 
+		   (ATOM E) (NOT (NUMBERP E)))))
+
+; The five  RHS functions,  <+>, <->,  <*>, <//>,  and <^>,  are
+; arithmetic functions.  <+>, <->, <*>, and <//> take any number
+; of arguments; <^> takes exactly  two arguments.   <+> adds its
+; arguments  together.    <*>  multiplies  its  arguments.   <->
+; subtracts the second through  last arguments (if there is more
+; than  one argument)  from the  first.  <//>  divides the first
+; argument by the second through last arguments.  <^> raises the
+; first argument  to the power of the  second argument.  All the
+; functions are  capable  of mixed  mode arithmetic.   They  are
+; defined as follows.
+;
+	(DEFUN <+> FEXPR (X) 
+	  (LIST (APPLY 'PLUS (APPLY 'EVAL-LIST X))))
+
+	(DEFUN <-> FEXPR (X) 
+	  (LIST (APPLY 'DIFFERENCE (APPLY 'EVAL-LIST X))))
+
+	(DEFUN <*> FEXPR (X) 
+	  (LIST (APPLY 'TIMES (APPLY 'EVAL-LIST X))))
+
+	(DEFUN <//> FEXPR (X) 
+	  (LIST (APPLY 'QUOTIENT (APPLY 'EVAL-LIST X))))
+
+	(DEFUN <^> FEXPR (X) 
+	  (LIST (APPLY 'EXPT (APPLY 'EVAL-LIST X))))
+
+
+;;; (FASLOAD  USER FAS)    ; Load the compiled code
+
+(VARIABLE < L2ND L1ST)		; Make the declarations
+(VARIABLE > L1ST L2ND)
+
+(PREDICATE << >> <= >= <ANY> <NOTANY> <TYPE>)
+
+(RHS-FUNCTION <+> <-> <*> <//> <^>)
+