[0001]
[0002]
[0003]
[0004]
[0005]
[0006]
[0007]
[0008]
[0009]
[0010]
[0011]
[0012]
[0013]
[0014]
[0015]
[0016]
[0017]
[0018]
[0019]
[0020]
[0021]
[0022]
[0023]
[0024]
[0025]
[0026]
[0027]
[0028]
[0029]
[0030]
[0031]
[0032]
[0033]
[0034]
[0035]
[0036]
[0037]
[0038]
[0039]
[0040]
[0041]
[0042]
[0043]
[0044]
[0045]
[0046]
[0047]
[0048]
[0049]
[0050]
[0051]
[0052]
[0053]
[0054]
[0055]
[0056]
[0057]
[0058]
[0059]
[0060]
[0061]
[0062]
[0063]
[0064]
[0065]
[0066]
[0067]
[0068]
[0069]
[0070]
[0071]
[0072]
[0073]
[0074]
[0075]
[0076]
[0077]
[0078]
[0079]
[0080]
[0081]
[0082]
[0083]
[0084]
[0085]
[0086]
[0087]
[0088]
[0089]
[0090]
[0091]
[0092]
[0093]
[0094]
[0095]
[0096]
[0097]
[0098]
[0099]
[0100]
[0101]
[0102]
[0103]
[0104]
[0105]
[0106]
[0107]
[0108]
[0109]
[0110]
[0111]
[0112]
[0113]
[0114]
[0115]
[0116]
[0117]
[0118]
[0119]
[0120]
[0121]
[0122]
[0123]
[0124]
[0125]
[0126]
[0127]
[0128]
[0129]
[0130]
[0131]
[0132]
[0133]
[0134]
[0135]
[0136]
[0137]
[0138]
[0139]
[0140]
[0141]
[0142]
[0143]
[0144]
[0145]
[0146]
[0147]
[0148]
[0149]
[0150]
[0151]
[0152]
[0153]
[0154]
[0155]
[0156]
[0157]
[0158]
[0159]
[0160]
[0161]
[0162]
[0163]
[0164]
[0165]
[0166]
[0167]
[0168]
[0169]
[0170]
[0171]
[0172]
[0173]
[0174]
[0175]
[0176]
[0177]
[0178]
[0179]
[0180]
[0181]
[0182]
[0183]
[0184]
[0185]
[0186]
[0187]
[0188]
[0189]
[0190]
[0191]
[0192]
[0193]
[0194]
[0195]
[0196]
[0197]
[0198]
[0199]
[0200]
[0201]
[0202]
[0203]
[0204]
[0205]
[0206]
[0207]
[0208]
[0209]
[0210]
[0211]
[0212]
[0213]
[0214]
[0215]
[0216]
[0217]
[0218]
[0219]
[0220]
[0221]
[0222]
[0223]
[0224]
[0225]
[0226]
[0227]
[0228]
[0229]
[0230]
[0231]
[0232]
[0233]
[0234]
[0235]
[0236]
[0237]
[0238]
[0239]
[0240]
[0241]
[0242]
[0243]
[0244]
[0245]
[0246]
[0247]
[0248]
[0249]
[0250]
[0251]
[0252]
[0253]
[0254]
[0255]
[0256]
[0257]
[0258]
[0259]
[0260]
[0261]
[0262]
[0263]
[0264]
[0265]
[0266]
[0267]
[0268]
[0269]
[0270]
[0271]
[0272]
[0273]
[0274]
[0275]
[0276]
[0277]
[0278]
[0279]
[0280]
[0281]
[0282]
[0283]
[0284]
[0285]
[0286]
[0287]
[0288]
[0289]
[0290]
[0291]
[0292]
[0293]
[0294]
[0295]
[0296]
[0297]
[0298]
[0299]
[0300]
[0301]
[0302]
[0303]
[0304]
[0305]
[0306]
[0307]
[0308]
[0309]
[0310]
[0311]
[0312]
[0313]
[0314]
[0315]
[0316]
[0317]
[0318]
[0319]
[0320]
[0321]
[0322]
[0323]
[0324]
[0325]
[0326]
[0327]
[0328]
[0329]
[0330]
[0331]
[0332]
[0333]
[0334]
[0335]
[0336]
[0337]
[0338]
[0339]
[0340]
[0341]
[0342]
[0343]
[0344]
[0345]
[0346]
[0347]
[0348]
[0349]
[0350]
[0351]
[0352]
[0353]
[0354]
[0355]
[0356]
[0357]
[0358]
[0359]
[0360]
[0361]
[0362]
[0363]
[0364]
[0365]
[0366]
[0367]
[0368]
[0369]
[0370]
[0371]
[0372]
[0373]
[0374]
[0375]
[0376]
[0377]
[0378]
[0379]
[0380]
[0381]
[0382]
[0383]
[0384]
[0385]
[0386]
[0387]
[0388]
[0389]
[0390]
[0391]
[0392]
[0393]
[0394]
[0395]
[0396]
[0397]
[0398]
[0399]
[0400]
[0401]
[0402]
[0403]
[0404]
[0405]
[0406]
[0407]
[0408]
[0409]
[0410]
[0411]
[0412]
[0413]
[0414]
[0415]
[0416]
[0417]
[0418]
[0419]
[0420]
[0421]
[0422]
[0423]
[0424]
[0425]
[0426]
[0427]
[0428]
[0429]
[0430]
[0431]
[0432]
[0433]
[0434]
[0435]
[0436]
[0437]
[0438]
[0439]
[0440]
[0441]
[0442]
[0443]
[0444]
[0445]
[0446]
[0447]
[0448]
[0449]
[0450]
[0451]
[0452]
[0453]
[0454]
[0455]
[0456]
[0457]
[0458]
[0459]
[0460]
[0461]
[0462]
[0463]
[0464]
[0465]
[0466]
[0467]
[0468]
[0469]
[0470]
[0471]
[0472]
[0473]
[0474]
[0475]
[0476]
[0477]
[0478]
[0479]
[0480]
[0481]
[0482]
[0483]
[0484]
[0485]
[0486]
[0487]
[0488]
[0489]
[0490]
[0491]
[0492]
[0493]
[0494]
[0495]
[0496]
[0497]
[0498]
[0499]
[0500]
[0501]
[0502]
[0503]
[0504]
[0505]
[0506]
[0507]
[0508]
[0509]
[0510]
[0511]
[0512]
[0513]
[0514]
[0515]
[0516]
[0517]
[0518]
[0519]
[0520]
[0521]
[0522]
[0523]
[0524]
[0525]
[0526]
[0527]
[0528]
[0529]
[0530]
[0531]
[0532]
[0533]
[0534]
[0535]
[0536]
[0537]
[0538]
[0539]
[0540]
[0541]
[0542]
[0543]
[0544]
[0545]
[0546]
[0547]
[0548]
[0549]
[0550]
[0551]
[0552]
[0553]
[0554]
[0555]
[0556]
[0557]
[0558]
[0559]
[0560]
[0561]
[0562]
[0563]
[0564]
[0565]
[0566]
[0567]
[0568]
[0569]
[0570]
[0571]
[0572]
[0573]
[0574]
[0575]
[0576]
[0577]
[0578]
[0579]
[0580]
[0581]
[0582]
[0583]
[0584]
[0585]
[0586]
[0587]
[0588]
[0589]
[0590]
[0591]
[0592]
[0593]
[0594]
[0595]
[0596]
[0597]
[0598]
[0599]
[0600]
[0601]
[0602]
[0603]
[0604]
/*****************************************************************************/
/*
DCLmembuf.c
Bulk data transfer from script to server using a (global section) memory
buffer. Intended for transfers of multiple megabytes, tens of megabytes, and
so up. Testing indicates transfers in excess of 500% of the standard mailbox
bandwidth, along with notable improvements in resource utilisation. YMMV
with platform, O/S version and TCP/IP stack (i.e. as the relative bottlenecks
shuffle about).
The script requests a memory-buffer using a callout. This module creates and
maps a non-permanent global section with a unique, one-off name. If this is
successful the script is advised of the global section name using the callout
response. The script uses this to map the section name and can then populate
the buffer. When the buffer is full or otherwise ready, the script issues a
callout with the number of bytes to write, and then stalls. This write is
accomplished asynchronously and may comprise multiple network $QIOs or TLS/SSL
blocks. When complete a callout response to the script is issued and the
script can continue processing. Standard script mailbox I/O (SYS$OUTPUT,
<stdout>) and memory-buffer I/O may be interleaved as required.
DCL.C callouts associated with the functionality in this module:
BUFFER-BEGIN:<integer>[k|M] create temporary global section for output
(default is an integer number of Mbytes)
BUFFER-END: release the global section
BUFFER-WRITE:<integer> write <integer> bytes from the buffer
See [SRC.MISC]MEMBUFLIB.C and [SRC.MISC]MEMBUFDEMO.C for examples of script
code suitable to use the memory buffer facility.
Global section access depends (to a certain extent) on security through
obscurity. Hmmmm. The global section allows full access to all. This
simplifies management of the section between the server and scripting accounts.
The name of the section comprises "WASD_MEMBUF_" plus twenty hex digits derived
in a non-determinate, non-repeating manner. The name is passed back to the
script to use for mapping the section. The likelihood of a(n unprivileged)
third-party operating on the system trying to guess these is improbable. The
(relatively) short life of each global section decreases the probability
further.
COMPARISON
----------
Actual data comparing standard mailbox IPC with memory-buffer generated using
[SRC.MISC]MEMBUFDEMO.C on a HP rx2660 (1.40GHz/6.0MB) with 4 CPUs and 16383MB
running VMS V8.4-2L1 with Multinet UCX$IPC_SHR V55A-B147, OpenSSL 1.0.2k and
WASD v11.1.1, with [BufferSizeDclOutput] 16384.
|$ wget "-O" nl: http://127.0.0.1/cgi-bin/membufdemo?250
|--2017-10-14 03:19:05-- http://127.0.0.1/cgi-bin/membufdemo?250
|Connecting to 127.0.0.1:80... connected.
|HTTP request sent, awaiting response... 200 OK
|Length: 262144000 (250M) [application/octet-stream]
|Saving to: 'nl:'
|
|nl: 100%[=====================>] 250.00M 25.6MB/s in 12s
|
|2017-10-14 03:19:17 (20.5 MB/s) - 'nl:' saved [262144000/262144000]
|
|$ wget "-O" nl: http://127.0.0.1/cgi-bin/membufdemo?250+b
|--2017-10-14 03:19:23-- http://127.0.0.1/cgi-bin/membufdemo?250+b
|Connecting to 127.0.0.1:80... connected.
|HTTP request sent, awaiting response... 200 OK
|Length: 262144000 (250M) [application/octet-stream]
|Saving to: 'nl:'
|
|nl: 100%[=====================>] 250.00M 105MB/s in 2.4s
|
|2017-10-14 03:19:26 (105 MB/s) - 'nl:' saved [262144000/262144000]
|
|$ wget "-O" nl: https://127.0.0.1/cgi-bin/membufdemo?250
|--2017-10-14 03:19:50-- https://127.0.0.1/cgi-bin/membufdemo?250
|Connecting to 127.0.0.1:443... connected.
|HTTP request sent, awaiting response... 200 OK
|Length: 262144000 (250M) [application/octet-stream]
|Saving to: 'nl:'
|
|nl: 100%[=====================>] 250.00M 14.5MB/s in 17s
|
|2017-10-14 03:20:07 (14.5 MB/s) - 'nl:' saved [262144000/262144000]
|
|$ wget "-O" nl: https://127.0.0.1/cgi-bin/membufdemo?250+b
|--2017-10-14 03:20:12-- https://127.0.0.1/cgi-bin/membufdemo?250+b
|HTTP request sent, awaiting response... 200 OK
|Length: 262144000 (250M) [application/octet-stream]
|Saving to: 'nl:'
|
|nl: 100%[=====================>] 250.00M 16.6MB/s in 15s
|
|2017-10-14 03:20:27 (16.6 MB/s) - 'nl:' saved [262144000/262144000]
It is obvious that memory-buffer provides significantly greater throughput than
mailbox (from the http:// test) and that with TLS/SSL network transport the
encryption becomes a significant overhead and choke-point. Nevertheless, there
is still an approximate 15% dividend, plus the more efficient interface the
script->memory-buffer->server provides. The VMS TLS/SSL implementation may
improve with time, especially if TLS/SSL hardware engines become available with
the port to x86_64.
POSTSCRIPT: The comparison also illustrates that the WASD environment can
deliver significant bandwidth through its script->server->network pathways.
On the demonstration class of system; ~200Mbps unencrypted and ~120Mbps
encrypted using the standard mailbox IPC; with ~850Mbps unencrypted and
~130Mbps encrypted using the memory-buffer IPC.
VERSION HISTORY
---------------
08-OCT-2017 MGD initial
*/
/*****************************************************************************/
#ifdef WASD_VMS_V7
# undef __VMS_VER
# define __VMS_VER 70000000
# undef __CRTL_VER
# define __CRTL_VER 70000000
#else
# ifdef WASD_VMS_V7
# undef _VMS__V6__SOURCE
# define _VMS__V6__SOURCE
# undef __VMS_VER
# define __VMS_VER 70000000
# undef __CRTL_VER
# define __CRTL_VER 70000000
# endif
#endif
#include <stdio.h>
#include <ctype.h>
#include <errno.h>
#include <in.h>
#include <secdef.h>
#include "wasd.h"
#define WASD_MODULE "DCLMEMBUF"
/* size of global section in megabytes */
#define DCLMEMBUF_SIZE_DEF 10
#define DCLMEMBUF_SIZE_MIN 1
#define DCLMEMBUF_SIZE_MAX 128
/******************/
/* global storage */
/******************/
int64 DclMemBufCount64;
uint DclMemBufFailCount,
DclMemBufGblPageCount,
DclMemBufGblPageCountMax,
DclMemBufGblPageCountMin,
DclMemBufGblPageMax,
DclMemBufGblPageMin,
DclMemBufGblSectionCount,
DclMemBufSizeDefault = DCLMEMBUF_SIZE_DEF, /*** temporary ***/
DclMemBufSizeMax,
DclMemBufSizeMin;
static char DclMemBuffer [256];
/********************/
/* external storage */
/********************/
extern int InstanceNumber;
extern uint EfnWait,
EfnNoWait,
HttpdTickSecond;
extern ulong GblSecPrvMask[];
extern char ErrorSanityCheck[];
extern struct dsc$descriptor TcpIpDeviceDsc;
extern TCP_SOCKET_ITEM TcpIpSocket4;
extern VMS_ITEM_LIST2 TcpIpSocketReuseAddrOption;
extern VMS_ITEM_LIST2 TcpIpSocketShareOption;
extern VMS_ITEM_LIST2 TcpIpFullDuplexCloseOption;
extern ACCOUNTING_STRUCT *AccountingPtr;
extern CONFIG_STRUCT Config;
extern WATCH_STRUCT Watch;
/*****************************************************************************/
/*
Initialise the DCL memory buffer facility.
*/
void DclMemBufInit ()
{
/*********/
/* begin */
/*********/
if (WATCH_MODULE (WATCH_MOD_DCL))
WatchThis (WATCHALL, WATCH_MOD_DCL, "DclMemBufInit()");
if (DclMemBufSizeMin < DCLMEMBUF_SIZE_MIN)
DclMemBufSizeMin = DCLMEMBUF_SIZE_MIN;
if (!DclMemBufSizeMax || DclMemBufSizeMax > DCLMEMBUF_SIZE_MAX)
DclMemBufSizeMax = DCLMEMBUF_SIZE_MAX;
if (DclMemBufSizeDefault < DclMemBufSizeMin)
DclMemBufSizeDefault = DclMemBufSizeMin;
else
if (DclMemBufSizeDefault > DclMemBufSizeMax)
DclMemBufSizeDefault = DclMemBufSizeMax;
if (WATCH_MODULE (WATCH_MOD_DCL))
WatchThis (WATCHALL, WATCH_MOD_DCL, "min: !UL max: !UL",
DclMemBufSizeMin, DclMemBufSizeMax);
}
/*****************************************************************************/
/*
Begin using a memory buffer by passing a string containing an integer number of
Mbytes (2048 x pages or 1024*1024 bytes) to allocate to the buffer. The size
can be specified in kilobytes if the integer is immediately followed by a
character 'k'.
*/
char* DclMemBufBegin
(
DCL_TASK *tkptr,
char *param
)
{
int size, status;
char *cptr;
/*********/
/* begin */
/*********/
if (WATCHMOD (tkptr, WATCH_MOD_DCL))
WatchThis (WATCHALL, WATCH_MOD_DCL, "DclMemBufBegin() !UL !UL !UL !AZ",
DclMemBufSizeDefault, DclMemBufSizeMin, DclMemBufSizeMax,
param);
/* if a subsequent begin without intervening delete */
if (tkptr->MemBufGblSecPtr) DclMemBufDelete (tkptr);
for (cptr = param; *cptr && isspace(*cptr); cptr++);
size = 0;
if (isdigit(*cptr))
{
size = atoi(cptr);
/* if zero is specified then use the configuration default */
if (!size) size = DclMemBufSizeDefault;
/* convert to megabytes */
size *= (1024 * 1024);
while (*cptr && isdigit(*cptr)) cptr++;
/* if was specified as kilobytes */
if (*cptr == 'k' || *cptr == 'K')
size /= 1024;
else
/* only other unit is 'M'egabytes */
if (*cptr && !(*cptr == 'm' || *cptr == 'M' || isspace(*cptr)))
size = 0;
}
if ((size >= DclMemBufSizeMin * (1024 * 1024)) &&
(size <= DclMemBufSizeMax * (1024 * 1024)))
status = DclMemBufCreate (tkptr, size);
else
status = SS$_BADBUFLEN;
if (WATCHING (tkptr, WATCH_DCL))
WatchThis (WATCHITM(tkptr), WATCH_DCL,
"BUFFER begin !UL bytes !UL pages \"!AZ\" !&S",
tkptr->MemBufSize, tkptr->MemBufSize / 512,
tkptr->MemBufGblSecName, status);
if (VMSok (status))
FaoToBuffer (DclMemBuffer, sizeof(DclMemBuffer), NULL,
"200 !AZ", tkptr->MemBufGblSecName);
else
FaoToBuffer (DclMemBuffer, sizeof(DclMemBuffer), NULL, "500 !&S", status);
return (DclMemBuffer);
}
/*****************************************************************************/
/*
End using the memory buffer by deleting the global section and reseting the
task memory buffer fields.
*/
char* DclMemBufEnd
(
DCL_TASK *tkptr,
char *param
)
{
int status;
int64 count64;
/*********/
/* begin */
/*********/
if (WATCHMOD (tkptr, WATCH_MOD_DCL))
WatchThis (WATCHALL, WATCH_MOD_DCL, "DclMemBufEnd() !AZ", param);
count64 = tkptr->MemBufCount64;
status = DclMemBufDelete (tkptr);
if (WATCHING (tkptr, WATCH_DCL))
WatchThis (WATCHITM(tkptr), WATCH_DCL,
"BUFFER end !@SQ bytes transferred !&S",
&count64, status);
if (VMSok (status))
FaoToBuffer (DclMemBuffer, sizeof(DclMemBuffer), NULL,
"200 !&S", status);
else
FaoToBuffer (DclMemBuffer, sizeof(DclMemBuffer), NULL,
"500 !&S", status);
return (DclMemBuffer);
}
/*****************************************************************************/
/*
The script is indicating the memory buffer has been written to and the data in
that global section should be written to the client. The string parameter
contains an integer number of bytes to write from the buffer. If the write
fails it immediately returns a status string. If the write is initiated it
return a NULL and the status string will be return asynchonously when the write
completes or fails.
*/
char* DclMemBufWrite
(
DCL_TASK *tkptr,
char *param
)
{
int bytes, status;
char *cptr;
NETIO_STRUCT *ioptr;
REQUEST_STRUCT *rqptr;
/*********/
/* begin */
/*********/
if (WATCHMOD (tkptr, WATCH_MOD_DCL))
WatchThis (WATCHALL, WATCH_MOD_DCL, "DclMemBufWrite() !AZ", param);
rqptr = tkptr->RequestPtr;
ioptr = rqptr->NetIoPtr;
if (rqptr->RequestState >= REQUEST_STATE_ABORT)
{
FaoToBuffer (DclMemBuffer, sizeof(DclMemBuffer), NULL, "500 abort");
return (DclMemBuffer);
}
for (cptr = param; *cptr && isspace(*cptr); cptr++);
bytes = 0;
if (isdigit(*cptr)) bytes = atoi(cptr);
if (tkptr->MemBufInProgress)
status = SS$_OPINCOMPL;
else
if (bytes > 0 && bytes <= tkptr->MemBufSize)
{
/* ensure any preceding/intervening SYS$OUTPUT (<stdout>) is flushed */
NetWrite (rqptr, NULL, NULL, 0);
status = NetIoWrite (ioptr, DclMemBufWriteAst, tkptr,
tkptr->MemBufGblSecPtr, bytes);
}
else
status = SS$_BADBUFLEN;
if (WATCHING (tkptr, WATCH_DCL))
WatchThis (WATCHITM(tkptr), WATCH_DCL,
"BUFFER write !UL bytes !&S", bytes, status);
if (VMSok (status))
{
tkptr->MemBufInProgress = true;
return (NULL);
}
FaoToBuffer (DclMemBuffer, sizeof(DclMemBuffer), NULL, "500 !&S", status);
return (DclMemBuffer);
}
/*****************************************************************************/
/*
The network write has completed (either successfully or not). Report that to
the script via a(n asynchronous) callout I/O.
*/
void DclMemBufWriteAst (DCL_TASK *tkptr)
{
int status;
unsigned short slen;
NETIO_STRUCT *ioptr;
REQUEST_STRUCT *rqptr;
/*********/
/* begin */
/*********/
if (WATCHMOD (tkptr, WATCH_MOD_DCL))
WatchThis (WATCHALL, WATCH_MOD_DCL, "DclMemBufWriteAst()");
rqptr = tkptr->RequestPtr;
ioptr = rqptr->NetIoPtr;
tkptr->MemBufInProgress = false;
tkptr->MemBufCount64 += ioptr->WriteCount;
if (WATCHING (tkptr, WATCH_DCL))
WatchThis (WATCHITM(tkptr), WATCH_DCL,
"BUFFER written !UL/!@SQ bytes !&S",
ioptr->WriteCount, &tkptr->MemBufCount64, ioptr->WriteStatus);
if (rqptr->RequestState >= REQUEST_STATE_ABORT)
FaoToBuffer (DclMemBuffer, sizeof(DclMemBuffer), NULL, "500 abort");
else
if (VMSok (ioptr->WriteStatus))
FaoToBuffer (DclMemBuffer, sizeof(DclMemBuffer), &slen,
"200 !UL/!@SQ", ioptr->WriteCount, &tkptr->MemBufCount64);
else
FaoToBuffer (DclMemBuffer, sizeof(DclMemBuffer), &slen,
"500 !UL/!@SQ !&S", ioptr->WriteCount,
&tkptr->MemBufCount64, ioptr->WriteStatus);
DclCalloutQio (rqptr, DclMemBuffer, slen);
}
/*****************************************************************************/
/*
Create the global section associated with this DCL memory buffer.
*/
int DclMemBufCreate
(
DCL_TASK *tkptr,
int bytes
)
{
/* i.e. "WASD_MEMBUF_" followed by 20 indeterminate hex-digits */
static $DESCRIPTOR (GblSecNameFaoDsc, "WASD_MEMBUF_!2XL!8XL!8XL!2XL");
/* global, allocate space, system, in page file, writable */
static int CreFlags = SEC$M_GBL | SEC$M_EXPREG | SEC$M_SYSGBL |
SEC$M_PAGFIL | SEC$M_WRT;
/* system & owner full access, group and world full access */
static ulong ProtectionMask = 0x0000;
/* it is recommended to map into any virtual address in the region (P0) */
static ulong InAddr [2] = { 0x200, 0x200 };
static int GblSecNameCount;
static char GblSecName [32+1];
static $DESCRIPTOR (GblSecNameDsc, GblSecName);
int status,
GblSecPages,
PageCount;
ushort slen;
ulong Time64 [2],
RetAddr [2];
char *cptr, *sptr, *zptr;
void *gsptr;
/*********/
/* begin */
/*********/
if (WATCHMOD (tkptr, WATCH_MOD_DCL))
WatchThis (WATCHALL, WATCH_MOD_DCL, "DclMemBufCreate() !UL", bytes);
sys$gettim (&Time64);
sys$fao (&GblSecNameFaoDsc, &slen, &GblSecNameDsc,
(InstanceNumber & 0xff), Time64[0], Time64[1],
((GblSecNameCount++) & 0xff));
GblSecName[slen] = '\0';
GblSecNameDsc.dsc$w_length = slen;
/* buffers are specified in (1024) kilobytes */
GblSecPages = bytes / 512;
if (WATCHMOD (tkptr, WATCH_MOD_DCL))
WatchThis (WATCHALL, WATCH_MOD_DCL, "!AZ !&,UL bytes !&,UL pages",
GblSecName, GblSecPages * 512, GblSecPages);
/* create the specified global section */
sys$setprv (1, &GblSecPrvMask, 0, 0);
status = sys$crmpsc (&InAddr, &RetAddr, 0, CreFlags,
&GblSecNameDsc, 0, 0, 0, GblSecPages, 0,
ProtectionMask, GblSecPages);
sys$setprv (0, &GblSecPrvMask, 0, 0);
if (WATCHMOD (tkptr, WATCH_MOD_DCL))
WatchThis (WATCHALL, WATCH_MOD_DCL,
"sys$crmpsc() !&S begin:!UL end:!UL",
status, RetAddr[0], RetAddr[1]);
if (VMSnok (status))
{
DclMemBufFailCount++;
return (status);
}
PageCount = (RetAddr[1]+1) - RetAddr[0] >> 9;
gsptr = (void*)RetAddr[0];
memset (gsptr, 0, PageCount * 512);
DclMemBufCount64++;
DclMemBufGblSectionCount++;
DclMemBufGblPageCount += PageCount;
if (!DclMemBufGblPageCountMin ||
DclMemBufGblPageCount < DclMemBufGblPageCountMin)
DclMemBufGblPageCountMin = DclMemBufGblPageCount;
if (DclMemBufGblPageCount > DclMemBufGblPageCountMax)
DclMemBufGblPageCountMax = DclMemBufGblPageCount;
if (PageCount > DclMemBufGblPageMax) DclMemBufGblPageMax = PageCount;
if (PageCount < DclMemBufGblPageMin) DclMemBufGblPageMin = PageCount;
tkptr->MemBufGblSecPtr = gsptr;
tkptr->MemBufSize = PageCount * 512;
zptr = (sptr = tkptr->MemBufGblSecName) + sizeof(tkptr->MemBufGblSecName)-1;
for (cptr = GblSecName; *cptr && sptr < zptr; *sptr++ = *cptr++);
*sptr = '\0';
return (status);
}
/*****************************************************************************/
/*
Delete the global section and reset the corresponding task fields.
*/
int DclMemBufDelete (DCL_TASK *tkptr)
{
static int DelFlags = SEC$M_SYSGBL;
static $DESCRIPTOR (GblSecNameDsc, "");
int status;
/*********/
/* begin */
/*********/
if (WATCHMOD (tkptr, WATCH_MOD_DCL))
WatchThis (WATCHALL, WATCH_MOD_DCL,
"DclMemBufDelete() !AZ !UL bytes !UL pages",
tkptr->MemBufGblSecName, tkptr->MemBufSize,
tkptr->MemBufSize / 512);
/* if I/O is in progress then just ensure it aborts */
if (tkptr->MemBufInProgress)
if (tkptr->RequestPtr)
tkptr->RequestPtr->NetIoPtr->VmsStatus = SS$_ABORT;
if (tkptr->MemBufGblSecPtr)
{
GblSecNameDsc.dsc$a_pointer = tkptr->MemBufGblSecName;
GblSecNameDsc.dsc$w_length = strlen(tkptr->MemBufGblSecName);
sys$setprv (1, &GblSecPrvMask, 0, 0);
status = sys$dgblsc (DelFlags, &GblSecNameDsc, 0);
sys$setprv (0, &GblSecPrvMask, 0, 0);
DclMemBufGblSectionCount--;
DclMemBufGblPageCount -= tkptr->MemBufSize / 512;
}
else
status = SS$_BUGCHECK;
if (VMSnok (status)) ErrorNoticed (NULL, status, NULL, FI_LI);
tkptr->MemBufGblSecPtr = NULL;
tkptr->MemBufSize = 0;
tkptr->MemBufCount64 = 0;
tkptr->MemBufGblSecName[0] = '\0';
return (status);
}
/*****************************************************************************/