/*********************************************************************
 *
 *       *** HAPPy Pascal Compiler ***
 *             program,block コンパイル処理
 *
 *                void programme(void)
 *                void block(Set fsys,enum symbol fsy,ctp *fprocp)
 *
 *       Copyright (c) H.Asano 1992,1994.
 *
 *********************************************************************/

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

void block(Set,enum symbol,ctp*) ;
static void body(Set,ctp*)  ;
static void paramcopy(ctp*) ;
static void statement(Set)  ;
static void compoundstatement(Set)    ;
static void ifstatement(Set)     ;
static void whilestatement(Set)  ;
static void repeatstatement(Set) ;
static void forstatement(Set)    ;
static void forident(attr*)      ;
static void forexpres1(Set,attr);
static void forexpres2(Set,attr,enum symbol,int*,int*) ;
static void fordostatement(Set,attr,enum symbol,int) ;
static void assignment(Set,ctp*) ;
static void casestatement(Set) ;
static void withstatement(Set) ;
static void gotostatement(Set) ;
extern void call(Set,ctp*) ;
extern void expression(Set) ;
extern void selector(Set,ctp*) ;
extern ctp  *mkctp(char*,enum idclass,stp*,ctp*) ;
extern void enterid(ctp*) ;
extern ctp  *searchid(Set);
extern ctp  *searchsection(ctp*) ;
extern void insymbol(void);
extern void skip(Set) ;
extern void updatelc(int)    ;
extern void pcerr(int,char*) ;
extern char *inttoch(long)   ;
extern char *inttoch(long)   ;
extern char *inttoch(long) ;
extern Set  *mkset(Set*,int,...) ;
extern Set  *orset(Set*,Set*)    ;
extern Set  *dfset(Set*,Set*) ;
extern int  crelabel(void) ;
extern void labeldecl(Set);
extern void constdecl(Set);
extern void typedecl(Set);
extern void vardecl(Set,ctp*);
extern void procfuncdecl(Set,enum symbol,ctp**);
extern void gencupejp(enum pcdmnc, int, int) ;
extern void genjump(enum pcdmnc,int) ;
extern void putlabel(int) ;
extern void genent(void) ;
extern void genret(stp*) ;
extern void putprogname(char*);
extern void putentv(int,int) ;
extern void putq(void) ;
extern void gen0(enum pcdmnc) ;
extern void genp(enum pcdmnc, int) ;
extern void gen0t(enum pcdmnc,stp*) ;
extern void gen1t(enum pcdmnc,stp*,int) ;
extern void gen2t(enum pcdmnc,stp*,int,int) ;
extern void genlda(int,int) ;
extern void genldc(char,long) ;
extern void genchk(stp*,int,long,long) ;
extern void convertint(stp*) ;
extern void load(void) ;
extern void loadaddress(void) ;
extern void store(attr) ;
extern void gencompare(enum pcdmnc,char,int) ;
extern void getbounds(stp*,long*,long*) ;
extern void checkbounds(stp*,int) ;
extern boolean compatible(stp*,stp*) ;
extern boolean assigncompati(stp*,stp*) ;
extern int  align(stp*,int) ;
extern void constant(Set,stp**,union valu*) ;
extern void *Malloc(int)  ;

static int lcmax     ;
static int mainlabel ;                  /* メインブロックのラベル値   */

/*******************************************************
 *   programme() : program の 処理
 *     形式は、次の2通り
 *        program ident( filename,filename,･･･ ) ;
 *        program ident;
 *******************************************************/
void programme(void)
{
  extfilep  *extfp ;                    /* ファイル名格納エリアのポインタ   */
  Set       fsys   ;                    /* block で 最初に現れるsymbolの集合*/
  Set       casesys;                    /* casesyだけの集合 (ワーク)        */
  ctp       *cp    ;                    /* input,output名前登録用           */
  int       i      ;
  int       adr    ;
  boolean   err196 ;

     fextfilep = nil ;

     insymbol() ;                       /* 最初のsymbolを読む         */

     if(sy == progsy) {
      insymbol();
      if(sy != ident) pcerr(2,"");      /* 名前がない                 */
      putprogname(id) ;                 /* プログラム名の出力         */
      insymbol();
      if((sy != lparent) && (sy != semicolon))
       pcerr(14,"");                    /* ; がない                   */

      if(sy == lparent) {               /* プログラム引数の処理       */
       do {
        insymbol();
        if(sy == ident) {
          err196 = false    ;
          extfp = fextfilep ;
          while(extfp) {                /* 重複指定チェック           */
           if(!strcmp(extfp->filename,id)) {
            pcerr(196,id) ;             /* プログラム引数に同じ名前   */
            err196 = true ;
           }
           extfp = extfp->nextfile ;
          }
          if(!err196) {
           if(!(i=strcmp(id,"input")) || !(strcmp(id,"output"))) {
            if(i!=0) {                  /* outputの時                 */
             adr = outputadr ;
             defineoutput = true ;      /* outputファイル定義済       */
            }
            else {                      /* inputの時                  */
             adr = inputadr ;
             defineinput = true ;       /* inputファイル定義済        */
            }
            cp = mkctp(id,vars,textptr,nil) ;
            cp->n.v.vkind = actual ;
            cp->n.v.vlev  = level  ;
            cp->n.v.vaddr = adr    ;
            enterid(cp);
           }

           extfp = (extfilep*)Malloc(sizeof(extfilep)) ;
           strcpy(extfp->filename,id);
	   extfp->nextfile = fextfilep ;
           fextfilep = extfp ;
          }

          insymbol() ;
          if((sy != comma) && (sy != rparent))
           pcerr(20,"") ;               /* , がない                   */
        }
	else pcerr(2,"") ;              /* 名前がない                 */
       } while(sy == comma);
       if(sy != rparent) pcerr(14,"");  /* ; がない                   */
       insymbol();
      }
      if(sy!=semicolon) pcerr(14,"");   /* ; がない                   */
      else insymbol();
     }
     else pcerr(3,"") ;                 /* program がない             */

     fsys = blockbegsys        ;        /* fsys =  blockbegsys        */
     orset(&fsys,&statbegsys)  ;        /*       + statbegsys         */
     mkset(&casesys,casesy,-1) ;
     dfset(&fsys,&casesys)     ;        /*       - casesy             */

     do {                               /* 誤り回復のためrepeat       */
      block(fsys,period,nil) ;          /* block の コンパイル        */
      if(sy != period) pcerr(21,"") ;   /*  *がない                   */
     } while(sy != period)   ;

}

