Google
 

Trailing-Edge - PDP-10 Archives - SRI_NIC_PERM_SRC_1_19910112 - 6-1-monitor/gtdom.mac
There are 2 other files named gtdom.mac in the archive. Click here to see a list.
;[SRI-NIC]SRC:<6-1-MONITOR>GTDOM.MAC.91, 21-Sep-88 20:08:06, Edit by MKL
; parse [a.b.c.d] format for .GTHSN

;XX:<CHIVES.V1.SOURCE>GTDOM.MAC.165, 14-Sep-88 19:10:04, Edit by SRA
; Update copyright notice and table of contents.
;XX:<CHIVES.V1.SOURCE>GTDOM.MAC.164, 14-Sep-88 18:12:22, Edit by SRA
; Mark Crispin requests that we don't depend on MSEC1 being set to
; zero in non-extended monitor, so change CALLXX to handle that.
;XX:<CHIVES.V1.SOURCE>GTDOM.MAC.163, 14-Sep-88 18:02:56, Edit by SRA
; Comment out the REL6 conditionals so that we can stop fixing
; this silliness.  Ten extra words of XSWAPCD doesn't matter.
;XX:<CHIVES.WORK>GTDOM.MAC.162,  4-Sep-88 14:53:03, Edit by SRA
; Add GTDX15 (version mismatch), add GTDX6 and GTDX15 to errors that
; GD%STA translates to .GTDXT, since we hope they are temporary.
; Clean up error handling: we no longer transmute temporary IPCF errors
; into GTDX4, instead we assume that anybody who wants status uses
; GD%STA and there we translate them to .GTDXT status code.
;XX:<CHIVES.BETA.SOURCEC>GTDOM.MAC.161,  3-Sep-88 17:56:03, Edit by SRA
; Add .GTDOS (Get OPSYS string from HINFO RR).  This is primarily
; intended for the Stanford user FTP program, which likes to be clever
; about setting defaults for several known operating system types.
;XX:<CHIVES.BETA.SOURCE>GTDOM.MAC.160,  3-Sep-88 14:09:33, Edit by SRA
; Add UE_ADM (authorization failure), not that we ever expect to see
; it as part of a normal query.  Change 5.4/6.1/7.0 compatability
; conditionals slightly so that the worst thing that will happen is
; that GTDOM will end up in SWAPCD instead of XSWAPCD if compiled under
; rel-5 and linked into a later version.
;XX:<CHIVES.BETA.SOURCE>GTDOM.MAC.159,  2-Sep-88 00:23:53, Edit by SRA
; Replace all uses of CALLX with a new macro, CALLXX, which does random
; arithmetic to force LINK to do the right thing via polish fixup.
;XX:<CHIVES.BETA.SOURCE>GTDOM.MAC.158,  1-Sep-88 22:32:16, Edit by SRA
; Change CALLX's in GETPAG and GIVPAG back to two-arg syntax, LINK didn't
; resolve these to 30-bit addresses. We may have to change all instances
; of CALLX back and use an expicit switch for rel-7, depending on how
; well the one-arg syntax works under rel-5 and rel-6.
;XX:<CHIVES.BETA.SOURCE>GTDOM.MAC.157,  7-Aug-88 21:08:13, Edit by SRA
; Change all occurances of CALLX to use the single-argument format so
; that LINK will supply the section numbers.  Proximate cause is that
; IPCF moved out of section 0/1 in TOPS-20 7.0.  There are still some
; references to external variables via 18-bit addressing in the code
; that interacts with IPIPIP.MAC, fix this if it becomes a problem.
;XX:<CHIVES.BETA.SOURCE>GTDOM.MAC.156, 15-Jul-88 03:46:29, Edit by SRA
; Fix typos in $GTDSA.
;XX:<CHIVES.BETA.SOURCE>GTDOM.MAC.155,  5-Jul-88 10:46:29, Edit by SRA
; Put original error code in LSTERR during GD%STA handling.
;XX:<CHIVES.BETA.SOURCE>GTDOM.MAC.154, 13-Apr-88 04:18:41, Edit by SRA
; Add $GTDLA & $GTDSA.  Rework QCxxxx routines a bit.  Host goodness
; for chaosnet is currently a no-op, it should be something like
; goodness := (max_cost+1 - cost(subnet(address))), but the current
; Chaosnet code doesn't bother with a routing table on a KL, so we lose.
;XX:<CHIVES.BETA.SOURCE>GTDOM.MAC.153, 21-Feb-88 18:42:45, Edit by SRA
;SSY:<5-4-MONITOR>GTDOM.MAC.153, 20-Feb-88 18:10:37, Edit by JTW
; Allow externally defined versions of HSTGUD host address prioritizing
;  routine. Include a default version in this file which should work
;  with standard DEC monitors. Select default version with DHPRSW
;  assembly switch (Non-zero to use default version. -1 by default).
;XX:<CHIVES.BETA.SOURCE>GTDOM.MAC.152,  3-Jan-88 22:54:54, Edit by SRA
; .GTDVN can't trust GTDX2 errors because of "*" name semantic hair.
;XX:<CHIVES.BETA.SOURCE>GTDOM.MAC.151, 29-Dec-87 15:49:15, Edit by SRA
; Fix PUSH/POP of FKSTA2(FX) not to screw up STKVAR frame in RESOLV.
;XX:<CHIVES.BETA.SOURCE>GTDOM.MAC.150, 27-Dec-87 23:35:30, Edit by SRA
; Allow non-network machine to specify -1 as IQH and have .GTDWT work.
; Preserve FKSTA2(FX) in RESOLV too.
;XX:<CHIVES.BETA.SOURCE>GTDOM.MAC.149, 26-Dec-87 17:49:57, Edit by SRA
; Add GTDX1 to GTDSTA list (handle bad syntax like name error).
;XX:<CHIVES.SOURCE>GTDOM.MAC.148, 24-Dec-87 13:23:26, Edit by SRA
; Changes to $GTDWT:
;  Use CHKIQ (from IPIPIP.MAC) to validate IQH (suggested by VAF).
;  Preserve FKSTA2(FX) across dismiss in rel 5 (suggested by JTW).
; Add .GTDVN support.
;XX:<CHIVES.SOURCE>GTDOM.MAC.147, 22-Dec-87 18:07:33, Edit by SRA
; Make .GTDMX work in user mode (one MOVE instruction).
;XX:<CHIVES.SOURCE>GTDOM.MAC.146,  4-Dec-87 03:40:13, Edit by SRA
; Add .GTDAA support.  Fix ATOD so that it returns ILDB pointer to
; terminating source character, rather than LDB pointer, for
; compatability with GTHST%.
;XX:<CHIVES.SOURCE>GTDOM.MAC.143, 16-Sep-87 14:01:39, Edit by SRA
; Test for QCLASS & QTYPE was backwards in $GTHNS.
;XX:<CHIVES.SOURCE>GTDOM.MAC.142, 13-Sep-87 21:46:55, Edit by SRA
; Add GD%STA support.
;XX:<CHIVES.SOURCE>GTDOM.MAC.141,  4-Sep-87 02:26:34, Edit by SRA
; From Mark Crispin:
;  Clean up GETPAG/GIVPAG and make them work with 6.1
;  Fix .GTHSZ function to return value in user AC4
;[MIT-SPEECH]SSY:<5-4-MONITOR>GTDOM.MAC.9,  5-Aug-87 05:44:53, Edit by SRA
;M60 Initial installation in MIT monitor.
	SUBTTL  Table of contents for GTDOM

;          -- Section --                                           -- Page --
;
;  1.   Edit history..................................................  1
;  2.   Table of contents.............................................  2
;  3.   Header and copyright information..............................  3
;  4.   Definitions...................................................  4
;  5.   GTDOM% JSYS...................................................  5
;  6.   Invoke resolver............................................... 14
;  7.   Scheduler stuff............................................... 15
;  8.   Address selection functions................................... 16
;  9.   I/O routines.................................................. 18
;  10.  Support routines.............................................. 23
;  11.  IP Address desirability evaluation............................ 27
;  12.  Class dependent stuff......................................... 28
;
;                    (End of table of contents)
	SUBTTL	Header and copyright information
	SEARCH	ANAUNV,PROLOG,DOMSYM
	TTITLE	GTDOM,GTDOM,< TOPS-20 resolver interface>

; Copyright (c) 1987,1988 Massachusetts Institute of Technology.
;
; Note that there is absolutely NO WARRANTY on this software.
; See the file COPYRIGHT.NOTICE for details and restrictions.
;
; See GTDOM.DOC for information on installing this module into the
; TOPS-20 monitor.
	SUBTTL	Definitions

; AC usage:
; Copies of user ACs are kept in P1 -> P4 and are put back on exit.
; P5 is used to point at IPCF buffer page.
; P6 is used to hold our PID if we have one.
; Tx, Qx, and F are available for general use.
	DEFAC(MSG,P5)
	DEFAC(MYPID,P6)

; Size of bytes in word-aligned string data we get from resolver
; Maybe this should be in USRDEF.D?
	KCCBSZ==9		; Easiest for KCC to handle
	KCCBPW==<<^D36/KCCBSZ>*KCCBSZ>

; Formalize assumptions about QNAME length and page size
	PAGSIZ==1000		; Size of a page on Twenex (vs. ITS!)
IFL <<<PAGSIZ-U.PHSIZ-U.DHSIZ>*KCCBPW>-MAXDNM>,<
	PRINTX ? QNAME space too small, may fall off data page
>

; 5.4/6.1/7.0 compatability.  Use SWAPCD if we haven't heard of XSWAPCD.
IFNDEF XSWAPCD,<		;; If we don't know about XSWAPCD,
	DEFINE XSWAPCD <SWAPCD>	;;  use regular SWAPCD
	DEFINE XNENT(NAME,G) <	;;  and do SWAPCD entry points.
		SWAPCD
		NAME:
		IFNB <G>,<INTERN NAME>
	>
>;IFNDEF XSWAPCD

; CALLXX is like CALLX but hairier because we want to generate .REL
; files that can be linked with any version of the monitor.
;
; NB: CALLXX depends on LINK evaluating the expression <0/0> as zero.
DEFINE CALLXX(FOO) <		;; Polish to add section number to local addrs
	MOVE CX,[FOO!<<1-<<FOO&<-1,,0>>/<FOO&<-1,,0>>>>*<MSEC1,,0>>]
	CALL (CX)		;; Index instead of indirect
>;DEFINE CALLXX

; Make this as swappable as we can.  Not exactly part of the core
; of the operating system, after all.
	XSWAPCD

; Use default host address prioritizing routine by default.
IFNDEF DHPRSW,<DHPRSW==-1>

; External things we probably need.
	EXT	<PDFKTB>	; STG.MAC
	EXT	<PDWTCK,PDWTCL>	; IPCF.MAC
	EXT	<CHKIQ>		; IPIPIP.MAC
IFE DHPRSW,<
	EXT	<HSTGUD,BSTLCL>	; Externally supplied at some sites
>				; (IPIPIP.MAC at MIT)

; Code doesn't fully support class CH (Chaosnet) yet,
; so turn off Chaos-specific things even at MIT.
	CHAOS==0		; Temporary!

; Default is no Chaosnet code for non-MIT monitors.
IFNDEF CHAOS,<CHAOS==0>
	SUBTTL	GTDOM% JSYS

; On entry T1-T4 have user acs 1-4; they are saved in P1-P4.

; Mask for bad flags.  This should help spot things like clients
; who think they're talking to the ISI GTDOM% or some such.
BADFLG==^-<GD%LDO!GD%MBA!GD%RBK!GD%EMO!GD%RAI!GD%QCL!GD%STA!.RHALF>

