2hw.fs

   1 \ http://www.complang.tuwien.ac.at/forth/gforth/Docs-html/Tutorial.html
   2 \ all `ass*' words are `( -- )' if not stated otherwise.
   3
   4 : rr ( -- ) s" 2hw.fs" included ;
   5 : :r rr ; \ ghci style
   6
   7
   8 \ ============================== 3.24 ========================================
   9 \ Assignment: Emit ( c -- ) types c as character (not a number). Implement
  10 \ type ( addr u -- ).
  11
  12 : type ( addr u -- )
  13         swap 1 chars - swap
  14         0 u+do
  15                 char+ dup c@ emit
  16         loop drop ;
  17 \ ============================== 3.27 ========================================
  18 \ Assignment: How could you modify copy-file so that it copies until a second
  19 \ line is matched? Can you write a program that extracts a section of a text
  20 \ file, given the line that starts and the line that terminates that section?
  21
  22 s" 1hw.fs" r/o open-file throw Value fd-in
  23 s" lol.out" w/o create-file throw Value fd-out
  24 512 Constant max-line
  25 Create line-buffer  max-line 2 + allot
  26
  27 \ TODO
  28 : copy-file ( -- )
  29         begin
  30                 line-buffer max-line fd-in read-line throw
  31         while
  32                 line-buffer swap fd-out write-line throw
  33         repeat ;
  34
  35 \ ============================== 3.29 ========================================
  36 : map-array ( ... addr u xt -- ... )
  37         \ executes xt ( ... x -- ... ) for every element of the array starting
  38         \ at addr and containing u elements
  39         { xt }
  40         cells over + swap ?do
  41                 i @ xt execute
  42         1 cells +loop ;
  43
  44 \ ============================== 3.31 ========================================
  45 : defer
  46         create ['] abort ,
  47         does> @ execute ;
  48
  49 : is ' >body ! ;
  50
  51 \ aufruf:
  52 \ > defer lulz
  53 \ > lulz ( abort )
  54 \ > s" lulz" find-name 48 dump ( mitschrift, leet hax )
  55 \ > ' + is lulz
  56 \ > 2 3 lulz . ( 5 )
  57 \ > s" lulz" find-name 48 dump ( mitschrift, leet hax )
  58
  59 \ ============================== 3.33 ========================================
  60 : my-2dup
  61         postpone over postpone over ; immediate
  62 : foodup my-2dup ; \ see foodup
  63
  64 \ ============================== 3.34 ========================================
  65 : ]L ] postpone literal ;
  66
  67 \ ============================== 3.37 ========================================
  68 : >order { wid -- }
  69         get-order wid swap 1+ set-order ;
  70
  71 \ > order
  72 \ > forth-wordlist >order
  73 \ > order \ "ich schieb nochmal `Forth' rauf"
  74
  75 \ ===== misc stuff
  76
  77 \ \ wie mach ich eine "gegenseitige" rekursion?
  78 \ > defer x
  79 \ > : y x ;
  80 \ > : (x) y ;
  81 \ > ' (x) is x
  82 \ \ controlbla...
  83 \ > : foo
  84 \ >     begin x if y then x until ; \ das `then' macht backpatching !
  85 \ > see foo \ ist falsch, weil buggy `see' :/
  86 \ > simple-see foo
  87
  88 \ \ major hax0r
  89 \ > hex \ HAX
  90 \ > : bar if x
  91 \ > [ .s ] \ jetzt wird zeug am stack vom compilezeit stuff angezeigt, w00t
  92 \ > else
  93 \ > [ .s ]
  94 \ > y then
  95 \ > [ .s ]
  96 \ > ;
  97 \ > simple-see bar
  98 \ \ `?branch' bedingter sprung, `branch' unbedingter sprung
  99
 100 \ btw, `cs-roll' manipuliert den stack zur compilezeit... (?)