Private void k_descr_error(
short int msg_no,
DESCRIPTOR * descr)
{
char * var;
char message[80+1];
char * p;
strcpy(message, sysmsg(msg_no));
p = strchr(message, '|');
if ((var = k_var_name(descr)) != NULL)
{
*p = ' ';
k_error(message, var);
}
else
{
*p = '\0';
k_error(message);
}
}
Private void itype()
{
/* Stack:
|=============================|=============================|
| BEFORE | AFTER |
|=============================|=============================|
top | ADDR to object code | Result |
|=============================|=============================|
*/
DESCRIPTOR * descr;
STRING_CHUNK * str;
char * p;
short int i;
int n;
u_char type;
unsigned short int header_flags;
OBJECT_HEADER * obj;
/* Find I-type code. An I-type must be referenced via an ADDR as we are
going to pop the pointer and use the actual string. Anything else would
require that we dereference the string on leaving the I-type program.
This implies that an I-type must be a variable or an array reference, not
a field extraction, etc. */
descr = e_stack - 1;
if (descr->type != ADDR) k_error(sysmsg(1470));
do {descr = descr->data.d_addr;} while(descr->type == ADDR);
k_get_string(descr);
descr->data.str.saddr = s_make_contiguous(descr->data.str.saddr, NULL);
str = descr->data.str.saddr;
if (str == NULL) goto inva_i_type;
p = str->data;
type = UpperCase(*p);
if ((type == 'I') || (type == 'C') || (type == 'A') || (type == 'S'))
{
/* It's a complete dictionary record */
for(i = 15; i--;) /* Skip 15 field marks */
{
p = strchr(p, FIELD_MARK);
if (p == NULL) goto inva_i_type;
p++;
}
}
if (*p != HDR_MAGIC)
{
if (*p == HDR_MAGIC_INVERSE) convert_object_header((OBJECT_HEADER *)p);
if (*p != HDR_MAGIC) goto inva_i_type;
}
k_pop(1);
if (((long int)p) & 0x00000003)
{
/* Not word aligned - must make a copy. To ensure that this gets
released at an abort, we push a string descriptor onto the stack */
n = str->bytes - (p - str->data);
k_put_string(p, n, e_stack);
obj = (OBJECT_HEADER *)((e_stack++)->data.str.saddr->data);
header_flags = obj->flags;
k_recurse((u_char *)obj, 0);
if (header_flags & HDR_CTYPE) /* 0560 */
{
k_release(e_stack - 1);
}
else
{
k_release(e_stack - 2);
*(e_stack - 2) = *(e_stack - 1);
}
e_stack--;
}
else
{
header_flags = ((OBJECT_HEADER *)p)->flags;
k_recurse((u_char *)p, 0);
}
/* If this is a C-type, load @ANS on to the stack */
if (header_flags & HDR_CTYPE)
{
*e_stack = *(Element(process.syscom, SYSCOM_AT_ANS));
if (e_stack->type >= COMPLEX_DESCR) k_incr_refct(e_stack);
e_stack++;
}
return;
inva_i_type:
k_recurse(pcode_itype, 1);
if (process.status == ER_INVA_ITYPE) k_error(sysmsg(1471));
}
static void exec_action(int op,int arg1,int arg2)
{
int i, j;
char *tmpstr;
switch(op)
{
case 1000:goto_room(arg1-first_room);break;
case 1001:goto_room(agt_rand(arg1,arg2)-first_room);break;
case 1002:agt_var[arg1]=loc+first_room;break;
case 1003:agt_var[arg1]=dobj;break;
case 1004:agt_var[arg1]=iobj;break;
case 1005:goto_room(agt_var[arg1]-first_room);break;
case 1006:it_move(arg1,agt_var[arg2]);break;
case 1007:get_obj(agt_var[arg1]);break;
case 1008:msgout(agt_var[arg1],1);break;
case 1009:get_obj(arg1);break;
case 1010:get_obj(arg1);it_move(arg1,1000);break;
case 1011:drop_obj(arg1);break;
case 1012:
if (it_loc(arg1)==1000) {
if (PURE_WEAR) drop_obj(arg1);
else it_move(arg1,1);
}
break;
case 1013:fontcmd(0,arg1-1);break; /* Load font */
case 1014:pictcmd(1,pictable[arg1-1]);break; /* Show picture */
case 1015:changepict(arg1,arg2);break; /* ChangePicture */
case 1016: if (PICT_SUPPORT &&
yesno("Would you like to see the picture?"))
pictcmd(1,pictable[arg1-1]);break;
case 1017:pictcmd(2,arg1);break; /* Show room pix */
case 1018: if (PICT_SUPPORT &&
yesno("Would you like to see the picture?"))
pictcmd(2,arg1-1);break;
case 1019:musiccmd(1,arg1-1);break;
case 1020:musiccmd(1,agt_rand(arg1,arg2)-1);break;
case 1021:musiccmd(2,arg1-1);break;
case 1022:musiccmd(3,-1); break; /* Stop Repeat */
case 1023:musiccmd(4,-1); break; /* Stop song */
case 1024:musiccmd(5,-1); break; /* Suspend song */
case 1025:musiccmd(6,-1);break; /* Resume song */
case 1026:
if (tnoun(dobj))
noun[dobj-first_noun].movable=!noun[dobj-first_noun].movable;
break;
case 1027: it_newdesc(arg1,&msg_ptr[arg2-1]); break;
case 1028:
if (tnoun(arg1)) noun[arg1-first_noun].points=arg2;
else if (tcreat(arg1)) creature[arg1-first_creat].points=arg2;
else if (troom(arg1)) room[arg1-first_room].points=arg2;
break;
case 1029:it_destroy(iobj);break;
case 1030:
tmpstr=agt_readline(3);
i=strlen(tmpstr)-1;
if (i>0 && tmpstr[i]=='\n') tmpstr[i]=0;
strncpy(userstr[arg1-1],tmpstr,80);
rfree(tmpstr);
break;
case 1031:agt_var[arg1]=read_number();break;
case 1032:agt_var[arg1]=curr_time;break;
case 1033:curr_time=normalize_time(agt_var[arg1]);break;
case 1034:curr_time=normalize_time(arg1); break;
case 1035:add_time(arg1);break;
case 1036:delta_time=arg1;break;
/* 1037 and 1038 are subroutine commands */
case 1039:get_obj(dobj);break;
case 1040:it_move(dobj,1000);break;
case 1041:drop_obj(dobj);break;
case 1042:
if (it_loc(dobj)==1000) {
if (PURE_WEAR) it_move(dobj,1);
else drop_obj(dobj);
}
break;
case 1043: /* drop all */
safecontloop(i,j,1) drop_obj(i);
break;
case 1044: /* remove all */
safecontloop(i,j,1000) drop_obj(i);
break;
case 1045:deadflag=1;break;
case 1046:it_move(arg1,loc+first_room);break;
case 1047:it_move(arg1,arg2);break;
case 1048:it_reposition(arg1,arg2,1);break; /* RePosition */
case 1049:it_move(dobj,loc+first_room);break;
case 1050:it_move(dobj,arg1);break;
case 1051:
safecontloop(i,j,1) it_move(i,arg1);
safecontloop(i,j,1000) it_move(i,arg1);
break;
case 1052:
nounloop(i)
if (player_has(i+first_noun) && noun[i].points>arg2)
it_move(i+first_noun,arg1);
break;
case 1053:
safecontloop(i,j,arg1)
if (tnoun(i)) it_move(i,arg2);
break;
case 1054:it_destroy(arg1);break;
case 1055:it_destroy(dobj);break;
case 1056:i=it_loc(arg1);
it_move(arg1,it_loc(arg2));
it_move(arg2,i);
break;
case 1057:it_move(arg1,it_loc(arg2));break;
case 1058:it_move(dobj,it_loc(arg2));break;
case 1059: case 1060: /* Add to/remove from group */
if (tcreat(arg1))
creature[arg1-first_creat].groupmemb=(op==1059);
break;
case 1061: /* Move group */
safecontloop(i,j,loc+first_room)
if (it_group(i)) it_move(i,arg1);
break;
/* 1062 is RedirectTo */
case 1063:msgout(agt_rand(arg1,arg2),1);break;
case 1064:print_contents(arg1,1);break;
case 1065: case 1066: case 1067: case 1068:
obj_act(op-1065,arg1);break;
case 1069: case 1070: case 1071: case 1072:
obj_act(op-1069,dobj);break;
case 1073:print_score();break;
case 1074: tscore+=arg1;break;
case 1075: tscore-=arg1;break;
case 1076:v_inventory();break;
case 1077:wait_return();break;
case 1078:writeln("Time passes...");break;
case 1079:agt_delay(arg1);break;
case 1080:agt_clrscr();break;
case 1081:it_describe(arg1);break;
case 1082:look_room();break; /* LOOK */
case 1083:msgout(arg1,1);break;
case 1084:writeln("");break;
case 1085:if (PURE_TONE && sound_on)
agt_tone(arg1,arg2);break; /* Tone */
case 1086:agt_number=ask_for_number(arg1,arg2);break;
case 1087:agt_answer=ask_question(arg1);break;
case 1088:change_passage(loc,arg1,arg2);break;
case 1089:flag[arg1]=1;break;
case 1090:flag[arg1]=0;break;
case 1091:flag[arg1]=!flag[arg1];break;
case 1092:room[loc].flag_noun_bits|=(1 << (arg1-1) );
break; /* Roomflag on */
case 1093:room[loc].flag_noun_bits&=~(1 << (arg1-1) );break; /* Off */
case 1094:room[loc].flag_noun_bits^=(1 << (arg1-1) );break; /* Toggle */
case 1095: /* if (agt_counter[arg1]==-1)*/
agt_counter[arg1]=1;break;
case 1096:agt_counter[arg1]=-1;break;
case 1097:agt_var[arg1]=arg2;break;
case 1098:agt_var[arg1]+=arg2;break;
case 1099:agt_var[arg1]-=arg2;break;
case 1100:agt_var[arg1]+=agt_var[arg2];break;
case 1101:agt_var[arg1]-=agt_var[arg2];break;
case 1102:agt_var[arg1]=agt_rand(0,arg2);break;
case 1103:agt_var[arg1]=dobj_rec->num;break;
case 1104:agt_var[arg1]=iobj_rec->num;break;
/* The following are v1.8x specific */
case 1105:quote(arg1);break;
case 1106:add_time(arg1);break;
case 1107:add_time(-arg1);break;
case 1108:curr_time=(curr_time%100)+100*arg1;break;
case 1109:curr_time=(curr_time/100)*100+arg1;break;
case 1110:add_time(agt_var[arg1]);break;
case 1111:add_time(-agt_var[arg1]);break;
case 1112:curr_time=(curr_time%100)+100*agt_var[arg1];break;
case 1113:curr_time=(curr_time/100)*100+agt_var[arg1];break;
/* Now for the AGX additions */
case 1114:add_time(-arg1);break; /* ME-style SubtractFromTime */
case 1115: disambig_score=arg1; break; /* SetDisambigPriority */
case 1116:agt_var[arg1]=delta_time;break;
case 1117: /* ChangeStatus */
statusmode=arg1;
break;
case 1118:
if (!mult_rangecheck(agt_var[arg1],arg2)) break;
agt_var[arg1]*=arg2;break;
case 1119:
if (arg2==0) {
if (!PURE_ERROR)
writeln("GAME ERROR: Division by zero.");
} else agt_var[arg1]/=arg2;
break;
case 1120:
if (arg2==0) {
if (!PURE_ERROR)
writeln("GAME ERROR: Attempt to divide by zero.");
} else agt_var[arg1]%=arg2;
break;
case 1121:agt_waitkey();break;
case 1122:last_he=arg1;break; /* SetHE */
case 1123:last_she=arg1;break;
case 1124:last_it=arg1;break;
case 1125:last_they=arg1;break;
case 1126:msgout(arg1,0);break;
case 1127:
if (!PURE_ERROR)
sysmsg(arg1,"GAME ERROR: Standard message not defined.");
break;
case 1128: msgout(arg1,1);break; /* FailMessage */
case 1129: /* StdMessage */
sysmsg(arg1,"GAME ERROR: Standard message not defined.");
break;
case 1130: msgout(arg2,1);break; /* ErrMessage */
case 1131: /* StdErrMessage */
sysmsg(arg1,"GAME ERROR: Standard message not defined.");
break;
case 1132: /* AND */
break; /* These don't do anything under normal circumstances */
case 1133: /* SetClass */
if (troom(arg1)) room[arg1-first_room].oclass=arg2;
else if (tnoun(arg1)) noun[arg1-first_noun].oclass=arg2;
else if (tcreat(arg1)) noun[arg1-first_creat].oclass=arg2;
break;
case 1134: agt_var[arg1]=it_class(arg2); break; /* SetVariableToClass */
/* Stack commands */
case 1135: push_stack(arg1); break;
case 1136: agt_var[arg1]=pop_stack(); break;
case 1137: case 1138: case 1139: case 1140: case 1141:
op_stack(op-1137); /* +,-,*, /,% * */
break;
case 1142: { /* DupStack */
long n;
n=pop_stack();
push_stack(n);
push_stack(n);
break;
}
case 1143: pop_stack();break; /* Discard TOS */
case 1144: agt_var[arg1]=agt_number;break; /* SetVariableToInput */
case 1145: setattr(arg1,arg2,1); break; /* Set */
case 1146: setattr(arg1,arg2,0); break; /* Clear */
case 1147: push_stack(getprop(arg1,arg2));break; /* PushProp */
case 1148: setprop(arg1,arg2,pop_stack());break; /* PopProp */
/* 1149, 1150 handled by run_metacommand */
/* 1151 is EndDisambig */
/* 1152 is XRedirect */
case 1153: rstrncpy(userstr[arg1-1],userstr[arg2-1],81);break;
case 1154: setcase(userstr[arg1-1],1); break;
case 1155: setcase(userstr[arg1-1],0);break;
case 1156: op_objflag(1,arg1,arg2);break;
case 1157: op_objflag(0,arg1,arg2);break;
case 1158: op_objflag(3,arg1,arg2);break;
case 1159: push_stack(op_objprop(2,arg1,arg2,0)); break;
case 1160: op_objprop(1,arg1,arg2,pop_stack()); break;
case 1161: move_in_dir(arg1,arg2); break;
default:
writeln("INTERNAL ERROR: Action token not supported.");
rprintf("Action #%d",op);
writeln("");
}
}
FUNCTION calculateCritPath()
{
Ocb * o, *critOcb;
State *s, *nxtState;
truncState * lastState;
Byte duplicateEpt;
if ( tw_node_num == CRITPATHMASTER )
{
_pprintf("Calculating critical path\n");
}
duplicateEpt = 0;
/* Look through each object to find the local object with the state with
the highest ept. */
for ( o = fstocb_macro; o != NULLOCB; o = nxtocb_macro ( o ) )
{
/* Ignore the stdout object. */
if ( o->runstat == ITS_STDOUT )
continue;
/* Truncate any states still in the state queue. They're only
needed for critical path purposes, at this point, and having
all the states in one queue simplifies matters. */
for ( s = fststate_macro ( o ) ; s != NULLSTATE; s = nxtState )
{
nxtState = nxtstate_macro ( s );
truncateState ( s );
}
lastState = l_prev_macro ( o->tsqh );
/* We expect all objects to have at least one state. */
if ( l_ishead_macro ( lastState ))
{
_pprintf("ocb %s has no state in truncated state queue\n", o->name );
tester();
}
/* Now check to see if this state's Ept is the highest seen so far.
If so, change both highEpt and critOcb. In any case, watch for
duplicates of the highest Ept using duplicateEpt. */
if ( lastState->Ept > highEpt )
{
highEpt = lastState->Ept;
critOcb = o;
duplicateEpt = 0;
}
else
if ( lastState->Ept < highEpt )
duplicateEpt = 0;
else
duplicateEpt++ ;
}
/* We're not prepared to deal with duplicate Epts yet. */
if ( duplicateEpt )
{
_pprintf("duplicate final EPT's = %d\n", highEpt );
tester();
}
if ( tw_node_num == CRITPATHMASTER )
{
/* If this node is the master, check its contribution immediately. */
/* highEpt keeps the recently calculated contribution for this node.
highestEpt, used only on the CRITPATHMASTER node, keeps the
globally highest Ept for all nodes that have reported, so far. */
if ( highestEpt < highEpt )
{
highestEpt = highEpt;
strcpy ( critObject, critOcb->name );
critNode = CRITPATHMASTER;
}
else
if ( highestEpt == highEpt )
{
_pprintf("duplicate high Epts %d and %d\n", highestEpt, highEpt);
tester();
}
nodesReporting--;
/* The master was the last node to report (or is the only node).
Call startCritPath(). (A function is used here because the
same code in startCritPath() will also be used by checkCritPath().
So both routines call the function startCritPath(), rather than
duplicate the code.) */
if ( nodesReporting == 0 )
{
startCritPath ();
}
}
else
{
/* This is not the master node. Send the CP contribution to the
master node. */
Msgh * p;
Critmsg * q;
p = sysbuf ();
q = ( Critmsg *) (p + 1);
sprintf ( p->snder, "CRIT%d", tw_node_num );
sprintf ( p->rcver, "CRIT%d", CRITPATHMASTER );
q->Ept = highEpt;
q->node = tw_node_num;
sprintf ( q->object, critOcb->name );
sysmsg ( CRITMSG, p, sizeof (Critmsg), CRITPATHMASTER );
}
}
void op_fileinfo()
{
/* Stack:
|================================|=============================|
| BEFORE | AFTER |
|================================|=============================|
top | Key | Information |
|--------------------------------|-----------------------------|
| ADDR to file variable | |
|================================|=============================|
Key values: Action Returns
0 FL_OPEN Test if is open file variable True/False
1 FL_VOCNAME Get VOC name of file VOC name
2 FL_PATH Get file pathname Pathname
3 FL_TYPE Check file type DH: FL_TYPE_DH (3)
Directory: FL_TYPE_DIR (4)
Sequential: FL_TYPE_SEQ (5)
5 FL_MODULUS File modulus Modulus value
6 FL_MINMOD Minimum modulus Minimum modulus value
7 FL_GRPSIZE Group size Group size
8 FL_LARGEREC Large record size Large record size
9 FL_MERGE Merge load percentage Merge load
10 FL_SPLIT Split load percentage Split load
11 FL_LOAD Current load percentage Current load
13 FL_AK File has AK indices? Boolean
14 FL_LINE Number of next line Line number
1000 FL_LOADBYTES Current load in bytes Current load bytes
1001 FL_READONLY Read only file? Boolean
1002 FL_TRIGGER Get trigger function name Call name
1003 FL_PHYSBYTES Physical file size Size in bytes, excl indices
1004 FL_VERSION File version
1005 FL_STATS_QUERY Query file stats status Boolean
1006 FL_SEQPOS File position File offset
1007 FL_TRG_MODES Get trigger modes Mode mask
1008 FL_NOCASE File uses case insensitive ids? Boolean
1009 FL_FILENO Return internal file number File number
1010 FL_JNL_FNO Return journalling file no File no, zero if not journalling
1011 FL_AKPATH Returns AK subfile location Pathname of directory
1012 FL_ID Id of last record read Id
1013 FL_STATUS As STATUS statement Dynamic array
1014 FL_MARK_MAPPING Is mark mapping enabled? Boolean
1015 FL_RECORD_COUNT Approximate record count
1016 FL_PRI_BYTES Primary subfile size in bytes
1017 FL_OVF_BYTES Overflow subfile size in bytes
1018 FL_NO_RESIZE Resizing inhibited?
1019 FL_UPDATE Update counter
1020 FL_ENCRYPTED File uses encryption? Boolean
10000 FL_EXCLUSIVE Set exclusive access Successful?
10001 FL_FLAGS Fetch file flags File flags
10002 FL_STATS_ON Turn on file statistics
10003 FL_STATS_OFF Turn off file statistics
10004 FL_STATS Return file statistics
10005 FL_SETRDONLY Set file as read only
*/
short int key;
DESCRIPTOR * descr;
FILE_VAR * fvar;
DH_FILE * dh_file;
char * p = NULL;
long int n = 0;
FILE_ENTRY * fptr;
OSFILE fu;
bool dynamic;
bool internal;
long int * q;
STRING_CHUNK * str;
short int i;
double floatnum;
u_char ftype;
int64 n64;
/* Get action key */
descr = e_stack - 1;
GetInt(descr);
key = (short int)(descr->data.value);
k_pop(1);
/* Get file variable */
descr = e_stack - 1;
while(descr->type == ADDR) {descr = descr->data.d_addr;}
if (key == FL_OPEN) /* Test if file is open */
{
n = (descr->type == FILE_REF);
}
else
{
if (descr->type != FILE_REF) k_error(sysmsg(1200));
fvar = descr->data.fvar;
ftype = fvar->type;
if (ftype == NET_FILE) /* Network file */
{
str = net_fileinfo(fvar, key);
k_dismiss();
InitDescr(e_stack, STRING);
(e_stack++)->data.str.saddr = str;
return;
}
fptr = FPtr(fvar->file_id);
dynamic = (ftype == DYNAMIC_FILE);
if (dynamic) dh_file = fvar->access.dh.dh_file;
internal = ((process.program.flags & HDR_INTERNAL) != 0);
switch(key)
{
case FL_VOCNAME: /* 1 VOC name of file */
if (fvar->voc_name != NULL) p = fvar->voc_name;
else p = "";
goto set_string;
case FL_PATH: /* 2 File pathname */
p = (char *)(fptr->pathname);
goto set_string;
case FL_TYPE: /* 3 File type */
/* !!FVAR_TYPES!! */
switch(ftype)
{
case DYNAMIC_FILE:
n = FL_TYPE_DH;
break;
case DIRECTORY_FILE:
n = FL_TYPE_DIR;
break;
case SEQ_FILE:
n = FL_TYPE_SEQ;
break;
}
break;
case FL_MODULUS: /* 5 Modulus of file */
if (dynamic) n = fptr->params.modulus;
break;
case FL_MINMOD: /* 6 Minimum modulus of file */
if (dynamic) n = fptr->params.min_modulus;
break;
case FL_GRPSIZE: /* 7 Group size of file */
if (dynamic) n = dh_file->group_size / DH_GROUP_MULTIPLIER;
break;
case FL_LARGEREC: /* 8 Large record size */
if (dynamic) n = fptr->params.big_rec_size;
break;
case FL_MERGE: /* 9 Merge load percentage */
if (dynamic) n = fptr->params.merge_load;
break;
case FL_SPLIT: /* 10 Split load percentage */
if (dynamic) n = fptr->params.split_load;
break;
case FL_LOAD: /* 11 Load percentage */
if (dynamic)
{
n = DHLoad(fptr->params.load_bytes, dh_file->group_size, fptr->params.modulus);
}
break;
case FL_AK: /* 13 File has AKs? */
if (dynamic) n = (dh_file->ak_map != 0);
break;
case FL_LINE: /* 14 Sequential file line position */
if (ftype == SEQ_FILE)
{
n64 = fvar->access.seq.sq_file->line;
if (n64 > LONG_MAX)
{
floatnum = (double)n64;
goto set_float;
}
n = (long)n64;
}
break;
case FL_LOADBYTES: /* 1000 Load bytes */
if (dynamic)
{
floatnum = (double)(fptr->params.load_bytes);
goto set_float;
}
break;
case FL_READONLY: /* 1001 Read-only? */
n = ((fvar->flags & FV_RDONLY) != 0);
break;
case FL_TRIGGER: /* 1002 Trigger function name */
if (dynamic)
{
p = dh_file->trigger_name;
goto set_string;
}
break;
case FL_PHYSBYTES: /* 1003 Physical file size */
switch(ftype)
{
case DIRECTORY_FILE:
floatnum = (double)dir_filesize(fvar);
break;
case DYNAMIC_FILE:
floatnum = (double)dh_filesize(dh_file, PRIMARY_SUBFILE) + dh_filesize(dh_file, OVERFLOW_SUBFILE);
break;
case SEQ_FILE:
fu = fvar->access.seq.sq_file->fu;
floatnum = (double)(ValidFileHandle(fu)?filelength64(fu):-1);
break;
}
goto set_float;
case FL_VERSION: /* 1004 File version */
if (dynamic) n = dh_file->file_version;
break;
case FL_STATS_QUERY: /* 1005 File statistics enabled? */
if (dynamic) n = (fptr->stats.reset != 0);
break;
case FL_SEQPOS: /* 1006 Sequential file offset */
if (ftype == SEQ_FILE)
{
n64 = fvar->access.seq.sq_file->posn;
if (n64 > LONG_MAX)
{
floatnum = (double)n64;
goto set_float;
}
n = (long)n64;
}
break;
case FL_TRG_MODES: /* 1007 Trigger modes */
if (dynamic) n = dh_file->trigger_modes;
break;
case FL_NOCASE: /* 1008 Case insensitive ids? */
switch(ftype)
{
case DIRECTORY_FILE:
case DYNAMIC_FILE:
n = (fptr->flags & DHF_NOCASE) != 0;
break;
}
break;
case FL_FILENO: /* 1009 Internal file number */
n = fvar->file_id;
break;
case FL_JNL_FNO: /* 1010 Journalling file number */
break;
case FL_AKPATH: /* 1011 AK subfile pathname */
if (dynamic)
{
p = dh_file->akpath;
goto set_string;
}
break;
case FL_ID: /* 1012 Id of last record read */
k_dismiss();
k_put_string(fvar->id, fvar->id_len, e_stack);
e_stack++;
return;
case FL_STATUS: /* 1013 STATUS array */
str = get_file_status(fvar);
k_dismiss();
InitDescr(e_stack, STRING);
(e_stack++)->data.str.saddr = str;
return;
case FL_MARK_MAPPING: /* 1014 Mark mapping enabled? */
if (ftype == DIRECTORY_FILE) n = fvar->access.dir.mark_mapping;
break;
case FL_RECORD_COUNT: /* 1015 Approximate record count */
if (dynamic)
{
floatnum = (double)(fptr->record_count);
goto set_float;
}
else n = -1;
case FL_PRI_BYTES: /* 1016 Physical size of primary subfile */
if (dynamic)
{
floatnum = (double)dh_filesize(dh_file, PRIMARY_SUBFILE);
goto set_float;
}
break;
case FL_OVF_BYTES: /* 1017 Physical size of overflow subfile */
if (dynamic)
{
floatnum = (double)dh_filesize(dh_file, OVERFLOW_SUBFILE);
goto set_float;
}
break;
case FL_NO_RESIZE: /* 1018 Resizing inhibited? */
if (dynamic) n = ((fptr->flags & DHF_NO_RESIZE) != 0);
break;
case FL_UPDATE: /* 1019 File update counter */
n = (long)(fptr->upd_ct);
break;
case FL_ENCRYPTED: /* 1020 File uses encryption? */
/* Recognised but returns default zero */
break;
case FL_EXCLUSIVE: /* 10000 Set exclusive access mode */
if (internal)
{
/* To gain exclusive access to a file it must be open only to this
process (fptr->ref_ct = 1) and must not be open more than once
in this process. The latter condition only affects dynamic files
as other types produce multiply referenced file table entries.
We need to ensure a dynamic file is only open once so that when
we close the file we really are going to kill off the DH_FILE
structure. This is essential, for example, in AK creation where
the DH_FILE structure has to change its size. */
flush_dh_cache(); /* Ensure we are not stopped by a cached
reference from our own process. */
n = FALSE;
for (i = 0; i < 6; i++)
{
StartExclusive(FILE_TABLE_LOCK, 37);
if ((fptr->ref_ct == 1)
&& ((ftype != DYNAMIC_FILE) || (dh_file->open_count == 1)))
{
fptr->ref_ct = -1;
fptr->fvar_index = fvar->index;
n = TRUE;
}
EndExclusive(FILE_TABLE_LOCK);
if (n) break;
if (i == 0) /* First attempt */
{
/* Cannot gain exclusive access. Maybe some other process has
the file in its DH cache. Fire an EVT_FLUSH_CACHE event to
all processes to see if this clears the problem. We then
continue trying for a short time until either we get the
required access or we reach our retry count. */
raise_event(EVT_FLUSH_CACHE, -1);
}
Sleep(500); /* Pause for something to happen */
}
}
break;
case FL_FLAGS: /* 10001 File flags */
if (dynamic && internal) n = (long int)(dh_file->flags);
break;
case FL_STATS_ON: /* 10002 Enable file statistics */
if (dynamic && internal)
{
memset((char *)&(fptr->stats), 0, sizeof(struct FILESTATS));
fptr->stats.reset = qmtime();
}
break;
case FL_STATS_OFF: /* 10003 Disable file statistics */
if (dynamic && internal) fptr->stats.reset = 0;
break;
case FL_STATS: /* 10004 Return file statistics data */
if (dynamic && internal)
{
str = NULL;
ts_init(&str, 5 * FILESTATS_COUNTERS);
for (i = 0, q = (long int *)&(fptr->stats.reset); i < FILESTATS_COUNTERS; i++, q++)
{
ts_printf("%ld\xfe", *q);
}
(void)ts_terminate();
k_dismiss(); /* 0363 */
InitDescr(e_stack, STRING);
(e_stack++)->data.str.saddr = str;
return;
}
break;
case FL_SETRDONLY: /* 10005 Set read-only */
if (internal)
{
fvar->flags |= FV_RDONLY;
if (dynamic) dh_file->flags |= DHF_RDONLY;
}
break;
default:
k_error(sysmsg(1010));
}
}
/* Set integer return value on stack */
set_integer:
k_dismiss();
InitDescr(e_stack, INTEGER);
(e_stack++)->data.value = n;
return;
/* Set string return value on stack */
set_string:
k_dismiss();
k_put_c_string(p, e_stack);
e_stack++;
return;
set_float:
if (floatnum <= (double)LONG_MAX)
{
n = (long)floatnum;
goto set_integer;
}
k_dismiss();
InitDescr(e_stack, FLOATNUM);
(e_stack++)->data.float_value = floatnum;
return;
}
void op_ospath()
{
/* Stack:
|================================|=============================|
| BEFORE | AFTER |
|================================|=============================|
top | Key | Information |
|--------------------------------|-----------------------------|
| Pathname string | |
|================================|=============================|
Key values: Action Returns
0 OS_PATHNAME Test if valid pathname True/False
1 OS_FILENAME Test if valid filename True/False
or directory file record name
2 OS_EXISTS Test if file exists True/False
3 OS_UNIQUE Make a unique file name Name
4 OS_FULLPATH Return full pathname Name
5 OS_DELETE Delete file Success/Failure
6 OS_CWD Get current working directory Pathname
7 OS_DTM Return date/time modified DTM value
8 OS_FLUSH_CACHE Flush DH file cache -
9 OS_CD Change working directory Success/Failure
10 OS_MAPPED_NAME Map a directory file name Mapped name
11 OS_OPEN Check if path is an open file True/False
12 OS_DIR Return content of directory Filenames
13 OS_MKDIR Make a directory True/False
14 OS_MKPATH Make a directory path True/False
Pathnames with lengths outside the range 1 to MAX_PATHNAME_LEN return
0 regardless of the action key.
*/
long int status = 0;
short int key;
DESCRIPTOR * descr;
char path[MAX_PATHNAME_LEN+1];
short int path_len;
char name[MAX_PATHNAME_LEN+1];
char * p;
char * q;
STRING_CHUNK * head;
int file_id;
FILE_ENTRY * fptr;
struct stat stat_buff;
DIR * dfu;
struct dirent * dp;
long int n;
/* Get action key */
descr = e_stack - 1;
GetInt(descr);
key = (short int)(descr->data.value);
k_pop(1);
/* Get pathname */
descr = e_stack - 1;
path_len = k_get_c_string(descr, path, MAX_PATHNAME_LEN);
k_dismiss();
if (path_len < 0) goto set_status;
#ifdef CASE_INSENSITIVE_FILE_SYSTEM
UpperCaseString(path);
#endif
switch(key)
{
case OS_PATHNAME: /* Test if valid pathname */
p = path;
if (*p == '/') p++;
do {
q = strchr(p, '/');
if (q != NULL) *q = '\0';
if (!valid_name(p)) goto set_status;
p = q + 1;
} while(q != NULL);
status = 1;
break;
case OS_FILENAME: /* Test if valid pathname */
status = (long int)valid_name(path);
break;
case OS_EXISTS: /* Test if file exists */
status = !access(path, 0);
break;
case OS_UNIQUE: /* Make unique file name. Path variable holds directory name */
n = (time(NULL) * 10) & 0xFFFFFFFL;
do {
sprintf(name, "%s\\D%07lX", path, n);
n--;
} while(!access(name, 0));
sprintf(name, "D%07lX", n);
k_put_c_string(name, e_stack);
e_stack++;
goto exit_op_pathinfo;
case OS_FULLPATH: /* Expand path to full OS pathname */
fullpath(name, path);
k_put_c_string(name, e_stack);
e_stack++;
goto exit_op_pathinfo;
case OS_DELETE:
flush_dh_cache();
status = (long int)delete_path(path);
break;
case OS_CWD:
(void)getcwd(name, MAX_PATHNAME_LEN);
#ifdef CASE_INSENSITIVE_FILE_SYSTEM
UpperCaseString(name);
#endif
k_put_c_string(name, e_stack);
e_stack++;
goto exit_op_pathinfo;
case OS_DTM:
if (stat(path, &stat_buff) == 0) status = stat_buff.st_mtime;
break;
case OS_FLUSH_CACHE:
flush_dh_cache();
break;
case OS_CD:
status = attach(path);
break;
case OS_MAPPED_NAME: /* Map a directory file record name */
(void)map_t1_id(path, strlen(path), name);
k_put_c_string(name, e_stack);
e_stack++;
goto exit_op_pathinfo;
case OS_OPEN:
fullpath(name, path);
for(file_id = 1; file_id <= sysseg->used_files; file_id++)
{
fptr = FPtr(file_id);
if ((fptr->ref_ct != 0)
&& (strcmp((char *)(fptr->pathname), name) == 0))
{
status = TRUE;
break;
}
}
break;
case OS_DIR:
head = NULL;
ts_init(&head, 1024);
if ((dfu = opendir(path)) != NULL)
{
if (path[path_len-1] == DS) path[path_len-1] = '\0';
while((dp = readdir(dfu)) != NULL)
{
if (strcmp(dp->d_name, ".") == 0) continue;
if (strcmp(dp->d_name, "..") == 0) continue;
sprintf(name, "%s%c%s", path, DS, dp->d_name);
if (stat(name, &stat_buff)) continue;
strcpy(name+1, dp->d_name);
#ifdef CASE_INSENSITIVE_FILE_SYSTEM
UpperCaseString(name+1);
#endif
if (stat_buff.st_mode & S_IFDIR)
{
name[0] = 'D';
if (head != NULL) ts_copy_byte(FIELD_MARK);
ts_copy_c_string(name);
}
else if (stat_buff.st_mode & S_IFREG)
{
name[0] = 'F';
if (head != NULL) ts_copy_byte(FIELD_MARK);
ts_copy_c_string(name);
}
}
closedir(dfu);
}
ts_terminate();
InitDescr(e_stack, STRING);
(e_stack++)->data.str.saddr = head;
goto exit_op_pathinfo;
case OS_MKDIR:
status = !MakeDirectory(path);
break;
case OS_MKPATH:
status = make_path(path);
break;
default:
k_error(sysmsg(1010));
}
set_status:
/* Set status value on stack */
InitDescr(e_stack, INTEGER);
(e_stack++)->data.value = status;
exit_op_pathinfo:
return;
}
void k_error(char * message, ...)
{
long int failing_offset;
char s[(3 * 80)+1]; /* Max 3 lines */
va_list arg_ptr;
short int n;
int line;
struct PROGRAM * pgm;
long int xpc_offset;
u_char * xcbase;
DESCRIPTOR * msg_descr;
bool fatal;
/* Ensure terminal is in an appropriate mode to receive the error message */
tio.hush = FALSE;
tio.suppress_como = TRUE;
tio_write(qmtgetstr("rlt"));
tio.suppress_como = FALSE;
in_sh = FALSE; /* 0562 */
fatal = (*message != '!');
if (!fatal) message++;
process.numeric_array_allowed = FALSE;
/* PC may now point anywhere from one byte after the start of the failing
opcode to the first byte of the next opcode. Back up by one byte to
place us within the current opcode. */
if (c_base != NULL)
{
/* Track back through any recursives to report error as belonging to
parent program. */
xpc_offset = pc - c_base;
xcbase = c_base;
pgm = &process.program;
while(pgm->flags & HDR_RECURSIVE)
{
if (internal_mode)
{
tio_printf("%08lX in %s \n", xpc_offset - 1,
((OBJECT_HEADER *)xcbase)->ext_hdr.prog.program_name);
}
pgm = pgm->prev;
xpc_offset = pgm->saved_pc_offset;
xcbase = pgm->saved_c_base;
}
failing_offset = xpc_offset - 1;
n = sprintf(s, "%08lX: ", failing_offset);
}
else
{
n = 0;
}
va_start(arg_ptr, message);
vsprintf(&(s[n]), message, arg_ptr);
va_end(arg_ptr);
if (c_base == NULL) /* No object currently loaded */
{
tio_write(s);
tio_write("\n");
k_exit_cause = K_LOGOUT;
longjmp(k_exit, k_exit_cause);
}
n = strlen(s);
if (process.program.flags & HDR_ITYPE)
{
// sprintf(s + n, sysmsg(1120)); /* in dictionary expression */
sprintf(s + n, "%s", sysmsg(1120)); /* 20Jun12 gwb #1 */
}
else
{
line = k_line_no(failing_offset, xcbase);
if (line >= 0)
{
sprintf(s + n, sysmsg(1121), (int)line,
((OBJECT_HEADER *)xcbase)->ext_hdr.prog.program_name);
}
else
{
sprintf(s + n, sysmsg(1122), ((OBJECT_HEADER *)xcbase)->ext_hdr.prog.program_name);
}
}
tio_write(s);
tio_write("\n");
log_message(s);
if (fatal)
{
/* Save abort message in SYSCOM */
msg_descr = Element(process.syscom, SYSCOM_ABORT_MESSAGE);
k_release(msg_descr);
k_put_c_string(s, msg_descr);
if (Option(OptShowStackOnError)) show_stack();
if (Option(OptDumpOnError)) pdump();
k_exit_cause = K_ABORT;
longjmp(k_exit, k_exit_cause);
}
}
void k_illegal_call_name() {k_error(sysmsg(1130));}
void k_txn_error() {k_error(sysmsg(1119));}
void k_select_range_error() {k_error(sysmsg(1118));}
void k_nary_length_error() {k_error(sysmsg(1117));}
void k_inva_task_lock_error() {k_error(sysmsg(1116));}
void k_err_pu() {k_error(sysmsg(1115));}
void k_deadlock() {k_error(sysmsg(1114));}
function main(in mode, in subject0, in body0, in groupids0, in jobids0, in userids0, in options, io emaillog) {
//options
//R = REPLYTO=@username email address if exists
//W = Groups by Word eg user with dept MEDIA BUYING matches group MEDIA
var interactive = not SYSTEM.a(33);
if (false) print(jobids0);//evade compiler warning on unused argument
if (mode.field(" ", 1) eq "UPGRADE") {
var subject = "NEOSYS Upgrade: " ^ SYSTEM.a(23);
if (SYSTEM.a(17) ne SYSTEM.a(23)) {
subject ^= " (" ^ SYSTEM.a(17) ^ ")";
}
var version = mode.field(" ", 2);
subject ^= version;
var body = "";
body ^= "The NEOSYS system software has been upgraded.";
body ^= VM;
body ^= VM ^ "Before you login to NEOSYS, please follow the instructions at";
body ^= VM ^ "http://userwiki.neosys.com/index.php/cache to avoid errors using NEOSYS.";
body ^= VM;
body ^= VM ^ "Please email [email protected] for any assistance.";
//body:=vm
//body:=vm:'This is an automated email. You cannot reply to it.'
body.converter(VM, var().chr(13));
call emailusers(mode, subject, body, "", "", "", "R", emaillog);
if (not emaillog) {
emaillog = "(nobody)";
}
emaillog = "Upgrade Notification emailed to:" ^ VM ^ emaillog;
emaillog.swapper(VM, var().chr(13));
call sysmsg(emaillog, "Upgrade to version " ^ version);
return 0;
} else if (mode ne "") {
var msg = DQ ^ (mode ^ DQ) ^ " is invalid in EMAILUSERS";
if (interactive) {
call mssg(msg);
}else{
call sysmsg(msg);
}
return 1;
}
//init:
//if target and options='' or index(options,'U',1) then
// end
var groupword = options.index("W", 1);
nsent = 0;
var subject = subject0;
var body = body0;
//read fromuser from users,@username else fromuser=''
var replyto = "";
if (options.index("R", 1)) {
if (USERNAME == "NEOSYS" or USERNAME == "ADAGENCY" or USERNAME == "ACCOUNTS") {
replyto = "*****@*****.**";
}else{
var fromuser = USERNAME.xlate("USERS", "", "X");
replyto = fromuser.a(7);
var fromline = "From " ^ fromuser.a(1);
if (USERNAME ne fromuser.a(1)) {
fromline ^= " (" ^ USERNAME ^ ")";
}
subject.splicer(1, 0, fromline ^ " : ");
}
}
var usercodes = SECURITY.a(1);
var nusers = usercodes.count(VM) + 1;
var usern = 0;
emaillog = "";
var alreadyemailed = "";
body.converter(FM ^ VM, var().chr(13) ^ var().chr(13));
var groupids = groupids0;
groupids.converter(",", VM);
var ngroups = groupids.count(VM) + 1;
var userids = userids0;
userids.converter(",", VM);
toemails = "";
ccemails = "";
var currdept = "";
var users;
if (not(users.open("USERS", ""))) {
call fsmsg();
return 0;
}
for (usern=1; usern<=nusers;++usern) {
//interrupt
if (esctoexit()) {
break;
}
//skip empty users
var usercode = usercodes.a(1, usern);
if (usercode == "") {
continue;
}
//only users on file
var USER;
if (not(USER.read(users, usercode))) {
continue;
}
//not expired users
var expirydate = USER.a(35);
if (expirydate and expirydate <= var().date()) {
continue;
}
//skip users with no email at all
//users may have 0 or more email addresses eg [email protected];[email protected] etc
var emails = USER.a(7);
if (emails == "") {
continue;
}
//always email to self last
if (usercode == USERNAME and replyto) {
continue;
}
var ok = 0;
if (not ok and userids) {
if (userids.locate(usercode, xx, 1)) {
ok = 1;
}
if (not ok and not groupids) {
continue;
}
}
//skip users not of required type (eg FINANCE is ok in FINANCE CONTROLLER)
//could determine user type from what menus they can access eg MEDIA
if (not ok and groupids) {
if (groupword) {
//eq search for MEDIA in user department like MEDIA BUYER
for (var groupn = 1; groupn <= ngroups; ++groupn) {
ok = (USER.a(5)).index(groupids.a(1, groupn), 1);
if (not(not ok))
break;;
};//groupn;
}else{
//exact groups
if (groupids.locate(USER.a(21), xx, 1)) {
ok = 1;
}
}
if (not ok) {
continue;
}
}
//must be last to avoid adding emails to sent list unless actually sent
//remove any emails that have already been emailed before
emails.converter(" ", "");
emails.converter(";", VM);
var nn = emails.count(VM) + (emails ne "");
for (var ii = nn; ii >= 1; --ii) {
var email = emails.a(1, ii);
if (alreadyemailed.locateusing(email, VM)) {
emails.eraser(1, ii);
}else{
alreadyemailed ^= VM ^ email;
}
};//ii;
emails.converter(VM, ";");
//skip users that have already been emailed before
if (emails == "") {
continue;
}
//userinit:
print(usercode, " ");
if (currdept and USER.a(5) ne currdept) {
gosub sendemails(emaillog);
}
currdept = USER.a(5);
if (toemails == "") {
toemails = emails;
//sending to users (or groups and users)
} else if (userids) {
toemails ^= ";" ^ emails;
//sending to groups then to the first and cc the rest
}else{
ccemails ^= ";" ^ emails;
}
emaillog ^= VM ^ usercode ^ " " ^ emails;
}//usern
//exit:
gosub sendemails(emaillog);
//trim trailing . vm and fm
emaillog.trimmerb("."^VM^FM);
//always email to self
if (nsent and replyto) {
toemails = replyto;
body ^= VM ^ VM ^ "-- Sent to --" ^ emaillog;
body.swapper(VM, var().chr(13));
gosub sendemails(emaillog);
}
if (not nsent) {
emaillog = "";
}
//trim trailing . vm and fm
emaillog.trimmerb("."^VM^FM);
return 0;
}