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