/***************************************
 *                                     *
 *  ** HAPPy Pascal compiler **        *
 *     P-code ソース生成               *
 *                                     *
 *   Copyright (c) H.Asano 1992,1993.  *
 ***************************************/

#define  EXTERN  extern
#include <stdio.h>
#include "pascomp.h"
#include "pcpcd.h"

extern char *version   ;                /* HAPPyのバージョン番号      */
extern FILE *pcdfile   ;                /* Pコード出力ファイル        */


/***** function prototype *****/
extern void pcerr(int,char*)  ;
extern boolean string(stp*)   ;
extern void getbounds(stp*,long*,long*) ;
extern void term(void) ;

/********** P-code ニーモニック 定義表 **********/

static struct {
   char    *mn     ;                   /* P-code mnemonics            */
   short   cdx     ;                   /* stack pointerの動き         */
} icd[iZZZ] ;

/***************************************/
/* initpcd() : P-code関連 初期設定処理 */
/***************************************/
void initpcd(void)
{
  enum pcdmnc i ;

  /**** P-code instruction mnmonics の 登録 *****/
     for(i=iABI;i<iZZZ;i++)
      icd[i].cdx = 0 ;                  /* 最初に初期化しておく       */
     icd[iABI].mn  = "abi" ;
     icd[iABR].mn  = "abr" ;
     icd[iADI].mn  = "adi" ;  icd[iADI].cdx =-1 ;
     icd[iADR].mn  = "adr" ;  icd[iADR].cdx =-1 ;
     icd[iAND].mn  = "and" ;  icd[iAND].cdx =-1 ;
     icd[iATN].mn  = "atn" ;
     icd[iBAS].mn  = "bas" ;  icd[iBAS].cdx =+1 ;
     icd[iCHK].mn  = "chk" ;
     icd[iCHR].mn  = "chr" ;
     icd[iCKA].mn  = "cka" ;
     icd[iCOS].mn  = "cos" ;
     icd[iCUI].mn  = "cui" ;  icd[iCUI].cdx =-1 ;
     icd[iCUP].mn  = "cup" ;
     icd[iDEC].mn  = "dec" ;
     icd[iDIF].mn  = "dif" ;  icd[iDIF].cdx =-1 ;
     icd[iDIS].mn  = "dis" ;  icd[iDIS].cdx =-1 ;
     icd[iDVI].mn  = "dvi" ;  icd[iDVI].cdx =-1 ;
     icd[iDVR].mn  = "dvr" ;  icd[iDVR].cdx =-1 ;
     icd[iEJP].mn  = "ejp" ;
     icd[iENT].mn  = "ent" ;
     icd[iEOF].mn  = "eof" ;
     icd[iEOL].mn  = "eol" ;
     icd[iEQU].mn  = "equ" ;  icd[iEQU].cdx =-1 ;
     icd[iEXP].mn  = "exp" ;
     icd[iFJP].mn  = "fjp" ;  icd[iFJP].cdx =-1 ;
     icd[iFLO].mn  = "flo" ;
     icd[iFLT].mn  = "flt" ;
     icd[iGEQ].mn  = "geq" ;  icd[iGEQ].cdx =-1 ;
     icd[iGET].mn  = "get" ;  icd[iGET].cdx =-1 ;
     icd[iGRT].mn  = "grt" ;  icd[iGRT].cdx =-1 ;
     icd[iINC].mn  = "inc" ;
     icd[iIND].mn  = "ind" ;
     icd[iINN].mn  = "inn" ;  icd[iINN].cdx =-1 ;
     icd[iINT].mn  = "int" ;  icd[iINT].cdx =-1 ;
     icd[iIOR].mn  = "ior" ;  icd[iIOR].cdx =-1 ;
     icd[iIXA].mn  = "ixa" ;  icd[iIXA].cdx =-1 ;
     icd[iLAO].mn  = "lao" ;  icd[iLAO].cdx =+1 ;
     icd[iLAP].mn  = "lap" ;  icd[iLAP].cdx =+1 ;
     icd[iLCA].mn  = "lca" ;  icd[iLCA].cdx =+1 ;
     icd[iLDA].mn  = "lda" ;  icd[iLDA].cdx =+1 ;
     icd[iLDC].mn  = "ldc" ;  icd[iLDC].cdx =+1 ;
     icd[iLDO].mn  = "ldo" ;  icd[iLDO].cdx =+1 ;
     icd[iLEQ].mn  = "leq" ;  icd[iLEQ].cdx =-1 ;
     icd[iLES].mn  = "les" ;  icd[iLES].cdx =-1 ;
     icd[iLOD].mn  = "lod" ;  icd[iLOD].cdx =+1 ;
     icd[iLOG].mn  = "log" ;
     icd[iMMS].mn  = "mms" ;  icd[iMMS].cdx =-1 ;
     icd[iMOD].mn  = "mod" ;  icd[iMOD].cdx =-1 ;
     icd[iMOV].mn  = "mov" ;  icd[iMOV].cdx =-2 ;
     icd[iMPI].mn  = "mpi" ;  icd[iMPI].cdx =-1 ;
     icd[iMPR].mn  = "mpr" ;  icd[iMPR].cdx =-1 ;
     icd[iMSI].mn  = "msi" ;  icd[iMSI].cdx =-1 ;
     icd[iMST].mn  = "mst" ;
     icd[iNEQ].mn  = "neq" ;  icd[iNEQ].cdx =-1 ;
     icd[iNEW].mn  = "new" ;  icd[iNEW].cdx =-1 ;
     icd[iNGI].mn  = "ngi" ;
     icd[iNGR].mn  = "ngr" ;
     icd[iNOT].mn  = "not" ;
     icd[iODD].mn  = "odd" ;
     icd[iORD].mn  = "ord" ;
     icd[iPGE].mn  = "pge" ;  icd[iPGE].cdx =-1 ;
     icd[iPUT].mn  = "put" ;  icd[iPUT].cdx =-1 ;
     icd[iRDC].mn  = "rdc" ;  icd[iRDC].cdx =-2 ;
     icd[iRDI].mn  = "rdi" ;  icd[iRDI].cdx =-2 ;
     icd[iRDR].mn  = "rdr" ;  icd[iRDR].cdx =-2 ;
     icd[iRET].mn  = "ret" ;
     icd[iRLN].mn  = "rln" ;  icd[iRLN].cdx =-1 ;
     icd[iROU].mn  = "rou" ;
     icd[iRST].mn  = "rst" ;  icd[iRST].cdx =-1 ;
     icd[iRWT].mn  = "rwt" ;  icd[iRWT].cdx =-1 ;
     icd[iSBI].mn  = "sbi" ;  icd[iSBI].cdx =-1 ;
     icd[iSBR].mn  = "sbr" ;  icd[iSBR].cdx =-1 ;
     icd[iSGS].mn  = "sgs" ;
     icd[iSIN].mn  = "sin" ;
     icd[iSQI].mn  = "sqi" ;
     icd[iSQR].mn  = "sqr" ;
     icd[iSQT].mn  = "sqt" ;
     icd[iSRO].mn  = "sro" ;  icd[iSRO].cdx =-1 ;
     icd[iSTO].mn  = "sto" ;  icd[iSTO].cdx =-2 ;
     icd[iSTP].mn  = "stp" ;
     icd[iSTR].mn  = "str" ;  icd[iSTR].cdx =-1 ;
     icd[iTGT].mn  = "tgt" ;  icd[iTGT].cdx =-1 ;
     icd[iTPT].mn  = "tpt" ;  icd[iTPT].cdx =-1 ;
     icd[iTRA].mn  = "tra" ;
     icd[iTRC].mn  = "trc" ;
     icd[iTRS].mn  = "trs" ;  icd[iTRS].cdx =-1 ;
     icd[iTRW].mn  = "trw" ;  icd[iTRW].cdx =-1 ;
     icd[iUJC].mn  = "ujc" ;
     icd[iUJP].mn  = "ujp" ;
     icd[iUNI].mn  = "uni" ;  icd[iUNI].cdx =-1 ;
     icd[iWLN].mn  = "wln" ;  icd[iWLN].cdx =-1 ;
     icd[iWRB].mn  = "wrb" ;  icd[iWRB].cdx =-3 ;
     icd[iWRC].mn  = "wrc" ;  icd[iWRC].cdx =-3 ;
     icd[iWRF].mn  = "wrf" ;  icd[iWRF].cdx =-4 ;
     icd[iWRI].mn  = "wri" ;  icd[iWRI].cdx =-3 ;
     icd[iWRR].mn  = "wrr" ;  icd[iWRR].cdx =-3 ;
     icd[iWRS].mn  = "wrs" ;  icd[iWRS].cdx =-3 ;
     icd[iXJP].mn  = "xjp" ;  icd[iXJP].cdx =-1 ;
}

