/************************************************
 **
 **    *** HAPPy P-code Interpreter ***
 **
 **            P-code命令解釈実行処理
 **
 **          Copyright (c) H.Asano. 1992-1994.
 ************************************************/

#define EXTERN  extern
#define trans(reg) \
          ((unsigned short)(reg)-(unsigned short)(store))/sizeof(_store)

#define setlow   0
#define sethigh 31

#include <process.h>
#include <stdio.h>
#include <string.h>
#include <math.h>
#include "hapai.h"

extern void prerr(short,char*); /* Run-timeエラーメッセージ出力処理   */
extern void puteoln(void)     ; /* ファイルクローズ時のeoln付与処理   */
extern void T_get(fileinfo*,_store*,char*);   /* 1文字読込            */
extern void EOL(void) ;
extern void EoF(void) ;
extern void GET(void) ;
extern void PGE(void) ;
extern void PUT(void) ;
extern void RLN(void) ;
extern void RDC(void) ;
extern void RDI(void) ;
extern void RDR(void) ;
extern void RST(void) ;
extern void RWT(void) ;
extern void TGT(void) ;
extern void TPT(void) ;
extern void TRS(void) ;
extern void TRW(void) ;
extern void WLN(void) ;
extern void WRB(void) ;
extern void WRC(void) ;
extern void WRF(void) ;
extern void WRI(void) ;
extern void WRR(void) ;
extern void WRS(void) ;

/**********************************************/
/*** P-code 計算機のレジスタ、メモリその他  ***/
/**********************************************/

extern _store store[] ; /* 記憶装置  */

extern _code  cd  ;     /* p-code    */
extern _store *sp ;     /* sp points to top of the stack */

extern short   pc  ;    /* program counter */
extern short   mp  ;    /* mp points to begginning of a data segment */
extern short   ep  ;    /* ep points to the maxmum extent of the stack */
extern short   np  ;    /* np points to top of the heap area      */
extern boolean trace      ; /* 命令トレースフラグ                 */
extern boolean readlnflag ; /* 起動時及びinputにreadlnをした時 真 */

/******** Run Time Error Mesage(埋め込み要のもの) **********/
static const struct {
               short  errno ;
               char   *msg  ;
             } errtbl[] = {
 {  1,  "配列の添え字式の値(%ld)が範囲内(%ld〜%ld)にない"},
 {  7,  "実値引数の値(%ld)が範囲内(%ld〜%ld)にない"},
 {  8,  "実値引数の集合値が範囲内(%ld〜%ld)にない"},
 { 17,  "read: バッファ変数の値(%d)が範囲内(%ld〜%ld)にない"},
 { 18,  "write: 式の値(%ld)が範囲内(%ld〜%ld)にない"},
 { 26,  "pack: 順序型の引数の値(%ld)が範囲内(%ld〜%ld)にない"},
 { 29,  "unpack: 順序型の引数の値(%ld)が範囲内(%ld〜%ld)にない"},
 { 31,  "unpack: 転送後に詰めなし配列の添え字型を越える"},
 { 38,  "succ: 引数の順序数(%ld)より1つ大きい値が存在しない"},
 { 39,  "pred: 引数の順序数(%ld)より1つ小さい値が存在しない"},
 { 49,  "代入文: 右辺値(%ld)が範囲内(%ld〜%ld)にない"},
 { 50,  "代入文: 集合値が範囲内(%ld〜%ld)にない"},
 { 51,  "case文: 選択式の値(%ld)に合致する選択定数がない"},
 { 52,  "for文: 初期値(%ld)が範囲内(%ld〜%ld)にない"},
 { 53,  "for文: 終値(%ld)が範囲内(%ld〜%ld)にない"},
 { 71,  "read: 集合型のバッファ変数の値が範囲内(%ld〜%ld)にない"},
 { 72,  "write: 集合型の式の値が範囲内(%ld〜%ld)にない"},
 {111,  "集合構成子の順序式の値(%ld)がHAPPyの制限範囲内(%ld〜%ld)にない"}
} ;

/***************************************/
/*   base() : 局所的番地を求める       */
/***************************************/
static short base(void)
{
  short  ad ;
  short  ld ;

     if(cd.p==0) return(mp) ;           /* pが0ならmp値を返す         */
     ad = mp ;
     ld = cd.p  ;
     while((ld--))                      /* 0より大きい間繰り返し      */
      ad = store[ad+1].va ;             /* static link                */
     return(ad) ;
}