/**************************************/
/* block() : block の 翻訳            */
/**************************************/
void block(Set fsys,         /* blockに最初に現れるsymbolの集合    */
           enum symbol fsy,  /* blockの終わりのsymbol              */
           ctp *fprocp)      /* proc/funcの名前ポインタ(mainはnil) */

{
  enum symbol lsy ;
  Set bodyfsys    ;
  ctp *pffwdptr = nil  ;                /* 手続き･関数の前方宣言リスト*/
  ctp *lcp        ;
  extfilep *extp  ;                     /* プログラム引数リスト       */

     do {                               /* declare partの処理         */
      if(sy == labelsy) {
       insymbol() ;
       labeldecl(fsys) ;                /* label節の処理              */
      }
      if(sy == constsy) {
       insymbol() ;
       constdecl(fsys) ;                /* const節の処理              */
      }
      if(sy == typesy)  {
       insymbol() ;
       typedecl(fsys)  ;                /* type節の処理               */
      }
      if(sy == varsy)   {
       insymbol() ;
       vardecl(fsys,fprocp)   ;         /* var節の処理                */
      } ;

      if(fprocp == nil) {               /* メインブロックの時         */
       extp = fextfilep ;
       while(extp) {                    /* プログラム引数の宣言チェック*/
        strcpy(id,extp->filename) ;
        lcp = searchsection(display[level].fname) ;
        if(!lcp) pcerr(197,id) ;        /* プログラム引数が未宣言      */
        extp = extp->nextfile  ;
       }

       genp(iMST,0) ;                   /*  mst命令の生成             */
       mainlabel = crelabel()       ;   /*  メインブロックのラベル名  */
       gencupejp(iCUP,0,mainlabel ) ;   /*  cup命令の生成             */
       gen0(iSTP)   ;                   /*  stp命令の生成             */

      }

      while((sy == procsy) || (sy == funcsy)) {
       lsy = sy   ;
       insymbol() ;
       procfuncdecl(fsys,lsy,&pffwdptr) ;/* 手続き･関数の宣言処理     */
      } ;

      while(pffwdptr) {                 /* 手続き･関数の前方宣言チェック*/
       pcerr(118,pffwdptr->name) ;      /*  前方宣言の実体がない      */
       pffwdptr = pffwdptr->n.pf.sd.d.af.a.fwdptr ;
      }

      if(sy != beginsy) {
       pcerr(18,"") ;                   /* 宣言部に誤りがある         */
       skip(fsys) ;
      } ;

     } while(! inset(statbegsys,sy)) ;  /* 誤り回復のため繰り返し     */

     if(sy == beginsy) insymbol()   ;
     else              pcerr(17,"") ;   /* begin がない               */

     bodyfsys = fsys ;
     addset(bodyfsys,casesy) ;
     do {
      body(bodyfsys,fprocp)     ;       /* begin 〜 end の処理        */
      if(sy != fsy) {
       pcerr(6,"") ;                    /* 不当な記号が現れた         */
       skip(fsys)  ;
      }
     } while((sy != fsy) && (! inset(blockbegsys,sy))) ;
}

