/*********************************************************************
 *
 *     *** HAPPy Pascal compiler ***
 *
 *          型の処理
 *
 *             void typ(Set fsys,stp **fsp,int *fsize)
 *
 *
 *                Copyright (c) H.Asano 1992
 *
 *********************************************************************/

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

extern void pcerr(int,char*) ;
extern char *inttoch(long)   ;
extern Set  *orset(Set*,Set*) ;
extern Set  *mkset(Set*,int,...) ;
extern Set  *dfset(Set*,Set*) ;
extern void insymbol(void) ;
extern void skip(Set)  ;
extern ctp  *mkctp(char*,enum idclass,stp*,ctp*) ;
extern void enterid(ctp*) ;
extern ctp  *searchid(Set) ;
extern ctp  *searchsection(ctp*) ;
extern int  align(stp*,int) ;
extern boolean string(stp*) ;
extern void constant(Set, stp**, union valu*);
extern void getbounds(stp*,long*,long*) ;
extern boolean compatible(stp*,stp*) ;
extern void *Malloc(int) ;
extern void applied(ctp*,int) ;

static boolean simpletype(Set,stp**,int*) ;
static stp  *enumtype(Set) ;
static stp  *subrtype1(Set,ctp*) ;
static stp  *subrtype2(Set,ctp*) ;
static boolean complextype(Set,stp**) ;
static stp *pointertype(Set) ;
static boolean packedtype(Set) ;
static stp *recordtype(Set,boolean,boolean*);
static boolean fieldlist(Set,stp**,int*) ;
static boolean varfield(Set,stp**,int*)  ;
static boolean varelement(Set,stp*,stp**,int**);
static stp *settype(Set,boolean) ;
static stp *filetype(Set,boolean) ;
static stp *arraytype(Set,boolean,boolean*) ;

/**************************************/
/*     typ() : 型の処理メイン         */
/**************************************/
boolean typ(Set fsys,stp **fsp,int *fsize)
{
  boolean fileflag = false ;
  Set ws ;

     if(! inset(typebegsys,sy)) {
      pcerr(10,"") ;                    /* 型の記述に誤りがある       */
      ws = fsys ;
      orset(&ws,&typebegsys) ;
      skip(ws)               ;          /* fsys+typebegsysまで読み飛ばし */
     }

     if(inset(typebegsys,sy)) {         /* symbolがtypebegsysにある時 */
      if(inset(simptypebegsys,sy))      /*  単純型の時                */
       fileflag = simpletype(fsys,fsp,fsize) ;/*    単純型の処理      */
      else
       fileflag = complextype(fsys,fsp) ;     /*  構造型の処理        */

     }
     else *fsp = nil  ;

     if(*fsp) {
      *fsize = (*fsp)->size ;
      (*fsp)->assignflag = !fileflag ;  /* 代入可能フラグ設定         */
     }
     else *fsize = 1  ;

     return(fileflag) ;
}

/***********************************************/
/*  simpletype() :  単純型の処理               */
/*                                             */
/*    単純型 ::= 列挙型 | 部分範囲型 | 型名    */
/*      列挙型      ::=  (名前,名前･･･)        */
/*      部分範囲型  ::= 定数   .. 定数|定数名  */
/*      部分範囲型  ::= 定数名 .. 定数名|定数  */
/*      型名        ::= 名前                   */
/*                                             */
/***********************************************/
static boolean simpletype(Set fsys,stp **fsp,int *fsize)
{
  stp *lsp ;
  ctp *lcp ;
  boolean fileflag = false ;
  Set ws ;

     *fsize = 1 ;
     if(! inset(simptypebegsys,sy)) {
      pcerr(1,"") ;                     /* 単純な型に誤りがある       */
      ws = fsys ;
      orset(&ws,  &simptypebegsys) ;
      skip(ws) ;                        /* fsys+simtypebegsysまで読み飛ばし */
     }

     if(inset(simptypebegsys,sy)) {     /* 単純型の始めのsymbolの時  */
      switch(sy) {
       case  lparent  :                 /*  (                        */
         lsp = enumtype(fsys) ;         /*    列挙型の処理           */
         break         ;
       case  ident    :                 /* 名前                      */
         mkset(&ws, konst,types, -1) ;
         lcp = searchid(ws)          ;  /*  定数か型名から名前を探す */
         applied(lcp,level)          ;  /*  引用名チェーン           */
         insymbol()                  ;  /*  次のsymbolを読んでおく   */
         if(lcp->klass == konst) {      /*  定数名                   */
          lsp = subrtype1(fsys,lcp);    /*    範囲型1の処理          */
         }
         else {                         /*  型名                     */
          lsp = lcp->idtype ;
          if(lsp) {
           *fsize = lsp->size ;
           fileflag=!(lsp->assignflag); /* 代入可能とfileありは反転関係*/
          }
         }
         break ;
       default :                        /*  定数                      */
         lsp = subrtype2(fsys,lcp) ;    /*    範囲型2の処理           */
      }

      if((lsp) && (lsp->form == subrange)
         && (lsp->sf.su.rangetype) )
       if(lsp->sf.su.rangetype == realptr) /* 範囲型の元の型が実数型  */
        pcerr(109,"") ;                 /* 範囲型は実数では駄目       */
       else
        if(lsp->sf.su.min > lsp->sf.su.max)
         pcerr(102,"")  ;               /* 下限が上限より大きい       */

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

      *fsp = lsp ;
     }

     else *fsp = nil ;                  /* not (sy in simptypebegsys) */

     return(fileflag) ;
}

