meta/meta-50-tc-imm-99-populate.f

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; UrForth level 1: self-hosting 32-bit Forth compiler
   3 ;; Metacompiler
   4 ;; Copyright (C) 2020 Ketmar Dark // Invisible Vector
   5 ;; GPLv3 ONLY
   6 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   7
   8 ;; create aliases for all public words from vocid
   9 : tc-populate-vocid  ( srcvocid destvocid -- )
  10   current @ >r ;; save "CURRENT"
  11   current !
  12   [:  ( nfa -- exitflag )
  13     dup nfa->ffa ffa@ [ (WFLAG-SMUDGE) (WFLAG-HIDDEN) or ] literal and
  14     ifnot
  15       ;; sanity check
  16       dup id-count 3 > swap 3 " TC-" s= or if
  17           \ endcr dup id-count 3 /string type cr
  18         ;; (ALIAS)
  19         ;; create new word
  20         dup nfa->cfa swap id-count 3 /string
  21         forth:(alias-str)
  22       else
  23         endcr ." non-hidden non-tc tc immediate \`" id-count type ." \`\n"
  24         abort" non-hidden non-tc tc immediate"
  25         \ drop
  26       endif
  27     else
  28       drop
  29     endif
  30     false
  31   ;] foreach-word drop
  32   \ previous
  33   r> current !  ;; restore "CURRENT"
  34 ;
  35
  36
  37 vocabulary tc-immediates
  38 \ also tc-immediates definitions
  39 vocid-of tc-immediates-src vocid-of tc-immediates tc-populate-vocid