% Section 2.3.2, Program D : Differentiation Routines % Author Chan Vinh VONG % Draft Version 2012 April 14th % Refined 2012 April 19th % Refined 2012 May 08th % Refined 2012 July 08th % % >|<-----OCTA----->|< % +----------------+ % | RLINK/63 RTAG/1| BA+0 % +----------------+ % | LLINK/63 LTAG/1| BA+8 % +----------------+ % | INFO/60 TYPE/4 | BA+16 % +----------------+ % % Remarks: % - INFO and TYPE are stored in the same octa, resp. w/ 60 and 4 bits % - one data block is made of 3 octas % % Global Variables: % :Y tree head PREFIX DIFF: dRLINK IS 8*0 dLLINK IS 8*1 dINFOTYPE IS 8*2 P IS $0 P1 IS $1 P2 IS $2 Q1 IS $3 Q IS $4 info IS $5 type IS $6 warp IS $7 ret IS $8 t IS $9 :DIFF LDOU P1,:Y,dLLINK % D1. Initialize 1H SET P,P1 LDOU P1,P,dLLINK BNZ P1,1B % Y$ is the leftmost node % Coroutine Test % GO :a,:b,0 D2 LDOU P1,P,dLLINK BZ P1,2F LDOU Q1,P1,dRLINK 2H LDOU type,P,dINFOTYPE AND type,type,#F INCL type,1 switch GREG @ STBU type,switch,7 JMP @+4 JMP CONST JMP VAR JMP LN JMP NEG JMP ADD JMP MINUS JMP TIMES JMP DIV JMP PWR D3 CMP t,type,4 BNP t,D4 STOU P2,P1,dRLINK D4 SET P2,P LDOU P,P,dRLINK BOD P,4F % it was a right thread hence we got P$ Scan LDOU t,P,dLLINK % else hard link thus get leftmost node BZ t,4F SET P,t JMP Scan 4H LDOU t,P2,dRLINK BOD t,D5 STOU Q,P2,dRLINK D5 SRU t,t,1 SLU t,t,1 % reset thread flag CMP t,t,:Y BNZ t,D2 STOU Q,:DY,dLLINK XOR t,:DY,#1 STOU t,Q,dRLINK POP 0,0 XValue IS #58 N_CONST0 GREG #0 % 0 N_CONST1 GREG #10 % 1 N_CONST2 GREG #20 % 2 N_VARX GREG #581 % "X" N_VARY GREG #591 % "Y" N_LN GREG #4C4E2 % "LN" N_NEG GREG #4E45473 % "NEG" N_PLUS GREG #2B4 % "+" N_MINUS GREG #2D5 % "-" N_TIMES GREG #2A6 % "*" N_DIV GREG #2F7 % "/" N_PWR GREG #5E8 % "^" %== NULLARY OPERATORS ================================================= CONST JMP 1F VAR LDOU info,P,dINFOTYPE SRU info,info,4 CMP t,info,XValue BNZ t,1F SET t+2,N_CONST1 JMP 2F 1H SET t+2,N_CONST0 2H GET warp,:rJ PUSHJ t+1,:TREE0 PUT :rJ,warp SET Q,t+1 JMP D3 %== UNARY OPERATORS =================================================== LN LDOU info,Q,dINFOTYPE BZ info,D3 GET warp,:rJ SET t+2,P1 PUSHJ t+1,:COPYRTBT SET t+4,t+1 SET t+3,Q SET t+2,N_DIV PUSHJ t+1,:TREE2 PUT :rJ,warp SET Q,t+1 JMP D3 NEG LDOU info,Q,dINFOTYPE BZ info,3F % NEG 0 = 0 SET t+3,Q SET t+2,N_NEG GET warp,:rJ PUSHJ t+1,:TREE1 PUT :rJ,warp SET Q,t+1 3H JMP D3 %== BINARY OPERATORS ================================================== ADD LDOU info,Q1,dINFOTYPE BNZ info,4F SET t,Q1 % dU = 0 => dU to be GC'd JMP GC4 4H LDOU info,Q,dINFOTYPE BNZ info,4F SET t,Q % dU != 0 and dV = 0 => dV to be GC'd SET Q,Q1 GC4 GET warp,:rJ % garbage collect unused block SET t+1,t PUSHJ t,:AGC:GC PUT :rJ,warp JMP D3 4H GET warp,:rJ % dU != 0 and dV != 0 SET t+4,Q SET t+3,Q1 SET t+2,N_PLUS PUSHJ t+1,:TREE2 SET Q,t+1 PUT :rJ,warp JMP D3 MINUS LDOU info,Q,dINFOTYPE BNZ info,5F SET t,Q % dV = 0 => GC dV SET Q,Q1 GET warp,:rJ % garbage collect unused block SET t+1,t PUSHJ t,:AGC:GC PUT :rJ,warp JMP D3 5H LDOU info,Q1,dINFOTYPE BNZ info,5F SET t,Q1 % dV != 0 but dU = 0 GET warp,:rJ % garbage collect unused block SET t+1,t PUSHJ t,:AGC:GC PUT :rJ,warp SET t+3,Q SET t+2,N_NEG PUSHJ t+1,:TREE1 SET Q,t+1 PUT :rJ,warp JMP D3 5H GET warp,:rJ % dV != 0 and dU != 0 SET t+4,Q SET t+3,Q1 SET t+2,N_MINUS PUSHJ t+1,:TREE2 SET Q,t+1 PUT :rJ,warp JMP D3 TIMES LDOU info,Q1,dINFOTYPE BZ info,6F GET warp,:rJ % dU != 0 SET t+1,P2 % copy V PUSHJ t,:COPYRTBT SET t+2,t % MULT(dU,copy(V)) SET t+1,Q1 PUSHJ t,:MULT SET Q1,t PUT :rJ,warp 6H LDOU info,Q,dINFOTYPE BZ info,6F GET warp,:rJ % dV != 0 LDOU t,P1,dRLINK % temp shunt rlink(P1) because STCO 1,P1,dRLINK % we are still in the middle of the % P1-Q1 temp bridging SET t+2,P1 % copy U PUSHJ t+1,:COPYRTBT STOU t,P1,dRLINK % restore bridge SET t+2,Q % MULT(copy(U),dV) PUSHJ t,:MULT SET Q,t PUT :rJ,warp 6H JMP ADD DIV LDOU info,Q1,dINFOTYPE % compute U'/V BZ info,7F % if U' is not already 0 GET warp,:rJ LDOU t,P2,dRLINK % temp disconnect P2 from the tree STCO 1,P2,dRLINK SET t+2,P2 % copy P2 PUSHJ t+1,:COPYRTBT STOU t,P2,dRLINK % reconnect P2 into the tree SET t+4,t+1 % assemble new Q1 SET t+3,Q1 SET t+2,N_DIV PUSHJ t+1,:TREE2 SET Q1,t+1 % finalize PUT :rJ,warp 7H LDOU info,Q,dINFOTYPE % compute (UV')/(V^2) BZ info,7F % if V' is not already 0 GET warp,:rJ LDOU t,P1,dRLINK % temp disconnect P1 from the tree STCO 1,P1,dRLINK SET t+2,P1 PUSHJ t+1,:COPYRTBT STOU t,P1,dRLINK % reconnect P1 into the tree SET t+2,t+1 % compute (copy(P1)*Q) SET t+1,Q PUSHJ t,:MULT % don't touch t until Q <- ... ! LDOU t+1,P2,dRLINK % temp disconnect P2 from the tree STCO 1,P2,dRLINK SET t+3,P2 % copy P2 PUSHJ t+2,:COPYRTBT STOU t+1,P2,dRLINK % reconnect P2 into the tree SET t+4,N_CONST2 % build TREE(2) PUSHJ t+3,:TREE0 SET t+4,t+3 % assemble power SET t+3,t+2 SET t+2,N_PWR PUSHJ t+1,:TREE2 SET t+3,t+1 % assemble new Q SET t+2,t SET t+1,N_DIV PUSHJ t,:TREE2 SET Q,t % finalize PUT :rJ,warp 7H JMP MINUS % assemble (Q1 - Q) PWR LDOU info,Q1,dINFOTYPE BZ info,PWRQ % no process for Q1, go to Q GET warp,:rJ LDOU t,P1,dRLINK % temp disconnect P1 STCO 1,P1,dRLINK SET t+2,P1 % t+1 is R <- COPY(P1) PUSHJ t+1,:COPYRTBT STOU t,P1,dRLINK % reconnect P1 LDOU type,P2,dINFOTYPE AND type,type,#F BNZ type,PWRQ1B % P2.TYPE=0 ? PWRQ1A LDOU info,P2,dINFOTYPE SRU info,info,4 CMP t,info,2 BZ t,PWRQ1X % P2.TYPE=0 && P2.INFO!=2 XOR t,t,t NEGU t,1 ADDU t,info,t % t = P2.INFO - 1 SLU t,t,4 % reassemble INFO|TYPE SET t+3,t PUSHJ t+2,:TREE0 % TREE(P2.INFO-1) SET t+4,t+2 SET t+3,t+1 % R SET t+2,#5E8 % "^" PUSHJ t+1,:TREE2 % keep [t+1] == R JMP PWRQ1X % R is ready for P2 constant and != 2 PWRQ1B LDOU t,P2,dRLINK % temp disconnect P2 STCO 1,P2,dRLINK SET t+3,P2 PUSHJ t+2,:COPYRTBT % copied P2 in [t+2] STOU t,P2,dRLINK % reconnect P2 SET t+4,#10 PUSHJ t+3,:TREE0 % built (1) in [t+3] SET t+5,t+3 SET t+4,t+2 SET t+3,N_MINUS PUSHJ t+2,:TREE2 % assembled (copy P2)-(1) in [t+2] SET t+4,t+2 SET t+3,t+1 SET t+2,N_PWR % assembled in [t+1] == R PUSHJ t+1,:TREE2 PWRQ1X LDOU t,P2,dRLINK % temp disconnect P2 STCO 1,P2,dRLINK SET t+3,P2 PUSHJ t+2,:COPYRTBT % copied P2 STOU t,P2,dRLINK % reconnect P2 SET t+4,t+1 % R SET t+3,t+2 % copy(P2) PUSHJ t+2,:MULT % assembled copy(P2)*R and consume R % SET t+2,t+2 % latest result is kept SET t+1,Q1 PUSHJ t,:MULT % assembled Q1* SET Q1,t % finalize Q1 PUT :rJ,warp PWRQ LDOU info,Q,dINFOTYPE BZ info,PWRX % no process required for Q, goto exit GET warp,:rJ LDOU t,P1,dRLINK STCO 1,P1,dRLINK SET t+2,P1 PUSHJ t+1,:COPYRTBT % copied P1 in [t+1] STOU t,P1,dRLINK SET t+2,t+1 SET t+1,N_LN PUSHJ t,:TREE1 % [t+1] consumed SET t+2,Q SET t+1,t PUSHJ t,:MULT % [t+1] consumed, [t] set LDOU t+1,P1,dRLINK STCO 1,P1,dRLINK SET t+3,P1 PUSHJ t+2,:COPYRTBT % copied P1 in [t+2] STOU t+1,P1,dRLINK LDOU t+1,P2,dRLINK STCO 1,P2,dRLINK SET t+4,P2 PUSHJ t+3,:COPYRTBT % copied P2 in [t+3] STOU t+1,P2,dRLINK SET t+4,t+3 SET t+3,t+2 SET t+2,N_PWR PUSHJ t+1,:TREE2 % consumed [t+2] and [t+3], set [t+1] SET t+3,t+1 SET t+2,t SET t+1,N_TIMES PUSHJ t,:TREE2 % consumed [t] and [t+1] SET Q,t % finalize PUT :rJ,warp PWRX JMP ADD PREFIX :