fth/flkcfstack.fs

   1 \  FLK control flow stack
   2 \
   3 \  Copyright (C) 1998 Lars Krueger
   4 \
   5 \  This file is part of FLK.
   6 \
   7 \  FLK is free software; you can redistribute it and/or
   8 \  modify it under the terms of the GNU General Public License
   9 \  as published by the Free Software Foundation; either version 2
  10 \  of the License, or (at your option) any later version.
  11 \
  12 \  This program is distributed in the hope that it will be useful,
  13 \  but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 \  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 \  GNU General Public License for more details.
  16 \
  17 \  You should have received a copy of the GNU General Public License
  18 \  along with this program; if not, write to the Free Software
  19 \  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20
  21 \ $Id: flkcfstack.fs,v 1.3 1998/09/13 21:28:56 root Exp $
  22 \ $Log: flkcfstack.fs,v $
  23 \ Revision 1.3  1998/09/13 21:28:56  root
  24 \ fixed cf stackk bugs
  25 \
  26 \ Revision 1.2  1998/09/13 16:14:56  root
  27 \ fixed cf stack item description
  28 \
  29 \ Revision 1.1  1998/09/13 15:42:04  root
  30 \ Initial revision
  31 \
  32
  33 \ Structure of one control flow stack item
  34 \ Offset  meaning
  35 \ 0     type
  36 \ 1 byte  type dependent data
  37
  38 \ Possible types of CF stack items
  39 0 CONSTANT CFT-orig
  40 1 CONSTANT CFT-dest
  41 2 CONSTANT CFT-do
  42 3 CONSTANT CFT-colon
  43 4 CONSTANT CFT-case
  44 5 CONSTANT CFT-callback
  45
  46 \ Data format for CFT-orig
  47 \ Offset  meaning
  48 \ 0     type
  49 \ 1 byte  allocator state
  50 \ 3 cells   addr of jump distance
  51
  52 \ Data format for CFT-dest
  53 \ Offset  meaning
  54 \ 0     type
  55 \ 1 byte  allocator state
  56 \ 3 cells   addr of jump target
  57
  58 \ Data format for CFT-do
  59 \ Offset  meaning
  60 \ 0     type
  61 \ 1 byte  last allocator state
  62 \ 3 cells   a1=addr. of inner code
  63 \ 4 cells   a3=fix-addr for ?DO
  64 \ 5 cells   last-leave
  65
  66 \ Data format for CFT-case
  67 \ Offset  meaning
  68 \ 0     type
  69 \ 3 cells   count
  70
  71 \ LEAVEs are stored as linked lists starting at last-leave (the global
  72 \ variable)
  73
  74 \ Data format for CFT-colon (host)
  75 \ Offset  meaning
  76 \ 0     type
  77 \ 3 cells   header address
  78 \ 4 cells   primitive?
  79
  80 \ Data format for CFT-colon (target)
  81 \ Offset  meaning
  82 \ 0     type
  83 \ 3 cells   header address
  84
  85 \ Data format for CFT-callback
  86 \ Offset  meaning
  87 \ 0     type
  88 \ 3 cells   header address
  89 \ 4 cells   return type
  90
  91 \ Total size of one CF stack item: 6 CELLS
  92
  93 \ Create the stack itself.
  94 CREATE cf-stack 6 CELLS CF-ITEMS * ALLOT
  95
  96 \ The stack pointer
  97 VARIABLE cf-sp
  98
  99 \ Find the n-th top of control flow stack item.
 100 : (#-top-cf-item)       ( n -- addr )
 101 ( OK )
 102   cf-sp @ SWAP -      \ offs
 103   DUP 0< IF -22 THROW THEN    \ offs
 104   6 CELLS * cf-stack +      \ addr
 105 ;
 106
 107 : .cf-type        ( type -- )
 108     CASE
 109       CFT-orig OF ." orig " ENDOF
 110       CFT-dest OF ." dest " ENDOF
 111       CFT-do OF ." do-sys " ENDOF
 112       CFT-colon OF ." colon-sys " ENDOF
 113       CFT-case OF ." case " ENDOF
 114       CFT-callback OF ." callback " ENDOF
 115       DUP ." unknown (" . ." ) "
 116     ENDCASE ;
 117
 118 \ Print the CF-stack.
 119 : .CS           ( -- )
 120 ( OK )
 121   cf-sp @ -1 = IF ." CF stack empty." CR EXIT THEN
 122   cf-sp @ 1+ 0 DO
 123     I (#-top-cf-item) DUP     \ addr addr
 124     C@ .cf-type       \ addr
 125 \     CHAR+ DUP C@ DUP . ." regs: "   \ addr #regs
 126 \     0 ?DO         \ addr
 127 \       CHAR+ DUP C@      \ addr vreg
 128 \       CASE
 129 \         VREG-EAX OF ." eax " ENDOF
 130 \         VREG-EBX OF ." ebx " ENDOF
 131 \         VREG-ECX OF ." ecx " ENDOF
 132 \         VREG-EDX OF ." edx " ENDOF
 133 \         VREG-ESI OF ." esi " ENDOF
 134 \         VREG-EDI OF ." edi " ENDOF
 135 \         DUP ." unknown(" . ." ) "
 136 \       ENDCASE
 137 \     LOOP
 138     DROP CR
 139   LOOP
 140 ;
 141
 142 \ Return the current cf-item.
 143 : (curr-cf-item)      ( -- addr )
 144   cf-sp @ 6 CELLS * cf-stack + ;
 145
 146 \ Allocate a new item.
 147 : (new-cs-item)       ( type -- )
 148   1 cf-sp +!
 149   cf-sp @ CF-ITEMS = IF .CS -52 THROW THEN
 150   (curr-cf-item) C! ;
 151
 152 \ Delete the current item.
 153 : (delete-cs-item)      ( -- )
 154   -1 cf-sp +! ;
 155
 156 \ Check if the current item is of correct type.
 157 : (check-cs-item)       ( type -- )
 158   (curr-cf-item) C@ 2DUP <> IF
 159     .cf-type ." found, " .cf-type ." expected." CR
 160     .CS -22 THROW
 161   ELSE
 162     2DROP
 163   THEN ;
 164
 165 \ See standard.
 166 : (CS-PICK)         ( n -- )
 167 ( OK )
 168   (#-top-cf-item)       \ addr
 169   0 (new-cs-item)       \ addr
 170   (curr-cf-item)      \ from to
 171   6 CELLS MOVE
 172 ;
 173
 174 \ See standard.
 175 : (CS-ROLL)         ( u -- )
 176 ( OK )
 177 \ cu cu-1 cu-2 ... c0 -- cu-1 cu-2 ... c0 cu
 178   DUP (CS-PICK)       \ u / cu cu-1 ... c0 cu
 179   DUP (#-top-cf-item)       \ u addr-u-1(=from)
 180   OVER 1+ (#-top-cf-item)     \ u from addr-u(=to)
 181   ROT 1+ 6 CELLS * MOVE
 182   (delete-cs-item)
 183 ;