← Back to branch summary

~burner/xsb/debianized-xsb

« back to all changes in this revision

Viewing changes to emu/dis.c

  • Committer: Michael R. Head
  • Date: 2006-09-06 22:11:55 UTC
  • Revision ID: burner@n23-20060906221155-7e398d23438a7ee4
Add the files from the 3.0.1 release package

Show diffs side-by-side

added added

removed removed

Lines of Context:
emu/dis.c
 
1
/* File:      dis.c
 
2
** Author(s): Warren, Swift, Xu, Sagonas
 
3
** Contact:   xsb-contact@cs.sunysb.edu
 
4
** 
 
5
** Copyright (C) The Research Foundation of SUNY, 1986, 1993-1998
 
6
** Copyright (C) ECRC, Germany, 1990
 
7
** 
 
8
** XSB is free software; you can redistribute it and/or modify it under the
 
9
** terms of the GNU Library General Public License as published by the Free
 
10
** Software Foundation; either version 2 of the License, or (at your option)
 
11
** any later version.
 
12
** 
 
13
** XSB is distributed in the hope that it will be useful, but WITHOUT ANY
 
14
** WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
 
15
** FOR A PARTICULAR PURPOSE.  See the GNU Library General Public License for
 
16
** more details.
 
17
** 
 
18
** You should have received a copy of the GNU Library General Public License
 
19
** along with XSB; if not, write to the Free Software Foundation,
 
20
** Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 
21
**
 
22
** $Id: dis.c,v 1.29 2006/07/14 16:49:36 tswift Exp $
 
23
** 
 
24
*/
 
25
 
 
26
 
 
27
#include "xsb_config.h"
 
28
#include "xsb_debug.h"
 
29
 
 
30
#include <stdio.h>
 
31
#include <string.h>
 
32
 
 
33
#include "auxlry.h"
 
34
#include "context.h"
 
35
#include "psc_xsb.h"
 
36
#include "hash_xsb.h"
 
37
#include "loader_xsb.h"
 
38
#include "cell_xsb.h"
 
39
#include "inst_xsb.h"
 
40
#include "builtin.h"
 
41
#include "memory_xsb.h"
 
42
#include "flags_xsb.h"
 
43
#include "tries.h"
 
44
#include "macro_xsb.h"
 
45
 
 
46
/* --------------- The following are working variables ---------------- */
 
47
 
 
48
extern Cell builtin_table[BUILTIN_TBL_SZ][2];
 
49
extern TIFptr get_tip_or_tdisp(Psc);
 
50
 
 
51
/* Include these so that the Gnu C Compiler does not complain */
 
52
void dis_data(FILE *);
 
53
void dis_text(FILE *);
 
54
static void dis_data_sub(FILE *, Pair *, char *);
 
55
 
 
56
void dis(xsbBool distext)
 
57
{  
 
58
  FILE *filedes ;
 
59
 
 
60
   filedes = fopen("stdout","w"); 
 
61
   dis_data(filedes);
 
62
   if (distext) dis_text(filedes);
 
63
   fflush(filedes);
 
64
   fclose(filedes); 
 
65
}
 
66
 
 
67
void dis_data(FILE *filedes)
 
68
{
 
69
        int i;
 
70
        Pair *temp_ptr;
 
71
        Psc psc_ptr;
 
72
        char *modname;
 
73
 
 
74
        temp_ptr = (Pair *)(&flags[MOD_LIST]);
 
75
        while(*temp_ptr) {
 
76
           psc_ptr = (*temp_ptr)->psc_ptr;
 
77
           modname = get_name(psc_ptr);
 
78
           if (get_type(psc_ptr))       /* 00000100 */
 
79
             fprintf(filedes, "module('%s',loaded).\n",modname);
 
80
           else 
 
81
             fprintf(filedes, "module('%s', unloaded).\n", modname);
 
82
           if (strcmp(modname,"global")==0)
 
83
                for(i=0; i < (int)symbol_table.size; i++) {
 
84
                  if ( symbol_table.table[i] ) {
 
85
/*                  fprintf(filedes, "... ... BUCKET NO. %d\n", i); */
 
86
                    dis_data_sub(filedes, (Pair *)(symbol_table.table + i),modname);
 
87
                  }
 
88
                }
 
89
           else if (strcmp(modname,"usermod")==0) 
 
90
             fprintf(filedes, "equiv(usermod,global).\n");
 
91
           else 
 
92
             dis_data_sub(filedes, (Pair *)&get_data(psc_ptr),modname);
 
93
           fprintf(filedes, "\n");
 
94
           temp_ptr = &((*temp_ptr)->next);
 
95
        }
 
96
}
 
