void main( void )
{
int handle;
unsigned date, time;
if( _dos_open( "file", O_RDWR, &handle ) != 0 ) {
printf( "Unable to open file\n" );
} else {
printf( "Open succeeded\n" );
_dos_getftime( handle, &date, &time );
printf( "The file was last modified on %d/%d/%d",
MONTH(date), DAY(date), YEAR(date) );
printf( " at %.2d:%.2d:%.2d\n",
HOUR(time), MINUTE(time), SECOND(time) );
/* set the time to 12 noon */
time = (12 << 11) + (0 << 5) + 0;
_dos_setftime( handle, date, time );
_dos_getftime( handle, &date, &time );
printf( "The file was last modified on %d/%d/%d",
MONTH(date), DAY(date), YEAR(date) );
printf( " at %.2d:%.2d:%.2d\n",
HOUR(time), MINUTE(time), SECOND(time) );
_dos_close( handle );
}
}
/* a and b are atomic formulas, but ICOMP is used to do the dirty work. */
static Word comp(Word a, Word b)
{
Word t;
t = ICOMP(FIRST(a),FIRST(b));
if (!t)
t = ICOMP(SECOND(a),SECOND(b));
return t;
}
int main() {
set_default_logif_level(LOG_WARN);
int n = 1;
evt_pool *pool = evt_pool_init(n);
net_addr addr;
netaddr_init_v4(&addr, "127.0.0.1", 8887);
ohbuffer_unit_objpool *upool[n];
int i;
for (i = 0; i < n; i++) {
upool[i] = (ohbuffer_unit_objpool*)ohmalloc(sizeof(ohbuffer_unit_objpool));
bufunit_pool_init(upool[i], TCPCLIENT_OBJPOOL_BLOCKSZ, OHBUFFER_UNIT_DEFAULT_SIZE + sizeof(ohbuffer_unit));
}
for (i = 0; i < 1000; i++) {
evt_loop *loop = pool->loops[i%n];
tcp_client *client = (tcp_client*)ohmalloc(sizeof(tcp_client));
tcp_client_init(client, &addr, loop, 0, upool[i%n], OHBUFFER_UNITPOOL_NOLOCK);
tcp_connection_set_on_write(client, write_cb);
tcp_connection_set_on_read(client, read_cb);
tcp_connection_set_on_close(client, close_cb);
tcp_connection_set_on_connect(client, connect_cb);
if (tcp_connect(client) < 0) {
log_error("error");
}
}
evt_timer calll;
evt_timer_init(&calll, calll_cb, SECOND(sec), SECOND(sec));
evt_timer_start(pool->loops[0], &calll);
// tcp_server_start(server);
evt_pool_run(pool);
// int i, n = 4;
// evt_pool *pool = evt_pool_init(n);
// tcp_server_hub *serverh = tcp_server_hub_init(&addr, pool, 0);
// tcp_server_hub_set_on_write(serverh, write_cb);
// tcp_server_hub_set_on_read(serverh, read_cb);
// tcp_server_hub_set_on_close(serverh, close_cb);
// tcp_server_hub_set_on_accept(serverh, accept_cb);
// tcp_server_hub_start(serverh);
// evt_timer calll;
// evt_timer_init(&calll, calll_cb, SECOND(sec), SECOND(sec));
// evt_set_data(&calll, serverh);
// evt_timer_start(pool->loops[0], &calll);
// evt_pool_run(pool);
return 0;
}
Word LBRNQORD(Word A, Word B)
{
Word a,b,i,j,t,s,k;
FIRST2(A,&a,&i);
FIRST2(B,&b,&j);
t = i - j;
s = - SECOND( SECOND( SSILRCRI(0,RNRED(a,b)) ) );
k = s - t - 1;
return k;
}
Word FMAOPCOMBINE(Word F)
{
Word L,M,Fp,f,a,b,Lp,Mp,Lb;
switch(FIRST(F)) {
case OROP:
/* Set L to a list of all top level atomic formulas. */
L = NIL; M = NIL;
for(Fp = RED(F); Fp != NIL; Fp = RED(Fp)) {
f = FIRST(Fp);
if (ISLIST(FIRST(f)))
L = COMP(f,L);
else
M = COMP(f,M); }
/* Create Lp from L */
Lp = NIL;
while(L != NIL) {
a = FIRST(L);
if (FMAQEXTAF(a)) { Lp = COMP(a,Lp); L = RED(L); continue; }
Lb = RED(L);
for(L = NIL; Lb != NIL; Lb = RED(Lb)) {
b = FIRST(Lb);
if (FMAQEXTAF(b) || ! EQUAL(FIRST(b),FIRST(a)))
L = COMP(b,L);
else
a = LIST2(FIRST(a),SECOND(a) | SECOND(b)); }
if (SECOND(a) > 6)
Lp = COMP(LIST1(TRUE),Lp);
else
Lp = COMP(a,Lp); }
/* Create Mp from M. */
for(Mp = NIL; M != NIL; M = RED(M))
Mp = COMP(FMAOPCOMBINE(FIRST(M)),Mp);
Fp = COMP(OROP,CCONC(Lp,Mp));
break;
case ANDOP:
Fp = NIL;
for(L = CINV(RED(F)); L != NIL; L = RED(L))
Fp = COMP(FMAOPCOMBINE(FIRST(L)),Fp);
Fp = COMP(ANDOP,Fp);
break;
default:
Fp = F;
}
return Fp;
}
Word RMNOTOP(Word F)
{
Word F1,Fb,Fp,Fp1,T;
Step1: /* Classify the formula v{F}. */
T = FIRST(F);
if (T == ANDOP) goto Step3;
if (T == OROP) goto Step3;
if (T == NOTOP) goto Step4;
Step2: /* Atomic Formula. */
Fp = F; goto Return;
Step3: /* Conjunction/Disjunction. */
Fb = RED(F); Fp = LIST1(T);
while (Fb != NIL)
{
ADV(Fb,&F1,&Fb);
Fp1 = RMNOTOP(F1);
Fp = COMP(Fp1,Fp);
}
Fp = INV(Fp);
goto Return;
Step4: /* Negation. */
F1 = SECOND(F);
Fp = RMNOTOPN(F1);
goto Return;
Return: /* Prepare for return. */
return(Fp);
}
void QepcadCls::PROJMCECCLOSURE(Word P, Word J, Word Q)
{
Word N,k,Q_k,PP,NP,pp,L,l,i,S,s;
Step1: /* Initialization. */
N = LENGTH(Q);
Step2: /* Loop from */
for(k = N; k > 1; k--) {
Q_k = LELTI(Q,k);
SEPPIVNONPIV(Q_k,k,&PP,&NP);
while (PP != NIL) {
ADV(PP,&pp,&PP);
Step3: /* Add necessary coefficients of pp. */
L = PFSUFFCOEF(pp,P,J);
while (L != NIL ) {
ADV(L,&l,&L);
i = SECOND(LELTI(l,PO_LABEL));
SLELTI(Q,i,PFSUNION(LELTI(Q,i),LIST1(l))); }
Step4: /* Add factors of the discriminant of pp. */
if (PDEG(LELTI(pp,PO_POLY)) > 1) {
L = PFDISCRIM(pp,P,J);
while (L != NIL ) {
ADV(L,&l,&L);
i = SECOND(LELTI(l,PO_LABEL));
SLELTI(Q,i,PFSUNION(LELTI(Q,i),LIST1(l))); } }
Step5: /* Add resultants. */
for(S = CCONC(PP,NP); S != NIL; S = RED(S)) {
s = FIRST(S);
L = PFRES(pp,s,P,J);
while (L != NIL ) {
ADV(L,&l,&L);
i = SECOND(LELTI(l,PO_LABEL));
SLELTI(Q,i,PFSUNION(LELTI(Q,i),LIST1(l))); } } } }
Return:/* Return. */
return;
}
Word LDCOEFMASK(Word c, Word P, Word J)
{
Word *A,P_2,n,i,M,P_1,L,m,j,p,Lp,h,q,v,l;
Step1: /* Set up A to be a characteristic vector for the set of
level 2 proj fac's whose leading coefficients vanish in c. */
P_2 = LELTI(P,2);
n = THIRD(LELTI(LAST(P_2),PO_LABEL));
A = GETARRAY(n + 1);
for(i = 1; i <= n; i++)
A[i] = 0;
Step2: /* Set L to be the list of projection factors which vanish in c. */
M = LELTI(c,MULSUB);
P_1 = LELTI(P,1);
L = NIL;
while(M != NIL) {
ADV(M,&m,&M);
j = FIRST(m);
do
ADV(P_1,&p,&P_1);
while(j != THIRD(LELTI(p,PO_LABEL)));
L = COMP(p,L); }
Step3: /* Set Lp to the list of projection polynomials with factors in L. */
Lp = NIL;
while(L != NIL) {
ADV(L,&p,&L);
for(h = LELTI(p,PO_PARENT); h != NIL; h = RED(h))
Lp = COMP(THIRD(FIRST(h)),Lp); }
Step4: /* Run through the histories of each polynomial in Lp. If the
polynomial is the leading coefficient of some bivariate projection factor,
set A at the index for that projection factor to 1. */
while(Lp != NIL) {
ADV(Lp,&p,&Lp);
for(h = LELTI(p,PO_PARENT); h != NIL; h = RED(h)) {
q = FIRST(h);
if (FIRST(q) == PO_LCO) {
l = LELTI(THIRD(q),PO_LABEL);
if (SECOND(l) == 2)
A[ THIRD(l) ] = 1; } } }
Step5: /* Create the vector itself! */
v = NIL;
while(P_2 != NIL) {
ADV(P_2,&p,&P_2);
j = THIRD(LELTI(p,PO_LABEL));
v = COMP(A[j],v); }
v = INV(v);
Return: /* Prepare to return. */
FREEARRAY(A);
return v;
}
void TRMODEWR(Word M)
{
Step1: /* Write. */
if (M == NIL) SWRITE("-");
else { CLOUT(FIRST(M)); SWRITE(" "); CLOUT(SECOND(M)); }
goto Return;
Return: /* Prepare for return. */
return;
}
Word PWUDSCWCP(Word D, Word P, Word N)
{
Word C,R,i,a,b,c,L,p,T_a,T_b,T_c,t_a,t_b,t_c,r;
Step1: /* Initialization. */
C = LELTI(D,CHILD);
R = NIL;
for(i = 0; i < N; i++) R = COMP(NIL,R);
Step2: /* Loop over the children of C. Child cell b will always be
a section. Decide if the polynomial defining that section
need to be added to R. */
for(ADV(C,&a,&C); C != NIL; a = c) {
ADV2(C,&b,&c,&C);
Step3: /* Get a list of polynomials which are zero in b and not in c. */
L = LPFSETMINUS(LPFZC(b,P),LPFZC(c,P));
if (LENGTH(L) == 1) {
Step4: /* If b is a section of a single projection factor ... */
T_a = LELTI(a,TRUTH);
T_b = LELTI(b,TRUTH);
T_c = LELTI(c,TRUTH);
t_a = CATV(a);
t_b = CATV(b);
t_c = CATV(c);
if (( T_b == TRUE && (t_a != TRUE || t_c != TRUE)) ||
( T_b == FALSE && (t_a != FALSE || t_c != FALSE)) ||
( ( T_a == TRUE || T_c == TRUE) && t_b != TRUE) ||
( ( T_a == FALSE || T_c == FALSE) && t_b != FALSE)) {
Step5: /* Add pol defining b to R. */
p = FIRST(L);
r = SECOND(LELTI(p,PO_LABEL));
SLELTI(R,r,PFSUNION(LELTI(R,r),L));
}
}
Step6: /* If necessary, search children of a and b. */
if (LELTI(a,CHILD) != NIL)
R = PFSSUNION(PWUDSCWCP(a,P,N),R);
if (LELTI(b,CHILD) != NIL)
R = PFSSUNION(PWUDSCWCP(b,P,N),R);
}
Step7: /* If necessary search children of a. */
if (LELTI(a,CHILD) != NIL)
R = PFSSUNION(PWUDSCWCP(a,P,N),R);
Return: /* Return. */
return (R);
}
std::string convert(const std::string& src){
std::string result;
unsigned long long hash = 0;
for(int i=0;i<3;i++){
hash *= 256;
hash += (unsigned long long)(src[i]);
}
result += table.table[FIRST(hash)];
result += table.table[SECOND(hash)];
result += table.table[THIRD(hash)];
result += table.table[FORTH(hash)];
return std::move(result);
}
Word POLYINDEX(Word P, Word p, Word r, Word *t)
{
Word P_r, Pp, pp;
for(; PDEG(p) == 0; r--)
p = SECOND(p);
/* Is p already in P? */
P_r = LELTI(P,r); *t = 0;
for(Pp = P_r; Pp != NIL; Pp = RED(Pp)) {
pp = FIRST(Pp);
if ( EQUAL(LELTI(pp,PO_POLY),p) ) {
*t = 1; break; } }
if (*t == 0) { SWRITE("Polynomial not found!!\n"); }
return RED(LELTI(pp,PO_LABEL));
}
void PRWHATIS()
{
Word C,C1,C_i,Cs,Csp,I,k,N,m;
Step1: /* Read in a command name. */
N = GETWORD();
Step2: /* Match the command. */
Cs = NIL;
C = COMMANDS;
while (C != NIL) {
ADV(C,&C_i,&C);
if (MATCHWORD(N,FIRST(C_i))) Cs = COMP(C_i,Cs); }
Cs = INV(Cs);
m = LENGTH(Cs);
Step3: /* No matched command. */
if (m == 0) {
SWRITE("Error WHATIS: There is no such command!\n");
goto Return; }
Step4: /* More than one command matched. */
if (m > 1) {
Csp = Cs;
ADV(Csp,&C1,&Csp);
k = LENGTH(FIRST(C1));
while (Csp != NIL) {
if (LENGTH(FIRST(FIRST(Csp))) < k)
C1 = FIRST(Csp);
Csp = RED(Csp); }
if (!EQUAL(N,FIRST(C1))) {
SWRITE("Error WHATIS: More than one command is matched.\n");
while (Cs != NIL) {
ADV(Cs,&C_i,&Cs);
SWRITE(" "); CLOUT(FIRST(C_i)); SWRITE("\n"); }
goto Return; } }
Step5: /* Give help on the command. */
C1 = FIRST(Cs); I = SECOND(C1);
HELPWR(I);
goto Return;
Return: /* Prepare for return. */
return;
}
void SEPLAB(Word k, Word C, Word *Cb_, Word *Ch_)
{
Word C1,Cb,Ch,Cp,h;
Step1: /* */
Cp = C;
Cb = NIL;
Ch = NIL;
while (Cp != NIL) {
ADV(Cp,&C1,&Cp);
h = SECOND(C1);
if (h < k) Cb = COMP(C1,Cb);
else Ch = COMP(C1,Ch); }
Return: /* Prepare for return. */
*Cb_ = Cb;
*Ch_ = Ch;
return;
}
Word PFDISCRIM(Word q, Word P, Word J)
{
Word i,h,D,d,L;
Step1: /* See if this discriminant has already been computed. */
i = SECOND(LELTI(q,PO_LABEL));
h = LIST4(PO_DIS,0,0,q);
D = PPWITHHIST(J,i-1,h);
Step2: /* Compute it if it hasn't, get a list of its factors if it has. */
if (! D) {
d = IPDSCRQE(i,LELTI(q,PO_POLY));
ADD2PROJPOLS(i-1,d,h,J,P,&D,&L); }
else {
L = LIST_OF_FACS(D,P); }
Return:/* Return. */
return (L);
}
// выводит в поле Label1 информацию о текущем треке
void __fastcall TForm1::TrackInfo()
{
int ms; // время звучания трека, мсек
AnsiString st;
Track = MCI_TMSF_TRACK(MediaPlayer->Position);
MediaPlayer->TimeFormat = tfMilliseconds;
ms = MediaPlayer->TrackLength[Track];
MediaPlayer->TimeFormat = tfTMSF;
st = IntToStr(SECOND(ms));
if ( st.Length() == 1)
st = "0" + st;
st = "Трек "+ IntToStr(Track) +
". Длительность "+ IntToStr(MINUTE(ms)) + ":" + st;
Label1->Caption = st;
}
Word POLFLAB(Word o, Word P)
{
Word r,P_r,p;
Step1: /* Initialize. */
r = SECOND(o);
P_r = LELTI(P,r);
Step2: /* Search P_r for a pol with label o. */
while ( P_r != NIL && ! EQUAL(o,LELTI(FIRST(P_r),PO_LABEL)) ) {
P_r = RED(P_r); }
Step3: /* Set return value p to the pol if it's found, and 0 otherwise. */
if ( P_r != NIL )
p = FIRST(P_r);
else
p = 0;
Return: /* Return. */
return (p);
}
void IPLDWR(Word V, Word A)
{
Word A1,P,r;
Step1: /* Write. */
while (A != NIL)
{
ADV(A,&A1,&A);
PLABELWR(A1);
SWRITE(" = ");
r = SECOND(LELTI(A1,PO_LABEL));
P = LELTI(A1,PO_POLY);
if (LELTI(A1,PO_TYPE) == PO_POINT) {
SAMPLEWR(r,FIRST(P),4);
}
else {
IPDWRITE(r,P,V); SWRITE("\n");
}
}
Return: /* Prepare for return. */
return;
}
int main (int argc,
char *argv[])
# endif
{
int column_num;
long field_len;
int line_num;
char *msg_name;
int save_statement_number = 0;
# if (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX))
double end_time;
double start_time;
/* char time[20]; */
double total_cpu_time;
struct rusage ru;
# else
# if !defined(_HOST_OS_UNICOS)
long end_clock;
# endif
float end_time;
float start_time;
float total_cpu_time;
# endif
# if defined(_HOST_OS_UNICOS) && defined(_DEBUG)
lowmem_check();
# endif
# if defined(_TARGET32) && defined(_DEBUG)
setbuf(stdout, NULL);
setbuf(stderr, NULL);
# endif
# if defined(_HOST_OS_UNICOS)
/* Lots of start up - ignore first call. See the comment block that */
/* precedes procedure cif_summary_rec in fecif.c for a discussion of the */
/* timing methods used by the different platforms. */
SECOND(&start_time);
/* M_LOWFIT will eventually be in malloc.h. */
/* When it is remove this definition. */
# define M_LOWFIT 0107 /* Use lowest-fit algorithm for allocation. */
mallopt(M_LOWFIT, 1);
# elif defined(_HOST_OS_MAX)
/* Use clock() on MPP's (in particular T3E's) because at the time this */
/* change was made, neither SECOND() nor SECONDR() worked on T3E's. */
/* LRR 4 Mar 1997 */
clock();
start_time = 0;
/* M_LOWFIT will eventually be in malloc.h. */
/* When it is remove this definition. */
# define M_LOWFIT 0107 /* Use lowest-fit algorithm for allocation. */
mallopt(M_LOWFIT, 1);
# elif defined(_HOST_OS_SOLARIS)
/* clock() is only semi-useful on a Sun because it rolls over in just over */
/* 2147 seconds (about 36 minutes). So on a Sun, we use clock() and */
/* time() both. If elapsed time <= 2147 seconds, the accounting info will */
/* show milliseconds (from clock()), else it will show seconds (because */
/* that is the accuracy of time()). This resolution should be good enough */
/* for a compilation exceeding 36 minutes. */
start_time = (float) time(NULL);
clock();
# elif (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX))
getrusage (RUSAGE_SELF, &ru);
start_time = (double) ru.ru_utime.tv_sec +
(double) ru.ru_utime.tv_usec * 1e-6 +
(double) ru.ru_stime.tv_sec +
(double) ru.ru_stime.tv_usec * 1e-6;
# else
start_time = 0;
# endif
comp_phase = Pass1_Parsing;
stmt_start_line = 1; /* Set in case mem problems */
init_compiler(argc, argv); /* init and process cmd line */
if (on_off_flags.preprocess_only) {
goto PREPROCESS_ONLY_SKIP;
}
stmt_start_line = 0;
while (LA_CH_CLASS != Ch_Class_EOF) {
comp_phase = Pass1_Parsing;
num_prog_unit_errors = 0; /* Accum errs for pgm unit */
OUTPUT_PASS_HEADER(Syntax_Pass);
if (save_statement_number != 0) {
statement_number = save_statement_number;
}
parse_prog_unit();
save_statement_number = statement_number;
if (LA_CH_CLASS == Ch_Class_EOF) {
issue_deferred_msgs();
}
/* get current field length and save largest value */
field_len = (long) sbrk(0);
# if defined(_HOST_OS_MAX)
field_len &= (1 << 32) - 1;
# endif
if (field_len > max_field_len) { /* Max set in init_compiler */
max_field_len = field_len; /* Track max usage */
}
PRINT_IR_TBL; /* If -u ir and DEBUG compiler, print ir. */
OUTPUT_PASS_HEADER(Semantics_Pass);
semantics_pass_driver(); /* PASS 2 */
if (SCP_IN_ERR(curr_scp_idx)) {
some_scp_in_err = TRUE;
}
PRINT_ALL_SYM_TBLS; /* If debug print -u options */
PRINT_FORTRAN_OUT; /* Print ir in a fortran format */
line_num = SH_GLB_LINE(SCP_LAST_SH_IDX(curr_scp_idx));
column_num = SH_COL_NUM(SCP_LAST_SH_IDX(curr_scp_idx));
if (num_prog_unit_errors == 0) {
if (opt_flags.inline_lvl > Inline_Lvl_0) {
comp_phase = Inlining;
inline_processing(SCP_FIRST_SH_IDX(curr_scp_idx));
PRINT_IR_TBL3;
}
}
insert_global_directives = TRUE;
comp_phase = Pdg_Conversion;
if (dump_flags.preinline) { /* Do not do a full compile */
if (ATP_PGM_UNIT(SCP_ATTR_IDX(MAIN_SCP_IDX)) == Module ||
ATP_PGM_UNIT(SCP_ATTR_IDX(MAIN_SCP_IDX)) == Function ||
ATP_PGM_UNIT(SCP_ATTR_IDX(MAIN_SCP_IDX)) == Subroutine) {
curr_scp_idx = MAIN_SCP_IDX;
#ifdef KEY /* Bug 3477 */
if (create_mod_info_file()) { /* Creates a name for the file. */
create_mod_info_tbl(); /* Creates the table. */
output_mod_info_file(); /* Writes the table. */
}
#else
create_mod_info_file(); /* Creates a name for the file. */
create_mod_info_tbl(); /* Creates the table. */
output_mod_info_file(); /* Writes the table. */
#endif /* KEY Bug 3477 */
free_tables(); /* Frees the tables. */
}
}
else {
#ifdef KEY /* Bug 3477 */
int do_output_file = FALSE;
#endif /* KEY Bug 3477 */
if (ATP_PGM_UNIT(SCP_ATTR_IDX(MAIN_SCP_IDX)) == Module) {
#ifdef KEY /* Bug 3477 */
do_output_file = create_mod_info_file(); /* Creates a name for the file. */
#else
create_mod_info_file(); /* Creates a name for the file. */
#endif /* KEY Bug 3477 */
}
if (num_prog_unit_errors == 0 && (binary_output || assembly_output)) {
cvrt_to_pdg(compiler_gen_date);
}
else if (ATP_PGM_UNIT(SCP_ATTR_IDX(MAIN_SCP_IDX)) == Module) {
if (!SCP_IN_ERR(MAIN_SCP_IDX)) {
curr_scp_idx = MAIN_SCP_IDX;
#ifdef KEY /* Bug 3477 */
if (do_output_file) {
create_mod_info_tbl(); /* Creates the table. */
output_mod_info_file(); /* Writes the table. */
}
#else
create_mod_info_tbl(); /* Creates the table. */
output_mod_info_file(); /* Writes the table. */
#endif /* KEY Bug 3477 */
}
free_tables(); /* Frees the tables. */
}
else {
free_tables(); /* Frees the tables. */
}
}
/* ALERT - At this point, the symbol tables are invalid. */
/* Spit out the End Unit for the current program unit. The End Unit */
/* is needed if the Compiler Information File (CIF) is being produced */
/* and for the buffered message file. */
stmt_start_line = line_num;
stmt_start_col = column_num;
if (scp_tbl == NULL_IDX) { /* Table has been freed. */
cif_end_unit_rec(program_unit_name);
}
else {
cif_end_unit_rec(AT_OBJ_NAME_PTR(SCP_ATTR_IDX(curr_scp_idx)));
}
} /* while */
clean_up_module_files();
# ifdef _NAME_SUBSTITUTION_INLINING
if (!dump_flags.preinline)
# endif
terminate_PDGCS();
PRINT_GL_TBL; /* Prints to debug_file ifdef _DEBUG and -u gl */
PRINT_GN_TBL; /* Prints to debug_file ifdef _DEBUG and -u gn */
PREPROCESS_ONLY_SKIP:
# if defined(_HOST_OS_UNICOS)
SECOND(&end_time);
# elif defined(_HOST_OS_MAX)
end_clock = clock();
end_time = 0;
# elif defined(_HOST_OS_SOLARIS)
end_time = (float) time(NULL);
end_clock = clock();
# elif (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX))
getrusage(RUSAGE_SELF, &ru);
end_time = (double) ru.ru_utime.tv_sec +
(double) ru.ru_utime.tv_usec * 1e-6 +
(double) ru.ru_stime.tv_sec +
(double) ru.ru_stime.tv_usec * 1e-6;
# else
end_time = 0;
# endif
total_cpu_time = end_time - start_time;
if (cif_need_unit_rec && cif_first_pgm_unit) {
/* Catastrophic errors, like a free source form program was compiled */
/* in fixed source form mode, so no Unit record was output. Output */
/* enough records to keep libcif tools happy. This routine needs to be */
/* called whether or not a CIF is being written because the buffered */
/* message file also must have the correct format. */
cif_fake_a_unit();
}
/* CAUTION: The following code assumes that non-Cray platforms measure */
/* memory usage in terms of bytes and that there are 4 bytes per word. */
cif_summary_rec(release_level,
compiler_gen_date,
compiler_gen_time,
total_cpu_time,
# if defined(_HOST_OS_UNICOS)
(long) 0,
(some_scp_in_err) ? -3 : max_field_len);
# elif defined(_HOST_OS_MAX)
end_clock,
(some_scp_in_err) ? -3 : max_field_len);
# elif (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX))
(long) 0,
(some_scp_in_err) ? -3 : max_field_len/4);
# else /* defined(_HOST_OS_SOLARIS) */
end_clock,
(some_scp_in_err) ? -3 : max_field_len/4);
# endif
/* Output compilation summary info if the -V option was specified on the */
/* command line. Also, issue the summary information if any messages were */
/* actually issued. */
if (cmd_line_flags.verify_option ||
num_errors > 0 ||
num_warnings > 0 ||
num_cautions > 0 ||
num_notes > 0 ||
num_comments > 0 ||
num_ansi > 0 ||
(num_optz_msgs > 0 && opt_flags.msgs)) {
print_buffered_messages();
print_id_line();
/* Output the summary lines. The compilation time is in seconds. */
/* CAUTION: The following non-Cray code assumes a 32-bit word. */
# if defined(_HOST_OS_UNICOS)
PRINTMSG (0, 104, Log_Summary, 0, (double) total_cpu_time);
msg_name = "cf90";
# elif defined(_HOST_OS_MAX)
PRINTMSG (0, 104, Log_Summary, 0, (double) end_clock/1000000.0);
msg_name = "cf90";
# elif defined(_HOST_OS_LINUX)
msg_name = PSC_NAME_PREFIX "f95";
# elif (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX))
/* IRIX cannot handle the int to float change necessary to get the */
/* time printed correctly, so we'll convert it to a character string */
/* and use a different message. */
/* */
/* LRR 4/28/97 In an email message from Rich Shapiro to me, he stated */
/* he did not want this line in the summary lines. */
/* sprintf(time, "%-1.2f", (double) total_cpu_time);
PRINTMSG (0, 1310, Log_Summary, 0, time); */
msg_name = "cf90";
# elif defined(_HOST_OS_SOLARIS)
PRINTMSG (0, 104, Log_Summary, 0,
(total_cpu_time <= 2147.0) ? (float) end_clock/1000000.0 :
(float) total_cpu_time);
msg_name = "cf90";
# endif
/* Maximum field length (maximum amount of memory used) in words */
/* (decimal). */
/* CAUTION: Non-Cray platforms are assumed to measure memory usage in */
/* bytes and we assume 4 bytes per word. */
# if defined(_HOST_OS_UNICOS)
PRINTMSG (0, 105, Log_Summary, 0, max_field_len);
# elif ! (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX))
/* LRR 4/28/97 In an email message from Rich Shapiro to me, he stated */
/* he did not want this line in the summary lines. */
PRINTMSG (0, 105, Log_Summary, 0, max_field_len/4);
# endif
/* Number of source lines compiled. */
# if (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) && !defined(_TARGET_SV2)
PRINTMSG (0, 1401, Log_Summary, 0, --curr_glb_line);
# else
PRINTMSG (0, 106, Log_Summary, 0, --curr_glb_line);
# endif
/* Number of messages issued. */
# if (defined(_HOST_OS_IRIX) || defined(_HOST_OS_LINUX)) && !defined(_TARGET_SV2)
PRINTMSG (0, 1403, Log_Summary, 0,
num_errors,
num_warnings,
(opt_flags.msgs == 0) ?
(num_cautions + num_notes + num_comments) :
(num_cautions + num_notes + num_comments + num_optz_msgs),
num_ansi);
# else
PRINTMSG (0, 107, Log_Summary, 0,
num_errors,
num_warnings,
(opt_flags.msgs == 0) ?
(num_cautions + num_notes + num_comments) :
(num_cautions + num_notes + num_comments + num_optz_msgs),
num_ansi);
/* Code: in words; data: in words. */
/* LRR 4/28/97 In an email message from Rich Shapiro to me, he stated */
/* he did not want this line in the summary lines. */
# if !defined(_TARGET_SV2) /* Prints blank for sv2 right now. */
PRINTMSG (0, 108, Log_Summary, 0, code_size, data_size);
# endif
# endif
if (num_errors > 0 ||
num_warnings > 0 ||
num_cautions > 0 ||
num_notes > 0 ||
num_comments > 0 ||
num_ansi > 0 ||
(num_optz_msgs > 0 && opt_flags.msgs)) {
PRINTMSG (0, 1636, Log_Summary, 0, msg_name, msg_name);
}
} /* End of summary printing. */
# ifdef _DEBUG
/* Get memory usage reports for these global tables. */
final_src_input();
MEM_REPORT(file_path_tbl);
MEM_REPORT(global_attr_tbl);
MEM_REPORT(global_bounds_tbl);
MEM_REPORT(global_line_tbl);
MEM_REPORT(global_name_tbl);
MEM_REPORT(global_type_tbl);
MEM_REPORT(str_pool);
# endif
exit_compiler ((num_errors == 0) ? RC_OKAY : RC_USER_ERROR);
} /* main */
// сигнал от таймера: вывести номер трека
// и время воспроизведения
void __fastcall TForm1::TimerTimer(TObject *Sender)
{
int trk; // трек
int min, sec; // время
AnsiString st;
if ( MediaPlayer->Mode == mpPlaying ) // режим воспроизведения
{
// получить номер воспроизводимого трека и
trk = MCI_TMSF_TRACK(MediaPlayer->Position);
if ( trk != Track ) // произошла смена трека
{
TrackInfo();
Track = trk;
if ( Track > 1 )
SpeedButton1->Enabled = true; // доступна кнопка "пред.трек"
if ( Track == MediaPlayer->Tracks)
SpeedButton3->Enabled = false; // кнопка "след.трек" недоступна
}
// вывод информации о воспроизводимом треке
min = MCI_TMSF_MINUTE(MediaPlayer->Position);
sec = MCI_TMSF_SECOND(MediaPlayer->Position);
st.printf("%d:%.2d",min,sec);
Label2->Caption = st;
return;
}
// Если дисковод открыт или в нем нет
// AudioCD, то Mode == mpOpen.
// Ждем диск, т.е. до тех пор пока не будет Mode == mpStopped + кол-во треков > 1
if ( (MediaPlayer->Mode == mpStopped) &&
(MediaPlayer->Tracks > 1) )
{
// диск вставлен
Timer->Enabled = false;
SpeedButton2->Enabled = true;;
SpeedButton2->Tag = 0;
SpeedButton3->Enabled = true;
MediaPlayer->Notify = true;
// получить информацию о времени звучания CD
MediaPlayer->TimeFormat = tfMilliseconds;
int ms = MediaPlayer->Length;
AnsiString st = "Audio CD. Время звучания: ";
st = st + IntToStr(MINUTE(ms));
st = st + ":" + IntToStr(SECOND(ms));
Label1->Caption = st;
MediaPlayer->TimeFormat = tfTMSF;
Label1->Visible = true;
Track = 0;
return;
}
// дисковод открыт или в дисководе не Audio CD
if (( MediaPlayer->Mode == mpOpen )||
(MediaPlayer->Mode == mpStopped) && (MediaPlayer->Tracks == 1))
{
Label1->Caption = "Вставьте Audio CD";
if ( Label1->Visible )
Label1->Visible = false;
else Label1->Visible = true;
}
}
/* Projection point equal */
BDigit PRJPNTEQUAL(Word A, Word B)
{
if (LENGTH(A) != LENGTH(B))
return 0;
/* Both primitive */
Word a = FIRST(A), b = FIRST(B);
if (ISPRIMIT(a) && ISPRIMIT(b)) {
Word aC,aK,ac,bC,bK,bc;
FIRST3(a,&aC,&aK,&ac);
FIRST3(b,&bC,&bK,&bc);
if (!EQUAL(aC,bC)) return 0;
if (EQUAL(FIRST(aK),SECOND(aK)) && EQUAL(aK,bK)) return 1;
if (EQUAL(FIRST(aK),SECOND(aK)) && EQUAL(FIRST(bK),SECOND(bK)) && !EQUAL(aK,bK)) return 0;
if (RNCOMP(SECOND(aK),FIRST(bK)) <= 0 || RNCOMP(FIRST(aK),SECOND(bK)) >= 0) return 0;
return EQUAL(ac,bc);
}
/* Both Not Primitive */
if (!ISPRIMIT(a) && !ISPRIMIT(b)) {
if (!PRJPNTEQUAL(LIST1(SECOND(A)),LIST1(SECOND(B)))) return 0;
Word aC,aK,aM,aI,ac,bC,bK,G,Af,Bf;
FIRST5(a,&aC,&aK,&aM,&aI,&ac);
FIRST2(b,&bC,&bK);
if (EQUAL(FIRST(aK),SECOND(aK)) && EQUAL(FIRST(bK),SECOND(bK)) && !EQUAL(aK,bK)) return 0;
if (RNCOMP(SECOND(aK),FIRST(bK)) <= 0 || RNCOMP(FIRST(aK),SECOND(bK)) >= 0) return 0;
if (EQUAL(aC,bC)) return 1;
AFUPGC(aM,aC,bC,&G,&Af,&Bf);
if (PDEG(G) < 1) return 0;
Word KL = LIST2(FIRST(aK),LIST2(1,1));
Word KR = LIST2(SECOND(aK),LIST2(1,1));
Word sL = AFSIGN(aM,aI,AFPEMV(1,aM,G,KL));
Word sR = AFSIGN(aM,aI,AFPEMV(1,aM,G,KR));
return EQUAL(KL,KR) && sL == 0 || sL == 1 && sR == -1 || sL == -1 && sR == 1;
}
/* One primitive, the other not */
if (ISPRIMIT(a) != ISPRIMIT(b)) {
SWRITE("This condition not implemented in PRJPNTEQUAL!\n");
FAIL("PRJPNTEQUAL","Incomplete Implementation Error!");
}
return -1;
}
Word ISDESIRED(Word c, Word C)
{
Word C1,C2,Cp,T,V1,V2,t;
/* hide C1,C2,Cp,T,V1,V2,t; */
Step1: /* Classify the condition. */
if (LELTI(c,LEVEL) == 0) { t = 1; goto Return; }
T = FIRST(C);
if (T == OROP) goto Step3;
if (T == ANDOP) goto Step4;
if (T == NOTOP) goto Step5;
if (T == LEFTOP) goto Step6;
if (T == RIGHTOP) goto Step7;
if (T == EQUIOP) goto Step8;
Step2: /* Atomic condition. */
V1 = SECOND(C); V2 = THIRD(C);
if (V1 < 0 ) V1 = CELLATTR(c,V1);
if (V2 < 0 ) V2 = CELLATTR(c,V2);
if (V1 == NIL || V2 == NIL)
{t = 0; goto Return;}
switch(T)
{
case LTOP: t = (V1 < V2 ? 1 : 0); break;
case EQOP: t = (V1 == V2 ? 1 : 0); break;
case GTOP: t = (V1 > V2 ? 1 : 0); break;
case GEOP: t = (V1 >= V2 ? 1 : 0); break;
case NEOP: t = (V1 != V2 ? 1 : 0); break;
case LEOP: t = (V1 <= V2 ? 1 : 0); break;
}
goto Return;
Step3: /* Disjunction. */
Cp = RED(C);
while (Cp != NIL)
{
ADV(Cp,&C1,&Cp);
t = ISDESIRED(c,C1);
if (t == 1) goto Return;
}
t = 0;
goto Return;
Step4: /* Conjunction. */
Cp = RED(C);
while (Cp != NIL)
{
ADV(Cp,&C1,&Cp);
t = ISDESIRED(c,C1);
if (t == 0) goto Return;
}
t = 1;
goto Return;
Step5: /* Negation. */
C1 = SECOND(C);
t = (ISDESIRED(c,C1) ? 0 : 1);
goto Return;
Step6: /* <==. */
C1 = SECOND(C);
C2 = THIRD(C);
t = (ISDESIRED(c,C1) || (!ISDESIRED(c,C2)) ? 1 : 0);
goto Return;
Step7: /* ==>. */
C1 = SECOND(C);
C2 = THIRD(C);
t = ((!ISDESIRED(c,C1)) || ISDESIRED(c,C2) ? 1 : 0);
goto Return;
Step8: /* <==>. */
C1 = SECOND(C);
C2 = THIRD(C);
t = (ISDESIRED(c,C1) == ISDESIRED(c,C2) ? 1 : 0);
goto Return;
Return: /* Prepare for return. */
return(t);
}
void SPFRPSFT(Word P, Word c, Word k, Word *R_, Word *F_)
{
Word R,F,Pk1,l,R1,i,j,S,Si,Pi,Sij,Pij,G,g;
Word H,h,f1,f2,f3,f4,f5,f6,n,n1,n2,L,L1,L2;
Step1: /* Initialize. */
Pk1 = LELTI(P,k+1);
l = LENGTH(Pk1);
R = NIL;
for (i=1; i<=l; i++) {
R1 = NIL;
for (j=1; j<=l; j++)
R1 = COMP(1,R1);
R = COMP(R1,R); }
F = NIL;
for (i=1; i<=l; i++)
F = COMP(1,F);
if (l == 0) goto Return;
Step2: /* Update. */
S = LELTI(c,SIGNPF);
S = CINV(S);
for (i=1; i<=k; i++) {
ADV(S,&Si,&S);
ADV(P,&Pi,&P);
while (Si != NIL) {
ADV(Si,&Sij,&Si);
ADV(Pi,&Pij,&Pi);
if (Sij != 0) continue;
G = LELTI(Pij,PO_PARENT);
while (G != NIL) {
ADV(G,&g,&G);
if (FIRST(g) != PO_FAC) continue;
H = LELTI(THIRD(g),PO_PARENT);
while (H != NIL) {
ADV(H,&h,&H);
switch(FIRST(h)) {
case PO_LCO:
FIRST3(h,&f1,&f2,&f3);
if (f2 != 0) break;
L = LELTI(f3,PO_LABEL);
if (SECOND(L) != k+1) break;
n = PLPOS(Pk1,THIRD(L));
if (n == 0) FAIL("SPFRPSFT","PO_LCO");
SLELTI(F,n,0);
break;
case PO_DIS:
FIRST4(h,&f1,&f2,&f3,&f4);
if (f2 != 0 || f3 != 0) break;
L = LELTI(f4,PO_LABEL);
if (SECOND(L) != k+1) break;
n = PLPOS(Pk1,THIRD(L));
if (n == 0) FAIL("SPFRPSFT","PO_DIS");
SLELTI(F,n,0);
break;
case PO_RES:
FIRST6(h,&f1,&f2,&f3,&f4,&f5,&f6);
if (f2 != 0 || f3 != 0 || f5 != 0) break;
L1 = LELTI(f4,PO_LABEL);
if (SECOND(L1) != k+1) break;
L2 = LELTI(f6,PO_LABEL);
if (SECOND(L2) != k+1)
FAIL("SPFRPSFT","resultant of diff level");
n1 = PLPOS(Pk1,THIRD(L1));
if (n1 == 0) FAIL("SPFRPSFT","PO_RES: n1");
n2 = PLPOS(Pk1,THIRD(L2));
if (n2 == 0) FAIL("SPFRPSFT","PO_RES: n2");
if (n2 > n1)
SLELTI(LELTI(R,n1),n2,0);
else
FAIL("SPFRPSFT","n2 <= n1");
break; } } } } }
Return: /* Prepare for return. */
*R_ = R;
*F_ = F;
return;
}
Word FMAQEXTAF(Word F)
{
return (ISLIST(FIRST(F)) && ISLIST(SECOND(F)));
}
Word RIIFACMA(Word I, Word A, Word t, Word P, Word J, Word K)
{
Word i1,i2,b1,b2,p,i,s;
FIRST2(I,&i1,&i2);
b1 = FIRST(J);
if (K != 0)
b2 = SECOND(K);
else
b2 = SECOND(J);
p = IPLBREVAL(2,P,b1);
while(TSVSLI(p,LIST2(i1,i2)) != 0)
{i = LSIM(i1,i2);
s = LBRNSIGN(IUPLBREVAL(A,i));
if (s == 0) {
i1 = LSIM(i1,i);
i2 = LSIM(i,i2); }
else if (s == t)
i2 = i;
else
i1 = i; }
while(IUPLBREVAL(p,i1) == 0)
{i = LSIM(i1,i2);
s = LBRNSIGN(IUPLBREVAL(A,i));
if (s == 0) {
i1 = LSIM(i1,i);
i2 = LSIM(i,i2); }
else if (s == t)
i2 = i;
else
i1 = i; }
while(IUPLBREVAL(p,i2) == 0)
{i = LSIM(i1,i2);
s = LBRNSIGN(IUPLBREVAL(A,i));
if (s == 0) {
i1 = LSIM(i1,i);
i2 = LSIM(i,i2); }
else if (s == t)
i2 = i;
else
i1 = i; }
p = IPLBREVAL(2,P,b2);
while(TSVSLI(p,LIST2(i1,i2)) != 0)
{i = LSIM(i1,i2);
s = LBRNSIGN(IUPLBREVAL(A,i));
if (s == 0) {
i1 = LSIM(i1,i);
i2 = LSIM(i,i2); }
else if (s == t)
i2 = i;
else
i1 = i; }
while(IUPLBREVAL(p,i1) == 0)
{i = LSIM(i1,i2);
s = LBRNSIGN(IUPLBREVAL(A,i));
if (s == 0) {
i1 = LSIM(i1,i);
i2 = LSIM(i,i2); }
else if (s == t)
i2 = i;
else
i1 = i; }
while(IUPLBREVAL(p,i2) == 0)
{i = LSIM(i1,i2);
s = LBRNSIGN(IUPLBREVAL(A,i));
if (s == 0) {
i1 = LSIM(i1,i);
i2 = LSIM(i,i2); }
else if (s == t)
i2 = i;
else
i1 = i; }
return LIST2(i1,i2);
}
Word sacMain()
{
interval *A;
Word P,t,L,n;
SWRITE("Enter pol. in x: ");
IPEXPREAD(1,LIST1(LFS("x")),&P,&t);
CREAD();
I = LBRIREAD();
Step1: /* Convert the isolating interval for \alpha to a
hardware interval. */
L = NIL;
LBRNIEEEE(FIRST(I), &t,&F1,&n1);
if (t != 0)
goto Return;
w1 = F1.num;
LBRNIEEEE(SECOND(I), &t,&F2,&n2);
if (t != 0)
goto Return;
w2 = F2.num;
np = MIN(n1,n2);
Step2: /* Convert the minimal polynomial to a hardware interval
polynomial and refine the hardware interval. */
FPCATCH();
IUPHIP(P,&A,&t);
if (t == 0) {
t = 1;
goto Return; }
n = PDEG(M);
t = HIPFES(n,A,w2);
if (FPCHECK() == 1) {
t = 1;
goto Return; }
if (t == NIL) {
t = 2;
goto Return; }
u = 0;
while (u == 0 && np > 0) {
p = (w1 + w2) / 2.0;
s = HIPFES(n,A,p);
if ((FPCHECK() == 1) || (s == NIL))
u = 1;
else if (s == t)
w2 = p;
else if (s == -t)
w1 = p;
else {
w1 = p;
w2 = p; }
np = np - 1; }
K.left = w1;
K.right = w2;
HIPFES(PDEG(P),A,x);
return 0;
}
Word RMCAFS(Word F)
{
Word F1,F2,Fb,Fp,Fp1,Fp2,T,t,t1,t2;
/* hide t,t1,t2; */
Step1: /* Classify the formula F. */
T = FIRST(F);
if (T == ANDOP) goto Step3;
if (T == OROP) goto Step4;
if (T == NOTOP) goto Step5;
if (T == RIGHTOP) goto Step6;
if (T == LEFTOP) goto Step7;
if (T == EQUIOP) goto Step8;
Step2: /* Atomic Formula. */
t = TYPEAF(F);
if (t == TRUE) {
Fp = LIST4(EQOP,0,0,NIL);
goto Return;
}
if (t == FALSE) {
Fp = LIST4(NEOP,0,0,NIL);
goto Return;
}
Fp = F;
goto Return;
Step3: /* Conjunction. */
Fb = RED(F);
Fp = LIST1(ANDOP);
while (Fb != NIL)
{
ADV(Fb,&F1,&Fb);
Fp1 = RMCAFS(F1);
t = TYPEQFF(Fp1);
if (t == FALSE) {
Fp = LIST4(NEOP,0,0,NIL);
goto Return;
}
if (t == UNDET) Fp = COMP(Fp1,Fp);
}
if (LENGTH(Fp) == 1) {
Fp = LIST4(EQOP,0,0,NIL);
goto Return;
}
if (LENGTH(Fp) == 2) {
Fp = FIRST(Fp);
goto Return;
}
Fp = INV(Fp);
goto Return;
Step4: /* Disjunction. */
Fb = RED(F);
Fp = LIST1(OROP);
while (Fb != NIL)
{
ADV(Fb,&F1,&Fb);
Fp1 = RMCAFS(F1);
t = TYPEQFF(Fp1);
if (t == TRUE) {
Fp = LIST4(EQOP,0,0,NIL);
goto Return;
}
if (t == UNDET) Fp = COMP(Fp1,Fp);
}
if (LENGTH(Fp) == 1) {
Fp = LIST4(NEOP,0,0,NIL);
goto Return;
}
if (LENGTH(Fp) == 2) {
Fp = FIRST(Fp);
goto Return;
}
Fp = INV(Fp);
goto Return;
Step5: /* Negation. */
F1 = SECOND(F);
Fp1 = RMCAFS(F1);
t = TYPEQFF(Fp1);
if (t == TRUE) Fp = LIST4(NEOP,0,0,NIL);
else if (t == FALSE) Fp = LIST4(EQOP,0,0,NIL);
else Fp = LIST2(NOTOP,Fp1);
goto Return;
Step6: /* $\Rightarrow$. */
F1 = SECOND(F);
Fp1 = RMCAFS(F1);
t1 = TYPEQFF(Fp1);
F2 = THIRD(F);
Fp2 = RMCAFS(F2);
t2 = TYPEQFF(Fp2);
if (t1 == TRUE) Fp = Fp2;
else if (t1 == FALSE) Fp = LIST4(EQOP,0,0,NIL);
else if (t2 == TRUE) Fp = LIST4(EQOP,0,0,NIL);
else if (t2 == FALSE) Fp = LIST2(NOTOP,Fp1);
else Fp = LIST3(RIGHTOP,Fp1,Fp2);
goto Return;
Step7: /* $\Leftarrow$. */
F1 = THIRD(F);
Fp1 = RMCAFS(F1);
t1 = TYPEQFF(Fp1);
F2 = SECOND(F);
Fp2 = RMCAFS(F2);
t2 = TYPEQFF(Fp2);
if (t1 == TRUE) Fp = Fp2;
else if (t1 == FALSE) Fp = LIST4(EQOP,0,0,NIL);
else if (t2 == TRUE) Fp = LIST4(EQOP,0,0,NIL);
else if (t2 == FALSE) Fp = LIST2(NOTOP,Fp1);
else Fp = LIST3(LEFTOP,Fp2,Fp1);
goto Return;
Step8: /* $\Leftrightarrow$. */
F1 = SECOND(F);
Fp1 = RMCAFS(F1);
t1 = TYPEQFF(Fp1);
F2 = THIRD(F);
Fp2 = RMCAFS(F2);
t2 = TYPEQFF(Fp2);
if (t1 == TRUE) Fp = Fp2;
else if (t2 == TRUE) Fp = Fp1;
else if (t1 == FALSE && t2 == FALSE) Fp = LIST4(EQOP,0,0,NIL);
else if (t1 == FALSE) Fp = LIST2(NOTOP,Fp2);
else if (t2 == FALSE) Fp = LIST2(NOTOP,Fp1);
else Fp = LIST3(EQUIOP,Fp1,Fp2);
goto Return;
Return: /* Prepare for return. */
return(Fp);
}
/*
* Evaluate a function object into a object.
*/
COObject *
vm_eval(COObject *func, COObject *globals)
{
#define JUMPBY(offset) next_code += offset
#define JUMPTO(offset) next_code = first_code + offset
#define NEXTOP() (*next_code++)
#define NEXTARG() (next_code += 2, (next_code[-1]<<8) + next_code[-2])
#define GETITEM(v, i) COTuple_GET_ITEM((COTupleObject *)(v), i)
#define GETLOCAL(i) (fastlocals[i])
#define SETLOCAL(i, v) \
do { \
COObject *tmp = GETLOCAL(i); \
GETLOCAL(i) = v; \
CO_XDECREF(tmp); \
} while (0);
#define PUSH(o) (*stack_top++ = (o))
#define POP() (*--stack_top)
#define TOP() (stack_top[-1])
#define SET_TOP(o) (stack_top[-1] = (o))
#define SECOND() (stack_top[-2])
#define THIRD() (stack_top[-3])
#define FOURTH() (stack_top[-4])
#define PEEK(n) (stack_top[-(n)])
#define STACK_ADJ(n) (stack_top += n)
#define STACK_LEVEL() ((int)(stack_top - TS(frame)->f_stack))
#define UNWIND_BLOCK(b) \
do { \
while (STACK_LEVEL() > (b)->fb_level) { \
COObject *o = POP(); \
CO_XDECREF(o); \
} \
} while (0)
COCodeObject *code;
COObject *names;
COObject *consts;
COObject *localnames;
COObject *funcargs = COList_New(0);
COObject **fastlocals;
COObject **stack_top; /* Stack top, points to next free slot in stack */
unsigned char *next_code;
unsigned char *first_code;
unsigned char opcode; /* Current opcode */
int oparg; /* Current opcode argument, if any */
COObject *x; /* Result object -- NULL if error */
COObject *o1, *o2, *o3; /* Temporary objects popped of stack */
int status; /* VM status */
int err; /* C function error code */
status = STATUS_NONE;
TS(frame) =
(COFrameObject *)COFrame_New((COObject *)TS(frame), func, globals);
new_frame: /* reentry point when function call/return */
code = (COCodeObject *)((COFunctionObject *)TS(frame)->f_func)->func_code;
stack_top = TS(frame)->f_stacktop;
names = code->co_names;
localnames = code->co_localnames;
consts = code->co_consts;
first_code = (unsigned char *)COBytes_AsString(code->co_code);
next_code = first_code + TS(frame)->f_lasti;
fastlocals = TS(frame)->f_extraplus;
/* Parse arguments. */
if (COList_GET_SIZE(funcargs)) {
// check arguments count
if (code->co_argcount != COList_GET_SIZE(funcargs)) {
COErr_Format(COException_ValueError,
"takes exactly %d arguments (%d given)",
code->co_argcount, COList_Size(funcargs));
status = STATUS_EXCEPTION;
goto fast_end;
}
size_t n = COList_Size(funcargs);
for (int i = 0; i < n; i++) {
x = COList_GetItem(funcargs, 0);
CO_INCREF(x);
SETLOCAL(n - i - 1, x);
COList_DelItem(funcargs, 0);
}
}
for (;;) {
opcode = NEXTOP();
switch (opcode) {
case OP_BINARY_ADD:
o1 = POP();
o2 = TOP();
if (COStr_Check(o1) && COStr_Check(o2)) {
COStr_Concat(&o2, o1);
x = o2;
goto skip_decref_o2;
} else {
x = COInt_Type.tp_int_interface->int_add(o1, o2);
}
CO_DECREF(o2);
skip_decref_o2:
CO_DECREF(o1);
SET_TOP(x);
if (!x) {
status = STATUS_EXCEPTION;
goto fast_end;
}
break;
case OP_BINARY_SUB:
o1 = POP();
o2 = TOP();
x = COInt_Type.tp_int_interface->int_sub(o2, o1);
CO_DECREF(o1);
CO_DECREF(o2);
SET_TOP(x);
break;
case OP_BINARY_MUL:
o1 = POP();
o2 = TOP();
x = COInt_Type.tp_int_interface->int_mul(o2, o1);
CO_DECREF(o1);
CO_DECREF(o2);
SET_TOP(x);
break;
case OP_BINARY_DIV:
o1 = POP();
o2 = TOP();
x = COInt_Type.tp_int_interface->int_div(o2, o1);
CO_DECREF(o1);
CO_DECREF(o2);
SET_TOP(x);
break;
case OP_BINARY_MOD:
o1 = POP();
o2 = TOP();
x = COInt_Type.tp_int_interface->int_mod(o2, o1);
CO_DECREF(o1);
CO_DECREF(o2);
SET_TOP(x);
break;
case OP_BINARY_SL:
o1 = POP();
o2 = TOP();
x = COInt_Type.tp_int_interface->int_lshift(o2, o1);
CO_DECREF(o1);
CO_DECREF(o2);
SET_TOP(x);
break;
case OP_BINARY_SR:
o1 = POP();
o2 = TOP();
x = COInt_Type.tp_int_interface->int_rshift(o2, o1);
CO_DECREF(o1);
CO_DECREF(o2);
SET_TOP(x);
break;
case OP_BINARY_SUBSCRIPT:
o1 = POP();
o2 = TOP();
if (!CO_TYPE(o2)->tp_mapping_interface) {
COErr_Format(COException_TypeError,
"'%.200s' object is not subscriptable",
CO_TYPE(o2)->tp_name);
status = STATUS_EXCEPTION;
} else {
x = CO_TYPE(o2)->tp_mapping_interface->mp_subscript(o2, o1);
if (!x) {
status = STATUS_EXCEPTION;
goto fast_end;
}
}
CO_DECREF(o1);
CO_DECREF(o2);
SET_TOP(x);
break;
case OP_CMP:
o1 = POP();
o2 = TOP();
oparg = NEXTARG();
x = vm_cmp(oparg, o1, o2);
if (!x) {
status = STATUS_EXCEPTION;
goto fast_end;
}
CO_DECREF(o1);
CO_DECREF(o2);
SET_TOP(x);
break;
case OP_UNARY_NEGATE:
o1 = TOP();
x = COInt_Type.tp_int_interface->int_neg(o1);
CO_DECREF(o1);
SET_TOP(x);
break;
case OP_UNARY_INVERT:
o1 = TOP();
x = COInt_Type.tp_int_interface->int_invert(o1);
CO_DECREF(o1);
SET_TOP(x);
break;
case OP_LOAD_LOCAL:
oparg = NEXTARG();
x = GETLOCAL(oparg);
CO_INCREF(x);
PUSH(x);
break;
case OP_LOAD_NAME:
oparg = NEXTARG();
o1 = GETITEM(names, oparg);
x = COObject_get(o1);
if (!x) {
COErr_Format(COException_NameError, "name '%s' is not defined",
COStr_AsString(o1));
status = STATUS_EXCEPTION;
goto fast_end;
}
CO_INCREF(x);
PUSH(x);
break;
case OP_LOAD_UPVAL:
oparg = NEXTARG();
o1 = COTuple_GET_ITEM(((COFunctionObject *)func)->func_upvalues,
oparg);
o2 = COCell_Get(o1);
PUSH(o2);
break;
case OP_LOAD_CONST:
oparg = NEXTARG();
x = GETITEM(consts, oparg);
CO_INCREF(x);
PUSH(x);
break;
case OP_BUILD_TUPLE:
oparg = NEXTARG();
x = COTuple_New(oparg);
if (x != NULL) {
for (; --oparg >= 0;) {
o1 = POP();
COTuple_SetItem(x, oparg, o1);
CO_DECREF(o1);
}
PUSH(x);
}
break;
case OP_BUILD_LIST:
oparg = NEXTARG();
x = COList_New(oparg);
if (x != NULL) {
for (; --oparg >= 0;) {
o1 = POP();
COList_SetItem(x, oparg, o1);
CO_DECREF(o1);
}
PUSH(x);
}
break;
case OP_DICT_BUILD:
oparg = NEXTARG();
x = CODict_New();
PUSH(x);
break;
case OP_DICT_ADD:
o1 = POP();
o2 = POP();
o3 = POP();
CODict_SetItem(o3, o2, o1);
x = o3;
CO_DECREF(o1);
CO_DECREF(o2);
PUSH(x);
break;
case OP_STORE_NAME:
oparg = NEXTARG();
o1 = GETITEM(names, oparg);
o2 = POP();
COObject_set(o1, o2);
CO_DECREF(o2);
break;
case OP_STORE_UPVAL:
oparg = NEXTARG();
o1 = COTuple_GET_ITEM(((COFunctionObject *)func)->func_upvalues,
oparg);
o2 = POP();
COCell_Set(o1, o2);
CO_DECREF(o2);
break;
case OP_STORE_LOCAL:
oparg = NEXTARG();
o1 = POP();
SETLOCAL(oparg, o1);
break;
case OP_JMPZ:
oparg = NEXTARG();
o1 = POP();
if (o1 == CO_True) {
} else if (o1 == CO_False) {
JUMPTO(oparg);
} else {
err = COObject_IsTrue(o1);
if (err > 0)
err = 0;
else if (err == 0)
JUMPTO(oparg);
}
CO_DECREF(o1);
break;
case OP_JMP:
oparg = NEXTARG();
JUMPBY(oparg);
break;
case OP_JMPX:
oparg = NEXTARG();
JUMPTO(oparg);
break;
case OP_DECLARE_FUNCTION:
o1 = POP();
x = COFunction_New(o1);
COCodeObject *c = (COCodeObject *)o1;
for (int i = 0; i < CO_SIZE(c->co_upvals); i++) {
COObject *name = COTuple_GET_ITEM(c->co_upvals, i);
COObject *upvalue = COObject_get(name);
if (!upvalue) {
// local variables
for (int j = 0; j < COTuple_Size(localnames); j++) {
if (COObject_CompareBool
(COTuple_GET_ITEM(localnames, j), name, Cmp_EQ)) {
upvalue = GETLOCAL(j);
}
}
}
COObject *cell = COCell_New(upvalue);
COTuple_SET_ITEM(((COFunctionObject *)x)->func_upvalues, i,
cell);
}
CO_DECREF(o1);
PUSH(x);
break;
case OP_CALL_FUNCTION:
o1 = POP();
oparg = NEXTARG();
COObject *args = COTuple_New(oparg);
while (--oparg >= 0) {
o2 = POP();
COTuple_SetItem(args, oparg, o2);
CO_DECREF(o2);
}
if (COCFunction_Check(o1)) {
COCFunction cfunc = COCFunction_GET_FUNCTION(o1);
x = cfunc(NULL, args);
CO_DECREF(o1);
CO_DECREF(args);
PUSH(x);
} else if (COFunction_Check(o1)) {
ssize_t i = CO_SIZE(args);
while (--i >= 0) {
COList_Append(funcargs, COTuple_GET_ITEM(args, i));
}
CO_DECREF(args);
TS(frame)->f_stacktop = stack_top;
TS(frame)->f_lasti = (int)(next_code - first_code);
TS(frame) =
(COFrameObject *)COFrame_New((COObject *)TS(frame), o1,
globals);
CO_DECREF(o1);
func = o1;
goto new_frame;
} else {
x = COObject_Call(o1, args);
CO_DECREF(args);
CO_DECREF(o1);
PUSH(x);
}
break;
case OP_RETURN:
o1 = POP();
TS(frame)->f_stacktop = stack_top;
TS(frame)->f_lasti = (int)(next_code - first_code);
COFrameObject *old_frame = (COFrameObject *)TS(frame);
TS(frame) = (COFrameObject *)old_frame->f_prev;
CO_DECREF(old_frame);
if (!TS(frame)) {
CO_DECREF(o1);
goto vm_exit;
}
// init function return
*(TS(frame)->f_stacktop++) = o1;
goto new_frame;
break;
case OP_SETUP_LOOP:
oparg = NEXTARG();
COFrameBlock_Setup(TS(frame), opcode, oparg, STACK_LEVEL());
break;
case OP_SETUP_TRY:
oparg = NEXTARG();
COFrameBlock_Setup(TS(frame), opcode, oparg, STACK_LEVEL());
break;
case OP_POP_BLOCK:
{
COFrameBlock *fb = COFrameBlock_Pop(TS(frame));
UNWIND_BLOCK(fb);
}
break;
case OP_POP_TRY:
{
COFrameBlock *fb = COFrameBlock_Pop(TS(frame));
UNWIND_BLOCK(fb);
}
break;
case OP_BREAK_LOOP:
status = STATUS_BREAK;
break;
case OP_CONTINUE_LOOP:
oparg = NEXTARG();
status = STATUS_CONTINUE;
break;
case OP_THROW:
oparg = NEXTARG();
if (oparg == 1) {
o1 = POP();
} else if (oparg == 0) {
o1 = CO_None;
} else {
error("error oparg");
}
status = STATUS_EXCEPTION;
COErr_SetObject(COException_SystemError, o1);
break;
case OP_DUP_TOP:
o1 = TOP();
CO_INCREF(o1);
PUSH(o1);
break;
case OP_POP_TOP:
o1 = POP();
CO_DECREF(o1);
break;
case OP_END_TRY:
o1 = POP();
COErr_SetString(COException_SystemError, COStr_AsString(o1));
status = STATUS_EXCEPTION;
CO_DECREF(o1);
break;
case OP_SETUP_FINALLY:
oparg = NEXTARG();
COFrameBlock_Setup(TS(frame), opcode, oparg, STACK_LEVEL());
break;
case OP_END_FINALLY:
o1 = POP();
if (o1 != CO_None) {
COErr_SetString(COException_SystemError, COStr_AsString(o1));
status = STATUS_EXCEPTION;
}
CO_DECREF(o1);
break;
case OP_STORE_SUBSCRIPT:
o1 = TOP();
o2 = SECOND();
o3 = THIRD();
STACK_ADJ(-3);
if (COList_Check(o3)) {
err = COList_SetItem(o3, COInt_AsSsize_t(o2), o1);
} else if (CODict_Check(o3)) {
CODict_SetItem(o3, o2, o1);
} else {
error("wrong store subscript");
}
CO_DECREF(o1);
CO_DECREF(o2);
CO_DECREF(o3);
break;
case OP_GET_ITER:
o1 = TOP();
x = COObject_GetIter(o1);
CO_DECREF(o1);
SET_TOP(x);
break;
case OP_FOR_ITER:
oparg = NEXTARG();
o1 = TOP();
x = (*o1->co_type->tp_iternext) (o1);
if (x) {
PUSH(x);
break;
}
o1 = POP();
CO_DECREF(o1);
JUMPTO(oparg);
break;
default:
error("unknown handle for opcode(%ld)\n", opcode);
}
fast_end:
while (status != STATUS_NONE && TS(frame)->f_iblock > 0) {
COFrameBlock *fb =
&TS(frame)->f_blockstack[TS(frame)->f_iblock - 1];
if (fb->fb_type == OP_SETUP_LOOP && status == STATUS_CONTINUE) {
status = STATUS_NONE;
JUMPTO(oparg);
break;
}
TS(frame)->f_iblock--;
UNWIND_BLOCK(fb);
if (fb->fb_type == OP_SETUP_LOOP && status == STATUS_BREAK) {
status = STATUS_NONE;
JUMPTO(fb->fb_handler);
break;
}
if (fb->fb_type == OP_SETUP_TRY && status == STATUS_EXCEPTION) {
status = STATUS_NONE;
COObject *exc, *val, *tb;
COErr_Fetch(&exc, &val, &tb);
PUSH(val);
JUMPTO(fb->fb_handler);
break;
}
}
/* End the loop if we still have an error (or return) */
x = NULL;
if (status != STATUS_NONE)
break;
}
vm_exit:
/* Clear frame stack. */
while (TS(frame)) {
COFrameObject *tmp_frame = (COFrameObject *)TS(frame)->f_prev;
CO_DECREF(TS(frame));
TS(frame) = tmp_frame;
}
return x;
}
void IBPRRIOAP(Word M,Word I,Word B,Word k, Word *L_,BDigit *t_)
{
Word L,CFP,Bp,Ls,Lp;
BDigit t,n,n1,n2,np,u,s,e,i,j,t1,tc,c;
ieee F1,F2;
double p,w1,w2;
interval *A,K,*Q,*HICFP,J;
Step1: /* Convert the isolating interval for \alpha to a
hardware interval. */
L = NIL;
LBRNIEEEE(FIRST(I), &t,&F1,&n1);
if (t != 0)
goto Return;
w1 = F1.num;
LBRNIEEEE(SECOND(I), &t,&F2,&n2);
if (t != 0)
goto Return;
w2 = F2.num;
np = MIN(n1,n2);
Step2: /* Convert the minimal polynomial to a hardware interval
polynomial and refine the hardware interval. */
FPCATCH();
IUPHIP(M,&A,&t);
if (t == 0) {
t = 1;
goto Return; }
n = PDEG(M);
t = HIPFES(n,A,w2);
if (FPCHECK() == 1) {
t = 1;
goto Return; }
if (t == NIL) {
t = 2;
goto Return; }
u = 0;
while (u == 0 && np > 0) {
p = (w1 + w2) / 2.0;
s = HIPFES(n,A,p);
if ((FPCHECK() == 1) || (s == NIL))
u = 1;
else if (s == t)
w2 = p;
else if (s == -t)
w1 = p;
else {
w1 = p;
w2 = p; }
np = np - 1; }
K.left = w1;
K.right = w2;
Step3: /* Isolate the roots of B(alpha,y) */
/* Get hardware interval array to store B(alpha,y) (init to zero) */
Q = GETHIPARRAY(PDEG(B));
for(i = 0; i < PDEG(B) + 1; i++)
IHI(0,&(Q[i]),&t); /* this can't fail! */
/* Compute B(alpha,y) and store in Q */
for(Bp = B; Bp != NIL; Bp = RED2(Bp)) {
FIRST2(Bp,&e,&CFP);
IUPHIP(CFP,&HICFP,&c);
Q[e] = HIPIEVAL(PDEG(CFP),HICFP,K); }
/* Check leading coefficient */
s = HISIGN(Q[PDEG(B)]);
if (s == NIL) {
t = 3;
goto Return; }
/* get trend of first root */
if (PDEG(B) % 2 == 0 && s == 1 || PDEG(B) % 2 == 1 && s == -1)
t1 = -1;
else
t1 = 1;
/* Isolate the roots of B(alpha,y) */
HIPRRID(PDEG(B),Q, &L,&t);
if (t != 0)
goto Return;
Step4: /* Refine roots? */
if (k == NIL)
goto Return;
Ls = NIL;
for(Lp = L, tc = t1; Lp != NIL; Lp = RED(Lp), tc *= -1)
{
LBRIHI(FIRST(Lp),&J,&t); /* Can this fail? */
if (LBRNCOMP(FIRST(FIRST(Lp)),SECOND(FIRST(Lp))) != 0) {
/* Open interval! */
j = -LSILW(FIRST(Lp));
HIPIR(PDEG(B),Q,J,tc,j,k,&J,&j);
Ls = COMP(HILBRI(J),Ls); }
else {
/* 1-Point interval! */
Ls = COMP(FIRST(Lp),Ls); }
}
L = CINV(Ls);
t = 0;
Return: /* Return L and t. */
*L_ = L;
*t_ = t;
return;
}
void IBPRRIOAPSF(Word M, Word I, Word B, BDigit p, BDigit k, Word *J_, Word *L_)
{
BDigit *Mp,*bp,*c,i,m,n,q1,q2,S,s,t;
Word b,Bp,I1,I2,J,K,L,Ls,Lp,T,Jp;
Step1: /* Convert the minimal polynomial to a software interval
polynomial. */
n = PDEG(M);
q1 = p + 3;
q2 = q1 + q1;
S = (n + 1) * q2 + 1;
Mp = GETARRAY(S);
IPSIP(M,p,Mp);
Step2: /* Compute the trend of \alpha. */
b = SECOND(I);
bp = GETARRAY(q1);
t = LBRNFEC(b,p,bp);
J = I;
L = 0;
if (t == 0) {
FREEARRAY(bp);
goto Return; }
t = SIPES(Mp,bp);
FREEARRAY(bp);
if (t == NIL)
goto Return;
Step3: /* Refine the isolating interval for \alpha. */
J = SIPIR(Mp,I,t,- (p * ZETA));
FREEARRAY(Mp);
Step4: /* Isolate the real roots of B(J)[Y]. */
L = NIL;
m = PDEG(B);
s = (m + 1) * q2 + 1;
c = GETARRAY(s);
IBPELBRISIPR(B,J,p,c);
L = SIPRRID(c);
if (L == 0)
goto Step8;
t = c[s - q2 + 1];
if (EVEN(m))
t = -t;
Step5: /* Refine the intervals. */
if (k == NIL)
goto Return;
Ls = NIL;
for(Lp = L; Lp != NIL; Lp = RED(Lp))
{
Jp = SIPIR(c,FIRST(Lp),t,-k);
Ls = COMP(Jp,Ls);
t = -t;
}
L = CINV(Ls);
Step8: /* Free arrays. */
FREEARRAY(c);
Return: /* Return J and L. */
*J_ = J;
*L_ = L;
return;
}
