/*
This file is part of the FElt finite element analysis package.
Copyright (C) 1993-2000 Jason I. Gobat and Darren C. Atkinson
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
*/
/************************************************************************
* File: control.c *
* *
* Description: This file contains the function definitions for the *
* control flow related virtual machine instructions. *
************************************************************************/
# include "debug.h"
# include "coerce.h"
# include "execute.h"
# include "control.h"
/************************************************************************
* Function: fail_op *
* *
* Description: Pops and tests the descriptor on the top of the stack. *
* If the descriptor is zero then a null descriptor is *
* pushed on the stack and control is transferred to the *
* specified address. *
************************************************************************/
int fail_op ( )
{
Address offset;
descriptor *d;
d = pop ( );
d = CoerceData (deref (d), T_Double);
offset = fetch (pc ++).addr;
if (D_Type (d) != T_Double) {
TypeError ("in conditional context", d, NULL, NULL, F_False);
RecycleData (d);
return 1;
}
if (*D_Double (d) == 0) {
RecycleData (d);
pc += offset;
d = push ( );
D_Type (d) = T_Null;
D_Temp (d) = F_False;
D_Trapped (d) = F_False;
D_Pointer (d) = NULL;
} else
RecycleData (d);
return 0;
}
/************************************************************************
* Function: gen_op *
* *
* Description: Generates the next result in a sequence by examining *
* the three descriptors on the top of the stack. The *
* following generation sequences are possible, where a *
* vector is a matrix with a single row or column: *
* *
* scalar -> scalar (identity operation) *
* vector -> scalar (next scalar in vector) *
* matrix -> vector (next column vector in matrix) *
* array -> unknown (next element in array) *
* *
* An attempt is first made to coerce the sequence to a *
* double value. If all values have been generated then *
* the generator is popped from the stack and a null *
* descriptor is pushed on the stack as the result. *
************************************************************************/
int gen_op ( )
{
Matrix a;
Matrix b;
void *ptr;
descriptor *d;
descriptor *v;
descriptor *var;
descriptor *index;
descriptor *vector;
descriptor temp;
double value;
Address increment;
Array arr;
int fail;
unsigned offset;
unsigned i;
unsigned c;
unsigned r;
index = ntop (0);
vector = ntop (1);
var = ntop (2);
offset = fetch (pc ++).ival;
if (D_Type (index) == T_Double) {
if (!assignable (var)) {
TypeError ("cannot assign to", NULL, var, NULL, F_False);
return 1;
}
d = &temp;
D_Type (d) = T_Null;
D_Temp (d) = F_False;
D_Trapped (d) = F_False;
D_Pointer (d) = NULL;
v = CoerceData (vector, T_Double);
AssignData (d, &v);
RecycleData (v);
D_Temp (d) = F_False;
d_printf ("d = %s %p\n", D_TypeName (d), D_Pointer (d));
switch (D_Type (d)) {
case T_Double:
case T_Matrix:
case T_Array:
case T_Null:
break;
default:
TypeError ("cannot index", NULL, d, NULL, F_False);
return 1;
}
*vector = *d;
D_Type (index) = T_Row;
D_Row (index) = 0;
}
d_printf ("vector = %s %p\n", D_TypeName (vector), D_Pointer (vector));
var = deref (var);
fail = F_False;
switch (D_Type (vector)) {
case T_Double:
if (D_Row (index) ++ == 0)
AssignData (var, &vector);
else
fail = F_True;
break;
case T_Matrix:
a = D_Matrix (vector);
d = &temp;
D_Temp (d) = F_False;
D_Trapped (d) = F_False;
if (Mrows (a) == 1) {
if (++ D_Row (index) <= Mcols (a)) {
D_Type (d) = T_Double;
D_Double (d) = &value;
value = mdata (a, 1, D_Row (index));
AssignData (var, &d);
} else
fail = F_True;
} else if (Mcols (a) == 1) {
if (++ D_Row (index) <= Mrows (a)) {
D_Type (d) = T_Double;
D_Double (d) = &value;
value = mdata (a, D_Row (index), 1);
AssignData (var, &d);
} else
fail = F_True;
} else {
if (++ D_Row (index) <= Mcols (a)) {
d_printf ("indexing matrix\n");
r = Mrows (a);
c = D_Row (index);
FreeData (var);
CreateData (var, NULL, NULL, T_Matrix, r, 1);
D_Temp (var) = F_False;
b = D_Matrix (var);
for (i = 1; i <= r; i ++)
sdata (b, i, 1) = mdata (a, i, c);
} else
fail = F_True;
}
break;
case T_Array:
arr = D_Array (vector);
d = &temp;
if (++ D_Row (index) <= arr -> length) {
increment = D_Row (index) * arr -> elt_size;
ptr = (void *) ((char *) arr -> ptr + increment);
D_Type (d) = arr -> type;
D_Temp (d) = F_False;
D_Trapped (d) = F_False;
D_Pointer (d) = ptr;
AssignData (var, &d);
} else
fail = F_True;
break;
case T_Null:
fail = F_True;
break;
}
/* After assignment the variable is certainly not temporary. Its trapped
status remains as before: if it was trapped then AssignData() called
the trap handler which didn't change the status. If it wasn't then
AssignData() left the status alone. */
D_Temp (var) = F_False;
if (fail == F_True) {
pop ( );
FreeData (pop ( )); /* free the privately owned vector */
pop ( );
d = push ( );
D_Type (d) = T_Null;
D_Temp (d) = F_False;
D_Trapped (d) = F_False;
D_Pointer (d) = NULL;
pc += offset;
d_printf ("failing\n");
}
return 0;
}
/************************************************************************
* Function: halt_op *
* *
* Description: Halts execution. *
************************************************************************/
int halt_op ( )
{
return -1;
}
/************************************************************************
* Function: jmp_op *
* *
* Description: Transfers control to the specified address. *
************************************************************************/
int jmp_op ( )
{
Address offset;
offset = fetch (pc ++).addr;
pc += offset;
return 0;
}
/************************************************************************
* Function: jnz_op *
* *
* Descriptor: Pops and tests the descriptor on the top of the stack. *
* If the descriptor is nonzero then control is *
* transferred to the specified address. *
************************************************************************/
int jnz_op ( )
{
Address offset;
descriptor *d;
d = pop ( );
d = CoerceData (deref (d), T_Double);
offset = fetch (pc ++).addr;
if (D_Type (d) != T_Double) {
TypeError ("in conditional context", d, NULL, NULL, F_False);
RecycleData (d);
return 1;
}
if (*D_Double (d) != 0)
pc += offset;
RecycleData (d);
return 0;
}
/************************************************************************
* Function: jz_op *
* *
* Description: Pops and tests the descriptor on the top of the stack. *
* If the descriptor is zero then control is transferred *
* to the specified address. *
************************************************************************/
int jz_op ( )
{
Address offset;
descriptor *d;
d = pop ( );
d = CoerceData (deref (d), T_Double);
offset = fetch (pc ++).addr;
if (D_Type (d) != T_Double) {
TypeError ("in conditional context", d, NULL, NULL, F_False);
RecycleData (d);
return 1;
}
if (*D_Double (d) == 0)
pc += offset;
RecycleData (d);
return 0;
}
syntax highlighted by Code2HTML, v. 0.9.1