void FB_CTUD_DINT::executeEvent(int pa_nEIID) {
if (pa_nEIID == scm_nEventREQID) {
if (true == R()) {
CV() = 0;
}
else {
if (true == LD()) {
CV() = PV();
}
else {
if (!(CU() && CD())) {
if ((CU() && (CV() < CIEC_DINT::scm_nMaxVal))) {
CV() = CV() + 1;
}
else {
if ((CD() && (CV() > CIEC_DINT::scm_nMinVal))) {
CV() = CV() - 1;
}
}
}
}
}
QU() = (CV() >= PV());
QD() = (CV() <= 0);
sendOutputEvent(scm_nEventCNFID);
}
}
void FB_CTUD::executeEvent(AppBlocInfo pa_stAppBlocInfo, EVENT_UID pa_unEIID) {
if (m_unEventREQID == pa_unEIID) {
if (true == R()) {
CV() = 0;
}
else {
if (true == LD()) {
CV() = PV();
}
else {
if (!(CU() && CD())) {
if ((CU() && (CV() < CIEC_DT_INT::scm_nMaxVal))) {
CV() = static_cast<FzrteInt16>(CV() + 1);
}
else {
if ((CD() && (CV() > CIEC_DT_INT::scm_nMinVal))) {
CV() = static_cast<FzrteInt16>(CV() - 1);
}
}
}
}
}
QU() = (CV() >= PV());
QD() = (CV() <= 0);
SendOutput(m_unEventCNFID);
}
}
/*
**
** read an error file to internal buffer and substitute the filename
**
*/
char *ePerl_ReadErrorFile(char *filename, char *scriptfile, char *scripturl)
{
char *rc;
FILE *fp = NULL;
char *cpBuf = NULL;
int nBuf;
char *cp;
if ((fp = fopen(filename, "r")) == NULL) {
ePerl_SetError("Cannot open error file %s for reading", filename);
CU(NULL);
}
fseek(fp, 0, SEEK_END);
nBuf = ftell(fp);
if ((cpBuf = (char *)malloc(sizeof(char) * nBuf * 2)) == NULL) {
ePerl_SetError("Cannot allocate %d bytes of memory", nBuf * 2);
CU(NULL);
}
fseek(fp, 0, SEEK_SET);
if (fread(cpBuf, nBuf, 1, fp) == 0) {
ePerl_SetError("Cannot read from file %s", filename);
CU(NULL);
}
cpBuf[nBuf] = '\0';
for (cp = cpBuf; cp < cpBuf+nBuf; ) {
if ((cp = strstr(cp, scriptfile)) != NULL) {
#ifdef HAVE_MEMMOVE
(void)memmove(cp+strlen(scripturl), cp+strlen(scriptfile), strlen(cp+strlen(scriptfile))+1);
#else
(void)bcopy(cp+strlen(scriptfile), cp+strlen(scripturl), strlen(cp+strlen(scriptfile))+1);
#endif
(void)memcpy(cp, scripturl, strlen(scripturl));
cp += strlen(scripturl);
continue;
}
break;
}
RETURN_WVAL(cpBuf);
CUS:
if (cpBuf)
free(cpBuf);
if (fp)
fclose(fp);
RETURN_EXRC;
}
void FB_CTU::executeEvent(int pa_nEIID){
if(pa_nEIID == scm_nEventREQID){
if(true == R()){
CV() = 0;
}
else if( (true == CU()) && (CV() < CIEC_INT::scm_nMaxVal)){
CV() = static_cast<TForteInt16>(CV() + 1);
}
Q() = (CV() >= PV());
sendOutputEvent(scm_nEventCNFID);
}
}
void FB_CTU::executeEvent(AppBlocInfo pa_stAppBlocInfo, EVENT_UID pa_unEIID) {
if (m_unEventREQID == pa_unEIID) {
if (true == R()) {
CV() = 0;
}
else if ((true == CU()) && (CV() < CIEC_DT_INT::scm_nMaxVal)) {
CV() = static_cast<FzrteInt16>(CV() + 1);
}
Q() = (CV() >= PV());
SendOutput(m_unEventCNFID);
}
}
/// ExtractDebugLocation - Extract debug location information
/// from llvm.dbg.func_start intrinsic.
DebugLoc ExtractDebugLocation(DbgFuncStartInst &FSI,
DebugLocTracker &DebugLocInfo) {
DebugLoc DL;
Value *SP = FSI.getSubprogram();
DISubprogram Subprogram(cast<MDNode>(SP));
unsigned Line = Subprogram.getLineNumber();
DICompileUnit CU(Subprogram.getCompileUnit());
// If this location is already tracked then use it.
DebugLocTuple Tuple(CU.getNode(), NULL, Line, /* Column */ 0);
DenseMap<DebugLocTuple, unsigned>::iterator II
= DebugLocInfo.DebugIdMap.find(Tuple);
if (II != DebugLocInfo.DebugIdMap.end())
return DebugLoc::get(II->second);
// Add a new location entry.
unsigned Id = DebugLocInfo.DebugLocations.size();
DebugLocInfo.DebugLocations.push_back(Tuple);
DebugLocInfo.DebugIdMap[Tuple] = Id;
return DebugLoc::get(Id);
}
int Perl5_Run(int myargc, char **myargv, int mode, int fCheck, int keepcwd, char *source, char **env, char *perlscript, char *perlstderr, char *perlstdout)
{
DECL_EXRC;
FILE *er;
FILE *out;
char *cpBuf = NULL;
char sourcedir[2048];
char *cp;
static PerlInterpreter *my_perl = NULL;
struct stat st;
int size;
char cwd[MAXPATHLEN];
/* open a file for Perl's STDOUT channel
and redirect stdout to the new channel */
if ((out = fopen(perlstdout, "w")) == NULL) {
PrintError(mode, source, NULL, NULL, "Cannot open STDOUT file `%s' for writing", perlstdout);
CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
}
IO_redirect_stdout(out);
/* open a file for Perl's STDERR channel
and redirect stderr to the new channel */
if ((er = fopen(perlstderr, "w")) == NULL) {
PrintError(mode, source, NULL, NULL, "Cannot open STDERR file `%s' for writing", perlstderr);
CU(mode == MODE_FILTER ? EX_IOERR : EX_OK);
}
IO_redirect_stderr(er);
my_perl = perl_alloc();
perl_construct(my_perl);
perl_init_i18nl10n(1);
/* now parse the script!
NOTICE: At this point, the script gets
only _parsed_, not evaluated/executed! */
#ifdef HAVE_PERL_DYNALOADER
rc = perl_parse(my_perl, Perl5_XSInit, myargc, myargv, env);
#else
rc = perl_parse(my_perl, NULL, myargc, myargv, env);
#endif
if (rc != 0) {
if (fCheck && mode == MODE_FILTER) {
fclose(er); er = NULL;
IO_restore_stdout();
IO_restore_stderr();
if ((cpBuf = ePerl_ReadErrorFile(perlstderr, perlscript, source)) != NULL) {
fprintf(stderr, cpBuf);
}
CU(EX_FAIL);
}
else {
fclose(er); er = NULL;
PrintError(mode, source, perlscript, perlstderr, "Perl parsing error (interpreter rc=%d)", rc);
CU(mode == MODE_FILTER ? EX_FAIL : EX_OK);
}
}
/* Stop when we are just doing a syntax check */
if (fCheck && mode == MODE_FILTER) {
fclose(er); er = NULL;
IO_restore_stdout();
IO_restore_stderr();
fprintf(stderr, "%s syntax OK\n", source);
CU(-1);
}
/* change to directory of script:
this actually is not important to us, but really useful
for the ePerl source file programmer!! */
cwd[0] = NUL;
if (!keepcwd) {
/* if running as a Unix filter remember the cwd for outputfile */
if (mode == MODE_FILTER)
getcwd(cwd, MAXPATHLEN);
/* determine dir of source file and switch to it */
strncpy(sourcedir, source, sizeof(sourcedir));
sourcedir[sizeof(sourcedir)-1] = NUL;
for (cp = sourcedir+strlen(sourcedir); cp > sourcedir && *cp != '/'; cp--)
;
*cp = NUL;
chdir(sourcedir);
}
/* Set the previously remembered Perl 5 scalars (option -d) */
Perl5_SetRememberedScalars(aTHX);
/* Force unbuffered I/O */
Perl5_ForceUnbufferedStdout(aTHX);
/* NOW IT IS TIME to evaluate/execute the script!!! */
rc = perl_run(my_perl);
/* pre-close the handles, to be able to check
its size and to be able to display the contents */
fclose(out); out = NULL;
fclose(er); er = NULL;
/* ok, now recover the stdout and stderr */
IO_restore_stdout();
IO_restore_stderr();
/* when the Perl interpreter failed or there
is data on stderr, we print a error page */
if (stat(perlstderr, &st) == 0)
size = st.st_size;
else
size = 0;
if (rc != 0 || size > 0) {
PrintError(mode, source, perlscript, perlstderr, "Perl runtime error (interpreter rc=%d)", rc);
CU(mode == MODE_FILTER ? EX_FAIL : EX_OK);
}
CUS: /* the Clean Up Sequence */
/* Ok, the script got evaluated. Now we can destroy
and de-allocate the Perl interpreter */
if (my_perl) {
perl_destruct(my_perl);
perl_free(my_perl);
}
return rc;
}
/*
* The iSelect function...
*/
int iSelect(char *caBuf, int pos, char *title, char *name,
char *tagbegin, char *tagend, int stripco, int stripws,
int browsealways, int allselectable,
int multiselect, int exitnoselect,
char **keystr)
{
WINDOW *wMain;
int i, j, k;
char ca[MAXLINELEN], ca2[MAXLINELEN];
char ca3[MAXLINELEN];
char *cp, *cps, *cpe;
struct Line *spLine;
int rc;
int ok;
/*
* convert input buffer caBuf into
* spaLines array of browsable strings
*/
j = 0;
nLines = 0;
for (i = 0; caBuf[i] != NUL; i++) {
if (caBuf[i] != NL) {
/* line accumulation */
ca[j++] = caBuf[i];
}
else {
/* end of line accumulation reached, now convert it */
ca[j++] = NUL;
j = 0;
/* skip comment lines */
if (stripco) {
if (strnEQ(ca, "#", 1))
continue;
}
spLine = (struct Line *)malloc(sizeof(struct Line));
sprintf(ca2, "%ss", tagbegin);
sprintf(ca3, "%sS", tagbegin);
if ( (cp = strstr(ca, ca2)) != NULL
|| (cp = strstr(ca, ca3)) != NULL) {
/* is a selectable line */
cps = cp;
cp += strlen(tagbegin)+1;
if (strnEQ(cp, ":", 1)) {
cp++;
for (k = 0; !strnEQ(cp, tagend, strlen(tagend)); k++)
ca2[k] = *cp++;
ca2[k] = NUL;
cpe = cp+strlen(tagend);
for (; *cpe != NUL; )
*cps++ = *cpe++;
*cps = NUL;
}
else if (strnEQ(cp, tagend, strlen(tagend))) {
cpe = cp+strlen(tagend);
for (; *cpe != NUL; )
*cps++ = *cpe++;
*cps = NUL;
strcpy(ca2, ca);
}
else {
CU(EX_FAIL);
}
spLine->cpLine = strdup(ca);
spLine->fSelectable = TRUE;
spLine->cpResult = strdup(ca2);
}
else {
/* is normal plain text line */
spLine->cpLine = strdup(ca);
if (allselectable)
spLine->fSelectable = TRUE;
else
spLine->fSelectable = FALSE;
spLine->cpResult = strdup(ca);
}
spLine->fSelected = FALSE;
if (stripws)
strip(spLine->cpResult);
spaLines[nLines++] = spLine;
}
}
#ifdef DEBUG
for (i = 0; i < nLines; i++) {
printf("spaLines[%d] = {\n", i);
printf(" cpLine = \"%s\"\n", spaLines[i]->cpLine);
printf(" fSelectable = %d\n", spaLines[i]->fSelectable);
printf(" cpResult = \"%s\"\n", spaLines[i]->cpResult);
printf("}\n");
}
#endif
if (!browsealways && nLines == 0)
CU(-1);
if (!browsealways && nLines == 1) {
spaLines[0]->fSelected = TRUE;
CU(0);
}
if (exitnoselect) {
ok = FALSE;
for (i = 0; i < nLines; i++) {
if (spaLines[i]->fSelectable) {
ok = TRUE;
break;
}
}
if (!ok)
CU(-1);
}
/*
* setup Curses package and
* open our own first window which holds the complete screen
*/
setup();
wMain = newwin(LINES, COLS, 0, 0);
werase(wMain);
wrefresh(wMain);
/*
* Now run the browser...
*/
rc = iSelect_Browser(/* Browser: */ LINES-2, COLS-2, 0, 1, pos, multiselect,
/* Status: */ 1, COLS, LINES-2, 0, title, name,
/* Message: */ 1, COLS-1, LINES-1, 0,
/* Result: */ keystr,
/* Tags: */ tagbegin, tagend);
/*
* delete the main window and
* close Curses package
*/
werase(wMain);
wrefresh(wMain);
delwin(wMain);
diesoft();
CUS:
return rc;
}
/*
** convert buffer from bristled format to plain format
*/
char *ePerl_Bristled2Plain(char *cpBuf)
{
char *rc;
char *cpOutBuf = NULL;
char *cpOut = NULL;
char *cps, *cpe;
char *cps2, *cpe2;
int nBuf;
char *cpEND;
int n;
if (strlen(cpBuf) == 0) {
/* make sure we return a buffer which the caller can free() */
cpOutBuf = (char *)malloc(sizeof(char) * 1);
*cpOutBuf = NUL;
return cpOutBuf;
}
nBuf = strlen(cpBuf);
cpEND = cpBuf+nBuf;
/* allocate memory for the Perl code */
n = sizeof(char) * nBuf * 10;
if (nBuf < 1024)
n = 16384;
if ((cpOutBuf = (char *)malloc(n)) == NULL) {
ePerl_SetError("Cannot allocate %d bytes of memory", n);
CU(NULL);
}
cpOut = cpOutBuf;
/* now step through the file and convert it to legal Perl code.
This is a bit complicated because we have to make sure that
we parse the correct delimiters while the delimiter
characters could also occur inside the Perl code! */
cps = cpBuf;
while (cps < cpEND) {
if (ePerl_case_sensitive_delimiters)
cpe = strnstr(cps, ePerl_begin_delimiter, cpEND-cps);
else
cpe = strncasestr(cps, ePerl_begin_delimiter, cpEND-cps);
if (cpe == NULL) {
/* there are no more ePerl blocks, so
just encapsulate the remaining contents into
Perl print constructs */
if (cps < cpEND) {
cps2 = cps;
/* first, do all complete lines */
while (cps2 < cpEND && (cpe2 = strnchr(cps2, '\n', cpEND-cps2)) != NULL) {
if (ePerl_line_continuation && cps < cpe2 && *(cpe2-1) == '\\') {
if (cpe2-1-cps2 > 0) {
cpOut = ePerl_fprintf(cpOut, "print \"");
cpOut = ePerl_Efwrite(cps2, cpe2-1-cps2, 1, cpOut);
cpOut = ePerl_fprintf(cpOut, "\";");
}
cpOut = ePerl_fprintf(cpOut, "\n");
}
else {
cpOut = ePerl_fprintf(cpOut, "print \"");
cpOut = ePerl_Efwrite(cps2, cpe2-cps2, 1, cpOut);
cpOut = ePerl_fprintf(cpOut, "\\n\";\n");
}
cps2 = cpe2+1;
}
/* then do the remainder which is not
finished by a newline */
if (cpEND > cps2) {
cpOut = ePerl_fprintf(cpOut, "print \"");
cpOut = ePerl_Efwrite(cps2, cpEND-cps2, 1, cpOut);
cpOut = ePerl_fprintf(cpOut, "\";");
}
}
break; /* and break the whole processing step */
}
else {
/* Ok, there is at least one more ePerl block */
/* first, encapsulate the content from current pos
up to the begin of the ePerl block as print statements */
if (cps < cpe) {
cps2 = cps;
while ((cpe2 = strnchr(cps2, '\n', cpe-cps2)) != NULL) {
if (ePerl_line_continuation && cps < cpe2 && *(cpe2-1) == '\\') {
if (cpe2-1-cps2 > 0) {
cpOut = ePerl_fprintf(cpOut, "print \"");
cpOut = ePerl_Efwrite(cps2, cpe2-1-cps2, 1, cpOut);
cpOut = ePerl_fprintf(cpOut, "\";");
}
cpOut = ePerl_fprintf(cpOut, "\n");
}
else {
cpOut = ePerl_fprintf(cpOut, "print \"");
cpOut = ePerl_Efwrite(cps2, cpe2-cps2, 1, cpOut);
cpOut = ePerl_fprintf(cpOut, "\\n\";\n");
}
cps2 = cpe2+1;
}
if (cpe > cps2) {
cpOut = ePerl_fprintf(cpOut, "print \"");
cpOut = ePerl_Efwrite(cps2, cpe-cps2, 1, cpOut);
cpOut = ePerl_fprintf(cpOut, "\";");
}
}
/* just output a leading space to make
the -x display more readable. */
if (cpOut > cpOutBuf && *(cpOut-1) != '\n')
cpOut = ePerl_fprintf(cpOut, " ");
/* skip the start delimiter */
cps = cpe+strlen(ePerl_begin_delimiter);
/* recognize the 'print' shortcut with '=',
* e.g. <:=$var:>
*/
if (*cps == '=') {
cpOut = ePerl_fprintf(cpOut, "print ");
cps++;
}
/* skip all following whitespaces.
Be careful: we could skip newlines too, but then the
error output will give wrong line numbers!!! */
while (cps < cpEND) {
if (*cps != ' ' && *cps != '\t')
break;
cps++;
}
cpe = cps;
/* move forward to end of ePerl block. */
if (ePerl_case_sensitive_delimiters)
cpe = strnstr(cpe, ePerl_end_delimiter, cpEND-cpe);
else
cpe = strncasestr(cpe, ePerl_end_delimiter, cpEND-cpe);
if (cpe == NULL) {
ePerl_SetError("Missing end delimiter");
CU(NULL);
}
/* step again backward over whitespaces */
for (cpe2 = cpe;
cpe2 > cps && (*(cpe2-1) == ' ' || *(cpe2-1) == '\t' || *(cpe2-1) == '\n');
cpe2--)
;
/* pass through the ePerl block without changes! */
if (cpe2 > cps) {
if (ePerl_convert_entities == TRUE)
cpOut = ePerl_Cfwrite(cps, cpe2-cps, 1, cpOut);
else
cpOut = ePerl_fwrite(cps, cpe2-cps, 1, cpOut);
/* be smart and automatically add a semicolon
if not provided at the end of the ePerl block.
But know the continuation indicator "_". */
if ((*(cpe2-1) != ';') &&
(*(cpe2-1) != '_') )
cpOut = ePerl_fprintf(cpOut, ";");
if (*(cpe2-1) == '_')
cpOut = cpOut - 1;
}
/* end preserve newlines for correct line numbers */
for ( ; cpe2 <= cpe; cpe2++)
if (*cpe2 == '\n')
cpOut = ePerl_fprintf(cpOut, "\n");
/* output a trailing space to make
the -x display more readable when
no newlines have finished the block. */
if (cpOut > cpOutBuf && *(cpOut-1) != '\n')
cpOut = ePerl_fprintf(cpOut, " ");
/* and adjust the current position to the first character
after the end delimiter */
cps = cpe+strlen(ePerl_end_delimiter);
/* finally just one more feature: when an end delimiter
is directly followed by ``//'' this discards all
data up to and including the following newline */
if (cps < cpEND-2 && *cps == '/' && *(cps+1) == '/') {
/* skip characters */
cps += 2;
for ( ; cps < cpEND && *cps != '\n'; cps++)
;
if (cps < cpEND)
cps++;
/* but preserve the newline in the script */
cpOut = ePerl_fprintf(cpOut, "\n");
}
}
}
RETURN_WVAL(cpOutBuf);
CUS:
if (cpOutBuf)
free(cpOutBuf);
RETURN_EXRC;
}
/*
**
** read source file into internal buffer
**
*/
char *ePerl_ReadSourceFile(char *filename, char **cpBufC, int *nBufC)
{
char *rc;
FILE *fp = NULL;
char *cpBuf = NULL;
int nBuf;
char tmpfile[256], *ptr_tmpfile;
int usetmp = 0;
int c;
if (stringEQ(filename, "-")) {
/* file is given on stdin */
ptr_tmpfile = mytmpfile("ePerl.source");
sprintf(tmpfile, "%s", ptr_tmpfile);
if ((fp = fopen(tmpfile, "w")) == NULL) {
ePerl_SetError("Cannot open temporary source file %s for writing", tmpfile);
CU(NULL);
}
nBuf = 0;
while ((c = fgetc(stdin)) != EOF) {
fprintf(fp, "%c", c);
}
fclose(fp);
fp = NULL;
filename = tmpfile;
usetmp = 1;
}
if ((fp = fopen(filename, "r")) == NULL) {
ePerl_SetError("Cannot open source file %s for reading", filename);
CU(NULL);
}
fseek(fp, 0, SEEK_END);
nBuf = ftell(fp);
if (nBuf == 0) {
cpBuf = (char *)malloc(sizeof(char) * 1);
*cpBuf = NUL;
}
else {
if ((cpBuf = (char *)malloc(sizeof(char) * nBuf+1)) == NULL) {
ePerl_SetError("Cannot allocate %d bytes of memory", nBuf);
CU(NULL);
}
fseek(fp, 0, SEEK_SET);
if (fread(cpBuf, nBuf, 1, fp) == 0) {
ePerl_SetError("Cannot read from file %s", filename);
CU(NULL);
}
cpBuf[nBuf] = '\0';
}
*cpBufC = cpBuf;
*nBufC = nBuf;
RETURN_WVAL(cpBuf);
CUS:
if (cpBuf)
free(cpBuf);
if (fp)
fclose(fp);
if (usetmp)
unlink(tmpfile);
RETURN_EXRC;
}
