X-Git-Url: https://jxself.org/git/?p=pdp10-muddle.git;a=blobdiff_plain;f=mim%2Fdevelopment%2Fmim%2Fvax%2Fmimlib%2Fnetwork.mud;fp=mim%2Fdevelopment%2Fmim%2Fvax%2Fmimlib%2Fnetwork.mud;h=a044d7c713bf180286337bad8cb7b183075ac61e;hp=0000000000000000000000000000000000000000;hb=d73ace3f3292e320b461b8fcd2e9f5dc5d9684d7;hpb=d530283ea60fb0ddcc28e9c5bd072456afe06e07

diff --git a/mim/development/mim/vax/mimlib/network.mud b/mim/development/mim/vax/mimlib/network.mud
new file mode 100644
index 0000000..a044d7c
--- /dev/null
+++ b/mim/development/mim/vax/mimlib/network.mud
@@ -0,0 +1,344 @@
+<PACKAGE "NETWORK">
+
+<ENTRY GET-HOST GET-SERVICE GET-PROTOCOL GET-ADDR
+       NO-BLOCK? INTERRUPT? CONNECTION-LOST CONNECTION-READY
+       CONNECTION-URGENT CHAN-SELECT SEND RECEIVE NET-SERVER
+       SERVER-INIT SERVER-WAIT
+       GET-ADDRESS LISTEN-ON-DATA CONNECT-DATA-CHANNEL
+       GET-DATA-ADDRESS WRAP-SOCKET>
+
+<USE "NETBASE">
+
+<INCLUDE-WHEN <COMPILING? "NETWORK"> "NETDEFS">
+
+<EXPORT "NETBASE">
+
+<ADD-CHANNEL-OPS NETWORK
+		 READ-SAFE-BUFFER NETWORK-READ-SAFE
+		 GET-HOST NETWORK-GET ;"DONE"
+		 GET-SERVICE NETWORK-GET	;"DONE"
+		 GET-PROTOCOL NETWORK-GET	;"DONE"
+		 GET-ADDR NETWORK-GET ;"DONE"
+		 NO-BLOCK? NETWORK-SET
+		 INTERRUPT? NETWORK-SET
+		 SEND NETWORK-SEND
+		 RECEIVE NETWORK-RECEIVE
+		 GET-ADDRESS NET-GET-ADDRESS
+		 LISTEN-ON-DATA NET-MAKE-ALT
+		 CONNECT-DATA-CHANNEL NET-ACCEPT-CONN
+		 GET-DATA-ADDRESS NET-GET-DADDR>
+
+<DEFINE NETWORK-SEND (CHANNEL:<CHANNEL 'NETWORK> OPER BUF:<OR STRING UVECTOR>
+		      "OPT" (LEN:FIX <COND (<TYPE? .BUF UVECTOR> <LENGTH .BUF>)
+					   (<LENGTH .BUF>)>)
+		      "AUX" (DATA:CONNECTION <CHANNEL-DATA .CHANNEL>)
+		      (FLAG:FIX 0) RES:<OR FIX FALSE>)
+   <COND (<N==? <LHW <C-SERVICE .DATA>> ,PROT-UDP>
+	  <SET FLAG 1>)>
+   <COND
+    (<SET RES
+	  <CALL SYSCALL SEND <C-SOCKET .DATA> .BUF
+		<COND (<TYPE? .BUF UVECTOR> <* 4 .LEN>) (T .LEN)> .FLAG>>
+     <COND (<TYPE? .BUF UVECTOR> </ .RES 4>)
+	   (T .RES)>)>>
+
+<DEFINE NETWORK-RECEIVE (CHANNEL:<CHANNEL 'NETWORK> OPER BUF:<OR UVECTOR STRING>
+			 "OPT" (LEN:FIX <COND (<TYPE? .BUF STRING>
+					       <LENGTH .BUF>)
+					      (T <LENGTH .BUF>)>)
+			 "AUX" (DATA:CONNECTION <CHANNEL-DATA .CHANNEL>)
+			 (FLAG:FIX 0) RES:<OR FIX FALSE>)
+   <COND (<N==? <LHW <C-SERVICE .DATA>> ,PROT-UDP>
+	  <SET FLAG 1>)>
+   <COND
+    (<OR <NOT <C-TIMEOUT .DATA>>
+	 <DO-TIMEOUT .DATA>>
+     <COND
+      (<SET RES <ISYSCALL RECV <C-SOCKET .DATA> .BUF
+			  <COND (<TYPE? .BUF UVECTOR> <* 4 .LEN>)(T .LEN)>
+			  .FLAG>>
+       <COND (<TYPE? .BUF UVECTOR> </ .RES 4>)
+	     (T .RES)>)>)>>
+
+<DEFINE NETWORK-SET (CHANNEL:<CHANNEL 'NETWORK> OPER:ATOM "OPT" NEW:<OR ATOM FALSE>
+		     "AUX" (DATA:CONNECTION <CHANNEL-DATA .CHANNEL>)
+		     FLAG:FIX)
+   <COND (<==? .OPER INTERRUPT?>
+	  <SET FLAG ,FASYNC>)
+	 (<==? .OPER NO-BLOCK?>
+	  <SET FLAG ,FNDELAY>)>
+   <COND
+    (<NOT <ASSIGNED? NEW>>
+     <NOT <0? <ANDB .FLAG <C-FLAGS .DATA>>>>)
+    (T
+     <C-FLAGS .DATA <ORB .FLAG <C-FLAGS .DATA>>>
+     <PROG ((CURRENT-CONNECTION:<SPECIAL <CHANNEL 'NETWORK>> .CHANNEL))
+	<COND
+	 (<CALL SYSCALL FCNTL <C-SOCKET .DATA> ,F-SETFL <C-FLAGS .DATA>>
+	  .NEW)>>)>>
+
+<DEFINE WRAP-SOCKET (S:FIX 
+		     "AUX" (ADDR:NET-ADDRESS 
+			    <CHTYPE <STACK <IUVECTOR ,ADDR-WORD-LEN>>
+				    NET-ADDRESS>) (TUV <STACK <IUVECTOR 1>>))
+   <COND (<CALL SYSCALL GETSOCKNAME .S .ADDR .TUV>
+	  <CHANNEL-OPEN NETWORK "RAND" 0 .ADDR .S>)>>
+
+<DEFINE NETWORK-READ-SAFE (CHANNEL:<CHANNEL 'NETWORK> OPER
+			   "TUPLE" STUFF
+			   "AUX" (DATA:CONNECTION <CHANNEL-DATA .CHANNEL>)
+			   (BUF:UVECTOR <STACK <IUVECTOR 1>>) 
+			   RES:<OR FIX FALSE>
+			   (CURRENT-CONNECTION:<SPECIAL <CHANNEL 'NETWORK>> 
+                            .CHANNEL))
+   #DECL ((STUFF) <<PRIMTYPE VECTOR>
+					  [REST <OR STRING UVECTOR>
+					   <OR FIX FALES>]>)
+   <COND (<OR <NETWORK-SET .CHANNEL NO-BLOCK?>
+	      <AND <SET RES <CALL SYSCALL IOCTL
+				  <C-SOCKET .DATA> ,FIONREAD .BUF>>
+		   <G? <1 .BUF> 0>>>
+	  <NETWORK-READ .CHANNEL .OPER !.STUFF>)
+	 (.RES 0)>>
+
+<DEFINE NETWORK-GET (CHANNEL:<CHANNEL 'NETWORK> OPER:ATOM
+		     "AUX" (DATA:CONNECTION <CHANNEL-DATA .CHANNEL>)
+		     (ADDR <C-ADDR .DATA>))
+  <COND (<==? .OPER GET-HOST>
+	 <NA-HOST .ADDR>)
+	(<==? .OPER GET-SERVICE>
+	 <C-SERVICE .DATA>)
+	(<==? .OPER GET-ADDR>
+	 .ADDR)
+	(<==? .OPER GET-PROTOCOL>
+	 <LHW <C-SERVICE .DATA>>)>>
+
+<DEFINE NET-PIPE-HANDLER (IGN "AUX" CHN)
+   <COND (<AND <ASSIGNED? CURRENT-CONNECTION>
+	       <SET CHN .CURRENT-CONNECTION>>
+	  <KILL-CHANNEL .CHN>)>
+   <COND (<NETWORK-SET .CHN INTERRUPT?>
+	  <INTERRUPT "NETWORK" .CHN CONNECTION-LOST>)>>
+
+<DEFINE NET-SIGIO-HANDLER (IGN "AUX" (RBUF:UVECTOR <STACK <IUVECTOR 1>>)
+			   (EBUF:UVECTOR <STACK <IUVECTOR 1>>) (RFL:FIX 0)
+			   (EFL:FIX 0) (MAX:FIX -1) FOUND:<OR FALSE FIX>)
+   <REPEAT ((L:<LIST [REST FIX CHANNEL]> ,NET-CHANNELS) S)
+      <COND (<EMPTY? .L> <RETURN>)>
+      <SET EFL <ORB .EFL <LSH 1 <SET S <1 .L>>>>>
+      <SET RFL <ORB .RFL <LSH 1 .S>>>
+      <SET MAX <MAX .MAX .S>>>
+   <COND (<G=? .MAX 0>
+	  <1 .EBUF .EFL>
+	  <1 .RBUF .RFL>
+	  <COND
+	   (<SET FOUND <CALL SYSCALL SELECT <+ .MAX 1> .RBUF 0 .EBUF>>
+	    <POKE .EBUF CONNECTION-URGENT .MAX>
+	    <POKE .RBUF CONNECTION-READY .MAX>)>)>>
+
+<DEFINE POKE (BUF:<UVECTOR [REST FIX]> WHICH MAX:FIX
+	      "AUX" (L:<LIST [REST FIX <CHANNEL 'NETWORK>]> ,NET-CHANNELS))
+   <REPEAT ((CUR 0) (BITS <1 .BUF>) NL:<OR LIST FALSE>)
+      <COND
+       (<NOT <0? <ANDB .BITS <LSH 1 .CUR>>>>
+	<COND
+	 (<SET NL <MEMQ .CUR ,NET-CHANNELS>>
+	  <INTERRUPT "NETWORK" <2 .NL> .WHICH>)>)>
+      <COND (<G? <SET CUR <+ .CUR 1>> .MAX>
+	     <RETURN>)>>>
+
+<DEFINE CHAN-SELECT (TIMEOUT:<OR FIX FLOAT FALSE>
+		     "TUPLE" STUFF
+		     "AUX" (RBUF <STACK <IUVECTOR 1>>)
+		     (EBUF <STACK <IUVECTOR 1>>) (RFL 0)
+		     (TIMEVAL <STACK <IUVECTOR 2>>)
+		     (HANDLES <STACK <IUVECTOR </ <LENGTH .STUFF> 2> -1>>)
+		     (MAX:FIX -1))
+   #DECL ((STUFF) <<PRIMTYPE VECTOR> 
+                   [REST <CHANNEL 'NETWORK> <OR APPLICABLE FALSE>]>)
+   <COND (.TIMEOUT
+	  <TIME-NUM .TIMEVAL .TIMEOUT>)>
+   <REPEAT (CHN:<CHANNEL 'NETWORK> (TST .STUFF) H:FIX (HAND .HANDLES))
+      <COND (<EMPTY? .TST> <RETURN>)>
+      <COND (<SET H <CHANNEL-OP <1 .TST> FILE-HANDLE>>
+	     <1 .HAND .H>
+	     <SET MAX <MAX .H .MAX>>
+	     <SET RFL <ORB .RFL <LSH 1 .H>>>)>
+      <SET TST <REST .TST 2>>
+      <SET HAND <REST .HAND>>>
+   <COND
+    (<G=? .MAX 0>
+     <REPEAT (RES)
+	<1 .RBUF .RFL>
+	<1 .EBUF .RFL>
+	<COND (<SET RES <ISYSCALL SELECT <+ .MAX 1> .RBUF 0 .EBUF
+			      <COND (.TIMEOUT .TIMEVAL) (T 0)>>>
+	       <COND (<INVOKE <ORB <1 .RBUF> <1 .EBUF>> .STUFF .HANDLES .MAX>
+		      <RETURN>)>)
+	      (T
+	       <RETURN .RES>)>>)>>
+
+<DEFINE INVOKE (BITS:FIX STUFF:<<PRIMTYPE VECTOR> [REST <CHANNEL 'NETWORK>
+						   <OR APPLICABLE FALSE>]>
+		HANDLES:<UVECTOR [REST FIX]> MAX:FIX
+		"AUX" (CUR:FIX 0))
+   <REPEAT (HH:UVECTOR TS:<PRIMTYPE VECTOR>)
+      <COND (<NOT <0? <ANDB <LSH 1 .CUR> .BITS>>>
+	     <SET HH <MEMQ .CUR .HANDLES>>
+	     <SET TS <REST .STUFF <* 2 <- <LENGTH .HANDLES> <LENGTH .HH>>>>>
+	     <COND (<NOT <2 .TS>> <RETURN>)>
+	     <APPLY <2 .TS> <1 .TS>>)>
+      <COND (<G? <SET CUR <+ .CUR 1>> .MAX> <RETURN <>>)>>>
+
+<COND (<GASSIGNED? NET-PIPE-HANDLER>
+       <ON <HANDLER "PIPE" ,NET-PIPE-HANDLER>>)>
+
+<COND (<GASSIGNED? NET-SIGIO-HANDLER>
+       <ON <HANDLER "IOINT" ,NET-SIGIO-HANDLER>>
+       <ON <HANDLER "SOCKET" ,NET-SIGIO-HANDLER>>)>
+
+
+<DEFINE SERVER-WAIT (S:FIX "OPT" (TIMEOUT:<OR FIX FLOAT FALSE> <>)
+		     (ADDR:NET-ADDRESS <CHTYPE <STACK <IUVECTOR ,ADDR-WORD-LEN>>
+					       NET-ADDRESS>)
+		     "AUX" NS (BUF <STACK <IUVECTOR 1>>) RS
+		     (TO <STACK <IUVECTOR 2>>) RES
+		     (PT <STACK <UVECTOR ,ADDR-LEN>>))
+   <COND (.TIMEOUT
+	  <TIME-NUM .TO .TIMEOUT>)
+	 (T
+	  <SET TO 0>)>
+   <SET RS <RHW .S>>
+   <1 .BUF <LSH 1 .RS>>
+   <COND (<SET RES
+	       <ISYSCALL SELECT <+ .RS 1> .BUF 0 0 .TO>:<OR FIX FALSE>>
+	  <COND (<0? .RES> ,TIMED-OUT)
+		(T
+		 <COND (<==? <LHW .S> ,SOCK-STREAM>
+			<COND (<SET S <ISYSCALL ACCEPT .RS .ADDR .PT>>
+			       <CHANNEL-OPEN NETWORK "SERVER" 0
+					     .ADDR .S>)>)
+		       (T
+			<ERROR NOT-SUPPORTED .S SERVER-WAIT>)>)>)>>
+
+<DEFINE SERVER-INIT (SERVICE:FIX "OPT" (HOST:FIX 0)
+		     "AUX" (PROT <LHW .SERVICE>) 
+		     (SERVSOCK <RHW .SERVICE>) KIND S ERR
+		     (ADDR <CHTYPE <STACK <IUVECTOR ,ADDR-WORD-LEN>>
+				   NET-ADDRESS>))
+   <COND (<==? .PROT ,PROT-UDP> <SET KIND ,SOCK-DGRAM>)
+	 (T <SET KIND ,SOCK-STREAM>)>
+   <COND (<SET S <CALL SYSCALL SOCKET ,AF-INET .KIND .PROT>>
+	  <BUILD-ADDRESS .SERVICE .HOST .ADDR>
+	  <COND 
+	   (<==? .KIND ,SOCK-STREAM>
+	    <COND (<AND <SET ERR <CALL SYSCALL BIND .S .ADDR ,ADDR-LEN>>
+			<SET ERR <CALL SYSCALL LISTEN .S 5>>>
+		   <PUTLHW .S .KIND>)
+		  (T
+		   <CALL SYSCALL CLOSE .S>
+		   .ERR)>)
+	   (T
+	    <COND (<SET ERR <CALL SYSCALL BIND .S .ADDR ,ADDR-LEN>>
+		   <PUTLHW .S .KIND>)
+		  (T
+		   <CALL SYSCALL CLOSE .S>
+		   .ERR)>)>)>>
+
+<DEFINE NET-SERVER (SERVICE:FIX ROUTINE:APPLICABLE "OPTIONAL" (H:FIX 0)
+		    "AUX"
+		    S NS
+		    (NADDR <CHTYPE <STACK <IUVECTOR ,ADDR-WORD-LEN>>
+				   NET-ADDRESS>)
+		    (PT <STACK <IUVECTOR 1>>))
+   #DECL ((SERVICE H) FIX)
+   <COND (<SET S <SERVER-INIT .SERVICE .H>>
+	  <COND (<==? <LHW .S> ,SOCK-STREAM>
+		 <REPEAT (CH)
+		    <COND (<SET CH <SERVER-WAIT .S <> .NADDR>>
+			   <APPLY .ROUTINE .CH>)
+			  (T
+			   <CALL SYSCALL CLOSE .S>
+			   <RETURN .CH>)>>)
+		(T
+		 <COND (<NOT <GASSIGNED? MSG-BUF>>
+			<SETG MSG-BUF <ISTRING 512>>)>
+		 <SET S <RHW .S>>
+		 <REPEAT (LEN)
+		    <COND (<SET LEN <ISYSCALL RECVFROM .S ,MSG-BUF 512
+					      0 .NADDR .PT>>
+			   <APPLY .ROUTINE ,MSG-BUF .LEN .NADDR .PT>)
+			  (T
+			   <CALL SYSCALL CLOSE .S>
+			   <RETURN .LEN>)>>)>)>>
+
+<GDECL (MSG-BUF) STRING>
+
+<DEFINE NET-GET-ADDRESS (CHANNEL:<CHANNEL 'NETWORK> OPER 
+			 "OPT" (ADDR:<OR NET-ADDRESS FALSE> <>) "AUX"
+			 (DATA:CONNECTION <CHANNEL-DATA .CHANNEL>))
+   <GET-ADDRESS <C-SOCKET .DATA> .ADDR>>
+
+<DEFINE GET-ADDRESS (SOCK:FIX "OPT" (ADDR:<OR NET-ADDRESS FALSE> <>)
+		     "AUX" (TBUF <STACK <UVECTOR ,ADDR-LEN>>))
+   <COND (<NOT .ADDR> <SET ADDR <CHTYPE <IUVECTOR ,ADDR-WORD-LEN 0>
+					NET-ADDRESS>>)>
+   <CALL SYSCALL GETSOCKNAME .SOCK .ADDR .TBUF>
+   .ADDR>
+
+<DEFINE NET-MAKE-ALT (C:<CHANNEL 'NETWORK> OPER 
+                      "OPT" (TYPE:FIX ,SOCK-STREAM) (PORT 0)
+                      "AUX" S RES NC (DATA:CONNECTION <CHANNEL-DATA .C>)
+                      (ADDR <CHTYPE <STACK <IUVECTOR ,ADDR-WORD-LEN 0>>
+                                    NET-ADDRESS>))
+   <COND (<C-ALTCHANNEL .DATA>)
+	 (<SET S <CALL SYSCALL SOCKET ,AF-INET
+		       .TYPE
+		       <COND (<==? .TYPE ,SOCK-STREAM> ,PROT-TCP)
+			     (T ,PROT-UDP)>>>
+	  <CHANNEL-OP .C GET-ADDRESS .ADDR>
+	  <IN-ADDR-PORT .ADDR .PORT>
+	  <COND (<SET RES <CALL SYSCALL BIND .S .ADDR ,ADDR-LEN>>
+		 <COND (<SET RES <CALL SYSCALL LISTEN .S 1>>
+			<C-ALTCHANNEL .DATA .S>
+			.C)
+		       (T
+			<CALL SYSCALL CLOSE .S>
+			.RES)>)
+		(T
+		 <CALL SYSCALL CLOSE .S>
+		 .RES)>)>>
+
+<DEFINE NET-GET-DADDR (C:<CHANNEL 'NETWORK> OPER 
+		       "OPT" (ADDR:<OR NET-ADDRESS FALSE> <>)
+		       "AUX" (DATA:CONNECTION <CHANNEL-DATA .C>) NC)
+   <COND (<SET NC <C-ALTCHANNEL .DATA>>
+	  <COND (<TYPE? .NC FIX>
+		 <GET-ADDRESS .NC .ADDR>)
+		(T
+		 <CHANNEL-OP .NC GET-ADDRESS .ADDR>)>)>>
+
+<DEFINE NET-ACCEPT-CONN (C:<CHANNEL 'NETWORK> OPER "OPT" (SERVICE:FIX 0)
+			 "AUX" (DATA:CONNECTION <CHANNEL-DATA .C>) NC
+			 (NADDR:NET-ADDRESS
+			  <CHTYPE <STACK <IUVECTOR ,ADDR-WORD-LEN 0>>
+				  NET-ADDRESS>) (BUF <STACK <IUVECTOR 1>>)
+			 (PT:UVECTOR <STACK <IUVECTOR 1>>) RES:<OR FIX FALSE>
+			 NS:<OR FIX FALSE> CH)
+   <COND (<TYPE? <SET NC <C-ALTCHANNEL .DATA>> FIX>
+	  <COND (<OR <NOT <C-TIMEOUT .DATA>>
+		     <AND <SET RES <ISYSCALL SELECT <+ .NC 1>
+					     <1 .BUF <LSH 1 .NC>> 0 0
+					     <C-TIMEOUT .DATA>>>
+			  <NOT <0? .RES>>>>
+		 <COND (<SET NS <ISYSCALL ACCEPT .NC .NADDR .PT>>
+			<SET CH <CHANNEL-OPEN NETWORK "DATA" .SERVICE .NADDR .NS>>
+			<C-ALTCHANNEL .DATA .CH>)>
+		 <CALL SYSCALL CLOSE .NC>
+		 <COND (.NS .CH)>)
+		(<0? .RES> ,TIMED-OUT)
+		(.RES)>)
+	 (.NC #FALSE ("ALREADY CONNECTED"))
+	 (T #FALSE ("NOT LISTENING"))>>
+
+<ENDPACKAGE>