/****************************************/
/* errchk() : P-codeソースファイルへの  */
/*            出力でエラーがあったか    */
/*            調べる                    */
/****************************************/
static void errchk(int returnfprintf)
{
     if(returnfprintf == EOF) {
       pcerr(701,"") ;
       term()        ;                  /* 終了処理                   */
     }
}

/**********************************/
/* mes(): スタックの必要量を調べる*/
/*          --> topmax            */
/**********************************/
static void mes(int i)
{
     topnew += icd[i].cdx*maxstack ;
     if(topnew > topmax) topmax = topnew ;
     ic++ ;                             /* Instruction Counter 更新   */
}

/***************************************/
/*   putic() : P-CODE付加情報出力      */
/*    ソースの行番号を出力する         */
/***************************************/
static void putic(void)
{
  static oldlineno = 0;

     if(! pcdinf) return ;              /* P-code information off の時*/

     if(oldlineno != lineno) {
      oldlineno = lineno ;
      errchk(fprintf(pcdfile,"; %s(%d)\n",passname,lineno)) ;
                                        /* ソースファイル名､行番号出力*/
     }
}

/************************************************/
/*     gentypindicator(): 型名の出力            */
/*         i : integer & 列挙型                 */
/*         b : boolean                          */
/*         c : char       r : real              */
/*         a : pointer    s : set               */
/*         m : records & arrays                 */
/************************************************/
static void gentypindicator(stp *fsp)
{
  char *type ;

     if(!fsp) {                         /* 型がない時                 */
      errchk(fprintf(pcdfile," ")) ;    /* 空白を出力して終わり       */
      return ;
     }

     switch(fsp->form) {
      case scalar :                     /* スカラー型                 */
        if(fsp == intptr)        type = "i" ;
        else if (fsp == boolptr) type = "b" ;
        else if (fsp == charptr) type = "c" ;
        else if (fsp->sf.sc.scalkind == declared) type = "i" ;
        else                     type = "r" ;
        errchk(fprintf(pcdfile,type)) ;
        break ;

      case subrange :                   /* 範囲型                     */
        gentypindicator(fsp->sf.su.rangetype) ;
        break ;                         /* 基の型について調べる       */

      case pointer :                    /* ポインタ型                 */
        errchk(fprintf(pcdfile,"a")) ;
        break       ;

      case power   :                    /* 集合型                     */
        errchk(fprintf(pcdfile,"s")) ;
        break ;

      case records :                    /* レコード                   */
      case arrays  :                    /* 配列                       */
        errchk(fprintf(pcdfile,"m")) ;
        break ;

   /* case files   : */
   /* case tagfld  : */
   /* case variant : */
                                        /* このルートへ来てはいけない */
     }
}