/**************************************/
/* body() : body部 の 翻訳            */
/**************************************/
static void body(Set fsys,ctp *fprocp)
{
  lbp *llp     ;
  int entname  ;
  Set statementfsys ;
  boolean test ;

     topnew  = topmax = lcaftermarkstack ;
     entname = (!fprocp) ? mainlabel               /* mainのbodyの時       */
                 : fprocp->n.pf.sd.d.af.a.pfname ; /* 手続き･関数のラベル値*/

     putlabel(entname)    ;             /* ラベルの出力               */
     genent()             ;

     if(fprocp) paramcopy(fprocp) ;     /* 手続き･関数の時 仮引数を
                                               スタックにコピーする   */
     lcmax = lc ;

    /**** statement の 処理　****/

     statementfsys = fsys ;             /* statementfsys =            */
     addset(statementfsys,semicolon);   /*  fsys + semicolon          */
     addset(statementfsys,endsy)    ;   /*       + endsy              */
     do {
      do {
       statement(statementfsys);
      } while(inset(statbegsys,sy)) ;
      if(test=(sy == semicolon)) insymbol() ;  /* ; ならば次のsymbolを読む */
     } while(test) ;                           /* ; ならば繰り返す    */
     if(sy == endsy) insymbol() ;
     else pcerr(13,"") ;                /* end がない                 */

   /**** ラベルの定義チェック ****/

     llp = display[top].flabel;
     while(llp) {                       /* 宣言られたラベルについて   */
      if(!llp->defined)                 /*   未定義                   */
       pcerr(168,inttoch((long)llp->labval)); /* ラベル未出現         */
      llp = llp->nextlab ;
     }

     if(fprocp) {                       /* 手続き･関数内のブロックの時*/
      genret(fprocp->idtype) ;          /* 型に応じたret命令生成      */
      if(fprocp->klass == func)         /* 関数の時                   */
       if(!display[top].funcassign)     /*   関数名への代入がない時   */
        pcerr(176,fprocp->name) ;       /*     関数名への代入がない   */
     }
     else genret(nil)        ;          /* mainブロックの時はretp命令 */

     putentv(topmax,lcmax)   ;
     if(!fprocp) putq()      ;          /* mainブロックの時 q指令を出力*/

}

/**************************************/
/* paramcopy() : 値引数のコピー処理   */
/**************************************/
static void paramcopy(ctp *fprocp)
{
  ctp *lcp ;
  int llc ;

     llc = lcaftermarkstack ;
     lcp = fprocp->next     ;           /* 引数の先頭                 */

     while(lcp) {
      llc = align(parmptr,llc) ;        /* 境界調整                   */
      if(lcp->klass == vars)            /* 変数の時                   */
       if(lcp->idtype)
        if(lcp->idtype->form > power) { /* 配列･レコード型            */
         if(lcp->n.v.vkind == actual) { /* 値引数                     */
          genlda(0,lcp->n.v.vaddr) ;    /* lda命令                    */
          gen2t(iLOD,nilptr,0,llc) ;    /* lod命令                    */
          gen2t(iMOV,nil,1,lcp->idtype->size); /* mov命令             */
         }
         llc += ptrsize ;
        }
        else llc += lcp->idtype->size ; /* スカラ､範囲､集合､ポインタ  */
      lcp = lcp->next ;
     }
}

/**************************************/
/* statement() : 文 の コンパイル     */
/**************************************/
static void statement(Set fsys)
{
  Set ws ;
  Set statfolsys ;                      /* 文の後に続くsymbolの集合   */
  Set identsys   ;                      /* 名前の集合                 */
  ctp *lcp ;
  lbp *llp ;

     mkset(&statfolsys, semicolon,endsy,elsesy,untilsy,-1);
     mkset(&identsys,   vars,field,func,proc,-1) ;

  /**** label の 処理 ****/
     if(sy == intconst) {
      llp = display[level].flabel ;
      while(llp) {
       if(llp->labval == (int)val.ival) {  /* 宣言されたラベルの時    */
        if(llp->defined)
         pcerr(165,inttoch(val.ival));/* ラベルが再度宣言された       */
        putlabel(llp->labname)     ;  /* ラベル値の出力               */
        llp->defined = true        ;  /* 定義済                       */
        break ;
       }
       else llp = llp->nextlab     ;    /* ラベル名が違う時           */
      }
      if(!llp)
       pcerr(167,inttoch(val.ival));    /* ラベルが未宣言             */
      insymbol() ;
      if(sy == colon) insymbol()   ;
      else pcerr(5,"")             ;    /* : がない　                 */
     }

  /***********************/

     if((! inset(fsys,sy)) && (sy != ident)) {    /* 許されないsymbolの時 */
      pcerr(6,"") ;                               /* 不当なsymbolが現れた */
      skip(fsys)  ;
     }
     if((inset(fsys,sy)) || (sy == ident)) {      /* 文の最初としてOKの時 */
      switch(sy) {
       case ident :    lcp=searchid(identsys) ;
                       insymbol() ;
                       if(lcp->klass != proc)
                        assignment(fsys,lcp) ;      /* 代入文の処理   */
                       else if((lcp->klass == proc) &&
                               (inset(statfolsys,sy) || (sy == lparent)))
                        call(fsys,lcp) ;            /* 手続きのみ呼出 */
                       else {
                        pcerr(6,"") ;   /* 不当な記号が現れた         */
                        ws = fsys ;
                        orset(&ws,&statfolsys) ;
                        skip(ws)  ;     /* 読み飛ばし                 */
                       }
                       break ;
       case beginsy  : insymbol() ;
                       compoundstatement(fsys) ;
                       break ;
       case gotosy   : insymbol() ;
                       gotostatement(fsys) ;
                       break ;
       case ifsy     : insymbol() ;
                       ifstatement(fsys) ;
                       break ;
       case casesy   : insymbol() ;
                       casestatement(fsys) ;
                       break ;
       case whilesy  : insymbol() ;
                       whilestatement(fsys) ;
                       break ;
       case repeatsy : insymbol() ;
                       repeatstatement(fsys) ;
                       break ;
       case forsy    : insymbol() ;
                       forstatement(fsys) ;
                       break ;
       case withsy   : insymbol() ;
                       withstatement(fsys) ;
      }

      if(! inset(statfolsys,sy)) {
       pcerr(6,"") ;                    /* 不当な記号が現れた         */
       skip(fsys) ;
      }
     }
}