/****************************************/
/* enumtype() : 列挙型の処理            */
/*   列挙型 := (名前,名前,名前,･････)   */
/****************************************/
static stp *enumtype(Set fsys)
{
  int ttop ;
  stp *lsp ;
  ctp *lcp, *lcp1 = nil ;
  int lcnt = 0    ;                     /* 各名前の値生成用のカウンタ */
  Set ws ;

     ttop = top  ;                      /* 今のdisplayのtopを退避     */
     while(display[top].occur != blck)  /* blockの水準をサーチ        */
      top-- ;
     lsp = (stp*)Malloc(sizeof(stp)) ;
     lsp->form = scalar  ;
     lsp->size = intsize ;
     lsp->sf.sc.scalkind = declared ;

     do {
      insymbol() ;
      if(sy == ident) {                 /* 各要素は名前である         */
       lcp = mkctp(id,konst,lsp,lcp1) ; /* 名前のエリアを確保         */
       lcp->n.values.ival = lcnt++ ;    /* 各名前の値を入れる         */
       enterid(lcp)          ;          /* 名前を登録                 */
       lcp1 = lcp            ;
       insymbol()            ;
      }
      else pcerr(2,"")       ;          /* 名前がない                 */

      mkset(&ws,comma,rparent,-1) ;
      orset(&ws, &fsys)      ;
      if(! inset(ws,sy)) {              /* , ) fsys のsymbolでない    */
       pcerr(6,"")           ;          /*  不当な記号が現れた        */
       skip(ws)              ;          /* fsys , )  までで読み飛ばし */
      }
     } while(sy == comma)    ;          /* , で区切られるならば次へ   */

     lsp->sf.sc.fconst = lcp1;          /* 列挙型の最後の名前へのポインタ */
     top = ttop              ;          /* displayの水準を元に戻す    */

     if(sy == rparent) insymbol() ;     /* ) なら次のsymbolを読む     */
     else pcerr(4,"")        ;          /*  ) がない                  */

     return(lsp) ;
}

/****************************************/
/* subrtype1() : 範囲型1の処理          */
/*   範囲型1 := 定数名..定数名|定数     */
/****************************************/
static stp *subrtype1(Set fsys, ctp *lcp)
{
  stp *lsp,*lsp1 ;
  union valu lvalu ;

     lsp = (stp*)Malloc(sizeof(stp));
     lsp->form = subrange ;
     lsp->sf.su.rangetype = lcp->idtype ;
     if(string(lsp->sf.su.rangetype)) { /* 定数が文字列型か調べる     */
      pcerr(109,"")       ;             /*  範囲型はの型は順序型      */
      lsp->sf.su.rangetype = nil ;
     }
     lsp->sf.su.min = lcp->n.values.ival;/* 下限値を入れる             */
     lsp->size      = intsize ;

     if(sy == period2) insymbol()  ;    /*  .. の時 上限のsymbolを読む*/
     else pcerr(22,"")  ;               /*  .. がない                 */
     constant(fsys, &lsp1, &lvalu) ;    /*  上限の処理                */
     lsp->sf.su.max = lvalu.ival   ;    /*  上限値を入れる            */
     if(lsp->sf.su.rangetype != lsp1)
      pcerr(107,"") ;                   /* 2つの型が一致しない        */

     return(lsp) ;
}