/***************************************/
/*  crelabel() :ラベル値の生成         */
/***************************************/
int crelabel(void)
{
  static int labelvalue = 0 ;

     return(++labelvalue) ;
}

/**************************************/
/* putlabel(): ラベルの出力           */
/**************************************/
void putlabel(int labname)
{
     if(!pcode) return ;                /* 出力不要ならリターン */
     errchk(fprintf(pcdfile,"L%d\n",labname)) ;
}

/**************************************/
/* putlblv(): ラベル値の出力          */
/**************************************/
void putlblv(int labname, int labvalue)
{
     if(!pcode) return ;                /* 出力不要ならリターン */
     errchk(fprintf(pcdfile,"L%d=%4d\n", labname, labvalue)) ;
}

/**************************************/
/* putprogname(): プログラム名の出力  */
/**************************************/
void putprogname(char *progname)
{
     if(!pcode) return ;                /* 出力不要ならリターン */
     errchk(
   fprintf(pcdfile,"; Writen by HAPPy Pascal Compiler Version %s\n",version));
     errchk(fprintf(pcdfile,"; Pascal source file name=%s\n",passname));
     errchk(fprintf(pcdfile,"N %s\n", progname));
}

/**************************************/
/* putfilename(): ファイル名の出力    */
/*         F ﾌｧｲﾙ名 ｱﾄﾞﾚｽ ｻｲｽﾞ        */
/**************************************/
void putfilename(char *name, int adr,int size)
{
     if(!pcode) return ;                /* 出力不要ならリターン */
     putic()           ;
     errchk(fprintf(pcdfile,"F %s %5d %5d\n", name,adr,size));
}

