static DF2(jtfolkcomp0){F2PREFIP;DECLFGH;PROLOG(0035);A z;AF f;D oldct=jt->ct;
RZ(a&&w);
jt->ct=0;
if(f=atcompf(a,w,self))z=f(jt,a,w,self); else if(cap(fs))CAP2 else FOLK2;
jt->ct=oldct;
EPILOG(z);
}
// General setup for verbs with IRS that do not go through jtirs[12]
// A verb u["n] using this function checks to see whether it has multiple cells; if so,
// it calls here, giving a callback; we split the arguents into cells and call the callback,
// which is often the same original function that called here.
A jtrank2ex(J jt,A a,A w,A fs,I lr,I rr,AF f2){PROLOG(0042);A y,y0,ya,yw,z;B ab,b,wb;
C*u,*uu,*v,*vv;I acn,acr,af,ak,ar,*as,at,k,mn,n=1,p,q,*s,wcn,wcr,wf,wk,wr,*ws,wt,yn,yr,*ys,yt;
RZ(a&&w);
at=AT(a); wt=AT(w);
if(at&SPARSE||wt&SPARSE)R sprank2(a,w,fs,lr,rr,f2);
// ?r=rank, ?s->shape, ?cr=effective rank, ?f=#frame, ?b=relative flag, for each argument
ar=AR(a); as=AS(a); acr=efr(ar,lr); af=ar-acr; ab=ARELATIVE(a);
wr=AR(w); ws=AS(w); wcr=efr(wr,rr); wf=wr-wcr; wb=ARELATIVE(w);
if(!af&&!wf)R CALL2(f2,a,w,fs); // if there's only one cell, run on it, that's the result
// multiple cells. Loop through them.
// ?cn=number of atoms in a cell, ?k=#bytes in a cell, uv point to one cell before aw data
// Allocate y? to hold one cell of ?, with uu,vv pointing to the data of y?
RE(acn=prod(acr,as+af)); ak=acn*bp(at); u=CAV(a)-ak; NEWYA;
RE(wcn=prod(wcr,ws+wf)); wk=wcn*bp(wt); v=CAV(w)-wk; NEWYW;
// b means 'w frame is larger'; p=#larger frame; q=#shorter frame; s->larger frame
// mn=#cells in larger frame (& therefore #cells in result); n=# times to repeat each cell
// from shorter-frame argument
b=af<=wf; p=b?wf:af; q=b?af:wf; s=b?ws:as; RE(mn=prod(p,s)); RE(n=prod(p-q,s+q));
ASSERT(!ICMP(as,ws,q),EVLENGTH); // error if frames are not same as prefix
// Initialize y? to hold data for the first cell; but if ? is empty, set y? to a cell of fills
if(AN(a))MOVEYA else RZ(ya=reshape(vec(INT,acr,as+af),filler(a)));
if(AN(w))MOVEYW else RZ(yw=reshape(vec(INT,wcr,ws+wf),filler(w)));
#define VALENCE 2
#define TEMPLATE 0
#include "cr_t.h"
}
/*
* @brief Called to destruct a fixed msg size (DLP_FLASH_PDU_SIZE)
*
* @param msg
*/
static inline void dlp_flash_msg_destruct_fix(struct hsi_msg *msg)
{
PROLOG("msg:0x%p", msg);
/* Delete the received msg */
dlp_pdu_free(msg, msg->channel);
EPILOG();
}
/*
* @brief Called to destruct a variable msg size (_write function)
*
* @param msg
*/
static inline void dlp_flash_msg_destruct_var(struct hsi_msg *msg)
{
PROLOG("msg:0x%p", msg);
/* Delete the received msg
* (size is variable, so dont consider the default PDU size) */
dlp_pdu_free(msg, -1);
EPILOG();
}
int WSAAPI
WSARecvDisconnect(
IN SOCKET s,
OUT LPWSABUF lpInboundDisconnectData
)
/*++
Routine Description:
Terminate reception on a socket, and retrieve the disconnect data if the
socket is connection-oriented.
Arguments:
s - A descriptor identifying a socket.
lpInboundDisconnectData - A pointer to the incoming disconnect data.
Returns:
Zero on success else SOCKET_ERROR. The error code is stored with
SetErrorCode().
--*/
{
PDPROCESS Process;
PDTHREAD Thread;
INT ErrorCode;
PDSOCKET Socket;
ErrorCode = PROLOG (&Process,&Thread);
if (ErrorCode==ERROR_SUCCESS) {
Socket = DSOCKET::GetCountedDSocketFromSocket(s);
if(Socket != NULL){
INT ReturnValue;
PDPROVIDER Provider;
Provider = Socket->GetDProvider();
ReturnValue = Provider->WSPRecvDisconnect(
s,
lpInboundDisconnectData,
&ErrorCode);
Socket->DropDSocketReference();
if (ReturnValue==ERROR_SUCCESS)
return ERROR_SUCCESS;
}
else {
ErrorCode = WSAENOTSOCK;
}
}
SetLastError(ErrorCode);
return(SOCKET_ERROR);
}
static DF1(jtpowseqlim){PROLOG(0039);A x,y,z,*zv;I i,n;
RZ(w);
RZ(z=exta(BOX,1L,1L,20L)); zv=AAV(z); *zv++=x=w;
i=1; n=AN(z);
while(1){
if(n==i){RZ(z=ext(0,z)); zv=i+AAV(z); n=AN(z);}
RZ(*zv++=x=df1(y=x,self));
if(equ(x,y)){AN(z)=*AS(z)=i; break;}
++i;
}
z=ope(z);
EPILOG(z);
} /* f^:(<_) w */
A jtrank1ex(J jt,A w,A fs,I mr,AF f1){PROLOG(0041);A y,y0,yw,z;B wb;C*v,*vv;
I k,mn,n=1,p,*s,wcn,wcr,wf,wk,wr,*ws,wt,yn,yr,*ys,yt;
RZ(w);
wt=AT(w);
if(wt&SPARSE)R sprank1(w,fs,mr,f1);
wr=AR(w); ws=AS(w); wcr=efr(wr,mr); wf=wr-wcr; wb=ARELATIVE(w);
if(!wf)R CALL1(f1,w,fs);
RE(wcn=prod(wcr,wf+ws)); wk=wcn*bp(wt); v=CAV(w)-wk; NEWYW;
p=wf; s=ws; RE(mn=prod(wf,ws));
if(AN(w))MOVEYW else RZ(yw=reshape(vec(INT,wcr,ws+wf),filler(w)));
#define VALENCE 1
#define TEMPLATE 0
#include "cr_t.h"
}
/*
* Push RX pdu on channel 0
*
*/
static int dlp_flash_push_rx_pdu(struct dlp_channel *ch_ctx)
{
int ret;
struct hsi_msg *rx_msg;
PROLOG();
/* Allocate a new RX msg */
rx_msg = dlp_pdu_alloc(ch_ctx->hsi_channel,
HSI_MSG_READ,
DLP_FLASH_RX_PDU_SIZE,
1,
ch_ctx,
dlp_flash_complete_rx,
dlp_flash_msg_destruct_fix);
if (!rx_msg) {
CRITICAL("dlp_pdu_alloc(RX) failed");
ret = -ENOMEM;
goto out;
}
/* Send the RX HSI msg */
ret = hsi_async(rx_msg->cl, rx_msg);
if (ret) {
CRITICAL("hsi_async() failed, ret:%d", ret);
ret = -EIO;
goto free_msg;
}
EPILOG();
return 0;
free_msg:
/* Free the msg */
dlp_pdu_free(rx_msg, rx_msg->channel);
out:
EPILOG();
return ret;
}
static DF2(jtcork2){F2PREFIP;DECLFGH;PROLOG(0027);A z; CAP2; EPILOG(z);}
AS2( mov ebp, DWORD PTR [ebp + 16] )
// ebp restored at end
#define EPILOG() \
AS2( movd edi, mm3 ) \
AS2( movd ebx, mm4 ) \
AS2( movd esi, mm5 ) \
AS2( mov esp, ebp ) \
AS1( pop ebp ) \
AS1( emms ) \
AS1( ret 12 )
#endif
PROLOG()
AS2( movd mm2, edx )
#ifdef OLD_GCC_OFFSET
AS2( add edx, 60 ) // des1 = des1 key
#else
AS2( add edx, 56 ) // des1 = des1 key
#endif
AS2( mov eax, DWORD PTR [esi] )
AS2( mov ebx, DWORD PTR [esi + 4] )
AS1( bswap eax ) // left
AS1( bswap ebx ) // right
AsmIPERM()
static DF2(jtnvv2){F1PREFIP;DECLFGH;PROLOG(0033);
PUSHZOMB; A protw = (A)((I)w+((I)jtinplace&JTINPLACEW)); A prota = (A)((I)a+((I)jtinplace&JTINPLACEA)); A hx=(h2)((VAV(hs)->flag&VINPLACEOK2)?jtinplace:jt,a,w,hs);
POPZOMB; A z=(g2)(VAV(gs)->flag&VINPLACEOK2&&hx!=protw&&hx!=prota?( (J)((I)jt|JTINPLACEW) ):jt,fs,hx,gs); EPILOG(z);}
static DF2(jtfolkcomp){F2PREFIP;DECLFGH;PROLOG(0034);A z;AF f;
RZ(a&&w);
if(f=atcompf(a,w,self))z=f(jt,a,w,self); else if(cap(fs))CAP2 else FOLK2;
EPILOG(z);
}
static DF2(jtcorx2){F2PREFIP;DECLFGH;PROLOG(0031);A z; if(cap(fs))RZ(z=df2(a,w,folk(ds(CCAP),gs,hs))) else FOLK2; EPILOG(z);}
// nvv forks. n must not be inplaced, since the fork may be reused. hx can be inplaced unless protected by caller.
static DF1(jtnvv1){F1PREFIP;DECLFGH;PROLOG(0032);
PUSHZOMB; A protw = (A)((I)w+((I)jtinplace&JTINPLACEW)); A hx=(h1)((VAV(hs)->flag&VINPLACEOK1)?jtinplace:jt, w,hs);
POPZOMB; A z=(g2)(VAV(gs)->flag&VINPLACEOK2&&hx!=protw?( (J)((I)jt|JTINPLACEW) ):jt,fs,hx,gs); EPILOG(z);}
int WSAAPI
connect(
IN SOCKET s,
IN const struct sockaddr FAR *name,
IN int namelen
)
/*++
Routine Description:
Establish a connection to a peer.
Arguments:
s - A descriptor identifying an unconnected socket.
name - The name of the peer to which the socket is to be connected.
namelen - The length of the name.
Returns:
Zero on success else SOCKET_ERROR. The error code is stored with
SetLastError().
--*/
{
INT ReturnValue;
PDPROCESS Process;
PDTHREAD Thread;
PDPROVIDER Provider;
INT ErrorCode;
PDSOCKET Socket;
BOOL RetryConnect;
INT SavedErrorCode;
ErrorCode = PROLOG(&Process, &Thread);
if (ErrorCode==ERROR_SUCCESS)
{
Socket = DSOCKET::GetCountedDSocketFromSocket(s);
if(Socket != NULL) {
Provider = Socket->GetDProvider();
#ifdef RASAUTODIAL
RetryConnect = FALSE;
retry:
#endif // RASAUTODIAL
ReturnValue = Provider->WSPConnect(s,
name,
namelen,
NULL,
NULL,
NULL,
NULL,
&ErrorCode);
#ifdef RASAUTODIAL
if (ReturnValue == SOCKET_ERROR &&
(ErrorCode == WSAEHOSTUNREACH || ErrorCode == WSAENETUNREACH))
{
if (!RetryConnect) {
//
// We preserve the original error
// so we can return it in case the
// second call to WSPConnect() fails
// also.
//
SavedErrorCode = ErrorCode;
//
// Only one retry per connect attempt.
//
RetryConnect = TRUE;
if (WSAttemptAutodialAddr(name, namelen))
goto retry;
}
else
ErrorCode = SavedErrorCode;
}
#endif // RASAUTODIAL
Socket->DropDSocketReference();
if (ReturnValue==ERROR_SUCCESS)
return ReturnValue;
assert (ErrorCode!=NO_ERROR);
if (ErrorCode==NO_ERROR)
ErrorCode = WSASYSCALLFAILURE;
}
else {
ErrorCode = WSAENOTSOCK;
}
}
//
// If this is a 1.x application and the service provider
// failed the request with WSAEALREADY, map the error code
// to WSAEINVAL to be consistent with MS's WinSock 1.1
// implementations.
//
if( ErrorCode == WSAEALREADY &&
Process->GetMajorVersion() == 1 ) {
ErrorCode = WSAEINVAL;
}
SetLastError(ErrorCode);
return SOCKET_ERROR;
}
// (name g h). If name is ultimately defined as [:, we redefine the derived verb and then run it, with no inplacing for it. Deprecated.
// The normal path supports inplacing
static DF1(jtcorx1){F1PREFIP;DECLFGH;PROLOG(0030);A z; if(cap(fs))RZ(z=df1( w,folk(ds(CCAP),gs,hs))) else FOLK1; EPILOG(z);}
int WSAAPI
WSAEnumProtocolsW(
IN LPINT lpiProtocols,
OUT LPWSAPROTOCOL_INFOW lpProtocolBuffer,
IN OUT LPDWORD lpdwBufferLength
)
/*++
Routine Description:
Retrieve information about available transport protocols.
Arguments:
lpiProtocols - A NULL-terminated array of protocol ids. This parameter
is optional; if lpiProtocols is NULL, information on all
available protocols is returned, otherwise information
is retrieved only for those protocols listed in the
array.
lpProtocolBuffer - A buffer which is filled with WSAPROTOCOL_INFOW
structures. See below for a detailed description of the
contents of the WSAPROTOCOL_INFOW structure.
lpdwBufferLength - On input, the count of bytes in the lpProtocolBuffer
buffer passed to WSAEnumProtocols(). On output, the
minimum buffer size that can be passed to
WSAEnumProtocols() to retrieve all the requested
information. This routine has no ability to enumerate
over multiple calls; the passed-in buffer must be large
enough to hold all entries in order for the routine to
succeed. This reduces the complexity of the API and
should not pose a problem because the number of
protocols loaded on a machine is typically small.
Returns:
The number of protocols to be reported on. Otherwise a value of
SOCKET_ERROR is returned and a specific stored with SetLastError().
--*/
{
INT ReturnCode;
PDPROCESS Process;
PDTHREAD Thread;
INT ErrorCode;
PDCATALOG Catalog;
PROTOCOL_ENUMERATION_CONTEXT EnumerationContext;
ErrorCode = PROLOG(&Process, &Thread);
if (ErrorCode != ERROR_SUCCESS) {
SetLastError(ErrorCode);
return(SOCKET_ERROR);
} //if
// Setup the enumeration context structure to hand the the
// protocol catalog iterator.
EnumerationContext.Protocols = lpiProtocols;
EnumerationContext.ProtocolBuffer = lpProtocolBuffer;
if (lpProtocolBuffer) {
__try {
EnumerationContext.BufferLength = *lpdwBufferLength;
}
__except (WS2_EXCEPTION_FILTER()) {
SetLastError (WSAEFAULT);
return SOCKET_ERROR;
}
}
else {
int WSAAPI
getsockopt(
IN SOCKET s,
IN int level,
IN int optname,
OUT char FAR * optval,
IN OUT int FAR *optlen
)
/*++
Routine Description:
Retrieve a socket option.
Arguments:
s - A descriptor identifying a socket.
level - The level at which the option is defined; the supported levels
include SOL_SOCKET and IPPROTO_TCP. (See annex for more
protocol-specific levels.)
optname - The socket option for which the value is to be retrieved.
optval - A pointer to the buffer in which the value for the requested
option is to be returned.
optlen - A pointer to the size of the optval buffer.
Returns:
Zero on success else SOCKET_ERROR. The error code is stored with
SetLastError().
--*/
{
INT ReturnValue;
PDPROCESS Process;
PDTHREAD Thread;
INT ErrorCode;
PDPROVIDER Provider;
PDSOCKET Socket;
WSAPROTOCOL_INFOW ProtocolInfoW;
char FAR * SavedOptionValue = NULL;
int SavedOptionLen = 0;
ErrorCode = PROLOG(&Process, &Thread);
if (ErrorCode==ERROR_SUCCESS) {
//
// SO_OPENTYPE hack-o-rama.
//
if( level == SOL_SOCKET && optname == SO_OPENTYPE ) {
__try {
if( optlen == NULL || *optlen < sizeof(INT) ) {
SetLastError( WSAEFAULT );
return SOCKET_ERROR;
}
*((LPINT)optval) = Thread->GetOpenType();
*optlen = sizeof(INT);
return ERROR_SUCCESS;
}
__except (WS2_EXCEPTION_FILTER()) {
SetLastError (WSAEFAULT);
return SOCKET_ERROR;
}
}
Socket = DSOCKET::GetCountedDSocketFromSocket(s);
if(Socket != NULL) {
Provider = Socket->GetDProvider();
//
// If we managed to lookup the provider from the socket, and the
// user is asking for the ANSI WSAPROTOCOL_INFOA information,
// then validate their option length parameter, remember this fact,
// and map the option name to SO_PROTOCOL_INFOW.
//
if( level == SOL_SOCKET &&
optname == SO_PROTOCOL_INFOA ) {
__try {
if( optval == NULL ||
optlen == NULL ||
*optlen < sizeof(WSAPROTOCOL_INFOA) ) {
* optlen = sizeof(WSAPROTOCOL_INFOA);
Socket->DropDSocketReference();
SetLastError (WSAEFAULT);
return (SOCKET_ERROR);
}
SavedOptionLen = *optlen;
*optlen = sizeof(WSAPROTOCOL_INFOW);
SavedOptionValue = optval;
optval = (char FAR *)&ProtocolInfoW;
optname = SO_PROTOCOL_INFOW;
}
__except (WS2_EXCEPTION_FILTER()) {
ErrorCode = WSAEFAULT;
Socket->DropDSocketReference();
goto ErrorExit;
}
}
static DF1(jtcork1){F1PREFIP;DECLFGH;PROLOG(0026);A z; CAP1; EPILOG(z);}
int WSAAPI
WSANtohs (
IN SOCKET s,
IN u_short netshort,
OUT u_short FAR * lphostshort
)
/*++
Routine Description:
Arguments:
Returns:
Zero on success else SOCKET_ERROR. The error code is stored with
SetErrorCode().
--*/
{
PDPROCESS Process;
PDTHREAD Thread;
PDSOCKET Socket;
INT ErrorCode;
INT ReturnCode;
PPROTO_CATALOG_ITEM CatalogEntry;
LPWSAPROTOCOL_INFOW ProtocolInfo;
ReturnCode = PROLOG(
&Process,
&Thread,
&ErrorCode);
if (ERROR_SUCCESS != ReturnCode) {
SetLastError(ErrorCode);
return(SOCKET_ERROR);
} //if
if( lphostshort == NULL ) {
SetLastError( WSAEFAULT );
return(SOCKET_ERROR);
}
ErrorCode = DSOCKET::GetCountedDSocketFromSocket(
s, // SocketHandle
& Socket); // DSocket
if(ERROR_SUCCESS == ErrorCode){
CatalogEntry = Socket->GetCatalogItem();
// This is kind of a special case. We are done with the DSOCKET
// object reference and we don't call through to the provider at
// all.
Socket->DropDSocketReference();
ProtocolInfo = CatalogEntry->GetProtocolInfo();
if (LITTLEENDIAN == ProtocolInfo->iNetworkByteOrder) {
*lphostshort = netshort;
} //if
else {
*lphostshort = SWAP_SHORT( netshort );
} //else
} //if
if (ErrorCode != ERROR_SUCCESS) {
SetLastError(ErrorCode);
ReturnCode = SOCKET_ERROR;
}
return(ReturnCode);
}
int WSAAPI
WSANtohl (
IN SOCKET s,
IN u_long netlong,
OUT u_long FAR * lphostlong
)
/*++
Routine Description:
Convert a u_long from network byte order to host byte order.
Arguments:
s - A descriptor identifying a socket.
netlong - A 32-bit number in network byte order.
lphostlong - A pointer to a 32-bit number in host byte order.
Returns:
If no error occurs, WSANtohs() returns 0. Otherwise, a value of
SOCKET_ERROR is returned.
--*/
{
PDPROCESS Process;
PDTHREAD Thread;
PDSOCKET Socket;
INT ErrorCode;
INT ReturnCode;
PPROTO_CATALOG_ITEM CatalogEntry;
LPWSAPROTOCOL_INFOW ProtocolInfo;
ReturnCode = PROLOG(
&Process,
&Thread,
&ErrorCode);
if (ERROR_SUCCESS != ReturnCode) {
SetLastError(ErrorCode);
return(SOCKET_ERROR);
} //if
if( lphostlong == NULL ) {
SetLastError( WSAEFAULT );
return(SOCKET_ERROR);
}
ErrorCode = DSOCKET::GetCountedDSocketFromSocket(
s, // SocketHandle
& Socket); // DSocket
if(ERROR_SUCCESS == ErrorCode){
CatalogEntry = Socket->GetCatalogItem();
// This is kind of a special case. We are done with the DSOCKET
// object reference and we don't call through to the provider at
// all.
Socket->DropDSocketReference();
ProtocolInfo = CatalogEntry->GetProtocolInfo();
if (LITTLEENDIAN == ProtocolInfo->iNetworkByteOrder) {
*lphostlong = netlong;
} //if
else {
*lphostlong = SWAP_LONG( netlong );
} //else
} //if
if (ErrorCode != ERROR_SUCCESS) {
SetLastError(ErrorCode);
ReturnCode = SOCKET_ERROR;
}
return(ReturnCode);
}
//! 64 bit problems - com and dll interface is 32 bit - needs test and thought
static int a2v (J jt, A a, VARIANT *v, int dobstrs)
{
SAFEARRAY FAR* psa;
SAFEARRAYBOUND rgsabound[MAXRANK];
int er;
I i,r,k,kw,t,cb,*pi;
VARTYPE vt;
k=AN(a);
pi=AV(a);
r=AR(a);
t=NOUN&AT(a);
if(r>MAXRANK) return EVRANK;
if(dobstrs && r<2 && (t&LIT+C2T+C4T)) // char scalar or vector returned as BSTR
{
WCHAR *wstr;
BSTR bstr;
if (LIT&t) {
wstr = malloc(sizeof(WCHAR)*k);
kw=tounin((C*)pi, k, wstr, k);
bstr = SysAllocStringLen(wstr, (UINT)kw);
} else if (C4T&t) {
kw=utowsize((C4*)pi, k);
kw=(kw<0)?(-kw):kw;
wstr = malloc(sizeof(WCHAR)*kw);
utow((C4*)pi, k, wstr);
bstr = SysAllocStringLen(wstr, (UINT)kw);
} else
bstr = SysAllocStringLen((WCHAR*)pi, (UINT)k);
v->vt=VT_BSTR;
v->bstrVal=bstr;
if (t&LIT+C4T) free(wstr);
R 0;
}
switch(t)
{
case LIT:
if(!r) {v->vt=VT_UI1; v->bVal = *(C*)pi; return 0;}
vt=VT_UI1;
cb=k*sizeof(char);
break;
case C2T:
if(!r) {v->vt=VT_UI2; v->iVal = *(WCHAR*)pi; return 0;}
vt=VT_UI2;
cb=k*sizeof(WCHAR);
break;
case C4T:
if(!r) {v->vt=VT_UI4; v->iVal = *(UI4*)pi; return 0;}
vt=VT_UI4;
cb=k*sizeof(C4);
break;
case B01:
if(!r) {
v->vt=VT_BOOL;
v->boolVal = *(B*)pi ? VARIANT_TRUE : VARIANT_FALSE;
return 0;
}
vt=VT_BOOL;
break;
case INT:
#if SY_64
if(jt->int64flag) {
if(!r) {v->vt=VT_I8; v->llVal = (I)(*pi); return 0;}
vt=VT_I8;
cb=k*sizeof(long long);
} else {
if(!r) {v->vt=VT_I4; v->lVal = (int)(*pi); return 0;}
vt=VT_I4;
cb=k*sizeof(int);
}
#else
if(!r) {v->vt=VT_I4; v->lVal = (I)(*pi); return 0;}
vt=VT_I4;
cb=k*sizeof(int);
#endif
break;
case FL:
if(!r) {v->vt=VT_R8; v->dblVal = *(D*)pi; return 0;}
vt=VT_R8;
cb=k*sizeof(double);
break;
case BOX:
if(!r)
{
// Pass a scalar box as a 1-elem VARIANT VT_ARRAY.
// It's marked as such by a lower bound set at -1.
// (All "true" boxed arrays will have the usual lb 0.)
rgsabound[0].lLbound = -1;
rgsabound[0].cElements = 1;
if ( ! (psa = SafeArrayCreate (VT_VARIANT, 1, rgsabound)))
return EVWSFULL;
if (0!= (er = a2v (jt, *(A*)pi, (VARIANT*)psa->pvData, dobstrs)))
{
SafeArrayDestroy (psa);
return er;
}
v->vt=VT_ARRAY|VT_VARIANT;
v->parray = psa;
return 0;
}
vt=VT_VARIANT;
cb=k*sizeof(A);
break;
default:
return EVDOMAIN;
}
if(1<r && jt->transposeflag)
RE(a=cant1(a)); // undo shape reversal later!
for(i=0; i<r; ++i)
{
rgsabound[i].lLbound = 0;
// undo shape reversal from cant1() here.
// In case of Transpose(0), the shape is
// still passed in Column-major notation.
rgsabound[i].cElements = (ULONG)AS(a)[r-1-i];
}
psa = SafeArrayCreate(vt, (UINT)r, rgsabound);
if(!psa)
{
return EVWSFULL;
}
switch (NOUN&AT(a))
{
case B01:
{
VARIANT_BOOL *pv = (VARIANT_BOOL*) psa->pvData;
B *ap = BAV(a);
while (k--)
*pv++ = *ap++ ? VARIANT_TRUE : VARIANT_FALSE;
break;
}
case BOX:
{
A* ap;
VARIANT *v;
for (ap=AAV(a), SafeArrayAccessData(psa, &v);
ap<AAV(a)+k;
++ap, ++v)
{
PROLOG(0118);
er=a2v (jt, *ap, v, dobstrs);
tpop(_ttop);
if (er!=0)
{
SafeArrayUnaccessData (psa);
SafeArrayDestroy (psa);
return er;
}
}
SafeArrayUnaccessData (psa);
break;
}
#if SY_64
case INT:
{
if (!jt->int64flag) {
long *p1=psa->pvData;
I *p2=AV(a);
while (k--)
*p1++=(long)*p2++;
}
break;
}
#endif
default:
memcpy(psa->pvData, AV(a), cb);
}
v->vt=VT_ARRAY|vt;
v->parray = psa;
return 0;
}
static DF1(jtfolk1){F1PREFIP;DECLFGH;PROLOG(0028);A z; FOLK1; EPILOG(z);}
char FAR * WSAAPI
inet_ntoa (
IN struct in_addr in
)
/*++
Routine Description:
Convert a network address into a string in dotted format.
Arguments:
in - A structure which represents an Internet host address.
Returns:
If no error occurs, inet_ntoa() returns a char pointer to a static buffer
containing the text address in standard ".'' notation. Otherwise, it
returns NULL. The data should be copied before another WinSock call is
made.
--*/
{
PDPROCESS Process;
PDTHREAD Thread;
INT ErrorCode;
PCHAR Buffer=NULL;
BOOL AddedArtificialStartup = FALSE;
WSADATA wsaData;
PUCHAR p;
PUCHAR b;
ErrorCode = PROLOG(&Process,&Thread);
if (ERROR_SUCCESS != ErrorCode) {
if( ErrorCode != WSANOTINITIALISED ) {
SetLastError(ErrorCode);
return(NULL);
}
//
// PROLOG failed with WSANOTINITIALIZED, meaning the app has not
// yet called WSAStartup(). For historical (hysterical?) reasons,
// inet_ntoa() must be functional before WSAStartup() is called.
// So, we'll add an artificial WSAStartup() and press on.
//
ErrorCode = WSAStartup( WINSOCK_HIGH_API_VERSION, &wsaData );
if( ErrorCode != NO_ERROR ) {
SetLastError( ErrorCode );
return NULL;
}
AddedArtificialStartup = TRUE;
//
// Retry the PROLOG.
//
ErrorCode = PROLOG(&Process,&Thread);
if (ErrorCode!=ERROR_SUCCESS) {
WSACleanup();
SetLastError(ErrorCode);
return NULL;
}
} //if
Buffer = Thread->GetResultBuffer();
b = (PUCHAR)Buffer;
//
// In an unrolled loop, calculate the string value for each of the four
// bytes in an IP address. Note that for values less than 100 we will
// do one or two extra assignments, but we save a test/jump with this
// algorithm.
//
p = (PUCHAR)∈
*b = NToACharStrings[*p][0];
*(b+1) = NToACharStrings[*p][1];
*(b+2) = NToACharStrings[*p][2];
b += NToACharStrings[*p][3];
*b++ = '.';
p++;
*b = NToACharStrings[*p][0];
*(b+1) = NToACharStrings[*p][1];
*(b+2) = NToACharStrings[*p][2];
b += NToACharStrings[*p][3];
*b++ = '.';
p++;
*b = NToACharStrings[*p][0];
*(b+1) = NToACharStrings[*p][1];
*(b+2) = NToACharStrings[*p][2];
b += NToACharStrings[*p][3];
*b++ = '.';
p++;
*b = NToACharStrings[*p][0];
*(b+1) = NToACharStrings[*p][1];
*(b+2) = NToACharStrings[*p][2];
b += NToACharStrings[*p][3];
*b = '\0';
if( AddedArtificialStartup ) {
WSACleanup();
}
return(Buffer);
}
static DF2(jtfolk2){F2PREFIP;DECLFGH;PROLOG(0029);A z; FOLK2; EPILOG(z);}
