开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > 操作系统开发 > 查看源码
varmgrc.c
资源名称：DOS系统的源代码.rar　[点击查看]
上传用户：xiaoan1112
上传日期：2013-04-11
资源大小：19621k
文件大小：63k
源码类别：

操作系统开发

开发平台：

Visual C++

varmgrc.c：源码内容
  1. /*** 
  2. *varmgrc.c - Variable Manager for the BASIC 5.0 Interpreter
  3. *
  4. *  Copyright <C> 1985, Microsoft Corporation
  5. *
  6. *Purpose:
  7. *  Includes code for:
  8. *     - creating and searching for variables
  9. *     - creating and searching for user-defined types
  10. *  Includes a description of namespaces in BASIC.
  11. *
  12. **************************************************************************/
  15. /*
  16. The matrix given below is a representation of the namespaces in BASIC.
  17. Each class of names is listed on both the vertical and horizontal axis';
  18. X's in a square indicate that the two classes share a namespace (and
  19. could thus have name conflicts), while blanks in a square indicates that
  20. the two classes have separate namespaces.
  22. An astrisk ('*') (shown on vertical axis only) indicates that
  23. a type character included at the end of the name counts as
  24. part of the name for determining uniqueness.
  26. NOTE: This is a copy of the identical table in basic40.doc. If there's
  27.       any conflict between this table and that one, the one in basic40.doc
  28.       takes precedence.
  31.            COM  LAB  DEF  SUB  FUNC Type Elem Sclr typd Arry typd Const
  32.            Blk        Fn                           Sclr      Arry
  33.           |    |    |    |    |    |    |    |    |    |    |    |    |
  34.         ---------------------------------------------------------------
  35. COMMON Blk| XX |    |    |    |    |    |    |    |    |    |    |    |
  36.           | XX |    |    |    |    |    |    |    |    |    |    |    |
  37.         ---------------------------------------------------------------
  38. Label     |    | XX |    |    |    |    |    |    |    |    |    |    |
  39.           |    | XX |    |    |    |    |    |    |    |    |    |    |
  40.         ---------------------------------------------------------------
  41. DEF Fn*   |    |    | XX | XX | XX |    |    | XX | XX | XX | XX | XX |
  42.           |    |    | XX | XX | XX |    |    | XX | XX | XX | XX | XX |
  43.         ---------------------------------------------------------------
  44. SUB       |    |    | XX | XX | XX |    |    | XX | XX | XX | XX | XX |
  45.           |    |    | XX | XX | XX |    |    | XX | XX | XX | XX | XX |
  46.         ---------------------------------------------------------------
  47. FUNCTION  |    |    | XX | XX | XX |    |    | XX | XX | XX | XX | XX |
  48.           |    |    | XX | XX | XX |    |    | XX | XX | XX | XX | XX |
  49.         ---------------------------------------------------------------
  50. Type      |    |    |    |    |    | XX |    |    |    |    |    |    |
  51.           |    |    |    |    |    | XX |    |    |    |    |    |    |
  52.         ---------------------------------------------------------------
  53. Element   |    |    |    |    |    |    | XX |    |    |    |    |    |
  54.           |    |    |    |    |    |    | XX |    |    |    |    |    |
  55.         ---------------------------------------------------------------
  56. Scaler*   |    |    | XX | XX | XX |    |    | XX | XX |    |    | XX |
  57.           |    |    | XX | XX | XX |    |    | XX | XX |    |    | XX |
  58.         ---------------------------------------------------------------
  59. typed     |    |    | XX | XX | XX |    |    | XX | XX |    |    | XX |
  60.   Scaler  |    |    | XX | XX | XX |    |    | XX | XX |    |    | XX |
  61.         ---------------------------------------------------------------
  62. Array*    |    |    | XX | XX | XX |    |    |    |    | XX | XX |    |
  63.           |    |    | XX | XX | XX |    |    |    |    | XX | XX |    |
  64.         ---------------------------------------------------------------
  65. typed     |    |    | XX | XX | XX |    |    |    |    | XX | XX |    |
  66.   Array   |    |    | XX | XX | XX |    |    |    |    | XX | XX |    |
  67.         ---------------------------------------------------------------
  68. Const     |    |    | XX | XX | XX |    |    | XX | XX |    |    | XX |
  69.           |    |    | XX | XX | XX |    |    | XX | XX |    |    | XX |
  70.         ---------------------------------------------------------------
  71. */
  73. #include "version.h"
  74. #if !HEAP_H
  75. #include "heap.h"
  76. #endif
  77. #if !CONINT_H
  78. #include "conint.h"
  79. #endif
  80. #if !CONTEXT_H
  81. #include "context.h"
  82. #endif
  83. #if !VARIABLE_H
  84. #include "variable.h"
  85. #endif
  86. #if !QBIMSGS_H
  87. #include "qbimsgs.h"
  88. #endif
  89. #if !NAMES_H
  90. #include "names.h"
  91. #endif
  92. #if !UTIL_H
  93. #include "util.h"
  94. #endif
  95. #if !EXECUTOR_H
  96. #include "executor.h"
  97. #endif
  98. #if !PARSER_H
  99. #include "parser.h"
  100. #endif
  101. #if !TXTMGR_H
  102. #include "txtmgr.h"
  103. #endif
  104. #if !SCANNER_H
  105. #include "scanner.h"
  106. #endif
  108. /* forward reference of functions used only locally */
  109. ushort   NEAR     CreateVar(ushort, ushort);
  110. boolean  FAR      ModSharedChk(VOID);
  111. void     NEAR     ReDirect(VOID);
  113. ushort   NEAR     StdSearch(VOID);
  114. STATICF(VOID) AdjustStatChain(var *, ushort, ushort);
  115. STATICF(ushort) GrowBdVar(ushort);
  116. ushort NEAR FuncSearch(void);
  117. ushort NEAR GetDefaultType(char);
  119. extern   ushort oNamOfPrsCur;    /* set in ssrude.asm                         */
  121. VOID     FAR      B_ISdUpd(sd *, ushort);
  122.                                  /* runtime entry point to update moving sd's */
  123. VOID     FAR      B_IAdUpd(ad *, ushort);
  124.                                  /* runtime entry point to update moving ad's */
  126. /* varmgr-specific data */
  127. ushort  vm_oVarCur;                 /* offset to current variable table entry */
  128. var *vm_pVarCur;                    /* only guaranteed to be setup immediately
  129.                                        after a search or variable creation    */
  130. ushort vm_oVarTmp;                  /* temporary var entry offset             */
  131. boolean vm_fVarFound;               /* return value from var search routines.
  132.                                        note that, if vm_fVarFound is TRUE, the 
  133.                                        offset to the found var will be in 
  134.                                        vm_oVarCur (a static, also used in 
  135.                                        variable creation).                    */
  136. ushort vm_fPVCur;                   /* currently searching tPV if TRUE        */
  137. STATICV uchar nm_mask;              /* mask to apply to tNam flag for variable*/
  138. STATICV ushort errVal;              /* error return - used for those cases
  139.                                        which must return some other value
  140.                                        (such as routines invoked via
  141.                                         ForEachPrsInMrs ...)                  */
  142. STATICV boolean fConvtdToFun;       /* used by FuncSearch to communicate the
  143.                                        fact that it converted an existing
  144.                                        entry to be a FUNCTION entry.          */
  146. /*##############################################################################
  147. #                                                                              #
  148. #                        Variable Storage Scheme                               #
  149. #                                                                              #
  150. ##############################################################################*/
  151. /* 
  152. Variables are stored as follows:
  154.       There is one physical variable table per module, and one logical table
  155.       per procedure and module. This is accomplished by having one hash table
  156.       per logical table, all inter-woven in the physical table.
  158.       Each hash table is initialized to zeros, and contains a fixed number
  159.       of fields, each of which is an offset into the physical table to the
  160.       first variable in a chain of variables that hash to the same hash table
  161.       entry.  The hashing function is based on the name table offset (oNam)
  162.       for the variable.   Note that module hash tables are larger than proc.
  163.       hash tables, in anticipation of more variables per module than per
  164.       procedure (i.e., to help give us reasonable search speed for module
  165.       variables).  As of this writing (Aug. '87), there are 16 hash chains 
  166.       per module hash table, and 8 per procedure hash table.
  168.       The links in each hash chain are (physical) variable table offsets to
  169.       the next variable entry in the chain.  The end-of-chain marker is
  170.       EITHER a 0 or a 1 - - - this is because we also store a flag in the
  171.       low bit of the hash link (we use every bit we can get ...).
  173.       Since variables cannot be dynamically removed and/or reused (i.e.,
  174.       one can unlink an entry, but then that space is dead), variable
  175.       entries and hash tables go into the physical table in whatever order 
  176.       they are encountered.
  178. Variable Entries:
  180.       A variable entry looks like one of the below:
  182.                   If oTyp is User-              If oTyp is I2, I4,
  183.                   Defined or a Fixed            R4, R8, or Sd. oTyp
  184.                   Length String                 is stored in low 3
  185.                                                 bits of flags field
  186.                   +----------------+      
  187.   |   oTyp/cbFS    |
  188.                   +----------------+            +----------------+
  189.                   |      oNam      |            |      oNam      |
  190.                   +----------------+            +----------------+ 
  191.                   |   oHashLink    |            |   oHashLink    |
  192.                   +----------------+            +----------------+
  193.                   |     flags      |            |     flags      |
  194.                   +----------------+            +----------------+
  195.           pVar--->+     value      |    pVar--->|     value      |
  196.                   |                |            |                |
  197.                   +----------------+            +----------------+
  200.       The value field is of variable length, depending on what the variable
  201.       represents. The flag bits allow determination of size and use of the
  202.       value field for any given variable.
  204.       All variable entries are of even size, and must fall on even byte
  205.       boundaries, for 2 reasons:
  206.          (1) The runtime requires SD's to fall on even byte boundaries
  207.          (2) We store a flag bit in the low byte of the oHashLink field,
  208.                so each oVar must be even.
  209.                                                                               */
  212. /*##############################################################################
  213. #                                                                              #
  214. #                        Variable Creation                                     #
  215. #                                                                              #
  216. ##############################################################################*/
  217. /***
  218. *GrowBdVar(cbGrowVar) - grow variable table
  219. *Purpose:
  220. *  Given an amount by which we wish to grow the active variable table,
  221. *  grow it if possible, returning FALSE if successful or an error code if not.
  222. *
  223. *  In the event that grs.otxCONT != UNDEFINED, don't call BdGrowVar; instead,
  224. *  succeed if sufficient space exists between cbLogical and cbPhysical, fail
  225. *  otherwise, returning ER_CN.
  226. *Entry:
  227. *  cbGrowVar - number of bytes we wish to grow mrsCur.bdVar by.
  228. *Exit:
  229. *  FALSE if successful, in which case mrsCur.bdVar.cbLogical is increased by
  230. *     cbGrowVar
  231. *  Otherwise, returns an error code for use by CreateVar, below.
  232. *******************************************************************************/
  233. STATICF(ushort) GrowBdVar(cbGrowVar)
  234. ushort cbGrowVar;
  235.    {
  236.    /* [13] ensure that oVar < 0x8000       */
  237.    if ((mrsCur.bdVar.cbLogical + VAR_STRUCT_SIZE + 2) > 0x7FFF) /* [13]       */
  238.       return (PRS_ER_RE | ER_OM);    /* [13] out of memory      */
  240.    if (grs.otxCONT == UNDEFINED) {                 /* user can't CONTinue     */
  241.       if (!BdGrowVar(&mrsCur.bdVar, cbGrowVar))
  242.          return (PRS_ER_RE | ER_OM);               /* out of memory           */
  243.       }
  244.    else {            
  245.       /* user is able to CONTinue; fail unless space already exists in table  */
  246.       REG1 ushort temp = mrsCur.bdVar.cbLogical + cbGrowVar;
  247.       if (temp > mrsCur.bdVar.cbPhysical) {    /* would have to actually  */
  248.    /* grow table       */
  249.          DbAssert(!(mkVar.flags2 & MV_fTrashTable))
  250.          return (0x8000 | ER_CN);
  251.          }
  252.       else 
  253.          mrsCur.bdVar.cbLogical = temp;            /* success.                */
  254.       }
  255.    return(FALSE); 
  256.    }
  258. /***
  259. *CreateVar(oPVHash, varFlags) - create a new variable
  260. *Purpose:
  261. *  Create a new variable in the mrsCur.bdVar. If 'oPVHASH' is UNDEFINED, 
  262. *  create it in the tMV, else, use the offset to the tPV hash table.
  263. *  
  264. *Entry:
  265. *  oPVHash - UNDEFINED if we're to create var in the tMV, or an offset
  266. *              into mrsCur.bdVar to the hash table for the tPV.
  267. *  varFlags  - Initial settings for the flags word in the new var entry.
  268. *              FVFNNAME, FVFUN, FVCOMMON, FVFORMAL, FVDECLDVAR, FVSHARED, 
  269. *              FVCONST, and FVSTATIC are to be set correctly; FVARRAY & 
  270. *              FVINDEXED will frequently be correct, but may be changed 
  271. *              based on other flags settings; FVVALUESTORED is to
  272. *              be pathologically set to TRUE on input, while 
  273. *              FVEVEREXPLICIT, and FVREDIRECT are to be set FALSE.
  274. *  mkVar - global structure containing MakeVariable inputs for oNam,
  275. *              oTyp, and a(nother) flags word.
  276. *
  277. *  NOTE: All variables are created on even-byte boundaries. This
  278. *        guarantees, in turn, that the value fields of all variables will
  279. *        start on even byte boundaries. We ensure this primarily by the
  280. *        structure definitions in variable.h/.inc.  The primary reason for
  281. *        this is that the shared runtime assumes (and requires) that all
  282. *        string descriptors be on even byte boundaries.
  283. *
  284. *Exit:
  285. *  return value is an error code; either zero is returned (no error),
  286. *  or the same error code as is used by MakeVariable is returned (see
  287. *  MakeVariable, below).
  288. *
  289. *  Also sets module static vm_oVarCur to the offset into mrsCur.bdVar
  290. *  to the new entry, and vm_pVarCur to point to the entry.
  291. *
  292. *Exceptions:
  293. *  none.
  294. *
  295. *******************************************************************************/
  296. ushort NEAR CreateVar(oPVHash, varFlags)
  297. ushort oPVHash;
  298. ushort varFlags;
  299.    {
  300.    var *pVar;
  301.    ushort inFlags = mkVar.flags;      /* put MakeVariable callers flags
  302. word in a register       */
  303.    ushort cbValue = 0;
  304.    ushort cbOTyp;
  305.    ushort *pHash;
  306.    uchar  nmsp_type;
  307.    ushort temp;
  308.    ushort entryFlags;      /* [11] use this to build up
  309. [11] the flags word for entry */
  310.    ushort oPrsRef;      /* [11] 0 or oPrs for function
  311. [11] ref       */
  313.    /* if caller to MakeVariable really wanted just a search without modifying
  314.       the variable table, return Internal Error code to indicate that the
  315.       search failed                                                           */
  316.    if (mkVar.flags2 & MV_fDontCreate)
  317.       return (PRS_ER_RP | ER_IER);
  319.    /* The following assertion is made because (if for no other reason ...)
  320.       we assume that the user can still CONTinue if he asks to add a variable
  321.       but we return ER_CN and he backs out of the edit                        */
  322.    DbAssertIf(mkVar.flags & !(FVCOMMON | FVFNNAME | FVFUNCTION), 
  323.                                           !(mkVar.flags2 & MV_fTrashTable))
  325.    if ((mkVar.oTyp == UNDEFINED) && !(mkVar.flags & FVASCLAUSE))
  326.                                     /* reference to a record prior to ...AS...*/
  327.       return (PRS_ER_RP | MSG_BadElemRef); /* [9] */
  329.    /* The following assertion is based on the fact that we're using
  330.       grs.oRsCur in the case that we CAN continue to see if there's an active
  331.       frame on the stack for the active procedure - if so, we return ER_CN    */
  332.    DbAssertIf(oPVHash != UNDEFINED, 
  333.                ((grs.oRsCur & 0x8000) && (prsCur.oVarHash == oPVHash)))
  334.    if ((oPVHash != UNDEFINED) && 
  335.        (grs.otxCONT != UNDEFINED) && 
  336.        !(varFlags & (FVSTATIC | FVSHARED | FVCONST)))
  337.       if (FindORsFrame())           /* TRUE if this proc has an active frame  */
  338.  return (0x8000 | ER_CN);   /* allow the user to back out of edit     */
  340.    oPrsRef = 0;      /* [11] initialize       */
  342.    entryFlags = varFlags & ~0x07;
  344.    if (inFlags & (FVFORCEARRAY | FVINDEXED))
  345.       if (varFlags & FVFUN)
  346.  entryFlags |= FVINDEXED;
  347.       else {
  348.  entryFlags |= (FVARRAY | FVINDEXED);
  349.          /* set the dimension count; if input of zero, assume 1 - - - will end
  350.             up giving Rude Edit later if this turns out to have been wrong    */
  351.          if ((mkVar.cDimensions == 0) && !(inFlags & FVCOMMON))
  352.             cbValue = sizeof(dm);
  353.             /* NOTE: we if a dimension count wasn't specified on a COMMON
  354.                      statement for an array, the execute scanner depends on
  355.                      the cDims field in the variable entry being 0;
  356.                      we depend on that for STATIC arrays, in StdSearch        */
  357.          if ((inFlags & FVSTATIC) && (mkVar.cDimensions > 8))
  358.             return (PRS_ER_RE | MSG_SubCnt); /* 'Wrong number of subscripts'  */
  359.          }
  360.    
  361.    if (!(inFlags & FVIMPLICIT))           /* if pathological input was wrong  */
  362.       entryFlags |= FVEVEREXPLICIT;
  363.                                                       
  364.    inFlags = entryFlags;      /* now use flags as passed BY MakeVariable      */
  366.    /* initialize cbValue for static variable case, to save code later on      */
  367.    cbValue += (inFlags & FVARRAY) ? (sizeof(aStat) + - sizeof(oneChar) +
  368.      sizeof(dm) * mkVar.cDimensions) :
  369.     (mkVar.oTyp == ET_FS ? mkVar.fsLength :
  370.      CbTyp(mkVar.oTyp));
  372.    nmsp_type = NMSP_Variable; /* assume we're not creating a FUNCTION, or 
  373.                                  DEF FN entry                                 */
  375.    if (inFlags & 
  376.       (FVFORMAL | FVCOMMON | FVSTATIC | FVFUNCTION | FVSHARED | FVCONST)) {
  377.       if (inFlags & (FVFORMAL | FVCOMMON | FVFUNCTION)) {
  378.          if (inFlags & FVCOMMON) {
  379.     entryFlags &= ~FVVALUESTORED;    /* set that bit to FALSE   */
  380.     cbValue = (inFlags & FVARRAY ? sizeof(aCom) : sizeof(comRef));
  381.             if (inFlags & FVSHARED)
  382.                nm_mask |= NM_fShared;
  383.             }
  384.          else {                                    /* not COMMON -            */
  385.     cbValue = sizeof(ushort);
  386.             if (inFlags & FVFUNCTION) {
  387.                nmsp_type = 0;                      /* don't set any name table
  388.                                                       bits                    */
  389.                if ((oPVHash == UNDEFINED) && (mkVar.flags & FVFUNCTION))
  390.                   nm_mask |= NM_fShared;           /* set tNam entry flag  */
  391.                if (mkVar.flags & FVLVAL)           /* retval                  */
  392.   entryFlags &= ~FVVALUESTORED;    /* set to FALSE for retval */
  393.        else {
  394.   if ((oPrsRef =
  395.                      PrsRef(mkVar.oNam,
  396.                             (uchar)((mkVar.flags & FVFUNCTION) ? 
  397.                                        PT_FUNCTION : PT_DEFFN),
  398.     mkVar.oTyp)) & 0x8000) /* [16] function not found */
  399.                      return (PRS_ER_RP | ER_UF);   /* 'Undefined Function'    */
  400.                   }
  401.                }
  402.             else {   /* FVFORMAL */
  403.        entryFlags &= ~FVVALUESTORED;    /* set that bit to FALSE   */
  404.                if (inFlags & FVARRAY)
  405.   cbValue = sizeof(aFormal);
  406.                }  
  407.             }  /* else - not COMMON */
  408.          }  /* if FORMAL, COMMON, DEF FN, or FUNCTION */
  409.       else                                         /* STATIC,SHARED, or CONST */
  410.          if (inFlags & FVSHARED) {
  411.             if (oPVHash == UNDEFINED)              /* entry going in the tMV  */
  412.                nm_mask |= NM_fShared;
  413.             else {   /* entry going in tPV */
  414.        entryFlags &= ~FVVALUESTORED;    /* set to FALSE */
  415.        cbValue = sizeof(ushort);
  416.                }
  417.             }  /* if SHARED */
  418.          else if (inFlags & FVCONST) {
  419.             if (oPVHash == UNDEFINED)              /* entry going in the tMV  */
  420.                nm_mask = NM_fShared;               /* Always set fShared bit
  421.                                                       so constants are found  */
  422.             }
  423.       }  /* if special case flag is set */
  424.    else {
  425.       if ((grs.oPrsCur != UNDEFINED) && (prsCur.procType == PT_DEFFN))
  426.          oPVHash = UNDEFINED;    /* var ref. belongs in the tMV for DEF's     */
  427.       if ((oPVHash != UNDEFINED) && (!(prsCur.flags & FP_STATIC))) {
  428.  entryFlags &= ~FVVALUESTORED;   /* actual value not stored in entry */
  429.          if (inFlags & FVARRAY)
  430.     cbValue = sizeof(aFrame);
  431.          else
  432.     cbValue = sizeof(ushort);    /* size of a frame offset  */
  433.          }
  434.       }  /* no special case flag was set */
  435.    cbValue = ((++cbValue) >> 1) << 1;              /* round up cbValue, to 
  436.                                                       ensure even-byte vars. 
  437.                                                       Note that this MUST be
  438.                                                       done in case of odd-sized
  439.                                                       user-defined types or 
  440.       fixed-length strings.   */
  441.    cbOTyp = ((mkVar.oTyp > ET_MAX) || (mkVar.oTyp == ET_FS)) ?
  442.   sizeof(ushort) : 0;
  444.    vm_oVarCur = mrsCur.bdVar.cbLogical + cbOTyp + VAR_STRUCT_SIZE;    /* [11] */
  446.    /* [11] see if namespace ER_DD error BEFORE we try to grow the var table,
  447.       [11] so we don't ask user if he wants to continue and THEN give error   */
  448.    if (nmsp_type)    /* don't set anything if
  449.                                                       creating a DEF or FUN
  450.                                                       entry (txtmgr does it)  */
  451.       if (CheckONamSpace(mkVar.oNam, nmsp_type))
  452.  return (PRS_ER_RE | ER_DD);    /* duplicate definition    */
  454.    temp = cbValue + cbOTyp + VAR_STRUCT_SIZE;
  455.    if (temp < cbValue) /* [12] 64k wrap occurred       */
  456.       return (PRS_ER_RE | ER_OM); /* [12] out of memory       */
  457.    if (temp = GrowBdVar(temp))
  458.       return (temp);
  459.    pVar = (var *)(mrsCur.bdVar.pb + vm_oVarCur); /* in case table moved    */
  460.    ZeroFill((char *)pVar, cbValue);
  462.    if (cbOTyp) {       /* oTyp > ET_MAX */
  463.       if (mkVar.oTyp == ET_FS) {
  464.   *((ushort *)((char *)pVar + VAR_cbFixed)) = mkVar.fsLength;
  465.   entryFlags |= mkVar.oTyp;
  466.       }
  467.       else
  468.   *((ushort *)((char *)pVar + VAR_oTyp)) = mkVar.oTyp;
  469.       }
  470.    else
  471.       entryFlags |= mkVar.oTyp;
  472.    
  473.    ONamOf(pVar) = mkVar.oNam;    /* [11]       */
  474.    FlagsOf(pVar) = entryFlags;    /* [11] set entry flags    */
  475.    ValueOf(pVar, oPrs) = oPrsRef;    /* [11] oPrs or zero       */
  477.    if (nmsp_type) {                                /* don't set anything if
  478.                                                       creating a DEF or FUN
  479.                                                       entry (txtmgr does it)  */
  480.       if (SetONamSpace(mkVar.oNam, nmsp_type))
  481.  ;    /* [11] CheckONamSpace will
  482.       [11] already have caught
  483.       [11] error, if any      */
  485.       }
  487.    mrsCur.oPastLastVar = mrsCur.bdVar.cbLogical;   /* can always trim table 
  488.                                                       back to oPastLastVar and
  489.                                                       lose no variables       */
  490.    vm_pVarCur = pVar;                              /* an exit value           */
  492.    /* initialize the dim count if:
  493. the entry is an array AND it's NOT (shared AND in a procedure).
  494. (If an array is shared and in a procedure it doesn't have a cDims
  495. field in the var table entry.  The entry is a near pointer to the
  496. array descriptor defining the array.) */
  498.    if ((FlagsOf(pVar) & FVARRAY) &&
  499.       !((FlagsOf(pVar) & FVSHARED) && (oPVHash != UNDEFINED))) //[17]
  500.       ValueOf(pVar, aryStat.cDims) = mkVar.cDimensions;
  501.                                                    /* this actually sets
  502.                                                       cDims for all arrays    */
  504.    /* now just have to link the new entry in */
  506.    pHash = (ushort *)(mrsCur.bdVar.pb +
  507.                         ((oPVHash == UNDEFINED) ? 
  508.                               (mkVar.oNam & HASH_MV_NAMMASK) : 
  509.                               (oPVHash + (mkVar.oNam & HASH_PV_NAMMASK))));
  510.    if ((*pHash == 0) || (FlagsOf(pVar) & FVDECLDVAR)) {  
  511.       /* link this entry into start of chain */
  512.       OHashLinkOf(pVar) = *pHash;         /* old start of chain in new entry  */
  513.       *pHash = vm_oVarCur;                /* save offset to new entry         */
  514.       }
  515.    else {   /* link this entry into end of chain */
  516.       OHashLinkOf(pVar) = 0;              /* 0 (or 1) indicates end of chain;
  517.                                              UNDEFINED doesn't do it because
  518.                                              we store a flag in the low bit   */
  519.    pVar = (var *)(mrsCur.bdVar.pb + *pHash);    /* point to start of chain */
  520.    while (OHashLinkOf(pVar) > 1)    /* while not end of hash chain    */
  521.       pVar = (var *)(mrsCur.bdVar.pb + (OHashLinkOf(pVar) & 0xFFFE));
  522.       OHashLinkOf(pVar) |= vm_oVarCur;    /* OR this in rather than assign it
  523.                                              to preserve existing flag value  */
  524.       DbAssert(!(vm_oVarCur & 1))         /* we depend on oVars being on even
  525.                                              byte boundaries for this hashlink
  526.                                              bit flag use, and for SD's       */
  527.       }
  528.    return (vm_fVarFound = FALSE);                  /* var created, not found;
  529.                                                       retval says 'no errors' */
  530.    }  /* CreateVar */
  533. /*##############################################################################
  534. #                                                                              #
  535. #                        Variable Searching                                    #
  536. #                                                                              #
  537. ##############################################################################*/
  539. /***
  540. *ReDirect() - unlink entry @ vm_oVarCur, set FVREDIRECT, put vm_oVarTmp in value
  541. *Purpose:
  542. *  'ReDirect' a variable entry, i.e., unlink it from its hash chain, set
  543. *  the FVREDIRECT flag in the entry, and put the offset to the 'real'
  544. *  entry (in vm_oVarTmp) into the value field.
  545. *
  546. *  Redirection is performed whenever an existing entry is made invalid
  547. *  by some new instance of a matching variable, for example, what looked
  548. *  like an array at first encounter might be found to be a FUNCTION at
  549. *  a later encounter - - - all such array entries (in tMV and all tPV's)
  550. *  are redirected to this newly created FUNCTION entry. The scanner
  551. *  can then go through and fix up the pcode for each redirected entry,
  552. *  since we'll put the oVar for the new entry in the redirected entry.
  553. *Entry:
  554. *  vm_fPVCur - module static flag, TRUE if hash table is in tPV, FALSE if tMV.
  555. *  mrsCur.bdVar assumed set up, and if vm_fPVCur is TRUE, prsCur is assumed
  556. *     to be set up, and the oVarHash field to contain an offset into
  557. *     mrsCur.bdVar to the tPV hash table.
  558. *  vm_oVarCur is an offset into mrsCur.bdVar to the entry to be redirected.
  559. *  vm_oVarTmp is an offset into mrsCur.bdVar to the entry it is to be
  560. *     redirected to.
  561. *Exit:
  562. *  none.
  563. *Exceptions:
  564. *  none.
  565. *******************************************************************************/
  566. VOID NEAR ReDirect()
  567.    {
  568.    REG1 var *pVar;                     
  569.    REG2 char *pVarBase = mrsCur.bdVar.pb;
  570.    REG3 ushort *pHash;
  571.    REG4 var *pVarPrev;
  572.    REG5 ushort oHashTmp;
  574.    /*--------------------------------------------------------------------------
  575.    | calculate pointer into hash table to offset to the first entry in the    |
  576.    |  chain; this is just:                                                    |
  577.    |     (base of physical table) + (offset to start of hash table) +         |
  578.    |     (offset into hash table)                                             |
  579.    --------------------------------------------------------------------------*/
  580.    DbAssertIf(vm_fPVCur, prsCur.oVarHash != UNDEFINED)
  581.    pHash = (ushort *)(mrsCur.bdVar.pb +
  582.                      (vm_fPVCur ? 
  583.                            (prsCur.oVarHash + (mkVar.oNam & HASH_PV_NAMMASK)) :
  584.                            (0 + (mkVar.oNam & HASH_MV_NAMMASK))));
  586.    pVar = (var *)(pVarBase + *pHash);           /* point to first entry       */
  588.    if (*pHash == vm_oVarCur)                    /* entry is @ start of chain  */
  589.       *pHash = OHashLinkOf(pVar) & 0xFFFE;      /* unlink first entry         */
  590.    else {
  591.       while ((oHashTmp = OHashLinkOf(pVar) & 0xFFFE) != vm_oVarCur) {
  592.          DbAssert(oHashTmp != 0)                /* better not be end of chain */
  593.          pVar = (var *)(pVarBase + oHashTmp);
  594.          }
  595.       pVarPrev = pVar;                          /* point to entry prior to one
  596.                                                    we wish to unlink          */
  597.       pVar = (var *)(pVarBase + oHashTmp);
  598.       OHashLinkOf(pVarPrev) = OHashLinkOf(pVar);/* unlink the entry           */
  599.       }
  600.    
  601.    /* at this point, pVar points to the entry being redirected                */
  602.    FlagsOf(pVar) |= FVREDIRECT;
  603.    ValueOf(pVar, oMV) = vm_oVarTmp;
  605.    }  /* ReDirect */
  607. /***
  608. *FuncSearch() - search the appropriate hash table for FUNCTION case
  609. *Purpose:
  610. *  Search the appropriate table (tPV or tMV) in the case where we've
  611. *  encountered [DECLARE] FUNCTION.
  612. *Entry:
  613. *  vm_fPVCur - module static flag, TRUE if we're to search tPV, FALSE if tMV.
  614. *  mrsCur.bdVar assumed set up, and if vm_fPVCur is TRUE, prsCur is assumed
  615. *     to be set up, and the oVarHash field is either UNDEFINED (in which
  616. *     case we just return), or contains an offset into mrsCur.bdVar to the 
  617. *     tPV hash table.
  618. *
  619. *  mkVar set up as per MakeVariable (below).
  620. *Exit:
  621. *  FALSE = no error
  622. *  otherwise, the same error code is returned as described for MakeVariable,
  623. *     below.
  624. *  If no error is returned, then the static vm_fVarFound indicates success or
  625. *     failure. 
  626. *  If vm_fVarFound == TRUE, vm_oVarCur is set to the offset into mrsCur.bdVar to
  627. *     the found variable entry, and vm_pVarCur points to the entry.
  628. *  If an existing entry has been converted to a FUNCTION entry by the search,
  629. *     the static flag fConvtdToFun will be set TRUE.
  630. *Exceptions:
  631. *  none.
  632. *******************************************************************************/
  633. ushort NEAR FuncSearch()
  634.    {
  635.    REG1 var *pVar;                     
  636.    REG2 char *pVarBase = mrsCur.bdVar.pb;
  638.    /*--------------------------------------------------------------------------
  639.    | calculate offset into mrsCur.bdVar to first entry in appropriate hash    |
  640.    |  chain; this is the contents of:                                         |
  641.    |     (base of physical table) + (offset to start of hash table) +         |
  642.    |     (offset into hash table)                                             |
  643.    --------------------------------------------------------------------------*/
  644.    REG3 ushort oVar = *(ushort *)(mrsCur.bdVar.pb +
  645.                      (vm_fPVCur ? 
  646.                            (prsCur.oVarHash + (mkVar.oNam & HASH_PV_NAMMASK)) :
  647.                            (0 + (mkVar.oNam & HASH_MV_NAMMASK))));
  648.    fConvtdToFun = vm_fVarFound = FALSE;      /* initialize                    */
  650.    if ((oVar == 0) || (vm_fPVCur && (prsCur.oVarHash == UNDEFINED)))
  651.       return(FALSE);                         /* empty hash chain - not found  */
  653.    for (pVar = (var *)(pVarBase + oVar);     /* loop init.                    */
  654.         pVar != (var *)pVarBase;             /* oVar = 0 ==> end of chain     */
  655.         pVar = (var *)(pVarBase + (OHashLinkOf(pVar) & 0xFFFE))) {   
  656.                                              /* loop re-init   */
  657.       if (mkVar.oNam != ONamOf(pVar))
  658.          continue;
  659.       if (!(FlagsOf(pVar) & FVFUN)) {
  660.          if (FlagsOf(pVar) & (FVFORMAL | FVCOMMON | FVSTATIC | FVCONST |
  661.                                                       FVSHARED | FVDECLDVAR))
  662.             return (PRS_ER_RE | ER_DD);
  663.          if (OTypOf(pVar) != mkVar.oTyp)
  664.             if (FlagsOf(pVar) & FVEVEREXPLICIT)
  665.                return (PRS_ER_RE | ER_DD);
  666.             else {
  667.                DbAssert(mkVar.oTyp <= ET_MAX)
  668.                FlagsOf(pVar) = (FlagsOf(pVar) & ~ 0x07 | mkVar.oTyp);
  669.                }
  670.          fConvtdToFun = TRUE;                /* set flag if converting to FUN */
  671.          ValueOf(pVar, oPrs) = PrsRef(mkVar.oNam, PT_FUNCTION, mkVar.oTyp);
  672.                                              /* set value field               */
  673.          DbAssert(ValueOf(pVar, oPrs) != UNDEFINED)
  674.                                              /* error if prs not found        */
  675.          FlagsOf(pVar) |= (FVFUN | FVDECLDVAR | FVEVEREXPLICIT);
  676.          FlagsOf(pVar) &= ~FVARRAY;
  677.          }  /* if entry flag FVFUN is FALSE */
  678.       if (vm_fVarFound)                      /* is this a second match in the */
  679.          return(PRS_ER_RE | ER_DD);          /*    same chain? If so error    */
  680.       /* now, note that we've found a match and save this oVar, but keep
  681.          looking, in case there's another matching name, which would trigger
  682.          the above error ...                                                  */
  683.       vm_fVarFound = TRUE;
  684.       vm_oVarCur = (char *)pVar - mrsCur.bdVar.pb;
  685.       vm_pVarCur = pVar;
  686.       }  /* while not at end of hash chain */
  687.    return (FALSE);                           /* no errors                     */
  688.    }  /* FuncSearch */
  690. /***
  691. *ModSharedChk() - check tPV for matches to a new module SHARED variable
  692. *Purpose:
  693. *  Check the tPV (of prsCur) for a match to a given (new) module SHARED
  694. *  variable. If a match is found, redirect it, i.e., unlink the tPV entry
  695. *  from its hash chain, set the FVREDIRECT flag in it, and place
  696. *  the offset to the new module SHARED variable in its value field.
  697. *
  698. *  Note: This is now optimized based on the knowledge that it's ONLY used
  699. *        used for FUNCTION declarations or definitions.
  700. *  
  701. *Entry:
  702. *  vm_oVarTmp = offset into mrsCur.bdVar to a new module SHARED variable.
  703. *  vm_fPVCur assumed to be TRUE
  704. *  other inputs set up as for FuncSearch (above)
  705. *Exit:
  706. *  TRUE - no error.
  707. *  FALSE - some error from FuncSearch, assumed to be a rude edit case
  708. *           (so we can count on mrsCur.bdVar being tossed out).
  709. *           In this event, the static variable 'errVal' will be contain the 
  710. *           error return, and (non-RELEASE only) the mkVar.flags2 bit
  711. *           MV_fTrashTable will be set.
  712. *Exceptions:
  713. *  none.
  714. *******************************************************************************/
  715. boolean ModSharedChk()
  716.    {
  717.    if (errVal = FuncSearch()) {
  718.       return(FALSE);                /* some error found - quit looking        */
  719.       }
  720.    if (vm_fVarFound)
  721.       ReDirect();
  722.    return (TRUE);
  723.    }  /* ModSharedChk */
  725. /***
  726. *GetDefaultType - given the logical 1st char of a var name,  get default oTyp
  727. *Purpose:
  728. *  Given the logical first char of a name, return the default oTyp of that name.
  729. *  Note that 'logical first char' implies the third char of a name which starts
  730. *  with 'FN' and the first char of any other name.
  731. *Entry:
  732. *  namChar
  733. *Exit:
  734. *  oTyp
  735. *Exceptions:
  736. *  none.
  737. *
  738. *******************************************************************************/
  739. ushort NEAR GetDefaultType(namChar)
  740. char namChar;
  741.    {
  742.    namChar &= 0xDF;   /* convert to upper case */
  743.    DbAssert ((namChar == ('.' & 0xDF)) ||
  744.              ((namChar >= 'A') && (namChar <= 'Z')));
  745.    return(namChar == ('.' & 0xDF)) ? ET_R4 : (ushort)ps.tEtCur[(namChar) - 'A'];
  746.    } /* GetDefaultType */
  749. /***
  750. *MakeVariable - Search for var, create if req'd, return offset to it
  751. *Purpose:
  752. *  Given a variable encountered by the parser or scanner, search for the
  753. *  variable; if not found (and no error conditions detected), create the
  754. *  variable in the tMV or the appropriate tPV and return an offset into
  755. *  mrsCur.bdVar ('oVar') to the value field in the variable entry; this offset 
  756. *  goes in the pcode stream.
  757. *
  758. *Entry:
  759. *  mrsCur set up; it is assumed that bdVar is a heap owner.
  760. *  prsCur either set up, or grs.oPrsCur is UNDEFINED if no procedure is
  761. *     currently active
  762. *  mkVar.oNam - global name table offset for the name of the input variable
  763. *  mkVar.oTyp - global type table offset for the (perhaps assumed) type of the
  764. *              input variable. In the case of an implicitly typed variable,
  765. *              ET_IMP should be passed; in this instance, MakeVariable will 
  766. *              determine the appropriate default type, based on the oNam.
  767. *              In the case of a reference to a record element, the oTyp of the
  768. *              record variable cannot be set by the caller; in this special 
  769. *              case, mkVar.oTyp must be set to UNDEFINED by the caller.
  770. *  mkVar.flags - global 2-bytes of bit flags used to describe the variable
  771. *              encountered. One byte contains flags which are set in 
  772. *              atypical situations, the other contains flags to be tested
  773. *              in common situations.
  774. *              Note that the FVIMPLICIT and FVFNNAME flags are not inputs,
  775. *              however - - - these can be set or reset on input: MakeVariable
  776. *              (now) sets these based on the oTyp and oNam fields (respectively)
  777. *  mkVar.cDimensions - number of dimensions in an array variable; required
  778. *              for correctly allocating the array descriptor, and setting
  779. *              the dimension count for array variables. Only meaningful
  780. *              when FVINDEXED is set, and FVFUNCTION is not (and the variable
  781. *              name does not start with 'FN') (Note that FVINDEXED is 
  782. *              considered to be set whenever FVFORCEARRAY is set).
  783. *  mkVar.flags2 & MV_fONamInOTyp - set when the oType field is either ET_FS or
  784. *        ET_FT and the fsLength field is the oNam of a CONSTant
  785. *        which gives the length of the fixed length string/text.
  786. *  mkVar.flags2 & MV_fDontCreate - set when MakeVariable is called JUST to 
  787. *              search for an existing variable. Does not create a new variable 
  788. *              if one is not found with this flag set. Non-RELEASE code checks 
  789. *              that no other modification of the variable table takes place 
  790. *              when this is TRUE.
  791. *
  792. *Exit:
  793. *  The return value is an oVar if the high bit (bit 15) is clear, and
  794. *  it's an error code if the high bit is set. 
  795. *
  796. *  If the high bit is not set (and retval is an oVar), if the input mkVar.oTyp 
  797. *  was incorrectly assumed by the caller (i.e., implicitly typed), mkVar.oTyp
  798. *  will contain the correct oTyp on exit. 
  799. *
  800. *  If the high bit is not set, if a CONSTant var entry was found, mkVar.flags2 
  801. *  will have the MV_fConstFound bit set (always reset on exit otherwise).
  802. *
  803. *  If the high bit is set, the LSB is a scanner error code and the MSB
  804. *  minus bit 15 is a parser action code.  The scanner error code is an
  805. *  error which the user will see, whereas the parser action code is an
  806. *  indication to the parser of what action it should take. The codes are 
  807. *  listed below:
  808. *
  809. *  +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
  810. *  |15|14|13|12|11|10| 9| 8| 7| 6| 5| 4| 3| 2| 1| 0|
  811. *  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |  |
  812. *  | E| P| P| P| P| P| P| P| S| S| S| S| S| S| S| S|
  813. *  +--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+--+
  814. *
  815. *  E - Error indicator (error if set)
  816. *  P - Parser action code - bits set for different codes (includes bit 15 set):
  817. *        PRS_ER_RE - Module Rude Edit
  818. *        PRS_ER_RP - opReParse placed before statement
  819. *  S - Scanner error code - decimal number in LSB (see basicmsg.doc)
  820. *
  821. *  If the return value is an error code, and the mkVar.flags2 MV_fTrashTable
  822. *  bit is set, then the caller MUST take action to 'throw away' mrsCur.bdVar; 
  823. *  this flag set on error return indicates that the table has been modified
  824. *  somehow and cannot be used dependably. 
  825. *  Note that this is a non-RELEASE flag; assertion code is used to ensure
  826. *  that a rude edit error is returned whenever this flag is TRUE.
  827. *
  828. *  Note that ER_IER ('Internal Error') is used to signal the case where
  829. *  the caller had the mkVar.flags2 MV_fDontCreate bit set on input and a 
  830. *  matching entry was not found.
  831. *
  832. *  Note that an oVar (pVar) is not an offset (pointer) to the start (low word)
  833. *  of the appropriate variable entry, rather it's an offset (pointer) to the
  834. *  value field in the entry. Other fields are referenced from a pVar via 
  835. *  negative offsets.
  836. *  
  837. *  On exit, the following input flag bits are reset to FALSE in mkVar.flags:
  838. *     FVASCLAUSE, FVFNNAME, FVFORCEARRAY, FVFUNCTION, FVIMPLICIT,
  839. *     FVINDEXED, FVLVAL, FVCONST 
  840. *  On exit, the MV_fONamInOTyp and MV_fDontCreate bits are always reset in
  841. *     in mkVar.flags2.
  842. *Exceptions:
  843. *  none.
  844. *
  845. *******************************************************************************/
  846. ushort NEAR MakeVariable()
  847.    {
  848.    REG1 ushort flags;
  849.    REG2 var *pVar;
  850.    REG3 ushort retval;
  851.    REG4 ushort createMask;
  852.    REG5 ushort oHashCreate;
  853.    REG6 ushort oNamPrs;
  854.    REG7 ushort namChar;
  855.    REG8 boolean fCreate;                     /* used to signal that we don't
  856.                                                 want to create input variable */
  857.    REG9 ushort inputFlags = mkVar.flags;     /* save input mkVar.flags in case
  858.                                                 we must change them locally   */
  859.    ushort mkVarONam;
  860.    ushort mkVarOTyp;
  861.    uchar mkVarCDims;
  862.    boolean fTemp;
  864.    DbAssert(grs.oMrsCur != UNDEFINED)
  865.    DbChkGrs()                    /* sanity check on grs, mrsCur, and prsCur   */
  867.    if (mkVar.flags2 & MV_fONamInOTyp) {
  868.       mkVarONam = mkVar.oNam;
  869.       mkVarOTyp = mkVar.oTyp;
  870.       mkVarCDims = mkVar.cDimensions;
  871.       /* mkVar.fsLength is really an oNam for a CONSTant. We must search local
  872.          var table for this constant (tMV too if we're at proc level) and
  873.          use it's value to set the input oTyp to the appropriate fixed length 
  874.          string constant                                                      */
  875.       DbChkoNam(mkVar.fsLength)
  876.       mkVar.flags2 &= ~MV_fConstFound;
  877.       mkVar.oNam = mkVar.fsLength;
  878.       mkVar.flags = FVIMPLICIT;
  879.       mkVar.oTyp = ET_I2;                    /* CONSTant MUST be an I2     */
  880.       vm_fPVCur = (grs.oPrsCur != UNDEFINED);
  881.       retval = StdSearch();
  882.       if (!vm_fVarFound && !retval && !(vm_fPVCur = !vm_fPVCur))
  883.          /* if we searched tPV and didn't find it, better be in tMV        */
  884.          retval = StdSearch();
  885.       /* restore input values of mkVar struct (must do this here so mkVar.flags
  886.          is correct in case of error)                                         */
  887.       mkVar.oNam = mkVarONam;
  888.       mkVar.oTyp = mkVarOTyp;
  889.       mkVar.flags = inputFlags;
  890.       mkVar.cDimensions = mkVarCDims;
  891.       if (retval || !vm_fVarFound || !(mkVar.flags2 & MV_fConstFound) ||
  892.   (OTypOf(vm_pVarCur) != ET_I2) || (ValueOf(vm_pVarCur, I2) <= 0)) {
  893.                retval = PRS_ER_RP | MSG_InvConst;
  894.                goto RetValExit;
  895.                }
  896.       mkVar.fsLength = ValueOf(vm_pVarCur, I2);
  897.       }
  899.    mkVar.flags &= ~(FVFNNAME | FVIMPLICIT);  /* Initialize the flags to FALSE */
  901.    DbAssertIf(mkVar.flags & FVCONST, 
  902.        (mkVar.oTyp != ET_IMP))
  904.    if ((mkVar.oTyp == ET_IMP) || 
  905.          ((mkVar.oTyp == UNDEFINED) && !(mkVar.flags & FVASCLAUSE)))
  906.       mkVar.flags |= FVIMPLICIT;             /* note that an 'UNDEFINED' oTyp
  907.                                                 could really be a fixed-length
  908.                                                 string of maximal (32K) length.
  909.                                                 The FVASCLAUSE bit removes this
  910.                                                 ambiguity                     */
  911.    if ((namChar = GetVarNamChar(mkVar.oNam)) & 0xff00)
  912.       mkVar.flags |= FVFNNAME;               /* get first logical char of name
  913.                                                 in low byte, & fFNnam in high */
  915.    if (vm_fPVCur = (grs.oPrsCur != UNDEFINED)) {
  916.       DbAssert(prsCur.oVarHash != UNDEFINED)
  917.       DbAssert(prsCur.oVarHash < mrsCur.bdVar.cbLogical)
  918.       if (mkVar.flags & FVCOMMON) {
  919.          retval = PRS_ER_RP | MSG_InvProc;
  920.          goto RetValExit;
  921.          }
  922.       oHashCreate = prsCur.oVarHash;
  923.       /* The below is a speed optimization. oNamOfPrsCur is set by the rude 
  924.          scanner to prevent searching the name table for the proc name for
  925.          each variable reference in the procedure.  When we're called by the
  926.          parser, oNamOfPrsCur will be UNDEFINED and we must do it here.       */
  927.       if ((oNamPrs = oNamOfPrsCur) == UNDEFINED)
  928.          oNamPrs = ONamOfOgNam(prsCur.ogNam);/* [4]                           */
  929.       DbAssert(oNamPrs != 0)                 /* [4] ONamOfOgNam CAN'T ret. OM */
  930.       }
  931.    else {                                    /* no prs active                 */
  932.       if (mkVar.flags & FVSTATIC) {
  933.          retval = PRS_ER_RP | MSG_InvModLev;
  934.          goto RetValExit;
  935.          }
  936.       oHashCreate = 
  937.       oNamPrs = UNDEFINED;
  938.       }
  940.    flags = mkVar.flags;          /* put flags word in a register              */
  942.    if ((flags & FVIMPLICIT) && (mkVar.oTyp != UNDEFINED)) 
  943.          mkVar.oTyp = GetDefaultType((char)namChar);  /* set default type     */
  945.    DbMkVarInp()                  /* special validation code for global inputs */
  947.    /*======================================================================
  948.       'createMask' is a mask used to pass to CreateVar - - - the code below
  949.       depends on the fact that most of the variable entry flags correspond
  950.       in position to the MakeVariable input flags ...                
  951.    =======================================================================*/
  952.    createMask = FVVALUESTORED |
  953.                 (flags & ~(FVREDIRECT | FVEVEREXPLICIT | FVDIM | FV_STATICSET));
  954.    
  955.    nm_mask = 0;                              /* initialize                    */
  956.    vm_oVarCur = UNDEFINED;                   /* initialize                    */
  957.    mkVar.flags2 &= ~MV_fConstFound;          /* initialize                    */
  959.    if (!(flags & (FVFORMAL | FVCOMMON | FVSTATIC | FVSHARED | FVFNNAME |
  960.                   FVFUNCTION | FVCONST))) {
  962.       /*==== SEARCHING FOR VARIABLE IN THE TYPICAL CASE ====*/
  964.       if (retval = StdSearch())
  965.          goto RetValExit;                    /* return error code             */
  967.       if (vm_fPVCur) {                       /* a procedure is active         */
  968.          /*====================================================================
  969.          Even though a procedure is active, we must search the tMV as well
  970.          in one of three possible cases:
  971.          1. A match was not found, and the name table entry indicates that
  972.             there is a module shared variable of this oNam.
  973.          2. A match was not found, and the current prs is for a DEF FN.
  974.          3. We've found a retval in the currently active FUNCTION, but input
  975.             FVLVAL is not set, i.e., we've got a case of self-recursion,
  976.             and thus want to find the tMV FUNCTION reference rather than the
  977.             tPV retval. Note that in this case, we KNOW we'll find a match
  978.             in the tMV, as the reference is to the FUNCTION in prsCur.
  979.          ====================================================================*/
  980.          if ((!vm_fVarFound && 
  981.               ((FlagOfONam(mkVar.oNam) & NM_fShared) ||
  982.                (prsCur.procType == PT_DEFFN))) ||
  983.              (vm_fVarFound && !(flags & FVLVAL) && 
  984.               (FlagsOf(vm_pVarCur) & FVFUN) &&
  985.               (mkVar.oNam == oNamPrs) && (prsCur.procType == PT_FUNCTION))) {
  986.             vm_fPVCur = FALSE;               /* search the tMV                */
  987.             if (retval = StdSearch())
  988.                goto RetValExit;              /* return error code             */
  989.             vm_fPVCur = TRUE;                /* reset                         */
  990.             if (vm_fVarFound) {
  991.        pVar = vm_pVarCur;
  992.        /* [10] set temp boolean TRUE if there exists a module-level
  993.   [10] var of this name (not necessarily the var just found!  */
  994.        fTemp = FlagOfONam(mkVar.oNam) & NM_fShared; /* [10]       */
  995.        if (fTemp && !(FlagsOf(pVar) & (FVFUN | FVCONST))) {   /* [10] */
  996.   if (!(FlagsOf(pVar) & FVSHARED))       /* [10] */
  997.       vm_fVarFound = FALSE;  /* [10] not SHARED, so not found */
  998.   }       /* [10] */
  999.        else if (!fTemp && (prsCur.procType != PT_DEFFN))      /* [10] */
  1000.       vm_fVarFound = FALSE;  /* if not SHARED, then not found */
  1001.                else if ((FlagsOf(pVar) & FVFUN) && (flags & FVLVAL))
  1002.                   if ((mkVar.oNam == oNamPrs) && 
  1003.                       (prsCur.procType == PT_FUNCTION)) { 
  1004.                      /* not found after all - really want to create a retval  */
  1005.                      createMask |= (FVFUN | FVDECLDVAR | FVEVEREXPLICIT);
  1006.                      vm_fVarFound = FALSE;
  1007.                      }
  1008.                   else goto RE_DD_Exit;      /* attempt to assign to a Function
  1009.                                                 outside of the Function       */
  1010.                }  /* if vm_fVarFound */
  1011.             }  /* if !vm_fVarFound && tNam entry fShared bit set */
  1012.          else if (vm_fVarFound && (FlagsOf(vm_pVarCur) & FVSHARED))
  1013.             vm_oVarCur = ValueOf(vm_pVarCur, oMV); 
  1014.                                              /* caller doesn't want oVar for 
  1015.                                                 the SHARED entry in the tPV,
  1016.                                                 he wants the actual tMV entry */
  1017.          }
  1018.       else                                   /* no procedure is active        */
  1019.          if ((flags & FVLVAL) && vm_fVarFound && (FlagsOf(vm_pVarCur) & FVFUN))
  1020.             goto RE_DD_Exit;                 /* attempt to assign to a Function
  1021.                                                 outside of the Function       */
  1022.       if (!vm_fVarFound)
  1023.          if (retval = CreateVar(oHashCreate, createMask))
  1024.             goto RetValExit;                 /* return error code             */
  1025.       }  /* typical case - no special flags set */
  1027.    else {
  1029.       /*==== SEARCHING FOR SOME SPECIAL VAR (i.e., COMMON, STATIC, etc.) =====*/
  1031.       if (flags & (FVFUNCTION | FVFNNAME)) {
  1032.          if (flags & FVFUNCTION) {
  1033.             DbAssert(vm_fPVCur == FALSE)     /* [DECLARE] FUNCTION only legal
  1034.                                                 at module level               */
  1035.             if (retval = FuncSearch())
  1036.                goto RetValExit;
  1037.             pVar = vm_pVarCur;
  1038.             if ((!vm_fVarFound) || (fConvtdToFun)) {
  1039.                if (!fConvtdToFun)         /* function entry doesn't exist yet */
  1040.                   if (retval = CreateVar(UNDEFINED, 
  1041.                         createMask | FVDECLDVAR | FVEVEREXPLICIT | FVSHARED))
  1042.                      goto RetValExit;     /* return error code */
  1043.                if ((NMSP_MASK & FlagOfONam(mkVar.oNam)) == NMSP_Variable) {
  1044.                   /* there exists at some non-FUNCTION variable(s) of this 
  1045.                      oNam somewhere in mrsCur.bdVar                           */
  1046.                   /* now set up inputs for each invocation of ModSharedChk    */
  1047.                   vm_fPVCur = TRUE; 
  1048.                   vm_oVarTmp = vm_oVarCur;
  1049.                   
  1050.                   errVal = 0;
  1051.                   ForEachPrsInMrs(ModSharedChk);
  1052.                
  1053.                   /* reset static variables */
  1054.                   vm_oVarCur = vm_oVarTmp;
  1055.                   vm_fPVCur = FALSE;
  1056.                   retval = errVal;
  1058.                   FlagsOf(vm_pVarCur) |= FVSHARED;
  1059.                   /* remember that an entry of this oNam is module shared: */
  1060.                   nm_mask |= NM_fShared;
  1061.    
  1062.                   if (retval)
  1063.                      goto RetValExit;  
  1064.                   ResetONamMaskTmp(mkVar.oNam,NMSP_Variable);
  1065.                                           /* txtmgr depends on us resetting 
  1066.                                              this bit in this case            */
  1067.                   }
  1068.                }
  1069.             }  /* if FVFUNCTION */
  1071.          else {                  /* must be FVFNNAME */
  1072.             if ((!vm_fPVCur) || (mkVar.oNam != oNamPrs))
  1073.                if (mkVar.flags & FVLVAL)
  1074.                   goto RE_DD_Exit;          
  1075.             if (retval = StdSearch())
  1076.                goto RetValExit;              /* return error code             */
  1077.             if (!vm_fVarFound) {
  1078.                if ((vm_fPVCur) && !(mkVar.flags & FVLVAL)) {
  1079.                   vm_fPVCur = FALSE;         /* search the tMV                */
  1080.                   if (retval = StdSearch())
  1081.                      goto RetValExit;        /* return error code             */
  1082.                   vm_fPVCur = TRUE;          /* reset                         */
  1083.                   }
  1084.                if (!vm_fVarFound)
  1085.                   if (retval = CreateVar(oHashCreate, createMask | FVFUN))
  1086.                      goto RetValExit;        /* return error code             */
  1087.                }
  1088.             }  /* if FVFNNAME */
  1089.          }  /* if FVFUNCTION, of FVFNNAME */
  1091.       else {                                 /* must be FORMAL, STATIC, 
  1092.                                                 COMMON, SHARED, or CONST      */
  1093.          if (retval = StdSearch())
  1094.             goto RetValExit;                 /* return error code             */
  1096.          if (flags & (FVFORMAL | FVSTATIC | FVCONST)) {
  1097.             if (vm_fVarFound)
  1098.                goto RE_DD_Exit;              /* existing var matches formal,
  1099.                                                 static, or const              */
  1100.             if (retval = CreateVar(oHashCreate, createMask))
  1101.                goto RetValExit;              /* return error code             */
  1102.             
  1103.             if ((flags & FVCONST) && !vm_fPVCur) {
  1104.                DbAssert(txdCur.scanState == SS_RUDE)  /* ensure no owners     */
  1105.                FlagsOf(vm_pVarCur) |= FVSHARED;
  1107.                /* remember that an entry of this oNam is module shared: */
  1108.                nm_mask |= NM_fShared;
  1109.                }
  1110.             }  /* if FVFORMAL, FVSTATIC, or FVCONST */
  1112.          else if (flags & FVCOMMON) {
  1113.             fCreate = TRUE;                  /* assume we want to create the
  1114.                                                 variable if not found         */
  1115.             if (vm_fVarFound) {
  1116.                pVar = vm_pVarCur;
  1117.                if (FlagsOf(pVar) & FVARRAY) {
  1118.                   DbAssert(txdCur.scanState == SS_RUDE)  /* ensure no owners  */
  1119.                   FlagsOf(pVar) |= FVCOMMON; /* convert entry to be a COMMON  */
  1120.                   FlagsOf(pVar) &= ~FVVALUESTORED;
  1121.                   fCreate = FALSE;           /* don't want to create too ...  */
  1122.                   }
  1123.        else      /* not an array       */
  1124.   goto RE_DD_Exit;      /* [14]       */
  1125.                }  /* if found */
  1126.             
  1127.             if (fCreate)   
  1128.                if (retval = CreateVar(UNDEFINED, createMask))
  1129.                   goto RetValExit;     /* return error code */
  1131.             if (flags & FVSHARED) {
  1132.                DbAssert(txdCur.scanState == SS_RUDE)  /* ensure no owners     */
  1133.                FlagsOf(vm_pVarCur) |= FVSHARED;
  1135.                /* remember that an entry of this oNam is module shared: */
  1136.                nm_mask |= NM_fShared;
  1137.                }
  1138.             }  /* if FVCOMMON */
  1140.          else {                              /* must be FVSHARED              */
  1141.             DbAssert(flags & FVSHARED)
  1142.             /* NOTE: this case MUST be tested AFTER we check for FVCOMMON     */
  1143.             if (vm_fPVCur) {                 /* active procedure              */
  1144.                if (vm_fVarFound)
  1145.   goto RE_DD_Exit;      /* [14] in case found entry
  1146. [14] contains an owner       */
  1147.                else {                        /* var not found in the tPV      */
  1148.                   vm_fPVCur = FALSE;
  1149.                   if (retval = StdSearch())  /* search tMV                    */
  1150.                      goto RetValExit;
  1151.                   vm_fPVCur = TRUE;          /* reset                         */
  1152.                   if (!vm_fVarFound) {
  1153.                      if (retval = CreateVar(UNDEFINED, createMask & ~FVSHARED))
  1154.                         goto RetValExit;     /* create var a module level     */
  1155.                      }
  1156.                   FlagsOf(vm_pVarCur) |= FVSHARED; /* scanner needs this bit
  1157.                                                       set in module entry.
  1158.                                                       Namespace bit keeps
  1159.                                                       this case straight.     */
  1160.                   vm_oVarTmp = vm_oVarCur;   /* save offset to tMV entry      */
  1161.                   if (retval = CreateVar(prsCur.oVarHash, createMask))
  1162.                      goto RetValExit;        /* return error code             */
  1163.                   pVar = vm_pVarCur;
  1164.                   ValueOf(pVar, oMV) = 
  1165.                   vm_oVarCur = vm_oVarTmp;
  1166.                   }
  1167.                }
  1168.             else {                           /* no proc active - DIM SHARED   */
  1169.                if (!vm_fVarFound)
  1170.                   if (retval = CreateVar(UNDEFINED, createMask))
  1171.                      goto RetValExit;        /* return error code             */
  1172.                /* NOTE: the parser CAN call us here when we're not in SS_RUDE,
  1173.                   NOTE: but the txtmgr guarantees us that if a user enters
  1174.                   NOTE: or modifies a DIM SHARED statement, it will be a rude
  1175.                   NOTE: edit. I.e., we don't need to worry about any proc-level
  1176.                   NOTE: variables here, since the rude scanner scans the
  1177.                   NOTE: module before any of the procedures in the module     */
  1178.                FlagsOf(vm_pVarCur) |= FVSHARED;
  1180.                /* remember that an entry of this oNam is module shared: */
  1181.                nm_mask |= NM_fShared;
  1182.                }
  1183.             }  /* if FVSHARED */
  1185.          }  /* COMMON, SHARED */
  1187.       }  /* some special-case flag(s) is/are set */
  1190.    /* var was either explicitly or implicitly typed; set flag accordingly:    */
  1191.    if (!(flags & FVIMPLICIT))
  1192.       FlagsOf((var *)(mrsCur.bdVar.pb + vm_oVarCur)) |= FVEVEREXPLICIT;
  1194.    if (nm_mask != 0)
  1195.       SetONamMask(mkVar.oNam, nm_mask);      /* don't set name table flag bits
  1196.                                                 until no chance of error      */
  1198.    DbChkoVar(vm_oVarCur)
  1199.    DbChkoTyp(mkVar.oTyp)
  1200.    DbMkVarExit(vm_oVarCur,vm_fVarFound,vm_fPVCur)
  1202.    /* Reset most of the input flags to their default values (FALSE) - - leave
  1203.       the rest as they were on entry                                          */
  1204.    mkVar.exitFlags = mkVar.flags;            /* NOTE: can remove exitFlags
  1205.                                                       when MakeVariable is
  1206.                                                       rewritten in native code*/
  1207.    mkVar.flags = inputFlags & ~(FVFNNAME | FVASCLAUSE | FVIMPLICIT | FVLVAL | 
  1208.      FVFORCEARRAY | FVINDEXED | FVFUNCTION | FVCONST);
  1209.    mkVar.flags2 &= ~(MV_fONamInOTyp | MV_fDontCreate);
  1211.    return(vm_oVarCur);
  1213. RE_DD_Exit:
  1214.    retval = PRS_ER_RE | ER_DD;
  1215. RetValExit:
  1216.    DbMkVarExit(retval,vm_fVarFound,vm_fPVCur)
  1217.    /* Reset most of the input flags to their default values (FALSE) - - leave
  1218.       the rest as they were on entry                                          */
  1219.    mkVar.exitFlags = mkVar.flags;            /* NOTE: can remove exitFlags
  1220.                                                       when MakeVariable is
  1221.                                                       rewritten in native code*/
  1222.    mkVar.flags = inputFlags & ~(FVFNNAME | FVASCLAUSE | FVIMPLICIT | FVLVAL | 
  1223.      FVFORCEARRAY | FVINDEXED | FVFUNCTION | FVCONST);
  1224.    mkVar.flags2 &= ~(MV_fONamInOTyp | MV_fDontCreate);
  1226.    return(retval);
  1227.    }  /* MakeVariable */
  1230. /*##############################################################################
  1231. #                                                                              #
  1232. #                 Call-back code, for when a variable table moves              #
  1233. #                                                                              #
  1234. ##############################################################################*/
  1235. /***
  1236. *AdjustStatChain(pVarTable, oVar, cbAdjust)
  1237. *Purpose:
  1238. *  Adjust the back pointers to AD's and SD's in all static variables in
  1239. *  the current hash chain by cbAdjust bytes.
  1240. *  Note that this code is shared by AdjustMrsVarTable and AdjustPrsVarTable.
  1241. *
  1242. *Entry:
  1243. *  pVarTable is the base pointer for the variable table.
  1244. *  oVar is an offset into a variable table to the first var in a chain.
  1245. *  cbAdjust is an adjustment factor to be added to appropriate backpointers.
  1246. *
  1247. *Exit:
  1248. *  none.
  1249. *
  1250. *Exceptions:
  1251. *  none.
  1252. *
  1253. *******************************************************************************/
  1254. STATICF(VOID) AdjustStatChain(pVarTable, oVar, cbAdjust)
  1255. var *pVarTable;
  1256. REG2 ushort oVar;
  1257. ushort cbAdjust;
  1258.    {
  1259.    REG1 var *pVar;
  1260.    REG3 ushort flags;
  1262.    while (oVar != 0) {
  1263.       pVar = (var *)((char *)pVarTable + oVar);
  1264.       flags = FlagsOf(pVar);
  1265.       oVar = (OHashLinkOf(pVar) & 0xFFFE);
  1267.       if ((flags & FVFUN) || !(flags & FVVALUESTORED))
  1268.          continue;
  1269.       if (flags & FVARRAY) {
  1270.          if ((ValueOf(pVar, aryStat.aryDsc.fFeatures & FADF_SD)) &&
  1271.              (ValueOf(pVar, aryStat.aryDsc.pNext) != NOT_OWNER))
  1272.                   B_IAdUpd(&(ValueOf(pVar, aryStat.aryDsc)), cbAdjust);
  1273.          }
  1274.       else if ((OTypOf(pVar) == ET_SD) && (ValueOf(pVar,sdStr.pb) != NULL)) {
  1275.          B_ISdUpd(&(ValueOf(pVar, sdStr)), cbAdjust);
  1276.          }
  1277.       }  /* while */
  1278.    }  /* AdjustStatChain */
  1280. /***
  1281. *AdjustMrsVarTable(pVarTable, cbAdjust)
  1282. *
  1283. *Purpose:
  1284. *  Adjust the back pointers to AD's and SD's in all static variables in
  1285. *  the tMV by cbAdjust bytes.
  1286. *
  1287. *Entry:
  1288. *  pVarTable is the base pointer for the variable table.
  1289. *  cbAdjust is an adjustment factor to be added to appropriate backpointers.
  1290. *
  1291. *Exit:
  1292. *  none.
  1293. *
  1294. *Exceptions:
  1295. *  none.
  1296. *
  1297. *******************************************************************************/
  1298. VOID NEAR AdjustMrsVarTable(pVarTable, cbAdjust)
  1299. var *pVarTable;
  1300. ushort cbAdjust;
  1301.    {
  1302.    REG1 ushort iHash;
  1303.    REG2 ushort *pHash = (ushort *)pVarTable; /* tMV hash tbl @ start    */
  1305.    for (iHash = 0; iHash < CBINITMVHASH/2; iHash++)
  1306.       AdjustStatChain(pVarTable, *pHash++, cbAdjust);
  1307.    }  /* AdjustMrsVarTable */
  1309. /***
  1310. *AdjustPrsVarTable(pVarTable, oVarHash, cbAdjust)
  1311. *
  1312. *Purpose:
  1313. *  Adjust the back pointers to AD's and SD's in all static variables in
  1314. *  the given tPV by cbAdjust bytes.
  1315. *
  1316. *Entry:
  1317. *  pVarTable is the base pointer for the variable table.
  1318. *  oVarHash is the offset in the variable table to the tPV hash table.
  1319. *  cbAdjust is an adjustment factor to be added to appropriate backpointers.
  1320. *
  1321. *Exit:
  1322. *  none.
  1323. *
  1324. *Exceptions:
  1325. *  none.
  1326. *
  1327. *******************************************************************************/
  1328. VOID NEAR AdjustPrsVarTable(pVarTable, oVarHash, cbAdjust)
  1329. var *pVarTable;
  1330. ushort oVarHash;
  1331. ushort cbAdjust;
  1332.    {
  1333.    REG1 ushort iHash;
  1334.    REG2 ushort *pHash = (ushort *)((char *)pVarTable + oVarHash);
  1335.    
  1336.    if (oVarHash != UNDEFINED)
  1337.       for (iHash = 0; iHash < CBINITPVHASH/2; iHash++)
  1338.          AdjustStatChain(pVarTable, *pHash++, cbAdjust);
  1339.    }  /* AdjustPrsVarTable */