/***************************************/
/*   StrComp() : 文字列の比較を行う    */
/***************************************/
static short StrComp(_store *str1,_store *str2,short length)
{
  register _store *s1,*s2 ;
  short disp ;

     s1     = str1 ;
     s2     = str2 ;
     while(length--) {
       disp = s1++->vc - s2++->vc ;
       if(disp) return(disp) ;
     }
     return(0) ;                        /* s1とs2が同じ               */
}

/************************ 各P-code の 処理 ****************************/

/******************/
/*  ABI           */ /* absolute integers */
/******************/
static void ABI(void)
{
     (*sp).vi = labs((*sp).vi) ;
}

/******************/
/*  ABR           */ /* absolute reals */
/******************/
static void ABR(void)
{
     (*sp).vr = (float)fabs((double)(*sp).vr);
}

/******************/
/*  ADI           */ /* add integers */
/******************/
static void ADI(void)
{
     sp->vi += (sp--)->vi ;
}

/******************/
/*  ADR           */ /* add reals */
/******************/
static void ADR(void)
{
     sp-- ;
     (*sp).vr += (*(sp+1)).vr ;
}

/******************/
/*  AND           */ /* logical and */
/******************/
static void AND(void)
{
     sp-- ;
     (*sp).vb = (*sp).vb && (*(sp+1)).vb ;
}

/**************************************/
/* ATN() : arctan標準関数             */
/**************************************/
static void ATN(void)
{
     (*sp).vr = (float)atan((double)(*sp).vr);
}

/******************/
/*  BAS           */  /* load base mark */
/******************/
static void BAS(void)
{
     (*++sp).va = base() ;
}

/*****************/
/*  CHK          */
/*****************/
static void CHK(void)
{
  short i      ;
  char buf[80] ;

     if(((*sp).vi < store[cd.q-1].vi) ||
        ((*sp).vi > store[cd.q].vi)) {
      i = -1 ;
      while(errtbl[++i].errno != cd.p) ;
      sprintf(buf,errtbl[i].msg,
                  (*sp).vi, store[cd.q-1].vi,store[cd.q].vi) ;
      prerr(cd.p,buf) ;               /* エラーメッセージ出力       */
     }
}

/******************/
/*  CHKs          */  /* check set */
/******************/
static void CHKs(void)
{
  short i      ;
  long  s = 0  ;                        /* 集合                       */
  char buf[80] ;

      for(i=(short)store[cd.q-1].vi;i<=(short)store[cd.q].vi;i++)
       addset(s,i);
      s  = (~s & (*sp).vs) ;
      if(s != 0) {
       i = -1 ;
       while(errtbl[++i].errno != cd.p) ;
       sprintf(buf,errtbl[i].msg,
                  store[cd.q-1].vi,store[cd.q].vi) ;
       prerr(cd.p,buf) ;               /* エラーメッセージ出力       */
      }
}

/******************/
/*  CHR           */  /* convert character */
/******************/
static void CHR(void)
{
    char buf[80] ;

     if(((*sp).vi < 0L) || (255L < (*sp).vi)) {
      sprintf(buf,"chr: 引数の値(%ld)に対応する文字がない",(*sp).vi);
      prerr(9,buf) ;
     }
        /* integer と char エリアは　0〜255の範囲では同一なので変換不要 */
}

/******************/
/*  CKA           */  /* Check Address */
/******************/
static void CKA(void)
{
     if((*sp).va == NilValue)
      prerr(3,"対象変数のポインタ変数の値がnilである") ;

     if(!((np <= (*sp).va) && ((*sp).va < Maxstore)))
      prerr(4,"対象変数のポインタ変数の値が不定である") ;
}

/**************************************/
/* COS() : cos標準関数                */
/**************************************/
static void COS(void)
{
     (*sp).vr = (float)cos((double)(*sp).vr) ;
}

/******************/
/*  CUI           */ /* Call User procedure Indirect */
/******************/
static void CUI(void)
{
  short calladr ;

     calladr = (*sp--).va     ;         /* 実行開始アドレス取得       */
     mp= trans(sp) - (cd.p+4) ;         /* 4はmstと関係               */
     store[mp+4].va = pc      ;         /* 戻り番地                   */
     pc = calladr             ;         /* jump                       */
}