/***************************************/
/* compoundstatement() : begin文の処理 */
/***************************************/
static void compoundstatement(Set fsys)
{
  Set ws;
  boolean test;

     do {
      do {
       mkset(&ws,semicolon,endsy,-1);
       orset(&ws,&fsys) ;
       statement(ws) ;
      } while(inset(statbegsys,sy)) ; /* statement以外がでてきた時終わり*/
      if(test = (sy == semicolon)) insymbol() ; /* ; ならば次のsymbol */
     } while(test) ;                    /* ; ならば繰り返す           */

     if(sy == endsy) insymbol() ;       /* end ならば次のsymbol       */
     else pcerr(13,"") ;                /*  end がない                */
}

/***************************************/
/*   gotostatement() : goto文の処理    */
/***************************************/
static void gotostatement(Set fsys)
{
  lbp *llp ;
  int ttop,ttop1 ;
  boolean found ;

     if(sy == intconst) {               /* ラベルは整数               */
      found = false ;
      ttop  = top   ;
      while(display[ttop].occur != blck)
        ttop-- ;                        /* block水準を探す            */
      ttop1 = ttop ;
      do {
       llp = display[ttop].flabel ;
       while(llp) {
        if(llp->labval == (int)val.ival) { /* ラベル値が同じ          */
         found = true ;
         if(ttop == ttop1)              /* ラベルの定義水準と同じ     */
          genjump(iUJP,llp->labname) ;  /* ujp命令                    */
         else
          gencupejp(iEJP,level-ttop,llp->labname); /* ejp命令         */
         break ;                        /* whileループを抜ける        */
        }
        else llp = llp->nextlab ;
       }
       ttop-- ;
      } while((! found) && (ttop != 0)) ;
      if(! found)
       pcerr(167,inttoch(val.ival));    /* ラベルが未宣言             */
      insymbol() ;
     }
     else pcerr(164,"") ;               /* ラベルが整数でない         */
}

/***************************************/
/*    ifstatement() : if文の処理       */
/***************************************/
static void ifstatement(Set fsys)
{
  int lcix1,lcix2 ;
  Set ws ;

     ws = fsys ;
     addset(ws,thensy) ;
     expression(ws) ;                   /* ifの次の式を評価           */
     load()               ;             /* 式の値をloadする           */
     if(gattr.typtr)
      if(gattr.typtr != boolptr)        /* 式の値がbooleanでない時    */
       pcerr(146,"if文")  ;             /*  演算対象は論理型でないと駄目*/
     lcix1 = crelabel()   ;
     genjump(iFJP,lcix1)  ;             /* 偽ならelseまたはifの終わりに飛ぶ*/

     if(sy == thensy) insymbol() ;
     else pcerr(52,"")    ;             /* then がない                */

     ws = fsys ;
     addset(ws,elsesy)    ;
     statement(ws)        ;             /* thenの次の文を処理         */

     if(sy == elsesy) {
      lcix2 = crelabel()  ;
      genjump(iUJP,lcix2) ;             /* elseの終わりまで飛ぶ       */
      putlabel(lcix1)     ;             /* elseのラベル出力           */
      insymbol()          ;
      statement(fsys)     ;             /* elseの次の文を処理         */
      putlabel(lcix2)     ;             /* elseの終わりのラベル出力   */
     }
     else putlabel(lcix1) ;             /* elseがない時 if文の終わりのラベル*/
}

/***************************************/
/*  whilestatement() : while文の処理   */
/***************************************/
static void whilestatement(Set fsys)
{
  int laddr ;                           /* 戻りラベル値               */
  int lcix  ;                           /* 飛び越しラベル値           */
  Set ws    ;

     laddr = crelabel() ;               /* ラベル値を得る             */
     putlabel(laddr)    ;               /* ラベル値の出力             */

     ws = fsys ;
     addset(ws,dosy)    ;
     expression(ws)     ;               /* whileの次の式の評価        */
     load()             ;               /* 式の値をloadする           */
     if(gattr.typtr)
      if(gattr.typtr != boolptr)        /* 式の値がbooleanでない時    */
       pcerr(146,"while文")  ;          /*  演算対象は論理型でないと駄目*/
     lcix = crelabel()  ;               /* 飛び越しラベル値を得る     */
     genjump(iFJP,lcix) ;               /* fjp命令の生成              */
     if(sy == dosy) insymbol() ;
     else pcerr(54,"")  ;               /* do がない                  */

     statement(fsys)    ;               /* 文の処理                   */

     genjump(iUJP,laddr);               /* ujp命令でwhile文の先頭に戻る*/

     putlabel(lcix)     ;               /* 飛び先ラベルの出力         */
}

