Mercurial > hg > Applications > Tokio
changeset 0:cfb7c6b24319
Initial revision
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/.xpce/Geometry.cnf Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,17 @@ +/* XPCE configuration file for "persistent_frame" + Saved Sat Aug 6 10:43:13 2005 by kono +*/ + +configversion(1). +[persistent_frame]. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Option lines starting with a `%' indicate % +% the value is equal to the application default. % +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +/* (X-)geometry for persistent frames */ +history/geometry/pui_manual = '880x335+2+21'. + +/* Sub-window layout for persistent frames */ +history/subwindow_layout/pui_manual = layout(*, [*, layout(*, [200, *]), *]).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/6502/RTL Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,44 @@ +Problem of RTL transition. + + 1. First get current predicate. + 2. Its all variables become terminal or register. + If variable's value is transfer to futer, it is register. + Otherwise it is only a terminal. + + 3. So it is necessary to make variable table. + 4. Trace all ( non assigned ) computation. + Then we get net-time queue for one alternatives. + 5. How to designate, state? + Sort up predicat and store into some database, + B-tree will be ok. + 6. add empty or not empty for sub-intervals. + main interval never terminate. it is an error. + +Restriction of Tokio in translating to hardware. + + 1. Only First time execution generates true parallel state machine. + + --------------> + |-------------> + + 2. In the 1th to nth clock, State is binary for each parallel state. + + a,b,a ----> (a & a ),b + + ex. parallel quick sort + + a -> a,a --> a,a,a,a ----> a,a,a,a,a,a,a,a + + ( hard ware restriction ). + + 3. Hardware had his own restriction. It makes this algorithm + terminate. + + i.e. in order to terminate expasion, we have + to implement hardware restreiction. + + ( = smae thing in PITL ) + + Over expresivness is necssary. + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/6502/a.hex Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,4 @@ +:10000000D8A201A00120090000E000D003C8986038 +:10001000C000D006CAA0014C09008A488820090007 +:07002000A868AACA4C090000 +:00000001FF
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/6502/a.s65 Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,46 @@ +;; +;; ackerman function + +;; procedure name ACK +;; ACK(X,Y) +;; == if X=0 then Y+1 +;; else if Y=0 then ACK(X-1,1) +;; else ACK(X-1, ACK(X,Y-1)) + +;; calling sequence +;; +;; X on x +;; Y on y +;; non compile 11.86 sec on Sun 140 +;; compile 7.54 sec on Sun 140 + +start cld + ldx #1 + ldy #1 + jsr ack + brk + +ack cpx #0 + bne xneqzero +xeqzero iny + tya + rts + +xneqzero cpy #0 + bne yneqzero + dex ;; x <- x-1 +yeqzero ldy #1 + jmp ack ;; tail recursion + +yneqzero txa + pha + dey ;; y <- y-1 + jsr ack ;; ack x,y-1 + tay + pla + tax + dex ;; x <- x-1 + jmp ack ;; tail recursion + + end +;;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/6502/isp.mc6502 Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,596 @@ +! ISPS Description of the MOS Technology MCS 6502 Microprocessor + +! G.W.Leive +! 10 July 1978 ISPS Version +! COPYRIGHT (C) 1978 + +MC6502 := + BEGIN + +**MP.STATE** + MACRO romlow:= |"F800 |, + MACRO romhi := |"FFFF |, + MACRO ramlow:= |"0000 |, + MACRO ramhi := |"1000 |, + MACRO maxb := |"FFFF |, ! High end of byte memory + + Mb[0:maxb]<7:0>, ! Primary memory range + ram[ramlow:ramhi]<7:0> := mb[ramlow:ramhi]<7:0>, ! RAM + rom[romlow:romhi]<7:0> := mb[romlow:romhi]<7:0> ! ROM + +**PC.STATE** + + Pc<15:0>, ! Program counter + + Y<7:0>, ! Index register + X<7:0>, ! Index register + S<7:0>, ! Stack pointer + Dl<7:0>, ! Input data latch + A<7:0>, ! Accumulator + Ir<7:0>, ! Instruction register + P<7:0>, ! Processor status + n<> := P<7>, ! Negative result + v<> := P<6>, ! Overflow + b<> := P<4>, ! Break command + d<> := P<3>, ! Decimal mode + i<> := P<2>, ! Interrupt disable + z<> := P<1>, ! Zero + c<> := P<0>, ! Carry + + Irq<>, ! Interrupt request + Nmi<>, ! Non-maskable interrupt + IFSync<>, ! High when instruction fetch + Rw<>, ! Read/Write control pin + So<>, ! Set overflow pin + Reset<>, ! Power up bit + Ready<> ! 1 means run, 0 means stop + +**ADDRESS.CALCULATION** + + immed()<15:0> := ! Immediate + BEGIN + immed = ab = Pc NEXT + Pc = Pc + 1 + END, + + zp()<15:0> := ! Zero page + BEGIN + zp = ab = read(Pc) NEXT + Pc = Pc + 1 + END, + + abs()<15:0> := ! Absolute + BEGIN + abs = ab(Pc + 1, Pc) NEXT + Pc = Pc + 2 + END, + + indx()<15:0> := ! Indexed indirect - (IND, X) + BEGIN + indx = ab((read(Pc) + X + 1)<7:0>, (read(Pc) + X)<7:0>) NEXT + Pc = Pc + 1 + END, + + indy()<15:0> := ! Indirect indexed - (IND), Y + BEGIN + indy = ab = ab(read(Pc) + 1, read(Pc)) + Y NEXT + Pc = Pc + 1 + END, + + zpx()<15:0> := ! Zero page indexed by X + BEGIN + zpx = ab = (read(Pc) + X)<7:0> NEXT + Pc = Pc + 1 + END, + + zpy()<15:0> := ! Zero page indexed by Y + BEGIN + zpy = ab = (read(Pc) + Y)<7:0> NEXT + Pc = Pc + 1 + END, + + + absy()<15:0> := ! Absolute modified by Y + BEGIN + absy = ab = ab(Pc + 1, Pc) + Y NEXT + Pc = Pc + 2 + END, + + absx()<15:0> := ! Ablolute modified by X + BEGIN + absx = ab = ab(Pc + 1, Pc) + X NEXT + Pc = Pc + 2 + END + +**SERVICE.FACILITIES** + + push(dbb.<7:0>) := ! Push a byte on the stack + BEGIN + write(1@S, dbb.) NEXT + S = S - 1 + END, + + pull<7:0> := ! Pull a byte off the stack + BEGIN + S = S + 1 NEXT + pull = read(1@S) + END, + + opex := ! Operation exception + BEGIN + Ready = 0 NEXT + RESTART run + END, + + setnz(ta.<7:0>) := ! Set neg and zero condition code + BEGIN + z = ta. EQL 0; n = ta.<7> + END, + + branch(cond<>) := + BEGIN + DECODE cond => + BEGIN + 0 := Pc = Pc + 1, + 1 := Pc = (Pc + 1) + read(PC) ! Relative addressing + END + END, + + decimal.adjust(tac.<8:0>) := ! Used by sbc and adc + BEGIN + IF A<7> EQV read<7> => v = tac.<7> XOR A<7>; c = tac.<8> NEXT + IF d => + BEGIN + tac.<8> = 0 NEXT + IF tac.<3:0> GTR{US} "9 => tac. = tac.<7:0> + "6 NEXT + IF NOT c => c = tac.<8> NEXT + IF tac.<7:4> GTR{US} "9 => tac. = tac.<7:0> + "60 NEXT + IF NOT c => c = tac.<8> + END NEXT + A = tac.<7:0> NEXT + setnz(A) + END, + + ab(adh.<15:0>, adl.<15:0>)<15:0> := ! Address buffer + BEGIN + ab<15:8> = read(adh.) NEXT + ab<7:0> = read(adl.) + END, + + ! Read and write memory access routines + + read(ab.<15:0>)<7:0> := ! Read from valid memory + BEGIN + Rw = 1 NEXT + IF NOT Ready => RESTART run NEXT + read = "FF NEXT ! Fake a nonexistant memory access + IF (ab. GEQ{US} ramlow) AND (ab. LEQ{US} ramhi) => read = ram[ab.]; + IF (ab. GEQ{US} romlow) AND (ab. LEQ{US} romhi) => read = rom[ab.] + END, + + write(ab.<15:0>, dbb.<7:0>) := ! Write to valid memory + BEGIN + IF (ab. GEQ{US} ramlow) AND (ab. LEQ{US} ramhi) => ram[ab.] = dbb.; + Rw = 0 + END, + + ! Interrupt routines + + intstk := ! Interrupt stack operations + BEGIN + push(Pc<15:8>) NEXT + push(Pc<7:0>) NEXT + push(P) NEXT + i = 1 + END, + + int := ! Interrupt processing + BEGIN + IF NOT Reset => + BEGIN + Reset = Irq = Nmi = Ready = 1 NEXT + Pc = ab("FFFD, "FFFC) NEXT + i = 1 NEXT + LEAVE int + END NEXT + + IF NOT Nmi => + BEGIN + Nmi = 1 NEXT + intstk() NEXT + Pc = ab("FFFB, "FFFA) NEXT + LEAVE int + END NEXT + + IF b OR (NOT Irq AND NOT i) => + BEGIN + intstk() NEXT + b = 0 NEXT + Pc = ab("FFFF, "FFFE) + END + END + +**INSTRUCTION.INTERPRETATION** + + run := + BEGIN + IF NOT Reset => int() NEXT ! Initial startup + IF NOT ready => stop() NEXT + IFSync = 1 NEXT ! Instruction fetch + Ir = read(Pc) NEXT + Pc = Pc + 1 NEXT + IFSync = 0 NEXT ! Execute + DECODE IR<1:0> => + BEGIN + '01 := group1(), + '10 := group2(), + '00 := group3(), + '11 := opex() + END NEXT + int() NEXT + IF So => v = 1 NEXT + RESTART RUN + END, + + ! Group 1 instruction decode + + group1 := + BEGIN + DECODE Ir<7:5> => + BEGIN + #0 := ora(), + #1 := and.(), + #2 := eor(), + #3 := adc(), + #4 := sta(), + #5 := lda(), + #6 := cmp(), + #7 := sbc() + END + END, + + ! Group 2 instruction decode + + group2 := + BEGIN + DECODE Ir<7:5> => + BEGIN + #0 := asl(), + #1 := rol(), + #2 := lsr(), + #3 := ror(), + #4 := stx(), ! Includes txa, txs + #5 := ldx(), ! Includes tax, tsx + #6 := dec(), ! Includes dex + #7 := inc() ! Includes no.op + END + END, + + ! Group 3 instruction decode + + group3 := + BEGIN + DECODE Ir => + BEGIN + "00 := brk(), ! Break + "08 := php(), ! Push status on stack + "28 := plp(), ! Pull status from stack + "48 := pha(), ! Push accumulator + "68 := pla(), ! Pull accumulator + "10 := bpl(), ! Branch on plus + "30 := bmi(), ! Branch on minus + "50 := bvc(), ! Branch if overflow clear + "70 := bvs(), ! Branch if overflow set + "90 := bcc(), ! Branch on carry clear + "D0 := bne(), ! Branch on not equal + "F0 := beq(), ! Branch if equal + "B0 := bcs(), ! Branch if carry set + "18 := clc(), ! Clear carry + "38 := sec(), ! Set carry + "58 := cli(), ! Clear interrupt enable + "78 := sei(), ! Set interrupt enable + "B8 := clv(), ! Clear overflow + "D8 := cld(), ! Clear decimal mode + "F8 := sed(), ! Set decimal mode + "20 := jsr(), ! Jump to subroutine + "24 := bit(read(zp())), ! Bit test - zero page + "2C := bit(read(abs())), ! Bit test - absolute + "40 := rti(), ! Return from interrupt + "4C := jmp(), ! Jump - absolute + "6C := jmp(), ! Jump - indirect + "60 := rts(), ! Return from subroutine + "84 := sty(zp()), ! Store Y - zero page + "8C := sty(abs()), ! Store Y - absolute + "94 := sty(zpx()), ! Store Y - zero page, X + "88 := dey(), ! Decrement Y + "C8 := iny(), ! Increment Y + "E8 := inx(), ! Increment X + "98 := tya(), ! Transfer Y to A + "A8 := tay(), ! Transfer A to Y + "A0 := ldy(immed()), ! Load Y - immediate + "A4 := ldy(zp()), ! Load Y - zero page + "AC := ldy(abs()), ! Load Y - absolute + "B4 := ldy(zpx()), ! Load Y - zero page, X + "BC := ldy(absx()), ! Load Y - absolute, X + "C0 := cpy(immed()), ! Compare immediate to Y + "C4 := cpy(zp()), ! Compare zero page to Y + "CC := cpy(abs()), ! Compare absolute to Y + "E0 := cpx(immed()), ! Compare immediate to X + "E4 := cpx(zp()), ! Compare zero page to X + "EC := cpx(abs()), ! Compare absolute to X + OTHERWISE := opex() + END + END + +**INSTRUCTION.EXECUTION** + + ! Group 1 instruction execution + + addrs1()<15:0> := ! Group 1 address generation + BEGIN + DECODE Ir<4:2> => + BEGIN + #0 := addrs1 = indx(), + #1 := addrs1 = zp(), + #2 := addrs1 = immed(), + #3 := addrs1 = abs(), + #4 := addrs1 = indy(), + #5 := addrs1 = zpx(), + #6 := addrs1 = absy(), + #7 := addrs1 = absx() + END + END, + + ora := ! Or + BEGIN + A = A OR read(addrs1()) NEXT + setnz(A) + END, + + and. := ! And + BEGIN + A = A AND read(addrs1()) NEXT + setnz(A) + END, + + eor := ! Exclusive or + BEGIN + A = A XOR read(addrs1()) NEXT + setnz(A) + END, + + adc := (decimal.adjust(A +{US} c + read(addrs1()))), ! Add with carry + + sta := (IF Ir NEQ{US} "89 => write(addrs1(),A)), ! Store immediate + + lda := ! Load accumulator + BEGIN + A = read(addrs1()) NEXT + setnz(A) + END, + + cmp := ! Compare + BEGIN + setnz(A - read(addrs1())) NEXT + c = A GEQ read + END, + + sbc := (decimal.adjust(A +{US} c + NOT read(addrs1()))), ! Sub/carry + + ! Group 2 addressing mode selection + + ! Group 2 gets and puts + + get2()<8:0> := ! Get the correct operand and return it in "get2" + BEGIN + DECODE Ir<4:2> => + BEGIN + #1 := get2<7:0> = read(zp()), + #2 := get2<7:0> = A, + #3 := get2<7:0> = read(abs()), + #5 := get2<7:0> = read(zpx()), + #7 := get2<7:0> = read(absx()), + OTHERWISE := opex() + END NEXT + get2<8> = c + END, + + put2(ta.<7:0>) := ! Put the operand in the proper location + BEGIN + DECODE Ir<4:2> => + BEGIN + [#1,#3,#5,#7] := write(ab, ta.), + #2 := A = ta., + OTHERWISE := opex() + END NEXT + setnz(ta.) + END, + + ! Group 2 instruction execution + + asl := ! Arithmetic shift left + BEGIN + get2 = get2() SL0 1 NEXT + c = get2<8>; put2(get2) + END, + + + rol := ! rotate left + BEGIN + get2 = get2() SLR 1 NEXT + c = get2<8>; put2(get2) + END, + + lsr := ! Logical shift right + BEGIN + c = get2<2> NEXT + get2 = get2<7:0> SR0 1 NEXT + put2(get2) + END, + + ror := ! Rotate right + BEGIN + get2 = get2() SRR 1 NEXT + c = get2<8>; put2(get2) + END, + + stx := ! Store index register + BEGIN + DECODE Ir<4:2> => + BEGIN + #1 := write(zp(), X), + #2 := A = X, ! Txa + #3 := write(abs(), X), + #5 := write(zpy(), X), + #6 := S = X, ! Txs + OTHERWISE := opex() + END + END, + + ldx := ! Load index register + BEGIN + DECODE Ir<4:2> => + BEGIN + #0 := X = read(immed()), + #1 := X = read(zp()), + #2 := X = A, ! Tax + #3 := X = read(abs()), + #4 := opex(), + #5 := X = read(zpy()), + #6 := X = S, ! Tsx + #7 := X = read(absy()) + END NEXT + setnz(X) + END, + + dec := ! Decrement + BEGIN + DECODE Ir EQL "CA => + BEGIN + 0 := put2(get2() - 1), + 1 := BEGIN ! Dex + X = X - 1 NEXT + setnz(X) + END + END + END, + + inc := ! Increment + BEGIN + IF Ir NEQ "EA => put2(get2() + 1) ! Op "EA => no.op + END, + + ! Group 3 instruction execution + + brk := (b = 1; Pc = Pc+1), ! Break + + php := (push(P)), ! Push processor status on stack + plp := (P = pull()), ! Pull processor status from stack + pha := (push(A)), ! Push accumulator on stack + pla := ! Pull accumulator from stack + BEGIN + A = pull() NEXT + setnz(A) + END, + + bpl := (branch(NOT n)), ! Branch on plus + bmi := (branch(n)), ! Branch on minus + bvc := (branch(NOT v)), ! Branch on overflow clear + bvs := (branch(v)), ! Branch if overflow set + bcc := (Branch(NOT c)), ! Branch on carry clear + bne := (branch(NOT z)), ! Branch if not equal + beq := (branch(z)), ! Branch on equal + bcs := (branch(c)), ! Branch on carry set + + clc := (c = 0), ! Clear carry flag + sec := (c = 1), ! Set carry + cli := (i = 0), ! Clear interrupt disable bit + sei := (i = 1), ! Set interrupt disable status + clv := (v = 0), ! Clear overflow + cld := (d = 0), ! Clear decimal mode + sed := (d = 1), ! Set decimal mode + + jsr := ! Jump to subroutine + BEGIN + push((Pc + 1)<15:8>) NEXT + push((Pc + 1)<7:0>) NEXT + Pc = abs() + END, + + bit(ta.<7:0>) := ! Bit test + BEGIN + n = ta.<7>; v = ta.<6>; z = (ta. AND A) EQL 0 + END, + + rti := ! Return from interrupt + BEGIN + P = pull() NEXT + Pc<7:0> = pull() NEXT + Pc<15:8> = pull(); b = 0 + END, + + jmp := ! Jump + BEGIN + Pc = abs() NEXT + IF Ir EQL "6C => Pc = abs() ! Indirect + END, + + ! Group 3 instruction execution (page 2) + + rts := ! return from subroutine + BEGIN + Pc<7:0> = pull() NEXT + Pc<15:8> = pull() NEXT + Pc = Pc + 1 + END, + + sty(ab.<15:0>) := (write(ab., Y)), ! Store index Y in memory + + dey := ! Decrement index Y by one + BEGIN + Y = Y - 1 NEXT + setnz(Y) + END, + + tya := ! Transfer index Y to accumulator + BEGIN + A = Y NEXT + setnz(A) + END, + + ldy(ab.<15:0>) := (Y = read(ab.)), ! Load index Y with memory + + tay := ! Transfer accumulator to index Y + BEGIN + Y = A NEXT + setnz(Y) + END, + + cpy(ab.<15:0>) := ! Compare memory and index Y + BEGIN + setnz(Y - read(ab.)) NEXT + c = Y GEQ read + END, + + iny := ! Increment index Y by one + BEGIN + Y = Y + 1 NEXT + setnz(Y) + END, + + cpx(ab.<15:0>) := ! Compare memory and index X + BEGIN + setnz(X - read(ab.)) NEXT + c = X GEQ read + END, + + inx := ! Increment index X by one + BEGIN + X = X + 1 NEXT + setnz(X) + END + + + END ! End of MC6502 + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/6502/mc6502.tokio Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,515 @@ +% ISPS Description of the MOS Technology MCS 6502 Microprocessor + +% G.W.Leive +% 10 July 1978 ISPS Version +% COPYRIGHT (C) 1978 + +% rewriten for Tokio + +% MC6502 :- + +'$function' bit(Bit,I) = ( I >> Bit ) /\ 1 :-true . +'$function' high(Word) = (Word>>8)/\hex("ff") :-true . +'$function' low(Word) = (Word/\hex("ff")) :-true . +'$function' signed(Data) = Signed :- signed(Data,Signed) . +'$function' byte(Word) = (Word/\hex("ff")) :-true . + +signed(Data,Signed) :- Data >127,!, Signed = Data - 256. +signed(Data,Data). + +:-op(600,xfy, xor). +'$function' xor(A,B) = ( (-A) /\ B) \/ (A /\ (-B)) :-true . + +:-static([ + mem(_), + +% *PCSTATE + + pc, % program counter + y, % Index register + x, % Index register + s, % stack pointer + dl, % Input data latch + a, % accumulator + ir, % Instruction register + p, % processor status + + n, % Negative result + v, % Overflow + b, % Break command + d, % Decimal mode + i, % Interrupt disable + z, % Zero + c, % Carry + + irq, % Interrupt request + nmi, % Non-maskable interrupt + ifsync, % High when instruction fetch + rw, % Read/Write control pin + so, % set overflow pin + reset, % power up bit + ready % 1 means run, 0 means stop + +]). + +status_report :- + write(('pc=',*pc,' y=', *y, ' x=',*x , ' dl=', *dl, + ' a=',*a,' ir=',*ir, ' rw=', *rw, + ' s=',*s, ' c=', *c, ' z=' ,*z)). + + +% ADDRESS.CALCULATION + +immed(R):- % Immediate + R <- *pc, + *pc <= *pc + 1. + +zp(R):- % Zero page + read(*pc,R) , *pc <= *pc + 1. + +abs(R):- % Absolute + ab(*pc + 1, *pc,R), + *pc <= *pc + 2. + +indx(R):- % Indexed indirect - (IND, *x) + read(*pc,R) && + R1 = R + *x, read_2(R1+1,R1,H,L) && + ab(H,L,R), *pc <= *pc + 1. + +indy(R):- % Indirect indexed - (IND), *y + read(*pc,R) && + ab(R + 1,R ,R) && + R <- R + *y, *pc <= *pc + 1. + +zpx(R):- % Zero page indexed by *x + read(*pc,R1) && + R <- byte(R1 + *x), *pc <= *pc + 1. + +zpy(R):- % Zero page indexed by *y + read(*pc,R1) && + R <- byte(R1 + *y), *pc <= *pc + 1. + +absy(R):- % absolute modified by *y + ab(*pc + 1, *pc,R1) && + R <- R1 + *y , *pc <= *pc + 2. + +absx(R) :- % absolute modified by *x + ab(*pc + 1, *pc,R1) && + R <- R1 + *x , *pc <= *pc + 2. + + +% *SERVICE.FACILITIES + +push(Dbb) :- % Push a byte on the stack + write(hex("100") + *s, Dbb), + *s <= *s - 1. + +pull(R):- % pull a byte off the stack + *s <= *s + 1 && + read(hex("100") + *s,R). + +opex :- % Operation exception + *ready <= 0 && run. + +setnz(Ta):- % Set neg and zero condition code + Ta = 0,!, *z <= 1, *n <= 0. +setnz(Ta):- + Ta < 0,!, *z <= 0, *n <= 1. +setnz(Ta):- + Ta > 0,!, *z <= 0, *n <= 0. + +branch(0) :- *pc <= *pc + 1. +branch(1) :- read(*pc,R) && + *pc <= *pc + 1 + signed(R). % Relative addressing + +decimal_adjust(Tac):- % Used by sbc and adc + ( if (bit(7,*a) = bit(7,Tac)) + then + *v <= bit(7,Tac) xor bit(7,*a), + *c <= bit(8,Tac) ) && + ( if (*d = 1) then ( + (if Tac /\ binary("1111") > 9 then + Tac <- (Tac/\hex("ff") + 6)) && + (if *c = 0 then *c <= bit(8,Tac)) && + (if (Tac /\ binary("11110000")>>4) > 9 then + Tac <- (Tac/\hex("ff") + hex("60"))) && + (if *c = 0 then *c <= bit(8,Tac)) + )) && + *a <= byte(Tac) && + setnz(*a). + +ab(Adh,Adl,R):- % *address buffer + read_2(Adh,Adl,R1,R2), + fin( R = R1<<8 + R2 ). + +% Read and write memory access routines + +read(Adr,Value):- % Read from valid memory + *rw <= 1, Adr <- Adr && + read_1(Adr,Value). +read_1(Adr,Value):- + *ready=0,!, int,Adr <- Adr && read_1(Adr,Value). +read_1(Adr,Value) :- + Value <- *mem(Adr). + +read_2(AdrH,AdrL,Vh,Vl) :- + read(AdrH,Vh) && read(AdrL,Vl), Vh <- Vh. + +write(Adr,Value) :- % Write to valid memory + *rw <=0,Adr <- Adr,Value <-Value && + *mem(Adr) <= Value. + +% Interrupt routines + +intstk :- % Interrupt stack operations + push(high(*pc)) && + push(low(*pc)) && + push(*p), *i <= 1. + +int :- % Interrupt processing + *reset = 0,!, + *reset <= 1,*irq <= 1,*nmi <= 1,*ready <= 1 && + ab(hex("FFFD"), hex("FFFC"),R) && + *pc <= R, *i <= 1. +int :- + *nmi = 0,!, + *nmi <= 1 && + intstk && + ab(hex("FFFB"), hex("FFFA"),R) && + *pc <= R. +int :- + (*b = 1 ; *irq = 0, *i = 0),!, + intstk, *b <= 0 && + ab(hex("FFFF"), hex("FFFE"),R) && + *pc <= R. +int. + +% INSTRUCTION.INTERPRETATION +% Yes It is the main routine. + +run :- + (if *reset = 0 then int ) && % Initial startup + run1. +run1 :- *ready = 0 ,! , empty. +run1 :- *ifsync <= 1 && % Instruction fetch + read(*pc,R) && + *ir <= R , *pc <= *pc + 1, *ifsync <= 0 && % Execute + run_decode(*ir/\binary("11")) && + int && + ( if *so=1 then *v <= 1), status_report && + run. + + run_decode(binary("01")) :- !, + I1 = (*ir>>5)/\binary("111"),group1(I1). + run_decode(binary("10")) :- !, + I1 = (*ir>>5)/\binary("111"),group2(I1). + run_decode(binary("00")) :- !, group3(*ir). + run_decode(binary("11")) :- !, opex. + +% Group 1 instruction decode + +group1( 0 ):- ora. +group1( 1 ):- and. +group1( 2 ):- eor. +group1( 3 ):- adc. +group1( 4 ):- sta. +group1( 5 ):- lda. +group1( 6 ):- cmp. +group1( 7 ):- sbc. + +% Group 2 instruction decode + +group2( 0 ):- asl. +group2( 1 ):- rol. +group2( 2 ):- lsr. +group2( 3 ):- ror. +group2( 4 ):- stx. % Includes txa. txs +group2( 5 ):- ldx. % Includes tax. tsx +group2( 6 ):- dec. % Includes dex +group2( 7 ):- inc. % Includes no.op + +% Group 3 instruction decode + +group3(hex("00")) :- !, brk. % Break +group3(hex("08")) :- !, php. % push status on stack +group3(hex("28")) :- !, plp. % pull status from stack +group3(hex("48")) :- !, pha. % push accumulator +group3(hex("68")) :- !, pla. % pull accumulator +group3(hex("10")) :- !, bpl. % Branch on plus +group3(hex("30")) :- !, bmi. % Branch on minus +group3(hex("50")) :- !, bvc. % Branch if overflow clear +group3(hex("70")) :- !, bvs. % Branch if overflow set +group3(hex("90")) :- !, bcc. % Branch on carry clear +group3(hex("D0")) :- !, bne. % Branch on not equal +group3(hex("F0")) :- !, beq. % Branch if equal +group3(hex("B0")) :- !, bcs. % Branch if carry set +group3(hex("18")) :- !, clc. % Clear carry +group3(hex("38")) :- !, sec. % set carry +group3(hex("58")) :- !, cli. % Clear interrupt enable +group3(hex("78")) :- !, sei. % set interrupt enable +group3(hex("B8")) :- !, clv. % Clear overflow +group3(hex("D8")) :- !, cld. % Clear decimal mode +group3(hex("F8")) :- !, sed. % set decimal mode +group3(hex("20")) :- !, jsr. % Jump to subroutine +group3(hex("24")) :- !, % Bit test - zero page + zp(Adr) && read(Adr,V) && bit(V). +group3(hex("2C")) :- !, % Bit test - absolute + abs(Adr) && read(Adr,V) && bit(V). +group3(hex("40")) :- !, rti. % Return from interrupt +group3(hex("4C")) :- !, jmp. % Jump - absolute +group3(hex("6C")) :- !, jmp. % Jump - indirect +group3(hex("60")) :- !, rts. % Return from subroutine +group3(hex("84")) :- !, % Store *y - zero page + zp(Adr) && sty(Adr). +group3(hex("8C")) :- !, % Store *y - absolute + abs(Adr) && sty(Adr). +group3(hex("94")) :- !, % Store *y - zero page, *x + zpx(Adr) && sty(Adr). +group3(hex("88")) :- !, dey. % Decrement *y +group3(hex("C8")) :- !, iny. % Increment *y +group3(hex("E8")) :- !, inx. % Increment *x +group3(hex("98")) :- !, tya. % Transfer *y to *a +group3(hex("A8")) :- !, tay. % Transfer *a to *y +group3(hex("A0")) :- !, % Load *y - immediate + immed(Adr) && ldy(Adr). +group3(hex("A4")) :- !, % Load *y - zero page + zp(Adr) && ldy(Adr). +group3(hex("AC")) :- !, % Load *y - absolute + abs(Adr) && ldy(Adr). +group3(hex("B4")) :- !, % Load *y - zero page, *x + zpx(Adr) && ldy(Adr). +group3(hex("BC")) :- !, % Load *y - absolute, *x + absz(Adr) && ldy(Adr). +group3(hex("C0")) :- !, % Compare immediate to *y + immed(Adr) && cpy(Adr). +group3(hex("C4")) :- !, % Compare zero page to *y + zp(Adr) && cpy(Adr). +group3(hex("CC")) :- !, % Compare absolute to *y + abs(Adr) && cpy(Adr). +group3(hex("E0")) :- !, % Compare immediate to *x + immed(Adr) && cpx(Adr). +group3(hex("E4")) :- !, % Compare zero page to *x + zp(Adr) && cpx(Adr). +group3(hex("EC")) :- !, % Compare absolute to *x + abs(Adr) && cpx(Adr). +group3(I) :- opex. + + +% INSTRUCTION.EXECUTION + +% Group 1 instruction execution + +addrs1(Adr) :- % Group 1 address generation + I = (*ir >> 2 ) /\ binary("111"), + addrs1(I,Adr). + +addrs1( 0 , Adr):- indx(Adr). +addrs1( 1 , Adr):- zp(Adr). +addrs1( 2 , Adr):- immed(Adr). +addrs1( 3 , Adr):- abs(Adr). +addrs1( 4 , Adr):- indy(Adr). +addrs1( 5 , Adr):- zpx(Adr). +addrs1( 6 , Adr):- absy(Adr). +addrs1( 7 , Adr):- absx(Adr). + +ora :- % Or + addrs1(Adr) && read(Adr,R) && *a <= *a /\ R && + setnz(*a). + +and :- % And + addrs1(Adr) && read(Adr,R) && *a <= *a /\ R && + setnz(*a). + +eor :- % Exclusive or + addrs1(Adr) && read(Adr,R) && *a <= *a xor R && + setnz(*a). + +adc :- + addrs1(Adr) && read(Adr,R) && + decimal_adjust(*a + *c + R). % add with carry + +sta :- *ir \= hex("89"),!, + addrs1(Adr) && write(Adr,*a). % store immediate + +lda :- % Load accumulator + addrs1(Adr) && read(Adr,R) && *a <= R && + setnz(*a). + + cmp :- % Compare + addrs1(Adr) && read(Adr,R) && setnz(*a - R) && + if *a > R then *c<=1 else *c<=0. + + sbc :- + addrs1(Adr) && read(Adr,R) && + decimal_adjust(*a + *c - R). % Sub/carry + + % Group 2 addressing mode selection + + % Group 2 gets and puts + + get2(R1,Adr) :- % Get the correct operand and return it in R1 + I = (*ir >> 2) /\ binary("111"), + get2(I,R,Adr) ,fin( R1 = R + (*c << 8)). + + get2(1,R,Adr) :- zp(Adr) && Adr <- Adr, read(Adr,R). + get2(2,R,Adr) :- R <- *a, Adr <- Adr. + get2(3,R,Adr) :- abs(Adr) && Adr <- Adr, read(Adr,R). + get2(5,R,Adr) :- zpx(Adr) && Adr <- Adr, read(Adr,R). + get2(7,R,Adr) :- absx(Adr) && Adr <- Adr, read(Adr,R). + get2(_,R,Adr) :- opex. + + put2(Ta,Adr) :- % put the operand in the proper location + I = (*ir >> 2) /\ binary("111"), + put2(I,Ta,Adr),Ta<-Ta && setnz(Ta). + + put2(1,Ta,Adr) :- write(Adr, Ta). + put2(3,Ta,Adr) :- write(Adr, Ta). + put2(5,Ta,Adr) :- write(Adr, Ta). + put2(7,Ta,Adr) :- write(Adr, Ta). + put2(2,Ta,Adr) :- *a <= Ta. + put2(_,Ta,Adr) :-opex. + + % Group 2 instruction execution + + asl :- % Arithmetic shift left + get2(V,Adr) && + V1 = V << 1, + *c <= (V1 >> 8) /\ 1,put2(byte(V1),Adr). + + rol :- % rotate left + get2(V,Adr) && + V1 = (V << 1)+ *c, + *c <= (V1 >> 8) /\ 1,put2(byte(V1),Adr). + + lsr :- % Logical shift right + get2(V,Adr) && + V1 = (V >> 1)/\ hex("7f") , + *c <= V /\ 1, put2(byte(V1),Adr). + + ror :- % Rotate right + get2(V,Adr) && + V1 = (V >> 1)/\ hex("7f") + ( (V /\ 1) << 8), + *c <= V /\ 1 , put2(byte(V1),Adr). + + stx :- % store index register + I = (*ir>>2)/\binary("111"), + stx(I,*x). + + stx(1,X) :- zp(Adr) && write(Adr, X). + stx(2,X) :- *a <= X. % Txa + stx(3,X) :- as(Adr) && write(Adr, X). + stx(5,X) :- zpy(Adr) && write(Adr, X). + stx(6,X) :- *s <= X. % Txs + stx(_,_) :- opex. + + ldx :- % Load index register + I = (*ir>>2)/\binary("111"), + ldx(I,X) && *x <= X && setnz(*x). + + ldx(0,X) :- immed(Adr) && read(Adr,X). + ldx(1,X) :- zp(Adr) && read(Adr,X). + ldx(2,X) :- X <- *a. % Tax + ldx(3,X) :- abs(Adr) && read(Adr,X). + ldx(4,X) :- opex. + ldx(5,X) :- zpy(Adr) && read(Adr,X). + ldx(6,X) :- X <- *s. % Tsx + ldx(7,X) :- absy(Adr) && read(Adr,X). + + dec :- % Decrement + *ir = hex("CA"),!, % Dex + X = *x - 1,*x <= X, setnz(X). + dec :- get2(Value,Adr) && put2(Value - 1,Adr). + + inc :- % Increment + *ir = hex("EA"),!. % EA no.op + inc :- + get2(Value,Adr) && put2(Value + 1,Adr). + + % Group 3 instruction execution + + brk :- + *ready <= 0. % for Debug +% (*b <= 1, *pc <= *pc+1). % Break + + php :- push(*p). % push processor status on stack + plp :- pull(A),*p <= A. % pull processor status from stack + pha :- push(*a). % push accumulator on stack + pla :- % pull accumulator from stack + pull(A) && *a <= A, setnz(A). + + bpl :- boolNot(*n,B),branch(B). % Branch on plus + bmi :- bool(*n,B),branch(B). % Branch on minus + bvc :- boolNot(*v,B),branch(B). % Branch on overflow clear + bvs :- bool(*v,B),branch(B). % Branch if overflow set + bcc :- boolNot(*c,B),branch(B). % Branch on carry clear + bne :- boolNot(*z,B),branch(B). % Branch if not equal + beq :- bool(*z,B),branch(B). % Branch on equal + bcs :- bool(*c,B),branch(B). % Branch on carry set + +bool(1,1). bool(0,0). +boolNot(1,0). boolNot(0,1). + + clc :- *c <= 0. % Clear carry flag + sec :- *c <= 1. % Set carry + cli :- *i <= 0. % Clear interrupt disable bit + sei :- *i <= 1. % Set interrupt disable status + clv :- *v <= 0. % Clear overflow + cld :- *d <= 0. % Clear decimal mode + sed :- *d <= 1. % Set decimal mode + + jsr :- % Jump to subroutine + push(high(*pc + 1)) && + push(low(*pc + 1)) && + abs(Value) && *pc <= Value. + + bit(Ta) :- % Bit test + *n <= Ta, (if (Ta /\ *a)=0 then *z <= 1 else *z <= 0). + + rti :- % Return from interrupt + pull(P) && *p <= P && + pull(P) && *pc<= P && + pull(P) && *pc<= (P<<8)+ *pc, *b <= 0. + + jmp :- *ir = hex("6C"),!, + abs(Value) && *pc <= Value && + abs(Value) && *pc <= Value . % Indirect + jmp :- abs(Value) && *pc <= Value. + + + % Group 3 instruction execution (page 2) + + rts :- % return from subroutine + pull(P) && *pc<= P && + pull(P) && *pc<= (P<<8)+ *pc && + *pc <= *pc+1. + + sty(X) :- write(X, *y). % Store index *y in memory + + dey :- % Decrement index *y by one + Y = *y - 1,*y <= Y, setnz(Y). + + tya :- % Transfer index *y to accumulator + *a <= *y, setnz(*y). + + ldy(A) :- read(A,Value) && *y <= Value. % Load index *y with memory + + tay :- % Transfer accumulator to index *y + *y <= *a, setnz(*a). + + cpy(A) :- % Compare memory and index *y + read(A,Value) && setnz(*y - Value), + (if *y > Value then *c <= 1 else *c <= 0). + + iny :- % Increment index *y by one + Y = *y + 1 , *y <= Y, setnz(*y). + + cpx(A) :- % Compare memory and index *x + read(A,Value) && setnz(*x - Value), + (if *x > Value then *c <= 1 else *c <= 0). + + inx :- % Increment index *x by one + X = *x + 1, *x <= X, setnz(*x). + +% End of MC6502 + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/6502/multi.s65 Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,60 @@ +;; 16 bit multply + +last equ $80 +d1 equ last +d2 equ last+2 +result equ last+4 +count equ last+8 +work equ last+9 + + org $0 + +start cld + lda #$92 + sta d1 + lda #$34 + sta d1+1 + lda #$83 + sta d2 + lda #$21 + sta d2+1 + jsr multi16 + brk + +multi16 lda #0 + sta result + sta result+1 + sta result+2 + sta result+3 + ldx #d1 + jsr multil + inx +;; fall into multi8 + +multi8 lda #0 +multil sta work + lda d2 + sta work+1 + lda d2+1 + sta work+2 + jmp entry + +adding clc + lda work+2 + adc 6,x + sta 6,x + lda work+1 + adc 5,x + sta 5,x + lda work + adc 4,x + sta 4,x +loop asl work+2 + rol work+1 + rol work +entry lsr 0,x + bcs adding + bne loop + rts + + end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/6502/run.tokio Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,91 @@ +/* + + read intel hex data from file + +:10000000D8A201A00120090000E000D003C8986038 +:10001000C000D006CAA0014C09008A488820090007 +:05002000A868AACA60F7 +:00000001FF + + write into internal memory. (assert ) + + +*/ + + +run0(Filename) :- + fname(Filename,".hex",Filename1), + ld0(Filename1),!, + *p := 0, *reset := 0, *s := 0, *b := 0, *so := 0, *y := 0, *x := 0, + *dl := 0, *a := 0, *c := 0, *z := 0, + *mem(hex("FFFC")) := 0, *mem(hex("FFFD")) := 0, + *mem(hex("FFFE")) := 0, *mem(hex("FFFF")) := 0 + && run. + +run(Filename) :- + fname(Filename,".hex",Filename1), + ld0(Filename1),!, + *p := 0, + *reset := 0, + *s := 0, + *b := 0, + *so := 0, + *y := 0, + *x := 0, + *dl := 0, + *a := 0, + *c := 0, *z := 0, + *mem(hex("FFFC")) := 0, + *mem(hex("FFFD")) := 0, + *mem(hex("FFFE")) := 0, + *mem(hex("FFFF")) := 0 + && X <- cputime, run, fin(( + X1 = cputime - X,nl,write(X1),nl)). + + +fname(Output,Option,Loutput) :- + name(Output,L),append(L,Option,LC),name(Loutput,LC). + +append([H|X],Y,[H|Z]) :- append(X,Y,Z). +append([],X,X) . + +ld0(File) :- seeing(O),ld1(File,Lines),seen,see(O). + +ld1(File,Lines) :- +% abolish(mem,2), + see(File), % nofileerrors, + get0(Ch),lines(Ch),!,seen. +ld1(File,Lines) :- seen, % fileerrors, + !,fail. + +lines(-1) :-!. +lines(26) :-!. +lines(58) :- !, + get0(C), count(N,[C|N],1,I), + get0(C0), count(N1,[C0|N1],3,Adr0), + get0(C1), count(N2,[C1|N2],1,Adr1), + Adr = Adr1*65536+Adr0+I, + data(I,Adr), + get0(NNC), lines(NNC). +lines(X) :- get0(C),lines(C). + +count([],NC,0,I) :-!, hex(NC,I). +count([H|T],NC,N,I) :- N1 = N-1, get0(H), + count(T,NC,N1,I). + +hex(L,V) :- hex(L,V,0). + +hex([],V,V) :-!. +hex([H|T],Y,V) :- H>47,H<58, !,V1 = V*16+H-48,hex(T,Y,V1). +hex([H|T],Y,V) :- H>64,H<71, !,V1 = V*16+H-65+10,hex(T,Y,V1). +hex([H|T],Y,V) :- H>96,H<103,!,V1 = V*16+H-97+10,hex(T,Y,V1). + +data(0,_) :-!. +data(N,Adr) :- + get0(C),count(T,[C|T],1,Data), + Adr1 = Adr-N, +% assert(mem(Adr1,Data)), + *mem(Adr1) := Data, + N1 = N-1, + data(N1,Adr). +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/dining_phil/di Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,39 @@ +philosopher(Lfork,Rfork,Sta,Id):- + Sta=think_, + @Sta=pick_l. +philosopher(Lfork,Rfork,Sta,Id):-Sta=pick_l, + (@Lfork=Id, @Sta=pick_r + ; @Sta=pick_l). +philosopher(Lfork,Rfork,Sta,Id):-Sta=pick_r, @Lfork=Lfork, + (@Rfork=Id, @Sta=eating + ; @Sta=pick_r). +philosopher(Lfork,Rfork,Sta,Id):- + Sta=eating, + @Rfork=Rfork, + @Sta=free_l. +philosopher(Lfork,Rfork,Sta,Id):- + Sta=free_l, + @Sta=free_r. +philosopher(Lfork,Rfork,Sta,Id):- + Sta=free_r, + @Sta=think_. + +dining_philosopher(F,S):- + length(20), + [Fa,Fb,Fc,Fd,Fe]=F, + [Sta,Stb,Stc,Std,Ste]=S, + #philosopher(Fa,Fb,Sta,a), + #philosopher(Fb,Fc,Stb,b), + #philosopher(Fc,Fd,Stc,c), + #philosopher(Fd,Fe,Std,e), + #philosopher(Fe,Fa,Ste,f), + #write((Sta,Stb,Stc,Std,Ste,-(Fa,Fb,Fc,Fd,Fe))). + +d0:- dining_philosopher( + [_,b,b,e,e], + [think_,eating,think_,eating,think_]). + +d1:- dining_philosopher( + [_,_,_,_,_], + [think_,think_,think_,think_,think_]). +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/dining_phil/ve Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,30 @@ +ph_think(L,R,I) :- @free(L,R,I),less(4) + && ph_left(L,R,I). +ph_left(L,R,I) :- @left(L,R,I),skip + && ph_eat(L,R,I). +ph_eat(L,R,I) :- @both(L,R,I),length(2) + && ph_left_off(L,R,I). +ph_left_off(L,R,I) :- @right(L,R,I),skip + && ph_think(L,R,I). + + less(N) :- M=N,less1(M). + less1(N) :- N = 0, empty. + less1(N) :- @N = N+1,next(less1(N)). + +left(I,_,(I,left)). +both(I,I,(I,eat)). +right(_,I,(I,right)). +free(_,_,(_,free)). + +ph_think(L,R,I) :- empty. +ph_left(L,R,I) :- empty. +ph_eat(L,R,I) :- empty. +ph_left_off(L,R,I) :- empty. + +diningPh(Sa,Sb,Sc) :- + ph_think(A,B,(1,Sa)), + ph_think(B,C,(2,Sb)), + ph_think(C,A,(3,Sc)), + #write((Sa,Sb,Sc)). + +test :- length(10),diningPh(A,B,C).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/etc/dekker Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,37 @@ +'$define' progress(Cr1,Crit,Conc):- + #(Cr1=true),Crit + && @ (#(Cr1=false),Conc). + +'$define' ( exclusion(Id,Id2,T,Cr1,Cr2,Crit,Conc):- H ) +'$clause' ( H :- + Cr1=true, + enter(Id,Id2,T,Cr1,Cr2) + && progress(Cr1,Crit,Conc) + && @ H) . + +enter(Id,Id2,T,Cr1,Cr2) :- + Cr2=true,T=Id2,@Cr1=false, + @enter(Id,Id2,T,Cr1,Cr2). +enter(Id,Id2,T,Cr1,Cr2) :- + Cr2=true,T=Id,@Cr1=true,@T=Id, + @trust(Id,Id2,T,Cr1,Cr2). +enter(Id,Id2,T,Cr1,Cr2) :- + Cr2=false,@Cr1=true,skip. + +trust(Id,Id2,T,Cr1,Cr2) :-stable(T), + Cr2=true,@Cr1=true, + @trust(Id,Id2,T,Cr1,Cr2). +trust(Id,Id2,T,Cr1,Cr2) :- + Cr2=false,@Cr1=true,skip. + + +dekker:-T=0,Cr1=true,Cr2=true, + exclusion(0,1,T,Cr1,Cr2,critical(0),concurrent(0)), + exclusion(1,0,T,Cr2,Cr1,critical(1),concurrent(1)). + +critical(Id):-length(2), + keep((write('critical-region'),write(Id),nl)). + +concurrent(Id):-length(3), + keep((write('concurrent-region'),write(Id),nl)). +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/etc/mac Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,102 @@ + +/* Three diferent descriptions of + calcurate maginitude of vector */ + +/* data flow calcuration */ + +magasync_dataflow(A,B,Res):- + Aab = 0, Bab = 0, G = 0, Res = 0, + L = 0, Sqs = 0, G1 = 0, % initialize + #abs_unit(A,Aab), + #abs_unit(B,Bab), + #maxmin(Aab,Bab,G,L), + #calc(G,L,Sqs), + #delay(G,G1), + #result(G1,Sqs,Res). + +delay(G,G1):- + @G1 = G. + +abs_unit(I,O):- + if I < 0 then @O = -I else @O = I . + +maxmin(I1,I2,O1,O2):- + if I1 > I2 then (@O1 = I1, @O2 = I2) + else (@O1 = I2, @O2 = I1) . + +calc(I1,I2,O):- + @O = I1 * 7 / 8 + I2 / 2 . + +result(I1,I2,O):- + if I1 > I2 then @O = I1 else @O = I2 . + +/* algorithmic description */ + +magasync(A,B,Res):- + (if A < 0 + then Aab <- - A + else Aab <- A ), + (if B < 0 + then Bab <- - B + else Bab <- B ) + && + (if Aab > Bab + then G <- Aab, L <- Bab + else G <- Bab, L <- Aab) + && + Sqs <- G * 7 / 8 + L / 2 , G <- G + && + (if G > Sqs + then Res <- G + else Res <- Sqs). + +/* head is interval name */ + +mag_name(A,B,Res) :- int1(A,B,Res). + +int1(A,B,Res) :- + skip, + (if A < 0 then Aab <- - A + else Aab <- A ), + (if B < 0 then Bab <- - B + else Bab <- B ) + && int2(Aab,Bab,Res). + +int2(Aab,Bab,Res) :- + skip, + (if Aab > Bab + then (G <- Aab, L <- Bab) + else (G <- Bab, L <- Aab)) + && int3(G,L,Res). + +int3(G,L,Res) :- + skip, + Sqs <- G * 7 / 8 + L / 2 , G <- G + && int4(Sqs,G,Res). + +int4(Sqs,G,Res) :- + skip, + (if G > Sqs + then Res <- G + else Res <- Sqs) + && true. + +/* data generator */ + +input_data(0,[]) :- !,empty. +input_data(V,[H|T]):- + V = H, + @T = T, + @input_data(V,T). + +write_fk(A) :- fin(write(A)),keep(write(A)). + +test1:- A=5,B=6, + magasync(A,B,Res), write_fk([A,B,Res]). + +test2:- Va = [1,2,3,4,5,6,7], Vb = [1,2,3,4,5,6,7], + input_data(A,Va),input_data(B,Vb), + magasync_dataflow(A,B,Res), write_fk([A,B,Res]). + +test3:- A=5,B=6, + mag_name(A,B,Res), write_fk([A,B,Res]).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/etc/memory Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,79 @@ +store(Adr,Value0,Contents) :- + Value = Value0, + Now = Contents, + store0(0,Adr,Value,Now,Next), + Contents <- Next. +store0(Adr,Adr1,Value,N,NN) :- Adr=Adr1,!,N=[_|Tail],NN=[Value|Tail]. +store0(I, Adr,Value,N,NN) :- N=[V|Now],NN=[V|Next], + I1 = I+1, + store0(I1,Adr,Value,Now,Next). + +fetch(Adr,Value0,Contents) :- + Now = Contents, + fetch0(0,Adr,Value,Now), + stable( Contents ), + Value0 <- Value. +fetch0(Adr,Adr1,N,NN) :- Adr=Adr1,!,N=Value,NN=[Value|_]. +fetch0(I, Adr,N,NN) :- N=Value,NN=[_|Now], + I1 = I+1, + fetch0(I1,Adr,Value,Now). + +memory(Adr,Cmd,Data,Contents) :- ( + if Cmd=read then fetch(Adr,Data,Contents) + else if Cmd=write then store(Adr,Data,Contents) + else stable(Contents)) && memory(Adr,Cmd,Data,Contents). +memory(Adr,Cmd,Data,Contents) :- empty. + + +test :- store(0,0,Contents) && store(3,1,Contents) && + stable(Contents) && + fetch(0,A,Contents),fetch(3,B,Contents), + fin(write( (A,B) )). + +test2 :- length(20),( + Cmd=write,Data=1,Adr=0 && + Cmd=write,Data=2,Adr=3 && + Cmd=off && + Cmd=read,Adr=0 && + Cmd=off && + Cmd=read,Adr=3 && + Cmd=off ), + memory(Adr,Cmd,Data,Contents), + #write((Adr,Cmd,Data)),#nl. + + +% memory using global variable + +:-static([cmd,adr,data,contents]). + +memory :- ( + if *cmd=read then fetch + else if *cmd=write then store) && memory. +memory :- empty. + +store :- + Value = *data, + Now = *contents, Adr = *adr, Value = *data, + store0(0,Adr,Value,Now,Next), + *contents <= Next. + +fetch :- + Adr = *adr, Now = *contents, + fetch0(0,Adr,Value,Now), + *data <= Value. + + +test3 :- length(20),( + *cmd:=write,*data:=1,*adr:=0 && + *cmd:=write,*data:=2,*adr:=3 && + *cmd:=off && + *cmd:=read,*adr:=0 && + *cmd:=off && + *cmd:=read,*adr:=3 && + *cmd:=off ), + memory, + #(( Adr = *adr, Cmd = *cmd, Data = *data, + write((Adr,Cmd,Data)), + nl )). + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/etc/rsffdelay Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,31 @@ + + +rs(R,S,NQ,Q) :- + (nand(S,Q,NQ,2) && true), + (nand(R,NQ,Q,3) && true). + +nand(A,B,Out,Delay) :- + A = 1,B = 1, + length(Delay), + Out <- 0 . +nand(A,B,Out,Delay) :- + A = 1,B = 0, + length(Delay), + Out <- 1 . +nand(A,B,Out,Delay) :- + A = 0,B = 1, + length(Delay), + Out <- 1 . +nand(A,B,Out,Delay) :- + A = 0,B = 0, + length(Delay), + Out <- 1 . + +test :- data(R,S), + #rs(R,S,NQ,Q), + #write((NQ,Q)). + +data(R,S) :- length(4), + read((R,S)), + stable(R),stable(S) + && @data(R,S).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/etc/rsflipflop Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,24 @@ + + +rs(R,S,Q,NQ) :- + nand(R,NQ,Q), + nand(S,Q,NQ). + +nand(A,B,Out) :- + A = 1,B = 1, + @Out = 0. +nand(A,B,Out) :- + A = 1,B = 0, + @Out = 1. +nand(A,B,Out) :- + A = 0,B = 1, + @Out = 1. +nand(A,B,Out) :- + A = 0,B = 0, + @Out = 1. + + +test :- #(notEmpty), + #read((R,S)), + #rs(R,S,Q,NQ), + #write((Q,NQ)).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/etc/send Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,43 @@ +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% % +% example of handshake % +% % +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% try tokio hand. I don't know how to stop it + +$define (loop(X) :- H) $clause (H :- X && H). + +hand :- Hear=0,Call=0, + send(Call,Hear,Data), % all always + receive(Call,Hear,Data), + #(write((Call,Hear,Data))). + +% sender and receiver + +send(Call,Hear,Data) :- + #send_sync(Call,Hear),send_data(Call,Hear,Data,0). + + send_sync(Call,Hear) :- Hear=0, Call=0, @Call = 1. + send_sync(Call,Hear) :- Hear=0, Call=1. + send_sync(Call,Hear) :- Hear=1, Call=1, @Call = 0. + send_sync(Call,Hear) :- Hear=1, Call=0. + + send_data(Call,Hear,Data,I) :- + halt(Call=1) + & #(Data=I), halt(Call=0) + & J <-- I+1, @send_data(Call,Hear,Data, J). + +receive(Call,Hear,Data) :- + #receive_sync(Call,Hear),receive_data(Call,Hear,Data). + + receive_sync(Call,Hear) :- Call=1, Hear=0, @Hear = 1. + receive_sync(Call,Hear) :- Call=1, Hear=1. + receive_sync(Call,Hear) :- Call=0, Hear=1, @Hear = 0. + receive_sync(Call,Hear) :- Call=0, Hear=0. + + receive_data(Call,Hear,Data) :- + halt(Hear=1) + & write(accept(Data)),halt(Hear=0) + & @receive_data(Call,Hear,Data). + +% end of examples
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/etc/solve Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,69 @@ +/* + + tokio interpreter on tokio + Thu Sep 4 11:06:06 GMT+9:00 1986 + +*/ + + +% main parts +solve((A,B)):- solve(A),solve(B). +solve(A):- t_clause(A,B),solve(B). + +%% temporal operators +solve((A && B)):- + solve(A) && solve(B). +solve(#A):- + #solve(A). +solve(@A):- + @solve(A). +solve(next(A)):- + next(solve(A)). +solve(keep(A)):- + keep(solve(A)). +solve(length(N)):- + length(N). + +%% functions +solve(A=B) :- eval(A,V),eval(B,V1),!,V=V1. +eval(V1,V) :- atomic(V1),!,V=V1. +eval(V1,V) :- var(V1),!,V=V1. +eval(@A,V) :- next(eval(A,V1)), V = @V1. +eval(A+B,V) :- eval(A,AA),eval(B,BB), V=AA+BB. + +%% system predicates +solve(A):- sys(A),prolog(A). + +sys(write(_)). +sys(nl). +sys(true). + +%% assertions +t_clause( counter(A) , (@A=A+1, next(counter(A)))). + +t_clause( ap([],A,A) , true). +t_clause( ap([H|X],Y,[H|Z]), ap(X,Y,Z)). + +%% tester +test1 :- solve(( + length(5),#write(1) + )). + +test2 :- solve(( + length(3),#write(0) && + length(2),#write(1) + )). + +test3 :- solve(( % this does not work + length(5),A=1, #(@A=A+1), #write(A) + )). + +test4 :- solve(( + length(5),A=1,counter(A),#write(A) + )). + +test5 :- solve(( + ap(A,B,[1,2,3]),write((A,B)),nl,fail + )). + +%%
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/etc/talk Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,36 @@ +% +% Talk Program for Tokio +% Tue Jul 5 01:18:04 JST 1988 + +talk(A,B) :- + #key(A,In1),#crt(A,Out1), + #key(B,In2),#crt(A,Out2), + Buffer1 = [], Buffer2 = [], + merge_dequeue(In1,In2,Out1,Buffer1), + merge_dequeue(In2,In1,Out2,Buffer2). + +key(Who,Input) :- write(Who),write(':in:'), read(Input). +crt(Who,Output) :- write(Who),write(':out:'),write(Output),nl. + +merge_dequeue(In1,In2,Out,Buffer) :- + merge(In1,In2,Buffer), + @ dequeue(Out,Buffer), + @ @ merge_dequeue(In1,In2,Out,Buffer). + +merge(In1,In2,Buffer) :- In1 = none, In2 = none,!, + @Buffer = Buffer. +merge(In1,In2,Buffer) :- In1 = none, !, + ap(Buffer,[In2],@Buffer). +merge(In1,In2,Buffer) :- In2 = none, !, + ap(Buffer,[In1],@Buffer). +merge(In1,In2,Buffer) :- % non deterministic choice + ap(Buffer,[In2],@Buffer). +merge(In1,In2,Buffer) :- + ap(Buffer,[In1],@Buffer). + +dequeue(Out, Buffer) :- Buffer = [],!. +dequeue(Out, Buffer) :- Buffer = [Out|@Buffer]. + +ap(Nil,X,X1) :- Nil = [], X = X1. +ap(HX,Z,HY) :- HX = [H|X], HY = [H|Y], + ap(X,Y,Z).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/kiss/keyc.kiss2 Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,175 @@ + +.i 7 +.o 6 +.p 170 +.s 19 +---0000 st0 st1 1-0000 +---0100 st0 st2 1-0001 +---0010 st0 st2 1-0001 +---0001 st0 st2 1-0001 +---1100 st0 st3 1-0001 +---1000 st0 st3 1-0001 +---011- st0 st0 -00001 +---01-1 st0 st0 -00001 +---101- st0 st0 -00001 +---10-1 st0 st0 -00001 +---111- st0 st0 -00001 +---11-1 st0 st0 -00001 +-----11 st0 st0 -00001 +0000000 st1 st4 1-0010 +1000000 st1 st5 0-0010 +0100000 st1 st5 0-0010 +0010000 st1 st5 0-0010 +0001000 st1 st5 0-0010 +0000100 st1 st5 0-0010 +0000010 st1 st5 0-0010 +0000001 st1 st5 0-0010 +11----- st1 st0 -00010 +1-1---- st1 st0 -00010 +1--1--- st1 st0 -00010 +1---1-- st1 st0 -00010 +1----1- st1 st0 -00010 +1-----1 st1 st0 -00010 +-11---- st1 st0 -00010 +-1-1--- st1 st0 -00010 +-1--1-- st1 st0 -00010 +-1---1- st1 st0 -00010 +-1----1 st1 st0 -00010 +--11--- st1 st0 -00010 +--1-1-- st1 st0 -00010 +--1--1- st1 st0 -00010 +--1---1 st1 st0 -00010 +---11-- st1 st0 -00010 +---1-1- st1 st0 -00010 +---1--1 st1 st0 -00010 +----11- st1 st0 -00010 +----1-1 st1 st0 -00010 +-----11 st1 st0 -00010 +0000000 st2 st5 --0011 +1------ st2 st0 -00011 +-1----- st2 st0 -00011 +--1---- st2 st0 -00011 +---1--- st2 st0 -00011 +----1-- st2 st0 -00011 +-----1- st2 st0 -00011 +------1 st2 st0 -00011 +0000000 st3 st6 1-0100 +0011000 st3 st5 0-0100 +0000100 st3 st5 0-0100 +0000010 st3 st5 0-0100 +0000001 st3 st5 0-0100 +1------ st3 st0 -00100 +-1----- st3 st0 -00100 +--01--- st3 st0 -00100 +--10--- st3 st0 -00100 +--111-- st3 st0 -00100 +--11-1- st3 st0 -00100 +--11--1 st3 st0 -00100 +----11- st3 st0 -00100 +----1-1 st3 st0 -00100 +-----11 st3 st0 -00100 +-000000 st4 st7 1-0101 +-100000 st4 st8 0-0101 +-010000 st4 st8 0-0101 +-001000 st4 st8 0-0101 +-000100 st4 st8 0-0101 +-000010 st4 st8 0-0101 +-000001 st4 st8 0-0101 +-11---- st4 st0 -00101 +-1-1--- st4 st0 -00101 +-1--1-- st4 st0 -00101 +-1---1- st4 st0 -00101 +-1----1 st4 st0 -00101 +--11--- st4 st0 -00101 +--1-1-- st4 st0 -00101 +--1--1- st4 st0 -00101 +--1---1 st4 st0 -00101 +---11-- st4 st0 -00101 +---1-1- st4 st0 -00101 +---1--1 st4 st0 -00101 +----11- st4 st0 -00101 +----1-1 st4 st0 -00101 +-----11 st4 st0 -00101 +-000000 st5 st8 0-0110 +-1----- st5 st0 -00110 +--1---- st5 st0 -00110 +---1--- st5 st0 -00110 +----1-- st5 st0 -00110 +-----1- st5 st0 -00110 +------1 st5 st0 -00110 +-011000 st6 st8 0-0111 +-000100 st6 st8 0-0111 +-000010 st6 st8 0-0111 +-000001 st6 st8 0-0111 +-000000 st6 st9 1-0111 +-1----- st6 st0 -00111 +--01--- st6 st0 -00111 +--10--- st6 st0 -00111 +--111-- st6 st0 -00111 +--11-1- st6 st0 -00111 +--11--1 st6 st0 -00111 +----11- st6 st0 -00111 +----1-1 st6 st0 -00111 +-----11 st6 st0 -00111 +--00000 st7 st10 1-1000 +--10000 st7 st11 0-1000 +--01000 st7 st11 0-1000 +--00100 st7 st11 0-1000 +--00010 st7 st11 0-1000 +--00001 st7 st11 0-1000 +--11--- st7 st0 -01000 +--1-1-- st7 st0 -01000 +--1--1- st7 st0 -01000 +--1---1 st7 st0 -01000 +---11-- st7 st0 -01000 +---1-1- st7 st0 -01000 +---1--1 st7 st0 -01000 +----11- st7 st0 -01000 +----1-1 st7 st0 -01000 +-----11 st7 st0 -01000 +--00000 st8 st11 0-1001 +--1---- st8 st0 -01001 +---1--- st8 st0 -01001 +----1-- st8 st0 -01001 +-----1- st8 st0 -01001 +------1 st8 st0 -01001 +--00000 st9 st12 --1010 +--11000 st9 st11 0-1010 +--00100 st9 st11 0-1010 +--00010 st9 st11 0-1010 +--00001 st9 st11 0-1010 +--01--- st9 st0 -01010 +--10--- st9 st0 -01010 +--111-- st9 st0 -01010 +--11-1- st9 st0 -01010 +--11--1 st9 st0 -01010 +----11- st9 st0 -01010 +----1-1 st9 st0 -01010 +-----11 st9 st0 -01010 +----000 st10 st13 1-1011 +----100 st10 st14 0-1011 +----010 st10 st14 0-1011 +----001 st10 st14 0-1011 +----11- st10 st0 -01011 +----1-1 st10 st0 -01011 +-----11 st10 st0 -01011 +----000 st11 st14 0-1100 +----1-- st11 st0 -01100 +-----1- st11 st0 -01100 +------1 st11 st0 -01100 +-----00 st12 st14 --1101 +-----1- st12 st0 -01101 +------1 st12 st0 -01101 +-----00 st13 st15 1-1110 +-----10 st13 st16 0-1110 +-----01 st13 st16 0-1110 +-----11 st13 st0 -01110 +-----00 st14 st16 0-1111 +-----1- st14 st0 -01111 +------1 st14 st0 -01111 +------0 st15 st17 --0000 +------1 st15 st18 0-0000 +------0 st16 st18 0-0001 +------1 st16 st0 -00001 +------- st17 st0 -00010 +------- st18 st0 -10011
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/kiss/kiss_ex1.pl Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,31 @@ +st_variables([a,b],[q]). + +st(ss1,(empty),false). +st(ss1,(more,p,b,a),true). +st(ss1,(more,not(p),b,a),ss2). +st(ss1,(more,not(b),a),ss3). +st(ss1,(more,not(a)),ss3). +st(ss2,(empty),false). +st(ss2,(more,q,c),true). +st(ss2,(more,not(q),c),ss4). +st(ss2,(more,q,not(c)),ss2). +st(ss2,(more,not(q),not(c)),true). +st(ss4,(empty),false). +st(ss4,(more,q,b,a),true). +st(ss4,(more,not(q),b,a),ss5). +st(ss4,(more,q,not(b),a),ss4). +st(ss4,(more,not(q),not(b),a),true). +st(ss4,(more,q,not(a)),true). +st(ss4,(more,not(q),not(a)),ss5). +st(ss5,(empty),false). +st(ss5,(more,q,c),true). +st(ss5,(more,not(q),c),ss3). +st(ss5,(more,q,not(c)),true). +st(ss5,(more,not(q),not(c)),ss5). +st(ss3,(empty),false). +st(ss3,(more,p,b,a),true). +st(ss3,(more,not(p),b,a),ss2). +st(ss3,(more,q,not(b),a),ss3). +st(ss3,(more,not(q),not(b),a),true). +st(ss3,(more,q,not(a)),ss3). +st(ss3,(more,not(q),not(a)),true).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/lecture/manual Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,659 @@ +.pl 10 +.ll 50 +.ul 1 +1 What is Tokio +.sp 1 +1.1 Preface +.sp 1 + Tokio is a hardware description language based on Interval Temporal +Logic (ITL) [1], which can also describe concurrency. +Although Tempura (by Moszkowski) [2], based on Interval Temporal Logic (ITL), +is well known as such a language, +ITL also completely includes First Order Predicate Logic, +and therefore Tokio includes Prolog, too . +.sp 1 +1.2 Tokio Time +.sp 1 + Time in Tokio is discrete and represented by integers. +An interval I in Tokio has a finite length, its beginning time is I.beg +and its ending time is I.fin. +It is necessary that 'I.beg' =< 'I.fin' . +.sp 1 +1.3 Temporal Operators +.sp 1 + In order to introduce the idea of time into Prolog, we need +.ul 1 +temporal operators. +These operators describe time relationships. +A goal is executed in an interval 'I'. In fact, +a goal which has no temporal operators +is executed at the beginning of the interval +ie. 'I.beg'. + A Tokio program with no temporal +operator is executed in (the beginning of) the same +interval. +In this case, programs run in the same way as Prolog. For example, +the goals 'q','r' of the following clause + p:-q,r. +.br +are executed in the same interval 'I' (exactly speaking, at the beginning +of the interval 'I', that is 'I.beg'). +.sp 1 + Here we introduce several temporal operators. +.sp 1 +.ul 1 +&& + We introduce the +.ul 1 +chop operator +which describes the order of execution of two goals. +The chop operator is defined as '&&' . + p:-q && r. + The chop operator divides the interval 'Ip' +(in which 'p' is executed) +into two intervals. In the first one (that is in Iq) 'q' is executed, +and in the latter one (that is in Ir) 'r' is executed. +.sp 1 +.ul 1 +@ + The +.ul 1 +next operator +\'@' means the execution at the next time. +While the present interval is between 'I.beg' and 'I.fin', +goals with a next operator are executed +at the beginning of the interval +which is between 'I.beg+1' and 'I.fin'. + p :- @q. +.br +\'q' is executed at the next time 'p' is executed. + If I.beg = I.fin (that is length(I) = 0), @p will +.ul 1 +fail. +.sp 1 +.ul 1 +next + The +.ul 1 +next operator +\'next' means almost same as '@'. + But if I.beg = I.fin, next(p) is +.ul 1 +true. +.sp 1 +.ul 1 +# + Goals with the +.ul 1 +always operator +\'#' are executed in all the subintervals of the interval. + p :- #q. +.br +\'q' is executed in all the subintervals of +the interval in which 'P' is executed. + The ends of all subintervals must be same. +This is the difference from another next operator '||'. +(See 1.6 Definition of Interval) +.sp 1 +.ul 1 +\'||' + Goals with the +.ul 1 +always operator +\'||' are executed in all the subintervals of the interval. + p :- '||'q. +.br +\'q' is executed in all the subintervals of +the interval in which 'p' is executed. + The ends of all subintervals must +.ul 1 +not +be same. +(See 1.6 Definition of Interval) +.sp 1 +.ul 1 +<> + Goals with the +.ul 1 +sometime oprator +\'<>' are executed at some time in the interval. + p :- <>q. +.br +\'q' is executed at some time in the interval in which 'P' is executed. +.sp 1 +.ul 1 +keep + Goals with the +.ul 1 +keep operator +are executed all times except the last one of the interval. + p :- keep(q). + 'q' is executed all the time in interval 'Ip' in which 'p' is executed +except the last time 'I.fin'. +.sp 1 +.ul 1 +fin + The +.ul 1 +fin operator +is used when we execute the goal at the end of the interval. + p :- fin(q). + 'q' is executed at the end time ('Ip.fin') of the interval +in which 'p' is executed. +.sp 1 +1.4 Tokio Variables +.sp 1 +.in 2 +1.4.1 Form + The +.ul 1 +Tokio variable +has different values at every time +and each of them is logic variable in Prolog. +Tokio variable is considered a sequence of logic variables. + A tokio variable is essentially only a logic variable, +there are some forms of variables in order to ease programming. +.sp 1 +.ul 1 +stable + When the predicate stable(X) is executed, +variable 'X' has the same value throughout the interval +in which this predicate is executed. +stable(X) is defined as follows. + stable(X) :- keep(@X = X). +.sp 1 +.ul 1 +global + When the predicate +global([atom1,atom2, ... ,atomN]) is defined, +atoms in the list are +recorded as variable names of global variables. +After the definition, the name is used as a normal Tokio variable +in the form of '*variableName'. With global variable, the following clauses + a(X,Y) :- + X = 1, Y = 1, b(X), c(Y). + b(X) :- X = ... + c(Y) :- Y = ... +.br +can be translated as follows. + global([x,y]). + a :- *x = 1, *y = 1, b, c. + b :- *x = ... + c :- *y = ... +.sp 1 +.ul 1 +static + A static variable keeps a value from an old binding until new binding. +This is the same as variables in Pascal etc. +.sp 1 +.ul 1 +:=, <= + There are two ways to assign the static variables a value as follows. + *s := 1. ---(1) + *s <= 1. ---(2) + A value is assigned at current time in (1), +but the value is assigned at the end of the interval in (2). +\':=' corresponds to '=' in the case of general Tokio variables, +and '<=' corresponds to '<-' in that case. (See 1.4.2) +.br +.sp 1 +1.4.2 Evaluation + Usually Tokio variables have all the values of each time. +In executing goals, unification is done from now to infinite future. + On the other hand, some predicates are necessary +to deal with individual value of variable at a certain time. +Such predicates are called evaluable predicates. +.ul 1 += + '=' unifies a value at current time and another at current time. + X = Y. +.br +means to take out the value of Tokio variables 'X' and 'Y' +which have all the values of each time and unify them. + '=' can unify static variables or function, too. +.ul 1 +<- + '<-' unifies a value at the beginning of an interval +and another value at the end of that interval. + X <- Y. +.br +means to unify the value of 'Y' at the beginning of an interval +and the value of 'X' at the end of that interval. +.br +.ul 1 +@ + '@' unifies a value at current time +and another value at the next time. + @X = Y. +.br +means to unify the value of 'Y' at current time +and the value of 'X' at the next time. +.sp 1 +.in -2 +1.5 Tokio Function +.br +.sp 1 +gets : +.in 8 +\'A gets B' means 'keep(B = @A)'. +The value of a Tokio variable B at current time +is unified with the value of Tokio variable A +at the next time, and this operation is +executed at all times of an interval +except at the end of that interval. +.in -8 +.br ++,-,*,/,mod,^,int,var : +.in 8 +These functions can be used. +.in -8 +.br +size(U) : +.in 8 +Return the number of arguments in the list U. +.in -8 +I thof U : +.in 8 +Return the I'th argument in the list U. +.br +Example; 2 thof [a,b,c,d] is c. + 0 1 2 3 +.in -8 +slice(U,H,T) : +.in 8 +Return a list consists of H'th, H+1'th, ... , T'th arguments +of the list U. +.br +Example; slice([a,b,c,[d,e]],2,3) is [c,[d,e]]. +.in -8 +Begin to End; +.in 8 +Begin and End is integer. +Return the list of [Begin, Begin + 1, ... , End]. +.in -8 +.br +.sp 1 +1.6 Definition of Interval +.sp 1 + Interval I is defined by a pair of integers <I.beg, I.fin>, +and the value of I.fin is decided nondeterminately. + In Tokio, an execution of a goal G in the interval Ig starts at Ig.big +and ends at I.fin.(=I.beg + N). +In this case, N is an integer which is larger than 0 or equal to 0 +and is decided nondeterminately. N varies by time backtrack.(See 1.7 +Backtrack) +.br +.ul 1 +length + In order to decide the length of an interval, there is +a predicate +.ul 1 +length. +For example, the predicate length(N) sets the I.fin to +satisfy I.fin = I.beg + N . +.br 1 +.ul 1 +empty + The predicate +.ul 1 +empty +means length(0). +.sp 1 + Temporal operators also decide intervals. +.br 1 +.ul 1 +chop operator + For example; p && q. ----- (1) + At first, we assume that I is an interval of 'p && q', Ip is that of 'p', +and Iq is that of 'q'. +Then I, Ip, and Iq are decided as follows. + + |----------|----------| + \\_____________________/ I + \\__________/\\_________/ + Ip Iq +.sp 1 + The execution is as follows. +.br +[1] 'p && q' is tried to be executed at I.beg. +.br +[2] Ip.beg is equal to I.beg, and 'p' is executed at Ip.beg(=I.beg). +.br +[3] Ip.fin = Ip.beg + Np, and Np is decided nondeteminately. +.br +[4] Iq.beg is equal to Ip.fin, and +.br +'q' is executed at Iq.beg(=Ip.fin). +.br +[5] Iq.fin = Iq.beg + Nq. +.br +[6] The execution of the whole goal +'p && q' ends and I.fin is equal to Iq.fin. + Then we consider the case of including the 'length' predicate. + For example; length(2),p && q. ------(2) + I.fin is decided as mentioned. Because of 'length(2)', +if I.fin is not equal to I.beg + 2, time backtrack arises +and Np and Nq are decided in another way. + In Tokio, the length of an interval is decided in the following way. +.br +[1] If there is a length specification (such as length(2) ) +it must be satisfied. +.br +[2] If there are no length appointment, +length is decided 1,2,3, ----,N. +N is smaller than the length of the parent interval. +That is, the length of 'p' is shorter than the length of 'p && q'. +.br +[3] The length is 0. +But if N in case [2] is infinite, length cannot be 0. + In case of example(1), +Np and Nq are decided in following order. + Np Nq + 1 1 + 1 2 + 1 3 + 1 4 + . . + . . +.sp 1 + In case of example(2), +Np and Nq cannot be larger than 2, they are decided in following order. + Np Nq + 1 1 + 2 0 +.sp 1 +.ul 1 +next operator + Examples; + p,@q. + At first, we assume the interval of 'p,@q' is I and that of 'q" +is Iq. + The execution of 'p,@q' in the interval I consists of the +execution of 'p' in I and the execution of 'q' in Iq. + I and Iq are as follows: + + |----|----|----|----|----| + \\________________________/ I + \\___________________/ Iq + + The execution is as follows: +.nf +[1] 'p,@q' is tried to be executed at I.beg. +[2] 'p' is executed at I.beg. +[3] '@q' is also tried to be executed at I.beg. +[4] 'q' is executed at Iq.beg(= I.beg + 1). +.fi +[5] The execution +of whole goal 'p,@q' ends, and I.fin is equal to Iq.fin. + +.sp 1 +.ul 1 +always operators # , || + Examples; +.nf +test1 :- length(5),#bb. + +test2 :- length(5),#aa. + +test3 :- length(5),'||'aa. + +aa :- length(1),write(aa),nl. + +bb :- write(bb),nl. + +.fi + Test1 and test3 succeed but test2 fails. + Subintervals in the case of test1 and test3 are as follows. +(See 1.3 Temporal Operator) + + |----|----|----|----|----| + \\________________________/ interval of test1 + + \\________________________/ + \\___________________/ subintervals + \\______________/ in which + \\_________/ bb is executed + \\____/ + + |----|----|----|----|----| + \\________________________/ interval of test3 + + \\____/ + \\____/ subintervals + \\____/ in which + \\____/ aa is executed + \\____/ + + + In case of test2, the ends of subintervals in which aa is executed +cannot be same because of length specification, and so test2 fails. +@ +.sp 1 +1.7 Backtrack +.sp 1 + There are two kinds of backtrack in Tokio. +One is the same as in Prolog, and +the other is time backtrack. +Time backtrack redefines the length of interval. + Time backtrack cause fail in prolog mode or repeat_fail mode. +(See 2.3 Modes) +.ul 1 +.sp 1 +2 Using Tokio + The usage of Tokio is very similar to that of Prolog. +.sp 1 +2.1 Startup, Halt, and Reading-in programs +.sp 1 + These are same as in Prolog. + Prompt in Tokio is 'tokio: ?-'. This is different from in Prolog. +.sp 1 +2.2 Break and Abort +.sp 1 + The way to break or abort is +the same as in Prolog. +But when break or abort arises, +the prompt is turned into '| ?- ' and in this condition +Tokio cannot be executed. + After a break or abort arises, +there are two ways to execute Tokio. + One is to give the directive '| ?- +.ul 1 +tokio. +\', and Tokio can be executed again and the prompt is turned +into 'tokio: ?- ' again. The other way is to give the directives +'| ?- +.ul 1 +tokio aa. +\' and the Tokio predicate aa can be executed. +.sp 1 +2.3 Modes +.sp 1 + There are three modes in Tokio. +That is (1) recursion (2) repeat_fail (3) prolog. + In prolog mode the system executes Prolog, +in repeat_fail mode the system executes Tokio without time backtrack, +and in recursion mode the system executes Tokio normally. + When system gives us the message "out of global stack" in Tokio mode, +we may change the mode from recursion to repeat_fail, because +in recursion mode system needs very large stack area for time backtrack. +.sp 1 +.ul 1 +2.4 Source files + Executable file 'tokio' is made by 'makefile'. +Following is a list of makefile. + +.nf +% makefile +tokio : tokio.bin + echo 'exec cprolog -q tokio.bin' > tokio + chmod 755 tokio +tokio.bin : tokio_src tokio_dat tokio_dbg + tokio_evl tokio_startup + tokio_sys tokio_uty + cprolog < tokio_startup +.fi +.sp 1 + Therefore following files are consulted in executing Tokio. + tokio_dat : date structure + tokio_dbg : debugger + tokio_evl : function evaluator + tokio_src : main routine + tokio_startup : tokio startup + tokio_sys : system predicate + tokio_uty : utility + xref.def : prolog predicate +.sp 1 +2.5 Operator declaration +.sp 1 + Operators in Tokio is declared as follows. + +.nf +:-op(1170, xfx ,( :: )). + % tokio formula definition +:-op(1160, fx ,(tokio)). + % tokio formula interpreter +:-op(1150, fx , [(if),(while)]). +:-op(1140, xfx , [(else),(do)]). +:-op(1130, xfx , (then)). +:-op(1120, xfy , ('&&')). +:-op(900, fx , + ['<>',#,'|a|','|t|','||',beg,halt]). +:-op(700, xfy , [\=,===] ). +:-op(700, xfy , [:=] ). + % static assignment instanteanous +:-op(700, xfy , [<=] ). + % static temporal assignment +:-op(700, xfy , [<-] ). + % temporal assignment +:-op(700, xfy , [<--] ). + % force constrant +:-op(700, xfy , gets ). + % repeatedly assignment +:-op(600, xfx , to ). % range +:-op(150, fy , @). % next oprator +:-op(140, fx , *). % variables +.fi +.sp 1 +.ul 1 +3. Debugging + Debugging in Tokio is also very similar to that in Prolog. +Resemblance between Tokio and Prolog is almost omitted in this section. +.sp 1 +3.1 The Procedure of Debugging +.sp 1 + Debugging starts by the command 'tokiotrace'. + For example, to debug a predicate 'ppp', +give the directives 'tokiotrace, ppp.'. + Call, Fail, and Back are the same as those in Prolog. +Exit is a little different from that in Prolog. +In Tokio, any predicate "exit" at the time when it is called. + Following is an example. +.sp 1 +.nf +Script started on Thu Aug 29 17:48:07 1985 +% tokio +C-Prolog version 1.5 + +A tokio interpreter Ver 7.0 8/26/85 + S.Kohno and M.Fujita Tokyo Univ. + + +tokio: ?- [ab]. +ab consulted 140 bytes 0.266669 sec. + +yes +tokio: ?- tokiotrace,testd. + +exit,t0:asserta(step(on)) +exit,t0:setval(step,on) +t0:tokiodebugon h:s + +exit,t0:tokiodebugon +exit,t0:call((setval(step,on),tokiodebugon)) +exit,t0:tokiotrace +t0:testd h: + +t0:aa h: + +t0:write(aa) h: +aa +exit,t0:write(aa) +exit,t0:aa +.ul 1 +exit,t0:testd +t1:bb h: + +t1:write(bb) h: +bb +exit,t1:write(bb) +exit,t1:bb +yes + +tokio: ?- halt. + +[ Prolog execution halted ] +.sp 1 +---------- list of file ab ---------- + +testd :- aa && bb. + +aa :- length(1),write(aa). +bb :- length(1),write(bb). +.fi +.br +.sp 1 +3.2 Options +.sp 1 + Options available during debugging are following. + a : abort b : break + d : dump h : help + l : leap s : skip + q : quasi-skip t : time skip + End-of-Line : creep + These are also the same as in Prolog except 'd' and 't'. + Dump shows the value of static variables at each time +like the following. + 2 of addr is [a,s] + 1 of addr is [a] +.br +This expression means that the value of a static variable 'addr' +is [a,s] at time 2 and [a] at time 1. + Time skip means to skip to the end of the time. +.sp 1 +3.3 Time Trace +.sp 1 + There are three modes of tracing, that is tron, trtime, and troff. + In 'tron' mode, system shows us the clauses +which are executed at that time and outputs (if there are) +every time. + In 'trtime' mode, the system shows us outputs (if there are) every time. + 'Troff' mode is the so called normal mode. + To change mode, do as follows. +.br +| ?- tron. + +.sp 1 +3.4 Help +.sp 1 + There is a +.ul 1 +help +command. Give the directive 'help', and following messages is echoed back. + 'tokiobreak tokio break call' + 'tron display queue in each clock' + 'trtime display only time' + 'troff no display' + 'tokiodebugon tokio spy mode on' + 'tokiodebugoff tokio spy mode off' + 'tokiodebugall trace all predicate' + 'tokiospy(X/N) trace predicate X with arity N' + 'tokiospy(X) trace predicate X' + 'tokionospy remove all spy point' + 'tokionospy(X) remove spy point of predicate X' + 'tokiotrace trace mode on' + 'tokionotrace trace mode off' + 'recursion main loop is recursion' + 'repeat_fail main loop is repeat fail' + 'prolog main loop is prolog' + 'tokio X execute X' + 'tokio main loop'
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/lecture/tuexample Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,239 @@ +%%%%%%% +% +% Temporal Logic Programming Language Tokio +% +% Fri Jun 6 1986 +% S.Kono +% The Faculty of Engineering +% The University of Tokyo +% a83793@tansei.u-tokyo.csnet +%%%%%%% +% 4.1 simple examples + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.0 always operator # +% length operator +% +% 1 1 1 1 1 1 +% |---|---|---|---|---|----> + +t0 :- #write(1),length(5). + + +% No.1 chop operator +% +% 0 0 0 0 +% 1 1 1 1 1 1 +% |---|---|---|---|---|---|---|---|----> + +t1 :- #write(0),length(3) && #write(1),length(5). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.2 fin and keep +% +% 0 0 0 +% 1 +% 2 2 2 2 2 2 +% 3 +% |---|---|---|---|---|---|---|---|----> + +t2 :- keep(write(0)), fin(write(1)), length(3) + && #write(2), fin(write(3)), length(5). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.3 next operator +% +% 0 1 2 3 4 5 +% |---|---|---|---|---|----> + +t3 :- length(5), I = 1, counter(I), #write(I). + + counter(I) :- keep( @I = I+1 ). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.4 stable operator +% +% 2 2 2 2 2 2 +% |---|---|---|---|---|----> + +t4 :- length(5), I = 2, stable(I), #write(I). + +% stable(I) :- keep( @I = I ). (defined internally) + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.5 temporal assignment +% +% A 0 1 0 +% |---|---|---|---|---|----> +% B 1 0 1 +% |---|---|---|---|---|----> + +t5 :- A = 0, B = 1, + ( A <- B, B <- A, length(3) && + A <- B, B <- A, length(2) && true ), + #write((A,B)). + +% A <- B :- C = B, stable(C), fin( A = C ). +% (defined internally) + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.6 interval join +% + +t6 :- length(8), + N=3,(N gets N+1, halt( N=5 ) && stable(N)), + M=0,(M gets M+1, fin( M=6 ) && stable(M)), + #write((N,M)). + +% A gets B :- keep(@A=B). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.7 back track to the past +% + +t7:- length(5), + fin(M=N), + N=3,(N gets N+1 && stable(N)), + M=0,(M gets M+1 && stable(M)), + #write((N,M)). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% 4.2 two way description of Tokio +% 1) algorithm description using "chop operator" + +magasync(A,B,Res):- + (if A < 0 + then Aab <- - A + else Aab <- A ), + (if B < 0 + then Bab <- - B + else Bab <- B ) + && + (if Aab > Bab + then G <- Aab, L <- Bab + else G <- Bab, L <- Aab) + && + Sqs <- G * 7 / 8 + L / 2 , G <- G + && + (if G > Sqs + then Res <- G + else Res <- Sqs). + +% 2) "Always operator" based description + +/* data flow calculation */ + +magasync_dataflow(A,B,Res):- + Aab = 0, Bab = 0, G = 0, Res = 0, + L = 0, Sqs = 0, G1 = 0, % initialize + #abs_unit(A,Aab), + #abs_unit(B,Bab), + #maxmin(Aab,Bab,G,L), + #calc(G,L,Sqs), + #delay(G,G1), + #result(G1,Sqs,Res). + +delay(G,G1):- + @G1 = G. + +abs_unit(I,O):- + if I < 0 then @O = -I else @O = I . + +maxmin(I1,I2,O1,O2):- + if I1 > I2 then (@O1 = I1, @O2 = I2) + else (@O1 = I2, @O2 = I1) . + +calc(I1,I2,O):- + @O = I1 * 7 / 8 + I2 / 2 . + +result(I1,I2,O):- + if I1 > I2 then @O = I1 else @O = I2 . + + +mag1:- A=5,B=6, + magasync(A,B,Res), write_fk([A,B,Res]). + +mag2:- Va = [1,2,3,4,5,6,7], Vb = [1,2,3,4,5,6,7], + input_data(A,Va),input_data(B,Vb), + magasync_dataflow(A,B,Res), write_fk([A,B,Res]). + +write_fk(X) :- keep(write(X)),fin(write(X)). + +input_data(0,[]) :- !,empty. +input_data(V,[H|T]):- + V = H, + @T = T, + @input_data(V,T). + +write_fk(A) :- fin(write(A)),keep(write(A)). + +%___________________________ +%4.3 pipeline merge sorter + + +sorter :- Strdata = [10,20,5,100,1,6,2,3], + datagen(Strdata,Data), + pipe(Data,Out), + length(18), + #write(Out). + + % Data Generator + +datagen([],[]). +datagen([H|T],Out) :- + Out = [H], + @T = T, @datagen(T,Out). + + % Pipeline Merge Sorter + +pipe(I0,Out) :- + I1 = [], I2 = [], Out = [], + proc_start(I0,I1, 2,1), + proc_start(I1,I2, 4,2), + proc_start(I2,Out,8,4). + + % Processor Unit + +proc_start(I,O,P,PP) :- + X = [], Y = [], Z = [], T = 1, + #proc(I,O,X,Y,Z,T,P,PP). + +proc(I,O,X,Y,Z,T,P,PP) :- X=[],Y=[],I=[],!, + @X=X, @Y=Y, @Z=Z, @O=[], @T=1. +proc(I,O,X,Y,Z,T,P,PP) :- + load(I,O,X,Y,Yn,Z,Zn,T,P,PP), + merge(I,O,X,Y,Yn,Z,Zn,T,P,PP). + +load(I,O,X,Y,Yn,Z,Zn,T,P,PP) :- T=<PP, !, + append(Z,I,Zn), @Z=Zn, Yn=Y, + @T=T+1. +load(I,O,X,Y,Yn,Z,Zn,T,P,PP) :- + append(Y,I,Yn), @Z=[], + (if T<P then @T=T+1 else @T=1). + +merge(I,O,X,Y,Yn,Z,Zn,T,P,PP) :-X=[],Yn=[],!, + @O=[], @Y=Yn, + (if T=PP then @X=Zn else @X=X). +merge(I,O,X,Y,Yn,Z,Zn,T,P,PP) :- X=[A|L],Yn=[],!, + @O=[A], @Y=Yn, + (if T=PP then @X=Zn else @X=L). +merge(I,O,X,Y,Yn,Z,Zn,T,P,PP) :-X=[],Yn=[B|N],!, + @O=[B], @Y=N, + (if T=PP then @X=Zn else @X=X). +merge(I,O,X,Y,Yn,Z,Zn,T,P,PP) :-X=[A|L],Yn=[B|N],!, + (if A<B then + @O=[A], @X=L, @Y=Yn + else + @O=[B], @Y=N, @X=X). + +append(Nil,L,L1) :- Nil=[],L=L1. +append(X,L,Y) :-[H|T]=X,[H1|M]=Y, + H=H1,append(T,L,M).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/lecture/tutorial Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,321 @@ +%%%%%%% +% +% Temporal Logic Programming Language Tokio +% +% Fri Jun 6 1986 +% S.Kono +% The Faculty of Engineering +% The University of Tokyo +% a83793@tansei.u-tokyo.csnet +%%%%%%% + + 1. Hardware description using Temporal Logic + + 2. Interval Temporal Logic + + 3. Execution of Interval Temporal Logic Tokio + + 4. How to write Hardware description in Tokio + + 4.1 simple examples + + 4.2 two way description of Tokio + + 4.3 pipeline merge sorter + + 5. Support tool for Tokio + +______________________________________________________ +1. Hardware description using Temporal Logic + + Logic Circuit <---> Logic Programming + + Declarative meaning in Classical Logic + Control Information in Modal Logic + + Much suitable for automatic Verification, Synthesis + and early time Simulation. + + Verification/Synthesis ----- Propositional Logic (decidable) + Low Level Simulation + + High Level Simulation ----- 1st order Logic (non decidable) + +______________________________________________________ +2. Interval Temporal Logic + + local ITL ( B. Moszkowski 1983 ) + + three main modal logic operator + + chop(&&) next(@) empty + + other modal logic operator + + <>p <-> (true & p) + #p <-> ~ <> ~p + fin(p) <-> #(empty->p) + keep(p) <-> #(~empty->p) + halt(p) <-> #(empty->p,p->empty) + + Advantage of ITL + + It is easy to write sequentiality. + ---> more suitable for Programming Language than other + temporal logic + +______________________________________________________ +3. Execution of Interval Temporal Logic Tokio + + Unification on Temporal Logic Variable + Refutation on next operator + Refutation on chop operator + + Extended Horn Clause for temporal operator + + Compilation to Prolog + +______________________________________________________ +4. How to write Hardware description in Tokio + + 4.1 simple examples + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.0 always operator # +% length operator +% +% 1 1 1 1 1 1 +% |---|---|---|---|---|----> + +t0 :- #write(1),length(5). + + +% No.1 chop operator +% +% 0 0 0 0 +% 1 1 1 1 1 1 +% |---|---|---|---|---|---|---|---|----> + +t1 :- #write(0),length(3) && #write(1),length(5). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.2 fin and keep +% +% 0 0 0 +% 1 +% 2 2 2 2 2 2 +% 3 +% |---|---|---|---|---|---|---|---|----> + +t2 :- keep(write(0)), fin(write(1)), length(3) + && #write(2), fin(write(3)), length(5). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.3 next operator +% +% 0 1 2 3 4 5 +% |---|---|---|---|---|----> + +t3 :- length(5), I = 1, counter(I), #write(I). + + counter(I) :- keep( @I = I+1 ). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.4 stable operator +% +% 2 2 2 2 2 2 +% |---|---|---|---|---|----> + +t4 :- length(5), I = 2, stable(I), #write(I). + +% stable(I) :- keep( @I = I ). (defined internally) + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.5 temporal assignment +% +% A 0 1 0 +% |---|---|---|---|---|----> +% B 1 0 1 +% |---|---|---|---|---|----> + +t5 :- A = 0, B = 1, + ( A <- B, B <- A, length(3) && + A <- B, B <- A, length(2) && true ), + #write((A,B)). + +% A <- B :- C = B, stable(C), fin( A = C ). +% (defined internally) + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.6 interval join +% + +t6 :- length(8), + N=3,(N gets N+1, halt( N=5 ) && stable(N)), + M=0,(M gets M+1, fin( M=6 ) && stable(M)), + #write((N,M)). + +% A gets B :- keep(@A=B). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.7 back track to the past +% + +t7:- length(5), + fin(M=N), + N=3,(N gets N+1 && stable(N)), + M=0,(M gets M+1 && stable(M)), + #write((N,M)). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +4.2 two way description of Tokio + + +Example of two different descriptions of + calculating magnitude of vector + +1) algorithm description using "chop operator" + loosely timing + +magasync(A,B,Res):- + (if A < 0 + then Aab <- - A + else Aab <- A ), + (if B < 0 + then Bab <- - B + else Bab <- B ) + && + (if Aab > Bab + then G <- Aab, L <- Bab + else G <- Bab, L <- Aab) + && + Sqs <- G * 7 / 8 + L / 2 , G <- G + && + (if G > Sqs + then Res <- G + else Res <- Sqs). + +2) "Always operator" based description + tightly synchronized module + + +/* data flow calculation */ + +magasync_dataflow(A,B,Res):- + Aab = 0, Bab = 0, G = 0, Res = 0, + L = 0, Sqs = 0, G1 = 0, % initialize + #abs_unit(A,Aab), + #abs_unit(B,Bab), + #maxmin(Aab,Bab,G,L), + #calc(G,L,Sqs), + #delay(G,G1), + #result(G1,Sqs,Res). + +delay(G,G1):- + @G1 = G. + +abs_unit(I,O):- + if I < 0 then @O = -I else @O = I . + +maxmin(I1,I2,O1,O2):- + if I1 > I2 then (@O1 = I1, @O2 = I2) + else (@O1 = I2, @O2 = I1) . + +calc(I1,I2,O):- + @O = I1 * 7 / 8 + I2 / 2 . + +result(I1,I2,O):- + if I1 > I2 then @O = I1 else @O = I2 . + +___________________________ +4.3 pipeline merge sorter + + +test :- Strdata = [10,20,5,100,1,6,2,3], + datagen(Strdata,Data), + pipe(Data,Out), + length(18), + #write(Out). + + % Data Generator + +datagen([],[]). +datagen([H|T],Out) :- + Out = [H], + @T = T, @datagen(T,Out). + + % Pipeline Merge Sorter + +pipe(I0,Out) :- + I1 = [], I2 = [], Out = [], + proc_start(I0,I1, 2,1), + proc_start(I1,I2, 4,2), + proc_start(I2,Out,8,4). + + % Processor Unit + +proc_start(I,O,P,PP) :- + X = [], Y = [], Z = [], T = 1, + #proc(I,O,X,Y,Z,T,P,PP). + +proc(I,O,X,Y,Z,T,P,PP) :- X=[],Y=[],I=[],!, + @X=X, @Y=Y, @Z=Z, @O=[], @T=1. +proc(I,O,X,Y,Z,T,P,PP) :- + load(I,O,X,Y,Yn,Z,Zn,T,P,PP), + merge(I,O,X,Y,Yn,Z,Zn,T,P,PP). + +load(I,O,X,Y,Yn,Z,Zn,T,P,PP) :- T=<PP, !, + append(Z,I,Zn), @Z=Zn, Yn=Y, + @T=T+1. +load(I,O,X,Y,Yn,Z,Zn,T,P,PP) :- + append(Y,I,Yn), @Z=[], + if T<P then @T=T+1 else @T=1. + +merge(I,O,X,Y,Yn,Z,Zn,T,P,PP) :-X=[],Yn=[],!, + @O=[], @Y=Yn, + if T=PP then @X=Zn else @X=X. +merge(I,O,X,Y,Yn,Z,Zn,T,P,PP) :- X=[A|L],Yn=[],!, + @O=[A], @Y=Yn, + if T=PP then @X=Zn else @X=L. +merge(I,O,X,Y,Yn,Z,Zn,T,P,PP) :-X=[],Yn=[B|N],!, + @O=[B], @Y=N, + if T=PP then @X=Zn else @X=X. +merge(I,O,X,Y,Yn,Z,Zn,T,P,PP) :-X=[A|L],Yn=[B|N],!, + if A<B then + @O=[A], @X=L, @Y=Yn + else + @O=[B], @Y=N, @X=X. + +append(Nil,L,L1) :- Nil=[],L=L1. +append(X,L,Y) :-[H|T]=X,[H1|M]=Y, + H=H1,append(T,L,M). + + +______________________________________________________ +5. Support tool for Tokio + + Verifier for Propositional Logic + Synthesizer for Propositional Logic + + We use Cube description + + +REFERENCES +[1] + B. Moszkowski, "A Temporal Logic for Multi Level Reasoning about + Hardware", IEEE Computer Magazine, February 1985. +[2] + B. Moszkowski, "Executing Temporal Logic Programs", + Technical Report No. 55 University of Cambridge, Computer Laboratory 1984. +[3] + M. Fujita, S. Kono, "Temporal Logic Programming Language: Tokio and + its compilation to Prolog", ICLP'86 +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/multiply/mul_al Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,66 @@ +mul2(X1,X0,Y1,Y0,M3,M2,M1,M0) :- + cell(0, 0, X0,Y0,M0, C00), + cell(0, 0, X1,Y0,S10,C10), + cell(S10,C00,X0,Y1,M1, C01), + cell(0 ,C10,X1,Y1,S11,C11), + cell(S11,C01,0, 0, M2, M3 ), + cell(0, C11,0, 0, _, _ ). + + +cell(Sin,Cin,X,Y,Sout,Cout) :- + #delay(Sin,S1), + #delay(Cin,C1), + #and(X,Y,L1), + #delay(L1,L2), + #half_adder(S1,C1,S2,C2), + #delay(C2,C4), + #half_adder(S2,L2,S3,C3), + #delay(S3,Sout), + #or(C3,C4,Cout). + +delay(X,X1) :- + @X1 = X. + +half_adder(A,B,S,C) :- + A = 0, B = 0, + @S = 0, @C = 0. +half_adder(A,B,S,C) :- + A = 0, B = 1, + @S = 1, @C = 0. +half_adder(A,B,S,C) :- + A = 1, B = 0, + @S = 1, @C = 0. +half_adder(A,B,S,C) :- + A = 1, B = 1, + @S = 0, @C = 1. + +or(A,B,C) :- + A = 0, B = 0, + @C = 0. +or(A,B,C) :- + A = 0, B = 1, + @C = 1. +or(A,B,C) :- + A = 1, B = 0, + @C = 1. +or(A,B,C) :- + A = 1, B = 1, + @C = 1. + +and(A,B,C) :- + A = 0, B = 0, + @C = 0. +and(A,B,C) :- + A = 0, B = 1, + @C = 0. +and(A,B,C) :- + A = 1, B = 0, + @C = 0. +and(A,B,C) :- + A = 1, B = 1, + @C = 1. + +test2 :- + length(12), + mul2(1,1,1,1,M3,M2,M1,M0), + #write((M3,M2,M1,M0)).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/multiply/mul_al9 Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,71 @@ +mul2(X1,X0,Y1,Y0,M3,M2,M1,M0) :- + length(4), + cell(0, 0, X0,Y0,M0, C00), + cell(0, 0, X1,Y0,S10,C10) + && + length(4), + cell(S10,C00,X0,Y1,M1, C01), + cell(0 ,C10,X1,Y1,S11,C11) + && + length(4), + cell(S11,C01,0, 0, M2, M3 ), + cell(0, C11,0, 0, _, _ ). + + +cell(Sin,Cin,X,Y,Sout,Cout) :- + #delay(Sin,S1), + #delay(Cin,C1), + #and(X,Y,L1), + #delay(L1,L2), + #half_adder(S1,C1,S2,C2), + #delay(C2,C4), + #half_adder(S2,L2,S3,C3), + #delay(S3,Sout), + #or(C3,C4,Cout). + +delay(X,X1) :- + @X1 = X. + +half_adder(A,B,S,C) :- + A = 0, B = 0, + @S = 0, @C = 0. +half_adder(A,B,S,C) :- + A = 0, B = 1, + @S = 1, @C = 0. +half_adder(A,B,S,C) :- + A = 1, B = 0, + @S = 1, @C = 0. +half_adder(A,B,S,C) :- + A = 1, B = 1, + @S = 0, @C = 1. + +or(A,B,C) :- + A = 0, B = 0, + @C = 0. +or(A,B,C) :- + A = 0, B = 1, + @C = 1. +or(A,B,C) :- + A = 1, B = 0, + @C = 1. +or(A,B,C) :- + A = 1, B = 1, + @C = 1. + +and(A,B,C) :- + A = 0, B = 0, + @C = 0. +and(A,B,C) :- + A = 0, B = 1, + @C = 0. +and(A,B,C) :- + A = 1, B = 0, + @C = 0. +and(A,B,C) :- + A = 1, B = 1, + @C = 1. + +test2 :- + length(12), + mul2(1,1,1,1,M3,M2,M1,M0), + #write((M3,M2,M1,M0)).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/multiply/mul_chop Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,81 @@ +mul2(X1,X0,Y1,Y0,M3,M2,M1,M0) :- + cell(0, 0, X0,Y0,M0,C00), + cell(0, 0, X1,Y0,S10,C10) + && + cell(S10,C00,X0,Y1,M1, C01), + cell(0 ,C10,X1,Y1,S11,C11) + && + cell(S11,C01,0, 0,M2 , M3), + cell(0, C11,0, 0, _, _ ). + + +cell(Sin,Cin,X,Y,Sout,Cout) :- + and(X,Y,L1),S1 <- Sin,C1<- Cin + && + full_adder(S1,C1,L1,Sout,Cout). + +full_adder(S1,C1,L1,Sout,Cout) :- + half_adder(S1,C1,S2,C2),L2 <- L1 + && + half_adder(S2,L2,S3,C3), + C4 <- C2 + && + or(C3,C4,Cout), + Sout <- S3. + +half_adder(A,B,S,C) :- + length(1), + A = 0, B = 0, + @S = 0, @C = 0. +half_adder(A,B,S,C) :- + length(1), + A = 0, B = 1, + @S = 1, @C = 0. +half_adder(A,B,S,C) :- + length(1), + A = 1, B = 0, + @S = 1, @C = 0. +half_adder(A,B,S,C) :- + length(1), + A = 1, B = 1, + @S = 0, @C = 1. + +or(A,B,C) :- + length(1), + A = 0, B = 0, + @C = 0. +or(A,B,C) :- + length(1), + A = 0, B = 1, + @C = 1. +or(A,B,C) :- + length(1), + A = 1, B = 0, + @C = 1. +or(A,B,C) :- + length(1), + A = 1, B = 1, + @C = 1. + +and(A,B,C) :- + length(1), + A = 0, B = 0, + @C = 0. +and(A,B,C) :- + length(1), + A = 0, B = 1, + @C = 0. +and(A,B,C) :- + length(1), + A = 1, B = 0, + @C = 0. +and(A,B,C) :- + length(1), + A = 1, B = 1, + @C = 1. + +test1 :- + mul2(1,1,1,1,M3,M2,M1,M0), + + fin(write((M3,M2,M1,M0))), + keep(write((M3,M2,M1,M0))).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/multiply/multi Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,55 @@ + +/* multipiler by Ben Moszkowski */ + +mux(Switch,In1,In2,Out) :- + if Switch = 0 + then Out = In2 + else Out = In1. + +reg(In,Out) :- @Out = In. +flipflop(In,Out) :- @Out = In. + +dec(In,Out) :- + if In = 0 + then Out = 0 + else Out = In-1. + +adder(In1,In2,Out) :- Out = In1+In2. + +zero_test(In,Out) :- + if In = 0 + then Out = 1 + else Out = 0. + +or_gate(In1,In2,Out) :- + Out1 is In1 \/ In2, + Out = Out1. + +mult_imp(In1,In2,M,N,Done) :- +% exists,(B1,B2,B3,B4,L1,L2,L3,L4,L5,L6,L7,L8,L9,L10) + #zero_test(In1,B4), + #(L10 = 0), + #mux(B4,L10,In2,L9), + #zero_test(In2,B2), + #dec(In1,L6), + #adder(L9,M,L8), + #dec(N,L3), + #mux(Done,L9,L8,L7), + #reg(L7,M), + #mux(Done,In1,L3,L1), + #reg(L1,N), + #dec(L3,L4), + #mux(Done,L6,L4,L5), + #zero_test(L5,B1), + #or_gate(B1,B2,B3), + #flipflop(B3,Done). + +main :- + read((In1,In2)), + Done = 1, + M = 39, + N = 83, + In1 <-- In1,In2 <-- In2, + mult_imp(In1,In2,M,N,Done), + @(halt(Done=1)), + #write((Done,M,N)).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/multiply/multi2 Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,22 @@ +main :- read((In1,In2)), + mult_imp4(In1,In2,M,N,Done), + #write((Done,M,N)). + +mult_imp4(In1,In2,M,N,Done) :- + #stable(In1),#stable(In2), + @ ( + M = In2, + N = In1, + Done = 0, + int1(In1,In2,Done,M,N) + ). + +int1(In1,In2,Done,M,N) :- + halt(Done=1), + intN(In2,Done,M,N). + +intN(In2,Done,M,N) :- + @M = M+In2, + @N = N-1, + (if N-2=0 then @Done=1 else @Done=0), + next(intN(In2,Done,M,N)).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/read.me Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,63 @@ +/* + Tokio examples + + Fri May 6 11:53:58 JST 1994 + + */ + +dining_phil: (Tokio) + % Dining Philosopher Problem Description + di % state transition version + ve % using backtracking + +etc: (Tokio) + dekker % dekker's algorithm + mac % three way calcuration of magnitude of vector + memory % memory simulation + rsffdelay % rs filp flop with dealy + rsflipflop % simple filp flop + send % handshaking example + solve % meta interpreter + +multiply: (Tokio) + mul_al % hardware multiplier + mul_al9 % much more bit + mul_chop % serial implementation + multi % Moszkowski's example + multi2 % it's translation form + +sorter: (Tokio) + pipe % pipeline merge sort for prolog + tpip % its modified version for tokio + sort % Moszkowski's example (list implementation) + sort2 % implicit sync + sort3 % functor implementation + pipe_sort % hardware pipeline merge sorter + +unifier: (Tokio) + % hardware unifier for Parallel Inference Engine: PIE + up % main part + upm % its macro definitions + +6502: (Tokio) + % MC6502 chip specification + a.hex % Intel Hex of Sample Machine code + a.s65 % Asembler source of Sample Machine code + asm % A Free 6502 Assembler + isp.mc6502 % ISP specification + mc6502.tokio % Tokio specification + multi.s65 % more complex example + run.tokio % Test routine for mc6502.tokio + +kiss: (LITE) + % KISS2 format example for UCB/SIS + % for LITE verifier + keyc.kiss2 % KISS2 format input + kiss_ex1.pl % FSA input for LITE + +toy: (LITE/Tokio) + % Toy GUI example. This is an example of LITE - Tokio + % combination. Sicstus/GM X-Window interface is required. + gi.tokio % generated Tokio source. this is generated from gi_ex.pl + gi_ex.pl % ITL specification of gi.tokio + toy.tokio % Tool kit parts (written in Tokio)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/sorter/pipe Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,29 @@ +/* pipe-line merge sorter */ + +test(X) :- pipe([10,5,3,1,7,2,4,6,5,100,5,12,150], X). + +pipe(X,Y) :- + lap(X,XX), + mergeAll(XX,Y). + +mergeAll([Single],Single) :- !. +mergeAll(S,Out) :- + merge2(S,Out1),mergeAll(Out1,Out). + +merge2([],[]). +merge2([Single],[Single]). +merge2([A,B|T],[YY|Y]) :- + merge(A,B,YY), + merge2(T,Y). + +lap([],[]). +lap([X|L],[[X]|S]):- + lap(L,S). + +merge(L,[],L). +merge([],L,L). +merge([A|X],[B|Y],[A|Z]) :- + A =< B, !, + merge(X,[B|Y],Z). +merge([A|X],[B|Y],[B|Z]) :- + merge([A|X],Y,Z).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/sorter/pipe_sort Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,60 @@ + +test :- Strdata = [10,20,5,100,1,6,2,3], + datagen(Strdata,Data), + pipe(Data,Out), + length(18), + #write(Out). + + % Data Generator + +datagen([],[]). +datagen([H|T],Out) :- + Out = [H], + @T = T, @datagen(T,Out). + + % Pipeline Merge Sorter + +pipe(I0,Out) :- + I1 = [], I2 = [], Out = [], + proc_start(I0,I1, 2,1), + proc_start(I1,I2, 4,2), + proc_start(I2,Out,8,4). + + % Processor Unit + +proc_start(I,O,P,PP) :- + X = [], Y = [], Z = [], T = 1, + #proc(I,O,X,Y,Z,T,P,PP). + +proc(I,O,X,Y,Z,T,P,PP) :- X=[],Y=[],I=[],!, + @X=X, @Y=Y, @Z=Z, @O=[], @T=1. +proc(I,O,X,Y,Z,T,P,PP) :- + load(I,O,X,Y,Yn,Z,Zn,T,P,PP), + merge(I,O,X,Y,Yn,Z,Zn,T,P,PP). + +load(I,O,X,Y,Yn,Z,Zn,T,P,PP) :- T=<PP, !, + append(Z,I,Zn), @Z=Zn, Yn=Y, + @T=T+1. +load(I,O,X,Y,Yn,Z,Zn,T,P,PP) :- + append(Y,I,Yn), @Z=[], + (if T<P then @T=T+1 else @T=1). + +merge(I,O,X,Y,Yn,Z,Zn,T,P,PP) :-X=[],Yn=[],!, + @O=[], @Y=Yn, + (if T=PP then @X=Zn else @X=X). +merge(I,O,X,Y,Yn,Z,Zn,T,P,PP) :- X=[A|L],Yn=[],!, + @O=[A], @Y=Yn, + (if T=PP then @X=Zn else @X=L). +merge(I,O,X,Y,Yn,Z,Zn,T,P,PP) :-X=[],Yn=[B|N],!, + @O=[B], @Y=N, + (if T=PP then @X=Zn else @X=X). +merge(I,O,X,Y,Yn,Z,Zn,T,P,PP) :-X=[A|L],Yn=[B|N],!, + (if A<B then + @O=[A], @X=L, @Y=Yn + else + @O=[B], @Y=N, @X=X). + +append(Nil,L,L1) :- Nil=[],L=L1. +append(X,L,Y) :-[H|T]=X,[H1|M]=Y, + H=H1,append(T,L,M). +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/sorter/psort Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,66 @@ + +test :- Strdata = [10,20,5,100,1,6,2,3], + datagen(Strdata,Data), + pipe(Data,Out), + length(18), + #write(Out). + +run :- Strdata = [10,20,5,100,1,6,2,3], + datagen(Strdata,Data), + pipe(Data,Out), + length(18). + + % Data Generator + +datagen([],[]). +datagen([H|T],Out) :- + Out = [H], @T = T, @datagen(T,Out). + + % Pipeline Merge Sorter + +pipe(I0,Out) :- + I1 = [], I2 = [], Out = [], + proc_start(I0,I1, 2,1), + proc_start(I1,I2, 4,2), + proc_start(I2,Out,8,4). + + % Processor Unit + +proc_start(I,O,P,PP) :- + X = [], Y = [], Z = [], T = 1, + #proc(I,O,X,Y,Z,T,P,PP). + +proc(I,O,X,Y,Z,T,P,PP) :- X=[],Y=[],I=[], + @X=X, @Y=Y, @Z=Z, @O=[], @T=1. +proc(I,O,X,Y,Z,T,P,PP) :- + load(I,O,X,Y,Yn,Z,Zn,T,P,PP), + merge(I,O,X,Y,Yn,Z,Zn,T,P,PP). + +load(I,O,X,Y,Yn,Z,Zn,T,P,PP) :- PP>=T, + append(Z,I,Zn), @Z=Zn, Yn=Y, @T=T+1. +load(I,O,X,Y,Yn,Z,Zn,T,P,PP) :- T>PP,T<P, + append(Y,I,Yn), @Z=[],@T=T+1. +load(I,O,X,Y,Yn,Z,Zn,T,P,PP) :- T>PP,T>=P, + append(Y,I,Yn), @Z=[],@T=1. + +merge(I,O,X,Y,Yn,Z,Zn,T,P,PP) :-X=[],Yn=[], + @O=[], @Y=Yn,switch(T,PP,X,Zn,X). +merge(I,O,X,Y,Yn,Z,Zn,T,P,PP) :- X=[A|L],Yn=[], + @O=[A], @Y=Yn,switch(T,PP,X,Zn,L). +merge(I,O,X,Y,Yn,Z,Zn,T,P,PP) :-X=[],Yn=[B|N], + @O=[B], @Y=N,switch(T,PP,X,Zn,X). +merge(I,O,X,Y,Yn,Z,Zn,T,P,PP) :-X=[A|L],Yn=[B|N], + A<B, + @O=[A], @X=L, @Y=Yn. +merge(I,O,X,Y,Yn,Z,Zn,T,P,PP) :-X=[A|L],Yn=[B|N], + A>=B, + @O=[B], @Y=N, @X=X. + +switch(T,PP,X,Zn,L) :- T=PP, @X=Zn. +switch(T,PP,X,Zn,L) :- T\=PP, @X=L. + + +append(Nil,L,L1) :- Nil=[],L=L1. +append(X,L,Y) :-[H|T]=X,[H1|M]=Y, + H=H1,append(T,L,M). +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/sorter/sort Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,98 @@ +/* Program to do parallel quicksort. Ben Moszkowski + Initial version written around 29 Apr 84. + Subsequent changes made. + Updated 7 Feb 85. + + translate to Tokio by S.Kono + Sun Aug 31 21:29:10 JST 1986 + using list and implicit sync + */ + +/* Support Routines */ + +'$function' (len(L) = Length :- list_length(L,Length)). + +list_length(Nil, -1 ) :- Nil=[],!. +list_length(List,N) :- List=[H|L],list_length(L,NN), + N = NN+1,!. + +'$function' (slice(List,From,To) = Slice :- slice(0,List,From,To,Slice)). + +slice(N,List,From,To,[]) :- N>To,!. +slice(N,[H|List],From,To,[H|Slice]) :- N>=From,!, + NN = N+1, + slice(NN,List,From,To,Slice). +slice(N,[H|List],From,To,Slice) :- + NN = N+1, + slice(NN,List,From,To,Slice). + +'$function' (thof(I,L) = E :- thof(I,L,E)). + +thof(0,[H|L],H) :- !. +thof(N,[H|L],H1) :- NN = N-1, thof(NN,L,H1). + +fixed_list([],Length) :- Length = -1 ,!. +fixed_list([H|L],Length) :- Length1 = Length-1, + fixed_list(L,Length1). + +'$function' ( (if Cond then Yes else No) = Reply :- + if Cond then Yes=Reply else No=Reply). + + +/* Support Routines end */ + +par_quicksort(L) :- + if len(L) < 1 + then empty + else + stable(Pivot), + ( quick_partition(L,Pivot) & + sort_parts(L,Pivot) ). + +quick_partition(L,Pivot) :- + I = 1, Z=0, J = len(L), J1=J+1,skip, + P = thof(0,L), + partition(I,J1,P,Z,J,L,Pivot). + +partition(K,K,P,I,J,L,Pivot) :- !,@Pivot=I,@I=I,@thof(I,L)=P. +partition(K,E,P,I,J,L,Pivot) :- thof(K,L) < P,!, II=I+1, + @I=I, @thof(I,L) = thof(K,L), KK=K+1, + partition(KK,E,P,II,J,L,Pivot). +partition(K,E,P,I,J,L,Pivot) :- JJ=J-1, + @J=J, @thof(J,L) = thof(K,L), KK=K+1, + partition(KK,E,P,I,JJ,L,Pivot). + +sort_parts(L,Pivot) :- + stable(thof(Pivot,L)), + quicksort_process(slice(L,0,Pivot-1)), + quicksort_process(slice(L,Pivot+1, len(L))). + +quicksort_process(L) :- + par_quicksort(L) & stable(L). + +monitor(L) :- + fixed_list(Tag_list,len(L)), + #tag(0,L,Tag_list), + #((write('''List='''),write(L),put(" "), + write('''Tag_list='''),write(Tag_list))). + +tag(_,Nil,Nil) :- Nil=[],!. +tag(I,[H|L],[TH|TL]) :- TH = (if I=H then 1 else 0), + J=I+1,tag(J,L,TL). + +/* test of quicksort */ +sort_test(Init_vector) :- + %exists L : + stable(Init_vector), + fixed_list(L,len(Init_vector)), + L=Init_vector, + par_quicksort(L), +% #write(L). + monitor(L). + +sort_test1 :- [2,0,1]=List,sort_test(List). + +sort_test2 :- [2,4,9,1,0,10,6,8,7,5,3]=List,sort_test(List). + +sort_test3 :- [13,7,5,3,1,9,8,6,2,0,12,11,4,10]=List,sort_test(List). +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/sorter/sort2 Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,105 @@ +/* Program to do parallel quicksort. Ben Moszkowski + Initial version written around 29 Apr 84. + Subsequent changes made. + Updated 7 Feb 85. + + translate to Tokio by S.Kono + Sun Aug 31 21:29:10 JST 1986 + using list and explicit sync + */ + +/* Support Routines */ + +'$function' (len(L) = Length :- list_length(L,Length)). + +list_length(Nil, -1 ) :- Nil=[],!. +list_length(List,N) :- List=[H|L],list_length(L,NN), + N = NN+1,!. + +'$function' (slice(List,From,To) = Slice :- slice(0,List,From,To,Slice)). + +slice(N,List,From,To,[]) :- N>To,!. +slice(N,[H|List],From,To,[H|Slice]) :- N>=From,!, + NN = N+1, + slice(NN,List,From,To,Slice). +slice(N,[H|List],From,To,Slice) :- + NN = N+1, + slice(NN,List,From,To,Slice). + +'$function' (thof(I,L) = E :- thof(I,L,E)). + +thof(0,[H|L],H) :- !. +thof(N,[H|L],H1) :- NN = N-1, thof(NN,L,H1). + +fixed_list([],Length) :- Length = -1,!. +fixed_list([H|L],Length) :- Length1 = Length-1, + fixed_list(L,Length1). + +'$function' ( (if Cond then Yes else No) = Reply :- + if Cond then Yes=Reply else No=Reply). + + +/* Support Routines end */ + +par_quicksort(L) :- + if len(L) < 1 + then empty + else + stable(Pivot), + ( quick_partition(L,Pivot) & + sort_parts(L,Pivot) ). + +quick_partition(L,Pivot) :- + I = 1, Z=0, J = len(L), J1=J+1,skip, + P = thof(0,L), + partition(I,J1,P,Z,J,L,Pivot). + +partition(K,K,P,I,J,L,Pivot) :- !,@Pivot=I,@I=I,@thof(I,L)=P. +partition(K,E,P,I,J,L,Pivot) :- thof(K,L) < P,!, II=I+1, + @I=I, @thof(I,L) = thof(K,L), KK=K+1, + partition(KK,E,P,II,J,L,Pivot). +partition(K,E,P,I,J,L,Pivot) :- JJ=J-1, + @J=J, @thof(J,L) = thof(K,L), KK=K+1, + partition(KK,E,P,I,JJ,L,Pivot). + +sort_parts(L,Pivot) :- + quicksort_process(Done,Ready1, slice(L,0,Pivot-1)), + quicksort_process(Done,Ready2, slice(L,Pivot+1, len(L))), + #((if 1 = Ready1, 1 = Ready2 then 1 = @Done else 0 = @Done)), + stable(thof(Pivot,L)). + +quicksort_process(Done,Ready,L) :- + par_quicksort(L), + #(Ready=0) + & + skip, @Ready=1, stable(L) + & + halt(Done=1), + #(Ready=1),stable(L). + +monitor(L) :- + fixed_list(Tag_list,len(L)), + #tag(0,L,Tag_list), + #((write('''List='''),write(L),put(" "), + write('''Tag_list='''),write(Tag_list))). + +tag(_,Nil,Nil) :- Nil=[],!. +tag(I,[H|L],[TH|TL]) :- TH = (if I=H then 1 else 0), + J=I+1,tag(J,L,TL). + +/* test of quicksort */ +sort_test(Init_vector) :- + %exists L : + stable(Init_vector), + fixed_list(L,len(Init_vector)), + L=Init_vector, + par_quicksort(L), + monitor(L). +% #write(L). + +sort_test1 :- [2,0,1]=List,sort_test(List). + +sort_test2 :- [2,4,9,1,0,10,6,8,7,5,3]=List,sort_test(List). + +sort_test3 :- [13,7,5,3,1,9,8,6,2,0,12,11,4,10]=List,sort_test(List). +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/sorter/sort3 Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,93 @@ +/* Program to do parallel quicksort. Ben Moszkowski + Initial version written around 29 Apr 84. + Subsequent changes made. + Updated 7 Feb 85. + + translate to Tokio by S.Kono + Sun Aug 31 21:29:10 JST 1986 + using functor and implicit sync + */ + +/* Support Routines */ + +'$function' (len(L) = Length :- functor(L,_,Length)). + +'$function' (slice(List,From,To) = Slice + :- Size<--To-From+1,From=From1,To=To1, + (Size < 1, #(Slice = array) ; + #functor(Slice,array,Size), + slice(1,List,From1,To1,1,Slice))). + +slice(N,List,From,To,_,_) :- N>To,!. +slice(N,List,From,To,I,Slice) :- N>=From,!, + NN = N+1,II = I+1,arg(N,List,E),arg(I,Slice,E), + slice(NN,List,From,To,II,Slice). +slice(N,List,From,To,I,Slice) :- + NN = N+1, + slice(NN,List,From,To,I,Slice). + +'$function' (thof(I,L) = E :- arg(I,L,E)). + +fixed_list(Array,Length) :- L <-- Length, + #functor(Array,array,L). + +'$function' ( (if Cond then Yes else No) = Reply :- + if Cond then Yes=Reply else No=Reply). + + +/* Support Routines end */ + +par_quicksort(L) :- + if len(L) =< 1 + then empty + else + stable(Pivot), + ( quick_partition(L,Pivot) & + sort_parts(L,Pivot) ). + +quick_partition(L,Pivot) :- + I = 2, Z=1, J = len(L), J1=J+1,skip, + P = thof(1,L), + partition(I,J1,P,Z,J,L,Pivot). + +partition(K,K,P,I,J,L,Pivot) :- !,@Pivot=I,@I=I,@thof(I,L)=P. +partition(K,E,P,I,J,L,Pivot) :- thof(K,L) < P,!, II=I+1, + @I=I, @thof(I,L) = thof(K,L), KK=K+1, + partition(KK,E,P,II,J,L,Pivot). +partition(K,E,P,I,J,L,Pivot) :- JJ=J-1, + @J=J, @thof(J,L) = thof(K,L), KK=K+1, + partition(KK,E,P,I,JJ,L,Pivot). + +sort_parts(L,Pivot) :- + stable(thof(Pivot,L)), + quicksort_process(slice(L,1, Pivot-1)), + quicksort_process(slice(L,Pivot+1, len(L) )). +quicksort_process(L) :- + par_quicksort(L) & stable(L). + +monitor(L) :- + fixed_list(Tag_list,len(L)), + #tag(1,len(L),L,Tag_list), + #((write('''List='''),write(L),put(" "), + write('''Tag_list='''),write(Tag_list))). + +tag(I,J,_,_) :- I>J,!. +tag(I,K,L,T) :- (if I-1=thof(I,L) then 1 else 0) = thof(I,T), + J=I+1,tag(J,K,L,T). + +/* test of quicksort */ +sort_test(Init_vector) :- + %exists L : + stable(Init_vector), + fixed_list(L,len(Init_vector)), + L=Init_vector, + par_quicksort(L), +% #write(L). + monitor(L). + +sort_test1 :- array(2,0,1)=List,sort_test(List). + +sort_test2 :- array(2,4,9,1,0,10,6,8,7,5,3)=List,sort_test(List). + +sort_test3 :- array(13,7,5,3,1,9,8,6,2,0,12,11,4,10)=List,sort_test(List). +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/sorter/tpip Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,27 @@ +/* pipe-line merge sorter */ + +test :- lap([10,5,3,1,7,2,4,6,5,100,5,12,150], X), + pipe(X), + #write(X). + +lap(In,Out) :- In=[],Out=[]. +lap(In,Out) :- In=[X|L],Out=[[X]|S], + lap(L,S). + +pipe(In) :- In=[I],In<-I,!. +pipe(In) :- mergeProcess(In) && pipe(In). + +mergeProcess([]) :-!. +mergeProcess([In]) :- In<-In,!. +mergeProcess(In) :- In=[A,B|T], + merge(A,B,X),fin(In=[X|T]), + mergeProcess(T). + +merge(X,Y,Z) :- Y=[],!,Z<-X. +merge(Y,X,Z) :- Y=[],!,Z<-X. +merge([A|X],[B|Y],[C|Z]) :- + A =< B,!, C<-A, + merge(X,[B|Y],Z). +merge([A|X],[B|Y],[C|Z]) :- + B =< A,!, C<-B, + merge([A|X],Y,Z).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/toy/gi.tokio Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,20 @@ +?-static([green,move,quit,red,start,stop]). +print_state:-(_2577= *green,_2593= *move,_2609= *quit,_2625= *red,_2641= *start,_2654= *stop),write((*green=_2577,*move=_2593,*quit=_2609,*red=_2625,*start=_2641,*stop=_2654)). +true :- empty,empty. +true :- more,true. +s1 :- empty,*stop= 1,*quit= 1,*green:= 0,*move:= 0,*red:= 1,empty. +s1 :- empty,*stop= 1,*quit= 1,*green:= 1,*move:= 1,*red:= 0,empty. +s1 :- empty,*stop= 0,*start= 1,*quit= 1,*green:= 0,*move:= 0,*red:= 1,empty. +s1 :- empty,*stop= 0,*start= 1,*quit= 1,*green:= 1,*move:= 1,*red:= 0,empty. +s1 :- more,*stop= 1,*start= 0,*quit= 0,*green:= 0,*move:= 0,*red:= 1,@s2. +s1 :- more,*stop= 0,*start= 1,*quit= 0,*green:= 1,*move:= 1,*red:= 0,@s3. +s2 :- empty,*quit= 1,*green:= 0,*move:= 0,*red:= 1,empty. +s2 :- empty,*quit= 1,*green:= 1,*move:= 1,*red:= 0,empty. +s2 :- more,*stop= 1,*start= 0,*quit= 0,*green:= 0,*move:= 0,*red:= 1,@s2. +s2 :- more,*stop= 0,*start= 0,*quit= 0,*green:= 0,*move:= 0,*red:= 1,@s2. +s2 :- more,*stop= 0,*start= 1,*quit= 0,*green:= 1,*move:= 1,*red:= 0,@s3. +s3 :- empty,*quit= 1,*green:= 0,*move:= 0,*red:= 1,empty. +s3 :- empty,*quit= 1,*green:= 1,*move:= 1,*red:= 0,empty. +s3 :- more,*stop= 0,*start= 1,*quit= 0,*green:= 1,*move:= 1,*red:= 0,@s3. +s3 :- more,*stop= 0,*start= 0,*quit= 0,*green:= 1,*move:= 1,*red:= 0,@s3. +s3 :- more,*stop= 1,*start= 0,*quit= 0,*green:= 0,*move:= 0,*red:= 1,@s2.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/toy/gi_ex.pl Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,16 @@ +% +% specification for simple graphics interaction +% + +gi_ex(( ++(((stop,keep((red,not(start)));start,keep((green,not(stop)))))), +[]((red,not(green);not(red),green)), +[]((green->move)), +[]((red->not(move))), +halt(quit) +)) :- + asserta(lite:st_variables([stop,start,quit],[red,gree,move])). + +gi:-gi_ex(X),write(X),nl,lite:ex(X),nl,lite:tgen. + +giout :- gi_ex(X),lite:ex(X),tell('gi.tokio'),lite:tgen,told.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/toy/toy.tokio Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,79 @@ +%% ------------------------------------------------- BOUNCE + + +toy :- static([green, red, move, stop, start,quit]), + *move:=1,*quit:=0,*stop:=0,*start:=1,*red:=0,*green:=1, + bounce_init(W,R,G),@toy1(W,R,G). + +toy1(W,R,G) :- + [](event), % input + s1, % automaton + []((button_red(R),button_green(G),bounce(W))). % output + +% ?- compile(['../tableau/gi.out']). + +event :- nextevent(E),E=E1,event_select(E1). +event_select(noevent) :- true. +event_select(button(_,start)) :- *start := 1, *stop := 0. +event_select(button(_,stop)) :- *stop := 1, *start := 0. +event_select(button(_,quit)) :- *quit := 1. + +button_red(Out) :- + *red =0, Out => out(""). +button_red(Out) :- + *red =1, Out => out("Red"). +button_green(Out) :- + *green =0, Out => out(""). +button_green(Out) :- + *green =1, Out => out("Green"). + +% size(400,400,10,fixed) :- true. +size(200,200,5,'7x14') :- true. + +bounce_init( [Window0, View0, Circ0, Xout0, X, Yout0, + Y, Xd, Yd, Ydd, Xlim, Ylim],Xout0,Yout0) :- + size(Hight,Width,R,Font), + H0 = Hight-2, W0 = Width-2, + H1 = Hight/2, W1 = Width/2, + View <= view(Hight,Width), +% View => setcolors(rgb(65000,0,0),white), + Xout <= output("Red",font(Font)), + Yout <= output("Green",font(Font)), + Start <= button("Start",start,font(Font)), + Stop <= button("Stop",stop,font(Font)), + Quit <= button("Quit",quit,font(Font)), + Box <= hbox([vbox([Xout,Yout,space,Start,Stop,Quit]),View]), + Window <= window("Toy Program",Box), + Window => open, + View => rect(0,0,H0,W0), + View => fillcircle(Circ,H1,W1,R), + Window0<--Window, View0<--View, Circ0<--Circ, + Xout0<--Xout, Yout0<--Yout, + Ylim = Hight-10, Xlim = Width-10, Ydd = -R/2, + #((@Ylim=Ylim,@Xlim=Xlim,@Ydd=Ydd)), + @X = H1, @Y = W1, @Xd = R/2, @Yd = R*2. +bounce([_, View, Obj, _Xout, X, _Yout, Y, Xd, Yd, Ydd, Xlim, _]) :- + *move = 1,*quit = 0, + X0 is integer(X), Y0 is integer(Y), + View => moveto(Obj,X0,Y0), + Y1 is Y+Yd, + calc_xd(X, Xd, Xd1, Xlim), + calc_yd(Y, Yd, Ydt, Y1, Yt1), + @X = X+Xd,@Xd = Xd1, @Y = Yt1, @Yd = Ydt+Ydd. +bounce([_, _, _, _, X, _, Y, Xd, Yd, _, _, _]) :- + *move = 0,*quit = 0, + @X = X,@Xd = Xd, @Y = Y, @Yd = Yd. +bounce([W|_]) :- + *quit = 1, + W => close. + +calc_xd(X, Xd, Xd1, _) :- X < 10, Xd1 is abs(Xd). +calc_xd(X, Xd, Xd1, Xlim) :- X > Xlim, Xd1 is -abs(Xd). +calc_xd(_, Xd, Xd, _):-true. + +calc_yd(Y, Yd, Ydt, _, Y0) :- + Y < 10, Yd > 0 , Ydt = Yd,Y0 = 10. +calc_yd(Y, Yd, Ydt, _, Y0) :- + Y < 10, Ydt = -Yd*0.9,Y0 = 10. +calc_yd(_, Yd, Yd, Y1, Y1):-true. +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/unifier/up Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,147 @@ +/* + + ?-com([upm,up]). + ?-tokio test. + + Thu Sep 4 22:22:41 GMT+9:00 1986 + */ + +:- static([ + memory(_), g_addr, d_addr, g_cell, d_cell, g_mem, d_mem, + length, stack_ln(_), stack_ga(_), stack_da(_), + stack_depth, return_code, run, d_bus, g_bus]). + + +init:- + *length <= (*memory(*g_addr)..data - 1,int,0), + *d_addr <= (*d_addr..data + 2,int,*d_addr..map), + *g_addr <= (*g_addr..data + 2,int,*g_addr..map), + *stack_depth <= 0, + *run <= 1 + && loop_unif. + +loop_unif:- + if *length..data > 0 + then fetch_unif1 + else if *stack_depth = 0 + then (*return_code <= (0,int,0), *run <= 0 && idle) + else *length <= *stack_ln(*stack_depth - 1), + *g_addr <= *stack_ga(*stack_depth - 1), + *d_addr <= *stack_da(*stack_depth - 1), + *stack_depth <= *stack_depth - 1 + && fetch_unif1. + +fetch_unif1:- + fetch_unif0g, + fetch_unif0d && + *length <= (*length..data - 1,int,0), + *g_addr <= (*g_addr..data + 1,int, *g_addr..map), + *d_addr <= (*d_addr..data + 1,int, *d_addr..map) && + fetch_unif2. + +fetch_unif0g:- + fetch(*g_addr,*g_cell,*g_bus), *g_mem <= *g_addr && + if *g_cell..tag = var + then fetch_unif1g. + +fetch_unif1g:- + fetch(*g_cell,*g_cell,*g_bus), *g_mem <= *g_cell && + if *g_cell..tag = var + then fetch_unif1g. + +fetch_unif0d:- + fetch(*d_addr,*d_cell,*d_bus), *d_mem <= *d_addr && + if *d_cell..tag = var + then fetch_unif1d. + +fetch_unif1d:- + fetch(*d_cell,*d_cell,*d_bus), *d_mem <= *d_cell && + if *d_cell..tag = var + then fetch_unif1d. + +fetch_unif2:- + if *g_mem = *d_mem then loop_unif + else { + G = *g_cell..tag, D = *d_cell..tag, { + if (G=undef,D=undef) then + (store(*g_mem,*d_mem, *g_bus) && loop_unif) + else if (G=undef,D\=undef) then + (store(*g_mem,*d_cell,*g_bus) && loop_unif) + else if (G\=undef,D=undef) then + (store(*d_mem,*g_cell,*d_bus) && loop_unif) + else if (G=list,D=list) then + (if *length..data > 0 + then ((*stack_depth <= *stack_depth + 1, + S<-- *stack_depth, + *stack_ga(S) <= *g_addr, + *stack_da(S) <= *d_addr, + *stack_ln(S) <= *length, + *length <= (2,int,g), + *g_addr <= *g_cell, + *d_addr <= *d_cell) && fetch_unif1) + else loop_unif) + else if (*g_cell..tag \= *d_cell..tag ; + *g_cell..data \= *d_cell..data) then + ((*return_code <= fail, *run <= 0) && idle) + else loop_unif }}. + + +idle:- if *run = 1 + then (true && init). + + +test:- + *memory((0,_,g)) := (4,int,g), % length + *memory((1,_,g)) := (append,atom,g), % append + *memory((2,_,g)) := (100,list,g), + *memory((3,_,g)) := (200,list,g), + *memory((4,_,g)) := (300,var,g), + *memory((5,_,g)) := (2,int,g), + *memory((6,_,g)) := (print,atom,g), % print + *memory((7,_,g)) := (400,var,g), + *memory((8,_,g)) := (0,int,g), % length = 0 + *memory((100,_,g)) := (a,atom,g), + *memory((101,_,g)) := (102,list,g), + *memory((102,_,g)) := (b,atom,g), + *memory((103,_,g)) := ([],atom,g), + *memory((200,_,g)) := (c,atom,g), + *memory((201,_,g)) := (102,list,g), + *memory((202,_,g)) := (d,atom,g), + *memory((203,_,g)) := ([],atom,g), + *memory((300,_,g)) := (0,undef,g), + *memory((400,_,g)) := (0,undef,g), + *memory((0,_,d)) := (5,int,d), + *memory((1,_,d)) := (append,atom,d), % append([H|X],Y,[H|Z]) + *memory((2,_,d)) := (200,list,d), + *memory((3,_,d)) := (300,var,d), + *memory((4,_,d)) := (400,list,d), + *memory((5,_,d)) := (5,int,d), + *memory((6,_,d)) := (append,atom,d), % append([],X,X) + *memory((7,_,d)) := ([],atom,d), + *memory((8,_,d)) := (100,var,d), + *memory((9,_,d)) := (100,var,d), + *memory((100,_,d)) := (0,undef,d), + *memory((200,_,d)) := (500,var,d), % [H|X] + *memory((201,_,d)) := (600,var,d), + *memory((300,_,d)) := (0,undef,d), % Y + *memory((400,_,d)) := (700,list,d), % [H|Z] + *memory((500,_,d)) := (0,undef,d), % H + *memory((600,_,d)) := (0,undef,d), % X + *memory((700,_,d)) := (500,var,d), % H + *memory((701,_,d)) := (800,var,d), % Z + *memory((800,_,d)) := (0,undef,d), % Z + *g_addr := (0,int,g), + *d_addr := (0,int,d), + *return_code := (0,undef,0), + *length := (0,int,0), + *g_mem := (0,int,g), + *d_mem := (0,int,d), + *g_cell := (0,int,g), + *d_cell := (0,int,d), + *run := 0, + *d_bus := free, *g_bus := free, + *stack_depth := 0 && + init, + # (Write = (*g_addr, *d_addr, *return_code, *run, *length, + *g_mem, *d_mem, *g_cell, *d_cell, *stack_depth, + *g_bus, *d_bus), write(Write) ).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/Examples/unifier/upm Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,21 @@ +:-op(400,xfy,'..'). + + +'$function' X..tag = Tag :- X = (Data,Tag,Map). +'$function' X..data = Data :- X = (Data,Tag,Map). +'$function' X..map = Map :- X = (Data,Tag,Map). + + +'$define' (store(ADR,Data,Bus):- + Address <-- ADR,Bus := ADR..map ,H, + *memory(Address) <= Data,Bus <= free) +'$clause' (H:- + if *d_bus = *g_bus ,Bus = d + then (true && H)). + +'$define' (fetch(ADR,Data,Bus):- + Address<--ADR,Bus := ADR..map,H, + Data <= *memory(Address),Bus <= free) +'$clause' (H:- + if *d_bus = *g_bus ,Bus = d + then (true && H)).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/call Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,23 @@ +/* + Copyright (C) 1988, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@mtl.u-tokyo.ac.jp +*/ + +?- ['ts'], + compile('to'), + compile('tc'), + compile('th'), + compile('td'), + compile('te'), + compile('tg'), + compile('tr'), + compile('tu'), + compile('tf'), + compile('xf'), + compile('cp'), + compile('tp'). +?- com('tm.pl', user), 'r_header'.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/cp.pl Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,37 @@ + + + + + + + + +compile0(F) :- + prolog_flag(single_var_warnings,_),!, + prolog_flag(single_var_warnings,X,off), + prolog_flag(discontiguous_warnings,Y,off), + compile(F), + prolog_flag(single_var_warnings,_,X), + prolog_flag(discontiguous_warnings,_,Y). +compile0(F) :- + style_check(-singleton),!, + style_check(-discontiguous),!, + compile(F), + style_check(+discontiguous), + style_check(+singleton). +compile0(F) :- + compile(F). + + + + + + + + +copy(X,Y) :- copy_term(X,Y). + + + +nofileerrors. +ttynl :- nl,flush.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/cp.pl.c Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,130 @@ +/* + Copyright (C) 1988, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@mtl.utokyo.ac.jp +*/ +/* + support routine for compatibilities + */ + +#ifdef CPROLOG + +help :- tokio_help. + +compile0(X) :- [X]. + +numbervars(X, V, V). + +/* +% numbervars('$VAR'(V0), V0, V) :- !, V is V0+1. +numbervars(Vname, Vname, V0, V) :- + var(Vname),!, + V is V0+1,name(V0,Lv),name(Vname,[95|Lv]). %%% _001 +numbervars(X, V0, V) :- + functor(X, F, A), + numbervars_args(0, A, X, V0, V),!. + +% :- mode numbervars_args(+,+,+,-,+,-). +numbervars_args(N, N, _, V, V) :- !. +numbervars_args(K, N, X, V0, V) :- + K1 is K+1, + arg(K1, X, XK), + numbervars(XK, V0, V1), + numbervars_args(K1, N, X, V1, V). +*/ + + +#ifdef CPROLOG15 +term_expansion(X,X). +:-unknown(X,trace). +#endif + +:- (ttyflush;assert((ttyflush:-nl))). + +:-asserta((c_post(Vname, Vname, V0, V) :- + var(Vname),!, + V is V0+1,name(V0,Lv),name(Vname,[95|Lv]))). %%% _001 +% c_post continue to to.pl + +:-abolish(c_post_atomic,2). +c_post_atomic([],[]) :- !. +c_post_atomic(Number,Number) :- number(Number),!. +c_post_atomic(=,' = ') :- !. % for 1.2, Do not ask me why. +c_post_atomic(Atomic,Qatomic):- + name(Atomic,La),La=[H|_],[H]\="'",[H]\="_",!, + concatenate(["'",La,"'"],Nla),name(Qatomic,Nla). +c_post_atomic(Atomic,Atomic). + +:-abolish(write_clause0,1). +write_clause0((X:-true)) :- + c_post(X, XX, 0, _), write(XX), put("."), nl,!,fail. %%% writeq --> write +write_clause0(X) :- + c_post(X, XX, 0, _), write(XX), put("."), nl,!,fail. %%% writeq --> write + +:-abolish(r_cputime,1). +r_cputime(X) :- X is cputime. + +:-abolish(tokiocomp1,1). +tokiocomp1(X) :- tokiocomp2(X). +tokiocomp1(_) :- + telling(I),tell(user), + read(Next),tell(I), !, tokiocomp1(Next). +tokiocomp1(_) :- c_error((nl,write('read error'),nl)). + +:-abolish(read_filter,2). +read_filter(X,Name) :- telling(I),tell(user), + repeat,read(X), + filter(X,Name),tell(I). + +#endif + +#ifdef SWIPROLOG +nofileerrors. +ttynl :- nl,flush. +#endif + +#if defined(SICSTUS) || defined(SWIPROLOG) +compile0(F) :- + prolog_flag(single_var_warnings,_),!, + prolog_flag(single_var_warnings,X,off), + prolog_flag(discontiguous_warnings,Y,off), + compile(F), + prolog_flag(single_var_warnings,_,X), + prolog_flag(discontiguous_warnings,_,Y). +compile0(F) :- + style_check(-singleton),!, + style_check(-discontiguous),!, + compile(F), + style_check(+discontiguous), + style_check(+singleton). +compile0(F) :- + compile(F). +#endif + +#if !defined(SICSTUS)||!defined(SWIPROLOG) + +% copy(X,Y) :- copy_term(X,Y). % for sicstus prolog + +copy(X, Y) :- copy(X, Y, var, _). +copy(X, Y, Vlist0, Vlist1) :- nonvar(X), + functor(X, F, A), functor(Y, F, A), !, + copy(A, X, Y, Vlist0, Vlist1). +copy(X, Y, Vlist0, Vlist0) :- map(Vlist0, X, Y), !. +copy(X, Y, Vlist0, var(X, Y, Vlist0)). +copy(0, _, _, Vlist0, Vlist0) :- !. +copy(N, X, Y, Vlist0, Vlist2) :- + arg(N, X, Xn), copy(Xn, Yn, Vlist0, Vlist1), arg(N, Y, Yn), + M is N-1, !, copy(M, X, Y, Vlist1, Vlist2). +map(var(X, Y, _), Var, Y) :- X==Var, !. +map(var(_,_,Rest), Var, Y) :- map(Rest, Var, Y). + +#else + +copy(X,Y) :- copy_term(X,Y). + +#endif + +/* end */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/example Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,304 @@ +%%%%%%% +% +% Temporal Logic Programming Language Tokio +% +% Fri Jun 6 1986 +% S.Kono +% The Faculty of Engineering +% The University of Tokyo +% a83793@tansei.u-tokyo.csnet +%%%%%%% +% 4.1 simple examples + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.0 always operator # +% length operator +% +% 1 1 1 1 1 1 +% |---|---|---|---|---|----> +% t0 t1 t2 t3 t4 t5 + +t0 :- #write(1),length(5). + + +% No.1 chop operator +% +% 0 0 0 0 +% 1 1 1 1 1 1 +% |---|---|---|---|---|---|---|---|----> +% |--- I0 ----|------- I1 --------| +% |------------ I ----------------| + +t1 :- #write(0),length(3) && #write(1),length(5). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.2 fin and keep +% +% 0 0 0 +% 1 +% 2 2 2 2 2 2 +% 3 +% |---|---|---|---|---|---|---|---|----> + +t2 :- keep(write(0)), fin(write(1)), length(3) + && #write(2), fin(write(3)), length(5). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.3 next operator +% +% 1 2 3 4 5 +% |---|---|---|---|---|----> + +t3 :- length(5), I = 1, counter(I), #write(I). + + counter(I) :- keep( @I = I+1 ). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.4 stable operator +% +% 2 2 2 2 2 2 +% |---|---|---|---|---|----> + +t4 :- length(5), I = 2, stable(I), #write(I). + +% stable(I) :- keep( @I = I ). (defined internally) + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.5 temporal assignment +% +% A 0 1 0 +% |---|---|---|---|---|----> +% B 1 0 1 +% |---|---|---|---|---|----> + +t5 :- A = 0, B = 1, + ( A <- B, B <- A, length(3) && + A <- B, B <- A, length(2) && true ), + #write((A,B)). + +% A <- B :- C = B, stable(C), fin( A = C ). +% (defined internally) +% +% B 0 ? ... ? ? +% |---|-- --|---|----> +% C 0 0 ... 0 0 +% |---|-- --|---|----> +% A ? ? ... ? 0 +% |---|-- --|---|----> + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.6 interval join +% + +t6 :- length(8), + N=3,(N gets N+1, halt( N=5 ) && stable(N)), + M=0,(M gets M+1, fin( M=6 ) && stable(M)), + #write((N,M)). + +% A gets B :- keep(@A=B). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.7 back track to the past +% + +t7:- length(5), + fin(M=N), + N=3,(N gets N+1 && stable(N)), + M=0,(M gets M+1 && stable(M)), + #write((N,M)). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.8 correct chop +% Not so important.... but +% Chop becomes slow in correct execution + +a(b):-true. +b(c):-true. +c(X) :- a(X) & @ b(X). + +t8 :- length(3),c(X),#write(X). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.9 and No. 10 projection +% Simple example of projection. Ben Moszkowski. Updated 19 Aug 85. +% +% changing unit of time using projection +% length(2) proj body(I,J) +% +% |--|--|--|--|--|--|--|--| (skip,stable(I),stable(J) & skip) +% I 0 1 2 3 4 +% |-----|-----|-----|-----| body(I,J) + +body(I,J) :- + I=0,I gets I+1,J=0,J gets J+I,halt(I=4). +t9 :- (skip,stable(I),stable(J) & skip) proj body(I,J), + #((write('I='),write(I),write(' J='),write(J))). + +% |--|--|--|--|--|--|--|--|--|--| (length(I),stable(I),stable(J)& skip) +% I 0 1 2 3 4 +% |--|-----|--------|-----------| body(I,J) + +t10:- (length(I),stable(I),stable(J)& skip) proj body(I,J), + #((write('I='),write(I),write(' J='),write(J))). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% No.11 prefix +% Terminate an interval early + +t11:-A=1,prefix((A gets 2*A,length(10))),halt(A=16),#write('I='),#write(A). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% 4.2 two way description of Tokio +% 1) algorithm description using "chop operator" + +magasync(A,B,Res):- + (if A < 0 + then Aab <- - A + else Aab <- A ), + (if B < 0 + then Bab <- - B + else Bab <- B ) + && + (if Aab > Bab + then G <- Aab, L <- Bab + else G <- Bab, L <- Aab) + && + Sqs <- G * 7 / 8 + L / 2 , G <- G + && + (if G > Sqs + then Res <- G + else Res <- Sqs). + +% 2) "Always operator" based description + +/* data flow calculation */ + +magasync_dataflow(A,B,Res):- + Aab = 0, Bab = 0, G = 0, Res = 0, + L = 0, Sqs = 0, G1 = 0, % initialize + #abs_unit(A,Aab), + #abs_unit(B,Bab), + #maxmin(Aab,Bab,G,L), + #calc(G,L,Sqs), + #delay(G,G1), + #result(G1,Sqs,Res). + +delay(G,G1):- + @G1 = G. + +abs_unit(I,O):- + if I < 0 then @O = -I else @O = I . + +maxmin(I1,I2,O1,O2):- + if I1 > I2 then (@O1 = I1, @O2 = I2) + else (@O1 = I2, @O2 = I1) . + +calc(I1,I2,O):- + @O = I1 * 7 / 8 + I2 / 2 . + +result(I1,I2,O):- + if I1 > I2 then @O = I1 else @O = I2 . + + +mag1:- A=5,B=6, + magasync(A,B,Res), write_fk([A,B,Res]). + +mag2:- Va = [1,2,3,4,5,6,7], Vb = [1,2,3,4,5,6,7], + input_data(A,Va),input_data(B,Vb), + magasync_dataflow(A,B,Res), write_fk([A,B,Res]). + +write_fk(X) :- keep(write(X)),fin(write(X)). +write_fk(A) :- fin(write(A)),keep(write(A)). + +input_data(0,[]) :- !,empty. +input_data(V,[H|T]):- + V = H, + @T = T, + @input_data(V,T). + + +%___________________________ +%4.3 pipeline merge sorter + + +sorter :- Strdata = [10,20,5,100,1,6,2,3], + datagen(Strdata,Data), + pipe(Data,Out), + length(18), + #write(Out). + + % Data Generator + +datagen([],[]):-true. +datagen([H|T],Out) :- + Out = [H], + @T = T, @datagen(T,Out). + + % Pipeline Merge Sorter + +pipe(I0,Out) :- + I1 = [], I2 = [], Out = [], + proc_start(I0,I1, 2,1), + proc_start(I1,I2, 4,2), + proc_start(I2,Out,8,4). + + % Processor Unit + +proc_start(I,O,P,PP) :- + X = [], Y = [], Z = [], T = 1, + #proc(I,O,X,Y,Z,T,P,PP). + +proc(I,O,X,Y,Z,T,_P,_PP) :- X=[],Y=[],I=[],!, + @X=X, @Y=Y, @Z=Z, @O=[], @T=1. +proc(I,O,X,Y,Z,T,P,PP) :- + load(I,O,X,Y,Yn,Z,Zn,T,P,PP), + merge(I,O,X,Y,Yn,Z,Zn,T,P,PP). + +load(I,_O,_X,Y,Yn,Z,Zn,T,_P,PP) :- T=<PP, !, + append(Z,I,Zn), @Z=Zn, Yn=Y, + @T=T+1. +load(I,_O,_X,Y,Yn,Z,_Zn,T,P,_PP) :- + append(Y,I,Yn), @Z=[], + (if T<P then @T=T+1 else @T=1). + +merge(_I,O,X,Y,Yn,_Z,Zn,T,_P,PP) :-X=[],Yn=[],!, + @O=[], @Y=Yn, + (if T=PP then @X=Zn else @X=X). +merge(_I,O,X,Y,Yn,_Z,Zn,T,_P,PP) :- X=[A|L],Yn=[],!, + @O=[A], @Y=Yn, + (if T=PP then @X=Zn else @X=L). +merge(_I,O,X,Y,Yn,_Z,Zn,T,_P,PP) :-X=[],Yn=[B|N],!, + @O=[B], @Y=N, + (if T=PP then @X=Zn else @X=X). +merge(_I,O,X,Y,Yn,_Z,_Zn,_T,_P,_PP) :-X=[A|L],Yn=[B|N],!, + (if A<B then + @O=[A], @X=L, @Y=Yn + else + @O=[B], @Y=N, @X=X). + +append(Nil,L,L1) :- Nil=[],L=L1. +append(X,L,Y) :-[H|T]=X,[H1|M]=Y, + H=H1,append(T,L,M). + +test :- t0 & @ + t1 & @ + t2 & @ + t3 & @ + t4 & @ + t5 & @ + t6 & @ + t7 & @ + t8 & @ +% t9 & @ +% t10 & @ +% t11 & @ + mag1 & @ + mag2 & @ + sorter.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/iall Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,26 @@ +/* + Copyright (C) 1988, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@mtl.u-tokyo.ac.jp +*/ +assert(dynamic(X)). + +?- nl,consult('ts.pl'), + consult('to.pl'), + consult('tc.pl'), + consult('th.pl'), + consult('td.pl'), + consult('te.pl'), + consult('tg.pl'), + consult('tr.pl'), + consult('tu.pl'), + consult('tf.pl'), + consult('xf.pl'), + consult('tp.pl'), + consult('cp.pl'). +?- ['ts.pl'], com('tm.pl', '/dev/null'). +% ?- save((tokio)), 'r_header'. +?- 'r_header'.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lall Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,24 @@ +/* + Copyright (C) 1988, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@mtl.u-tokyo.ac.jp +*/ +?- nl,load('ts.ql'), + load('to.ql'), + load('tc.ql'), + load('th.ql'), + load('td.ql'), + load('te.ql'), + load('tg.ql'), + load('tr.ql'), + load('tu.ql'), + load('tf.ql'), + load('xf.ql'), + load('cp.ql'), + load('tp.ql'). +?- [ts], com('tm.pl', '/dev/null'). +% ?- gc, ttyflush, save((tokio)), 'r_header', (tokio). +end_of_file.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/mall Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,50 @@ +/* + Copyright (C) 1988, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@csl.sony.co.jp +*/ + +:-module(tokio,[ + com/1, % compile & compile program. + com/2, % compile & counsult & save file. + pcom/2, % compile specified predicates. + pcom/3, % compile specified predicates. + mcom/1, % preprocess + mcom/2, % preprocess & outputfile. + static/1, % static variable declaration + restart/1, % run tokio save file. + tokiodebug/0, % All computation will be traced. + tokionodebug/0, % Debug mode is switched off. + tokiodebugging/0, % Display some informations about tracing. + notimebacktrack/0, % no time backtrack.. + timebacktrack/0, % time backtrack.. + tokio/0, % start tokio top-level. + tokio/1, % run tokio program. + tokio_help/0, % help + user_help/0, % help + reset_macro/1 % Reset Macro Definition. com predicates also reset Macros. +]). + +?- ['ts'], + ensure_loaded('to'), + ensure_loaded('tc'), + ensure_loaded('th'), + ensure_loaded('td'), + ensure_loaded('te'), + ensure_loaded('tg'), + ensure_loaded('tr'), + ensure_loaded('tu'), + ensure_loaded('tf'), + ensure_loaded('xf'), + ensure_loaded('cp'), + ensure_loaded('tp'). + +% :-prolog_flag(single_var_warnings, _, off), +% prolog_flag(compiling,_,compactcode). + +:-com('tm.pl',user). + +% end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/read.me Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,289 @@ +Tokio / Prolog Compiler + + Fri Aug 5 19:35:55 JST 2005 + Shinji KONO + kono@ie.u-ryukyu.ac.jp + University of the Ryukyus + +1. Change -D flag in Makefile + + Supporting Prologs PROLOG_TYPE PROLOG + SICStus SICSTUS sicstus + Quintus QUINTUS quintus + SWI-Prolog SWIPROLOG swipl + +2. File List + + call prolog bootup file + cp.pl file for compatiblities + cp.pl.c file for compatiblities (no longer used) + tc.pl tokio clause compiler + td.pl debugger + te.pl expression basics + tf.pl predicates compiler + tg.pl one line compiler + th.pl head unification + tm.pl basic macros + to.pl tokio compiler main routines + tp.pl macro expansion + tr.pl runtime support + ts.pl system definition & operator + tu.pl temporal logic unification + xf.pl system-predicates list + tokio.pl module definition + call iall lall mall load file + +3. How to run + +In SICStus, use tokio module. + + % sicstus + SICStus 3.12.1 (powerpc-darwin-7.8.0): Mon Apr 18 20:00:24 CEST 2005 + Licensed to ie.u-ryukyu.ac.jp + | ?- use_module(tokio). + % compiling /Users/kono/ITL/Tokio/tokio.pl... + % compiled /Users/kono/ITL/Tokio/tp.pl in module tokio, 60 msec 19832 bytes + END + 0.0 sec. + % compiled /Users/kono/ITL/Tokio/tokio.pl in module tokio, 350 msec 153404 bytes + yes + | ?- com(example). + Compiling: t0/0 + Compiling: test/0 + END + 0.10999999999999999 sec. + % compiling /Users/kono/ITL/Tokio/#temp.tokio... + * [E] - singleton variables in (tokio):t1/2 + * Approximate lines: 873-877, file: '/Users/kono/ITL/Tokio/#temp.tokio' + % compiled /Users/kono/ITL/Tokio/#temp.tokio in module tokio, 210 msec 57528 bytes + yes + | ?- tokio. + + tokio: test. + + t0:1 + t1:1 + ... + t90:[100] + t91:[] + 91 clock and 0.010000000000000009 sec. + + tokio: ^D + yes + | ?- ^D + +In SWI Prolog, use tokio_swi.pl script. + + % swipl + Welcome to SWI-Prolog (Multi-threaded, Version 5.4.7) + Copyright (c) 1990-2003 University of Amsterdam. + SWI-Prolog comes with ABSOLUTELY NO WARRANTY. This is free software, + and you are welcome to redistribute it under certain conditions. + Please visit http://www.swi-prolog.org for details. + + For help, use ?- help(Topic). or ?- apropos(Word). + + ?- [tokio_swi]. + % ts compiled into tokio 0.00 sec, 1,984 bytes + ... + % tp compiled into tokio 0.00 sec, 18,668 bytes + END + 0 sec. + % tokio compiled into tokio 0.06 sec, 142,720 bytes + % ts compiled 0.00 sec, 840 bytes + % tokio_swi compiled 0.06 sec, 143,952 bytes + + Yes + tokio: ?- com(example). + Compiling: t0/0 + Compiling: t1/0 + Compiling: test/0 + END + 0.14 sec. + Warning: (/Users/kono/ITL/Tokio/#temp.tokio:18): + Singleton variables: [E] + ... + Warning: (/Users/kono/ITL/Tokio/#temp.tokio:873): + Singleton variables: [E] + % #temp.tokio compiled into tokio 0.02 sec, 68,272 bytes + + Yes + tokio: ?- tokio. + + tokio: test. + + t0:1 + t1:1 + t2:1 + t90:[100] + t91:[] + 91 clock and 0.02 sec. + + tokio: + + Yes + tokio: ?- + % halt + +You can run each small test in example file, + ?- tokio t0. +or in tokio top level, + ?- tokio. + tokio: t0. + +To try more examles, + + % cd Examples/6502 + % sicstus + ?-use_module('../../Tokio/tokiko'). + ?-com(mc6502). + ?-com(run). + ?-tokio run(a). + +Some of them may not work, such as toy. + +3. Notice + +If you are going to create very large program in Tokio, +use com/2 instead of com/1. It greatly reduces compile time and you +can use Prolog output for debugging purpose. + +Converting Tokio Program into Prolog is quite fast. But +compiling the output by Prolog compiler takes long time (in some prolog). +Execution speed of Tokio program mainly depends on runtime library, so +Tokio code can run reasonably fast even if generated code is not compiled. + +"com(file)" command translates and compiles Tokio program, but +"com(file,output)" translates and consults Tokio program. +In this reason, it is better to use com(file,output) than com(file) to +speed up Tokio to Prolog translation. + +When you exit Prolog top level, use ``tokio'' to reenter Tokio top level. + +In SICStus/Quintus, com/2 automatically try to add '.tokio' postfix, +but SWI-Prolog does not. You need type com('mc6502.tokio') in SWI-Prolog. + +SICStus/Quintus complains, + * nofileerrors/0 - NOT redefined +Please ignore. + +4. Module + + ?- use_module(tokio). + ?- com(example). + ?- tokio test. + +will work on SICStus Prolog. + +In SWI-Prolog, + + ?- use_module(tokio). + ?- [ts]. + ?- module(tokio). + ?- com(example). + ?- tokio test. + +Yes, we should have seprate space for compiled tokio clauses. + +5. Sample Run + +Here is an example script.... + + +Script started on Fri Aug 5 19:39:20 2005 +% swipl + +Welcome to SWI-Prolog (Multi-threaded, Version 5.4.7) +Copyright (c) 1990-2003 University of Amsterdam. +SWI-Prolog comes with ABSOLUTELY NO WARRANTY. This is free software, +and you are welcome to redistribute it under certain conditions. +Please visit http://www.swi-prolog.org for details. + +For help, use ?- help(Topic). or ?- apropos(Word). + +?- [call]. +% ts compiled 0.00 sec, 1,880 bytes +% to compiled 0.01 sec, 16,656 bytes + ... +% tp compiled 0.01 sec, 18,156 bytes +END +0 sec. + + Tokio to prolog compiler $Revision$ $Date$ + try ?- tokio_help. + +% call compiled 0.08 sec, 257,608 bytes + +Yes +?- com(example) + +?- com +?- com(example). +Compiling: t0/0 +Compiling: t1/0 + .... +Compiling: append/3 +Compiling: test/0 +END +0.14 sec. +Warning: (/Users/kono/ITL/Tokio/#temp.tokio:18): + Singleton variables: [E] + ... +Warning: (/Users/kono/ITL/Tokio/#temp.tokio:873): + Singleton variables: [E] +% #temp.tokio compiled 0.02 sec, 68,272 bytes + +Yes +?- tokio test. + +t0:1 +t1:1 +t2:1 +t3:1 +t4:1 + ... +t89:[20] +t90:[100] +t91:[] +91 clock and 0.02 sec. + +Yes +?- tokiodebug. +Tokio debug mode switched on. +All computation will be traced. +ERROR: Undefined procedure: ttynl/0 +?- tokio t0. + +Tokio Trace t0:h. +help/h/? print this +next/n skip to next clock +dump/d dump current static value +all all history of static value +save(file) save current state +skip(n)/s(n)/+-Number goto +-Number clock +abort/a abort tokio execution +break/b break to prolog +value(Name)/*Name examine static value +queue/q show current process queue +trace/t enter prolog tracer + +Tokio Trace t0:next. + +t0:1 +Tokio Trace t1:next. + +t1:1 +Tokio Trace t2:q. + +:-abolish(restart, 1), recorda(time, 2, _G415). +restart:-r_solve_t((r_0t00(['$t'(B, C, D, $(5, 2, A))|E], ['$t'(true, true, true, $(5, 2, A))|F]), true), 5, 2, ['$t'(B, C, D, $(5, 2, A))|E], ['$t'(true, true, true, $(5, 2, A))|F]). + +Tokio Trace t2:skip(3). + +t2:1 +t3:1 +t4:1 + + +Script done on Fri Aug 5 19:41:30 2005 +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tc.pl Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,214 @@ +/* + Copyright (C) 1988,2005, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@ie.u-ryukyu.ac.jp +*/ + +/* + + Tokio compiler to prolog + Thu Aug 15 12:17:04 JST 1985 + Fri Jan 10 16:11:31 JST 1986 + Fri Sep 5 09:51:36 JST 1986 for 1.2a + Thu Mar 26 16:19:10 JST 1987 + Wed Oct 14 13:35:54 JST 1987 full time F + Fri Oct 16 11:28:26 JST 1987 Sicstus + $Header$ + body-compiler +*/ + +c_clause((Head :- Body), (H :- B)) :- !, + c_opt(Body, NBody, _), % delete true + c_body(NBody, Control, + ['$t'(B1,_,_,_)|Q] , ['$t'(true,_,_,_)|T1], before_cut-_), + % make queue structure + c_head(Head, H0, B2, B1,Control,Q), % inline unification + c_opt(B2, B, _), % off tailing true + c_make_pred(H0, H, Q, T1). +c_clause(Head, H) :- % fact + c_head(Head, H0, B2, true,_,_), + c_make_pred(H0, H1, Q, Q), + c_opt(B2, B, _), % off tailing true + (B = true, H = H1,! ; H = (H1 :- B)). + +c_error(A) :- + telling(Old),tell(user), + call(A), + tell(Old). + +/* + + c_head(Head, ModfiedHead, Qhead, Qtail) + +*/ + +c_head(H,Mh,Qh0,Qt,Control,Q) :- + c_control_reference(Control,Qh0,Qh,Q), + functor(H,F,A),functor(Mh,F,A), + c_args(0,A, H, Mh, Qh, Qt). + +c_args(N, N, _, _, Q, Q) :- !. +c_args(K, N, Head, H, Q, Q1) :- + K1 is K+1, arg(K1, Head, AK), arg(K1, H, HK), + c_unify(AK, HK, Q, Q2, 8), + c_args(K1, N, Head, H, Q2, Q1). + +% We needs NOW value however sometines is is hiden in Next time Queue +c_control_reference(Control,(Q=['$t'(_N,_F,_K,'$'(_,NowTime,_))|_],Qh),Qh,Q) :- + Control = '$'(_Fin,Now,_Empty),nonvar(Now),var(Q), + Now = '$REF'(NowTime),!. +c_control_reference(_Control,Qh,Qh,_Q). + +/* + + Tokio compiler Queue structure + + [Qnow,Qnext1,Qnext2,......|_],[QnowTail,Qnext1Tail,Qnext2Tail,.....|_] + D-list + Qnow = '$t'(Next,Fin,Keep,'$'(Fin,Now,Empty)) + + predicate(A):- p,q. + ---> predicate(A,Q,Q1) :- + p(Q,Q2),q(Q2,Q1). +*/ + +c_body(E=E1, Control, + ['$t'(N1,F,K,C)|Q], + ['$t'(N,F,K,C)|Q], before_cut-before_cut) :- !, + c_eval(E, EE, N1, N2, Control), c_eval(E1, EE1, N2, N, Control), + c_equate(EE,EE1). +c_body(E=E1, Control, + ['$t'(N1,F,K,C)|Q], + ['$t'(N,F,K,C)|Q], after_cut-after_cut) :- !, + c_eval(E, EE, N1, N2, Control), c_eval(E1, EE1, N2, (EE = EE1,N), Control). +c_body(E is E1, Control, + ['$t'(N1,F,K,C)|Q], + ['$t'(N,F,K,C)|Q], Cut-Cut) :- !, + c_eval(E, EE, N1, N2, Control), c_eval(E1, EE1, N2, (EE is EE1,N), Control). +c_body('$chop'(Former,Later), Control, % later must be atomic + ['$t'(('r_subBegin'(Q,QF,QF1,_Sfin),FF),F,K,Control)|Q], + ['$t'(FF1,F,K,Control)|Q1],Cut) :- !, + Control = '$'(_CFin,CNow,_CEmpty), NC = '$'(_,CNow,_), % subtle code + c_body(Former,NC,['$t'(FF,_,_,NC)|QF1],['$t'((L1,FF1),_,_,NC)|QF2],Cut), + c_chop_later(Later, L1, Q, Q1, QF, QF2). +c_body((A,B), Control, Q, Q1, Cut-Cut1) :- !, + c_body(A, Control, Q, Q2, Cut-Cut2), + c_body(B, Control, Q2, Q1, Cut2-Cut1). +%c_body(empty, '$'(Fin,Now,empty), +% [Now,'$t'(N,F,K,'$'(Fin,Now,empty))|Q1], +% [Now,'$t'(N,F,K,'$'(Fin,Now,empty))|Q1], Cut) :- !, % strong next +c_body(empty, Control, + ['$t'(('r_empty'(Q),N),F,K,Control)|Q], + ['$t'(N,F,K,Control)|Q],Cut-Cut) :- !. +c_body(notEmpty, Control, + ['$t'(('r_notEmpty'(Q),N),F,K,Control)|Q], + ['$t'(N,F,K,Control)|Q],Cut-Cut) :- !. +c_body(length(L), Control, + ['$t'(N2,F,K,Control)|Q], + ['$t'(N,F,K,Control)|Q],Cut-Cut) :- !, + c_eval(L, LL, N2, ('r_length'(LL,Q),N), Control). +%% c_body(@true, C, Q, Q, Cut-Cut) :-!. % special optimize +c_body(next(true), _C, Q, Q, Cut-Cut) :-!. +c_body(@A, '$'(Fin,NowTime,notEmpty), + [Now|Q], + [Now,'$t'(N,F,K,'$'(Fin,NowTime,notEmpty))|Q1], Cut) :- !, % strong next + c_seperate_next(A, NextA), + c_body(NextA, _Control, + Q, + ['$t'(N,F,K,'$'(Fin,NowTime,notEmpty))|Q1], Cut). +c_body(next(A), _Control, + [Now|Q], [Now|Q1], Cut) :- !, % weak next + c_seperate_next(A, NextA), + c_body(NextA, _Control1, Q, Q1, Cut). +c_body(ifEmpty(A), Control, % fin don't care queue + [Now,'$t'(N,F,K,Control)|Q],[Now,'$t'(N,F1,K,Control)|Q], + Cut-Cut) :- !, + c_body(A, Control, + ['$t'(F,F2,_,Control)|_], + ['$t'(F2,F1,_,Control)|_] , after_cut-_). +c_body(ifNotEmpty(A), Control, + [Now,'$t'(N,F,K,Control)|Q],[Now,'$t'(N1,F,K1,Control1)|Q1], + Cut-Cut) :- !, + c_body(A, Control, + ['$t'(K ,_,_,Control),'$t'(N, _,K2,Control) |Q], + ['$t'(K2,_,_,Control),'$t'(N1,_,K1,Control1)|Q1] , after_cut-_). +c_body(A, Control, ['$t'(System,F,K,Control)|Q], + ['$t'(System1,F,K,Control)|Q], Cut) :- + c_system(A, System, System1, Control, Cut), !. +c_body(A, Control, + ['$t'((A1,Now),F,K,Control)|Q], + ['$t'(Now,F,K,Control)|Q1], Cut-Cut) :- !, + c_make_pred(A,A1,Q,Q1). + +c_make_pred(X, XX, Q, T) :- + functor(X, F, A), + A1 is A+1, A2 is A+2, + functor(XX, F, A2), + c_copy_args(A, X, XX), + arg(A1, XX, Q), arg(A2, XX, T). + +c_copy_args(0, _, _) :- !. +c_copy_args(K, X, XX) :- + arg(K, X, XK), arg(K, XX, XK), K1 is K-1, c_copy_args(K1, X, XX). + +c_system(true,Q, Q, _, Cut-Cut) :- !. +c_system('r_read_value'(A,B),('r_read_value'(A1,B),Q), Q, _, Cut-Cut) :- !, + c_seperate_now(A,A1). +c_system(!, (!,Q), Q, _, _Cut-after_cut) :- !. +c_system(prolog(A), (call(A1),Q), Q, _, Cut-Cut) :- !, c_seperate_now(A,A1). +%% c_system(A<--B, Q, Q1, Control, Cut-Cut) :- !, +%% c_eval(B, V, Q, Q2, Control), +%% (A = '$CNT'(V),!,Q1=Q2 ; Q2 = (unifyAll(A,V),Q1)). +c_system(*A:=B, Q, Q1, Control, Cut-Cut) :- !, + '$'(_Fin,'$REF'(NowTime),_Empty)=Control, + c_eval(A, Name, Q, Q2, Control), + c_eval(B, Value, Q2, ('r_set_value'(Name,Value,NowTime),Q1), Control). +c_system(Op, Q, Q1, Control, Cut-Cut) :- n_predicate(Op,A,B,Op2,AA,BB),!, + c_eval(A, AA, Q, Q2, Control), c_eval(B, BB, Q2, (Op2,Q1), Control). +c_system(System,(System1,Q), Q, _, Cut-Cut) :- systemp(System), + c_seperate_now(System,System1). + +% compile chop operator +% +% c_chop_later(Later, GenerateLater, Q, Q1, QF, QF1). + +c_chop_later(Later, GenerateLater, Q, Q1, QF, QF1) :- + + % 0r(X, '$'(Q,Q1,QF,QF1)) + + functor(Later, LH1, A), + A1 is A+1, + functor(GenerateLater, LH1, A1), + arg(A1, GenerateLater, '$'(Q,Q1,QF,QF1)), + c_skel_copy_arg(0, 0, A, Later, GenerateLater), + + % 0r(X, '$'(Q, Q1, QF, QF1)) :- 'r_subFin'(QF, QF1),r(X, Q, Q1). + + functor(Later0, LH1, A), + c_make_pred(Later0, Later1, QQ, QQ1), + functor(L2, LH1, A1), + arg(A1, L2, '$'(QQ,QQ1,QQF,QQF1)), + c_skel_copy_arg(0, 0, A, Later0, L2), + write_clause( (L2 :- 'r_subFin'(QQF,QQF1), Later1)), + + % 0r(X, '$'(Q, Q1, QF, QF1)) :- + % 'r_subNotFin'( + % 0r(Xn,'$'(NQ,NQ1,NQF,NQF1)), '$'(NQ,NQ1,NQF,NQF1), + % '$'(Q, Q1, QF, QF1)). + + functor(Later00, LH1, A), + functor(L3, LH1, A1), + arg(A1, L3, '$'(QQ,QQ1,QQF,QQF1)), + functor(L4, LH1, A1), + arg(A1, L4, '$'(NQQ,NQQ1,NQQF,NQQF1)), + c_seperate_next(Later00,Later00Next), + c_skel_copy_arg(0, 0, A, Later00Next, L4), + c_args(0,A,Later00, L3, Body, + 'r_subNotFin'( L4, '$'(NQQ,NQQ1,NQQF,NQQF1), + QQ, QQ1, QQF, QQF1)), + write_clause(( L3 :- Body )). + +%%
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/td.pl Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,182 @@ +/* + Copyright (C) 1988,2005, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@ie.u-ryukyu.ac.jp +*/ + + +tokiodebug_on :- recorded(tokiodebug, on, _), !. +tokiodebug_on :- recorda(tokiodebug, on, _), + write('Tokio debug mode switched on.'), nl. + +tokiodebug_off :- recorded(tokiodebug, _, R), !, + erase(R), write('Tokio debug mode switched off.'), nl. +tokiodebug_off. + +'tokiodebugon?' :- + recorded(tokiodebug, on, _), !, uhihi. + +uhihi :- + recorded(tokiotraceat, _, _), !, fail. +uhihi. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Clocked Stepping +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +r_tokioDebug(Q,Now) :- + r_skip(S), + r_tokioDebug(S,Q,Now). + +r_tokioDebug(S,_Q,Now) :- S > Now,!. +r_tokioDebug(S,_Q,Now) :- 0<S,S < Now,!,fail. +r_tokioDebug(_,Q,Now) :- + abolish(r_skip,1), + assert(r_skip(-1)),!, + r_select(Q,Now),!,r_skip(S),(S>Now;S= -1). + +r_select(Q,Now) :- repeat,nl,write('Tokio Trace t'),write(Now),write(:), + read(Key),r_menu(Key,Key1), + r_tokioDebug_menu(Key1,Q,Now),!. + +r_menu(n,next):-!. +r_menu(d,dump):-!. +r_menu(s(N),skip(N)):-!. +r_menu(+(N),skip(N)):-!. +r_menu(a,abort):-!. +r_menu(b,break):-!. +r_menu(v(N),value(N)):-!. +r_menu(*(N),value(N)):-!. +r_menu(q,queue):-!. +r_menu(t,trace):-!. +r_menu(N,skip(N)):-number(N),!. +r_menu(h,help):-!. +r_menu(?,help):-!. +r_menu(V,V). + +r_tokioDebug_menu(help,_,_) :- + write('help/h/? '),put(9), write(' print this'),nl, + write('next/n '),put(9), write(' skip to next clock'),nl, + write('dump/d '),put(9), write(' dump current static value'),nl, + write('all '),put(9), write(' all history of static value'),nl, + write('save(file) '),put(9), write(' save current state'),nl, + write('skip(n)/s(n)/+-Number'),put(9),write(' goto +-Number clock'),nl, + write('abort/a '),put(9), write(' abort tokio execution'),nl, + write('break/b '),put(9), write(' break to prolog'),nl, + write('value(Name)/*Name '),put(9),write(' examine static value'),nl, + write('queue/q '),put(9), write(' show current process queue'),nl, + write('trace/t '),put(9), write(' enter prolog tracer'), + nl,fail. +r_tokioDebug_menu(dump,_,_) :- + recorded(r_static,Name,_),record1(Name,(Name,Value,Time),_Ref), + write(at),write(Time),write(': '),put(9), + write(*Name),write( = ),write(Value),nl,fail. +r_tokioDebug_menu(abort,_,_Time):- !,abort. +r_tokioDebug_menu(break,_,_Time):- !,break,fail. +r_tokioDebug_menu(next,_,_Time):- !. +r_tokioDebug_menu(trace,_,_Time):- !,trace. +r_tokioDebug_menu(all,_,Time) :- % recorded(time,Now,_),!, + r_inc_time(Now,Time), assert(r_fififi), + recorded(r_static,Name,_),recorded(Name,(Name,Value,Now),_Ref), + (r_fififi,write(Now),write(': '),retract(r_fififi),fail; put(9)), + write(*),write(Name),write(' = '),write(Value), + nl,fail. +r_tokioDebug_menu(queue,Q,_Time) :- + numbervars(Q,0,_),r_save_queue(Q),!,fail. +r_tokioDebug_menu(value(Name),_Q,_) :- + recorded(Name,(Name,Value,Time),_Ref), + write(*),write(Name),write(' = '),write(Value), + write(' at: '),write(Time),nl,fail. +r_tokioDebug_menu(save(File),Q,_Time) :- + tell(File), + write((:- init_static)),write('.'),nl, + r_save_static,numbervars(Q,0,_), + r_save_queue(Q), + told,!,fail. +r_tokioDebug_menu(skip(N),_,Time) :- !, + M is N+Time,abolish(r_skip,1), + assert(r_skip(M)). +r_tokioDebug_menu(_,_,_Time) :- !,fail. + +r_inc_time(X,Now) :- r_inc_time(X,Now,0). +r_inc_time(N,_Now,N). +r_inc_time(N,Now,M) :- M1 is M+1,M1 =< Now, r_inc_time(N,Now,M1). + +r_save_static :- + recorded(r_static,Name,_),recorded(Name,(Value,Time),_Ref), + write_term((:- recordz(Name,(Value,Time),_)),[numbervars(true),quoted(true)]), + % writeq((:- recordz(Name,(Value,Time),_))), + write('.'),nl,fail. +r_save_static. + +r_save_queue(t(Empty,X,Fin,Now,F,K,Next,Futures,True)) :- + nl,write((:- abolish(restart,1),recorda(time,Now,_))),write('.'), + nl, + OO = ( restart + :- r_solve_t(X,Fin,Now,['$t'(Next,F,K,'$'(Fin,Now,Empty))|Futures], + ['$t'(true,true,true,'$'(Fin,Now,Empty))|True]) ), + % writeq(OO), + write_term(OO,[numbervars(true),quoted(true)]), + write('.'),nl. + +restart(File) :- [-File],restart. + +record1(Name,Value,Ref) :- recorded(Name,Value,Ref),!. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Clause Tracer (N.Y.I) +%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +tokiospied(G) :- + functor(G, F, A), A2 is A-2, recorded(tokiospy, F/A2, _), !. + +tokiofailed1(_G) :- recorded(tokiofail, _, _), !. +tokiofailed(G) :- + functor(G, F, A), A2 is A-2, recorded(tokiofail, F/A2, _), !. + +% tokiodebug :- recorded(tokiospy, _, R), erase(R), fail. +% tokiodebug :- recorded(tokiofail, _, R), erase(R), fail. +tokiodebug :- tokiodebug_on, + recorda(tokiospy, _, _), recorda(tokiofail, _, _), + write('All computation will be traced.'), ttynl. + +% tokionodebug :- recorded(tokiospy, _, R), erase(R), fail. +% tokionodebug :- recorded(tokiofail, _, R), erase(R), fail. +% tokionodebug :- recorded(tokiotraceat, _, R), erase(R), fail. +tokionodebug :- tokiodebug_off. + +(tokiospy) :- recorded(tokiospy, _, R), erase(R), fail. +(tokiospy) :- recorded(tokiofail, _, R), erase(R), fail. +(tokiospy) :- tokiodebug_on, recorda(tokiospy, _, _), + write('All Tokio reductions will be traced.'), ttynl. + +tokiospy(X) :- + tokiodebug_on, + ( X=_F/_A, !, recorda(tokiospy, X, _); recorda(tokiospy, X/_, _) ), + write('Tokio spy-point placed on '), write(X), put("."), nl. + +(tokionospy) :- recorded(tokiospy, _, R), erase(R), fail. +(tokionospy) :- tokiodebug_off. + +tokionospy(F/A) :- + recorded(tokiospy, F/A, R), erase(R), + write('Tokio spy-point on '), write(F/A), write(' removed.'), nl, fail. +tokionospy(X) :- + recorded(tokiospy, X/_, R), erase(R), + write('Tokio spy-point on '), write(X), write(' removed.'), nl, fail. +tokionospy(_X) :- recorded(tokiospy, _, _), !. +tokionospy(_) :- tokiodebug_off. + +tokiodebugging :- recorded(tokiodebug, on, _), !, + write('Tokio debug mode is switched on.'), nl, + tokiodebugging1. +tokiodebugging :- write('Tokio debug mode is switched off.'), nl. + +tokiodebugging1 :- + ( setof(X, R^recorded(tokiospy, X, R), S), !, + ( S=[V|_], var(V), !, write('All Tokio reductions are traced.'); + write('Tokio spy-points set on: '), write(S) ), nl; + true ). + +/* end td */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/te.pl Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,91 @@ +/* + Copyright (C) 1988,2005, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@ie.u-ryukyu.ac.jp +*/ + +/* + tokio compier function evaluator + Sat Jan 11 12:11:22 JST 1986 +*/ + +/* + Now we move hole computation routines to tp + preprocessor part. So we only try to make temporal varible + structures here. +*/ + +% c_eval(Expression, Generate_Expression, Qhead, Qtail, Control). + +c_eval(Var, Now, Q, Q, _C) :- + variable(Var),!, + c_seperate_now(Var, Now). +%c_eval(Exp, Value, Q, Q1, C) :- n_function(Exp,A,B,Exp1,AA,BB),!, +% c_eval_exp(A, AA, Q, Q2, C), +% c_eval_exp(B, BB, Q2, (Value is Exp1,Q1), C). +c_eval(Atomic, Atomic, Q, Q, _C) :- atomic(Atomic),!. +c_eval(@E, Next, Q, Q1, C) :- !, + c_seperate_next(E, EE), + c_eval(EE, Next, Q, Q1, C). +% c_eval(*S, Value, Q, Q1, C) :- !, % move into tp (macro expanstion) +% c_eval(S, Name, Q, ('r_read_value'(Name,Value),Q1), C). +c_eval(Func, Value, Q, Q1, C) :- + functor(Func, H, A), functor(Value, H, A), + c_eval_arg(0, A, Func, Value, Q, Q1, C). + +c_eval_arg(N, N, _, _, Q, Q, _) :- !. +c_eval_arg(N, M, A, B, Q, Q2, C) :- + N1 is N+1, + arg(N1, A, A1), arg(N1, B, B1), + c_eval(A1, B1, Q, Q1, C), + c_eval_arg(N1, M, A, B, Q1, Q2, C). + +%c_eval_exp(Exp, Exp1, Q, Q1, C) :- nonvar(Exp), +% n_function(Exp,A,B,Exp1,AA,BB),!, +% c_eval_exp(A, AA, Q, Q2, C), +% c_eval_exp(B, BB, Q2, Q1, C). +%c_eval_exp(Exp, Exp1, Q, Q1, C) :- +% c_eval(Exp, Exp1, Q, Q1, C). + +c_hex(H,V) :- c_hex(H,0,V). +c_hex([],V,V):-!. +c_hex([H|T],V,V1) :- c_hex1([H],VH), V2 is V*16+VH, + c_hex(T,V2,V1). + +c_binary(H,V) :- c_binary(H,0,V). +c_binary([],V,V):-!. +c_binary([H|T],V,V1) :- c_binary1([H],VH), V2 is V*2+VH, + c_binary(T,V2,V1). + +c_binary1("0",0). c_binary1("1",1). + +c_hex1("0",0). c_hex1("1",1). c_hex1("2",2). c_hex1("3",3). +c_hex1("4",4). c_hex1("5",5). c_hex1("6",6). c_hex1("7",7). +c_hex1("8",8). c_hex1("9",9). c_hex1("A",10). c_hex1("B",11). +c_hex1("C",12). c_hex1("D",13). c_hex1("E",14). c_hex1("F",15). +c_hex1("a",10). c_hex1("b",11). c_hex1("c",12). c_hex1("d",13). +c_hex1("e",14). c_hex1("f",15). + +n_predicate(A<B,A,B,AA<BB,AA,BB). +n_predicate(A>B,A,B,AA>BB,AA,BB). +n_predicate(A=<B,A,B,AA=<BB,AA,BB). +n_predicate(A>=B,A,B,AA>=BB,AA,BB). +n_predicate(A\=B,A,B,AA\==BB,AA,BB). + +% n_function(cputime,0,0,cputime,_,_). +n_function(A+B,A,B,AA+BB,AA,BB). +n_function(A-B,A,B,AA-BB,AA,BB). +n_function(A*B,A,B,AA*BB,AA,BB). +n_function(A/B,A,B,AA/BB,AA,BB). +n_function(A//B,A,B,AA//BB,AA,BB). +n_function(A^B,A,B,AA^BB,AA,BB). +n_function(A mod B,A,B,AA mod BB,AA,BB). +n_function(A/\B,A,B,AA/\BB,AA,BB). +n_function(A\/B,A,B,AA\/BB,AA,BB). +n_function(A<<B,A,B,AA<<BB,AA,BB). +n_function(A>>B,A,B,AA>>BB,AA,BB). + +/* evalator end */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tf.pl Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,119 @@ +/* + Copyright (C) 1988,2005, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@ie.u-ryukyu.ac.jp +*/ + +/* + + filter for partial compile + Sun Oct 13 18:35:19 JST 1985 + Sun Nov 17 00:03:22 JST 1985 :-static + Wed Mar 25 23:00:23 JST 1987 rewrite + $Header$ + */ + +pcom(File,Name) :- reset_macro,tokiopcompile(File,Name). +pcom(File,Name,Out) :- reset_macro,tokiopcompile(File,Out,Name), + (Out = user,!;reconsult(Out)). + +tokiopcompile(S,Names) :- + tokiopcompile(S, '#temp.tokio', Names), + reconsult('#temp.tokio'). % I suppose we are in debugging. + +tokiopcompile(S, O,Names) :- + cputime(Time), + init_tokiocomp, + tell(O), + tokiopcomp(S, [], _L, Names), told, + cputime(Time1),Time0 is Time1-Time, + c_error((write('END '), nl, + write(Time0), write(' sec.'),nl)). + +tokiopcomp([], L, L, _Names) :- !. +tokiopcomp([H|T], L0, L, Names) :- !, + tokiopcomp(H, L0, L1, Names), tokiopcomp(T, L1, L, Names). +tokiopcomp(F, L, L, Names) :- + seeing(O), nofileerrors, + tokiofile(F,F1),see(F1), !, + tokiopcomp1('$$$$',Names), seen, see(O), !. +tokiopcomp(F, _, _, _) :- + fileerrors, + c_error(( + display('Cannot open file: '), display(F), ttynl)),fail. + +tokiopcomp1(X,_Names) :- tokiocomp2(X),!. +tokiopcomp1(_,Names) :- + read_filter(Next,Names), + tokiopcomp1(Next,Names). +tokiopcomp1(_,_Names) :- + c_error((nl,write('read error'),nl)). + +read_filter(X,Name) :- repeat,read(X), + filter(X,Name). + +filter(end_of_file,_):-!. +filter((:-_X),_):-!. +filter((?-_X),_):-!. +filter(('$function'(_X)),_):-!. +filter(('$define'(_X)),_):-!. +filter((H:-_),Name) :- !,functor(H,HH,_), + (HH=Name ; member(HH,Name)),!. +filter(X,Name) :- functor(X,HH,_), + (HH=Name ; member(HH,Name)),!. + +cputime(T) :- 'r_cputime'(T). + +/* Macro Level Only Output */ +mcom(File) :- reset_macro,tokiomcompile(File). +mcom(File,Out) :- reset_macro,tokiomcompile(File,Out). + +tokiomcompile(S) :- + tokiomcompile(S, '#temp.tokio'). + +tokiomcompile(S, O) :- + cputime(Time), + init_tokiocomp, + tell(O), + tokiomcomp(S, [], _L), told, + cputime(Time1),Time0 is Time1-Time, + c_error((write('END '), nl, + write(Time0), write(' sec.'),nl)). + +tokiomcomp([], L, L) :- !. +tokiomcomp([H|T], L0, L) :- !, + tokiomcomp(H, L0, L1), tokiomcomp(T, L1, L). +tokiomcomp(F, L, L) :- + seeing(O), nofileerrors, + tokiofile(F,F1),see(F1), !, + tokiomcomp1('$$$$'), seen, see(O), !. +tokiomcomp(F, _, _) :- + fileerrors, + c_error(( + display('Cannot open file: '), display(F), ttynl)),fail. + +tokiomcomp1(X) :- tokiomcomp2(X),!. +tokiomcomp1(_) :- + read(Next),!,tokiomcomp1(Next). +tokiomcomp1(_) :- + c_error((nl,write('read error'),nl)). + +tokiomcomp2(end_of_file) :- !. +tokiomcomp2('$$$$') :- !,fail. +tokiomcomp2('$define'(Macro)) :- + read_macro(Macro),!,fail. +tokiomcomp2('$function'(Function)) :- + read_function(Function),!,fail. +tokiomcomp2((:- X)) :- + call(X), write_clause((:- X)),!,fail. +tokiomcomp2((?- X)) :- + call(X), write_clause((:- X)),!,fail. +% tokiomcomp2(Head) :- compiling_message(Head),fail. +tokiomcomp2(X) :- preprocess(X,X1),!, + numbervars(X1,0,_), + write_clause(X1),!,fail. + +/* end */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tg.pl Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,94 @@ +/* + Copyright (C) 1988,2005, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@ie.u-ryukyu.ac.jp +*/ + +/* + + Tokio to prolog compiler + One line compiler + Mon Jun 18 16:09:07 JST 1990 + $Header$ +*/ + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Main Loop +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +(tokio) :- repeat, init_static, nl, + display('tokio: '), ttyflush, + read(G), r_tokio_loop(G). +r_tokio_loop(end_of_file) :- !. +r_tokio_loop(G) :- r_goal(G), + !,fail. + +% Now main loop becomes one line compiler in tg.pl +% +% tokio(Goals) :- init_static, +% copy(Goals, G), 'r_tokio0'(G), +% Goals = G. + +tokio(Goals) :- init_static, + r_goal(Goals). + +% +% call '$g$g$g'(Varlists) +% +r_goal(Goal) :- + r_goals_retract, + get_variable(Goal,Vlist,[],_,0,Vcount), + functor(GGG, '$g$g$g', Vcount), + get_variable(GGG,Vlist,[],_,0,_),!, + preprocess((GGG :- Goal),Processed), + r_goal1(GGG,Processed). + +% success on compiler failuer +r_goal1(_GGG,Processed) :- + r_goals(Processed),!,r_goals_retract. +% Then execute goal +r_goal1(GGG,_Processed) :- + 'r_tokio0'(GGG),r_goals_retract. +% Real Fail +r_goal1(_GGG,_Processed) :- r_goals_retract,fail. + +r_goals((X,_Y)) :- r_goals(X). % fail and fall into next line +r_goals((_X,Y)) :- !,r_goals(Y). +r_goals(X) :- + recorda('r_assert',on,Ref), + c_clause(X, C), % clitical on asserting clause + erase(Ref), + assert_clause(C),!, fail. % to reduce stack +r_goals(X) :- + c_error((nl,write('compiler error on '),write(X),nl)). + +r_goals_retract :- recorded('r_run',XXX,Ref),erase(Ref),retract(XXX),fail. +r_goals_retract. + +c_melt('$VAR'(N), Var, Vs) :- !, + c_nlist(N,Var,Vs). +c_melt([X|TX], [XX|TXX], Vs) :- + c_melt(X,XX,Vs),c_melt(TX,TXX,Vs). +c_melt('$t'(X,TX), '$t'(XX,TXX), Vs) :- + c_melt(X,XX,Vs),c_melt(TX,TXX,Vs). +c_melt(X, XX, Vs) :- + functor(X, F, A), + functor(XX, F, A), + c_melt_args(0, A, X, XX, Vs),!. + +c_melt_args(N, N, _X, _, _) :- !. +c_melt_args(K, N, X, XX, Vs) :- + K1 is K+1, + arg(K1, X, XK), + arg(K1, XX,XXK), + c_melt(XK, XXK, Vs), + c_melt_args(K1, N, X, XX, Vs). + +c_nlist(0,V,[V|_]) :-!. +c_nlist(N,V,[_|T]) :- + N1 is N-1, + c_nlist(N1,V,T). + +/* */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/th.pl Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,192 @@ +/* + Copyright (C) 1988,2005, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@ie.u-ryukyu.ac.jp +*/ + +%% Tokio to Prolog compiler +%% +%% variable classification and head compile +%% +%% +%% Sat Jan 11 11:31:10 JST 1986 +%% $Header$ + +c_equate(EE,EE) :-!. +c_equate('$CNT'(EE),EE) :-!. +c_equate(EE,'$CNT'(EE)) :-!. + +%% variable separation for temporality + +c_seperate(Var,Now,Next) :- Var = '$TMP'(_,Now,Next),!. +c_seperate(Var,Var,'$CNT'(Var1)) :- Var = '$CNT'(Var1),!. +c_seperate(Var,Now,Next) :- Var = '$NOW'(Var1,Now),!, + c_seperate(Var1,Now,Next). +c_seperate(Var,Now,Next) :- Var = '$NXT'(Var1,Next),!, + c_seperate(Var1,Now,Next). +c_seperate(Atomic,Atomic,Atomic) :- atomic(Atomic),!. +c_seperate(Op, Op1, Op2) :- + functor(Op, H, N),functor(Op1, H, N),functor(Op2, H, N), + c_seperate_arg(0, N, Op, Op1, Op2). + +c_seperate_arg(N, N, _, _, _) :- !. +c_seperate_arg(M, N, Op, Op1, Op2) :- + M1 is M+1,arg(M1, Op, A), arg(M1, Op1, A1),arg(M1, Op2, A2), + c_seperate(A,A1,A2), + c_seperate_arg(M1, N, Op, Op1, Op2). + + +c_seperate_now(Var,Now) :- Var = '$NOW'(_,Now),!. +c_seperate_now(Var,Var) :- Var = '$CNT'(_Var1),!. +c_seperate_now(Var,Now) :- Var = '$TMP'(_,Now,_Next),!. +c_seperate_now(Var,Now) :- Var = '$NXT'(Var1,Next),!, + c_seperate(Var1,Now,Next). +c_seperate_now(Atomic,Atomic) :- atomic(Atomic),!. +c_seperate_now(Op, Op1) :- + functor(Op, H, N),functor(Op1, H, N), + c_seperate_now_arg(0, N, Op, Op1). + +c_seperate_now_arg(N, N, _, _) :- !. +c_seperate_now_arg(M, N, Op, Op1) :- + M1 is M+1,arg(M1, Op, A), arg(M1, Op1, A1), + c_seperate_now(A,A1), + c_seperate_now_arg(M1, N, Op, Op1). + +c_seperate_next(Var,Next) :- Var = '$NXT'(_,Next),!. +c_seperate_next(Var,'$CNT'(Var1)) :- Var = '$CNT'(Var1),!. +c_seperate_next(Var,Next) :- Var = '$TMP'(_,_Now,Next),!. +c_seperate_next(Var,Next) :- Var = '$NOW'(Var1,Now),!, + c_seperate(Var1,Now,Next). +c_seperate_next(Atomic,Atomic) :- atomic(Atomic),!. +c_seperate_next(Op, Op1) :- + functor(Op, H, N),functor(Op1, H, N), + c_seperate_next_arg(0, N, Op, Op1). + +c_seperate_next_arg(N, N, _, _) :- !. +c_seperate_next_arg(M, N, Op, Op1) :- + M1 is M+1,arg(M1, Op, A), arg(M1, Op1, A1), + c_seperate_next(A,A1), + c_seperate_next_arg(M1, N, Op, Op1). + +% c_unify(Original_argument, Generated_argument, Unification_code, ItsBase, +% Level). +% Tokio has same problem as ghc. f(X,X) must be comipled into +% f(X, Y) :- unify(X, Y). +c_unify(X, Y, Q, Q, _) :- + var(X), !, X= '$REF'(Y). % mark X as "used!" +c_unify('$REF'(X), Y, (unifyAll(X, Y),Q), Q, _) :- !. +% c_unify('$CNT'(X), X, Q, Q, _) :- !. +c_unify('$CNT'(X), Y, (uconst(Y,X),Q), Q, _) :- !. +c_unify('$TMP'(Org,Now,Next), Org1, Q1, Q, L) :- !, + c_nownext(Org, Org1, Now, Next, Q1, Q, L). +c_unify('$NOW'(Org,Now), Org1, Q1, Q, L) :- !, + c_now(Org, Org1, Now, Q1, Q, L). +c_unify('$NXT'(Org,Next), Org1, Q1, Q, L) :- !, + c_next(Org, Org1, Next, Q1, Q, L). +c_unify([], X, (unil(X),Q), Q, _) :- !. +c_unify(A, X, (uatom(X, A),Q), Q, _) :- atomic(A), !. +c_unify(X, Y, (unifyAll(X, Y),Q), Q, 0) :- !. % Stop expansion at given level +c_unify([H|T], X, (ulist(X, H0, T0), Q1), Q, L) :- !, + L1 is L-1, c_unify(H, H0, Q1, Q2, L1), + c_unify(T, T0, Q2, Q, L1). +c_unify(S, X, Q1, Q, L) :- % compile unification + functor(S, F, A), A < 4, !, functor(S0, F, A), + make_skel_name(F, Us, A), + c_skel(Us, S0, X, F, A, Q1, Q2, L), + L1 is L-1, + c_unify_args(0, A, S, S0, Q2, Q, L1). +c_unify(S, X, (uskel(X, S0), Q1), Q, L) :- !, + L1 is L-1, functor(S, F, A), functor(S0, F, A), + c_unify_args(0, A, S, S0, Q1, Q, L1). + +c_unify_args(N, N, _, _, Q, Q, _) :- !. +c_unify_args(K, N, S, X, Q1, Q, L) :- + K1 is K+1, arg(K1, S, SK), arg(K1, X, XK), + c_unify(SK, XK, Q1, Q2, L), + c_unify_args(K1, N, S, X, Q2, Q, L). + +% compile skelton unifications +% +% f(_,_,_) ---> 'r_f3' + +make_skel_name(F, U, A) :- + name(A, AL), name(F, FL), +% concatenate(["'r_",FL,AL,"'"], UL), + concatenate(["r_",FL,AL], UL), %%%%%%%%%%%%%%%%% + name(U, UL). + +concatenate([],[]). +concatenate([H|T],X) :- concatenate(T,X1),append(H,X1,X). + +c_skel(U, S, X, _F, A, (Uc,Q), Q, _L) :- recorded('$uskel',U,_),!, + A1 is A+1, functor(Uc, U, A1), + arg(1, Uc, X), + c_skel_copy_arg(0, 1, A1, S, Uc). +c_skel(U, S, X, F, A, (Uc,Q), Q, _L) :- recordz('$uskel',U,_),!, + A1 is A+1, functor(Uc, U, A1), + arg(1, Uc, X), + c_skel_copy_arg(0, 1, A1, S, Uc), + functor(U1, U, A1), functor(Us, F, A), + c_skel_copy_arg(0, 1, A1, Us, U1), + arg(1, U1, Us), + write_clause((U1 :- !)), + functor(U2, U, A1), functor(Us2, F, A), functor(Un, U, A1), + c_skel_copy_arg_tmp(0, 1, A1, Us2, U2, Un), + arg(1, U2, '$t'(Us2, N)), + arg(1, Un, N), + write_clause((U2 :- Un)). + + +c_skel_copy_arg(_L, N, N, _A, _B) :- !. +c_skel_copy_arg(L, N, M, A, B) :- + L1 is L+1, N1 is N+1, + arg(L1, A, Arg), arg(N1, B, Arg), + c_skel_copy_arg(L1, N1, M, A, B). + +c_skel_copy_arg_tmp(_L, N, N, _A, _B, _C) :- !. +c_skel_copy_arg_tmp(L, N, M, A, B, C) :- + L1 is L+1, N1 is N+1, + arg(L1, A, Now), arg(N1, B, '$t'(Now,Next)), arg(N1, C, Next), + c_skel_copy_arg_tmp(L1, N1, M, A, B, C). +% optimiser check variables +% now only referenced unifyNow +% next only referenced unifyNext +% both referenced unifyNowNext +% +% if already referenced then product unifyAll code +% +% c_now/next(Org, Modyfied, Now/Next, Q1, Q), + +c_nownext(Org, Org1, Now, Next, (unifyNowNext(Org1,Now,Next1),Q1), Q, L) :- + var(Org),!,Org = '$REF'(Org1), + c_unify(Next,Next1, Q1, Q, L). +c_nownext('$REF'(O2), O, _Now, _Next, (unifyAll(O2,O),Q), Q, _L). + +c_now(Var, Var1, Now, (unifyNow(Var1,Now), Q), Q, _L) :- var(Var),!, + Var = '$REF'(Var1). +c_now('$REF'(O2), O, _Now, (unifyAll(O2,O),Q), Q, _L) :- !. +c_now('$TMP'(O,Now,Next), O1, Now, Q, Q1, L) :- + c_nownext(O, O1, Now, Next, Q, Q1, L). + +c_next(Var, Var, Next, (unifyNext(Var1,Next1), Q), Q1, L) :- var(Var),!, + Var = '$REF'(Var1), + c_unify(Next,Next1, Q, Q1, L). +c_next('$REF'(O2), O, _Next, (unifyAll(O2,O),Q), Q, _L) :- !. +c_next('$TMP'(O,Now,Next), O1, Next, Q, Q1, L) :- + c_nownext(O, O1, Now, Next, Q, Q1, L). + + +% c_opt(Before, After, Optimized_or_not) +c_opt(X,X,0) :- var(X),!. +c_opt((true, X), Y, 1) :- !, c_opt(X, Y, _). +c_opt((X0, true), X, 1) :- !, c_opt(X0, X, _). +c_opt((X0, Y0), R, C) :- !, + c_opt(X0, X1, CX), c_opt(Y0, Y1, CY), C0 is CX\/CY, + ( C0 =:= 0, !, C is C0, R = (X1, Y1); + c_opt((X1, Y1), R, C) ). % X1/Y1 may be optimized to 'true' +c_opt(X, X, 0). + +/* end of compiler */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tm.pl Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,92 @@ +/* + Copyright (C) 1988,2005, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@ie.u-ryukyu.ac.jp +*/ + +% +% tokio standard macro definition +% +% Sat Sep 7 16:45:15 JST 1985 +% $Header$ + +'$define' ( *A :- *A = 1 ). +'$define' ( not(*A) :- *A = 0 ). + +% '$define' ( (A | B) :- A,!,B ). ! = | in some prolog + +'$define' (A ; B :- H) +'$clause' (H :- A) +'$clause' (H :- B). + +'$define' (if A then B else C :- H) +'$clause' (H :- A,!,B) +'$clause' (H :- C). + +'$define' (if A then B :- H) +'$clause' (H :- A,!,B) +'$clause' (H). + +'$define' (not(A) :- H) +'$clause' (H :- A,!,fail) +'$clause' (H). + +'$define' (while A do B :- H) +'$clause' (H :- A,!,( B && H)) +'$clause' (H :- empty). + +'$define' (A && B) :- A,@true & B. % strong chop + +'$define' (fin(A) :- H) +'$clause' (H :- ifEmpty(A), next(H)). + +'$define' (keep(A) :- H) +'$clause' (H :- ifNotEmpty(A), next(H)). + +'$define' (more :- @true). % better than notEmpty? + +'$define' (#P :- Q) % |t| +'$clause' (Q :- P, next(Q)). + +'$define' ([](P) :- Q) % |t| +'$clause' (Q :- P, next(Q)). + +'$define' ('||'P :- Q) % Sun Oct 13 16:48:00 JST 1985 +'$clause' (Q :- (P & true), next(Q)). + +'$define' ( {P} :- P ). + +'$define' ( A gets B :- keep(@A = B) ). + +'$define' ( stable(A) :- A gets A ). + +'$define' ( <>P :- true && P). + +'$define' ( halt(P) :- # (if P then empty else @true)). + +'$define' ( '$CNT'(A) <-- B :- '$CNT'(A) = B ). %% tricky! + +% many kind of temporal assignments + +'$define' ( A <- B :- C <-- B, fin( A = C) ). +'$define' ( A <= B :- C <-- B, fin( A := C) ). +'$define' ( [] <<- B :- true). +'$define' ( [H|T] <<- B :- C <-- B, fin( H = C), T <<- C). +'$define' ( [] <== B :- true). +'$define' ( [H|T] <== B :- C=B,H <== B,T <== C). +% next two macros are processed in tp.pl +% '$define' ( A <= B :- C <-- B, fin( A := C) ). +% '$define' ( *A <= B :- D <-- A, C <-- B, fin( *D := C) ). + +'$define' ( skip :- @empty ). + +'$define' ( beg(X) :- empty,X & true ). + +'$define' (call(H) :- r_tokio_call(H)). + + %% system macro end + +'$define' ('r_initr_').
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/to.pl Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,238 @@ +/* + Copyright (C) 1988,2005, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@ie.u-ryukyu.ac.jp +*/ + +/* + + Tokio compiler to prolog + Thu Aug 15 12:17:04 JST 1985 + Fri Jan 10 16:11:31 JST 1986 + Fri Sep 5 09:51:36 JST 1986 for 1.2a + Thu Mar 26 16:19:10 JST 1987 + Wed Oct 14 13:35:54 JST 1987 full time F + Fri Oct 16 11:28:26 JST 1987 Sicstus + $Header$ + compiler main routine +*/ + +com(X) :- reset_macro,tokiocompile(X). +com(X,Y) :- reset_macro,tokiocompile(X, Y), + (Y = user,!;reconsult(Y)). + +tokiocompile(S) :- + tokiocompile(S, '#temp.tokio'), +% reconsult('#temp.tokio'). + compile0('#temp.tokio'). + +tokiocompile(S, O) :- + cputime(Time), + init_tokiocomp, + tell(O), + tokiocomp(S, [], _L), told, + cputime(Time1),Time0 is Time1-Time, + c_error((write('END '), nl, write(Time0), write(' sec.'),nl)). + +init_tokiocomp :- recorded('$uskel', _X, R), erase(R), fail. +init_tokiocomp :- recorded('$mnum', _X, R), erase(R), fail. +init_tokiocomp. + +tokiocomp([], L, L) :- !. +tokiocomp([H|T], L0, L) :- !, tokiocomp(H, L0, L1), tokiocomp(T, L1, L). +tokiocomp(F, _L0, _L) :- + seeing(O), nofileerrors, tokiofile(F,F1),see(F1), !, + tokiocomp1('$$$$'), seen, see(O), !. +tokiocomp(F, _, _) :- + fileerrors, + c_error((write('Cannot open file: '), write(F), nl)), !, fail. + +tokiofile(F,F). +tokiofile(F,F1) :- name(F,FL),concatenate([FL,".tokio"],NewL),name(F1,NewL). +tokiofile(F,F1) :- name(F,FL),concatenate([FL,".t"],NewL),name(F1,NewL). + + +/* tokiocomp1 + read loop (fail loop) +*/ + +tokiocomp1(X) :- tokiocomp2(X). +tokiocomp1(_) :- + read(Next), !, tokiocomp1(Next). +tokiocomp1(_) :- c_error((nl,write('read error'),nl)). + +/* tokocomp2 + compiler directive + this predicate never success except file end. +*/ + +tokiocomp2(end_of_file) :- !. +tokiocomp2('$$$$') :- !,fail. +tokiocomp2('$define'(Macro)) :- + read_macro(Macro),!,fail. +tokiocomp2('$function'(Function)) :- + read_function(Function),!,fail. +tokiocomp2((:- X)) :- + call(X), write_clause((:- X)),!,fail. +tokiocomp2((?- X)) :- + call(X), write_clause((:- X)),!,fail. +tokiocomp2(Head) :- compiling_message(Head),fail. +tokiocomp2(X) :- preprocess(X,X1),!,tokiocomp3(X1). + +compiling_message((Head :- _Body)) :- !,compiling_message(Head). +compiling_message(Head) :- + (systemp(Head);Head = (_,_);Head = [_|_];functor(Head,'{}',_)),!, + functor(Head,H,A), + c_error(( + write('Compiling System Predicate: '), + write(H/A),nl)),!. +compiling_message(Head) :- + functor(Head,H,A), + c_error(( + write('Compiling: '), + write(H/A),nl)),!,!. + +/* tokiocomp3 + if end_of_file then success otherwise fail +*/ + +tokiocomp3((X,_Y)) :- tokiocomp3(X),fail. % fail and fall into next line +tokiocomp3((_X,Y)) :- !,tokiocomp3(Y). +tokiocomp3(X) :- + c_clause(X, C), write_clause(C),!, fail. % to reduce stack +tokiocomp3(X) :- + c_error((nl,write('compiler error on '),write(X),nl)),fail. + +% preprocess(X,X). % no development + +display_fa(F/A) :- display(F), display('/'), display(A), display(','). + +writel([]) :- !. +writel([X|L]) :- writel(L), write(X), write(', '). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% +% varialble type +% +% '$REF' full referenced variable +% '$TMP' both now and next are referenced +% '$NOW','$NXT' either now or next is referenced +% '$CNT' this variable is constnat in time transition +% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +variable(X) :- var(X), !. +variable('$REF'(_)) :- !. +variable('$CNT'(_)) :- !. +variable('$NOW'(_,_)) :- !. +variable('$NXT'(_,_)) :- !. +variable('$TMP'(_,_,_)). + + +% c_post(Vname, Vname, V0, V) :- +% var(Vname),!, V is V0+1,name(V0,Lv),name(Vname,[95|Lv]). %%% _001 +c_post(Vname, Vname, V0, V) :- + var(Vname),!, V is V0+1,Vname = '$VAR'(V0). %%% _001 +c_post('$VAR'(X), '$VAR'(X), V, V) :- !. +c_post('$CNT'(X), XX, V0, V) :- !, c_post(X, XX, V0, V). +c_post('$REF'(X), XX, V0, V) :- !, c_post(X, XX, V0, V). +c_post('$TMP'(X,Now,Nxt), XX, V0, V) :- !, c_post_tvar(X,Now,Nxt, XX, V0, V). +c_post('$NOW'(X,Now), XX, V0, V) :- !, c_post_tvar(X,Now,_Nxt, XX, V0, V). +c_post('$NXT'(X,Nxt), XX, V0, V) :- !, c_post_tvar(X,_Now,Nxt, XX, V0, V). +c_post(Atomic,Qatomic,V,V) :- atomic(Atomic),!, + c_post_atomic(Atomic,Qatomic). +c_post([A|B],[AA|BB], V0, V) :- !, + c_post(A,AA,V0,V1),c_post(B,BB,V1,V). +c_post((A,B),(AA,BB), V0, V) :- !, + c_post(A,AA,V0,V1),c_post(B,BB,V1,V). +% Special Hack.... ( nonvar for C-Prolog) +c_post('r_eq'(A,B,Q1,Q2), B1=A1, V0, V) :- nonvar(A),nonvar(B), + functor(A,'$CNT',_),functor(B,'$CNT',_),!, + c_post(A,A1,V0,V1),c_post(B,B1,V1,V2), + c_post(Q1,Q11,V2,V3),c_post(Q2,Q12,V3,V),Q11=Q12. +c_post('r_eq'(A,B,Q1,Q2), 'r_eqn'(B1,A1,Q11,Q12), V0, V) :- nonvar(A), + functor(A,'$CNT',_),!, + c_post(A,A1,V0,V1),c_post(B,B1,V1,V2), + c_post(Q1,Q11,V2,V3),c_post(Q2,Q12,V3,V). +c_post('r_eq'(A,B,Q1,Q2), 'r_eqn'(A1,B1,Q11,Q12), V0, V) :- nonvar(B), + functor(B,'$CNT',_),!, + c_post(A,A1,V0,V1),c_post(B,B1,V1,V2), + c_post(Q1,Q11,V2,V3),c_post(Q2,Q12,V3,V). +c_post('r_eq'(A,B,Q1,Q2), 'r_eq'(A1,B1,Q11,Q12), V0, V) :- !, + c_post(A,A1,V0,V1),c_post(B,B1,V1,V2), + c_post(Q1,Q11,V2,V3),c_post(Q2,Q12,V3,V). +c_post(X, XX, V0, V) :- + functor(X, F, A), c_post_atomic(F,F1),!, functor(XX, F1, A), + c_post_args(0, A, X, XX, V0, V). + +c_post_atomic(X,X). +% c_post_atomic([],[]) :- !. +% c_post_atomic(Number,Number) :- number(Number),!. +% c_post_atomic(Atomic,Qatomic):- +% name(Atomic,La),La=[H|_],[H]\="'",[H]\="_",!, +% concatenate(["'",La,"'"],Nla),name(Qatomic,Nla). +% c_post_atomic(Atomic,Atomic). + +c_post_args(N, N, _, _, V, V) :- !. +c_post_args(K, N, X, XX, V0, V) :- + K1 is K+1, arg(K1, X, XK), c_post(XK, XXK, V0, V1), arg(K1, XX, XXK), + c_post_args(K1, N, X, XX, V1, V). + +c_post_tvar(X, Now, Nxt, '$t'(Now1,Nxt1), V0, V) :- var(X),!, + X='$TMP'(_,Now,Nxt), + c_post(Now, Now1, V0, V1), + c_post(Nxt, Nxt1, V1, V). +c_post_tvar('$REF'(X), _Now, _Nxt, XX, V0, V) :- !, + c_post(X, XX, V0, V). +c_post_tvar('$CNT'(X), _Now, _Nxt, XX, V0, V) :- !, + c_post(X, XX, V0, V). +c_post_tvar('$TMP'(X,Now,Nxt), Now, Nxt, XX, V0, V) :- !, + c_post_tvar(X, Now, Nxt, XX, V0, V). + +write_clause(X) :- recorded('r_assert',_,_),assert_clause0(X). +write_clause(_) :- recorded('r_assert',_,_). +write_clause(X) :- write_clause0(X). +write_clause(_). + +write_clause0((X:-true)) :- + c_post(X, XX, 0, _), + write_term(XX,[numbervars(true),quoted(true)]), + % writeq(XX), + put("."), nl,!,fail. %%% writeq --> write +write_clause0(X) :- + c_post(X, XX, 0, _), writeq1(XX), put("."), nl,!,fail. %%% writeq --> write + +% a little pretty print +writeq1((A,B)) :- !,writeq1(A),put("."), nl, + writeq1(B). +writeq1((H:-B)) :- !, + % writeq(H), + write_term(H,[numbervars(true),quoted(true)]), + write((:-)), + writeq2(B). +writeq1(X) :- + % writeq(X). + write_term(X,[numbervars(true),quoted(true)]). +writeq2((A,B)) :- !,nl,tab(4), + % writeq(A), + write_term(A,[numbervars(true),quoted(true)]), + put(","),writeq2(B). +writeq2(X) :- nl,tab(4), + write_term(X,[numbervars(true),quoted(true)]). + % writeq(X). + + +assert_clause(X) :- assert_clause0(X). +assert_clause(_). + +%assert_clause0((X:-true)) :- +% c_post(X, XX, 0, _), c_melt(XX,XXX,_), +% recorda('r_run',XXX,Ref),assertz(XXX), !,fail. +assert_clause0(X) :- + c_post(X, XX, 0, _), c_melt(XX,((XXX:-Y)),_), + recorda('r_run',((XXX:-_)),_Ref),assertz((XXX:-Y)), !,fail. + +/* end */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tokio.pl Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,54 @@ +/* + Copyright (C) 1988,2005, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@ie.u-ryukyu.ac.jp +*/ +:-module(tokio,[ + com/1, % compile & compile program. + com/2, % compile & counsult & save file. + pcom/2, % compile specified predicates. + pcom/3, % compile specified predicates. + mcom/1, % preprocess + mcom/2, % preprocess & outputfile. + static/1, % static variable declaration + restart/1, % run tokio save file. + tokiodebug/0, % All computation will be traced. + tokionodebug/0, % Debug mode is switched off. + tokiodebugging/0, % Display some informations about tracing. + notimebacktrack/0, % no time backtrack.. + timebacktrack/0, % time backtrack.. + (tokio)/0, % start tokio top-level. + (tokio)/1, % run tokio program. + tokio_help/0, % help + user_help/0, % help + reset_macro/0 % Reset Macro Definition. com predicates also reset Macros. +]). + +:- ['ts'], + % ensure_loaded('ts'), + ensure_loaded('to'), + ensure_loaded('tc'), + ensure_loaded('th'), + ensure_loaded('td'), + ensure_loaded('te'), + ensure_loaded('tg'), + ensure_loaded('tr'), + ensure_loaded('tu'), + ensure_loaded('tf'), + ensure_loaded('xf'), + ensure_loaded('cp'), + ensure_loaded('tp'). + +% :-prolog_flag(single_var_warnings, _, off), +% prolog_flag(compiling,_,compactcode). + +:-com('tm.pl',user). +:-[ts]. + +% :-module(user),['ts']. +% :-module(tokio),['ts'],module(user). + +% end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tokio_swi.pl Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,2 @@ +:-[ts]. +:-use_module(tokio).
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tp.pl Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,282 @@ +/* + Copyright (C) 1988,2005, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@ie.u-ryukyu.ac.jp +*/ + +/* + Tokio preprosessor + Thu Aug 22 15:52:08 JST 1985 + Wed Sep 4 16:07:39 JST 1985 + $Header$ + + use 'r_prepr' record to generate new predicate + +*/ + +read_macro( (A '$clause' B) ) :- !,recordz('r_prepr',(A,B),_). +read_macro( A ) :- recordz('r_prepr',(A,true),_). + +read_function( (A '$clause' B ) ) :- !,recordz('r_func',(A,B),_). +read_function( A ) :- recordz('r_func',(A,true),_). + +reset_macro :- recorda('r_tmp',0,_),fail. +reset_macro :- recorded('r_prepr', X, R), check_init(X), + erase(R), fail. +reset_macro :- recorded('r_func', X, R), check_init(X), + erase(R), fail. +reset_macro. + +check_init(('r_initr_',true)) :- !,recorded('r_tmp',_,Ref),erase(Ref),fail. +check_init(_) :- recorded('r_tmp',_,_),!,fail. +check_init(_). + + +preprocess((X,Y),(XX,YY)) :- !,preprocess(X,XX),preprocess(Y,YY). +% preprosess(( :- X),( :- X) ) :- !. +preprocess((H :- B), OUT) :- !, + functor(H,HH,NN), + (recorded('$mnum',(HH,NN,N),R),erase(R) ; N = 0),!, + functor(H1,HH,NN), + develop_args(0, NN, N, N1, H, H, H1, OUT1, (H1 :- B0),B0,BB), + develop(B, BB, H, N1, N2, OUT, OUT1), + recordz('$mnum',(HH,NN,N2),_). +preprocess(H,H1) :- preprocess((H :- true),H1). + +/* + develop(Original, Head, Base, NextBase, Qhead, Qtail). + +*/ + + +develop(A,'tokio_call'(A),_H,N,N,Q,Q) :- var(A),!. +develop((A,B),(AA,BB),H,N,N1,Q,Q1) :- !, + develop(A,AA,H,N,N2,Q,Q2), + develop(B,BB,H,N2,N1,Q2,Q1). +develop(@(A),@(AA),H,N,N1,Q,Q1) :- !, + develop(A,AA,H,N,N1,Q,Q1). +develop(next(A),next(AA),H,N,N1,Q,Q1) :- !, + develop(A,AA,H,N,N1,Q,Q1). +develop(ifEmpty(A),ifEmpty(AA),H,N,N1,Q,Q1) :- !, + develop(A,AA,H,N,N1,Q,Q1). +develop(ifNotEmpty(A),ifNotEmpty(AA),H,N,N1,Q,Q1) :- !, + develop(A,AA,H,N,N1,Q,Q1). +develop((A & B),'$chop'(AA,BBB),H,N,N1,Q3,Q1) :- !, + copyv(A,Acopy,V,Vcopy),( + V = [], + develop(A,AA,H,N,N2,Q,Q2),! + ; + length(V,VN),VN>8,!, + develop(( 'r_eq'(V,Vcopy),Acopy ) ,AA,H,N,N2,Q,Q2) + ; + V=[V1],Vcopy=[Vc1],!, + develop(( 'r_eq'(V1,Vc1),Acopy ) ,AA,H,N,N2,Q,Q2) + ; + V=[V1,V2],Vcopy=[Vc1,Vc2],!, + develop(( 'r_eq'(V1,Vc1),'r_eq'(V2,Vc2),Acopy ) ,AA,H,N,N2,Q,Q2) + ; + V=[V1,V2,V3],Vcopy=[Vc1,Vc2,Vc3],!, + develop(( 'r_eq'(V1,Vc1),'r_eq'(V2,Vc2),'r_eq'(V3,Vc3), + Acopy ) ,AA,H,N,N2,Q,Q2) + ; + develop(( #(V=Vcopy),Acopy ) ,AA,H,N,N2,Q,Q2)),!, + develop(B,BB,H,N2,N3,Q2,Q1),!, + ( var(BB), !, Q3 = Q, BBB = B, N1 = N3 + ; get_variable(BB,Vlist,[],_,0,_Vcount), + new_head(H,BBB,N3,Vlist), % necessary to reduce variable copy.. + N1 is N3+1, + Q3 = ((BBB :- BB),Q)),!. +% single time funcitons +develop(A:=B, true, _Root, M, M, Q, Q) :- + (A \= *('$CNT'(_)),A \= *(_); var(A)) ,!, + c_error((write('assign to non static:'),write(A:=B),nl)). +% <= use current value for addressing +develop(A<==B, true, _Root, M, M, Q, Q) :- + (A \= *_,A \= [_|_]; var(A)) ,!, + c_error((write('assign to non static:'),write(A<==B),nl)). +develop(*A<==B, C, Root, M, M1, Q, Q1) :- !, + d_function(A, AA, M, M2, Root, Q, Q2, C, C2), + d_function(B, BB, M2,M1, Root, Q2,Q1, C2, + ('$CNT'(YY)=AA,'$CNT'(VV)=BB, 'r_assign'('$CNT'(YY),'$CNT'(VV)))). +% develop(*A<=B, C, Root, M, M1, Q, Q1) :- atomic(A),!, +% d_function(B, BB, M,M1, Root, Q,Q1, C, 'r_assign'(A,'$CNT'(BB))). +develop(*('$CNT'(A)):=B, C, Root, M, M1, Q, Q1) :- !, + d_function(A, AA, M, M2, Root, Q, Q2, C2, *('$CNT'(AA)):=BB),!, + d_function(B, BB, M2,M1, Root, Q2,Q1, C, C2). +develop(*A:=B, C, Root, M, M1, Q, Q1) :- !, + d_function(A, AA, M, M2, Root, Q, Q2, C2, *AA:=BB),!, + d_function(B, BB, M2,M1, Root, Q2,Q1, C, C2). +develop(A=B, C, Root, M, M1, Q, Q1) :- !, + d_function(A, AA, M, M2, Root, Q, Q2, C2, AA=BB),!, + d_function(B, BB, M2,M1, Root, Q2,Q1, C, C2). +develop(A<B, C, Root, M, M1, Q, Q1) :- !, + d_function(A, AA, M, M2, Root, Q, Q2, C2, AA<BB),!, + d_function(B, BB, M2,M1, Root, Q2,Q1, C, C2). +develop(A>B, C, Root, M, M1, Q, Q1) :- !, + d_function(A, AA, M, M2, Root, Q, Q2, C2, AA>BB),!, + d_function(B, BB, M2,M1, Root, Q2,Q1, C, C2). +% full time functions +develop(A,AAA,Root,N,N1,Q,Q1) :- + recorded('r_prepr', ((A :- AA),Body),_),!, + develop_macro(Body,A,AA,AAA,Root,N,N1,Q,Q1). +develop(A, C, Root, M, M1, Q, Q1) :- functor(A,H,N),functor(AA,H,N), + develop_args(0, N, M, M1, Root, A, AA, Q, Q1, C, AA). + +develop_args(N , N, M, M , _Root, _A, _AA, Q, Q, C, C) :- !. +develop_args(N1, N, M, M1, Root, A, AA, Q, Q1, C, C1) :- + N2 is N1+1, arg(N2,A,B), arg(N2,AA,BB), + d_function(B, BB, M, M2, Root, Q, Q2, C, C2),!, %%% check full time here? + develop_args(N2, N, M2, M1, Root, A, AA, Q2, Q1, C2, C1). + +develop_macro(true,_A,AA,AAA,Root,N,N1,Q,Q1) :- !, + develop(AA,AAA,Root,N,N1,Q,Q1). +develop_macro(Body,A,AA,AAA,Root,N,N1,Q,Q2) :- + get_variable(A,Vlist,[],_,0,_Vcount), + macro(Body, Root, N, N2, Vlist, Q, Q1), + develop(AA,AAA,Root,N2,N1,Q1,Q2),!. + +/* make original head + + Root head + New head + uniq Id + variable list +*/ + +new_head(Root,New,No,Vlist) :- + new_head(Root,New,No,Vlist,_,T,T). + +new_head(Root,New,No,Vlist,large,T,T1) :- + length(Vlist,N),N>10,!, + [A,B,C|T] = Vlist, + functor(Root,HH,Arity), + name(HH,HL),name(No,NL),name(Arity,NAL), + concatenate(["r_",NL,HL,NAL],NewL), + name(NewH,NewL), + New =.. [NewH,A,B,C,T1]. +new_head(Root,New,No,Vlist,small,_,_) :- functor(Root,HH,A), + name(HH,HL),name(No,NL),name(A,NAL), + concatenate(["r_",NL,HL,NAL],NewL), + name(NewH,NewL), + New =.. [NewH|Vlist]. + +/* make variable list */ + +get_variable(H,V,V1,VL,N,N1) :- + var(H),!, + not_vmember(H,V,V1,VL,N,N1). +get_variable(H,V,V1,VL,N,N1) :- + H = '$CNT'(_),!, % inherit constant + not_vmember(H,V,V1,VL,N,N1). +get_variable(F,V,V1,VL,N,N1) :- + functor(F,_,A), + get_variable_arg(0,A,F,V, V1, VL, N,N1). + +get_variable_arg(A,A,_F,V,V,_VL, N,N) :- !. +get_variable_arg(A,A1,F,V,V1,VL,N,N1) :- + A2 is A+1, arg(A2, F, Arg), + get_variable(Arg,V,V2,VL,N, N2), + get_variable_arg(A2,A1,F,V2,V1,VL,N2,N1). + +not_vmember(H,[H|T],T,VL,N,N1) :- var(VL),!,VL = [H|_],N1 is N+1. +not_vmember(H, T,T,[H1|_VL],N,N) :- H == H1,!. +not_vmember(H, T,T,[H1|_VL],N,N) :- H == '$CNT'(H1),!. +not_vmember(H, T, T1,[_|VL], N, N1) :- not_vmember(H,T,T1,VL,N,N1). + +/* copyv + make copy with new variables + and its old variable list and new variable list + + copyv(Old, New, OldVariable, NewVariable) + + a little dum algorithm +*/ + +copyv(O,N,OV,NV) :- + get_variable(O,OV,[],_,0,_Vcount),!, + copy((O,OV),(N,NV)). + +/* + macro + +*/ + + +macro((A '$clause' B), Root, N, N1, Vs, Q, Q2) :- !, + single_macro(A, Root, N, N2, Vs, Q, Q1), + macro(B, Root, N2, N1, Vs, Q1, Q2). +macro(A, Root, N, N1, Vs, Q, Q1) :- + single_macro(A, Root, N, N1, Vs, Q, Q1). + + +single_macro(A , Root, N, N1, Vlist, (A,Q), Q) :- var(A),!, + new_head(Root,A,N,Vlist), + N1 is N+1. +single_macro((A :- B), Root, N, N2, Vlist, Q, Q2) :- !, + head_optimize(BB,A,Root,Vlist,N,N1,Q,Q1),!, + develop(B,BB,Root,N1,N2,Q1,Q2),!. +single_macro(A, _Root, N, N, _Vlist, (A,Q), Q). + +head_optimize(BB,A,Root,Vlist,N,N2,((A:-BB),Q),Q) :- + var(A), + !, + new_head(Root,A,N,Vlist), + N2 is N+1. +head_optimize(BB,A,_Root,_Vlist,N,N,((A:-BB),Q),Q). + +/* + functions + should be seprated full time function and + now only function +*/ + +d_function(A,AA,N,N,_Root,Q,Q,C,C) :- var(A),!, A = AA. % not interval constant +d_function(A,R1,N,N1,Root,Q,Q1,(AAA,C1),C) :- % not interval constant + recorded('r_func', ((A = R :- AA),Body) ,_),!, + d_function(R,R1,N,N2,Root,Q2,Q1,C1,C), + d_f_dev(Body,A,AA,AAA,Root,N2,N1,Q,Q2). +d_function(cputime, '$CNT'(Value), N,N,_R,Q, Q, ('r_cputime'(Value),C),C) :- !. +d_function(A,AA,N,N,_Root,Q,Q,C,C) :- atomic(A),!, A = AA. +d_function(@A,@AA,N,N2,Root,Q,Q1,Next,C) :- !, % not interval constant + d_function(A,AA,N,N2,Root,Q,Q1,CN,true), + d_next_check(CN,Next,C). +d_function(*Name,'$CNT'(V),N,N2,Root,Q,Q1,C,C1) :- !, % not interval constant + d_function(Name,Name1,N,N2,Root,Q,Q1,C,('r_read_value'(Name1,'$CNT'(V)),C1)). +d_function(binary(B), Value, N,N,_R,Q, Q, C,C) :- !, + c_binary(B,Value),!. +d_function(hex(H), Value, N,N,_R,Q, Q, C,C) :- !, + c_hex(H,Value),!. +d_function(Exp, '$CNT'(Value), N,N1,R,Q, Q1, C,C1) :- % not interval constant + n_function(Exp,A,B,Exp1,AA,BB),!, + d_function_exp(A, AA, N,N2,R,Q, Q2,C, C2), + d_function_exp(B, BB, N2,N1,R,Q2,Q1,C2,('$CNT'(Value) is Exp1,C1)). +d_function(A,AA,N,N1,Root,Q,Q1,C,C1) :- functor(A,H,M),functor(AA,H,M), + d_function_args(0,M,A,AA,N,N1,Root,Q,Q1,C,C1),!. + +d_next_check(true,C,C):-!. +d_next_check(CN,(next(CN),C),C):-!. + +d_function_args(M,M,_A,_AA,N,N,_Root,Q,Q,C,C) :- !. +d_function_args(M1,M,A,AA,N,N1,Root,Q,Q1,C,C1) :- + M2 is M1+1, arg(M2,A,B), arg(M2,AA,BB), + d_function(B,BB,N,N2,Root,Q,Q2,C,C2),!, + d_function_args(M2,M,A,AA,N2,N1,Root,Q2,Q1,C2,C1),!. + +d_function_exp(Exp, Exp1, N,N1,R,Q, Q1, C,C1) :- nonvar(Exp), + n_function(Exp,A,B,Exp1,AA,BB),!, + d_function_exp(A, AA, N,N2,R,Q, Q2, C,C2), + d_function_exp(B, BB, N2,N1,R,Q2, Q1, C2,C1). +d_function_exp(Exp, Exp1, N,N1,R,Q, Q1, C,C1) :- + d_function(Exp, Exp1, N,N1,R,Q, Q1, C,C1). + +d_f_dev(true,_A,AA,AAA,Root,N,N1,Q,Q1) :-!, + develop(AA, AAA, Root, N, N1, Q, Q1). +d_f_dev(Body,A,AA,AAA,Root,N,N1,Q,Q1) :- + get_variable(A,Vs,[],_,0,_Vcount),!, + develop(AA, AAA, Root, N, N2, Q, Q2),!, + macro(Body, Root, N2, N1, Vs, Q2, Q1),!. + +/* */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tr.pl Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,325 @@ +/* + Copyright (C) 1988,2005, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@ie.u-ryukyu.ac.jp +*/ + +/* + + Tokio to prolog compiler + Runtime routine + with register list + + Mon Aug 5 09:01:29 JST 1985 + fix put_queue Fri Jan 24 11:47:11 JST 1986 + add tracer Sun Jun 22 12:47:21 JST 1986 + fix empty/notempty Wed Mar 9 09:24:47 JST 1988 + reducing compile time Fri Oct 14 03:27:08 JST 1988 + add mcom and fix chop Sat Aug 5 22:25:15 JST 1989 + meta call supported Sun Aug 6 00:55:42 JST 1989 + $Header$ +*/ + +:-dynamic(r_fififi/1). +:-dynamic(r_skip/1). + +r_header :- + write(' + Tokio to prolog compiler $Revision$ $Date$ + try ?- tokio_help. + '). + +user_help :- tokio_help. +tokio_help :- + nl, r_header,nl, +write(' com(File). : compile & compile program. '),nl, +write(' com(File,Output).: compile & counsult & save file. '),nl, +write(' pcom(File,Predicate-heads). : compile specified predicates. '),nl, +write(' pcom(File,Predicate-heads,Output).: compile specified predicates. '),nl, +write(' mcom(File). : preprocess '),nl, +write(' mcom(File,Output).: preprocess & outputfile.'),nl, +write(' restart(File). : run tokio save file. '),nl, +write(' tokiodebug. : All computation will be traced. '),nl, +write(' tokionodebug. : Debug mode is switched off. '),nl, +write(' tokiodebugging. : Display some informations about tracing. '),nl, +write(' notimebacktrack. : no time backtrack.. '),nl, +write(' timebacktrack. : time backtrack.. '),nl, +write(' tokio. : start tokio top-level. '),nl, +write(' tokio predicate. : run tokio program. '),nl, +write(' reset_macro. : Reset Macro Definition. com predicates also reset Macros.'),nl. +% write(' tokiospy : All predicate will be traced. '),nl, +% write(' tokiospy(F/N) : Predicate F which have N arity will be traced.'),nl, +% write(' tokionospy : All spy point are removed. '),nl, +% write(' tokionospy(F/N) : Spy point F/N will be removed. '),nl, +% write(' tokiodebugat(T) : Tracing will be start at time=Time. '),nl, +% write(' tokionodebugat : Start point of tracing is removed. '),nl, + +r_tokio0(Goals) :- + cputime(Time), + r_do_solve(Goals, C), + cputime(Time1), + T is (Time1-Time), % sec + r_tokiostats(C, T). +r_tokio0(_Goals) :- nl, write('--fail--'), nl. + +r_do_solve(Goals,C) :- + r_put_queue(Goals, X, true, Q, Q1), + r_notEmpty(Q), + ( recorded(tokiodebug, on, _), !, + r_solve_t(X,C,0,Q,Q1); + recorded(timebacktrack, off, _), !, + r_solve_d(X,C,0,Q,Q1); + r_solve(X,C,0,Q,Q1)). + +notimebacktrack :- recorded(timebacktrack,_,Ref),erase(Ref),fail. +notimebacktrack :- recorda(timebacktrack,off,_Ref). +timebacktrack :- recorded(timebacktrack,_,Ref),erase(Ref),fail. +timebacktrack :- recorda(timebacktrack,on,_Ref). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Quick and Easy Compile +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +r_put_queue(X, Y, Y, Q, Q) :- var(X),!, + write('cannot call variable:'),write(X),nl. +r_put_queue(X, (unifyNow(X,Xn),Xn,Y), Y, Q, Q) :- systemp(X),!. +% Tokio's varible is local, so, meta call is also local to +% its value. But I don't care about its arguments. +r_put_queue('$t'(Now,_Next),Z, Z1,Q, Q1) :- !, + r_put_queue(Now, Z, Z1,Q, Q1). +r_put_queue((X,Y), Z, Z1, Q, Q1) :- !, + r_put_queue(X,Z, Z2, Q,Q2), + r_put_queue(Y,Z2,Z1,Q2,Q1). +r_put_queue(#P, (r_always(P,Q,Q1),Y), Y, Q, Q1) :- !. +r_put_queue(next(P), (r_next(P,Q,Q1),Y), Y, Q, Q1) :- !. +r_put_queue(length(N), (r_length(M,Q),Y), Y, Q, Q) :- !, % restricted length + M is N. +r_put_queue(P, (P1,Y), Y, Q, Q1) :- + functor(P, H, N), N2 is N+2, N1 is N+1, + functor(P1, H, N2), arg(N1, P1, Q), arg(N2, P1, Q1), + r_put_queue_arg(N,P,P1). + +r_put_queue_arg(0,_,_) :- !. +r_put_queue_arg(M,F,F1) :- + arg(M,F,FA),arg(M,F1,FA),M1 is M-1, + r_put_queue_arg(M1,F,F1). + +r_tokiostats(L, T) :- nl, + write(L), write(' clock and '), + write(T), write(' sec. '), nl. + +r_always(X,['$t'((r_always(Xn,Q,Q2),N),F,E,C)|Q],Q1) :- + unifyNowNext(X,Xx,Xn), + 'tokio_call'(Xx,['$t'(N,F,E,C)|Q2],Q1). +r_next(X,['$t'(N,F,E,C)|Q], % same as next(tokio_call(X)) + ['$t'(N1,F,E,C)|Q1]) :- unifyNext(X,Xn), + r_put_queue(Xn,N,N1,Q,Q1). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Tokio Temporal Resolution +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +r_solve(r_end,_Fin,_Now,_X,_Y) :- !. +r_solve(X,Fin,Now,['$t'(Next,F,K,'$'(Fin,Now,Empty))|Futures], + ['$t'(true,true,true,'$'(Fin,Now,Empty))|True]) :- + NextTime is Now+1, + nl,write('t'),write(Now),write(':'),ttyflush, + call(X), + r_exec_fin_keep(Empty,Fin,Now,F,K,Next,Next1), + r_solve(Next1, Fin, NextTime, Futures, True). +r_solve(_,_,Now,_,_) :- B is Now-1, B>0, nl,write(b),write(B),write(':'), + ttyflush,!,fail. + +r_solve_t(r_end,_Fin,_Now,_X,_Y) :- !. +r_solve_t(X,Fin,Now,['$t'(Next,F,K,'$'(Fin,Now,Empty))|Futures], + ['$t'(true,true,true,'$'(Fin,Now,Empty))|True]) :- + r_tokioDebug(t(Empty,X,Fin,Now,F,K,Next,Futures,True),Now), + NextTime is Now+1, + nl,write('t'),write(Now),write(':'),ttyflush, + call(X), + r_exec_fin_keep(Empty,Fin,Now,F,K,Next,Next1), + r_solve_t(Next1, Fin, NextTime, Futures, True). +r_solve_t(_,_,Now,_,_) :- B is Now-1, B>0, nl,write(b),write(B),write(':'), + ttyflush,!,fail. + +r_solve_d(r_end,_Fin,_Now,_X,_Y) :- !. +r_solve_d(X,Fin,Now,['$t'(Next,F,K,'$'(Fin,Now,Empty))|Futures], + ['$t'(true,true,true,'$'(Fin,Now,Empty))|True]) :-!, + NextTime is Now+1, call(X), + r_exec_fin_keep(Empty,Fin,Now,F,K,Next,Next1), + r_solve_d(Next1, Fin, NextTime, Futures, True). + +r_exec_fin_keep(empty, Fin, Fin, F, _, _, r_end) :- !, % end at this time + call(F). +r_exec_fin_keep(notEmpty, Now, Fin, _, K, Next, Next) :- + Now \== Fin, + call(K). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Chop Operator Runtime +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +r_subBegin(['$t'(_,_,_,'$'(_,Now,_))|Q], % original interval + ['$t'((r_subBegin(Q,SQ,SQ1,Fin),N),F,K,'$'(Fin,Now,E))|SQ], + ['$t'(N,F,K,'$'(Fin,Now,E))|SQ1],Fin). % subinterval's Fin + +r_subFin( ['$t'(_, F , _, '$'(Fin,Fin,empty)) | _ ], % outer fin? + ['$t'(_, true, _, '$'(Fin,Fin,empty)) | _ ]) :- + call(F). + +r_subNotFin( LaterLoop, '$'(Q,Q1,QF,QF1), + ['$t'(N, F, K, '$'(OuterFin,Now,notEmpty)) | Q ], + ['$t'(N1, F1, K1, '$'(OuterFin,Now,notEmpty)) | Q1 ], + ['$t'(N, F, K, '$'(Fin,Now,Empty)) | QF ], + ['$t'((LaterLoop,N1), F1, K1, '$'(Fin,Now,Empty)) | QF1 ]) :- + r_sub_check(OuterFin,Now,Fin). + +r_sub_check(OuterFin,Now,Fin) :- var(OuterFin),!, + r_sub_check2(Fin,Now). +r_sub_check(OuterFin,Now,Fin) :- + OuterFin > Now,r_sub_check3(OuterFin,Now,Fin). %%%% Fin > Now, OuterFin > Now +r_sub_check2(Fin,_Now) :- var(Fin),!. %%%% freeze(Fin,Fin>Now). +r_sub_check2(Fin,Now) :- Fin>Now. +r_sub_check3(_OuterFin,_Now,Fin) :- var(Fin),!. %%%% freeze(Fin,(N<F,F<O)) +r_sub_check3(OuterFin,Now,Fin) :- Now<Fin,Fin<OuterFin. + +%%%%%%%%%%%%%%%%%%%%%%%%% +% meta call ( same restriction as top level ) +%%%%%%%%%%%%%%%%%%%%%%%%% +tokio_call(A,Q,Q) :- var(A),!, + write('uninstantiated meta call'),nl. +tokio_call(A,Q,Q1) :- + r_put_queue(A, X, true, Q, Q1), + call(X). + +%%%%%%%%%%%%%%%%%%%%%%%%% +% Tokio System Call +%%%%%%%%%%%%%%%%%%%%%%%%% +% Thanks for Prof. Esterline and Dr. Kilis +r_empty(['$t'(_,_,_,'$'(F,F,empty))|_]). +r_notEmpty(['$t'(_,_,_,'$'(F,N,notEmpty))|_]):- F\==N. + +r_length( 0, ['$t'(_,_,_,'$'(Fin,Fin,empty))|_] ) :-!. +r_length( L, ['$t'(_,_,_,'$'(Fin,Now,notEmpty))|_] ) :- + Fin is Now+L. + +r_cputime(X) :- statistics(runtime,[X1,_]),X is X1/1000. +r_cputime(X,Q,Q) :- r_cputime(X). + + +%%%%%%%%%%%%%%%%%%%%%%%%%%% +% Static Variable Runtime +%%%%%%%%%%%%%%%%%%%%%%%%%%% +r_set_value(Name,Value) :- var(Value),!, + write('Assign non fixed value = '), + write(Name),nl. +r_set_value(Name,Value) :- +%%%%%%% r_check(Name,Time), + recorded(Name,(Name,V,_Time),_),!,V=Value. +r_set_value(Name,Value) :- +%%%%%%% r_check(Name,Time), + recorda(Name,(Name,Value,_Time),_). +r_set_value(Name,Value) :- + recorded(Name,(Name,Value,_),Ref), + erase(Ref),!,fail. + +r_set_value(Name,Value,_Time) :- var(Value),!, + write('Assign non fixed value = '), + write(Name),nl. +r_set_value(Name,Value,Time) :- + recorded(Name,(Name,V,Time),_),!,V=Value. +r_set_value(Name,Value,Time) :- + recorda(Name,(Name,Value,Time),_). +r_set_value(Name,Value,Time) :- + recorded(Name,(Name,Value,Time),Ref), + erase(Ref),!,fail. + +% Special Cases + +% #(A=B) +% variable vs varible +% variable vs time constance +% *i <= ?? + +r_eq(A,B,['$t'((r_eq(C,D,E,F),G),H,I,J)|E],['$t'(G,H,I,J)|F]) :- + unifyNowNext(A,K,C),unifyNowNext(B,K,D). +r_eqn(A,B,['$t'((r_eqn(C,B,D,E),F),G,H,I)|D],['$t'(F,G,H,I)|E]) :- + unifyNowNext(A,B,C). +r_assign(Static,A,['$t'((r_assign(Static,A,B,C),D),(r_set_value(Static,A,Time),E),F,G)|B], + ['$t'(D,E,F,G)|C]):- G='$'(_Fin,Time,_Empty). + + + +% r_check(Name,Time) :- +% recorded(time,Time,_), +% ( recorded(Name,(Name,Value1,Time),_), +% report_conflict(Name,Name,Time) +% ; true), +% ( recorded(r_write,(Name,Bus),_),( +% recorded(Bus,(Name2,Time),_), +% report_conflict(Name,Name2,Time) +% ; recorda(Bus,(Name,Time),_)) +% ; true),!. + +r_read_value(Name,Value) :- recorded(Name,(Name,Value1,_),_),!, +% recorded(time,Time,_), +% recorda(Name,(Name,Value1,Time),_), +% ( recorded(r_read,(Name,Bus),_),( +% recorded(Bus,(Name2,Time),_),Name2 \= Name, +% report_conflict(Name,Name2,Time) +% ; recorda(Bus,Name,_)) +% ; true),!, + Value = Value1. +r_read_value(Name,_Value) :- nl, + write('Reference Not assigned value -- '), + write(Name),nl. + +init_static :- recorded(r_static,Name,_),recorded(Name,_,Ref), + erase(Ref),fail. +init_static :- abolish(r_skip,1), + assert(r_skip(-1)). + +reset_static :- recorded(r_static,Name,Iref),recorded(Name,_,Ref), + erase(Ref),erase(Iref),fail. + +static([]) :- !. +static([H|T]) :- !,static(H),static(T). + + +% static(Name=Bus) :- !,static(Name),static(Bus), +% r_read_bus(Name,Bus),r_write_bus(Name,Bus). +% static(Name=[RBus,WBus]) :- !,static(Name),static(Bus), +% r_read_bus(Name,RBus),r_write_bus(Name,WBus). +static(Name) :- functor(Name,_H,_),recorded(r_static,Name,_),!. +static(Name) :- functor(Name,_H,_),recordz(r_static,Name,_). + +static_memory(L) :- static(L). +static_register(L) :- static(L). + +r_read_bus(Name,Bus) :- + (recorded(r_read,(Name,Bus),_);recordz(r_read,(Name,Bus),_)). +r_write_bus(Name,Bus) :- + (recorded(r_write,(Name,Bus),_);recordz(r_write,(Name,Bus),_)). + +/* :- static(time). */ + +% r_report_conflict(Name,Name2,Time) :- nl, +% write('Conflict *'), +% write(Name),write(' and *'), +% write(Name2),write(' at '), +% write(Time). + +% A \= A :-!,fail. +% _ \= _. + +append([],X,X). +append([H|X],Y,[H|Z]) :- append(X,Y,Z). + +member(H,[H|_]) :-!. +member(H,[_|T]) :- member(H,T). + +/* for ttyflush */ + +/* :- (ttyflush ; assert(ttyflush) ). */ + +/* end of runtime */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/ts.pl Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,39 @@ +/* + Copyright (C) 1988,2005, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@ie.u-ryukyu.ac.jp +*/ + +/* Tokio interpreter on prolog */ + +/* operator definitions */ +/* @ .. next */ +/* #,[] .. always */ +/* <> .. sometime */ + +:-op(1200, fy ,[(('$define')),(('$function'))]). /* macro definitions */ +/* :-op(1250, xfy ,[('$clause'),('r_call')]). macro development */ +:-op(1200, xfy ,[('$clause'),('$call')]). /* macro development */ +:-op(1100, xfy ,[( '|' )]). /* guard */ +:-op(1160, fx ,[(tokio)]). /* Tokio formula interpreter */ +:-op(1150, fy , [(if),(while)]). +:-op(1150, xfy , [(else)]). +:-op(1150, xfy , [(do)]). +:-op(1150, xfy , (then)). +:-op(1150, xfy , [('&&'),( & )]). +:-op(900, fx , ['<>',#,'|a|','|t|','||',beg,halt]). +:-op(700, xfy , [\=,===,' = '] ). +:-op(700, xfy , [:=] ). /* static assignment instanteanous */ +:-op(700, xfy , [<=] ). /* temporal assignment instanteanous */ +:-op(700, xfy , [<==] ). /* static temporal assignment */ +:-op(700, xfy , [<-] ). /* temporal assignment */ +:-op(700, xfy , [<<-] ). /* multiple temporal assignment */ +:-op(700, xfy , [<--] ). /* force constrant */ +:-op(700, xfy , proj ). /* projection */ +:-op(700, xfy , gets ). /* repeatedly assignment */ +:-op(600, xfx , to ). /* range */ +:-op(150, fy , @). /* next oprator */ +:-op(140, fx , *). /* variables */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/tu.pl Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,158 @@ +/* + Copyright (C) 1988,2005, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@ie.u-ryukyu.ac.jp +*/ + + +/* + temporal unifier + Tue Oct 15 11:36:12 JST 1985 +*/ + +unifyAll(V,V) :- !. % variable case +unifyAll('$t'(Now,Nxt),'$t'(Now,Nxt1)) :-!, + unifyAll(Nxt,Nxt1). +unifyAll('$t'(Now,Nxt),D):-!, + unifyNowNext(D,Now,Nxt1), + unifyAll(Nxt,Nxt1). +unifyAll(D,'$t'(Now,Nxt)):-!, + unifyNowNext(D,Now,Nxt1), + unifyAll(Nxt,Nxt1). +unifyAll([H|L],[H1|L1]) :- !, + unifyAll(H,H1),unifyAll(L,L1). +unifyAll(Sa,Sb):- + functor(Sa,H,N),functor(Sb,H,N), + unify_arg(N,N,Sa,Sb). + +unify_arg(0,_N,_,_):-!. +unify_arg(M,N,Sa,Sb):- + arg(M,Sa,Aa),arg(M,Sb,Ab), + unifyAll(Aa,Ab),M1 is M-1,!, + unify_arg(M1,N,Sa,Sb). + +unifyNowNext('$t'(Now,Next),Now1,Next1):-!,Now=Now1,Next=Next1. +unifyNowNext(X,X1,X1):-atomic(X),!,X=X1. +unifyNowNext([H|L],[Hn|Ln],[Hnn|Lnn]):-!, + unifyNowNext(H,Hn,Hnn), + unifyNowNext(L,Ln,Lnn). +unifyNowNext(S,Sn,Snn):- + functor(S,H,N),functor(Sn,H,N),functor(Snn,H,N), + unifyNowNextArg(N,N,S,Sn,Snn). + +unifyNowNextArg(0,_,_,_,_). +unifyNowNextArg(M,N,Sa,Sb,Sc):- + arg(M,Sa,Aa),arg(M,Sb,Ab),arg(M,Sc,Ac), + unifyNowNext(Aa,Ab,Ac),M1 is M-1,!, + unifyNowNextArg(M1,N,Sa,Sb,Sc). + +unifyNow(X,X1):-atomic(X),!,X=X1. +unifyNow('$t'(Now,_),Now1):-!,Now=Now1. +unifyNow([H|L],[Hn|Ln]):-!, + unifyNow(H,Hn), + unifyNow(L,Ln). +unifyNow(S,Sn):- + functor(S,H,N),functor(Sn,H,N), + unifyNowArg(N,N,S,Sn). + +unifyNowArg(0,_,_,_). +unifyNowArg(M,N,Sa,Sb):- + arg(M,Sa,Aa),arg(M,Sb,Ab), + unifyNow(Aa,Ab),M1 is M-1,!, + unifyNowArg(M1,N,Sa,Sb). + + +unifyNext(X,X):-atomic(X),!. +unifyNext('$t'(_,Next),Next1):-!,Next=Next1. +unifyNext([H|L],[Hn|Ln]):-!, + unifyNext(H,Hn), + unifyNext(L,Ln). +unifyNext(S,Sn):- + functor(S,H,N),functor(Sn,H,N), + unifyNextArg(N,N,S,Sn). + +unifyNextArg(0,_,_,_). +unifyNextArg(M,N,Sa,Sb):- + arg(M,Sa,Aa),arg(M,Sb,Ab), + unifyNext(Aa,Ab),M1 is M-1,!, + unifyNextArg(M1,N,Sa,Sb). + + +% ATOMIC +% uatom(X, Atom) +uatom(X, X) :- !. +uatom('$t'(Atom,Next), Atom) :- uatom(Next, Atom). + +uconst(X, X) :- var(X),!. +uconst('$t'(Atom,Next), Atom) :- uatom(Next, Atom). +uconst(X, Y) :- nonvar(X),!,X=Y. + +% unil(X) : Hacked version of uatom. +unil([]) :- !. +unil('$t'([],Next)) :- unil(Next). + + +% COMPOUND TERM +% uskel(X, Skeleton) +uskel(X,X) :- !. +uskel('$t'(X,Next),S) :- + functor(S,H,N),functor(X,H,N),functor(Sn,H,N), + uskelArg(N,N,S,X,Sn), + uskel(Next,Sn). + +uskelArg(0, _, _, _, _) :- !. +uskelArg(M, N, S, X, Sn) :- + arg(M, S, '$t'(Now, Next)), + arg(M, X, Now), + arg(M, Sn, Next), + M1 is M-1, + uskelArg(M1, N, S, X, Sn). + +% ulist(X, Car, Cdr) : Hacked version of uskel. +ulist([H|T], H, T) :- !. +ulist('$t'([H|T],Next), '$t'(H,NH), '$t'(T,NT)) :- !, ulist(Next, NH, NT). + + +% readonly unify + + +r_unifyAll(G,D):- + (var(G) ; var(D)),!,G==D. +r_unifyAll(Fl,D):-functor(Fl,'$t',2),!, + r_unify_flt(Fl,D). +r_unifyAll(D,Fl):-functor(Fl,'$t',2),!, + r_unify_flt(Fl,D). +r_unifyAll(Sa,Sb):- + functor(Sa,H,N),functor(Sb,H,N), + r_unify_arg(N,N,Sa,Sb). + +r_unify_arg(0,_N,_,_):-!. +r_unify_arg(M,N,Sa,Sb):- + arg(M,Sa,Aa),arg(M,Sb,Ab), + r_unifyAll(Aa,Ab),M1 is M-1,!, + r_unify_arg(M1,N,Sa,Sb). + +r_unify_flt('$t'(Now,Nxt),'$t'(Now1,Nxt1)) :-!,Now==Now1, + r_unifyAll(Nxt,Nxt1). +r_unify_flt('$t'(Now,Nxt),S) :- nonvar(Now),nonvar(Nxt), + r_unifyNowNext(S,Now,Nxt1), + r_unifyAll(Nxt,Nxt1). + +r_unifyNowNext(V,_,_) :- var(V),!,fail. +r_unifyNowNext('$t'(Now,Next),Now1,Next1):-!,Now==Now1,Next==Next1. +r_unifyNowNext(X,X1,X2):-atomic(X),!,X==X1,X==X2. +r_unifyNowNext(S,Sn,Snn):- + functor(S,H,N),functor(Sn,H,N),functor(Snn,H,N), + r_unifyNowNext(N,N,S,Sn,Snn). + +r_unifyNowNextArg(0,_,_,_,_). +r_unifyNowNextArg(M,N,Sa,Sb,Sc):- + arg(M,Sa,Aa),arg(M,Sb,Ab),arg(M,Sc,Ac), + r_unifyNowNext(Aa,Ab,Ac),M1 is M-1,!, + r_unifyNowNextArg(M1,N,Sa,Sb,Sc). + + +/* end of unifier */
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/xf.pl Thu Aug 30 14:57:44 2007 +0900 @@ -0,0 +1,155 @@ +/* + Copyright (C) 1988,2005, Shinji Kono + Everyone is permitted to copy and distribute verbatim copies + of this license, but changing it is not allowed. You can also + use this wording to make the terms for other programs. + + send your comments to kono@ie.u-ryukyu.ac.jp +*/ + +% This routine is faster than predicate_property. +% This is a old fashsioned method for C-Prolog. +% $Header$ + +systemp( com(_File)). +systemp( com(_File,_Output)). +systemp( mcom(_File)). +systemp( mcom(_File,_Output)). +systemp( pcom(_File,_PredicateHeads)). +systemp( pcom(_File,_PredicateHeads,_Output)). +systemp( restart(_File)). +systemp( tokiodebug). +systemp( tokionodebug). +systemp( tokiodebugging). +systemp( notimebacktrack). +systemp( timebacktrack). +systemp( (tokio)). +systemp( tokio(_)). +systemp( static(_)). +systemp( reset_macro). +systemp( tokiospy). +systemp( tokiospy(_F/_N)). +systemp( tokionospy). +systemp( tokionospy(_F/_N)). +systemp( tokiodebugat(_T)). +systemp( tokionodebugat). +systemp( help). +systemp( tokio_help). +systemp( unix(_)). +systemp( vms(_)). +systemp( compile(_)). +systemp( fcompile(_)). +systemp( load(_)). +systemp( use_module(_)). +systemp( use_module(_,_)). +systemp( use_module(_,_,_)). +systemp( module(_)). + +systemp( =>(_,_)). +systemp( <=(_,_)). +systemp( nextevent(_)). +systemp( waitevent(_)). + +systemp(abolish(_,_)). +systemp(abort). +systemp(arg(_,_,_)). +systemp(assert(_)). +systemp(assert(_,_)). +systemp(asserta(_)). +systemp(asserta(_,_)). +systemp(assertz(_)). +systemp(assertz(_,_)). +systemp(atom(_)). +systemp(atomic(_)). +systemp(bagof(_,_,_)). +systemp(break). +systemp(c(_,_,_)). +systemp(call(_)). +systemp(clause(_,_)). +systemp(clause(_,_,_)). +systemp(close(_)). +systemp(compare(_,_,_)). +systemp(consult(_)). +systemp(current_atom(_)). +systemp(current_functor(_,_)). +systemp(current_predicate(_,_)). +systemp(db_reference(_)). +systemp(debug). +systemp(debugging). +systemp(display(_)). +systemp(erase(_)). +systemp(erased(_)). +systemp(expand_term(_,_)). +systemp(exists(_)). +systemp(fail). +systemp(fileerrors). +systemp(functor(_,_,_)). +systemp(get(_)). +systemp(get0(_)). +systemp((halt)). +systemp(instance(_,_)). +systemp(integer(_)). +systemp(is(_,_)). +systemp(keysort(_,_)). +systemp(leash(_)). +systemp(listing). +systemp(listing(_)). +systemp(name(_,_)). +systemp(nl). +systemp(nodebug). +systemp(nofileerrors). +systemp(nonvar(_)). +systemp(nospy(_)). +systemp(number(_)). +systemp(op(_,_,_)). +systemp(primitive(_)). +systemp(print(_)). +systemp(prompt(_,_)). +systemp(put(_)). +systemp(read(_)). +systemp(reconsult(_)). +systemp(recorda(_,_,_)). +systemp(recorded(_,_,_)). +systemp(recordz(_,_,_)). +systemp(rename(_,_)). +systemp(repeat). +systemp(retract(_)). +systemp(save(_)). +systemp(see(_)). +systemp(seeing(_)). +systemp(seen). +systemp(setof(_,_,_)). +systemp(sh). +systemp(skip(_)). +systemp(sort(_,_)). +systemp(spy(_)). +systemp(system(_)). +systemp(statistics). +systemp(statistics(_,_)). +systemp(unix(_)). +systemp(vms(_)). +systemp(tab(_)). +systemp(tell(_)). +systemp(telling(_)). +systemp(told). +systemp(trace). +systemp(true). +systemp(var(_)). +systemp(write(_)). +systemp(writeq(_)). +systemp('LC'). +systemp('NOLC'). +systemp('!'). +systemp('\+'). +systemp(_'<'_). +systemp(_'=<'_). +systemp('>'(_,_)). +systemp('>='(_,_)). +systemp('='(_,_)). +systemp('=..'(_,_)). +systemp('=='(_,_)). +systemp('\=='(_,_)). +systemp('@<'(_,_)). +systemp('@=<'(_,_)). +systemp('@>'(_,_)). +systemp('@>='(_,_)).