From:	CSBVAX::MRGATE!RELAY-INFO-VAX@CRVAX.SRI.COM@SMTP  9-AUG-1988 07:20
To:	ARISIA::EVERHART
Subj:	UNSDL Part 2 of 3 parts


Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Tue,  9 AUG 88 03:30:49 PDT
Received: from uwavm.acs.washington.edu (oly.acs.washington.edu) by KL.SRI.COM with TCP; Tue, 9 Aug 88 03:07:42 PDT
Received: from UWAVM.ACS.WASHINGTON.EDU by uwavm.acs.washington.edu ; Tue, 09 Aug 88 03:01:08 PDT
Received: from UWAVM.ACS.WASHINGTON.EDU by UWAVM.ACS.WASHINGTON.EDU (Mailer
 X1.24) with BSMTP id 2806; Tue, 09 Aug 88 03:01:04 PDT
P1-Message-Id: US**EDU;UWAVM.ACS.WASHINGTON.EDU:LTbkeKvP
Date:         Mon, 8 Aug 88 21:59-0700
X400-Trace:   US**EDU; arrival Mon, 8 Aug 88 21:59-0700 action Relayed
X400-Trace:   US**EDU; arrival Tue, 9 Aug 88 03:01-0700 action Relayed
From:         Joe Meadows</ADMD=/PRMD=BITNET/O=FHCRCVAX/PN=JOE/@US>
Subject:      UNSDL Part 2 of 3 parts
To:           <info-vax@kl.sri.COM>
Message-Id:   <UWAVM.ACS.WASHINGTON.EDU:LTbkeKvP*>
X-VMS-To: IN%"info-vax@kl.sri.com"

Here is part 2 (of 3) of UNSDL. See the AAAREADME.TXT file found
in part one for a description.

This part should include the following files:
        C.OPT,COMPILE.COM,LOOKUP_TEMPLATE.TPU
        MAKEFILE.,MISC.C,READABLE.MAR,SDL.OPT
        SDLDEF.H,SDLDUMP.C,UNSDL.C,UNSDL.CLD

$ create/log C.OPT
$DECK
sys$share:vaxcrtl.exe/share
$EOD
$ create/log COMPILE.COM
$DECK
$! Creating all
$
$ cc/debug unsdl
$ cc/debug misc
$ link unsdl,misc,c/option
$!
$ cc/debug sdlcc
$ macro/debug readable
$ set command/object sdlcc-cld
$ link/share/debug sdlcc,misc,readable,sdlcc-cld,sdl/option
$!
$ cc/debug sdldump
$ link/share/debug sdldump,misc,readable,sdl/option
$!
$ runoff sdl
$EOD
$ create/log LOOKUP_TEMPLATE.TPU
$DECK
procedure eve_lookup_template(routine_name)
local rname, thisbuffer, template, pat1, pat2;

if not (eve$prompt_string(routine_name,rname,"Routine : ",
                          "No routine name given")) then
  return;
endif;

if not jem$k_templates_loaded then
  jem$k_template_buffer := create_buffer("templates","routines.template");
  jem$k_templates_loaded := 1;
endif;

! we should do match(rname) in (space separated) chunks.
edit(rname,lower,trim,compress);
pat1 := line_begin & "/*+~" & match(rname) & match("~+*/") & line_end;
pat2 := line_end & line_begin & "/*~-" & match("-~*/") & line_end;

thisbuffer := current_buffer;
position(beginning_of(jem$k_template_buffer));
position(beginning_of(search(pat1,forward)));
move_vertical(1);

template := create_range(mark(none),beginning_of(search(pat2,forward)),none);

position(thisbuffer);
copy_text(template);
delete(template);

endprocedure;

eve$arg1_lookup_template := "string";
jem$k_templates_loaded := 0;
$EOD
$ create/log MAKEFILE.
$DECK
# create everything needed for UNSDL
all : unsdl.exe sdlcc.exe sdldump.exe sdl.mem
        ! SDL tools build is complete

cleanup:        # clean up for DECUS submission
        -delete readable.obj;*
        -delete sdlcc-cld.obj;*
        -purge
        -rename *.* ;1

sdl.mem : sdl.rno
        runoff sdl

