## pre-socket.pkg
# Compiled by:
# src/lib/std/src/standard-core.sublib# These are some common type definitions used in the sockets library.
stipulate
package host_unt = host_unt_guts; # host_unt_guts is from src/lib/std/src/bind-sysword-32.pkg package one_byte_unt = one_byte_unt_guts; # one_byte_unt_guts is from src/lib/std/src/one-byte-unt-guts.pkg package unt = unt_guts; # unt_guts is from src/lib/std/src/bind-unt-guts.pkg package ci = mythryl_callable_c_library_interface; # mythryl_callable_c_library_interface is from src/lib/std/src/unsafe/mythryl-callable-c-library-interface.pkgherein
package pre_socket {
# The raw representation address data:
#
Internet_Address
=
vector_of_one_byte_unts::Vector;
# The raw representation of an address family:
#
Raw_Address_Family = ci::System_Constant;
# The raw representation of a socket:
# a file descriptor for now and a mutable flag indicating
# (with a value of TRUE) if the socket is currently set
# to non-blocking:
#
Socket_Fd = Int;
#
Socket_Record
=
{ file_descriptor: Socket_Fd,
nonblocking: Ref( Bool )
};
# Sockets are typeagnostic. The instantiation of the type variables
# provides a way to distinguish between different kinds of sockets.
#
Socket (A_sock, A_af)
=
SOCKET Socket_Record;
Socket_Address A_af
=
ADDRESS Internet_Address;
# Witness types for the socket parameter:
#
Datagram = DATAGRAM;
Stream(X) = STREAM;
Passive = PASSIVE;
Active = ACTIVE;
package af {
Address_Family = ADDRESS_FAMILY Raw_Address_Family;
};
package socket {
# Socket types:
Socket_Type = SOCKET_TYPE ci::System_Constant;
};
Shutdown_Mode
#
= NO_RECVS
| NO_SENDS
| NO_RECVS_OR_SENDS
;
Socket_Descriptor = winix_types::io::Io_Descriptor;
# Socket I/O option types:
#
Out_Flags = { oob: Bool, don't_route: Bool };
In_Flags = { oob: Bool, peek: Bool };
# Utility functions for parsing/unparsing network addresses:
#
stipulate
package sys_w = host_unt; # host_unt is from src/lib/std/types-only/bind-largest32.pkg package scvt = number_string; # number_string is from src/lib/std/src/number-string.pkg fun to_w (getc, stream)
=
{ fun scan radix stream
=
case (sys_w::scan radix getc stream)
#
THE (w, stream) => THE (w, stream);
NULL => NULL;
esac;
case (getc stream)
#
NULL => NULL;
#
THE ('0', stream')
=>
(case (getc stream')
NULL => THE (0u0, stream');
THE(('x' | 'X'), stream'')
=>
scan scvt::HEX stream'';
_ => scan scvt::OCTAL stream;
esac
);
_ => scan scvt::DECIMAL stream;
esac;
};
# Check that the word is representable
# in the given number of bits;
# raise OVERFLOW if not.
#
fun check (w, bits)
=
if (sys_w::(>=) (sys_w::(>>) (0uxffffffff, unt::(-) (0u32, bits)), w))
w;
else raise exception exceptions_guts::OVERFLOW; # exceptions_guts is from src/lib/std/src/exceptions-guts.pkg fi;
# Scan a sequence of numbers separated by '.'
#
fun scan getc stream
=
(case (to_w (getc, stream))
NULL => NULL;
THE (w, stream') => scan_rest getc ([w], stream');
esac
)
also
fun scan_rest getc (l, stream)
=
case (getc stream)
THE ('.', stream')
=>
(case (to_w (getc, stream'))
NULL => THE (list::reverse l, stream);
THE (w, stream'') => scan_rest getc (w ! l, stream'');
esac
);
_ => THE (list::reverse l, stream);
esac;
herein
fun to_unts getc stream
=
case (scan getc stream)
#
THE ([a, b, c, d], stream)
=>
THE ([check (a, 0u8), check (b, 0u8), check (c, 0u8), check (d, 0u8)], stream);
THE ([a, b, c], stream)
=>
THE ([check (a, 0u8), check (b, 0u8), check (c, 0u16)], stream);
THE ([a, b], stream)
=>
THE ([check (a, 0u8), check (b, 0u24)], stream);
THE ([a], stream)
=>
THE ([check (a, 0u32)], stream);
_ => NULL;
esac;
fun from_bytes (a, b, c, d)
=
{ format = one_byte_unt::format number_string::DECIMAL;
cat [ format a, ".",
format b, ".",
format c, ".",
format d
];
};
end; # stipulate
fun to_string (SOCKET { file_descriptor, nonblocking })
# # NB: sfprintf package is not defined at this level of the library.
= "SOCKET { file_descriptor => "
+ (num_format::format_int number_string::DECIMAL (one_word_int_guts::from_int file_descriptor))
+ ", nonblocking => "
+ (*nonblocking ?? "TRUE" :: "FALSE")
+ " }"
;
}; # pre_socket
end; # stipulate
## COPYRIGHT (c) 1995 AT&T Bell Laboratories.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2012,
## released under Gnu Public Licence version 3.