language/dynamic/command-line.e


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61

8 2 * allocate s" argument-scan-state" variable
: argument-scan-state-next-argument-handle ;
: argument-scan-state-n-remaining-arguments 8 + ;

~ (next argument handle, n remaining arguments --)
: save-argument-scan-state
  argument-scan-state argument-scan-state-n-remaining-arguments !
  argument-scan-state argument-scan-state-next-argument-handle ! ;
~ (-- next argument handle, n remaining arguments)
: restore-argument-scan-state
  argument-scan-state argument-scan-state-next-argument-handle @
  argument-scan-state argument-scan-state-n-remaining-arguments @ ;

~ (argument pointer -- *)
: process-command-line-argument
  dup find dup {
    ~ (argument pointer, entry pointer)
    swap drop
    interpreter-flags @ 0x01 & {
      dup entry-flags@ 1 &
      swap entry-to-execution-token swap
      { execute } { , } if-else
    } { entry-to-execution-token execute } if-else
  } {
    drop
    ~ (argument pointer)
    dup read-integer 0 = {
      ~ (argument pointer, integer value)
      interpreter-flags @ 0x01 & {
        x' lit , ,
        drop
      } {
        swap drop
      } if-else
    } {
      ~ (argument pointer)
      ." No such word: " emitstring newline
    } if-else
  } if-else ;

: process-command-line-arguments
  s0 @
  dup @
  swap 8 +
  swap
  ~ (next argument handle, n remaining arguments)
  dup {
    ~ Skip the executable name.
    1- swap 8 + swap

    { dup } {
      over @
      3unroll save-argument-scan-state

      process-command-line-argument

      restore-argument-scan-state
      1- swap 8 + swap
    } while
  } if 2drop ;