Return to pdae.icn CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / icon / src / lib

Annotation of 43BSD/contrib/icon/src/lib/pdae.icn, revision 1.1

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

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