/*****************************************/
/*  repeatstatement() : repeat文の処理   */
/*****************************************/
static void repeatstatement(Set fsys)
{
  int laddr ;                           /* 戻りラベル値               */
  Set ws    ;
  boolean test ;

     laddr = crelabel() ;               /* ラベル値を得る             */
     putlabel(laddr)    ;               /* ラベル値の出力             */

     mkset(&ws,semicolon,untilsy,-1);
     orset(&ws, &fsys) ;
     do {
      do {
       statement(ws)   ;                 /* 文の処理                   */
       if(inset(statbegsys,sy))
        pcerr(14,"") ;                   /*  ; がない                  */
      } while(inset(statbegsys,sy)); /*  文として正しいsymbolならﾘﾋﾟｰﾄ */
      if(test = (sy==semicolon)) insymbol() ; /* ; ならば次のsymbol    */
     } while(test) ;                     /*      ; ならば繰り返す      */

     if(sy == untilsy) {
      insymbol() ;
      expression(fsys) ;                /* untilに続く式の評価        */
      load()             ;              /* 式の値をloadする           */
      if(gattr.typtr)
       if(gattr.typtr != boolptr)       /* 式の値がbooleanでない時    */
        pcerr(146,"repeat文") ;         /*  式は論理式でない          */
      genjump(iFJP,laddr) ;             /* fjp命令の生成              */
     }
     else pcerr(53,"") ;                /* until がない               */
}

/***************************************/
/* forstatement() : for文のコンパイル  */
/***************************************/
static void forstatement(Set fsys)
{
  attr lattr ;
  int  llc   ;
  enum symbol lsy ;
  int  looplabel  ;                     /* for文のループ用ラベル値    */
  int  forendlabel;                     /* for文終了の飛び先ラベル値  */
  Set  ws    ;

     llc = lc ;                         /* 変数割りつけ状況を退避     */
     lattr.typtr  = nil   ;             /* 制御変数の属性初期設定     */
     lattr.kind   = varbl ;
     lattr.access = drct  ;
     lattr.vlevel = level ;
     lattr.dplmt  = 0     ;

     if(sy == ident) forident(&lattr) ;
     else {
      pcerr(2,"") ;                     /* 名前がない                 */
      mkset(&ws,becomes,tosy,downtosy,dosy,-1) ;
      orset(&ws,&fsys) ;
      skip(ws)    ;                     /*     読み飛ばし             */
     }

     if(sy == becomes) forexpres1(fsys,lattr) ;  /* 式1の処理         */
     else {
      pcerr(51,"") ;                    /* := がない                  */
      mkset(&ws,tosy,downtosy,dosy,-1) ;
      orset(&ws,&fsys) ;
      skip(ws)     ;                    /*     読み飛ばし             */
     }

     if((sy == tosy) || (sy == downtosy)) {
      lsy = sy     ;                    /* to か downsyを後で判断するため退避*/
      forexpres2(fsys,lattr,lsy,&looplabel,&forendlabel) ; /* 式2の処理      */
     }
     else {
      pcerr(55,"") ;                    /* to / downto がない         */
      mkset(&ws,dosy,-1) ;
      orset(&ws,&fsys)   ;
      skip(ws)           ;              /*     読み飛ばし             */
     }

     if(sy == dosy) insymbol() ;
     else pcerr(54,"")   ;              /* do がない                  */

     fordostatement(fsys,lattr,lsy,looplabel) ;    /* doに続く文の処理*/

     putlabel(forendlabel) ;            /* for文の終わりラベル出力    */

     lc = llc              ;            /* 一時変数を開放             */
}

/***************************************/
/* forident() : for文の制御変数処理    */
/***************************************/
static void forident(attr *fattr)
{
  ctp *lcp ;
  Set ws   ;
  int ltop ;

     mkset(&ws,vars,-1) ;
     lcp = searchid(ws) ;               /* 変数の中から名前を探す     */

     (*fattr).typtr = lcp->idtype ;     /*   変数の型                 */
     (*fattr).kind  = varbl       ;
     if(lcp->n.v.vkind == actual) {     /* 実変数ならばOK             */
      (*fattr).access = drct ;
      (*fattr).vlevel = lcp->n.v.vlev ; /*    変数の宣言レベル        */
      (*fattr).dplmt  = lcp->n.v.vaddr; /*    変数の割りつけアドレス  */
      ltop = top ;
      while(display[ltop].occur != blck) /* block水準を探す           */
       ltop-- ;
      if(lcp->n.v.vlev != ltop)         /* 制御変数の定義水準が       */
       pcerr(186,id) ;                  /*  for文と同一ぶろっくでない */
     }
     else {
      pcerr(187,id) ;                   /* 変数引数を制御変数に使えない */
      (*fattr).typtr = nil ;
     }

     if((*fattr).typtr)
      if(((*fattr).typtr->form > subrange) ||     /* ポインタ型､集合型､   */
                                                  /* レコード型､ファイル型*/
         (realptr == (*fattr).typtr)) {           /* またはreal型         */
       pcerr(188,id) ;                            /* 制御変数の型が不当   */
       (*fattr).typtr = nil ;
      }

     insymbol() ;
}

/***************************************/
/* forexpres1() : for文の式1処理       */
/*      for 制御変数:=式1 ････         */
/***************************************/
static void forexpres1(Set fsys,attr fattr)
{
  Set ws ;

     insymbol() ;

     mkset(&ws,tosy,downtosy,dosy,-1) ;
     orset(&ws,&fsys) ;
     expression(ws)   ;                 /* 式1を評価                  */

     if(gattr.typtr)
      if((gattr.typtr->form != scalar) || (gattr.typtr == realptr))
       pcerr(144,"for文の初期値")  ;/* 式が順序式でない               */
      else if(compatible(fattr.typtr,gattr.typtr)) {   /* 制御変数と型が同じ*/
       load() ;                         /* 式の値をload               */
       store(fattr) ;                   /* 制御変数域にstore          */
      }
      else pcerr(145,"初期値") ;        /* 制御変数と初期値の型が不適合*/
}

