OpenVMS Source-Code Demos
TCPIP$TCP_CLIENT_QIO_BASIC
1000 %title "TCPIP$TCP_CLIENT_QIO_BASIC" !
%ident "version_101.2" ! <---+--- must match
declare string constant k_version = "101.2" , ! <---+ &
k_program = "TCPIP$TCP_CLIENT_QIO_BASIC" !
!========================================================================================================================
! Title : TCPIP$TCP_CLIENT_QIO_BASIC.BAS
! Author : Neil Rieck
! Notes : 1. this program is derived from "TCPIP$EXAMPLES:TCPIP$TCP_CLIENT_QIO.C"
! which is a TCP/IP (UCX) example program for DEC-C and VAX-C
! copyrighted in 1989 and 1998 by "Digital Equipment Corporation" and
! subsequently by "Compaq Computer Corporation".
! More 'C' programs were added to directory TCPIP$EXAMPLES in 2003 and 2008.
! History:
! ver who when what
! --- --- ------ --------------------------------------------------------------------------------------------------------
! 100 NSR 001025 1. started conversion from DECC source (in my spare time)
! NSR 001027 2. finished conversion and testing (good enough for a demo)
! 101 NSR 121230 1. fixed a few obvious bugs
! 2. brought a little more up-to-date
!========================================================================================================================
option type=explicit ! cuz tricks are for kids
!
on error goto trap ! old-school trapping
!
! <<< external declarations >>>
!
%include "starlet" %from %library "sys$library:basic$starlet" ! system services
%include "$ssdef" %from %library "sys$library:basic$starlet" ! ss$
%include "$iodef" %from %library "sys$library:basic$starlet" ! io$
%include "lib$routines" %from %library "sys$library:basic$starlet" ! lib$
%include "sys$library:tcpip$inetdef.bas" ! tcp/ip network definitions for BASIC
!
! <<< home brewed functions >>>
!
external word function htons(word by ref) !
external byte function long_to_byte( long by ref ) !
!
! note: for the peek trick to work, we must...
!
! 1. declare LONG BY VALUE passing mechanisms here (we are passing 32-bit addresses)
! 2. declare BY REF passing mechanisms in the receiving functions
!
external long function my_peek_L( long by value ) !
external long function my_peek_W( long by value ) !
external long function my_peek_B( long by value ) !
!
! my I/O Status Block
!
record IosbRec !
variant
case
group one
word rc
word xfer_count
long long_0
end group one
case
group two
basic$quadword quad_0
end group two
end variant
end record IosbRec
!
! my Item Record Block
!
record ItemRec !
variant
case
group one
word BuffLen
word ItemCode
long BuffAddr
long RtnLenAdr
end group one
case
group two
long ListTerm
long junk1
long junk2
end group two
end variant
end record ItemRec
!
! <<< variable declarations >>>
!
declare long rc_status , ! &
word channel_0 , ! INET channel &
word sck_parm(2) , ! Socket creation parameter &
IosbRec myIosb !
!
map(buf)string buf = 512
declare long buflen
buflen = 512
declare word port%
declare long dummy_ptr% ! in DECC was unsigned char *dummy
declare long r_retlen
declare sockaddrin remote_host ! was sockaddr_in in 'C'
!
record IL2 ! input list 2 descriptor
long il2_length
long il2_address
end record IL2
declare IL2 rhst_adrs ! remote host address
!
!===============================================================
! main
!===============================================================
1500 main: !
print k_program +"_"+ k_version !
print string$(len(k_program +"_"+ k_version), asc("=")) ! how will this optimize on Alpha?
!
declare string inet_dev ! dynamic string descriptor (good)
inet_dev = "TCPIP$DEVICE:" !
buf = "Hi there" ! we will send this text
!
declare ItemRec Item_List(1) ! 0->1
item_list(0)::BuffLen = 4% ! 4 bytes (the size of next param)
item_list(0)::ItemCode = TCPIP$C_REUSEADDR !
item_list(0)::BuffAddr = 0% ! none
item_list(0)::RtnLenAdr = 0% ! no address given (so call will not store return length)
item_list(1)::ListTerm = 0% ! no more items...
!
declare ItemRec sock_opts(1) !
sock_opts(0)::BuffLen = 4% ! 4 bytes
sock_opts(0)::ItemCode = TCPIP$C_SOCKOPT !
sock_opts(0)::BuffAddr = loc( item_list(0) ) !
sock_opts(0)::RtnLenAdr = 0% ! no address given (so call will not store return length)
sock_opts(1)::ListTerm = 0% ! no more items...
rhst_adrs::il2_length = SIN$S_SOCKADDRIN ! size of local host sockaddrin
rhst_adrs::il2_address = loc( remote_host ) ! address of local host sockaddrin
sck_parm(0) = TCPIP$C_TCP ! TCP/IP protocol
sck_parm(1) = INET_PROTYP$C_STREAM ! stream type of socket
remote_host::sin$w_family = TCPIP$C_AF_INET ! INET family (in 'c' was: sin_family )
!
! Note: both VAX + Alpha are little-endian architectures but network order requires that we send MSB first so
! we load structures as if we were big-endian
!
map(switch) long long0 !
map(switch) byte byte0 ,! LSB (little-endian) &
byte1 ,! &
byte2 ,! &
byte3 ! MSB (little-endian)
!
2000 %let %loopback=1% ! 1=use loopback, 0=use other address
%if %loopback=1% !
%then
byte0= 127% ! 127.0.0.1
byte1= 0% !
byte2= 0% !
byte3= 1% !
%else
byte0= long_to_byte( 142% ) ! 142.180.39.57
byte1= long_to_byte( 180% ) !
byte2= long_to_byte( 39% ) !
byte3= long_to_byte( 57% ) !
%end %if
!
3000 print "-i-address: "+ str$(byte0)+"."+str$(byte1)+"."+str$(byte2)+"."+str$(byte3)
remote_host::sin$l_addr = long0 ! address (in 'c' was: sin_addr.s_addr )
port% = 5321% ! hard code the port for now
remote_host::sin$w_port = htons(port%) ! (in 'c' was: sin_port )
print "-i-port: "+ str$(port%) !
!
! Assign a channel to the TCPIP device
!
rc_status = sys$assign(inet_dev, channel_0,,,) ! assign a channel
if ((rc_status and 1%) <> 1%) then !
print "-e-Failed to assign channel to TCPIP device." !
call lib$stop(rc_status) ! death is rather abrupt :-)
end if !
!
rc_status = sys$qiow( 3%, ! Event flag &
channel_0, ! Channel number &
IO$_SETMODE, ! I/O function &
myIosb::quad_0, ! I/O status block &
, , ! &
sck_parm(0%), , ! P1 Socket creation parameter &
, , ! &
, ) ! P5 Socket option descriptor
if ((rc_status and 1%) = 1%) then
rc_status = myIosb::rc
end if
if ((rc_status and 1%) <> 1%) then
print "-e-Failed to create the device socket"
call lib$stop(rc_status)
end if
!
! Bind to chosen port number (after REUSEADDR is set above)
!
rc_status = sys$qiow( 3%, ! Event flag &
channel_0, ! Channel number &
IO$_ACCESS, ! I/O function &
myIosb::quad_0, ! I/O rc_status block &
, , ! &
, , ! &
loc(rhst_adrs::il2_length), ! P3 local socket name &
, ! &
, ) !
if ((rc_status and 1%) = 1%) then
rc_status = myIosb::rc
end if
if ((rc_status and 1%) <> 1%) then
print "-e-Failed to connect to remote host"
call lib$stop(rc_status)
end if
!
! Write I/O buffer
!
print "-i-calling qiow (sending text)" !
rc_status = sys$qiow( 3%, ! Event flag &
channel_0, ! Channel number &
IO$_WRITEVBLK, ! I/O function &
myIosb::quad_0, ! I/O rc_status block &
, , ! &
buf, ! P1 buffer &
!~~~ buflen, x P2 buffer length &
len( edit$(buf,128) ), ! P2 buffer length (drop trailing white space) &
, , , ) !
if ((rc_status and 1%) = 1%) then !
rc_status = myIosb::rc
end if
if ((rc_status and 1%) <> 1%) then
print "-e-Failed to write to socket"
end if
!
! Shut down the socket (optional)
!
rc_status = sys$qiow( 3%, ! &
channel_0, ! &
(IO$_DEACCESS or IO$M_SHUTDOWN), ! &
myIosb::quad_0, ! &
, , ! &
, , , ! &
TCPIP$C_DSC_ALL, ! P4 Discard all packets &
, ) !
if ((rc_status and 1%) = 1%) then !
rc_status = myIosb::rc
end if
if ((rc_status and 1%) <> 1%) then
print "-e-Failed to shut down the socket"
end if
!
! Close the sockets
!
10000 rc_status = sys$qiow( 3%, ! &
channel_0, ! &
IO$_DEACCESS, ! &
myIosb::quad_0, ! &
, , ! &
, , , , , ) !
if ((rc_status and 1%) = 1%) then
rc_status = myIosb::rc
end if
if ((rc_status and 1%) <> 1%) then
print "-e-Failed to close the socket."
end if
!
! Deassign the TCPIP device channels
!
rc_status = sys$dassgn(channel_0)
if ((rc_status and 1%) <> 1%) then
print "-e-Failed to deassign the channel"
end if
!
goto fini
!----------------------------------------------------------------------------------------------------
! <<< error trap >>>
!----------------------------------------------------------------------------------------------------
31000 trap:
print
print "=== Common Error Trap ===" !
print "error num : "+ str$(err) +" on line "+ str$(erl) !
print "error text: "+ ert$(err) !
rc_status = 2 ! vms-e-
resume fini2 ! fix stack
!----------------------------------------------------------------------------------------------------
! <<< adios >>>
!----------------------------------------------------------------------------------------------------
fini: !
rc_status = 1 ! vms-s-
!
! rc_status must be set up before this point
!
fini2:
print "-i-program exiting with status: "+str$(rc_status) !
32000 end program rc_status !
!
!#######################################################################
!
!----------------------------------------------------------------------------------------------------
! this BASIC function replaces the C-MACRO 'hton' (which is nothing more than a byte swap)
!
! Notes:
! 1. 'hton' means host-to-network byte order ('s' means 'short' or 'word')
! 2. both VAX + Alpha are little-endian architectures but network order requires that we send
! ports (and IP addresses) MSB first
!----------------------------------------------------------------------------------------------------
32010 function word htons(word incoming_data by ref) !
option type=explicit
!
map(my_map)word bits_F0 ! Bits F->0
map(my_map)byte bits_70 ,! Bits 7->0 &
bits_F8 ! Bits F->8
declare byte temp%
!
bits_F0 = incoming_data
temp% = bits_70
bits_70 = bits_F8
bits_F8 = temp%
htons = bits_F0 ! prepare to exit the function
!
end function
!----------------------------------------------------------------------------------------------------
! peek LONG
!----------------------------------------------------------------------------------------------------
32020 function long my_peek_L(long incoming by ref)
option type=explicit
my_peek_L = incoming
end function
!----------------------------------------------------------------------------------------------------
! peek WORD
!----------------------------------------------------------------------------------------------------
32030 function long my_peek_W(word incoming by ref)
option type=explicit
declare long temp%
temp% = incoming
temp% = abs( temp%) if temp% < 0%
my_peek_W = temp%
end function
!----------------------------------------------------------------------------------------------------
! peek BYTE
!----------------------------------------------------------------------------------------------------
32040 function long my_peek_B(byte incoming by ref)
option type=explicit
declare long temp%
temp% = incoming
temp% = abs( temp%) if temp% < 0%
my_peek_B = temp%
end function
!
!----------------------------------------------------------------------------------------------------
! long_to_byte
!
! Notes:
! 1. when jamming bytes (as is the case with the octets in an I/P address) we may wish to poke an
! unsigned byte like 192 but all bytes in BASIC are signed so this little function will do the
! conversion for us with very little fuss.
! 2. remember that we are little-endian
!----------------------------------------------------------------------------------------------------
32050 function byte long_to_byte(long incoming by ref)
option type=explicit
!
map(my_map)long long0
map(my_map)byte byte0, ! LSB &
byte1, ! &
byte2, ! &
byte3 ! MSB
!
long0 = incoming
long_to_byte = byte0
end function
!