urflibs/locals.f

   1 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; and now for something completely different...
   3 ;; UrForth/C Forth Engine!
   4 ;; Copyright (C) 2023 Ketmar Dark // Invisible Vector
   5 ;; GPLv3 ONLY
   6 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   7 ;; local variables support
   8 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   9
  10 (*
  11   : myword  ( a b -- c )
  12     args: a b
  13     locals: loc1 loc2
  14
  15     :a TO :loc1
  16     :b TO :loc2
  17     :loc1 :loc2 +
  18   ;
  19 here, "args:" will declare local variables, and automatically fill them
  20 with arguments from the data stack. "locals:" declare "free" locals.
  21 there can be more than one "locals:" section, but all such sections should
  22 come before anything else. to use local, you must prepend its name with a
  23 colon. the usual "TO" word is used to set local values.
  24 *)
  25
  26 VOCABULARY (LOCALS-SUPPORT)
  27 ALSO (LOCALS-SUPPORT) DEFINITIONS
  28
  29 ;; offset in temp (user) dict
  30 ;; should be enough for now ;-)
  31 65536 CONSTANT LOCALS-TEMP-VOC-OFFSET
  32
  33 0 VALUE LOCALS-DP-TEMP
  34 0 VALUE LOCALS-VOCID
  35
  36 : NEW-LOCALS-WORDLIST  ( -- )
  37   FORTH:(DP-TEMP) @   ;; save it
  38   FORTH:(ADDR-TEMP-BIT) LOCALS-TEMP-VOC-OFFSET + FORTH:(DP-TEMP) !
  39   0 FALSE FORTH:(NEW-WORDLIST) TO LOCALS-VOCID
  40   HERE TO LOCALS-DP-TEMP
  41   FORTH:(DP-TEMP) !
  42 ;
  43
  44 ;; (L-ENTER) arg:
  45 ;; low byte of loccount is total number of locals
  46 ;; high byte is the number of args
  47
  48 : LATEST-HAS-LOCALS?  ( -- bool )
  49   LATEST-PFA DUP HERE = IF DROP FALSE
  50   ELSE @ ['] FORTH:(L-ENTER) =
  51   ENDIF
  52 ;
  53
  54 : START-LOCALS  ( -- )
  55   LATEST-PFA HERE <> IF
  56     LATEST-HAS-LOCALS? " \`locals:\` or \`args:\` should be the first word" ?NOT-ERROR
  57   ELSE  ;; init locals
  58     NEW-LOCALS-WORDLIST COMPILE FORTH:(L-ENTER) 0 ,
  59   ENDIF
  60 ;
  61
  62 : ADD-LOCAL  ( addr count -- )
  63   START-LOCALS
  64   LATEST-PFA CELL+  DUP C@ 255 = " too many locals" ?ERROR
  65   1 OVER +! C@ >R  ;; save current local number to RSTACK
  66   ;; now create access word
  67   FORTH:(DP-TEMP) @  CURRENT @
  68   LOCALS-DP-TEMP FORTH:(DP-TEMP) !  LOCALS-VOCID CURRENT !
  69   \ ." DP: " FORTH:(DP) @ . CR
  70   \ ." DP-TEMP: " FORTH:(DP-TEMP) @ . CR
  71   \ ." HERE: " HERE . CR
  72   2SWAP
  73   \ 2DUP XTYPE CR
  74   COMPILER:(CREATE-HEADER)
  75   COMPILER:(CFAIDX-DO-CONST) ,  ;; why not
  76   R> ,  ;; local index
  77   COMPILER:RESET-SMUDGE
  78   FORTH:(DP-TEMP) @ HERE <> " WTF?!" ?ERROR  ;; assertion
  79   HERE TO LOCALS-DP-TEMP
  80   ;; restore voc and DP
  81   CURRENT !  FORTH:(DP-TEMP) !
  82 ;
  83
  84 ;; create local access words, adjust "(L-ENTER)"
  85 : ADD-ARG  ( addr count -- )
  86   ADD-LOCAL 0x01_00 LATEST-PFA CELL+ +!
  87 ;
  88
  89 : PARSE-LOC-LIST  ( regcfa -- )
  90   >R BEGIN
  91     PARSE-SKIP-LINE-COMMENTS
  92     PARSE-NAME ?DUP
  93   WHILE
  94     R@ EXECUTE
  95   REPEAT
  96   DROP RDROP
  97 ;
  98
  99
 100 ..: FORTH:(EXIT-EXTENDER)  ( -- )
 101   LATEST-HAS-LOCALS? IF COMPILE FORTH:(L-LEAVE) ENDIF
 102 ;..
 103
 104
 105 : FIND-LOCAL  ( addr count -- addr count FALSE / idx TRUE )
 106   FALSE >R
 107   2DUP  1 >  SWAP C@ [CHAR] : =  AND IF
 108     LATEST-HAS-LOCALS? IF  ( addr count | ret-flag )
 109       OVER 1+ OVER 1- LOCALS-VOCID FIND-WORD-IN-VOC
 110       IF  ;; i found her!
 111         >R 2DROP R> CFA->PFA @
 112         RDROP TRUE >R
 113       ENDIF
 114     ENDIF
 115   ENDIF
 116   R>
 117 ;
 118
 119 ..: FORTH:(TO-EXTENDER)  ( addr count FALSE -- addr count FALSE / TRUE )
 120   DUP IFNOT
 121     STATE @ IF DROP
 122       FIND-LOCAL IF LITERAL COMPILE FORTH:(LOCAL!) TRUE
 123       ELSE FALSE
 124       ENDIF
 125     ENDIF
 126   ENDIF
 127 ;..
 128
 129
 130 ..: FORTH:(INTERPRET-CHECK-WORD)  ( addr count FALSE -- addr count FALSE / TRUE )
 131   DUP IFNOT
 132     STATE @ IF DROP
 133       FIND-LOCAL IF LITERAL COMPILE FORTH:(LOCAL@) TRUE
 134       ELSE FALSE
 135       ENDIF
 136     ENDIF
 137   ENDIF
 138 ;..
 139
 140
 141 PREVIOUS DEFINITIONS
 142
 143
 144 : ARGS:    ['] (LOCALS-SUPPORT):ADD-ARG (LOCALS-SUPPORT):PARSE-LOC-LIST ; IMMEDIATE
 145 : LOCALS:  ['] (LOCALS-SUPPORT):ADD-LOCAL (LOCALS-SUPPORT):PARSE-LOC-LIST ; IMMEDIATE