/****************************************/
/* subrtype2() : 範囲型2の処理          */
/*   範囲型2 := 定数..定数|定数名       */
/****************************************/
static stp *subrtype2(Set fsys, ctp *lcp)
{
  stp *lsp,*lsp1 ;
  union valu lvalu ;
  Set ws ;

     lsp = (stp*)Malloc(sizeof(stp)) ;
     lsp->form = subrange            ;
     lsp->size = intsize             ;  /*  範囲型となれるのは整数のみ*/
     ws = fsys ;
     addset(ws,period2) ;
     constant(ws, &lsp1, &lvalu)     ;  /* 下限値の処理               */
     if(string(lsp1)) {
      pcerr(109,"") ;                   /* 範囲型の型は順序型         */
      lsp1 = nil    ;
     }
     lsp->sf.su.rangetype = lsp1     ;  /* 範囲型の元の型             */
     lsp->sf.su.min       = lvalu.ival; /* 下限値の設定               */

     if(sy == period2) insymbol() ;     /* .. なら次のsymbol(上限値)  */
     else pcerr(22,"")            ;     /* ..でなければ .. がない     */

     constant(fsys, &lsp1, &lvalu)   ;  /* 上限値の処理               */
     lsp->sf.su.max = lvalu.ival     ;  /* 上限値の設定               */

     if(lsp->sf.su.rangetype != lsp1)   /* 上限値と下限値のタイプが違う時 */
      pcerr(107,"") ;                   /*  範囲型の2つの型が不一致   */

     return(lsp) ;
}

/***********************************************/
/*  complextype() : 単純型以外の型の処理       */
/*                                             */
/*     ^ 型名                                  */
/*      [packed]   array[単純型,･･･] of 型     */
/*      [packed]   file of 型                  */
/*      [packed]   set  of 型                  */
/*      [packed]   record 欄の並び end         */
/***********************************************/
static boolean complextype(Set fsys,stp **fsp)
{
  boolean packedflag ;
  boolean fileflag = false  ;

     if(sy == arrow) *fsp=pointertype(fsys)   ;         /* ポインタ型 */
     else {
      packedflag = packedtype(fsys) ;
      switch(sy) {
       case arraysy  : *fsp=arraytype(fsys,packedflag,&fileflag);
                       break ;                          /* 配列型     */
       case recordsy : *fsp=recordtype(fsys,packedflag,&fileflag);
                       break ;                          /* レコード型 */
       case setsy    : *fsp=settype(fsys,packedflag) ;  /* 集合型     */
                       break ;
       case filesy   : *fsp=filetype(fsys,packedflag);  /* ファイル型 */
                       fileflag = true ;
      }
     }
     return(fileflag) ;
}

/**************************************/
/* pointertype() : ポインタ型の処理   */
/**************************************/
static stp *pointertype(Set fsys)
{
  stp *lsp ;
  ctp *lcp ;
  int ttop ;
  Set ws   ;

     lsp = (stp*)Malloc(sizeof(stp)) ;  /* 型のエリア 確保            */
     lsp->form = pointer ;
     lsp->size = ptrsize ;
     lsp->sf.pt.eltype =  nil  ;        /* とりあえずnilに            */

     insymbol() ;                       /* 次のsymbol(指し示す型名)   */
     if(sy == ident) {
      if(typevar) {                     /* 型定義部の処理の時         */
       ttop = top ;
       do {                             /* ブロック水準から型名を探す */
        lcp = searchsection(display[top].fname) ;
        if(lcp)
         if(lcp->klass == types) break ;
         else lcp = nil ;
       } while(display[top--].occur != blck);
       top = ttop ;
       if(!lcp) lcp = searchsection(display[0].fname) ;
                                        /* 標準名から探す             */
       if(!lcp) {                       /* 見つからない(前方参照)     */
        lcp = mkctp(id,types,lsp,fwptr);/*  名前エリアを型名で確保する*/
        fwptr       = lcp    ;          /* forward pointerにつなぐ    */
       }
       else                             /* 見つかった時               */
        lsp->sf.pt.eltype = lcp->idtype;/*  指し示すものの型          */
      }
      else {                            /* 変数定義部の処理の時       */
       mkset(&ws, types, -1);
       lcp = searchid(ws)   ;           /* 被指示型を探す             */
       lsp->sf.pt.eltype = lcp->idtype; /*  指し示すものの型          */
      }

      if(lsp->sf.pt.eltype)
       if(!lsp->sf.pt.eltype->assignflag)
        pcerr(608,"") ;                 /* 局所ファイルは駄目         */

      insymbol() ;
     }
     else pcerr(2,"") ;                 /* 名前がない                 */

     return(lsp) ;
}

