Trailing-Edge
-
PDP-10 Archives
-
-
There are no other files named in the archive.
(FILECREATED "16-MAR-81 22:05:39" <LISPUSERS>UTIL.;4 14019
changes to: UTILCOMS
previous date: "18-DEC-78 17:37:02" <LISPUSERS>UTIL.;3)
(PRETTYCOMPRINT UTILCOMS)
(RPAQQ UTILCOMS ((FNS COPYFILES COPYFILES1 DELETEFILES DELFILES DOLOADUP DIRSTR DOMERGE HBINALPHORDER
HMAKEBINFILE HOSTEST)
(FNS STORAGEDIF)
(DECLARE: EVAL@COMPILE DONTCOPY (FILES (SYSLOAD)
CJSYS))))
(DEFINEQ
(COPYFILES
(LAMBDA (DIR FILELST PRESERVERSION#S)
(* wt: "21-OCT-77 18:45")
(* Copies highest version of all symbolic and compiled files from DIR
(or <NEWLISP>) that do not appear in connected directory.)
(OR DIR (SETQQ DIR <NEWLISP>))
(MAPC (COND
(FILELST (MAPCONC FILELST (FUNCTION (LAMBDA (FL)
(LIST (PACKFILENAME (QUOTE DIRECTORY)
DIR
(QUOTE BODY)
FL)
(PACKFILENAME (QUOTE DIRECTORY)
DIR
(QUOTE EXTENSION)
(QUOTE .COM)
(QUOTE BODY)
FL))))))
(T (APPEND (FILDIR (PACK (LIST DIR (QUOTE *.;0))))
(FILDIR (PACK (LIST DIR (QUOTE *.COM;0)))))))
(FUNCTION (LAMBDA (FL)
(PROG (TEM)
(COND
((NULL (INFILEP (SETQ TEM (NAMEFIELD FL T))))
(COPYFILES1 FL))
((NOT (EQUAL (FILEDATE TEM)
(FILEDATE FL)))
(COPYFILES1 FL T)))))))))
(COPYFILES1
(LAMBDA (FILE FLG)
(* wt: "21-OCT-77 18:47")
(AND (SETQ FILE (INFILEP FILE))
(TENEX (CONCAT "COP" FILE "" (COND
(PRESERVERSION#S (PACKFILENAME (QUOTE DIRECTORY)
NIL
(QUOTE BODY)
FILE))
(T (PACKFILENAME (QUOTE DIRECTORY)
NIL
(QUOTE VERSION)
NIL
(QUOTE BODY)
FILE)))
(COND
(FLG "")
(T "
")))))))
(DELETEFILES
(LAMBDA (FILES)
(* lmm "10-APR-78 12:55")
(MAPC (FILDIR FILES)
(FUNCTION DELFILE))))
(DELFILES
(LAMBDA (DIR)
(* goes through connect directory and compaes filedates with other directory, and
deletes all ssmbolic and compiiled versions if date of latest symbolic agress with
that in other directory)
(MAPC (FILDIR (QUOTE *.;0))
(FUNCTION (LAMBDA (X)
(PROG (TEM)
(AND (SETQ TEM (FILEDATE X))
(EQUAL TEM (FILEDATE (PACKFILENAME (QUOTE DIRECTORY)
(OR DIR (QUOTE <NEWLISP>))
(QUOTE NAME)
(NAMEFIELD X)
(QUOTE EXTENSION)
(NAMEFIELD X (QUOTE ONLY)))))
(SETQ TEM (NAMEFIELD X))
(MAPC (PRINT (NCONC (FILDIR (PACK (LIST TEM (QUOTE .;*))))
(FILDIR (PACK (LIST TEM (QUOTE .COM;*)))))
T T)
(FUNCTION DELFILE)))))))))
(DOLOADUP
(LAMBDA (FLG) (* lmm "15-SEP-78 06:05")
(CLOSEALL)
(DELETEFILES (QUOTE LISP.CMD;*))
(OUTFILE (QUOTE LISP.CMD;T))
(SELECTQ FLG
(T (DELETEFILES (QUOTE LISP.REL;*))
(PRIN3 "%%1000OLISP.REL="))
(NIL (DELETEFILES (QUOTE BLISP.REL;*))
(PRIN3 "%%1000OBLISP.REL="))
(X (DELETEFILES (QUOTE XLISP.REL;*))
(PRIN3 "%%1000OXLISP.REL="))
(HELP))
(MAP (SELECTQ FLG
(T (QUOTE (LISP ATHASH SWAP GC)))
(NIL (QUOTE (MAXC LISP ATHASH BYTE SWAP GC)))
(X (QUOTE (PMAPIN MAXC LISP ATHASH BYTE SWAP GC)))
(HELP))
(FUNCTION (LAMBDA (X)
(PRIN3 (CAR X))
(COND
((INFILEP (PACK (LIST (CAR X)
(QUOTE .MAC)))))
((INFILEP (PACK (LIST (QUOTE <NEWLISP>)
(CAR X)
(QUOTE .MAC))))
(PRIN3 (DIRSTR (QUOTE NEWLISP))))
(T (PRIN3 (DIRSTR (QUOTE LISP)))))
(AND (CDR X)
(PRIN1 "+")))))
(CLOSEF (OUTPUT))
(DELETEFILES (QUOTE LISP.RUN;*))
(OUTFILE (QUOTE LISP.RUN;T))
(PROGN (PRIN3 "CCL
LOAD @LISP.CMD
IDDT
;W")
(PRIN3 (SELECTQ FLG
(T "LISP.SYMBOLS")
(NIL "BLISP.SYMBOLS")
(X "XLISP.SYMBOLS")
HELP))
(PRIN3 "
LISP:LISP00GG
")
(PRIN3 "INFILE(")
(PROG ((FL (SELECTQ FLG
(T (QUOTE PUTDQ))
(NIL (QUOTE BPUTDQ))
(X (QUOTE XPUTDQ))
(HELP))))
(COND
((INFILEP FL))
((INFILEP (PACK (LIST "<NEWLISP>" FL)))
(PRIN3 "<NEWLISP>"))
(T (PRIN3 "<LISP>")))
(PRIN3 FL))
(PRIN3 "]EVAL((EVAL(READ]LOGOUT];U")
(PRIN3 (SELECTQ FLG
(T "LISP.PDQ
")
(NIL "BLISP.PDQ
")
(X "XLISP.PDQ
")
(HELP))))
(PROGN (BKSYSBUF (CLOSEF (OUTPUT)))
(BKSYSBUF "
")
(KFORK (SUBSYS (QUOTE RUNFIL))))))
(DIRSTR
(LAMBDA (NAME)
(* lmm: "15-JUL-77 02:16")
(OR (GETP NAME (QUOTE DIRSTR))
(PUT NAME (QUOTE DIRSTR)
(RESETFORM (RADIX 10Q)
(RESETVARS ((PRXFLG T))
(RETURN (CONCAT "[1," (USERNUMBER NAME)
"]"))))))))
(DOMERGE
(LAMBDA (MYFILE HISFILE OLDFILE NEWFILE)
(* lmm " 9-JUL-78 03:33")
(PROG (TMP (MYF (CHECKFILE MYFILE)))
(KFORK (SUBSYS (SUBSYS (SUBSYS (QUOTE CAM)
(CONCAT "HIS.COR _ " (SETQ OLDFILE (CHECKFILE OLDFILE))
" , "
(CHECKFILE HISFILE)
"
MY.COR _ " OLDFILE " , " MYF "
MERGED.COR , MERGED.ERR , _ , MY.COR , HIS.COR
"))
"
")
"
"))
EDLP(COND
((PROGN (INFILE (QUOTE MERGED.COR))
(PROG1 (FILEPOS "/-/-/")
(SETQ TMP (CLOSEF))))
(PRIN1
"
There are some conflicts in the places where BBN edited and
where Maxc lisp has been edited. These have to be resolved:
Edit MERGED.COR to remove the conflicts and quit out of TECO
and this exec.
"
T)
(BKSYSBUF "EDIT MERGED.COR
S/-/-/0L4T")
(EVAL (CADR (ASSOC (QUOTE EXEC)
LISPXMACROS)))
(COND
((NEQ (INFILEP (QUOTE MERGED.COR))
TMP)
(GO EDLP))
(T (HELP)))))
(PROGN (OUTFILE (QUOTE TMP;T))
(MAPC (LIST "FED
DSK: _ " OLDFILE " , MERGED.COR
")
(FUNCTION PRIN3))
(BKSYSBUF (CLOSEF))
(BKSYSBUF "
")
(KFORK (SUBSYS (QUOTE RUNFIL))))
(DELETEFILES (QUOTE *.ERR;*))
(DELETEFILES (QUOTE *.COR;*))
(RETURN (RENAMEFILE (NAMEFIELD MYF T)
(NAMEFIELD MYFILE T))))))
(HBINALPHORDER
(LAMBDA (A B)
(* ALPHORDER compares two items from a list being sorted, returns T if they are in
order, i.e. if it is ok to place A before B in the final list.
Order of precedence is numbers, literals, and everything else.
Numbers are sorted by size; literals (strings, atoms and pnames) are sorted
character by character by the magnitude of the character code
(straight alphabetization is a subset of this) and other types are not sorted
among themselves.)
(PROG ((TB (NTYP (SETQ B (CAR B)))))
(SELECTQ (NTYP (SETQ A (CAR A)))
(24Q (ASSEMBLE NIL
(* A is SMALLP)
(CQ A)
(SUBI 1 , ASZ))
(* Fast unbox for small numbers.)
(GO UNBOXEDINT))
(22Q (ASSEMBLE NIL
(CQ A)
(MOVE 1 , 0 (1))
(* Fast unbox for large numbers.)
)
(* A is integer)
(GO UNBOXEDINT))
(20Q
(* A is floating)
(SELECTQ TB
(20Q
(* Both floating. Do open FGREATERP.)
(ASSEMBLE NIL
(CQ B)
(MOVE 2 , 0 (1))
(* Fast unbox but into floating format.)
(CQ A)
(CAMGE 2 , 0 (1))
(SKIPA 1 , KNIL)
(CQ T)
(CQ (RETURN (AC)))))
(24Q (ASSEMBLE NIL
(CQ B)
(SUBI 1 , ASZ)))
(22Q (ASSEMBLE NIL
(CQ B)
(MOVE 1 , 0 (1))))
(RETURN T))
(* Return T for A floating, B non-numeric.)
(ASSEMBLE NIL
(FASTCALL FXFLT)
(* Unboxed (integer) B in ac1. FLOAT it and compare to A.)
(LDV2 'A SP 2)
(CAMGE 1 , 0 (2))
(SKIPA 1 , KNIL)
(CQ T)
(CQ (RETURN (AC)))))
(14Q (ASSEMBLE NIL
(* A is LITATOM)
(CQ A)
(HLRZ 1 , 2 (1)))
(GO LIT))
((30Q 34Q)
(* A is string or pname)
(ASSEMBLE NIL
(CQ A))
(GO LIT))
(SELECTQ TB
((34Q 30Q 14Q 24Q 22Q 20Q)
(* A is list, ARRAY or junk; B is something legal so it belongs first.)
(RETURN NIL))
(RETURN T)))
(* Both junk; return T.)
UNBOXEDINT
(ASSEMBLE NIL
(* Unboxed integer A in ac1. Stack it.)
(PUSHN)
(CQ (SELECTQ TB
(24Q (ASSEMBLE NIL
(CQ B)
(SUBI 1 , ASZ)))
(22Q (ASSEMBLE NIL
(CQ B)
(MOVE 1 , 0 (1))))
(20Q (ASSEMBLE NIL
(NREF (MOVE 1 , 0))
(FASTCALL FXFLT)
(* A integral, B floating. float unboxed A on stack and load ac1 with unboxed B.)
(NREF (MOVEM 1 , 0))
(CQ B)
(MOVE 1 , 0 (1))))
(RETURN T)))
(* A numeric, B not.)
(NREF (CAMGE 1 , 0))
(* Compare two unboxed numbers. Fixed or floating doesn't matter as long as both the same.)
(SKIPA 1 , KNIL)
(CQ T)
(POPNN 1)
(CQ (RETURN (AC))))
LIT (ASSEMBLE NIL
(FASTCALL UPATM)
(* Ac3 has byte ptr to A; ac4 has NCHARS. Notice use of CP here.)
(PUSHN 4)
(PUSH CP , 3)
(CQ (SELECTQ TB
((24Q 22Q 20Q)
(ASSEMBLE NIL
(POP CP , 1))
(* A was literal, B numeric.)
(RETURN))
((30Q 34Q)
(ASSEMBLE NIL
(CQ B)))
(14Q (ASSEMBLE NIL
(CQ B)
(HLRZ 1 , 2 (1))))
(ASSEMBLE NIL
(POP CP , 1)
(* A was literal, B was list or junk.)
(CQ (RETURN T)))))
(* At last the basic alphabetizer. Ac6 has NCHARS A; ac5 has byte pointer to A;
ac4 has NCHARS B (from this call to UPATM), ac3 has byte pointer to B.)
(FASTCALL UPATM)
(POP CP , 5)
(POPN 6)
LP (SOJL 6 , SUCCEED)
(* A won because shorter)
(SOJL 4 , FAIL)
(* B won because shorter.)
(ILDB 1 , 5)
(CAIL 1 , 141Q)
(CAILE 1 , 172Q)
(SKIPA)
(SUBI 1 , 40Q)
(ILDB 2 , 3)
(CAIL 2 , 141Q)
(CAILE 2 , 172Q)
(SKIPA)
(SUBI 2 , 40Q)
(CAMN 1 , 2)
(JRST LP)
(* Chars the same, try again.)
(CAML 1 , 2)
(* A and B have different spellings. Compare magnitude of character byte and exit with result.)
FAIL(SKIPA 1 , KNIL)
SUCCEED
(CQ T)
(CQ (RETURN (AC)))))))
(HMAKEBINFILE
(LAMBDA (DATA FILE)
(* lmm "14-SEP-78 14:22")
(PROG ((N (IPLUS (LENGTH DATA)
35Q))
LPOS
(CH -1)
CH2
(JFN (VAG (OPNJFN (SETQ FILE (OUTPUT (OUTFILE FILE)))))))
(SORT DATA (FUNCTION HBINALPHORDER))
(JS SFBSZ (LOC JFN)
22Q)
(JS SFPTR (LOC JFN)
0)
(for I from 1 to (ADD1 N) do (JS BOUT (LOC N)
JFN))
(JS SFBSZ (LOC JFN)
7)
(SETQ LPOS (JS RFPTR (LOC JFN)
NIL NIL 2))
(for X in DATA as I from 35Q do (JS SFBSZ (LOC JFN)
22Q)
(JS SFPTR (LOC JFN)
I)
(JS BOUT (LOC LPOS)
JFN)
(SETQ CH2 (IDIFFERENCE (CHCON1 (CAR X))
100Q))
(AND (IGREATERP CH2 40Q)
(ILESSP CH2 73Q)
(SETQ CH2 (IDIFFERENCE CH2 40Q)))
(COND
((NEQ CH (SETQ CH2 (COND
((ILESSP CH2 1)
0)
((IGREATERP CH2 32Q)
33Q)
(T CH2))))
(for J from (ADD1 CH) to CH2
do (JS SFPTR (LOC JFN)
J)
(JS BOUT (LOC I)
JFN))
(SETQ CH CH2)))
(JS SFBSZ (LOC JFN)
7)
(JS SFPTR (LOC JFN)
LPOS)
(PRIN2 (CAR X)
FILE)
(SPACES 1 FILE)
(PRIN2 (CDR X)
FILE)
(SPACES 1 FILE)
(POSITION FILE 0)
(SETQ LPOS (JS RFPTR (LOC JFN)
NIL NIL 2)))
(RETURN (CLOSEF FILE)))))
(HOSTEST
(LAMBDA (H N)
(PROG ((NAME (QUOTE (NET:. SUMEX-AIM -1;T)))
(W (OR (NUMBERP N)
5))
JFN)
(FRPLACA (CDR NAME)
H)
(SETQ NAME (PACK NAME))
(OR (NLSETQ (OPENF NAME -374777600000Q))
(RETURN NIL))
(SETQ JFN (OPNJFN NAME))
WAIT(RETURN (PROG1 (SELECTQ (LRSH (JSYS 145Q JFN NIL NIL 2)
40Q)
(6 (COND
((NEQ W 0)
(SETQ W (SUB1 W))
(DISMISS 1750Q)
(GO WAIT))))
((7 13Q 14Q)
T)
NIL)
(CLOSEF NAME))))))
)
(DEFINEQ
(STORAGEDIF
(LAMBDA (N)
(* lmm " 7-SEP-78 12:23")
(PROG NIL
(INFILE (COND
((FIXP N)
(PACKFILENAME (QUOTE NAME)
(QUOTE STORAGE)
(QUOTE VERSION)
N))
(T N)))
(OUTFILE (PACKFILENAME (QUOTE EXTENSION)
(QUOTE DIFFERENCES)
(QUOTE BODY)
(INPUT)))
(SETFILEPTR NIL 0)
(PRIN1 "Storage changes from ")
(PRINT (INPUT))
(NLSETQ (PROG (PREV)
LP (PRINT (SETQ FILE (READ)))
(SETQ PREV
(for TYPE
in (QUOTE (ARRAYP STACK SWPARRAYP STACKP GC.BTAB ATOM.HASH LISTP VCELLP
LITATOM FLOATP FIXP STRINGP ATOM.CHARS STRING.CHARS
SUM))
collect (FILEPOS TYPE)
(until (NUMBERP (SETQ USED (READ))))
(SETQ ASSIGNED (READ))
(SETQ TMP (FASSOC TYPE PREV))
(SETQ DU (IDIFFERENCE USED (OR (CADR TMP)
0)))
(SETQ DA (IDIFFERENCE ASSIGNED (OR (CADDR TMP)
0)))
(COND
((OR (NEQ DU 0)
(NEQ DA 0))
(PRIN1 TYPE)
(TAB 24Q)
(PRIN1 DU)
(TAB 36Q)
(PRIN1 DA)
(TERPRI)))
(LIST TYPE USED ASSIGNED)))
(TERPRI)
(GO LP)))
(CLOSEF (INPUT))
(CLOSEF (OUTPUT)))))
)
(DECLARE: EVAL@COMPILE DONTCOPY
(FILESLOAD (SYSLOAD)
CJSYS)
)
(DECLARE: DONTCOPY
(FILEMAP (NIL (426 12588 (COPYFILES 438 . 1363) (COPYFILES1 1367 . 1788) (DELETEFILES 1792 . 1902) (
DELFILES 1906 . 2685) (DOLOADUP 2689 . 4580) (DIRSTR 4584 . 4835) (DOMERGE 4839 . 6201) (HBINALPHORDER
6205 . 10515) (HMAKEBINFILE 10519 . 12025) (HOSTEST 12029 . 12585)) (12590 13924 (STORAGEDIF 12602 .
13921)))))
STOP