              <<< VAXAXP::NOTES$:[NOTES$LIBRARY]VMSNOTES.NOTE;1 >>>
               -< VAX and Alpha VMS - Digital Internal Use Only >-
================================================================================
Note 938.0                    Problem with SCH$QAST                    2 replies
MUTEX::LIU                                          716 lines  24-MAY-1996 12:42
--------------------------------------------------------------------------------
Hello,

Attached is a transcript from Oasis, Inc., a partner who is porting the
Digital product called TMX to Alpha. TMX (Transaction Management Executive)
is a transaction-processing toolkit used to create applications for the
finanical industry. The transcript contains a description of the problem
and two source files.

The version is Alpha OpenVMS V6.2.

Thanks for the help in advance...

Faan-Hoan Liu
DTN381-2283
==============================================================================
Hi,

This and the subsequent message contain the files and notes of the 
problem I am having with this VMS internal service.

In several services of TMX, AST are delivered to other processes.  
The method that was used on the VAX no longer seems to work on AXP.  
Both user mode as well as exec mode AST need delivering.  The example 

programs were ported from the original TMX code in MACRO-32 and 
ported to C for easier debugging.  In this example a program called 
MAE_WEST sets up to receive the user mode AST and wait with a 
sys$hiber for invocation of the AST routines.  A program called 
WC_FIELDS goes into kernel mode and uses the SCH_STD$QAST entry 
point to deliver the AST to MAE_WEST.

MAE_WEST seems to receive the AST, since "she" starts to print out 
the message from that AST routine.  WC_FIELDS seems to return from 
its kernel mode routine with a successful status.  However shortly 
thereafter (ie. within milliseconds) VMS crashes with the code 
"INCON_SCHED, Inconsistent scheduling state", in some process, not 
necessarily either MAE_WEST and WC_FIELDS (although I have seen it 
happen when MAE_WEST was "considered" CURrent).  The crash dump 
usually 
shows that there weren't any processes in CUR mode but it crashes at 
location SCH$STATE_TO_COM+00040 where it is attempting to change the 
state of the current process to COM but it is checking to make sure 
that it is really CUR (which it is not).  

The user stack of MAE_WEST shows that it has recently gone through 
EXE$REI_TO_AST_C. 

The pair of programs can be forced to work by running both programs 
in a real-time-mode with the QUANTUM on the system set very high like 

32767.  This seems to avoid the scheduler interrupt, and all seems 
well.

The following is the build procedure for the programs which will be 
in the next two message:
-------------------
 $ cc/deb/noopt mae_west+sys$share:sys$lib_c.tlb/library
$ link/trace/sysexe mae_west
$ cc/deb/noopt wc_fields+sys$share:sys$lib_c.tlb/library
$ link/trace/sysexe wc_fields
$ exit

You must start MAE_WEST first by typing
R MAE_WEST 
after she has been built.

you should then run WC_FIELDS on a different session by typing
R WC_FIELDS

You will need CMKRNL and GROUP priv to try these examples.


The following is the source for MAE_WEST.C
--------------------
#include <descrip>
#include <ssdef>
#include <stdio>
#include <lnmdef>
#include <jpidef>

#include <builtins>
#include <prdef>
#include <psldef>

#define YES 1
#define NO  0

#define TRUE  1
#define FALSE 0


#define SET_LOGICAL($logical$,$table$,$fao$,$value$)\
{\
    $DESCRIPTOR(_$fao$,$fao$);\
    $DESCRIPTOR(_$logical$,$logical$);\
    $DESCRIPTOR(_$table$,$table$);\
    static char $msg$[80];\
    $DESCRIPTOR(_$msg$,$msg$);\
    if((sys$fao(&_$fao$,&_$msg$.dsc$w_length,&_$msg$,$value$) & 0x01) 
==1)\
	    lib$set_logical(\
			    &_$logical$,\
			    &_$msg$,\
			    &_$table$);\
}\
	    

typedef struct {
		unsigned short	buffer_length;
		unsigned short	item_code;
		unsigned int	*buffer_address;
		unsigned int	*size_return_address;
		} ITEM;

extern lib$wait();
extern lib$get_foreign();
extern lib$put_output();
extern lib$set_logical();
extern sys$exit();
extern sys$fao();
extern sys$hiber();
extern sys$setast();
extern sys$getjpiw();
extern lib$movc5();


