* TBparm area for tblBase
TBParm DS 0cl64 <<--- Release 5 and after TB-Parm
TBp_id dc cl2'TB' TB-Parm id
dc xl2'00' Must be set to binary zero
TBp_version dc c'5' TB-Parm format is Rel 5 and after
TBp_format dc c'0' '0' means use 72-byte Command Areas
dc xl18'00' Reserved (should be binary zero)
TBp_subsystem dc xl4'00' VTS name if used else binary zeroes
dc xl8'00' Reserved (should be binary zeroes)
TBp_turbo dc xl8'00' Turbo (set to zero for 1st call)
dc xl16 Reserved (should be binary zeroes)
* Command area for tblBase
Command_Area DS 0cl72 <<--- Long-form Command area
Cmd_command ds cl2 Command to be performed by tableBASE
Cmd_table ds cl8 Name of table to be used
Cmd_found ds c Found code
Cmd_indirect dc c Indirect Open indicator
dc x'00' Reserved - do not alter
Cmd_abend_override dc c' ' Abend override
Cmd_error_code ds h Error code set by tblBase
Cmd_count dc f'0' Count field set by tblBase
Cmd_lock_latch dc xl8'0' Lock-latch
Cmd_row_length_override dc f'0' Row length override set by caller
Cmd_row_actual_length ds f Actual row length returned
Cmd_FG_key_length dc h'0' Fetch Generic partial key length
Cmd_function_id dc h'0' Special processing value if not zero
Cmd_dsp_date dc xl8'0' Date for Date-Sensitive Processing
dc cl20 Reserved (should be binary zero)
Cmd_rtn_abs_gen ds h Returned Absolute Generation set by tblBase
Cmd_subcode ds h Error subcode set by tblBase
* Extended DT block for GD and DT commands
Definition_block DS 0cl256 <<--- Long-form Definition Block
Dt_Organization dc cl1'S'
Dt_Search_method dc cl1'B'
Dt_Index dc cl1'P'
Dt_SMC dc cl1'R'
Dt_Read_Password dc cl8' '
Dt_Write_Password dc cl8'SECURITY'
Dt_Row_size dc f'120'
Dt_Key_size dc f'11'
Dt_Key_location dc f'1'
Dt_Number_of_rows dc f'500'
Dt_Generations dc h'3'
Dt_Expansion_factor dc h'0'
Dt_Low_density dc h'0'
Dt_High_density dc h'0'
ds xl6
Dt_Date_time ds cl12
Dt_Absolute_generation_number dc h'0'
Dt_Dataset_name ds cl44
Dt_Relative_generation_number dc h'0'
Dt_Generations_present dc h'0'
Dt_Rows_at_expansion dc f'0'
Dt_DDname ds cl8
Dt_Data_table dc cl8' '
Dt_Open_status ds c
Dt_Alternates_invoked dc c' '
Dt_View_version dc cl1'5'
ds x
Dt_Userid ds cl8
Dt_View_name ds cl8
Dt_View_date ds cl12
Dt_User_comments dc cl16' '
ds cl76
* Library list
Liblist DS (0*10)cl8
dc cl8'PROGLIB'
dc cl8'SYSTMLIB'
dc cl8'INSTALIB'
dc 7*cl8' '
* Row area with key
Row_Area ds 0cl120
Row_key ds cl11
Row_data ds cl109
* Some test keys
testkeys ds 0cl11
dc cl11'aaaaaaa'
dc cl11'bbbbbbb'
numkeys equ (*-testkeys)/l'testkeys
...
...
...
* Set up the library concatenation order.
mvc Cmd_command,=c'ML'
Call tblBase,(TBparm,Command_Area,Liblist),VL
clc Cmd_error,=h'0'
bne MLerror
* Define the new table.
mvc Cmd_command,=c'DT'
mvc Cmd_table,=cl8'TABLE01'
Call tblBase,(TBparm,Command_Area,DT_definition_block),VL
clc Cmd_error,=h'0'
bne DTerror
* Set up command outside loop.
mvc Cmd_commmand,=c'IK'
* Read row records until end-of-file, and insert each into the table.
getrow get infile,Row
* Search and insert into table
Call tblBase,(TBparm,Command_Area,Row_Area),VL
clc Cmd_error,=h'0'
bne IKerror
cli Cmd_found,c'Y'
bne getrow
* Log duplicate key.
mvc dup_msg_key, row_key
put logfile,dup_msg
b getrow
* Store new table on PROGLIB, the first entry in the ML list.
RowEOD mvc Cmd_command,=c'ST'
Call tblBase,(TBparm,Command_Area),VL
clc Cmd_error,=h'0'
bne STerror
* Look up some sample keys.
la r2,testkeys
la r3,numkeys
mvc Cmd_command,=c'SK'
samploop Call tblBase,(TBparm,Comand_area,(r2)),VL
clc Cmd_error,=h'0'
bne SKerror
mvc msg_word,=cl9'Found'
cli Cmd_found,c'Y'
be *+10
mvc msg_word,=cl9'Not found'
put logfile,samp_msg
la r2,l'testkey(,r2)
bct r3,samploop
* Close the table.
mvc Cmd_Command,=c'CL'
Call tblBase,(TBparm,Command_Area),VL
clc Cmd_Error,=h'0'
bne Closerr
...
...
* Routines to handle errors in various commands
MLerror ds 0h
DTerror ds 0h
IKerror ds 0h
SToserr ds 0h
SKerror ds 0h
CLoserr ds 0h
...
...
...
infile dcb ddname=INFILE,dsorg=PS,macrf=GM,recfm=FB,lrecl=120, X
eodad=RowEOD
logfile dcb .....
dup_msg dc c' Duplicate key '
dup_key ds cl11
samp_msg dc c' Test key '
samp_key ds cl11
dc c' '
msg_word ds cl9