/******************/
/*  CUP           */ /* Call User Procedure */
/******************/
static void CUP(void)
{
     mp =trans(sp) - (cd.p+4) ;         /* 4はmstと関係*/
     store[mp+4].va = pc      ;         /* 戻り番地    */
     pc = cd.q                ;         /* jump        */
}

/******************/
/*  DEC           */
/******************/
static void DEC(void)
{
     if(cd.p==1) (*sp).vi -= cd.q ;     /* 1(i)                       */
     else        (*sp).vc -= cd.q ;     /* 0(a) 3(b) 6(c)             */
                     /* ↑ boolean,char,addressエリアは同一           */
}

/******************/
/*  DIF           */
/******************/
static void DIF(void)
{
     sp--;
     (*sp).vs  &= ((*sp).vs ^ (*(sp+1)).vs) ;
}

/**************************************/
/* DIS() : dispose標準手続き          */
/**************************************/
static void DIS(void)
{
  short ad ;

     ad = (*sp--).va ;                  /* 解放するアドレス           */
     if(ad == NilValue)
      prerr(23,"dispose: 引数の値がnilである") ;
     if((np <= ad) && (ad < Maxstore)) {      /* 正常値               */
      if(ad == np) np += cd.q ;               /* 一番後にnewした時だけ*/
                                              /* 本当に解放する       */
     }
     else prerr(24,"dispose: 引数の値が不定である") ;
}

/******************/
/*  DVI           */
/******************/
static void DVI(void)
{
     if((*sp--).vi == 0) prerr(45,"div演算子: 0で割ろうとしている") ;
     (*sp).vi /= (*(sp+1)).vi ;
}

/******************/
/*  DVR           */
/******************/
static void DVR(void)
{
     if((*sp--).vr == (float)0.0)
      prerr(44,"/演算子: 0で割ろうとしている") ;
     (*sp).vr /= (*(sp+1)).vr ;
}

/******************/
/*  EJP           */  /* Extra block Jump */
/******************/
static void EJP(void)
{
  short req ;

     req = base() ;
     while(mp != req) {                 /* スタックの枠を解放         */
      sp = store + mp - 1 ;
      ep = store[mp+3].va ;             /* mp+3 ･･･ 旧ep              */
      mp = store[mp+2].va ;             /* mp+2 ･･･ 動鎖              */
     }
     pc = cd.q;
}

/******************/
/*  ENT           */
/******************/
static void ENT(void)
{
     sp = store + mp + cd.q - 1   ;    /* スタックポインタ設定        */
     if((ep = trans(sp)+cd.p) >= np)   /* スタックの枠限界設定
                                            &  スタックチェック       */
       prerr(122,"スタック用のメモリが不足している") ;
}

/******************/
/*  EQU           */
/******************/
static void EQU(void)
{
     sp-- ;

     switch(cd.p) {
      case 1: /* (*sp).vb = (*sp).vi == (*(sp+1)).vi ; return; */
      case 2: /* (*sp).vb = (*sp).vr == (*(sp+1)).vr ; return; */
      case 4:    (*sp).vb = (*sp).vs == (*(sp+1)).vs ; return;

      case 6: /* (*sp).vb = (*sp).vc == (*(sp+1)).vc ; return; */
      case 0: /* (*sp).vb = (*sp).va == (*(sp+1)).va ; return; */
      case 3:    (*sp).vb = (*sp).vb == (*(sp+1)).vb ; return;

      case 5: (*sp).vb = (StrComp(store+(*sp).va,
                                  store+(*(sp+1)).va,
                                  cd.q) == 0);
     }
}

/**************************************/
/* EXP() : exp標準関数                */
/**************************************/
static void EXP(void)
{
     (*sp).vr = (float)exp((double)(*sp).vr) ;
}

/******************/
/*  FJP           */
/******************/
static void FJP(void)
{
     if(! (*(sp--)).vb) pc = cd.q;
}

/******************/
/*  FLO           */
/******************/
static void FLO(void)
{
     (*(sp-1)).vr = (float)(*(sp-1)).vi ;
}