#define LNM$FILE_DEV "LNM$FILE_DEV"
#define LNM$PROCESS  "LNM$PROCESS"
#define LNM$JOB      "LNM$JOB"
#define LNM$GROUP    "LNM$GROUP"
#define LNM$SYSTEM   "LNM$SYSTEM"


static int ps_mode   = -1;
static int ps	     = -1;
static int ipl_level = -1;


void big_boy(int parm){

    
    ps = __PAL_RD_PS() & PR$M_PS_CURMOD;
    ps_mode = (ps >> 3) & 0x03;
    ipl_level = ((ps & PSL$M_IPL) >> 6) & 0x31;

    printf("MAE_WEST: Hey big boy\n");
    printf("MAE_WEST: My current mode is => %d.\n",ps_mode);
    printf("MAE_WEST: We have are out of here => %08X\n",parm);
    lib$wait(&5.0);
    sys$exit(parm);
}

int get_my_pid() {
unsigned l_pid;
unsigned l_return_size;
int stat;

ITEM item_list[2];


	l_pid = 0;
	item_list[0].buffer_length       = 4;
	item_list[0].item_code           = JPI$_PID;
	item_list[0].buffer_address      = &l_pid;
	item_list[0].size_return_address = &l_return_size;
	item_list[1].buffer_length       = 0;
	item_list[1].item_code           = 0;
	item_list[1].buffer_address      = 0;
	item_list[1].size_return_address = 0;


	stat = sys$getjpiw(
			0,			/* efn	    */
			&l_pid,			/* pidaddr  */
			0,			/* prcnam   */
			&item_list,		/* itmlst   */
			0,			/* iosb	    */
			0,			/* astadr   */
			0			/* astprm   */
		    );

    if((stat&0x01)==1)
	return(l_pid);
    else
	return(0);
}

main() {

    int stat;
    int pid;

    printf("MAE_WEST: My PS mode can found at => %08X\n",&ps_mode);

    pid = get_my_pid();

    if(pid==0) {
	printf("Failed on self-examination.\n");
	sys$exit(1);
	};

    
SET_LOGICAL("COME_UP_AND_SEE_ME_SOMETIME$PID",LNM$GROUP,"!XL",pid);

    printf("MAE_WEST: Big boy => %08X\n",(int *) big_boy);
    
SET_LOGICAL("COME_UP_AND_SEE_ME_SOMETIME$FUNC",LNM$GROUP,"!XL",(int *) big_boy);

    ps_mode = -1;	/* We would not want to be caught page-fault 
			/* during a crash 
			/* */

    /* wake me up when it's all over */

    sys$setast(1);	 /* turn ast back on in case we need it on */
    sys$hiber();	/* ...perchance to dream... */

}


The following is the source for WC_FIELDS.C
-----------------------
#include <descrip>
#include <ssdef>
#include <stdio>
#include <lnmdef>
#include <jpidef>
#include <chfdef>
#include <lib$routines>
#include <prdef>
#include <plvdef>
#include <pcbdef>
#include <ipldef>
#include <exe_routines>
#include <sch_routines>
#include <acbdef>
#include <vms_macros>
#include <dyndef>
#include <psldef>

#include <string>

#define NA	0	    /* Not applicable */
#define KERNEL	100
#define EXEC	101
#define CALLER	102
#define USER	103
#define WAIT	104
#define NOWAIT	105
#define UNIV	106
#define NOUNIV	107
#define NOSETIPL        0
#define SETIPL          1
#define UNLOCK_RESTORE  1
#define UNLOCK_RELEASE  0

#define TXF$_BAD_KRNLSTS 0x03401    /* Differ kernel status returns 
*/


#define TRUE  1
#define FALSE 0


typedef struct _QUAD {
			unsigned int l;
			unsigned int h;
		    } QUAD;


typedef struct {
		unsigned short	buffer_length;
		unsigned short	item_code;
		         char	*buffer_address;
		unsigned int	*size_return_address;
		} ITEM;


extern sys$exit();
extern sys$fao();
extern sys$hiber();
extern sys$setast();
extern sys$trnlnm();
extern sys$cmkrnl();
extern sys$getjpiw();
extern sys$lckpag();
extern sys$synch();
extern sys$cmkrnl();
extern sys$cmexec();
extern sys$getjpiw();
extern sys$setpri();