/**************************************/
/* arraytype() : 配列型の処理         */
/**************************************/
static stp *arraytype(Set fsys,boolean packedflag,boolean *fileflag)
{
  stp *lsp,*lsp1,*lsp2 ;
  int lsize = 1 ;
  long range     ;
  long lmin , lmax ;
  Set ws ;
  boolean test ;

     insymbol() ;
     if(sy == lbrack) insymbol()   ;    /* [ ならば次のsymbolを読む   */
     else             pcerr(11,"") ;    /* [ でなければ [がないエラー */

     lsp1 = nil ;
     do {
      lsp = (stp*)Malloc(sizeof(stp)) ;
      lsp->form = arrays           ;
      lsp->sf.ar.packed  = packedflag ; /* packed指定有無             */
      lsp->sf.ar.aeltype = lsp1    ;    /* 要素の型は前の添え字の型   */
      lsp->sf.ar.inxtype = nil     ;    /* 添え字の型の初期設定       */
      lsp1 = lsp ;                      /* 次回のループのために退避   */

      mkset(&ws, comma,rbrack,ofsy,-1) ;
      orset(&ws, &fsys) ;
      simpletype(ws,&lsp2,&lsize)  ;    /* 添え字の型の処理           */
      lsp->size = lsize ;               /* 添え字の型の大きさ         */

      if(lsp2) {
       if(lsp2->form <= subrange) {     /* 添え字の型がscalar,subrange*/
        if(lsp2 == realptr) {           /*  実数型                    */
         pcerr(109,"") ;                /*   ここでは実数型は駄目     */
         lsp2 = nil    ;
        }
       }
       else {                           /* 添え字の型がscalar,subrangeでない*/
        pcerr(113,"") ;                 /*  添え字の型はスカラ､範囲型 */
        lsp2 = nil    ;
       }
      }
      lsp->sf.ar.inxtype = lsp2 ;       /* 添え字の型を入れる         */

      if(test=(sy==comma)) insymbol() ; /* , なら次のsymbol           */
     } while(test) ;                    /* , ならば繰り返す           */

     if(sy == rbrack) insymbol()   ;    /* ]  なら次のsymbol          */
     else             pcerr(12,"") ;    /*  ] がない                  */
     if(sy == ofsy)   insymbol()   ;    /* of なら次のsymbol          */
     else             pcerr(8,"")  ;    /*  ofがない                  */

     *fileflag = typ(fsys,&lsp,&lsize); /* 要素の型の処理             */

     do {
      lsp2 = lsp1->sf.ar.aeltype   ;    /* 1つ前の添え字の型          */
      lsp1->sf.ar.aeltype = lsp    ;    /* 要素の型を入れる           */
      lsp1->assignflag=lsp->assignflag; /* 代入可能フラグを受け継ぐ   */
      if(lsp1->sf.ar.inxtype) {         /* 添え字の型がある時         */
       getbounds(lsp1->sf.ar.inxtype,&lmin,&lmax) ; /* 型の最小,最大値*/
       range = lmax - lmin + 1     ;    /* 1つの配列の大きさ          */
       lsize = align(lsp,lsize) ;       /* 要素の型のサイズ境界       */
       if(range &&
          ((range > (long)Maxaddr) ||
           ((long)lsize > (long)Maxaddr/range))) {
        pcerr(605,inttoch((long)Maxaddr));    /* 型の大きさ制限       */
        lsize = 0               ;       /* 以後同じエラーがでないよう */
       }
       lsize = lsize * (int)range    ;
       lsp1->size = lsize ;             /* その型までのサイズを入れる */
      }
      lsp  = lsp1 ;
      lsp1 = lsp2 ;
     } while(lsp1) ;

     lsp->size = ((lsize > 1) ? lsize : 1)  ;  /* 1以上のサイズの設定 */
     return(lsp) ;
}

