OpenVMS Source Code Demos
RMS_TEST_FSP
1000 %title "RMS_TEST_FSP_xxx"
%ident "version 103.1" ! <<<---+---
declare string constant k_version = "version 103.1" , ! <<<---+ &
k_program = "RMS_TEST_FSP" !
!====================================================================================================
! Title : RMS_TEST_FSP_xxx.BAS
! Author : Neil Rieck
! Created: 000809
! Notes : 1. original program from examples in the DEC BASIC for OpenVMS "User's Manual"
! and "Reference Manual"
! 2. additional info from $FABDEF and $RABDEF found in SYS$LIBRARY:BASIC$STARLET.TLB
! ver who when what
! --- --- -------- ----------------------------------------------------------------------------------
! 100 NSR 20000809 1. original program
! 101 NSR 20100529 1. renamed a few variables
! 102 NSR 20100531 1. added code to to test-open GIFs and JPGs (this is just hacking)
! NSR 20110825 2. a few tweaks
! 103 NSR 20140708 1. a few tweaks
!====================================================================================================
option type=explicit !
set no prompt !
!
map(disk_fake) string d100_whole = 53 , ! &
string d100_align = 0 ! enforce layout check
map(disk_fake) string d100_field_001 = 10 , ! &
string d100_field_002 = 11 , ! &
string d100_field_003 = 12 , ! &
string d100_field_004 = 20 , ! &
string d100_align = 0 ! must align with previous decl
!
map(rms_stuff) string rms_stuff = 16 , ! &
string rms_align = 0 ! enforce layout check
map(rms_stuff) byte rs_org , ! 1= 1 &
byte rs_rat , !+1= 2 &
word rs_mrs , !+2= 4 &
long rs_alq , !+4= 8 &
word rs_bks_bls , !+2= 10 &
word rs_num_keys , !+2= 12 &
long rs_mrn , !+4= 16 &
string rms_align = 0 ! must align with previous decl
!
declare string my_file$, temp$ !
!========================================================================================================================
! main
!========================================================================================================================
main:
print k_program +"_"+ k_version !
print string$(len(k_program +"_"+ k_version), asc("=")) !
!
print "test existing gif files? (y/N) "; !
input temp$ !
goto test_gif_files if edit$(temp$, 32%+2%) = "Y" !
!
print "recreate test files? (y/N) "; !
input temp$ !
gosub create_some_test_files if edit$(temp$, 32%+2%) = "Y" !
!
!-----------------------------------------------------------------------
! test these data files
!-----------------------------------------------------------------------
test_data_files:
print "-i- file testing will begin in 2 seconds"
sleep 2
!
my_file$ = "aaa_demo_basic_rms_seq_term.txt"
gosub test_file
!
my_file$ = "aaa_demo_basic_rms_seq_fix.dat"
gosub test_file
!
my_file$ = "aaa_demo_basic_rms_seq_var.dat"
gosub test_file
!
my_file$ = "aaa_demo_basic_rms_rel_fix.dat"
gosub test_file
!
my_file$ = "aaa_demo_basic_rms_rel_var.dat"
gosub test_file
!
my_file$ = "aaa_demo_basic_rms_inx_fix.dat"
gosub test_file
!
my_file$ = "aaa_demo_basic_rms_inx_var.dat"
gosub test_file
!
goto fini !
!-----------------------------------------------------------------------
! test these data files
!-----------------------------------------------------------------------
test_gif_files:
!
my_file$ = "[._BASIC_DEMO]Crookes_radiometer_moving.gif"
gosub test_file
!
my_file$ = "[._BASIC_DEMO]skynet-prototype-cpu.jpg"
gosub test_file
!
my_file$ = "[._BASIC_DEMO]TM-CM2-0109-SUPERCOMP_x600.jpg"
gosub test_file
!
goto fini !
!-----------------------------------------------------------------------
! <<< test the desired file >>>
!-----------------------------------------------------------------------
test_file:
open my_file$ for input as #100 &
,access read &
,recordtype any &
,organization undefined
rms_stuff = fsp$(100) ! snoop
!
print "========================================"
print "file "; my_file$
print "org "; rs_org;
select rs_org !
case >= 48
print " (hashed)"
case >= 32
print " (indexed)"
case >= 16
print " (relative)"
case else
print " (sequential)"
end select
print "rec attr "; rs_rat !
print "max rec siz "; rs_mrs !
print "alloc qty "; rs_alq !
print "bucket size "; rs_bks_bls; " (always zero)" ! see "User Manual" about bytes 9-12
print "num of keys "; rs_num_keys; " (always zero)" ! see "User Manual" about bytes 9-12
print "max rec num "; rs_mrn ! not always zero (see relative tests)
close #100 !
return !
!-------------------------------------------------------
! <<< create some test files >>>
!-------------------------------------------------------
create_some_test_files:
print "-i-creating test files"
!
d100_whole = "" ! init the whole buffer
!
d100_field_001 = "Neil" ! create some test data
d100_field_002 = "Rieck" !
d100_field_003 = "Programmer" !
d100_field_003 = "Waterloo, Ontario, Canada" !
!
! sequential (terminal)
!
open "aaa_demo_basic_rms_seq_term.txt" for output as #100 &
,organization sequential
print #100, d100_field_001
print #100, d100_field_002
print #100, d100_field_003
print #100, d100_field_004
close #100 !
!
! sequential (fixed)
!
open "aaa_demo_basic_rms_seq_fix.dat" for output as #100 &
,organization sequential fixed &
,map disk_fake
put #100
put #100
put #100
close #100
!
! sequential (variable)
!
open "aaa_demo_basic_rms_seq_var.dat" for output as #100 &
,organization sequential variable &
,map disk_fake
put #100
put #100
put #100
close #100
!
! relative (fixed)
!
open "aaa_demo_basic_rms_rel_fix.dat" for output as #100 &
,organization relative fixed &
,map disk_fake
put #100, record 1
put #100, record 2
put #100, record 3
close #100
!
! relative (variable)
!
open "aaa_demo_basic_rms_rel_var.dat" for output as #100 &
,organization relative variable &
,map disk_fake
put #100, record 1
put #100, record 2
put #100, record 3
close #100
!
! indexed (fixed)
!
open "aaa_demo_basic_rms_inx_fix.dat" for output as #100 &
,organization indexed fixed &
,map disk_fake &
,primary key d100_field_001 duplicates &
,alternate key d100_field_002 duplicates
put #100
put #100
put #100
close #100
!
! indexed (variable)
!
open "aaa_demo_basic_rms_inx_var.dat" for output as #100 &
,organization indexed variable &
,map disk_fake &
,primary key d100_field_001 duplicates &
,alternate key d100_field_002 duplicates &
,alternate key d100_field_003 duplicates
put #100
put #100
put #100
close #100
!
print "-i-file creation is complete"
sleep 1
return !
!
! <<< adios >>>
!
32000 fini: !
end !