Date: Mon, 18 May 87 22:20 N
From: BUCLIN%CLSEPF51.BITNET%wiscvm.wisc.EDU%relay.cs.net@RCA.COM
Subject: DCL symbol table dump program

Hello everybody,

          I posted recently on INFO-VAX a program to dump the DCL
     symbol table on a file but it seemed that my mail didn't  go
     out of Europe. As the first release of the program had a bug
     (I correct it), I repost it now.

          Sometimes ago, one asked for a program which allows  to
     write the DCL symbol table on a file and to  recover  it  in
     another session. I have written such a program. The  sources
     are appended to the end of this mail. Just some comments  on
     how it works :

          - The program  builds  a  binary  file  containing  all
     global  symbols.  Keypad  symbols,  local  symbols,   label,
     process logical names are ignored. Wildcarded global symbols
     are included.

          - It is called via a CDU definition (file SYMBOLS.CLD).
     It has two qualifiers : /SAVE : allows to build a file  from
     the current symbol table. /RESTORE : restores a symbol table
     from a file. It takes one required  parameter  that  is  the
     symbol table file specification.

          - The privilege CMEXEC is required to run  the  program
     (one could install the image) and is set at the beginning of
     the image (this is usefull  for  those  who  don't  want  to
     install the program but have the  privilege).  Symbol  table
     pages (address  range  CTL$AG_CLIDATA+10  -  CTL$AG_CLIMAGE)
     have protection set to Supervisor Write.

          - To build  the  file,  the  procedure  WRITE_TABLE  is
     entered in Executive mode and step through the  whole  table
     and writes only the global symbols on the file.  DCL  stores
     the symbols in a hash table. One feature of this program  is
     to write with  the  symbols  the  hash  index.  One  can  be
     absolutely sure that the hash index will be  independent  of
     the process context (it is computed via  a  CRC  instruction
     based upon a fixed polynom). This allows the restore process
     to avoid the recomputation of the CRC and thus speed it up.

          - To read the file, the routine READ_TABLE  is  entered
     in Executive mode  too.  Before  effectively  restoring  the
     symbol table, the current one is deleted thus  clearing  the
     entries  that  may  be  potentially  used  by  the   symbols
     restored. This is not an undesirable effect because the main
     usage of this program is in the login command procedure and,
     in general, the symbol table is empty at this moment (except
     for the symbols declared in the SYLOGIN procedure but these
     can be included in the symbol table file).

          I use this program to speed up my login procedure  (the
     speed ratio is between 10 and 15 : 1 and a  half  second  of
     CPU time for a classical login procedure where only  symbols
     are declared, and 0.1 second with this program).

     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     !!!                                                      !!!
     !!!  IMPORTANT NOTE :                                    !!!
     !!!   This program works ONLY in standard version of     !!!
     !!!   VMS 4.5 (Version 4.5a will not work)               !!!
     !!!                                                      !!!
     !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

          For those who want to adapt the program for another VMS
     version, offsets used in DCL_LINK routine must be reajusted.
     Use  the  DCL  link  map  file  to  find  the  new   offset.
     Identifiers of DCL routines used in  my  program  are  those
     used in DCL. For VMS 4.4, values are :

          DCL$PURGE_SYM:        .long ^X2319
          DCL$RESTORE_SYM:      .long ^X2270
          DCL$RESTORE_ABBREV:   .long ^X2238
          DCL$DEALLOCSYM:       .long ^X1FE6

                             Bertrand Buclin
                             Service Informatique
                             Departement de Mathematiques
                             Ecole Polytechnique Federale de Lausanne
                             CH-1015 Lausanne (Switzerland)

          Electronic Mail addresses:

          BITNET/EARN:  BUCLIN@CLSPEF51
          DECnet     :  ELMA::BUCLIN (node 20.34 on Span/PhysNet/CHadNet)
          PSI/VAX    :  PSI%022846911008::ELMA::BUCLIN

          -------------------------------------------------
File: SYMBOLS.CLD

define verb symbols
  image sys$system:symbols
  parameter p1, label file_name, prompt "File", value (required, type=$infile)
  qualifier save, nonnegatable
  qualifier restore, nonnegatable

          -------------------------------------------------
File: SYMBOLS.MAR

Assemble it with MACRO SYMBOLS and link it with LINK SYMBOLS (no options)

        .title  Symbol table dump program
;++
;
; FACILITY : DCL Symbol table dump program
;
; ABSTRACT : This program dumps the DCL symbol table on a file to reuse it
;            in another process.
;
; ENVIRONMENT : VAX/VMS V4.5 DCL command language, privileged mode
;
; AUTHOR   : Bertrand Buclin
;            Service Informatique, Departement de Mathematiques
;            Ecole Polytechnique Federale de Lausanne
;            CH-1015 Lausanne
;
; CREATION DATE : 7-MAY-1987
;
;--
        .link   "SYS$SYSTEM:DCLDEF.STB"
        .link   "SYS$SYSTEM:SYS.STB"

        .weak   SYS$K_VERSION                   ; Require recompilation
                                                ; For next VMS upgrade

        $PRVDEF                                 ; Get privileges definitions

