From 7516a430f876abfbcf5c578fb2affdc704d3daa5 Mon Sep 17 00:00:00 2001 From: mainzelm Date: Mon, 2 Apr 2001 14:57:25 +0000 Subject: [PATCH] Switched back to integers as internet-host-addresses. --- scsh/network.scm | 68 +++++------------------------------------------- scsh/network1.c | 37 +++++++------------------- 2 files changed, 16 insertions(+), 89 deletions(-) diff --git a/scsh/network.scm b/scsh/network.scm index 0bf4809..bd883a7 100644 --- a/scsh/network.scm +++ b/scsh/network.scm @@ -1,6 +1,7 @@ ;;; Networking for the Scheme Shell ;;; Copyright (c) 1994-1995 by Brian D. Carlstrom. ;;; Copyright (c) 1994 by Olin Shivers. +;;; See file COPYING. ;;; Scheme48 implementation. @@ -21,24 +22,6 @@ "#define False_on_zero(x) ((x) ? s48_enter_fixnum(x) : S48_FALSE)" "" ) -(define (byte-vector->integer bv) - (let ((number (byte-vector-ref bv 0))) - (set! number (bitwise-ior number (arithmetic-shift (byte-vector-ref bv 1) - 8))) - (set! number (bitwise-ior number (arithmetic-shift (byte-vector-ref bv 2) - 16))) - (bitwise-ior number (arithmetic-shift (byte-vector-ref bv 3) - 24)))) - -(define (integer->byte-vector number) - (let ((bv (make-byte-vector 4 0))) - (byte-vector-set! bv 0 (bitwise-and number #xff)) - (byte-vector-set! bv 1 (bitwise-and (arithmetic-shift number -8) #xff)) - (byte-vector-set! bv 2 (bitwise-and (arithmetic-shift number -16) #xff)) - (byte-vector-set! bv 3 (bitwise-and (arithmetic-shift number -24) #xff)) - bv)) - - ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ;;; High Level Prototypes ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- @@ -73,9 +56,9 @@ (dynamic-wind (lambda () #f) (lambda () (connect-socket sock addr) (set! connected #t)) - (lambda () #f - ;(if (not connected) - ; (close-socket sock)) + (lambda () + (if (not connected) + (close-socket sock)) )) (if connected sock @@ -129,45 +112,8 @@ ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- ;;; Socket Address Routines ;;;-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=- -(define (internet-host-address-from-number address32) - (integer->byte-vector address32)) - -(define (internet-host-address-from-bytes b4 b3 b2 b1) - (let ((bv (make-byte-vector 4 0))) - (byte-vector-set! bv 0 b1) - (byte-vector-set! bv 1 b2) - (byte-vector-set! bv 2 b3) - (byte-vector-set! bv 3 b4) - bv)) - -(define (internet-host-address-to-bytes address) - (list (byte-vector-ref address 3) - (byte-vector-ref address 2) - (byte-vector-ref address 1) - (byte-vector-ref address 0))) - -;;; This proc and its inverse should be in a general IP module. -(define (internet-host-address->dotted-string bv) - (let* ((byte0 (byte-vector-ref bv 0)) - (byte1 (byte-vector-ref bv 1)) - (byte2 (byte-vector-ref bv 2)) - (byte3 (byte-vector-ref bv 3))) - (string-append (number->string byte3) "." (number->string byte2) "." - (number->string byte1) "." (number->string byte0)))) - -(define (internet-host-address-to-number address) - (byte-vector->integer address)) - -(set! internet-address/any - (internet-host-address-from-number internet-address/any )) -(set! internet-address/loopback - (internet-host-address-from-number internet-address/loopback )) -(set! internet-address/broadcast - (internet-host-address-from-number internet-address/broadcast )) - (define (internet-address->socket-address address32 port16) - (cond ((not (and (byte-vector? address32) - (= (byte-vector-length address32) 4))) + (cond ((not (<= 0 address32 #xffffffff)) (error "internet-address->socket-address: address out of range ~s" address32)) ((not (<= 0 port16 #xffff)) @@ -760,8 +706,8 @@ (error "network-info: string or socket-address expected ~s" arg)))) (define (address->network-info addr) - (if (not (byte-vector? addr)) - (error "address->network-info: byte-vector expected ~s" addr) + (if (not (integer? addr)) + (error "address->network-info: integer expected ~s" addr) (%net-address->network-info addr))) (define-stubless-foreign %net-address->network-info (addr) diff --git a/scsh/network1.c b/scsh/network1.c index 4616f71..7d5aa16 100644 --- a/scsh/network1.c +++ b/scsh/network1.c @@ -27,25 +27,6 @@ #define SET_LONG(x,n,v) GET_LONG((x),(n))=(u_long)(v); -s48_value long2byte_vector (u_long number) -{ - s48_value bv = s48_make_byte_vector (4, 0); - S48_BYTE_VECTOR_SET(bv, 0, number & 0xff); - S48_BYTE_VECTOR_SET(bv, 1, (number >> 8) & 0xff); - S48_BYTE_VECTOR_SET(bv, 2, (number >> 16) & 0xff); - S48_BYTE_VECTOR_SET(bv, 3, (number >> 24) & 0xff); - return bv; -} - -u_long byte_vector2long (s48_value bv) -{ - u_long number = (u_char) S48_BYTE_VECTOR_REF (bv, 0); - number |= (((u_char) S48_BYTE_VECTOR_REF (bv, 1)) << 8); - number |= (((u_char) S48_BYTE_VECTOR_REF (bv, 2)) << 16); - number |= (((u_char) S48_BYTE_VECTOR_REF (bv, 3)) << 24); - return number; -} - /*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-*/ s48_value scheme_bind(s48_value sock, s48_value family, s48_value scheme_name) { @@ -72,7 +53,7 @@ s48_value scheme_bind(s48_value sock, s48_value family, s48_value scheme_name) { struct sockaddr_in name; - u_long addr = htonl(byte_vector2long (S48_CAR (scheme_name))); + u_long addr = htonl(s48_extract_unsigned_integer (S48_CAR (scheme_name))); u_short port = htons(s48_extract_fixnum (S48_CDR (scheme_name))); name.sin_family=AF_INET; @@ -127,7 +108,7 @@ s48_value scheme_connect(s48_value sock, s48_value family, s48_value scheme_name { struct sockaddr_in name; - u_long addr= htonl(byte_vector2long (S48_CAR (scheme_name))); + u_long addr= htonl(s48_extract_unsigned_integer (S48_CAR (scheme_name))); u_short port= htons(s48_extract_fixnum (S48_CDR (scheme_name))); name.sin_family=AF_INET; @@ -198,7 +179,7 @@ s48_value scheme_accept(s48_value sockfd_tagged, s48_value family) } fcntl(newsockfd, F_SETFL, O_NONBLOCK); S48_GC_PROTECT_2 (result, sock_addr); - sock_addr = long2byte_vector (ntohl(name.sin_addr.s_addr)); + sock_addr = s48_enter_unsigned_integer (ntohl(name.sin_addr.s_addr)); result = s48_cons (sock_addr, s48_enter_fixnum (ntohs(name.sin_port))); @@ -218,7 +199,7 @@ s48_value make_addr (long net_s_addr, int net_s_port) s48_value result, sock_addr; S48_DECLARE_GC_PROTECT(2); S48_GC_PROTECT_2 (result, sock_addr); - sock_addr = long2byte_vector (ntohl (net_s_addr)); + sock_addr = s48_enter_unsigned_integer (ntohl (net_s_addr)); result = s48_cons (sock_addr, s48_enter_fixnum (ntohs (net_s_port))); S48_GC_UNPROTECT(); @@ -357,7 +338,7 @@ s48_value send_substring(s48_value scm_sockfd, case AF_INET: { struct sockaddr_in name; - u_long addr = htonl (byte_vector2long (S48_CAR (scheme_name))); + u_long addr = htonl (s48_extract_unsigned_integer (S48_CAR (scheme_name))); u_short port = htons(s48_extract_fixnum (S48_CDR (scheme_name))); name.sin_family=AF_INET; name.sin_addr.s_addr=addr; @@ -541,7 +522,7 @@ s48_value host_ent2host_info (struct hostent * host) while (*ptr) { list = - s48_cons (long2byte_vector (ntohl (*(long *)(host->h_addr_list[i]))), + s48_cons (s48_enter_unsigned_integer (ntohl (*(long *)(host->h_addr_list[i]))), list); ptr++; i++; @@ -558,7 +539,7 @@ s48_value scheme_host_address2host_info(s48_value addr_port) struct in_addr name; struct hostent *host; - u_long addr = htonl(byte_vector2long (S48_CAR (addr_port))); + u_long addr = htonl(s48_extract_unsigned_integer (S48_CAR (addr_port))); name.s_addr = addr; host=gethostbyaddr((char *)&name,sizeof(name),AF_INET); @@ -617,7 +598,7 @@ s48_value netent2net_info(struct netent *net) } S48_RECORD_SET (network_info, 1, list); - S48_RECORD_SET (network_info, 2, long2byte_vector (net->n_net)); + S48_RECORD_SET (network_info, 2, s48_enter_unsigned_integer (net->n_net)); S48_GC_UNPROTECT (); @@ -628,7 +609,7 @@ s48_value scheme_net_address2net_info(s48_value net_addr) { struct netent *net; // expects host byte order : - net=getnetbyaddr(byte_vector2long (net_addr),AF_INET); + net=getnetbyaddr(s48_extract_unsigned_integer (net_addr),AF_INET); return netent2net_info (net); }