/**************************************/
/* recordtype() : レコード型の処理    */
/**************************************/
static stp *recordtype(Set fsys,boolean packedflag,boolean *fileflag)
{
  int oldtop ;                          /* displayのtopを退避しておく */
  int disp1=0;                          /* レコード内相対番地         */
  stp *lsp   ;                          /* レコード型のポインタ       */
  stp *varp  ;                          /* 可変部の型 (ない時はnil)   */
  Set ws1    ;
  Set ws2    ;

     insymbol() ;
     oldtop = top ;                     /* displayのtopを退避         */
     if(top < Displimit) {              /*  最大ネスト数以下だったらOK*/
      top++ ;
      display[top].fname  = nil ;       /*  新しい水準のdisplayを初期化*/
      display[top].flabel = nil ;
      display[top].aname  = nil ;
      display[top].occur  = rec ;       /*  レコード内定義            */
     }
     else pcerr(603,inttoch((long)Displimit)) ;
                                        /* 名前の入れ子が深すぎる     */

     mkset(&ws1, endsy,-1) ;
     orset(&ws1, &fsys)    ;
     mkset(&ws2, semicolon,-1) ;        /* ws1 = fsys-[semicolon]     */
     dfset(&ws1, &ws2)     ;            /*           +[endsy]         */
     *fileflag = fieldlist(ws1,&varp,&disp1) ;
                                        /* フィールドの処理           */

     lsp = (stp*)Malloc(sizeof(stp)) ;  /* レコードの型エリアへの設定 */
     lsp->form = records ;
     lsp->size = disp1   ;              /* レコードの大きさ           */
     lsp->sf.re.packed = packedflag ;   /* packed指定有無             */
     lsp->sf.re.fstfld = display[top].fname ; /* 最初の欄のアドレス   */
     lsp->sf.re.recvar = varp ;         /* 可変部のアドレス(ない時はnil)*/

     top = oldtop ;                     /* displayの水準を戻す        */

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

     return(lsp) ;
}

/**************************************/
/* fieldlist() : レコードの欄の処理   */
/**************************************/
static boolean fieldlist(Set fsys,stp **frecvar,int *disp)
{
  ctp *lcp        ;
  ctp *nxt        ;
  ctp *nxt1 = nil ;
  stp *lsp  = nil ;
  int lsize       ;
  Set ws          ;
  Set ws2         ;
  boolean fileflag = false ;
  boolean test    ;

     mkset(&ws, ident, casesy, -1) ;
     orset(&ws, &fsys) ;
     if(! inset(ws,sy)) {               /* symbolがfsys,ident,caseでない*/
      pcerr(19,"") ;                    /*  欄の並びに誤りがある        */
      skip(ws)     ;                    /*  読み飛ばし                  */
     }

     while(sy == ident) {               /* 固定部の処理               */
      nxt = nxt1 ;
      do {
       if(sy == ident) {                /* 名前の時                   */
        lcp = mkctp(id,field,nil,nxt) ; /* 名前エリアをfield属性で確保*/
        enterid(lcp) ;
        nxt = lcp ;
        insymbol() ;                    /* 名前の次のsymbol           */
       }
       else pcerr(2,"") ;               /*  名前がない                */

       mkset(&ws, comma, colon, -1) ;
       if(! inset(ws,sy)) {             /* , : でない時               */
        pcerr(6,"")  ;                  /*  不当な記号が現れた        */
        addset(ws,semicolon) ;
        addset(ws,casesy)    ;
        orset(&ws, &fsys) ;
        skip(ws)     ;                  /* 読み飛ばし                 */
       }

       if(test=(sy==comma)) insymbol(); /* , ならば次のsymbol         */
      } while(test) ;                   /* , ならば繰り返す           */

      if(sy == colon) insymbol() ;      /* : ならば次のsymbol         */
      else pcerr(5,"") ;                /*  : がない                  */

      mkset(&ws, casesy,semicolon,-1) ;
      orset(&ws, &fsys)   ;
      fileflag |= typ(ws,&lsp,&lsize) ; /* 名前の型の処理             */

      while(nxt != nxt1) {              /* 名前の列に型を入れる       */
       nxt->idtype = lsp ;
       *disp = align(lsp,*disp) ;
       nxt->n.fldaddr = *disp   ;       /* レコード内の相対開始番地   */
       if(Maxaddr-lsize < *disp)        /* 大きすぎる                 */
        pcerr(605,inttoch((long)Maxaddr));   /* 型の大きさ制限        */
       else *disp += lsize    ;
       nxt = nxt->next   ;              /* 次の名前                   */
      }
      nxt1 = lcp  ;                     /* 次の型の名前の並びのために */

      mkset(&ws , ident,casesy,semicolon,-1) ;
      orset(&ws , &fsys) ;
      mkset(&ws2, ident,casesy,-1) ;
      orset(&ws2, &fsys) ;
      while(sy == semicolon) {
       insymbol() ;
       if(! inset(ws,sy)) {             /* symbolが名前,case,;でない時*/
        pcerr(19,"") ;                  /*  欄の並びに誤りがある      */
        skip(ws2) ;                     /*  読み飛ばし                */
       }
      }
     }

     if(sy == casesy)                   /* caseが現れたら             */
      fileflag |= varfield(fsys,frecvar,disp)  ;
                                        /*   可変フィールドの処理     */
     else  *frecvar = nil          ;    /* caseでなければ可変部はない */

     return(fileflag) ;
}