/****************************************/
/* forexpres2() : for文の式2処理        */
/*   for ･･･ to/downto 式2 do ･･･       */
/****************************************/
static void forexpres2(Set fsys,attr fattr,
                       enum symbol fsy,int *flooplabel,int *forendlabel)
{
  stp  *lspfin ;
  char typind  ;                        /* gencompareに引き渡す型文字 */
  int  tempadr ;                        /* 一時変数域のアドレス       */
  Set ws ;

     insymbol() ;

     ws = fsys ;
     addset(ws,dosy) ;
     expression(ws) ;                   /* 式2を評価                  */

     lspfin = gattr.typtr ;             /* 終値の属性を退避           */
     if(lspfin == boolptr)      typind = 'b' ;    /* boolean          */
     else if(lspfin == charptr) typind = 'c' ;    /* char             */
     else                       typind = 'i' ;    /* integer/列挙型   */

     if(lspfin)
      if((lspfin->form != scalar) || (lspfin == realptr))
       pcerr(144,"for文の終値")  ;          /* 順序式でない           */
      else if(compatible(fattr.typtr,lspfin)) {  /* 制御変数と型が同じ*/
       load() ;                             /* 式の値をload           */
       updatelc(align(lspfin,lc) - lc) ;    /* 境界合わせ             */
       tempadr = lc ;
       gen2t(iSTR,lspfin,0,tempadr) ;       /* 一時変数域に式の値をstr*/
       *flooplabel = crelabel() ;
       if(!debug)                           /* debugでないならば      */
        putlabel(*flooplabel) ;             /* ループラベル出力       */
       gattr = fattr  ;
       load()          ;                    /* 制御変数をload         */
       gen2t(iLOD,lspfin,0,tempadr) ;       /* 一時変数(式2)をload    */
       updatelc(lspfin->size)       ;
       if(lc > lcmax) lcmax =lc ;           /* 最大変数域サイズの更新 */
       (fsy == tosy) ? gencompare(iLEQ,typind,0) /* to ならeq命令生成 */
                     : gencompare(iGEQ,typind,0);/* downtoならgeq命令生成 */
      }
      else pcerr(145,"終値") ;          /* 制御変数と終値の型が不適合  */

     *forendlabel = crelabel() ;        /* for文終了後の飛び先ラベル生成*/
     genjump(iFJP,*forendlabel);        /* fjp命令生成                */

     if(debug) {                        /* debugの時                  */
      gattr = fattr   ;
      load()          ;                 /* 制御変数をload             */
      checkbounds(fattr.typtr,52);      /* 範囲チェック               */
      store(fattr) ;
      gen2t(iLOD,lspfin,0,tempadr)  ;   /* 一時変数(式2)をload        */
      checkbounds(fattr.typtr,53)   ;   /* 範囲チェック               */
      gen2t(iSTR,lspfin,0,tempadr) ;    /* 一時変数域に式の値をstr    */

      putlabel(*flooplabel) ;           /* ループラベル出力           */
      gattr = fattr   ;
      load()          ;                 /* 制御変数をload             */
      gen2t(iLOD,lspfin,0,tempadr)  ;   /* 一時変数(式2)をload        */
      (fsy == tosy) ? gencompare(iLEQ,typind,0) /* to ならleq命令生成 */
                    : gencompare(iGEQ,typind,0);/* downtoならgeq命令生成 */
      genjump(iFJP,*forendlabel);       /* fjp命令生成                */
     }
}

/**********************************************/
/* fordostatement() : for文のdoに続く文の処理 */
/*                     for ･･･  do 文         */
/**********************************************/
static void fordostatement(Set fsys,attr fattr,
                           enum symbol fsy,int looplabel)
{
     statement(fsys) ;                  /* 文の処理                   */
     (fsy == tosy) ? gen1t(iNXT,fattr.typtr,fattr.dplmt)   /* nxt命令 */
                   : gen1t(iNXD,fattr.typtr,fattr.dplmt) ; /* nxd命令 */
     genjump(iUJP,looplabel) ;          /* ujp命令で戻る              */
}

