external/ton
1
0
Fork 0
mirror of https://github.com/ton-blockchain/ton synced 2025-03-09 15:40:10 +00:00
Code Issues Releases Wiki Activity

initial commit

Browse source
This commit is contained in:
initial commit 2019-09-07 14:03:22 +04:00 • committed by vvaltman
commit c2da007f40
1610 changed files with 398047 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

3
crypto/test/fift/bug.fif Normal file
View file

@ -0,0 +1,3 @@
10000000000000000000000000000000000000000000000000000000 dup .
dup 1 */ .

12
crypto/test/fift/bug_div.fif Normal file
View file

@ -0,0 +1,12 @@
"Asm.fif" include
1000 1 /r
x{7A71A905} runvmcode
<{ 1000 INT 1 INT DIVR }>s
dup csr.
runvmcode
.s

8
crypto/test/fift/cmdline.fif Executable file
View file

@ -0,0 +1,8 @@
#!/usr/bin/fift -s
{ ."usage: " $0 type ." <num1> <num2>" cr
."Computes the product of two integers." cr bye } : usage
{ ' usage if } : ?usage
$# 2 <> ?usage
$1 (number) 1- ?usage
$2 (number) 1- ?usage
* . cr

18
crypto/test/fift/contfrac.fif Normal file
View file

@ -0,0 +1,18 @@
{ dup 2over rot } : 3dup
{ 2drop drop } : 3drop
{ { 5 roll } 3 times } : 3swap
{ -rot over + rot over + -rot over + rot } : step1
{ negate -rot negate swap negate } : step2
{ 0 3 -roll { 3dup step1 dup 0> } { 3swap 3drop 3 roll 1+ 3 -roll } while 3drop step2 } : nsteps1
{ ' nsteps1 swap times 3drop } : qcontfrac
{ -1 0 2swap qcontfrac } : sqrtcontfrac
{ rot 2 pick * + swap } : revstep1
{ 1 0 rot ' revstep1 swap times } : computecontfrac
1 { 10 * } 74 times constant One
{ 100 sqrtcontfrac 100 computecontfrac */r } : *sqrtint
{ One swap *sqrtint } : sqrtint
2 sqrtint .
3 sqrtint .
6 sqrtint .
7 sqrtint .
239 sqrtint .

19
crypto/test/fift/fixed.fif Normal file
View file

@ -0,0 +1,19 @@
1 { 10 * } 70 times constant One
{ bl word (number) dup 0= abort"invalid fixed-point constant"
1- { One swap */r } { One * } cond 1 'nop } ::_ F$
' + : F+
' - : F-
{ One */r } : F*
{ One swap */r } : F/
{ One dup rot */r } : Finv
{ One { 2dup F/ F+ 2/ } 9 times nip } : Fsqrt
{ ' Fsqrt 128 times One F- 128 << } : Fln
{ dup abs <# ' # 70 times char . hold #s rot sign #>
nip -trailing0 type space } : .F
F$17/12 .F
F$3.14159265 .F
{ 1 0 rot { -rot over + swap rot 2dup >= } until drop
} : fib-gtr
One fib-gtr F/ .F
F$2 Fsqrt .F
F$2 Fln .F

27
crypto/test/fift/sort.fif Normal file
View file

@ -0,0 +1,27 @@
{ null null rot
{ dup null? not }
{ uncons swap rot cons -rot } while drop
} : split
variable 'sort variable 'merge variable 'compare
{ 'sort @ execute } : sort
{ 'merge @ execute } : merge
{ 'compare @ execute } : compare
' < 'compare !
{ dup null? { drop } {
over null? { nip } {
over car over car compare ' swap if
uncons rot merge cons
} cond
} cond
} 'merge !
{ dup null? {
dup cdr null? {
split sort swap sort merge
} ifnot
} ifnot
} 'sort !
3 1 4 1 5 9 2 6 5 9 list
dup .l cr sort .l cr
"once" "upon" "a" "time" "there" "lived" "a" "very" "little" "kitten" 10 list
{ $cmp 0< } 'compare !
dup .l cr sort .l cr

28
crypto/test/fift/sort2.fif Normal file
View file

@ -0,0 +1,28 @@
{ hole dup 1 { @ execute } does create 1 ' ! does create } : defvect
defvect sort :sort
defvect merge :merge
defvect less :less
' < :less
{ null null rot
{ dup null? not }
{ uncons swap rot cons -rot } while drop
} : split
{ dup null? { drop } {
over null? { nip } {
over car over car less ' swap if
uncons rot merge cons
} cond
} cond
} :merge
{ dup null? {
dup cdr null? {
split sort swap sort merge
} ifnot
} ifnot
} :sort
3 1 4 1 5 9 2 6 5 9 list
dup .l cr sort .l cr
"once" "upon" "a" "time" "there" "lived" "a" "very" "little" "kitten" 10 list
{ $cmp 0< } :less
dup .l cr sort .l cr

24
crypto/test/fift/test.fif Normal file
View file

@ -0,0 +1,24 @@
{ bl word 1 2 ' (create) } "::" 1 (create)
{ bl word 0 2 ' (create) } :: :
{ bl word 2 2 ' (create) } :: :_
{ bl word 3 2 ' (create) } :: ::_
{ bl word 0 (create) } : create
{ char " word 1 ' type } ::_ ."
{ char " word 1 { swap { abort } if drop } } ::_ abort"
{ dup * } : square
6 square .
{ swap ({) over 2+ -roll swap (compile) (}) } : does
{ 1 'nop does create } : constant
10 constant ten
ten .
ten ten * .
{ 1 ' emit does create } : emits
42 emits star
34 emits quote
30000 emits figna
star star quote figna quote
{ 0 word drop 0 'nop } ::_ //
star quote // end-to-line comment
{ 1 ' * does create } : mulby
3 mulby 3*
4 3* .

102
crypto/test/fift/testdb.fif Normal file
View file

@ -0,0 +1,102 @@
"Asm.fif" include
PROGRAM{
NEWPROC load_dict
NEWPROC generate_dict
NEWPROC save_dict
NEWPROC do_get
NEWPROC do_set
NEWPROC do_erase
main PROC:<{
DUP 1 INT EQUAL IF:<{
DROP
do_get CALL
}>ELSE<{
DUP 2 INT EQUAL IF:<{
DROP
do_set CALL
}>ELSE<{
DUP 3 INT EQUAL IF:<{
DROP
do_erase CALL
}> }> }>
-1 INT
}>
do_get PROC:<{
load_dict CALL
32 INT
DICTIGET
}>
do_set PROC:<{
load_dict CALL
32 INT
DICTISET
save_dict CALL
}>
do_erase PROC:<{
load_dict CALL
32 INT
DICTIDEL
DROP
save_dict CALL
}>
generate_dict PROC:<{
4 INT 100 INT REPEAT:<{
DUP 2DUP MUL ROT 617 INT ADD 1000 INT MOD
}>
DROP 100 INT
NEWDICT
SWAP REPEAT:<{
s0 s2 XCHG
NEWC
16 STU
s0 s2 XCHG
32 INT
DICTISETB
}>
}>
load_dict PROC:<{
PUSHROOT
CTOS DUP SEMPTY IF:<{
DROP
generate_dict CALL
}>
}>
save_dict PROC:<{
NEWC
STSLICE
ENDC
POPROOT
}>
}END>s constant pmc_prog
{ 1 2 rot pmc_prog } : task_pmc_get
{ 2 3 rot pmc_prog } : task_pmc_set
{ 3 2 rot pmc_prog } : task_pmc_erase
{ task_pmc_get dbrunvm 2drop } : pmc_get
{ task_pmc_set dbrunvm 2drop } : pmc_set
{ task_pmc_erase dbrunvm 2drop } : pmc_erase
<b x{abacaba} s, <b x{dead} s, x{1dead} sr, b> <s sr, b> <s constant test_value
// 123 "a" pmc_get
// { csr. } if
// 123 "a" pmc_set
// test_value 123 x{a} task_pmc_set test_value 123 x{b} task_pmc_set test_value 123 x{c} task_pmc_set 3 3 dbrunvm-parallel
{ test_value 150 rot task_pmc_set } 0 { 1 + 2dup swap execute 7 roll 7 roll } 10000 times 2drop 10000 4 dbrunvm-parallel
// 123 "a" task_pmc_get 123 "b" task_pmc_get 123 "c" task_pmc_get 3 dbrunvm-parallel

24
crypto/test/fift/testdict.fif Normal file
View file

@ -0,0 +1,24 @@
"Lisp.fif" include
16 constant key-bits
16 constant val-bits
{ val-bits u, } : val,
{ val-bits u@ } : val@
{ swap unpair <b swap val, b> <s swap rot key-bits udict! not abort"cannot add key-value" } : +dictpair
{ dictnew { over null? not } { swap uncons swap rot +dictpair } while nip } : mkdict
{ dup null? { ."(null) " drop } { val@ . } cond } : .val
{ key-bits { swap . ."-> " .val ."; " true } dictforeach drop cr } : show-dict
{ key-bits { rot . ."-> " swap .val .val ."; " true } dictdiff drop cr } : show-dict-diff
{ key-bits { val@ swap val@ + val, true } dictmerge } : dict-sum
{ null swap key-bits { val@ pair swap cons true } dictforeach drop } : dict>list-rev
{ dict>list-rev list-reverse } : dict>list
( _( 13 169 ) _( 17 289 ) _( 10 100 ) ) mkdict =: Dict
_( 4 16 ) _( 9 81 ) Dict +dictpair +dictpair =: Dict1
_( 4 20 ) _( 101 10201 ) Dict +dictpair +dictpair =: Dict2
."Dict1 = " Dict1 show-dict
Dict1 dict>list .l cr
Dict1 <s csr. cr
."Dict2 = " Dict2 show-dict
Dict2 dict>list .l cr
Dict2 <s csr. cr
Dict1 Dict2 show-dict-diff
Dict2 Dict1 show-dict-diff

10
crypto/test/fift/testvm.fif Normal file
View file

@ -0,0 +1,10 @@
{ bl word 0 (create) } : create
{ swap ({) over 2+ -roll swap (compile) (}) } : does
{ 1 'nop does create } : constant
1 2 3 <b 0x01 8 u, 0x58 8 u, b> .s <s .s runvmcode .s
x{5352A85354A8A15224A8460525A8A104A85042A8A15112A90402A904} constant solvelineq_code
x{2523A82525A8A10322A80521A815A103A80314A80102A10122A90402A904} constant solvelineq_simple_code
x{2523A82525A8A1220104A80521A815A11504A81402A8A10122A90402A904} constant solvelineq_compiled_code
2 3 1 1 29 12 solvelineq_code runvmcode .s
2 3 1 1 29 12 solvelineq_simple_code runvmcode .s
2 3 1 1 29 12 solvelineq_compiled_code runvmcode .s

22
crypto/test/fift/testvm2.fif Normal file
View file

@ -0,0 +1,22 @@
239 x{9220A8D8A601} runvmcode .s
55 x{719C2272B9DC5921A801A50220D920D83031} runvmcode .s
10 x{9E21C102925B71E021A50120D8A820D9} runvmcode .s
55 x{7101209466A801A5E430} runvmcode .s
x{71209A21A00121A020B7B5FCC4E60171804592A70AE401A985} runvmcode .s
x{71804592A70AE471209821A00121A05302BEE601A985} runvmcode .s
20 x{710192A70AE471209821A00121A05302BEE601A984} runvmcode .s
239 x{9F202071B093A703A492AB00E220C001E6} runvmcode drop .s
239 x{9320C301992093A703A4E380AB00E8} runvmcode drop .s
x{7791A0EC11717322D802D8} runvmcode drop .s
x{917720ED50D8} runvmcode drop .s
10 x{9A20C10DE30820C213E308EDF931} runvmcode drop .s
10 x{9720C11401C20CB0D8} runvmcode drop .s
15 x{9A20C10DE30820C213E308EDF931} runvmcode drop .s
15 x{9720C11401C20CB0D8} runvmcode drop .s
20 x{9A20C10DE30820C213E308EDF931} runvmcode drop .s
20 x{9720C11401C20CB0D8} runvmcode drop .s
x{E3C03077F001A4} x{3020A8} |_ runvmdict drop .s
x{71B0E30277F001A4} x{20A8} |_ runvmdict .s
17 x{30ED44D0D71131A020C8CB3FC9ED54} <b x{0000000012345678} s, b> runvm .s
100 19 7 x{92A9069620C004F2F571F321A0} runvmcode .s
19 0 x{92A9069620C004F2F571F321A0} runvmcode .s

8
crypto/test/fift/testvm3.fif Normal file
View file

@ -0,0 +1,8 @@
x{C8}
x{62_}
x{A68054C_} |_
x{A08090C_} |_ |_
x{BEFDF21} |_
dup csr. s>c
13 x{218010F40C} runvmcode .s drop swap csr.

14
crypto/test/fift/testvm4.fif Normal file
View file

@ -0,0 +1,14 @@
169 13
239 dup dup * swap
289 17
3
x{6D01E502C8CB0F028010F442} runvmcode .s drop dup <s csr.
1 { dup 2dup * swap rot 1+ } 100 times drop 100 .s
x{6D01E502C8CB0FC9D0028010F414} runvmcode .s drop dup <s csr.
0 { dup 2dup * rot 617 + 1000 mod } 1000 times drop 1000 .s
x{6D01E502C8CB0F028020F442} runvmcode .s drop dup <s csr.
<b x{C_} s, over ref, b> dup 15 boc+>B .s
B>boc .s

5
crypto/test/fift/testvm4a.fif Normal file
View file

@ -0,0 +1,5 @@
169 13
239 dup dup * swap
289 17
3
x{6D01E502C8CB0F028010F442} runvmcode drop dup <s csr.

16
crypto/test/fift/testvm4b.fif Normal file
View file

@ -0,0 +1,16 @@
169 13
239 dup dup * swap
289 17
3
x{6D01E502C8CB0F028010F442} runvmcode .s drop dup <s csr.
1 { dup 2dup * swap rot 1+ } 100 times drop 100 .s
x{6D01E502C8CB0FC9D0028010F414} runvmcode .s drop dup <s csr.
0 { dup 2dup * rot 617 + 1000 mod } 1000 times drop 1000 .s
x{6D01E502C8CB0F028020F442} runvmcode .s drop dup <s csr.
<b x{C_} s, over ref, b> dup 15 boc+>B .s
"dict1000.boc" B>file
"dict1000.boc" file>B
B>boc .s

52
crypto/test/fift/testvm4c.fif Normal file
View file

@ -0,0 +1,52 @@
"Asm.fif" include
<{ NEWDICT SWAP REPEAT:
s2 XCHG0 NEWC 16 STU s2 XCHG0
16 INT DICTISETB }>s
dup csr. constant mkdict(16,16).code
{ mkdict(16,16).code runvmcode abort"cannot create 16->16 dictionary" } : mkdict(16,16)
<{ ZERO WHILE:<{ SWAP 16 INT DICTIREMMAX }>DO<{ // n d' x i
SWAP 16 LDU ENDS // n d' i s
2SWAP SWAP INC
}> DROP
}>s dup csr. constant explode_dict(16,16).code
{ explode_dict(16,16).code runvmcode abort"cannot explode 16->16 dictionary" } : xdict(16,16)
{ xdict(16,16) ."{ " { swap . ."-> " . ."; " } swap times ."}" cr } : .dict(16,16)
{ xdict(16,16) { dup 0< not { ."+" } if ._ 64 + emit } swap times space } : .v
169 13
239 dup dup * swap
289 17
3
mkdict(16,16) constant dict
{ 16 { 16 i@+ s> 1+ 16 i, true } dictmap } : dict:1+
{ 16 { 16 i@+ s> swap 16 i@+ s> + 16 i, true } dictmerge } : dict:+
dict dict:1+ dup <s csr. constant dict2
dict .dict(16,16)
dict2 .dict(16,16)
10 13 20 20 2 mkdict(16,16) constant dict3
0 mkdict(16,16) constant dict0
169 13 1 mkdict(16,16) constant dict1a
100 10 1 mkdict(16,16) constant dict1b
dict dict3
2dup swap <s csr. <s csr. dict:+ dup <s csr. .dict(16,16)
{ 1 mkdict(16,16) } : cst*
{ 1 cst* } : A*
{ 2 cst* } : B*
{ 3 cst* } : C*
{ 4 cst* } : D*
{ 5 cst* } : E*
{ 6 cst* } : F*
' dict:+ : v+
2 A* 3 C* v+ 9 F* v+
1 A* 6 D* v+ 2 E* v+
over .v cr dup .v cr
v+ .v cr

26
crypto/test/fift/testvm4d.fif Normal file
View file

@ -0,0 +1,26 @@
"Asm.fif" include
<{ NEWDICT SWAP REPEAT:
s2 XCHG0 NEWC 16 STU s2 XCHG0
16 INT DICTISETB }>s
dup csr. constant mkdict(16,16).code
{ mkdict(16,16).code runvmcode abort"cannot create 16->16 dictionary" } : mkdict(16,16)
<{ ZERO WHILE:<{ SWAP 16 INT DICTIREMMAX }>DO<{ // n d' x i
SWAP 16 LDU ENDS // n d' i s
2SWAP SWAP INC
}> DROP
}>s dup csr. constant explode_dict(16,16).code
{ explode_dict(16,16).code runvmcode abort"cannot explode 16->16 dictionary" } : xdict(16,16)
{ xdict(16,16) ."{ " { swap . ."-> " . ."; " } swap times ."}" cr } : .dict(16,16)
{ 16 { 16 i@+ s> 1+ 16 i, true } dictmap } : dict:1+
{ 16 { 16 i@+ s> swap 16 i@+ s> + 16 i, true } dictmerge } : dict:+
{ 1 swap dup 1 { 2dup dup * + 2 swap 2swap 1+ } 100 times nip mkdict(16,16) } : mdisqpb
0 mdisqpb 0 { 1+ tuck dup * mdisqpb tuck dict:+ dict:+ swap } 100 times drop
dup <s csr. .dict(16,16)

61
crypto/test/fift/testvm4e.fif Normal file
View file

@ -0,0 +1,61 @@
"Asm.fif" include
<{ NEWDICT SWAP REPEAT:
s2 XCHG0 NEWC 16 STU s2 XCHG0
16 INT DICTUSETB }>s
dup csr. constant mkdict(16,16).code
{ mkdict(16,16).code runvmcode abort"cannot create 16->16 dictionary" } : mkdict(16,16)
<{ ZERO WHILE:<{ SWAP 16 INT DICTUREMMAX }>DO<{ // n d' x i
SWAP 16 LDU ENDS // n d' i s
2SWAP SWAP INC
}> DROP
}>s dup csr. constant explode_dict(16,16).code
{ explode_dict(16,16).code runvmcode abort"cannot explode 16->16 dictionary" } : xdict(16,16)
{ xdict(16,16) ."{ " { swap x. ."-> " x. ."; " } swap times ."}" } : .dict(16,16)
{ 16 { 16 u@+ s> 1+ 16 u, true } dictmap } : dict:1+
{ 16 { 16 u@+ s> swap 16 u@+ s> + 16 u, true } dictmerge } : dict:+
0x1000 0x1000
0x1234 0x1234
0x1357 0x1357
0xABCD 0xABCD
0xBFFF 0xBFFF
5 mkdict(16,16) constant D
D dup dict>s csr. .dict(16,16) ." <-- D" cr
D <{ 0 INT 0 INT ROT 16 INT SUBDICTUGET }>s dup csr. runvmcode drop
dup dict>s csr. .dict(16,16) ." <-- SubDict(D,_)" cr
D <{ 0x1 INT 4 INT ROT 16 INT SUBDICTUGET }>s runvmcode drop
dup dict>s csr. .dict(16,16) ." <-- SubDict(D,0001)" cr
D <{ 0x10 INT 8 INT ROT 16 INT SUBDICTUGET }>s runvmcode drop
dup dict>s csr. .dict(16,16) ." <-- SubDict(D,00010000)" cr
D <{ 0x12 INT 8 INT ROT 16 INT SUBDICTUGET }>s runvmcode drop
dup dict>s csr. .dict(16,16) ." <-- SubDict(D,00010010)" cr
D <{ 0x1357 INT 16 INT ROT OVER SUBDICTUGET }>s runvmcode drop
dup dict>s csr. .dict(16,16) ." <-- SubDict(D,x1357)" cr
D <{ 0 INT 2 INT ROT 16 INT SUBDICTUGET }>s runvmcode .s drop
dup dict>s csr. .dict(16,16) ." <-- SubDict(D,00)" cr
D <{ 1 INT 2 INT ROT 16 INT SUBDICTUGET }>s runvmcode .s drop
dup dict>s csr. .dict(16,16) ." <-- SubDict(D,01)" cr
D <{ 0 INT 1 INT ROT 16 INT SUBDICTUGET }>s runvmcode .s drop
dup dict>s csr. .dict(16,16) ." <-- SubDict(D,0)" cr
D <{ 1 INT 1 INT ROT 16 INT SUBDICTUGET }>s runvmcode .s drop
dup dict>s csr. .dict(16,16) ." <-- SubDict(D,1)" cr
D <{ 0xA INT 4 INT ROT 16 INT SUBDICTUGET }>s runvmcode .s drop
dup dict>s csr. .dict(16,16) ." <-- SubDict(D,1010)" cr
D <{ 0xB INT 4 INT ROT 16 INT SUBDICTUGET }>s runvmcode .s drop
dup dict>s csr. .dict(16,16) ." <-- SubDict(D,1011)" cr

11
crypto/test/fift/testvm5.fif Normal file
View file

@ -0,0 +1,11 @@
"Asm.fif" include
<{ 2SWAP ADD s2 POP FALSE }>s b{00}
<{ 2SWAP MUL s2 POP FALSE }>s b{1}
<{ 2SWAP SUB s2 POP FALSE }>s b{01}
3
<{ NEWDICT SWAP REPEAT: 8 INT PFXDICTADD 11 THROWIFNOT }>s runvmcode
abort"cannot create prefix code dictionary"
dup dict>s csr.
<{ <{ rot 8 PFXDICTSWITCH TRUE }>UNTIL SDEMPTY 11 THROWIFNOT }>s
dup csr.
1 2 3 4 5 b{001011} 6 roll runvmcode .s

66
crypto/test/fift/testvm6.fif Normal file
View file

@ -0,0 +1,66 @@
"Asm.fif" include
<{ 1 INT 70 INT
REPEAT:<{ 10 MULCONST }>
1 INT DUP <{ TUCK ADD DUP s3 PUSH GREATER }>UNTIL
MULDIVR
}>s
dup csr.
runvmcode .s
<{ 1 INT 70 INT REPEAT:<{ 10 MULCONST }>
1 INT DUP <{ TUCK ADD TUCK ADD SWAP DUP s3 PUSH GREATER }>UNTIL
MULDIVR
}>s
dup csr.
runvmcode .s
<{ WHILE:<{
DUP DEC
}>DO<{
DUP DUP 1 INT AND IF:<{
3 MULCONST INC
}>ELSE<{
1 RSHIFT#
}>
}>
}>s
dup csr.
<{ WHILE:<{
DUP DEC
}>DO:
DUP DUP 1 INT AND IF:<{
3 MULCONST INC
}>ELSE:
1 RSHIFT#
}>s
dup csr.
nip
17 swap runvmcode .s
<{ CONT:<{
TUCK DIVR SWAP DUP MUL NEGATE SWAP ZERO ONE
<{ SWAP s2 s1 PUSH2 DIVR ADD SWAP 2 ADDCONST
2SWAP OVER DIVR 2SWAP s2 PUSH ISZERO }>UNTIL
DROP s2 POP DROP
}>
8 PUSHPOW2 70 INT REPEAT:<{ 10 MULCONST }>
DUP 2 LSHIFT# 5 INT s3 PUSH EXECUTE
s0 s2 XCHG 239 INT SWAP EXECUTE SUB
6 RSHIFTR#
}>s dup csr.
runvmcode .s
<{ 8 PUSHPOW2 70 INT REPEAT:<{ 10 MULCONST }>
ZERO DUP
<{ s2 PUSH ADD -ROT INC TUCK DIVR -ROT SWAP s2 PUSH ISZERO }>UNTIL
NIP NIP 8 RSHIFTR#
}>s dup csr.
runvmcode .s

47
crypto/test/fift/testvm7.fif Normal file
View file

@ -0,0 +1,47 @@
"Asm.fif" include
<{ -1 INT ZERO ROT
100 INT REPEAT:<{
ZERO WHILE:<{
3 3 BLKPUSH
// -ROT OVER ADD ROT OVER ADD -ROT OVER ADD ROT
s2 s1 PUXC ADD TUCK ADD s2 s1 PUXC ADD SWAP
DUP ISPOS
}>DO<{
s4 POP s4 POP s4 POP INC
}>
3 BLKDROP
s3 XCHG0 NEGATE s2 XCHG0 NEGATE SWAP NEGATE s2 XCHG0
}>
3 BLKDROP
}>s dup csr.
// 61 swap runvmcode .s
drop
<{ -1 INT ZERO ROT ONE ZERO s0 s1 PUSH2
<{ 3 6 BLKPUSH // a b c m11 m12 m21 m22 a' b' c'
s2 s1 PUXC ADD TUCK ADD s2 s1 PUXC ADD SWAP
DUP ISPOS IF:<{
s7 POP s7 POP s7 POP // a' b' c' m11 m12 m21 m22
s2 PUSH ADD SWAP s3 PUSH ADD SWAP
}>ELSE<{
3 BLKDROP // a b c m11 m12 m21 m22
2SWAP
3 4 BLKSWAP // m m m m a b c
NEGATE SWAP NEGATE // .. a -c -b
ROT NEGATE // -c -b -a
4 3 BLKSWAP
}>
DUP 250 QFITS ISNAN
}>UNTIL
2DROP s3 POP s3 POP DROP
}>s dup csr.
1 { 10 * } 75 times constant One
{ One swap */r } : frac*One
61 over runvmcode drop frac*One swap
2 over runvmcode drop frac*One swap
3 over runvmcode drop frac*One swap
5 over runvmcode drop frac*One swap
6 over runvmcode drop frac*One swap
7 over runvmcode drop frac*One swap
8 over runvmcode drop frac*One swap
.s

5
crypto/test/fift/testvm8.fif Normal file
View file

@ -0,0 +1,5 @@
"Asm.fif" include
<{ 7 INT -4 INT NEWC 64 STI 4 STU ENDC
CTOS 64 LDI 4 LDU ENDS }>s
dup csr.
runvmcode .s

7
crypto/test/fift/testvm9.fif Normal file
View file

@ -0,0 +1,7 @@
"Asm.fif" include
<{ 2 INT 3 INT 9 INT NULL CONS CONS CONS }>s dup csr. runvmcode .s
drop =: L
<{ ZERO WHILE:<{ OVER ISNULL NOT }>DO<{ SWAP SECOND SWAP INC }> NIP }>s dup csr. =: ListLength
L ListLength runvmcode .s 2drop
<{ CONT:<{ DUP ISNULL IF:<{ 2DROP ZERO }>ELSE: CDR OVER EXECUTE INC }> TUCK JMPX }>s dup csr. =: ListLengthRec
L ListLengthRec runvmcode .s 2drop

40
crypto/test/fift/testvmprog.fif Normal file
View file

@ -0,0 +1,40 @@
"Asm.fif" include
PROGRAM{
NEWPROC add
NEWPROC sub
NEWPROC mul
sub <{ s3 s3 XCHG2 SUB s2 XCHG0 SUB }>s PROC
// compute (5+i)^4 * (239-i)
main PROC:<{
5 INT 1 INT // 5+i
2DUP
mul CALL
2DUP
mul CALL
239 INT -1 INT
mul JMP
}>
add PROC:<{
s1 s2 XCHG
ADD -ROT ADD SWAP
}>
// a b c d -- ac-bd ad+bc : complex number multiplication
mul PROC:<{
s3 s1 PUSH2 // a b c d a c
MUL // a b c d ac
s3 s1 PUSH2 // a b c d ac b d
MUL // a b c d ac bd
SUB // a b c d ac-bd
s4 s4 XCHG2 // ac-bd b c a d
MUL // ac-bd b c ad
-ROT MUL ADD
}>
}END>s
dup csr. runvmdict .s