/******************/
/*  FLT           */
/******************/
static void FLT(void)
{
     (*sp).vr = (float)(*sp).vi ;
}

/******************/
/*  GEQ           */
/******************/
static void GEQ(void)
{
     sp-- ;
     switch(cd.p) {
      case 1:    (*sp).vb = (*sp).vi >= (*(sp+1)).vi ;  return;

      case 2:    (*sp).vb = (*sp).vr >= (*(sp+1)).vr ;  return;

      case 6: /* (*sp).vb = (*sp).vc >= (*(sp+1)).vc ;  return; */
      case 3:    (*sp).vb = (*sp).vb >= (*(sp+1)).vb ;  return;

      case 4:    (*sp).vb = !
                    ((*(sp+1)).vs & ((*(sp+1)).vs ^ (*sp).vs)) ; return;

      case 5:    (*sp).vb = (StrComp(store+(*sp).va,
                                  store+(*(sp+1)).va,
                                  cd.q) >= 0);
     }
}

/******************/
/*  GRT           */
/******************/
static void GRT(void)
{
     sp-- ;
     switch(cd.p) {
      case 1:    (*sp).vb = (*sp).vi > (*(sp+1)).vi ;  return;

      case 6: /* (*sp).vb = (*sp).vc > (*(sp+1)).vc ;  return; */
      case 3:    (*sp).vb = (*sp).vb > (*(sp+1)).vb ;  return;

      case 2: (*sp).vb = (*sp).vr > (*(sp+1)).vr ;  return;

      case 5: (*sp).vb = (StrComp(store+(*sp).va,
                                  store+(*(sp+1)).va,
                                  cd.q) > 0);
     }
}

/******************/
/*  INC           */
/******************/
static void INC(void)
{
     if(cd.p==1) (*sp).vi += cd.q ;     /* 1(i)                       */
     else        (*sp).vc += cd.q ;     /* 0(a) 3(b) 6(c)             */
                     /* ↑ boolean,char,addressエリアは同一           */
}

/******************/
/*  IND           */    /* INDirect */
/******************/
static void IND(void)
{
     (*sp)=store[(*sp).va+cd.q] ;
}

/******************/
/*  INDa          */    /* INDirect address */
/******************/
static void INDa(void)
{
     (*sp).va=store[(*sp).va+cd.q].va ;
}

#define INDb INDa
#define INDs IND
#define INDr IND

/******************/
/*  INDc          */  /* INDirect character */
/******************/
     /* inputバッファの値が決まっていない時のために
        特別な処理が必要なので、この処理を作りました */
static void INDc(void)
{
  short adr ;

     adr = (*sp).va+cd.q ;
     if((adr == fi[0].fileadr) && readlnflag) {
      T_get(fi,store+adr,"get");
      readlnflag = false ;
     }

     (*sp).vc = store[adr].vc ;
}

/******************/
/*  INN           */
/******************/
static void INN(void)
{
  integer i;

     i=(*(--sp)).vi ;
     (*sp).vb =
       (i & 0xffffffe0)                 /* 0<=i<=31 かどうかの判定    */
        ? (boolean)false
        : (boolean)(((*(sp+1)).vs >> (char)i) & 0x1) ;
}

/******************/
/*  INT           */
/******************/
static void INT(void)
{
     sp--;
     (*sp).vs &= (*(sp+1)).vs  ;
}

/******************/
/*  IOR           */ /* logical inclusive or */
/******************/
static void IOR(void)
{
     sp-- ;
     (*sp).vb = (*sp).vb || (*(sp+1)).vb ;
}

/******************/
/*  IXA           */
/******************/
static void IXA(void)
{
  short disp ;

     disp = (short)((*sp--).vi - store[cd.q-1].vi);/* 配列の下限値を引く*/
     (*sp).va += store[cd.q].va * disp ;
                          /* ↑ vaは2バイトエリアとて使用             */
}

/******************/
/*  LAO           */  /* load base-level address */
/******************/
static void LAO(void)
{
     (*(++sp)).va = cd.q ;
}

/******************/
/*  LAP           */  /* Load Address Procedure */
/******************/
#define LAP LAO

/******************/
/*  LCA           */
/******************/
#define LCA LAO

/******************/
/*  LCI           */  /* load constant integer */
/******************/
#define LCI LDO

