static void cmj_accept_ast(struct CLB *lnk)
{
struct NTD *tsk;
uint4 status;
tsk = lnk->ntd;
status = lnk->ios.status;
if ((status & 1) == 0)
{
if (cmj_unit2clb(tsk, lnk->mun) == 0)
{
lib$free_vm(&SIZEOF(*lnk), &lnk, 0);
lnk = 0;
}
cmj_mbx_err(status, tsk, lnk);
}else
{
insqhi(lnk, tsk);
(*tsk->crq)(lnk);
}
status = cmj_mbx_read_start(tsk);
if ((status & 1) == 0)
cmj_mbx_err(status, tsk, lnk);
}
/*
**++
** ROUTINE: exit_handler
**
** FUNCTIONAL DESCRIPTION:
**
** Exit handler for the sp_mgr routines. Closes down the
** subprocesses and cleans up their SPB context blocks.
**
** RETURNS: cond_value, longword (unsigned), write only, by value
**
** PROTOTYPE:
**
** exit_handler(unsigned int *stat, struct QUE *spq)
**
** IMPLICIT INPUTS: None.
**
** IMPLICIT OUTPUTS: None.
**
** COMPLETION CODES:
**
**
** SIDE EFFECTS: None.
**
**--
*/
static unsigned int exit_handler (unsigned int *stat, struct QUE *spq) {
SPHANDLE ctx;
while(queue_remove(spq->head, &ctx)) {
sys$delprc(&ctx->pid, 0);
lib$free_ef(&ctx->termefn);
lib$free_ef(&ctx->inefn);
lib$free_ef(&ctx->outefn);
sys$dassgn(ctx->inchn);
sys$dassgn(ctx->outchn);
lib$free_vm(&ctx->bufsiz, &ctx->bufptr);
lib$free_vm(&spb_size, &ctx);
}
return SS$_NORMAL;
} /* exit_handler */
/*
**++
** ROUTINE: free_spd
**
** FUNCTIONAL DESCRIPTION:
**
** Frees an SPD data cell.
**
** RETURNS: void
**
** PROTOTYPE:
**
** free_spd(struct SPD *spd)
**
** IMPLICIT INPUTS: None.
**
** IMPLICIT OUTPUTS: None.
**
** COMPLETION CODES: None.
**
** SIDE EFFECTS: None.
**
**--
*/
static void free_spd (struct SPD *spd) {
unsigned int cellsize;
cellsize = spd->len + sizeof(struct SPD);
lib$free_vm(&cellsize, &spd);
return;
} /* free_spd */
/*
**++
** ROUTINE: netlib___free_ctx
**
** FUNCTIONAL DESCRIPTION:
**
** Frees a block of memory.
**
** RETURNS: void
**
** PROTOTYPE:
**
** netlib___free_ctx(struct CMD *c)
**
** IMPLICIT INPUTS: None.
**
** IMPLICIT OUTPUTS: None.
**
** COMPLETION CODES: None.
**
** SIDE EFFECTS: None.
**
**--
*/
unsigned int netlib___free_ctx (struct CTX *ctx) {
unsigned int fullsize;
if (ctx->linebuf != 0) {
fullsize = CTX_S_LINEBUF;
lib$free_vm(&fullsize, &ctx->linebuf);
}
if (ctx->wlinebuf != 0 && ctx->wlinesize != 0) {
lib$free_vm(&ctx->wlinesize, &ctx->wlinebuf);
}
netlib___free_dns_context(ctx);
fullsize = ctx->specctx_size + CTX_S_CTXDEF;
return lib$free_vm(&fullsize, &ctx, &ctxzone);
} /* netlib___free_ctx */
/*
**++
** ROUTINE: netlib___free_dns_context
**
** FUNCTIONAL DESCRIPTION:
**
** Deallocates the resolver context.
**
** RETURNS: cond_value, longword (unsigned), write only, by value
**
** PROTOTYPE:
**
** netlib___free_dns_context(struct CTX *ctx)
**
** IMPLICIT INPUTS: None.
**
** IMPLICIT OUTPUTS: None.
**
** COMPLETION CODES: See code.
**
** SIDE EFFECTS: None.
**
**--
*/
void netlib___free_dns_context (struct CTX *ctx) {
struct NAMESERVER *ns;
struct DOMAIN *d;
unsigned int size;
if (ctx->dnsctx == 0) return;
size = sizeof(struct NAMESERVER);
while (queue_remove(ctx->dnsctx->nsq.head, &ns)) lib$free_vm(&size, &ns);
while (queue_remove(ctx->dnsctx->domq.head, &d)) {
size = sizeof(struct DOMAIN) + d->length;
lib$free_vm(&size, &d);
}
size = sizeof(struct DNSCTX);
lib$free_vm(&size, &ctx->dnsctx);
ctx->dnsctx = 0;
} /* netlib___free_dns_context */
/*
**++
** ROUTINE: sp_close
**
** FUNCTIONAL DESCRIPTION:
**
** Close down a subprocess.
**
** RETURNS: cond_value, longword (unsigned), write only, by value
**
** PROTOTYPE:
**
** sp_close(SPHANDLE *ctxpp)
**
** IMPLICIT INPUTS: None.
**
** IMPLICIT OUTPUTS: None.
**
** COMPLETION CODES:
** SS$_NORMAL: Normal successful completion.
**
** SIDE EFFECTS: None.
**
**--
*/
unsigned int sp_close (SPHANDLE *ctxpp) {
SPHANDLE ctx;
struct SPD *spd;
unsigned int status;
ctx = *ctxpp;
/*
** Unlink the context block from our tracking queue
*/
status = sys$setast(0);
queue_remove(ctx, &ctx);
while (queue_remove(ctx->sendque.head, &spd)) free_spd(spd);
if (status == SS$_WASSET) sys$setast(1);
/*
** Delete the subprocess
*/
sys$forcex(&ctx->pid, 0, SS$_NORMAL);
sys$delprc(&ctx->pid, 0);
/*
** Wait till it actually dies
*/
sys$waitfr(ctx->termefn);
/*
** Clean up and return
*/
lib$free_ef(&ctx->termefn);
lib$free_ef(&ctx->inefn);
lib$free_ef(&ctx->outefn);
sys$dassgn(ctx->inchn);
sys$dassgn(ctx->outchn);
lib$free_vm(&ctx->bufsiz, &ctx->bufptr);
lib$free_vm(&spb_size, &ctx);
return SS$_NORMAL;
} /* sp_close */
int main() {
unsigned int initial_values[4] = { 0, 0, 500, 600 };
URMVM *vm = new_vm();
URMProgram *program = preconfigure_program_loop((unsigned int*)&initial_values, 4, 1);
unsigned int results = 0;
unsigned int *result_registers = NULL;
FILE *file = fopen("misc/program.txt", "r");
if(file == NULL) {
printf("Unable to open file!\n");
}
parse(program, file);
#if 0
unsigned int i = 0;
for(; i < program->instructions; ++i) {
printf("instruction %u: %d\n", i, program->instruction_list[i]->instruction);
unsigned int j = 0;
for(; j < program->instruction_list[i]->args; ++j) {
printf("arg %u: %d\n", j, program->instruction_list[i]->arg_list[j]);
}
}
for(i = 0; i < program->errors; ++i) {
printf("error: %s\n", program->error_list[i]);
}
#endif
if(start_program(vm, program, &result_registers, &results)) {
printf("Results:\n");
int i = 0;
for(; i < results; ++i) {
printf ("Register %u, result %u\n", i, result_registers[i]);
}
} else {
printf("Error in execution!\n");
}
fclose(file);
free(result_registers);
free_program(program);
free(program);
free_vm(vm);
free(vm);
return 0;
}
/*
**++
** ROUTINE: netlib___alloc_ctx
**
** FUNCTIONAL DESCRIPTION:
**
** Allocates some memory.
**
** RETURNS: cond_value
**
** PROTOTYPE:
**
** netlib___alloc_ctx(unsigned int size, void *ptr)
**
** IMPLICIT INPUTS: None.
**
** IMPLICIT OUTPUTS: None.
**
** COMPLETION CODES: None.
**
** SIDE EFFECTS: None.
**
**--
*/
unsigned int netlib___alloc_ctx (struct CTX **ctxp, unsigned int specsize) {
struct CTX *ctx;
unsigned int status, fullsize, aststat;
BLOCK_ASTS(aststat);
if (netlib_synch_efn == 0xffffffff) {
status = lib$get_ef(&netlib_synch_efn);
if (!OK(status)) {
UNBLOCK_ASTS(aststat);
return status;
}
}
if (netlib_asynch_efn == 0xffffffff) {
status = lib$get_ef(&netlib_asynch_efn);
if (!OK(status)) {
UNBLOCK_ASTS(aststat);
return status;
}
}
fullsize = specsize + CTX_S_CTXDEF;
if (ctxzone == 0) {
unsigned int algorithm=LIB$K_VM_FIXED;
unsigned int flags=LIB$M_VM_GET_FILL0|LIB$M_VM_EXTEND_AREA;
status = lib$create_vm_zone(&ctxzone, &algorithm, &fullsize, &flags);
if (!OK(status)) {
UNBLOCK_ASTS(aststat);
return status;
}
}
status = lib$get_vm(&fullsize, &ctx, &ctxzone);
if (OK(status)) {
ctx->specctx = ctx + 1;
ctx->specctx_size = specsize;
if (!OK(status)) lib$free_vm(&fullsize, &ctx, &ctxzone);
*ctxp = ctx;
}
UNBLOCK_ASTS(aststat);
return status;
} /* netlib___alloc_ctx */
int main(int argc, const char *argv[])
{
init_vm();
switch (argc)
{
case 1:
repl();
break;
case 2:
runFile(argv[1]);
break;
default:
fprintf(stderr, "Usage: coil [path]\n");
exit(64);
}
free_vm();
return 0;
}
int main(int argc, char **argv)
{
t_vm *vm;
int dump;
if (argc > 1)
{
if (!(vm = init_vm()))
exit(write(2, "No memory\n", 10));
dump = -1;
parse_args(argc, argv, vm, &dump);
if (vm->nb_players < 1)
exit(write(2, "No players\n", 11));
vm->last_player = vm->players[vm->nb_players - 1]->number;
load_players_in_memory(vm);
run_vm(vm, dump);
print_winner(vm);
free_vm(vm);
}
return (0);
}
static void sqlite3MemFree(void *pPrior){
long *pOld = ((long *)pPrior) - 1, szOld = *pOld + sizeof(int);
lib$free_vm(&szOld, &pOld, &_sqliteZone_);
}
/*
**++
** ROUTINE: netlib_connect_by_name
**
** FUNCTIONAL DESCRIPTION:
**
** Connects to a remote host/port by name. The name is looked up,
** then a connection is tried to each address until a connection is
** established, or we run out of addresses.
**
** RETURNS: cond_value, longword (unsigned), write only, by value
**
** PROTOTYPE:
**
** NETLIB_CONNECT_BY_NAME ctxptr, namdsc, port [,iosb] [,astadr] [,astprm]
**
** ctxptr: NETLIB context, longword (unsigned), read only, by reference
** namdsc: char_string, character string, read only, by descriptor
** port: word_unsigned, word (unsigned), read only, by reference
** iosb: io_status_block, quadword (unsigned), write only, by reference
** astadr: ast_procedure, procedure value, call, by reference
** astprm: user_arg, longword (unsigned), read only, by value
**
** IMPLICIT INPUTS: None.
**
** IMPLICIT OUTPUTS: None.
**
** COMPLETION CODES:
** SS$_NORMAL: normal successful completion
** SS$_INSFARG: not enough arguments
** SS$_BADPARAM: invalid argument
** Codes from LIB$GET_VM, LIB$ANALYZE_SDESC, and
** other NETLIB network status codes.
**
** SIDE EFFECTS: None.
**
**--
*/
unsigned int netlib_connect_by_name (struct CTX **xctx,
struct dsc$descriptor *dsc, unsigned short *port,
struct NETLIBIOSBDEF *iosb, void (*astadr)(), void *astprm) {
struct Connect_Context *con;
struct CTX *ctx;
struct INADDRDEF addr;
unsigned int status, size;
unsigned short namlen;
char *namp;
int argc;
/*
** Verify the arguments
*/
VERIFY_CTX(xctx, ctx);
SETARGCOUNT(argc);
if (argc < 3) return SS$_INSFARG;
if (dsc == 0 || port == 0) return SS$_BADPARAM;
/*
** Allocate and fill in the connection context
*/
status = lib$analyze_sdesc(dsc, &namlen, &namp);
if (!OK(status)) return status;
size = namlen + sizeof(struct Connect_Context);
status = lib$get_vm(&size, &con);
if (!OK(status)) return status;
memset(con, 0, size);
con->name = (char *) (con + 1);
memcpy(con->name, namp, namlen);
INIT_SDESC(con->dsc, namlen, con->name);
con->ctx = ctx;
con->sin.sin_w_family = NETLIB_K_AF_INET;
con->sin.sin_w_port = netlib_word_swap(*port);
con->ctxsize = size;
size = sizeof(con->htadrlst)/sizeof(con->htadrlst[0]);
if (argc > 3 && iosb != 0) con->user_iosb = iosb;
if (argc > 4 && astadr != 0) {
con->astadr = astadr;
if (argc > 5) con->astprm = astprm;
}
/*
** If they provided us with a dotted-decimal IP address, fake
** out do_connect to make it look like we looked up the address
** via DNS.
*/
if (OK(netlib_strtoaddr(&con->dsc, &addr))) {
con->iosb.iosb_w_status = SS$_NORMAL;
con->nsadrcnt = 1;
con->nsadrlst[0] = addr;
if (con->astadr != 0) return sys$dclast(do_connect, con, 0);
return do_connect(con);
}
/*
** Make lookup via host table synchronous and in main-line thread
** because we can't call it from AST level for all packages
*/
status = netlib_name_to_address(&con->ctx, &useht, &con->dsc,
con->htadrlst, &size, &con->htadrcnt, &con->iosb);
if (!OK(status)) con->htadrcnt = 0;
size = sizeof(con->nsadrlst)/sizeof(con->nsadrlst[0]);
/*
** For an asynch call, do the DNS lookup and have DO_CONNECT invoked
** as the AST routine
*/
if (argc > 4 && astadr != 0) {
status = netlib_name_to_address(&con->ctx, &usedns, &con->dsc,
con->nsadrlst, &size, &con->nsadrcnt, &con->iosb,
do_connect, con);
if (!OK(status)) lib$free_vm(&con->ctxsize, &con);
return status;
}
/*
** Synchronous call: do the DNS lookup...
*/
status = netlib_name_to_address(&con->ctx, &usedns, &con->dsc,
con->nsadrlst, &size, &con->nsadrcnt, &con->iosb);
/*
** ... if it failed, fall back on the host table lookup info we got
*/
if (!OK(status)) {
con->iosb.iosb_w_status = SS$_ENDOFFILE;
con->nsadrcnt = 0;
}
/*
** Just call DO_CONNECT to complete this for us
*/
return do_connect(con);
} /* netlib_connect_by_name */
/*
**++
** ROUTINE: do_connect
**
** FUNCTIONAL DESCRIPTION:
**
** Completion routine for NETLIB_CONNECT_BY_NAME. Can be
** invoked as a regular main-line routine or an AST completion.
**
** RETURNS: cond_value, longword (unsigned), write only, by value
**
** PROTOTYPE:
**
** DO_CONNECT connection-context
**
** IMPLICIT INPUTS: None.
**
** IMPLICIT OUTPUTS: None.
**
** COMPLETION CODES: Any NETLIB network status code.
**
** SIDE EFFECTS: None.
**
**--
*/
static unsigned int do_connect (struct Connect_Context *con) {
unsigned int status;
int done;
/*
** We implement our FSM as a loop for the synchronous case
*/
done = 0;
while (!done) {
status = con->iosb.iosb_w_status;
switch (con->state) {
/*
** Initial state -- if the DNS lookup failed, fall back on host table
** entry. Otherwise, start trying the connections.
*/
case 0:
if (con->nsadrcnt == 0) {
if (con->htadrcnt == 0) {
con->iosb.iosb_w_status = SS$_ENDOFFILE;
done = 1;
break;
}
con->adrlst = con->htadrlst;
con->adrcnt = con->htadrcnt;
} else {
con->adrlst = con->nsadrlst;
con->adrcnt = con->nsadrcnt;
}
con->state = 1;
/* and fall through */
/*
** State 1: Attempt a connection
*/
case 1:
con->sin.sin_x_addr = con->adrlst[con->curadr++];
con->state = 2;
status = netlib_connect(&con->ctx, &con->sin, &sinsize,
&con->iosb, (con->astadr == 0) ? 0 : do_connect,
(con->astadr == 0) ? 0 : con);
if (!OK(status)) done = 1;
else if (con->astadr != 0) return status;
break;
/*
** State 2: connect() completion status check. If we're successful
** or we've run out of addresses, we're done. Otherwise, we loop
** back up and try again.
*/
case 2:
if (OK(status) || con->curadr >= con->adrcnt) done = 1;
con->state = 1;
break;
}
}
/*
** We're done, one way or another. Fill in the caller's IOSB and
** call back the AST, if there was one.
*/
if (con->user_iosb != 0)
memcpy(con->user_iosb, &con->iosb, sizeof(con->iosb));
if (con->astadr != 0) (*con->astadr)(con->astprm);
/*
** We're done with this context -- free it
*/
lib$free_vm(&con->ctxsize, &con);
/*
** Synchronous completion occurs here.
*/
return status;
} /* do_connect */
/*
**++
** ROUTINE: netlib___dns_init
**
** FUNCTIONAL DESCRIPTION:
**
** Initializes an internal DNS resolver context.
**
** RETURNS: cond_value, longword (unsigned), write only, by value
**
** PROTOTYPE:
**
** netlib___dns_init(struct CTX *ctx)
**
** ctx: NETLIB context, modify, by reference.
**
** IMPLICIT INPUTS: None.
**
** IMPLICIT OUTPUTS: None.
**
** COMPLETION CODES: See code.
**
** SIDE EFFECTS: None.
**
**--
*/
unsigned int netlib___dns_init (struct CTX *ctx) {
struct DOMAIN *dom;
unsigned int status;
ITMLST lnmlst[3];
int i, maxidx;
unsigned int size;
unsigned short buflen;
char buf[256];
int did_tmo;
static unsigned int socktype = NETLIB_K_TYPE_DGRAM;
static unsigned int ctxsize = sizeof(struct DNSCTX);
static $DESCRIPTOR(tabnam, "LNM$FILE_DEV");
static $DESCRIPTOR(lognam, "NETLIB_SEARCH_DOMAIN");
static $DESCRIPTOR(tmolnm, "NETLIB_DNS_QUERY_TIMEOUT");
/*
** Allocate the DNS resolver context
*/
status = lib$get_vm(&ctxsize, &ctx->dnsctx);
if (!OK(status)) return status;
INIT_QUEUE(ctx->dnsctx->nsq);
INIT_QUEUE(ctx->dnsctx->domq);
/*
** Get the list of name servers we're supposed to contact
*/
if (netlib___get_nameservers(&ctx->dnsctx->nsq) == 0) {
lib$free_vm(&ctxsize, &ctx->dnsctx);
ctx->dnsctx = 0;
ctx->flags |= CTX_M_NO_DNS;
return SS$_UNSUPPORTED;
}
/*
** Get the list of NETLIB search domains, or the package-specific
** ones.
*/
ITMLST_INIT(lnmlst[0], LNM$_MAX_INDEX, sizeof(maxidx), &maxidx, 0);
ITMLST_INIT(lnmlst[1], 0, 0, 0, 0);
if (OK(sys$trnlnm(0, &tabnam, &lognam, 0, lnmlst))) {
ITMLST_INIT(lnmlst[0], LNM$_INDEX, sizeof(i), &i, 0);
ITMLST_INIT(lnmlst[1], LNM$_STRING, sizeof(buf), buf, &buflen);
ITMLST_INIT(lnmlst[2], 0, 0, 0, 0);
for (i = 0; i <= maxidx; i++) {
if (OK(sys$trnlnm(0, &tabnam, &lognam, 0, lnmlst)) && buflen != 0) {
size = buflen + sizeof(struct DOMAIN);
if (OK(lib$get_vm(&size, &dom))) {
dom->length = buflen;
memcpy(dom->name, buf, buflen);
dom->name[buflen] = '\0';
queue_insert(dom, ctx->dnsctx->domq.tail);
}
}
}
} else if (netlib___get_domain(buf, sizeof(buf), &buflen)) {
char *cp, *cp1;
int remain;
cp = buf;
remain = buflen;
/*
** A search domain must have at least two parts, to avoid the ".com.edu"
** problem, which is why we check to make sure that the remaining domain
** string has at least one dot.
*/
while (remain > 0) {
cp1 = memchr(cp, '.', remain);
if (cp1 == 0) break;
size = remain + sizeof(struct DOMAIN);
if (OK(lib$get_vm(&size, &dom))) {
dom->length = remain;
memcpy(dom->name, cp, remain);
dom->name[remain] = '\0';
queue_insert(dom, ctx->dnsctx->domq.tail);
}
remain -= (cp1 - cp) + 1;
cp = cp1 + 1;
}
}
did_tmo = 0;
ITMLST_INIT(lnmlst[0], LNM$_STRING, sizeof(buf), buf, &buflen);
ITMLST_INIT(lnmlst[1], 0, 0, 0, 0);
if (OK(sys$trnlnm(0, &tabnam, &tmolnm, 0, lnmlst))) {
struct dsc$descriptor dsc;
INIT_SDESC(dsc, buflen, buf);
/*
* Make sure it's a delta time value
*/
if (OK(sys$bintim(&dsc, &ctx->dnsctx->timeout)))
did_tmo = (int) ctx->dnsctx->timeout.long2 < 0;
}
if (!did_tmo)
sys$bintim(&default_timeout, &ctx->dnsctx->timeout);
ctx->dnsctx->retry_count = 4;
return SS$_NORMAL;
} /* netlib___dns_init */
/*
**++
** ROUTINE: io_completion
**
** FUNCTIONAL DESCRIPTION:
**
** tbs
**
** RETURNS: cond_value, longword (unsigned), write only, by value
**
** PROTOTYPE:
**
** tbs
**
** IMPLICIT INPUTS: None.
**
** IMPLICIT OUTPUTS: None.
**
** COMPLETION CODES:
**
**
** SIDE EFFECTS: None.
**
**--
*/
static unsigned int io_completion (struct IOR *ior) {
struct CTX *ctx = ior->ctx;
ior->iorflags |= IOR_M_IO_COMPLETED;
if (ior->iorflags & IOR_M_IO_TIMED) sys$cantim(ior, 0);
if (ior->iosb.iosb_w_status == SS$_CANCEL && (ior->iorflags & IOR_M_IO_TIMEOUT))
ior->iosb.iosb_w_status = SS$_TIMEOUT;
if (ior->iosbp != 0) netlib___cvt_iosb(ior->iosbp, &ior->iosb);
if (ior->iorflags & IOR_M_COPY_LENGTH) {
if (OK(ior->iosb.iosb_w_status) && ior->spec_retlen != 0)
*(unsigned int *) ior->spec_retlen = ior->spec_length;
ior->iorflags &= ~IOR_M_COPY_LENGTH;
}
if (ior->iorflags & IOR_M_COPY_FROM) {
if (OK(ior->iosb.iosb_w_status) && ior->spec_userfrom != 0) {
unsigned int len;
len = ior->specior.fromlen;
if (len > ior->spec_length) len = ior->spec_length;
memcpy(ior->spec_userfrom, &ior->specior.from, len);
if (ior->spec_retlen != 0) *(unsigned int *)ior->spec_retlen = len;
}
ior->iorflags &= ~IOR_M_COPY_FROM;
}
if (ior->iorflags & IOR_M_COPY_ADDRS) {
struct HOSTENT *h;
h = ior->spec_hostent;
if (OK(ior->iosb.iosb_w_status)) {
char *base;
unsigned int *offlst;
int i;
base = (char *) h;
i = 0;
if (h->addrlist_offset != 0) {
struct INADDRDEF *alist = ior->spec_useralist;
offlst = (unsigned int *) (base+h->addrlist_offset);
while (i < ior->spec_length && offlst[i] != 0) {
alist[i] = *(struct INADDRDEF *) (base + offlst[i]);
i++;
}
}
if (ior->spec_retlen != 0) *(unsigned int *)ior->spec_retlen = i;
}
lib$free_vm(&hostent_size, &h);
ior->iorflags &= ~IOR_M_COPY_ADDRS;
}
if (ior->iorflags & IOR_M_COPY_HOSTNAME) {
struct HOSTENT *h;
h = ior->spec_hostent;
if (OK(ior->iosb.iosb_w_status)) {
str$copy_r(ior->spec_usrdsc, &ior->specior.fromlen,
h->buffer);
if (ior->spec_retlen != 0)
*(unsigned short *)ior->spec_retlen =
ior->specior.fromlen;
}
lib$free_vm(&hostent_size, &h);
ior->iorflags &= ~IOR_M_COPY_HOSTNAME;
}
if (ior->iorflags & IOR_M_NEW_CONTEXT) {
if (OK(ior->iosb.iosb_w_status)) {
*(struct CTX **) ior->spec_xnewctx = ior->spec_newctx;
} else {
sys$dassgn(((struct CTX *)ior->spec_newctx)->chan);
netlib___free_ctx((struct CTX *) ior->spec_newctx);
}
ior->iorflags &= ~IOR_M_NEW_CONTEXT;
}
if (ior->astadr != 0) (*(ior->astadr))(ior->astprm);
FREE_IOR(ior);
return SS$_NORMAL;
} /* io_completion */
/*
**++
** ROUTINE: sp_open
**
** FUNCTIONAL DESCRIPTION:
**
** Spawns a subprocess, possibly passing it an initial command.
**
** RETURNS: cond_value, longword (unsigned), write only, by value
**
** PROTOTYPE:
**
** sp_open(SPHANDLE *ctxpp, struct dsc$descriptor *inicmd,
** unsigned int (*rcvast)(void *), void *rcvastprm);
**
** IMPLICIT INPUTS: None.
**
** IMPLICIT OUTPUTS: None.
**
** COMPLETION CODES:
** SS$_NORMAL: Normal successful completion.
**
** SIDE EFFECTS: None.
**
**--
*/
unsigned int sp_open (SPHANDLE *ctxpp, void *inicmd, unsigned int (*rcvast)(void *), void *rcvastprm) {
SPHANDLE ctx;
unsigned int dvi_devnam = DVI$_DEVNAM, dvi_devbufsiz = DVI$_DEVBUFSIZ;
unsigned int spawn_flags = CLI$M_NOWAIT|CLI$M_NOKEYPAD;
unsigned int status;
struct dsc$descriptor inbox, outbox;
status = lib$get_vm(&spb_size, &ctx);
if (!OK(status)) return status;
/*
** Assign the SPHANDLE address for the caller immediately to avoid timing issues with
** WRTATTN AST that passes the ctx as rcvastprm (which sp_once does).
*/
*ctxpp = ctx;
ctx->sendque.head = ctx->sendque.tail = &ctx->sendque;
ctx->ok_to_send = 0;
/*
** Create the mailboxes we'll be using for I/O with the subprocess
*/
status = sys$crembx(0, &ctx->inchn, 1024, 1024, 0xff00, 0, 0, 0);
if (!OK(status)) {
lib$free_vm(&spb_size, &ctx);
return status;
}
status = sys$crembx(0, &ctx->outchn, 1024, 1024, 0xff00, 0, 0, 0);
if (!OK(status)) {
sys$dassgn(ctx->inchn);
lib$free_vm(&spb_size, &ctx);
return status;
}
/*
** Now that they're created, let's find out what they're called so we
** can tell LIB$SPAWN
*/
INIT_DYNDESC(inbox);
INIT_DYNDESC(outbox);
lib$getdvi(&dvi_devnam, &ctx->inchn, 0, 0, &inbox);
lib$getdvi(&dvi_devnam, &ctx->outchn, 0, 0, &outbox);
lib$getdvi(&dvi_devbufsiz, &ctx->outchn, 0, &ctx->bufsiz);
/*
** Create the output buffer for the subprocess.
*/
status = lib$get_vm(&ctx->bufsiz, &ctx->bufptr);
if (!OK(status)) {
sys$dassgn(ctx->outchn);
sys$dassgn(ctx->inchn);
str$free1_dx(&inbox);
str$free1_dx(&outbox);
lib$free_vm(&spb_size, &ctx);
return status;
}
/*
** Set the "receive AST" routine to be invoked by SP_WRTATTN_AST
*/
ctx->rcvast = rcvast;
ctx->astprm = rcvastprm;
sys$qiow(0, ctx->outchn, IO$_SETMODE|IO$M_WRTATTN, 0, 0, 0,
sp_wrtattn_ast, ctx, 0, 0, 0, 0);
sys$qiow(0, ctx->inchn, IO$_SETMODE|IO$M_READATTN, 0, 0, 0,
sp_readattn_ast, ctx, 0, 0, 0, 0);
/*
** Get us a termination event flag
*/
status = lib$get_ef(&ctx->termefn);
if (OK(status)) lib$get_ef(&ctx->inefn);
if (OK(status)) lib$get_ef(&ctx->outefn);
if (!OK(status)) {
sys$dassgn(ctx->outchn);
sys$dassgn(ctx->inchn);
str$free1_dx(&inbox);
str$free1_dx(&outbox);
lib$free_vm(&ctx->bufsiz, &ctx->bufptr);
lib$free_vm(&spb_size, &ctx);
return status;
}
/*
** Now create the subprocess
*/
status = lib$spawn(inicmd, &inbox, &outbox, &spawn_flags, 0, &ctx->pid,
0, &ctx->termefn);
if (!OK(status)) {
lib$free_ef(&ctx->termefn);
lib$free_ef(&ctx->outefn);
lib$free_ef(&ctx->inefn);
sys$dassgn(ctx->outchn);
sys$dassgn(ctx->inchn);
str$free1_dx(&inbox);
str$free1_dx(&outbox);
lib$free_vm(&ctx->bufsiz, &ctx->bufptr);
lib$free_vm(&spb_size, &ctx);
return status;
}
/*
** Set up the exit handler, if we haven't done so already
*/
status = sys$setast(0);
if (!exh_declared) {
sys$dclexh(&exhblk);
exh_declared = 1;
}
if (status == SS$_WASSET) sys$setast(1);
/*
** Save the SPB in our private queue
*/
queue_insert(ctx, spque.tail);
/*
** Clean up and return
*/
str$free1_dx(&inbox);
str$free1_dx(&outbox);
return SS$_NORMAL;
} /* sp_open */
void cmj_mbx_ast(struct NTD *tsk)
{
struct CLB *cmu_makclb();
struct dsc$descriptor_s ncb_desc;
uint4 status, unit;
cm_mbx *mp;
struct CLB *lnk;
bool newclb;
void cmj_ast();
status = 0;
mp = tsk->mbx.dsc$a_pointer;
assert(mp->netnum == 3 && mp->netnam[0] == 'N' && mp->netnam[1] == 'E' && mp->netnam[2] == 'T');
switch(mp->msg)
{
case MSG$_CONNECT:
lnk = cmj_unit2clb(tsk, mp->unit);
if (lnk == 0)
{
newclb = TRUE;
lnk = cmu_makclb();
lnk->dch = tsk->dch;
lnk->ntd = tsk;
}else
{
newclb = FALSE;
assert(lnk->sta == CM_CLB_IDLE);
}
ncb_desc.dsc$w_length = mp->len;
ncb_desc.dsc$b_dtype = DSC$K_DTYPE_T;
ncb_desc.dsc$b_class = DSC$K_CLASS_S;
ncb_desc.dsc$a_pointer = mp->text;
lnk->mbf = 0;
/* the statement below and the 3 qio's emulate cmj_iostart which could be used if lnk->clb were a int4 */
lnk->sta = CM_CLB_WRITE;
if (tsk->crq == 0)
{
lnk->ast = cmj_reject_ast;
status = sys$qio(efn_ignore, lnk->dch, IO$_ACCESS | IO$M_ABORT,
&lnk->ios, cmj_ast, lnk,
lnk->mbf, &ncb_desc, 0, 0, 0, 0);
} else
{ if (tsk->acc && !(*tsk->acc)(lnk))
{
lnk->ast = cmj_reject_ast;
status = sys$qio(efn_ignore, lnk->dch, IO$_ACCESS | IO$M_ABORT,
&lnk->ios, cmj_ast, lnk,
lnk->mbf, &ncb_desc, 0, 0, 0, 0);
}else
{
status = sys$assign(&cm_netname, &lnk->dch, 0, &tsk->mnm);
if (status & 1)
{
status = lib$getdvi(&DVI$_UNIT, &lnk->dch, 0, &unit, 0, 0);
if (status & 1)
{
lnk->mun = (unsigned short)unit;
lnk->ast = cmj_accept_ast;
status = sys$qio(efn_ignore, lnk->dch, IO$_ACCESS,
&lnk->ios, cmj_ast, lnk,
lnk->mbf, &ncb_desc, 0, 0, 0, 0);
}
}
}
}
if ((status & 1) == 0)
{
if (newclb)
{
lib$free_vm(&SIZEOF(*lnk), &lnk, 0);
lnk = 0;
}
cmj_mbx_err(status, tsk, lnk);
break;
}
return;
case MSG$_INTMSG:
if (tsk->mbx_ast != 0)
{ (*tsk->mbx_ast)(tsk);
break;
}
/* CAUTION: FALLTHROUGH */
case MSG$_DISCON:
case MSG$_ABORT:
case MSG$_EXIT:
case MSG$_PATHLOST:
case MSG$_PROTOCOL:
case MSG$_THIRDPARTY:
case MSG$_TIMEOUT:
case MSG$_NETSHUT:
case MSG$_REJECT:
case MSG$_CONFIRM:
if (tsk->err)
{
lnk = cmj_unit2clb(tsk, mp->unit);
(*tsk->err)(tsk, lnk, mp->msg);
}else
rts_error(CMI_NETFAIL,0,status); /* condition handler would need to close the connection */
/* CAUTION: FALLTHROUGH */
default:
break;
}
status = cmj_mbx_read_start(tsk);
if ((status & 1) == 0)
{
lnk = cmj_unit2clb(tsk, mp->unit);
cmj_mbx_err(status, tsk, lnk);
}
}
