//#include "Unix.h"
#include "stdafx.h"   //MS Windows
#include "Strawberry.h"

#include "StrawberryDoc.h"

BYTE key_map[256]={
        130,128,128,128,128,128,128,128,128,129,129,128,128,130,128,128,
        128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,128,
        129, 80,138, 66, 68,140, 70,137,131,132, 71, 72, 82, 73, 67, 74,// 134
          0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 75, 81, 77, 78, 79, 65,
         76, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
         25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35,135, 63,136, 64, 36,
        139, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51,
         52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62,133, 83,134, 69,128,
         36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36,
         36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36,
         36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36,
         36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36, 36,
         10, 84, 11, 85, 86, 14, 87, 88, 89, 90, 20, 91, 22, 17, 24, 92,
         25, 12, 29, 34, 93, 33, 94, 95, 96, 97, 98, 98, 98, 99,100,101,
         37,102,103,104,105, 41,106,107, 57,108, 47,109,110,111, 51, 50,
         52, 39, 49, 61,112, 60,113,114,115,116,117,118,119,120,121,122};

BYTE key_oposit[126];
                  /* temporal */
DWORD  gl_read;            
                  /* others */
DWORD  MEMORY_C=4096, MEMORY_c256=4096+TT_START, MEMORY_V=3072, MEMORY_S=4096, MEMORY_STemp=2048;
DWORD  MEMORY_tr=8192, BLOCKS=2048, PROGRAM_L=1016, PROGRAM_F=6144-8;
DWORD  DEF_F=1024-NUMB_FLAGS, FUNC_F=2048, READY_LISTS=16;
DWORD  FUNCTOR_L=256, NEW_OBJ=2048-8, SALAM=256, EKLER=2040, OBJ_STORE=512, STRING_STORE=8192;

DWORD  STACK2, BUDA3, BUDA_S2; // limits are saved in registry
int    BUDA3_UP=4096;

// MEMORY_C     /* close terms */
// MEMORY_c256  /* close terms + TT_START */
// MEMORY_V     /* open terms */
// MEMORY_S     /* substitutions */
// MEMORY_St    /* substitutions - temporal*/
// MEMORY_tr    /* tree elements on the main tree */
// BLOCKS       /* Blocks */
// PROGRAM_L    /* number of clauses */
// PROGRAM_F    
// NEW_OBJ      
// SALAM        /* back tr. in the unification */
// EKLER        /* pointers to back tr. branches */

// WIN_STORE    /* 6*windows */
// STRING_STORE 

DWORD  ch_set=2, default_char='?';
DWORD c_black, c_red, c_green, c_blue, c_violet, c_output;
char string[L_BUFER+2], string2[L_BUFER+2];    // string2 must be big
BYTE MyCallback1[2*BUFFERS]; // because of multytreading
DWORD  status_fl=0, f_end, len, Trace=0, main_h1;
DWORD  Definition[DEFINITIONS], ret_fl, Wait=0, Wait_d=0, ObjectStore_br=0;

// m_Settings  * Prolongated Stack,
//               Active Break Point,
//               Stack is Full as Fail
//               Fix first random number
//16           * Use Default Font,
//             * Use Default Memory
//               Add the source code,
//             * --- Free
//256            Don't recompile on run
//               Not working with the Light edition
//               Don't edit this project
//               Execute the EXE file on run
//0x1000          system use llike flag in do you like to change question
//               Add the Standard.add file

//0x10000        Use # instead of ?
//0x7e0000       Car Set
//0x7f800000     Font of the Project
//********* HALF impossible byte
 
// Environment * Filter==1 (Open File) 
//               Next is Always Active,
//16             One Step is Always Active,
//               Execute Only Projects,
//             * Toolbar,
//             * Statusbar,
//256            Automatic Word Selection
//             * Splash on Start
//               Big Tool Bar
//                used in the past - Sizable Bitmaps 
//0x1000         Proof Tree Always at the Top
//            i* Automatic scroll in Proof Tree,
//             * Remember the last file when exit
//             * Flat Toolbar
//0x10000      * Syntax Coloring 
//               Syntax Coloring on Every Text Change
//               Syntax Coloring only when Enter (change with EveryTxtChenge if PROF)
//               Save Mode
//0x7f800000     InfoFont
//********* HALF impossible byte
 
// status_fl   - Can do Next,
//                 Runing,
//               Waiting,
//                 Trace wait
//16             Painting in Proof Tree
//               Making a retract
//               Run Directly
//               Registered
//256            Called from EXE file (Temp)
//               Called from EXE file


#if 1
MY_HANDLE hOper, hOpPr, hOpType, hOpMin, Hbuf_sub, hArray, hArType, hArPos, hAddInfo; 
MY_HANDLE Hatom_buf, Hvar_field, hReadStack, hLeft, hRight, Hbuf1, Hbuf2;
MY_HANDLE Hbufu1, Hbufu2, Hbufu3, Hbufu4, Hbufu5, Hbufu6, Hbufu7, Hst_buf;
MY_HANDLE Hbuf_3, Hbuf_4, Hbuf_5, Hbuf_6, Hbuf_7, Hbuf_8, Hlist, Hglobal, Hglobal2, Hst_buf_num;
#endif
                  /* Operators */
DWORD  oper_br=0, *Oper, *OpPr, *OpType, *OpMin; 

                  /* buffers - CREATE */
DWORD  br_buf2=0, *bufu1, *bufu2, *bufu3, *bufu4; 
DWORD  *bufu5, *bufu6, *bufu7, *st_buf;    // bufu6 is in WRITE

                  /* buffers - READ */
DWORD  i_poin, bufu[BUFFERS], *buf_sub, *Array, *ArType, *ArPos, *AddInfo;
DWORD  read_br, newline_br, error=1, warn_br=0;
BYTE   *atom_buf, *var_field;
DWORD  *ReadStack, *Left, *Right, *buf1, *buf2;

                  /* buffers - CALL */
