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

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.