mirror of
https://github.com/PDP-10/its.git
synced 2026-04-10 23:11:03 +00:00
Eric Swenson
409
src/cstacy/netrtn.76
Normal file
409
src/cstacy/netrtn.76
Normal file
@@ -0,0 +1,409 @@
|
||||
;;; -*- Mode: MIDAS -*-
|
||||
|
||||
TITLE NETRTN - Maclisp/NETWRK package.
|
||||
;CStacy, December 1983
|
||||
|
||||
; Summary:
|
||||
;
|
||||
; (MAP-HOSTS3) ==> T if mapped in the database.
|
||||
; (STDHST host) ==> standardized host-number.
|
||||
; (GET-NET-FROM-ADDRESS host) ==> network-number.
|
||||
; (OWN-HOST network-numer) ==> host.
|
||||
; (HOST-EQUAL host1 host2) ==> T iff they refer to same host.
|
||||
; (LOOKUP-HOST host-name) ==> host-number.
|
||||
; (HOST-SIXBIT-NAME host) ==> sixbit host name.
|
||||
; (HOST-INFO host) ==> (host-name . SITES-pointer)
|
||||
; (TAC? host) ==> T iff this is an Internet TIP or TAC.
|
||||
; NW%ARP ==> ARPAnet network-number.
|
||||
; NW%LCS ==> LCSnet network-number.
|
||||
; NW%CHS ==> CHAOSnet network-number.
|
||||
|
||||
|
||||
.FASL
|
||||
IF1,.INSRT SYS:.FASL DEFS
|
||||
|
||||
;;; Accumulator definitions
|
||||
;;; NETWRK assumes A thru E, consecutive T and TT, and pdl pointer P.
|
||||
|
||||
NETWRK"A=A
|
||||
NETWRK"B=B
|
||||
NETWRK"C=D
|
||||
NETWRK"D=R
|
||||
NETWRK"E=F
|
||||
NETWRK"T=T
|
||||
NETWRK"TT=TT
|
||||
NETWRK"P==FXP
|
||||
|
||||
;;; NETWRK routines
|
||||
|
||||
NETWRK"$$LOOK==1 ;Include only lookup routines.
|
||||
NETWRK"$$ARPA==1
|
||||
NETWRK"$$CHAOS==1
|
||||
NETWRK"$$HST3==1 ;Use the HOSTS3 database.
|
||||
NETWRK"$$ALLNET==1 ;Look up Internet/Unternet.
|
||||
NETWRK"$$HSTMAP==1 ;Host mapping routines.
|
||||
NETWRK"$$SYMLOOK==1 ;Host name lookup.
|
||||
NETWRK"$$HOSTNM==1 ;Host name lookup.
|
||||
NETWRK"$$HSTSIX==1 ;Sixbit-name host lookup.
|
||||
NETWRK"$$OWNHST==1 ;Own host number routine.
|
||||
NETWRK"$$HSTCMP==1 ;Host number comparisons.
|
||||
NETWRK"$$CVH==1 ;Host number conversions.
|
||||
.INSRT SYSENG;NETWRK
|
||||
|
||||
;;;; Macros.
|
||||
|
||||
;;; Nice names for some instructions.
|
||||
|
||||
NOP=:<JFCL>
|
||||
CALRET==:JRST
|
||||
|
||||
;;; System calling.
|
||||
|
||||
DEFINE SYSCAL NAME,ARGS
|
||||
.CALL [SETZ ? SIXBIT /NAME/ ? ARGS ((SETZ))]
|
||||
TERMIN
|
||||
|
||||
;;; (NOT NIL)
|
||||
|
||||
DEFINE TRUTH
|
||||
.ATOM T!TERMIN
|
||||
|
||||
;;; SETQing a symbol to a number at FASLOAD time.
|
||||
|
||||
DEFINE QTES NAME,VAL
|
||||
.SXEVA (SETQ NAME #VAL )
|
||||
TERMIN
|
||||
|
||||
;;; GCOFF and GCON can surround code during which garbage collection
|
||||
;;; and interrupts should not happen.
|
||||
;;; This is necessary since we let LSRTNS randomly hack the argument ACs.
|
||||
|
||||
DEFINE GCOFF
|
||||
PUSH FXP,INHIBIT
|
||||
SETOM INHIBIT
|
||||
PUSH FXP,NOQUIT
|
||||
HLLOS NOQUIT
|
||||
TERMIN
|
||||
|
||||
DEFINE GCON
|
||||
POP FXP,NOQUIT
|
||||
PUSHJ P,INTREL ;Pop FXP and check for deferred interrupts.
|
||||
TERMIN
|
||||
|
||||
;;; Bash ACs to be NIL, which is a reasonable pointer for an argument AC.
|
||||
;;; MacLisp does "caller-saves" protocol, so we just need to make sure
|
||||
;;; there is not garbage left in these when we turn back on interrupts
|
||||
;;; and garbage collection.
|
||||
|
||||
DEFINE NULLIFY LIST
|
||||
IRP AC,,[LIST]
|
||||
MOVE AC,NIL
|
||||
TERMIN
|
||||
TERMIN
|
||||
|
||||
;;; Popular returns:
|
||||
|
||||
;;; ONRET - Zap reasonable things into argument ACs, turn on interrupts
|
||||
;;; and garbage collection, and return the value in A.
|
||||
;;; (But for NCALLable functions, you must return value in TT instead.)
|
||||
|
||||
ONRET: NULLIFY [B,C,AR1,AR2A]
|
||||
GCON
|
||||
POPJ P,
|
||||
|
||||
|
||||
;;; Check for HOSTS3 having been mapped in.
|
||||
;;; Do this before hacking GC or trashing anything.
|
||||
|
||||
DEFINE HST3CK
|
||||
SKIPN HST3P
|
||||
LERR [SIXBIT "Host table has not been mapped in!"]
|
||||
TERMIN
|
||||
|
||||
|
||||
|
||||
;;; BP2LST - Given a Bp in D, return in A a list of characters.
|
||||
|
||||
BP2LST: PUSH FXP,B
|
||||
PUSH FXP,D
|
||||
MOVEI B,NIL ;()
|
||||
BP2LS1: ILDB TT,D ;Get a character.
|
||||
JUMPE TT,BP2LS9 ;Zero terminated strings.
|
||||
JSP T,FXCONS ;Turn into fixnum.
|
||||
CALL 2,.FUNCTION CONS ;CONS onto our list.
|
||||
MOVE B,A ;Recover list pointer.
|
||||
JRST BP2LS1 ;Gobbble entire string.
|
||||
BP2LS9: MOVE A,B ;Recover list pointer.
|
||||
CALL 1,.FUNCTION NREVERSE ;Reverse it to normal order.
|
||||
POP FXP,D
|
||||
POP FXP,B
|
||||
POPJ FXP,
|
||||
|
||||
|
||||
|
||||
;;;; (HSTMAP)
|
||||
;;;
|
||||
;;; Maps in the HOSTS3 database and returns the file object opened.
|
||||
;;; Returns NIL if there was an error.
|
||||
;;;
|
||||
;;; Note: since there is no way to return storage to Maclisp,
|
||||
;;; we do not provide a "HSTUNM" function.
|
||||
|
||||
HST3P: 0
|
||||
|
||||
.ENTRY MAP-HOSTS3 SUBR 1+0 ;No argument.
|
||||
GCOFF
|
||||
MOVEI A,.ATOM SYSBIN/;HOSTS3/ >
|
||||
MOVEI B,.SX (IN)
|
||||
CALL 2,.FUNCTION OPEN ;Ask for file object.
|
||||
PUSH FXP,A ;Stack the file object.
|
||||
MOVEI TT,F.CHAN ;Get channel number from the file array.
|
||||
MOVE B,@TTSAR(A)
|
||||
SYSCAL OPEN,[ NETWRK"B ? %CLBIT,,.BII
|
||||
[SIXBIT /DSK/]
|
||||
[SIXBIT /HOSTS3/]
|
||||
[SIXBIT />/]
|
||||
[SIXBIT /SYSBIN/]]
|
||||
JRST HSTMA8 ; Fail
|
||||
SYSCAL FILLEN,[B ? %CLOUT,,TT] ;Get length in bytes.
|
||||
JRST HSTMA8 ; Fail
|
||||
JUMPLE TT,HSTMA8 ;Make sure length not zero.
|
||||
MOVEI TT,1777(TT) ;Round up length to next page.
|
||||
LSH TT,-10. ;And convert to number of pages.
|
||||
PUSH FXP,TT
|
||||
PUSHJ P,GETCOR ;Ask for that much core.
|
||||
JUMPE TT,HSTMA8 ; If not available, fail.
|
||||
MOVEM TT,NETWRK"HSTADR ;Remember addr where mapping.
|
||||
IDIVI TT,2000 ;Convert addr to page number.
|
||||
HRRZ A,TT ;Page number RH of AOBJN ptr.
|
||||
POP FXP,TT ;Get number pages desired.
|
||||
MOVNS TT ;Negative number of pages in LH.
|
||||
HRL A,TT
|
||||
MOVEM A,NETWRK"HSTABN ;Save AOBJN for unmapping (not really).
|
||||
SYSCAL CORBLK,[ 1000,,%CBNDR ;Read-only
|
||||
1000,,%JSELF ;into self
|
||||
A ;at core pages provided.
|
||||
B] ;from file open on channel.
|
||||
JRST HSTMA8 ; Fail.
|
||||
SYSCAL CLOSE,[ B ] ;All mapped in: close HOSTS3.
|
||||
JRST HSTMA8
|
||||
MOVE T,NETWRK"HSTADR ;Address where HOSTS3 should start.
|
||||
MOVE T,NETWRK"HSTSID(T) ;Examine check word.
|
||||
MOVEI FREEAC,TRUTH ;If we win, we return T.
|
||||
CAME T,[SIXBIT /HOSTS3/] ;Finally, is this really HOSTS3?
|
||||
HSTMA8: MOVEI FREEAC,NIL ; No, we lose: we return NIL.
|
||||
POP FXP,A ;Recover file object.
|
||||
CALL 1,.FUNCTION CLOSE ;Close it.
|
||||
SETOM HST3P ;Remember we mapped it in OK.
|
||||
MOVE A,FREEAC
|
||||
JRST ONRET ;Return T or NIL.
|
||||
|
||||
|
||||
|
||||
;;;; (OWN-HOST network-numer)
|
||||
;;;
|
||||
;;; Given a network number (fixnum), returns our own host address there.
|
||||
|
||||
.ENTRY OWN-HOST SUBR 1+1
|
||||
HST3CK
|
||||
JSP T,FXNV1 ;TT gets network fixnum.
|
||||
GCOFF
|
||||
MOVE NETWRK"A,TT
|
||||
PUSHJ FXP,NETWRK"OWNHST ;Look up our host address.
|
||||
JRST [ MOVEI NETWRK"A,NIL ; Not on this net => NIL.
|
||||
JRST ONRET ]
|
||||
MOVE TT,NETWRK"A ;Get the HOSTS3 address.
|
||||
JSP T,FXCONS ;Make into fixnum.
|
||||
JRST ONRET
|
||||
|
||||
|
||||
;;; (STDHST host)
|
||||
;;; Return the host number in standard format.
|
||||
|
||||
.ENTRY STDHST SUBR 1+1
|
||||
JSP T,FXNV1 ;TT gets host fixnum.
|
||||
GCOFF
|
||||
MOVE NETWRK"A,TT
|
||||
PUSHJ FXP,NETWRK"STDHST ;Hack the host number.
|
||||
MOVE TT,NETWRK"A ;Here it is in standard format
|
||||
JSP T,FXCONS ;Make it into a fixnum.
|
||||
JRST ONRET ;Return it.
|
||||
|
||||
|
||||
;;; (GET-NET-FROM-ADDRESS host-address)
|
||||
;;;
|
||||
;;; Given a host address (fixnum), return its network number (fixnum).
|
||||
|
||||
.ENTRY GET-NET-FROM-ADDRESS SUBR 1+1
|
||||
JSP T,FXNV1 ;TT gets host fixnum.
|
||||
GCOFF
|
||||
NETWRK"GETNET TT,TT ;Get network number of our arg.
|
||||
JSP T,FXCONS ;CONS fixnum.
|
||||
MOVE A,TT ;That's the return value.
|
||||
JRST ONRET
|
||||
|
||||
|
||||
;;; Some popular HOSTS3 Network Numbers.
|
||||
|
||||
QTES NW%ARP,\NETWRK"NW%ARP
|
||||
QTES NW%LCS,\NETWRK"NW%LCS
|
||||
QTES NW%CHS,\NETWRK"NW%CHS
|
||||
|
||||
;.ENTRY NW%ARP SUBR 1+0
|
||||
; MOVE TT,[NETWRK"NW%ARP] ;ARPAnet IP net number.
|
||||
; JRST FIX1 ;CONS fixnum from A and return.
|
||||
|
||||
|
||||
|
||||
;;;; (HOST-EQUAL host1 host2)
|
||||
;;;
|
||||
;;; Returns T if the host numbers refer to the same host.
|
||||
;;; To compare host-numbers on different networks, HOSTS3 must be mapped.
|
||||
|
||||
.ENTRY HOST-EQUAL SUBR 2+1
|
||||
HST3CK
|
||||
JSP T,FXNV1 ;Host1 into TT.
|
||||
JSP T,FXNV2 ;Host2 into D.
|
||||
GCOFF
|
||||
MOVE NETWRK"A,TT
|
||||
MOVE NETWRK"B,D
|
||||
PUSHJ FXP,NETWRK"HSTCMP
|
||||
JRST [ MOVEI A,NIL
|
||||
JRST ONRET ]
|
||||
MOVEI A,TRUTH
|
||||
JRST ONRET
|
||||
|
||||
|
||||
|
||||
;;;; HOSTS3 SITE table lookup.
|
||||
|
||||
;;; (HOST-INFO host-address)
|
||||
;;;
|
||||
;;; Given a host (fixnum), returns a pair whose CAR is the host
|
||||
;;; name (fake-string) and whose CADR is a (fixnum) pointer into
|
||||
;;; the HOSTS3 SITE table.
|
||||
;;; Returns NIL if the host is not found.
|
||||
|
||||
.ENTRY HOST-INFO SUBR 1+1
|
||||
HST3CK
|
||||
JSP T,FXNV1 ;TT gets host fixnum.
|
||||
GCOFF
|
||||
MOVE NETWRK"B,TT
|
||||
PUSHJ FXP,NETWRK"HSTSRC ;Look up host.
|
||||
JRST [ MOVEI A,NIL ; Not found => NIL.
|
||||
JRST ONRET ]
|
||||
HRRZ D,NETWRK"A ;D gets address of official host name.
|
||||
HRLI D,440700 ;Make Bp to it.
|
||||
PUSHJ FXP,BP2LST ;Get list of fixnums into A.
|
||||
CALL 1,.FUNCTION IMPLODE ;Make into a symbol.
|
||||
PUSH P,A ;Stash pointer to it.
|
||||
; MOVEI B,TRUTH ;Say that it is a fake string.
|
||||
; MOVEI C,.ATOM +INTERNAL-STRING-MARKER
|
||||
; CALL 3,.FUNCTION PUTPROP
|
||||
MOVE TT,NETWRK"D ;Get SITE table pointer.
|
||||
JSP T,FXCONS
|
||||
MOVEI B,NIL ;Start with ().
|
||||
CALL 2,.FUNCTION CONS ;CONS on HOSTS3 pointer.
|
||||
MOVE B,A ;Recover list pointer.
|
||||
POP P,A ;A gets host name string.
|
||||
CALL 2,.FUNCTION CONS ;CONS it on.
|
||||
JRST ONRET ;Return pair.
|
||||
|
||||
|
||||
;;; (TAC? host-address)
|
||||
;;;
|
||||
;;; Given a host (fixnum), returns T of the host claims to be an
|
||||
;;; Internet TAC or TIP. Otherwise, returns NIL.
|
||||
|
||||
.ENTRY TAC? SUBR 1+1
|
||||
HST3CK
|
||||
JSP T,FXNV1 ;TT gets host fixnum.
|
||||
GCOFF
|
||||
MOVE NETWRK"B,TT
|
||||
PUSHJ FXP,NETWRK"HSTSRC ;Look up host.
|
||||
JRST TACP1 ; Not found, return NIL.
|
||||
MOVEI B,TRUTH ;Assume host is a TAC.
|
||||
TLNN NETWRK"A,400000 ;Is it really?
|
||||
TACP1: MOVEI B,NIL ; Nope.
|
||||
MOVE A,B
|
||||
JRST ONRET
|
||||
|
||||
|
||||
;;; (HOST-SIXBIT-NAME host-address)
|
||||
;;;
|
||||
;;; Given a host (fixnum), return its (sixbit quantity) host name,
|
||||
;;; or NIL if the host is not found.
|
||||
;;;
|
||||
;;; You need something like KMP's SIXBIT package (with SIXBIT->SYMBOL) to
|
||||
;;; make much use of the return value.
|
||||
|
||||
.ENTRY HOST-SIXBIT-NAME SUBR 1+1
|
||||
HST3CK
|
||||
JSP T,FXNV1 ;TT gets host fixnum.
|
||||
GCOFF
|
||||
MOVE NETWRK"A,TT
|
||||
PUSHJ FXP,NETWRK"HSTSIX ;Look up host.
|
||||
JRST [ MOVEI A,NIL ; Not found => NIL.
|
||||
JRST ONRET ]
|
||||
MOVE TT,NETWRK"A ;Sixbit value.
|
||||
JSP T,FXCONS ;CONS fixnum.
|
||||
JRST ONRET
|
||||
|
||||
|
||||
;;; Other things from the SITE table we might want to fool around with
|
||||
;;; include: the host ADDRESS table entries, the operating system and
|
||||
;;; machine types, and whether the host is a server; from the NAMES table
|
||||
;;; we might want to manually frob around with other names. We might also
|
||||
;;; want to examine the NETNAMES table and provide functions to map those
|
||||
;;; names to addresses and back.
|
||||
;;;
|
||||
;;; Hey, maybe if I figured out how to do Structs from inside MIDAS or something,
|
||||
;;; we could have SI:PARSE-HOST, which accept either host names or addresses
|
||||
;;; (maybe even site table entries?) and return all the various junk.
|
||||
;;;
|
||||
;;; Someday when I figure out the functionality and representation for these
|
||||
;;; features, I will implement them. That probably won't happen until I have
|
||||
;;; a real need to use them. If you are using this package and need to do
|
||||
;;; these things, send me mail and I'll put it in. -- CSTACY, 31 December 1983
|
||||
|
||||
|
||||
;;;; Host name lookup.
|
||||
|
||||
;;; (HOST-LOOKUP host-name)
|
||||
;;;
|
||||
;;; Given a host name (symbol), return its (fixnum) host address,
|
||||
;;; or NIL if unknown host.
|
||||
|
||||
HSLUQQ: BLOCK 20. ;Cruft.
|
||||
|
||||
.ENTRY HOST-LOOKUP SUBR 1+1
|
||||
HST3CK
|
||||
GCOFF
|
||||
PUSH P,A ;Stash arg.
|
||||
MOVEI TT,7. ;We want packed-ASCII fixnums.
|
||||
JSP T,FXCONS ;(Must use Lisp fixnums.)
|
||||
MOVE B,A
|
||||
POP P,A ;Recover arg.
|
||||
CALL 2,.FUNCTION PNGET ;Get the pname-list of our argument.
|
||||
MOVE F,[440700,,HSLUQQ] ;Bp to ASCIZ string we'll accumulate.
|
||||
MOVE A,(A) ;A gets first CONS of pname-list.
|
||||
HSLU20: HLRZ B,A ;Take CAR of list.
|
||||
MOVE C,B ;Make Bp to chars.
|
||||
HRLI C,440700
|
||||
MOVE FREEAC,[-5,,0] ;AOBJN to them.
|
||||
HSLU30: ILDB R,C ;Get a character.
|
||||
IDPB R,F ;Store it.
|
||||
AOBJN FREEAC,HSLU30 ;Get all five chars.
|
||||
SKIPE A,(A) ;Get next CONS from CDR of A.
|
||||
JRST HSLU20 ;Process this one.
|
||||
MOVEI NETWRK"A,HSLUQQ ;ASCIZ host name.
|
||||
PUSHJ FXP,NETWRK"HSTLOOK ;Look up the host.
|
||||
JRST [ MOVEI A,NIL ; Not found => NIL.
|
||||
JRST ONRET ]
|
||||
MOVE TT,NETWRK"A ;TT gets the host's Inter/Unternet address.
|
||||
JSP T,FXCONS ;CONS fixnum.
|
||||
JRST ONRET
|
||||
|
||||
.SXEVAL (SSTATUS FEATURE NETWRK)
|
||||
FASEND
|
||||
|
||||
Reference in New Issue
Block a user