DWORD  term_1, term_2, buda_br, a1=0, br_buf1=0, RedLine=0;
DWORD  *buf_3, *buf_4, *buf_5, *buf_6, *buf_7, *buf_8;
int    buda_br_up=0; 
                  /* CREATE */
DWORD  sv_c=0, sv_v=1, sv_tr=1, sv_sub=0, sv_subv=0;
DWORD  sv_c_old, sv_v_old, sv_sub_old;
DWORD  sv_subT=0, sv_StStore=512, sv_NewObj=0, sv_blocks=1024, sv_blocks2=0;
DWORD  *list, list_br, *global, *global2, global_br=0, global_br2=0, GLOBAL_max=128;
DWORD  p1, StepOver, tt, tt_sub, *st_buf_num;

                  /* MAIN ARRAYS */
#if 1
MY_HANDLE  hTemp, hFunctors, hProgram, hProg_Obj, hAtoms, hProg_fild, hD_field, hF_field, hReadyLists;
MY_HANDLE  hDurty, hStack, hBuda1, hNewObj, hProgram2, hProgTail, hPointers;
MY_HANDLE  hBuda2, hLink, hUfil_c1, hUfil_c2, hUfil_vs, hBlocks, hBlocks_val, hBlocks_next;
MY_HANDLE  hChfil_c, hChfil_v, hSubsti, hSubstiT, hCh_tree;
MY_HANDLE  hStringStore, hNewObj1, hNewObj2, hObjectStore, hMtree, hSalam, hEkler;
#endif
DWORD *Functors, *Program, *Program2, *ProgTail, *Pointers;
DWORD *Prog_Obj, *Atoms, *Prog_fild, *D_field, *F_field, *ReadyLists;
DWORD *Ufil_c1, *Ufil_c2, *Ufil_vs;
DWORD *Buda1, *Buda2, *NewObj, *Stack, *Link; 
DWORD *Blocks, *Salam, *Ekler, *Durty, *ObjectStore;
WORD *Blocks_val, *Blocks_next, *Ch_tree, *Chfil_v, *Substi, *SubstiT, *NewObj2; 
BYTE *Chfil_c, *NewObj1, *StringStore;
unsigned4 *Mtree;

DWORD p_fild_br, df_min_p, df_pointer, ff_pointer, program_br1, program_br2, program_br;
DWORD ekler_br, stack_br=0, lSteps_br, Corection, my_gl, my_gl2, func_br, func_in_ADD;
WORD  Steps_br;

/* global variables used in this module or among more than one module */
#if !CONSOLE
HMENU MainMenu=NULL;
HPEN hPen, hSavePen, hMyRedPen, hMyBluePen;
HBRUSH hbrGreen, hbrGrey, hBrush, hSaveBrush;
HFONT hFont, hSaveFont;
CFont InfoFont;
CHARFORMAT cf_blue, cf_red, cf_black, cf_green, *pFontMask;
DWORD  synt_color[LAST_COLOR+1];
SIZE Screen;
CString ProgramPath; 
CString TempStr, TempStr2;

CString RegName, RegFrom, RegProdID, RegPassword;
#endif

// Proof Tree
DWORD open_br=0, open_start, j_start, k_old;

//system lists and containers
DWORD the_free_list, the_free_container;
// system / window / button or icon or ...

// system / file / text or bynary or ...

// system / list / int or str or ...
// Type, Name, Current Size, Pointer, Real Size, Handel