extern exe_std$nam_to_pcb();
extern exe$alononpaged_aln();
extern unsigned int *SCH$GL_PCBVEC; /* Array of ponter to PCBs */
extern unsigned int SCH$GL_MAXPIX;  /* Maximum number of processes */

PCB *TMC$PID_TO_PCB();

#define LOCK_RANGE(low,hi,retadr,mode) \
{\
    int inadr[2];\
    inadr[0]=(int) low;\
    inadr[1]=(int) hi;\
\
    retadr[2] = sys$lckpag(&inadr,&retadr,mode);\
}\

#pragma extern_model save
#pragma extern_model strict_refdef "_KRNL$DATA1" noshr

QUAD tmx$gq_start = {0,0};
PCB  *TMX$GA_PCB = 0;		/* will pick up the value of our PCB */
int  tmx$gl_krnl_sts;
int  gl_ret_size = -1;
PCB  *gl_pcb = (PCB *) -1;
int   gl_pid = -1;
int   kernel_pages_locked = FALSE;
int   lock1_range[3];
int   lock2_range[3];
QUAD  tmx$gq_end = {-1,-1};

#pragma extern_model restore


$DESCRIPTOR(_pid_logical,"COME_UP_AND_SEE_ME_SOMETIME$PID");
$DESCRIPTOR(_func1_logical,"COME_UP_AND_SEE_ME_SOMETIME$FUNC");
static $DESCRIPTOR(_file_dev_table,"LNM$FILE_DEV");

#define LINE_SIZE 80
static char s_logical_value[LINE_SIZE];
static unsigned  ret_len;


static ITEM item_list[2] = {
			    {	sizeof(s_logical_value),
				LNM$_STRING,
				(char *) &s_logical_value,
				&ret_len},
			    {0,0,0,0}};

#pragma extern_model save
#pragma extern_model strict_refdef "_KRNL$LOCK1" shr

void lock1_start() {} /* Marker for the beginning of the psect */
void lock1_end(); /* Forward declare end marker */

int TMK$DO_AST(
		int *pidadr,
		struct dsc$descriptor *prcnam,
		void (*astadr)(),
		int astprm,
		int acmode) {

    ACB *last_acb;
   int stat,target_pid,target_csid;
   int saved_ipl,current_ipl,ps,pid;
   int nsatype;
   int ret_size,prv_prio;
   int *nam,*temp_pcb;
   PCB *target_pcb,*pcb;
   ACB *acb;


    target_pcb  = (PCB *) 0;
    target_pid  = 0;
    target_csid = 0;

   if(astadr==0)
    return(0);

    stat = sys$setpri(0,0,31,&prv_prio);
    if(stat!=1)
	return(stat);
    ps = __PAL_RD_PS();	/* Getting our PSL */

    /* Lock these down while we can still page */

    if(kernel_pages_locked==FALSE) {
	LOCK_RANGE(lock1_start,  lock1_end,  lock1_range,PSL$C_KERNEL);
	LOCK_RANGE(&tmx$gq_start,&tmx$gq_end,lock2_range,PSL$C_KERNEL);
	kernel_pages_locked==TRUE;
    };

    if (__PAL_PROBER((void *) pidadr,4,ps & PR$M_PS_CURMOD)==0) {
	tmx$gl_krnl_sts = SS$_ACCVIO;
	return(TXF$_BAD_KRNLSTS);    /* Prevent the system from crashing */
	};

    saved_ipl = __PAL_MFPR_IPL(); /* Save our IPL when came into this 
thing */

    pcb = TMX$GA_PCB;
    
    target_pcb = TMC$PID_TO_PCB(*pidadr);

    if(target_pcb == 0)
	stat = 0;
    else
	stat = 1;

    if((stat&0x01)==1) { /* If found continue */

	/* Get some space for our ACB */

	stat = exe$alononpaged_aln(
					ACB$K_LENGTH,
					3,
					&acb,
					&ret_size
					);
	if(ret_size < ACB$K_LENGTH) {

	/* Punt if failed on the allocation */

	    sys_lock(SCHED,SETIPL,0);
	    sys_unlock(SCHED,saved_ipl,UNLOCK_RESTORE);

	    if((stat&0x01)==1)
		stat=2;
	    if(stat==0)
		stat=2; /* Give it some personality */
	}
    };


    if((stat&0x01)==1) {
/*	;+
/*	; If here, we have a pointer to our acb. Fill out the ACB
/*	; and call SCH$QAST:
/*	;-
/* */	


    { 
      /* Since we can't trust any RTL in elevated IPL 
      /* we have to clear it out ourselves
      */
	int i;
	char *c;
	
	c = (char *) acb;
	for(i=0;i<ACB$K_LENGTH;i++) c[i] = 0;
    };

    acb->acb$w_size   = ACB$K_LENGTH;		/* Set the length of struct */
    acb->acb$b_type   = DYN$C_ACB;		/* Set the type byte	    */
    acb->acb$v_mode   = acmode;			/* set access mode for AST  */
    acb->acb$v_nodelete=1;			/* save this ACB (for debug) */
    acb->acb$v_quota  = 0;			/* Don't charge QUOTA	    */
    acb->acb$l_pid    = target_pcb->pcb$l_pid;	/* Fill out target pid 
     */
    acb->acb$l_ast    = astadr;			/* Store ASTADR             */
    acb->acb$l_astprm = astprm;			/* Store ASTPRM	            */

    sys_lock  (SCHED,SETIPL,0);
    sys_unlock(SCHED,IPL$_ASTDEL,UNLOCK_RESTORE);

    stat = sch_std$qast(
			31,			/* Lets try a boost      */
			acb,			/* Our ACB	         */
			target_pcb);	        /* Pointer to the target */


    if((stat&0x01)==1)
	stat = SS$_NORMAL; /* Set final status */
    };


    setipl(saved_ipl); /* Get IPL back to normal (in another 
lifetime)*/

    gl_ret_size = ret_size; /* Now that its safe to page-fault */
    sys$setpri(0,0,4);

    if((stat&0x01)!=1) {
	tmx$gl_krnl_sts = stat;
	return(TXF$_BAD_KRNLSTS);    /* Prevent the system from crashing
					from bad return status */
    }
    else
	return(stat);

}

