github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-17 00:33:22 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/syseng/lsrtns.69
Lars Brinkhoff 084d79d3c5 DDT source code.
2016-11-02 10:08:29 +01:00

1034 lines
30 KiB
Plaintext
Executable File
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; INSERT FILE LSRTNS > -*-MIDAS-*-
IFN 0,.LIBFIL ;Don't process this file in @ unless it's being listed.
;******* If you modify this, inform TAA @ dm, who maintains *******
;******* the corresponding routines for muddle. *******
subttl LSRTNS Definitions
;Assumes ACs A,B,C,D,E in that order, and P.
;Clobbers no ACs except those documented in the front of the routine.
;Always skip-returns unless error.
;Is pure. Assumes no external locations (not even CPOPJ).
.AUXIL ;cref control
;PRINT VERSION NUMBER
.TYO6 .IFNM1
.TYO 40
.TYO6 .IFNM2
PRINTX/ included in this assembly.
/
.BEGIN LSRTNS
;;; Conditional assembly switches
; The default is to assemble almost everything
IFNDEF $$DEFS, $$DEFS==0 ;Assemble no routines, only definitions!
IFNDEF $$ULNM, $$ULNM==1 ;Assemble LSRLNM routine
IFNDEF $$ULNP, $$ULNP==1 ;Assemble last-name-prefix matcher
IFNDEF $$UNAM, $$UNAM==1 ;Assemble LSRNAM routine
IFNDEF $$OVLY, $$OVLY==1 ;Do overlaying (don't map in whole LSR1 file at once).
IFNDEF $$HSNM, $$HSNM==0 ;Assemble HSNAME routines.
;the rest of the routines you probably always want.
;;; SYMBOLS FOR FORMAT OF THE INQUIR;LSR1 > FILE.
;;; The LSR1 database begins with pointers to various tables
;;; and the data area. These areas are described (in order) below.
HDRLEN==8. ;Number of words in the following header area.
HDRSID==0 ; wd 0 SIXBIT /LSR1!!/
HDRDAT==1 ; wd 1 Date of compilation as sixbit YYMMDD
HDRTIM==2 ; wd 2 Time of compilation as sixbit HHMMSS
HDRUNM==3 ; wd 3 Address in file of UNAME table.
HDRLNM==4 ; wd 4 Address in file LASTNAME table.
HDRDTA==5 ; wd 5 Address in file of start of data area.
; The data area must start on a page boundary,
; and it must be the last thing in the file.
HDRHSN==6 ; wd 6 Address in file of HSNAME table.
HDRVER==7 ; wd 7 Format version of the LSR1 database.
; Before 3/15/83, this word was data!
COMMENT |
The UNAME table:
Word 0 contains the number of entries in this table.
Next come the entries, one per page of data area, each containing the
sixbit UNAME of the first data area entry which begins on that page.
The sign bit of each UNAME is complemented to speed up the search.
The LASTNAME table:
Word 0 contains the number of entries in this table.
Next come the entrie, in order by last name.
Each entry looks like:
RH addr in file of entry
LH addr in file of Last-name string
The lastname strings are word-aligned upper-case ASCIZ strings, and
they follow the LASTNAME table.
The HSNAME table:
Currently this table is simply snarfed from the file INQUIR;DIRS BIN
and the format is documented in the source of the "program" that
creates it, namely INQUIR;DMUNCH >.
The DATA Area
The data area starts on a page boundary. It is made up of consecutive
entries, in order by ascii UNAME. Each entry is a header word,
followed by some items strings. The entire entry is then padded to a
word boundary with nulls.
The header word looks like: LENGTH,,-1 where LENGTH is the number of
words the item strings use. The next entry header can be found at (+
THIS-HEADER-ADDR LENGTH). Note that entry header words are the *only*
words in the DATA area which have their low bits set.
An item string is unaligned ASCIZ, separated only by the single ^@
that ends the ASCIZ. The strings are associated with their meanings
according to their numerical position in the entry.
The end of the data area is marked by 0,,-1.
This is tantamount to an entry 0 words long. That word is also the
last word of the file.
|;TNEMOC
;;; Symbols for fields of an entry.
; I$ prefix is for the sake of bit-typeout mode
I$==0,,-1
I$UNAM==0 ;UNAME
I$NAME==1 ;FULL NAME
I$NICK==2 ;NICKNAME
I$LOCL==3 ;LOCAL ITEMS
I$MITA==4 ;MIT ADDRESS
I$MITT==5 ;MIT TELEPHONE NUMBER
I$HOMA==6 ;HOME ADDRESS
I$HOMT==7 ;HOME TELEPHONE NUMBER
I$SUPR==10 ;SUPERVISOR(S)
I$PROJ==11 ;PROJECT
I$DIR==12 ;FILE DIR NAMES
I$AUTH==13 ;AUTHORIZATION
I$GRP==14 ;GROUP AFFILIATION
I$REL==15 ;RELATION TO GROUP
I$BRTH==16 ;BIRTHDAY
I$REM==17 ;REMARKS
I$NETA==20 ;NETWORK ADDRESS
I$ALTR==21 ;USER &TIME OF LAST ALTERATION
I$MACH==22 ;SUNAME@MACHINE PAIRS
NFILDS==19. ;How many fields there are.
;Provide names of all items, for INQUIR and INQUPD, etc.
DEFINE ITMIRP FORM
IRPS ITEM,,[SUNAM UNAME NAME NICK LOCAL MITAD MITTE HOMAD
HOMTE SUPER PROJE FILDI AUTHO GROUP RELAT BIRTH
REMAR NETAD ALTER MACHI]
FORM
TERMIN TERMIN
;;; User programs generally do not need to read in an entire
;;; entry or know the entry lengths, but here they are.
;;; This code fragment is from INQUPD, the deamon which updates
;;; the database:
;;;
;;;
;;; %UNAME: BLOCK 2 ;UNAME
;;; %NAME: BLOCK 20 ;FULL NAME
;;; %NICK: BLOCK 10 ;NICKNAME
;;; %LOCAL: BLOCK 10 ;LOCAL INQUIRE ITEMS
;;; %MITAD: BLOCK 40 ;MIT ADDRESS
;;; %MITTE: BLOCK 20 ;MIT TELEPHONE NUMBER
;;; %HOMAD: BLOCK 40 ;HOME ADDRESS
;;; %HOMTE: BLOCK 20 ;HOME TELEPHONE NUMBER
;;; %SUPER: BLOCK 40 ;SUPERVISOR(S)
;;; %PROJE: BLOCK 40 ;PROJECT
;;; %FILDI: BLOCK 20 ;FILE DIR NAMES
;;; %AUTHO: BLOCK 10 ;AUTHORIZATION
;;; %GROUP: BLOCK 1 ;GROUP AFFILIATION
;;; %RELAT: BLOCK 1 ;RELATION TO GROUP
;;; %BIRTH: BLOCK 10 ;BIRTHDAY
;;; %REMAR: BLOCK 200 ;REMARKS
;;; %NETAD: BLOCK 20 ;NETWORK ADDRESS
;;; %ALTER: BLOCK 10 ;USER &TIME OF LAST ALTERATION
;;; %MACHI: BLOCK 40 ;SUNAME/MACHINES TO BE UPDATED
;;; Constant Parameters
LSRFID: SIXBIT /LSR1!!/ ; File identifier word (what HDRID should be)
LSRFN1: SIXBIT /LSR1/ ; File name for LSR data
LSRFN2: SIXBIT />/
LSRDIR: SIXBIT /INQUIR/ ; Directory to find file on.
;;; Useful macros
DEFINE SYSCAL A,B
.CALL [SETZ ? SIXBIT/A/ ? B ((SETZ))]
TERMIN
;;; Variables
.SCALAR LSRADR ;Core address where first part of file is mapped in
.SCALAR DATFPG ;Page number in file of first data page
.SCALAR SCMPRT ;String compare routine to use LSRLNM and LSRLNP
.SCALAR DATADR ;Core address of two pages for mapping in data pages of file
.SCALAR DATPAG ;DATADR/2000
.SCALAR PAGEIN ;Page number in file of page currently mapped in at DATPAG
;The page after that maps the next sequential file page.
;This is negative if no page is currently mapped in.
IFE $$DEFS,[
SUBTTL LSRMAP
;LSRMAP takes in A a channel number, and in B an AOBJN pointer to a
;range of free pages, and maps in the data base. If successful, it
;returns in B an updated pointer indicating which pages were not
;needed, and leaves the file STILL OPEN on the given channel.
;Pages which might be needed later for mapping in an entry are
;remembered internally and marked off as "used". No skip can
;either be due to trouble opening or mapping the file, or due
;to a clobbered file, or due to needing more pages than are offered.
;In non-overlay mode, the entire LSR1 file is mapped in,
;and the channel is closed.
LSRMAP: PUSH P,C
PUSH P,D
PUSH P,E
SYSCAL OPEN,[5000,,.UII ; Open the file
MOVEI (A) ? [SIXBIT/DSK/]
LSRFN1 ? LSRFN2 ? LSRDIR]
JRST LSRMPL ;Fail
IFN $$OVLY,[
;If doing overlaying, map in just the tables at the front, and leave
;2 pages of space to hold 2 consecutive data pages at any time.
SYSCAL CORBLK,[ ;Map in the first page of the file
MOVEI %CBNDR ;Read-only, must be present
MOVEI %JSELF
MOVEI (B)
MOVEI (A) ]
JRST LSRMPL
HRRZ C,B ;Get address of start of file
LSH C,10.
MOVE D,HDRSID(C) ;Verify that file is really LSR1.
CAME D,LSRFID ;Compare with file identifier word.
JRST LSRMPL ;no good
AOBJP B,LSRMPL ;Advance B over first page
MOVE D,HDRDTA(C) ;Number of words always to be mapped
TRNE D,1777 ;Must be multiple of 1 page
JRST LSRMPL
LSH D,-10. ;Get number of pages
MOVEM D,DATFPG
;D has the number of pages in the fixed front part of the file.
;In addition, we need two more pages to window into the data
;part of the file, but, also, B has already been advanced one
;page, and we want to stop one page short so we can test
;for not enough core. These cancel out and D contains the right value.
MOVEI E,-1(D) ;Save number of pages in fixed part yet to be mapped.
HRLS D
ADD D,B ;Compute final aobjn pointer less one
AOBJP D,LSRMPL ;Not enough core supplied
MOVNS E
HRL B,E ;Aobjn pointer to always-mapped pages
SYSCAL CORBLK,[MOVEI %CBNDR
MOVEI %JSELF
MOVE B
MOVEI (A) ]
JRST LSRMPL
;It's successfully mapped in, save pointers for later calls.
MOVE B,D ;Return aobjn pointer to pages not used
MOVE E,C
ADD E,HDRDTA(C) ;Set up pointer to data pages
MOVEM E,DATADR
LSH E,-10.
HRRZM E,DATPAG
SETOM PAGEIN ;No page is mapped in yet
]
IFE $$OVLY,[
SYSCAL FILLEN,[A ? MOVEM E] ; Get file length in wds
JRST LSRMPL
ADDI E,1777
LSH E,-10. ;get length in pages.
MOVEI D,(E)
MOVNS E
HRLZS E
HRR E,B ;Aobjn pointer to range of pages to fill with file.
HRRZ C,B ;remember address in core of the first page.
LSH C,10.
HRLS D
ADDM D,B ;advance the supplied pointer past them.
JUMPGE B,LSRMPL ;jump if not enough core supplied
SYSCAL CORBLK,[ MOVEI %CBNDR
MOVEI %JSELF
MOVE E
MOVEI (A) ]
JRST LSRMPL
MOVE D,HDRSID(C) ;Verify that file is really LSR1.
CAME D,LSRFID ;Compare with file identifier word.
JRST LSRMPL ;no good
]
;C now has core address of the first word of the file.
MOVEM C,LSRADR ;good; save core addr of file, thus marking it "in".
MOVE C,HDRDTA(C)
LSH C,-10.
MOVEM C,DATFPG ;Store # of file pages before start of data area.
IFN $$HSNM, PUSHJ P,LSRHIN ; Initialize HSNAME cruft.
AOS -3(P) ;Take success return
LSRMPL: POP P,E
POP P,D
POP P,C
POPJ P,
SUBTTL LSRNXT
;Given in B the core address of an entry, returns in B the
;core address of the next sequential entry in the database.
;Wants the LSR1 file channel number in A, as in LSRGET.
;(DEFUN FILE-ADDR (B) ;An entry core address.
; (+ (* 2000 (+ PAGEIN (- DATPAG B))) (- B DATADR)))
LSRNXT: PUSH P,A
PUSH P,C
PUSH P,D
SKIPN C,LSRADR ;Header file address.
JSP B,LSRUNX ;Oops - user forgot to map in database.
MOVE C,B
LSH C,-10. ;Core page number.
MOVE D,DATPAG
SUB D,C
ADD D,PAGEIN ;File page of entry.
IMULI D,2000 ;File address of entry's page.
HLRZ C,(B) ;Length of entry.
JUMPE C,LSRNX9 ;Zero length entry terminates the database.
SUB B,DATADR ;Offset of entry on the page.
ADD D,B ;File address of entry.
ADD D,C ;File address of next entry.
MOVE B,D ;Return result here.
PUSHJ P,LSRGET ;Map it and get its core address.
CAIA
AOS -3(P) ;Skip if successful.
LSRNX9: POP P,D
POP P,C
POP P,A
POPJ P,
SUBTTL LSRUNM
;LSRUNM takes in A a channel number, on which the LSR1 file is
;assumed to be open, and in B a UNAME as a word of SIXBIT,
;and returns in B the address, in core, of the entry for that UNAME.
;Such entries are mapped in by LSRUNM and will not
;necessarily remain in core if another LSRUNM or LSRLNM is done.
;No skip implies there is no entry for that UNAME if B is zero
;or a system error if B is non-zero.
LSRUNM: PUSH P,A
TLC B,(SETZ) ;complement high bit in sixbit to get ascii order
PUSH P,C
PUSH P,D
PUSH P,E
SKIPN C,LSRADR ;Address file header
JSP B,LSRUNX ;you forgot to map it in
;Linear search the Uname table to find what page the desired entry starts on
;No reason to do a binary search since only 80 or a 100 entries.
MOVEI D,1(C)
ADD D,HDRUNM(C) ;-> Uname table first uname
CAMGE B,(D) ;Check for fencepost bug in code below
JRST LSRUNL ;This indicates the entry does not exist
MOVN E,-1(D) ;Set up aobjn pointer
HRL D,E
LSRUN1: CAML B,(D) ;Skip if this is too far down the file
AOBJN D,LSRUN1
SUB D,HDRUNM(C) ;Compute the desired page number
SUBI D,2(C)
HRRZS D
ADD D,DATFPG
EXCH B,D ;Map it and the page after it in
LSH B,10.
HRRO A,-3(P)
PUSHJ P,LSRGET
JSP B,LSRUNX ;Lost
MOVE E,B ;core address of the page.
MOVE B,D ;Restore uname being searched for
;Now linearly search for the start of an entry, and compare Unames.
;This code assumes the Uname is the first item in an entry.
HRLI E,-2000 ;The header is known to be on the first page
LSRUN3: MOVEI D,1 ;Search for a header (bit 1.1 turned on)
TDNN D,(E)
AOBJN E,.-1
JUMPGE E,LSRUNL ;Not found
HLRZ D,(E) ;Get word count
JUMPE D,LSRUNL ;0 => EOF => not found
PUSH P,B ;Extract uname and convert to sixbit
PUSH P,C
PUSH P,E
MOVEI D,0 ;Accumulate sixbit in D
HRLI E,010700 ;using byte pointer in E to load
MOVE B,[440600,,D] ;and byte pointer in B to store
LSRUN4: ILDB C,E
JUMPE C,LSRUN5
CAIGE C,140
SUBI C,40
TLNE B,770000
IDPB C,B
JRST LSRUN4
LSRUN5: POP P,E
POP P,C
POP P,B
TLC D,(SETZ)
CAMLE B,D
AOBJN E,LSRUN3 ;not found yet, scan more
CAME B,D
JRST LSRUNL ;got past where it should be => doesn't exist
HRRZ B,E ;Found it. Get address of header of entry
AOSA -4(P) ;and take success return
LSRUNL: MOVEI B,0 ;doesn't exist
LSRUNX: POP P,E
POP P,D
POP P,C
POP P,A
POPJ P,
SUBTTL LSRLNM
;LSRLNM is like LSRUNM but expects in B the address of
;an all-caps last name, as an ASCIZ string, instead
;of a UNAME, and returns in B an aobjn pointer to the
;LASTNAME table words whose Lastname match the argument.
;Note that the argument must end with null all the way to
;the end of the word, not just a single null character. This
;is so that it can compare strings a word at a time.
;LSRLNP is similar to LSRLNM but returns an aobjn pointer
;to all the lastname table entries for which the argument
;in B is a prefix of their last name. It works by using
;a different STRCMP routine.
IFN $$ULNP,[
LSRLNP: PUSH P,A
MOVEI A,STRPRC
JRST LSRLN0
];$$ULNP
IFN $$ULNM,[
LSRLNM: PUSH P,A
MOVEI A,STRCMP
];$$ULNM
IFN $$ULNM\$$ULNP,[
LSRLN0: MOVEM A,SCMPRT
PUSH P,B
PUSH P,C
PUSH P,D
PUSH P,E
SKIPN C,LSRADR
JRST LSRLNL ;you forgot to map in the file
MOVEI E,1(C)
ADD E,HDRLNM(C) ;-> Lastname table first entry
MOVE D,E
ADD E,-1(E)
;Binary Search.
;-3(P) initial byte pointer to lastname being searched for
;A points to current entry in Lastname table
;B byte pointer to argument name
;C byte pointer to name in table
;D points to first possible entry in Lastname table
;E points after last possible entry in Lastname table
LSRLN1: CAMG E,D ;Skip if any possibilities left
JRST LSRLNL ;no match, lose
MOVE A,E ;Generate probe point in center
SUB A,D
LSH A,-1
ADD A,D
HLRZ C,(A) ;Get address in file of that lastname
ADD C,LSRADR ;Relocate to core address
MOVE B,-3(P) ;Get address of name being searched for
PUSHJ P,@SCMPRT ;Compare the strings
JRST [ MOVEI D,1(A) ? JRST LSRLN1 ] ;B>C, move up
JRST [ MOVE E,A ? JRST LSRLN1 ] ;B<C, move down
;Equal. Now narrow [D,E) to range of equality (may be more than one.) ;] match []'s.
;First back up to first
LSRLN4: CAMG A,D
JRST LSRLN5 ;Don't back up past D
HLRZ C,-1(A) ;Get address in file of previous lastname
ADD C,LSRADR ;Relocate to core address
MOVE B,-3(P) ;Get address of name being searched for
PUSHJ P,@SCMPRT
JRST LSRLN5 ;B>C
JRST LSRLN5 ;B<C (shouldn't happen)
SOJA A,LSRLN4 ;B=C, back up more
;Now run forward to last
LSRLN5: MOVNI D,1 ;Keep negative count of entries in RH
HRL D,A ;Keep address of first entry in LH
LSRLN6: CAIL A,-1(E)
JRST LSRLN7 ;Don't run forward past E
HLRZ C,1(A) ;Get address in file of next lastname
ADD C,LSRADR ;Relocate to core address
MOVE B,-3(P) ;Get address of name being searched for
PUSHJ P,@SCMPRT
JRST LSRLN7 ;B>C (shouldn't happen)
JRST LSRLN7 ;B<C
SUBI D,1 ;B=C, forward more
AOJA A,LSRLN6
LSRLN7: MOVS B,D ;Return aobjn pointer
AOS -5(P) ;Take success return
LSRLNL: POP P,E
POP P,D
POP P,C
POP P,A ;was saved B, but we're returning something
POP P,A
POPJ P,
];$$ULNM+$$ULNMP
IFN $$ULNM,[
;Asciz string compare. B and C are byte pointers to the two upper-case strings.
;Clobbers only B and C
;Skip twice if equal, once if B<C, no skip if B>C
;Does assume that both strings are nulled out to word boundaries.
STRCMP: PUSH P,D
PUSH P,E
STRCM1: MOVE D,(B)
LSH D,-1
MOVE E,(C)
LSH E,-1
CAMLE D,E
JRST STRCM3 ;B>C
CAME D,E
JRST STRCM2 ;B<C
TRNN E,177
JRST STRCM4 ;Compared all, they are equal
ADDI B,1
AOJA C,STRCM1 ;Equal so far, compare more
STRCM4: AOS -2(P) ;Reached end, B=C
STRCM2: AOS -2(P)
STRCM3: POP P,E
POP P,D
POPJ P,
];$$ULNM
IFN $$ULNP,[
;Asciz string compare. B and C are byte pointers to the two upper-case strings.
;Clobbers only B and C.
;Skip twice if equal, once if B<C, no skip if B>C
;Here they are considered equal if B is a valid prefix of C.
STRPRC: HRLI B,440700
HRLI C,440700
PUSH P,D
PUSH P,E
STRPR1: ILDB D,B
JUMPE D,STRPR4 ;Equal
ILDB E,C
JUMPE E,STRPR3 ;B>C
CAMN D,E
JRST STRPR1 ;equal so far, test more
CAMG D,E
STRPR2: AOS -2(P) ;B<C
STRPR3: POP P,E
POP P,D
POPJ P,
STRPR4: AOS -2(P) ;B=C
JRST STRPR2
];$$ULNP
SUBTTL LSRGET
;LSRGET takes in A a channel number and in B the file address of an entry.
;It maps in the appropriate pages (unless the whole file is in core)
;and returns in B the core address. Fails to skip if the map fails or
;if the given address does not point at the header of an entry, or at eof.
;Use this after calling LSRLNM.
;Also used internally, in which case the sign bit of A is set
;to indicate that it shouldn't check whether B points to a valid entry.
LSRGET: PUSH P,D
PUSH P,E
;If not all of the file is in core, we must map in the needed page.
IFN $$OVLY,[
LDB D,[121000,,B]
CAMN D,PAGEIN ;Is it in already?
JRST LSRGT1 ;Yes, don't bother mapping again
HRROM D,PAGEIN ;Save page, but leave negative in case CORBLK fails
MOVE E,DATPAG ;Map in that and the following page
HRLI E,-2
SYSCAL CORBLK,[MOVEI %CBRED ;2nd page may not exist, so don't require access
MOVEI %JSELF
MOVE E
MOVEI (A)
D ]
JRST LSRGTL ;Any failure is an error
;At this point, the 2 map pages each either point to the appropriate
;file page or are non-existent memory, in the case where the file is
;not that long. In any case, the system will have counted out
;the AOBJN pointer in E. If only one page was valid, hopefully we
;will not try to reference off the end of the file and so will not
;reference that page. If neither page was valid, we have a bug and
;will find out about it by getting an MPV in about five instructions.
HRRZS PAGEIN ;OK page is really in now
LSRGT1: ANDI B,1777 ;Make core address
ADD B,DATADR
] ;end IFN $$OVLY
;If whole file is in core, just convert file address to core address.
IFE $$OVLY, ADD B,LSRADR
JUMPL A,LSRGT2 ;Sign(A) => don't check address for validity.
HRRO D,(B) ;Else verify that B points at a valid item header
AOJN D,LSRGTL ;Barf if no -1 in RH
HLRE D,(B)
JUMPL D,LSRGTL ;Barf if LH negative - 0 (EOF) is ok.
IFN $$OVLY,[
ADD D,B
SUB D,DATADR
CAIG D,4000 ;Barf if entry not entirely in core
]
LSRGT2: AOS -2(P) ;Success return
LSRGTL: POP P,E
POP P,D
POPJ P,
SUBTTL LSRITM
;LSRITM takes in A an item number and in B the address in core
;of a LSR entry, and returns in A a b.p. to the specified item.
;No skip => this entry lacks that item, meaning either that there
;are not <item number> items in this entry or that the item is the
;null string.
LSRITM: PUSH P,C
PUSH P,D
PUSH P,E
HRRO C,(B) ;Verify that B points at a valid item header
AOJN C,LSRITL ;Barf if no -1 in RH
HLRE C,(B)
JUMPLE C,LSRITL ;Barf if LH 0 or negative
MOVE E,A ;Save item number (i.e. number of items to skip)
MOVE A,B ;Set up byte pointer
HRLI A,010700
JUMPE E,LSRIT9 ;Got the desired item
LSRIT1: ILDB C,A ;Skip over this item
JUMPN C,LSRIT1
MOVEI C,1 ;Check for end of entry
MOVE D,A
IBP D
TDNE C,(D)
JRST LSRITL ;End of entry, item not found
SOJG E,LSRIT1 ;Search more unless next item is it
LSRIT9: MOVE C,A ;Next item A-> is it
ILDB C,C
JUMPE C,LSRITL ;Null string, non-skip return
AOS -3(P)
LSRITL: POP P,E
POP P,D
POP P,C
POPJ P,
SUBTTL LSRNAM
;LSRNAM takes in A a b.p. to a Name item, and in B a b.p. to
;storage, and IDPBs down B the name, canonically permuted into
;Firstname Lastname Suffix order.
;If the input name contains no comma, leave it alone.
;If it contains one comma, it is Lastname comma spaces Firstname
; which we change into Firstname space Lastname
;If it contains more than one comma,
; it is Lastname comma spaces Firstname comma additionalcruft
; which we change into Firstname space Lastname comma additionalcruft
;The Middle name is treated as part of the first name.
IFN $$UNAM,[
LSRNAM: PUSH P,A
PUSH P,C
PUSH P,D
LSRNM1: ILDB C,A ;First, look for a comma
JUMPE C,LSRNM8 ;No comma, go copy it straight across
CAIE C,",
JRST LSRNM1
LSRNM2: ILDB C,A ;Found comma, skip spaces after it if any
CAIN C,40
JRST LSRNM2
LSRNM3: IDPB C,B ;Copy first name
ILDB C,A
CAIE C,",
JUMPN C,LSRNM3
MOVEI D,40 ;Put a space after the first name
IDPB D,B
JUMPE C,LSRNM8 ;If no additionalcruft, go copy last name
MOVE D,A ;Save pointer to addtionalcruft
SKIPA A,-2(P) ;Get back pointer to last name
LSRNM4: IDPB C,B
ILDB C,A ;Copy it over
CAIE C,",
JRST LSRNM4
MOVE A,D ;Then copy over the additionalcruft
JRST LSRNM9 ;preceded by the comma that is in C
LSRNM8: SKIPA A,-2(P) ;Copy the last name (or sometimes other things)
LSRNM9: IDPB C,B
ILDB C,A
CAIE C,", ;Stop on comma or null
JUMPN C,LSRNM9
MOVEI C,0 ;Terminate Asciz string with a null
IDPB C,B
AOS -3(P) ;Success return
POP P,D
POP P,C
POP P,A
POPJ P,
];$$UNAM
SUBTTL HSNAME Routines
IFN $$HSNM,[
.SCALAR HSNADR ; Address in core of HSNAME table base.
.SCALAR HSNPTR ; AOBJN ptr to HSNAME table entries.
.SCALAR HSNLN1 ; Length-1 of an entry in HSNAME table.
.SCALAR LMCHNM ; Local machine name, as returned by SSTATU.
; HSNAME table indices (later maybe .INSRT these)
HX$MCH==0 ; Machine name, as returned by SSTATU call.
HX$HST==1 ; ARPAnet host #.
HX$NRM==2 ; Pointer to "normal" subtable
HX$TUR==3 ; Pointer to "tourist" subtable
HX$AIL==4 ; On MC and ML, AI people have a set of dirs.
; Sub-table indices
HS$UNM==0 ; UNAME, with sign bit complemented.
HS$HSN==1 ; HSNAME for this entry's range. Range of an entry
; extends from its UNAME (incl) to next entry's UNAME (excl).
; LSRHIN - HSNAME initialization at LSRMAP time.
; Internal rtn, clobbers C,D.
LSRHIN: SYSCAL SSTATU,[
REPEAT 5,MOVEM C
MOVEM LMCHNM] ; Set local machine name.
POPJ P,
SETZM HSNPTR
SKIPN D,LSRADR
POPJ P,
ADD D,HDRHSN(D) ; Get abs addr of HSNAME table in core.
MOVEM D,HSNADR ; Save
SKIPL C,(D) ; Get -<# entries>,,<# wds/entry>
POPJ P,
SUBI C,1 ; Get entry length-1
HRRZM C,HSNLN1 ; Save.
HRRI C,1(D) ; Now make AOBJN to table entries
MOVEM C,HSNPTR ; And save, all done.
POPJ P,
; LSRTUR - Test entry for touristness.
; B/ <LSR entry addr>
; Skips if tourist ("Group" field T or non-existent)
LSRTUR: PUSH P,A
MOVEI A,I$GRP
PUSHJ P,LSRITM ; Find item
TDZA A,A ; If none, use zero char.
ILDB A,A ; Get char of field
JUMPE A,LSRTRW ; Null implies tourist
CAIE A,"S ; Students are tourists.
CAIN A,"T ; Tourists are tourists.
LSRTRW: AOS -1(P) ;skip on return.
POP P,A
POPJ P,
;;; LSRHTB - Find luser's HSNAME table index.
;;; Check's the luser's entry and determines which HSNAME table is
;;; appropriate to use. (Looks at the group field.)
;;;
;;; B/ <LSR entry addr>
;;; C/ <site>
;;; Returns the HSNAME table number in B.
LSRHTB: PUSH P,A
PUSH P,C
SKIPN C ; If no site specified
MOVE C,LMCHNM ; use the local machine.
JUMPE B,LSRHB1 ; No INQUIR entry means tourist.
MOVEI A,I$GRP ; Want luser's group info.
PUSHJ P,LSRITM ; Look up the item.
TDZA A,A ; If none, use zero char.
ILDB A,A ; Get char of field
MOVEI B,HX$NRM ; Assume normal table to start.
SKIPN A ; People with null groups
LSRHB1: MOVEI B,HX$TUR ; are tourists.
CAIE A,"T ; Tourists always use the tourist dirs.
CAIN A,"S ; Students always use the tourist dirs.
MOVEI B,HX$TUR
CAME C,[SIXBIT /ML/] ; Mathlab has special provisions.
CAIN C,306
JRST LSRHMC
CAMN C,[SIXBIT /MC/] ; Macsyma Consortium has special provisions.
JRST LSRHMC
CAIE C,354
JRST LSRHB9
LSRHMC: CAIN A,"A ; On MC and ML, AI people get special dirs.
MOVEI B,HX$AIL ; Isn't that a nice kludge!
LSRHB9: POP P,C
POP P,A
POPJ P,
;;; LSRHLK - HSNAME table lookup
;;; LSRHTL - Same lookup, but arg B/ HSNAME table index #.
;;; A/ UNAME
;;; B/ <LSR entry addr> or 0 if none.
;;; C/ <site> sixbit name ala SSTATU, 0 for local, else ARPAnet host #.
;;;
;;; Skip returns with HSNAME in B.
;;; If failure (bad args or no table) does not skip.
LSRHLK: PUSHJ P,LSRHTB ; Get table to use in B.
LSRHTL: SETOM HRETRY ; Standard entry point will re-try on failure,
CAIN B,HX$NRM ; unless already asking for "normal" table.
LSRHTX: SETZM HRETRY ; This entry point never retries.
CAIL B, ; Make sure that table index is OK.
CAMLE B,HSNLN1
POPJ P, ; Ugh.
PUSH P,C
PUSH P,D
SKIPL D,HSNPTR ; Get aobjn to HSNAME table
JRST LSRHT9 ; Not mapped in or no table.
CAIN C,0
MOVE C,LMCHNM ; If site 0, use local mach.
LSRHT2: CAME C,HX$MCH(D) ; Compare spec'd site with entry's sitename
CAMN C,HX$HST(D) ; and host #.
JRST LSRHT3 ; Win for either.
ADD D,HSNLN1 ; Add entry length-1
AOBJN D,LSRHT2
JRST LSRHT9 ; Didn't find site.
LSRHT3: ADDI D,(B) ; Add in index to point at right table.
SKIPN D,(D) ; Pluck out rel addr of table to use.
JRST LSRHT9
ADD D,HSNADR ; Make abs.
SKIPL C,(D) ; Get -<# entries>,,<# wds/entry>
JRST LSRHT9
HLL D,C
ADDI D,1 ; Now have aobjn pointing at 1st entry in table.
TLC A,(SETZ) ; For proper ordering must flip sign.
LSRHT5: CAMGE A,HS$UNM(D) ; Compare unames,
JRST LSRHT6 ; and jump out when entry greater (over-run)
ADDI D,-1(C)
AOBJN D,LSRHT5
LSRHT6: TLC A,(SETZ) ; Restore UNAME...
SUBI D,(C) ; Hit entry+1, point back at previous.
MOVE B,HS$HSN(D) ; and that's the HSNAME to use.
AOS -2(P)
SETZM HRETRY ; Won, so no retry of course.
LSRHT9: POP P,D
POP P,C
SKIPN HRETRY ; See if should re-try...
POPJ P, ; Nope, just return.
MOVEI B,HX$NRM ; Yes, re-try for "normal".
JRST LSRHTX
.SCALAR HRETRY ; Switch for re-trying with HX$NRM if HX$TUR (or other) fails.
] ;IFN $$HSNM
IFN $$HSNM,[
; LSRHSN - Find HSNAME for entry, given:
; A/ UNAME of entry
; B/ <LSR entry addr> or 0 if none.
; C/ <site> - as per SSTATU call, or host #, or 0 for local site.
; D/ <channel #> to use for disk opens (if -1, don't use any.)
; Skips if successful, with
; D/ HSNAME
; Uses the following algorithm:
; If no entry address given,
; If directory for that UNAME exists, return that as HSNAME
; Else assume tourist and use tables.
; Else if "Fildir" entry exists, and a valid dir is specified for
; local site, return that.
; Else if directory for that UNAME exists, return that as HSNAME
; Else determine HSNAME using tables, plus touristness.
.SCALAR LSRCHN ; Holds # of temp channel to use.
.SCALAR MNAME ; "Canonical" machname of site specified.
.SCALAR MNAME1 ; "MIT-**" version of machname.
LSRHSN: MOVEM D,LSRCHN
PUSHJ P,MCHFIX ; Canonicalize site arg & set MNAME, MNAME1.
PUSH P,A
PUSH P,B
PUSH P,C
jumpe b,lsrhn1 ; If no entry given, maybe use UNAME, else tables
MOVE D,A ; Save UNAME in D.
PUSHJ P,LSRDRX ; Find & parse FILDIR field.
SKIPA A,D ; Didn't find anything, restore uname.
JRST LSRHN8 ; Aha, found it.
lsrhn1: skipge lsrchn
jrst lsrhn5 ; if channel -1, skip it.
SYSCAL OPEN,[LSRCHN ? MNAME ; See if UNAME has a directory.
[SIXBIT /.FILE./] ? [SIXBIT /(DIR)/] ? A
%CLERR,,D]
JRST LSRHN2 ; Failed.
SYSCAL CLOSE,[LSRCHN]
JFCL
JRST LSRHN8 ; Won, return UNAME as HSNAME.
LSRHN2: CAIE D,%ENSDR ; If error not "no such directory",
JRST LSRHN9 ; then fail.
LSRHN5: PUSHJ P,LSRHLK ; Look up in tables.
JRST LSRHN9
SKIPA D,B ; Return HSNAME in D.
LSRHN8: MOVE D,A
AOS -3(P)
LSRHN9: POP P,C
POP P,B
POP P,A
POPJ P,
; LSRDRX - (internal) Read File-Directory field & scan for dir names.
; B/ <LSR entry addr>
; MNAME/ <site> (must be canonical 6bit)
; Skip returns with A/ <6bit dir name> if finds a spec for given site.
lsrdrx: push p,b
push p,c
push p,d
movei a,lsrtns"i$dir
pushj p,lsrtns"lsritm ; find the FILDIR item in it.
jrst rdirx9 ; none, lose.
move d,a
movei c,100 ;tell 1st 6READ we are not at end of command string.
rdirx2: pushj p,6read ;read a sixbit word into A; terminating char in C.
jrst rdirx9 ; end of item, lose.
caie c,"@ ; does this item apply only on one machine?
cain c,"%
caia
jrst rdirx5 ;No, so try it out
push p,a
pushj p,6read ; read which machine.
jrst rdirx9 ; ran out, lose.
move b,a
pop p,a
came b,mname ;if we aren't on that machine, look at next entry.
camn b,mname1 ; check both forms for the name
rdirx5: cain a,0 ; ignore null names
jrst rdirx2
skipge lsrchn
jrst rdirx8
syscal open,[lsrchn ? mname ; on whatever machine we're hacking
[sixbit /.FILE./] ? [sixbit /(DIR)/] ? A
%clerr,,b] ;and get the error code
jrst [ caie b,%ensdr ; no such directory?
jrst rdirx8 ; No, can't check, so return it.
jrst rdirx2] ; Doesn't exist, try another.
SYSCAL CLOSE,[LSRCHN] ; Won, close & drop thru.
JFCL
rdirx8: aos -3(p) ; won, A has HSNAME.
rdirx9: pop p,d
pop p,c
pop p,b
popj p,
; Read into A a sixbit word, from the ascii b.p. in D.
; The terminating character is left in C.
; No skip => end of command string and word is null.
6read: caige c,40
cpopj: popj p,
setz a,
move b,[440600,,a]
6readl: ildb c,d
cain c,40
jrst 6readl ; spaces are ignored.
cain c,"% ; % is a terminator
jrst mpopj1
caie c,"@ ; @, comma are terminators
cain c,",
jrst mpopj1
cain c,^Q ; let ^Q quote a character.
ildb c,d
caige c,40
jrst mpopj1 ; control chars terminate even if ^Q'd
cail c,140
subi c,40
subi c,40
tlne b,770000
idpb c,b
jrst 6readl
mpopj1: skipe a ;unless this is a null entry
popj1: aos (p)
popj p,
; MCHFIX - canonicalize site argument into MNAME and MNAME1.
; C/ <site> - sixbit or site # or 0 for local.
mchfix: cain c, ; if 0,
move c,lmchnm ; use local name.
push p,d
skipl d,hsnptr
jrst mchfx9
mchfx2: camn c,hx$hst(d) ; see if a host #.
jrst [ move c,hx$mch(d) ; If so, cvt to name.
jrst mchfx3]
add d,hsnln1
aobjn d,mchfx2
mchfx3: movem c,mname
ldb d,[301400,,c] ; right-justify in D
ior d,[sixbit /MIT-/]
tdne c,[77,,777777] ; was orig name 2 chars long?
move d,c ; no, so don't hack mname1.
movem d,mname1
mchfx9: pop p,d
popj p,
] ;IFN $$HSNM
] ;IFE $$DEFS
.END LSRTNS
;;; Local Modes:
;;; Mode:MIDAS
;;; Comment Column:32
;;; compile command: :midas 1 M
;;; End:
Reference in New Issue View Git Blame Copy Permalink