mirror of
https://github.com/PDP-10/its.git
synced 2026-02-27 09:18:58 +00:00
Resolves #908: Reconcile two different versions of LSRRTN.
Resolves #912: Fix reference to BMT1;ANIMAL ONEWS in GAMES; ANIMAL NEWS.
This commit is contained in:
Eric Swenson
@@ -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"
|
||||
|
||||
@@ -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.
|
||||
|
||||
@@ -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 <number of pages to use>)
|
||||
;;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 <file obj returned by LSRMAP> <uname>)
|
||||
;;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 <uname> 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 <item number> <magic number>)
|
||||
;;returns the <item number> slot of the entry <magic number> 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
|
||||
@@ -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))
|
||||
|
||||
234
src/inquir/lsrrtn.32
Normal file
234
src/inquir/lsrrtn.32
Normal file
@@ -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 <number of pages to use>)
|
||||
;;; 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 <file-object>
|
||||
;;;
|
||||
;;; 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 <file-obj> <core address>)
|
||||
;;;
|
||||
;;; 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 <file obj returned by LSRMAP> <uname>)
|
||||
;;; 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 <uname> 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 <item number> <magic number>)
|
||||
;;; returns the <item number> slot of the entry <magic number>
|
||||
;;; 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 <file object> <uname>)
|
||||
;;; 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 <uname> 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
|
||||
Reference in New Issue
Block a user