ASSEMBLER coding example

*    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
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