/******************/
/*  LDA           */  /* load level p address */
/******************/
static void LDA(void)
{
     (*(++sp)).va = base()+cd.q ;
}

/******************/
/*  LDC           */  /* load constant */
/******************/
static void LDC(void)
{
     sp++ ;
     switch(cd.p) {
      case 1 :    (*sp).vi = cd.q;        return ;    /* integer */

      case 6 : /* (*sp).vc = cd.q;        return ; */ /* char    */
      case 3 :    (*sp).vb = cd.q;        return ;    /* boolean */

      case 2 : /* (*sp).vr = store[cd.q].vr; return;*//* real    */
      case 4 :    *sp = store[cd.q]; return;          /* set     */

      case 0 :    (*sp).va = NilValue ;               /* nil     */
                              /* programmer が 生成できない値    */
     }
}

/******************/
/*  LDO           */  /* load contents of base-level address */
/******************/
static void LDO(void)
{
     *(++sp)=store[cd.q] ;
}

/******************/
/*  LDOc          */  /* load char of base-level address */
/******************/
     /* inputバッファの値が決まっていない時のために
        特別な処理が必要なので、この処理を作りました */
static void LDOc(void)
{
     if((cd.q == fi[0].fileadr) && readlnflag) {
      T_get(fi,store+cd.q,"get");
      readlnflag = false ;
     }

     (*(++sp)).vc = store[cd.q].vc ;
}

/******************/
/*  LDOa          */  /* load char of base-level address */
/******************/
static void LDOa(void)
{
     (*(++sp)).va = store[cd.q].va ;
}

#define LDOb LDOa
#define LDOr LDO
#define LDOs LDO

/******************/
/*  LEQ           */
/******************/
static void LEQ(void)
{
     sp-- ;
     switch(cd.p) {
      case 1:    (*sp).vb = (*sp).vi <= (*(sp+1)).vi ; return;

      case 2:    (*sp).vb = (*sp).vr <= (*(sp+1)).vr ; return;

      case 6: /* (*sp).vb = (*sp).vc <= (*(sp+1)).vc ; return; */
      case 3:    (*sp).vb = (*sp).vb <= (*(sp+1)).vb ; return;

      case 4:    (*sp).vb = !
                   ((*sp).vs & ((*sp).vs ^ (*(sp+1)).vs)) ; return;

      case 5:    (*sp).vb = (StrComp(store+(*sp).va,
                                     store+(*(sp+1)).va,
                                     cd.q) <= 0);
     }
}

/******************/
/*  LES           */
/******************/
static void LES(void)
{
     sp-- ;
     switch(cd.p) {
      case 1:    (*sp).vb = (*sp).vi < (*(sp+1)).vi ; return;

      case 2:    (*sp).vb = (*sp).vr < (*(sp+1)).vr ; return;

      case 6: /* (*sp).vb = (*sp).vc < (*(sp+1)).vc ; return; */
      case 3:    (*sp).vb = (*sp).vb < (*(sp+1)).vb ; return;

      case 5:    (*sp).vb = (StrComp(store+(*sp).va,
                                     store+(*(sp+1)).va,
                                     cd.q) < 0);
     }
}

/******************/
/*  LOD           */  /* load contents of address at level p */
/******************/
static void LOD(void)
{
     *(++sp) = store[base()+cd.q] ;
}

/******************/
/*  LODa          */  /* load contents of address at level p */
/******************/
static void LODa(void)
{
     (*(++sp)).va = store[base()+cd.q].va ;
}

#define LODc LODa
#define LODb LODa
#define LODs LOD
#define LODr LOD

/**************************************/
/* LOG() : ln標準関数                 */
/**************************************/
static void LOG(void)
{
     if((*sp).vr <= (float)0.0)
      prerr(33,"ln: 引数の値が0以下である") ;
     (*sp).vr = (float)log((double)(*sp).vr);
}

/******************/
/*  MMS           */  /* Make Multiple Set */
/******************/
/* この命令だけが -dオプション指定時 自前でチェックを行っている。
   統一がとれていないけど 暫定的処置である */

