a68g-frames.h

     
   1  //! @file a68g-frames.h
   2  //! @author J. Marcel van der Veer
   3  //!
   4  //! @section Copyright
   5  //!
   6  //! This file is part of Algol68G - an Algol 68 compiler-interpreter.
   7  //! Copyright 2001-2023 J. Marcel van der Veer [algol68g@xs4all.nl].
   8  //!
   9  //! @section License
  10  //!
  11  //! This program is free software; you can redistribute it and/or modify it 
  12  //! under the terms of the GNU General Public License as published by the 
  13  //! Free Software Foundation; either version 3 of the License, or 
  14  //! (at your option) any later version.
  15  //!
  16  //! This program is distributed in the hope that it will be useful, but 
  17  //! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY 
  18  //! or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for 
  19  //! more details. You should have received a copy of the GNU General Public 
  20  //! License along with this program. If not, see [http://www.gnu.org/licenses/].
  21  
  22  #if !defined (__A68G_FRAMES_H__)
  23  #define __A68G_FRAMES_H__
  24  
  25  // Operations on stack frames
  26  
  27  #define FRAME_ADDRESS(n) ((BYTE_T *) &(A68_STACK[n]))
  28  #define FACT(n) ((ACTIVATION_RECORD *) FRAME_ADDRESS (n))
  29  #define FRAME_CLEAR(m) FILL ((BYTE_T *) FRAME_OFFSET (FRAME_INFO_SIZE), 0, (m))
  30  #define FRAME_BLOCKS(n) (BLOCKS (FACT (n)))
  31  #define FRAME_DYNAMIC_LINK(n) (DYNAMIC_LINK (FACT (n)))
  32  #define FRAME_DNS(n) (DYNAMIC_SCOPE (FACT (n)))
  33  #define FRAME_INCREMENT(n) (AP_INCREMENT (TABLE (FRAME_TREE(n))))
  34  #define FRAME_INFO_SIZE (A68_FRAME_ALIGN (sizeof (ACTIVATION_RECORD)))
  35  #define FRAME_JUMP_STAT(n) (JUMP_STAT (FACT (n)))
  36  #define FRAME_LEXICAL_LEVEL(n) (FRAME_LEVEL (FACT (n)))
  37  #define FRAME_LOCAL(n, m) (FRAME_ADDRESS ((n) + FRAME_INFO_SIZE + (m)))
  38  #define FRAME_NUMBER(n) (FRAME_NO (FACT (n)))
  39  #define FRAME_OBJECT(n) (FRAME_OFFSET (FRAME_INFO_SIZE + (n)))
  40  #define FRAME_OFFSET(n) (FRAME_ADDRESS (A68_FP + (n)))
  41  #define FRAME_PARAMETER_LEVEL(n) (PARAMETER_LEVEL (FACT (n)))
  42  #define FRAME_PARAMETERS(n) (PARAMETERS (FACT (n)))
  43  #define FRAME_PROC_FRAME(n) (PROC_FRAME (FACT (n)))
  44  #define FRAME_SIZE(fp) (FRAME_INFO_SIZE + FRAME_INCREMENT (fp))
  45  #define FRAME_STATIC_LINK(n) (STATIC_LINK (FACT (n)))
  46  #define FRAME_TREE(n) (NODE (FACT (n)))
  47  
  48  #if defined (BUILD_PARALLEL_CLAUSE)
  49  #define FRAME_THREAD_ID(n) (THREAD_ID (FACT (n)))
  50  #endif
  51  
  52  #define FOLLOW_SL(dest, l) {\
  53    (dest) = A68_FP;\
  54    if ((l) <= FRAME_PARAMETER_LEVEL ((dest))) {\
  55      (dest) = FRAME_PARAMETERS ((dest));\
  56    }\
  57    while ((l) != FRAME_LEXICAL_LEVEL ((dest))) {\
  58      (dest) = FRAME_STATIC_LINK ((dest));\
  59    }}
  60  
  61  #define FOLLOW_STATIC_LINK(dest, l) {\
  62    if ((l) == A68 (global_level) && A68_GLOBALS > 0) {\
  63      (dest) = A68_GLOBALS;\
  64    } else {\
  65      FOLLOW_SL (dest, l)\
  66    }}
  67  
  68  #define FRAME_GET(dest, cast, p) {\
  69    ADDR_T _m_z;\
  70    FOLLOW_STATIC_LINK (_m_z, LEVEL (GINFO (p)));\
  71    (dest) = (cast *) & (OFFSET (GINFO (p))[_m_z]);\
  72    }
  73  
  74  #define GET_FRAME(dest, cast, level, offset) {\
  75    ADDR_T _m_z;\
  76    FOLLOW_SL (_m_z, (level));\
  77    (dest) = (cast *) & (A68_STACK [_m_z + FRAME_INFO_SIZE + (offset)]);\
  78    }
  79  
  80  #define GET_GLOBAL(dest, cast, offset) {\
  81    (dest) = (cast *) & (A68_STACK [A68_GLOBALS + FRAME_INFO_SIZE + (offset)]);\
  82    }
  83  
  84  // Opening of stack frames is in-line
  85  
  86  // 
  87  // STATIC_LINK_FOR_FRAME: determine static link for stack frame.
  88  // new_lex_lvl: lexical level of new stack frame.
  89  // returns: static link for stack frame at 'new_lex_lvl'. 
  90  
  91  #define STATIC_LINK_FOR_FRAME(dest, new_lex_lvl) {\
  92    int _m_cur_lex_lvl = FRAME_LEXICAL_LEVEL (A68_FP);\
  93    if (_m_cur_lex_lvl == (new_lex_lvl)) {\
  94      (dest) = FRAME_STATIC_LINK (A68_FP);\
  95    } else if (_m_cur_lex_lvl > (new_lex_lvl)) {\
  96      ADDR_T _m_static_link = A68_FP;\
  97      while (FRAME_LEXICAL_LEVEL (_m_static_link) >= (new_lex_lvl)) {\
  98        _m_static_link = FRAME_STATIC_LINK (_m_static_link);\
  99      }\
 100      (dest) = _m_static_link;\
 101    } else {\
 102      (dest) = A68_FP;\
 103    }}
 104  
 105  #define INIT_STATIC_FRAME(p) {\
 106    FRAME_CLEAR (AP_INCREMENT (TABLE (p)));\
 107    if (INITIALISE_FRAME (TABLE (p))) {\
 108      initialise_frame (p);\
 109    }}
 110  
 111  #define INIT_GLOBAL_POINTER(p) {\
 112    if (LEX_LEVEL (p) == A68 (global_level)) {\
 113      A68_GLOBALS = A68_FP;\
 114    }}
 115  
 116  #if defined (BUILD_PARALLEL_CLAUSE)
 117  #define OPEN_STATIC_FRAME(p) {\
 118    ADDR_T dynamic_link = A68_FP, static_link;\
 119    ACTIVATION_RECORD *act, *pre;\
 120    STATIC_LINK_FOR_FRAME (static_link, LEX_LEVEL (p));\
 121    pre = FACT (A68_FP);\
 122    A68_FP += FRAME_SIZE (dynamic_link);\
 123    act = FACT (A68_FP);\
 124    FRAME_NO (act) = FRAME_NO (pre) + 1;\
 125    FRAME_LEVEL (act) = LEX_LEVEL (p);\
 126    PARAMETER_LEVEL (act) = PARAMETER_LEVEL (pre);\
 127    PARAMETERS (act) = PARAMETERS (pre);\
 128    STATIC_LINK (act) = static_link;\
 129    DYNAMIC_LINK (act) = dynamic_link;\
 130    DYNAMIC_SCOPE (act) = A68_FP;\
 131    NODE (act) = p;\
 132    JUMP_STAT (act) = NO_JMP_BUF;\
 133    PROC_FRAME (act) = A68_FALSE;\
 134    THREAD_ID (act) = pthread_self ();\
 135    }
 136  #else
 137  #define OPEN_STATIC_FRAME(p) {\
 138    ADDR_T dynamic_link = A68_FP, static_link;\
 139    ACTIVATION_RECORD *act, *pre;\
 140    STATIC_LINK_FOR_FRAME (static_link, LEX_LEVEL (p));\
 141    pre = FACT (A68_FP);\
 142    A68_FP += FRAME_SIZE (dynamic_link);\
 143    act = FACT (A68_FP);\
 144    FRAME_NO (act) = FRAME_NO (pre) + 1;\
 145    FRAME_LEVEL (act) = LEX_LEVEL (p);\
 146    PARAMETER_LEVEL (act) = PARAMETER_LEVEL (pre);\
 147    PARAMETERS (act) = PARAMETERS (pre);\
 148    STATIC_LINK (act) = static_link;\
 149    DYNAMIC_LINK (act) = dynamic_link;\
 150    DYNAMIC_SCOPE (act) = A68_FP;\
 151    NODE (act) = p;\
 152    JUMP_STAT (act) = NO_JMP_BUF;\
 153    PROC_FRAME (act) = A68_FALSE;\
 154    }
 155  #endif
 156  
 157  //! @def OPEN_PROC_FRAME
 158  //! @brief Open a stack frame for a procedure.
 159  
 160  #if defined (BUILD_PARALLEL_CLAUSE)
 161  #define OPEN_PROC_FRAME(p, environ) {\
 162    ADDR_T dynamic_link = A68_FP, static_link;\
 163    ACTIVATION_RECORD *act;\
 164    LOW_STACK_ALERT (p);\
 165    static_link = (environ > 0 ? environ : A68_FP);\
 166    if (A68_FP < static_link) {\
 167      diagnostic (A68_RUNTIME_ERROR, (p), ERROR_SCOPE_DYNAMIC_0);\
 168      exit_genie (p, A68_RUNTIME_ERROR);\
 169    }\
 170    A68_FP += FRAME_SIZE (dynamic_link);\
 171    act = FACT (A68_FP);\
 172    FRAME_NO (act) = FRAME_NUMBER (dynamic_link) + 1;\
 173    FRAME_LEVEL (act) = LEX_LEVEL (p);\
 174    PARAMETER_LEVEL (act) = LEX_LEVEL (p);\
 175    PARAMETERS (act) = A68_FP;\
 176    STATIC_LINK (act) = static_link;\
 177    DYNAMIC_LINK (act) = dynamic_link;\
 178    DYNAMIC_SCOPE (act) = A68_FP;\
 179    NODE (act) = p;\
 180    JUMP_STAT (act) = NO_JMP_BUF;\
 181    PROC_FRAME (act) = A68_TRUE;\
 182    THREAD_ID (act) = pthread_self ();\
 183    }
 184  #else
 185  #define OPEN_PROC_FRAME(p, environ) {\
 186    ADDR_T dynamic_link = A68_FP, static_link;\
 187    ACTIVATION_RECORD *act;\
 188    LOW_STACK_ALERT (p);\
 189    static_link = (environ > 0 ? environ : A68_FP);\
 190    if (A68_FP < static_link) {\
 191      diagnostic (A68_RUNTIME_ERROR, (p), ERROR_SCOPE_DYNAMIC_0);\
 192      exit_genie (p, A68_RUNTIME_ERROR);\
 193    }\
 194    A68_FP += FRAME_SIZE (dynamic_link);\
 195    act = FACT (A68_FP);\
 196    FRAME_NO (act) = FRAME_NUMBER (dynamic_link) + 1;\
 197    FRAME_LEVEL (act) = LEX_LEVEL (p);\
 198    PARAMETER_LEVEL (act) = LEX_LEVEL (p);\
 199    PARAMETERS (act) = A68_FP;\
 200    STATIC_LINK (act) = static_link;\
 201    DYNAMIC_LINK (act) = dynamic_link;\
 202    DYNAMIC_SCOPE (act) = A68_FP;\
 203    NODE (act) = p;\
 204    JUMP_STAT (act) = NO_JMP_BUF;\
 205    PROC_FRAME (act) = A68_TRUE;\
 206    }
 207  #endif
 208  
 209  #define CLOSE_FRAME {\
 210    ACTIVATION_RECORD *act = FACT (A68_FP);\
 211    A68_FP = DYNAMIC_LINK (act);\
 212    }
 213  
 214  #endif