/*****************************************/
/* withstatement() : with文のコンパイル  */
/*****************************************/
static void withstatement(Set fsys)
{
  ctp *lcp     ;
  int oldlc    ;                         /* lcの退避域                */
  int oldtop   ;                         /* display top の退避域      */
  boolean test ;
  Set ws       ;

     oldtop = top ;                     /* 今のdisplayのtopを退避     */
     oldlc  = lc  ;                     /* 今のlcを退避               */

     do {
      if(sy == ident) {
       mkset(&ws,vars,field,-1) ;
       lcp = searchid(ws) ;             /* 名前を変数､フィールド名より探す*/
       insymbol() ;
      }
      else {
       pcerr(2,"") ;                    /* 名前がない                 */
       lcp = uvarptr ;                  /* 未定義用の変数ポインタ     */
      }
      mkset(&ws,comma,dosy,-1) ;
      orset(&ws,&fsys) ;
      selector(ws,lcp) ;                /* 変数の処理                 */
      if(gattr.typtr)
       if(gattr.typtr->form == records)
        if(top < Displimit) {           /* displayがまだある時        */
         top++ ;
         display[top].fname  = gattr.typtr->sf.re.fstfld ; /* 最初の欄*/
         display[top].flabel = nil ;    /* ラベル欄の初期設定         */
         if(gattr.access == drct) {     /* 直接参照の時               */
          display[top].occur = crec ;   /* 固定部のレコード欄         */
          display[top].clev  = gattr.vlevel ; /* 定義水準             */
          display[top].cdspl = gattr.dplmt  ; /* 相対アドレス         */
         }
         else {                         /* 間接参照の時               */
          loadaddress() ;               /* loadaddress命令            */
          updatelc(align(nilptr,lc)-lc);/* lcの境界調整               */
          gen2t(iSTR,nilptr,0,lc) ;     /* str命令                    */
          display[top].occur = vrec ;   /* 可変レコード欄             */
          display[top].vdspl = lc   ;   /* loadaddress 格納場所       */
          updatelc(ptrsize)         ;   /* lcを1アドレス分進める      */
          if(lc > lcmax) lcmax = lc ;
         }
        }
        else
         pcerr(603,inttoch((long)Displimit));/* 名前の入れ子が深すぎる */
       else pcerr(140,"")  ;            /* 変数の型がレコードでない   */
      if(test = (sy == comma)) insymbol() ; /* , なら次の変数を読む   */
     } while(test) ;                    /* , なら次の変数の処理へ　   */

     if(sy == dosy) insymbol() ;
     else pcerr(54,"") ;                /* do がない                  */

     statement(fsys)   ;                /* with文配下の文の処理       */

     top = oldtop ;                     /* 水準を元に戻す             */
     lc  = oldlc  ;                     /* lcを元に戻す               */
}

/**************************************/
/* assignment() : 代入文のコンパイル  */
/**************************************/
static void assignment(Set fsys,ctp *fcp)
{
  attr lattr ;                          /* 1つ前の属性                */
  long lmin,lmax ;
  boolean cstflag ;
  Set ws ;

     ws = fsys ;
     addset(ws,becomes)    ;
     addset(ws,relop  )    ;            /* := を = と間違えやすいので
                                           この場合だけ別エラーにする */
     selector(ws, fcp)     ;            /* 左辺の処理                 */

     if(fcp->klass == func)             /* 左辺が関数の時             */
      if(fcp->n.pf.pfdeckind == standard) {
       pcerr(150,fcp->name) ;           /* 標準関数への代入は駄目     */
       gattr.typtr = nil ;
      }
      else if(fcp->n.pf.sd.d.pfkind == formal)
        pcerr(151,"") ;                 /* 関数引数への代入は駄目     */
      else if(display[fcp->n.pf.sd.d.pflev+1].funcname != fcp)
       pcerr(177,fcp->name) ;           /* ここでは代入できない       */
      else display[fcp->n.pf.sd.d.pflev+1].funcassign = true ;
                                        /* 関数名への代入あり         */

     if(sy==relop && op==eqop) {
           pcerr(49,"") ;               /*  = でなく := を使え        */
           sy = becomes ;               /* := に 置き換える           */
     }
     if(sy == becomes) {
      if(gattr.typtr)
       if(gattr.typtr->form == subrange)    /* 範囲型の時は　範囲値を */
        getbounds(gattr.typtr,&lmin,&lmax) ;/*   求めておく           */
       if((gattr.access != drct) ||     /* 直接参照でないか           */
          (gattr.typtr->form > power))  /* 配列型､レコード型､ファイル型*/
        loadaddress() ;                 /* の時は、アドレスをのせる   */
      lattr = gattr   ;                 /* 左辺を退避                 */
      insymbol() ;
      expression(fsys) ;                /* 右辺の処理                 */
      if(gattr.typtr)
       cstflag = gattr.kind == cst ;    /* 右辺が定数の時 真          */
       if(gattr.typtr->form <= power)   /* スカラー､範囲､ポインタ､集合*/
        load() ;
       else loadaddress() ;

      if((lattr.typtr) && (gattr.typtr)) {
       if((lattr.typtr == realptr) &&          /* 左辺が実数型で      */
          (compatible(gattr.typtr,intptr))) {  /* 右辺が整数型の時    */
        gen0(iFLT) ;                           /* 実数に変換 flt命令  */
        gattr.typtr = realptr ;
       }

       if(assigncompati(lattr.typtr,gattr.typtr)) /* 代入可能な時     */
        switch(lattr.typtr->form) {           /* 型によって振り分ける */
         case subrange :
           if(cstflag) {
            if((lmin > gattr.cval.ival) || /*   コンパイル時に        */
               (lmax < gattr.cval.ival))   /*   範囲内チェックを行    */
             pcerr(129,"") ;               /* 代入可能でない          */
           }
           else checkbounds(lattr.typtr,49) ;/* 実行時にチェック      */
           store(lattr) ;
           break ;
         case scalar   :
           checkbounds(lattr.typtr,49) ;       /* 上限･下限のチェック */
         case pointer  :
           store(lattr) ;
           break ;
         case power :
           checkbounds(lattr.typtr,50) ;       /* 上限･下限のチェック */
           store(lattr) ;
           break ;
         case arrays  :
         case records :
           gen2t(iMOV,nil,1,lattr.typtr->size) ;
        }
       else pcerr(129,"") ;             /* 代入可能でない　           */
      }
     }
     else  pcerr(51,"") ;               /*  := がない                 */
}