page
        .subtitle DCL internal routine addresses
;++
;
;       The following entities correspond to DCL routines. Their address
;       are subject to modification with each VMS upgrade. The DCL base
;       address is given by process context symbol CTL$AG_CLIMAGE. Offsets
;       for internal DCL routines are taken from the DCL map file.
;       These offsets are valid for VMS 4.5.
;       Initial values of longwords are the offset inside the DCL image
;       for the corresponding routine.
;
;--
        .psect  $DATA, pic, con, rel, lcl, wrt, rd, noexe, noshr, novec

DCL$PURGE_SYM:          .long   ^X2363  ; Purge active symbol table
DCL$RESTORE_SYM:        .long   ^X2244  ; Restore a symbol in the table
DCL$RESTORE_ABBREV:     .long   ^X22B7  ; Restore abbreviation from current tabl
e
DCL$DEALLOCSYM:         .long   ^X1FE9  ; Deallocate a symbol from table

page
        .subtitle DCL linkage

        .psect  $CODE, pic, con, rel, gbl, nowrt, rd, exe, shr

        .entry  DCL_LINK, ^m<>
;++
;
;       This routine establish the linkage with the DCL image.
;
; Inputs:
;
;       None
;
; Outputs:
;
;       None
;
;--
        movl    G^CTL$AG_CLIMAGE, R1            ; Get DCL base address
        addl    R1, DCL$PURGE_SYM               ; Compute DCL internal
        addl    R1, DCL$RESTORE_SYM             ; routines addresses
        addl    R1, DCL$RESTORE_ABBREV
        addl    R1, DCL$DEALLOCSYM
        ret
page
        .subtitle SYMTBLDMP - Main routine

        .psect  $CODE, pic, con, rel, gbl, nowrt, rd, exe, shr
        .entry  SYMBOLS, ^m<>
;++
;
;       This routine constitute the main routine of the program
;
; Inputs:
;
;       None
;
; Outputs:
;
;       None
;
;--
        .psect  $DATA, pic, con, rel, lcl, wrt, rd, noexe, noshr, novec

file_fab:       $FAB    FOP=<OFP, SQO>          ; Symbol table file FAB
file_rab:       $RAB    FAB=file_fab            ; Symbol record RAB
save:           .ascid  "SAVE"                  ; CLI qualifier
restore:        .ascid  "RESTORE"               ; CLI qualifier
file_name:      .ascid  "FILE_NAME"             ; CLI parameter
cmexecprv:      .quad   <1@PRV$V_CMEXEC>        ; Priv. mask
prvmsk:         .quad   0

        .psect  $CODE, pic, con, rel, gbl, nowrt, rd, exe, shr
        .default displacement, word

        $SETPRV_S ENBFLG=#1, -          ; Set CMEXEC privilege
                  PRVADR=cmexecprv, -   ; during image execution
                  PRMFLG=#0, -
                  PRVPRV=prvmsk
        pushab  file_name               ; Is file name present ?
        calls   #1, G^CLI$PRESENT
        blbs    R0, 20$                 ; No signal the error
10$:    ret
20$:    clrq    -(SP)                   ; Reserve space on stack for descriptor
        movl    SP, R2                  ; Save descriptor address
        movb    #DSC$K_DTYPE_T, -       ; Build dynamic string descriptor
                DSC$B_DTYPE(R2)
        movb    #DSC$K_CLASS_D, -
                DSC$B_CLASS(R2)
        pushl   R2                      ; Get symbol table file name
        pushab  file_name
        calls   #2, G^CLI$GET_VALUE
        blbc    R0, 10$                 ; Signal any error
        movl    DSC$A_POINTER(R2), -    ; Update FAB file name fields
                file_fab+FAB$L_FNA
        movb    DSC$W_LENGTH(R2), -
                file_fab+FAB$B_FNS
        calls   #0, dcl_link            ; establish DCL linkage
        pushab  save
        calls   #1, G^CLI$PRESENT       ; Do we save the table ?
        blbs    R0, 30$
        pushab  restore
        calls   #1, G^CLI$PRESENT       ; or restore it ?
        blbc    R0, 50$
        movb    #FAB$M_GET, -
                file_fab+FAB$B_FAC      ; Open file for read
        $OPEN   FAB=file_fab
        blbc    R0, 50$
        $CONNECT RAB=file_rab
        blbc    R0, 50$
        $CMEXEC_S ROUTIN=read_table     ; and read the table from the file.
        blbc    R0, 50$                 ; Signal any error
        brb     40$                     ; Close symbol table file and return