XNENT .GTDOM,G			; 6.1 style JSYS global entry
	MCENT			; Establish MONITOR context
	TXNE T1,BADFLG		; Any bad flags turned on?
	 RETERR (ARGX22)	; Yes, give invalid flags error
	SETZ MYPID,		; We don't yet have a PID
	DMOVE P1,T1		; Save user ACs
	DMOVE P3,T3
	HRRES T1		; Get function code
	SKIPL T1		; Check range for legality
	 CAIL T1,GTDMAX
	  RETERR (ARGX02)	; Bad function code
	XCT GTDDSP(T1)		; Execute function
	IFSKP.			; Won?
	  SETO T3,		; Yeah, flag that we want skip return
	  TXNE P1,GD%STA	; User wants status code?
	   MOVX P1,.GTDX0	; Yeah, use code for total win
	  XCTU [DMOVEM P1,1]	; Return ACs to caller
	  XCTU [DMOVEM P3,3]
	ELSE.			; No, T1 has error code
	  SETZ T3,		; Assume non-skip return
	ANDXN. P1,GD%STA	; Need error post-processing?
	  XMOVEI T2,GTDSTA	; Yeah, examine list of codes
	  DO.
	    SKIPN T3,(T2)	; Get a table entry
	     EXIT.		; No more, real error
	    HLRZ T4,T3		; Get this error code
	    CAME T1,T4		; Match?
	     AOJA T2,TOP.	; No, try next
	    HRRZM T1,LSTERR	; Yes, put error where user can find it
	    XCTU [HRRZM T3,1]	; And put status code in user AC1
	  ENDDO.		; T3 <> 0 iff want skip return
	ENDIF.
	CALL KILPID		; Release our PID if we have one
	IFN. T3			; Won (or faking it)?
	  SMRETN		; Yes, return successfully
	ELSE.
	  RETERR ()		; No, pass error code back to caller
	ENDIF.			; Never get here.
; Dispatch table.  This has gotten too long to keep track of manually,
; so do it with a macro that will check the offsets for us.  The routines
; we dispatch to have the same name as the function they implement, with
; the leading dot changed to a dollar sign.  Unimplemented functions
; should be present and commented out to reserve their codes.

DEFINE	T(NAME) <
	IFB <NAME>,<CALL GTDNOP>
	IFNB <NAME>,<
		IFN <.-.'NAME>,<PRINTX ? Dispatch table out of order at NAME
		>
		CALL	$'NAME
	>
>

GTDDSP:	PHASE 0			; Enter weird assembly mode
T	 GTHSZ			; (00) Get name table size
T	;GTHIX			; (01) Index into name space
T	 GTHNS			; (02) Convert number to string
T	 GTHSN			; (03) Convert string to number
T	;GTHHN			; (04) Status by number
T	;GTHHI			; (05) Status by index
T	;GTHNL			; (06) Get local number on a network
T	;GTHNT			; (07) Get status table of a network
T	;GTHRT			; (10) Get first hop/route to a host
T	;xxxxx			; (11) Return Resource Record (ISI unformated)
T	 GTDWT			; (12) Resolver wait function
T	;GTDFN			; (13) Domain file use (ISI code only)
T	 GTDPN			; (14) Primary name and IP address
T	 GTDMX			; (15) Get MX data
T	 GTDAA			; (16) Authenticate an address
T	;GTDRR			; (17) Get arbitrary RR (MIT formatted)
T	 GTDVN			; (20) Validate name
T	 GTDLA			; (21) Get appropriate local address
T	 GTDSA			; (22) Sort list of addresses
T	 GTDOS			; (23) Get opsys name
GTDMAX:!DEPHASE			; Number of functions in table

	PURGE	T		; Clean up

; Unimplemented functions come here

GTDNOP:	MOVEI T1,ARGX28		; Not available on this system
	RET			; Return lossage


; Table of errors that are converted to success and status code by
; calls with GD%STA turned on.  Table is sorted by likelyhood.
; Includes IPCF errors that we consider temporary, ie, indications
; that the resolver is just out to lunch.  List terminated with a zero
; word.

GTDSTA:	XWD	GTDX4,  .GTDXT	; Timeout
	XWD	GTDX2,  .GTDXN	; Bad name
	XWD	GTDX3,  .GTDXN	; No matching RRs
	XWD	GTDX1,	.GTDXN	; Bad name syntax
	XWD	GTDX10, .GTDXF	; Probable CNAME loop
	XWD	GTDX7,  .GTDXF	; Database corruption detected
	XWD	IPCF27,	.GTDXT	; Resolver's pid is not defined
	XWD	IPCFX4,	.GTDXT	; Receiver's PID invalid
	XWD	IPCFX5,	.GTDXT	; Receiver's PID disabled
	XWD	IPCFX6,	.GTDXT	; Sender's quota exceeded
	XWD	IPCFX7,	.GTDXT	; Receiver's quota exceeded
	XWD	IPCFX8,	.GTDXT	; IPCF free space exhausted
	XWD	IPCF12,	.GTDXT	; No free PIDs available
	XWD	IPCF13,	.GTDXT	; PID quota exceeded
	XWD	IPCF14,	.GTDXT	; No PIDs available to this job
	XWD	IPCF15,	.GTDXT	; No PIDs available to this proccess
	XWD	GTDX6,	.GTDXT	; Internal error in GTDOM% or resolver
	XWD	GTDX15,	.GTDXT	; Bad version, special case of internal error
	0			; End of list
; Function .GTHSZ(0), Get our host address

; We smash user's AC2 & AC3 to remain consistant with GTHST%.

$GTHSZ:	TXNE P1,GD%QCL		; QCLASS specified?
	 SKIPA T1,P2		; Yes, get it
	  MOVX T1,QC.IN		; No, use Internet
	CALL QCGLCL		; Get our local address into T2
	 RETBAD ()		; Say WHAT? Unknown host number!
	MOVE P4,T2		; Set up to return to user's T4
	SETZB P2,P3		; Length of a nonexistant table is zero
	RETSKP			; Done.
; Function .GTHNS(2), Convert number to string.

$GTHNS:	SKIPN .SPRSV+SPIDTB	; Possible?
	 RETBAD (IPCF27)	; No resolver, data not available
	CALL GETPAG		; Get a JSB page for IPCF
	 RETBAD (IOX7)		; Lost, pass error up the line
	TXNN P1,GD%QCL		; User specify QCLASS?
	 MOVX P4,QC.IN		; No, so use Internet
	SKIPLE T2,P3		; User wants "local host"?
	IFSKP.			; Yup
	  MOVE T1,P4		; This is class specific
	  CALL QCGLCL		; Get our local address into T2
	   RETBAD ()		; Unknown host number!
	  MOVE P3,T2		; Save it for later
	ENDIF.			; T2 now has desired address
	MOVX T1,<POINT KCCBSZ,U.PHSIZ+U.DHSIZ(MSG)>
	MOVE T3,P4		; QCLASS
	CALL QCNTOD		; Convert to a QNAME
	 RETBAD ()
	MOVE T1,P4		; QCLASS = whatever
	MOVX T2,QT.PTR		; QTYPE = Pointer
	MOVX T3,UF.EMO		; Exact match required
	CALL RESOLV		; Go ask the resolver
	 RETBAD ()		; Lost, pass error up the line
	LOAD T1,COUNT,+U.PHSIZ(MSG)
	CAIE T1,1		; Must have exactly one RR as answer
	 RETBAD (GTDX7)		; Multiple primary names?? Inconsistant!
	LOAD T1,CLASS,+U.PHSIZ+U.DHSIZ(MSG)
	LOAD T2,TYPE,+U.PHSIZ+U.DHSIZ(MSG)
	CAMN T1,P4		; Make sure class and type match
	CAIE T2,QT.PTR
	 RETBAD (GTDX6)		; Didn't, we are losing big
	TLC P2,-1		; Fix HRROI style pointer
	TLCN P2,-1
	 HRLI P2,(POINT 7,)
	MOVE T1,P2		; Get user's AC2
	MOVE T2,U.PHSIZ+U.DHSIZ+U.RHSIZ(MSG)	; Offset to answer string
	MOVEI T3,PAGSIZ		; Compute min(MAXDNM,<space left on page>)
	SUB T3,T2
	IMULI T3,KCCBPW
	CAILE T3,MAXDNM
	 MOVEI T3,MAXDNM	; ASSUME user's buffer is at least this big
	TXO T2,<POINT KCCBSZ,0(MSG)>	; Make byte pointer to packet
	MOVE T4,[XCTBU [IDPB T2,T1]]	; Instruction to store a byte
	TLNN T1,-1		; Unless AC1 is a JFN?
	 MOVE T4,[BOUT%]	; It is, handle correctly
	CALL DTOA		; Convert name string to asciz
	 RETBAD ()		; Lost, pass error up
	MOVE P2,T1		; Updated pointer for user
	DMOVE T1,P3		; Get host address and class
	CALL GSBITS		; Get host status bits
	RETSKP			; Done, return win
; Function .GTHSN(3), Convert string to number.
; Function .GTDPN(14), Convert string to primary name and number.

$GTDPN:				; Same entry point for now
$GTHSN:	SKIPN .SPRSV+SPIDTB	; Have PID for resolver?
	 RETBAD (IPCF27)	; Nope, data not available
	CALL GETPAG		; Get a JSB page for IPCF
	 RETBAD (IOX7)		; Can't, pass failure up
	TLC P2,-1		; Fix up HRROI style pointer
	TLCN P2,-1
	 HRLI P2,(POINT 7,)
	MOVE T1,P2
	MOVX T2,<POINT KCCBSZ,U.PHSIZ+U.DHSIZ(MSG)>
	MOVX T3,<<PAGSIZ-U.PHSIZ-U.DHSIZ>*KCCBPW>
	MOVE T4,[XCTBU [ILDB T2,T1]]
	CALL ATOD		; Read in name user specified
	 RETBAD ()		; Lost, pass error back up
	MOVE P2,T1		; Restore updated pointer
	TXNN P1,GD%QCL		; QCLASS specified?
	 MOVX P3,QC.IN		; No, use Internet
IFN NICSW,<
	HRRZ T2,P1		; Get function code
	CAIE T2,.GTHSN		; Want normal string to number?
	IFSKP.
	 MOVX T1,<POINT KCCBSZ,U.PHSIZ+U.DHSIZ(MSG)>
	 ILDB T2,T1		;get first label count
	 ILDB T2,T1		;get first char of first label
	 CAIE T2,"["		;open bracket for [a.b.c.d] format?
	 IFSKP.
	  CALL PRSINM		;yes, go parse it then
	  IFSKP.
	   MOVE P3,T4		;if won, save address to return
	   MOVE T1,T4		;for gsbits
	   CALL GSBITS		;get host status bits
	   RETSKP		;and win
	  ENDIF.
	 ENDIF.
	ENDIF.	
