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     ! 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.