PCB *TMC$PID_TO_PCB(int pid) {

    int max_proc,table_size,idx,ps,mode;
    PCB *pcb;
    int argv[3];

    ps = __PAL_RD_PS(); /* Get our PSL vial our PAL */
    mode = (ps & PR$M_PS_CURMOD) >> 3;

    switch(mode) {
    case PSL$C_USER:
    case PSL$C_SUPER: {
	argv[0]=1;
	argv[1]=pid;
	argv[2]=0;

	    pcb = (PCB *) sys$cmexec(TMC$PID_TO_PCB,&argv);
	    return(pcb);
	};
    case PSL$C_EXEC:
    case PSL$C_KERNEL: 
	{
	if(__PAL_PROBER((void *) &SCH$GL_PCBVEC,4,ps & PR$M_PS_CURMOD)==0) {
	    return(0); /* Sorry couldn't hack it */
	    };

    /* Since SCH$GL_PCBVEC is pointer lets check to see if can read 
what its
	poiting to */

	if(__PAL_PROBER((void *) SCH$GL_PCBVEC,4,ps & PR$M_PS_CURMOD)==0) {
	    return(0); /* Sorry couldn't hack it */
	    };

    /* Figure out the size of the thing */

	if(__PAL_PROBER((void *) &SCH$GL_MAXPIX,4,ps & PR$M_PS_CURMOD)==0) {
	    return(0); /* Sorry couldn't hack it */
	    };
	max_proc = SCH$GL_MAXPIX;
	for(table_size=2;table_size<max_proc;table_size*=2)
	    if(table_size>16384) return(0); /* Coding bug */
	table_size--; /* one less for a mask */
	idx =  pid & table_size;
	pcb = (PCB *) SCH$GL_PCBVEC[idx];
	gl_pcb = pcb;
	gl_pid = pcb->pcb$l_pid;

	return(pcb); /* This should do it */

	}
    }
}