unsdl.exe : unsdl.obj misc.obj c.opt
        link unsdl,misc,c/option

sdlcc.exe : sdlcc.obj misc.obj readable.obj sdlcc-cld.obj sdl.opt
        link/share/debug sdlcc,misc,readable,sdlcc-cld,sdl/option

sdldump.exe : sdldump.obj misc.obj readable.obj sdl.opt
        link/share/debug sdldump,misc,readable,sdl/option

unsdl.obj : unsdl.c sdldef.h
        cc/debug unsdl

sdlcc.obj : sdlcc.c sdldef.h
        cc/debug sdlcc

sdlcc-cld.obj : sdlcc-cld.cld
        set command/object sdlcc-cld

sdldump.obj : sdldump.c sdldef.h
        cc/debug sdldump

misc.obj : misc.c
        cc/debug misc

readable.obj : readable.mar
        macro/debug readable
$EOD
$ create/log MISC.C
$DECK
/* Version 1.0 Feb. 4 1988
   first release - no modifications
   These are the routines - they simply create descriptors and call
   their real counterparts, i.e. str$append. Strings used as input are
   simply regular c strings, output are via descriptors (I like dynamic
   string descriptors).

        str_append(dst,src)
          struct dsc$descriptor *dst;
          char *src;
        lib_delete_symbol(name)
          char *name;
        lib_get_symbol(name,value)
          char *name;
          struct dsc$descriptor *value;
        lib_set_symbol(name,value)
          char *name;
          struct dsc$descriptor *value;
        cli_get_value(s1,s2)
          char *s1;
          struct dsc$descriptor *s2;
        cli_present(s1)
          char *s1;
*/

#include <descrip.h>

str_append(dst,src)
  struct dsc$descriptor *dst;
  char *src;
{
  struct dsc$descriptor src_desc =
        {strlen(src),DSC$K_DTYPE_T,DSC$K_CLASS_S,src};
  return(str$append(dst,&src_desc));
}

lib_delete_symbol(name)
  char *name;
{
  static int two = 2;
  struct dsc$descriptor name_desc =
        {strlen(name),DSC$K_DTYPE_T,DSC$K_CLASS_S,name};

  return(lib$delete_symbol(&name_desc,&two));
}

lib_get_symbol(name,value)
  char *name;
  struct dsc$descriptor *value;
{
  struct dsc$descriptor name_desc =
        {strlen(name),DSC$K_DTYPE_T,DSC$K_CLASS_S,name};

  return(lib$get_symbol(&name_desc,value));
}

lib_set_symbol(name,value)
  char *name;
  struct dsc$descriptor *value;
{
  static int two = 2;
  struct dsc$descriptor name_desc =
        {strlen(name),DSC$K_DTYPE_T,DSC$K_CLASS_S,name};

  return(lib$set_symbol(&name_desc,value,&two));
}

cli_get_value(s1,s2)
  char *s1;
  struct dsc$descriptor *s2;
{
  static struct dsc$descriptor s1_desc={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};

  s1_desc.dsc$w_length = strlen(s1);
  s1_desc.dsc$a_pointer = s1;

  return(cli$get_value(&s1_desc,s2));
}

cli_present(s1)
  char *s1;
{
  static struct dsc$descriptor s1_desc={0,DSC$K_DTYPE_T,DSC$K_CLASS_S,0};

  s1_desc.dsc$w_length = strlen(s1);
  s1_desc.dsc$a_pointer = s1;

  return(cli$present(&s1_desc));
}
$EOD
$ create/log READABLE.MAR
$DECK
; version 1.0 Feb 4, 1988
; first version - no modifications
;
        .title  readable
        .entry  readable,0

        movzbl  #-1,r0  ; assume it will work

        prober  #0,#4,@4(ap)

        bneq    10$
        clrl    r0      ; clear it if it didn't work

10$:    ret

        .end
$EOD
$ create/log SDL.OPT
$DECK
sys$share:vaxcrtl.exe/share
universal = sdl$output
$EOD
$ create/log SDLDEF.H
$DECK
/* Version 1.1, 7/15/88
        Modified to reflect changes in 5.0, not complete (does not have
   the return value name field included yet).

   Standard include file for SDL modules (UNSDL, SDLCC, SDLDUMP)
*/
struct itmlst { /* this is an item list - for getjpi etc. */
  short int  BufLen;
  short int  ItmCod;
  char      *BufAdr;
  short int *RetLenAdr;
};

struct sptr { /* this is a string pointer, as used in PLI apparently */
  short int len;
  char str[32];
};

struct Head {
    char fill[298];
    short int banner_len;
    char banner[68];
    char version[10];
    struct Node *head;
};

struct Node {
  /* this is the structure of a node used in the tree created by
     SDL/NOPARSE, note that I have not been able to find where the
     src_lines variable is kept, since I have not found any SDI
     files that contain a non-zero src_lines field. */
  struct Node *flink, *blink;
  short int size;
  short int type;
  struct Node *parent, *child;
  char fill1[4];
  int hidim;
  int lodim;
  int default_value;
  struct sptr name;
  char fill2[2];
  struct sptr prefix;
  char fill3[34];
  struct sptr tag;
  struct sptr naked;
  char fill4[2];
  int offset;
  int fldsiz;
  unsigned int datatype;
  union {
    int flags;
    struct {
      unsigned m_value : 1;
      unsigned m_mask : 1;
      unsigned m_unsigned : 1;
      unsigned m_common : 1; /* ??? */
      unsigned m_global : 1; /* ??? */
      unsigned m_varying : 1; /* ??? */
      unsigned m_variable : 1;
      unsigned m_based : 1;
      unsigned m_descriptor : 1;
      unsigned m_dimen : 1;
      unsigned m_in : 1;
      unsigned m_out : 1;
      unsigned m_bottom : 1;
      unsigned m_bound : 1; /* ??? */
      unsigned m_ref : 1;
      unsigned m_fill : 1;
      unsigned m_16 : 1;
      unsigned m_default : 1;
      unsigned m_vardim : 1;
      unsigned m_link : 1;
      unsigned m_optional : 1;
      unsigned m_21 : 1;
      unsigned m_fixed : 1;
      unsigned m_generated : 1;
      unsigned m_24 : 1;
      unsigned m_list : 1;
      unsigned m_rtl_str_desc : 1;
      unsigned m_complex : 1;
      unsigned m_28 : 1;
      unsigned m_29 : 1;
      unsigned m_30 : 1;
      unsigned m_31 : 1;
    } flag;
  } sdl_flag_bits ; /* end of variant_union */
  int typeinfo;
  int typeinfo2;
  struct sptr *comment;
  struct sptr typename;
};

#define SDL$C_NODE_ROOT 1
#define SDL$C_NODE_COMMENT 2
#define SDL$C_NODE_CONSTANT 3
#define SDL$C_NODE_ENTRY 4
#define SDL$C_NODE_ITEM 5
#define SDL$C_NODE_MODULE 6
#define SDL$C_NODE_PARAMETER 7
#define SDL$C_NODE_UNKNOWN 8
#define SDL$C_NODE_OBJECT 9
#define SDL$C_NODE_HEAD 10

#define SDL$C_TYPE_ADDRESS 1
#define SDL$C_TYPE_BYTE 2
#define SDL$C_TYPE_CHARACTER 3
#define SDL$C_TYPE_BOOLEAN 4
#define SDL$C_TYPE_DECIMAL 5 /* ??? */
#define SDL$C_TYPE_DFLOAT 6
#define SDL$C_TYPE_FFLOAT 7
#define SDL$C_TYPE_GLOAT 8
#define SDL$C_TYPE_HFLOAT 9
#define SDL$C_TYPE_LONGWORD 10
#define SDL$C_TYPE_OCTAWORD 11 /* ??? */
#define SDL$C_TYPE_QUADWORD 12
#define SDL$C_TYPE_BITFIELD 13
#define SDL$C_TYPE_WORD 14
#define SDL$C_TYPE_STRUCTURE 15
#define SDL$C_TYPE_UNION 16
#define SDL$C_TYPE_ANY 17
#define SDL$C_TYPE_ENTRY 18
#define SDL$C_TYPE_DFLOAT_COMPLEX 19
#define SDL$C_TYPE_FFLOAT_COMPLEX 20
#define SDL$C_TYPE_GFLOAT_COMPLEX 21
#define SDL$C_TYPE_HFLOAT_COMPLEX 22 /* guess */

#define SDL$M_VALUE 1<<0
#define SDL$M_MASK 1<<1
#define SDL$M_UNSIGNED 1<<2
#define SDL$M_COMMON 1<<3 /* ??? */
#define SDL$M_GLOBAL 1<<4 /* ??? */
#define SDL$M_VARYING 1<<5 /* ??? */
#define SDL$M_VARIABLE 1<<6
#define SDL$M_BASED 1<<7
#define SDL$M_DESCRIPTOR 1<<8
#define SDL$M_DIMEN 1<<9
#define SDL$M_IN 1<<10
#define SDL$M_OUT 1<<11
#define SDL$M_BOTTOM 1<<12
#define SDL$M_BOUND 1<<13 /* ?? */
#define SDL$M_REF 1<<14
#define SDL$M_FILL 1<<15
#define SDL$M_16 1<<16 /* ??? */
#define SDL$M_DEFAULT 1<<17
#define SDL$M_VARDIM 1<<18
#define SDL$M_LINK 1<<19
#define SDL$M_OPTIONAL 1<<20
#define SDL$M_21 1<<21 /* ??? */
#define SDL$M_FIXED 1<<22
#define SDL$M_GENERATED 1<<23
#define SDL$M_24 1<<24
#define SDL$M_LIST 1<<25
#define SDL$M_RTL_STR_DESC 1<<26
#define SDL$M_COMPLEX 1<<27
#define SDL$M_28 1<<28
#define SDL$M_29 1<<29
#define SDL$M_30 1<<30
#define SDL$M_31 1<<31

#define SDL_SYMBOL "SDL_COMMAND_ARGS"
$EOD
$ create/log SDLDUMP.C
$DECK
/* Version 1.0 (Hmm, should be 0.something) Feb. 4, 1988
   First release - no modifications

   This program does a dump of the internal tree created by SDL/NOPARSE.
   This dump doesn't look like the dump from SDL/NOPARSE/DUMP, although
   it probably should so that we could use DIFFERENCES to see if I have
   all the datatypes and structures and such figured out correctly.

   Note that there should be some modifications - I just added
   code to UNSDL (actually, I just created it) and to SDLCC to allow
   passing extra information than was allowed via the SDL command.
   The code from SDLCC should be brought into this module
   at some point.
*/
#include <stdio.h>
#include "sdldef.h"

int readable();

sdl$output(outfile, module, root)
  struct sptr *outfile, *module;
  struct Head *root;

{
  struct Node *node;
  char out[256];
  int i;

  /* get outfile copied into local space, so I can add a zero to it. */
  for (i=0; (i < outfile->len) & (outfile->str[i] != ' '); i++)
    out[i] = outfile->str[i];
  out[i] = '\0';
  /* if no output file name present, use module name. */
  if (i==0) {
    for (i=0; (i < module->len) & (module->str[i] != ' '); i++)
      out[i] = module->str[i];
    out[i] = '.';
    out[i+1] = 'd';
    out[i+2] = 'm';
    out[i+3] = 'p';
    out[i+4] = '\0';
  };
  freopen(out,"w",stdout,"rfm=var","rat=cr");

  printf("Created by SDL %.*s\n",10,root->version);
  printf("Source: %.*s\n",root->banner_len,root->banner);
  printf("Module name is %.*s\n",module->len,&(module->str));

  node = root->head;
  traverse_node(node,0); /* this should be the root node */
}

traverse_node(node,level)
  struct Node *node;
  int level;
{
  struct Node *head;

  head = node;
  if (!readable(node))
    printf("WARNING unable to read address %08X\n",node);
  else
    do {
      print_node(node,level);
      printf("\n");

      if ((node->datatype == 1) && node->typeinfo2)  /* address */
        traverse_node(node->typeinfo2,level+1);

      if ((node->datatype == 18) && node->typeinfo2) /* entry */
        traverse_node(node->typeinfo2,level+1);

      if (node->child)
        traverse_node(node->child,level+1);

      node = node->flink;

      if (!readable(node)) {
        printf("WARNING unable to read address %08X\n",node);
        node = head; /* cause it to fall out of loop */
      };

    } while (node != head);
}

print_node(node,level)
  struct Node *node;
  int level;
{
  struct sptr *ptr;
  int i;

  static char *unknown = "unknown";

  static char *nodetypes[11] = {"?","root","comment","constant","entry","item",
        "module","parameter","?","object","head"};

  static char *datatypes[19] = {"?","address","byte","character","boolean",
        "decimal?","d-float","f-float","g-float","h-float","longword",
        "octaword?","quadword","bitfield","word","structure",
        "union","any","entry"};

  static char *flags[24] = {"value","mask","unsigned","common3?","global4?",
        "varying5?","variable","based","descriptor","dimen","in",
        "out","bottom","bound13?","ref","fill","16?","default",
        "vardim","link","optional","21?","fixed","generated"};
  static char spaces[] = "                                             ";

  if (level > 15) level = 15;

  printf("%.*sAddress: %08X Type: %s node\n",level*3,spaces,
                node,((node->type > 0) && (node->type < 11))?
                        nodetypes[node->type]:unknown);

  printf("%.*sFlink: %08X, Blink: %08X\n",level*3,spaces,
                node->flink,node->blink);
  printf("%.*sParent: %08X, Child: %08X\n",level*3,spaces,
                node->parent,node->child);

  if (node->name.len)
        printf("%.*sName: %.*s\n",level*3,spaces,
                node->name.len,node->name.str);
  if (node->prefix.len)
        printf("%.*sPrefix: %.*s\n",level*3,spaces,
                node->prefix.len,node->prefix.str);
  if (node->tag.len)
        printf("%.*sTag: %.*s\n",level*3,spaces,
                node->tag.len,node->tag.str);
  if (node->naked.len)
        printf("%.*sNaked: %.*s\n",level*3,spaces,
                node->naked.len,node->naked.str);
  if (node->typename.len)
        printf("%.*sTypename: %.*s\n",level*3,spaces,
                node->typename.len,node->typename.str);
  if (node->comment) {
        ptr = node->comment;
        printf("%.*sComment: %.*s\n",level*3,spaces,
                (*ptr).len,(*ptr).str);
        };
  if (node->size) printf("%.*ssize: %d\n",level*3,spaces,node->size);
  /*
   *    if (node->src_line) printf("\tsrc_line %d\n",node->src_line);
   */
  if (node->hidim) printf("%.*shidim: %d\n",level*3,spaces,node->hidim);
  if (node->lodim) printf("%.*slodim: %d\n",level*3,spaces,node->lodim);
  if (node->offset) printf("%.*soffset: %d\n",level*3,spaces,node->offset);
  if (node->fldsiz) printf("%.*sfldsiz: %d\n",level*3,spaces,node->fldsiz);

  if (node->datatype)
    printf("%.*sdatatype: %s (%d)\n",level*3,spaces,
                (node->datatype < 19)?
                        datatypes[node->datatype]:unknown, node->datatype);

  if (node->sdl_flag_bits.flags)
        if (!((node->type == 4) && (node->sdl_flag_bits.flags == 0x00010000)))
{
                printf("%.*sflags: (%08X) ",
                        level*3,spaces,node->sdl_flag_bits.flags);
                for (i=0; i<24; i++)
                  if (node->sdl_flag_bits.flags & (1<<i))
                    printf("%s ",flags[i]);
                for (i=24; i<32; i++)
                  if (node->sdl_flag_bits.flags & (1<<i))
                    printf("%d? ",i);
                printf("\n");
                };

  if (node->typeinfo)
    printf("%.*stypeinfo: %08X (%d)\n",level*3,spaces,
                node->typeinfo,node->typeinfo);
  if (node->typeinfo2)
    printf("%.*stypeinfo2: %08X (%d)\n",level*3,spaces,
                node->typeinfo2,node->typeinfo2);
  if (node->default_value)
    printf("%.*sdefault_value: %08X (%d)\n",level*3,spaces,
                node->default_value,node->default_value);

  for (i=0;i<4;i++)
    if (node->fill1[i]) {
      printf("%.*s*** fill1[] ",level*3,spaces);
      for (i=3; i >= 0;i--)
        printf("%02x",node->fill1[i]);
      printf("\n");
      i = 5;
      };
  for (i=0;i<2;i++)
    if (node->fill2[i]) {
      printf("%.*s*** fill2[] ",level*3,spaces);
      for (i=1; i >= 0;i--)
        printf("%02x",node->fill2[i]);
      printf("\n");
      i = 3;
      };
  for (i=0;i<34;i++)
    if (node->fill3[i]) {
      printf("%.*s*** fill3[] ",level*3,spaces);
      for (i=33; i >= 0;i--)
        printf("%02x",node->fill3[i]);
      printf("\n");
      i = 35;
      };
  for (i=0;i<2;i++)
    if (node->fill4[i]) {
      printf("%.*s*** fill4[] ",level*3,spaces);
      for (i=1; i >= 0;i--)
        printf("%02x",node->fill4[i]);
      printf("\n");
      };
}
$EOD
$ create/log UNSDL.C
$DECK
/* Version 1.1, March 11, 1988
   This program provides an alterative to SDL/NOPARSE command - all
   it does is set up a symbol to allow passing additional info
   to the language module, then it uses lib$do_command to execute
   the appropriate  SDL/NOPARSE command. See UNSDL.CLD for command
   definition.

   Modified command - now looks like:
     UNSDL InputFile/LANGUAGE=language=modifiers/OUTPUT=filename
   "modifiers" is then put into a symbol, and the language module is
   expected to deal with it any way it likes.
*/
#include <descrip.h>
#include <jpidef.h>
#include "sdldef.h"