static void MMS(void)
{
  long    s = 0;
  short   i ;
  long    low,high ;                    /* 下限 上限                  */
  char    buf[80]  ;

     sp--    ;
     if(cd.p<=1) {                      /* p in [0,1]                 */
      low  = sp->vi ;
      high = (sp+1)->vi ;
     }
     else {                             /* p in [2,3]                 */
      low  = (sp+1)->vi ;
      high = sp->vi ;
     }
     if(cd.p & 0x1)                     /* p in [1,3] (-dｵﾌﾟｼｮﾝ)      */
      if((low <= high) &&               /* 下限の方が大きい･･･要素なし*/
         (((long)setlow > low) || (high > (long)sethigh))) {
       sprintf(buf,
        "集合: 式..式の値ががHAPPyの制限範囲内(%d〜%d)にない",
        setlow,sethigh) ;
       prerr(112,buf) ;                /* エラーメッセージ出力       */
      }
     for(i=(short)low;i<=(short)high;i++) addset(s,(short)i);
     (*sp).vs = s;
}

/******************/
/*  MOD           */
/******************/
static void MOD(void)
{
     if((*sp--).vi <= 0)
      prerr(46,"mod演算子: 右辺値が0または負である") ;
     (*sp).vi %= (*(sp+1)).vi ;
}

/******************/
/*  MOV           */
/******************/
static void MOV(void)
{
     if(cd.p==1)                        /* 通常                       */
      memcpy(store+(sp-1)->va,
             store+sp->va,  cd.q*sizeof(_store)) ;
     else /* cd.p==2 */                 /* pack,unpack,writeの時使う  */
      memcpy(store+sp->va,
             store+(sp-1)->va,  cd.q*sizeof(_store)) ;

     sp-=2 ;

}

/******************/
/*  MPI           */
/******************/
static void MPI(void)
{
     sp--;
     (*sp).vi *= (*(sp+1)).vi ;
}

/******************/
/*  MPR           */
/******************/
static void MPR(void)
{
     sp--;
     (*sp).vr *= (*(sp+1)).vr ;
}

/******************/
/*  MSI           */ /* Mark Stack Indirect */
/******************/
static void MSI(void)
{
     (*(sp+2)).va = (*(sp--)).va ;    /* 静鎖    */
     (*(sp+3)).va = mp  ;             /* 動鎖    */
     (*(sp+4)).va = ep  ;             /* 旧ep    */
     sp += 5            ;
}

/******************/
/*  MST           */ /* Mark STack */
/******************/
static void MST(void)
{
     (*(sp+2)).va = base()  ;           /* 静鎖 */
     (*(sp+3)).va = mp      ;           /* 動鎖 */
     (*(sp+4)).va = ep      ;           /* 旧ep */
     sp += 5                ;
}

/******************/
/*  NEQ           */
/******************/
static void NEQ(void)
{
     sp-- ;
     switch(cd.p) {
      case 1: /* (*sp).vb = (*sp).vi != (*(sp+1)).vi ; return; */
      case 2: /* (*sp).vb = (*sp).vr != (*(sp+1)).vr ; return; */
      case 4:    (*sp).vb = (*sp).vs != (*(sp+1)).vs ; return;

      case 0: /* (*sp).vb = (*sp).va != (*(sp+1)).va ; return; */
      case 6: /* (*sp).vb = (*sp).vc != (*(sp+1)).vc ; return; */
      case 3:    (*sp).vb = (*sp).vb != (*(sp+1)).vb ; return;

      case 5:    (*sp).vb = (StrComp(store+(*sp).va,
                                     store+(*(sp+1)).va,
                                     cd.q) != 0);
     }
}

/**************************************/
/* NEW() : new標準手続き              */
/**************************************/
static void NEW(void)
{
  short ad ;

     np -= cd.q ;
     if(np <= ep)
       prerr(121,"new: メモリ不足で割り付けができない") ;
     ad = (*sp--).va ;
     store[ad].va = np ;
}

/******************/
/*  NGI           */
/******************/
static void NGI(void)
{
     (*sp).vi = - (*sp).vi ;
}

/******************/
/*  NGR           */
/******************/
static void NGR(void)
{
     (*sp).vr = - (*sp).vr ;
}

/******************/
/*  NOT           */
/******************/
static void NOT(void)
{
     (*sp).vb = ! (*sp).vb ;
}

