urflibs/init/bootstrap/80-locals.f

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