25c25
< \ $FreeBSD: head/sys/boot/forth/support.4th 50477 1999-08-28 01:08:13Z peter $
---
> \ $FreeBSD: head/sys/boot/forth/support.4th 53672 1999-11-24 17:56:40Z dcs $
57a58
> \ string password password
114a116
> string password
138a141,144
> \ How come ficl doesn't have again?
>
> : again false postpone literal postpone until ; immediate
>
145a152,153
> 7 constant bell
> 8 constant backspace
147a156
> 13 constant <cr>
507a517,520
> : password?
> s" password" assignment_type?
> ;
>
706c719
< 2 chars - swap char+ swap
---
> 2 - swap char+ swap
710a724,735
> : set_password
> password .addr @ ?dup if free if free_error throw then then
> value_buffer .addr @ c@ [char] " = if
> value_buffer .addr @ char+ value_buffer .len @ 2 - strdup
> value_buffer .addr @ free if free_error throw then
> else
> value_buffer .addr @ value_buffer .len @
> then
> password .len ! password .addr !
> 0 value_buffer .addr !
> ;
>
715a741
> password? if set_password exit then
725a752,757
> \ free_buffer ( -- )
> \
> \ Free some pointers if needed. The code then tests for errors
> \ in freeing, and throws an exception if needed. If a pointer is
> \ not allocated, it's value (0) is used as flag.
>
780a813
> 0 password .addr !
854c887
< : skip_leading_spaces { addr len ptr -- addr len ptr' }
---
> : skip_leading_spaces { addr len pos -- addr len pos' }
856,857c889,890
< ptr len = if addr len ptr exit then
< addr ptr + c@ bl =
---
> pos len = if addr len pos exit then
> addr pos + c@ bl =
859c892
< ptr char+ to ptr
---
> pos char+ to pos
861c894
< addr len ptr
---
> addr len pos
864,865c897,898
< : get_file_name { addr len ptr -- addr len ptr' addr' len' || 0 }
< ptr len = if
---
> : get_file_name { addr len pos -- addr len pos' addr' len' || 0 }
> pos len = if
869c902
< ptr >r
---
> pos >r
871c904
< addr ptr + c@ bl <>
---
> addr pos + c@ bl <>
873,875c906,908
< ptr char+ to ptr
< ptr len = if
< addr len ptr addr r@ + ptr r> - exit
---
> pos char+ to pos
> pos len = if
> addr len pos addr r@ + pos r> - exit
878c911
< addr len ptr addr r@ + ptr r> -
---
> addr len pos addr r@ + pos r> -
1067a1101,1127
> : read-password { size | buf len -- }
> size allocate if out_of_memory throw then
> to buf
> 0 to len
> begin
> key
> dup backspace = if
> drop
> len if
> backspace emit bl emit backspace emit
> len 1 - to len
> else
> bell emit
> then
> else
> dup <cr> = if cr drop buf len exit then
> [char] * emit
> len size < if
> buf len chars + c!
> else
> drop
> then
> len 1+ to len
> then
> again
> ;
>