Alexander_KS/SAPFOR
4
2
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

fixed and improved SAPFOR and FDVM

Browse Source
This commit is contained in:
ALEXks
2023-12-27 12:57:00 +03:00
parent 752e9206db
commit 34f0214404
15 changed files with 109 additions and 35 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
dvm/fdvm/trunk/fdvm/dvm.cpp
View File

@@ -12668,6 +12668,7 @@ int DistrArrayAssign(SgStatement *stmt)
return(1);
left_whole = !le->lhs();
right_whole = !re->lhs();
CANCEL_RTS2_MODE; // switch to basic RTS interface
ChangeDistArrayRef(le->lhs()); //replacing dvm-array references in subscript list
ChangeDistArrayRef(re->lhs());
LINE_NUMBER_BEFORE(stmt,stmt);
@@ -12709,13 +12710,15 @@ int DistrArrayAssign(SgStatement *stmt)
doAssignStmtAfter(ArrayCopy(headr, from_init, from_init+rr, from_init+2*rr, headl, to_init, to_init+rl, to_init+2*rl, 0));
if(dvm_ind)
doCallAfter(DeleteObject_H(DVM000(dvm_ind)));
SET_DVM(to_init);
SET_DVM(to_init);
RESUMPTION_RTS2_MODE; // return to RTS2 interface
return(1);
}
// assignment statement of kind: <dvm_array_section> = <scalar_expression>
if(only_debug)
return(1);
CANCEL_RTS2_MODE; // switch to basic RTS interface
if(INTERFACE_RTS2 && !isWholeArray(stmt->expr(0)))
err("Illegal array statement in -Opl2 mode", 642, stmt);
@@ -12735,6 +12738,7 @@ int DistrArrayAssign(SgStatement *stmt)
else
doAssignStmtAfter(ArrayCopy(headr, to_init, to_init, to_init, headl, to_init, to_init+rl, to_init+2*rl, -1));
SET_DVM(to_init);
RESUMPTION_RTS2_MODE; // return to RTS2 interface
return(1);
}
@@ -12753,6 +12757,7 @@ int AssignDistrArray(SgStatement *stmt)
// assignment statement of kind: <array_section> = <dvm_array_section>
if(only_debug)
return(1);
CANCEL_RTS2_MODE; // switch to basic RTS interface
left_whole = !le->lhs();
right_whole = !re->lhs();
@@ -12781,8 +12786,10 @@ int AssignDistrArray(SgStatement *stmt)
typer = ar->type()->baseType();
rr = Rank(ar);
headr = HeaderRef(ar);
if(!headr) // if there is error of dvm-array specification, header is not created
if(!headr) { // if there is error of dvm-array specification, header is not created
RESUMPTION_RTS2_MODE; // return to RTS2 interface
return(0);
}
if(!CompareTypes(typel,typer))
err("Different types of left and right side",620,stmt);
@@ -12801,6 +12808,7 @@ int AssignDistrArray(SgStatement *stmt)
doCallAfter(DeleteObject_H(DVM000(dvm_ind)));
SET_DVM(dvm_ind ? dvm_ind : to_init) ; //SET_DVM(to_init);
RESUMPTION_RTS2_MODE; // return to RTS2 interface
return(1);
}

2
dvm/fdvm/trunk/include/dvm.h
View File

@@ -415,6 +415,8 @@ const int Logical_8 = 12;
#define HEDR(A) ((A)->thesymb->entry.Template.func_hedr)
#define FILE_LAST_STATEMENT(ST) ((SgStatement **)(ST)->attributeValue(0,LAST_STATEMENT))
#define CALLED_FUNCTIONS(ST) ((symb_list **)(ST)->attributeValue(0,RTC_CALLS))
#define INTERFACE_RTS2 (parloop_by_handler == 2)
#define CANCEL_RTS2_MODE if(parloop_by_handler == 2) parloop_by_handler = -1
#define RESUMPTION_RTS2_MODE if(parloop_by_handler == -1) parloop_by_handler = 2
#define HEADER_FOR_HANDLER(A) ( (SgSymbol **)(A)->attributeValue(0,HANDLER_HEADER) )
#define USE_STATEMENTS_ARE_REQUIRED ( (int *) first_do_par->attributeValue(0,MODULE_USE) )