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

#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 ;*//* staticなので初期化済*/
     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[iNXT].mn  = "nxt" ;
     icd[iNXD].mn  = "nxd" ;
     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)
      switch(fsp->form) {
       case subrange :                  /* 範囲型                     */
         gentypindicator(fsp->sf.su.rangetype);/* 基の型について調べる*/
         return ;                              /* 戻る                */

       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" ;
         break ;

       case pointer :                   /* ポインタ型                 */
         type = "a" ;
         break      ;

       case power   :                   /* 集合型                     */
         type = "s" ;
         break      ;

       case records :                   /* レコード                   */
       case arrays  :                   /* 配列                       */
         type = "m" ;
         break      ;

    /* case files   : */
    /* case tagfld  : */
    /* case variant : */
                                        /* このルートへ来てはいけない */
      }
     else type = " " ;                  /* 型がない時 空白を出力      */

     errchk(fprintf(pcdfile,type)) ;
}

/***************************************/
/*  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)) ;
}

/****************************************/
/* putentv(): ent命令のオペランド値出力 */
/****************************************/
void putentv(int p, int q)
{
     if(!pcode) return ;                /* 出力不要ならリターン */
     errchk(fprintf(pcdfile,"V %4d %4d\n", p, q)) ;
}

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

/***************************************/
/*   putmnc() : ニーモニック出力処理   */
/***************************************/
static void putmnc(enum pcdmnc fop)
{
     putic()                                    ; /* 行番号出力       */
     errchk(fprintf(pcdfile," %s",icd[fop].mn)) ; /* ニーモック出力   */
     mes(fop)                                   ; /* sp増減値更新     */
}

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

/************************************************/
/* genp(): パラメータがpで､ 型のないP-code出力  */
/************************************************/
void genp(enum pcdmnc fop, int fp)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     putmnc(fop)       ;
     errchk(fprintf(pcdfile,"%4d\n",fp)) ;
}

/************************************************/
/* genq(): パラメータがqで､ 型のないP-code出力  */
/************************************************/
void genq(enum pcdmnc fop, int fq)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     putmnc(fop)       ;
     errchk(fprintf(pcdfile,"%12d\n",fq)) ;
}

/*************************************************/
/*    gen0t() : パラメータがなくて型名のある命令 */
/*                 の出力                        */
/*************************************************/
void gen0t(enum pcdmnc fop,stp *fsp)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     putmnc(fop)       ;
     gentypindicator(fsp)  ;            /* 型の出力                   */
     errchk(fprintf(pcdfile,"\n")) ;
}

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

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

/************************************************/
/*    genent(): ent命令の出力                   */
/************************************************/
void genent(void)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     putmnc(iENT)      ;
     errchk(fprintf(pcdfile,"   V\n")) ;
}

/************************************************/
/*    genret(): ret命令の出力                   */
/************************************************/
void genret(stp *fsp)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     if(fsp) gen0t(iRET,fsp) ;          /* 型に応じたret命令          */
     else {                             /* 型がない時                 */
      putmnc(iRET) ;
      errchk(fprintf(pcdfile, "p\n")) ; /* retp命令                   */
     }
}

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

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

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

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

     if(!pcode) return ;                /* 出力不要ならリターン       */
     putmnc(iLDC)      ;
     switch(ftype) {
      case 'i' :
      case 'b' : errchk(fprintf(pcdfile,"%c %10ld\n",ftype,fq)) ;
                 break ;
      case 'r' : errchk(fprintf(pcdfile,"r %s\n",gattr.cval.valp->c.rval)) ;
                 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((gattr.cval.valp->c.pval >> i) & 0x1) /* 要素あり*/
                   errchk(fprintf(pcdfile,"%3d",i)) ;
                 errchk(fprintf(pcdfile,")\n")) ;
     }
}

/************************************************/
/*    gencupejp(): cup, ejp命令の出力           */
/*       cup  引数の数  手続きのラベル          */
/*       ejp  水準差    ラベル                  */
/************************************************/
void gencupejp(enum pcdmnc fop, int fp1, int fp2)
{
     if(!pcode) return ;                /* 出力不要ならリターン       */
     putmnc(fop)       ;
     errchk(fprintf(pcdfile," %3d   L%4d\n", fp1, fp2 )) ;
}

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

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

/************************************************/
/*    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)
{
  char kind ;

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

     switch(gattr.kind) {               /* 種類で振り分ける           */
      case cst :                        /* 定数                       */
       if(gattr.typtr->form == scalar) {/* スカラー                   */
        if(gattr.typtr == intptr)       kind = 'i' ;  /*   整数       */
        else if(gattr.typtr == charptr) kind = 'c' ;  /*   文字       */
        else if(gattr.typtr == boolptr) kind = 'b' ;  /*   boolean    */
        else if(gattr.typtr == realptr) kind = 'r' ;  /*   実数       */
        else                            kind = 'i' ;  /*   列挙型     */
       }
       else if(gattr.typtr == nilptr)   kind = 'n' ;  /*  nil の時    */
       else                             kind = 's' ;  /*  集合型      */
       genldc(kind,gattr.cval.ival) ;   /* 'r','n','s' の時はival無効 */
       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)
         genq(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 ;                /* 出力不要ならリターン       */
     putmnc(iCHK)      ;
     gentypindicator(fsp) ;             /* 型の出力                   */
     errchk(fprintf(pcdfile," %2d %ld %ld\n", kind,min, max)) ;
}

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

     if((!debug)         ||             /* debugでない                */
        (!fsp)           ||             /* 型がない                   */
        (fsp == intptr)  ||             /* 整数型                     */
        (fsp == charptr) ||             /* 文字型                     */
        (fsp == realptr) ||             /* 実数型                     */
        (fsp == boolptr)) return ;      /* booleanならばチェック不要  */
                                        /* スカラー,範囲型,集合型の時
                                           しか、この処理は呼ばれない */
     getbounds(fsp,&lmin,&lmax) ;       /* その型の上限､下限を求める  */
     genchk(fsp,kind,lmin,lmax) ;       /* chk命令生成                */
}