diff --git a/bin/inquir/netrtn.fasl b/bin/inquir/netrtn.fasl deleted file mode 100644 index 6f993713..00000000 Binary files a/bin/inquir/netrtn.fasl and /dev/null differ diff --git a/build/lisp.tcl b/build/lisp.tcl index 5b029ff8..4d57c5b8 100644 --- a/build/lisp.tcl +++ b/build/lisp.tcl @@ -183,6 +183,8 @@ type ":kill\r" # inquir respond "*" ":midas inquir;_lsrrtn\r" expect ":KILL" +respond "*" ":midas inquir;_cstacy;netrtn\r" +expect ":KILL" respond "*" ":link liblsp;debug fasl,liblsp;dbg fasl\r" respond "*" ":link lisp;debug fasl,liblsp;debug fasl\r" diff --git a/src/cstacy/netrtn.76 b/src/cstacy/netrtn.76 new file mode 100644 index 00000000..cd5b2a84 --- /dev/null +++ b/src/cstacy/netrtn.76 @@ -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=: +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 + \ No newline at end of file