30$:    movb    #FAB$M_PUT, -
                file_fab+FAB$B_FAC      ; set write access
        $CREATE FAB=file_fab            ; Create the dump file
        blbc    R0, 50$                 ; Signal any error
        $CONNECT RAB=file_rab           ; Connect the rab
        blbc    R0, 50$                 ; Signal any error
        $CMEXEC_S ROUTIN=write_table    ; and dump the table to it.
        blbc    R0, 50$                 ; Signal any error
40$:    $CLOSE  FAB=file_fab            ; Close the file
50$:    ret                             ; Return to DCL
page
        .subtitle Write_table - Dump the table to a file

        .entry  write_table, ^m<R2, R3, R4, R5, R6, R7, R8, R9, R10, R11>
;++
;
;       This routine writes the symbol table to the dump file.
;
; Inputs:
;
;       None
;
; Outputs:
;
;       None
;
;--

CTX_B_QHEADER =   2
CTX_B_SYMTYPE =   5
CTX_W_SYMSIZE =   3
CTX_C_CLISYMG =   8
CTX_C_CLISYML =   3
CTX_C_MAXLEN  = ^X400
CTX_W_TYPE    =   0
TABLE_LENGTH  = ^X100

        moval   G^CTL$AG_CLIDATA, R11   ; Get DCL data area address
        movl    PPD$L_PRC(R11), R11     ; Get process environment
        jsb     @DCL$PURGE_SYM          ; Purge symbol table of invalid symbols
        clrl    R5                      ; Setup loop counter
        movl    PRC_L_SYMTABLE(R11), R4 ; Get address of central symbol table.
;
; Start of loop to process each symbol entry in each queue in the central
; table.
;
10$:    movl    R4, R9                  ; Save address of listhead
15$:    movl    SYM_L_FL(R9), R9        ; Get next symbol entry
        beql    70$                     ; If null address, exits
        cmpl    R9, R4                  ; Are we finished with this queue ?
        beql    60$                     ; Yes, check if through with the table
;
; Validate this entry, pass through only global symbols and local symbols
; defined at the current procedure level. Do not save permanent symbols.
;
        cmpb    #SYM_K_PERM, SYM_B_TYPE(R9)     ; Is this a permanent symbol ?
        beql    15$                             ; Yes skip it.

        tstw    SYM_W_PROCLEVEL(R9)     ; Is this a global symbol ?
        blss    18$                     ; Yes save all global symbols

        cmpb    #SYM_K_LABEL, SYM_B_TYPE(R9)    ; Is this a label ?
        beql    15$                             ; Yes, ignore labels

        cmpw    PRC_W_PROCLEVEL(R11), - ; Is this local symbol defined at
                SYM_W_PROCLEVEL(R9)     ; the current procedure level ?
        bneq    15$                     ; No, skip it.

18$:    tstw    SYM_W_NONUNIQUE(R9)     ; Is this an abbreviation pointer ?
        blss    15$                     ; Yes, skip it, copy only master symbol
;
; A valid symbol must be saved.
;
20$:    movab   SYM_L_BLOCKSEQ+1(R9), R7        ; Set start address of block
        movw    #CTX_C_CLISYMG, CTX_W_TYPE(R7)  ; Assume a global symbol
        tstw    SYM_W_PROCLEVEL(R9)             ; Is this a global symbol ?
        blss    25$                             ; Yes, symbol type is ok.

        movw    #CTX_C_CLISYML, CTX_W_TYPE(R7)  ; No, change to local symbol

25$:    movb    R5, CTX_B_QHEADER(R7)   ; Store current queue header offset
        movzwl  SYM_W_SIZE(R9), R3      ; Get total size required to store sym.
;
; Since the entire symbol entry definition will not be saved, adjust this
; size by adding the CTX overhead and substracting that portion of the
; symbol definition which will not be saved.
;
        subl    #SYM_C_FIXED, R3        ; Adjust size
        cmpw    R3, #CTX_C_MAXLEN       ; Is this symbol too long ?
        bgtru   100$                    ; Yes, report skipping it
        movl    R7, file_rab+RAB$L_RBF  ; Set buffer address
        movw    R3, file_rab+RAB$W_RSZ  ; and length
        $PUT    RAB=file_rab            ; and write it.
        brb     15$                     ; Get next symbol entry
;
; This queue is finished, check if there are more queues in the central
; symbol table to process.
;
60$:    addl    #8, R4                  ; Point to next queue
        incl    R5
        cmpl    R5, #TABLE_LENGTH       ; Process next queue, if not at end
        bgtr    70$
        brw     10$
