Return to pdae.icn CVS log

Up to [Research Unix] / researchv10dc / cmd / icon / tests

Annotation of researchv10dc/cmd/icon/tests/pdae.icn, revision 1.1.1.1

1.1       root        1: procedure main()
                      2:    every Parallel{|write,!"abcd",1 to 10}
                      3:    every Allpar{|write,!"abcd",1 to 10} \ 20
                      4:    every Rotate{|write,!"abcd",1 to 10} \ 20
                      5: end
                      6: 
                      7: procedure Allpar(a)
                      8:    local i, x, done
                      9:    x := list(*a)
                     10:    done := list(*a,1)
                     11:    every i := 1 to *a do x[i] := @a[i] | fail
                     12:    repeat {
                     13:       suspend Call(x)
                     14:       every i := 1 to *a do
                     15:          if done[i] = 1 then ((x[i] := @a[i]) | (done[i] := 0))
                     16:       if not(!done = 1) then fail
                     17:        }
                     18: end
                     19: 
                     20: procedure Call(a)
                     21:    suspend case *a of {
                     22:       1 : a[1]()
                     23:       2 : a[1](a[2])
                     24:       3 : a[1](a[2],a[3])
                     25:       4 : a[1](a[2],a[3],a[4])
                     26:       5 : a[1](a[2],a[3],a[4],a[5])
                     27:       6 : a[1](a[2],a[3],a[4],a[5],a[6])
                     28:       7 : a[1](a[2],a[3],a[4],a[5],a[6],a[7])
                     29:       8 : a[1](a[2],a[3],a[4],a[5],a[6],a[7],a[8])
                     30:       9 : a[1](a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9])
                     31:       10 : a[1](a[2],a[3],a[4],a[5],a[6],a[7],a[8],a[9],a[10])
                     32:       default :  stop("Call : too many args.")
                     33:       }
                     34: end
                     35: 
                     36: procedure Extract(a)
                     37:    local i, j, n, x
                     38:    x := list(*a/2)
                     39:    repeat {
                     40:       i := 1
                     41:       while i < *a do {
                     42:          n := @a[i] | fail
                     43:          every 1 to n do
                     44:             x[(i + 1)/2] := @a[i + 1] | fail
                     45:          a[i + 1] := ^a[i + 1]
                     46:          i +:= 2
                     47:          }
                     48:       suspend Call(x)
                     49:       }
                     50: end
                     51: 
                     52: procedure Lifo(a)
                     53:    local i, x, ptr
                     54:    x := list(*a)
                     55:    ptr := 1
                     56:    repeat {
                     57:       repeat
                     58:          if x[ptr] := @a[ptr]
                     59:          then {
                     60:             ptr +:= 1
                     61:             (a[ptr] := ^a[ptr]) |
                     62:             break
                     63:             }
                     64:          else if (ptr -:=  1) = 0
                     65:               then fail
                     66:       suspend Call(x)
                     67:       ptr := *a
                     68:       }
                     69: end
                     70: 
                     71: procedure Parallel(a)
                     72:    local i, x
                     73:    x := list(*a)
                     74:    repeat {
                     75:       every i := 1 to *a do
                     76:          x[i] := @a[i] | fail
                     77:       suspend Call(x)
                     78:       }
                     79: end
                     80: 
                     81: procedure Reverse(a)
                     82:    local i, x, ptr
                     83:    x := list(*a)
                     84:    ptr := *a
                     85:    repeat {
                     86:       repeat
                     87:          if x[ptr] := @a[ptr]
                     88:          then {
                     89:             ptr -:= 1
                     90:             (a[ptr] := ^a[ptr]) |
                     91:             break
                     92:             }
                     93:          else if (ptr +:= 1) > *a
                     94:               then fail
                     95:       suspend Call(x)
                     96:       ptr := 1
                     97:       }
                     98: end
                     99: 
                    100: procedure Rotate(a)
                    101:    local i, x, done
                    102:    x := list(*a)
                    103:    done := list(*a,1)
                    104:    every i := 1 to *a do x[i] := @a[i] | fail
                    105:    repeat {
                    106:       suspend Call(x)
                    107:       every i := 1 to *a do
                    108:          if not(x[i] := @a[i]) then {
                    109:             done[i] := 0
                    110:             if !done = 1 then {
                    111:                a[i] := ^a[i]
                    112:                x[i] := @a[i] | fail
                    113:                }
                    114:             else fail
                    115:             }
                    116:         }
                    117: end
                    118: 
                    119: procedure Simple(a)
                    120:    local i, x
                    121:    x := list(*a)
                    122:    every i := 1 to *a do
                    123:       x[i] := @a[i] | fail
                    124:    return Call(x)
                    125: end
                    126: 

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.