Last active
June 9, 2021 19:09
-
-
Save neuro-sys/9d5595e028a1693b741b1cb511ec45b6 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
marker new | |
\ dev words | |
: edit s" emacs -Q example.fs" system new s" example.fs" included ; | |
\ internal words | |
variable dp1 \ backup for dp | |
variable sdp here 100000 + sdp ! \ string dp | |
: string-dp-setup ( -- ) | |
dp @ dp1 ! | |
sdp @ dp ! ; | |
: string-dp-exit ( -- ) | |
here sdp ! | |
dp1 @ dp ! ; | |
: string-allot ( caddr u -- addr ) | |
string-dp-setup | |
here dup >r over 1+ allot place r> | |
string-dp-exit ; | |
: .string ( addr -- ) count type ; | |
\ Program begin | |
0 | |
dup constant student->id cell + | |
dup constant student->age cell + | |
dup constant student->name cell + | |
constant student | |
0 | |
create list-of-students | |
1001 , 15 , s" Joe" string-allot , 1+ | |
1002 , 17 , s" Marry" string-allot , 1+ | |
1003 , 18 , s" Alice" string-allot , 1+ | |
1004 , 19 , s" Lula" string-allot , 1+ | |
constant #list-of-students | |
: do-for-each-student ( xt addr n -- ) | |
0 do | |
dup i student * + >r over r> swap execute | |
loop 2drop ; | |
: print-student ( addr -- ) | |
cr ." =======================" | |
dup cr ." Name: " student->name + @ .string | |
dup cr ." Age: " student->age + @ . | |
cr ." Id: " student->id + @ . ; | |
\ example | |
' print-student list-of-students #list-of-students do-for-each-student |
Author
neuro-sys
commented
Jun 9, 2021
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment