Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | RSS feed
/*
Crown Copyright (c) 1997
This TenDRA(r) Computer Program is subject to Copyright
owned by the United Kingdom Secretary of State for Defence
acting through the Defence Evaluation and Research Agency
(DERA). It is made available to Recipients with a
royalty-free licence for its use, reproduction, transfer
to other parties and amendment for any purpose not excluding
product development provided that any such use et cetera
shall be deemed to be acceptance of the following conditions:-
(1) Its Recipients shall ensure that this Notice is
reproduced upon any copies or amended versions of it;
(2) Any amended version of it shall be clearly marked to
show both the nature of and the organisation responsible
for the relevant amendment or amendments;
(3) Its onward transfer from a recipient to another
party shall be deemed to be that party's acceptance of
these conditions;
(4) DERA gives no warranty or assurance as to its
quality or suitability for any purpose and DERA accepts
no liability whatsoever in relation to any use to which
it may be put.
*/
#include "config.h"
#include <ctype.h>
#include "types.h"
#include "file.h"
#include "high.h"
#include "names.h"
#include "node.h"
#include "shape.h"
#include "table.h"
#include "tdf.h"
#include "utility.h"
#include "write.h"
/*
FLAGS CONTROLLING OUTPUT OF TOKENS ETC
The output is in the fully expanded form if verbose is true. The
shape of each expression is printed if print_shapes is true. The
flag func_output controls whether the output should be lisp-like
(default) or c-like.
*/
boolean verbose = 0 ;
boolean print_shapes = 0 ;
boolean func_output = 0 ;
/*
PRINT A NUMBER OF SPACES
An indentation of d spaces is printed to the output file.
*/
void print_spaces
PROTO_N ( ( d ) )
PROTO_T ( int d )
{
int n = 2 * d ;
while ( n >= 8 ) {
IGNORE fputc ( '\t', output ) ;
n -= 8 ;
}
while ( n ) {
IGNORE fputc ( ' ', output ) ;
n-- ;
}
return ;
}
/*
PRINT A NODE
The node p is printed to the output file with an indentation of
d spaces.
*/
static boolean print_node
PROTO_N ( ( p, d ) )
PROTO_T ( node *p X int d )
{
boolean negate = 0 ;
boolean newline = 0 ;
while ( p ) {
construct *q = p->cons ;
sortname s = q->sortnum ;
long m = q->encoding ;
newline = 0 ;
switch ( s ) {
case SORT_tdfbool : {
/* Set neg for subsequent number */
negate = ( boolean ) ( m ? 1 : 0 ) ;
break ;
}
case SORT_bytestream : {
/* Print a bytestream */
newline = print_node ( p->son, d ) ;
break ;
}
case SORT_completion : {
/* Print a completion */
newline = print_node ( p->son, d ) ;
break ;
}
case SORT_small_tdfint : {
/* Print a small number */
long n = q->encoding ;
print_spaces ( d ) ;
if ( negate ) n = -n ;
IGNORE fprintf ( output, "%ld", n ) ;
negate = 0 ;
newline = 1 ;
break ;
}
case SORT_tdfint : {
/* Print a number */
char *num = q->name ;
print_spaces ( d ) ;
if ( fits_ulong ( num, 0 ) ) {
unsigned long n = octal_to_ulong ( num ) ;
if ( negate && n ) IGNORE fputc ( '-', output ) ;
IGNORE fprintf ( output, "%lu", n ) ;
} else {
if ( negate ) IGNORE fputc ( '-', output ) ;
IGNORE fprintf ( output, "0%s", num ) ;
}
negate = 0 ;
newline = 1 ;
break ;
}
case SORT_option : {
/* Print an optional argument */
if ( p->son ) {
newline = print_node ( p->son, d ) ;
} else {
print_spaces ( d ) ;
IGNORE fputc ( '-', output ) ;
newline = 1 ;
}
break ;
}
case SORT_repeat : {
/* Print a repeated argument */
if ( m == 0 ) {
print_spaces ( d ) ;
IGNORE fputc ( '|', output ) ;
newline = 1 ;
} else {
newline = print_node ( p->son, d ) ;
if ( func_output ) IGNORE fputc ( ',', output ) ;
IGNORE fputs ( " |", output ) ;
}
break ;
}
case SORT_tdfstring : {
/* Print a string */
int i, n = ( int ) m ;
print_spaces ( d ) ;
if ( n == -1 ) {
char *f = ( func_output ? "%s (\n" : "( %s\n" ) ;
IGNORE fprintf ( output, f, MAKE_STRING ) ;
newline = print_node ( p->son, d + 1 ) ;
IGNORE fputs ( " )", output ) ;
} else {
IGNORE fputc ( '"', output ) ;
for ( i = 0 ; i < n ; i++ ) {
int c = ( ( q->name [i] ) & 0xff ) ;
if ( isprint ( c ) ) {
if ( c == '\\' || c == '"' ) {
IGNORE fputc ( '\\', output ) ;
}
IGNORE fputc ( c, output ) ;
} else {
if ( c == '\n' ) {
IGNORE fputs ( "\\n", output ) ;
} else if ( c == '\t' ) {
IGNORE fputs ( "\\t", output ) ;
} else {
unsigned co = ( unsigned ) c ;
IGNORE fprintf ( output, "\\%03o", co ) ;
}
}
}
IGNORE fputc ( '"', output ) ;
newline = 1 ;
}
break ;
}
case SORT_nat : {
/* Print a nat */
if ( m != ENC_make_nat ) goto default_label ;
newline = print_node ( p->son, d ) ;
break ;
}
case SORT_signed_nat : {
/* Print a signed_nat */
if ( m != ENC_make_signed_nat ) goto default_label ;
newline = print_node ( p->son, d ) ;
break ;
}
case SORT_string : {
/* Print a string */
if ( m != ENC_make_string ) goto default_label ;
newline = print_node ( p->son, d ) ;
break ;
}
case SORT_al_tag : {
/* Print an alignment tag */
if ( verbose || m != ENC_make_al_tag || p->son == null ) {
goto default_label ;
}
newline = print_node ( p->son, d ) ;
break ;
}
case SORT_label : {
/* Print a label */
if ( verbose || m != ENC_make_label || p->son == null ) {
goto default_label ;
}
newline = print_node ( p->son, d ) ;
break ;
}
case SORT_tag : {
/* Print a tag */
if ( verbose || m != ENC_make_tag || p->son == null ) {
goto default_label ;
}
newline = print_node ( p->son, d ) ;
break ;
}
case SORT_exp : {
static node special_node ;
if ( print_shapes && p->shape != &special_node ) {
/* Change exp to show shape */
node *z = new_node () ;
z->cons = &exp_shape ;
z->bro = p->bro ;
z->son = p ;
if ( p->shape ) {
z->son->bro = copy_node ( p->shape ) ;
} else {
z->son->bro = new_node () ;
z->son->bro->cons = &unknown_cons ;
}
p->shape = &special_node ;
p = z ;
q = p->cons ;
m = q->encoding ;
}
goto default_label ;
}
default : {
/* Print a simple sort */
default_label : {
if ( !verbose && m == sort_tokens [s] && p->son &&
p->son->cons->sortnum == SORT_token ) {
newline = print_node ( p->son, d ) ;
} else {
print_spaces ( d ) ;
if ( p->son ) {
char *f = ( func_output ? "%s (\n" : "( %s\n" ) ;
IGNORE fprintf ( output, f, q->name ) ;
newline = print_node ( p->son, d + 1 ) ;
IGNORE fputs ( " )", output ) ;
} else {
IGNORE fprintf ( output, "%s", q->name ) ;
newline = 1 ;
}
}
}
break ;
}
}
p = p->bro ;
if ( newline && p ) {
if ( func_output ) IGNORE fputc ( ',', output ) ;
IGNORE fputc ( '\n', output ) ;
newline = 0 ;
}
}
return ( newline ) ;
}
/*
PRINT AN EXTERNAL NAME
The start of a statement with name title concerning the construct
p is output. dec is true if this is the first statement concerning p.
*/
static void print_name
PROTO_N ( ( title, p, dec ) )
PROTO_T ( char *title X construct *p X int dec )
{
if ( !func_output ) IGNORE fputs ( "( ", output ) ;
if ( p->ename == null ) IGNORE fprintf ( output, "%s ", LOCAL_DECL ) ;
IGNORE fprintf ( output, "%s", title ) ;
if ( func_output ) IGNORE fputs ( " (", output ) ;
if ( p->ename && p->ename->cons->encoding && dec ) {
char *f = ( func_output ? "\n %s (\n" : "\n ( %s\n" ) ;
if ( p->ename->son->cons->sortnum == SORT_tdfstring ) {
if ( p->ename->son->bro == null ) {
IGNORE fprintf ( output, f, MAKE_STRING_EXTERN ) ;
} else {
IGNORE fprintf ( output, f, MAKE_CHAIN_EXTERN ) ;
}
} else {
IGNORE fprintf ( output, f, MAKE_UNIQUE_EXTERN ) ;
}
IGNORE print_node ( p->ename->son, 2 ) ;
if ( func_output ) {
IGNORE fputs ( " ),\n ", output ) ;
} else {
IGNORE fputs ( " )\n ", output ) ;
}
} else {
IGNORE fputc ( ' ', output ) ;
}
IGNORE fprintf ( output, "%s", p->name ) ;
return ;
}
/*
ALIGNMENT TAG DECLARATION AUXILIARY PRINTING ROUTINE
Print the declaration of the alignment tag p.
*/
static void print_aldec
PROTO_N ( ( p ) )
PROTO_T ( construct *p )
{
if ( p->encoding == -1 ) return ;
print_name ( MAKE_ALDEC, p, 1 ) ;
IGNORE fputs ( ( func_output ? " ) ;\n\n" : " )\n\n" ), output ) ;
return ;
}
/*
ALIGNMENT TAG DEFINITION AUXILIARY PRINTING ROUTINE
Print the definition of the alignment tag p.
*/
static void print_aldef
PROTO_N ( ( p ) )
PROTO_T ( construct *p )
{
al_tag_info *info = get_al_tag_info ( p ) ;
if ( p->encoding == -1 ) return ;
if ( info->def == null ) return ;
print_name ( MAKE_ALDEF, p, !show_aldecs ) ;
if ( func_output ) IGNORE fputc ( ',', output ) ;
IGNORE fputc ( '\n', output ) ;
IGNORE print_node ( info->def, 1 ) ;
IGNORE fputs ( ( func_output ? " ) ;\n\n" : " )\n\n" ), output ) ;
return ;
}
/*
TAG DECLARATION AUXILIARY PRINTING ROUTINE
Print the declaration of the tag p.
*/
static void print_tagdec
PROTO_N ( ( p ) )
PROTO_T ( construct *p )
{
tag_info *info = get_tag_info ( p ) ;
if ( p->encoding == -1 || info->dec == null ) return ;
switch ( info->var ) {
case 0 : print_name ( MAKE_ID_TAGDEC, p, 1 ) ; break ;
case 1 : print_name ( MAKE_VAR_TAGDEC, p, 1 ) ; break ;
case 2 : print_name ( COMMON_TAGDEC, p, 1 ) ; break ;
}
if ( func_output ) IGNORE fputc ( ',', output ) ;
IGNORE fputc ( '\n', output ) ;
IGNORE print_node ( info->dec, 1 ) ;
IGNORE fputs ( ( func_output ? " ) ;\n\n" : " )\n\n" ), output ) ;
return ;
}
/*
TAG DEFINITION AUXILIARY PRINTING ROUTINE
Print the definition of the tag p.
*/
static void print_tagdef
PROTO_N ( ( p ) )
PROTO_T ( construct *p )
{
char *instr ;
tag_info *info = get_tag_info ( p ) ;
node *d = info->def ;
if ( p->encoding == -1 || d == null ) return ;
switch ( info->var ) EXHAUSTIVE {
case 0 : instr = MAKE_ID_TAGDEF ; break ;
case 1 : instr = MAKE_VAR_TAGDEF ; break ;
case 2 : instr = COMMON_TAGDEF ; break ;
}
while ( d ) {
/* Can have multiple definitions */
print_name ( instr, p, !show_tagdecs ) ;
if ( func_output ) IGNORE fputc ( ',', output ) ;
IGNORE fputc ( '\n', output ) ;
IGNORE print_node ( d->son, 1 ) ;
IGNORE fputs ( ( func_output ? " ) ;\n\n" : " )\n\n" ), output ) ;
d = d->bro ;
}
return ;
}
/*
TOKEN DECLARATION AUXILIARY PRINTING ROUTINE
Print the declaration of the token p.
*/
static void print_tokdec
PROTO_N ( ( p ) )
PROTO_T ( construct *p )
{
tok_info *info = get_tok_info ( p ) ;
if ( p->encoding == -1 ) return ;
if ( !info->dec ) return ;
print_name ( MAKE_TOKDEC, p, 1 ) ;
if ( func_output ) IGNORE fputc ( ',', output ) ;
IGNORE fputc ( '\n', output ) ;
if ( info->sig ) {
IGNORE print_node ( info->sig, 1 ) ;
} else {
print_spaces ( 1 ) ;
IGNORE fputc ( '-', output ) ;
}
if ( func_output ) IGNORE fputc ( ',', output ) ;
IGNORE fputs ( "\n ", output ) ;
if ( info->args ) {
int n = 0 ;
char *q = info->args ;
IGNORE fputs ( "( ", output ) ;
while ( *q ) {
sortname s ;
q = find_sortname ( q, &s ) ;
q++ ;
if ( n++ == 8 ) {
IGNORE fputs ( "\n ", output ) ;
n = 1 ;
}
IGNORE fputs ( sort_name ( s ), output ) ;
if ( func_output && *q ) IGNORE fputc ( ',', output ) ;
IGNORE fputc ( ' ', output ) ;
}
IGNORE fputs ( ") ", output ) ;
if ( func_output ) IGNORE fputs ( "-> ", output ) ;
}
IGNORE fputs ( sort_name ( info->res ), output ) ;
IGNORE fputs ( ( func_output ? " ) ;\n\n" : " )\n\n" ), output ) ;
return ;
}
/*
TOKEN DEFINITION AUXILIARY PRINTING ROUTINE
Print the definition of the token p.
*/
static void print_tokdef
PROTO_N ( ( p ) )
PROTO_T ( construct *p )
{
tok_info *info = get_tok_info ( p ) ;
if ( p->encoding == -1 ) return ;
if ( !info->dec ) return ;
if ( info->def == null ) return ;
print_name ( MAKE_TOKDEF, p, !show_tagdefs ) ;
if ( func_output ) IGNORE fputc ( ',', output ) ;
IGNORE fputc ( '\n', output ) ;
if ( info->sig ) {
IGNORE print_node ( info->sig, 1 ) ;
} else {
print_spaces ( 1 ) ;
IGNORE fputc ( '-', output ) ;
}
if ( func_output ) IGNORE fputc ( ',', output ) ;
IGNORE fputs ( "\n ", output ) ;
if ( info->args ) {
int n = 0 ;
construct **q = info->pars ;
IGNORE fputs ( "( ", output ) ;
while ( *q ) {
tok_info *qinfo = get_tok_info ( *q ) ;
if ( n++ == 4 ) {
IGNORE fputs ( "\n ", output ) ;
n = 1 ;
}
IGNORE fprintf ( output, "%s %s", sort_name ( qinfo->res ),
( *q )->name ) ;
q++ ;
if ( func_output && *q ) IGNORE fputc ( ',', output ) ;
IGNORE fputc ( ' ', output ) ;
}
IGNORE fputs ( ") ", output ) ;
if ( func_output ) IGNORE fputs ( "-> ", output ) ;
}
IGNORE fputs ( sort_name ( info->res ), output ) ;
if ( func_output ) IGNORE fputc ( ',', output ) ;
IGNORE fputc ( '\n', output ) ;
IGNORE print_node ( info->def, 1 ) ;
IGNORE fputs ( ( func_output ? " ) ;\n\n" : " )\n\n" ), output ) ;
return ;
}
/*
PRINT A HIGH-LEVEL SORT
This routine prints the high level sort h.
*/
static void print_high_sort
PROTO_N ( ( h ) )
PROTO_T ( high_sort *h )
{
int i, n ;
if ( h->id == SORT_unknown ) return ;
if ( func_output ) {
IGNORE fprintf ( output, "%s ( %s, ", MAKE_SORT, h->name ) ;
} else {
IGNORE fprintf ( output, "( %s %s ", MAKE_SORT, h->name ) ;
}
n = h->no_args ;
if ( n ) {
int m = 0 ;
IGNORE fputs ( "( ", output ) ;
for ( i = 0 ; i < n ; i++ ) {
if ( m++ == 8 ) {
IGNORE fputs ( "\n ", output ) ;
m = 1 ;
}
IGNORE fputs ( sort_name ( h->args [i] ), output ) ;
if ( func_output && i < n - 1 ) IGNORE fputc ( ',', output ) ;
IGNORE fputc ( ' ', output ) ;
}
IGNORE fputs ( ") ", output ) ;
if ( func_output ) IGNORE fputs ( "-> ", output ) ;
}
IGNORE fputs ( sort_name ( h->res ), output ) ;
IGNORE fputs ( ( func_output ? " ) ;\n\n" : " )\n\n" ), output ) ;
return ;
}
/*
MAIN PRINTING ROUTINE
This routine prints an entire capsule to the output file.
*/
void print_capsule
PROTO_Z ()
{
if ( high_sorts ) {
int i ;
IGNORE fputs ( "# HIGH-LEVEL SORTS\n\n", output ) ;
for ( i = 0 ; i < crt_high_sort ; i++ ) {
print_high_sort ( high_sorts + i ) ;
}
IGNORE fputc ( '\n', output ) ;
}
if ( show_tokdecs ) {
IGNORE fputs ( "# TOKEN DECLARATIONS\n\n", output ) ;
apply_to_all ( print_tokdec, SORT_token ) ;
IGNORE fputc ( '\n', output ) ;
}
if ( show_aldecs ) {
IGNORE fputs ( "# ALIGNMENT TAG DECLARATIONS\n\n", output ) ;
apply_to_all ( print_aldec, SORT_al_tag ) ;
IGNORE fputc ( '\n', output ) ;
}
if ( show_tagdecs ) {
IGNORE fputs ( "# TAG DECLARATIONS\n\n", output ) ;
apply_to_all ( print_tagdec, SORT_tag ) ;
IGNORE fputc ( '\n', output ) ;
}
if ( show_tokdefs ) {
IGNORE fputs ( "# TOKEN DEFINITIONS\n\n", output ) ;
apply_to_all ( print_tokdef, SORT_token ) ;
IGNORE fputc ( '\n', output ) ;
}
if ( show_aldefs ) {
IGNORE fputs ( "# ALIGNMENT TAG DEFINITIONS\n\n", output ) ;
apply_to_all ( print_aldef, SORT_al_tag ) ;
IGNORE fputc ( '\n', output ) ;
}
if ( show_tagdefs ) {
IGNORE fputs ( "# TAG DEFINITIONS\n\n", output ) ;
apply_to_all ( print_tagdef, SORT_tag ) ;
IGNORE fputc ( '\n', output ) ;
}
return ;
}