/**************************************/
/* putq(): quit指示の出力             */
/**************************************/
void putq(void)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     errchk(fprintf(pcdfile,"Q\n"));
}

/**************************************/
/* gen0(): オペランドのないP-code出力 */
/**************************************/
void gen0(enum pcdmnc fop)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     putic() ;
     errchk(fprintf(pcdfile," %s\n",icd[fop].mn)) ;
     mes(fop) ;
}

/************************************************/
/* gen1(): パラメータが1で､ 型のないP-code出力  */
/************************************************/
void gen1(enum pcdmnc fop, int fq)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     putic()  ;
     errchk(fprintf(pcdfile," %s%12d\n",icd[fop].mn,fq)) ;
     mes(fop) ;
}

/*************************************************/
/*    gen0t() : パラメータがなくて型名のある命令 */
/*                 の出力                        */
/*************************************************/
void gen0t(enum pcdmnc fop,stp *fsp)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     putic() ;
     errchk(fprintf(pcdfile," %s",icd[fop].mn));/* ニーモニック出力   */
     gentypindicator(fsp)  ;            /* 型の出力                   */
     errchk(fprintf(pcdfile,"\n")) ;

     mes(fop) ;
}

/************************************************/
/*    gen1t() : パラメータ1つで型名のある命令   */
/*                 の出力                       */
/************************************************/
void gen1t(enum pcdmnc fop,stp *fsp, int fq)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     putic() ;
     errchk(fprintf(pcdfile," %s",icd[fop].mn));/* ニーモニック出力   */
     gentypindicator(fsp) ;             /* 型の出力                   */
     errchk(fprintf(pcdfile,"%11d\n",fq)) ;

     mes(fop) ;
}

/************************************************/
/*    gen2t() : パラメータが2つで型名のある命令 */
/*                 の出力                       */
/************************************************/
void gen2t(enum pcdmnc fop, stp *fsp, int fp,int fq)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     putic() ;
     errchk(fprintf(pcdfile," %s",icd[fop].mn));/* ニーモニック出力   */
     gentypindicator(fsp) ;             /* 型の出力                   */
     errchk(fprintf(pcdfile," %2d %7d\n",fp,fq)); /* p と q の出力    */

     mes(fop) ;
}

/************************************************/
/*    genret(): ret命令の出力                   */
/************************************************/
void genret(stp *fsp)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     putic() ;
     if(!fsp) {                         /* 型のない時は、retp命令     */
      errchk(fprintf(pcdfile, " %sp\n", icd[iRET].mn)) ;
      mes(iRET) ;
     }
     else gen0t(iRET,fsp) ;             /* 型に応じたretp命令         */
}

/************************************************/
/*    genlca(): lca命令の出力                   */
/*                 lca '文字列'\n               */
/************************************************/
static void genlca(void)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     putic() ;
     errchk(fprintf(pcdfile, " %s '%s'\n",
                    icd[iLCA].mn,gattr.cval.valp->c.sval)) ;
     mes(iLCA) ;
}

/************************************************/
/*    genlda(): lda命令の出力                   */
/*                 lda  p  q                    */
/************************************************/
void genlda(int fp,int fq)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     putic() ;
     errchk(fprintf(pcdfile, " %s %3d %7d\n", icd[iLDA].mn, fp, fq));
     mes(iLDA) ;
}

/************************************************/
/*    genixa(): ixa命令の出力                   */
/*                 ixa  p  q                    */
/************************************************/
void genixa(long fp,int fq)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     putic() ;
     errchk(fprintf(pcdfile, " %s %3ld %7d\n", icd[iIXA].mn, fp, fq));
     mes(iIXA) ;
}