static void TMX$$$GET_MY_PCB() {

unsigned l_pid;
unsigned l_return_size;
int stat;

ITEM item_list[2];

	l_pid = 0;
	item_list[0].buffer_length       = 4;
	item_list[0].item_code           = JPI$_PID;
	item_list[0].buffer_address      = (char *) &l_pid;
	item_list[0].size_return_address = &l_return_size;
	item_list[1].buffer_length       = 0;
	item_list[1].item_code           = 0;
	item_list[1].buffer_address      = 0;
	item_list[1].size_return_address = 0;


	stat = sys$getjpiw(
			0,			/* efn	    */
			&l_pid,			/* pidaddr  */
			0,			/* prcnam   */
			&item_list,		/* itmlst   */
			0,			/* iosb	    */
			0,			/* astadr   */
			0			/* astprm   */
		    );

	if((stat&0x01)!=1)
	    lib$signal(SS$_ABORT);

	TMX$GA_PCB = TMC$PID_TO_PCB(l_pid);

	if(TMX$GA_PCB==0)
	    lib$signal(SS$_ABORT);

}

void lock1_end() {} /* Marker for the end of Psect */

#pragma extern_model restore

int get_my_pid() {
unsigned l_pid;
unsigned l_return_size;
int stat;

ITEM item_list[2];

	l_pid = 0;
	item_list[0].buffer_length       = 4;
	item_list[0].item_code           = JPI$_PID;
	item_list[0].buffer_address      = (char *) &l_pid;
	item_list[0].size_return_address = &l_return_size;
	item_list[1].buffer_length       = 0;
	item_list[1].item_code           = 0;
	item_list[1].buffer_address      = 0;
	item_list[1].size_return_address = 0;


	stat = sys$getjpiw(
			0,			/* efn	    */
			&l_pid,			/* pidaddr  */
			0,			/* prcnam   */
			&item_list,		/* itmlst   */
			0,			/* iosb	    */
			0,			/* astadr   */
			0			/* astprm   */
		    );

    if((stat&0x01)==1)
	return(l_pid);
    else
	return(0);
}

main() {

    int argv[6],pid,stat,astadr;
    int my_pid;

/* Spill our guts out before we die */


    printf("WC_FIELDS: tmx$gq_start        is located 
@%08X\n",&tmx$gq_start);

/* Get my pid */

    my_pid = get_my_pid();

    if(my_pid==0) {
	printf("WC_FIELDS: Failed on self-examination.\n");
	sys$exit(1);
	};


/* Get the pid */

    stat = sys$trnlnm(  
		    0,			    /* Flags                     */
		    &_file_dev_table,	    /* Table that it is in       */
		    &_pid_logical,	    /* Logical to Look up        */
		    0,			    /* Access mode               */
		    &item_list		    /* Item List of What we want */
		    );


    if((stat&0x01)!=1) 
	sys$exit(stat);

    s_logical_value[ret_len]=0;
    sscanf(s_logical_value,"%x",&pid);


/* Get the astadr for func1 */
    stat = sys$trnlnm(  
		    0,			    /* Flags                     */
		    &_file_dev_table,	    /* Table that it is in       */
		    &_func1_logical,	    /* Logical to Look up        */
		    0,			    /* Access mode               */
		    &item_list		    /* Item List of What we want */
		    );


    if((stat&0x01)!=1) 
	sys$exit(stat);

    s_logical_value[ret_len]=0;
    sscanf(s_logical_value,"%x",&astadr);


    printf("WC_FIELDS: Calling MAE_WEST pid (%08X) to run (%08X) and 
return (%08X)\n",
	    pid,astadr,my_pid);


    lib$wait(&2.0); /* Let all messages flush out before continuing 
*/

    argv[0] = 5;
    argv[1] = (int) &pid;
    argv[2] = 0;
    argv[3] = astadr;
    argv[4] = my_pid;
    argv[5] = PSL$C_USER;

    stat = sys$cmkrnl(TMK$DO_AST,&argv);

    if (stat!=TXF$_BAD_KRNLSTS )
	printf("WC_FIELDS: Status of DO_AST was %08X\n",stat);
    else
	printf("WC_FIELDS: Status of DO_AST was %08X\n",tmx$gl_krnl_sts);

    printf("WC_FIELDS: Ret Size is %d\n",gl_ret_size);
    printf("WC_FIELDS: PCB found is %08X\n",gl_pcb);
    printf("WC_FIELDS: Pid found is %08X\n",gl_pid);

    lib$wait(&5.0); /* Wait a sec */

    sys$exit(stat);

/* Do the other funcs if so desired */

}