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									!