97
 
 
98
static void dis_data_sub(FILE *filedes, Pair *chain_ptr, char* modname)
 
99
{
 
100
   Psc temp;
 
101
 
 
102
   while (*chain_ptr) {
 
103
        temp = (*chain_ptr)->psc_ptr;
 
104
        fprintf(filedes,"entry('%s',",modname);
 
105
        fprintf(filedes, "%p,", temp);
 
106
        fflush(filedes);
 
107
        fprintf(filedes, "'%s'", get_name(temp));
 
108
        fprintf(filedes, "/%d,", get_arity(temp));
 
109
        switch(get_type(temp)) {
 
110
            case T_PRED: fprintf(filedes, "'PRED',"); break;
 
111
            case T_DYNA: fprintf(filedes, "'DYNA',"); break;
 
112
            case T_ORDI: fprintf(filedes, "'ORDI',"); break;
 
113
              //            case T_FILE: fprintf(filedes, "'FILE',"); break;
 
114
            case T_MODU: fprintf(filedes, "'MODU',"); break;
 
115
            case T_FORN: fprintf(filedes, "'FORN',"); break;
 
116
            case T_UDEF: fprintf(filedes, "'UDEF',"); break;
 
117
            default:     fprintf(filedes, "\'????\',"); break;
 
118
        }
 
119
        switch(get_env(temp)) {
 
120
            case T_VISIBLE:  fprintf(filedes, "'VISIBLE',"); break;
 
121
            case T_HIDDEN:   fprintf(filedes, "'HIDDEN',"); break;
 
122
            case T_UNLOADED: fprintf(filedes, "'UNLOADED',"); break;
 
123
            default:         fprintf(filedes, "error_env,"); break;
 
124
        }
 
125
        // TLS: should T_DYNA be checked, also???
 
126
        if (get_type(temp) == T_PRED) {
 
127
          if (get_tip_or_tdisp(temp) == NULL) 
 
128
            fprintf(filedes, "'UNTABLED',"); 
 
129
          else 
 
130
            fprintf(filedes, "'TABLED',");
 
131
        } else
 
132
          fprintf(filedes, "'n/a',");
 
133
        fprintf(filedes, "%p).\n", get_ep(temp));  /* dsw ???? */
 
134
        chain_ptr = &((*chain_ptr)->next);
 
135
   } /* while */
 
136
}
 
137
 
 
138
CPtr print_inst(FILE *fd, CPtr inst_ptr)
 
139
{
 
140
    Cell instr ;
 
141
    CPtr loc_pcreg ;
 
142
    int i,a;
 
143
    Psc psc;
 
144
 
 
145
    loc_pcreg = (CPtr) inst_ptr;
 
146
    fprintf(fd,"     inst("),
 
147
    fprintf(fd,"%p, ", loc_pcreg);
 
148
    instr = cell(loc_pcreg++) ;
 
149
/* We want the instruction string printed out below.  
 
150
 * Someday we should ANSI-fy it. 
 
151
 */
 
152
    fprintf(fd, "%s",(char *)inst_table[cell_opcode(&instr)][0]);
 
153
    a = 1 ; /* current operand */
 
154
    for (i=1; i<=4; i++) {
 
155
        switch (inst_table[cell_opcode(&instr)][i]) {
 
156
         case A:
 
157
           if (cell_opcode(&instr) == (byte) builtin) {
 
158
             a++;
 
159
             fprintf(fd, ", '%d'", cell_operand3(&instr));
 
160
             fprintf(fd, ", %s", 
 
161
                     (char *)builtin_table[cell_operand3(&instr)][0]);
 
162
           } else 
 
163
             fprintf(fd, ", %d", cell_operandn(&instr,a++));
 
164
           break;
 
165
         case V:
 
166
           fprintf(fd, ", %d", cell_operandn(&instr,a++));
 
167
           break;
 
168
         case R:
 
169
           fprintf(fd, ", r%d", cell_operandn(&instr,a++));
 
170
           break;
 
171
         case T:
 
172
           fprintf(fd, ", %lx", cell(loc_pcreg++));
 
173
           break;
 
174
         case P:
 
175
           a++;
 
176
           break;
 
177
         case S:
 
178
           if (cell_opcode(&instr) == (byte) call ||
 
179
               cell_opcode(&instr) == (byte) xsb_execute) {
 
180
             fprintf(fd, ", 0x%lx", *loc_pcreg);
 
181
             psc = (Psc) cell(loc_pcreg++);
 
182
             fprintf(fd,", '%s'/%d", get_name(psc), get_arity(psc));
 
183
           }
 
184
           else
 
185
             fprintf(fd, ", 0x%lx", cell(loc_pcreg++));
 
186
           break;
 
187
         case C:
 
188
         case L:
 
189
         case G:
 
190
           fprintf(fd, ", 0x%lx", cell(loc_pcreg++));
 
191
           break;
 
192
         case I:
 
193
         case N:
 
194
           fprintf(fd, ", %ld", cell(loc_pcreg++));
 
195
           break;
 
196
         case B:
 
197
           fprintf(fd, ", %ld", (long) int_val(cell(loc_pcreg)));
 
198
           loc_pcreg++;
 
199
           break;
 
200
         case F:
 
201
           fprintf(fd, ", %f", ofloat_val(cell(loc_pcreg)));
 
202
           loc_pcreg++;
 
203
           break;
 
204
         case PP:
 
205
           a += 2;
 
206
           break;
 
207
         case PPP:
 
208
           break;
 
209
         case PPR:
 
210
           fprintf(fd, ", r%d", cell_operand3(&instr));
 
211
           break;
 
212
         case RRR:
 
213
           fprintf(fd, ", r%d", cell_operand1(&instr));
 
214
           fprintf(fd, ", r%d", cell_operand2(&instr));
 
215
           fprintf(fd, ", r%d", cell_operand3(&instr));
 
216
           break;
 
217
         case X:
 
218
           break;
 
219
         default:
 
220
           break;
 
221
        }  /* switch */
 
222
        /*if (cell_opcode(&instr) == noop) loc_pcreg += 2 * *(loc_pcreg-1); */
 
223
        if (cell_opcode(&instr) == noop) loc_pcreg += cell_operand3(&instr)/2; /* ?!@% */
 
224
        else if (cell_opcode(&instr) == dynnoop) loc_pcreg += cell_operand3(&instr)/2; /* ?!@% */
 
225
    } /* for */
 
226
    fprintf(fd, ")");
 
227
    fflush(fd);
 
228
    return loc_pcreg;
 
229
} /* print_inst */
 