/***************************************************/
/*    genldc(): ldc命令の出力                      */
/*       ldci q        整数値をスタックにのせる    */
/*       ldcr ･･･.･･･  実数値をスタックにのせる    */
/*       ldcb q        boolean値をスタックのせる   */
/*       ldcn          nilをスタックにのせる       */
/*       ldcc 'q'      文字をスタックにのせる      */
/*       ldcs (･ ･ ･)  集合の要素をスタックにのせる*/
/***************************************************/
void genldc(char ftype,long fq)
{
  int i ;

     if(!pcode) return ;                /* 出力不要ならリターン       */
     putic() ;
     errchk(fprintf(pcdfile, " %s", icd[iLDC].mn)) ;
     switch(ftype) {
      case 'i' : errchk(fprintf(pcdfile,"i %10ld\n",fq)) ;
                 break ;
      case 'r' : errchk(fprintf(pcdfile,"r %s\n",gattr.cval.valp->c.rval)) ;
                 break ;
      case 'b' : errchk(fprintf(pcdfile,"b %10ld\n",fq)) ;
                 break ;
      case 'n' : errchk(fprintf(pcdfile,"n\n")) ;   /* fqはない */
                 break ;
      case 'c' : errchk(fprintf(pcdfile,"c '%c'\n",(char)fq)) ;
                 break ;
      case 's' : errchk(fprintf(pcdfile,"s (")) ;
                 for(i=0; i<=sethigh; i++)
                  if(inset(gattr.cval.valp->c.pval,i))/* 要素がある時 */
                   errchk(fprintf(pcdfile,"%3d",i)) ;
                 errchk(fprintf(pcdfile,")\n")) ;
     }
     mes(iLDC) ;
}

/************************************************/
/*    gencupent(): cup, ent､ejp命令の出力       */
/*       cup  引数の数  手続きのラベル          */
/*       ent  1または2  ラベル                  */
/*       ejp  水準差    ラベル                  */
/************************************************/
void gencupent(enum pcdmnc fop, int fp1, int fp2)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     putic() ;
     errchk(fprintf(pcdfile," %s %3d   L%4d\n",
                 icd[fop].mn, fp1, fp2 )) ;

     mes(fop) ;
}

/************************************************/
/*    genjump(): jump関係の命令出力             */
/*                ujp / fjp                     */
/************************************************/
void genjump(enum pcdmnc fop, int fq)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     putic() ;
     errchk(fprintf(pcdfile," %s       L%4d\n",
                     icd[fop].mn,  fq)) ;
     mes(fop) ;
}

/************************************************/
/*    gencompare(): 比較関係の命令出力          */
/*                   les/leq/grt/geq/neq/equ    */
/************************************************/
void gencompare(enum pcdmnc fop, char ftypind,int fq)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     putic() ;
     errchk(fprintf(pcdfile," %s%c",icd[fop].mn,ftypind)) ;
     if(ftypind == 'm')                 /* 文字列比較                 */
      errchk(fprintf(pcdfile,"%11d",fq));/* 比較長を出力              */
     errchk(fprintf(pcdfile,"\n")) ;
     mes(fop) ;
}

/************************************************/
/*    convertint() : 必要ならばord命令を生成    */
/*      boolean型か､列挙型でなく                */
/*      integer型に適合しなければ ord命令を生成 */
/************************************************/
void convertint(stp *fsp)
{
     if(fsp == intptr) return ;
     if((fsp->form == scalar) && (fsp->sf.sc.scalkind == declared)
        && (fsp != boolptr)) return ;
     if(fsp->form   == subrange) {
      if(fsp->sf.su.rangetype == intptr) return ;
      if((fsp->sf.su.rangetype->form == scalar) &&
          (fsp->sf.su.rangetype->sf.sc.scalkind == declared)
        && (fsp->sf.su.rangetype != boolptr)) return ;
     }
     gen0t(iORD,fsp) ;
}

