From 947d786951b525a9ad481ed8c8902efdbf0d66d4 Mon Sep 17 00:00:00 2001 From: Eric Swenson Date: Sat, 3 Dec 2016 14:42:37 -0800 Subject: [PATCH] Added LOOKUP to look up INQUIR entries. Added INQUPD to process INQUIR database updates. Added DMUNCH to produce INQUIR;DIRS BIN file. --- README.md | 2 + build/build.tcl | 13 + src/inquir/dmunch.29 | 160 ++++ src/inquir/inqupd.128 | 1827 +++++++++++++++++++++++++++++++++++++++++ src/inquir/lookup.4 | 274 ++++++ 5 files changed, 2276 insertions(+) create mode 100755 src/inquir/dmunch.29 create mode 100644 src/inquir/inqupd.128 create mode 100644 src/inquir/lookup.4 diff --git a/README.md b/README.md index 6888cfff..9a390027 100644 --- a/README.md +++ b/README.md @@ -106,6 +106,8 @@ from scratch. - PWORD, replacement for sys;atsign hactrn that requires registered logins - PANDA, user account management program - SEND, REPLY, replacements for DDT :SEND + - INQUPD, processes INQUIR change requests + - LOOKUP, looks up user info in INQUIR database 6. A brand new host table is built from the host table source and installed into SYSBIN; HOSTS3 > using H3MAKE. diff --git a/build/build.tcl b/build/build.tcl index 2cc5679b..66a0b147 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -585,6 +585,19 @@ respond "*" ":lisp inquir;inquir (dump)\r" respond "*" ":link inquir;ts inquir,inquir;inqbin >\r" respond "*" ":link sys;ts inquir,inquir;ts inquir\r" +respond "*" ":midas inquir;dirs bin_inquir;dmunch\r" +expect ":KILL" + +respond "*" ":midas inquir;inqupd bin_inquir;inqupd\r" +expect ":KILL" + +respond "*" ":link inquir;lsrtns 1,syseng;lsrtns >\r" + +respond "*" ":midas inquir;ts lookup_inquir;lookup\r" +expect ":KILL" + +respond "*" ":link sys1;ts lookup,inquir;ts lookup\r" + # pword/panda respond "*" ":midas sysbin;pword bin_sysen1;pword\r" respond "Is this to be a PANDA?" "yes\r" diff --git a/src/inquir/dmunch.29 b/src/inquir/dmunch.29 new file mode 100755 index 00000000..54de6cfe --- /dev/null +++ b/src/inquir/dmunch.29 @@ -0,0 +1,160 @@ +; -*- Midas -*- +; +; To create new binary file after munging text definitions (see +; last 2 pages of this file) just assemble into desired filename. +; e.g. :MIDAS INQUIR;DIRS BIN_DMUNCH + +ife .fnam1-.ifnm1,[ ; Conditional true if file not being .INSRT'd. +title DMUNCH +.decsav ; to avoid cretinous sblk loader etc. +nosyms +insrtd==0 +] +.else [ +.begin hsname +insrtd==1 +] + +comment | + +HSNAME TABLE: + 0: -<# entries>,,# wds/entry + 1-n: MACH entries + +================================================================= +Sub-tables + + mach wd 0: ; 6bit returned by SSTATU + mach wd 1: ; Arpanet site #. + mach wd 2: ; Addr is rel to start of HSNAME-table. + mach wd 3: + +Each sub-table is simply: + 0: -<# entries>,,# wds per entry ; RH is currently 2. + 1-n: NAME entries + + entry wd 0: UNAME ; For all unames => this but < next entry, + entry wd 1: HSNAME ; this is the HSNAME. + +| + + ; HSNAME table indices +hx$mch==:0 ; wd 0 of mach-table entry is mach name, as per SSTATU call. +hx$hst==:1 ; wd 1 is arpanet host #. +hx$nrm==:2 ; wd 2 is sub-table ptr for normal unames. +hx$tur==:3 ; wd 3 is sub-table ptr for tourists. +hx$ail==:4 +hx$len==:5 ; # wds per mach-table entry + + ; Sub-table indices +hs$unm==:0 ; wd 0 of sub-table entry is UNAME +hs$hsn==:1 ; wd 1 is HSNAME for range. +hs$len==:2 ; # wds per sub-table entry + + +ife insrtd,[ + +if2 word -<%nmach>,,hx$len +%loc==1 +%nmach==0 + +define mach abr,mname,host,list +%sav==%loc +word sixbit /mname/ ; store name of mach +word host ; and site # +%loc==%loc+2 +irp d,,[0,1,2,3,4,5,6] ; then various args for mach. + ifle -d, .istop + ifdef s%!d!!abr, word s%!d!!abr + .else word 0 + %loc==%loc+1 + termin +%sav==hx$len-<%loc-%sav> +ifg %sav, repeat %sav,[ word 0 ? %loc==%loc+1 ? ] +%nmach==%nmach+1 +termin + +define subtab abr,idx,list +s%!idx!abr==%loc ; note loc of subtable +word -,,hs$len ; set <# entries>,,<# wds per entry> +%loc==%loc+1 +%ecnt==0 +irp pair,,[list] + irp uname,hsname,[pair] + ife %ecnt,[ifnb [uname][ ; Make sure 1st entry has zero uname. + word setz + word sixbit |hsname| + %ecnt==%ecnt+1 + %loc==%loc+hs$len + ]] + word #setz + word sixbit |hsname| + %ecnt==%ecnt+1 + %loc==%loc+hs$len + .istop + termin + termin +c%!idx!abr==%ecnt ; set # entries. +termin + +] ; ife insrtd, + + +; MACHINE definitions - Syntax is +; MACH ,,, +; where must be 3 letters or less, and must be what +; a SSTATU call returns, and is the arpanet site #. + +MACH AI,AI,206,[[3,USERS1]] +MACH MC,MC,354,[[4,USERS1],[3,GUEST1]] +MACH MX,MX,-1,[[4,USERS1],[3,GUEST1]] +MACH MD,MD,-1,[[2,USERS1]] +MACH ML,ML,-1,[[3,USERS1]] +;MACH ML,ML,306,[[3,USERS1]] +;MACH DM,DM,106,[[2,USERS1]] + +;;; This is not the most flexible kludge in the world. +;;; Users are divided into directory groups, each of which has a subtable. +;;; #0 is for normal users (who don't have their own dir). +;;; #1 is for tourists. +;;; #2 is defined on MC and ML for AI lab users. +;;; +;;; User group mapping information is procedurally embedded in the LSRTNS"LSRSNN routine. + +; DIRECTORY SUBTABLE definitions - syntax is: +; SUBTAB ,, +; is one of those defined by MACH, +;
is 0 for normal, 1 for tourist. +; is a list of paired names; the first +; name is the start of a UNAME range extending up to +; but not including the next pair, and the second +; name is the HSNAME for that range. +; NOTE: the first name of the first pair should be null. +; e.g. +; SUBTAB AI,0,[[,GUEST0],[K,GUEST1],[P,GUEST2]] +; which defines the "normal" (0) subtable for AI to have 3 directories, +; GUEST0 for UNAMES from null to "L_____" inclusive, +; GUEST1 for UNAMES from "K" to "O_____" inclusive, and +; GUEST2 for UNAMES from "P" to "______" inclusive. +; + +SUBTAB AI,0,[[,USERS1],[GS,USERS2],[MP,USERS3]] + +SUBTAB MC,0,[[,USERS0],[DA,USERS1],[F,USERS2],[J,USERS3],[JO,USERS4],[KJ,USERS5],[NR,USERS6],[R,USERS7],[RL,USERS8],[SR,USERS9]] +SUBTAB MC,1,[[,GUEST0],[D,GUEST1],[I,GUEST2],[LJ,GUEST3],[PD,GUEST4],[T,GUEST5]] +SUBTAB MC,2,[[,AI0]] + +SUBTAB MX,0,[[,USERS0],[DA,USERS1],[F,USERS2],[J,USERS3],[JO,USERS4],[KJ,USERS5],[NR,USERS6],[R,USERS7],[RL,USERS8],[SR,USERS9]] +SUBTAB MX,1,[[,GUEST0],[D,GUEST1],[I,GUEST2],[LJ,GUEST3],[PD,GUEST4],[T,GUEST5]] +SUBTAB MX,2,[[,AI0]] + +SUBTAB MD,0,[[,USERS1],[KK,USERS2]] + +SUBTAB ML,0,[[,USERS1],[GS,USERS2],[MP,USERS3]] +SUBTAB ML,2,[[,AIRAN]] + +;SUBTAB DM,0,[[,USERS1],[KK,USERS2]] + + +ifn insrtd, .end hsname +ife insrtd, end diff --git a/src/inquir/inqupd.128 b/src/inquir/inqupd.128 new file mode 100644 index 00000000..b218a496 --- /dev/null +++ b/src/inquir/inqupd.128 @@ -0,0 +1,1827 @@ +;-*- Mode: midas -*- +.QMTCH==1 + +VERSION==.FNAM2 + +TITLE INQUIRE UPDATE DEAMON + ;CStacy, 4/1/83 + +COMMENT | + INQUPD documentation. + +The INQUPD deamon is the only process which should update the LSR1 +database. It is usually started by COMSAT, when the user interface +process (:INQUIR) writes an update request addressed to UPDATE-INQUIR. + +INQUPD maps in the entire LSR1 database, slurps in the the update +request files, updates the database as specified, and writes out the +new version. We keep three old LSR1 versions under other names, in +case we want them back for some reason. + +An update request file must be written by :INQUIR for each host where +the entry will be updated. An update request file can contain more +than one update request. + +The update request file (from INQUIR;.UPD1. >) is parsed into its +component "items", which are identified by their names, and the the +items are read into slots. These slots form the data for the new +database entry. + +Items are indicated by their item-name, a colon, a tab, and the value +of the item. Only the first 5 chars of the item name matter. Lines +which begin with only a tab are continuations of the previous item. + +The very first item, which needs no value, is called BEGIN. +Everything until the "BEGIN:" is ignored. After all the items comes +"END:". + +The SUNAME item says which LSR1 entry to modify. +This is the only requisite field. + +The old entry for the indicated SUNAME is read in, and the items +from the update request file are merged into it. The new items +have precdence; only items specifically mentioned in the request +are changed. Items which we never heard of, we simply ignore. + +If the UNAME is null, SUNAME's entry is deleted. If the UNAME differs +from the SUNAME, SUNAME is changing his name to UNAME. That is, +SUNAME's entry is deleted and a new ENTRY is created for UNAME. + +The NETAD field can currently be any string. In the future, it will +have to be a fully qualified RFC822 format address. + + +COPY mode is useful for changing the format of the database, and +must be run under a DDT, preferably in DEBUG mode. +The program loops down all the entries in the database, filling in the +update item slots. Then the entries are canonicalized to the new +format. The rest of the procedure is as usual: the entry is updated +in the core LSR1, and the new database is written out. + +Database installation procedures are a little different for COPY mode +operation. We use "LSR1 1" as the constant database, and we write out +a file called "NEWLSR 1". When the entire database is copied, the +program pauses. If proceeded, NEWLSR will be installed. + +The LSR1 lock is held until the copied database is installed, so that +no INQUPD jobs can run and change the database out from under us. The +usual installation procedure is not followed when in COPY mode. + +INQPAT mode is useful for hand-patching the database. In this +mode, we simply lock and load LSR1, and allow the user to call +routines (such as LOOKUP, DELETE, and DONE) from DDT. + +| + + + +SUBTTL Basic Definitions + +;;; Registers. + +X=0 ;Super temporary register. +A=1 ;General +B=2 ; purpose +C=3 ; utility +D=4 +E=5 +F=6 ;Flag register. +T=7 ;Temporary. +TT=10 ;Temporary, T+1. +CHAR=11 ;Character being manipulated. +BP=12 ;Byte pointer. + +I==12 ;Synonyms used +J==13 ;for sorting +K==14 ;routines. +L==15 +R==16 + +P=17 ;Stack pointer. + + +;;; I/O Channels + +LOCKC=14 ;Locking channel. +DSKI=15 ;Disk input channel. +DSKO=16 ;Disk output channel. + +;;; LH Flags + +%COPY==1 ;We are a COPY program. +%RETRY==2 ;We are retrying a failed operation. +%PATCH==3 ;We are manually patching the database. +%MPVOK==4 ;MPVs should create core. +%MUNG==10 ;In-core database has been modified. + + +;;; Basic Macros +.INSRT KSC;MACROS > + +;;; Sleeping. +DEFINE SLEEP SECS + MOVEI T,30.*SECS + SKIPN DEBUG + .SLEEP T, +TERMIN + +;;; Decrement Ascii Bp +DEFINE D7BPT AC + ADD AC,[70000,,] + SKIPGE AC + SUB AC,[430000,,1] +TERMIN + + +;;; Uppercase character +DEFINE UPPER AC + CAIL AC,141 + CAILE AC,172 + CAIA + SUBI AC,40 +TERMIN + +;;; Decrement 7-bit byte pointer. +DEFINE DBP7 AC + ADD AC,[70000,,] + SKIPGE AC + SUB AC,[430000,,1] +TERMIN + + +;;; Simple error macro for now. +DEFINE ERROR &MSG + .VALUE [ASCIZ /:MSG /] +TERMIN + + +;;; Definitions for LSR1 database. + +$$DEFS==1 +.INSRT SYSENG;LSRTNS > + +LSRVER==1 ;LSR1 database format version. + + +SUBTTL Filenames + +;;; Locking file. + +LOCKFL: SIXBIT /DSK/ + SIXBIT /LSR1/ + SIXBIT /LOCK/ + SIXBIT /INQUIR/ + + +;;; File for notifying COMSAT of LSR1. + +SATFL: SIXBIT /DSK/ + SIXBIT / FROM/ + SIXBIT /INQUIR/ + SIXBIT /.MAIL./ + + +;;; The HSNAME database. + +HSNFIL: SIXBIT /DSK/ + SIXBIT /DIRS/ + SIXBIT /BIN/ + SIXBIT /INQUIR/ + + +;;; The installed LSR1 database. + +LSR1: SIXBIT /DSK/ + SIXBIT /LSR1/ + SIXBIT /1/ + SIXBIT /INQUIR/ + +;;; The provisionally installed LSR1 database. + +LSR2: SIXBIT /DSK/ + SIXBIT /NLSR1/ + SIXBIT /1/ + SIXBIT /INQUIR/ + +;;; Old and Ancient versions of the database. + +OLD: SIXBIT /DSK/ + SIXBIT /LSR1/ + SIXBIT /OLD/ + SIXBIT /INQUIR/ + +OOLD: SIXBIT /DSK/ + SIXBIT /LSR1/ + SIXBIT /OLDOLD/ + SIXBIT /INQUIR/ + + +;;; Crash dump file. + +CRASHF: SIXBIT /DSK/ + SIXBIT /INQUPD/ + SIXBIT />/ + SIXBIT /CRASH/ + + +;;; Update request file. + +UPDFL: SIXBIT /DSK/ + SIXBIT /.UPD1./ + SIXBIT />/ + SIXBIT /INQUIR/ + +;;; Old update request file. + +OUPDFL: SIXBIT /DSK/ + SIXBIT /.UPD1$/ + SIXBIT />/ + SIXBIT /INQUIR/ + +;;; Losing update request file. + +LOSSF: SIXBIT /DSK/ + SIXBIT /LOSS/ + SIXBIT />/ + SIXBIT /INQUIR/ + + + + +SUBTTL Error handler + +;;; Fatal error handler to JSR to when something bad happens. + +SYSLOS:: +AUTPSY: 0 ;Fatal errors JSR here. + SKIPE DEBUG + .VALUE [ASCIZ /:Autopsy required/] + MOVEM 0,LOSEAC ;Remember all ACs. + MOVE 0,[1,,LOSEAC+1] + BLT 0,LOSEAC+17 ;BLT them to a safe place. + .SUSET [.RBCHN,,LOSBCH] ;Remember losing channel. + .SUSET [.RPICL,,LOSPCL] ;Remember interrupts. + .SUSET [.SPICL,,[-1]] ;Arm interrupts, in case get disk full. + SYSCAL STATUS,[ LOSBCH ? %CLOUT,,LOSSTS] ;Remember losing status. + NOP + .CLOSE DSKO, + MOVEI A,CRASHF ;Try opening the crash file. + SYSCAL OPEN,[%CLBIT,,.UIO ? %CLIMM,,DSKO ? 0(A) ? 1(A) ? 2(A) ? 3(A)] + JRST DIE ; Just die if we cannot. + .RDATE A, ;Read date and time, + .RTIME B, ;for posterity. + MOVE C,LENGTH + MOVEI C,DATA(C) ;We want to dump all our core. + MOVE D,[444400,,0] + SYSCAL SIOT,[%CLIMM,,DSKO ? D ? C] ;Dump our pages to disk. + .LOSE %LSFIL + .CLOSE DSKO, + JRST DIE + + +SUBTTL Interrupt Handler and stuff + + +POPJ1: AOS (P) ;Skip +CPOPJ: POPJ P, ;Return + + +;;; Old style, winning-PC interrupt handler. + +TMPLOC 42,{TSINT} + +TSINT: 0 ;Interrupt word stored here. +TSIPC: 0 ;Valid PC stored here. + PUSHAE P,[A,B] ;Save accumulators. + MOVE A,TSINT ;What's the meaning of this interruption?? + CAIN A,%PIMPV ;Was it an MPV? + JRST MPVINT ; Yes. + CAIN A,%PIIOC ;Was it an IOC error? + JRST IOCINT ; Yes. + JSR AUTPSY ;Hmmm. Nothing we know how to handle. + +DISMIS: POPAE P,[B,A] ;All handlers should come here to dismiss. + .DISMIS TSIPC + +IOCINT::.SUSET [.RBCHN,,A] ;See which channel is erring. + CAIE A,DSKO ;If it is not the disk output channel + JSR AUTPSY ; we are in trouble. + SYSCAL STATUS,[A ? %CLOUT,,B] + JSR AUTPSY + LDB A,[330500,,B] ;Get the error code. + CAIN A,11 ;Maybe just out of disk space. + JRST [ SLEEP 60. ; Hopefully a temporary situation. + JRST DISMIS ] +; CAIN A,14 ;Is our directory full? + JSR AUTPSY ; Someday figure out how to handle such. + + +MPVINT: TLNN F,%MPVOK ;If not OK for MPVs to happen npw + JSR AUTPSY ; die. + .SUSET [.RMPVA,,A] ;Get address which caused the MPV. + CAIL A,MPVOKB ;See if in the range of legal MPVs. + CAIL A,MPVOKE + JSR AUTPSY ;If not in range, die. + LSH A,-10. ;Else round up address to page. +MPVMAK: SYSCAL CORBLK,[ %CLIMM,,%CBNDR+%CBNDW + %CLIMM,,%JSELF + A ;Create one new page in our space. + %CLIMM,,%JSNEW] + JRST [ SLEEP 60. ; If failed to get core. + JRST MPVMAK ] ; Sleep for a minute and retry. + JRST DISMIS ;When we have created more core, dismiss. + + +SUBTTL Main Program + +GO: MOVE P,[-PDLLEN,,PDL] ;Init the stack. + .SUSET [.RJNAME,,A] ;Find our job name. + CAMN A,[SIXBIT /INQCPY/] ;If we are in COPY mode + TLO F,%COPY ; remember that. + CAMN A,[SIXBIT /INQPAT/] ;If we are in PATch mode. + TLO F,%PATCH ; remember that. + .SUSET [.ROPTIO,,A] ;Find our job options. + TLNN F,%PATCH ;If are are patching the database + TLNE F,%COPY + JRST [ TLNN A,%OPDDT ; Make sure a human is around. + ERROR "Must run with human supervision." + JRST .+1] + TLO A,%OPOPC + .SUSET [.SOPTIO,,A] ;Set winning interrupt-PC option. + .SUSET [.SMASK,, [%PIPDL+%PIIOC+%PIMPV]] ;Arm interrupts. + CALL LOCK ;Try to lock the LSR1 database. + JRST DONE ; If already locked, commit suicide. + CALL MAPIN ;Map all database entries into core. + ERROR "Unable to map LSR1 database." + SETZM COUNT ;Count of entries is zero based. + TLNE F,%PATCH + ERROR "LSR1 loaded and locked. You may call LOOKUP, DELETE, and DONE." + TLNE F,%COPY ;If copying the database + JRST LOOP ; avoid chewing on update files. + +;;; Rename any .UPD1$ files to .UPD1. files. +;;; .UPD1$ files must be .UPD1. files which had been processed by an +;;; earlier INQUPD which hadn't written out LSR1 > yet so they need +;;; to be processed again. Note that it does no harm to process an +;;; update twice. + +GETOUP: MOVEI A,OUPDFL ;Rename old requests + MOVEI B,UPDFL ;to new requests. + SYSCAL RENAME,[ 0(A) ? 1(A) ? 2(A) ? 3(A) ? 1(B) ? 2(B) ] + JRST LOOP ;When all renamed, we can get to work! + JRST GETOUP ;Else rename the rest of them. + +;;; Loop through all the update requests and process them, changing +;;; the in-core database. When there are no more updates, write +;;; out and install the database. + +LOOP: SETZM TOOBIG ;Say nothing was truncated yet. + CALL GETUPD ;Try to read in an update. + JRST DONE0 + MOVE A,%SUNAM ;SUNAME says which entry to update. + MOVE B,%SUNAM+1 + CALL LOOKUP ;Look up entry in LSR1 + JRST LOOP1 ; If not there, this is a new entry. + MOVE D,WHERE ;Get address of entry. + CALL DELETE ;Delete old entry. + ERROR "Cant delete old entry." +LOOP1: SKIPN $UNAME + SKIPE $UNAME+1 ;If UNAME in request file slots is null + CAIA ; we are simply deleting an entry. + JRST LOOP9 + CAMN A,%UNAME ;See if the SUNAME and UNAME differ. + CAME B,%UNAME+1 + JRST [ MOVE A,%UNAME ;They do - need to delete UNAME's + MOVE B,%UNAME+1 ;entry before we insert under there. + CALL LOOKUP + JRST LOOP2 + MOVE D,WHERE + CALL DELETE + ERROR "Cant delete new entry." + JRST LOOP2 ] +LOOP2: MOVE D,WHERE ;Get address where entry should go. + CALL INSERT ;Insert new entry. + ERROR "Cant insert entry." +LOOP9: AOS COUNT ;Keep count of processed entries. + SKIPE TOOBIG ;If we had to truncate something + CALL WARNER ; be sure to tell him about it. + JRST LOOP ;Go process another update. + + +;;; Bug fix: Make sure that last entry in DATA area is followed by +;;; and end-of-data sentinel (-1). If the last DATA area entry is +;;; deleted and replaced, the DELETE/INSERT logic does not guarantee +;;; that this is the case. -- EJS +DONE0: MOVE A,LENGTH ;get length of DATA area + MOVEI B,-1 ;end-of-data area sentinel + MOVEM B,DATA-1(A) ;store end-of-data sentinel + +DONE: TLNN F,%MUNG ;If no modification + JRST DONE3 ; don't write out out anything. + TLNE F,%COPY ;If COPYing + JRST [ MOVE A,WHERE ; cons up "final" entry. + ADDI A,1 + SUBI A,DATA + MOVEM A,LENGTH + JRST .+1 ] + CALL CHECK + ERROR "Data bashed." ;Make sure LSR1 looks Ok. + CALL MAKTAB ;Create LSR1 tables. + ERROR "Cant create tables." +DONE1: +; CALL INSTAL ;Make files consistant + NOP ;in case previous deamon left a mess. +DONE2: CALL WRITE ;Write out the new database files. + ERROR "Error writing database." + CALL INSTAL ;Install it. + NOP + MOVEI A,SATFL ;Tell COMSAT there is a new LSR1 file. + SYSCAL OPEN,[%CLBIT,,.BIO ? %CLIMM,,DSKO ? 0(A) ? 1(A) ? 2(A) ? 3(A)] + NOP + .CLOSE DSKO, +DONE3: TLNE F,%COPY ;Unless we are an INQCPY + JRST DONE5 ;We will delete all the old update + MOVEI A,OUPDFL ;request files. +DONE4: SYSCAL DELETE,[0(A) ? 1(A) ? 2(A) ? 3(A)] + CAIA + JRST DONE4 +DONE5: .CLOSE LOCKC, ;Relinquish lock on database. + SKIPE DEBUG ;If being debugged + .VALUE [ASCIZ /:Done./] ; pause. + SYSCAL STDMST,[ [SIXBIT /INQUPD/] ? [-1] ? 0] + NOP +DIE: .LOGOUT 1, ;Log out. + + + +SUBTTL Lock the database + +;;; Only one process should ever update the LSR1 database at a time. +;;; This routine attempts to seize the database lock, which is implemented +;;; as a file. If the lock cannot be seized because it is missing, it +;;; is re-created. +;;; +;;; Skip returns if the lock is seized. +;;; Non-skip probably means some other process has the lock. + +LOCK: MOVEI A,LOCKFL + SYSCAL OPEN,[%CLBIT,,100007 ? %CLIMM,,LOCKC ? 0(A) ? 1(A) ? 2(A) ? 3(A)] + JRST LOCK1 + JRST POPJ1 ;Database locked. + +;;; Trouble locking the database. + +LOCK1: .STATUS LOCKC,A ;See why open failed. + LDB A,[220600,,A] ;Get error code. + CAIN A,%ENAFL ;If someone else has the lock + RET ; Take failure return. + CAIE A,%ENSFL ;Maybe lock file is missing. + JSR AUTPSY ; Eh? + MOVEI A,LOCKFL ;Lock file is missing + SYSCAL RENAME,[ 0(A) ? 1(A) ? ;Maybe ITS had crashed + [SIXBIT /LOCK !/] ;and left this crufty lossage + 3(A) + 1(A) ? 2(A) ] ;instead of this? + JRST LOCK2 ; Nope... + JRST LOCK ;Renaming won - try locking now. + +LOCK2: .STATUS A ;See why renaming did not work. + LDB A,[220600,,A] ;Get error code. + CAIE A,%ENSFL ;Is lock file really gone? + JSR AUTPSY ; Nope, it's hopeless. + MOVEI A,LOCKFL + SYSCAL OPEN,[%CLBIT,,.UAO ? %CLIMM,,LOCKC ? 0(A) ? 1(A) ? 2(A) ? 3(A)] + JSR AUTPSY ; Fail miserably if unable to create lock. + .CLOSE LOCKC, ;Lock file re-created now. + JRST LOCK ;Try to seize it. + + +SUBTTL Map in database + +;;; Map the entire LSR1 file at DATA using DSKI, and close it. + +MAPIN: PUSHAE P,[A,B,BP] + .CORE DATA/2000 ;Flush core where LSR1 entries mapped. + JSR AUTPSY + SETZM LENGTH + MOVEI A,LSR1 ;Open the database file. + SYSCAL OPEN,[%CLBIT,,.UII ? %CLIMM,,DSKI + 0(A) ? 1(A) ? 2(A) ? 3(A)] + JSR AUTPSY + MOVEI A,LSRTNS"HDRLEN ;Read in the database header, so we + MOVE BP,[444400,,HEADER] ;can find out where entries begin. + SYSCAL SIOT,[%CLIMM,,DSKI ? BP ? A] + JSR AUTPSY + MOVE B,HEADER+LSRTNS"HDRDTA + TRNE B,1777 ;DATA should start on page boundry. + JSR AUTPSY + SYSCAL FILLEN,[%CLIMM,,DSKI ? %CLOUT,,A] + JSR AUTPSY + SUB A,B ;We dont want Areas before DATA. + LSH B,-10. ;Get # of 1st page to map. + MOVEM A,LENGTH ;Remember the DATA length. + ADDI A,1777 ;Round up a page. + LSH A,-10. ;Convert words to pages. + MOVNS A ;Make into AOBJN pointer. + HRLZS A + HRRI A,DATA/2000 ;A gets AOBJN to pages to map file into. + SYSCAL CORBLK,[ %CLIMM,,%CBNDW+%CBCPY ? %CLIMM,,%JSELF ? A + %CLIMM,,DSKI + B] ;Try to map in the DATA Area pages. + JRST [ TLNE F,%RETRY ; If failed twice + JRST CPOPJ ; give up. + TLO F,%RETRY ; Else say we are trying again. + SLEEP 60. ; Wait a minute. + JRST MAPIN ] ; And try again. + TLZ F,%RETRY ;Success. + .CLOSE DSKI, ;Close up. +GETHSN: MOVEI A,HSNFIL ;Now to read the HSNAME table. + SYSCAL OPEN,[%CLBIT,,.UII ? %CLIMM,,DSKI ? 0(A) ? 1(A) ? 2(A) ? 3(A)] + JSR AUTPSY ; Glorp! The HSNAME table is missing! + SYSCAL FILLEN,[%CLIMM,,DSKI ? %CLOUT,,A] + JSR AUTPSY + CAIL A,HBFLEN ;If the HSNAME stuff doesn't fit + JSR AUTPSY ; lose. + MOVEM A,HFILEN ;Remember how long the file is. + MOVE BP,[444400,,HBUF] + SYSCAL SIOT,[%CLIMM,,DSKI ? BP ? A] + JSR AUTPSY + HLRES A ;Find remaining cnt if any. + ADDM A,HFILEN ;Adjust for # wds actually read. + .CLOSE DSKI, ;All done with HSNAME file. + POPAE P,[BP,B,A] + JRST POPJ1 + + + + +SUBTTL Get update + +;;; Read an update and fill in the slots. +;;; Process (or finish processing) an update request file. +;;; For COPY mode, use an entry from the database instead of a request. +;;; Does not skip if there is no update to process. + + +GETUPD: SETZM %SUNAM ;Clear out the regular slots. + MOVE T,[%SUNAM,,%SUNAM+1] + BLT T,ITEMND ;Zap! + + TLNE F,%COPY ;If we are copying + PJRST GETOLD ;Form update from database entry. + + PUSHAE P,[A,B,C,D,BP] ;Normal update from request file. + SKIPE SAVEBP ;If already have request in buffer + JRST GETUP2 ; continue processing. +GETUP1: MOVEI A,UPDFL ;Else look for another update request file. + SYSCAL OPEN,[%CLBIT,,.UAI ? %CLIMM,,DSKI + 0(A) ? 1(A) ? [SIXBIT / + SYSCAL FILLEN,[%CLIMM,,DSKI ? %CLOUT,,A] + JSR AUTPSY + CAIL A,RQLEN*5 ;File is open in .UAI mode. + ERROR "Update request was too big!" + MOVE BP,[440700,,REQBUF] + SYSCAL SIOT,[%CLIMM,,DSKI ? BP ? A] ;Slurp. + JSR AUTPSY + .CLOSE DSKI, + MOVE BP,[440700,,REQBUF] ;Make a Bp to the buffer. + SETZM SAVEBP ;Flush multiple-update Bp. + SKIPN REQBUF ;Going to parse item names and + JSR UPDLOS + +INAT1: SETOM INHEDR ;First, we skip over the header. + SETZM GOTUNM ;Say we have not yet seen his (new) UNAME. + SETZM NEWINQ ;We don't think this is new style (yet). +INAT2: SETZ B, ;B gets name of an item from file. + MOVE C,[440700,,B] ;Make a Bp to it. +INAT3: ILDB CHAR,BP ;Get char from the file. + CAIG CHAR,40 ;Check for control characters. + JRST [ JUMPLE CHAR,INATND ;If eof, see if have got header yet. + CAIE CHAR,^_ ; Check also if this is ^_ + CAIN CHAR,^C ; Or maybe ^C. + JRST INATND + CAIE CHAR,40 ; If this is a space + CAIN CHAR,^I ; Or TAB + JRST INAT3 ; Ignore it. + CAIE CHAR,^M ; If CR + CAIN CHAR,^J ; Or LF + JRST INAT2 ; Flush any accumulated label, ignore. + JSR UPDLOS] ;Otherwise, its a bad random control char. + CAIN CHAR,":" ;If this is seperator + JRST INAT4 ;Go look at its name. + TLNE C,760000 + IDPB CHAR,C + JRST INAT3 + +;;; Gobble down and ignore the header. + +INAT4: SKIPN INHEDR ;Are we still looking for the header? + JRST INAT6 ; No, process this normally. + CAMN B,[ASCII /BEGIN/] ;Is this is the BEGIN item name + SETZM INHEDR ; we have gotten past the header. +INAT5: ILDB CHAR,BP ;Get a char. + CAIN CHAR,0 ;Not expecting EOF yet! + JSR UPDLOS ; update-request must be bad. + CAIE CHAR,^J ;If this is not a newline + JRST INAT5 ; go gobble chars. + JRST INAT2 ;After the newline comes another item. + +;;; Figure out which slot the named item in B goes into. + +INAT6: CAMN B,[ASCII /UNAME/] ;Is this the (maybe) new UNAME? + SETOM GOTUNM ;Yeah, remember we saw it + CAME B,[ASCII /UNAME/] ;If it's either the UNAME + CAMN B,[ASCII /SUNAM/] ;or the SUNAME + JRST [MOVE X,BP ;Peek ahead one character + ILDB CHAR,X ;for DWIM purposes. + CAIE CHAR,^I ;Old format insists on tab as next char + SETOM NEWINQ ;so anything else means new format. + JRST INAT7 ] ;Somehow I don't think this is an END: line + CAME B,[ASCII /END/] ;Is this is the terminating item? + JRST INAT7 ; No - keep gobbling. + +;;; Now we have read the "END" item, we are done reading in a request. +;;; Now check to see if there seems to be another request in the +;;; same update request file buffer. + + SKIPN GOTUNM ;Did we see a UNAME field? + JRST [ MOVE X,$SUNAM ; No - he forgot it. + MOVEM X,$UNAME ; Pretend it is the same as the SUNAME. + MOVE X,$SUNAM+1 + MOVEM X,$UNAME+1 + SETOM ATMUNG+1 ;Remember that we saw this item! + JRST .+1 ] + MOVE X,BP ;Let's look at any data to come. + ILDB CHAR,X ;Maybe a CR. + ILDB CHAR,X ;Maybe a LF. + ILDB CHAR,X ;A ^_ often ends the file buffer. + JUMPLE CHAR,INAT8 ;Check for EOF too! + CAILE CHAR,40 ;If we have a printing character + MOVEM BP,SAVEBP ; there probably are more updates. + JRST INAT8 ;OK, all done hacking this request. + +INAT7: LDB X,[172500,,B] ;Check for silly synonyms + MOVE D,["MIT"] ;for this value + CAME X,["WOR"] ;(because the rest of the world + CAMN X,["WRK"] ; doesn't have MIT address or phone!) + DPB D,[172500,,B] ;Was a synonym, zap it to old name. + SKIPE NEWINQ ;Skip tab check if new format. + JRST INAT7A + ILDB CHAR,BP ;Process current item (named in B). + CAIE CHAR,^I ;There had better be a tab + JSR UPDLOS ; after the item name. +INAT7A: MOVSI D,-NAITEM ;Loop through all the items. + CAME B,ATEMN(D) ;Is this the item? + AOBJN D,.-1 ; Nope, keep looking. + JUMPL D,INAFIL ;We found the item - go slurp it. +INAFLS: ILDB CHAR,BP ;Else gobble and ignore an item. + JUMPLE CHAR,INATND ;Handle EOF + CAIE CHAR,^J ;EOL? + JRST INAFLS ;nope, next char. + MOVE X,BP ;Save BP in case we want to back up. + SKIPE NEWINQ ;New format update message? + JRST INAFL1 ;yep, handle differently + ILDB CHAR,X ;Old format, get first char of next line + CAIE CHAR,^I ;TAB? + JRST INAT2 ;no, new item + JRST INAFLS ;yes, continuation line, so skip it too. +INAFL1: ILDB CHAR,X ;New format, get a char. + CAIN CHAR,":" ;New style continuation line? + JRST INAFLS ;yep, so skip this line too. + CAIE CHAR,40 ;Ignore whitespace. + CAIN CHAR,^I + JRST INAFL1 + CAIN CHAR,^J ;EOL? + SKIPA BP,X ;yeah, so that's one line gone for good. + CAIN CHAR,^M ;Totally blank lines are whitespace too. + JRST INAFL1 + JRST INAT2 ;Anything else is begining of new field. + +;;; Read the value of the item whose name is in B and number in D. + +INAFIL: SETOM ATMUNG(D) ;Remember that we saw this item! + MOVE B,ATEMS(D) ;Get Bp to the item's value slot. + HRLI B,440700 + MOVE T,ITEML(D) ;Get length of this slot. + IMULI T,5. ;Convert to chars. +CPYLIN: ILDB CHAR,BP ;Copy rest of the line into the slot. + SOJE T,[ SKIPN TOOBIG + HRRM D,TOOBIG ; If item overflows slot, + DBP7 B ; remember we lost, and back up and + DPB CHAR,B ; bash the last char to zero + JRST INAFLS ] ; and flush the rest of the item. + CAIN CHAR,^C ;^Cs pad the request file. + JSR UPDLOS ; But we are not expecting EOF yet. + CAIN CHAR,0 ; ^@s are the same as ^Cs. + JSR UPDLOS + IDPB CHAR,B ;Copy a character. + CAIE CHAR,^J ;EOL? + JRST CPYLIN ;no, next char. + MOVE E,BP ;May have to back out of this.... + SKIPE NEWINQ ;New format update message? + JRST INAFI2 ;yep, handle differently. + ILDB CHAR,BP ;See if next line starts + CAIN CHAR,^I ;With a TAB? + JRST CPYLIN ; Then drop the TAB on the floor. +INAFI1: SETZ CHAR, ;Nope, line copy is complete. + DPB CHAR,B ;Bash ^J to a zero, + DBP7 B ;back up + DPB CHAR,B ;and bash the ^M to a zero. + MOVE BP,E ;UNTYI the start of the new line. + JRST INAT2 ;Go back for another item. +INAFI2: ILDB CHAR,BP ;New format, get a char. + CAIN CHAR,":" ;New style continuation line? + JRST CPYLIN ;yep, go snarf some more text. + CAIE CHAR,40 ;Ignore whitespace. + CAIN CHAR,^I + JRST INAFI2 + CAIN CHAR,^J ;EOL? + SKIPA E,BP ;Yep, that was a totally useless line. + CAIN CHAR,^M ;Ignore blank lines too. + JRST INAFI2 + JRST INAFI1 ;Line copy is complete, handle it. + +;;; Come here when we think we are done reading. + +INATND: SKIPN INHEDR ;Here when EOF. + JSR UPDLOS ; Barf if we have not seen data yet. +INAT8: MOVE A,[ASCII /_____/] ;We know we have data in the slots. + MOVE B,[ASCII /_/] ;Make sure we are not trying to + CAME A,%SUNAM ;mung the magic final "______" + JRST INAT9 ;entry in the database. + CAME B,%SUNAM+1 + JRST INAT9 + CAMN A,%UNAME ;Else check to make sure UNAME + CAME B,%UNAME+1 ;is not changing. + CAIA + JSR UPDLOS ;Throw away if offensive. +INAT9: JRST POPJ1 + + +;;; JSR Here to throw away losingly formatted update request files. + +UPDLOS: 0 + MOVEI A,OUPDFL ;Rename badly formatted files. + MOVEI T,LOSSF + SYSCAL RENAME, [0(A) ? 1(A) ? 2(A) ? 3(A) ? 1(T) ? 2(T)] + NOP + SKIPE DEBUG ;If debugging + JSR AUTPSY ; Let hacker can see why we got upset. + RET ;Else take failure return. + + + +SUBTTL Read items from database into Regular Slots. + +INITM: PUSHAE P,[A,B,BP] + MOVE A,$SUNAM + MOVE B,$SUNAM+1 + CALL LOOKUP ;Find entry in database. + JRST INITM9 ; If no entry, nothing to copy. + MOVE B,WHERE ;Address of entry. + ADDI B,1 ;First item is in the following word. + HRLI B,440700 ;Make Bp to the items. + MOVE A,[-NITEMS+1,,1] ;AOBJN pointer -(NITEMS-1). + MOVSI A,-NITEMS ;AOBJN pointer to Alternate items. + HRRI A,1 ;excluding SUNAME (since not in database). +INITM1: MOVE BP,ITEMS(A) ;Make Bp to next slot. + HRLI BP,440700 + CALL CPYSTR ;Copy item into Alternate slot. + AOBJN A,INITM1 ;Go do next item. + AOS -3(P) +INITM9: POPAE P,[BP,B,A] + RET + + + + +SUBTTL Merge Alternate into Regular Slots. + +;;; The table at ATMUNG says which Alternate slots have something in +;;; them. These slots replace what is already in the Regular slots. + +MRGSLT: PUSHAE P,[A,B,C,D,BP] + MOVSI A,-NAITEM ;AOBJN pointer to Alternate slots. +MRGSL1: SKIPN ATMUNG(A) ;If the Alternate slot was not updated + JRST MRGSL3 ; leave the Regular slot alone. + MOVE BP,ITEMS(A) ;Get Bp to Regular slot. + HRLI BP,440700 + MOVE B,ATEMS(A) ;Get Bp to Alternate slot. + HRLI B,440700 + CALL CPYSTR ;Copy Alternate --> Regular slot. +MRGSL3: AOBJN A,MRGSL1 ;Check out each of the items. + POPAE P,[BP,D,C,B,A] + RET + + + + +SUBTTL Generate Update Request from the existing database + +;;; Step through the mapped in LSR1 database, until we reach the next +;;; entry we have not processed. Read in the entry, and munge it up. +;;; +;;; It works to step through a changing LSR1 database, because the +;;; entries are sorted alphabetically. An entry will not change its +;;; relative position unless its UNAME is changed. Entries are +;;; shuffled "down" to make room when the new entry is inserted. +;;; .SEE FIND and .SEE INSERT. + + +GETOLD: PUSHAE P,[A,B,C,BP] + SKIPN DANGER ;Paranoid check for losers!! + ERROR "This is too dangerous!" + SETZM $SUNAM ;Clear out the alternate slots. + MOVE T,[$SUNAM,,$SUNAM+1] + BLT T,ITEMND ;Zap! +GETOL1: MOVE B,WHERE ;Get address of previous entry. + SKIPN B ;If it is zero + JRST [ MOVEI B,DATA ; addr was not initialized + JRST GETOL2 ] ; so we want the first entry. + HLRZ C,(B) ;Get its length. + ADD B,C ;Compute address where next entry is. +GETOL2: HRRZ C,(B) ;Get header of next entry. + JUMPE C,GETOL9 ;If zero, assume its the ______ entry. + CAIE C,-1 ;Make sure it looks like a header. + ERROR "Invalid header found in GETOLD. " + HLRZ C,(B) ;If entry length is zero + JUMPE C,GETOL9 ; we are past the last entry. + AOS B ;First item is in the following word. + HRLI B,440700 ;Make Bp to the items. + MOVSI A,-<-1+NAITEM> ;AOBJN pointer to Alternate items. + HRRI A,1 ;excluding SUNAME (since not in database). +GETOL3: MOVE BP,ATEMS(A) ;Make Bp to next slot. + HRLI BP,440700 + CALL CPYSTR ;Copy item into Alternate slot. + AOBJN A,GETOL3 ;Go do next item. + CALL CANON ;Canonicalize Alternate to regular slots. + AOS -4(P) +GETOL9: POPAE P,[BP,C,B,A] + RET ;Update info is now ready to process. + +;;; This ad-hoc routine is the dangerous part of the COPY affair. +;;; It munges up the items in ad-hoc ways, and puts them into +;;; the Regular slots. +;;; +;;; Currently it: +;;; Makes up an SUNAME item. +;;; Makes up a LOCAL item. +;;; Makes up an ALTER item. +;;; Changes format of MACHI from [SITE1 SITE2...] to [X@SITE1 X@SITE2]. + +CANON: MOVE A,$UNAME ;Make the luser an SUNAME. + MOVE B,$UNAME+1 + MOVEM A,$SUNAM + MOVEM B,$SUNAM+1 + + MOVSI A,-NAITEM ;AOBJN to Alternate slots. +CANON1: MOVE B,ATEMS(A) ;Bp to Alternate slots. + HRLI B,440700 + MOVE BP,ITEMS(A) ;Bp to Regular slots. + HRLI BP,440700 + CALL CPYSTR ;Copy item. + AOBJN A,CANON1 ;First, just copy them all. + +;;; Now construct a new MACHI item using luser's SUNAME and site names. +;;; New MACHI item looks like "CSTACY@MC CSTACY@AI CSTACY@DM CSTACY@ML". + + MOVEI D,LSRTNS"I$MACH ;Get MACHI database item number. + ADDI D,1 ;Make it into a slot number. + MOVE B,ITEMS(D) ;Bp to MACHI item. + HRLI B,440700 + MOVSI D,-3 ;There were four machines. +CANON2: MOVE A,[440700,,%SUNAM] ;We are making UNAME@SITE strings. +CANON3: ILDB CHAR,A + JUMPE CHAR,CANON4 ;When at end of UNAME, add site. + IDPB CHAR,B + JRST CANON3 ;Copy entire UNAME. +CANON4: MOVEI CHAR,"@" + IDPB CHAR,B + MOVEI A,NEWMAC(D) + HRLI A,440700 +CANON5: ILDB CHAR,A + JUMPE CHAR,CANON6 + IDPB CHAR,B + JRST CANON5 ;Copy entire machine name. +CANON6: MOVEI CHAR,40 + IDPB CHAR,B + AOBJN D,CANON2 + MOVEI CHAR,0 + IDPB CHAR,B + +;;; Now make up a LOCAL item. + + MOVE B,[440700,,NEWLCL] ;Bp to string for LOCAL data. + MOVEI D,LSRTNS"I$LOCL ;Get LOCAL item numer. + ADDI D,1 ;Convert to slot number. + MOVE BP,ITEMS(D) ;Bp to LOCAL slot. + HRLI BP,440700 + CALL CPYSTR ;Copy into LOCAL field. + +;;; Now make up an ALTER item. + + MOVE B,[440700,,NEWALT] ;Bp to string for ALTER data. + MOVEI D,LSRTNS"I$ALTR ;Get ALTER item numer. + ADDI D,1 ;Convert to slot number. + MOVE BP,ITEMS(D) ;Bp to ALTER slot. + HRLI BP,440700 + CALL CPYSTR ;Copy into ALTER field. + +CANON7: RET ;All done with slots conversion. + + + + +SUBTTL Find database entry + +;;; Another crufty but working routine from the old source code. +;;; Rewrite it next pass. + +;;; Find the start of the entry for the asciz UNAME specified in +;;; registers A and B. If the entry does not exist, return the address +;;; of the entry to insert it before. Core address goes into WHERE. +;;; Skip return if the entry is found. + +LOOKUP: PUSHAE P,[A,B,C,D,E,I] + MOVEI E,A-1 ;Convert UNAME to search for to SIXBIT in D. + PUSHJ P,FIND76 + MOVE B,D ;and keep it in B. + HRRZI E,DATA ;E gets address of 1st user's entry. +;Now linearly search for the start of an entry, and compare Unames. +;This code assumes the Uname is the first item in an entry. +FIND1: HLRZ C,(E) ;Get word count of next user. + JUMPE C,FINDL ;0 => EOF => user not found + PUSHJ P,FIND76 + CAMLE B,D + JRST [ ADD E,C + JRST FIND1 ] + CAME B,D + JRST FINDL ;got past where it should be => doesn't exist + AOS -6(P) ;Found it => take success return +FINDL: HRRZI D,(E) + MOVEM D,WHERE + POPAE P,[I,E,D,C,B,A] ;Pop off. + RET ;Return. + +;Convert aligned ASCIZ string that E points TO THE WORD BEFORE to SIXBIT in D. +;Actually, we complement the sign bit of the returned sixbit word +;so that they compare in the same order as ascii strings. +;This routine must not use A or B since the arg string can be there. +FIND76: PUSH P,I ;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 I,[440600,,D] ;and byte pointer in B to store +FIND77: ILDB C,E + JUMPE C,FIND78 + CAIGE C,140 + SUBI C,40 + TLNE I,770000 + IDPB C,I + JRST FIND77 + +FIND78: POP P,E + POP P,C + POP P,I + TLC D,(SETZ) + POPJ P, + + + + +SUBTTL Delete entry. + +;;; Delete the entry whose address is in D from the core database. +;;; The entries after the victim are BLTd up over him. + +DELETE: PUSHAE P,[A,B,C] + TLO F,%MUNG + HLRZ A,(D) ;A GETS LENGTH OF ENTRY IN WORDS. + MOVN B,A + ADDB B,LENGTH ;FILE IS SHRINKING BY THAT MUCH. + ADD A,D + HRL D,A + HRRZ A,D + CAIE A,DATA-1(B) ;DON'T DO THE BLT IF 0 WORDS ARE TO BE MOVED. + BLT D,DATA-1(B) ;MOVE FOLLOWING STUFF DOWN. + POPAE P,[C,B,A] + JRST POPJ1 + + + +SUBTTL Insert entry + +;;; Insert the entry described in the regular slots into the core database. +;;; Address to insert at (where already deleted from) is in RH(D). + +INSERT: PUSHAE P,[A,B,C,D,E,BP] + TLO F,%MUNG + CALL COMPAC ;Compactify the entry. + PUSH P,A ;Save length. BP now points at end. + MOVE B,LENGTH + ADDI B,DATA-1 ;LAST WORD ADDR OF LSR1 FILE, NOW. + ADDB A,LENGTH + ADDI A,DATA-1 ;LAST WORD ADDR, AFTER MOVING UP. + MOVEI C,2000(A) ;MAKE SURE WE HAVE CORE FOR THOSE WORDS. + LSH C,-10. + .CORE (C) + JSR AUTPSY + HRLI B,-1 ;MAKE C(A) WORDS OF SPACE IN THE LSR1 + ANDI D,-1 ;FILE, WHERE D POINTS + ;BY MOVING UP THE STUFF ABOVE IT. + CALL SEQPGR ;TURN ON REVERSE PAGE-AHEAD + CAILE D,(B) ;SINCE MOVING DOWNWARD THRU MEMORY + JRST INSER2 +INSER1: POP B,(A) + CAIG D,(B) + SOJA A,INSER1 +INSER2: POP P,A ;GET BACK LENGTH OF NEW ENTRY + CALL SEQPGX + HRLOM A,(D) ;WRITE ,,-1 AS ITS 1ST WORD. + ADDI D,1 + HRLI D,%UNAME ;AFTER THAT PUT THE COMPACTED NEW ENTRY. + SUBI BP,%UNAME + ADDI BP,(D) + BLT D,(BP) ;BLT entire entry in to place. + CALL SEQPGX ;TURN OFF SEQUENTIAL PAGING. + POPAE P,[BP,E,D,C,B,A] ;Restore stuff. + JRST POPJ1 ;All done. + + +;;; Compactify the Regular Slots items. +;;; This way there is no padding, and items are seperated by ^@s. +;;; Returns the actual word-length of the entry (+ header) in A, +;;; and leaves the updated Bp to the end of the item in BP. + +COMPAC: PUSHAE P,[B,C] + MOVE A,[1-NITEMS,,1] ;AOBJN ponter to items. + MOVE BP,[440700,,%UNAME] ;Bp to start of +COMPA1: MOVE B,ITEMS(A) ;Get addr of next item. + HRLI B,440700 ;Make Bp to read item from. +COMPA2: ILDB C,B ;Get char from item. + HRRZ X,A ;Special kludge for UNAME slot. + CAIN X,1. ;Make damn sure it is uppercased. + JRST [ UPPER C ;(SUNAME slot shouldn't matter.) + JRST .+1 ] + IDPB C,BP ;Stuff it. + JUMPN C,COMPA2 ;Stop after the ^@ is inserted. + AOBJN A,COMPA1 ;Go get next item. + CAIA +COMPA3: IDPB C,BP ;Pad to word boundary. + TLNE BP,760000 + JRST COMPA3 + + HRRZ A,BP ;End of compacted entry. + SUBI A,%UNAME-1 ;Find how many words. + ADDI A,1 ;Also count the header word. + POPAE P,[C,B] + RET + +SUBTTL Check database format + +;;; Verify that all the entries' lengths are reasonable. + +CHECK: PUSHAE P,[A,B,C,D] + MOVEI A,DATA ;Get address of database start. + CALL SEQPAG ;Turn on page-ahead. +CHECK1: HRRZ B,(A) ;Get the header check halfword. + HLRZ D,(A) ;Get the entry length. + CAIE B,-1 ;Make sure it looks correct. + ERROR "Illegal header in database entry." + JUMPE D,CHECK2 + ADD A,D ;Compute start of next entry. + JRST CHECK1 ;Go check it. +CHECK2: MOVEI A,DATA ;Find address of last word. + ADD A,LENGTH ;(LENGTH points 1 past it.) + SETZM (A) + SUBI A,1 + HRRZ B,(A) ;Get terminating header word. + HLRZ C,(A) ;Get terminating header's length. + SKIPN C + CAIE B,-1 ;Are we looking at it? + ERROR "LENGTH screwed up - last header not found." + +;;; Clear out any random low bits set where they shouldn't be. + +CHECK3: MOVEI I,DATA ;Get address of first entry. + CALL SEQPAG ;Turn on page ahead. + MOVEI B,1 +CHECK4: HRRZ A,(I) ;Get entry header. + CAIE A,-1 ;Make sure it looks like one. + ERROR "Illegal entry header found in CHECK3. " + HLRZ A,(I) ;Get entry length. + JUMPE A,CHECK9 ; Last entry has zero length. + ADD A,I ;Compute addr of next entry. +CHECK5: AOS I ;Clear the low bit in each entry word. + CAMN A,I ;Count up data words + JRST [ MOVE I,A ; until next entry header. + JRST CHECK4 ] + ANDCAM B,(I) ;Clearing low bits as we go. + JRST CHECK5 + +CHECK9: CALL SEQPGX ;Turn off page-ahead. + POPAE P,[D,C,B,A] + JRST POPJ1 + + + +SUBTTL Create tables + +;;; This routine and its subrs unmodified from old version. +;;; (ie, they need rewriting..) + +MAKTAB: PUSHAE P,[A,B,C,D,E,BP,I,J,K,L,R] + CALL LSRIDX ;Create Tables, + POPAE P,[R,L,K,J,I,BP,E,D,C,B,A] + JRST POPJ1 + +;FIRST STEP IS TO MAKE THE UNAME INDEX AND VERIFY THAT EVERYTHING HAS BEEN SORTED. +;ALSO, WE COLLECT THE LAST NAMES AND SET UP AN UNSORTED LAST NAME TABLE. + +LSRIDX: MOVEI I,DATA ;-> ENTRY + CALL SEQPAG + SETZM DTALST + SETZM NUNMS + TLO F,%MPVOK ;Say it's OK to create core for tables. + MOVSI A,400000 + MOVEM A,LASUNM + MOVEI A,LNMSTR + MOVEM A,LNMPTR +LSRID0: HLRZ A,(I) ;SEE IF EOF + JUMPE A,LSRID3 ;YUP. + MOVEI R,-DATA(I) ;SAVE RELATIVE ADDRESS + MOVE J,I + EXCH J,DTALST ;GET ADDRESS OF ENTRY BEFORE THIS ONE + XOR J,I ;MAKE J ZERO IF THIS IS ON SAME PAGE + ANDI J,-2000 + HRLI I,010700 ;SET UP TO EXTRACT UNAME + MOVEI E,0 + MOVE D,[440600,,E] +GUNM1: ILDB A,I + JUMPE A,GUNM2 + CAIGE A,140 + SUBI A,40 + TLNE D,770000 + IDPB A,D + JRST GUNM1 + +GUNM2: MOVE A,LASUNM + TLC E,(SETZ) ;CHANGE SIGN BIT SO IT SORTS CORRECTLY + CAMGE E,A + JSR AUTPSY + MOVEM E,LASUNM + JUMPE J,GLNM ;JUMP IF SAME PAGE + AOS A,NUNMS ;OTHERWISE, STORE ANOTHER INDEX ENTRY + MOVEM E,UNMIDX-1(A) +GLNM: MOVE D,LNMPTR ;SET UP TO STORE LAST NAME + HRLI D,440700 +GLNM1: ILDB A,I + CAIE A,"," + CAIG A,40 + JRST GLNM2 ;LAST NAME ENDS WITH COMMA, SPACE, NULL, OR CONTROL + CAIL A,"a" + CAILE A,"z" + CAIA + SUBI A,40 ;UPPER CASE IFY + IDPB A,D + JRST GLNM1 + +GLNM2: MOVEI A,0 ;END ASCIZ STRING + IDPB A,D + TLNE D,760000 ;PAD OUT TO WORD BOUNDARY + JRST GLNM2 + SKIPN @LNMPTR ;IGNORE NULL LAST NAMES + JRST GLNM3 + MOVEI D,1(D) ;NEW VALUE OF LNMPTR + EXCH D,LNMPTR + SUBI D,LNMSTR ;MAKE RELATIVE ADDRESS FOR LNM TABLE + AOS A,NLNMS + HRLM D,LNMIDX-1(A) + HRRM R,LNMIDX-1(A) +GLNM3: MOVEI I,DATA(R) ;GET BACK BEGINNING OF ENTRY + HLRZ A,(I) ;GET LENGTH + ADD I,A ;ADVANCE TO NEXT ENTRY + JRST LSRID0 ;LOOP + +;ALL DONE. NOW WHAT WE HAVE TO DO IS SET UP HDR, +; SORT THE LNM TABLE, AND DE-RELATIVIZE THE VARIOUS POINTERS. +LSRID3: CALL SEQPGX ;NO LONGER ARE WE SCANNING THE DATA. + TLZ F,%MPVOK ;Done creating tables. + + MOVEI A,LSRVER ;Store LSR1 versiob format. + MOVEM A,HDR+LSRTNS"HDRVER + + MOVE A,[SIXBIT/LSR1!!/] ;Store compilation timestamps. + MOVEM A,HDR+LSRTNS"HDRSID + .RDATE A, + MOVEM A,HDR+LSRTNS"HDRDAT + .RTIME A, + MOVEM A,HDR+LSRTNS"HDRTIM + + MOVEI A,LSRTNS"HDRLEN ;After the header, comes UNAME table. + MOVEM A,HDR+LSRTNS"HDRUNM + + MOVE A,NUNMS ;After the UNAME table + ADDI A,LSRTNS"HDRLEN+1 ;comes the LASTNAME table. + + MOVEM A,LNMREL ;Compute relocation of LASTNAME strings. + MOVEM A,HDR+LSRTNS"HDRLNM + ADD A,NLNMS + ADDI A,1 + MOVEM A,STRREL + + ADD A,LNMPTR ;COMPUTE RELOCATION OF HSNAME TABLE + SUBI A,LNMSTR + MOVEM A,HDR+LSRTNS"HDRHSN + + ADD A,HFILEN ; COMPUTE RELOCATION OF DATA AREA + MOVE B,A + ADDI A,1777 ;MUST BE ON PAGE BOUNDARY + ANDI A,-2000 + MOVEM A,DTAREL + MOVEM A,HDR+LSRTNS"HDRDTA + SUB A,B + MOVEM A,DTAPAD ;AMOUNT OF SPACE TO PAD TO PAGE BOUNDARY + CALL LNMSRT + +;RELOCATE THE ENTRY PTRS AND STRING PTRS IN LNM TABLE + MOVN B,NLNMS + HRLZS B +REL1: HRRZ A,LNMIDX(B) + ADD A,DTAREL + HRRM A,LNMIDX(B) + HLRZ A,LNMIDX(B) + ADD A,STRREL + HRLM A,LNMIDX(B) + AOBJN B,REL1 + RET + + +;SUBROUTINE TO SORT THE LNM TABLE +;FOR DOCUMENTATION SEE THE LISP-MACHINE QUICKSORT ROUTINE +;LH OF EACH ENTRY IS A RELATIVE ADDRESS INTO LNMSTR. +;USES STRCMP. +LNMSRT: MOVEI L,0 + MOVE R,NLNMS + SUBI R,1 ;INDICES ARE INCLUSIVE +;RECURSES TO HERE +LNMSR0: CAMG R,L ;SKIP IF MORE THAN ONE LONG + POPJ P, ;ALREADY SORTED OR L>R (WHICH CAN HAPPEN!) + MOVE D,R ;RANDOMLY CHOOSE A POINT HALFWAY BETWEEN + SUB D,L + LSH D,-1 + ADD D,L +;DO + MOVE K,LNMIDX(D) ;K IS OLD D'TH (NEW E'TH) ELEMENT + MOVE A,LNMIDX(L) ;STORE L'TH INTO D'TH + MOVEM A,LNMIDX(D) + MOVE I,L + MOVE J,R +LNMSR1: ;DECREASE J UNTIL K NOT LT A[J] + CAME J,I + JRST LNMSR2 + MOVEM K,LNMIDX(I) + MOVE E,I + JRST LNMSRX + +LNMSR2: HLRZ B,K + HLRZ C,LNMIDX(J) + CALL STRCMP + JRST LNMSR3 + SOJA J,LNMSR1 ;KC +;;; Does assume that both strings are nulled out to word boundaries. + +STRCMP: PUSHAE P,[D,E] + ADDI B,LNMSTR + ADDI C,LNMSTR +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 LIVE -> OLD -> OOLD -> Deleted + +INSTAL: PUSHAE P,[A,B] + + MOVEI A,OOLD + SYSCAL DELETE,[ 0(A) ? 1(A) ? 2(A) ? 3(A)] + NOP + + MOVEI A,OLD + MOVEI B,OOLD + SYSCAL RENAME,[ 0(A) ? 1(A) ? 2(A) ? 3(A) ? 1(B) ? 2(B) ] + NOP + + MOVEI A,LSR1 + MOVEI B,OLD + SYSCAL RENAME,[ 0(A) ? 1(A) ? 2(A) ? 3(A) ? 1(B) ? 2(B) ] + NOP + + MOVEI A,LSR2 + MOVEI B,LSR1 + SYSCAL RENAME,[ 0(A) ? 1(A) ? 2(A) ? 3(A) ? 1(B) ? 2(B) ] + NOP + + POPAE P,[B,A] + JRST POPJ1 + + + +SUBTTL Warn Luser of truncated entry + +WARNER: PUSHAE P,[A,B,C] + SYSCAL OPEN,[%CLBIT,,.UAO ? %CLIMM,,DSKO + [SIXBIT /DSK/] + [SIXBIT /_INQUP/] + [SIXBIT /OUTPUT/] + [SIXBIT /.MAIL./] ] + JRST WARNE9 ; If directory full or something, just punt. + MOVEI X,DSKO ;Select output channel. + MOVEI BP,[ASCIZ "FROM-JOB:INQUPD +AUTHOR:INQUPD +RCPT:(UPDATE-INQUIR-LOSSAGE (R-OPTION CC)) +SUBJECT: Problem updating "] + CALL TYPSTR + MOVEI BP,%SUNAM + CALL TYPSTR + MOVEI BP,[ASCIZ "'s INQUIR entry +"] + CALL TYPSTR + MOVE A,TOOBIG ;Get the offending slot number. + MOVE B,ITEMN(A) ;Get the name of the slot. + CAME B,[ASCII "NETADR"] ;Is his network address losing? + JRST WARNE3 ; No, so we can barf at him. + MOVEI BP,[ASCIZ "TEXT;-1 + +(User's NETADR is losing, so I am sending this note here.) + + -- INQUPD + +"] + CALL TYPSTR + JRST WARNE7 + +WARNE3: MOVEI BP,[ASCIZ "RCPT:("] + CALL TYPSTR + MOVEI BP,%SUNAME ;Don't try to parse NETADR. + CALL TYPSTR ;COMSAT will indirect via it. + MOVEI BP,[ASCIZ ") +"] + CALL TYPSTR + MOVEI BP,[ASCIZ "TEXT;-1 + +Hello, + +I am the INQUIR update system daemon for the ITS machines. +Some trouble was encountered in processing the latest changes to +your INQUIR entry here. One or more of the fields in your entry +was too long, and has been truncated. I suggest that you check +your INQUIR entry on MIT-MC using the WHOIS command. You may want +to run INQUIR again to make all your information fit. + +Yours Truly, + INQUPD + + +"] + CALL TYPSTR +WARNE7: SYSCAL RENMWO,[%CLIMM,,DSKO ? [SIXBIT /MAIL/] ? [SIXBIT />/] ] + JSR AUTPSY + .CLOSE DSKO, +WARNE9: POPAE P,[C,B,A] + RET + + + + +SUBTTL Little utility routines + +;;; Type out ASCIZ string from BP onto (unit) channel in X. + +TYPSTR: HRLI BP,440700 +TYPST1: ILDB CHAR,BP + JUMPE CHAR,CPOPJ + SYSCAL IOT,[X ? CHAR] + JSR AUTPSY + JRST TYPST1 + + + +;;; Copy ASCIZ string from Bp in B down the Bp in BP. +;;; Copies the terminating ^@ and always returns. + +CPYSTR: ILDB CHAR,B + IDPB CHAR,BP + JUMPE CHAR,CPOPJ + JRST CPYSTR + + + +;;; Turn on sequential page ahead for LSR1 data in core. + +SEQPAG: .SUSET [.SPAGAHD,,[2,,-2]] ;For forward scan. + JRST SEQPG1 +SEQPGR: .SUSET [.SPAGAHD,,[-2,,2]] ;For backward scan. +SEQPG1: PUSH P,E + MOVE E,LENGTH + ADDI E,DATA+2000 + LSH E,-10. + HRLI E,DATA/2000 + .SUSET [.SPAGRAN,,E] + POP P,E + POPJ P, + +;;;Turn off sequential paging. + +SEQPGX: .SUSET [.SPAGAHD,,[0]] + .SUSET [.SPAGRAN,,[0]] + POPJ P, + + +CONSTANTS +VARIABLES + + +SUBTTL Storage + + +;;; AUTPSY cruft stored here. + +LOSEAC: BLOCK 20 +LOSJPC: 0 +LOSPCL: 0 +LOSBCH: 0 +LOSSTS: 0 +UUOJPC: 0 + +PDLLEN==200 +PDL: BLOCK PDLLEN ;The stack. + +DANGER: -1 ;-1 if Copy-munging. + +DEBUG: -1 ;-1 if debugging. + +JUNK: 0 ;Random sink. + +WHERE: 0 ;Address of entry found by LOOKUP. + +COUNT: 0 ;Count of updates done. + +GOTUNM: 0 ;-1 if have read UNAME from update request file. + +INHEDR: 0 ;-1 if inside header in update request file. + +NEWINQ: 0 ;-1 if new style (gz/sra/romkey) request file. + +LENGTH: 0 ;Length of LSR1 Data Area we mapped. + +HFILEN: 0 ;Length of the HSNAME file we slurped. + +SAVEBP: 0 ;Saved Byte pointer into update request file. + +TOOBIG: 0 ;Slot number of item which was truncated. + +;;; These are for the new LOCAL slots when COPYing. + +NEWLCL: ASCIZ /FILDI GROUP RELAT/ +NEWALT: ASCIZ /INQUIR 830512-000000/ +NEWMAC: ASCIZ /MC/ + ASCIZ /ML/ + ASCIZ /DM/ + + +;;; Update request file buffer. + +RQPGS==20. +RQLEN==2000*RQPGS +REQBUF: BLOCK RQLEN + -1 ;Force core to exist + + + +SUBTTL Item Slot Definitions + +;;; Due to dirty evolution, this is all somewhat of a crock. +;;; +;;; There are two buffers (two slots) for each of the item strings. +;;; The "Regular" slots are are used to construct a LSR1 entry. +;;; The "Alternate" slots are filled in by INATM (GETUPD) and for +;;; frobbing around when we need two copies (for example, when we +;;; merge two versions of the data.) +;;; +;;; +;;; SLOT is a macro which defines the "Regular" item slots (at ITEMBG) +;;; and the "Alternate" slots (at ATEMBG), sets up the length of each +;;; item in ITEML, and counts up ICOUNT and ISIZE. +;;; +;;; *** CAVEAT **** +;;; Crock #1: SLOT must be called with items in same order as ITMIRP uses. +;;; Crock #2: SUNAM and UNAME must be first, and must be 2 words each. + + +ITEMBG=<.+1777>&-2000 ;This page for Regular slots. +ATEMBG=ITEMBG+2000 ;Following page for Alternate slots. +ITEML=ATEMBG+2000 ;This page for table of lengths. +.=ITEML+2000 ;Hop to next page. + +ICOUNT==0 ;Count of items defined. +ISIZE==0 ;Length of a LSR1 entry. +IPTR==0 ;Pointer into each slot buffer. + +DEFINE SLOT NAME,LENGTH + %!NAME=ITEMBG+IPTR + $!NAME=ATEMBG+IPTR + LOC ITEML+ICOUNT + LENGTH + ISIZE==ISIZE+LENGTH + IPTR==IPTR+LENGTH +ICOUNT==ICOUNT+1 +TERMIN + + +;;; Now build the slot buffers. + +SLOT SUNAM,2 ;Entry to be updated. +SLOT UNAME,2 ;Uname. +SLOT NAME,20 ;Full Name. +SLOT NICK,10 ;Nickname. +SLOT LOCAL,10 ;Local Inquire Items. +SLOT MITAD,40 ;MIT Address. +SLOT MITTE,20 ;MIT Telephone Number. +SLOT HOMAD,40 ;Home Address. +SLOT HOMTE,20 ;Home Telephone Number. +SLOT SUPER,40 ;Supervisor. +SLOT PROJE,40 ;Project. +SLOT FILDI,20 ;File Dir Names. +SLOT AUTHO,10 ;Authorization +SLOT GROUP,1 ;Group Affiliation. +SLOT RELAT,1 ;Relation To Group. +SLOT BIRTH,10 ;Birthday. +SLOT REMAR,200 ;Remarks. +SLOT NETAD,20 ;Network Address. +SLOT ALTER,10 ;User &Time Of Last Alteration. +SLOT MACHI,40 ;Suname/Machines To Be Updated. + + +;;; Define addrs of the end of each set of slots. + +ITEMND=ITEMBG+IPTR+1 +ATEMND=ATEMBG+IPTR+1 + +;;; Macros for pointing to Regular items. +;;; ITEMS+N points to n'th item. ITEMS+N+1 points to end of n'th item. +;;; ITEMN+N has name of n'th item, as 5 chars of ascii. +;;; ATEMS and ATEMN are also defined (for Alternate slots.) + +ITEMS: LSRTNS"ITMIRP [%!ITEM] +NITEMS==.-ITEMS + ITEMND + +ITEMN: LSRTNS"ITMIRP [.1STWD ASCII/ITEM/] + + +ATEMS: LSRTNS"ITMIRP [$!ITEM] +NAITEM==.-ATEMS + ATEMND + +ATEMN: LSRTNS"ITMIRP [.1STWD ASCII/ITEM/] + +;;; Disposition table for alternate slots, 1 word/item. When +;;; processing an update-request, a -1 means the item appeared while +;;; a 0 means it was not mentioned (should be defaulted) + +ATMUNG: BLOCK NAITEM + + + +SUBTTL LSR1 database storage + +;;; A block of words for the orignial LSR1 database header. + +HEADER: BLOCK LSRTNS"HDRLEN + +;;; Variables used in creating the tables for the new LSR1 file. + +LNMPTR: LNMSTR ;Next free location in last name strings. +DTALST: 0 ;Address of last data entry scanned. +DTAREL: 0 ;Relocation of data area. +STRREL: 0 ;Relocation of lnm strings. +LNMREL: 0 ;Relocation Of lnm index. +DTAPAD: 0 ;Number of words to pad to page boundary. + +;;; HDR through the filled part of UNMIDX are all +;;; written into the new LSR1 file. + +HDR: BLOCK LSRTNS"HDRLEN ;Fixed header area for new LSR1 file.. +NUNMS: 0 ;Number of entries in UNAMES table. +UNMIDX: BLOCK 400 ;UNAMES table. + +LASUNM: SETZ ;LAST UNAME SEEN, TO CHECK SORTING + +CONSTANTS +VARIABLES + +HBFLEN==2000 ;Max length of HSNAME file buffer. +HBUF: BLOCK HBFLEN ;HSNAME file buffer. + +ZERO: BLOCK 2000 ;Zeros, for writing padding out. + -1 ;Make sure that core exists. + +;;; The data pages containing the entries in the LSR1 database +;;; will be mapped here. + +DATA==<.+1777>&-2000 ;Place to read LSR1 file into. + +;;; Allow 142K for LSR1 file DATA area. +NPAGES==400-<<50000.+5000.+1+1777>&-2000>/2000-DATA/2000 +.=DATA+NPAGES*2000 + +;;; The pages for the new tables in the LSR1 database are created here. +;;; If the core is not already available, an MPV handler creates it. + +MPVOKB:: ;Beginning of legal MPV area. +NLNMS: 0 ;Number of entries in LastNames table. +LNMIDX: BLOCK 5000. ;LastNames table. +LNMSTR: BLOCK 50000. ;LastName Strings. +MPVOKE: ;Ending of legal MPV area. + + + +;;; Local Modes ::: +;;; Comment Column:35 ::: +;;; End: ::: + +END GO + + + + diff --git a/src/inquir/lookup.4 b/src/inquir/lookup.4 new file mode 100644 index 00000000..7595f3e4 --- /dev/null +++ b/src/inquir/lookup.4 @@ -0,0 +1,274 @@ +;-*- Mode: Midas -*- + +TITLE LOOKUP an Inquire entry + ;CStacy, 4/26/83 + +SUBTTL Basic definitions + +;;; Registers. + +X=0 ;Super temporary register. +A=1 ;General registers. +B=2 +C=3 +D=4 +E=5 +BP=6 ;Byte pointer. +CHAR=7 ;Character being manipulated. +T=10 ;Temporary +TT=11 ;Temporary+1. +OC==12 ;OUT register. +U1==13 ;4 UUO Registers. +U2==14 +U3==15 +U4==16 +P=17 ;Stack pointer. + +;;; I/O Channels + +DSKI=14 ;Disk input. +TTYO=15 ;TTY typeout. +TTYI=16 ;TTY typein. + +;;; Macros and output routines. + +$$OUT==1 +.INSRT KSC;MACROS > +.INSRT KSC;IVORY > +.INSRT KSC;OUT > + + +;;; LSR1 database routines. +$$OVLY==1 +.INSRT LSRTNS > + + + +SUBTTL Interrupt Handler and various returns + +POPJ1: AOS (P) ;Skip +CPOPJ: RET ;Return + +SYSLOS:: +AUTPSY: 0 ;Fatal error JSR here. + +DEATH: SKIPE DEBUG ;Come here to log out. + .VALUE [0] + .LOGOUT 1, + + +TMPLOC 42,{-TSINTL,,TSINT} ;New style interrupts. + +INTACS==T_6+7 ;T,TT, and OUT registers preserved. + + +TSINT: INTACS,,P + 0 ? 1_TTYI ? 0 ? <1_TTYO>\<1_TTYI> ? CHRINT + 0 ? 1_TTYO ? 0 ? 0 ? MORINT +TSINTL==:.-TSINT + +;;; Interrupt dismissal + +INTRET: SYSCAL DISMIS,[%CLBIT,,INTACS ? P] + JSR SYSLOS + +;;; Console interrupts. + +CHRINT: MOVEI T,TTYI ;INTERRUPT CHAR. + .ITYIC T, + JRST INTRET + CAIE T,^S + CAIN T,^G + JRST [.RESET TTYO, + SYSCAL TTYFLS,[ %CLBIT,,1 ? %CLIMM,,TTYI] + .LOSE %LSSYS + JRST FLSIT1] + JRST INTRET +MORINT: OUT(TTYO,("--More--")) ;MORE BREAK. + SYSCAL IOT,[%CLBIT,,%TIPEK ? %CLIMM,,TTYI ? %CLOUT,,T] + .LOSE %LSFIL + CAIE T,40 + CAIN T,177 + .IOT TTYI,T + CAIE T,40 + JRST FLSIT + OUT(TTYO,("A")) + JRST INTRET +FLSIT: OUT(TTYO,("Flushed")) +FLSIT1: JRST DEATH ;means we are done. + + + +SUBTTL Main program + +GO: MOVE P,[-PDLLEN,,PDL] ;Init the stack. + SYSCAL OPEN,[%CLBIT,,<.UAO\%TJDIS> ? %CLIMM,,TTYO ? [SIXBIT /TTY/]] + .LOSE %LSFIL + SYSCAL OPEN,[%CLBIT,,.UAI ? %CLIMM,,TTYI ? [SIXBIT /TTY/]] + .LOSE %LSFIL + SYSCAL CNSGET,[%CLIMM,,TTYO ? %CLOUT,,X ? %CLOUT,,TCMXH] + .LOSE %LSFIL + SYSCAL TTYSET,[%CLIMM,,TTYI ? [222222,,222222] ? [230222,,220222]] + .LOSE %LSFIL + .SUSET [.ROPTION,,A] ;Read job option bits. + TLO A,%OPINT\%OPOPC ;Turn on winning-PC and new interrupts. + .SUSET [.SOPTION,,A] ;Set option bits. + .SUSET [.SMSK2,,[<1_TTYI>\<1_TTYO>]] ;Enable TTY interrupts. + OUT(TTYO,OPEN(UC$IOT)) + OUT(,CH(TTYO)) ;Open typeout display as default device. + TLNN A,OPTCMD ;If user forgot JCL + JRST [ SKIPN DEBUG ; and we are not debugging + JRST NOJCL ; we can't do much. + MOVE A,[SIXBIT /TEST/] + MOVEM A,UNAME ; Use TEST name for debugging. + JRST MAPLSR ] + .BREAK 12,[..RJCL,,JCLBUF] ;Read JCL into buffer. + MOVE BP,[440700,,JCLBUF] + MOVE B,[440600,,UNAME] + MOVEI C,6 +GETJCL: ILDB CHAR,BP + JUMPE CHAR, ENDJCL ;A ^@ ends JCL. + CAIN CHAR,^M ;So does a ^M. + JRST ENDJCL + CAIN CHAR,37 ;So does a ^_. + JRST ENDJCL + CAIN CHAR,3 ;So does a ^C. + JRST ENDJCL + CAIGE CHAR,140 ;Convert to Sixbit. + SUBI CHAR,40 + IDPB CHAR,B ;Store as uname. + SOJN C,GETJCL +ENDJCL: CAIE C,6 + JRST MAPLSR +NOJCL: OUT(,("AUsage is :LOOKUP ")) + JRST DEATH + +MAPLSR: MOVEI A,DSKI ;Try to map in Inquire database. + MOVE B,[-LSRPGS,,LSRPAG] + CALL LSRTNS"LSRMAP + JRST [ OUT(,("AUnable to map Inquire database."),CRLF) + JRST DEATH ] + +GETLSR: MOVEI A,DSKI + MOVE B,UNAME ;Look up luser in database. + CALL LSRTNS"LSRUNM ;Get core addr of entry in B. + JRST [ OUT(,("ANot found"),CRLF) + JRST DEATH ] + +SHOWIT: + SKIPN DEBUG + OUTCAL(,("C")) ;Clear screen. + MOVSI D,-NITMS ;AOBJN pointer to Items. +GETITM: HRRZ A,LSTTAB(D) ;Get next item description string. + HRLI A,440700 ;Make Bp to it. + OUT(,TZ$(A),(" "),LPAR) ;Print long name of item. + HLRZ E,LSTTAB(D) ;Get item number. + CALL NAMOUT ;Print short name of item. + OUT(,RPAR,(":"),CALL(PTAB)) + MOVE A,E ;Get item number. + CALL LSRTNS"LSRITM ;Look up item in database. + JRST [ OUT(,CRLF) ; If not there skip it. + JRST NXTITM ] + CALL ITMOUT ;Type out the item's value. +NXTITM: AOBJN D,GETITM ;Get another item. + JRST DEATH ;All done. + + + + +SUBTTL Additional Output routines + +;;; CLEOL and move to column #o50. + +PTAB: MOVE T,[ASCIZ /LH(/] + OUT(,TZ(T)) + RET + + +;;; ITMOUT types out the Inquire item pointed at by the Bp in A. +;;; Newlines get handled properly. The Bp is updated. + +ITMOUT: ILDB CHAR,A + CAIN CHAR,^M ;If this is a CR + JRST [ ILDB CHAR,A ; Gobble the LF. + OUT(,CRLF,CALL(PTAB)) ; Do a prettier CRLF. + JRST ITMOUT ] ; Continue. + SKIPN CHAR + JRST [ OUT(,CRLF) + RET ] + .IOT TTYO,CHAR + JRST ITMOUT + + +;;; NAMOUT takes a LSR1 item number in E, and types out its name. + +NAMOUT: HRRZI T,ITMNAM+1(E) ;Get addr of item short name. + HRLI T,440700 ;Make Bp to it. + MOVEI TT,5. ;Max five chars. +NAMOU1: ILDB CHAR,T ;Get character. + JUMPE CHAR,NAMOU2 ;If zero, done. + .IOT TTYO,CHAR ;Type it. + SOJN TT,NAMOU1 ;Go back for more characters. +NAMOU2: RET ;Done. + + + + + +SUBTTL Storage + +;;; Macro to create a table of item descriptions. + +NITMS==0 +DEFINE ITEM NUM,&DESC +NITMS==NITMS+1 + NUM,,[ASCIZ DESC] +TERMIN + +;;; This table is in the order we want the items listed. + +LSTTAB: ITEM LSRTNS"I$UNAM,"User-name" + ITEM LSRTNS"I$AUTH,"Authorization" + ITEM LSRTNS"I$NAME,"Name" + ITEM LSRTNS"I$NICK,"Nick-name" + ITEM LSRTNS"I$GRP,"Group" + ITEM LSRTNS"I$REL,"Relation" + ITEM LSRTNS"I$MITA,"MIT address" + ITEM LSRTNS"I$MITT,"MIT phone" + ITEM LSRTNS"I$HOMA,"Home address" + ITEM LSRTNS"I$HOMT,"Home phone" + ITEM LSRTNS"I$NETA,"Network mailbox" + ITEM LSRTNS"I$BRTH,"Birthday" + ITEM LSRTNS"I$PROJ,"Project" + ITEM LSRTNS"I$SUPR,"Supervisor" + ITEM LSRTNS"I$REM,"Remarks" + ITEM LSRTNS"I$DIR,"File directories" + ITEM LSRTNS"I$LOCL,"Local fields" + ITEM LSRTNS"I$MACH,"Machines" + ITEM LSRTNS"I$ALTR,"Last Alteration" + +;ITEMN+N has name of n'th item, as 5 chars of ascii. +ITMNAM: LSRTNS"ITMIRP [.1STWD ASCII/ITEM/] + + + +PDLLEN==64. ;Stack length. +LSRPGS==220. ;Number of pages reserved for LSR1. +JCLBFL==10. ;Number of words for JCL buffer. + +PDL: BLOCK PDLLEN ;The stack. +DEBUG: 0 ;-1 iff debugging. +JCLBUF: BLOCK JCLBFL ;JCL buffer. +TCMXH: 0 ;Console parameters. +UNAME: 0 ;UNAME of loser to look up. + + +CONSTANTS +VARIABLES + +VARCHK + +LSRPAG==<.+1777>/2000 ;Starting page of Inquire database. +LSR1=LSRPAG*2000 ;Address of database header. + +END GO