Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
7/ft3/monitor/stanford/pupnm.mac
There are 2 other files named pupnm.mac in the archive. Click here to see a list.
;<6-1-MONITOR>PUPNM.MAC.29, 12-May-85 23:50:33, Edit by LOUGHEED
; Remove G1BPT definition now that MACSYM is fixed
;<6-1-MONITOR>PUPNM.MAC.28, 17-Mar-85 14:50:31, Edit by LOUGHEED
;<6-1-MONITOR>PUPNM.MAC.25, 15-Mar-85 15:27:43, Edit by LOUGHEED
; Move into extended code section
;<6-MONITOR>PUPNM.MAC.24, 16-Oct-84 22:48:11, Edit by LOUGHEED
; Remove SEARCH PUPSYM
;<6-MONITOR>PUPNM.MAC.21, 24-Jun-84 12:14:13, Edit by LOUGHEED
; Global byte pointer macro lossage
;<6-MONITOR>PUPNM.MAC.20, 21-Jun-84 21:39:51, Edit by LOUGHEED
; Define REL6 symbol for conditional assembly under Release 5.x
; Remove reference to MSTKOV
;<X-MONITOR>PUPNM.MAC.19, 10-Dec-83 23:08:16, Edit by LOUGHEED
; Find PUP symbols in PUPSYM library
;<5-3-MONITOR>PUPNM.MAC.18, 25-Nov-83 17:53:08, Edit by LOUGHEED
;<5-3-MONITOR>PUPNM.MAC.17, 25-Nov-83 15:53:04, Edit by LOUGHEED
; Fix ILMNRF in CMPATR code
;<5-3-MONITOR>PUPNM.MAC.16, 25-Nov-83 14:15:01, Edit by KRONJ
; Fix some more global pointers
;<5-3-MONITOR>PUPNM.MAC.15, 25-Nov-83 02:42:07, Edit by LOUGHEED
; Use NETBAS when building global pointers - work around addressing problems
; Clean up SIN code. Open file in 18-bits, read only.
;<5-3-MONITOR>PUPNM.MAC.14, 25-Nov-83 01:47:41, Edit by LOUGHEED
; SETMPG doesn't like 23-bit addresses. Try using SIN instead!
;<5-3-MONITOR>PUPNM.MAC.13, 25-Nov-83 00:53:33, Edit by LOUGHEED
; Fix definition of ENTDIR
;<5-3-MONITOR>PUPNM.MAC.12, 25-Nov-83 00:26:58, Edit by LOUGHEED
; Put BUG macros back here from PUPBUG.MAC
; Remove assembly-time sanity check - can't evaluate external symbols
;<5-3-MONITOR>PUPNM.MAC.11, 22-Nov-83 21:46:13, Edit by KRONJ
; Extended addressing - move mapped directory out of monitor section
;<5-MONITOR>PUPNM.MAC.10, 12-Feb-83 22:29:37, Edit by LOUGHEED
; NTDVER is now externally defined - an offset in the PUPPAR GETAB% table
;<5-MONITOR>PUPNM.MAC.9, 2-Jan-83 21:04:27, Edit by B.BOMBADIL
; Define storage for ENTDIR here instead of in PUP.MAC
; Better error message if network directory file is too large to map
;<5-MONITOR>PUPNM.MAC.8, 23-Aug-82 01:33:49, Edit by ADMIN.LOUGHEED
; Fix byte pointer bug in PUPNM%
;<5-MONITOR>PUPNM.MAC.7, 18-Aug-82 17:25:00, Edit by ADMIN.LOUGHEED
;<5-MONITOR>PUPNM.MAC.6, 18-Aug-82 17:17:59, Edit by ADMIN.LOUGHEED
; Use CHKJFA instead of CHKJFN (preserves Px registers, has standard returns)
; Remove previous edit (was wrong and using CHKJFA fixes problem)
; Remove superfluous arguments from LOCK/UNLOCK macros
; Bullet proof XCTBUU/XCTBU calls with ERJMP's
; Remove accidentally replicated code near PNMLU3
;<5-MONITOR>PUPNM.MAC.5, 17-Aug-82 20:52:54, Edit by ADMIN.LOUGHEED
; Use P4 instead of P3 as the PF AC (CHKJFN clobbers P3)
;<5-MONITOR>PUPNM.MAC.4, 17-Aug-82 01:01:41, Edit by ADMIN.LOUGHEED
;PUPNM% extended addressing bug: Flags and a block count were kept in
; left half of E, right half was used as index into stack. Moved flags
; into another AC (PF) and made sure left half of E was zeroed.
;<5-MONITOR.PUP>PUPNM.MAC.2, 24-Jun-82 18:51:38, Edit by B.BOMBADIL
;If system not initialized, look for PUPNM directory on <SYSTEM>, not SYSTEM:
;<4.MONITOR>PUPNM.MAC.2, 11-Jul-81 15:13:16, Edit by WOHL
;CS36 Covert to version 4 tops-20
; Get constants from PUPPAR
; Label PNMXIT => PNMXT (Conflicted with BUG)
;<3A-MONITOR>PUPNM.MAC.5 22-May-80 11:59:56 TECO'd by GILMURRAY
; On 2020, search PROLOG for NTDSIZ definition
; Incorporate 2020 changes into Tenex version
; Search SYSDEF for FT20 and FT10X definitions
;<MON>PUPNM.MAC;4 3/5/80 EDIT BY RINDFLEISCH
; Fixed check for monitor mode call in PNMSIN (UIOF)
; Fixed XCTUU [ILDB ac,ptr] - PARC does adr calc in ptr in USER space
;<MON>PUPNM.MAC;3 29-Feb-80 10:07:50 EDIT BY SWEER
; Put LOCK/UNLOCK calls back the way they were as they assemble ok anyway
; Readjust stack at PNMXIT
; Revised LOCK/UNLOCK calls back to 1.31
;<134>PUPNM.MAC;10 30-JAN-77 15:14:22 EDIT BY TAFT
; Fix CMPADR to do unsigned compares correctly and
; to not care about garbage low-order 4 bits
;<134>PUPNM.MAC;9 21-APR-76 16:43:03 EDIT BY TAFT
; Add attribute lookup capability
;<134>PUPNM.MAC;7 11-JAN-76 21:36:47 EDIT BY TAFT
; Fix assembly glitch -- need () around LOCK/UNLOCK macro arg
;<134>PUPNM.MAC;6 10-JAN-76 23:57:57 EDIT BY TAFT
; Revise LOCK/UNLOCK calls for 1.34 scheduler strategy
SEARCH PROLOG
TTITLE (PUPNM,,< - PUP NETWORK DIRECTORY LOOKUP>)
SUBTTL E. A. Taft, April 1975
; Format of Network Directory:
; The directory consists of the highest-numbered version of
; file (SYSTEM)PUP-NETWORK.DIRECTORY, which is a file written
; in 16-bit bytes (for the sake of Altos and Novas) and mapped
; into monitor space starting at ENTDIR for the purpose of doing
; lookups by means of the PUPNM Jsys. All "pointers" in the
; directory refer to 16-bit bytes relative to the start of the
; directory. All "strings" are BCPL-style, i.e. an 8-bit
; byte count followed by that number of 8-bit bytes. All
; "blocks" and "tables" start at Maxc word boundaries, i.e.
; "pointers" to them are always even.
; Header block (starts at word 0 of the directory):
; # of name blocks
; Pointer to name lookup table
; # of address blocks
; Pointer to address lookup table
; # words occupied by entry blocks
; Pointer to first entry block
; Name lookup table (ordered alphabetically by name):
; Pointer to name block
; Pointer to name block
; ...
; Pointer to name block
; Address lookup table (ordered by value of (net,host,socket)):
; Pointer to address block
; Pointer to address block
; ...
; Pointer to address block
; Entry block:
; Pointer to first name block for entry
; Pointer to first address block for entry
; Number of attributes
; Pointer to first attribute name
; Pointer to first attribute value
; ...
; Pointer to last attribute name
; Pointer to last attribute value
; Name block:
; Pointer to next name block for same entry, or 0
; Pointer to owning entry block
; Name string
; Address block:
; Pointer to next address block for same entry, or 0
; Pointer to owning entry block
; Net (8 bits), Host (8 bits)
; Socket (32 bits)
; Number of attributes
; Pointer to first attribute name
; Pointer to first attribute value
; ...
; Pointer to last attribute name
; Pointer to last attribute value
; Attribute block (name or value):
; Attribute string
IFNDEF REL6,<REL6==1>
IFE REL6,<DEFINE XSWAPCD <SWAPCD>>
IFE REL6,<DEFINE CALLM(ARG) <CALL ARG>>
IFN REL6,<DEFINE CALLM(ARG) <
CALL @[XWD MSEC1,ARG]
>
; AC definitions
DEFAC(UNIT,Q1)
DEFAC(IOS,Q2)
DEFAC(E,Q3)
DEFAC(F,P1)
DEFAC(JFN,P2)
DEFAC(PF,P3)
; Local storage
; Care must be taken when moving PUP storage definitions around. We leave a
; one page buffer zone between the end of the PUP buffer storage and the
; beginning of the mapped directory. These definitions assume that the net
; directory is the last piece of storage in the PUPSEC section.
EXTERN PBSTGE ;Get end of Pup buffer space
EXTERN PUPSEC ;Which section to map net directory into
ENTDIR==PBSTGE+PGSIZ ;Base address of network directory
NTDSIZ==:<1000000-ENTDIR>/PGSIZ ;Calculate how many pages we have
NR NAMLTP ;AOBJN pointer to name lookup table
NR ADRLTP ;AOBJN pointer to address lookup table
RS NTDUSE ;Use count: +1 for every active user of ENTDIR
RS NTDLCK ;Lock against modifying ENTDIR or incrementing NTDUSE
; Storage defined in PUP
EXTERN NTDVER ;Version # of (SYSTEM)PUP-NETWORK.DIRECTORY
XSWAPCD
NETBAS: XWD PUPSEC,ENTDIR ;Base address of network directory
; Initialize network directory SMON
; Returns to user+1:Success
; ITRAP on error
IFE REL6,<NTDINI::>
IFN REL6,<XNENT NTDINI,G>
STKVAR <NTDJFN> ;Netword directory JFN
NTDIN1: NOINT ;Don't leave a JFN around
MOVX T1,GJ%OLD!GJ%SHT!GJ%PHY!GJ%ACC ;Old file, name from string
HRROI T2,[ASCIZ/SYSTEM:PUP-NETWORK.DIRECTORY/]
SKIPN SYSIFG ;Is system initialized?
HRROI T2,[ASCIZ/<SYSTEM>PUP-NETWORK.DIRECTORY/] ;No
GTJFN% ;Get the jfn
ITERR() ;Failed, pass error back
HRRZM T1,NTDJFN ;Save jfn
MOVX T2,FLD(^D18,OF%BSZ)!OF%RD ;18-bits, read access
OPENF% ;Open file
ITERR(,<MOVE T1,NTDJFN ;Jfn
RLJFN% ;Release it
NOP
MOVE T1,LSTERR>) ;Propagate error
SIZEF% ;Get # pages in file
BUG.(HLT,NTDINA,PUPNM,SOFT,<PUPNM - Impossible failure of SIZEF>)
CAILE T3,NTDSIZ ;Too big to map?
ITERR(MLKBX2,< MOVE T1,NTDJFN ;JFN for NTDCLS
CALL NTDCLS >) ;Yes, "Too many pages to be locked"
; Lock out all access to the network directory before changing it
SKIPN SYSIFG ;System initialized?
SETOM NTDLCK ;No, unlock NTDLCK
LOCK(NTDLCK) ;Get the lock
SKIPN NTDUSE ;Directory in use?
IFSKP.
UNLOCK(NTDLCK) ;Yes, must wait
MOVE T1,NTDJFN ;Close the file
CALL NTDCLS
OKINT ;No longer have JFN to protect, allow ^C
MOVEI T1,NTDUSE
CALL DISE ;Dismiss until NTDUSE zero
JRST NTDIN1 ;Then try again
ENDIF.
;Read into monitor VAS using sequential I/O. No page mapping support for
; addresses in non-zero/one sections as of Release 5.3.
MOVE T1,NTDJFN ;Get JFN
MOVE T2,[G1BPT(PUPSEC,^D18,ENTDIR)] ;Pointer to string "buffer"
;; MOVE T2,[740000+PUPSEC,,ENTDIR]
MOVN T3,T3 ;Get negative page count
IMULI T3,2*PGSIZ ;Number of 18-bit bytes per page
SIN ;Slurp up the file
IFJER.
MOVE T1,NTDJFN ;An error, get the JFN
GTSTS% ;Get status bits
TXNE T2,GS%EOF ;At end of file on read?
IFSKP.
MOVE T1,NTDJFN ;No, some other lossage. Get back JFN.
CALL NTDCLS ;Close the file
UNLOCK(NTDLCK) ;Unlock network directory
OKINT ;Reallow PSI
MOVE T1,LSTERR ;Get last error
ITERR() ;Take an error return
ENDIF.
ENDIF.
; Done mapping pages, now setup some derived constants
MOVE T1,NTDJFN ;Recover JFN
MOVX T2,<1,,.FBGEN> ;Get file version
MOVEI T3,T3
GTFDB%
HLRZM T3,NTDVER ;Store for return by PUPNM
MOVE T3,NETBAS ;Get pointer to base of directory
MOVE T1,0(T3) ;Get name count, pointer
CALL NTDCNV ;Convert to -count,,pointer
MOVEM T1,NAMLTP ;Store name lookup table ptr
MOVE T1,1(T3) ;Get address count, pointer
CALL NTDCNV ;Convert to -count,,pointer
MOVEM T1,ADRLTP ;Store address lookup table ptr
UNLOCK(NTDLCK) ;Make new ENTDIR available
MOVE T1,NTDJFN ;Close the
CALL NTDCLS ; net directory file
OKINT ;No longer have to protect the JFN
JRST MRETN ;Done
; NTDINI (cont'd)
; T1/ JFN
NTDCLS: CLOSF% ;Close file (pages stay mapped)
BUG.(CHK,NTDINC,PUPNM,SOFT,<PUPNM - CLOSF% failure>)
RET ;Return
; Convert ENTDIR lookup pointer to usable form
; T1/ BYTE(16) count, pointer
; Returns +1:
; T1/ -count ,, pointer
; Clobbers T2
NTDCNV: LSHC T1,-^D20 ;Right-justify count
MOVN T1,T1 ;Negate count
LSH T1,2 ;Vacate 2 low-order bits
LSHC T1,^D16 ;Make -count,,pointer
RET
; Do Pup name/address translation
; 1/ Source/destination designator (must be string ptr if source)
; 2/ B0 off: Lookup address pointed to by 2, output resulting
; name string to 1 (or attribute string if B4 on)
; on: Lookup name string given by 1, return address(es)
; in block pointed to by 2
; B1 off: Output something for each field (B0 off)
; Do not allow recognition (B0 on)
; on: Omit fields where possible (B0 off)
; Allow recognition (B0 on)
; B2 off: Error if address not found (B0 off)
; on: Output octal numbers for unknown fields
; B3 on: Return address block pointer in 3 (B0 off)
; B4 on: Lookup attribute name string given by 4, output
; corresponding attribute value string to 1
; (B0 must be off, and B4 on suppresses outputting
; of name string and forces B2 off)
; B9-17: Block length (words) (ignored unless B0 on)
; B18-35: Block address
; 4/ Destination designator for attribute value string (B4 on)
; Returns +1: Unsuccessful, 1/ Error #
; +2: Successful
; 1/ Updated where relevant (string pointer)
; 2/ Updated only if B0 on:
; LH: # words used in block (i.e. 2*number of
; matching addresses, which can be greater
; than the number of words in the block)
; RH: Unchanged
; 3/ LH: Version # of (SYSTEM)PUP-NETWORK.DIRECTORY
; RH: 16-bit byte address of first word of address
; block (if B3 on in call 2). Zero if not found.
; 4/ Updated where relevant
; Block format (pointed to by 2), any number of repetitions of:
; Net ,, Host
; Socket
; Errors:
; PUPNX1 Name or address not found
; PUPNX2 Recognition invoked and name ambiguous
; PUPNX3 Syntax error or illegal address
; PUPNX4 Inconsistent overlapping elements in name string
; PUPNX5 Syntax error in attribute name string
; PUPNX6 Attribute name not found
DEFINE ERRX(ERRORN,EXTRA,OP<JRST>) <
OP [ EXTRA
IFNB <ERRORN>,<MOVEI T1,ERRORN>
JRST PNMERR]
>
PNMADR==0 ;Offset of address temp region (6 words)
PNMSTR==6 ;Offset of string temp region (8 words)
PNMTSZ==PNMSTR+8 ;Size of temp region
IFE REL6,<.PUPNM::>
IFN REL6,<XNENT .PUPNM,G>
MCENT ;Enter monitor context
UMOVE JFN,1 ;Get user's source/destination designator
UMOVE PF,2 ;Get user's flags
CALLM CHKJFA ;Check its validity
RETERR() ;Bad designator
CAIE T1,JF%BYP ;Is it a special designator?
IFSKP.
TXNN JFN,.LHALF ;Yes, is it a byte pointer
RETERR(DESX1) ;No, don't want other special designators
TLC JFN,-1
TLCN JFN,-1
HRLI JFN,(POINT 7) ;Make -1,,<addr> into POINT 7,ADDR
UMOVEM JFN,1 ;Make sure user copy is updated
JRST PUPNM0 ;Join main code
ENDIF.
CAIE T1,JF%FIL ;File?
CAIN T1,JF%TTY ;or TTY?
JUMPL PF,[RETERR(DESX1)] ;Neither good if doing input
PUPNM0: XMOVEI E,1(P) ;Set up base address of monitor buffer
ADJSP P,PNMTSZ ;Advance P past temp region
IFE REL6,<ERJMP MSTKOV ;Make sure no overflow>
NOINT
LOCK(NTDLCK) ;Lock network directory
AOS NTDUSE ;Bump use count
UNLOCK(NTDLCK) ;Unlock network directory
JUMPL PF,PNMNTA ;Jump if looking up name
; JRST PNMATN
; PUPNM (cont'd)
; Do address to name conversion (or output attributes for address)
PNMATN: UMOVE T2,2 ;Get address arguments
UMOVE T1,0(T2) ; from user block
UMOVE T2,1(T2)
TDNN T1,[777400,,777400] ;Range check
TLNE T2,740000 ;socket too
ERRX(PUPNX3) ;Illegal address
; Reformat address to be the same as in the network directory
LSH T2,4 ;Left-justify socket
LSHC T1,^D10 ;Left-justify net
HLLZM T1,PNMADR(E) ;Store (net)B7
LSHC T1,6 ;T1/ (host)B19 + (high socket)B35
LSH T1,4 ;T1/ (host)B15 + (high socket)B31
IORM T1,PNMADR(E) ;Store host, high socket
MOVEM T2,PNMADR+1(E) ;Store low socket
; Lookup the complete address
MOVEI T2,PNMADR(E) ;Pointer to key address
CALL ADRSRC ;Lookup address
IFSKP.
MOVEI IOS,(T1) ;Save pointer to address block
ELSE.
TXNE PF,PN%OCT ;Not found, is that ok?
TXNE PF,PN%ATT
ERRX(PUPNX1) ;No, give error
SETZB T1,IOS ;Yes, note no match yet
ENDIF.
; Generate name string and return address block ptr if desired
TXNN PF,PN%ATT ;Unless looking up attribute,
CALL PNMWRT ; write name string for address
TXNN PF,PN%ADR!PN%ATT ;Anything more to do?
JRST PNMXT ;No
SKIPN T1,IOS ;Yes, have address block pointer?
IFSKP.
LSHC T1,-1 ;Convert address table ptr
LSH T2,-^D35 ; to word and byte number
ADD T1,NETBAS ;Add base address
LDB IOS,[ POINT 16,(T1),15 ;Get ptr to address block
POINT 16,(T1),31 ](T2)
HRL IOS,NTDVER ;Return version # in lh
ENDIF.
TXNE PF,PN%ADR ;Want to return pointer to user?
UMOVEM IOS,3 ;Yes, do so
TXNN PF,PN%ATT ;Want to look up attribute?
JRST PNMXT ;No, done
; PUPNM (cont'd)
; Look up attribute for address
UMOVE T1,4 ;Get attribute name from user
TLC T1,-1 ;Convert -1 lh to string ptr
TLCN T1,-1
HRLI T1,(POINT 7)
UMOVEM T1,4 ;Put back in case changed
CALL PNMSIN ;Read string from user
ILDB T3,4 ;Inst to "XCTUU" to get char
ERRX(PUPNX5) ;Error, no characters
ERRX(PUPNX5,,<JUMPN T3,>) ;Give error if not null terminator
HRRZ T1,IOS ;Get address block pointer
LSH T1,-1 ;Make Maxc offset
ADD T1,NETBAS ;Add base address
LDB T1,[POINT 15,0(T1),30] ;Get ptr to entry block
ADD T1,NETBAS ;Add base address
LDB T2,[POINT 16,1(T1),15] ;Get number of attributes
ERRX(PUPNX6,,<JUMPE T2,>) ;Error if none
MOVNS T2 ;Negate
SUB T1,NETBAS ;Get back word offset
LSH T1,1 ;Convert to pointer to 16-bit bytes
ADDI T1,3 ;Point to first attribute name ptr
HRLI T1,(T2) ;Make AOBJN pointer
MOVEI T2,PNMSTR(E) ;Make string ptr to input
HRLI T2,(POINT 7)
; Loop to compare user's string to attribute names for entry
PNMAT5: CALL CMPATR ;Compare string to attribute name
JRST PNMAT6 ;String ( entry
JRST PNMAT6 ;String ) entry
MOVEI T1,1(T1) ;String = entry, advance to value ptr
LSHC T1,-1 ;Convert to Maxc word and byte
LSH T2,-^D35
ADD T1,NETBAS ;Add base address
LDB T1,[POINT 15,(T1),14 ;Get ptr to attribute value
POINT 15,(T1),30](T2)
ADD T1,[G1BPT(PUPSEC,^D8,ENTDIR)] ;Make byte ptr
ILDB T3,T1 ;Get byte count
DO.
ILDB T2,T1 ;Get char from attribute value
CALLM BOUTA ;Output via caller's ac1
SOJG T3,TOP. ;Repeat for all bytes
ENDDO.
JRST PNMXT ;Done
; Here when string doesn't match this attribute name
PNMAT6: ADDI T1,1 ;So pointer will advance by 2
AOBJN T1,PNMAT5 ;Try next attribute
ERRX(PUPNX6) ;No more, fail
; PUPNM (cont'd)
; Do name to address conversion
PNMNTA: MOVEI F,PNMADR(E) ;Make AOBJN pointer to temp
HRLI F,-6 ; address region
PNMNT1: SETZM 0(F) ;Init address
SETZM 1(F)
CALL PNMSIN ;Get a string
ILDB T3,1 ;Inst to "XCTUU" to get char
JRST PNMNT0 ;None, check if start of octal constant
JUMPGE T4,PNMNT3 ;Jump if numeric
PUSH P,T3 ;Save user terminator
CALL PNMLUK ;Look up string
POP P,T3 ;Restore terminator
HRROM T1,0(F) ;Store entry pointer
JRST PNMNT4 ;On to next
; Here when string was empty
PNMNT0: CAIE T3,"#" ;Start of octal constant?
ERRX(PUPNX3) ;No, syntax error
; Here to do octal constants
PNMNT2: CALL PNMSIN ;Get next field
ILDB T3,1 ;Inst to "XCTUU" to get char
TDZA T4,T4 ;Empty means zero
ERRX(PUPNX3,,<JUMPL T4,>) ;Error if non-numeric string
PNMNT3: EXCH T4,1(F) ;Store new socket, get old
MOVE T1,0(F) ;Get old net/host
TLNN T1,-1 ;Error if already had net
CAILE T4,377 ;Error if new host too big
ERRX(PUPNX3)
HRLI T1,(T4) ;Net_Host, Host_Socket
MOVSM T1,0(F)
CAIN T3,"#" ;More numbers?
JRST PNMNT2 ;Yes, continue
; Repeat if necessary for next field
PNMNT4: ADD F,BHC+2 ;Advance field pointer
CAIN T3,"+" ;More fields?
JUMPL F,PNMNT1 ;Yes, go process
CAIE T3,"+" ;Error if have special char now
CAIN T3,"#"
ERRX(PUPNX3)
; Now check all input fields for consistency, and return all
; possible addresses by iterating names over all their values
SUBI F,PNMADR(E) ;Compute # words input
HRLOI F,-1(F) ;Reset AOBJN pointer
EQVI F,PNMADR(E)
UMOVE IOS,2 ;Get block pointer from user
TLZ IOS,(-1B8)
TLC IOS,-1 ;Make AOBJN pointer to user block
ADD IOS,[1,,0]
SETZB T1,B ;Init merged address to zero
CALL PNMEAD ;Emit address(es)
UMOVE T1,2 ;Get user block pointer again
SUBI IOS,(T1) ;Compute # words used
TRNN IOS,-1 ;Did we emit any addresses?
ERRX(PUPNX4) ;No, means no consistent combinations
XCTU [HRLM IOS,2] ;Yes, return count
; Here on success exit.
PNMXT: SOSGE NTDUSE ;Decrement directory use count
BUG.(CHK,PNMXIT,PUPNM,SOFT,<PUPNM - Over-decremented NTDUSE>)
ADJSP P,-PNMTSZ ;Backup P over temp region
JRST SKMRTN ;Skip return
; Here on error exit
PNMERR: SOSGE NTDUSE ;Decrement directory use count
BUG.(CHK,PNMERX,PUPNM,SOFT,<PUPNM - Over-decremented NTDUSE>)
RETERR() ;Take error return
; PUPNM subroutines
; Write name for address
; T1/ Address lookup table index for block matching entire
; address (0 if none)
; E/ Temp block pointer
; PF/ Flags,,0
; PNMADR(E)/ BYTE(8) Net, Host (16) High socket
; PNMADR+1(E)/ BYTE(16) Low socket (rest zeroes)
; If B1 of PF is off, outputs all fields separately, with
; punctuation between fields.
; If B1 is on, simply outputs the first name for that entry, if found.
; Returns +1 always
; Clobbers T1-T4, UNIT
PNMWRT: MOVEI UNIT,2 ;Set initial state
JRST PNMWR0 ;Perform conversion
; Recursive calls here for preceding fields
PNMWRA: XMOVEI T2,PNMADR(E) ;Set ptr to key address
CALL ADRSRC ;Search directory for address
SETZ T1, ;Not found, remember so
; Here with T1/ index of matching entry, or zero
PNMWR0: TXNE PF,PN%FLD ;Want field omission?
JUMPN T1,PNMWR3 ;Yes, if found entry just print it
JUMPE UNIT,PNMWR2 ;Skip following if state=0
PUSH P,T1 ;Save entry pointer if have one
PUSH P,PNMADR(E) ;Save address being looked up
PUSH P,PNMADR+1(E)
HRRZ T1,UNIT ;Make into pointer
MOVE T1,FLDMSK(T1) ;Mask to just preceding fields
ANDB T1,PNMADR(E)
JUMPE T1,PNMWR1 ;Do nothing if all zero
SETZM PNMADR+1(E)
SUBI UNIT,1 ;State _ State-1
CALL PNMWRA ;Recursive call for preceding field(s)
ADDI UNIT,1 ;Back to current state
PNMWR1: POP P,PNMADR+1(E) ;Restore address
POP P,PNMADR(E)
POP P,T1 ;Restore entry pointer
PNMWR2: HRRZ T2,UNIT ;Make into pointer
MOVE T2,FLDMSK(T2) ;Mask out preceding fields
ANDCAB T2,PNMADR(E) ;(Following fields masked by caller)
SKIPN PNMADR+1(E) ;Current field zero?
JUMPE T2,PNMWR7 ;If so, print zero or nothing
JUMPN T1,PNMWR3 ;Print name and exit if have entry
XMOVEI T2,PNMADR(E) ;Set ptr to key address
CALL ADRSRC ;Lookup just this field
JRST PNMWR8 ;Not found
; PNMWRT (cont'd)
; Here to output first name string for entry
; T1/ Address table pointer (as returned by ADRSRC)
PNMWR3: TLON UNIT,(1B1) ;Preceding field printed?
JRST PNMWR5 ;No, no prefix needed
JUMPGE UNIT,PNMWR4 ;Yes, numeric?
MOVEI T2,"#" ;Yes, output 3-state# trailing #'s
HRREI T3,-3(UNIT)
DO.
CALLM BOUTA ;Assumed not to clobber T1
AOJL T3,TOP.
ENDDO.
PNMWR4: MOVEI T2,"+" ;Now separator
CALLM BOUTA
PNMWR5: TLZ UNIT,(1B0) ;Remember symbolic field printed
MOVEI T1,(T1) ;Clear lh
LSHC T1,-1 ;Compute word address and remainder
LSH T2,-^D35 ; for address lookup table entry
ADD T1,NETBAS ;Add base address
LDB T1,[POINT 15,(T1),14 ;Get ptr to address block
POINT 15,(T1),30](T2)
ADD T1,NETBAS ;Add base address
LDB T1,[POINT 15,(T1),30] ;Get ptr to entry block
ADD T1,NETBAS ;Add base address
LDB T1,[POINT 15,(T1),14] ;Get ptr to name block
ADD T1,[G1BPT(PUPSEC,^D8,ENTDIR+1)] ;Make byte ptr
ILDB T3,T1 ;Get byte count
DO.
ILDB T2,T1 ;Get byte
CALLM BOUTA ;Output it (via caller's ac1)
SOJG T3,TOP. ;Repeat for all bytes
ENDDO.
RET ;Return from PNMWRT
; Here if current field is zero
PNMWR7: JUMPL UNIT,PNMWR8 ;Preceding numeric field printed?
CAIE UNIT,2 ;Last field and none printed yet?
RET ;No, do nothing
; Here to print field value as octal number
PNMWR8: TLNN UNIT,(1B1) ;Preceding field printed?
JRST PNMWR9 ;No, no prefix needed
MOVEI T2,"+" ;Yes, use "+" if symbolic
TLNE UNIT,(1B0) ;"#" if numeric
MOVEI T2,"#"
CALLM BOUTA ;Output separator
PNMWR9: MOVE T1,PNMADR(E) ;Fetch the address
MOVE T2,PNMADR+1(E)
HRRZ T3,UNIT ;Make into pointer
XCT FLDRJB(T3) ;Right-justify field in B
CAIE UNIT,2 ;Last field and none printed yet?
JUMPE T2,PNMWRX ;No, don't print if zero
PUSH P,E ;Save (clobbered by NOUTX)
MOVEI T3,10 ;Octal radix
CALLM NOUTX ;Print value of field in octal
BUG.(HLT,PNMWRB,PUPNM,SOFT,<PUPNM - Impossible return from NOUTX>)
POP P,E
PNMWRX: TLO UNIT,(1B0+1B1) ;Remember numeric field printed
RET ;Return from PNMWRT
; State-indexed tables controlling the operation of PNMWRT
; Mask covering all preceding fields
FLDMSK: 0
-1B7
-1B15
; Instruction to right-justify current field in B
FLDRJB: LSHC T1,-^D<72-8> ;Right-justify net
LSHC T1,-^D<72-16> ;Right-justify host
CALL [LSH T1,-4 ;Right-justify socket
LSHC T1,-^D<36-16>
RET]
; Get string or octal number from user
; E/ pointer to storage block
; +1: Instruction to "XCTUU" to get next char into C
; KI-10 change: XCTUU [ILDB ac,ptr] on the KI-10 does the adr
; calculation for the ptr in monitor space. Thus the ptr is
; put in JFN before calling PNMSIN.
; Returns +2: No characters input before terminator
; +3: At least one character input before terminator
; T3/ Terminating character (on either return)
; T4/ Numeric value if all chars were digits, or -1 if not
; Does not return if error (string too long)
; Input terminates on "+", "#" or any character outside the range
; 41-176. If called from monitor, "!" is also a terminator
; (for the sake of GTJFN). The terminator is not stored
; in the buffer. Lower-case letters are converted to upper.
; Clobbers T1-T4
PNMSIN: PUSH P,F ;Save another ac
MOVEI T2,PNMSTR(E) ;Make storage byte pointer
HRLI T2,(POINT 7)
MOVEI T1,^D39 ;Max # chars
SETZ T4, ;Init number
PNMSI1: XCTBUU @-1(P) ;Get next char
ERRX(ILLX01,,ERJMP) ;Illegal memory read
CAIE T3,"+" ;One of special chars?
CAIN T3,"#"
JRST PNMSI3 ;Yes, terminate
CAIL T3,41 ;In range of printing characters?
CAILE T3,176
JRST PNMSI3 ;No, terminate
CAIN T3,"!" ;Special terminator for GTJFN?
JRST [ XSFM F ;STORE FLAGS
TLNN F,(1B6) ;Yes, call from monitor?
JRST PNMSI3 ;Yes, terminate on that
JRST PNMSI2] ;No, treat as ordinary character
CAIL T3,"0" ;An octal digit?
CAILE T3,"7"
JRST PNMSI2 ;No, try other things
LSH T4,3 ;Yes, shift previous number
TLNN T4,740000 ;Skip if too big or not number
TROA T4,-"0"(T3) ;Ok, add value of new digit
PNMSI2: SETO T4, ;Not ok, remember can't be number
ERRX(PUPNX3,,<SOJL T1,>) ;If too long, give syntax error
CAIL T3,"a" ;Lower case letter?
CAILE T3,"z"
CAIA ;No
SUBI T3,40 ;Yes, make upper
IDPB T3,T2 ;Ok, store char
JRST PNMSI1 ;Back for more
; Here when hit end of input string
PNMSI3: CAIE T1,^D39 ;Were any characters input?
AOS -1(P) ;Yes, preset +3 return
SETZ T1, ;Append null
IDPB T1,T2
POP P,F ;Restore saved ac
RETSKP ;Done, return +2 or +3
; Lookup string and do recognition if appropriate
; E/ Pointer to temp block containing string
; User ac1/ Byte pointer to input string terminator
; Does not return if error
; Returns +1: T1/ 16-bit byte address of directory entry
PNMLUK: MOVEI T2,PNMSTR(E) ;Make pointer to string
HRLI T2,(POINT 7)
CALL NAMSRC ;Lookup name string
JRST PNMLU1 ;Key # entry, might be substring
JRST PNMLU5 ;Key = entry, success
; If key ( entry, it might be a substring
PNMLU1: JUMPGE T1,PNMLUF ;Fail if off end of table
XCTBUU [LDB T3,1] ;Get terminating char of input
ERRX(ILLX01,,ERJMP) ;Illegal memory read
JUMPN T3,PNMLUF ;Can't recognize if not null terminator
TLNN PF,(1B1) ;Recognition allowed?
PNMLUF: ERRX(PUPNX1) ;No, just fail
AOBJP T1,PNMLU2 ;Look at next entry if have one
CALL CMPNAM ;Check for match
ERRX(PUPNX2,,<JUMPN T4,>) ;Ambiguous if also substring
JRST PNMLU2 ;Did not match, continue
BUG.(HLT,PNMLUA,PUPNM,SOFT,<PUPNM - Unexpected +3 return from CMPNAM>)
PNMLU2: SUB T1,BHC+1 ;Back to current entry
CALL CMPNAM ;Check for match
JUMPN T4,PNMLU3 ;Jump if substring
ERRX(PUPNX1) ;Not found
BUG.(HLT,PNMLUB,PUPNM,SOFT,<PUPNM - Unexpected +3 return from CMPNAM>)
; Got unique initial substring.
; Now have T1/ Name table pointer,
; T3/ Char count, T4/ String pointer to tail
PNMLU3: ILDB T2,T4 ;Get first char of tail
XCTUU [DPB T2,1] ;Overwrite null at end of input
ERRX(ILLX02,,ERJMP) ;Illegal memory write
SOJLE T3,PNMLU4 ;Check count
PNML3A: ILDB T2,T4 ;Append rest of tail to input
XCTUU [IDPB T2,1]
ERRX(ILLX02,,ERJMP) ;Illegal memory write
SOJG T3,PNML3A
PNMLU4: UMOVE T2,1 ;Copy pointer
XCTBU [IDPB T3,2] ;Append null without changing pointer
ERRX(ILLX02,,ERJMP) ;Illegal memory write
; Success: Set pointer to directory entry and return
; Rh T1/ 16-bit byte address of matching name table entry
PNMLU5: MOVEI T1,(T1) ;Just rh
LSHC T1,-1 ;Compute word adr and remainder
LSH T2,-^D35
ADD T1,NETBAS ;Add base address
LDB T1,[POINT 15,(T1),14 ;Get ptr to name block
POINT 15,(T1),30](T2)
ADD T1,NETBAS ;Add base address
LDB T1,[POINT 16,(T1),31] ;Get ptr to dir entry
RET ;Return
; Emit address(es) and do consistency checking (recursively)
; T1/ Net,,Host so far compiled
; T2/ Socket so far compiled
; F/ AOBJN ptr to address table
; Entries are 2 words each,
; Net,,Host and Socket, or
; -1,,Dir entry ptr and 0
; IOS/ AOBJN ptr to user block to return addresses in
; Returns +1: IOS/ Updated AOBJN pointer
; This routine iterates recursive calls of itself over all
; possible addresses corresponding to fields which are names.
; Each branch is followed until either (a) an address is
; encountered with a nonzero field that conflicts with the
; address so far compiled, in which case that branch is
; terminated, or (b) the end of the branch is reached (i.e.
; all fields have been used up), in which case the compiled
; address is passed back to the user (and IOS is advanced).
; Clobbers T1-T4, F
PNMEAD: JUMPGE F,PNMEA7 ;Emit address if at terminal node
SKIPGE T3,0(F) ;Numeric field?
JRST PNMEA2 ;No, symbolic
; Here for numeric field
MOVE T4,1(F) ;Get socket too
CALL PNMMRG ;Merge and check consistency
RET ;Inconsistent, terminate branch
ADD F,BHC+2 ;Ok, advance to next field
JRST PNMEAD ;Merge it in too
; Here for symbolic field
PNMEA2: STKVAR <<PNMADS,2>,PNMPTR>
DMOVEM T1,PNMADS ;Save address and socket
MOVEI T1,(T3) ;Just right half
LSH T1,-1 ;Make word address
ADD T1,NETBAS ;Add base address
LDB T1,[POINT 15,(T1),30] ;Get adr of first address block
PNMEA3: ADD T1,NETBAS ;Add base address
MOVEM T1,PNMPTR ;Save address block pointer
MOVE T3,1(T1) ;Get address from block
MOVE T4,2(T1)
LSH T3,-4 ;Reformat to net,,host and socket
LSHC T3,-^D16
LSH T4,-4
MOVE T1,T3
LSH T1,^D<18-8>
ANDI T3,377
HLL T3,T1
DMOVE T1,PNMADS ;Restore saved address
CALL PNMMRG ;Merge and check consistency
IFSKP.
PUSH P,F ;Save current field pointer
ADD F,BHC+2 ;Advance to next field
CALL PNMEAD ;Recursive call to process it
POP P,F ;Restore field pointer
ENDIF.
MOVE T1,PNMPTR ;Recover address block adr (already global)
LDB T1,[POINT 15,0(T1),14] ;Get adr of next address block
JUMPN T1,PNMEA3 ;Loop if more
RET
; Here to emit address in T1,B
PNMEA7: JUMPGE IOS,.+2 ;Don't store if block exhausted
UMOVEM T1,(IOS) ;Store address in block
AOBJP IOS,.+2
UMOVEM T2,(IOS)
AOBJP IOS,.+1
RET
; Merge addresses and check consistency
; T1,T2/ Current address
; T3,T4/ Address to be merged in
; Returns +1: Inconsistent, ac's unchanged
; +2: Consistent, T1,T2/ Combined address
PNMMRG: STKVAR <<PNMCUR,2>> ;Save current address
DMOVEM T1,PNMCUR
XORM T3,PNMCUR ;Compute differences
XORM T4,1+PNMCUR
TLNE T1,-1 ;Unspecified net?
TLNN T3,-1
HRRZS PNMCUR ;Yes, scratch that difference
TRNE T1,-1 ;Unspecified host?
TRNN T3,-1
HLLZS PNMCUR ;Yes, that's a match
SKIPE T2 ;Unspecified socket?
SKIPN T4
SETZM 1+PNMCUR ;Yes, match
SKIPN PNMCUR ;Any inconsistencies?
SKIPE 1+PNMCUR
RET ;Yes, give fail return
IOR T1,T3 ;No, now do the merge
IOR T2,T4
RETSKP
; Binary search comparison routines for network directory lookup.
; See BINSRC for further details of calling sequence.
; BINSRC entry to do address lookup
; T2/ Key (see CMPADR)
ADRSRC: MOVE T1,ADRLTP ;Set address lookup table ptr
JSP T3,BINSRC ;Do binary search
; Compare network address
; rh T1/ 16-bit byte address of address lookup table entry,
; which is in turn the 16-bit byte address of the
; address block itself (which is guaranteed to start
; on a 36-bit word boundary)
; T2/ (key) pointer to address being looked up, in the form
; BYTE(8) net, host (16) high 16 bits of socket
; BYTE(16) low 16 bits of socket (rest of word zero)
CMPADR: MOVEI T3,(T1) ;Copy byte address of entry
LSHC T3,-1 ;Divide by 2 to get Maxc word adr
LSH T4,-^D35
ADD T3,NETBAS ;Add base address
LDB T3,[POINT 15,(T3),14 ;Fetch entry/2
POINT 15,(T3),30](T4)
JFCL 17,.+1 ;Clear flags
ADD T3,NETBAS ;Add base address
MOVE T4,1(T3) ;Get first word of entry
TRZ T4,17 ;Clear garbage bits
SUB T4,0(T2) ;Compare with key
JUMPN T4,CMPAD1 ;Jump if not equal
JFCL 17,.+1 ;Equal, clear flags again
MOVSI T4,(177777B15) ;Get second word of entry (16 bits)
AND T4,2(T3) ;(pointer is already global)
SUB T4,1(T2) ;Compare with key
JUMPE T4,SK2RET ;Return +3 if equal
CMPAD1: JCRY0 CPOPJ ;Return +1 if key ( entry
RETSKP ;Return +2 if key ) entry
; BINSRC entry to do name lookup
; T2/ Key (see CMPNAM)
NAMSRC: MOVE T1,NAMLTP ;Set name lookup table ptr
JSP T3,BINSRC ;Do binary search
; Compare network name
; rh T1/ 16-bit byte address of name lookup table entry,
; which in turn contains the 16-bit byte address of
; the name block itself (which is guaranteed to start
; on a 36-bit word boundary)
; T2/ (key) Byte pointer to ASCIZ string being looked up.
; All letters must be upper-case.
; Note lower-case letters are treated the same as upper case
; when they appear in the name block.
; As an additional bonus, on the +1 return (key ( entry), if the
; key is an initial substring of the entry,
; T3/ Count of characters in tail
; T4/ String pointer to tail
; T4 is zero in all other cases.
CMPNAM: SKIPA T4,[G1BPT(PUPSEC,^D8,ENTDIR+1)] ;Name string offset in name block
; Enter here to compare attribute name
CMPATR: MOVE T4,[G1BPT(PUPSEC,^D8,ENTDIR)] ;Attribute string offset in block
PUSH P,T1 ;Need more ac's
PUSH P,T2
PUSH P,E
PUSH P,T4 ;Save offset
MOVEI T3,(T1) ;Copy byte address of entry
LSHC T3,-1 ;Divide by 2 to get word address
LSH T4,-^D35
ADD T3,NETBAS ;Add in base address
LDB T4,[ POINT 15,(T3),14 ;Fetch entry/2
POINT 15,(T3),30](T4)
POP P,T3 ;Recover offset in block
ADD T4,T3 ;Make one word global byte ptr to string
ILDB T3,T4 ;Get byte count
CMPNA1: SOJGE T3,.+2 ;Name string exhausted?
TDZA T1,T1 ;Yes, use null
ILDB T1,T4 ;No, get char from name string
CAIL T1,"a" ;Lower case letter?
CAILE T1,"z"
CAIA ;No
SUBI T1,40 ;Yes, make upper case
ILDB E,B ;Get char from string being looked up
CAIL E,(T1) ;Compare characters
IFSKP.
JUMPN E,CMPNA3 ;Key ( entry, return +1
SETO E, ;Else get -1
ADJBP E,T4 ;To back up byte pointer
MOVE T4,E ;Put byte pointer in proper place
AOJA T3,CMPNA4 ;Fix count and return
ENDIF.
CAILE E,(T1)
JRST CMPNA2 ;Key ) entry, return +2
JUMPN E,CMPNA1 ;Key char = entry, look at next
AOS -3(P) ;End, matched, return +3
CMPNA2: AOS -3(P)
CMPNA3: SETZ T4, ;Note key not initial substring
CMPNA4: POP P,E ;Restore ac's
POP P,T2
POP P,T1
RET
; Perform binary search
; T1/ -length ,, address of table to search
; T2/ Search key
; T3/ Routine to call to compare key to entry
; Returns +1: Not found, T1 points to smallest entry ) key
; +2: Found, T1 points to matching entry
; In both cases, T1 is still in AOBJN pointer format. In the
; +1 return, the lh is positive if T1 points past end of table.
; Clobbers T1-T4
; The comparison routine must operate as follows:
; T1/ Address of table entry to compare in rh
; T2/ Search key (as passed to BINSRC)
; Returns +1: Key ( Entry
; +2: Key ) Entry
; +3: Key = Entry
; T3 and T4 may be clobbered freely, others must be protected
BINSRC: PUSH P,T3 ;Save routine to call
PUSH P,E ;Save another temp
HLRE T3,T1 ;Get negative table length
MOVN T3,T3 ;Make positive
JFFO T3,.+2 ;Find position of first 1
JRST BINSRF ;Empty table, fail
MOVE E,BITS(T4) ;Compute largest power of 2 (= table length
HRLI E,(E) ;Put in both halves
SUB T1,BHC+1 ;Backup ptr to one before table
BINSR1: ADD T1,E ;Add increment to table pointer
BINSR2: LSH E,-1 ;Halve increment (both halves)
TRZ E,400000
JUMPGE T1,BINSRL ;Jump if off end of table
CALL @-1(P) ;Call routine to do compare
JRST BINSRL ;Key ( entry
JRST BINSRG ;Key ) entry
AOSA -2(P) ;Key = entry, set skip return
; Here to add 1 to pointer and fail return
BINSR3: AOBJN T1,.+1
; Here to fail return
BINSRF: POP P,E ;Restore ac's
POP P,T3
RET
; Here if key ( entry, or past end: backup table pointer
BINSRL: JUMPE E,BINSRF ;Fail if increment zero
SUB T1,E ;Backup table pointer
JRST BINSR2 ;Try again
; Here if key ) entry: advance table pointer
BINSRG: JUMPE E,BINSR3 ;Fail if increment zero
JRST BINSR1 ;Advance pointer and try again
TNXEND
END