/******************/
/*  NXT           */  /* next */  /* for 〜 to */
/******************/
static void NXT(void)
{
     if(cd.p==1) store[mp+cd.q].vi++ ;
     else        store[mp+cd.q].vc++ ;  /* 3(b) 6(c)                  */
                              /* ↑ char と boolean は 同じエリア     */
}

/******************/
/*  NXD           */  /* next downto */  /* for 〜 downto */
/******************/
static void NXD(void)
{
     if(cd.p==1) store[mp+cd.q].vi-- ;
     else        store[mp+cd.q].vc-- ;  /* 3(b) 6(c)                  */
                              /* ↑ char と boolean は 同じエリア     */
}

/******************/
/*  ODD           */
/******************/
static void ODD(void)
{
     (*sp).vb = (boolean)((*sp).vi & 0x00000001) ;
}

/******************/
/*  ORD           */  /* ORDinary */
/******************/
static void ORD(void)
{
                               /* vc も vb も同じエリアなのでif文不要 */
   /*if(cd.p == 3)*/                   /* ordb                        */
      (*sp).vi = (integer)(*sp).vb ;
   /*else*/                            /* ordc                        */
    /*(*sp).vi = (integer)(*sp).vc ;*/
}

/******************/
/*  RET           */
/******************/
static void RET(void)
{
     if(cd.p==0) sp = store + mp -1 ;   /* retp:p=0  p<>0は以下の命令 */
     else        sp = store + mp    ;   /* reti,retr,retc,retb,rets   */
     pc  = store[mp+4].va ;             /* pc 復帰                    */
     ep  = store[mp+3].va ;             /* ep 復帰                    */
     mp  = store[mp+2].va ;             /* mp 復帰                    */
}

/******************/
/*  ROU           */  /* round */
/******************/
static void ROU(void)
{
     (*sp).vi = (integer)floor((double)((*sp).vr + 0.5)) ;
}

/******************/
/*  SBI           */ /* subtruct integers */
/******************/
static void SBI(void)
{
     sp->vi -= (sp--)->vi ;
}

/******************/
/*  SBR           */ /* subtruct reals */
/******************/
static void SBR(void)
{
     sp-- ;
     (*sp).vr -= (*(sp+1)).vr ;
}

/******************/
/*  SGS           */
/******************/
static void SGS(void)
{
  long s = 0 ;

     addset(s,(short)(*sp).vi) ;
     (*sp).vs = s       ;
}

/***************************************/
/* SIN() : sin標準関数                 */
/***************************************/
static void SIN(void)
{
     (*sp).vr = (float)sin((double)(*sp).vr) ;
}

/******************/
/*  SQI           */
/******************/
static void SQI(void)
{
     (*sp).vi *= (*sp).vi ;
}

/******************/
/*  SQR           */
/******************/
static void SQR(void)
{
     (*sp).vr *= (*sp).vr ;
}

/***************************************/
/* SQT() : sqrt標準関数                */
/***************************************/
static void SQT(void)
{
     if((*sp).vr < (float)0.0)      /* 負の平方根                 */
      prerr(34,"sqrt:引数の値が負である") ;
     (*sp).vr = (float)sqrt((double)(*sp).vr);
}

/******************/
/*  SRO           */  /* store at base-level address */
/******************/
static void SRO(void)
{
     store[cd.q] = *(sp--) ;
}

/******************/
/*  SROa          */  /* store at base-level address */
/******************/
static void SROa(void)
{
     store[cd.q].va = (*(sp--)).va ;
}

#define SROc SROa
#define SROb SROa
#define SROr SRO
#define SROs SRO

/******************/
/*  STO           */
/******************/
static void STO(void)
{
     store[(*(sp-1)).va] = *sp ;
     sp-=2 ;
}

/******************/
/*  STOa          */
/******************/
static void STOa(void)
{
     store[(*(sp-1)).va].va = (*sp).va ;
     sp-=2 ;
}

#define STOc STOa
#define STOb STOa
#define STOr STO
#define STOs STO

/******************/
/*  STP           */  /* stop */
/******************/
static void STP(void)
{
     puteoln() ;                        /* ファイルクローズ & eoln付与*/
     exit(0)   ;
}

/******************/
/*  STR           */  /* store contents at address at level p */
/******************/
static void STR(void)
{
     store[base()+cd.q] = *sp-- ;
}