/**************************************/
/* varfield() : 可変フィールドの処理  */
/**************************************/
static boolean varfield(Set fsys,stp **frecvar,int *disp)
{
  stp *lsp,*lsptag;
  ctp *lcp=nil,*lcptag  ;
  Set ws ;
  char oldid[MaxIDlng+1] ;
  enum symbol oldsy ;

     lsp = (stp*)Malloc(sizeof(stp)) ;
     lsp->form = tagfld   ;             /* タグ欄用のエリア           */
     lsp->sf.tg.tagfieldp = nil ;
     lsp->sf.tg.tagtype   = nil ;
     lsp->sf.tg.fstvar    = nil ;
     *frecvar = lsp       ;             /* 可変部のタグ欄アドレス返却 */

     insymbol() ;
     if(sy == ident) {
      strcpy(oldid,id) ;
      oldsy = sy;
      insymbol() ;
      if(sy == colon) {
       lcp = mkctp(oldid,field,nil,nil) ; /* タグ名のエリア確保       */
       lcp->n.fldaddr = *disp ;
       enterid(lcp) ;
       insymbol()   ;
      }
      else if(sy == ofsy) {             /* ofの時(タグ欄省略)         */
       strcpy(id,oldid) ;
       sy = oldsy       ;               /* 前読んだ名前は型名         */
       oldsy = ofsy     ;
      }
      else  pcerr(5,"") ;               /*  : がない                  */
      if(sy == ident) {                 /* 型名 の 処理               */
       mkset(&ws, types, -1) ;
       lcptag = searchid(ws)   ;        /* 型名からサーチする         */
       applied(lcptag,level)   ;        /* 引用名チェーン             */
       lsptag = lcptag->idtype ;        /* 型名の型                   */
       if(lsptag) {                     /* 型がある場合               */
        *disp = align(lsptag,*disp) ;   /* 型に適応した割りつけ開始番地*/
        if(Maxaddr < *disp-lsptag->size)
         pcerr(605,inttoch((long)Maxaddr)); /* 型の大きさ制限         */
        if(lcp)                         /* タグ欄がある時は           */
         lcp->n.fldaddr = *disp    ;    /* タグ欄の変位を設定         */
        *disp += lsptag->size ;         /* 次の変位のためにサイズ分進める*/
                                        /* タグ欄がなくても場所は確保 */
        if((lsptag->form <= subrange ) &&
           (lsptag != realptr)) {       /* 順序型                     */
         if(lcp) lcp->idtype = lsptag ; /* タグの型アドレス           */
         lsp->sf.tg.tagfieldp     = lcp    ;
         lsp->sf.tg.tagtype       = lsptag ;
        }
        else pcerr(110,"") ;            /* タグの型は順序型以外は駄目 */
       }
       if(oldsy != ofsy) insymbol() ;   /* of を読む                  */
       else sy = oldsy ;                /* すでにofを読んでいる時     */
      }
      else pcerr(2,"") ;                /* 名前がない                 */
     }
     else {                             /* caseの次が名前でない場合   */
      pcerr(2,"") ;                     /*  名前がない                */
      mkset(&ws, ofsy, lparent, -1) ;
      orset(&ws, &fsys) ;
      skip(ws) ;                        /* 読み飛ばし                 */
     }

     lsp->size = *disp ;                /* タグ欄のまでの大きさ       */

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

     return(varelement(fsys,lsptag,&(lsp->sf.tg.fstvar),&disp));
                                        /* 可変要素の処理             */
}

/**************************************/
/* varelement() : 可変要素の処理      */
/**************************************/
static boolean varelement(Set fsys,stp *fsptag,stp **fsp,int **disp)
{
  stp *lspconst,*lspfield,*lspvar=nil ;
  stp *lsp1,*lsp2,*lsp4,*lsp5,*lsp6 ;
  union valu lvalu ;
  int minsize, maxsize ,ldisp ;
  long range ;                          /* タグ型の取りえる要素の合計 */
  long itemsu=0;                        /* 選択定数の指定数           */
  Set ws ;
  boolean fileflag = false ;
  boolean test ;
  boolean ok   ;

     range = (fsptag->form == subrange)
            ? fsptag->sf.su.max - fsptag->sf.su.min + 1  /* 範囲型の時*/
            : fsptag->sf.sc.fconst->n.values.ival+1 ;    /* 列挙型の時*/
     lsp1    = lsp4 = nil   ;
     maxsize = minsize = ldisp = **disp ;

     do {
      lsp2 = nil ;
      do {
       ok = false ;
       mkset(&ws, comma,colon,lparent,-1) ;
       orset(&ws, &fsys) ;
       constant(ws,&lspconst,&lvalu) ;  /* 選択定数                   */
       if(string(lspconst) || (lspconst==realptr)) /* 文字列､実数型   */
        pcerr(159,"") ;                 /* 文字列､実数型は指定不可    */
       else if(fsptag) {                /* タグ型がある時のみチェック */
        if(! compatible(fsptag,lspconst))
         pcerr(111,"")  ;               /* 見出しの型と一致していない */
        else {
         ok = true ;
         if(fsptag->form == subrange)   /* 部分範囲型の時             */
          if((lvalu.ival < fsptag->sf.su.min) ||  /* 最小値           */
             (lvalu.ival > fsptag->sf.su.max)) {  /* 最大値チェック   */
           pcerr(111,"") ;              /* 見出しの型と一致していない */
           ok = false ;
          }
         while(lsp4) {                /* 重複指定チェック           */
          if(lsp4->sf.vr.varval == lvalu.ival) {  /*    値が同じ      */
           pcerr(178,"") ;            /* 同じものが定義された       */
           ok = false ;
          }
          lsp4 = lsp4->sf.vr.nextvr ;
         }
        }
       }
       if(ok) {                         /* 選択定数が正しいものの時   */
        itemsu++ ;                      /*  定数の数を数える          */
        lspvar = (stp*)Malloc(sizeof(stp));
        lspvar->form         = variant    ;
        lspvar->sf.vr.nextvr = lsp1       ;
        lspvar->sf.vr.subvar = lsp2       ;
        lspvar->sf.vr.varval = lvalu.ival ;/* 選択定数の値             */
        lsp1 = lsp2 = lsp4 = lspvar ;
       }
       if(test=(sy==comma)) insymbol(); /* , ならば次の名札           */
      } while(test) ;
      if(sy == colon) insymbol() ;      /* : ならば次のsymbol         */
      else pcerr(5,"") ;                /*  : がない                  */
      if(sy == lparent) insymbol() ;    /* ( ならば次のsymbol         */
      else pcerr(9,"") ;                /*  ( がない                  */
      mkset(&ws, rparent,semicolon,-1);
      orset(&ws, &fsys) ;
      fileflag |= fieldlist(ws,&lspfield,&ldisp) ;
                                        /* フィールドの処理           */
      if(ldisp > maxsize) maxsize = ldisp ;
      lsp5 = lspvar                 ;
      while(lsp5) {
       lsp6 = lsp5->sf.vr.subvar     ;
       lsp5->sf.vr.subvar = lspfield ;
       lsp5->size         = ldisp    ;
       lsp5               = lsp6     ;
      }
      if(sy == rparent) {
       insymbol() ;
       ws = fsys ;
       addset(ws,semicolon) ;
       if(! inset(ws,sy)) {
        pcerr(6,"") ;                   /*  不当な記号が現れた        */
        skip(ws)    ;                   /*  fsys+[semicolon]まで読み飛ばし*/
       }
      }
      else pcerr(4,"") ;                /*  ) がない                  */
      if(sy == semicolon) {
       ldisp = minsize ;
       insymbol() ;
      }
     } while(! inset(fsys,sy)) ;        /* ; end fsys でなければループ*/

     if(itemsu != range) pcerr(179,"") ;/* タグ型で取りえるすべての選択定数
                                           が指定されていない              */
     *fsp   = lspvar  ;
     **disp = maxsize ;
     return(fileflag) ;
}

/**************************************/
/* settype() : 集合型の処理           */
/**************************************/
static stp *settype(Set fsys,boolean packedflag)
{
  stp *lsp, *lsp1 ;
  int lsize = 1 ;
  long lmin , lmax ;

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

     simpletype(fsys,&lsp1,&lsize) ;    /* 基底の型は単純型           */

     if(lsp1) {
      if((lsp1->form > subrange) ||     /* scalar,範囲型ではない      */
          (lsp1 == realptr)) {          /* 実数型                     */
       pcerr(115,"")  ;                 /*  基底の型が順序型でない　  */
       lsp1 = nil     ;
      }
      else {                            /* 列挙型､範囲型の時          */
       getbounds(lsp1,&lmin,&lmax) ;    /* 型の最小値､最大値を求める  */
       if((lmin < (long)setlow) ||
          ((long)sethigh < lmax))       /* 集合の要素数チェック       */
        pcerr(606,inttoch((long)sethigh)) ;/*  基底型の順序数範囲越え */
      }
     }

     lsp = (stp*)Malloc(sizeof(stp)) ;
     lsp->form = power       ;          /* 集合型                     */
     lsp->size = setsize     ;          /* 集合の大きさ               */
     lsp->sf.pw.packed= packedflag ;    /* packed指定有無             */
     lsp->sf.pw.elset = lsp1 ;          /* 要素の型                   */
     lsp->sf.pw.elmin = (int)lmin ;     /* 要素の最小値               */
     lsp->sf.pw.elmax = (int)lmax ;     /* 要素の最大値               */
     return(lsp)             ;
}

/**************************************/
/* filetype() : ファイル型の処理      */
/**************************************/
static stp *filetype(Set fsys,boolean packedflag)
{
   stp *lsp,*lsp1 ;
   int lsize ;
   boolean fileflag ;

     insymbol()    ;
     if(sy == ofsy) insymbol() ;
     else pcerr(8,"") ;                 /* of がない                  */
     fileflag = typ(fsys,&lsp1,&lsize) ;/* 基底の型の処理             */
     if(fileflag) pcerr(112,"") ;       /* 代入可能な型でない         */

     lsp = (stp*)Malloc(sizeof(stp)) ;
     lsp->form = files ;                /* ファイル型                 */
     lsp->size = lsp1->size ;           /* 基底の型の大きさ           */
     lsp->sf.fi.packed = packedflag ;   /* packed指定有無             */
     lsp->sf.fi.texttype = false    ;   /* file of 〜 は text型でない */
     lsp->sf.fi.filtype  = lsp1     ;   /* 基底の型                   */

     return(lsp) ;
}

/**************************************/
/* packedtype() : packed の処理       */
/**************************************/
static boolean packedtype(Set fsys)
{
  boolean packedflag ;                  /* packed 指定の時 true       */
  Set ws ;

     if(packedflag=(sy == packedsy)) {  /* packedの記述がある時       */
      insymbol() ;                      /* 次のsymbolを読む           */
      if(! inset(typedels,sy)) {        /*  array,record,set,file以外 */
       pcerr(10,"")  ;                  /*   型の記述に誤りがある     */
       ws = fsys ;
       orset(&ws,&typedels) ;
       skip(ws)  ;                      /* fsys+typedlesまで読み飛ばし*/
      }
     }
     return(packedflag) ;
}