OpenVMS Notes: Hacking Starlet Libraries
- The information presented here is intended for educational use by qualified OpenVMS technologists.
- The information presented here is provided free of charge, as-is, with no warranty of any kind.
Overview
OpenVMS documentation is some of the best I've seen but nothing is 100% accurate which is why you need other options. If you write programs requiring OpenVMS system calls, then doing a simple hack of the Starlet library is one such option. The whole purpose of the next example is to produce a searchable text file of the BASIC definition for the Starlet system library (known as BASIC$STARLET.TLB) in order to "double check" passing mechanisms, variable types and variable sizes described in official OpenVMS documentation.
BTW, the following procedure requires ~ 7900 blocks for OpenVMS-8.3 so be careful.
Dumping a Library to a Text File
Legend: <ur> = user response
<sr> = system response
------------------------------
<sr> $ ! this is the default prompt
<ur> set def sys$library
<sr> $
<ur> dir *.tlb ! see all TLB files
<sr> Directory SYS$COMMON:[SYSLIB]
BASIC$STARLET.TLB;1 DECC$RTLDEF.TLB;1 EPC$FACILITY.TLB;1 ERFLIB.TLB;1
LIB_ADA_SUBSET.TLB;1 NTA.TLB;1 STARLETSD.TLB;1
STARLET_RECENT_ADA_SUBSET.TLB;1 SYS$LIB_C.TLB;1 SYS$STARLET_C.TLB;1
TCPIP$TEMPLATES.TLB;1
Total of 11 files.
$
<ur> lib/list BASIC$STARLET.TLB/text ! see library chapters
<sr>
Directory of TEXT library SYS$COMMON:[SYSLIB]BASIC$STARLET.TLB;1 on 25-MAR-2012 09:18:11 Creation date: 12-AUG-2010 17:23:28 Creator: Librarian A09-30 Revision date: 12-AUG-2010 17:23:30 Library format: 3.0 Number of modules: 318 Max. key length: 39 Other entries: 0 Preallocated index blocks: 31 Recoverable deleted blocks: 0 Total index blocks used: 15 Max. Number history records: 20 Library history records: 0 Library is in DCX data reduced format $ACCDEF $ACCESSDEF $ACEDEF $ACLDEF $ACMEDEF $ACMEMSGDEF $ACMEVMSDEF $ACRDEF $AFRDEF $AGNDEF $ALPHADEF $ARGDEF $ARMDEF $ATRDEF $BASDEF $BRKDEF $CAPDEF $CBODEF $CHFDEF $CHKPNTDEF $CHPDEF $CLIDEF $CLIMSGDEF $CLISERVDEF $CLIVERBDEF $CLSDEF $CLUEVTDEF $CMBDEF $COBDEF $CONVDEF $CONVMSGDEF $CPUIDEF $CQUALDEF $CRDEF $CREDEF $CRFDEF $CRFMSG $CSTDEF $CVTDEF $CVTFNMDEF $CVTMSG $DCDEF $DDTMDEF $DDTMMSGDEF $DELPRCSYMDEF $DEVDEF $DIBDEF $DIRENTDEF $DMTDEF $DPSDEF $DSCDEF $DSTDEF $DTIDEF $DTKDEF $DTKMSG $DVIDEF $DVSDEF $EEOMDEF $EFNDEF $EGPSDEF $EGSDEF $EGSTDEF $EGSYDEF $EIDCDEF $EMHDEF $ENVDEF $EOBJRECDEF $EOMDEF $EOMWDEF $EPMDEF $EPMMDEF $EPMVDEF $EPMWDEF $ERADEF $ESDFDEF $ESDFMDEF $ESDFVDEF $ESGPSDEF $ESRFDEF $ETIRDEF $EVAX_INSTRDEF $EVENTDEF $FABDEF $FALDEF $FDLDEF $FDLMSGDEF $FIBDEF $FIDDEF $FLTDEF $FMLDEF $FORDEF $FSCNDEF $GEN64DEF $GETSPIDEF $GLOCKDEF $GPSDEF $GSDEF $GSYDEF $HLPDEF $HWDEF $IACDEF $ICCDEF $IDCDEF $IEEEDEF $ILEDEF $INDICTDEF $INITDEF $IODEF $IOSADEF $IOSBDEF $ISSDEF $JBCMSGDEF $JPIDEF $JPIFDEF $KGBDEF $LADEF $LATDEF $LATMSGDEF $LBRCTLTBL $LBRDEF $LCKDEF $LDDEF $LEPMDEF $LGIDEF $LHIDEF $LIBCLIDEF $LIBDCFDEF $LIBDEF $LIBDTDEF $LIBFILDEF $LIBFISDEF $LIBVMDEF $LIBWAITDEF $LICENSEDEF $LKIDEF $LKSBDEF $LMFDEF $LNKDEF $LNMDEF $LOGTYPDEF $LPDEF $LPRODEF $LSDFDEF $LSRFDEF $LSYDEF $MACIDDEF $MAILDEF $MAILMSGDEF $MAPPINGDEF $MHDDEF $MHDEF $MMEMSGDEF $MMIDEF $MNTDEF $MOUNDEF $MSGDEF $MSGHLPDEF $MT2DEF $MT3DEF $MTADEF $MTDEF $MTHDEF $NAMDEF $NCSDEF $NETDEF $NSADEF $NSAMSGDEF $NSARECDEF $OBJRECDEF $OPCDEF $OPCMSG $OPRDEF $OSSDEF $OTSDEF $PCCDEF $PDSCDEF $PMMDEF $POSIX_SERVICEDEF $POWERDEF $PPLDEF $PPROPDEF $PQLDEF $PRCDEF $PRDEF $PRODEF $PROMDEF $PROVDEF $PROWDEF $PRTDEF $PRVDEF $PRXDEF $PSCANDEF $PSIGDEF $PSLDEF $PSMMSGDEF $PTDDEF $QSRVDEF $QUIDEF $RABDEF $RBLDDEF $REGDEF $REGMSG $RMEDEF $RMIDEF $RMSDEF $RNHBLKDEF $RSDMDEF $S2DGBDEF $SBKDEF $SCRDEF $SDBDEF $SDDEF $SDFDEF $SDFMDEF $SDFVDEF $SDFWDEF $SDVDEF $SECDEF $SECIDDEF $SECSRVDEF $SECSRVMSGDEF $SGPSDEF $SHRDEF $SJCDEF $SMBMSGDEF $SMGDEF $SMGMSG $SMGTRMPTR $SMRDEF $SORDEF $SRFDEF $SRMDEF $SSDEF $SSIODEF $STENVDEF $STRDEF $STSDEF $SYIDEF $SYSEVTDEF $TBKDEF $TEBDEF $TIRDEF $TPADEF $TPUDEF $TRMDEF $TT2DEF $TT3DEF $TTCDEF $TTDEF $TTYDPORTDEF $UAF070DEF $UAIDEF $UICDEF $UIDDEF $USGDEF $USRIDEF $UTCBLKDEF $VADEF $VAXDEF $VA_RANGEDEF $WBEMIDEF $WWIDDEF $XABALLDEF $XABCXFDEF $XABCXRDEF $XABDATDEF $XABDEF $XABFHCDEF $XABITMDEF $XABJNLDEF $XABKEYDEF $XABPRODEF $XABRDTDEF $XABRUDEF $XABSUMDEF $XABTRMDEF $XADEF $XKDEVDEF $XKSTSDEF $XMDEF $XWDEF ACLEDIT$ROUTINES CIADEF CLI$ROUTINES CMA$DEF CONV$ROUTINES CSHDEF CVT$ROUTINES DCX$ROUTINES DTK$ROUTINES EDT$ROUTINES ELFDATYP ELFDEF ESFDEF EVX_OPCODES FDL$ROUTINES LBR$ROUTINES LIB$ROUTINES LIBICB MAIL$ROUTINES MMEDEF MTH$ROUTINES NCS$ROUTINES OTS$ROUTINES PAGEDEF PPL$DEF PPL$ROUTINES PSM$ROUTINES SMB$ROUTINES SMG$ROUTINES SNAPEVTDEF SOR$ROUTINES STARLET STR$ROUTINES TBK$ROUTINES TPU$ROUTINES UTIL$ROUTINES VERSION_INFO $
<ur> lib BASIC$STARLET.TLB/text/extract=* ! dump all chapters to file BASIC$STARLET.TXT
<sr> $
<ur> lib BASIC$STARLET.TLB/text/extract=$IOSBDEF/out=BASIC$STARLET_$IOSBDEF.TXT
<sr> $
<ur> lib BASIC$STARLET.TLB/text/extract=$ILEDEF /out=BASIC$STARLET_$ILEDEF.TXT
<sr> $
<ur> lib BASIC$STARLET.TLB/text/extract=starlet /out=BASIC$STARLET_startlet.txt
<sr> $
<ur> dir basic$starlet*.txt/siz/width=file=30
<sr> Directory SYS$COMMON:[SYSLIB]
BASIC$STARLET.TXT;12 8017
BASIC$STARLET_$ILEDEF.TXT;1 9
BASIC$STARLET_$IOSBDEF.TXT;2 8
BASIC$STARLET_STARTLET.TXT;1 658
Total of 4 files, 8692 blocks.
$
<ur> edit/read BASIC$STARLET.TXT ! comment: use "edit/tpu/read" to invoke EVE
Now that you've created a text file representation of the whole library called "BASIC$STARLET.TXT", use your favorite editor to open it, then search for the string "sys$qio" and you'll see the following:
$QIO
Queue I/O Request
$QIO [efn] ,chan ,func ,[iosb] ,[astadr] ,[astprm]
($QIOW) ,[p1] ,[p2] ,[p3] ,[p4] ,[p5] ,[p6]
efn = number of event flag to set on completion
chan = number of channel on which I/O is directed
func = function code specifying action to be performed
iosb = address of quadword I/O status block to receive final
completion status
astadr = address of entry mask of AST routine
astprm = value to be passed to AST routine as argument
p1..p6 = optional device- and function-specific parameters
EXTERNAL LONG FUNCTION SYS$QIO &
( LONG BY VALUE , &
WORD BY VALUE , &
WORD BY VALUE , &
BASIC$QUADWORD BY REF, &
LONG BY REF , &
LONG BY VALUE , &
ANY BY REF , &
LONG BY VALUE , &
LONG BY VALUE , &
LONG BY VALUE , &
LONG BY VALUE , &
LONG BY VALUE &
)
Note: this information is only required when chasing strange compile-time bugs. Normally, the OpenVMS CD-ROM documentation is all you need to create and support a program employing system calls.
A Few OpenVMS Documentation Anomalies I've Discovered:
System Call Starlet
DefinitionOpenVMS 7.2-1
CD-ROM (1999)OpenVMS 7.3-1
CD-ROM (2002)lib$bbcci long by ref,
long by value
always correctlong by ref,
address by ref
incorrectlong by ref,
address by value
correctlib$bbssi long by ref,
long by value
always correctlong by ref,
address by ref
incorrectlong by ref,
address by value
correct
Example References
To properly reference BASIC$STARLET text library declarations from within OpenVMS-BASIC (DEC-BASIC, Compaq-BASIC, HP-BASIC) you'll need to employ something similar to this code fragment:
!
! <<< system declarations >>>
!
%include "starlet" %from %library "sys$library:basic$starlet" ! system services (e.g. sys$qio)
%include "$ssdef" %from %library "sys$library:basic$starlet" ! ss$
%include "lib$routines" %from %library "sys$library:basic$starlet" ! lib$
%include "$uaidef" %from %library "sys$library:basic$starlet" ! uai$
!
Note: Make sure to include every module required by your program.
For more information just click here to check out some of my fully-functional free demo programs.
Example Program
1000 %title "timer_demo_xxx" !
%ident "version_101.1" !
option type = explicit ! no kid stuff...
declare string constant k_program = "timer_demo" , &
k_version = "101.1" !
!=======================================================================
! title : timer_demo_xxx.bas
! author : Neil Rieck
! created: 2004.01.01
!=======================================================================
set no prompt !
!
! system declarations
!
%include "starlet" %from %library "sys$library:basic$starlet" ! system services
%include "$ssdef" %from %library "sys$library:basic$starlet" ! ss$
%include "lib$routines" %from %library "sys$library:basic$starlet" ! lib$
!
! home brewed functions
!
external long function get_timer_bit_vector(long) ! required for used with SYS$WFLOR
!
declare long rc% ,! return code &
timer_event_flag% ,! timer event flag &
timer_ef_state% ,! timer event flag state &
tcp_event_flag% ,! tcp event flag &
tcp_ef_state% ,! tcp event flag state &
mask% ,! required for sys$wflor &
junk% ,! &
basic$QuadWord DeltaQuad ! for sys$bintim etc.
!
!=======================================================================
! main
!=======================================================================
main:
margin #0, 132 ! width for the log file
print k_program +"_"+ k_version !
print string$(len(k_program +"_"+ k_version), asc("=")) ! underline previous line (how will this optimize?)
!
! <<< get some event flags for later >>>
!
if tcp_event_flag% = 0 then ! if not yet allocated
rc% = lib$get_EF( tcp_event_flag% ) ! get an event flag
if ((rc% and 7%) <> 1) then !
print "lib$get_EF-1 rc: ";str$(rc%) !
goto rc_exit !
end if !
end if !
!
if timer_event_flag% = 0 then ! if not yet allocated
rc% = lib$get_EF( timer_event_flag% ) ! get another event flag
if ((rc% and 7%) <> 1) then !
print "lib$get_EF-2 rc: ";str$(rc%) !
goto rc_exit !
end if !
end if !
!
! <<< arm a timer to expire 'x' time from now >>>
!
print "-i- arming timer-1 (timer) for 10 seconds from now" !
declare string constant k_delay010 = "0 00:00:10" ! set delay time 10 seconds from now
rc% = sys$bintim(k_delay010, DeltaQuad ) ! init delta time ('x' time from now)
print "-e- sys$bintim rc: "+ str$(rc%) if ((rc% and 1%) <> 1%) !
rc% = sys$setimr(timer_event_flag%,DeltaQuad by ref,,,) ! now use it to schedule a wake up
print "-e- sys$setimr rc: "+ str$(rc%) if ((rc% and 1%) <> 1%) !
!
! <<< use a second timer to simulate some sort of TCP timeout >
!
print "-i- arming timer-2 (fake tcp) for 20 seconds from now" !
declare string constant k_delay020 = "0 00:00:20" ! set delay time 20 seconds from now
rc% = sys$bintim(k_delay020, DeltaQuad ) ! init delta time ('x' time from now)
print "-e- sys$bintim rc: "+ str$(rc%) if ((rc% and 1%) <> 1%) !
rc% = sys$setimr(tcp_event_flag%,DeltaQuad by ref,,,) ! now use it to schedule a wake up
print "-e- sys$setimr rc: "+ str$(rc%) if ((rc% and 1%) <> 1%) !
!
! note: for the SYS$WFLOR call to work, both event flags must be in the same event flag cluster.
! The first parameter is only used to determine which event flag cluster to test.
! The second parameter (mask) contains bits representing event flags within that cluster
!
mask% = get_timer_bit_vector( tcp_event_flag%) ! insert vector 1 into mask
mask% = mask% or get_timer_bit_vector(timer_event_flag%) ! insert vector 2 into mask
!
! <<< wait for either the 'TCP event flag' or the 'TIMER event flag' to change state >>>
!
print "-i- waiting for event flag "+ str$(tcp_event_flag%) +" or event flag "+ str$(timer_event_flag%)
!
rc% = sys$wflor( tcp_event_flag%, mask%) ! wait for a response from one of two flags
print "-e- sys$waitfr rc: "+ str$(rc%) if ((rc% and 1%) <> 1%) !
!
! <<< cancel all timer requests (if any) >>>
!
print "-i- Calling $CanTim" !
rc% = sys$cantim(,) ! cancel all timer requests
print "-e- sys$cantim rc: "+ str$(rc%) if ((rc% and 1%) <> 1%) !
!
! which event flag is set? TCP or TIMER?
!
rc% = sys$readEF(tcp_event_flag%, junk%) ! test TCP event flag
select rc% !
case SS$_WASCLR !
tcp_ef_state% = 0 !
case SS$_WASSET !
tcp_ef_state% = 1 !
case else !
print "-e- sys$readef-tcp rc: "+ str$(rc%) !
end select !
print "-i- TCP EF State : ";str$(tcp_ef_state%) !
!
rc% = sys$readEF(timer_event_flag%, junk%) ! test TIMER event flag
select rc% !
case SS$_WASCLR !
timer_ef_state% = 0 !
case SS$_WASSET !
timer_ef_state% = 1 !
case else !
print "-e- sys$readef-timer rc: "+ str$(rc%) !
end select !
print "-i- Timer EF State: ";str$(timer_ef_state%) !
!
! at this point either the TCP-EF or the TIMER-EF could be set
!
if (timer_ef_state% = 1) and ! if the TIMER-EF is set &
( tcp_ef_state% = 0) ! and the TCP-EF is clear
then ! then something timed out
print "-i-the tcp event timed out"
end if
!=======================================================================
! <<< adios... >>>
!=======================================================================
fini:
rc% = 1 ! vms -s-
!
! rc% must be set up b4 this point (and must not be changed)
!
rc_exit:
30000 end program rc% !
!#######################################################################
!
! <<< external functions >>>
!
!======================================================================
! get timer bit vector
! (see OpenVMS system services documentation for "sys$wflor")
!
! notes: cluster event flags
! 0 00- 31
! 1 32- 63
! 2 64- 95
! 3 96-127
!======================================================================
31040 function long get_timer_bit_vector(long event_flag)
option type = explicit
declare long temp
!
select event_flag
case <= 31
temp = event_flag
case <= 63
temp = event_flag - 32
case <= 95
temp = event_flag - 64
case else
temp = event_flag -96
end select
!
select temp ! this code will avoid an integer overflow
case 31 ! need to set bit #31
! 33222222222211111111110000000000
! 10987654321098765432109876543210
get_timer_bit_vector = B"10000000000000000000000000000000"L ! so return this
case else !
get_timer_bit_vector = (2% ^ temp) ! else return this
end select
!
end function ! get_timer_bit_vector
!
!#######################################################################
Back to HomeNeil Rieck
Waterloo, Ontario, Canada.