>;IFN NICSW
	MOVE T1,P3		; QCLASS = whatever
	MOVX T2,QT.A		; QTYPE = Address
	MOVX T3,0		; Flags
	SKIPE T4		; Did name end with a dot?
	 TXO T3,UF.EMO		; Yes, exact match required
	CALL RESOLV		; Go ask the resolver
	 RETBAD ()		; Lost, punt
	MOVE F,P3		; Save QCLASS
	XMOVEI Q1,U.PHSIZ+U.DHSIZ(MSG)	; Point at first RR
	SETZB Q2,P3			; No addresses seen yet
	LOAD Q3,COUNT,+U.PHSIZ(MSG)	; Count of RRs
	DO.			; Look at all addresses
	  SOJL Q3,ENDLP.	; Exit if no RRs left
	  XMOVEI T1,PAGSIZ(MSG)	; Make sure this RR doesn't fall
	  OPSTR <SUB T1,>,LENGTH,(Q1)	; off the message page
	  CAMG T1,Q1		; If it does, exit loop
	   EXIT.
	  LOAD T1,CLASS,(Q1)	; Get RR class
	  LOAD T2,TYPE,(Q1)	; and type
	  CAMN T1,F		; Must be type A and right class
	  CAIE T2,QT.A
	  IFSKP.		; It is
	    XMOVEI T1,U.RHSIZ(Q1)	; Get address of RDATA
	    MOVE T2,F		; QCLASS
	    CALL QCGADR		; Get address into T1 and goodness
	     RETBAD ()		; into T2
	    CAMG T2,Q2		; This address better?
	  ANSKP.		; Yeah
	    MOVE Q2,T2		; Save its goodness
	    MOVE P3,T1		; And address itself
	  ENDIF.		; Done with this address
	  OPSTR <ADD Q1,>,LENGTH,(Q1)
	  LOOP.			; Next RR
	ENDDO.
	SKIPN T1,P3		; Did we get an address?
	 RETBAD (GTDX6)		; No, then why did RESOLV skip? Punt.
	HRRZ T2,P1		; Get function code
	CAIE T2,.GTDPN		; Want primary name via AC4?
	IFSKP.			; Yeah
	  MOVE T1,P4		; Destination, handle normally
	  TLC T1,-1		; Fix HRROI style pointer
	  TLCN T1,-1
	   HRLI T1,(POINT 7,)
	  LOAD T2,RNAME,+U.PHSIZ(MSG)	; Get offset into page
	  MOVEI T3,PAGSIZ	; Compute min(MAXDNM,<space left on page>)
	  SUB T3,T2
	  IMULI T3,KCCBPW
	  CAILE T3,MAXDNM
	   MOVEI T3,MAXDNM	; ASSUME user's buffer is at least this big
	  TXO T2,<POINT KCCBSZ,0(MSG)>	; Make pointer to name
	  MOVE T4,[XCTBU [IDPB T2,T1]]	; Output via T1
	  TLNN T1,-1		; Is AC1 a JFN?
	   MOVE T4,[BOUT%]	; It is, handle correctly
	  CALL DTOA		; Dump canonicalized name
	   RETBAD ()		; Lost, pass error up
	  MOVE P4,T1		; Get back pointer for user
	ELSE.			; Wants status bits in AC4
	  MOVE T2,F		; QCLASS
	  CALL GSBITS		; Get the status bits
	ENDIF.
	RETSKP			; Done, return win
IFN NICSW,<
;parse a number in internet format [a.b.c.d].
;opening bracket already read.  string in compressed format.
;pointer to string in ac1.  
;retskp's on success with host number in ac4.
PRSINM:	MOVEI T3,^D10		;decimal
	NIN%			;1st byte
	 ERJMP R
	SETZ T4,		;accumulate host number here
	DPB T2,[POINT 8,T4,11]
	LDB T2,T1		;get terminator
	CAILE T2,3		;next label can only be 3 digits
	 RET			;no, fail
	NIN%			;2nd byte
	 ERJMP R
	DPB T2,[POINT 8,T4,19]
	LDB T2,T1		;get terminator
	CAILE T2,3		;next label can only be 3 digits
	 RET			;no, fail
	NIN%			;3rd byte
	 ERJMP R
	DPB T2,[POINT 8,T4,27]
	LDB T2,T1		;get terminator
	CAILE T2,4		;next label can only be 3 digits (plus bracket)
	 RET			;no, fail
	NIN%			;4th byte
	 ERJMP R
	DPB T2,[POINT 8,T4,35]
	LDB T2,T1		;get terminator
	CAIE T2,"]"		;end bracket?  
	 RET			;no, fail
	ILDB T2,T1		;get null terminator
	SKIPE T2		;was it?
	 RET			;no, fail
	RETSKP
>;IFN NICSW
; Function .GTHMX(15), Look up mail agent forwarding info.

; I happen to know that MX.PREF + 1 == MX.AGENT, but that's not good
; code, hence the following macro which takes advantage of this
; assumption iff it is true.  The things we do in the name of "good
; taste"....
DEFINE	MVMX(OP,AC,PTR) <
	IFE <MX.AGENT-MX.PREF-1>,<
		D'OP AC,MX.PREF+U.RHSIZ(PTR)
	>
	IFN <MX.AGENT-MX.PREF-1>,<
		OP AC,MX.PREF+U.RHSIZ(PTR)
		OP AC+1,MX.AGENT+U.RHSIZ(PTR)
	>
>

