From e9a608ecc722df64e5cb5f50fbeabcd1ddcb5a2f Mon Sep 17 00:00:00 2001 From: Eric Swenson Date: Sun, 20 May 2018 21:57:00 -0700 Subject: [PATCH] Resolves #908: Reconcile two different versions of LSRRTN. Resolves #912: Fix reference to BMT1;ANIMAL ONEWS in GAMES; ANIMAL NEWS. --- build/lisp.tcl | 2 - src/games/animal.news | 2 +- src/games/lsrrtn.1 | 140 ------------------------ src/games/lsrrtn.insert | 2 +- src/inquir/lsrrtn.32 | 234 ++++++++++++++++++++++++++++++++++++++++ 5 files changed, 236 insertions(+), 144 deletions(-) delete mode 100644 src/games/lsrrtn.1 create mode 100644 src/inquir/lsrrtn.32 diff --git a/build/lisp.tcl b/build/lisp.tcl index 9d2fa038..17f12065 100644 --- a/build/lisp.tcl +++ b/build/lisp.tcl @@ -808,8 +808,6 @@ respond "GT40F=" "0\r" expect ":KILL" # animal -respond "*" ":midas games;_lsrrtn\r" -expect ":KILL" respond "*" "complr\013" respond "_" "games;_games;parse\r" respond "_" "games;_games;pattrn\r" diff --git a/src/games/animal.news b/src/games/animal.news index 5e748b30..56281075 100644 --- a/src/games/animal.news +++ b/src/games/animal.news @@ -6,4 +6,4 @@ happen sadly (not really something in my control to fix completely), but I hope they'll happen less often. That's about it. The game is essentially unchanged over the last two years. -Those interested in old news can print the file BMT1;ANIMAL ONEWS. +Those interested in old news can print the file GAMES;ANIMAL ONEWS. diff --git a/src/games/lsrrtn.1 b/src/games/lsrrtn.1 deleted file mode 100644 index 1c5a514e..00000000 --- a/src/games/lsrrtn.1 +++ /dev/null @@ -1,140 +0,0 @@ -title LLSRTN - LISP interface to -*-MIDAS-*- inquir lookups - -.fasl -.insrt sys:.fasl defs - -;;Set up and include the inquire database hacking routines - -lsrtns"$$ulnm==0 ;don't need last name search -lsrtns"$$ulnp==0 ;don't need abbrev l.name lookup -lsrtns"$$unam==0 ;don't need name permutation - -;;define some acs for lsrtns use -lsrtns"a==t -lsrtns"b==tt -lsrtns"c==d -lsrtns"d==r -lsrtns"e==f - -.insrt syseng;lsrtns - -;;---------------------------------------------------------------- - -;;(LSRMAP ) -;;opens up and maps in the inquir database for looking up people. -;;Returns a file object to be passed to other routines. -;;Uses GETCOR to reserve address space. Don't try this too many times -;;since the addr space isn't reused. - -.entry LSRMAP SUBR 1+1 - - jsp t,fxnv1 ;get & save # pages to use, a->tt - push fxp,tt -;; (open '|inquir;lsr1 >| '(in)) - movei a,.atom INQUIR/;LSR1/ > - movei b,.sx (IN) - call 2,.function OPEN - push p,a -;; extract I/O channel number from the file array, into TT - movei tt,f.chan - move tt,@ttsar(a) - push fxp,tt -;; get pages via getcor - move tt,-1(fxp) ;# pages - pushj p,getcor ;request addr space from Lisp - jumpe tt,corlos ;its addr is returned zero if none avbl - idivi tt,2000 ;cvt to page number - movn d,-1(fxp) ;get number of pages requested to construct - hrl tt,d ;aobjn to them -;; construct args for lsrmap - move lsrtns"b,tt ;aobjn to free page range - move lsrtns"a,(fxp) ;disk channel number -;; Get the INQUIR data base mapped in - pushj p,lsrtns"lsrmap ;try to map in the data base - jrst lsrluz ;no skip if it lost -;; I guess we won, clean up and return the file object. -opnbye: sub fxp,[2,,2] - pop p,a - popj p, - -;; Random error routines, return () instead of file obj. -corlos: -lsrluz: move a,(p) ;get the file obj - call 1,.function CLOSE ;close it - setzm (p) ;return () - jrst opnbye - -;;---------------------------------------------------------------- - -;;(LSRUNM ) -;;Returns a magic number to be passed to LSRITM, etc., or -1 if uname unknown. -;;Actually, the "magic number" is the entry's core address returned -;;by the lib subr. - -.entry LSRUNM SUBR 2+1 - - push p,cfix1 ;NCALLable! - movei tt,f.chan ;pick up disk channel number - move tt,@ttsar(a) - push fxp,tt ;and save it - move a,b ;(car (pnget 6)) - movei b,.atom #6. - call 2,.function PNGET - hlrz a,(a) - move lsrtns"b,(a) ;set up uname in 6bit for lsrunm - pop fxp,lsrtns"a ;the channel - pushj p,lsrtns"lsrunm ;get entry addr in lsrtns"b - movni lsrtns"b,1 ;-1 for loss - move tt,lsrtns"b ;move to where Lisp wants it. - popj p, - -;;---------------------------------------------------------------- - -;;(LSRITM ) -;;returns the slot of the entry returned -;;by LSRUNM. -;;This file sets the symbols I$UNAM etc to the correct values. -;;Look after this function, and in :INFO LIB LSRTNS . - -.entry LSRITM SUBR 2+1 - - jsp t,fxnv1 ;item number, a->tt - jsp t,fxnv2 ;address, b->d - push fxp,d ;save so we don't have to worry about ac corres - movem tt,lsrtns"a - pop fxp,lsrtns"b - pushj p,lsrtns"lsritm ;returns bp in lsrtns"a - skipa d,[440700,,[0]] ;unless there was no skip: use null string then - move d,lsrtns"a ;d is input bp - setz b, ;start with () -chlp: ildb tt,d ;get a char - jumpe tt,chlpx ;zero terminates - jsp t,fxcons ;turn into fixnum - call 2,.function CONS ;cons onto list - move b,a - jrst chlp ;go for another char -chlpx: move a,b ;reverse the list and atomify - call 1,.function NREVERSE - jcall 1,.function IMPLODE - -.sxeva (SETQ I$UNAM #0 ) ;UNAME -.sxeva (SETQ I$NAME #1 ) ;FULL NAME -.sxeva (SETQ I$NICK #2 ) ;NICKNAME -.sxeva (SETQ I$SSN #3 ) ;SOC SEC NUMBER -.sxeva (SETQ I$MITA #4 ) ;MIT ADDRESS -.sxeva (SETQ I$MITT #5 ) ;MIT TELEPHONE NUMBER -.sxeva (SETQ I$HOMA #6 ) ;HOME ADDRESS -.sxeva (SETQ I$HOMT #7 ) ;HOME TELEPHONE NUMBER -.sxeva (SETQ I$SUPR #10 ) ;SUPERVISOR(S) -.sxeva (SETQ I$PROJ #11 ) ;PROJECT -.sxeva (SETQ I$DIR #12 ) ;FILE DIR NAMES -.sxeva (SETQ I$AUTH #13 ) ;AUTHORIZATION -.sxeva (SETQ I$GRP #14 ) ;GROUP AFFILIATION -.sxeva (SETQ I$REL #15 ) ;RELATION TO GROUP -.sxeva (SETQ I$BRTH #16 ) ;BIRTHDAY -.sxeva (SETQ I$REM #17 ) ;REMARKS -.sxeva (SETQ I$NETA #20 ) ;NETWORK ADDRESS -.sxeva (SETQ I$ALTR #21 ) ;USER AND TIME OF LAST ALTERATION -.sxeva (SETQ I$MACH #22 ) ;ITS-S TO BE KNOWN ON. - -fasend diff --git a/src/games/lsrrtn.insert b/src/games/lsrrtn.insert index 2c4c372d..1c777b13 100644 --- a/src/games/lsrrtn.insert +++ b/src/games/lsrrtn.insert @@ -29,7 +29,7 @@ ;;; close our INQUIR disk channel. ;;; -(DEFPROP LSRMAP ((DSK games) LSRRTN FASL) AUTOLOAD) +(DEFPROP LSRMAP ((DSK inquir) LSRRTN FASL) AUTOLOAD) (DECLARE (SPECIAL *INQUIR-FILE-OBJECT*) (*EXPR LSRMAP LSRITM LSRUNM)) diff --git a/src/inquir/lsrrtn.32 b/src/inquir/lsrrtn.32 new file mode 100644 index 00000000..f6879e53 --- /dev/null +++ b/src/inquir/lsrrtn.32 @@ -0,0 +1,234 @@ +;;; -*- Mode: MIDAS -*- + +TITLE LSRRTN - LSR1 database interface. + ;Originally by RLB, extended by CSTACY. + +SUBTTL Basic definitions + +.FASL +.INSRT sys:.fasl defs +.SXEVAL (SSTATUS FEATURE LSRRTN) + +;;; Get the system LSR1 database routines. + +lsrtns"$$ovly==1 ;Map only a few pages and hack overlaying. +lsrtns"$$hsnm==1 ;HSNAME lookup. +lsrtns"$$ulnm==0 ;No last name searching. +lsrtns"$$ulnp==0 ;No abbrev l.name lookups. +lsrtns"$$unam==0 ;No name permutations. + +lsrtns"a==t ;LSRTNS requires some ACs. +lsrtns"b==tt +lsrtns"c==d +lsrtns"d==r +lsrtns"e==f +.INSRT dsk:syseng;lsrtns + +;;; Random utility routines and macros. + +;;; Given a Byte pointer in D, return a list of chars in B. + +chlp0: setz b, ;start with () +chlp: ildb tt,d ;get a char + jumpe tt,chlpx ;zero terminates + jsp t,fxcons ;turn into fixnum + call 2,.function CONS ;cons onto list + move b,a + jrst chlp ;go for another char +chlpx: popj p, ;all done. + + +;;; Item numbers. + +.SXEVA (SETQ I$UNAM #0 ) ;UNAME +.SXEVA (SETQ I$NAME #1 ) ;FULL NAME +.SXEVA (SETQ I$NICK #2 ) ;NICKNAME +.SXEVA (SETQ I$LOCL #3 ) ;LOCAL ITEMS +.SXEVA (SETQ I$MITA #4 ) ;MIT ADDRESS +.SXEVA (SETQ I$MITT #5 ) ;MIT TELEPHONE NUMBER +.SXEVA (SETQ I$HOMA #6 ) ;HOME ADDRESS +.SXEVA (SETQ I$HOMT #7 ) ;HOME TELEPHONE NUMBER +.SXEVA (SETQ I$SUPR #10 ) ;SUPERVISOR(S) +.SXEVA (SETQ I$PROJ #11 ) ;PROJECT +.SXEVA (SETQ I$DIR #12 ) ;FILE DIR NAMES +.SXEVA (SETQ I$AUTH #13 ) ;AUTHORIZATION +.SXEVA (SETQ I$GRP #14 ) ;GROUP AFFILIATION +.SXEVA (SETQ I$REL #15 ) ;RELATION TO GROUP +.SXEVA (SETQ I$BRTH #16 ) ;BIRTHDAY +.SXEVA (SETQ I$REM #17 ) ;REMARKS +.SXEVA (SETQ I$NETA #20 ) ;NETWORK ADDRESS +.SXEVA (SETQ I$ALTR #21 ) ;USER AND TIME OF LAST ALTERATION +.SXEVA (SETQ I$MACH #22 ) ;SUNAME@MACHINE PAIRS + + +SUBTTL Mapping the database. + +;;; (LSRMAP ) +;;; opens up and maps in the inquir database for looking up people. +;;; Returns a file object to be passed to other routines. +;;; Uses GETCOR to reserve address space. Don't try this too many times +;;; since the addr space isn't reused. + +.ENTRY LSRMAP SUBR 1+1 + jsp t,fxnv1 ;get & save # pages to use, a->tt + push fxp,tt +;; (OPEN '|INQUIR;LSR1 >| '(IN)) + movei a,.atom INQUIR/;LSR1/ > + movei b,.sx (IN) + call 2,.function OPEN + push p,a +;; extract I/O channel number from the file array, into TT + movei tt,f.chan + move tt,@ttsar(a) + push fxp,tt +;; get pages via getcor + move tt,-1(fxp) ;# pages + pushj p,getcor ;request addr space from Lisp + jumpe tt,corlos ;its addr is returned zero if none avbl + idivi tt,2000 ;cvt to page number + movn d,-1(fxp) ;get number of pages requested to construct + hrl tt,d ;aobjn to them +;; construct args for lsrmap + move lsrtns"b,tt ;aobjn to free page range + move lsrtns"a,(fxp) ;disk channel number +;; Get the INQUIR data base mapped in + pushj p,lsrtns"lsrmap ;try to map in the data base + jrst lsrluz ;no skip if it lost +;; I guess we won, clean up and return the file object. +opnbye: sub fxp,[2,,2] + pop p,a + popj p, + +;;; Return () instead of file obj. +corlos: +lsrluz: move a,(p) ;get the file obj + call 1,.function CLOSE ;close it + setzm (p) ;return () + jrst opnbye + + +SUBTTL Stepping through the database. + +;;; The screw with stepping through the database is that +;;; LSRDTA and LSRNXT return a core address, not a file address. +;;; +;;; For example, you can not search by stepping through the database and +;;; storing the addresses of the found entries, because succesive LSRNXTs +;;; will not necessarily leave the entries mapped. Instead, you must +;;; process each entry as you find it, and then call LSRNXT. + + +;;; (LSRDTA +;;; +;;; Returns the core address of the first data entry. +;;; This can be used to get an initial pointer for LSRNXT. +;;; Returns -1 if the LSR1 database does not appear to be mapped. + +.ENTRY LSRDTA SUBR 1+1 + push p,[fix1] ;Ncallable: (declare (fixnum (lsrnxt ...))) + ; so return machine number in TT. + movei tt,f.chan ;Pick up disk channel number. + move lsrtns"a,@ttsar(a) + move lsrtns"b,lsrtns"datfpg + imuli lsrtns"b,2000 ;File data page => addr first entry + pushj p,lsrtns"lsrget ;Map it and get core addr. + movni lsrtns"b,1 ; Say -1 for lossage. + move tt,lsrtns"b ;Return value. + popj p, + +;;; (LSRNXT ) +;;; +;;; Given the core address of an entry, returns the core address of the +;;; next sequential entry in the LSR1 database. Returns -1 iff there +;;; are no more entries. + +.ENTRY LSRNXT SUBR 2+1 + push p,[fix1] ;Ncallable: (declare (fixnum (lsrnxt ...))) + ; so return machine number in TT. + movei tt,f.chan ;Pick up disk channel number. + move lsrtns"a,@ttsar(a) + move lsrtns"b,(b) + pushj p,lsrtns"lsrnxt ;Get entry into lsrtns"b. + movni lsrtns"b,1 ; Say -1 for lossage. + move tt,lsrtns"b ;Return value. + popj p, + + +SUBTTL Looking up a user. + +;;; (LSRUNM ) +;;; Returns a magic number to be passed to LSRITM, etc., or -1 if uname unknown. +;;; Actually, the "magic number" is the entry's core address returned +;;; by the lib subr. + +.ENTRY LSRUNM SUBR 2+1 + push p,cfix1 ;NCALLable! + movei tt,f.chan ;pick up disk channel number + move tt,@ttsar(a) + push fxp,tt ;and save it + move a,b ;(car (pnget 6)) + movei b,.atom #6. + call 2,.function PNGET + hlrz a,(a) + move lsrtns"b,(a) ;set up uname in 6bit for lsrunm + pop fxp,lsrtns"a ;the channel + pushj p,lsrtns"lsrunm ;get entry addr in lsrtns"b + movni lsrtns"b,1 ;-1 for loss + move tt,lsrtns"b ;move to where Lisp wants it. + popj p, + + +SUBTTL Fetching an item. + +;;; (LSRITM ) +;;; returns the slot of the entry +;;; returned by LSRUNM. +;;; This file sets the symbols I$UNAM etc to the correct values. +;;; Look after this function, and in :INFO LIB LSRTNS . + +.ENTRY LSRITM SUBR 2+1 + jsp t,fxnv1 ;item number, a->tt + jsp t,fxnv2 ;address, b->d + push fxp,d ;save so we don't have to worry about ac corres + movem tt,lsrtns"a + pop fxp,lsrtns"b + pushj p,lsrtns"lsritm ;returns bp in lsrtns"a + skipa d,[440700,,[0]] ;unless there was no skip: use null string then + move d,lsrtns"a ;d is input bp + pushj p,chlp0 + move a,b ;reverse the list and atomify + call 1,.function NREVERSE + jcall 1,.function IMPLODE ;Return the symbol! + + +SUBTTL HSNAME hackery. +;;; Most often you want (STATUS HSNAME user) and not LSRHTL. + +;;; (LSRHTL ) +;;; Returns a symbol which is the hsname of the argument uname. +;;; Returns NIL if unknown. + +.ENTRY LSRHTL SUBR 2+1 + push p,cfix1 ;NCALLable! + movei tt,f.chan ;pick up disk channel number + move tt,@ttsar(a) + push fxp,tt ;and save it + move a,b ;(car (pnget 6)) + movei b,.atom #6. + call 2,.function PNGET + hlrz a,(a) + move lsrtns"a,(a) ;set up uname in 6bit for lsrunm + pop fxp,lsrtns"b ;the channel + movei c,lsrtns"hx$nrm ;use the normal table. + setz lsrtns"c, ;use the local site. + pushj p,lsrtns"lsrhtl ;get entry addr in lsrtns"b + jrst [ move d,[440700,,[0]] ; use null string for pretend result + jrst lsrht1 ] + move r,lsrtns"b ;get Bp to user's directory name + move d,[440600,,r] +lsrht1: pushj p,chlp0 ;CONS up list of letters symbol from Bp in D + move a,b ;reverse the list and atomify + call 1,.function NREVERSE + jcall 1,.function IMPLODE ;Return the symbol! + +FASEND