main()
{
  static struct dsc$descriptor string = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
  static struct dsc$descriptor command = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
  static struct dsc$descriptor options = {0,DSC$K_DTYPE_T,DSC$K_CLASS_D,0};
  static long int imagecount;
  static struct dsc$descriptor imagecnt =
           {4,DSC$K_DTYPE_T,DSC$K_CLASS_S,&imagecount};
  struct itmlst jpi[2] = {{4,JPI$_IMAGECOUNT,&imagecount,0},{0,0,0,0}};
  char *ptr;
  int status,i,j;

  status = cli_get_value("language",&string);
  if (!(status & 1)) return(status);

  /* pull the string apart = i.e. if it is CC=(a,b,c) change it to
     CC, and put (a,b,c) into a symbol (defined in sdldef.h) */
  ptr = string.dsc$a_pointer;
  for (i=0; i<string.dsc$w_length;i++,ptr++)
    if ((*ptr == '=') || (*ptr == ':')) {
      /* get the image count */
      status = sys$getjpiw(0,0,0,&jpi,0,0,0);
      if (!(status & 1)) return(status);

      j = i + 2;
      str$right(&options,&string,&j);
      str$left(&string,&string,&i);
      i = string.dsc$w_length; /* force exit out of the for loop */

      str$concat(&options,&imagecnt,&options);

      status = lib_set_symbol(SDL_SYMBOL,&options);
      if (!(status & 1)) return(status);


    };

  str_append(&command,"SDL/NOPARSE/LANGUAGE=");
  str$append(&command,&string);

  if (cli_present("output") & 1) {
    status = cli_get_value("output",&string);
    if ((status & 1) && string.dsc$w_length) {
      str_append(&command,"=");
      str$append(&command,&string);
    };
  };

  status = cli_get_value("infile",&string);
  if (!(status & 1))
    return(status);
  str_append(&command," ");
  str$append(&command,&string);

  status = lib$do_command(&command);
  if (!(status & 1)) return(status);
} /* end of main */
$EOD
$ create/log UNSDL.CLD
$DECK
define verb UNSDL
   image unsdl
   parameter P1 , label=INFILE , prompt="File"  ! this is the .SDI file
      value (required)
   qualifier LANGUAGE   ! i.e. CC for the SDLCC module
      nonnegatable
      value (required)
   qualifier OUTPUT     ! name of an output file, if not given defaults
      default           ! to name of input file with filetype added at end
      value (type=$outfile)     ! i.e. .H for CC module
$EOD