/************************************************/
/*    load() : ロード関係の命令の出力           */
/************************************************/
void load(void)
{
     if(!gattr.typtr) return ;          /* 型がなければ何もしない     */

     switch(gattr.kind) {               /* 種類で振り分ける           */
      case cst :                        /* 定数                       */
       if(gattr.typtr->form == scalar) {/* スカラー                   */
        if(gattr.typtr == intptr)       /*   整数                     */
         genldc('i',gattr.cval.ival) ;
        else if(gattr.typtr == charptr) /*   文字                     */
         genldc('c',gattr.cval.ival) ;
        else if(gattr.typtr == boolptr) /*   boolean                  */
         genldc('b',gattr.cval.ival) ;
        else if(gattr.typtr == realptr) /*   実数                     */
         genldc('r',0L) ;
        else                            /*   列挙型                   */
         genldc('i',gattr.cval.ival);
       }
       else if(gattr.typtr == nilptr)   /*  nil の時                  */
        genldc('n',0L) ;
       else                             /* スカラー型,nilでない       */
        genldc('s',0L) ;                /*  集合型の処理              */
       break ;

      case varbl :                      /* 変数                       */
       if(gattr.access == drct)         /*  直接参照                  */
        if(gattr.vlevel <= 1)           /*  大域変数(1),標準変数(0)   */
         gen1t(iLDO,gattr.typtr,gattr.dplmt) ;
        else                            /*  局所変数                  */
         gen2t(iLOD,gattr.typtr,level-gattr.vlevel,gattr.dplmt) ;
       else                             /*  間接参照                  */
        gen1t(iIND,gattr.typtr,gattr.idplmt) ;
       break ;

/*    case expr : */                    /* 式の場合はすでに値がstackに*/
/*     break ;    */                    /* 載っているので何もしない   */
     }

     gattr.kind = expr ;                /* これ以降は式の扱いのため
                                          次回はloadが生成されない    */
}

/****************************************************/
/*    loadaddress() : アドレスロード関係命令の出力  */
/****************************************************/
void loadaddress(void)
{
     if(!gattr.typtr) return ;          /* 型がなければ何もしない     */

     switch(gattr.kind) {               /* 種類で振り分ける           */
      case cst :                        /* 定数                       */
        if(string(gattr.typtr))         /*  文字列ならば              */
         genlca() ;                     /*  lca命令出力               */
        break ;

      case varbl :                      /* 変数                       */
       if(gattr.access == drct)         /*  直接参照                  */
        if(gattr.vlevel <= 1)
         gen1(iLAO,gattr.dplmt) ;       /*  lao命令の出力             */
        else
         genlda(level-gattr.vlevel,gattr.dplmt) ; /* lda命令の出力    */
       else                             /*  間接参照(indrct)          */
        if(gattr.idplmt != 0)
         gen1t(iINC,nilptr,gattr.idplmt) ; /* inc命令の出力           */
       break ;

   /* case expr :*/                     /* 式                         */
                                        /* 本来はこのルートはない     */
     }

     gattr.kind   = varbl ;
     gattr.access = indrct ;
     gattr.idplmt = 0 ;
}

/******************************************/
/*     store() : ストア関係命令の出力     */
/******************************************/
void store(attr fattr)
{

     if(!gattr.typtr) return ;          /* 型がなければ何もしない     */

     if(fattr.access == drct)           /* 直接参照                   */
      if(fattr.vlevel <= 1)             /* 大域変数(1) 標準変数(0)    */
       gen1t(iSRO,fattr.typtr,fattr.dplmt) ;       /* sro命令         */
      else                              /* 局所変数                   */
       gen2t(iSTR,fattr.typtr,level-fattr.vlevel,fattr.dplmt);/*str命令*/
     else                               /* 間接参照                   */
      gen0t(iSTO,fattr.typtr) ;         /*  sto命令                   */
                                        /* fattr.idplmt != 0 のこと   */
}

/****************************************/
/*    genchk()  : chk命令の出力         */
/*                 chk型 種別 下限 上限 */
/****************************************/
void genchk(stp *fsp, int kind, long min, long max)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     putic() ;
     errchk(fprintf(pcdfile," %s",icd[iCHK].mn)) ;
     gentypindicator(fsp) ;             /* 型の出力                   */
     errchk(fprintf(pcdfile," %2d %ld %ld\n", kind,min, max)) ;

     mes(iCHK) ;
}

/*************************************************/
/*  checkbounds() : 上･下限のチェック命令の出力  */
/*************************************************/
void checkbounds(stp *fsp,int kind)
{
  long lmin,lmax ;

     if((!debug)         ||             /* debugでない                */
        (!fsp)           ||             /* 型がない                   */
        (fsp == intptr)  ||             /* 整数型                     */
        (fsp == realptr) ||             /* 実数型                     */
        (fsp == boolptr)) return ;      /* booleanならばチェック不要  */

     if((fsp->form <= subrange)         /* スカラー型､範囲型の時      */
     || (fsp->form == power)) {         /* または集合型               */
      getbounds(fsp,&lmin,&lmax) ;      /* その型の上限､下限を求める  */
      genchk(fsp,kind,lmin,lmax) ;      /* chk命令生成                */
     }
}