void compile(int flag) // &4 compile only the Def and Add files
{
  DWORD i, j, t, k, h1, h2;
  DWORD AddedFiles[32];
  CString str;

#if TR
  if (status_fl&2)
    MitiText("Conflict!\r\n", &cf_red);
#endif
  while(status_fl&2);
  if (flag!=4)
  {
#if TR
    if (status_fl&16)
      MitiText("Conflict!\r\n", &cf_red);
#endif
    while(status_fl&16);
  }    
  // close_all_objects
  for (k=0; k<ObjectStore_br; )
  {
    k+=ObjectStore[ObjectStore[k]+2]?ObjectStore[ObjectStore[k]+2]:
      (ObjectStore[k]?ObjectStore[k+2]:ObjectStore[k+1]);
    if (ObjectStore[k]!=0 && k<ObjectStore_br)
      close_object(k);
  }
  for (i=global_br; i<global_br2; j=global2[i++], Link[j]=j); // repair the negative Link
  
  func_br=open_br=0;
  Link[0]=Stack[3]=Stack[4]=0;  // corekting a error
  error=warn_br=p_fild_br=ff_pointer=0;
  Program2[0]=0; Ufil_vs[0]=M1; Ufil_c1[MEMORY_C]=0;                                               
  pInfo2->m_Settings&=M1^4;
#if !CONSOLE
  G_rectPaint.SetRect(0, 0, 0, 0);
  G_FlagsMes=0;
  if (gl_open&4)
  {
    ch_set=(gl_open&0x7e0000)/0x20000;
    default_char=(gl_open&0x10000)?'#':'?';
  }
  else
  {
    ch_set=(pInfo2->m_Settings&0x7e0000)/0x20000;
    default_char=(pInfo2->m_Settings&0x10000)?'#':'?';
  }
#endif
  df_min_p=df_pointer=NUMB_FLAGS-1;
  for (i=DEF_F+NUMB_FLAGS; i; D_field[--i]=M1);
  for (i=MEMORY_c256+MEMORY_V; i; Pointers[--i]=0);
  if (flag&2)
  {
    //MessageBoxA(NULL, "Version 1.6 cannot execute EXE files.", "Error", MB_OK | MB_ICONSTOP);
    //error=1;;
    for (i=0; i<oper_br; i++)
    {
      if (i==0 || Oper[i]!=Oper[i-1])
        put_in_f(i, Oper[i], 7, OBSEG6);
    }
    for (ReadyLists[0]=TT_LIST, i=1; i<READY_LISTS; ReadyLists[i]=creat_p(2, TT_VAR, ReadyLists[i-1], M1 ,1), i++); // twice
    goto P2;
  }
  // Mtree[0][0] is used as a black hole
  Mtree[0][1]=Mtree[0][2]=Mtree[0][3]=MASKA; // make agein
  br_buf1=sv_blocks2=0; sv_blocks=1024;
  for (i=BLOCKS+TT_START+MAX_VARS; i; Blocks_val[--i]=SM1); // clean blocks
  sv_tr=1;

  sv_StStore=512;   // loaded from exe
  sv_v=1;
  sv_c=sv_sub=sv_NewObj=global_br=global_br2=0;
  oper_br=program_br=program_br1=program_br2=0;
  for (ReadyLists[0]=TT_LIST, i=1; i<READY_LISTS; ReadyLists[i]=creat_p(2, TT_VAR, ReadyLists[i-1], M1 ,1), i++);

#if CONSOLE
  strcpy(string2, ProgramPath);
  strcat(string2, "Standard.def");
  if ((file=open(string2, O_RDONLY | O_TEXT))==-1)  // Standard Terms
  {
    MitiText("\r\nUnable to open Standard.def!\r\n");
    error++;
    goto e1;  
  }
  lseek(file,0,SEEK_SET);
  f_end=read(file, string, L_BUFER);
#else
  if (!(flag&4))
  {
    my_sprintf(string3, _T("\r\nCompiling the file:\r\n%s\r\n"), namef);
    MitiText(make_utf8(string3));
  }
  if (pInfo2->m_DefFile=="Standard.def" || pInfo2->m_DefFile=="")
    str=ProgramPath + _T("Standard.def");
  else
    str=pInfo2->m_DefFile;
  if (file.Open(str, CFile::modeRead)==0)  // Standard Terms
  {
    if (!(flag&4))
    {
      MitiText("\r\nUnable to open the DEF file:\r\n", &cf_red);
      MitiText(make_utf8(str));
      MitiText("\r\n");
    }
    error++;
    goto e1;  
  }
  file.SeekToBegin();
  f_end=file.Read(string, L_BUFER);
#endif
  i_poin=read_br=newline_br=0;
  string[f_end]=0;
  i=0;
  while(i<DEFINITIONS && f_end && f_end!=M1)
  {
    if (read_n(&t, 9))
      Definition[i++]=t;
  }
#if CONSOLE
  close(file);
  h1=h2=2;
#else
  file.Close();
  h1=h2=pInfo2->m_FilesList.GetSize()+2;
#endif
  if (i<DEFINITIONS)
  {
      MitiText("\r\nError: The Standard.def is corrupt!\r\n", &cf_red);
      error++;
      goto e1;  
  }

  sv_NewObj=0;
  for (j=0; j<h2; j++)
  {
#if CONSOLE
    if (j==0)
    {
      strcpy(string2, ProgramPath);
      strcat(string2, "Standard.add");
      if ((file=open(string2, O_RDONLY | O_TEXT))==-1)  // Addition to the File
      {
        MitiText("\r\nUnable to open Standard.add!\r\n");
        error++;
        goto e1;  
      }
    }
    else if (j==1)
    {
      if (flag&4)
      {
        error++;
        pCompiled=pActive;
        return;
      }
      program_br1=program_br;
      program_br2=program_br=program_br1+300;
      Program2[program_br2]=0;
      if ((file=open(namef, O_RDONLY | O_TEXT))==-1)  // Addition to the File
      {
        MitiText("\r\nUnable to open the main file!\r\n");
        error++;
        goto e1;  
      }
    }
    else
    {
      if ((file=open((LPSTR)(StringStore+AddedFiles[j-h1]), O_RDONLY | O_TEXT))==-1)  // Definitions
      {
        MitiText("\r\nUnable to open the include file:\r\n");
        MitiText((LPSTR)(StringStore+AddedFiles[j-h1]));
        MitiText("\r\n");
        error++;
        goto e1;  
      }
    }
    lseek(file,0,SEEK_SET);
    f_end=read(file, string, L_BUFER);
#else
    if (j==0)
    {
      if (pInfo2->m_AddFile=="Standard.add" || pInfo2->m_AddFile=="")
        str=ProgramPath + _T("Standard.add");
      else
        str=pInfo2->m_AddFile;
      if (file.Open(str, CFile::modeRead)==0)  // Addition to the File
      {
        if (!(flag&4))
        {
          MitiText("\r\nUnable to open the ADD file:\r\n", &cf_red);
          MitiText(make_utf8(str));
          MitiText("\r\n");
        }
        error++;
        goto e1;  
      }
      file.SeekToBegin();
    }
    else if (j==1)
    {
      sv_c_old=sv_c; sv_v_old=sv_v; sv_sub_old=sv_sub;
      if (flag&4)
      {
        pCompiled=pActive;
        return;
      }
      RedLine=global_br2;
      program_br1=program_br;
      program_br2=program_br=program_br1+300;
      Program2[program_br2]=0;
      if (file.Open(namef, CFile::modeRead)==0)   // Main Program
      {
        sprintf((LPSTR)string2, "\r\nUnable to open the main file:\r\n%s\r\n", namef);
        MitiText((LPSTR)string2, &cf_red);
        error++;
        goto e1;  
      }
      if (pInfo2!=&DefaultProject)
      {
        if (status_fl&64) // Run Directly
        {
          BYTE ch_warn, ch_ver, num_int, num_str;
          DWORD Head;
          CArchive ar(&file, CArchive::load);

          ar>>ch_warn;
          ar>>ch_ver;
          if (ch_ver==1)
          {
            num_int=14;
            num_str=1;
          }
          else if (ch_ver==2)
          {
            if (ch_warn>1)
              MessageBoxA(NUL,
                "Warning: This project file is made on a newer version of Strawberry Prolog.\r\n",
                   "Strawberry Prolog 2.92", MB_OK | MB_ICONEXCLAMATION);
            ar>>num_int;
            ar>>num_str;
          }
          else if (ch_ver>2)
          {
            MessageBoxA(NUL,
               "Error: This project file cannot be open. It is made on a newer version of Strawberry Prolog.\r\n\r\n",
                   "Strawberry Prolog 2.92", MB_OK | MB_ICONSTOP);
            ar.Close();
            file.Close();
            error=1;
            return;
          }
          ar>>pInfo2->m_Settings;
          pInfo2->m_Settings&=M1^6; // Active Break Point and St. is full as fail
          ar>>pInfo2->m_Break_point;
          ar>>pInfo2->m_Colors;
          ar>>pInfo2->STACK_start;
          ar>>pInfo2->BUDA_start;
          ar>>pInfo2->BUDA_S_start;
          ar>>pInfo2->STACK_max;
          ar>>pInfo2->BUDA_max;
          ar>>pInfo2->BUDA_S_max;
          ar>>pInfo2->m_lf.lfHeight;
          ar>>pInfo2->m_lf.lfWidth;
          ar>>pInfo2->m_lf.lfEscapement;
          ar>>pInfo2->m_lf.lfOrientation;
          ar>>pInfo2->m_lf.lfWeight;
          for (int t_num; num_int>14; ar>>t_num, num_int--);
          { // for st
           CString st;
           ar>>st;
           my_strcpy(pInfo2->m_lf.lfFaceName, st);
          }
          if (ch_ver==2)
          {
            ar>>pInfo2->m_AddFile;
            ar>>pInfo2->m_DefFile;
            ar>>pInfo2->m_ExeFileName;
            ar>>pInfo2->m_Comments;
            if (num_str>5)
            {
              ar>>pInfo2->m_GetMethod;
              ar>>pInfo2->m_PostMethod;
              ar>>pInfo2->m_ProgArg;
            }
            else
            {
              pInfo2->m_GetMethod="new";
              pInfo2->m_PostMethod="new";
              pInfo2->m_ProgArg="";
            }
            CString st;
            for ( ; num_str-->8; ar>>st);
            for (ar>>i; i-->0; ar>>st, pInfo2->m_FilesList.Add(st) );
            for (i=0; i<744; ar>>pInfo2->m_Icon[i++]);
          }
          { // for fp
           ar.Flush();
           CFile* fp = ar.GetFile();
           Head=(DWORD)fp->GetPosition();
          }
          ar.Close();
          if (pInfo2->STACK_start<8)
            pInfo2->STACK_start=8;
          if (pInfo2->BUDA_start<MAX_VARS+2048)
            pInfo2->BUDA_start=MAX_VARS+2048;
          if (pInfo2->BUDA_S_start<MAX_VARS)
            pInfo2->BUDA_S_start=MAX_VARS;
          file.Seek(Head, CFile::begin);
        }
        else
          file.Seek(pActive->m_Head, CFile::begin);
      }
      else
        file.SeekToBegin();
    }
    else if (j<h1)
    {
      if (file.Open(pInfo2->m_FilesList[j-2], CFile::modeRead)==0)  // Definitions
      {
        MitiText("\r\nUnable to open the project file:\r\n", &cf_red);
        MitiText(make_utf8(pInfo2->m_FilesList[j-2]));
        MitiText("\r\n");
        error++;
        goto e1;  
      }
      else
        MitiText("Compiling the file:\r\n");
      MitiText(make_utf8(pInfo2->m_FilesList[j-2]));
      MitiText("\r\n");
      file.SeekToBegin();
    }
    else
    {
      if (file.Open(make_long(StringStore+AddedFiles[j-h1]), CFile::modeRead)==0)  // Definitions
      {
        MitiText("\r\nUnable to open the include file:\r\n", &cf_red);
        ChangeCharset(ch_set, 0, StringStore+AddedFiles[j-h1], (BYTE *)string2, &k, default_char);
        MitiText(string2);
        MitiText("\r\n");
        error++;
        goto e1;  
      }
      else
      {
        MitiText("Compiling the file:\r\n");
        ChangeCharset(ch_set, 0, StringStore+AddedFiles[j-h1], (BYTE *)string2, &k, default_char);
        MitiText(string2);
        MitiText("\r\n");
      }
      file.SeekToBegin();
    }
    f_end=file.Read(string, L_BUFER);
#endif
    i_poin=read_br=newline_br=0;
    string[f_end]=0;
    if (string[0]=='#' && string[1]=='!')
    {
      while(string[i_poin++]!='\n' && string[i_poin]);
      newline_br=1;
    }
    while(f_end && f_end!=M1)
    {
      if (read_n(&t, 9))
      {
        if (program_br>=PROGRAM_L && correct_PROG_L() )
        {
          MitiText("\r\nProgram is too long!\r\n", &cf_red);
          error++;
          goto e1;  
        }
        Program[program_br]=t;
        if (t>=TT_START && Chfil_c[t-=TT_START]==1)
        {
          if (Ufil_c1[t]==Definition[DF_INCLUDE])  // include
          {
            AddedFiles[h2++ -h1]=NewObj[sv_NewObj-1];
            continue;
          }
          else if (Ufil_c1[t]==Definition[DF_OP] || Ufil_c1[t]==Definition[DF_UNDEF_OP])   // op
          {
            DWORD temp;
            if ((temp=Ufil_c2[t])>=TT_START && (i=Ufil_c2[temp-=TT_START])>=TT_START && (k=Ufil_c2[i-=TT_START])>=TT_START)
            {
              k-=TT_START;
              if (Ufil_c1[t]==Definition[DF_OP])
              {
                if (Ufil_c2[k]==TT_LIST)
                  Add_op(NewObj[sv_NewObj-1], Ufil_c1[i], Ufil_c1[k], Ufil_c1[k]);
                else if ((temp=Ufil_c2[j])>=TT_START)
                  Add_op(NewObj[sv_NewObj-1], Ufil_c1[i], Ufil_c1[k], Ufil_c1[temp-TT_START]);
              }
              else
              {
                if (Ufil_c2[k]==TT_LIST) // problems for undef_op( _, x, x) must exist at least one new obj
                  Delete_op(NewObj1[sv_NewObj-1], NewObj[sv_NewObj-1], Ufil_c1[i], Ufil_c1[k], Ufil_c1[k]);
                else if ((temp=Ufil_c2[j])>=TT_START)
                  Delete_op(NewObj1[sv_NewObj-1], NewObj[sv_NewObj-1], Ufil_c1[i], Ufil_c1[k], Ufil_c1[temp-TT_START]);
              }
              continue;
            }
            else
            {
              MitiText("Error: ", &cf_red);
              MitiText("Bad definition of operator. (The \"op\" predicate.)\r\n");
              error++;
              goto e1;  
            }
          }
        }
        ++program_br;
        if (j==0)
          Program2[program_br]=0;
        else if (j==1)
          Program2[program_br]=i_poin+read_br-newline_br+1; //-newline_br
        else
          Program2[program_br]=Program2[program_br-1];
      }
    }
#if CONSOLE
    close(file);
#else
    file.Close();
  }
  if (flag&1)
  {
    pCompiled=NULL;
    return;
#endif
  }
P2:
  for(i=0; i<program_br1; i++)
    assert(i, 1);
  for(i=program_br2; i<program_br; i++)
    assert(i, 1);
  the_free_list=the_free_container=M1;
  for(ObjectStore_br=i=0; i<35; ObjectStore_br+=10, i++)
  {
    ObjectStore[ObjectStore_br]=CLASS_S_CLASS; // class
    if (i)
    {
      ObjectStore[ObjectStore_br+1]=Definition[DF_CLASSES-1+i]; // name
      if (Pointers[Definition[DF_CLASSES-1+i]]&OBSEG5) // object name
      {
        error++; len=0; 
        write_p(Definition[DF_CLASSES-1+i], 4, 0);
        MitiText("Error: ", &cf_red); MitiText("The name \""); MitiText(string2);
        MitiText("\"is already used.\r\n");
      }
      else
        put_in_f(ObjectStore_br, Definition[DF_CLASSES-1+i], 6, OBSEG5);
    }
    else
      ObjectStore[ObjectStore_br+1]=M1; // no name
    ObjectStore[ObjectStore_br+6]=M1;      // chield
    ObjectStore[ObjectStore_br+7]=ObjectStore_br+10;      // brother
    if (ObjectStore_br>C_S_WIN) // father
    {
      ObjectStore[ObjectStore_br+3]=C_S_WIN;   // father
      ObjectStore[ObjectStore_br+4]=83+64*(ObjectStore_br-C_S_WIN)/5; // 1+2+4*20+128*N/10
      ObjectStore[ObjectStore_br+5]=2047;   // maska
    }
    else if (ObjectStore_br>CLASS_SYSTEM)
    {
      ObjectStore[ObjectStore_br+3]=CLASS_SYSTEM;
      ObjectStore[ObjectStore_br+4]=3+2*(ObjectStore_br-CLASS_SYSTEM)/5; // 4*N/10
      ObjectStore[ObjectStore_br+5]=127;
    }
    else if (ObjectStore_br==CLASS_SYSTEM)
    {
      ObjectStore[ObjectStore_br+3]=CLASS_OBJECT;
      ObjectStore[ObjectStore_br+4]=3;
      ObjectStore[ObjectStore_br+5]=3;
    }
    else if (ObjectStore_br==CLASS_OBJECT)
    {
      ObjectStore[ObjectStore_br+3]=M1;
      ObjectStore[ObjectStore_br+4]=1;
      ObjectStore[ObjectStore_br+5]=1;
    }
    else // ObjectStore_br==0)
    {
      ObjectStore[ObjectStore_br+3]=M1;
      ObjectStore[ObjectStore_br+4]=0;
      ObjectStore[ObjectStore_br+5]=0;
    }
  }
  ObjectStore[2]=0;
  ObjectStore[7]=M1;
  ObjectStore[CLASS_OBJECT+6]=CLASS_SYSTEM;
  ObjectStore[CLASS_OBJECT+7]=M1;
  ObjectStore[CLASS_SYSTEM+6]=CLASS_S_CLASS;
  ObjectStore[CLASS_SYSTEM+7]=M1;
  ObjectStore[C_S_WIN+6]=C_S_WIN_Main;
  ObjectStore[C_S_WIN+7]=M1;
  ObjectStore[C_S_WIN_Embedded+7]=M1;
   // size
  ObjectStore[CLASS_OBJECT+2]=2;
  ObjectStore[CLASS_SYSTEM+2]=2;
  ObjectStore[CLASS_S_CLASS+2]=10;
  ObjectStore[CLASS_SYSTEM_FILE+2]=3;
  ObjectStore[CLASS_SYSTEM_LIST+2]=7;
  ObjectStore[CLASS_SYSTEM_ActiveX+2]=9;
  ObjectStore[CLASS_SYSTEM_PEN+2]=3;
  ObjectStore[CLASS_SYSTEM_BRUSH+2]=3;
  ObjectStore[CLASS_SYSTEM_FONT+2]=3;
  ObjectStore[CLASS_SYSTEM_FONTMASK+2]=3+sizeof(CHARFORMAT)/4;
  ObjectStore[CLASS_SYSTEM_BITMAP+2]=6;
  ObjectStore[CLASS_SYSTEM_TIMER+2]=4;
  ObjectStore[CLASS_SYSTEM_DLL+2]=3;
  ObjectStore[CLASS_SYSTEM_SOCKET+2]=8;
  ObjectStore[CLASS_SYSTEM_MYSQL+2]=6;
  ObjectStore[CLASS_SYSTEM_MYSQL_RES+2]=6;
  ObjectStore[CLASS_SYSTEM_MYSQL_ROW+2]=6;
  ObjectStore[CLASS_SYSTEM_CONTAINER+2]=8;
  ObjectStore[CLASS_SYSTEM_MENU+2]=7;
  ObjectStore[C_S_WIN+2]=7;
  ObjectStore[C_S_WIN_Main+2]=7;
  ObjectStore[C_S_WIN_Dialog+2]=7;
  ObjectStore[C_S_WIN_Static+2]=7;
  ObjectStore[C_S_WIN_Edit+2]=7;
  ObjectStore[C_S_WIN_Animate+2]=7;
  ObjectStore[C_S_WIN_ListBox+2]=7;
  ObjectStore[C_S_WIN_TreeBox+2]=7;
  ObjectStore[C_S_WIN_Bitmap+2]=7;
  ObjectStore[C_S_WIN_Icon+2]=7;
  ObjectStore[C_S_WIN_Button+2]=7;
  ObjectStore[C_S_WIN_CheckBox+2]=7;
  ObjectStore[C_S_WIN_Embedded+2]=9;
  if (!error)
  {
    i=FIRST_ROWS;
    k=program_br1; 
    DWORD mem;
Re1:for( ; i<k; i++)
    {
      if ((Program[i]&HALF) || (Prog_fild[Program[i]+1]&QUARTER))
        continue;
      j=Prog_fild[Program[i]];
      if (j>=TT_START && Chfil_c[j-TT_START]==1)
      {
        mem=Ufil_c1[j-TT_START];
        if (Pointers[mem]&OBSEG1)
        {
          warn_br++;
          len=0;
          write_p(mem, 4, 0);
          if (k!=program_br)
            MitiText("Warning 6: ", &cf_green);
          else
            MitiText("Warning 7: ", &cf_green);
          MitiText("You try to redifine the built-in predicate: ");
          MitiText(string2, &cf_black);
          MitiText("(...)", &cf_black);
          if (k==program_br)
            sprintf(string2, " in clause %d.\r\n", i-program_br2);
          else
            sprintf(string2, " in the ADD file at clause %d.\r\n", i);
          MitiText(string2);
        }
      }
      else
      {
        mem=QUARTER | j;
        if (Pointers[j]&OBSEG2)
        {
          warn_br++;
          len=0;
          write_p(j, 4, 0);
          if (k!=program_br)
            MitiText("Warning 6: ", &cf_green);
          else
            MitiText("Warning 7: ", &cf_green);
          MitiText("You try to redifine the built-in atom: ");
          MitiText(string2, &cf_black);
          if (k==program_br)
            sprintf(string2, " in clause %d.\r\n", i-program_br2);
          else
            sprintf(string2, " in the ADD file at clause %d.\r\n", i);
          MitiText(string2);
        }
      }
      for (t=func_br; t-->0 && (Functors[t]&HALFM)!=mem; );
      if (t==M1) // new
      {
        if (func_br>=FUNCTOR_L && correct_FUNCTOR())
        {
          MitiText("\r\nSystem error: Too many functors! No space!\r\n", &cf_red);
          error=1;
          goto e1;
        }
        Functors[func_br++]=mem;
        if ((mem&MASKA2)>=MEMORY_c256 || (mem&MASKA2)==TT_VAR)
        {
          warn_br++;
          len=0;
          write_p((mem&MASKA2), 4, 0);
          MitiText("Warning 9: ", &cf_green);
          MitiText("Strange predicate ");
          MitiText(string2, &cf_black);
          if (!(mem&QUARTER))
            MitiText("(...)", &cf_black);
          if (k==program_br)
            sprintf(string2, " as a head in clause %d.\r\n", i-program_br2);
          else
            sprintf(string2, " as a head in the ADD file at clause %d.\r\n", i);
          MitiText(string2);
        }
      }
      else if (k==program_br && (t<func_br-1 || i==program_br2) && !(Functors[t]&HALF) && (mem&MASKA2)!=Definition[DF_DEFINE_SYS_VAR])
      {   // redefine
        warn_br++;
        len=0;
        write_p((mem&MASKA2), 4, 0);
        if (t<func_in_ADD)
          MitiText("Warning 6: ", &cf_green);
        else
          MitiText("Warning 7: ", &cf_green);
        MitiText("The predicate ");
        MitiText(string2, &cf_black);
        if (!(mem&QUARTER))
          MitiText("(...)", &cf_black);
        if (t<func_in_ADD)
          sprintf(string2, " is defined in the ADD file. (clause %d)\r\n", i-program_br2);
        else
          sprintf(string2, " has an interrupted definition. (clause %d)\r\n", i-program_br2);
        MitiText(string2);
        Functors[t]|=HALF;
      }

      if (Pointers[j] & HALF)
      {
        for (t=D_field[Pointers[j] & MASKA3]; ProgTail[t]!=M1; t=ProgTail[t])
          if (ProgTail[t]==t)
          {
            sprintf(string2, "Error: The clause %d is unreachable (after :--).\r\n", i-program_br2);
            MitiText(string2, &cf_red);
            error++;
            goto e11; // go on
          }
        ProgTail[t]=i;
e11:    ;
      }
      else 
      {
        if (registrate(j, HALF) != j)
          MitiText("It can't be. Diferent2c\r\n");
        put_in_f(i, j, 0, HALF);
      }
    }
    if (i==program_br1)
    {
      i=program_br2;
      k=program_br;
      func_in_ADD=func_br;
      goto Re1;
    }
    Program[FIRST_ROWS-1]=HALF;
    for (i=1; i<FIRST_ROWS-2; Prog_fild[Program[i++]+1]=HALF);// as if we have sp_types in the head
#if TR
    i=0; k=program_br1;
Re2:for( ; i<k; i++)
    {
      if (Program[i]&HALF)
        continue;
      for(t=1; t<=Atoms[i]; t++)
      {
        j=Prog_fild[Program[i]+2*t];
        if (!(Pointers[j] & QUARTER))
        {
          if (registrate(j, QUARTER) != j)
            MitiText("It can't be. Diferent3\r\n");
          put_in_f(i, j, 1, QUARTER);  // 0->?
        }
      }
    }
    if (i==program_br1)
    {
      i=program_br2;
      k=program_br;
      goto Re2;
    }
#endif
    if (Pointers[TT_VAR] & HALF)
    {
      main_h1=1;
      warn_br++;
      MitiText("Warning 10: ", &cf_green);
      MitiText("You have a clause with a variable for head.\r\n");
    }
    else
      main_h1=0;
    if (!(Mtree[0][1] & HALF))
    {
      error++;
      MitiText("Error: You need at least one head with arguments.\r\n", &cf_red);
    }
    if ((Pointers[TT_VAR]&OBSEG1)==0)   // for easy check M1->?
      put_in_f(M1, TT_VAR, 2, OBSEG1);  // bult-in predicte
    if ((Pointers[TT_VAR]&OBSEG2)==0)   // built-in acsiom
      put_in_f(M1, TT_VAR, 3, OBSEG2);
    if ((Pointers[TT_VAR]&OBSEG3)==0)   // function
      put_in_f(M1, TT_VAR, 4, OBSEG3);
    if ((Pointers[TT_VAR]&OBSEG4)==0)   // constant
      put_in_f(M1, TT_VAR, 5, OBSEG4);
    if ((Pointers[TT_VAR]&OBSEG5)==0)   // object name ? do we need this
      put_in_f(M1, TT_VAR, 6, OBSEG5);
    //if ((Pointers[TT_VAR]&OBSEG6)==0)   // op // this will make problems in check_op
    //  put_in_f(M1, TT_VAR, 7, OBSEG6);
    for (a1=global_br=global_br2, j=0; j<global_br; j++)
    {
      if (global2[j]==1 && j>=RedLine && !(flag&6))
      {
        int m, n=2;
        
        warn_br++;
        MitiText("Warning 5: ", &cf_green);
        MitiText("The global variable ");
        string2[0]='G';
        string2[1]='_';
        for(m=global[j]; m>=TT_START; m=Ufil_c2[m-TT_START])
          string2[n++]=key_oposit[Ufil_c1[m-TT_START]];
        string2[n++]=key_oposit[m];
        string2[n]=0;
        MitiText(string2, &cf_black);
        MitiText(" is used only once.\r\n");
      }
      global2[j]=j;
    }
  }
e1:
  status_fl&=M1^1;       // Can't do next
#if !CONSOLE
  if (!(flag&4))
  {
    sprintf(string2, "%d error%s, %d warning%s.\r\n", 
            error, (error==1)?"":"s", warn_br, (warn_br==1)?"":"s");
    MitiText(string2);
  }
  pCompiled=pActive;
#endif
  return;
}