/******************/
/*  STRa          */  /* store contents at address at level p */
/******************/
static void STRa(void)
{
     store[base()+cd.q].va = (*(sp--)).va ;
}

#define STRc STRa
#define STRb STRa
#define STRr STR
#define STRs STR


/******************/
/*  TRA           */  /* trace of execuction */
/******************/
static void TRA(void)
{
     trace = (cd.p==1) ;                /* tra 1 の時 トレースON      */
}

/******************/
/*  TRC           */  /* truncate */
/******************/
static void TRC(void)
{
     (*sp).vi = (integer)(*sp).vr ;
}

/******************/
/*  UDF           */  /* UnDeFined instruction */
/******************/
static void UDF(void)
{
     prerr(142,"未定義命令を実行しようとした") ;
}

/******************/
/*  UJC           */
/******************/
static void UJC(void)
{
     prerr(51,"case文: 選択式の値に合致する選択定数がない") ;
}

/******************/
/*  UJP           */
/******************/
static void UJP(void)
{
     pc = cd.q;
}

/******************/
/*  UNI           */
/******************/
static void UNI(void)
{
     sp--   ;
     (*sp).vs |= (*(sp+1)).vs  ;
}

/******************/
/*  XJP           */
/******************/
static void XJP(void)
{
     pc += (short)(*sp--).vi ;
}

/**********************************************************************/
/*                      P-code   別 処理エントリ表                    */
/**********************************************************************/

static struct entry {
       void (*func)(void) ;
} pcd[] = {
           /*         xx0  xx1  xx2  xx3  xx4  xx5  xx6  xx7  xx8  xx9   */
           /*00x*/    LOD, LDO, STR, SRO, STO, CHK, IND, LDC, LDA, DEC,
           /*01x*/    INC, MST, CUP, ENT, RET, UDF, IXA, EQU, NEQ, GEQ,
           /*02x*/    GRT, LEQ, LES, UJP, FJP, XJP, EJP, LAP, ADI, ADR,
           /*03x*/    SBI, SBR, SGS, FLT, FLO, TRC, NGI, NGR, SQI, SQR,
           /*04x*/    ABI, ABR, NOT, AND, IOR, DIF, INT, UNI, INN, MOD,
           /*05x*/    ODD, MPI, MPR, DVI, DVR, MOV, LCA, LAO, STP, ORD,
           /*06x*/    CHR, UJC, MMS, MSI, CUI, BAS, LCI, CKA, TRA, ROU,
           /*07x*/    NXT, NXD, UDF, UDF, UDF, NEW, DIS, PGE, EoF, EOL,
           /*08x*/    RST, RWT, GET, PUT, WRS, WRB, WRI, WRR, WRC, WRF,
           /*09x*/    WLN, RDI, RDR, RDC, RLN, TRS, TRW, TGT, TPT, ATN,
           /*10x*/    SIN, COS, EXP, LOG, SQT, LDOa,LDOr,LDOs,LDOb,LDOc,
           /*11x*/    UDF, UDF, CHKs,CHK, CHK, LODa,LODr,LODs,LODb,LODc,
           /*12x*/    SROa,SROr,SROs,SROb,SROc,STRa,STRr,STRs,STRb,STRc,
           /*13x*/    STOa,STOr,STOs,STOb,STOc,INDa,INDr,INDs,INDb,INDc,
           /*14x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
           /*15x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
           /*16x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
           /*17x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
           /*18x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
           /*19x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
           /*20x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
           /*21x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
           /*22x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
           /*23x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
           /*24x*/    UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF, UDF,
           /*25x*/    UDF, UDF, UDF, UDF, UDF, UDF
         };

/***********************/
/*     トレース処理    */
/***********************/
static void tracing(void)
{
     printf("%4d[%3d %1d %6d] mp=%4d ep=%4d np=%4d stack[%4d]=%08lxH\n",
       pc-1,cd.op,cd.p,cd.q, mp,ep,np,trans(sp),(*sp).vi);
}

/********************************/
/*      P-code の 解釈実行処理  */
/********************************/
void interpret(void)
{
loop:
     cd = store[pc++].vo ;

     if(trace) tracing() ;              /* トレースオプション有効     */

     pcd[cd.op].func()   ;              /* opに対応した命令を実行     */

     goto loop;
}