/*****************************************/
/* casestatement() : case文のコンパイル  */
/*****************************************/
typedef struct caseinfo cip ;
struct caseinfo {
   cip  *next   ;
   int  csstart ;                       /* P-codeラベル値             */
   long cslab   ;                       /* 定数値                     */
} ;

static void casestatement(Set fsys)
{
  stp *lsp,*lsp1 ;
  cip *lpt,*lpt1,*lpt2,*lpt3,*fstptr;
  int laddr ;
  int lcix,lcix1;
  long lmin,lmax;
  union valu lval ;
  boolean test ;
  Set ws ;

     mkset(&ws,ofsy,comma,colon,-1) ;
     expression(ws) ;                   /* caseに続く式の処理         */
     load() ;                           /* 式の値をload               */
     lsp = gattr.typtr ;
     if(lsp)
      if((lsp->form != scalar) || (lsp == realptr)) {
       pcerr(144,"case文の選択式") ;    /* 順序式でない               */
       lsp = nil     ;
      }
      else convertint(gattr.typtr) ;    /* 必要ならord命令生成        */

     lcix = crelabel()  ;
     genjump(iUJP,lcix) ;               /* 式の値チェックへ飛ぶ       */

     if(sy == ofsy) insymbol() ;
     else pcerr(8,"")          ;        /* of がない                  */

     fstptr = nil ;
     laddr = crelabel() ;
     do {
      lpt = nil ;
      lcix1 = crelabel() ;
      do {
       mkset(&ws,comma,colon,-1);
       orset(&ws,&fsys) ;
       constant(ws,&lsp1,&lval) ;       /* 定数の処理                 */
       if(lsp1)
        if(lsp == lsp1) {               /* 式の型と定数の型を比較     */
        /*** 新しい定数を昇順となるようlpt1 と lpt2 の間に挿入する ****/
         lpt1 = fstptr ;
         lpt2 = nil    ;
         while(lpt1 != nil) {
          if(lpt1->cslab >= lval.ival) {
           if(lpt1->cslab == lval.ival)/* 前の定数と同じ値の時        */
            pcerr(156,"") ;            /* case文の名札が再度定義された*/
           break ;
          }
          lpt2 = lpt1;
          lpt1 = lpt1->next ;
         }
         lpt = (cip*)Malloc(sizeof(cip)) ;
         lpt->next            = lpt1      ;
         lpt->cslab           = lval.ival ;
         lpt->csstart         = lcix1     ;
         if(lpt2==nil) fstptr = lpt       ; /* 一度もwhileﾙｰﾌﾟを回ってない*/
         else lpt2->next      = lpt       ;
         if(lpt1==nil) lmax   = lval.ival ; /* 定数の最大値           */
        }
        else pcerr(147,"") ;            /* case文の名札の型がおかしい */
       if(test=(sy==comma)) insymbol() ;/*   , ならば次の定数を読む   */
      } while(test) ;                   /*   , ならば次の定数の処理   */
      if(sy == colon) insymbol() ;
      else pcerr(5,"") ;                /* : がない                   */
      putlabel(lcix1) ;
      ws = fsys;
      addset(ws,semicolon) ;
      lpt3 = lpt;                       /* QuickCのバグのため(lpt破壊)*/
      do {                              /* 誤り回復のため繰り返し     */
       statement(ws)       ;            /* 定数に対する文の処理       */
      } while(inset(statbegsys,sy));
      if(lpt3) genjump(iUJP,laddr);
      if(test=(sy==semicolon)) insymbol() ;/* ; ならば次の定数を読む  */
      if(sy==endsy) break ;             /*   endなら処理終わり        */
     } while(test) ;                    /*    ; ならば次の定数の処理  */

     putlabel(lcix) ;

     if(fstptr) {
      lmin = fstptr->cslab;
      if(lmax - lmin < Cixmax) {
       genchk(intptr,51,lmin,lmax);
       if(lmin!=0)                      /* 最小値が0の時はそのまま    */
        if(labs(lmin) <=32767)          /* qオペランドで表現できる値  */
         gen1t(iDEC,intptr,(int)lmin) ; /* deci  最小値               */
        else {                          /* 大きな値                   */
         genldc('i',lmin);              /* ldci lmin                  */
         gen0(iSBI) ;                   /* sbi                        */
        }
       gen0(iXJP) ;
       do {
        while(fstptr->cslab > lmin) {
         gen0(iUJC) ;
         lmin++ ;
        }
        genjump(iUJP,fstptr->csstart);
        fstptr = fstptr->next ;
        lmin++ ;
       } while(fstptr) ;
       putlabel(laddr) ;
      }
      else
       pcerr(601,inttoch((long)Cixmax)) ; /* case文の選択の範囲が大きすぎる*/
     }

     if(sy == endsy) insymbol() ;
     else pcerr(13,"") ;                /* end がない                 */
}