70$:    movzbl  #SS$_NORMAL, R0
        ret                             ; return if all finished.
;
; We have encountered an oversized symbol. Issue a warning message saying
; that it is ignored and then proceed.
;
100$:   movab   SYM_T_SYMBOL+1(R4), -(SP); Push descriptor of the symbol name
        movzbl  SYM_T_SYMBOL(R4), -(SP)
        pushl   SP                      ; Descriptor address
        movl    #1, R1                  ; Set number of arguments
        pushl   #CLI$_SYMTOOLNG         ; Message name
        calls   #3, G^LIB$SIGNAL        ; Output message
        clrq    (SP)+                   ; Clean stack
        brw     15$                     ; Process next symbol
page
        .subtitle READ_TABLE - Read and restore the symbol table
        .entry  READ_TABLE, ^m<R2, R3, R4, R5, R6, R7, R8, R9, R10, R11>
;++
;
;       This routine reads the symbol table from a file and
;       restore it.
;
; Inputs:
;
;       None
;
; Outputs:
;
;       None
;
;--
        moval   G^CTL$AG_CLIDATA, R11   ; Get DCL data area address
        movl    PPD$L_PRC(R11), R11     ; Get process environment
        jsb     delete_table            ; Delete existing table
        moval   -CTX_C_MAXLEN(SP), SP   ; Reserve symbol file buffer
        movl    SP, R5                  ; and get its address
        movl    R5, file_rab+RAB$L_UBF  ; Set buffer address
        movw    #CTX_C_MAXLEN, -        ; Set buffer length
                file_rab+RAB$W_USZ
10$:    $GET    RAB=file_rab            ; Read symbol from file
        cmpl    R0, #RMS$_EOF           ; Are we at end of file ?
        beql    30$
        blbc    R0, 40$                 ; Is there any error ?
        movl    file_rab+RAB$L_UBF, R5  ; Get record address
        movzbl  CTX_B_QHEADER(R5), R4   ; Get queue list offset in symbol table
        movzwl  CTX_W_SYMSIZE(R5), R1   ; Get size of memory required for symbol
        movl    PRC_L_SYMTABLE(R11), R6 ; Assume we have global symbol
        cmpb    #SYM_K_KEYPAD, -        ; Is this a keypad symbol ?
                CTX_B_SYMTYPE(R5)
        bneq    20$                     ; No table address is ok as is
        clrl    R4                      ; Use first queue list (the keypad
                                        ; table only has one queue list.
        movab   PRC_Q_KEYPAD(R11), R6   ; Get address of keypad table listhead
20$:    jsb     @DCL$RESTORE_SYM        ; Store this symbol
        brb     10$                     ; Go to next symbol

30$:    jsb     @DCL$RESTORE_ABBREV     ; Restore abbreviate symbols
        movzbl  #SS$_NORMAL, R0         ; Return success
40$:    ret
page
        .subtitle DELETE_TABLE - Delete all symbols in tables
        ;.entry DELETE_TABLE, ^m<R2, R3, R4, R5, R6, R7, R8, R9, R10, R11>
;++
;
;       This routine delete all symbols in a table. It is used before
;       restoring a symbol table from a file in order to avoid the
;       redefinition of symbols.
;
; Inputs:
;
;       R11 = Per process context area address
;
; Outputs:
;
;       None
;
;--
delete_table:
        movl    #SYM_C_GLOBAL, R7       ; Set global search type
        movl    PRC_L_SYMTABLE(R11), R6 ; Get first queue in symbol table
        clrl    R5                      ; Clear loop counter
10$:    movl    R6, R3                  ; Save address of queue header
20$:    movl    (R3), R3                ; Get address of next symbol
        cmpl    R6, R3                  ; End of queue ?
        beql    40$                     ; Yes skip to next queue
        cmpb    #SYM_K_LABEL, -         ; Is this a label entry ?
                SYM_B_TYPE(R3)
        beql    20$                     ; Yes skip it.
        tstw    SYM_W_PROCLEVEL(R3)     ; Is this a local symbol ?
        bgeq    20$                     ; Yes, then skip it.
;
; We have found a global symbol. Check if it is permanent and deallocate it
; if it is not.
;
        cmpb    #SYM_K_PERM, SYM_B_TYPE(R3); Permanent symbol ?
        beql    20$                     ; Don't deallocate it if yes.
        pushab  20$                     ; Set return address
        jmp     @DCL$DEALLOCSYM         ; Deallocate it.
40$:    addl    #8, R6                  ; Point to hext queue header in table
        aoblss  #TABLE_LENGTH, R5, 10$  ; Process next queue
50$:    movzbl  #SS$_NORMAL, R0         ; Return success
        rsb
        .end    SYMBOLS
