*/ void Trap_Expect(REBVAL *object, REBCNT index, REBCNT type)
/*
** Object field is not of expected type.
** PORT expected SCHEME of OBJECT type
**
***********************************************************************/
{
Trap3(RE_EXPECT_TYPE, Of_Type(object), Obj_Word(object, index), Get_Type(type));
}
VOID FAR _loadds _cdecl ADDEntryPoint (PIORBH pIORB)
{
PIORBH pFirstIORB;
PIORBH pLastIORB;
NPA npA;
NPU npU;
#if PCITRACER
outpw (TRPORT, 0xDEDE);
#endif
LoadFlatGS();
pFirstIORB = pIORB;
/*-------------------------------------------*/
/* Queue IORB commands which don't address a */
/* specific unit to ACB 0 Unit 0 */
/*-------------------------------------------*/
if (pFirstIORB->CommandCode == IOCC_CONFIGURATION) {
pFirstIORB->UnitHandle = (USHORT)ACBPtrs[0]->UnitCB;
}
npU = (NPU)pFirstIORB->UnitHandle;
#if PCITRACER
outpw (TRPORT+2, npU);
outpw (TRPORT+2, REQ (pFirstIORB->CommandCode, pFirstIORB->CommandModifier));
OutD (TRPORT, npU->Flags);
#endif
#ifdef CHECK_HANDLES
{
// Since this driver uses a lot of near pointers, it is possible
// to get a bad UnitHandle and use it for a while before trapping
// or worse continuing. This check and the one below for the ACB
// confirm the resulting pointer are referencing valid internal
// structures.
// Validate the unit handle.
int a;
if (npU) {
for (a = 0; a < cAdapters; a++) {
if (npU == (NPU)(&(ACBPtrs[a]->UnitCB[0]))) goto goodUCB;
if (npU == (NPU)(&(ACBPtrs[a]->UnitCB[1]))) goto goodUCB;
}
}
// This is an invalid UCB.
Trap3 (1, npU);
goodUCB:
npA = npU->npA;
// Validate the ACB pointer.
if (npA) {
if (npA == ACBPtrs[a]) {
outpw (TRPORT+2, npA);
outp (TRPORT+2, a);
goto goodACB;
}
}
// This is an invalid ACB.
Trap3 (2, npA);
goodACB:
;
}
#else
npA = npU->npA;
#endif
if (npA->FlagsT & ATBF_PCMCIA) LastAccessedPCCardUnit = npA;
pLastIORB = PreProcessIORBs (npA, &pFirstIORB);
DISABLE
if (pFirstIORB) {
/*------------------------------------------------*/
/* Add non-preprocessed IORBs to end of the ACB Q */
/*------------------------------------------------*/
if (!npA->pHeadIORB)
npA->pHeadIORB = pFirstIORB;
else
npA->pFootIORB->pNxtIORB = pFirstIORB;
/*--------------------------------------*/
/* Point to the last IORB on the ACB Q */
/*--------------------------------------*/
npA->pFootIORB = pLastIORB;
}
/*
** Check if there is any work on the queue, try to restart the
** state machine.
** Work could have been added to the current ACB only by adding
** onto the normal work queue and/or onto the suspend queue,
** check both to see if we should restart the state machine.
*/
if (npA->pHeadIORB || npA->pSuspendHead) {
/*
** Restart the state machine.
*/
if (npA->State & ACBS_SUSPENDED) {
npA->State &= ~ACBS_SUSPENDED;
ENABLE
StartSM (npA);
}
}
#if PCITRACER
outpw (TRPORT, 0xDEDF);
#endif
ENABLE
}
*/ void Do_Commands(REBSER *cmds, void *context)
/*
** Evaluate a block of commands as efficiently as possible.
** The arguments to each command must already be reduced or
** use only variable lookup.
**
** Returns the last evaluated value, if provided.
**
***********************************************************************/
{
REBVAL *blk;
REBCNT index = 0;
REBVAL *set_word = 0;
REBVAL *cmd_word;
REBSER *words;
REBVAL *args;
REBVAL *val;
REBVAL *func;
RXIFRM frm; // args stored here
REBCNT n;
REBEXT *ext;
REBCEC *ctx;
if ((ctx = context)) ctx->block = cmds;
blk = BLK_HEAD(cmds);
while (NOT_END(blk)) {
// var: command result
if IS_SET_WORD(blk) {
set_word = blk++;
index++;
};
// get command function
if (IS_WORD(cmd_word = blk)) {
// Optimized var fetch:
n = VAL_WORD_INDEX(blk);
if (n > 0) func = FRM_VALUES(VAL_WORD_FRAME(blk)) + n;
else func = Get_Var(blk); // fallback
} else func = blk;
if (!IS_COMMAND(func)) Trap2(RE_EXPECT_VAL, Get_Type_Word(REB_COMMAND), blk);
// Advance to next value
blk++;
if (ctx) ctx->index = index; // position of function
index++;
// get command arguments and body
words = VAL_FUNC_WORDS(func);
RXA_COUNT(&frm) = SERIES_TAIL(VAL_FUNC_ARGS(func))-1; // not self
// collect each argument (arg list already validated on MAKE)
n = 0;
for (args = BLK_SKIP(words, 1); NOT_END(args); args++) {
//Debug_Type(args);
val = blk++;
index++;
if (IS_END(val)) Trap2(RE_NO_ARG, cmd_word, args);
//Debug_Type(val);
// actual arg is a word, lookup?
if (VAL_TYPE(val) >= REB_WORD) {
if (IS_WORD(val)) {
if (IS_WORD(args)) val = Get_Var(val);
}
else if (IS_PATH(val)) {
if (IS_WORD(args)) val = Get_Any_Var(val); // volatile value!
}
else if (IS_PAREN(val)) {
val = Do_Blk(VAL_SERIES(val), 0); // volatile value!
}
// all others fall through
}
// check datatype
if (!TYPE_CHECK(args, VAL_TYPE(val)))
Trap3(RE_EXPECT_ARG, cmd_word, args, Of_Type(val));
// put arg into command frame
n++;
RXA_TYPE(&frm, n) = Reb_To_RXT[VAL_TYPE(val)];
frm.args[n] = Value_To_RXI(val);
}
// Call the command (also supports different extension modules):
func = BLK_HEAD(VAL_FUNC_BODY(func));
n = (REBCNT)VAL_INT64(func + 1);
ext = &Ext_List[VAL_I32(VAL_OBJ_VALUE(func, 1))]; // Handler
n = ext->call(n, &frm, context);
val = DS_RETURN;
switch (n) {
case RXR_VALUE:
RXI_To_Value(val, frm.args[1], RXA_TYPE(&frm, 1));
break;
case RXR_BLOCK:
RXI_To_Block(&frm, val);
break;
case RXR_UNSET:
SET_UNSET(val);
break;
case RXR_NONE:
SET_NONE(val);
break;
case RXR_TRUE:
SET_TRUE(val);
break;
case RXR_FALSE:
SET_FALSE(val);
break;
case RXR_ERROR:
default:
SET_UNSET(val);
}
if (set_word) {
Set_Var(set_word, val);
set_word = 0;
}
}
}