230
 
 
231
 
 
232
void dis_text(FILE * filedes)
 
233
{
 
234
   pseg   this_seg;
 
235
   pindex index_seg ;
 
236
   CPtr   endaddr, inst_addr2 ;
 
237
   int comma;
 
238
 
 
239
   fprintf(filedes, "\n/*text below\t\t*/\n\n");
 
240
   this_seg = (pseg) inst_begin_gl;
 
241
   while (this_seg) {           /* repeat for all text segment */
 
242
      fprintf(filedes, "segment([\n");
 
243
      endaddr = (CPtr) ((pb) seg_hdr(this_seg) + seg_size(this_seg)) ;
 
244
      inst_addr2 = seg_text(this_seg);
 
245
      comma = 0;
 
246
      while (inst_addr2<endaddr) {
 
247
        if (comma) 
 
248
          fprintf(filedes,", \n");
 
249
        comma = 1;
 
250
        inst_addr2 = print_inst(filedes, inst_addr2);
 
251
      }
 
252
      index_seg = seg_index(this_seg);
 
253
      while (index_seg) {
 
254
        inst_addr2 = i_block(index_seg);
 
255
        endaddr = (CPtr)((pb)index_seg + i_size(index_seg));
 
256
        if (cell_opcode(i_block(index_seg)) == try ||
 
257
            cell_opcode(i_block(index_seg)) == tabletry ||
 
258
            cell_opcode(i_block(index_seg)) == tabletrysingle) {        
 
259
                                                   /* is try/retry/trust */
 
260
          while (inst_addr2<endaddr) {
 
261
            if (comma) 
 
262
              fprintf(filedes,", \n");
 
263
            comma = 1;
 
264
            inst_addr2 = print_inst(filedes, inst_addr2);
 
265
          }
 
266
        } else {                                        /* is hash table */
 
267
          if (comma) 
 
268
            fprintf(filedes,", \n");
 
269
          fprintf(filedes, "     hash_table([\n");
 
270
          comma = 0;
 
271
          while (inst_addr2<endaddr) {
 
272
            if (comma) {
 
273
              fprintf(filedes, ", \n");
 
274
            }
 
275
            comma = 1;
 
276
            fprintf(filedes, 
 
277
                    "          hash_entry(%p,%lx)", 
 
278
                    inst_addr2, 
 
279
                    cell(inst_addr2));
 
280
            inst_addr2 ++;
 
281
          }
 
282
          fprintf(filedes, "])");
 
283
        }
 
284
        index_seg = i_next(index_seg);
 
285
      }
 
286
      fprintf(filedes, "]).\n");
 
287
      this_seg = seg_next(this_seg);
 
288
   }  
 
289
}