/**********************************************************************
 *
 *              ***   HAPPy Pascal compiler ***
 *                    各種サブルーチン群
 *
 *      void skip(Set fsys)
 *      void updatelc(int upsize)
 *      void getbounds(stp *fsp,long *fmin, long *fmax)
 *      boolean equalbounds(stp *fsp1, stp *fsp2)
 *      int align(stp *fsp,int flc)
 *      void constant(Set fsys, stp **fsp, union valu *fvalu)
 *      boolean compatible(stp *fsp1,stp *fsp2)
 *      boolean assigncompati(stp *fsp1,stp *fsp2)
 *      boolean string(stp *fsp) ;
 *
 *                Copyright (c) H.Asano 1992,1994.
 *
 **********************************************************************/

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

typedef enum _sign {none, pos, neg } signflag ;

boolean string(stp*)       ;
static int alignquot(stp*) ;
static void conststrings(stp**, union valu*) ;
static void constident(signflag,stp**, union valu*) ;
extern void pcerr(int,char*) ;
extern void insymbol(void) ;
extern ctp  *searchid(Set) ;
extern Set  *mkset(Set*,int,...) ;
extern Set  *orset(Set*,Set*)    ;
extern void term(void) ;
extern void *Malloc(int) ;
extern void applied(ctp*,int) ;


/**************************************/
/* skip() : 誤り回復のためにsymbolを  */
/*          キーにして読み飛ばす      */
/**************************************/
void skip(Set fsys)
{
     while(! inset(fsys,sy))
      insymbol() ;
}

/**************************************/
/* updatelc() : location counter更新  */
/**************************************/
void updatelc(int upsize)
{
       if(Maxaddr-upsize < lc)
        pcerr(609,"") ;                 /* 変数割当できない           */
       else lc += upsize ;              /* lc を更新                  */
}

/*******************************************************/
/* getbounds() : 範囲型,文字型,整数型､集合型,列挙型の  */
/*               下限､上限値を求める                   */
/*  (* assume fsp<>intptr and fsp<>realptr *)          */
/*******************************************************/
void getbounds(stp *fsp,long *fmin, long *fmax)
{
     if(!fsp) return ;

     if(fsp == charptr) {               /* 文字型                     */
      *fmin = ordminchar          ;     /*   一番小さい文字コード     */
      *fmax = ordmaxchar          ;     /*   一番大きい文字コード     */
     }
     else if(fsp == intptr) {           /* 整数型                     */
      *fmin = -Maxint ;                 /*   -Maxint .. Maxint        */
      *fmax =  Maxint ;
     }
     else if(fsp->form == subrange) {   /* 範囲型                     */
      *fmin = fsp->sf.su.min      ;     /*  下限                      */
      *fmax = fsp->sf.su.max      ;     /*  上限                      */
     }
     else if(fsp->form == power) {      /* 集合型                     */
      *fmin = fsp->sf.pw.elmin   ;      /* 下限                       */
      *fmax = fsp->sf.pw.elmax   ;      /* 上限                       */
     }
     else if(fsp->sf.sc.fconst) {       /* 列挙型の時                 */
      *fmax = fsp->sf.sc.fconst->n.values.ival ; /* 最後の列挙名の値  */
      *fmin = 0 ;
     }
}

/****************************************/
/* equalbounds() : 2つの型の上限､下限が */
/*                 等しいか判定する     */
/****************************************/
boolean equalbounds(stp *fsp1, stp *fsp2)
{
  long lmin1,lmin2,lmax1,lmax2 ;

     if((!fsp1) || (!fsp2)) return(true) ;  /* 今のところ意味不明     */

     getbounds(fsp1,&lmin1,&lmax1) ;    /* fsp1 の下限､上限を調べる   */
     getbounds(fsp2,&lmin2,&lmax2) ;    /* fsp2 の下限､上限を調べる   */
     return((lmin1==lmin2) && (lmax1==lmax2)) ;/* 両方とも等しいとき真*/
}

/************************************************/
/* align() : 型に応じた割りつけ開始番地を求める */
/*            flc    : 今の番地                 */
/*            return : 割りつけ開始番地         */
/************************************************/
int align(stp *fsp,int flc)
{
  int k, l;

     k = alignquot(fsp) ;               /* その型の境界値を求める     */
     l = flc - 1 + k    ;               /* flc以上の最小のkの公倍数を */
     return(l - l%k)    ;               /* 返却する                   */
}

/**************************************/
/* alignquot() : 型の境界を求める     */
/*     align の 内部関数              */
/**************************************/
static int alignquot(stp *fsp)
{
     if(!fsp) return(1) ;               /* 型ポインタがない時は1      */

     switch(fsp->form) {
      case scalar   :                   /* スカラー型    */
             if(fsp==intptr)  return(intal)  ;           /* integer型     */
             if(fsp==boolptr) return(boolal) ;           /* boolean型     */
             if(fsp==charptr) return(charal) ;           /* char   型     */
             if(fsp==realptr) return(realal) ;           /* real   型     */
             if(fsp->sf.sc.scalkind == declared)         /* 列挙   型     */
                              return(intal)  ;
             return(parmal) ;                            /* parameter list*/
      case subrange :                   /* 範囲型        */
             return(alignquot(fsp->sf.su.rangetype)) ;   /* 範囲の元の型  */
      case pointer  :                   /* ポインタ型    */
             return(adral)  ;
      case power    :                   /* 集合型        */
             return(setal)  ;
      case files    :                   /* ファイル型    */
             return(fileal) ;
      case arrays   :                   /* 配列型        */
             return(alignquot(fsp->sf.ar.aeltype)) ;
                                        /* 要素の型      */
      case records  :                   /* レコード      */
             return(recal)  ;
/*    case variant  : */                /* 可変レコード  */
/*    case tagfld   : */                /* 可変レコードのタグ名 */
                                        /* このルートはない     */
     }
}

/*********************************************/
/*     constant() : 定数の処理               */
/*********************************************/
void constant(Set fsys, stp **fsp, union valu *fvalu)
{
  stp *lsp ;
  signflag sign ;
  Set ws ;

     lsp = nil ;
     (*fvalu).ival = 0 ;

     if(! inset(constbegsys,sy)) {    /* 定数として許されない時  */
      pcerr(50,"") ;                  /*  定数に誤りがある       */
      ws = fsys                 ;
      orset(&ws,&constbegsys)   ;
      skip(ws)                  ;     /* fsys+constbegsysまでskip*/
     }

     if(inset(constbegsys,sy)) {      /* 定数としてOKの時        */
      if(sy == stringconst)           /*   文字列定数の時        */
       conststrings(fsp,fvalu)  ;     /*   文字列定数の処理      */
      else {
     /***  文字列以外の時は まず符号(+ -)の処理をする ***/

       sign = none ;
       if((op == plus) || (op == minus)) {  /* + - の 時          */
        sign = (op == plus) ? pos : neg ;   /*  符号の選別        */
        insymbol() ;
       }

       if(sy == ident)                  /* 名前の時                   */
        constident(sign,fsp,fvalu) ;    /* 名前定数の処理             */

       else if(sy == intconst) {        /* 整数定数の時               */

        if(sign == neg) val.ival = -val.ival ; /* -の時は値を反転 */
        *fsp   = intptr     ;
        *fvalu = val        ;
        insymbol()          ;
       }

       else if(sy == realconst) {       /* 実数定数の時               */
        if(sign == neg)
        *(val.valp->c.rval) = '-' ;     /*  頭に負の符号をつける      */
        *fsp = realptr      ;
        *fvalu = val        ;
        insymbol()          ;
       }

       else {                           /* それ以外                   */
        pcerr(106,"") ;                 /* 数がない                   */
        skip(fsys)    ;
       }
      }
     }

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

/***************************************/
/* conststrings():  文字列定数の処理   */
/***************************************/
static void conststrings(stp **fsp, union valu *fvalu)
{
  stp *lsp,*lsp1 ;

     if(lgth == 1)      lsp = charptr ; /*   1文字は文字型            */
     else if(lgth == 0) lsp = nil ;     /*   0文字はエラー            */
     else {
      lsp = (stp*)Malloc(sizeof(stp));
      lsp->size = lgth*charsize ;       /* 文字列長                   */
      lsp->form = arrays ;              /* 配列型                     */
      lsp->sf.ar.packed  = true    ;    /* 詰め込み型である           */
      lsp->sf.ar.aeltype = charptr ;    /*  要素の型は文字型          */
      lsp1 = (stp*)Malloc(sizeof(stp)) ;/*  添字の型は                */
      lsp1->form = subrange          ;  /*        範囲型              */
      lsp1->size = intsize           ;
      lsp1->sf.su.rangetype = intptr ;
      lsp1->sf.su.min = 1            ;  /*  添字の下限値は1           */
      lsp1->sf.su.max = (long)lgth   ;  /*  添字の上限値は文字列長    */
      lsp->sf.ar.inxtype = lsp1      ;  /*  添字の型をこの範囲型とする*/
     }
     *fvalu = val ;                     /*  文字列を返却              */
     *fsp   = lsp ;
     insymbol()   ;
}

/***************************************/
/* constident():  名前定数の処理       */
/***************************************/
static void constident(signflag fsign,stp **fsp, union valu *fvalu)
{
  stp *lsp ;
  ctp *lcp ;
  csp *lvp ;
  Set ws ;

     mkset(&ws, konst, -1)   ;
     lcp = searchid(ws)      ;          /* 定数の名前から探す         */
     applied(lcp,level)      ;          /* 参照名チェーン             */
     lsp = lcp->idtype       ;
     *fvalu = lcp->n.values  ;          /* 名前の値                   */
     if(fsign != none) {                /* 符号がある時               */
      if(lsp == intptr) {               /*  整数                      */
       if(fsign == neg)
        (*fvalu).ival = -(*fvalu).ival; /*  値を反転                  */
      }
      else if(lsp == realptr) {         /*  実数                      */
       if(fsign == neg) {
        lvp = (csp*)Malloc(sizeof(csp));
        lvp->cclass = real ;
        lvp->c.rval = (char*)Malloc(Maxdiglng+1+1);
        *(lvp->c.rval) = ((*(*fvalu).valp->c.rval)=='-')/*  - * - = + */
                          ? (char)' ' : (char)'-'  ;    /*  + * - = - */
        strcpy(lvp->c.rval+1,
              (*fvalu).valp->c.rval+1); /*  中身を移しかえ            */
        (*fvalu).valp = lvp ;
       }
      }
      else   pcerr(105,lcp->name) ;     /*  整数や実数でないのに      */
                                        /*  符号があるので、符号は駄目*/
                                        /*  のエラーメッセージ        */
     }
     *fsp   = lsp ;
     insymbol()   ;
}

/********************************************/
/* compatible() : 2つの型が適合するか判定   */
/********************************************/
boolean compatible(stp *fsp1,stp *fsp2)
{

     if(fsp1 == fsp2) return(true) ;    /* 型のアドレスが同じなら等しい*/

     if((!fsp1) || (!fsp2)) return(true);
                                        /* どちらかがnilならば､すでに
                                          エラーメッセージが出ている
                                          はずなので、ここでさらに
                                          エラーを検出させないためtrue*/

     if(fsp1->form == fsp2->form)       /* 型が等しい                 */
      switch(fsp1->form) {
       case subrange : return           /* 部分範囲型                 */
                      (fsp1->sf.su.rangetype == fsp2->sf.su.rangetype);
                                        /*   両方が 同じ型            */

       case power    :                  /* 集合型                     */
                      if((fsp1->sf.pw.packed == both) ||
                         (fsp2->sf.pw.packed == both))
                        return(compatible(fsp1->sf.pw.elset, /*基底の型*/
                                          fsp2->sf.pw.elset )) ;/*のD適合*/
                      else return
                      (!(fsp1->sf.pw.packed ^ fsp2->sf.pw.packed) &&
                                        /* 両方とも詰めなしか詰めあり */
                       compatible(fsp1->sf.pw.elset,     /* 基底の型が*/
                                  fsp2->sf.pw.elset )) ; /* 適合      */

       case pointer :  return           /* ポインタ型                 */
                      ((fsp1 == nilptr) || (fsp2 == nilptr)) ;
                                        /*   nilは全てのﾎﾟｲﾝﾀ型と適合 */

       case arrays  :  return           /* 配列型                     */
                      (string(fsp1) && string(fsp2) &&
                        (fsp1->sf.ar.inxtype->sf.su.max ==
                         fsp2->sf.ar.inxtype->sf.su.max));
                                         /* 同数の成分を持つ文字列型の
                                            時は適合する              */

       default       : return(false)  ; /* それ以外の型は不適合       */
      }

     else if(fsp1->form == subrange)    /* fsp1がfsp2の部分範囲か     */
      return (fsp1->sf.su.rangetype == fsp2) ;
     else if(fsp2->form == subrange)    /* fsp2がfsp1の部分範囲か     */
      return (fsp1 == fsp2->sf.su.rangetype) ;
     else return(false) ;
}

/***************************************************/
/* assigncompati() : 2つの型の代入可能性を判定する */
/*           型fsp1に対して型fsp2が代入可能の時真  */
/***************************************************/
boolean assigncompati(stp *fsp1,stp *fsp2)
{
     if(fsp1 == fsp2)                   /* 同じ型                     */
      return(fsp1->assignflag) ;        /* 代入可能性のチェック       */
     else if((fsp1 == realptr) && compatible(fsp2,intptr)) return(true) ;
     else return(compatible(fsp1,fsp2)) ;
}

/**************************************/
/* string() : 型が文字列か判定する    */
/**************************************/
boolean string(stp *fsp)
{
     if(!fsp) return(false) ;

     return
        ((fsp->form == arrays)                       /* 配列型         */
     && (fsp->sf.ar.packed)                         /* packed指定あり */
     && (compatible(fsp->sf.ar.aeltype,charptr))    /* 要素の型が文字型*/
     && (fsp->sf.ar.inxtype->form == subrange)      /* 添字の型は範囲 */
     && (fsp->sf.ar.inxtype->sf.su.min == 1)        /* 下限値は1      */
     && (fsp->sf.ar.inxtype->sf.su.max >  1 )) ;    /* 上限値は2以上  */
                                        /* その時 文字列と認められる  */
                                        /* 上記以外は文字列ではない   */
}