$GTDMX:	SKIPN .SPRSV+SPIDTB	; Have PID for resolver?
	 RETBAD (IPCF27)	; Nope, data not available
	CALL GETPAG		; Get a JSB page for IPCF
	 RETBAD (IOX7)		; Can't, pass failure up
	TLC P2,-1		; Fix up HRROI style pointer
	TLCN P2,-1
	 HRLI P2,(POINT 7,)
	MOVE T1,P2
	MOVX T2,<POINT KCCBSZ,U.PHSIZ+U.DHSIZ(MSG)>
	MOVX T3,<<PAGSIZ-U.PHSIZ-U.DHSIZ>*KCCBPW>
	MOVE T4,[XCTBU [ILDB T2,T1]]
	CALL ATOD		; Read in name user specified
	 RETBAD ()		; Lost, pass error up
	MOVE P2,T1		; Restore updated pointer
	IFXN. P1,GD%QCL		; QCLASS specified?
	  XCTU [HRRZ F,.GTDTC(P4)]	; Yeah, get QCLASS into F
	   ERJMP URMPV
	ELSE.			; Not specified
	  MOVX F,QC.IN		; Use Internet
	ENDIF.
	MOVE T1,F		; QCLASS = whatever
	MOVX T2,QT.MX		; QTYPE = MX
	MOVX T3,0		; Flags
	SKIPE T4		; Did name end with a dot?
	 TXO T3,UF.EMO		; Yes, exact match required
	CALL RESOLV		; Go ask the resolver
	 RETBAD ()		; Lost, punt
	DO.			; Bubble sort the MX RRs
	  LOAD Q1,COUNT,+U.PHSIZ(MSG)	; Count of RRs
	  XMOVEI Q2,U.PHSIZ+U.DHSIZ(MSG); Current RR
	  SETZ Q3,		; NULL sample pointer
	  DO.			; Look at all RRs
	    XMOVEI T3,PAGSIZ(MSG)	; Make sure this RR doesn't fall
	    OPSTR <SUB T3,>,LENGTH,(Q2)	; off the message page
	    CAMG T3,Q2		; If it does, pretend we ran out of RRs
	     SETZ Q1,		; (we sure did if there's no page there!)
	    JUMPLE Q1,ENDLP.	; Exit if no RRs left to scan
	    LOAD T3,CLASS,(Q2)	; Get RR class and type
	    LOAD T4,TYPE,(Q2)
	    CAMN T3,F		; Ignore if not MX of proper class
	    CAIE T4,QT.MX
	    IFSKP.		; Type and class ok
	      IFN. Q3		; If we have a sample point
		CAMG T1,U.RHSIZ+MX.PREF(Q2)
	      ANSKP.		; And this RR is better
		MVMX(MOVE, T3,Q2)	; Swap the PREF and AGENT
		MVMX(MOVEM,T1,Q2)	; values for these RRs
		MVMX(MOVEM,T3,Q3)	; (the rest doesn't matter to us)
		EXIT.		; Exit inner loop, and waltz around again
	      ELSE.
		MOVE Q3,Q2	; Otherwise, take new sample here
		MVMX(MOVE,T1,Q3)
	      ENDIF.		; In order so far
	    ENDIF.		; Done with this RR
	    OPSTR <ADD Q2,>,LENGTH,(Q2)
	    SOJA Q1,TOP.	; Next RR
	  ENDDO.		; Swapped, no more RRs, or fell off page
	  JUMPG Q1,TOP.		; Start over if swapped
	ENDDO.			; Done sorting RRs
	SKIPN Q3		; Did we see anything useful?
	 RETBAD (GTDX6)		; No, RESOLV shouldn't have skipped. Punt.
	TLCN P3,-1		; Check for JFN instead of pointer
	 RETBAD (GTDX5)		; Can't handle that, punt
	TLCN P3,-1		; Fix HRROI style pointer
	 HRLI P3,(POINT 7,)
	CALL CNOINT		; Turn off interrupts but allow RETBAD to work
	MOVE T4,P4		; Make this work right in user mode
	XCTU [MOVE T1,4]	; Make sure user didn't change AC4 while
	 ERJMP URMPV		; we were off doing other things
	CAME T1,P4
	 RETBAD (GTDX11)	; Memory changed while we were out fishing
	IFXN. P1,GD%QCL		; If QCLASS was specified, check it too
	  XCTU [HRRZ T1,.GTDTC(P4)]
	   ERJMP URMPV
	  CAME T1,F
	   RETBAD (GTDX11)
	ENDIF.
	XCTU [MOVE Q1,.GTDLN(P4)]	; Get argblock length
	 ERJMP URMPV
	CAIGE Q1,.GTDML		; Make sure block is big enough
	 RETBAD (ARGX04)	; Isn't, return arg block too small
	LOAD T2,RNAME,+U.PHSIZ(MSG)	; Get offset into message page
	XCTU [MOVE T3,.GTDBC(P4)]	; Count of available bytes
	 ERJMP URMPV
	MOVE T1,P4		; Point at correct argblock slot
	ADDI T1,.GTDNM		; for returned canonical name
	CALL DUMP1N		; Dump canonical name
	 RETBAD ()		; Lost, foo
	SUBI Q1,.GTDRD		; Subtract fixed part of argblock from length
IFN <.GTDRD-.GTDNM-1>,<ADD T1,[.GTDRD-.GTDNM-1]>	; Paranoia
	XMOVEI Q2,U.PHSIZ+U.DHSIZ(MSG)	; Pointer to RRs
	LOAD Q3,COUNT,+U.PHSIZ(MSG)	; Count of RRs
	DO.			; Look at all addresses
	  SOJL Q3,ENDLP.	; Exit if no RRs left
	  XMOVEI T2,PAGSIZ(MSG)	; Make sure this RR doesn't fall
	  OPSTR <SUB T2,>,LENGTH,(Q2)	; off the message page
	  CAMG T2,Q2		; If it does, exit loop
	   EXIT.
	  LOAD T2,CLASS,(Q2)	; Get RR class
	  LOAD T4,TYPE,(Q2)	; Get RR type
	  CAMN T2,F		; Type and class must match
	  CAIE T4,QT.MX
	  IFSKP.		; It is
	    SOJL Q1,ENDLP.	; Make sure there's room (NOT an error)
	    MOVE T2,U.RHSIZ+MX.AGENT(Q2)
	    CALL DUMP1N		; Dump this name
	     RETBAD ()		; Lost, foo
	  ENDIF.		; Advance to next RR.
	  OPSTR <ADD Q2,>,LENGTH,(Q2)
	  LOOP.			; Next RR
	ENDDO.			; Done dumping RRs
	MOVNS Q1		; Update user's counts in argblock
	XCTU [ADDM Q1,.GTDLN(P4)]
	 ERJMP UWMPV
	XCTU [MOVEM T2,.GTDBC(P4)]
	 ERJMP UWMPV
	RETSKP			; Done, return win (and go OKINT)

; Routine to dump one name
;  T1/ Pointer (in user space) to arg block slot
;  T2/ MSG page offset to domain name format string
;  T3/ Buffer byte count (used by DTOA)
;  T4/ Trashed by this routine and DTOA
; We assume that if we lose, so does the JSYS, so it's ok
; for us to return a bogus value in T3 if we lose.

DUMP1N:	STKVAR <LIMORG,LIMMIN>	; Limits, original and after min()
	MOVEI T4,PAGSIZ		; Compute limit based on page size
	SUB T4,T2		; (ie, don't fall off message page)
	IMULI T4,KCCBPW
	MOVEM T3,LIMORG		; Save caller-specified limit
	CAMLE T3,T4		; Take minimum limit value
	 MOVE T3,T4
	SKIPG T3		; Are we already losing?
	 RETBAD (GTDX7)		; Yeah, string too long, punt
	MOVEM T3,LIMMIN		; Save limit we will use
	XCTU [MOVEM P3,(T1)]	; Store BP to user
	 ERJMP UWMPV		; Lost
	TXO T2,<POINT KCCBSZ,0(MSG)>	; Make source pointer from offset
	MOVE T4,[XCTBU [IDPB T2,P3]]	; Output via P3
	CALL DTOA		; Dump name to user
	 RETBAD ()		; Lost, pass error up
	SUB T3,LIMMIN		; Translate limit back to what the
	ADD T3,LIMORG		; calling routine wants to see
	AOJA T1,RSKP		; Update pointer and return win
; Function .GTDAA(16), Authenticate Address for hostname

$GTDAA:	SKIPN .SPRSV+SPIDTB	; Have PID for resolver?
	 RETBAD (IPCF27)	; Nope, data not available
	CALL GETPAG		; Get a JSB page for IPCF
	 RETBAD (IOX7)		; Can't, pass failure up
	MOVE F,P4		; Get QCLASS
	TXNN P1,GD%QCL		; QCLASS specified?
	 MOVX F,QC.IN		; No, use Internet
	IFLE. P3		; User wants "local host"?
	  MOVE T1,F		; This is class specific
	  CALL QCGLCL		; Get our local address into T2
	   RETBAD ()		; Unknown host number!
	  MOVE P3,T2		; Save it for later
	ENDIF.			; T2 now has desired address
	TLC P2,-1		; Fix up HRROI style pointer
	TLCN P2,-1
	 HRLI P2,(POINT 7,)
	MOVE T1,P2		; Read in name user specified
	MOVX T2,<POINT KCCBSZ,U.PHSIZ+U.DHSIZ(MSG)>
	MOVX T3,<<PAGSIZ-U.PHSIZ-U.DHSIZ>*KCCBPW>
	MOVE T4,[XCTBU [ILDB T2,T1]]
	CALL ATOD
	 RETBAD ()		; Lost, pass error back up
	MOVE P2,T1		; Restore updated pointer
	MOVE T1,F		; QCLASS = whatever
	MOVX T2,QT.A		; QTYPE = Address
	MOVX T3,0		; Flags
	SKIPE T4		; Did name end with a dot?
	 TXO T3,UF.EMO		; Yes, exact match required
	CALL RESOLV		; Go ask the resolver
	 RETBAD ()		; Lost, punt
	XMOVEI Q1,U.PHSIZ+U.DHSIZ(MSG)	; Point at first RR
	SETZ Q2,			; No good address seen yet
	LOAD Q3,COUNT,+U.PHSIZ(MSG)	; Count of RRs
	DO.			; Look at all addresses
	  SOJL Q3,ENDLP.	; Exit if no RRs left
	  XMOVEI T1,PAGSIZ(MSG)	; Make sure this RR doesn't fall
	  OPSTR <SUB T1,>,LENGTH,(Q1)	; off the message page
	  CAMG T1,Q1		; If it does, exit loop
	   EXIT.
	  LOAD T1,CLASS,(Q1)	; Get RR class
	  LOAD T2,TYPE,(Q1)	; and type
	  CAMN T1,F		; Must be type A and right class
	  CAIE T2,QT.A
	  IFSKP.		; It is
	    XMOVEI T1,U.RHSIZ(Q1)	; Get address of RDATA
	    MOVE T2,F		; QCLASS
	    CALL QCGADR		; Get address into T1 and goodness (ignored)
	     RETBAD ()		; into T2
	    CAMN T1,P3		; Does this address match?
	     AOJA Q2,ENDLP.	; Yes, success, now
	  ENDIF.		; No, done with this address
	  OPSTR <ADD Q1,>,LENGTH,(Q1)
	  LOOP.			; Next RR
	ENDDO.
	SKIPN Q2		; Did we find the desired address?
	 RETBAD (GTDX3)		; No, give error (seems appropriate message)
	RETSKP			; Yes, return win
; Function .GTDVN(21), Validate Name for type and class

$GTDVN:	SKIPN .SPRSV+SPIDTB	; Have PID for resolver?
	 RETBAD (IPCF27)	; Nope, data not available
	CALL GETPAG		; Get a JSB page for IPCF
	 RETBAD (IOX7)		; Can't, pass failure up
	STKVAR <LSTPTR,<LSTBLK,2>,SRCBP>	; (must come after GETPAG)
	TXNN P1,GD%QCL		; QCLASS specified?
	 HRLI P3,QC.IN		; No, use Internet
	HRRZ T1,P3		; Get QTYPE or catagory token
	CAIL T1,.GTDV0		; Less than minimum catagory token?
	IFSKP.			; Yes, it's a QTYPE
	  MOVEM T1,LSTBLK	; Make one entry search list
	  SETOM 1+LSTBLK	; Tie it off
	  XMOVEI T1,LSTBLK	; Point at it
	ELSE.			; Wasn't a QTYPE, must be catagory
	  MOVSI T2,-LVNTAB	; How many entries in our table
	  DO.			; Look for matching catagory
	    HLRZ T3,VNTAB(T2)	; Get catagory field
	    CAME T1,T3		; Match?
	     AOBJN T2,TOP.	; No, try next
	  ENDDO.
	  SKIPL T2		; Did we find it?
	   RETBAD (GTDX14)	; No, bad QTYPE
	  HRRZ T1,VNTAB(T2)	; Get address of list
	ENDIF.
	MOVEM T1,LSTPTR		; Save list pointer
	TLC P2,-1		; Fix up HRROI style pointer
	TLCN P2,-1
	 HRLI P2,(POINT 7,)
	MOVEM P2,SRCBP		; Save source pointer

	DO.			; Do some queries
	  MOVE T1,LSTPTR	; Get pointer to QTYPE list
	  SKIPGE T1,(T1)	; Any left to look for?
	   RETBAD (GTDX3)	; No, "data not present at name"
	  HRR P3,T1		; Yes, it's our current target type
	  MOVE T1,SRCBP		; Get target name
	  MOVX T2,<POINT KCCBSZ,U.PHSIZ+U.DHSIZ(MSG)>
	  MOVX T3,<<PAGSIZ-U.PHSIZ-U.DHSIZ>*KCCBPW>
	  MOVE T4,[XCTBU [ILDB T2,T1]]
	  CALL ATOD
	   RETBAD ()		; Lost, pass error back up
	  MOVE P2,T1		; Restore updated pointer
	  HLRZ T1,P3		; QCLASS = whatever
	  HRRZ T2,P3		; QTYPE = whatever
	  MOVX T3,0		; No flags
	  SKIPE T4		; Did name end with a dot?
	   TXO T3,UF.EMO	; Yes, exact match required
	  CALL RESOLV		; Go ask the resolver
	   AOSA LSTPTR		; Lost, increment list pointer
	    EXIT.		; Won, done
	  CAIE T1,GTDX3		; No data matching that name?
	  CAIN T1,GTDX2		; No such name (*.foo.bar hair)?
	   LOOP.		; Yup, go try next QTYPE
	  RETBAD ()		; Nope, really lost, punt
	ENDDO.			; Won if we get here

	MOVE T1,P4		; Write canonical name for user
	TLC T1,-1		; Fix HRROI style pointer
	TLCN T1,-1
	 HRLI T1,(POINT 7,)
	LOAD T2,RNAME,+U.PHSIZ(MSG)	; Get offset into page
	MOVEI T3,PAGSIZ		; Compute min(MAXDNM,<space left on page>)
	SUB T3,T2
	IMULI T3,KCCBPW
	CAILE T3,MAXDNM
	 MOVEI T3,MAXDNM	; ASSUME user's buffer is at least this big
	TXO T2,<POINT KCCBSZ,0(MSG)>	; Make pointer to name
	MOVE T4,[XCTBU [IDPB T2,T1]]	; Output via T1
	TLNN T1,-1		; Is AC1 a JFN?
	 MOVE T4,[BOUT%]	; It is, handle correctly
	CALL DTOA		; Dump canonicalized name
	 RETBAD ()		; Lost, pass error up
	MOVE P4,T1		; Get back pointer for user
	RETSKP			; Return win
	ENDSV.			; Close scope

; Table of QTYPEs matching known catagories.  Add as needed.
VNTAB:	.GTDVH,,[EXP QT.A,QT.MX,QT.WKS,QT.HINFO,-1]	; Host
	.GTDVZ,,[EXP QT.SOA,QT.NS,		-1]	; Zone
LVNTAB==.-VNTAB
; Function .GTDOS(23), Get operating system from HINFO for host (for FTP)

$GTDOS:	SKIPN .SPRSV+SPIDTB	; Have PID for resolver?
	 RETBAD (IPCF27)	; Nope, data not available
	CALL GETPAG		; Get a JSB page for IPCF
	 RETBAD (IOX7)		; Can't, pass failure up
	MOVE F,P4		; Get QCLASS
	TXNN P1,GD%QCL		; QCLASS specified?
	 MOVX F,QC.IN		; No, use Internet
	TLC P2,-1		; Fix up HRROI style pointer
	TLCN P2,-1
	 HRLI P2,(POINT 7,)
	MOVE T1,P2		; Read in name user specified
	MOVX T2,<POINT KCCBSZ,U.PHSIZ+U.DHSIZ(MSG)>
	MOVX T3,<<PAGSIZ-U.PHSIZ-U.DHSIZ>*KCCBPW>
	MOVE T4,[XCTBU [ILDB T2,T1]]
	CALL ATOD
	 RETBAD ()		; Lost, pass error back up
	MOVE P2,T1		; Restore updated pointer
	MOVE T1,F		; QCLASS = whatever
	MOVX T2,QT.HINFO	; QTYPE = Host INFOrmation
	MOVX T3,0		; Flags
	SKIPE T4		; Did name end with a dot?
	 TXO T3,UF.EMO		; Yes, exact match required
	CALL RESOLV		; Go ask the resolver
	 RETBAD ()		; Lost, punt
	XMOVEI Q1,U.PHSIZ+U.DHSIZ(MSG)	; Point at first RR
	SETZ Q2,			; No good data seen yet
	LOAD Q3,COUNT,+U.PHSIZ(MSG)	; Count of RRs
	DO.			; Look at all addresses
	  SOJL Q3,ENDLP.	; Exit if no RRs left
	  XMOVEI T1,PAGSIZ(MSG)	; Make sure this RR doesn't fall
	  OPSTR <SUB T1,>,LENGTH,(Q1)	; off the message page
	  CAMG T1,Q1		; If it does, exit loop
	   EXIT.
	  LOAD T1,CLASS,(Q1)	; Get RR class
	  LOAD T2,TYPE,(Q1)	; and type
	  CAMN T1,F		; Must be type HINFO and right class
	  CAIE T2,QT.HINFO
	  IFSKP.		; It is
	    SKIPE Q2		; More than one HINFO for this name?
	     RETBAD (GTDX7)	; Yes, "received data inconsistant"
	    XMOVEI Q2,U.RHSIZ(Q1)
	  ENDIF.		; Otherwise remember address of RDATA
	  OPSTR <ADD Q1,>,LENGTH,(Q1)
	  LOOP.			; Next RR
	ENDDO.
	SKIPN Q2		; Did we find anything?
	 RETBAD (GTDX6)		; No, resolver is losing
	TLC P3,-1		; Fix up HRROI style pointer
	TLCN P3,-1
	 HRLI P3,(POINT 7,)
	MOVE T1,P3		; Write out opsys string
	MOVX T2,<POINT KCCBSZ,(MSG)>
	ADD T2,HINF.OS(Q2)
	MOVX T3,<PAGSIZ*KCCBPW>
	SUB T3,HINF.OS(Q2)
	MOVE T4,[XCTBU [IDPB T2,T1]]
	CALL STOA
	 RETBAD ()		; Lost, pass error back up
	MOVE P3,T1		; Restore updated pointer
	RETSKP			; Return win
	SUBTTL Invoke resolver

; Credits:
; This code derived from the RED protocol GTHST% module,
; written by Vince Fuller (Carnegie-Mellon University).

; RESOLV - Send a message to resolver and get a response
; Called with:
;	T1/ QCLASS
;	T2/ QTYPE
;	T3/ UF.EMO, zero, or any flags caller wants to force
;	P1/ Flags from user GTDOM% JSYS
;	MSG/ Address of JSB page to send containing message
;	     (With QNAME already in place on page)
; Returns:
;	+1/ Something lost, error code in T1
;	+2/ Success, PID created if necessary, resolver's response
;	    in page pointed to by MSG
;
; We IOR relevant user P1 flags into T3.
;
; Destroys T1->T4.

; How long the resolver has to get back to us with an answer (can be patched)
GTDTMO:	^D<60*1000>		; Milliseconds

RESOLV:	STKVAR <<PDB,.IPCFC+1>,STAMP,MYTMO,OFKSTA>
	CALL QCVAL		; Make sure QCLASS is ok
	 RETBAD ()		; Pass errors back
	TXNE P1,GD%LDO		; Local data only?
	 TXO T3,UF.LDO
	TXNE P1,GD%MBA		; Must be authoritative?
	 TXO T3,UF.MBA
	TXNE P1,GD%RBK		; Resolve in background?
	 TXO T3,UF.RBK
	TXNE P1,GD%EMO		; Exact match only?
	 TXO T3,UF.EMO		; NB, overrides caller's setting!
	; Add any new flags here.
	STOR T1,QCLASS,+U.PHSIZ(MSG)	; Put QCLASS into message
	STOR T2,QTYPE,+U.PHSIZ(MSG)	; And QTYPE
	STOR T3,FLAGS,+U.PHSIZ(MSG)	; Save flags
	MOVEI T1,U.PHSIZ+U.DHSIZ	; Where QNAME is
	STOR T1,QNAME,+U.PHSIZ(MSG)	; Store that too
	SETZRO RCODE,+U.PHSIZ(MSG)	; No response code yet
	SETZRO RNAME,+U.PHSIZ(MSG)	; Or canonicalized name
	SETZRO COUNT,+U.PHSIZ(MSG)	; No RRs in query message
	MOVX T1,USRVER		; Get user protocol version
	STOR T1,VERUSR,(MSG)	; send it so resolver can check
	MOVX T1,RFCVER		; Same for network protocol version
	STOR T1,VERRFC,(MSG)
	MOVX T1,US.QRY		; This is a query message
	STOR T1,STATE,(MSG)	; Tell resolver
	MOVEI T1,1		; Set page count fields
	STOR T1,PAG.COUNT,(MSG)	; page_count
	STOR T1,PAG.THIS,(MSG)	; page_this
	MOVE T1,TODCLK		; Get current system uptime
	STOR T1,STMP1,(MSG)	; and our fork index, use them
	MOVEM T1,STAMP		; as the two stamp words we check
	MOVE T1,FORKX		; to be sure that resolver really
	STOR T1,STMP2,(MSG)	; meant answer for us.

	MOVX T3,IP%CFV!IP%INT!IP%EPN	; Extended page, internal call
	SKIPN T4,MYPID		; Have a PID yet?
	 TXO T3,<IP%CPD>	; Request PID creation on send
	MOVEM T4,.IPCFS+PDB	; Sending PID
	MOVEM T3,.IPCFL+PDB	; Set flags
	SKIPN T1,.SPRSV+SPIDTB	; Get resolver PID
	 RETBAD (IPCF27)	; Error, data not available
	MOVEM T1,.IPCFR+PDB
	MOVE T1,MSG		; Get message address
	LSH T1,-9		; Make into a page number
	HRLI T1,1000		; Size of paged message
	MOVEM T1,.IPCFP+PDB
	MOVEI T1,4		; PDB length
	MOVEI T2,PDB		; Point at PDB here
	MSEND%			; Send message to resolver
	IFNJE.			; Sent ok?
	  TXNN P1,GD%RBK	; Yeah, background query?
	   TDZA T1,T1		; No, clear T1 to indicate success
	   MOVX T1,GTDX4	; Yes, tell user we timed out (like ISI code)
	ENDIF.
	SKIPE MYPID		; Had PID already?
	IFSKP.			; No, we just created one (maybe)
	  MOVE T2,.IPCFS+PDB	; Get sender's PID from message we just sent
	  MOVEM T2,MYPID	; Save it for posterity
	ENDIF.
	JUMPN T1,R		; Exit now if we got an error

	MOVE T1,TODCLK		; Current time
	ADD T1,GTDTMO		; Compute our timeout
	MOVEM T1,MYTMO		; Save it
	DO.			; Loop listening for response
	  MOVE T1,MYPID		; Our PID
	  CALLXX PDWTCK		; See if it's ok to hang on it
	  IFSKP.		; It is, we are committed to dismiss
	    MOVE T1,FORKX	; Our fork index
;IFE REL6,<			; Rel 5 workaround
	    MOVE T2,FKSTA2(T1)	; Get current contents
	    MOVEM T2,OFKSTA	; Save it since TOPS-20 doesn't
;>;IFE REL6
	    MOVE T2,MYTMO	; Our timeout
	    MOVEM T2,FKSTA2(T1)	; Save it for scheduler
	    MOVEI T1,DOMUSR	; Our test routine
	    MDISMS		; Normal dismiss (without hold time)
	    CALLXX PDWTCL	; Clear PIDFW
;IFE REL6,<			; Rel 5 workaround
	    MOVE T1,FORKX	; Our fork index
	    MOVE T2,OFKSTA	; Get stuff TOPS-20 should have saved
	    MOVEM T2,FKSTA2(T1)	; Put it back where TCP code expects it
;>;IFE REL6
	  ELSE.			; Couldn't hang on our PID, look at reason
	    JUMPN T1,R		; If it's not incoming msg, something's wrong
	  ENDIF.		; We should now have a message to read
	  MOVE T1,MYPID		; Our PID again
	  MOVEM T1,.IPCFR+PDB	; Receiver
	  MOVX T1,IP%CFV!IP%EPN!IP%INT!IP%CFB
	  MOVEM T1,.IPCFL+PDB	; Extended page, internal, don't hang
	  MOVE T1,MSG		; Get message address
	  LSH T1,-9		; Make into a page number
	  HRLI T1,1000		; Make a page pointer
	  MOVEM T1,.IPCFP+PDB
	  MOVEI T1,.IPCFC+1	; Length of PDB
	  MOVEI T2,PDB		; Point at PDB..
	  SKIPN .SPRSV+SPIDTB	; Check resolver PID again
	   RETBAD (IPCF27)	; in case it got blown away
	  MRECV%		; Receive a message
	  IFJER.		; Error?
	    CAIN T1,IPCFX2	; Yes, no messages ready?
	     MOVEI T1,GTDX4	; Yup, must have timed out
	    RETBAD ()		; Return error to caller
	  ENDIF.
;	  MOVE T1,.IPCFC+PDB	; Ignore bogons
;	  JXE T1,SC%WHL!SC%OPR,TOP.
	  SKIPN T1,.SPRSV+SPIDTB
	   RETBAD (IPCF27)	; Paranoia
	  CAME T1,.IPCFS+PDB	; Ignore message if it wasn't
	   LOOP.		; from the resolver
	ENDDO.

	LOAD T1,VERUSR,(MSG)	; Make sure we are talking same version
	LOAD T2,VERRFC,(MSG)	; of the protocols as the resolver is.
	CAIN T1,USRVER
	CAIE T2,RFCVER
	 RETBAD (GTDX15)	; We're not, give up
	LOAD T1,STATE,(MSG)	; Check what kind of message this is
	CAME T1,[US.RSP]	; Better be a response
	 RETBAD (GTDX6)
	LOAD T1,PAG.COUNT,(MSG)	; For now we can only handle single
	LOAD T2,PAG.THIS,(MSG)	; page responses, so make sure that's
	CAIN T1,1		; what this is
	CAIE T2,1
	 RETBAD (GTDX6)
	LOAD T1,STMP1,(MSG)	; Check to see if resolver is suffering
	LOAD T2,STMP2,(MSG)	; from a nervous breakdown and is sending
	CAMN T1,STAMP		; us somebody else's responses or is answering
	CAME T2,FORKX		; an old query of ours
	 RETBAD (GTDX6)		; Lastly, check the error code
	LOAD T1,RCODE,+U.PHSIZ(MSG)
	JUMPE T1,RSKP		; Won if no error
	SKIPL T1		; In range of known errors?
	CAILE T1,UE.MAX
	 SETZ T1,		; No, use default error code
	MOVE T1,UE$TAB(T1)	; Get TOPS-20 error code for it
	RET			; Losing return
	ENDSV.			; Close scope of STKVAR

; Resolver "user" protocol errors, see USRDEF.D for error codes.

; Macro to define an error entry
DEFINE	DEF$UE(JCODE,UCODE) <
	IFN <.-UCODE>,<
		PRINTX ? UE$TAB out of order at JCODE, UCODE
	>
	JCODE
>

UE$TAB:	PHASE 0			; Check positions of errors
	DEF$UE(GTDX6, 0)	; Unknown error code from resolver!
	DEF$UE(GTDX2, UE.NAM)	; Name does not exist (authoritative answer)
	DEF$UE(GTDX3, UE.NRR)	; No RRs match name (authoritative answer)
	DEF$UE(GTDX6, UE.SYS)	; System error.
	DEF$UE(GTDX6, UE.NIY)	; Not Implemented Yet.
	DEF$UE(GTDX4, UE.TMO)	; Timeout while resolving query.
	DEF$UE(GTDX4, UE.RBK)	; Resolving in background.
	DEF$UE(GTDX10,UE.TMC)	; Too Many CNAMEs.
	DEF$UE(GTDX6, UE.ACK)	; ACKnowledgement (CTL messages only).
	DEF$UE(GTDX6, UE.ARG)	; Arguments invalid.
	DEF$UE(GTDX4, UE.DNA)	; Data Not Available.
	DEF$UE(GTDX6, UE.NOP)	; "No-op" error (internal resolver use only).
	DEF$UE(GTDX6, UE.ADM)	; Administrative (authorization) error
IFN <.-UE.MAX-1>,<PRINTX ? UE$TAB length error
>
	DEPHASE			; End of table
	PURGE DEF$UE		; Clean up
SUBTTL	Scheduler stuff

; Credits:
; This code derived from the ISI GTDOM% function by the same name,
; which was written by Paul Mockapetris and/or Dave Bilkis (USC-ISI).

; Function .GTDWT, Resolver wait function

; This function is used to let the resolver do a scheduler dismiss to avoid
; busy-waiting.  We hang until (1) a new IPCF message comes in, (2) a new
; IP packet comes in, or (3) the caller-specifed time elapses.
;
; Arguments to JSYS:
;	AC1/ .GTDWT
;	AC2/ hold time for HDISMS
;	AC3/ wait time for HDISMS
;	AC4/ resolver's IP queue handle

$GTDWT:	SKIPGE T1,P4		; Are we doing full IQH dismiss?
	IFSKP.			; Yes, check IQH for validity
	  NOINT			; CHKIQ wants to run NOINT
	  CALL CHKIQ		; See if it's legal (CHKIQ is in XSWAPCD)
	  OKINT			; Clean up
	ANDL. T1		; Did the IQH pass muster?
	  HRRZS T1		; No, clear LH bits
	  RETBAD ()		; and pass error to caller
	ENDIF.
	SKIPN T1,.SPRSV+SPIDTB	; Resolver's PID
	 RETBAD (GTDX6)		; None set, punt.
	CALLXX PDWTCK		; Set up PDFKTB, ok for us to dismiss?
	IFNSK.			; No, we don't want to dismiss...
	  JUMPE T1,RSKP		; ...because there's already a message for us.
	  RETBAD ()		; ...because something's wrong with our PID.
	ENDIF.
	MOVE T1,FORKX		; We are now committed to a dismiss
;IFE REL6,<			; Rel 5 workaround
	PUSH P,FKSTA2(T1)	; Preserve in case we're running at PSI level
;>;IFE REL6
	ADD P3,TODCLK		; Compute wakeup time
	MOVEM P3,FKSTA2(T1)	; Save it for scheduler test
	IFGE. P4		; Are we doing full IQH dismiss?
	  MOVEI T1,DOMSVR	; Yes, address of our scheduler test
	  HRL T1,P4		; Resolver's IQH
	ELSE.			; No, non-network machine, presumably
	  MOVEI T1,DOMUSR	; User test does the right thing
	ENDIF.			; In either case
	MOVE T2,P2		; Hold time
	HDISMS			; Dismiss to scheduler
	CALLXX PDWTCL		; Clear PIDFW
;IFE REL6,<			; Rel 5 workaround
	MOVE T1,FORKX		; Restore in case we are running at PSI level
	POP P,FKSTA2(T1)	; with a TCP scheduler dismiss at MP level
;>;IFE REL6
	RETSKP			; Return success always

; Scheduler tests.  User and server tests are identical except that
; user doesn't have an IQH, so we can reuse the same test code.
;
; Requires:
;	T1/ IQH (server test only), set by SCHED from LH of FKSTAT word
;	FX/ Fork index
;	FKSTA2(FX)/ Wakeup time
;
; Note that in Rel 5 FKSTA2 is not preserved across PSI, and there are
; some routines in TCPJFN which might smash it.  At worst this will
; cause a premature wakeup to a user GTDOM%, which will be interpreted
; as a timeout waiting for the resolver and thus will be signaled as a
; soft error and handled correctly by any reasonable program.

	RESCD			; Scheduler tests must be resident

	FX==Q3			; Why the bleep isn't this global?

DOMSVR::			; Server test routine
	SKIPE INTQSP(T1)	; Any IP packets queued for us?
	 JRST 1(T4)		; Yes, wake up due to incoming net traffic.
DOMUSR::			; User test routine
	MOVE T2,FKSTA2(FX)	; Get time for wakeup
	CAMG T2,TODCLK		; Is it later than that?
	 JRST 1(T4)		; Yes, wake up due to alarm clock.
	MOVE T1,FX		; Our fork number
	IDIVI T1,^D36		; Get PDFKTB index and bit position
	MOVE T1,PDFKTB(T1)	; Get appropriate word
	LSH T1,(T2)		; Shift interesting bit to sign bit
	JUMPL T1,1(T4)		; IPCF packet queued, wake up.
	JRST 0(T4)		; Nothing interesting, snooze some more.

	XSWAPCD			; Back to swappable code
SUBTTL	Address selection functions

; Function .GTDLA, Get best local address for a particular foreign address
;
; This function is used to select the best local address to use when
; a user program has to send datagrams (usually UDP) to a foreign host.
;
; Arguments:
;	AC1/ flags ,, .GTDLA
;	AC2/ Address of foreign machine
;	AC3/ (optional) QCLASS
; Returns:
;	AC2/ Local address appropriate for this foreign address

$GTDLA:	MOVE T1,P2		; Get target foreign address
	TXNE P1,GD%QCL		; QCLASS specified?
	 SKIPA T2,P3		; Yes, get it
	  MOVX T2,QC.IN		; No, use Internet
	CALL QCBLCL		; Get appropriate local address into T1
	 RETBAD ()		; Lost, pass error up
	MOVE P2,T1		; Put result where user can find it
	RETSKP			; Done
; Function .GTDSA, Sort addresses by "goodness"
;
; This function will sort a list of network addresses, best first.
; Addresses that are known to be totally useless will be removed.
; This function is primarily of interest to the domain resolver.
;
; Arguments:
;	AC1/ flagss ,, .GTDSA
;	AC2/ 30-bit address of block of addresses
;	AC3/ Count
;	AC4/ (optional) QCLASS
; Returns:
;	AC2/ Pointer to updated block of addresses
;	AC3/ Updated count
;
; We use a page of JSB space as scratch space for the sort, two words
; per entry:
;	0/ address
;	1/ goodness
; Addresses are assumed to fit into one word.

$GTDSA:	CALL CNOINT		; Turn off interrupts but allow RETBAD()
	SKIPG P3		; Check for silly initial argblock length
	 RETBAD (ARGX04)	; Argblock too small
	CAILE P3,<PAGSIZ/2>	; Will we have enough room?
	 RETBAD (ARGX05)	; Nope, argblock too long.
	CALL GETPAG		; Get a JSB page for scratch space
	 RETBAD (IOX7)		; Can't, pass failure up
	TXNN P1,GD%QCL		; QCLASS specified?
	 MOVX P4,QC.IN		; No, default to Internet
	MOVE Q1,P2		; Point to user's block of addresses
	MOVE Q2,MSG		; Point to our buffer
	MOVE Q3,P3		; Count of addresses
	DO.			; Loop to snarf and evaluate addresses
	  XCTU [MOVE T1,(Q1)]	; Get an address
	   ERJMP URMPV
	  MOVE T2,P4		; QCLASS
	  CALL QCGGUD		; Get goodness
	   RETBAD ()
	  IFG. T2		; This address any use at all?
	    DMOVEM T1,(Q2)	; Yeah, save this entry
	    ADDI Q2,2		; Remember that we did
	  ENDIF.
	  AOJ Q1,		; That was one more user address
	  SOJG Q3,TOP.		; Loop if there are more addresses
	ENDDO.			; All useful addresses now in our table
	SUB Q2,MSG		; See how many entries we kept
	LSH Q2,-1
	MOVE P3,Q2		; That's our new count

	DO.			; Bubble sort the entries by goodness
	  MOVE Q1,P3		; Count
	  MOVE Q2,MSG		; Current address
	  SETZ Q3,		; NULL sample pointer
	  DO.			; Look at all addresses
	    JUMPLE Q1,ENDLP.	; Exit if no addresses left to scan
	    IFN. Q3		; If we have a sample point
	      CAML T2,1(Q2)	; And this address is better
	    ANSKP.
	      DMOVE T3,(Q2)	; Swap this entry with the sampled entry
	      DMOVEM T1,(Q2)
	      DMOVEM T3,(Q3)
	      EXIT.		; Exit inner loop, and waltz around again
	    ELSE.
	      MOVE Q3,Q2	; Otherwise, take new sample here
	      DMOVE T1,(Q3)
	    ENDIF.		; In order so far
	    ADDI Q2,2		; Increment pointer by one entry
	    SOJA Q1,TOP.	; Do next entry
	  ENDDO.		; Swapped or no more addresses
	  JUMPG Q1,TOP.		; Start over if swapped
	ENDDO.			; Done sorting.

	MOVE Q1,P2		; Point to user's block of addresses
	MOVE Q2,MSG		; Point to our buffer
	MOVE Q3,P3		; Count of addresses
	DO.			; Loop to write sorted addresses to user
	  SOJL Q3,RSKP		; Return success when done (and go OKINT)
	  MOVE T1,0(Q2)		; Get an address
	  XCTU [MOVEM T1,(Q1)]	; Write it
	   ERJMP UWMPV
	  ADDI Q2,2		; Count one table entry
	  AOJA Q1,TOP.		; Update user space pointer and loop
	ENDDO.			; Never get here.
SUBTTL	I/O routines

; ITOD -- convert a 32 bit IP address into IN-ADDR domain name format
;
; Accepts:
; T1/ output byte pointer
; T2/ number to convert
;
; Returns:
; +1 on failure
; +2 on success
;  T1/ updated byte pointer
;
; Output buffer should be long enough to hold a 29 byte string.

ITOD:	TLNE T2,740000		; Make sure this is legal IP address
	 RETBAD (GTDX13)
	SAVEAC <T2,T3,T4,Q1,Q2>	; Save ACs we use
	MOVE Q1,T2
	MOVEI Q2,3		; Loop four times
	DO.			; Get an octet
	  LDB T3,[POINT 8,Q1,11
		  POINT 8,Q1,19
		  POINT 8,Q1,27
		  POINT 8,Q1,35](Q2)
	  MOVEI T2,1		; Assume one-digit number
	  CAIL T3,^D10		; Is two digit?
	   AOJ T2,		; Yup
	  CAIL T3,^D100		; Three digit?
	   AOJ T2,		; Yup
	  IDPB T2,T1		; Write count byte
	  IDIVI T3,^D100	; Get high digit
	  IFN. T3		; If non-zero
	    ADDI T3,"0"		; Make into ascii digit
	    IDPB T3,T1		; Write it
	  ENDIF.
	  MOVE T3,T4		; Get remainder
	  IDIVI T3,^D10		; Make other two digits
	  ADDI T3,"0"		; Convert to ascii
	  CAIL T2,2		; More than one digit?
	   IDPB T3,T1		; Yes, write middle digit
	  ADDI T4,"0"		; Last digit gets written
	  IDPB T4,T1		; in all cases.
	  SOJGE Q2,TOP.		; Loop if more octets
	ENDDO.			; Done with number
	MOVE T2,[POINT 7,INADDR]
	DO.			; Tack on suffix string
	  ILDB T3,T2
	  IDPB T3,T1
	  JUMPN T3,TOP.
	ENDDO.
	RETSKP			; Return success

; String to append to domain-name-formatted address.
INADDR:	BYTE(7) 7,"I","N","-","A","D","D","R",4,"A","R","P","A",0

; Extreme paranoia, formalize assumptions about MAXDNM and length of
; IN-ADDR QNAMEs.
; Max length = number_of_octets * length_of_octet_tag + length_of_suffix.
IFL <MAXDNM-<4*4+<<.-INADDR>*5>>>,<
	PRINTX ? IN-ADDR QNAME too long for data page (impossible error)
>

IFN CHAOS,<			; Chaosnet support only

; CTOD -- convert a 16 bit chaos address into CH-ADDR domain name format
;
; Accepts:
; T1/ output byte pointer
; T2/ number to convert
;
; Returns:
; +1 on failure
; +2 on success
;  T1/ updated byte pointer
;
; Output buffer should be long enough to hold a full length domain name.

CTOD:	SKIPLE T2		; Make sure it's a legal Chaos address
	CAILE T2,177777
	 RETBAD (GTDX13)
	SAVEAC <T2,T3,T4>	; Save ACs we use
	MOVEI T4,1		; Start with one digit
	DO.
	  IDIVI T2,8		; Divide off a digit
	  PUSH P,T3		; Save the digit
	  SKIPE T2		; Exit if that's all the digits
	   AOJA T4,TOP.		; Count another digit
	ENDDO.
	IDPB T4,T1		; Write length byte
	DO.
	  POP P,T2		; Get back a digit
	  ADDI T2,"0"		; Convert to an ascii character
	  IDPB T2,T1		; Write it into string
	  SOJG T4,TOP.		; Next digit
	ENDDO.
	MOVE T2,[POINT 7,CHADDR]
	DO.			; Tack on suffix strings
	  ILDB T3,T2
	  JUMPE T3,ENDLP.
	  IDPB T3,T1
	  LOOP.
	ENDDO.
	MOVE T2,CHDOMN		; Pointer to our chaosnet domain name
	DO.
	  ILDB T3,T2
	  IDPB T3,T1
	  JUMPN T3,TOP.
	ENDDO.
	RETSKP			; Return success

; String to append to domain-name-formatted address.
CHADDR:	BYTE(7) 7,"C","H","-","A","D","D","R",0

; There should be a conditional PRINTX here that checks to be
; sure CHADDR and associated stuff aren't too long for buffer.

>;IFN CHAOS

; ATOD -- convert asciz string with dots to domain name format.
;
; Accepts:
;  T2/ Destination byte pointer
;  T3/ Size of destination buffer in bytes
;  T4/ Instruction which will fetch a byte into T2
;
; Returns:
; +1 on error
;  T1/ Error code
; +2 on success
;  T2/ Updated pointer
;  T3/ Updated count
;  T4/ Non-zero if string ended with "."
;
; Does not use T1, P, or Q registers, so fetch instruction can
; reference these.  Saves T1 across fetch instruction that reads the
; null terminating the string, so T1 is the right place to put a byte
; pointer if you want it returned in ILDB format.

ATOD:	STKVAR <OUTBP,CNT,FETCH,SAVEBP,DOT,HOLDT1>
	MOVEM T2,OUTBP		; Save arguments
	MOVEM T3,CNT
	MOVEM T4,FETCH
	SETOM DOT		; Pretend last char was a dot to catch
	DO.			; bogus strings begining with a dot
	  SOSG CNT		; Check for overflow
	   RETBAD (GTDX9)	; Out of room, punt
	  SETZ T3,		; Count of chars for this label
	  IDPB T3,OUTBP		; Zero count byte and advance over it
	  MOVE T4,OUTBP		; Get pointer to count byte
	  MOVEM T4,SAVEBP	; Save till have something to put there
	  DO.
	    MOVEM T1,HOLDT1	; Save T1 in case it's caller's source BP
	    XCT FETCH		; Get a byte
	     ERJMP URIOX	; Paranoia
	    JUMPE T2,ENDLP.	; Exit loop if null or dot
	    CAIN T2,"."
	     EXIT.
	    SETZM DOT		; Ok, saw a non-dot character
	    CAIE T2,"\"		; Backslash quoting?
	    IFSKP.		; Yup
	      XCT FETCH		; Get next byte
	       ERJMP URIOX
	      CAIL T2,"0"	; Is it a digit?
	      CAILE T2,"9"
	    ANSKP.		; Yeah, sigh, \DDD character representation
	      MOVEI T4,-"0"(T2)	; Three decimal digits, result is assumed
	      IMULI T4,5+5	; to be text, thank Ghu
	      XCT FETCH
	       ERJMP URIOX
	      ADDI T4,-"0"(T2)
	      IMULI T4,5+5
	      XCT FETCH
	       ERJMP URIOX
	      SUBI T2,-"0"
	      ADD T2,T4
	    ENDIF.		; Done with "\" handling
	    SOSG CNT		; Make sure there's room
	     RETBAD (GTDX9)
	    IDPB T2,OUTBP	; Write the byte
	    AOJA T3,TOP.	; Next
	  ENDDO.
	  MOVE T4,SAVEBP	; Get pointer to count byte
	  DPB T3,T4		; Put in the count byte.
	  JUMPE T2,ENDLP.	; Done if saw null byte
	  CAIG T3,MAXLAB	; Was dot.  Label too long?
	  SKIPE DOT		; Or two dots in a row?
	   RETBAD (GTDX1)	; Loser, punt
	  SETOM DOT		; Remember that this is a dot
	  LOOP.			; Next label
	ENDDO.			; End of string
	SOSG CNT		; Terminate with null label
	 RETBAD (GTDX9)
	IDPB T2,OUTBP		; T2 already contained zero
	MOVE T1,HOLDT1		; Get return values
	MOVE T2,OUTBP
	MOVE T3,CNT
	MOVE T4,DOT
	RETSKP			; Return success
	ENDSV.			; Close scope of STKVAR
; DTOA -- convert domain format name to asciz string.
;
; Accepts:
;  T2/ Source byte pointer
;  T3/ Size of destination buffer in bytes
;  T4/ Instruction which will store a byte from T2
;  P1/ Flags from user GTDOM% call
;
; Returns:
; +1 on error
;  T1/ Error code
; +2 on success
;  T2/ Updated pointer
;  T3/ Updated count
;  T4/ Count of labels seen
;
; Does not use T1, P, or Q registers, so store instruction can reference these.
; If opcode of store instruction is not JSYS, will write a null byte after end
; of string, preserving T1 across this write operation, so T1 is the right 
; place to put a byte pointer if you want it preserved this way.

DTOA:	STKVAR <SRCBP,CNT,STORE,NLABEL>
	MOVEM T2,SRCBP		; Save arguments
	MOVEM T3,CNT
	MOVEM T4,STORE
	SETOM NLABEL		; No labels seen yet
	DO.
	  ILDB T3,SRCBP		; Get count for this label
	  JUMPE T3,ENDLP.	; Null count, end of domain name
	  SKIPL T3		; Paranoia
	   CAILE T3,MAXLAB
	    RETBAD (GTDX6)	; Bad label count, our fault, punt
	  AOSG NLABEL		; Do we need to write a dot?
	  IFSKP.		; Yes
	    SOSG CNT		; Check for room
	     RETBAD (GTDX8)	; Too long, return error
	    MOVEI T2,"."	; Character to write
	    XCT STORE		; Do it
	     ERJMP UWIOX	; Paranoia
	  ENDIF.		; Done handling dot
	  DO.			; Output each char of this label
	    ILDB T2,SRCBP	; Get one char
	    IFXN. P1,GD%RAI	; Want uppercase output?
	      CAIL T2,"a"	; Yeah, check for lowercase letter
	      CAILE T2,"z"
	    ANSKP.		; It's lowercase
	      SUBI T2,<"a"-"A">	; Convert to uppercase
	    ENDIF.
	    CAIE T2,"."		; Is it a dot?
	    CAIN T2,"\"		; Or a backslash?
	    IFNSK.		; Yup, have to quote it with "\"
	      SOSG CNT		; Check for overflow
	       RETBAD (GTDX8)	; Out of room, punt
	      MOVE T4,T2	; Save char
	      MOVEI T2,"\"	; Quoting character
	      XCT STORE		; Write it
	       ERJMP UWIOX	; Paranoia
	      MOVE T2,T4	; Get back original character
	    ENDIF.		; Now output original character
	    SOSG CNT		; Check for room
	     RETBAD (GTDX8)	; Overflow, punt
	    XCT STORE		; Write it
	     ERJMP UWIOX
	    SOJG T3,TOP.	; Next char in this label
	  ENDDO.		; End of this label
	  LOOP.			; Next label
	ENDDO.			; No more labels
	HLRZ T3,STORE		; Get store instruction opcode
	CAIN T3,(JSYS)		; Is it a JSYS?
	IFSKP.			; Nope, have to write null byte	
	  SOSG CNT		; Check for room
	   RETBAD (GTDX8)	; Drat and double drat
	  MOVE T4,T1		; Save T1 across null byte output
	  SETZ T2,		; A null byte
	  XCT STORE		; Write it
	   ERJMP UWIOX		; Gack
	  MOVE T1,T4		; Put T1 back
	ENDIF.			; Done with null byte
	MOVE T2,SRCBP		; Get return values
	MOVE T3,CNT
	AOS T4,NLABEL
	RETSKP			; Return success
	ENDSV.			; Close scope of STKVAR
; STOA -- convert domain format string to asciz string.
;
; Accepts:
;  T2/ Source byte pointer
;  T3/ Size of destination buffer in bytes
;  T4/ Instruction which will store a byte from T2
;
; Returns:
; +1 on error
;  T1/ Error code
; +2 on success
;  T2/ Updated pointer
;  T3/ Updated count
;
; Does not use T1, P, or Q registers, so store instruction can reference these.
; If opcode of store instruction is not JSYS, will write a null byte after end
; of string, preserving T1 across this write operation, so T1 is the right 
; place to put a byte pointer if you want it preserved this way.

STOA:	STKVAR <SRCBP,CNT,STORE>
	MOVEM T2,SRCBP		; Save arguments
	MOVEM T3,CNT
	MOVEM T4,STORE
	ILDB T3,SRCBP		; Get length of string
	DO.
	  SOJL T3,ENDLP.	; Exit loop if end of source string
	  ILDB T2,SRCBP		; Get one char
	  SOSG CNT		; Check for room
	   RETBAD (GTDX8)	; Overflow, punt
	  XCT STORE		; Write it
	   ERJMP UWIOX
	  LOOP.
	ENDDO.			; End of string
	HLRZ T3,STORE		; Get store instruction opcode
	CAIN T3,(JSYS)		; Is it a JSYS?
	IFSKP.			; Nope, have to write null byte	
	  SOSG CNT		; Check for room
	   RETBAD (GTDX8)	; Drat and double drat
	  MOVE T3,T1		; Save T1 across null byte output
	  SETZ T2,		; A null byte
	  XCT STORE		; Write it
	   ERJMP UWIOX		; Gack
	  MOVE T1,T3		; Put T1 back
	ENDIF.			; Done with null byte
	MOVE T2,SRCBP		; Get return values
	MOVE T3,CNT
	RETSKP			; Return success
	ENDSV.			; Close scope of STKVAR
SUBTTL	Support routines

; GETPAG -- co-routine to assign a page from free space
; Takes no arguments.  On lossage, just returns +1.
; On win, returns +2 with page address in MSG, and twiddles
; stack so that exit will release page correctly.
; We misuse MSG within this routine for the sake of cleaner
; stack twiddling code.

GETPAG:	XMOVEI MSG,GIVPAG	; Set up return PC
	EXCH MSG,(P)		; Put return on the stack
	PUSH P,MSG		; Then the guy who called us
	SAVEAC <T1,T2,T3,T4>	; Save other registers
	CALLXX ASGPGS		; Assign page from free space
	IFNSK.
	  SETZ MSG,		; No message page
	  RET			; Return to caller
	ENDIF.
	MOVE MSG,T1		; Address of block
	RETSKP

; Coroutine to release monitor IPCF page during return
; Accepts:
;	MSG/ Address of page

GIVPAG:	TRNA			; Normal entry...
	 AOS (P)		; Propagate skip return
	JUMPE MSG,R		; Return pronto if nothing to do
	SAVEAC <T1,T2,T3,T4>	; Save registers
	MOVE T1,MSG		; Get page address
	CALLXX RELPGS		; Release it
	RET			; Done
; ERJMP handlers:

; URIOX, UWIOX -- User Read/Write I/O XCT error (T4 contains instruction)
; URMPV, UWMPV -- XCTU to/from user memory failed

URIOX:	CAME T4,[BIN%]		; Already have error code if JSYS
URMPV:	 MOVEI T1,ILLX01	; Else, bad memory operation
	RETBAD ()		; Return error to caller.

UWIOX:	CAME T4,[BOUT%]		; Already have error code if JSYS
UWMPV:	 MOVEI T1,ILLX02	; Else, bad memory operation
	RETBAD ()		; Return error to caller.
; Coroutine to go NOINT but still support RETBAD()

CNOINT:	NOINT			; Turn off interrupts
	POP P,CX		; MACSYM scratch AC
	CALL (CX)		; Coreturn to caller
	 SKIPA			; +1 return
	  AOS (P)		; +2 return
	OKINT			; Turn on interrupts
	RET			; Unwind stack some more

; Routine to kill MYPID when we're done with it.  Preserves all ACs.

KILPID:	JUMPE MYPID,R		; Don't bother if no PID
	SAVEAC <T1,T2,T3,T4>	; Save ACs we smash
	MOVEI T1,2		; Two words of argument
	MOVEI T2,T3		; Arguments are in T3 and T4
	MOVEI T3,.MUDES		; Delete a PID
	MOVE T4,MYPID		; Our PID
	MUTIL%			; Destroy it
	 ERJMP .+1		; Oh well, we tried
	SETZM MYPID		; Don't do this again
	RET			; Done

; GSBITS -- Get host status bits.
; Accepts T1/  Host number
;	  MSG/ Message page pointer
; Returns +1 always
;	  P4/  Status bits
GSBITS:	SAVEAC <T1,T2,T3,T4>	; Save ACs we smash
	CAIN T2,QC.IN		; Only know about status for Internet
	 CALL HSTHSH		; See if this host has status
	  TDZA P4,P4		; No host status
	   MOVE P4,HSTSTS(T2)	; Get host status bits
	LOAD T1,FLAGS,+U.PHSIZ(MSG)
	TXNE T1,UF.AKA		; If resolver said "alias found",
	 TXO P4,HS%NCK		; light the nickname bit
	RET			; That's it.
SUBTTL	IP Address desirability evaluation

IFN DHPRSW,<

; WARNING: This code knows too flinking much about the guts of the IP code.
;	   It may stop working at any time, if in fact it works on your
;	   machine to begin with.

	EXT	<MAXGWA,GWYLUK>	; Stuff we need from IPIPIP.MAC
				; NB: these aren't global on a vanilla system

; Routine to determine a host address "Goodness"
; Accepts:  T1/ host number
; returns:  T2/ goodness
;
; The value returned in T2 is a positive integer which indicates the
; desirability of this address. Larger numbers indicate more desirable
; addresses. This routine is used to order addresses returned by the
; resolver for presentation to the user.

; This default version of the routine is intended to work with standard
; DEC monitors. Sites may wish to change this routine to consider issues
; such as fast vs slow interfaces or locally implemented subnet schemes.
; 
; Priority rankings:
;
;		5 : host is directly connected to the preferred net
;		4 : host is directly connected to an available net
;		3 : a gateway to the host's net is on the preferred net
;		2 : a gateway to the host's net is on an available net.
;		1 : host is at least 2 hops away..

HSTGUD:	NETNUM T2,T1		; Get network number of destination
	CAME T2,PRFNET		; Check if this address is on the preferred net
	IFSKP.
	 MOVEI T2,5		; really good address.
	 RET
	ENDIF.

; Now check if we have ANY interface direct to the desired net
	XMOVEI T3,NCTVT		; Point to the NCT table
	DO.
	 LOAD T3,NTLNK,(T3)	; Get net in the chain
	 JUMPE T3,ENDLP.	; no more Interfaces - failure
	 CAME T2,NTNET(T3)	; same network?
	  LOOP.			; No, loop
	 MOVEI T2,4		; YES. return goodness level 4.
	 RET
	ENDDO.

; Now check if we know of any gateways connected directly to the specified net
	SAVEAC <T1>		; save t1
	CALL FNDGAT		; find a gateway
	IFSKP.			; one has been found...
	 MOVE T1,.GWILS(T1)	; get its (local) address
	 NETNUM T1,T1		; get network number of gateway
	 CAME T1,PRFNET		; is it on our preferred net?
	  TDZA T2,T2		; no
	   MOVEI T2,1		; yes - it gets an extra point
	 ADDI T2,2		; 2 or 3 total points
	 RET			; return this value
	ENDIF.

; Still losing, address is at least two hops away
	MOVEI T2,1		; address is minimally good.
	RET

; FNDGAT: Find a gateway (in the gateway table) that is directly connected
;	 to the Network specified (and to a net we are on).
; Entry: T2/ Network number
; Exit:	+1 failure.  No good gateways were found.
;	+2 success.  T1/ (extended) pointer to gateway block.
;

FNDGAT:	ACVAR	<GWT,I>
	MOVSI	I,-MAXGWA	; Size of tables
	DO.
	  HRRZ	GWT,I		; Get offset
	  ADD	GWT,GWTAB	; Point into table
	  SKIPN	GWT,(GWT)	; Get entry (if any)
	   RET			; Slot is empty - assume end of table
	  IFQN.	GWUP,(GWT)	; Gateway up?
	    MOVE T1,.GWILS(GWT)	; Get accessable address
	    CALL NETCHK		; Is this interface up?
	  ANSKP.		; No, try another gateway
	    LOAD T3,GWICT,(GWT)	; Get the interface count
	    XMOVEI T4,.GWILS(GWT)
	    DO.			; Point to interface names
	      MOVE T1,(T4)	; Get an address
	      NETNUM T1,T1	; Get the net number
	      CAME T1,T2	; Same network as we want?
	      IFSKP.
	        MOVE T1,GWT	; Get the address of this GW block
	        RETSKP		; and return
	      ENDIF.
	      AOJ T4,		; Point to the next entry
	      SOJG T3,TOP.	; and loop through this gateway
	    ENDDO.
	  ENDIF.		; Done with this gateway block
	  AOBJN I,TOP.		; Loop through all gateway blocks
	ENDDO.
	RET			; Failure.  No skip.
	ENDAV.

;Policy routine to compute best local address for communication with
; a given foreign host. Compute local addr by asking IP for the best
; gateway to that host, then using our interface on that gateway's
; subnet as the local address.
;
;Call:	T1/	Foreign address
;Return +1, T1/ Best local address for communication with this host
;
BSTLCL:	SAVEAC <P1>
	CALL GWYLUK		;See how IP would get there.
	IFN. T1			;It wouldn't. Let loser lose later, not now.
	  CALL FNDNCT		;P1/ NCT for interface to this GW
	ANSKP.			;Should never happen, GWYLUK checks
	  MOVE T1,NTLADR(P1)	;Get local address of this interface.
	ELSE.
	  MOVE T1,DEFADR	;Bail out.
	ENDIF.
	RET

>;IFN DHPRSW
SUBTTL	Class dependent stuff

; These are mostly stub routines.  The intent is to localize
; knowledge of class specific parts of the domain protocol
; to this section.  Currently there are only two RRs known
; to be class dependent in format: A and WKS.  We don't use WKS
; for anything ourselves, so that's not a problem.  A we have
; to handle.  Also, the suffix name used in CH-ADDR lookups
; is dependent on the domain name of the local chaosnet.

; There is also stuff here for extracting information from
; the network code that is in some mystical way related to
; the way the domain system uses class.  This is mostly address
; selection/evaluation stuff.

; If there ever get to be more than two useful classes,
; this stuff should be expanded to table lookups.  Right now
; it's faster and cleaner to just code tests directly.

; QCVAL -- See if QCLASS is valid.
; Accepts:
;  T1/ QCLASS
; Returns:
;  +1: Bad QCLASS, error code in T1
;  +2: QCLASS ok, all ACs preserved

QCVAL:
	CAIN T1,QC.IN		; Internet?
	 RETSKP			; Yes, Win
IFN CHAOS,<
	CAIN T1,QC.CH		; Chaosnet?
	 RETSKP			; Yes, Win
>;IFN CHAOS
	RETBAD (GTDX12)		; Unknown, lose


; QCNTOD -- Convert Number to Domain name (xx-ADDR format)
; Accepts:
;  T1/ output byte pointer
;  T2/ number to convert
; Returns:
; +1 on failure
;  T1/ error code
; +2 on success
;  T1/ updated byte pointer

QCNTOD:	CAIN T3,QC.IN		; Internet?
	 JRST ITOD		; Yes, dispatch
IFN CHAOS,<
	CAIN T3,QC.CH		; Chaosnet?
	 JRST CTOD		; Yes, dispatch
>;IFN CHAOS
	RETBAD (GTDX12)

	
; QCGLCL -- Get local host address
; Accepts:
;  T1/ QCLASS
; Returns:
;  +1: error
;  +2: success
;  T2/ host address

QCGLCL:	CAIE T1,QC.IN		; Internet?
	IFSKP.
	  MOVE T2,PRFADR	; Use our prefered IP address
	  RETSKP
	ENDIF.
IFN CHAOS,<
	CAIE T1,QC.CH		; Chaosnet?
	IFSKP.
	  MOVE T2,MYCHAD	; Multi-homing? What's that?
	  RETSKP
	ENDIF.
>;IFN CHAOS
	RETBAD (GTDX12)

; QCBLCL -- Get "best" local host address for specified foreign address
; Accepts:
;  T1/ target foreign address
;  T2/ QCLASS
; Returns:
;  +1: error
;  +2: success
;  T1/ host address

QCBLCL:	CAIE T2,QC.IN		; Internet?
	IFSKP.
	  CALL BSTLCL		; Yeah, what a coincidence, all the args
	  RETSKP		; are where they should be.
	ENDIF.
IFN CHAOS,<
	CAIE T2,QC.CH		; Chaosnet?
	IFSKP.
	  MOVE T1,MYCHAD	; This is a bad joke, but what else
	  RETSKP		; can we do without a routing table?
	ENDIF.
>;IFN CHAOS
	RETBAD (GTDX12)

; QCGADR -- Get host address from IPCF packet and determine "goodness" value
; Accepts:
;  T1/ Pointer to RDATA portion of current RR
;  T2/ QCLASS
;  MSG/ pointer to message page
; Returns:
;  +1: error
;  +2: success, with
;  T1/ address
;  T2/ "goodness"

QCGADR:	CAIE T2,QC.IN		; Internet?
	IFSKP.
	  MOVE T1,IN.A.ADDR(T1)	; Get address
	  CALLRET QCGGUD	; Onward to get goodness
	ENDIF.
IFN CHAOS,<
	CAIE T2,QC.CH		; Chaosnet?
	IFSKP.
	  MOVE T1,CH.A.ADDR(Q1)	; Get address
	  ; Ought to compare against CHDOMN
	  ; to be sure this is right chaosnet.
	  ; If it isn't, return -1 as goodness,
	  ; which will prevent this addr from
	  ; ever being used.
	  CALLRET QCGGUD	; Onward to get goodness
	ENDIF.
>;IFN CHAOS
	RETBAD (GTDX12)

; QCGGUD -- Determine "goodness" value for a host address
; Accepts:
;  T1/ Address
;  T2/ QCLASS
; Returns:
;  +1: error
;  +2: success, with
;  T1/ address
;  T2/ "goodness"

QCGGUD:	CAIE T2,QC.IN		; Internet
	IFSKP.
	  CALL HSTGUD		; Look up goodness
	  RETSKP		; Return win
	ENDIF.
IFN CHAOS,<
	CAIE T2,QC.CH
	  MOVEI T2,1		; All addresses look alike without a routing
	  RETSKP		; table, so the all win, I guess
	ENDIF.
>;IFN CHAOS
	RETBAD (GTDX12)
	TNXEND
	END