void Add_op(DWORD Priority, DWORD Assoc, DWORD Atom, DWORD Minning)
{
  unsigned i, min, max, Assoc2; 

  if (Priority==1000) // place for the comma
  {
    MitiText("Error: The priority in the operator definition cannot be 1000 because this value is reserved for comma and for |..\r\n", &cf_red);
    error++;
    return;
  }
  if (Definition[DF_TERM]==Assoc)
    Assoc2=0;
  else
  {
    for (Assoc2=0; Assoc2<20 && Definition[Assoc2+DF_FX]!=Assoc; Assoc2++);
    if (Assoc2==20)
    {
      MitiText("Error: The type in the operator definition is wrong.\r\n", &cf_red);
      error++;
      return;
    }
    if (Assoc2>15)
      Assoc2=8*(Assoc2-16)+34;  // 2+32
    else
    {
      if (Assoc2%4==3)        // Assoc .. 012 . x-xx . Left x-y . Right x-y . 2x-2xx
                              // 0 prefics, 1 sufics, 2 infics
        Assoc2=18+(Assoc2&12);// 2+16 4+8
      else if (Assoc2%4==1 && (Assoc2&8))     // prefics fy
        Assoc2+=8;          // -8+16
    }
    Assoc2++;
  }
  if ((Assoc2&36) && Priority<1000)
  {
    MitiText("Error: Types with xx or with yy can be used only for operators with priority bigger than 1000.\r\n", &cf_red);
    error++;
    return;
  }
  min=0;
  max=oper_br;
  while(min+1<max)
  {
    if (Atom<Oper[(min+max)/2])
      max=(min+max)/2;
    else if (Atom==Oper[(min+max)/2])
    {
      for (min=(min+max)/2; min && Oper[min-1]==Atom; min--);
et:   for ( max=min; Oper[max]==Atom; max++)
      {
        if (OpPr[max]==Priority && OpType[max]==Assoc2 && OpMin[max]==Minning)
          return;
        else if ((OpType[max]&2)==(Assoc2&2))
        {
          MitiText("Warning: ", &cf_green);
          MitiText("In this version of Strawberry Prolog ");
          if ((OpType[max]&3)==(Assoc2&3))
            MitiText("if you define one operator twice then it should be defined with different types.\r\n");
          else if ((Assoc2&2)==0)
            MitiText("you cannot define one operator both as a prefix and as a type term.\r\n");
          else
            MitiText("you cannot define one operator both as an infix and as a suffix.\r\n");
          return;
        }
      }
      if (oper_br==BUFFERS-1)
        goto et2;
      goto et1;
    }
    else
      min=(min+max)/2;
  }
  if (Atom<=Oper[min])
  {
    if (Atom==Oper[min] && oper_br) // only for '0'
      goto et;
    else
      max=0;
  }
  if (oper_br==BUFFERS-1)
  {
et2:MitiText("Error: Too many definitions of operators.\r\n", &cf_red);// error of space
    error++;
    return;
  }
  put_in_f(max, Atom, 7, OBSEG6);
et1:
  for (i=oper_br; i>max; i--)
  {
    if (i==1 || Oper[i-1]!=Oper[i-2])
      D_field[(Pointers[Oper[i-1]]&MASKA3)+7]++;
    OpPr[i]=OpPr[i-1];
    OpType[i]=OpType[i-1];
    Oper[i]=Oper[i-1];
    OpMin[i]=OpMin[i-1];
  }
  oper_br++;
  Oper[oper_br]=M1; // for easy chck Oper[i]!=Oper[i+1]
  OpPr[max]=Priority;
  OpType[max]=Assoc2;
  Oper[max]=Atom;
  OpMin[max]=Minning;
  /*
  if (Pointers[Atom]&OBSEG6)
  {
    for ( i=D_field[(Pointers[Atom]&MASKA3)+7]; Oper[i]==Atom; i++)
      if (OpPr[i]==Priority && OpType[i]==Assoc2 && OpMin[i]==Minning)
        return;
    if (i==oper_br)
      goto et1;
    if (Oper[i]==M1) // free place
      goto et2;
    j=D_field[(Pointers[Atom]&MASKA3)+7];
    if (oper_br+i-j>=BUFFERS)  
      goto et3;
    for ( k=j; k<i; k++)
    {
      OpPr[oper_br+k-j]=OpPr[k];
      OpType[oper_br+k-j]=OpType[k];
      Oper[oper_br+k-j]=Oper[k];
      OpMin[oper_br+k-j]=OpMin[k];
      Oper[k]=M1; // free it
    }
    D_field[(Pointers[Atom]&MASKA3)+7]=oper_br;
    oper_br+=i-j+1;
    i=oper_br-1;  
    goto et2;
  }
  else
  {
    put_in_f(oper_br, Atom, 7, OBSEG6);
    i=oper_br;  
et1:
    if (oper_br==BUFFERS)
    {
et3:  MitiText("Error: Too many definitions of operators.\r\n", &cf_red);// error of space
      error++;
      return;
    }
    oper_br++;
et2:
    OpPr[i]=Priority;
    OpType[i]=Assoc2;
    Oper[i]=Atom;
    OpMin[i]=Minning;
  }
  */
}
void Delete_op(DWORD PriorityType, DWORD Priority, DWORD Assoc, DWORD Atom, DWORD Minning)
{
  unsigned i, k, Assoc2; 

  if (Assoc  ==TT_LINK) Assoc  =TT_VAR;
  if (Atom   ==TT_LINK) Atom   =TT_VAR;
  if (Minning==TT_LINK) Minning=TT_VAR;

  if (Assoc!=TT_VAR)
  {
    if (Definition[DF_TERM]==Assoc)
      Assoc2=0;
    else
    {
      for (Assoc2=0; Assoc2<20 && Definition[Assoc2+DF_FX]!=Assoc; Assoc2++);
      if (Assoc2==20)
      {
        MitiText("Error: The type in the operator definition is wrong.\r\n", &cf_red);
        error++;
        return;
      }
      if (Assoc2>15)
        Assoc2=8*(Assoc2-16)+34;  // 2+32
      else
      {
        if (Assoc2%4==3)        // Assoc .. 012 . x-xx . Left x-y . Right x-y . 2x-2xx
                                // 0 prefics, 1 sufics, 2 infics
          Assoc2=18+(Assoc2&12);// 2+16 4+8
        else if (Assoc2%4==1 && (Assoc2&8))     // prefics fy
          Assoc2+=8;          // -8+16
      }
      Assoc2++;
    }
  }
  if (Atom==TT_VAR)
    i=0;
  else if (Pointers[Atom]&OBSEG6)
    i=D_field[(Pointers[Atom]&MASKA3)+7];
  else
    return;
  for (k=0; i<oper_br; i++)
  {
    if ((PriorityType!=TT_INT || OpPr[i]==Priority) && (Assoc==TT_VAR || OpType[i]==Assoc2)
          && (Atom==TT_VAR || Oper[i]==Atom) && (Minning==TT_VAR || OpMin[i]==Minning))
    {
      if (Oper[i]!=Oper[i+1] && (i==k || Oper[i]!=Oper[i-k-1]))
      {
        D_field[(Pointers[Oper[i]]&MASKA3)+7]=M1;
        Pointers[Oper[i]]&=M1^OBSEG6;
      }
      k++;
    }
    else if (k>0)
    {
      if (i-k>0 && Oper[i]!=Oper[i-k-1])
        D_field[(Pointers[Oper[i]]&MASKA3)+7]=i-k;
      OpPr[i-k]=OpPr[i];
      OpType[i-k]=OpType[i];
      Oper[i-k]=Oper[i];
      OpMin[i-k]=OpMin[i];
    }
  }
  oper_br-=k;
  Oper[oper_br]=M1; // for easy chck Oper[i]!=Oper[i+1]
}
