;;; 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 ] ;BC JRST LSRLN5 ;BC (shouldn't happen) JRST LSRLN7 ;BC ;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 ;BC ;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 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 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/ ; 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/ ;;; C/ ;;; 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/ or 0 if none. ;;; C/ 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/ or 0 if none. ; C/ - as per SSTATU call, or host #, or 0 for local site. ; D/ 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/ ; MNAME/ (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/ - 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: