リンクその１：MATH VER 4.50 ASSEMBLY ;MATH VER4.50 pre_on iocs: equ 0fffe8h bx: equ 0d4h bl: equ 0d4h bh: equ 0d5h cx: equ 0d6h cl: equ 0d6h ch: equ 0d7h dx: equ 0d8h dl: equ 0d8h dh: equ 0d9h si: equ 0dah di: equ 0ddh ptrbp: equ 0ech org 0b7c00h fresult:ds 1 charn: ds 1 charm: ds 1 s_work: ds 3 finitm: mv [s_work],s call findsingle call findmatrix call keyscan retf fmul: mv [s_work],s call findsingle_af call nmul call keyscan retf fdiv: mv [s_work],s call findsingle_af call ndiv call keyscan retf fdblqrlp: mv [s_work],s call ndblqrlp call keyscan retf fhh: mv [s_work],s call nhh call keyscan retf fscale: mv [s_work],s call nscale call keyscan retf fns: mv [s_work],s call nns call keyscan retf frcp: mv [s_work],s call nrcp call keyscan retf fmldia: mv [s_work],s call nmldia call keyscan retf fscale2: mv [s_work],s call nscale2 call keyscan retf fjacobilp: mv [s_work],s call njacobilp call keyscan retf fframelp: mv [s_work],s call nframelp call keyscan retf fnscp: mv [s_work],s call nnscp call keyscan retf frcpcp: mv [s_work],s call nrcpcp call keyscan retf fnsfast: mv [s_work],s call nnsfast call keyscan retf feigen33: mv [s_work],s call neigen33 call keyscan retf feigen44: mv [s_work],s call neigen44 call keyscan retf fexp: mv [s_work],s call findsingle_af call nexp call keyscan retf fln: mv [s_work],s call findsingle_af call nln call keyscan retf fsqr: mv [s_work],s call findsingle_af call nsqr call keyscan retf fcur: mv [s_work],s call findsingle_af call ncur call keyscan retf finkey: call ninkey retf charm1: ds 1 charj: ds 1 chark: ds 1 charl: ds 1 charle: ds 1 fsr: ds 7 fsi: ds 7 ptrar: ds 3 ptrai: ds 3 ptrbr: ds 3 ptrbi: ds 3 ndblqrlp: call findsingle mv a,'A' call findmat00 mv [ptrma],x mv a,'N' call findmat00 mv [ptrmn],x mv a,'A' mv [fdbyte1],a mv a,'R' mv [fdbyte2],a call finddouble mv [ptrar],x mv a,'I' mv [fdbyte2],a call finddouble mv [ptrai],x mv a,'B' mv [fdbyte1],a mv a,'R' mv [fdbyte2],a call finddouble mv [ptrbr],x mv a,'I' mv [fdbyte2],a call finddouble mv [ptrbi],x call finde0e1e2 mv a,[charm] dec a mv [charm1],a ;For[i = 1, i < m, i++, mv a,0 mv [chari],a nd50: ; If[i == 1, mv a,[chari] cmp a,0 jpnz nd60 ; b1 = a[[1, 1]]^2 mv a,0 mv [ptr1],a mv [ptr2],a call getoffset mv [inttmp0],i mv x,[ptrma] add x,i pushs x mv y,[ptra] call mtom pops x mv y,[ptrc] call mtom mv x,[ptrmn] add x,i pushs x mv y,[ptrb] call mtom pops x mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,fb1r call mtom mv x,[ptrb] mv y,fb1i call mtom ; - (s1 + s2)*a[[1, 1]] mv x,[ptrar] call mtox mv x,[ptrbr] call mtox call ad jpc err5 mv x,fsr pushs x call xtom pops x mv y,[ptra] call mtom mv x,[ptrai] call mtox mv x,[ptrbi] call mtox call ad jpc err5 mv x,fsi pushs x call xtom pops x mv y,[ptrb] call mtom mv i,[inttmp0] mv x,[ptrma] add x,i mv y,[ptrc] call mtom mv x,[ptrmn] add x,i mv y,[ptrd] call mtom call nmul mv x,fb1r pushs x call mtox mv x,[ptra] call mtox call sb jpc err5 pops x call xtom mv x,fb1i pushs x call mtox mv x,[ptrb] call mtox call sb jpc err5 pops x call xtom ; + s1*s2 mv x,[ptrar] mv y,[ptra] call mtom mv x,[ptrai] mv y,[ptrb] call mtom mv x,[ptrbr] mv y,[ptrc] call mtom mv x,[ptrbi] mv y,[ptrd] call mtom call nmul call addfb1ab ; + a[[1, 2]]*a[[2, 1]]; mv a,0 mv [ptr1],a mv a,1 mv [ptr2],a call getoffset mv x,[ptrma] add x,i mv y,[ptra] call mtom mv x,[ptrmn] add x,i mv y,[ptrb] call mtom mv a,1 mv [ptr1],a mv a,0 mv [ptr2],a call getoffset mv [inttmp1],i mv x,[ptrma] add x,i mv y,[ptrc] call mtom mv x,[ptrmn] add x,i mv y,[ptrd] call mtom call nmul call addfb1ab ; b2 = (a[[1, 1]] + a[[2, 2]] - s1 - s2) mv i,[inttmp0] mv x,[ptrma] pushs x add x,i call mtox mv a,1 mv [ptr1],a mv [ptr2],a call getoffset mv [inttmp2],i pops x add x,i call mtox call ad jpc err5 mv x,fsr call mtox call sb jpc err5 mv x,[ptra] call xtom mv i,[inttmp0] mv x,[ptrmn] pushs x add x,i call mtox mv i,[inttmp2] pops x add x,i call mtox call ad jpc err5 mv x,fsi call mtox call sb jpc err5 mv x,[ptrb] call xtom ;*a[[2, 1]]; mv i,[inttmp1] mv x,[ptrma] add x,i mv y,[ptrc] call mtom mv x,[ptrmn] add x,i mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,fb2r call mtom mv x,[ptrb] mv y,fb2i call mtom ; b3 = a[[3, 2]]*a[[2, 1]]; mv a,2 mv [ptr1],a mv a,1 mv [ptr2],a call getoffset mv x,[ptrma] add x,i mv y,[ptra] call mtom mv x,[ptrmn] add x,i mv y,[ptrb] call mtom mv i,[inttmp1] mv x,[ptrma] add x,i mv y,[ptrc] call mtom mv x,[ptrmn] add x,i mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,fb3r call mtom mv x,[ptrb] mv y,fb3i call mtom jr nd70 ; , nd60: ; b1 = a[[i, i - 1]]; mv a,[chari] mv [ptr1],a dec a mv [ptr2],a call getoffset mv x,[ptrma] add x,i mv y,fb1r call mtom mv x,[ptrmn] add x,i mv y,fb1i call mtom ; b2 = a[[i + 1, i - 1]]; mv a,[chari] inc a mv [ptr1],a call getoffset mv x,[ptrma] add x,i mv y,fb2r call mtom mv x,[ptrmn] add x,i mv y,fb2i call mtom ; b3 = If[i == m - 2, 0, a[[i + 2, i - 1]]]; mv a,[chari] add a,2 mv il,[charm] sub il,a jrz nd61 mv [ptr1],a call getoffset mv x,[ptrma] add x,i mv y,fb3r call mtom mv x,[ptrmn] add x,i mv y,fb3i call mtom jr nd62 nd61: mv x,fb3r call mv0 mv x,fb3i call mv0 nd62: ; ]; nd70: ; If[Im[b1] != 0, b2 /= b1; b3 /= b1; b1 = 1;]; mv x,fb1i mv y,[ptrb] pushs y call mtom pops x mv a,0 mv [x],a mv y,[ptre3] call cp ;E3 - ABS Im[b1] jrnc nd71 mv x,fb1r mv y,[ptrc] call mtom mv x,fb1i mv y,[ptrd] call mtom mv x,fb2r pushs x mv y,[ptra] pushs y call mtom mv x,fb2i pushs x mv y,[ptrb] pushs y call mtom call ndiv pops x ;[ptrb] pops y ;fb2i call mtom pops x ;[ptra] pops y ;fb2r call mtom mv x,fb3r pushs x mv y,[ptra] pushs y call mtom mv x,fb3i pushs x mv y,[ptrb] pushs y call mtom call ndiv pops x ;[ptrb] pops y ;fb3i call mtom pops x ;[ptra] pops y ;fb3r call mtom mv x,fb1r call mv1 mv x,fb1i call mv0 nd71: ; no = Norm[{b2, b3}]; mv x,fb2r pushs x call mtox pops x call mtox call mul jpc err5 mv x,fb2i pushs x call mtox pops x call mtox call mul jpc err5 call ad jpc err5 mv x,fb3r pushs x call mtox pops x call mtox call mul jpc err5 mv x,fb3i pushs x call mtox pops x call mtox call mul jpc err5 call ad jpc err5 call ad jpc err5 mv x,fss call xtom ; r = Norm[{b1, no}]; mv x,fb1r mv a,[x] pushs a pushs x call mtox pops x pushs x call mtox pops x call mtox call mul jpc err5 mv x,fb1i pushs x call mtox pops x call mtox call mul jpc err5 call ad jpc err5 mv x,fss call mtox call ad jpc err5 call sqr jpc err5 ; b1 = b1 + r*If[Re[b1] >= 0, 1, -1]; pops a cmp a,0 jrz nd72 call sb jr nd73 nd72: call ad nd73: jpc err5 mv x,fb1r call xtom ; no = Norm[{b1, no}]^2; mv x,fb1r pushs x call mtox pops x call mtox call mul jpc err5 mv x,fb1i pushs x call mtox pops x call mtox call mul jpc err5 call ad jpc err5 mv x,fss pushs x call mtox call ad jpc err5 pops x call xtom ; If[no > 0, (==0, nd40) mv x,fss call is0 jpz nd40 ; d2 = Sqrt[2]/Sqrt[no]; mv x,fc_sqrt2 call mtox mv x,fss call mtox call sqr jpc err5 call div jpc err5 mv x,fd2r call xtom mv x,fb1r call mulxd2 mv x,fb1i call mulxd2 mv x,fb2r call mulxd2 mv x,fb2i call mulxd2 mv x,fb3r call mulxd2 mv x,fb3i call mulxd2 ; If[i - 1 >= 1, j = i - 1, j = 1]; mv a,[chari] sub a,1 jrnc nd74 mv a,0 nd74: mv [charj],a ; For[k = j, k <= m, k++, mv a,[charj] mv [chark],a nd20: ; d1 = Conjugate[b1]*a[[i, k]]; mv x,fb1r mv y,[ptra] call mtom mv x,fb1i mv y,[ptrb] pushs y call mtom pops x call chs mv a,[chari] mv [ptr1],a mv a,[chark] mv [ptr2],a call getoffset mv [inttmp0],i mv x,[ptrma] add x,i mv y,[ptrc] call mtom mv x,[ptrmn] add x,i mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,fd1r call mtom mv x,[ptrb] mv y,fd1i call mtom ; If[i + 1 <= n, d1 += Conjugate[b2]*a[[i + 1, k]];]; mv il,[charn1] mv a,[chari] inc a sub il,a jrc nd21 mv [ptr1],a call getoffset mv [inttmp1],i mv x,[ptrma] add x,i mv y,[ptra] call mtom mv x,[ptrmn] add x,i mv y,[ptrb] call mtom mv x,fb2r mv y,[ptrc] call mtom mv x,fb2i mv y,[ptrd] pushs y call mtom pops x call chs call nmul call addfd1ab nd21: ; If[i + 2 <= n, d1 += Conjugate[b3]*a[[i + 2, k]];]; mv il,[charn1] mv a,[chari] add a,2 sub il,a jrc nd22 mv [ptr1],a call getoffset mv [inttmp2],i mv x,[ptrma] add x,i mv y,[ptra] call mtom mv x,[ptrmn] add x,i mv y,[ptrb] call mtom mv x,fb3r mv y,[ptrc] call mtom mv x,fb3i mv y,[ptrd] pushs y call mtom pops x call chs call nmul call addfd1ab nd22: ; a[[i, k]] -= b1*d1; mv x,fd1r mv y,[ptrc] call mtom mv x,fd1i mv y,[ptrd] call mtom mv x,fb1r mv y,[ptra] call mtom mv x,fb1i mv y,[ptrb] call mtom call nmul mv i,[inttmp0] call submamnab ; If[i + 1 <= n, a[[i + 1, k]] -= b2*d1;]; mv il,[charn1] mv a,[chari] inc a sub il,a jrc nd23 mv x,fb2r mv y,[ptra] call mtom mv x,fb2i mv y,[ptrb] call mtom call nmul mv i,[inttmp1] call submamnab nd23: ; If[i + 2 <= n, a[[i + 2, k]] -= b3*d1;]; mv il,[charn1] mv a,[chari] add a,2 sub il,a jrc nd24 mv x,fb3r mv y,[ptra] call mtom mv x,fb3i mv y,[ptrb] call mtom call nmul mv i,[inttmp2] call submamnab nd24: ; ]; (k++, to [charm]-1, nd20) mv a,[chark] inc a mv [chark],a mv il,[charm1] sub il,a jpnc nd20 ; If[i + 3 <= m, j = i + 3, j = m]; mv a,[chari] add a,3 mv il,[charm1] sub il,a jrnc nd25 mv a,[charm1] nd25: mv [charj],a ; For[k = 1, k <= j, k++, mv a,0 mv [chark],a nd30: ; d1 = b1*a[[k, i]]; mv x,fb1r mv y,[ptra] call mtom mv x,fb1i mv y,[ptrb] call mtom mv a,[chark] mv [ptr1],a mv a,[chari] mv [ptr2],a call getoffset mv [inttmp0],i mv x,[ptrma] add x,i mv y,[ptrc] call mtom mv x,[ptrmn] add x,i mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,fd1r call mtom mv x,[ptrb] mv y,fd1i call mtom ; If[i + 1 <= n, d1 += b2*a[[k, i + 1]];]; mv il,[charn1] mv a,[chari] inc a sub il,a jrc nd31 mv [ptr2],a call getoffset mv [inttmp1],i mv x,[ptrma] add x,i mv y,[ptra] call mtom mv x,[ptrmn] add x,i mv y,[ptrb] call mtom mv x,fb2r mv y,[ptrc] call mtom mv x,fb2i mv y,[ptrd] call mtom call nmul call addfd1ab nd31: ; If[i + 2 <= n, d1 += b3*a[[k, i + 2]];]; mv il,[charn1] mv a,[chari] add a,2 sub il,a jrc nd32 mv [ptr2],a call getoffset mv [inttmp2],i mv x,[ptrma] add x,i mv y,[ptra] call mtom mv x,[ptrmn] add x,i mv y,[ptrb] call mtom mv x,fb3r mv y,[ptrc] call mtom mv x,fb3i mv y,[ptrd] call mtom call nmul call addfd1ab nd32: ; a[[k, i]] -= Conjugate[b1]*d1; mv x,fd1r mv y,[ptrc] call mtom mv x,fd1i mv y,[ptrd] call mtom mv x,fb1r mv y,[ptra] call mtom mv x,fb1i mv y,[ptrb] pushs y call mtom pops x call chs call nmul mv i,[inttmp0] call submamnab ; If[i + 1 <= n, a[[k, i + 1]] -= Conjugate[b2]*d1;]; mv il,[charn1] mv a,[chari] inc a sub il,a jrc nd33 mv x,fb2r mv y,[ptra] call mtom mv x,fb2i mv y,[ptrb] pushs y call mtom pops x call chs call nmul mv i,[inttmp1] call submamnab nd33: ; If[i + 2 <= n, a[[k, i + 2]] -= Conjugate[b3]*d1;]; mv il,[charn1] mv a,[chari] add a,2 sub il,a jrc nd34 mv x,fb3r mv y,[ptra] call mtom mv x,fb3i mv y,[ptrb] pushs y call mtom pops x call chs call nmul mv i,[inttmp2] call submamnab nd34: ; ]; (k++, to [charj], nd30) mv a,[chark] inc a mv [chark],a mv il,[charj] sub il,a jpnc nd30 ; ]; nd40: ; ]; (i++, to [charm]-2, nd50) mv a,[chari] inc a mv [chari],a mv il,[charm1] dec il sub il,a jpnc nd50 ret submamnab: pushs i mv x,[ptrma] add x,i pushs x call mtox mv x,[ptra] call mtox call sb jpc err5 pops x call xtom pops i mv x,[ptrmn] add x,i pushs x call mtox mv x,[ptrb] call mtox call sb jpc err5 pops x jp xtom mulxd2: pushs x call mtox mv x,fd2r call mtox call mul jrc err5 pops x jp xtom addfb1ab: mv x,fb1r call addfd1ab00 mv x,fb1i jr addfd1ab01 addfd1ab: mv x,fd1r call addfd1ab00 mv x,fd1i ; addfd1ab01: pushs x call mtox mv x,[ptrb] call mtox call ad jrc err5 pops x jp xtom addfd1ab00: pushs x call mtox mv x,[ptra] call mtox call ad jrc err5 pops x jp xtom err5: mv a,5 ;error on dblqrlp jp err fcc: ds 7 chari: ds 1 inttmp0:ds 2 inttmp1:ds 2 inttmp2:ds 2 fss: ds 7 fun: ds 7 fd1r: ds 7 fd1i: ds 7 fd2r: ds 7 fd2i: ds 7 nhh: call findsingle mv a,'A' call findmat00 mv [ptrma],x mv a,'B' call findmat00 mv [ptrmb],x mv a,'F' call findmat00 mv [ptrmf],x mv a,'G' call findmat00 mv [ptrmg],x mv a,'N' call findmat00 mv [ptrmn],x mv a,'O' call findmat00 mv [ptrmo],x mv a,'S' call findmat00 mv [ptrms],x mv a,'T' call findmat00 mv [ptrmt],x call finde0e1e2 ;7220 "MHH" ;7221 WAIT 0:PRINT "ﾊｳｽﾎﾙﾀﾞ-ﾍﾝｶﾝ ｼﾃｲﾏｽ"; ;qh の領域は MF, MS に取る。 ;qh=I mv a,0 mv [ptr1],a nh100: mv a,0 mv [ptr2],a nh110: call getoffset mv x,[ptrms] add x,i call mv0 mv x,[ptrmf] add x,i mv a,[ptr1] mv il,[ptr2] sub il,a jrz nh111 call mv0 jr nh112 nh111: call mv1 nh112: mv a,[ptr2] inc a mv [ptr2],a mv il,[charn1] sub il,a jrnc nh110 mv a,[ptr1] inc a mv [ptr1],a mv il,[charn1] sub il,a jrnc nh100 ;7230 FOR K=0TO N-3 mv a,0 mv [chark],a nh00: ;7231 PRINT "."; call printdot ;7240 FOR I=0TO K mv a,0 mv [chari],a nh01: ;7241 MB(I,0)=0:MO(I,0)=0 mv a,[chari] mv [ptr1],a mv a,0 mv [ptr2],a call getoffset mv x,[ptrmb] add x,i call mv0 mv x,[ptrmo] add x,i call mv0 ;7242 NEXT I mv a,[chari] inc a mv [chari],a mv il,[chark] sub il,a jrnc nh01 ;7243 FOR I=K+1TO N-1 mv a,[chark] inc a mv [chari],a nh02: ;7244 MB(I,0)=MA(I,K) mv a,[chari] mv [ptr1],a mv a,[chark] mv [ptr2],a call getoffset mv [inttmp0],i mv x,[ptrma] add x,i pushs x mv a,0 mv [ptr2],a call getoffset mv [inttmp1],i mv y,[ptrmb] add y,i pops x call mtom ;7245 MO(I,0)=MN(I,K) mv x,[ptrmn] mv i,[inttmp0] add x,i mv y,[ptrmo] mv i,[inttmp1] add y,i call mtom ;7246 NEXT I (TO N-1, nh02) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jrnc nh02 ;7250 D=MO(K+1,0) mv a,[chark] inc a mv [ptr1],a mv a,0 mv [ptr2],a call getoffset mv [inttmp0],i mv x,[ptrmo] add x,i mv y,[ptrd] call mtom ;7251 IF ABS D>E3 THEN mv x,[ptrd] mv y,[ptrf] pushs y call mtom pops x mv a,0 mv [x],a mv y,[ptre3] call cp ;E3 - ABS D jrnc nh7255 ;7252 C=MB(K+1,0):A=1:B=0:CALL FDIV:C=A:D=B mv x,[ptrmb] mv i,[inttmp0] add x,i mv y,[ptrc] call mtom mv x,[ptra] call mv1 mv x,[ptrb] call mv0 call ndiv mv x,[ptra] mv y,[ptrc] call mtom mv x,[ptrb] mv y,[ptrd] call mtom ;FOR I=K+1TO N-1 mv a,[chark] inc a mv [chari],a nh03: ;7253 A=MB(I,0):B=MO(I,0):CALL FMUL:MB(I,0)=A:MO(I,0)=B mv a,[chari] mv [ptr1],a mv a,0 mv [ptr2],a call getoffset mv [inttmp0],i mv x,[ptrmb] add x,i mv y,[ptra] call mtom mv x,[ptrmo] add x,i mv y,[ptrb] call mtom call nmul mv x,[ptra] mv y,[ptrmb] mv i,[inttmp0] add y,i call mtom mv x,[ptrb] mv y,[ptrmo] add y,i call mtom ;7254 NEXT I (TO N-1,nh03) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jrnc nh03 ;7255 ENDIF nh7255: ;7260 SS=0:FOR I=K+2TO N-1 mv x,fss call mv0 mv a,[chark] add a,2 mv [chari],a nh04: ;7261 A=MB(I,0):B=MO(I,0):SS=SS+A*A+B*B mv a,[chari] mv [ptr1],a mv a,0 mv [ptr2],a call getoffset pushs i mv x,[ptrmb] add x,i pushs x call mtox pops x call mtox call mul jpc err7 pops i mv x,[ptrmo] add x,i pushs x call mtox pops x call mtox call mul jpc err7 call ad jpc err7 mv x,fss call mtox call ad jpc err7 mv x,fss call xtom ;7262 NEXT I (TO N-1, nh04) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jrnc nh04 ;7270 IF SS=0THEN 7320 mv x,fss call is0 jpz nh7320 ;この列はすでにヘッセンベルグ型になっています ;7271 A=MB(K+1,0):S=SQR (SS+A*A) mv a,[chark] inc a mv [ptr1],a mv a,0 mv [ptr2],a call getoffset pushs i mv x,[ptrmb] add x,i mv y,[ptra] call mtom mv x,[ptra] pushs x call mtox pops x call mtox call mul jpc err7 mv x,fss call mtox call ad jpc err7 call sqr jpc err7 mv x,[ptrs] call xtom ;7272 IF A>=0THEN S=-S mv x,[ptra] mv a,[x] cmp a,8 jrz nh7273 mv x,[ptrs] call chs nh7273: ;7273 A=A-S:MB(K+1,0)=A mv x,[ptra] pushs x call mtox mv x,[ptrs] call mtox call sb jpc err7 pops x call xtom mv x,[ptra] mv y,[ptrmb] pops i add y,i call mtom ;7274 UN=SQR (SS+A*A) mv x,[ptra] pushs x call mtox pops x call mtox call mul jpc err7 mv x,fss call mtox call ad jpc err7 call sqr jpc err7 mv x,fun call xtom ;7275 FOR I=K+1TO N-1 mv a,[chark] inc a mv [chari],a nh05: ;7276 MB(I,0)=MB(I,0)/UN mv a,[chari] mv [ptr1],a mv a,0 mv [ptr2],a call getoffset pushs i mv x,[ptrmb] add x,i pushs x call mtox mv x,fun call mtox call div jpc err7 pops x call xtom ;7277 MO(I,0)=MO(I,0)/UN pops i mv x,[ptrmo] add x,i pushs x call mtox mv x,fun call mtox call div jpc err7 pops x call xtom ;7278 NEXT I (TO N-1, nh05) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jrnc nh05 ;7280 FOR I=0TO N-1 mv a,0 mv [chari],a nh10: ;7281 D1R=0:D1I=0:D2R=0:D2I=0 mv x,fd1r call mv0 mv x,fd1i call mv0 mv x,fd2r call mv0 mv x,fd2i call mv0 ;7282 FOR J=K+1TO N-1 mv a,[chark] inc a mv [charj],a nh11: ;7283 A=MA(I,J):B=MN(I,J):C=MB(J,0):D=MO(J,0):CALL FMUL mv a,[chari] mv [ptr1],a mv a,[charj] mv [ptr2],a call getoffset mv x,[ptrma] add x,i mv y,[ptra] call mtom mv x,[ptrmn] add x,i mv y,[ptrb] call mtom mv a,[charj] mv [ptr1],a mv a,0 mv [ptr2],a call getoffset mv x,[ptrmb] add x,i mv y,[ptrc] call mtom mv x,[ptrmo] add x,i mv y,[ptrd] call mtom call nmul ;7284 D1R=D1R+A:D1I=D1I+B mv x,fd1r pushs x call mtox mv x,[ptra] call mtox call ad jpc err7 pops x call xtom mv x,fd1i pushs x call mtox mv x,[ptrb] call mtox call ad jpc err7 pops x call xtom ;7285 A=MA(J,I):B=-MN(J,I):CALL FMUL mv a,[charj] mv [ptr1],a mv a,[chari] mv [ptr2],a call getoffset mv x,[ptrma] add x,i mv y,[ptra] call mtom mv x,[ptrmn] add x,i mv y,[ptrb] pushs y call mtom pops x call chs call nmul ;7286 D2R=D2R+A:D2I=D2I+B mv x,fd2r pushs x call mtox mv x,[ptra] call mtox call ad jpc err7 pops x call xtom mv x,fd2i pushs x call mtox mv x,[ptrb] call mtox call ad jpc err7 pops x call xtom ;7287 NEXT J (TO N-1, nh11) mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jpnc nh11 ;7288 MB(I,1)=D1R:MO(I,1)=D1I mv a,[chari] mv [ptr1],a mv a,1 mv [ptr2],a call getoffset mv x,fd1r mv y,[ptrmb] add y,i call mtom mv x,fd1i mv y,[ptrmo] add y,i call mtom ;7289 MB(I,2)=D2R:MO(I,2)=D2I mv a,2 mv [ptr2],a call getoffset mv x,fd2r mv y,[ptrmb] add y,i call mtom mv x,fd2i mv y,[ptrmo] add y,i call mtom ;7290 NEXT I (TO N-1, nh10) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jpnc nh10 ;7291 D1R=0:D1I=0:D2R=0:D2I=0 mv x,fd1r call mv0 mv x,fd1i call mv0 mv x,fd2r call mv0 mv x,fd2i call mv0 ;7292 FOR I=K+1TO N-1 mv a,[chark] inc a mv [chari],a nh20: ;7293 A=MB(I,1):B=MO(I,1):C=MB(I,0):D=-MO(I,0):CALL FMUL mv a,[chari] mv [ptr1],a mv a,1 mv [ptr2],a call getoffset mv x,[ptrmb] add x,i mv y,[ptra] call mtom mv x,[ptrmo] add x,i mv y,[ptrb] call mtom mv a,[chari] mv [ptr1],a mv a,0 mv [ptr2],a call getoffset mv x,[ptrmb] add x,i mv y,[ptrc] call mtom mv x,[ptrmo] add x,i mv y,[ptrd] pushs y call mtom pops x call chs call nmul ;7294 D1R=D1R+A:D1I=D1I+B mv x,fd1r pushs x call mtox mv x,[ptra] call mtox call ad jpc err7 pops x call xtom mv x,fd1i pushs x call mtox mv x,[ptrb] call mtox call ad jpc err7 pops x call xtom ;7295 A=MB(I,2):B=MO(I,2):CALL FMUL mv a,[chari] mv [ptr1],a mv a,2 mv [ptr2],a call getoffset mv x,[ptrmb] add x,i mv y,[ptra] call mtom mv x,[ptrmo] add x,i mv y,[ptrb] call mtom call nmul ;7296 D2R=D2R+A:D2I=D2I+B mv x,fd2r pushs x call mtox mv x,[ptra] call mtox call ad jpc err7 pops x call xtom mv x,fd2i pushs x call mtox mv x,[ptrb] call mtox call ad jpc err7 pops x call xtom ;7297 NEXT I (TO N-1, nh20) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jpnc nh20 ;7300 FOR I=0TO N-1 mv a,0 mv [chari],a nh30: ;7301 C=MB(I,0):D=MO(I,0) mv a,[chari] mv [ptr1],a mv a,0 mv [ptr2],a call getoffset mv x,[ptrmb] add x,i mv y,[ptrc] call mtom mv x,[ptrmo] add x,i mv y,[ptrd] call mtom ;7302 A=D1R:B=D1I:CALL FMUL mv x,fd1r mv y,[ptra] call mtom mv x,fd1i mv y,[ptrb] call mtom call nmul ;7303 MB(I,1)=2*(MB(I,1)-A) mv a,1 mv [ptr2],a call getoffset pushs i mv x,[ptrmb] add x,i pushs x call mtox mv x,[ptra] call mtox call sb jpc err7 pops x pushs x call xtom pops x pushs x call mtox pops x pushs x call mtox call ad jpc err7 pops x call xtom ;7304 MO(I,1)=2*(MO(I,1)-B) pops i mv x,[ptrmo] add x,i pushs x call mtox mv x,[ptrb] call mtox call sb jpc err7 pops x pushs x call xtom pops x pushs x call mtox pops x pushs x call mtox call ad jpc err7 pops x call xtom ;7305 A=D2R:B=D2I:CALL FMUL mv x,fd2r mv y,[ptra] call mtom mv x,fd2i mv y,[ptrb] call mtom call nmul ;7306 MB(I,2)=2*(MB(I,2)-A) mv a,2 mv [ptr2],a call getoffset pushs i mv x,[ptrmb] add x,i pushs x call mtox mv x,[ptra] call mtox call sb jpc err7 pops x pushs x call xtom pops x pushs x call mtox pops x pushs x call mtox call ad jpc err7 pops x call xtom ;7307 MO(I,2)=2*(MO(I,2)-B) pops i mv x,[ptrmo] add x,i pushs x call mtox mv x,[ptrb] call mtox call sb jpc err7 pops x pushs x call xtom pops x pushs x call mtox pops x pushs x call mtox call ad jpc err7 pops x call xtom ;7308 NEXT I (TO N-1, nh30) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jpnc nh30 ;7310 FOR I=0TO N-1:FOR J=0TO N-1 mv a,0 mv [chari],a nh40: mv a,0 mv [charj],a nh41: ;7311 A=MB(I,0):B=MO(I,0):C=MB(J,2):D=-MO(J,2):CALL FMUL mv a,[chari] mv [ptr1],a mv a,0 mv [ptr2],a call getoffset mv x,[ptrmb] add x,i mv y,[ptra] call mtom mv x,[ptrmo] add x,i mv y,[ptrb] call mtom mv a,[charj] mv [ptr1],a mv a,2 mv [ptr2],a call getoffset mv x,[ptrmb] add x,i mv y,[ptrc] call mtom mv x,[ptrmo] add x,i mv y,[ptrd] pushs y call mtom pops x call chs call nmul ;7312 P=A:Q=B mv x,[ptra] mv y,[ptrp] call mtom mv x,[ptrb] mv y,[ptrq] call mtom ;7313 A=MB(I,1):B=MO(I,1):C=MB(J,0):D=-MO(J,0):CALL FMUL mv a,[chari] mv [ptr1],a mv a,1 mv [ptr2],a call getoffset mv x,[ptrmb] add x,i mv y,[ptra] call mtom mv x,[ptrmo] add x,i mv y,[ptrb] call mtom mv a,[charj] mv [ptr1],a mv a,0 mv [ptr2],a call getoffset mv x,[ptrmb] add x,i mv y,[ptrc] call mtom mv x,[ptrmo] add x,i mv y,[ptrd] pushs y call mtom pops x call chs call nmul ;7314 MA(I,J)=MA(I,J)-P-A mv a,[chari] mv [ptr1],a mv a,[charj] mv [ptr2],a call getoffset pushs i mv x,[ptrma] add x,i pushs x call mtox mv x,[ptrp] call mtox call sb jpc err7 mv x,[ptra] call mtox call sb jpc err7 pops x call xtom ;7315 MN(I,J)=MN(I,J)-Q-B pops i mv x,[ptrmn] add x,i pushs x call mtox mv x,[ptrq] call mtox call sb jpc err7 mv x,[ptrb] call mtox call sb jpc err7 pops x call xtom ;7316 NEXT J (TO N-1, nh41):NEXT I (TO N-1, nh40) mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jpnc nh41 mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jpnc nh40 ;qh の領域は MF, MS に取る。 ; For[i = 1, i ? n, i++, ←　新たに付け加えた「qh *= q」 mv a,0 mv [chari],a nh200: ; d3 = 0; mv x,fd1r call mv0 mv x,fd1i call mv0 ; For[j = k + 1, j ? n, j++, mv a,[chark] inc a mv [charj],a nh210: ; d3 += qh[[i, j]]*u[[j]] --> u[[j]]=MB(j,0), MO(j,0); mv a,[chari] mv [ptr1],a mv a,[charj] mv [ptr2],a call getoffset mv x,[ptrmf] add x,i mv y,[ptra] call mtom mv x,[ptrms] add x,i mv y,[ptrb] call mtom mv a,[charj] mv [ptr1],a mv a,0 mv [ptr2],a call getoffset mv x,[ptrmb] add x,i mv y,[ptrc] call mtom mv x,[ptrmo] add x,i mv y,[ptrd] call mtom call nmul mv x,fd1r pushs x call mtox mv x,[ptra] call mtox call ad jpc err7 pops x call xtom mv x,fd1i pushs x call mtox mv x,[ptrb] call mtox call ad jpc err7 pops x call xtom ; ]; (j++, to n-1, nh210) mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc nh210 ; For[j = k + 1, j ? n, j++, mv a,[chark] inc a mv [charj],a nh220: ; qh[[i, j]] -= (2*Conjugate[u[[j]]]*d3) --> u[[j]]=MB(j,0), MO(j,0); mv a,[charj] mv [ptr1],a mv a,0 mv [ptr2],a call getoffset mv x,[ptrmb] add x,i mv y,[ptra] call mtom mv x,[ptrmo] add x,i mv y,[ptrb] pushs y call mtom pops x call chs mv x,fd1r mv y,[ptrc] call mtom mv x,fd1i mv y,[ptrd] call mtom call nmul mv x,[ptra] pushs x call mtox pops x pushs x call mtox call ad jrc err7 pops x call xtom mv x,[ptrb] pushs x call mtox pops x pushs x call mtox call ad jrc err7 pops x call xtom mv a,[chari] mv [ptr1],a mv a,[charj] mv [ptr2],a call getoffset pushs i mv x,[ptrmf] add x,i pushs x call mtox mv x,[ptra] call mtox call sb jrc err7 pops x call xtom pops i mv x,[ptrms] add x,i pushs x call mtox mv x,[ptrb] call mtox call sb jrc err7 pops x call xtom ; ]; (j++, to n-1, nh220) mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc nh220 ; ]; (i++, to n-1, nh200) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jpnc nh200 nh7320: ;7320 NEXT K (TO N-3,nh00):PRINT "ﾍﾝｶﾝ ｶﾞ ｶﾝﾘｮｳｼﾏｼﾀ":RETURN mv a,[chark] inc a mv [chark],a mv il,[charn2] dec il sub il,a jpnc nh00 mv x,[ptrma] mv y,[ptrmg] mv i,[lengthofmatrix] nh300: mv a,[x++] mv [y++],a dec i jrnz nh300 mv x,[ptrmn] mv y,[ptrmt] mv i,[lengthofmatrix] nh301: mv a,[x++] mv [y++],a dec i jrnz nh301 ret err7: mv a,7 ;error on hh jp err nscale: call findsingle mv a,'D' call findmat00 mv [ptrmd],x mv a,'Q' call findmat00 mv [ptrmq],x ;12400 "MSCALE" ;12410 FOR J=0TO N-1 mv a,0 mv [charj],a ns00: ;12411 S=0:FOR K=0TO N-1 mv x,fss call mv0 mv a,0 mv [chark],a ns10: ;12412 A=MD(J,K):B=MQ(J,K):T=A*A+B*B mv a,[charj] mv [ptr1],a mv a,[chark] mv [ptr2],a call getoffset pushs i mv x,[ptrmd] add x,i pushs x call mtox pops x call mtox call mul jpc err8 pops i mv x,[ptrmq] add x,i pushs x call mtox pops x call mtox call mul jrc err8 call ad jrc err8 mv x,[ptrt] call xtom ;12413 IF T>S THEN S=T mv y,fss mv x,[ptrt] call cp jrnc ns11 mv x,[ptrt] mv y,fss call mtom ns11: ;12414 NEXT K (TO N-1, ns10) mv a,[chark] inc a mv [chark],a mv il,[charn1] sub il,a jrnc ns10 ;12415 IF S<>0 THEN (ns20) mv x,fss call is0 jrz ns20 ;12416 S=1/SQR S:FOR K=0TO N-1 mv x,[ptra] pushs x call mv1 pops x call mtox mv x,fss pushs x call mtox call sqr jrc err8 call div jrc err8 pops x call xtom mv a,0 mv [chark],a ns30: ;12417 MD(J,K)=MD(J,K)*S mv a,[charj] mv [ptr1],a mv a,[chark] mv [ptr2],a call getoffset pushs i mv x,[ptrmd] add x,i pushs x call mtox mv x,fss call mtox call mul jrc err8 pops x call xtom ;12418 MQ(J,K)=MQ(J,K)*S pops i mv x,[ptrmq] add x,i pushs x call mtox mv x,fss call mtox call mul jrc err8 pops x call xtom ;12419 NEXT K (TO N-1, ns30) mv a,[chark] inc a mv [chark],a mv il,[charn1] sub il,a jrnc ns30 ns20: ;12420 ENDIF ;12421 NEXT J (TO N-1, ns00):RETURN mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jpnc ns00 ret err8: mv a,8 ;error on scale jp err charpv: ds 16 charph: ds 16 fpp: ds 7 chark0: ds 1 charl0: ds 1 charfl: ds 1 nns: call findsingle mv a,'A' call findmat00 mv [ptrma],x mv a,'C' call findmat00 mv [ptrmc],x mv a,'N' call findmat00 mv [ptrmn],x mv a,'P' call findmat00 mv [ptrmp],x call finde0e1e2 ;12020 FOR J=0 TO N-1:PV(J)=J:NEXT J mv a,0 mv x,charpv nn00: mv [x++],a inc a mv il,[charn1] sub il,a jrnc nn00 ;12030 FOR J=0 TO N-2 mv a,0 mv [charj],a nn10: ;12040 A=MC(PV(J),J):B=MP(PV(J),J):P=A*A+B*B mv x,charpv mv a,[charj] mv [ptr2],a add x,a mv a,[x] mv [ptr1],a call getoffset pushs i mv x,[ptrmc] add x,i pushs x call mtox pops x call mtox call mul jpc err9 pops i mv x,[ptrmp] add x,i pushs x call mtox pops x call mtox call mul jpc err9 call ad jpc err9 mv x,[ptrp] call xtom ;12041 K0=J mv a,[charj] mv [chark0],a ;12050 FOR K=J+1 TO N-1 mv a,[charj] inc a mv [chark],a nn20: ;12051 A=MC(PV(K),J):B=MP(PV(K),J):PP=A*A+B*B mv x,charpv mv a,[chark] add x,a mv a,[x] mv [ptr1],a mv a,[charj] mv [ptr2],a call getoffset pushs i mv x,[ptrmc] add x,i pushs x call mtox pops x call mtox call mul jpc err9 pops i mv x,[ptrmp] add x,i pushs x call mtox pops x call mtox call mul jpc err9 call ad jpc err9 mv x,fpp call xtom ;12052 IF PP>=P THEN K0=K:P=PP mv y,fpp mv x,[ptrp] call cp jrc nn21 mv a,[chark] mv [chark0],a mv x,fpp mv y,[ptrp] call mtom nn21: ;12053 NEXT K (TO N-1, nn20) mv a,[chark] inc a mv [chark],a mv il,[charn1] sub il,a jrnc nn20 ;12060 IF K0<>J THEN P=PV(J):PV(J)=PV(K0):PV(K0)=P mv a,[charj] mv il,[chark0] sub il,a jrz nn22 add il,a mv x,charpv mv y,x add x,a mv a,[x] add y,il mv il,[y] mv [y],a mv [x],il nn22: ;12070 A=MC(PV(J),J):B=MP(PV(J),J):P=SQR (A*A+B*B) mv x,charpv mv a,[charj] mv [ptr2],a add x,a mv a,[x] mv [ptr1],a call getoffset pushs i mv x,[ptrmc] add x,i pushs x call mtox pops x call mtox call mul jpc err9 pops i mv x,[ptrmp] add x,i pushs x call mtox pops x call mtox call mul jpc err9 call ad jpc err9 call sqr jpc err9 mv x,[ptrp] call xtom ;12071 IF P<=E1 THEN 12080 mv y,[ptre1] mv x,[ptrp] call cp jpnc nn12080 ;12072 FOR K=J+1 TO N-1 mv a,[charj] inc a mv [chark],a nn30: ;12073 A=MC(PV(K),J):B=MP(PV(K),J):C=MC(PV(J),J):D=MP(PV(J),J) mv x,charpv mv a,[chark] add x,a mv a,[x] mv [ptr1],a mv a,[charj] mv [ptr2],a call getoffset mv x,[ptrmc] add x,i mv y,[ptra] call mtom mv x,[ptrmp] add x,i mv y,[ptrb] call mtom mv x,charpv mv a,[charj] mv [ptr2],a add x,a mv a,[x] mv [ptr1],a call getoffset mv x,[ptrmc] add x,i mv y,[ptrc] call mtom mv x,[ptrmp] add x,i mv y,[ptrd] call mtom ;12074 CALL FDIV:C=A:D=B call ndiv mv x,[ptra] mv y,[ptrc] call mtom mv x,[ptrb] mv y,[ptrd] call mtom ;12075 FOR L=J+1 TO N-1 mv a,[charj] inc a mv [charl],a nn31: ;12076 A=MC(PV(J),L):B=MP(PV(J),L):CALL FMUL mv x,charpv mv a,[charj] add x,a mv a,[x] mv [ptr1],a mv a,[charl] mv [ptr2],a call getoffset mv x,[ptrmc] add x,i mv y,[ptra] call mtom mv x,[ptrmp] add x,i mv y,[ptrb] call mtom call nmul ;12077 MC(PV(K),L)=MC(PV(K),L)-A mv x,charpv mv a,[chark] add x,a mv a,[x] mv [ptr1],a call getoffset pushs i mv x,[ptrmc] add x,i pushs x call mtox mv x,[ptra] call mtox call sb jpc err9 pops x call xtom ;12078 MP(PV(K),L)=MP(PV(K),L)-B pops i mv x,[ptrmp] add x,i pushs x call mtox mv x,[ptrb] call mtox call sb jpc err9 pops x call xtom ;12079 NEXT L (TO N-1, nn31):NEXT K (TO N-1, nn30) mv a,[charl] inc a mv [charl],a mv il,[charn1] sub il,a jrnc nn31 mv a,[chark] inc a mv [chark],a mv il,[charn1] sub il,a jpnc nn30 nn12080: ;12080 NEXT J (TO N-2, nn10) mv a,[charj] inc a mv [charj],a mv il,[charn2] sub il,a jpnc nn10 ;12090 FL=0 mv a,0 mv [charfl],a ;12100 FOR J=N-1 TO 0 STEP -1 mv a,[charn1] mv [charj],a nn40: ;12101 SR=0:SI=0 mv x,fsr call mv0 mv x,fsi call mv0 ;12102 IF J=N-1 THEN 12110 mv a,[charj] mv il,[charn1] sub il,a jrz nn12110 ;12103 FOR K=N-1 TO J+1 STEP -1 mv a,[charn1] mv [chark],a nn41: ;12104 A=MA(K,P3):B=MN(K,P3):C=MC(PV(J),K):D=MP(PV(J),K) mv a,[chark] mv [ptr1],a mv a,[charm] mv [ptr2],a call getoffset mv x,[ptrma] add x,i mv y,[ptra] call mtom mv x,[ptrmn] add x,i mv y,[ptrb] call mtom mv x,charpv mv a,[charj] add x,a mv a,[x] mv [ptr1],a mv a,[chark] mv [ptr2],a call getoffset mv x,[ptrmc] add x,i mv y,[ptrc] call mtom mv x,[ptrmp] add x,i mv y,[ptrd] call mtom ;12105 CALL FMUL:SR=SR-A:SI=SI-B call nmul mv x,fsr pushs x call mtox mv x,[ptra] call mtox call sb jpc err9 pops x call xtom mv x,fsi pushs x call mtox mv x,[ptrb] call mtox call sb jpc err9 pops x call xtom ;12106 NEXT K (TO J+1 STEP -1, nn41) mv a,[chark] dec a mv [chark],a mv il,[charj] sub il,a jrnz nn41 nn12110: ;12110 P=MC(PV(J),J):Q=MP(PV(J),J) mv x,charpv mv a,[charj] mv [ptr2],a add x,a mv a,[x] mv [ptr1],a call getoffset mv x,[ptrmc] add x,i mv y,[ptrp] call mtom mv x,[ptrmp] add x,i mv y,[ptrq] call mtom ;12111 IF SQR (P*P+Q*Q)>E1 THEN 12120 mv x,[ptrp] pushs x call mtox pops x call mtox call mul jpc err9 mv x,[ptrq] pushs x call mtox pops x call mtox call mul jpc err9 call ad jpc err9 call sqr jpc err9 mv x,fcc pushs x call xtom mv y,[ptre1] pops x call cp jrc nn12120 ;12112 IF SQR (SR*SR+SI*SI)>E1 THEN J=-1:NEXT J:WAIT 0:PRINT "ｶｲ ｶﾞ ﾑｹﾞﾝﾀﾞｲﾆ ﾅﾘﾏｼﾀ.ｶﾝｾﾞﾝ ﾋﾟﾎﾞｯﾄ ｦ ｺｺﾛﾐﾏｽ":GOTO 12150 mv x,fsr pushs x call mtox pops x call mtox call mul jrc err9 mv x,fsi pushs x call mtox pops x call mtox call mul jrc err9 call ad jrc err9 call sqr jrc err9 mv x,fcc pushs x call xtom mv y,[ptre1] pops x call cp jrc errf0 ;12113 MA(J,P3)=1:MN(J,P3)=0:FL=1:GOTO 12130 mv a,[charj] mv [ptr1],a mv a,[charm] mv [ptr2],a call getoffset mv x,[ptrma] add x,i call mv1 mv x,[ptrmn] add x,i call mv0 mv a,1 mv [charfl],a jr nn12130 nn12120: ;12120 A=SR:B=SI:C=P:D=Q:CALL FDIV mv x,fsr mv y,[ptra] call mtom mv x,fsi mv y,[ptrb] call mtom mv x,[ptrp] mv y,[ptrc] call mtom mv x,[ptrq] mv y,[ptrd] call mtom call ndiv ;12121 MA(J,P3)=A:MN(J,P3)=B mv a,[charj] mv [ptr1],a mv a,[charm] mv [ptr2],a call getoffset mv x,[ptra] mv y,[ptrma] add y,i call mtom mv x,[ptrb] mv y,[ptrmn] add y,i call mtom nn12130: ;12130 NEXT J (TO 0 STEP -1, nn40) mv a,[charj] dec a mv [charj],a cmp a,0ffh jpnz nn40 ;12131 IF FL=0 THEN PRINT "ﾇﾙ ｽﾍﾟ-ｽ ﾊ ｱﾘﾏｾﾝ.ｶﾝｾﾞﾝ ﾋﾟﾎﾞｯﾄ ｦ ｺｺﾛﾐﾏｽ":GOTO 12150 mv a,[charfl] cmp a,0 jrz errf1 ;12140 RETURN ret err9: mv a,9 ;error on ns jp err errf0: mv a,0f0h ;ｶｲ ｶﾞ ﾑｹﾞﾝﾀﾞｲﾆ ﾅﾘﾏｼﾀ.ｶﾝｾﾞﾝ ﾋﾟﾎﾞｯﾄ ｦ ｺｺﾛﾐﾏｽ jp err errf1: mv a,0f1h ;ﾇﾙ ｽﾍﾟ-ｽ ﾊ ｱﾘﾏｾﾝ.ｶﾝｾﾞﾝ ﾋﾟﾎﾞｯﾄ ｦ ｺｺﾛﾐﾏｽ jp err faw: ds 7 nrcp: call findsingle mv a,'A' call findmat00 mv [ptrma],x mv a,'B' call findmat00 mv [ptrmb],x mv a,'N' call findmat00 mv [ptrmn],x mv a,'O' call findmat00 mv [ptrmo],x call finde0e1e2 ;8710 FOR J=0TO N-1:PV(J)=J:NEXT J mv a,0 mv x,charpv nr00: mv [x++],a inc a mv il,[charn1] sub il,a jrnc nr00 ;8720 FOR K=0TO N-1 mv a,0 mv [chark],a nr10: ;8730 A=MA(K,K):B=MN(K,K):AW=A*A+B*B:K0=K mv a,[chark] mv [ptr1],a mv [ptr2],a call getoffset pushs i mv x,[ptrma] add x,i pushs x call mtox pops x call mtox call mul jpc err11 pops i mv x,[ptrmn] add x,i pushs x call mtox pops x call mtox call mul jpc err11 call ad jpc err11 mv x,faw call xtom mv a,[chark] mv [chark0],a ;8740 FOR I=K TO N-1 mv a,[chark] mv [chari],a nr20: ;8741 A=MA(I,K):B=MN(I,K):C=A*A+B*B mv a,[chari] mv [ptr1],a mv a,[chark] mv [ptr2],a call getoffset pushs i mv x,[ptrma] add x,i pushs x call mtox pops x call mtox call mul jpc err11 pops i mv x,[ptrmn] add x,i pushs x call mtox pops x call mtox call mul jpc err11 call ad jpc err11 mv x,[ptrc] call xtom ;8742 IF AW<C THEN AW=C:K0=I mv y,faw mv x,[ptrc] call cp jrnc nr21 mv x,[ptrc] mv y,faw call mtom mv a,[chari] mv [chark0],a nr21: ;8743 NEXT I (TO N-1, nr20) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jrnc nr20 ;8744 IF SQR AW<=E2 THEN K=N:NEXT K:Z=3:GOSUB "MREAD0":WAIT 0:PRINT "ﾌﾞﾌﾞﾝﾋﾟﾎﾞｯﾄ ｶﾞ ｼｯﾊﾟｲｼﾏｼﾀ.ｶﾝｾﾞﾝﾋﾟﾎﾞｯﾄ ｦ ｺｺﾛﾐﾏｽ":GOTO "MRCPCP" mv x,faw pushs x call mtox call sqr jpc err11 pops x call xtom mv y,[ptre2] mv x,faw call cp jpnc errf2 ;8750 IF K<>K0 THEN mv a,[chark] mv il,[chark0] sub il,a jrz nr30 ;8751 FOR J=0TO N-1 mv a,0 mv [charj],a nr31: ;8752 A=MA(K,J):MA(K,J)=MA(K0,J):MA(K0,J)=A mv a,[charj] mv [ptr2],a mv a,[chark0] mv [ptr1],a call getoffset mv [inttmp0],i mv x,[ptrma] add x,i pushs x mv a,[chark] mv [ptr1],a call getoffset mv [inttmp1],i mv y,[ptrma] add y,i pops x call exchange ;8753 A=MN(K,J):MN(K,J)=MN(K0,J):MN(K0,J)=A mv x,[ptrmn] mv y,x mv i,[inttmp0] add x,i mv i,[inttmp1] add y,i call exchange ;8754 NEXT J (TO N-1, nr31) mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc nr31 ;8755 MW=PV(K):PV(K)=PV(K0):PV(K0)=MW mv x,charpv mv y,x mv a,[chark] add x,a mv a,[chark0] add y,a mv a,[x] mv il,[y] mv [x],il mv [y],a ;8756 ENDIF nr30: ;8760 A=1:B=0:C=MA(K,K):D=MN(K,K):CALL FDIV:C=A:D=B mv x,[ptra] call mv1 mv x,[ptrb] call mv0 mv a,[chark] mv [ptr1],a mv [ptr2],a call getoffset mv [inttmp0],i mv x,[ptrma] add x,i mv y,[ptrc] call mtom mv x,[ptrmn] add x,i mv y,[ptrd] call mtom call ndiv mv x,[ptra] mv y,[ptrc] call mtom mv x,[ptrb] mv y,[ptrd] call mtom ;8761 MA(K,K)=1:MN(K,K)=0 mv i,[inttmp0] mv x,[ptrma] add x,i call mv1 mv x,[ptrmn] add x,i call mv0 ;8762 FOR J=0TO N-1 mv a,0 mv [charj],a nr40: ;8763 A=MA(K,J):B=MN(K,J):CALL FMUL:MA(K,J)=A:MN(K,J)=B mv a,[chark] mv [ptr1],a mv a,[charj] mv [ptr2],a call getoffset mv x,[ptrma] add x,i pushs x mv y,[ptra] call mtom mv x,[ptrmn] add x,i pushs x mv y,[ptrb] call mtom call nmul mv x,[ptrb] pops y call mtom mv x,[ptra] pops y call mtom ;8764 NEXT J (TO N-1, nr40) mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc nr40 ;8770 FOR I=0TO N-1 mv a,0 mv [chari],a nr41: ;8771 IF I<>K THEN mv a,[chari] mv il,[chark] sub il,a jrz nr42 ;8772 C=MA(I,K):D=MN(I,K):MA(I,K)=0:MN(I,K)=0 mv a,[chari] mv [ptr1],a mv a,[chark] mv [ptr2],a call getoffset mv x,[ptrma] add x,i pushs x mv y,[ptrc] call mtom mv x,[ptrmn] add x,i pushs x mv y,[ptrd] call mtom pops x call mv0 pops x call mv0 ;8773 FOR J=0TO N-1 mv a,0 mv [charj],a nr43: ;8774 A=MA(K,J):B=MN(K,J):CALL FMUL mv a,[chark] mv [ptr1],a mv a,[charj] mv [ptr2],a call getoffset mv x,[ptrma] add x,i mv y,[ptra] call mtom mv x,[ptrmn] add x,i mv y,[ptrb] call mtom call nmul ;8775 MA(I,J)=MA(I,J)-A mv a,[chari] mv [ptr1],a call getoffset pushs i mv x,[ptrma] add x,i pushs x call mtox mv x,[ptra] call mtox call sb jpc err11 pops x call xtom ;8776 MN(I,J)=MN(I,J)-B pops i mv x,[ptrmn] add x,i pushs x call mtox mv x,[ptrb] call mtox call sb jpc err11 pops x call xtom ;8777 NEXT J (TO N-1, nr43) mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc nr43 ;8778 ENDIF nr42: ;8779 NEXT I (TO N-1, nr41) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jrnc nr41 ;8780 NEXT K (TO N-1, nr10) mv a,[chark] inc a mv [chark],a mv il,[charn1] sub il,a jpnc nr10 ;8790 FOR I=0TO N-1 mv a,0 mv [chari],a nr50: ;8791 FOR J=0TO N-1 mv a,0 mv [charj],a nr51: ;8792 MW=PV(J):MB(0,MW)=MA(I,J):MO(0,MW)=MN(I,J) mv a,[chari] mv [ptr1],a mv a,[charj] mv [ptr2],a call getoffset mv [inttmp0],i mv a,0 mv [ptr1],a mv a,[charj] mv x,charpv add x,a mv a,[x] mv [ptr2],a call getoffset mv [inttmp1],i mv x,[ptrma] mv i,[inttmp0] add x,i mv y,[ptrmb] mv i,[inttmp1] add y,i call mtom mv x,[ptrmn] mv i,[inttmp0] add x,i mv y,[ptrmo] mv i,[inttmp1] add y,i call mtom ;8793 NEXT J (TO N-1, nr51) mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc nr51 ;8794 FOR J=0TO N-1 mv a,0 mv [charj],a nr52: ;8795 MA(I,J)=MB(0,J):MN(I,J)=MO(0,J) mv a,[chari] mv [ptr1],a mv a,[charj] mv [ptr2],a call getoffset mv [inttmp0],i mv a,0 mv [ptr1],a call getoffset mv [inttmp1],i mv x,[ptrmb] mv i,[inttmp1] add x,i mv y,[ptrma] mv i,[inttmp0] add y,i call mtom mv x,[ptrmo] mv i,[inttmp1] add x,i mv y,[ptrmn] mv i,[inttmp0] add y,i call mtom ;8796 NEXT J (TO N-1, nr52) mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc nr52 ;8797 NEXT I (TO N-1, nr50) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jrnc nr50 ;8798 RETURN ret err11: mv a,11 ;error on rcp jp err errf2: mv a,0f2h ;ﾌﾞﾌﾞﾝﾋﾟﾎﾞｯﾄ ｶﾞ ｼｯﾊﾟｲｼﾏｼﾀ.ｶﾝｾﾞﾝﾋﾟﾎﾞｯﾄ ｦ ｺｺﾛﾐﾏｽ jp err ptrcr: ds 3 ptrci: ds 3 nmldia: call findsingle mv a,'B' call findmat00 mv [ptrmb],x mv a,'C' call findmat00 mv [ptrmc],x mv a,'O' call findmat00 mv [ptrmo],x mv a,'P' call findmat00 mv [ptrmp],x mv a,'R' call finddblarray mv [ptrcr],x mv a,'I' call finddblarray mv [ptrci],x ;9150 FOR J=0TO N-1:FOR K=0TO N-1 mv a,0 mv [charj],a nd00: mv a,0 mv [chark],a nd10: ;9151 A=MC(J,K):B=MP(J,K) mv a,[charj] mv [ptr1],a mv a,[chark] mv [ptr2],a call getoffset mv [inttmp0],i mv x,[ptrmc] add x,i mv y,[ptra] call mtom mv x,[ptrmp] add x,i mv y,[ptrb] call mtom ;9152 C=CR(K):D=CI(K) mv i,0 mv a,[chark] add i,a add i,i add i,i add i,i sub i,a mv x,[ptrcr] add x,i mv y,[ptrc] call mtom mv x,[ptrci] add x,i mv y,[ptrd] call mtom ;9153 CALL FMUL call nmul ;9154 MB(J,K)=A:MO(J,K)=B mv i,[inttmp0] mv x,[ptra] mv y,[ptrmb] add y,i call mtom mv x,[ptrb] mv y,[ptrmo] add y,i call mtom ;9155 NEXT K (TO N-1, nd10):NEXT J (TO N-1, nd00) mv a,[chark] inc a mv [chark],a mv il,[charn1] sub il,a jrnc nd10 mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc nd00 ret err12: mv a,12 ;error on mldia jp err ptrsc: ds 3 nscale2: call findsingle mv a,'A' call findmat00 mv [ptrma],x mv a,'N' call findmat00 mv [ptrmn],x mv a,'S' mv [fdbyte1],a mv a,'C' mv [fdbyte2],a call finddouble mv [ptrsc],x ;12500 "MSCALE2" ;12510 Q=0:FOR J=0TO N-1:FOR K=0TO N-1 mv x,[ptrq] call mv0 mv a,0 mv [charj],a ns40: mv a,0 mv [chark],a ns41: ;12511 P=MA(J,K)^2+MN(J,K)^2 mv a,[charj] mv [ptr1],a mv a,[chark] mv [ptr2],a call getoffset pushs i mv x,[ptrma] add x,i pushs x call mtox pops x call mtox call mul jpc err13 pops i mv x,[ptrmn] add x,i pushs x call mtox pops x call mtox call mul jpc err13 call ad jpc err13 mv x,[ptrp] call xtom ;12512 IF Q<P THEN Q=P mv y,[ptrq] mv x,[ptrp] call cp jrnc ns42 mv x,[ptrp] mv y,[ptrq] call mtom ns42: ;12513 NEXT K (TO N-1, ns41):NEXT J (TO N-1, ns40) mv a,[chark] inc a mv [chark],a mv il,[charn1] sub il,a jrnc ns41 mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc ns40 ;12520 IF Q>0 THEN mv x,[ptrq] call is0 jrz ns50 ;12521 SC=SQR Q:Q=1/SC mv x,[ptrq] call mtox call sqr jrc err13 mv x,[ptrsc] call xtom mv x,[ptrp] pushs x call mv1 pops x call mtox mv x,[ptrsc] call mtox call div jrc err13 mv x,[ptrq] call xtom ;12522 FOR J=0TO N-1:FOR K=0TO N-1 mv a,0 mv [charj],a ns60: mv a,0 mv [chark],a ns61: ;12523 MA(J,K)=MA(J,K)*Q ;12524 MN(J,K)=MN(J,K)*Q mv a,[charj] mv [ptr1],a mv a,[chark] mv [ptr2],a call getoffset pushs i mv x,[ptrma] add x,i pushs x call mtox mv x,[ptrq] call mtox call mul jrc err13 pops x call xtom pops i mv x,[ptrmn] add x,i pushs x call mtox mv x,[ptrq] call mtox call mul jrc err13 pops x call xtom ;12525 NEXT K (TO N-1, ns61):NEXT J (TO N-1, ns60) mv a,[chark] inc a mv [chark],a mv il,[charn1] sub il,a jrnc ns61 mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc ns60 ;12526 ENDIF ns50: ;12530 RETURN ret err13: mv a,13 ;error on scale2 jp err fx0: ds 7 fx1: fs1: ds 7 fx2: fs2: ds 7 fx3: fs3: ds 7 fx4: fs4: ds 7 fx5: fs5: ds 7 fw1: ds 7 fw2: ds 7 ptram: ds 3 njacobilp: call findsingle mv a,'A' call findmat00 mv [ptrma],x mv a,'B' call findmat00 mv [ptrmb],x mv a,'A' mv [fdbyte1],a mv a,'M' mv [fdbyte2],a call finddouble mv [ptram],x call finde0e1e2 ;9580 FOR I=0TO N-2 mv a,0 mv [chari],a nj00: ;9590 FOR J=I+1TO N-1 mv a,[chari] inc a mv [charj],a nj01: ;9600 W=ABS MA(I,J) mv a,[chari] mv [ptr1],a mv a,[charj] mv [ptr2],a call getoffset mv x,[ptrma] add x,i mv y,[ptrw] pushs y call mtom pops x mv a,[x] and a,0f7h mv [x],a ;9610 IF AM<W THEN AM=W:L=I:M=J mv y,[ptram] call cp ;AM - W jrnc nj02 mv x,[ptrw] mv y,[ptram] call mtom mv a,[chari] mv [charl],a mv a,[charj] mv [charm],a nj02: ;9620 NEXT J (TO N-1, nj01) mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc nj01 ;9630 NEXT I (TO N-2, nj00) mv a,[chari] inc a mv [chari],a mv il,[charn2] sub il,a jrnc nj00 ;9640 IF E0>=AM THEN 9800 mv y,[ptre0] mv x,[ptram] call cp ;E0 - AM jpnc quitjacobi ;9650 S1=MA(L,L) mv a,[charl] mv [ptr1],a mv [ptr2],a call getoffset mv x,[ptrma] add x,i mv y,fs1 call mtom ;9651 S2=MA(M,M) mv a,[charm] mv [ptr1],a mv [ptr2],a call getoffset mv x,[ptrma] add x,i mv y,fs2 call mtom ;9652 S3=MA(L,M) mv a,[charl] mv [ptr1],a call getoffset mv x,[ptrma] add x,i mv y,fs3 call mtom ;9660 W1=(S1-S2)*0.5 mv x,fs1 call mtox mv x,fs2 call mtox call sb jpc err14 mv x,[ptra] pushs x call mv0p5 pops x call mtox call mul jpc err14 mv x,fw1 pushs x call xtom ;9670 D=SQR (W1*W1+S3*S3) pops x pushs x call mtox pops x call mtox call mul jpc err14 mv x,fs3 pushs x call mtox pops x call mtox call mul jpc err14 call ad jpc err14 call sqr jpc err14 mv x,[ptrd] call xtom ;9680 IF W1<0THEN D=-D mv x,fw1 mv a,[x] cmp a,8 jrnz nj10 mv x,[ptrd] call chs nj10: ;9690 T=S3/(W1+D) mv x,fs3 call mtox mv x,fw1 call mtox mv x,[ptrd] call mtox call ad jpc err14 call div jpc err14 mv x,[ptrt] call xtom ;9700 C=1/SQR (1+T*T) mv x,[ptrc] pushs x call mv1 pops x pushs x call mtox pops x call mtox mv x,[ptrt] pushs x call mtox pops x call mtox call mul jpc err14 call ad jpc err14 call sqr jpc err14 call div jpc err14 mv x,[ptrc] pushs x call xtom ;9710 S=C*T pops x call mtox mv x,[ptrt] call mtox call mul jpc err14 mv x,[ptrs] call xtom ;9720 FOR I=0TO N-1 mv a,0 mv [chari],a nj20: ;9730 S4=MB(I,L) mv a,[chari] mv [ptr1],a mv a,[charl] mv [ptr2],a call getoffset mv x,[ptrmb] add x,i mv y,fs4 call mtom ;9731 S5=MB(I,M) mv a,[charm] mv [ptr2],a call getoffset mv x,[ptrmb] add x,i mv y,fs5 call mtom ;9740 MB(I,L)=S4*C+S5*S mv x,fs4 call mtox mv x,[ptrc] call mtox call mul jpc err14 mv x,fs5 call mtox mv x,[ptrs] call mtox call mul jpc err14 call ad jpc err14 mv a,[charl] mv [ptr2],a call getoffset mv x,[ptrmb] add x,i call xtom ;9741 MB(I,M)=S5*C-S4*S mv x,fs5 call mtox mv x,[ptrc] call mtox call mul jpc err14 mv x,fs4 call mtox mv x,[ptrs] call mtox call mul jpc err14 call sb jpc err14 mv a,[charm] mv [ptr2],a call getoffset mv x,[ptrmb] add x,i call xtom ;9750 IF I<>L OR I<>M THEN mv a,[chari] mv il,[charl] sub il,a jrnz nj21 mv il,[charm] sub il,a jpz nj22 nj21: ;S4=MA(I,L): mv a,[chari] mv [ptr1],a mv a,[charl] mv [ptr2],a call getoffset mv x,[ptrma] add x,i mv y,fs4 call mtom ;S5=MA(I,M): mv a,[charm] mv [ptr2],a call getoffset mv x,[ptrma] add x,i mv y,fs5 call mtom ;MA(I,L)=S4*C+S5*S: mv x,fs4 call mtox mv x,[ptrc] call mtox call mul jpc err14 mv x,fs5 call mtox mv x,[ptrs] call mtox call mul jpc err14 call ad jpc err14 mv a,[charl] mv [ptr2],a call getoffset mv x,[ptrma] add x,i call xtom ;MA(I,M)=S5*C-S4*S: mv x,fs5 call mtox mv x,[ptrc] call mtox call mul jpc err14 mv x,fs4 call mtox mv x,[ptrs] call mtox call mul jpc err14 call sb jpc err14 mv a,[charm] mv [ptr2],a call getoffset mv x,[ptrma] add x,i call xtom ;MA(L,I)=MA(I,L): mv a,[chari] mv [ptr1],a mv a,[charl] mv [ptr2],a call getoffset pushs i mv a,[charl] mv [ptr1],a mv a,[chari] mv [ptr2],a call getoffset mv y,[ptrma] mv x,y add y,i pops i add x,i call mtom ;MA(M,I)=MA(I,M) mv a,[chari] mv [ptr1],a mv a,[charm] mv [ptr2],a call getoffset pushs i mv a,[charm] mv [ptr1],a mv a,[chari] mv [ptr2],a call getoffset mv y,[ptrma] mv x,y add y,i pops i add x,i call mtom nj22: ;9760 NEXT I (TO N-1, nj20) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jpnc nj20 ;9770 W2=2*S3*S*C mv x,fs3 call mtox mv x,[ptrs] call mtox call mul jpc err14 mv x,[ptrc] call mtox call mul jpc err14 mv x,fw2 pushs x call xtom pops x pushs x call mtox pops x pushs x call mtox call ad jpc err14 pops x call xtom ;9780 MA(L,L)=S1*C*C+S2*S*S+W2 mv x,fs1 call mtox mv x,[ptrc] pushs x call mtox call mul jpc err14 pops x call mtox call mul jpc err14 mv x,fs2 call mtox mv x,[ptrs] pushs x call mtox call mul jpc err14 pops x call mtox call mul jpc err14 call ad jpc err14 mv x,fw2 call mtox call ad jpc err14 mv a,[charl] mv [ptr1],a mv [ptr2],a call getoffset mv x,[ptrma] add x,i call xtom ;9781 MA(M,M)=S2*C*C+S1*S*S-W2 mv x,fs2 call mtox mv x,[ptrc] pushs x call mtox call mul jrc err14 pops x call mtox call mul jrc err14 mv x,fs1 call mtox mv x,[ptrs] pushs x call mtox call mul jrc err14 pops x call mtox call mul jrc err14 call ad jrc err14 mv x,fw2 call mtox call sb jrc err14 mv a,[charm] mv [ptr1],a mv [ptr2],a call getoffset mv x,[ptrma] add x,i call xtom ;9782 MA(L,M)=0 mv a,[charl] mv [ptr1],a mv a,[charm] mv [ptr2],a call getoffset mv x,[ptrma] add x,i call mv0 ;9783 MA(M,L)=0 mv a,[charm] mv [ptr1],a mv a,[charl] mv [ptr2],a call getoffset mv x,[ptrma] add x,i call mv0 ;9790 GOTO 9570 ret err14: mv a,14 ;error on jacobi loop jp err quitjacobi: mv a,0e0h ;quit jacobi loop jp err ptrda: ds 3 nframelp: call findsingle mv a,'R' call finddblarray mv [ptrcr],x mv a,'I' call finddblarray mv [ptrci],x mv a,'D' call findsnglarray mv [ptrda],x call finde0e1e2 ;10170 PRINT ".";:F=0:FOR I=0TO N-1 mv x,[ptrf] call mv0 mv a,0 mv [chari],a nf00: mv i,0 mv a,[chari] add i,a add i,i add i,i add i,i sub i,a mv [inttmp0],i ;10171 X0=1:X1=0: mv x,fx0 call mv1 mv x,fx1 call mv0 ;FOR J=0TO N-1: mv a,0 mv [charj],a nf10: mv i,0 mv a,[charj] add i,a add i,i add i,i add i,i sub i,a mv [inttmp1],i ;X=X0*CR(I)-X1*CI(I): mv x,fx0 call mtox mv x,[ptrcr] mv i,[inttmp0] add x,i call mtox call mul jpc err15 mv x,fx1 call mtox mv x,[ptrci] mv i,[inttmp0] add x,i call mtox call mul jpc err15 call sb jpc err15 mv x,[ptrx] call xtom ;X1=X1*CR(I)+X0*CI(I): mv x,fx1 call mtox mv x,[ptrcr] mv i,[inttmp0] add x,i call mtox call mul jpc err15 mv x,fx0 call mtox mv x,[ptrci] mv i,[inttmp0] add x,i call mtox call mul jpc err15 call ad jpc err15 mv x,fx1 call xtom ;X0=X+D(J): mv x,[ptrx] call mtox mv x,[ptrda] mv i,[inttmp1] add x,i call mtox call ad jpc err15 mv x,fx0 call xtom ;NEXT J (TO N-1, nf10) mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc nf10 ;10172 X2=1:X3=0:FOR J=0TO N-1 mv x,fx2 call mv1 mv x,fx3 call mv0 mv a,0 mv [charj],a nf20: mv i,0 mv a,[charj] add i,a add i,i add i,i add i,i sub i,a mv [inttmp1],i ;10173 IF J<>I THEN mv a,[charj] mv il,[chari] sub il,a jrz nf21 ;X4=CR(I)-CR(J): mv x,[ptrcr] pushs x mv i,[inttmp0] add x,i call mtox pops x mv i,[inttmp1] add x,i call mtox call sb jpc err15 mv x,fx4 call xtom ;X5=CI(I)-CI(J): mv x,[ptrci] pushs x mv i,[inttmp0] add x,i call mtox pops x mv i,[inttmp1] add x,i call mtox call sb jpc err15 mv x,fx5 call xtom ;X=X2*X4-X3*X5: mv x,fx2 call mtox mv x,fx4 call mtox call mul jpc err15 mv x,fx3 call mtox mv x,fx5 call mtox call mul jpc err15 call sb jpc err15 mv x,[ptrx] call xtom ;X3=X3*X4+X2*X5: mv x,fx3 call mtox mv x,fx4 call mtox call mul jpc err15 mv x,fx2 call mtox mv x,fx5 call mtox call mul jpc err15 call ad jpc err15 mv x,fx3 call xtom ;X2=X mv x,[ptrx] mv y,fx2 call mtom nf21: ;10174 NEXT J (TO N-1, nf20) mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc nf20 ;10175 D=X2*X2+X3*X3: mv x,fx2 pushs x call mtox pops x call mtox call mul jpc err15 mv x,fx3 pushs x call mtox pops x call mtox call mul jpc err15 call ad jpc err15 mv x,[ptrd] call xtom ;X=X0*X2+X1*X3: mv x,fx0 call mtox mv x,fx2 call mtox call mul jpc err15 mv x,fx1 call mtox mv x,fx3 call mtox call mul jpc err15 call ad jpc err15 mv x,[ptrx] call xtom ;X1=(X1*X2-X0*X3)/D: mv x,fx1 call mtox mv x,fx2 call mtox call mul jpc err15 mv x,fx0 call mtox mv x,fx3 call mtox call mul jrc err15 call sb jrc err15 mv x,[ptrd] call mtox call div jrc err15 mv x,fx1 call xtom ;X0=X/D mv x,[ptrx] call mtox mv x,[ptrd] call mtox call div jrc err15 mv x,fx0 call xtom ;10176 IF SQR (X0*X0+X1*X1)>E0 THEN F=1 mv x,fx0 pushs x call mtox pops x call mtox call mul jrc err15 mv x,fx1 pushs x call mtox pops x call mtox call mul jrc err15 call ad jrc err15 call sqr jrc err15 mv x,[ptra] pushs x call xtom pops x mv y,[ptre0] call cp ;E0 - A jrnc nf30 mv x,[ptrf] call mv1 nf30: ;10177 CR(I)=CR(I)-X0:CI(I)=CI(I)-X1 mv x,[ptrcr] mv i,[inttmp0] add x,i pushs x call mtox mv x,fx0 call mtox call sb jrc err15 pops x call xtom mv x,[ptrci] mv i,[inttmp0] add x,i pushs x call mtox mv x,fx1 call mtox call sb jrc err15 pops x call xtom ;10180 NEXT I (TO N-1, nf00) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jpnc nf00 ;10181 IF F=1THEN 10170 ret err15: mv a,15 ;error on frame loop jp err nnscp: ;12200 "MNSCP" call findsingle mv a,'A' call findmat00 mv [ptrma],x mv a,'C' call findmat00 mv [ptrmc],x mv a,'N' call findmat00 mv [ptrmn],x mv a,'P' call findmat00 mv [ptrmp],x call finde0e1e2 ;12220 FOR J=0 TO N-1:PV(J)=J:PH(J)=J:NEXT J mv a,0 mv x,charpv mv y,charph nn50: mv [x++],a mv [y++],a inc a mv il,[charn1] sub il,a jrnc nn50 ;12230 FOR J=0 TO N-2 mv a,0 mv [charj],a nn60: ;12240 A=MC(PV(J),PH(J)):B=MP(PV(J),PH(J)) mv a,[charj] mv x,charpv add x,a mv y,charph add y,a mv a,[x] mv [ptr1],a mv a,[y] mv [ptr2],a call getoffset pushs i mv x,[ptrmc] add x,i pushs x call mtox pops x call mtox call mul jpc err16 pops i mv x,[ptrmp] add x,i pushs x call mtox pops x call mtox call mul jpc err16 ;:P=A*A+B*B call ad jpc err16 mv x,[ptrp] call xtom ;12250 FOR K=J TO N-1:FOR L=J TO N-1 mv a,[charj] mv [chark],a nn61: mv a,[charj] mv [charl],a nn62: ;12251 A=MC(PV(K),PH(L)):B=MP(PV(K),PH(L)) mv a,[chark] mv x,charpv add x,a mv a,[x] mv [ptr1],a mv a,[charl] mv x,charph add x,a mv a,[x] mv [ptr2],a call getoffset pushs i mv x,[ptrmc] add x,i pushs x call mtox pops x call mtox call mul jpc err16 pops i mv x,[ptrmp] add x,i pushs x call mtox pops x call mtox call mul jpc err16 ;:PP=A*A+B*B call ad jpc err16 mv x,fpp call xtom ;12252 IF PP>=P THEN K0=K:L0=L:P=PP mv y,fpp mv x,[ptrp] call cp ;PP - P jrc nn63 mv a,[chark] mv [chark0],a mv a,[charl] mv [charl0],a mv x,fpp mv y,[ptrp] call mtom nn63: ;12253 NEXT L (TO N-1,nn62):NEXT K (TO N-1, nn61) mv a,[charl] inc a mv [charl],a mv il,[charn1] sub il,a jrnc nn62 mv a,[chark] inc a mv [chark],a mv il,[charn1] sub il,a jrnc nn61 ;12260 IF K0<>J THEN P=PV(J):PV(J)=PV(K0):PV(K0)=P mv a,[chark0] mv il,[charj] sub il,a jrz nn70 add il,a mv x,charpv mv y,x add x,a add y,il mv a,[x] mv il,[y] mv [x],il mv [y],a nn70: ;12261 IF L0<>J THEN P=PH(J):PH(J)=PH(L0):PH(L0)=P mv a,[charl0] mv il,[charj] sub il,a jrz nn71 add il,a mv x,charph mv y,x add x,a add y,il mv a,[x] mv il,[y] mv [x],il mv [y],a nn71: ;12270 A=MC(PV(J),PH(J)):B=MP(PV(J),PH(J)) mv a,[charj] mv x,charpv add x,a mv y,charph add y,a mv a,[x] mv [ptr1],a mv a,[y] mv [ptr2],a call getoffset pushs i mv x,[ptrmc] add x,i pushs x call mtox pops x call mtox call mul jpc err16 pops i mv x,[ptrmp] add x,i pushs x call mtox pops x call mtox call mul jpc err16 ;:P=SQR (A*A+B*B) call ad jpc err16 call sqr jpc err16 mv x,[ptrp] pushs x call xtom ;12271 IF P<=E1 THEN 12280 pops x mv y,[ptre1] call cp ;E1 - P jpnc nn12280 ;12272 FOR K=J+1 TO N-1 mv a,[charj] inc a mv [chark],a nn80: ;12273 A=MC(PV(K),PH(J)):B=MP(PV(K),PH(J)) mv a,[chark] mv x,charpv add x,a mv a,[x] mv [ptr1],a mv a,[charj] mv x,charph add x,a mv a,[x] mv [ptr2],a call getoffset mv x,[ptrmc] add x,i mv y,[ptra] call mtom mv x,[ptrmp] add x,i mv y,[ptrb] call mtom ;:C=MC(PV(J),PH(J)):D=MP(PV(J),PH(J)) mv a,[charj] mv x,charpv add x,a mv a,[x] mv [ptr1],a call getoffset mv x,[ptrmc] add x,i mv y,[ptrc] call mtom mv x,[ptrmp] add x,i mv y,[ptrd] call mtom ;12274 CALL FDIV:C=A:D=B call ndiv mv x,[ptra] mv y,[ptrc] call mtom mv x,[ptrb] mv y,[ptrd] call mtom ;12275 FOR L=J+1 TO N-1 mv a,[charj] inc a mv [charl],a nn81: ;12276 A=MC(PV(J),PH(L)):B=MP(PV(J),PH(L)):CALL FMUL mv a,[charj] mv x,charpv add x,a mv a,[x] mv [ptr1],a mv a,[charl] mv x,charph add x,a mv a,[x] mv [ptr2],a call getoffset mv x,[ptrmc] add x,i mv y,[ptra] call mtom mv x,[ptrmp] add x,i mv y,[ptrb] call mtom call nmul ;12277 MC(PV(K),PH(L))=MC(PV(K),PH(L))-A mv a,[chark] mv x,charpv add x,a mv a,[x] mv [ptr1],a mv a,[charl] mv x,charph add x,a mv a,[x] mv [ptr2],a call getoffset pushs i mv x,[ptrmc] add x,i pushs x call mtox mv x,[ptra] call mtox call sb jpc err16 pops x call xtom ;12278 MP(PV(K),PH(L))=MP(PV(K),PH(L))-B pops i mv x,[ptrmp] add x,i pushs x call mtox mv x,[ptrb] call mtox call sb jpc err16 pops x call xtom ;12279 NEXT L (TO N-1, nn81):NEXT K (TO N-1, nn80) mv a,[charl] inc a mv [charl],a mv il,[charn1] sub il,a jrnc nn81 mv a,[chark] inc a mv [chark],a mv il,[charn1] sub il,a jpnc nn80 nn12280: ;12280 NEXT J (TO N-2, nn60) mv a,[charj] inc a mv [charj],a mv il,[charn2] sub il,a jpnc nn60 ;12290 FL=0 mv a,0 mv [charfl],a ;12300 FOR J=N-1 TO 0 STEP -1 mv a,[charn1] mv [charj],a nn90: ;12301 SR=0:SI=0 mv x,fsr call mv0 mv x,fsi call mv0 ;12302 IF J=N-1 THEN 12310 mv a,[charj] mv il,[charn1] sub il,a jrz nn12310 ;12303 FOR K=N-1 TO J+1 STEP -1 mv a,[charn1] mv [chark],a nn91: ;12304 A=MA(PH(K),P3):B=MN(PH(K),P3) mv a,[chark] mv x,charph add x,a mv a,[x] mv [ptr1],a mv a,[charm] mv [ptr2],a call getoffset mv x,[ptrma] add x,i mv y,[ptra] call mtom mv x,[ptrmn] add x,i mv y,[ptrb] call mtom ;:C=MC(PV(J),PH(K)):D=MP(PV(J),PH(K)) mv a,[charj] mv x,charpv add x,a mv a,[x] mv [ptr1],a mv a,[chark] mv x,charph add x,a mv a,[x] mv [ptr2],a call getoffset mv x,[ptrmc] add x,i mv y,[ptrc] call mtom mv x,[ptrmp] add x,i mv y,[ptrd] call mtom ;12305 CALL FMUL:SR=SR-A:SI=SI-B call nmul mv x,fsr pushs x call mtox mv x,[ptra] call mtox call sb jpc err16 pops x call xtom mv x,fsi pushs x call mtox mv x,[ptrb] call mtox call sb jpc err16 pops x call xtom ;12306 NEXT K (TO J+1 STEP -1, nn91) mv a,[chark] dec a mv [chark],a mv il,[charj] sub il,a jrnz nn91 nn12310: ;12310 P=MC(PV(J),PH(J)):Q=MP(PV(J),PH(J)) mv a,[charj] mv x,charpv add x,a mv y,charph add y,a mv a,[x] mv [ptr1],a mv a,[y] mv [ptr2],a call getoffset mv x,[ptrmc] add x,i mv y,[ptrp] call mtom mv x,[ptrmp] add x,i mv y,[ptrq] call mtom ;12311 IF SQR (P*P+Q*Q)>E1 THEN 12320 mv x,[ptrp] pushs x call mtox pops x call mtox call mul jpc err16 mv x,[ptrq] pushs x call mtox pops x call mtox call mul jpc err16 call ad jpc err16 call sqr jpc err16 mv x,fcc pushs x call xtom mv y,[ptre1] pops x call cp jrc nn12320 ;12312 IF SQR (SR*SR+SI*SI)>E1 THEN J=-1:NEXT J:WAIT :PRINT "ｶｲ ｶﾞ ﾑｹﾞﾝﾀﾞｲﾆ ﾅﾘﾏｼﾀ.ｹｲｻﾝﾃﾞｷﾏｾﾝ":RETURN mv x,fsr pushs x call mtox pops x call mtox call mul jpc err16 mv x,fsi pushs x call mtox pops x call mtox call mul jrc err16 call ad jrc err16 call sqr jrc err16 mv x,fcc pushs x call xtom mv y,[ptre1] pops x call cp jpc errf0 ;12313 MA(PH(J),P3)=1:MN(PH(J),P3)=0:FL=1:GOTO 12330 mv a,[charj] mv x,charph add x,a mv a,[x] mv [ptr1],a mv a,[charm] mv [ptr2],a call getoffset mv x,[ptrma] add x,i call mv1 mv x,[ptrmn] add x,i call mv0 mv a,1 mv [charfl],a jr nn12330 nn12320: ;12320 A=SR:B=SI:C=P:D=Q:CALL FDIV mv x,fsr mv y,[ptra] call mtom mv x,fsi mv y,[ptrb] call mtom mv x,[ptrp] mv y,[ptrc] call mtom mv x,[ptrq] mv y,[ptrd] call mtom call ndiv ;12321 MA(PH(J),P3)=A:MN(PH(J),P3)=B mv a,[charj] mv x,charph add x,a mv a,[x] mv [ptr1],a mv a,[charm] mv [ptr2],a call getoffset mv x,[ptra] mv y,[ptrma] add y,i call mtom mv x,[ptrb] mv y,[ptrmn] add y,i call mtom nn12330: ;12330 NEXT J (TO 0 STEP -1, nn90) mv a,[charj] dec a mv [charj],a cmp a,0ffh jpnz nn90 ;12331 IF FL=0 THEN WAIT :PRINT "ﾇﾙ ｽﾍﾟ-ｽ ﾊ ｱﾘﾏｾﾝ" mv a,[charfl] cmp a,0 jpz errf1 ;12340 RETURN ret err16: mv a,16 ;error on nscp jp err charnn: ds 1 nnsfast: call findsingle call finde0e1e2 ;e[[j]] = CR(n+j), CI(n+j) mv a,'R' call finddblarray mv [ptrcr],x mv a,'I' call finddblarray mv [ptrci],x ; v[[nn, j]] = MA(nn, [charm]), MN(nn, [charm]) mv a,'A' call findmat00 mv [ptrma],x mv a,'N' call findmat00 mv [ptrmn],x ; a[[x, y]] = MG(x, y), MT(x, y) mv a,'G' call findmat00 mv [ptrmg],x mv a,'T' call findmat00 mv [ptrmt],x ; qh[[2]][[x, y]] = MF(x, y), MS(x, y) mv a,'F' call findmat00 mv [ptrmf],x mv a,'S' call findmat00 mv [ptrms],x ;j = [charm] ; nn = n; mv a,[charn1] mv [charnn],a ; v[[nn, j]] = 1; mv [ptr1],a mv a,[charm] mv [ptr2],a call getoffset mv x,[ptrma] add x,i call mv1 mv x,[ptrmn] add x,i call mv0 ; While[nn > 1, nn100: mv a,[charnn] cmp a,0 jpz nn101 ; nn--; dec a mv [charnn],a ; v[[nn, j]] = v[[nn + 1, j]]*(e[[j]] - a[[nn + 1, nn + 1]]); mv a,[charm] mv il,[charn] add a,il mv i,0 add i,a add i,i add i,i add i,i sub i,a mv [inttmp0],i mv x,[ptrcr] add x,i call mtox mv a,[charnn] inc a mv [ptr1],a mv [ptr2],a call getoffset mv [inttmp1],i mv x,[ptrmg] add x,i call mtox call sb jpc err18 mv x,[ptra] call xtom mv x,[ptrci] mv i,[inttmp0] add x,i call mtox mv x,[ptrmt] mv i,[inttmp1] add x,i call mtox call sb jpc err18 mv x,[ptrb] call xtom mv a,[charm] mv [ptr2],a mv a,[charnn] inc a mv [ptr1],a call getoffset mv x,[ptrma] add x,i mv y,[ptrc] call mtom mv x,[ptrmn] add x,i mv y,[ptrd] call mtom call nmul mv a,[charnn] mv [ptr1],a call getoffset mv y,[ptrma] add y,i mv x,[ptra] call mtom mv y,[ptrmn] add y,i mv x,[ptrb] call mtom ; For[i = nn + 2, i <= n, i++, mv a,[charnn] add a,2 mv [chari],a mv il,[charn1] sub il,a jrc nn111 nn110: ; v[[nn, j]] -= v[[i, j]]*a[[nn + 1, i]]; mv a,[chari] mv [ptr1],a mv a,[charm] mv [ptr2],a call getoffset mv x,[ptrma] add x,i mv y,[ptra] call mtom mv x,[ptrmn] add x,i mv y,[ptrb] call mtom mv a,[charnn] inc a mv [ptr1],a mv a,[chari] mv [ptr2],a call getoffset mv x,[ptrmg] add x,i mv y,[ptrc] call mtom mv x,[ptrmt] add x,i mv y,[ptrd] call mtom call nmul mv a,[charnn] mv [ptr1],a mv a,[charm] mv [ptr2],a call getoffset mv [inttmp0],i mv x,[ptrma] add x,i pushs x call mtox mv x,[ptra] call mtox call sb jpc err18 pops x call xtom mv i,[inttmp0] mv x,[ptrmn] add x,i pushs x call mtox mv x,[ptrb] call mtox call sb jpc err18 pops x call xtom ; ]; (i++, to n-1,nn110) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jrnc nn110 nn111: ; v[[nn, j]] /= a[[nn + 1, nn]]; mv a,[charnn] mv [ptr1],a mv a,[charm] mv [ptr2],a call getoffset mv [inttmp0],i mv x,[ptrma] add x,i mv y,[ptra] call mtom mv x,[ptrmn] add x,i mv y,[ptrb] call mtom mv a,[charnn] mv [ptr2],a inc a mv [ptr1],a call getoffset mv x,[ptrmg] add x,i mv y,[ptrc] call mtom mv x,[ptrmt] add x,i mv y,[ptrd] call mtom mv x,[ptrc] call is0 jrnz nn112 mv x,[ptrd] call is0 jpz errf1 nn112: call ndiv mv i,[inttmp0] mv y,[ptrma] add y,i mv x,[ptra] call mtom mv y,[ptrmn] add y,i mv x,[ptrb] call mtom jp nn100 nn101: ; ]; ;no = Norm[v[[All, j]]]; If[no != 0, v[[All, j]] /= no, GOTO ERRF1;]; mv x,fss call mv0 mv a,[charm] mv [ptr2],a mv a,0 mv [ptr1],a nn200: call getoffset pushs i mv x,[ptrma] add x,i pushs x call mtox pops x call mtox call mul jpc err18 pops i mv x,[ptrmn] add x,i pushs x call mtox pops x call mtox call mul jpc err18 mv x,fss pushs x call mtox call ad jpc err18 call ad jpc err18 pops x call xtom mv a,[ptr1] inc a mv [ptr1],a mv il,[charn1] sub il,a jrnc nn200 mv x,fss call is0 jpz errf1 mv x,[ptra] pushs x call mv1 pops x call mtox mv x,fss pushs x call mtox call sqr jpc err18 call div jpc err18 pops x call xtom mv a,0 mv [ptr1],a nn202: call getoffset pushs i mv x,[ptrma] add x,i pushs x call mtox mv x,fss call mtox call mul jpc err18 pops x call xtom pops i mv x,[ptrmn] add x,i pushs x call mtox mv x,fss call mtox call mul jpc err18 pops x call xtom mv a,[ptr1] inc a mv [ptr1],a mv il,[charn1] sub il,a jrnc nn202 ;no = 0; For[i = 1, i <= n, i++, mv x,fd1r call mv0 mv x,fd1i call mv0 mv a,0 mv [chari],a nn210: ; no += v[[i, j]]*If[i == 1, a[[1, i]] - e[[j]], a[[1, i]]]; mv a,[chari] mv [ptr1],a mv a,[charm] mv [ptr2],a call getoffset mv x,[ptrma] add x,i mv y,[ptra] call mtom mv x,[ptrmn] add x,i mv y,[ptrb] call mtom mv a,0 mv [ptr1],a mv a,[chari] mv [ptr2],a call getoffset mv x,[ptrmg] add x,i mv y,[ptrc] call mtom mv x,[ptrmt] add x,i mv y,[ptrd] call mtom mv a,[chari] cmp a,0 jrnz nn211 mv x,[ptrc] pushs x call mtox mv a,[charm] mv il,[charn] add a,il mv i,0 add i,a add i,i add i,i add i,i sub i,a mv [inttmp0],i mv x,[ptrcr] add x,i call mtox call sb jpc err18 pops x call xtom mv x,[ptrd] pushs x call mtox mv i,[inttmp0] mv x,[ptrci] add x,i call mtox call sb jpc err18 pops x call xtom nn211: call nmul mv x,fd1r pushs x call mtox mv x,[ptra] call mtox call ad jpc err18 pops x call xtom mv x,fd1i pushs x call mtox mv x,[ptrb] call mtox call ad jpc err18 pops x call xtom ; ]; (i++, to n-1,nn210) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jpnc nn210 ;If[Abs[no] < eps, mv x,fd1r pushs x call mtox pops x call mtox call mul jpc err18 mv x,fd1i pushs x call mtox pops x call mtox call mul jpc err18 call ad jpc err18 call sqr jpc err18 mv x,fss pushs x call xtom pops y mv x,[ptre4] call cp ;Abs[no] - eps jpnc errf1 ; v[[All, charm]] = qh[[2]].v[[All, charm]]; mv a,0 mv [charj],a nn220: mv x,fd1r call mv0 mv x,fd1i call mv0 mv a,0 mv [chark],a nn221: mv a,[charj] mv [ptr1],a mv a,[chark] mv [ptr2],a call getoffset mv x,[ptrmf] add x,i mv y,[ptra] call mtom mv x,[ptrms] add x,i mv y,[ptrb] call mtom mv a,[chark] mv [ptr1],a mv a,[charm] mv [ptr2],a call getoffset mv x,[ptrma] add x,i mv y,[ptrc] call mtom mv x,[ptrmn] add x,i mv y,[ptrd] call mtom call nmul mv x,fd1r pushs x call mtox mv x,[ptra] call mtox call ad jpc err18 pops x call xtom mv x,fd1i pushs x call mtox mv x,[ptrb] call mtox call ad jrc err18 pops x call xtom mv a,[chark] inc a mv [chark],a mv il,[charn1] sub il,a jrnc nn221 mv a,[charj] mv il,[charn] add a,il add a,il mv i,0 add i,a add i,i add i,i add i,i sub i,a mv y,[ptrcr] add y,i mv x,fd1r call mtom mv y,[ptrci] add y,i mv x,fd1i call mtom mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc nn220 mv a,[charm] mv [ptr2],a mv a,0 mv [ptr1],a nn230: mv a,[ptr1] mv il,[charn] add a,il add a,il mv i,0 add i,a add i,i add i,i add i,i sub i,a mv [inttmp0],i mv x,[ptrcr] add x,i pushs x call getoffset mv [inttmp1],i mv y,[ptrma] add y,i pops x call mtom mv i,[inttmp0] mv x,[ptrci] add x,i mv i,[inttmp1] mv y,[ptrmn] add y,i call mtom mv a,[ptr1] inc a mv [ptr1],a mv il,[charn1] sub il,a jrnc nn230 ret err18: mv a,18 ;error on nsfast jp err fdr: ds 7 fdi: ds 7 charp: ds 1 charq: ds 1 nrcpcp: ;8000 "MRCPCP" call findsingle mv a,'A' call findmat00 mv [ptrma],x mv a,'B' call findmat00 mv [ptrmb],x mv a,'N' call findmat00 mv [ptrmn],x mv a,'O' call findmat00 mv [ptrmo],x call finde0e1e2 ;8010 FOR J=0TO N-1 ;8011 PV(J)=J:PH(J)=J ;8012 NEXT J mv a,0 mv x,charpv mv y,charph nr60: mv [x++],a mv [y++],a inc a mv il,[charn1] sub il,a jrnc nr60 ;8020 DR=1:DI=0 mv x,fdr call mv1 mv x,fdi call mv0 ;8030 FOR K=0TO N-1 mv a,0 mv [chark],a nr70: ;8040 A=MA(K,K):B=MN(K,K) mv a,[chark] mv [ptr1],a mv [ptr2],a call getoffset pushs i mv x,[ptrma] add x,i pushs x call mtox pops x call mtox call mul jpc err17 pops i mv x,[ptrmn] add x,i pushs x call mtox pops x call mtox call mul jpc err17 call ad jpc err17 ;:AW=A*A+B*B mv x,faw call xtom ;8050 P=K:Q=K mv a,[chark] mv [charp],a mv [charq],a ;8060 FOR J=K TO N-1 mv a,[chark] mv [charj],a nr71: ;8070 FOR I=K TO N-1 mv a,[chark] mv [chari],a nr72: ;8080 A=MA(I,J):B=MN(I,J) mv a,[chari] mv [ptr1],a mv a,[charj] mv [ptr2],a call getoffset pushs i mv x,[ptrma] add x,i pushs x call mtox pops x call mtox call mul jpc err17 pops i mv x,[ptrmn] add x,i pushs x call mtox pops x call mtox call mul jpc err17 call ad jpc err17 ;:C=A*A+B*B mv x,[ptrc] call xtom ;8081 IF AW<C THEN AW=C:P=I:Q=J mv y,faw mv x,[ptrc] call cp ;AW - C jrnc nr73 mv x,[ptrc] mv y,faw call mtom mv a,[chari] mv [charp],a mv a,[charj] mv [charq],a nr73: ;8090 NEXT I (TO N-1, nr72):NEXT J (TO N-1, nr71) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jrnc nr72 mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc nr71 ;8100 IF SQR AW<=E2 THEN WAIT :PRINT "ﾄｸｲｷﾞｮｳﾚﾂ ｶﾞ ｹﾝｼｭﾂｻﾚﾏｼﾀ.ｹｲｻﾝﾃﾞｷﾏｾﾝ":RETURN mv x,faw pushs x call mtox call sqr jpc err17 pops x pushs x call xtom pops x mv y,[ptre2] call cp ;E2 - SQR AW jpnc errf2 ;8110 IF K<>P THEN mv a,[chark] mv il,[charp] sub il,a jrz nr80 ;8120 DR=-DR:DI=-DI mv x,fdr call chs mv x,fdi call chs ;8130 FOR J=0TO N-1 mv a,0 mv [charj],a nr81: ;8131 A=MA(K,J):MA(K,J)=MA(P,J):MA(P,J)=A mv a,[charj] mv [ptr2],a mv a,[chark] mv [ptr1],a call getoffset mv x,[ptrma] pushs x add x,i pushs x mv a,[charp] mv [ptr1],a call getoffset pops x pops y add y,i call exchange ;8132 A=MN(K,J):MN(K,J)=MN(P,J):MN(P,J)=A mv a,[chark] mv [ptr1],a call getoffset mv x,[ptrmn] pushs x add x,i pushs x mv a,[charp] mv [ptr1],a call getoffset pops x pops y add y,i call exchange ;8133 NEXT J (TO N-1, nr81) mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc nr81 ;8140 A=PH(K):PH(K)=PH(P):PH(P)=A mv a,[chark] mv x,charph mv y,x add x,a mv a,[charp] add y,a mv a,[x] mv il,[y] mv [x],il mv [y],a nr80: ;8150 ENDIF ;8160 IF K<>Q THEN mv a,[chark] mv il,[charq] sub il,a jrz nr82 ;8170 DR=-DR:DI=-DI mv x,fdr call chs mv x,fdi call chs ;8180 FOR I=0TO N-1 mv a,0 mv [chari],a nr83: ;8181 A=MA(I,K):MA(I,K)=MA(I,Q):MA(I,Q)=A mv a,[chari] mv [ptr1],a mv a,[chark] mv [ptr2],a call getoffset mv x,[ptrma] pushs x add x,i pushs x mv a,[charq] mv [ptr2],a call getoffset pops x pops y add y,i call exchange ;8182 A=MN(I,K):MN(I,K)=MN(I,Q):MN(I,Q)=A mv a,[chark] mv [ptr2],a call getoffset mv x,[ptrmn] pushs x add x,i pushs x mv a,[charq] mv [ptr2],a call getoffset pops x pops y add y,i call exchange ;8183 NEXT I (TO N-1, nr83) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jrnc nr83 ;8190 A=PV(K):PV(K)=PV(Q):PV(Q)=A mv a,[chark] mv x,charpv mv y,x add x,a mv a,[charq] add y,a mv a,[x] mv il,[y] mv [x],il mv [y],a nr82: ;8200 ENDIF ;8210 C=MA(K,K):D=MN(K,K) mv a,[chark] mv [ptr1],a mv [ptr2],a call getoffset mv x,[ptrma] add x,i pushs x mv y,[ptrc] call mtom mv x,[ptrmn] add x,i pushs x mv y,[ptrd] call mtom ;8220 MA(K,K)=1:MN(K,K)=0 pops x call mv0 pops x call mv1 ;8230 A=DR:B=DI:CALL FMUL:DR=A:DI=B mv x,fdr mv y,[ptra] call mtom mv x,fdi mv y,[ptrb] call mtom call nmul mv x,[ptra] mv y,fdr call mtom mv x,[ptrb] mv y,fdi call mtom ;8240 FOR J=0TO N-1 mv a,0 mv [charj],a nr84: ;8250 A=MA(K,J):B=MN(K,J):CALL FDIV:MA(K,J)=A:MN(K,J)=B mv a,[chark] mv [ptr1],a mv a,[charj] mv [ptr2],a call getoffset mv x,[ptrma] add x,i pushs x mv y,[ptra] call mtom mv x,[ptrmn] add x,i pushs x mv y,[ptrb] call mtom call ndiv pops y mv x,[ptrb] call mtom pops y mv x,[ptra] call mtom ;8260 NEXT J (TO N-1, nr84) mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc nr84 ;8270 FOR I=0TO N-1 mv a,0 mv [chari],a nr85: ;8280 IF I<>K THEN mv a,[chari] mv il,[chark] sub il,a jrz nr86 ;8290 C=MA(I,K):D=MN(I,K) mv a,[chari] mv [ptr1],a mv a,[chark] mv [ptr2],a call getoffset mv x,[ptrma] add x,i pushs x mv y,[ptrc] call mtom mv x,[ptrmn] add x,i pushs x mv y,[ptrd] call mtom ;8300 MA(I,K)=0:MN(I,K)=0 pops x call mv0 pops x call mv0 ;8310 FOR J=0TO N-1 mv a,0 mv [charj],a nr87: ;8320 A=MA(K,J):B=MN(K,J):CALL FMUL mv a,[chark] mv [ptr1],a mv a,[charj] mv [ptr2],a call getoffset mv x,[ptrma] add x,i mv y,[ptra] call mtom mv x,[ptrmn] add x,i mv y,[ptrb] call mtom call nmul ;8321 MA(I,J)=MA(I,J)-A mv a,[chari] mv [ptr1],a call getoffset pushs i mv x,[ptrma] add x,i pushs x call mtox mv x,[ptra] call mtox call sb jpc err17 pops x call xtom ;8322 MN(I,J)=MN(I,J)-B pops i mv x,[ptrmn] add x,i pushs x call mtox mv x,[ptrb] call mtox call sb jpc err17 pops x call xtom ;8330 NEXT J (TO N-1, nr87) mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc nr87 nr86: ;8340 ENDIF ;8350 NEXT I (TO N-1, nr85) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jrnc nr85 ;8360 NEXT K (TO N-1, nr70) mv a,[chark] inc a mv [chark],a mv il,[charn1] sub il,a jpnc nr70 ;8370 FOR J=0TO N-1 mv a,0 mv [charj],a nr90: ;8380 FOR I=0TO N-1 mv a,0 mv [chari],a nr91: ;8390 P=PV(I) mv a,[chari] mv x,charpv add x,a ;8400 MB(P,0)=MA(I,J) mv a,[x] mv [ptr1],a mv a,0 mv [ptr2],a call getoffset mv [inttmp0],i mv a,[chari] mv [ptr1],a mv a,[charj] mv [ptr2],a call getoffset mv [inttmp1],i mv x,[ptrma] add x,i mv y,[ptrmb] mv i,[inttmp0] add y,i call mtom ;8401 MO(P,0)=MN(I,J) mv i,[inttmp1] mv x,[ptrmn] add x,i mv i,[inttmp0] mv y,[ptrmo] add y,i call mtom ;8410 NEXT I (TO N-1, nr91) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jrnc nr91 ;8420 FOR I=0TO N-1 mv a,0 mv [chari],a nr92: ;8430 MA(I,J)=MB(I,0) mv a,[chari] mv [ptr1],a mv a,[charj] mv [ptr2],a call getoffset mv [inttmp0],i mv a,0 mv [ptr2],a call getoffset mv [inttmp1],i mv x,[ptrmb] add x,i mv y,[ptrma] mv i,[inttmp0] add y,i call mtom ;8431 MN(I,J)=MO(I,0) mv i,[inttmp1] mv x,[ptrmo] add x,i mv i,[inttmp0] mv y,[ptrmn] add y,i call mtom ;8440 NEXT I (TO N-1, nr92) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jrnc nr92 ;8450 NEXT J (TO N-1, nr90) mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc nr90 ;8460 FOR I=0TO N-1 mv a,0 mv [chari],a nr93: ;8470 FOR J=0TO N-1 mv a,0 mv [charj],a nr94: ;8480 Q=PH(J) mv a,[charj] mv x,charph add x,a ;8490 MB(0,Q)=MA(I,J) mv a,[x] mv [ptr2],a mv a,0 mv [ptr1],a call getoffset mv [inttmp0],i mv a,[chari] mv [ptr1],a mv a,[charj] mv [ptr2],a call getoffset mv [inttmp1],i mv x,[ptrma] add x,i mv y,[ptrmb] mv i,[inttmp0] add y,i call mtom ;8491 MO(0,Q)=MN(I,J) mv i,[inttmp1] mv x,[ptrmn] add x,i mv i,[inttmp0] mv y,[ptrmo] add y,i call mtom ;8500 NEXT J (TO N-1, nr94) mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc nr94 ;8510 FOR J=0TO N-1 mv a,0 mv [charj],a nr95: ;8520 MA(I,J)=MB(0,J) mv a,[chari] mv [ptr1],a mv a,[charj] mv [ptr2],a call getoffset mv [inttmp0],i mv a,0 mv [ptr1],a call getoffset mv [inttmp1],i mv x,[ptrmb] add x,i mv y,[ptrma] mv i,[inttmp0] add y,i call mtom ;8521 MN(I,J)=MO(0,J) mv i,[inttmp1] mv x,[ptrmo] add x,i mv i,[inttmp0] mv y,[ptrmn] add y,i call mtom ;8530 NEXT J (TO N-1, nr95) mv a,[charj] inc a mv [charj],a mv il,[charn1] sub il,a jrnc nr95 ;8540 NEXT I (TO N-1, nr93) mv a,[chari] inc a mv [chari],a mv il,[charn1] sub il,a jrnc nr93 ;8550 RETURN ret err17: mv a,17 ;error on rcpcp jp err at11: aq11: ds 3 at12: aq12: ds 3 at13: aq13: ds 3 at21: aq14: ds 3 at22: aq21: ds 3 at23: aq22: ds 3 at31: aq23: ds 3 at32: aq24: ds 3 at33: aq31: ds 3 aq32: ds 3 aq33: ds 3 aq34: ds 3 aq41: ds 3 aq42: ds 3 aq43: ds 3 aq44: ds 3 nt11: nq11: ds 3 nt12: nq12: ds 3 nt13: nq13: ds 3 nt21: nq14: ds 3 nt22: nq21: ds 3 nt23: nq22: ds 3 nt31: nq23: ds 3 nt32: nq24: ds 3 nt33: nq31: ds 3 nq32: ds 3 nq33: ds 3 nq34: ds 3 nq41: ds 3 nq42: ds 3 nq43: ds 3 nq44: ds 3 fa1r: ds 7 fa1i: ds 7 fa2r: ds 7 fa2i: ds 7 fa3r: ds 7 fa3i: ds 7 fa4r: ds 7 fa4i: ds 7 fa5r: ds 7 fa5i: ds 7 fb1r: ds 7 fb1i: ds 7 fb2r: ds 7 fb2i: ds 7 fb3r: ds 7 fb3i: ds 7 fb4r: ds 7 fb4i: ds 7 fb5r: ds 7 fb5i: ds 7 fb6r: ds 7 fb6i: ds 7 fb7r: ds 7 fb7i: ds 7 fc1r: ds 7 fc1i: ds 7 fc2r: ds 7 fc2i: ds 7 fc3r: ds 7 fc3i: ds 7 fd3r: ds 7 fd3i: ds 7 fd4r: ds 7 fd4i: ds 7 neigen33: call findsingle call finde0e1e2 mv a,'R' call finddblarray mv [ptrcr],x mv a,'I' call finddblarray mv [ptrci],x mv a,'A' call findmat00 mv [ptrma],x mv a,'N' call findmat00 mv [ptrmn],x mv a,7 mv x,at11 mv y,[ptrma] mv il,3*3 ne3000: mv [x++],y add y,a dec il jrnz ne3000 mv x,nt11 mv y,[ptrmn] mv il,3*3 ne3001: mv [x++],y add y,a dec il jrnz ne3001 ;eigen3[A_] := Module[{a, b, c}, ; a = A; ; b = a[[2, 3]]*a[[3, 2]] ;b --> g,h mv x,[at23] mv y,[ptra] call mtom mv x,[nt23] mv y,[ptrb] call mtom mv x,[at32] mv y,[ptrc] call mtom mv x,[nt32] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptrg] call mtom mv x,[ptrb] mv y,[ptrh] call mtom ; - a[[2, 2]]*a[[3, 3]]; mv x,[at22] mv y,[ptra] call mtom mv x,[nt22] mv y,[ptrb] call mtom mv x,[at33] mv y,[ptrc] call mtom mv x,[nt33] mv y,[ptrd] call mtom call nmul mv x,[ptrg] pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,[ptrh] pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; c = ( ;c --> i,j ; a[[2, 2]]*a[[3, 1]] mv x,[at22] mv y,[ptra] call mtom mv x,[nt22] mv y,[ptrb] call mtom mv x,[at31] mv y,[ptrc] call mtom mv x,[nt31] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptri] call mtom mv x,[ptrb] mv y,[ptrj] call mtom ; - a[[2, 1]]*a[[3, 2]] mv x,[at21] mv y,[ptra] call mtom mv x,[nt21] mv y,[ptrb] call mtom mv x,[at32] mv y,[ptrc] call mtom mv x,[nt32] mv y,[ptrd] call mtom call nmul mv x,[ptri] call mtox mv x,[ptra] pushs x call mtox call sb jpc errf0 pops x call xtom mv x,[ptrj] call mtox mv x,[ptrb] pushs x call mtox call sb jpc errf0 pops x call xtom ; )*a[[1, 3]] mv x,[at13] mv y,[ptrc] call mtom mv x,[nt13] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptri] call mtom mv x,[ptrb] mv y,[ptrj] call mtom ; + ( ; a[[2, 1]]*a[[3, 3]] mv x,[at21] mv y,[ptra] call mtom mv x,[nt21] mv y,[ptrb] call mtom mv x,[at33] mv y,[ptrc] call mtom mv x,[nt33] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptrk] call mtom mv x,[ptrb] mv y,[ptrl] call mtom ; - a[[2, 3]]*a[[3, 1]] mv x,[at23] mv y,[ptra] call mtom mv x,[nt23] mv y,[ptrb] call mtom mv x,[at31] mv y,[ptrc] call mtom mv x,[nt31] mv y,[ptrd] call mtom call nmul mv x,[ptrk] call mtox mv x,[ptra] pushs x call mtox call sb jpc errf0 pops x call xtom mv x,[ptrl] call mtox mv x,[ptrb] pushs x call mtox call sb jpc errf0 pops x call xtom ; )*a[[1, 2]] mv x,[at12] mv y,[ptrc] call mtom mv x,[nt12] mv y,[ptrd] call mtom call nmul mv x,[ptri] pushs x call mtox mv x,[ptra] call mtox call ad jpc errf0 pops x call xtom mv x,[ptrj] pushs x call mtox mv x,[ptrb] call mtox call ad jpc errf0 pops x call xtom ; + a[[1, 1]]*b; mv x,[at11] mv y,[ptra] call mtom mv x,[nt11] mv y,[ptrb] call mtom mv x,[ptrg] mv y,[ptrc] call mtom mv x,[ptrh] mv y,[ptrd] call mtom call nmul mv x,[ptri] pushs x call mtox mv x,[ptra] call mtox call ad jpc errf0 pops x call xtom mv x,[ptrj] pushs x call mtox mv x,[ptrb] call mtox call ad jpc errf0 pops x call xtom ; b = a[[1, 1]]*a[[2, 2]] mv x,[at11] mv y,[ptra] call mtom mv x,[nt11] mv y,[ptrb] call mtom mv x,[at22] mv y,[ptrc] call mtom mv x,[nt22] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptrk] call mtom mv x,[ptrb] mv y,[ptrl] call mtom ; - a[[1, 2]]*a[[2,1]] mv x,[at12] mv y,[ptra] call mtom mv x,[nt12] mv y,[ptrb] call mtom mv x,[at21] mv y,[ptrc] call mtom mv x,[nt21] mv y,[ptrd] call mtom call nmul mv x,[ptrk] pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,[ptrl] pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; - a[[1, 3]]*a[[3, 1]] mv x,[at13] mv y,[ptra] call mtom mv x,[nt13] mv y,[ptrb] call mtom mv x,[at31] mv y,[ptrc] call mtom mv x,[nt31] mv y,[ptrd] call mtom call nmul mv x,[ptrk] pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,[ptrl] pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; + a[[1, 1]]*a[[3, 3]] mv x,[at11] mv y,[ptra] call mtom mv x,[nt11] mv y,[ptrb] call mtom mv x,[at33] mv y,[ptrc] call mtom mv x,[nt33] mv y,[ptrd] call mtom call nmul ; - b; mv x,[ptrk] call mtox mv x,[ptra] call mtox call ad jpc errf0 mv x,[ptrg] pushs x call mtox call sb jpc errf0 pops x call xtom mv x,[ptrl] call mtox mv x,[ptrb] call mtox call ad jpc errf0 mv x,[ptrh] pushs x call mtox call sb jpc errf0 pops x call xtom ; a = -a[[1, 1]] - a[[2, 2]] - a[[3, 3]]; mv x,[at11] call mtox mv x,[at22] call mtox mv x,[at33] call mtox call ad jpc errf0 call ad jpc errf0 mv x,[ptrk] pushs x call xtom pops x call chs mv x,[nt11] call mtox mv x,[nt22] call mtox mv x,[nt33] call mtox call ad jpc errf0 call ad jpc errf0 mv x,[ptrl] pushs x call xtom pops x call chs ; Return[solve3[a, b, c]]; ; ]; ;b --> g,h ;c --> i,j ;a --> k,l ;solve3[a_, b_, c_] := Module[{st, o1, o2, ; st3, a1, a2, a3, a4, abc, b1, b2, b3, b4}, ; st = Sqrt[3]; o1 = 1 - st*I; o2 = 1 + st*I; st3 = 3*st; ; a2 = a*a; mv x,[ptrk] pushs x mv y,[ptra] call mtom pops x mv y,[ptrc] call mtom mv x,[ptrl] pushs x mv y,[ptrb] call mtom pops x mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,fa2r call mtom mv x,[ptrb] mv y,fa2i call mtom ; a3 = -a/3; mv x,[ptrk] call mtox mv x,fc_0p333 pushs x call mtox call mul jpc errf0 mv x,fa3r pushs x call xtom pops x call chs mv x,[ptrl] call mtox pops x call mtox call mul jpc errf0 mv x,fa3i pushs x call xtom pops x call chs ; b3 = b + b + b; mv x,[ptrg] pushs x call mtox pops x pushs x call mtox pops x call mtox call ad jpc errf0 call ad jpc errf0 mv x,fb3r call xtom mv x,[ptrh] pushs x call mtox pops x pushs x call mtox pops x call mtox call ad jpc errf0 call ad jpc errf0 mv x,fb3i call xtom ; a4 = b3 - a2; mv x,fb3r call mtox mv x,fa2r call mtox call sb jpc errf0 mv x,fa4r call xtom mv x,fb3i call mtox mv x,fa2i call mtox call sb jpc errf0 mv x,fa4i call xtom ; a2 = a*(a2 + a2 - b3 - b3 - b3); mv x,fa2r pushs x call mtox pops x call mtox call ad jpc errf0 mv x,fb3r pushs x call mtox call sb jpc errf0 pops x pushs x call mtox call sb jpc errf0 pops x call mtox call sb jpc errf0 mv x,[ptra] call xtom mv x,fa2i pushs x call mtox pops x call mtox call ad jpc errf0 mv x,fb3i pushs x call mtox call sb jpc errf0 pops x pushs x call mtox call sb jpc errf0 pops x call mtox call sb jpc errf0 mv x,[ptrb] call xtom mv x,[ptrk] mv y,[ptrc] call mtom mv x,[ptrl] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,fa2r call mtom mv x,[ptrb] mv y,fa2i call mtom ; a1 = a2 + 27*c; mv x,[ptri] call mtox mv x,fc_27 call mtox call mul jpc errf0 mv x,fa2r call mtox call ad jpc errf0 mv x,fa1r call xtom mv x,[ptrj] call mtox mv x,fc_27 call mtox call mul jpc errf0 mv x,fa2i call mtox call ad jpc errf0 mv x,fa1i call xtom ; abc = FullSimplify[(-a1 + st3*Sqrt[b*b*(a4 + b) + c*(a2 + a1)])^(1/3)]; ;[o,p] <-- b*b*(a4 + b) mv x,[ptrg] pushs x mv y,[ptra] call mtom pops x mv y,[ptrc] call mtom mv x,[ptrh] pushs x mv y,[ptrb] call mtom pops x mv y,[ptrd] call mtom call nmul mv x,fa4r call mtox mv x,[ptrg] call mtox call ad jpc errf0 mv x,[ptrc] call xtom mv x,fa4i call mtox mv x,[ptrh] call mtox call ad jpc errf0 mv x,[ptrd] call xtom call nmul mv x,[ptra] mv y,[ptro] call mtom mv x,[ptrb] mv y,[ptrp] call mtom ;+c*(a2 + a1) mv x,fa2r call mtox mv x,fa1r call mtox call ad jpc errf0 mv x,[ptra] call xtom mv x,fa2i call mtox mv x,fa1i call mtox call ad jpc errf0 mv x,[ptrb] call xtom mv x,[ptri] mv y,[ptrc] call mtom mv x,[ptrj] mv y,[ptrd] call mtom call nmul mv x,[ptra] pushs x call mtox mv x,[ptro] call mtox call ad jpc errf0 pops x call xtom mv x,[ptrb] pushs x call mtox mv x,[ptrp] call mtox call ad jpc errf0 pops x call xtom call nsqr ;*st3 -a1 mv x,[ptra] pushs x call mtox mv x,fc_3bsqrt3 call mtox call mul jpc errf0 mv x,fa1r call mtox call sb jpc errf0 pops x call xtom mv x,[ptrb] pushs x call mtox mv x,fc_3bsqrt3 call mtox call mul jpc errf0 mv x,fa1i call mtox call sb jpc errf0 pops x call xtom ;^(1/3) call ncur mv x,[ptra] mv y,fa5r call mtom mv x,[ptrb] mv y,fa5i call mtom ; b1 = a4/(3*abc); mv x,fa5r pushs x call mtox pops x pushs x call mtox pops x call mtox call ad jpc errf0 call ad jpc errf0 mv x,[ptrc] pushs x call xtom mv x,fa5i pushs x call mtox pops x pushs x call mtox pops x call mtox call ad jpc errf0 call ad jpc errf0 mv x,[ptrd] pushs x call xtom pops x pushs x call mtox pops x call mtox call mul jpc errf0 pops x pushs x call mtox pops x call mtox call mul jpc errf0 call ad jpc errf0 call sqr jpc errf0 mv x,fss pushs x call xtom pops x mv y,[ptre5] call cp ;E5 - ABS(3*ABC) jpnc errf0 mv x,fa4r mv y,[ptra] call mtom mv x,fa4i mv y,[ptrb] call mtom call ndiv mv x,[ptra] mv y,fb1r call mtom mv x,[ptrb] mv y,fb1i call mtom ; b2 = abc*(1/(3*2^(1/3))); mv x,fa5r call mtox mv x,fc_1d3b2pow333 pushs x call mtox call mul jpc errf0 mv x,fb2r call xtom mv x,fa5i call mtox pops x call mtox call mul jpc errf0 mv x,fb2i call xtom ; b3 = b1*(1/(2^(2/3))); mv x,fb1r call mtox mv x,fc_1d2powp666 pushs x call mtox call mul jpc errf0 mv x,fb3r call xtom mv x,fb1i call mtox pops x call mtox call mul jpc errf0 mv x,fb3i call xtom ; b4 = b2/2; mv x,fb2r call mtox mv x,fc_0p5 pushs x call mtox call mul jpc errf0 mv x,fb4r call xtom mv x,fb2i call mtox pops x call mtox call mul jpc errf0 mv x,fb4i call xtom ; Return[{a3 - 2^(1/3)*b1 + b2, --> CR,CI(0) mv x,fa3r call mtox mv x,fb1r call mtox mv x,fc_2powp333 pushs x call mtox call mul jpc errf0 call sb jpc errf0 mv x,fb2r call mtox call ad jpc errf0 mv x,[ptrcr] call xtom mv x,fa3i call mtox mv x,fb1i call mtox pops x call mtox call mul jpc errf0 call sb jpc errf0 mv x,fb2i call mtox call ad jpc errf0 mv x,[ptrci] call xtom ; a3 + o2*b3 - o1*b4, --> CR,CI(1) mv x,fb3r mv y,[ptra] call mtom mv x,fb3i mv y,[ptrb] call mtom mv x,fc_1 mv y,[ptrc] call mtom mv x,fc_sqrt3 mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptro] call mtom mv x,[ptrb] mv y,[ptrp] call mtom mv x,fb4r mv y,[ptra] call mtom mv x,fb4i mv y,[ptrb] call mtom mv x,fc_1 mv y,[ptrc] call mtom mv x,fc_msqrt3 mv y,[ptrd] call mtom call nmul mv x,[ptro] call mtox mv x,[ptra] call mtox call sb jpc errf0 mv x,fa3r call mtox call ad jpc errf0 mv x,[ptrcr] mv a,7 add x,a call xtom mv x,[ptrp] call mtox mv x,[ptrb] call mtox call sb jpc errf0 mv x,fa3i call mtox call ad jpc errf0 mv x,[ptrci] mv a,7 add x,a call xtom ; a3 + o1*b3 - o2*b4}]; --> CR,CI(2) mv x,fb3r mv y,[ptra] call mtom mv x,fb3i mv y,[ptrb] call mtom mv x,fc_1 mv y,[ptrc] call mtom mv x,fc_msqrt3 mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptro] call mtom mv x,[ptrb] mv y,[ptrp] call mtom mv x,fb4r mv y,[ptra] call mtom mv x,fb4i mv y,[ptrb] call mtom mv x,fc_1 mv y,[ptrc] call mtom mv x,fc_sqrt3 mv y,[ptrd] call mtom call nmul mv x,[ptro] call mtox mv x,[ptra] call mtox call sb jpc errf0 mv x,fa3r call mtox call ad jpc errf0 mv x,[ptrcr] mv a,14 add x,a call xtom mv x,[ptrp] call mtox mv x,[ptrb] call mtox call sb jpc errf0 mv x,fa3i call mtox call ad jpc errf0 mv x,[ptrci] mv a,14 add x,a call xtom ; ]; ret err19: mv a,19 ;error on eigen33 jp err fc_1: db 0,000h,010h,000h,000h,000h,000h ;1 fc_27: db 0,001h,027h,000h,000h,000h,000h ;27 fc_2powp333: db 0,000h,012h,059h,092h,010h,050h ;2^(1/3) fc_1d2powp666: db 0,0ffh,062h,099h,060h,052h,049h ;1/(2^(2/3)) fc_1d3b2pow333: db 0,0ffh,026h,045h,066h,084h,020h ;1/(3*2^(1/3)) fc_sqrt3: db 0,000h,017h,032h,005h,008h,008h ;Sqrt(3) fc_msqrt3: db 8,000h,017h,032h,005h,008h,008h ;-Sqrt(3) fc_3bsqrt3: db 0,000h,051h,096h,015h,024h,023h ;3*Sqrt(3) neigen44: call findsingle call finde0e1e2 mv a,'R' call finddblarray mv [ptrcr],x mv a,'I' call finddblarray mv [ptrci],x mv a,'A' call findmat00 mv [ptrma],x mv a,'N' call findmat00 mv [ptrmn],x mv a,7 mv x,aq11 mv y,[ptrma] mv il,4*4 ne4000: mv [x++],y add y,a dec il jrnz ne4000 mv x,nq11 mv y,[ptrmn] mv il,4*4 ne4001: mv [x++],y add y,a dec il jrnz ne4001 ;eigen4[A_] := Module[{a, b, b1, b2, b3, c, c1, d, d1, d2, d3, d4}, ; a = A; ; b1 = a[[1, 2]]*a[[2, 1]]; mv x,[aq12] mv y,[ptra] call mtom mv x,[nq12] mv y,[ptrb] call mtom mv x,[aq21] mv y,[ptrc] call mtom mv x,[nq21] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,fb1r call mtom mv x,[ptrb] mv y,fb1i call mtom ; b2 = a[[2, 2]]*a[[3, 3]]; mv x,[aq22] mv y,[ptra] call mtom mv x,[nq22] mv y,[ptrb] call mtom mv x,[aq33] mv y,[ptrc] call mtom mv x,[nq33] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,fb2r call mtom mv x,[ptrb] mv y,fb2i call mtom ; b3 = a[[2, 4]]*a[[4, 2]]; mv x,[aq24] mv y,[ptra] call mtom mv x,[nq24] mv y,[ptrb] call mtom mv x,[aq42] mv y,[ptrc] call mtom mv x,[nq42] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,fb3r call mtom mv x,[ptrb] mv y,fb3i call mtom ; c1 = a[[2, 3]]*a[[3, 2]]; mv x,[aq23] mv y,[ptra] call mtom mv x,[nq23] mv y,[ptrb] call mtom mv x,[aq32] mv y,[ptrc] call mtom mv x,[nq32] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,fc1r call mtom mv x,[ptrb] mv y,fc1i call mtom ; c2 = a[[2, 2]] + a[[3, 3]] mv x,[aq22] call mtox mv x,[aq33] call mtox call ad jpc errf0 mv x,fc2r call xtom mv x,[nq22] call mtox mv x,[nq33] call mtox call ad jpc errf0 mv x,fc2i call xtom ; c3 = c2 + a[[4, 4]] mv x,fc2r call mtox mv x,[aq44] call mtox call ad jpc errf0 mv x,fc3r call xtom mv x,fc2i call mtox mv x,[nq44] call mtox call ad jpc errf0 mv x,fc3i call xtom ; d1 = a[[2, 4]]*a[[3, 3]]; mv x,[aq24] mv y,[ptra] call mtom mv x,[nq24] mv y,[ptrb] call mtom mv x,[aq33] mv y,[ptrc] call mtom mv x,[nq33] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,fd1r call mtom mv x,[ptrb] mv y,fd1i call mtom ; d2 = a[[2, 3]]*a[[3, 4]]; mv x,[aq23] mv y,[ptra] call mtom mv x,[nq23] mv y,[ptrb] call mtom mv x,[aq34] mv y,[ptrc] call mtom mv x,[nq34] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,fd2r call mtom mv x,[ptrb] mv y,fd2i call mtom ; d3 = a[[2, 4]]*a[[4, 3]]; mv x,[aq24] mv y,[ptra] call mtom mv x,[nq24] mv y,[ptrb] call mtom mv x,[aq43] mv y,[ptrc] call mtom mv x,[nq43] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,fd3r call mtom mv x,[ptrb] mv y,fd3i call mtom ; d4 = a[[3, 4]]*a[[4, 3]]; mv x,[aq34] mv y,[ptra] call mtom mv x,[nq34] mv y,[ptrb] call mtom mv x,[aq43] mv y,[ptrc] call mtom mv x,[nq43] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,fd4r call mtom mv x,[ptrb] mv y,fd4i call mtom ; d = ( ; (d1-d2)*a[[4, 1]] mv x,fd1r call mtox mv x,fd2r call mtox call sb jpc errf0 mv x,[ptra] call xtom mv x,fd1i call mtox mv x,fd2i call mtox call sb jpc errf0 mv x,[ptrb] call xtom mv x,[aq41] mv y,[ptrc] call mtom mv x,[nq41] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptro] call mtom mv x,[ptrb] mv y,[ptrp] call mtom ; - d3*a[[3, 1]] mv x,fd3r mv y,[ptra] call mtom mv x,fd3i mv y,[ptrb] call mtom mv x,[aq31] mv y,[ptrc] call mtom mv x,[nq31] mv y,[ptrd] call mtom call nmul mv x,[ptro] pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,[ptrp] pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; + d4*a[[2, 1]] mv x,fd4r mv y,[ptra] call mtom mv x,fd4i mv y,[ptrb] call mtom mv x,[aq21] mv y,[ptrc] call mtom mv x,[nq21] mv y,[ptrd] call mtom call nmul mv x,[ptro] call mtox mv x,[ptra] pushs x call mtox call ad jpc errf0 pops x call xtom mv x,[ptrp] call mtox mv x,[ptrb] pushs x call mtox call ad jpc errf0 pops x call xtom ; )*a[[1, 2]] mv x,[aq12] mv y,[ptrc] call mtom mv x,[nq12] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptro] call mtom mv x,[ptrb] mv y,[ptrp] call mtom ; + ( ; + d2*a[[4, 2]] mv x,fd2r mv y,[ptra] call mtom mv x,fd2i mv y,[ptrb] call mtom mv x,[aq42] mv y,[ptrc] call mtom mv x,[nq42] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptrs] call mtom mv x,[ptrb] mv y,[ptrt] call mtom ; + d3*a[[3, 2]] mv x,fd3r mv y,[ptra] call mtom mv x,fd3i mv y,[ptrb] call mtom mv x,[aq32] mv y,[ptrc] call mtom mv x,[nq32] mv y,[ptrd] call mtom call nmul mv x,[ptrs] pushs x call mtox mv x,[ptra] call mtox call ad jpc errf0 pops x call xtom mv x,[ptrt] pushs x call mtox mv x,[ptrb] call mtox call ad jpc errf0 pops x call xtom ; -d1*a[[4, 2]] mv x,fd1r mv y,[ptra] call mtom mv x,fd1i mv y,[ptrb] call mtom mv x,[aq42] mv y,[ptrc] call mtom mv x,[nq42] mv y,[ptrd] call mtom call nmul mv x,[ptrs] pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,[ptrt] pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; - d4*a[[2, 2]] mv x,fd4r mv y,[ptra] call mtom mv x,fd4i mv y,[ptrb] call mtom mv x,[aq22] mv y,[ptrc] call mtom mv x,[nq22] mv y,[ptrd] call mtom call nmul mv x,[ptrs] call mtox mv x,[ptra] pushs x call mtox call sb jpc errf0 pops x call xtom mv x,[ptrt] call mtox mv x,[ptrb] pushs x call mtox call sb jpc errf0 pops x call xtom ; )*a[[1, 1]] mv x,[aq11] mv y,[ptrc] call mtom mv x,[nq11] mv y,[ptrd] call mtom call nmul mv x,[ptro] pushs x call mtox mv x,[ptra] call mtox call ad jpc errf0 pops x call xtom mv x,[ptrp] pushs x call mtox mv x,[ptrb] call mtox call ad jpc errf0 pops x call xtom ; + ( ; a[[2, 3]]*a[[3, 2]]*a[[4, 1]] mv x,[aq23] mv y,[ptra] call mtom mv x,[nq23] mv y,[ptrb] call mtom mv x,[aq32] mv y,[ptrc] call mtom mv x,[nq32] mv y,[ptrd] call mtom call nmul mv x,[aq41] mv y,[ptrc] call mtom mv x,[nq41] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptrs] call mtom mv x,[ptrb] mv y,[ptrt] call mtom ; + a[[2, 1]]*a[[3, 3]]*a[[4, 2]] mv x,[aq21] mv y,[ptra] call mtom mv x,[nq21] mv y,[ptrb] call mtom mv x,[aq33] mv y,[ptrc] call mtom mv x,[nq33] mv y,[ptrd] call mtom call nmul mv x,[aq42] mv y,[ptrc] call mtom mv x,[nq42] mv y,[ptrd] call mtom call nmul mv x,[ptrs] pushs x call mtox mv x,[ptra] call mtox call ad jpc errf0 pops x call xtom mv x,[ptrt] pushs x call mtox mv x,[ptrb] call mtox call ad jpc errf0 pops x call xtom ; + a[[2, 2]]*a[[3, 1]]*a[[4, 3]] mv x,[aq22] mv y,[ptra] call mtom mv x,[nq22] mv y,[ptrb] call mtom mv x,[aq31] mv y,[ptrc] call mtom mv x,[nq31] mv y,[ptrd] call mtom call nmul mv x,[aq43] mv y,[ptrc] call mtom mv x,[nq43] mv y,[ptrd] call mtom call nmul mv x,[ptrs] pushs x call mtox mv x,[ptra] call mtox call ad jpc errf0 pops x call xtom mv x,[ptrt] pushs x call mtox mv x,[ptrb] call mtox call ad jpc errf0 pops x call xtom ; - a[[2, 2]]*a[[3, 3]]*a[[4,1]] mv x,[aq22] mv y,[ptra] call mtom mv x,[nq22] mv y,[ptrb] call mtom mv x,[aq33] mv y,[ptrc] call mtom mv x,[nq33] mv y,[ptrd] call mtom call nmul mv x,[aq41] mv y,[ptrc] call mtom mv x,[nq41] mv y,[ptrd] call mtom call nmul mv x,[ptrs] pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,[ptrt] pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; - a[[2, 3]]*a[[3, 1]]*a[[4, 2]] mv x,[aq23] mv y,[ptra] call mtom mv x,[nq23] mv y,[ptrb] call mtom mv x,[aq31] mv y,[ptrc] call mtom mv x,[nq31] mv y,[ptrd] call mtom call nmul mv x,[aq42] mv y,[ptrc] call mtom mv x,[nq42] mv y,[ptrd] call mtom call nmul mv x,[ptrs] pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,[ptrt] pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; - a[[2, 1]]*a[[3, 2]]*a[[4, 3]] mv x,[aq21] mv y,[ptra] call mtom mv x,[nq21] mv y,[ptrb] call mtom mv x,[aq32] mv y,[ptrc] call mtom mv x,[nq32] mv y,[ptrd] call mtom call nmul mv x,[aq43] mv y,[ptrc] call mtom mv x,[nq43] mv y,[ptrd] call mtom call nmul mv x,[ptrs] call mtox mv x,[ptra] pushs x call mtox call sb jpc errf0 pops x call xtom mv x,[ptrt] call mtox mv x,[ptrb] pushs x call mtox call sb jpc errf0 pops x call xtom ; )*a[[1,4]] mv x,[aq14] mv y,[ptrc] call mtom mv x,[nq14] mv y,[ptrd] call mtom call nmul mv x,[ptro] pushs x call mtox mv x,[ptra] call mtox call ad jpc errf0 pops x call xtom mv x,[ptrp] pushs x call mtox mv x,[ptrb] call mtox call ad jpc errf0 pops x call xtom ; + ( ; a[[1, 2]]*a[[2,3]]*a[[3, 1]] mv x,[aq12] mv y,[ptra] call mtom mv x,[nq12] mv y,[ptrb] call mtom mv x,[aq23] mv y,[ptrc] call mtom mv x,[nq23] mv y,[ptrd] call mtom call nmul mv x,[aq31] mv y,[ptrc] call mtom mv x,[nq31] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptrs] call mtom mv x,[ptrb] mv y,[ptrt] call mtom ; - c1*a[[1, 1]] mv x,fc1r mv y,[ptra] call mtom mv x,fc1i mv y,[ptrb] call mtom mv x,[aq11] mv y,[ptrc] call mtom mv x,[nq11] mv y,[ptrd] call mtom call nmul mv x,[ptrs] pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,[ptrt] pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; - b1*a[[3, 3]] mv x,fb1r mv y,[ptra] call mtom mv x,fb1i mv y,[ptrb] call mtom mv x,[aq33] mv y,[ptrc] call mtom mv x,[nq33] mv y,[ptrd] call mtom call nmul mv x,[ptrs] pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,[ptrt] pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; + b2*a[[1, 1]] mv x,fb2r mv y,[ptra] call mtom mv x,fb2i mv y,[ptrb] call mtom mv x,[aq11] mv y,[ptrc] call mtom mv x,[nq11] mv y,[ptrd] call mtom call nmul mv x,[ptrs] call mtox mv x,[ptra] pushs x call mtox call ad jpc errf0 pops x call xtom mv x,[ptrt] call mtox mv x,[ptrb] pushs x call mtox call ad jpc errf0 pops x call xtom ; )*a[[4, 4]] mv x,[aq44] mv y,[ptrc] call mtom mv x,[nq44] mv y,[ptrd] call mtom call nmul mv x,[ptro] pushs x call mtox mv x,[ptra] call mtox call ad jpc errf0 pops x call xtom mv x,[ptrp] pushs x call mtox mv x,[ptrb] call mtox call ad jpc errf0 pops x call xtom ; + ( ; + a[[2, 2]]*a[[3, 4]]*a[[4, 1]] mv x,[aq22] mv y,[ptra] call mtom mv x,[nq22] mv y,[ptrb] call mtom mv x,[aq34] mv y,[ptrc] call mtom mv x,[nq34] mv y,[ptrd] call mtom call nmul mv x,[aq41] mv y,[ptrc] call mtom mv x,[nq41] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptrs] call mtom mv x,[ptrb] mv y,[ptrt] call mtom ; + b3*a[[3, 1]] mv x,fb3r mv y,[ptra] call mtom mv x,fb3i mv y,[ptrb] call mtom mv x,[aq31] mv y,[ptrc] call mtom mv x,[nq31] mv y,[ptrd] call mtom call nmul mv x,[ptrs] pushs x call mtox mv x,[ptra] call mtox call ad jpc errf0 pops x call xtom mv x,[ptrt] pushs x call mtox mv x,[ptrb] call mtox call ad jpc errf0 pops x call xtom ; + a[[2, 1]]*a[[3, 2]]*a[[4, 4]] mv x,[aq21] mv y,[ptra] call mtom mv x,[nq21] mv y,[ptrb] call mtom mv x,[aq32] mv y,[ptrc] call mtom mv x,[nq32] mv y,[ptrd] call mtom call nmul mv x,[aq44] mv y,[ptrc] call mtom mv x,[nq44] mv y,[ptrd] call mtom call nmul mv x,[ptrs] pushs x call mtox mv x,[ptra] call mtox call ad jpc errf0 pops x call xtom mv x,[ptrt] pushs x call mtox mv x,[ptrb] call mtox call ad jpc errf0 pops x call xtom ; -a[[2, 4]]*a[[3, 2]]*a[[4, 1]] mv x,[aq24] mv y,[ptra] call mtom mv x,[nq24] mv y,[ptrb] call mtom mv x,[aq32] mv y,[ptrc] call mtom mv x,[nq32] mv y,[ptrd] call mtom call nmul mv x,[aq41] mv y,[ptrc] call mtom mv x,[nq41] mv y,[ptrd] call mtom call nmul mv x,[ptrs] pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,[ptrt] pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; - a[[2, 1]]*a[[3, 4]]*a[[4, 2]] mv x,[aq21] mv y,[ptra] call mtom mv x,[nq21] mv y,[ptrb] call mtom mv x,[aq34] mv y,[ptrc] call mtom mv x,[nq34] mv y,[ptrd] call mtom call nmul mv x,[aq42] mv y,[ptrc] call mtom mv x,[nq42] mv y,[ptrd] call mtom call nmul mv x,[ptrs] pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,[ptrt] pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; - a[[2, 2]]*a[[3, 1]]*a[[4, 4]] mv x,[aq22] mv y,[ptra] call mtom mv x,[nq22] mv y,[ptrb] call mtom mv x,[aq31] mv y,[ptrc] call mtom mv x,[nq31] mv y,[ptrd] call mtom call nmul mv x,[aq44] mv y,[ptrc] call mtom mv x,[nq44] mv y,[ptrd] call mtom call nmul mv x,[ptrs] call mtox mv x,[ptra] pushs x call mtox call sb jpc errf0 pops x call xtom mv x,[ptrt] call mtox mv x,[ptrb] pushs x call mtox call sb jpc errf0 pops x call xtom ; )*a[[1, 3]]; mv x,[aq13] mv y,[ptrc] call mtom mv x,[nq13] mv y,[ptrd] call mtom call nmul mv x,[ptro] pushs x call mtox mv x,[ptra] call mtox call ad jpc errf0 pops x call xtom mv x,[ptrp] pushs x call mtox mv x,[ptrb] call mtox call ad jpc errf0 pops x call xtom ; c = ( ; c1 + d4 mv x,fc1r call mtox mv x,fd4r call mtox call ad jpc errf0 mv x,[ptri] call xtom mv x,fc1i call mtox mv x,fd4i call mtox call ad jpc errf0 mv x,[ptrj] call xtom ; - a[[2, 2]]*a[[3,3]] mv x,[aq22] mv y,[ptra] call mtom mv x,[nq22] mv y,[ptrb] call mtom mv x,[aq33] mv y,[ptrc] call mtom mv x,[nq33] mv y,[ptrd] call mtom call nmul mv x,[ptri] pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,[ptrj] pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; + a[[2, 4]]*a[[4, 2]] mv x,[aq24] mv y,[ptra] call mtom mv x,[nq24] mv y,[ptrb] call mtom mv x,[aq42] mv y,[ptrc] call mtom mv x,[nq42] mv y,[ptrd] call mtom call nmul mv x,[ptri] call mtox mv x,[ptra] pushs x call mtox call ad jpc errf0 pops x call xtom mv x,[ptrj] call mtox mv x,[ptrb] pushs x call mtox call ad jpc errf0 pops x call xtom ; )*a[[1, 1]] mv x,[aq11] mv y,[ptrc] call mtom mv x,[nq11] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptri] call mtom mv x,[ptrb] mv y,[ptrj] call mtom ; + ( ; a[[2, 2]]*a[[4, 1]] mv x,[aq22] mv y,[ptra] call mtom mv x,[nq22] mv y,[ptrb] call mtom mv x,[aq41] mv y,[ptrc] call mtom mv x,[nq41] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptrs] call mtom mv x,[ptrb] mv y,[ptrt] call mtom ; + a[[3, 3]]*a[[4, 1]] mv x,[aq33] mv y,[ptra] call mtom mv x,[nq33] mv y,[ptrb] call mtom mv x,[aq41] mv y,[ptrc] call mtom mv x,[nq41] mv y,[ptrd] call mtom call nmul mv x,[ptrs] pushs x call mtox mv x,[ptra] call mtox call ad jpc errf0 pops x call xtom mv x,[ptrt] pushs x call mtox mv x,[ptrb] call mtox call ad jpc errf0 pops x call xtom ; - a[[2, 1]]*a[[4, 2]] mv x,[aq21] mv y,[ptra] call mtom mv x,[nq21] mv y,[ptrb] call mtom mv x,[aq42] mv y,[ptrc] call mtom mv x,[nq42] mv y,[ptrd] call mtom call nmul mv x,[ptrs] pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,[ptrt] pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; - a[[3, 1]]*a[[4, 3]] mv x,[aq31] mv y,[ptra] call mtom mv x,[nq31] mv y,[ptrb] call mtom mv x,[aq43] mv y,[ptrc] call mtom mv x,[nq43] mv y,[ptrd] call mtom call nmul mv x,[ptrs] call mtox mv x,[ptra] pushs x call mtox call sb jpc errf0 pops x call xtom mv x,[ptrt] call mtox mv x,[ptrb] pushs x call mtox call sb jpc errf0 pops x call xtom ; )*a[[1, 4]] mv x,[aq14] mv y,[ptrc] call mtom mv x,[nq14] mv y,[ptrd] call mtom call nmul mv x,[ptri] pushs x call mtox mv x,[ptra] call mtox call ad jpc errf0 pops x call xtom mv x,[ptrj] pushs x call mtox mv x,[ptrb] call mtox call ad jpc errf0 pops x call xtom ; + ( ; a[[3, 3]]*a[[4, 2]] mv x,[aq33] mv y,[ptra] call mtom mv x,[nq33] mv y,[ptrb] call mtom mv x,[aq42] mv y,[ptrc] call mtom mv x,[nq42] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptrs] call mtom mv x,[ptrb] mv y,[ptrt] call mtom ; - a[[3, 2]]*a[[4, 3]] mv x,[aq32] mv y,[ptra] call mtom mv x,[nq32] mv y,[ptrb] call mtom mv x,[aq43] mv y,[ptrc] call mtom mv x,[nq43] mv y,[ptrd] call mtom call nmul mv x,[ptrs] call mtox mv x,[ptra] pushs x call mtox call sb jpc errf0 pops x call xtom mv x,[ptrt] call mtox mv x,[ptrb] pushs x call mtox call sb jpc errf0 pops x call xtom ; )*a[[2, 4]] mv x,[aq24] mv y,[ptrc] call mtom mv x,[nq24] mv y,[ptrd] call mtom call nmul mv x,[ptri] pushs x call mtox mv x,[ptra] call mtox call ad jpc errf0 pops x call xtom mv x,[ptrj] pushs x call mtox mv x,[ptrb] call mtox call ad jpc errf0 pops x call xtom ; - a[[2, 3]]*a[[3, 4]]*a[[4, 2]] mv x,[aq23] mv y,[ptra] call mtom mv x,[nq23] mv y,[ptrb] call mtom mv x,[aq34] mv y,[ptrc] call mtom mv x,[nq34] mv y,[ptrd] call mtom call nmul mv x,[aq42] mv y,[ptrc] call mtom mv x,[nq42] mv y,[ptrd] call mtom call nmul mv x,[ptri] pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,[ptrj] pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; + d4*a[[2, 2]] mv x,fd4r mv y,[ptra] call mtom mv x,fd4i mv y,[ptrb] call mtom mv x,[aq22] mv y,[ptrc] call mtom mv x,[nq22] mv y,[ptrd] call mtom call nmul mv x,[ptri] pushs x call mtox mv x,[ptra] call mtox call ad jpc errf0 pops x call xtom mv x,[ptrj] pushs x call mtox mv x,[ptrb] call mtox call ad jpc errf0 pops x call xtom ; - ( ; a[[1, 1]]*a[[2, 2]] mv x,[aq11] mv y,[ptra] call mtom mv x,[nq11] mv y,[ptrb] call mtom mv x,[aq22] mv y,[ptrc] call mtom mv x,[nq22] mv y,[ptrd] call mtom call nmul ; - c1 mv x,[ptra] call mtox mv x,fc1r call mtox call sb jpc errf0 mv x,[ptrs] call xtom mv x,[ptrb] call mtox mv x,fc1i call mtox call sb jpc errf0 mv x,[ptrt] call xtom ; + ( ; a[[1, 1]] + a[[2, 2]] mv x,[aq11] call mtox mv x,[aq22] call mtox call ad jpc errf0 mv x,[ptra] call xtom mv x,[nq11] call mtox mv x,[nq22] call mtox call ad jpc errf0 mv x,[ptrb] call xtom ; )*a[[3, 3]] mv x,[aq33] mv y,[ptrc] call mtom mv x,[nq33] mv y,[ptrd] call mtom call nmul mv x,[ptrs] call mtox mv x,[ptra] pushs x call mtox call ad jpc errf0 pops x call xtom mv x,[ptrt] call mtox mv x,[ptrb] pushs x call mtox call ad jpc errf0 pops x call xtom ; )*a[[4, 4]] mv x,[aq44] mv y,[ptrc] call mtom mv x,[nq44] mv y,[ptrd] call mtom call nmul mv x,[ptri] pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,[ptrj] pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; + ( ; -a[[2, 1]]*a[[3, 2]] mv x,[aq21] mv y,[ptra] call mtom mv x,[nq21] mv y,[ptrb] call mtom mv x,[aq32] mv y,[ptrc] call mtom mv x,[nq32] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptrs] pushs y call mtom pops x call chs mv x,[ptrb] mv y,[ptrt] pushs y call mtom pops x call chs ; - a[[3, 4]]*a[[4, 1]] mv x,[aq34] mv y,[ptra] call mtom mv x,[nq34] mv y,[ptrb] call mtom mv x,[aq41] mv y,[ptrc] call mtom mv x,[nq41] mv y,[ptrd] call mtom call nmul mv x,[ptrs] pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,[ptrt] pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; + ( ; a[[2, 2]] + a[[4, 4]] mv x,[aq22] call mtox mv x,[aq44] call mtox call ad jpc errf0 mv x,[ptra] call xtom mv x,[nq22] call mtox mv x,[nq44] call mtox call ad jpc errf0 mv x,[ptrb] call xtom ; )*a[[3, 1]] mv x,[aq31] mv y,[ptrc] call mtom mv x,[nq31] mv y,[ptrd] call mtom call nmul mv x,[ptrs] call mtox mv x,[ptra] pushs x call mtox call ad jpc errf0 pops x call xtom mv x,[ptrt] call mtox mv x,[ptrb] pushs x call mtox call ad jpc errf0 pops x call xtom ; )*a[[1, 3]] mv x,[aq13] mv y,[ptrc] call mtom mv x,[nq13] mv y,[ptrd] call mtom call nmul mv x,[ptri] pushs x call mtox mv x,[ptra] call mtox call ad jpc errf0 pops x call xtom mv x,[ptrj] pushs x call mtox mv x,[ptrb] call mtox call ad jpc errf0 pops x call xtom ; + ( ; -a[[2, 3]]*a[[3, 1]] mv x,[aq23] mv y,[ptra] call mtom mv x,[nq23] mv y,[ptrb] call mtom mv x,[aq31] mv y,[ptrc] call mtom mv x,[nq31] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptrs] pushs y call mtom pops x call chs mv x,[ptrb] mv y,[ptrt] pushs y call mtom pops x call chs ; - a[[2,4]]*a[[4, 1]] mv x,[aq24] mv y,[ptra] call mtom mv x,[nq24] mv y,[ptrb] call mtom mv x,[aq41] mv y,[ptrc] call mtom mv x,[nq41] mv y,[ptrd] call mtom call nmul mv x,[ptrs] pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,[ptrt] pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; + ( ; a[[3, 3]] + a[[4, 4]] mv x,[aq33] call mtox mv x,[aq44] call mtox call ad jpc errf0 mv x,[ptra] call xtom mv x,[nq33] call mtox mv x,[nq44] call mtox call ad jpc errf0 mv x,[ptrb] call xtom ; )*a[[2, 1]] mv x,[aq21] mv y,[ptrc] call mtom mv x,[nq21] mv y,[ptrd] call mtom call nmul mv x,[ptrs] call mtox mv x,[ptra] pushs x call mtox call ad jpc errf0 pops x call xtom mv x,[ptrt] call mtox mv x,[ptrb] pushs x call mtox call ad jpc errf0 pops x call xtom ; )*a[[1, 2]]; mv x,[aq12] mv y,[ptrc] call mtom mv x,[nq12] mv y,[ptrd] call mtom call nmul mv x,[ptri] pushs x call mtox mv x,[ptra] call mtox call ad jpc errf0 pops x call xtom mv x,[ptrj] pushs x call mtox mv x,[ptrb] call mtox call ad jpc errf0 pops x call xtom ; b = ; + c2*a[[4, 4]] mv x,fc2r mv y,[ptra] call mtom mv x,fc2i mv y,[ptrb] call mtom mv x,[aq44] mv y,[ptrc] call mtom mv x,[nq44] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptrg] call mtom mv x,[ptrb] mv y,[ptrh] call mtom ; + c3*a[[1, 1]]; mv x,fc3r mv y,[ptra] call mtom mv x,fc3i mv y,[ptrb] call mtom mv x,[aq11] mv y,[ptrc] call mtom mv x,[nq11] mv y,[ptrd] call mtom call nmul mv x,[ptrg] pushs x call mtox mv x,[ptra] call mtox call ad jpc errf0 pops x call xtom mv x,[ptrh] pushs x call mtox mv x,[ptrb] call mtox call ad jpc errf0 pops x call xtom ; -b1 ; + b2 mv x,[ptrg] pushs x call mtox mv x,fb1r call mtox call sb jpc errf0 mv x,fb2r call mtox call ad jpc errf0 pops x call xtom mv x,[ptrh] pushs x call mtox mv x,fb1i call mtox call sb jpc errf0 mv x,fb2i call mtox call ad jpc errf0 pops x call xtom ; - a[[1, 3]]*a[[3,1]] mv x,[aq13] mv y,[ptra] call mtom mv x,[nq13] mv y,[ptrb] call mtom mv x,[aq31] mv y,[ptrc] call mtom mv x,[nq31] mv y,[ptrd] call mtom call nmul mv x,[ptrg] pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,[ptrh] pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; - c1 mv x,[ptrg] pushs x call mtox mv x,fc1r call mtox call sb jpc errf0 pops x call xtom mv x,[ptrh] pushs x call mtox mv x,fc1i call mtox call sb jpc errf0 pops x call xtom ; - a[[1, 4]]*a[[4, 1]] mv x,[aq14] mv y,[ptra] call mtom mv x,[nq14] mv y,[ptrb] call mtom mv x,[aq41] mv y,[ptrc] call mtom mv x,[nq41] mv y,[ptrd] call mtom call nmul mv x,[ptrg] pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,[ptrh] pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; - b3 ; - d4 mv x,[ptrg] pushs x call mtox mv x,fb3r call mtox call sb jpc errf0 mv x,fd4r call mtox call sb jpc errf0 pops x call xtom mv x,[ptrh] pushs x call mtox mv x,fb3i call mtox call sb jpc errf0 mv x,fd4i call mtox call sb jpc errf0 pops x call xtom ; a = -a[[1, 1]] - c3; mv x,[aq11] call mtox mv x,fc3r call mtox call ad jpc errf0 mv x,[ptrk] pushs x call xtom pops x call chs mv x,[nq11] call mtox mv x,fc3i call mtox call ad jpc errf0 mv x,[ptrl] pushs x call xtom pops x call chs ; Return[solve4[a, b, c, d]]; ; ]; ;solve4[a_, b_, c_, d_] := Module[{a2, a4, ab, b1, b2, b3, b4, b5, b6, b7}, ; a2 = a*a; mv x,[ptrk] pushs x mv y,[ptra] call mtom pops x mv y,[ptrc] call mtom mv x,[ptrl] pushs x mv y,[ptrb] call mtom pops x mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,fa2r call mtom mv x,[ptrb] mv y,fa2i call mtom ; a4 = -a/4; mv x,[ptrk] call mtox mv x,fc_m0p25 call mtox call mul jpc errf0 mv x,fa4r call xtom mv x,[ptrl] call mtox mv x,fc_m0p25 call mtox call mul jpc errf0 mv x,fa4i call xtom ; ab = a*b; mv x,[ptrk] mv y,[ptra] call mtom mv x,[ptrl] mv y,[ptrb] call mtom mv x,[ptrg] mv y,[ptrc] call mtom mv x,[ptrh] mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,fa5r call mtom mv x,[ptrb] mv y,fa5i call mtom ; b1 = a2/4 - b*2/3; mv x,fa2r call mtox mv x,fc_0p25 call mtox call mul jpc errf0 mv x,[ptrg] call mtox mv x,fc_0p666 call mtox call mul jpc errf0 call sb jpc errf0 mv x,fb1r call xtom mv x,fa2i call mtox mv x,fc_0p25 call mtox call mul jpc errf0 mv x,[ptrh] call mtox mv x,fc_0p666 call mtox call mul jpc errf0 call sb jpc errf0 mv x,fb1i call xtom ; b2 = b*b; mv x,[ptrg] pushs x mv y,[ptra] call mtom pops x mv y,[ptrc] call mtom mv x,[ptrh] pushs x mv y,[ptrb] call mtom pops x mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,fb2r call mtom mv x,[ptrb] mv y,fb2i call mtom ; b3 = ; + 12*d; mv x,[ptro] call mtox mv x,fc_12 call mtox call mul jpc errf0 mv x,fb3r call xtom mv x,[ptrp] call mtox mv x,fc_12 call mtox call mul jpc errf0 mv x,fb3i call xtom ; - 3*a*c ; + b2 mv x,[ptrk] mv y,[ptra] call mtom mv x,[ptrl] mv y,[ptrb] call mtom mv x,[ptri] mv y,[ptrc] call mtom mv x,[ptrj] mv y,[ptrd] call mtom call nmul mv x,fb2r call mtox mv x,fb3r pushs x call mtox mv x,[ptra] call mtox mv x,fc_3 call mtox call mul jpc errf0 call sb jpc errf0 call ad jpc errf0 pops x call xtom mv x,fb2i call mtox mv x,fb3i pushs x call mtox mv x,[ptrb] call mtox mv x,fc_3 call mtox call mul jpc errf0 call sb jpc errf0 call ad jpc errf0 pops x call xtom ; b4 = 2*b2*b mv x,fb2r mv y,[ptra] call mtom mv x,fb2i mv y,[ptrb] call mtom mv x,[ptrg] mv y,[ptrc] call mtom mv x,[ptrh] mv y,[ptrd] call mtom call nmul mv x,[ptra] pushs x call mtox pops x call mtox call ad jpc errf0 mv x,fb4r call xtom mv x,[ptrb] pushs x call mtox pops x call mtox call ad jpc errf0 mv x,fb4i call xtom ; - (9*ab - 27*c)*c mv x,fa5r call mtox mv x,fc_9 call mtox call mul jpc errf0 mv x,[ptri] call mtox mv x,fc_27 call mtox call mul jpc errf0 call sb jpc errf0 mv x,[ptra] call xtom mv x,fa5i call mtox mv x,fc_9 call mtox call mul jpc errf0 mv x,[ptrj] call mtox mv x,fc_27 call mtox call mul jpc errf0 call sb jpc errf0 mv x,[ptrb] call xtom mv x,[ptri] mv y,[ptrc] call mtom mv x,[ptrj] mv y,[ptrd] call mtom call nmul mv x,fb4r pushs x call mtox mv x,[ptra] call mtox call sb jpc errf0 pops x call xtom mv x,fb4i pushs x call mtox mv x,[ptrb] call mtox call sb jpc errf0 pops x call xtom ; + (27*a2 - 72*b)*d; mv x,fa2r call mtox mv x,fc_27 call mtox call mul jpc errf0 mv x,[ptrg] call mtox mv x,fc_72 call mtox call mul jpc errf0 call sb jpc errf0 mv x,[ptra] call xtom mv x,fa2i call mtox mv x,fc_27 call mtox call mul jpc errf0 mv x,[ptrh] call mtox mv x,fc_72 call mtox call mul jpc errf0 call sb jpc errf0 mv x,[ptrb] call xtom mv x,[ptro] mv y,[ptrc] call mtom mv x,[ptrp] mv y,[ptrd] call mtom call nmul mv x,fb4r pushs x call mtox mv x,[ptra] call mtox call ad jpc errf0 pops x call xtom mv x,fb4i pushs x call mtox mv x,[ptrb] call mtox call ad jpc errf0 pops x call xtom ; b5 = -a2*a + 4*(ab - c - c); mv x,fa2r mv y,[ptra] pushs y call mtom mv x,fa2i mv y,[ptrb] pushs y call mtom mv x,[ptrk] mv y,[ptrc] call mtom mv x,[ptrl] mv y,[ptrd] call mtom call nmul pops x call chs pops x call chs mv x,fa5r call mtox mv x,[ptri] pushs x call mtox call sb jpc errf0 pops x call mtox call sb jpc errf0 mv x,fc_4 call mtox call mul jpc errf0 mv x,[ptra] call mtox call ad jpc errf0 mv x,fb5r call xtom mv x,fa5i call mtox mv x,[ptrj] pushs x call mtox call sb jpc errf0 pops x call mtox call sb jpc errf0 mv x,fc_4 call mtox call mul jpc errf0 mv x,[ptrb] call mtox call ad jpc errf0 mv x,fb5i call xtom ; b6 = (b4 + Sqrt[b4*b4 - 4*b3*b3*b3])^(1/3); ;b4*b4 mv x,fb4r pushs x mv y,[ptra] call mtom pops x mv y,[ptrc] call mtom mv x,fb4i pushs x mv y,[ptrb] call mtom pops x mv y,[ptrd] call mtom call nmul mv x,[ptra] mv y,[ptrs] call mtom mv x,[ptrb] mv y,[ptrt] call mtom ;4*b3*b3*b3 mv x,fb3r pushs x pushs x mv y,[ptra] call mtom pops x mv y,[ptrc] call mtom mv x,fb3i pushs x pushs x mv y,[ptrb] call mtom pops x mv y,[ptrd] call mtom call nmul pops x mv y,[ptrd] call mtom pops x mv y,[ptrc] call mtom call nmul mv x,[ptrs] call mtox mv x,[ptra] pushs x call mtox mv x,fc_4 call mtox call mul jpc errf0 call sb jpc errf0 pops x call xtom mv x,[ptrt] call mtox mv x,[ptrb] pushs x call mtox mv x,fc_4 call mtox call mul jpc errf0 call sb jpc errf0 pops x call xtom call nsqr ;+ b4 mv x,[ptra] pushs x call mtox mv x,fb4r call mtox call ad jpc errf0 pops x call xtom mv x,[ptrb] pushs x call mtox mv x,fb4i call mtox call ad jpc errf0 pops x call xtom call ncur mv x,[ptra] mv y,fb6r call mtom mv x,[ptrb] mv y,fb6i call mtom ; b6 = b6/(3*2^(1/3)) mv x,fb6r call mtox mv x,fc_1d3b2pow333 ;1/(3*2^(1/3)) call mtox call mul jpc errf0 mv x,[ptrs] call xtom mv x,fb6i call mtox mv x,fc_1d3b2pow333 ;1/(3*2^(1/3)) call mtox call mul jpc errf0 mv x,[ptrt] call xtom ; + (2^(1/3))*b3/(3*b6); mv x,fb6r call mtox mv x,fc_3 call mtox call mul jpc errf0 mv x,[ptrc] pushs x call xtom mv x,fb6i call mtox mv x,fc_3 call mtox call mul jpc errf0 mv x,[ptrd] pushs x call xtom pops x pushs x call mtox pops x call mtox call mul jpc errf0 pops x pushs x call mtox pops x call mtox call mul jpc errf0 call ad jpc errf0 call sqr jpc errf0 mv x,fss pushs x call xtom pops x mv y,[ptre5] call cp ;E5 - ABS(3*b6) jpnc errf0 mv x,fb3r mv y,[ptra] call mtom mv x,fb3i mv y,[ptrb] call mtom call ndiv ;*(2^(1/3)) mv x,[ptra] call mtox mv x,fc_2powp333 ;2^(1/3) call mtox call mul jpc errf0 mv x,[ptrs] call mtox call ad jpc errf0 mv x,fb6r call xtom mv x,[ptrb] call mtox mv x,fc_2powp333 ;2^(1/3) call mtox call mul jpc errf0 mv x,[ptrt] call mtox call ad jpc errf0 mv x,fb6i call xtom ; b7 = Sqrt[b1 + b6]/2; mv x,fb1r call mtox mv x,fb6r call mtox call ad jpc errf0 mv x,[ptra] call xtom mv x,fb1i call mtox mv x,fb6i call mtox call ad jpc errf0 mv x,[ptrb] call xtom call nsqr mv x,[ptra] call mtox mv x,fc_0p5 call mtox call mul jpc errf0 mv x,fb7r call xtom mv x,[ptrb] call mtox mv x,fc_0p5 call mtox call mul jpc errf0 mv x,fb7i call xtom ; b5 = b5/(8*b7); mv x,fb7r call mtox mv x,fc_8 call mtox call mul jpc errf0 mv x,[ptrc] pushs x call xtom mv x,fb7i call mtox mv x,fc_8 call mtox call mul jpc errf0 mv x,[ptrd] pushs x call xtom pops x pushs x call mtox pops x call mtox call mul jpc errf0 pops x pushs x call mtox pops x call mtox call mul jpc errf0 call ad jpc errf0 call sqr jpc errf0 mv x,fss pushs x call xtom pops x mv y,[ptre5] call cp ;E5 - ABS(8*b7) jpnc errf0 mv x,fb5r mv y,[ptra] call mtom mv x,fb5i mv y,[ptrb] call mtom call ndiv mv y,fb5r mv x,[ptra] call mtom mv y,fb5i mv x,[ptrb] call mtom ; b1 = b1 + b1 - b6; mv x,fb1r pushs x pushs x call mtox pops x call mtox call ad jpc errf0 mv x,fb6r call mtox call sb jpc errf0 mv x,fb1i pushs x pushs x call mtox pops x call mtox call ad jpc errf0 mv x,fb6i call mtox call sb jpc errf0 pops x call xtom pops x call xtom ; b2 = a4 - b7; mv x,fa4r call mtox mv x,fb7r call mtox call sb jpc errf0 mv x,fb2r call xtom mv x,fa4i call mtox mv x,fb7i call mtox call sb jpc errf0 mv x,fb2i call xtom ; b3 = a4 + b7; mv x,fa4r call mtox mv x,fb7r call mtox call ad jpc errf0 mv x,fb3r call xtom mv x,fa4i call mtox mv x,fb7i call mtox call ad jpc errf0 mv x,fb3i call xtom ; b4 = Sqrt[b1 - b5]/2 mv x,fb1r call mtox mv x,fb5r call mtox call sb jpc errf0 mv x,[ptra] call xtom mv x,fb1i call mtox mv x,fb5i call mtox call sb jpc errf0 mv x,[ptrb] call xtom call nsqr mv x,[ptra] call mtox mv x,fc_0p5 call mtox call mul jpc errf0 mv x,fb4r call xtom mv x,[ptrb] call mtox mv x,fc_0p5 call mtox call mul jpc errf0 mv x,fb4i call xtom ; b5 = Sqrt[b1 + b5]/2; mv x,fb1r call mtox mv x,fb5r call mtox call ad jpc errf0 mv x,[ptra] call xtom mv x,fb1i call mtox mv x,fb5i call mtox call ad jpc errf0 mv x,[ptrb] call xtom call nsqr mv x,[ptra] call mtox mv x,fc_0p5 call mtox call mul jpc errf0 mv x,fb5r call xtom mv x,[ptrb] call mtox mv x,fc_0p5 call mtox call mul jpc errf0 mv x,fb5i call xtom ; Return[{b2 - b4, b2 + b4, b3 - b5, b3 + b5}]; mv x,fb2r call mtox mv x,fb4r call mtox call sb jpc errf0 mv x,[ptrcr] call xtom mv x,fb2i call mtox mv x,fb4i call mtox call sb jpc errf0 mv x,[ptrci] call xtom ;b2 + b4 mv x,fb2r call mtox mv x,fb4r call mtox call ad jpc errf0 mv x,[ptrcr] mv a,7 add x,a call xtom mv x,fb2i call mtox mv x,fb4i call mtox call ad jpc errf0 mv x,[ptrci] mv a,7 add x,a call xtom ;b3 - b5 mv x,fb3r call mtox mv x,fb5r call mtox call sb jpc errf0 mv x,[ptrcr] mv a,14 add x,a call xtom mv x,fb3i call mtox mv x,fb5i call mtox call sb jpc errf0 mv x,[ptrci] mv a,14 add x,a call xtom ;b3 + b5 mv x,fb3r call mtox mv x,fb5r call mtox call ad jpc errf0 mv x,[ptrcr] mv a,21 add x,a call xtom mv x,fb3i call mtox mv x,fb5i call mtox call ad jpc errf0 mv x,[ptrci] mv a,21 add x,a call xtom ; ]; ret fc_m0p25: db 8,0ffh,025h,000h,000h,000h,000h ;-1/4 fc_0p25: db 0,0ffh,025h,000h,000h,000h,000h ;1/4 fc_0p666: db 0,0ffh,066h,066h,066h,066h,067h ;2/3 fc_sqrt2: db 0,000h,014h,014h,021h,035h,062h ;Sqrt(2) fc_3: db 0,000h,030h,000h,000h,000h,000h ;3 fc_4: db 0,000h,040h,000h,000h,000h,000h ;4 fc_8: db 0,000h,080h,000h,000h,000h,000h ;8 fc_9: db 0,000h,090h,000h,000h,000h,000h ;9 fc_12: db 0,001h,012h,000h,000h,000h,000h ;12 fc_72: db 0,001h,072h,000h,000h,000h,000h ;72 ;fc_1: ;1 ;fc_27: ;27 ;fc_2powp333: ;2^(1/3) ;fc_1d2powp666: ;1/(2^(2/3)) ;fc_1d3b2pow333: ;1/(3*2^(1/3)) ;fc_sqrt3: ;Sqrt(3) ;fc_msqrt3: ;-Sqrt(3) ;fc_3bsqrt3: ;3*Sqrt(3) err20: mv a,20 ;error on eigen44 jp err nexp: ;5020 "CEXP"IF B=0THEN A=EXP A:RETURN mv x,[ptrb] call is0 jrnz nexp00 mv x,[ptra] pushs x call mtox call exp jrc err21 pops x call xtom ret nexp00: ;5021 F=EXP A:E=F*COS B:B=F*SIN B:A=E:RETURN mv x,[ptra] pushs x call mtox call exp jrc err21 mv x,[ptrf] pushs x call xtom pops x pushs x call mtox pops x call mtox mv x,[ptrb] pushs x pushs x call mtox call cos jrc err21 call mul jrc err21 mv x,[ptre] call xtom pops x call mtox call sin jrc err21 call mul jrc err21 pops x call xtom mv x,[ptre] pops y call mtom ret err21: mv a,21 ;error on exp jp err fnlna: ds 7 fnlnb: ds 7 fnlnc: ds 7 fc_pi: db 0,000h,031h,041h,059h,026h,054h fc_mpi: db 8,000h,031h,041h,059h,026h,054h fc_pid2: db 0,000h,015h,070h,079h,063h,027h fc_mpid2: db 8,000h,015h,070h,079h,063h,027h nln: ;5030 "CLN" ;5031 IF ABS A>=ABS B THEN mv x,[ptra] mv y,fnlna pushs y call mtom pops y pushs y mv a,0 mv [y],a mv x,[ptrb] mv y,fnlnb pushs y call mtom pops y mv a,0 mv [y],a pops x call cp ;ABS B - ABS A jrnc nln00 ;5032 C=ABS A*SQR (1+(B/A)^2) mv x,[ptrb] call mtox mv x,[ptra] call mtox call div jpc err22 mv x,fnlnc pushs x pushs x call xtom pops x pushs x call mtox pops x call mtox call mul jpc err22 pops x pushs x call mv1 pops x call mtox call ad jpc err22 call sqr jpc err22 mv x,fnlna jr nln01 ;5033 ELSE nln00: ;5034 C=ABS B*SQR (1+(A/B)^2) mv x,[ptra] call mtox mv x,[ptrb] call mtox call div jpc err22 mv x,fnlnc pushs x pushs x call xtom pops x pushs x call mtox pops x call mtox call mul jpc err22 pops x pushs x call mv1 pops x call mtox call ad jpc err22 call sqr jpc err22 mv x,fnlnb ;5035 ENDIF nln01: call mtox call mul jpc err22 mv x,[ptrc] call xtom ;5036 D=(SGN B+1)*10+SGN A+1 mv x,[ptra] pushs x call is0 pops x jrz nln11 mv a,[x] cmp a,0 jrz nln12 mv a,0 ;A<0 jr nln13 nln11: mv a,1 ;A==0 jr nln13 nln12: mv a,2 ;A>0 nln13: mv il,a mv x,[ptrb] pushs x call is0 pops x jrz nln21 mv a,[x] cmp a,0 jrz nln22 mv a,0 ;B<0 jr nln23 nln21: mv a,3 ;B==0 jr nln23 nln22: mv a,6 ;B>0 nln23: add a,il cmp a,3*1+0 jrz nln5038 cmp a,3*1+1 jrz nln5039 cmp a,3*1+2 jrz nln5040 cmp a,3*2+0 jrz nln5041 cmp a,3*2+1 jrz nln5042 cmp a,3*2+2 jrz nln5043 cmp a,3*0+0 jrz nln5044 cmp a,3*0+1 jrz nln5045 cmp a,3*0+2 jrz nln5046 ;5037 SWITCH D nln5038: ;5038 CASE 10:B=PI mv x,fc_pi mv y,[ptrb] call mtom jr nln5047 nln5039: ;5039 CASE 11:PRINT "LN 0" jr err22 nln5040: ;5040 CASE 12:B=0 mv x,[ptrb] call mv0 jr nln5047 nln5041: ;5041 CASE 20:B=PI +ATN (B/A) call nln30 mv x,fc_pi nln40: call mtox call ad jrc err22 jr nln42 nln5042: ;5042 CASE 21:B=PI /2 mv x,fc_pid2 nln41: mv y,[ptrb] call mtom jr nln5047 nln5046: ;5046 CASE 2:B=ATN (B/A) nln5043: ;5043 CASE 22:B=ATN (B/A) call nln30 nln42: mv x,[ptrb] call xtom jr nln5047 nln5044: ;5044 CASE 0:B=-PI +ATN (B/A) call nln30 mv x,fc_mpi jr nln40 nln5045: ;5045 CASE 1:B=-PI /2 mv x,fc_mpid2 jr nln41 ;5047 ENDSWITCH nln5047: ;5048 A=LN C:RETURN mv x,[ptrc] call mtox call ln jrc err22 mv x,[ptra] call xtom ret nln30: mv x,[ptrb] call mtox mv x,[ptra] call mtox call div jrc err22 call arctan jrc err22 ret err22: mv a,22 ;error on ln jp err fc_0p5: db 0,0ffh,050h,000h,000h,000h,000h fc_0p333: db 0,0ffh,033h,033h,033h,033h,033h nsqr: mv x,fc_0p5 jr npower ncur: mv x,fc_0p333 jr npower npower: pushs x mv x,[ptra] call is0 jrnz npower00 mv x,[ptrb] call is0 jrz npower01 npower00: call nln mv x,[ptra] call mtox pops x pushs x call mtox call mul jrc err23 mv x,[ptra] call xtom mv x,[ptrb] call mtox pops x call mtox call mul jrc err23 mv x,[ptrb] call xtom call nexp ret npower01: pops x ret err23: mv a,23 ;error on power jp err exchange: ;7 byte [x] <-> [y] mv ba,[x] ;0,1 mv i,[y] mv [x++],i mv [y++],ba mv ba,[x] ;2,3 mv i,[y] mv [x++],i mv [y++],ba mv ba,[x] ;4,5 mv i,[y] mv [x++],i mv [y++],ba mv a,[x] ;6 mv il,[y] mv [x],il mv [y],a ret findmatrix: mv a,[charn] pushs a dec a mv [charn1],a dec a mv [charn2],a pops a mv x,0 mv il,a fi30: add x,a dec il jrnz fi30 mv y,x add x,x add x,x add x,x sub x,y mv [lengthofmatrix],x mv a,11 add x,a mv [lengthofmdata],x mv a,'A' mv y,ptrma fi31: pushs a pushs y call findmat00 pops y pops a mv x,0 mv [y++],x inc a cmp a,'Z'+1 jrnz fi31 mv a,[charn] mv [fi3s0+1],a mv [fi3s1+1],a mv y,matrixoffset mv i,0 mv a,0 fi32: pushs a mv a,0 fi33: pushs a fi3s0: cmp a,0 jrnc fi34 mv [y++],i inc i ;1 inc i ;2 inc i ;3 inc i ;4 inc i ;5 inc i ;6 inc i ;7 jr fi35 fi34: inc y inc y fi35: pops a inc a cmp a,16 jrnz fi33 pops a inc a fi3s1: cmp a,16 jrc fi32 ret getoffset: ;i = matrixoffset( [ptr1], [ptr2] ) gos1: mv a,0 swap a gos2: or a,0 mv x,matrixoffset add x,a add x,a mv i,[x] ret ptr1: equ gos1+1 ptr2: equ gos2+1 findmat00: ;find matrix 'M',a ;matrix data pointer -> x mv [fi4s0+1],a mv x,(0ceh) mv y,[x+026h] add x,y fi41: mv a,[x] mv y,[x+1] cmp a,0 jpz err1 cmp a,16 jpnc err1 cmp a,2 jrnz fi42 mv a,[x+4] cmp a,'M' jrnz fi42 mv a,[x+5] fi4s0: cmp a,'A' jrnz fi42 pushs x pushs y mv x,[lengthofmdata] sub y,x pops y pops x jrnz fi42 mv a,[x+6] cmp a,2 jrnz fi42 mv ba,0 mv a,[charn1] mv i,[x+7] sub i,ba jrnz fi42 mv i,[x+9] sub i,ba jrnz fi42 mv a,11 add x,a ret fi42: add x,y jr fi41 findsnglarray: ;find array a ;array data pointer -> x mv [fda5s0+1],a mv i,0 mv a,[charn] add i,a add i,i add i,i add i,i sub i,a mv a,8 ;4+1+1+2 add i,a mv [inttmp0],i ;4+1+1+2+(n*7) mv x,(0ceh) mv y,[x+026h] add x,y fda51: mv a,[x] mv y,[x+1] cmp a,0 jpz err1 cmp a,16 jpnc err1 cmp a,1 jrnz fda52 mv a,[x+4] fda5s0: cmp a,0 jrnz fda52 pushs y mv i,[inttmp0] sub y,i pops y jrnz fda52 mv a,[x+5] cmp a,1 jrnz fda52 mv ba,0 mv a,[charn1] mv i,[x+6] sub i,ba jrnz fda52 mv a,8 add x,a ret fda52: add x,y jr fda51 finddblarray: ;find array 'C',a ;array data pointer -> x mv [fda4s0+1],a mv x,(0ceh) mv y,[x+026h] add x,y fda41: mv a,[x] mv y,[x+1] cmp a,0 jpz err1 cmp a,16 jpnc err1 cmp a,2 jrnz fda42 mv a,[x+4] cmp a,'C' jrnz fda42 mv a,[x+5] fda4s0: cmp a,0 jrnz fda42 pushs x pushs y mv x,709 ;4+2+1+2+(100*7) sub y,x pops y pops x jrnz fda42 mv a,[x+6] cmp a,1 jrnz fda42 mv ba,99 mv i,[x+7] sub i,ba jrnz fda42 mv a,9 add x,a ret fda42: add x,y jr fda41 findsingle: mv a,26-1 jr findsingle00 findsingle_af: mv a,6-1 ; findsingle00: mv [fis00+1],a mv x,(0ceh) mv y,[x+026h] add x,y fi00: mv a,[x] mv y,[x+1] cmp a,0 jpz err1 cmp a,16 jpnc err1 cmp a,1 jrnz fi10 mv a,[x+4] cmp a,'A' jrnz fi10 pushs x pushs y mv x,12 sub y,x pops y pops x jrnz fi10 mv a,[x+5] cmp a,0 jrz fi20 cmp a,8 jrnz fi10 fi20: mv y,5 add x,y mv [ptra],x mv y,ptrb mv a,12 fis00: mv il,1 ;26-1 or 6-1 fi21: add x,a mv [y++],x dec il jrnz fi21 ret fi10: add x,y jr fi00 finddouble: mv x,(0ceh) mv y,[x+026h] add x,y fi50: mv a,[x] mv y,[x+1] cmp a,0 jpz err1 cmp a,16 jpnc err1 cmp a,2 jrnz fi60 mv a,[x+4] fi50s1: cmp a,0 jrnz fi60 mv a,[x+5] fi50s2: cmp a,0 jrnz fi60 pushs x pushs y mv x,13 sub y,x pops y pops x jrnz fi60 mv a,[x+6] cmp a,0 jrz fi70 cmp a,8 jrnz fi60 fi70: mv y,6 add x,y ret fi60: add x,y jr fi50 fdbyte1:equ fi50s1+1 fdbyte2:equ fi50s2+1 finde0e1e2: mv a,'E' mv [fdbyte1],a mv a,'0' mv [fdbyte2],a call finddouble mv [ptre0],x mv a,'1' mv [fdbyte2],a call finddouble mv [ptre1],x mv a,'2' mv [fdbyte2],a call finddouble mv [ptre2],x mv a,'3' mv [fdbyte2],a call finddouble mv [ptre3],x mv a,'4' mv [fdbyte2],a call finddouble mv [ptre4],x ret err1: mv a,1 ;memory not found jr err err4: mv a,4 ;stack over flow ;jr err err: mv [fresult],a mv s,[s_work] call keyscan retf mtox: ;x=ptr m mv a,(ptrbp) cmp a,15 jrc err4 sub a,6 mv (ptrbp),a mv (bp),0 dec (ptrbp) mv (bp),0 mv y,6 add x,y dec (ptrbp) mv (bp),[x] ;+6 dec (ptrbp) mv (bp),[--x] ;+5 dec (ptrbp) mv (bp),[--x] ;+4 dec (ptrbp) mv (bp),[--x] ;+3 dec (ptrbp) mv (bp),[--x] ;+2 dec (ptrbp) mv (bp),0 dec (ptrbp) mv (bp),[--x] ;+1 dec (ptrbp) mv (bp),[--x] ;+0 ret xtom: ;x=ptr m mv [x++],(bp) ;+0 inc (ptrbp) mv [x++],(bp) ;+1 add (ptrbp),2 mv [x++],(bp) ;+2 inc (ptrbp) mv [x++],(bp) ;+3 inc (ptrbp) mv [x++],(bp) ;+4 inc (ptrbp) mv [x++],(bp) ;+5 inc (ptrbp) mv [x],(bp) ;+6 add (ptrbp),8 ret err2: mv a,2 ;error on mul jr err nmul: ;E=A*C-B*D mv x,[ptra] ;(y1)=a*c call mtox mv x,[ptrc] call mtox call mul jrc err2 mv x,[ptrb] ;(y0)=b*d call mtox mv x,[ptrd] call mtox call mul jrc err2 call sb ;(y)=(y1)-(y0) jrc err2 ;B=A*D+B*C:A=E mv x,[ptra] ;(y1)=a*d call mtox mv x,[ptrd] call mtox call mul jrc err2 mv x,[ptrb] ;(y0)=b*c call mtox mv x,[ptrc] call mtox call mul jrc err2 call ad ;b=(y1)+(y0) jrc err2 mv x,[ptrb] call xtom mv x,[ptra] ;a=(y) call xtom ret err3: mv a,3 ;error on div jr err ndiv: ;F=C*C+D*D mv x,[ptrc] ;(y1)=c*c call mtox mv x,[ptrc] call mtox call mul jrc err3 mv x,[ptrd] ;(y0)=d*d call mtox mv x,[ptrd] call mtox call mul jrc err3 call ad ;f=(y) jrc err3 mv x,[ptrf] call xtom ;E=(A*C+B*D)/F mv x,[ptra] ;(y1)=a*c call mtox mv x,[ptrc] call mtox call mul jrc err3 mv x,[ptrb] ;(y0)=b*d call mtox mv x,[ptrd] call mtox call mul jrc err3 call ad ;(y)=((y1)+(y0))/f jrc err3 mv x,[ptrf] call mtox call div jrc err3 ;B=(B*C-A*D)/F:A=E mv x,[ptrb] ;(y1)=b*c call mtox mv x,[ptrc] call mtox call mul jrc err3 mv x,[ptra] ;(y0)=a*d call mtox mv x,[ptrd] call mtox call mul jrc err3 call sb ;(y)=(y1)-(y0) jrc err3 mv x,[ptrf] ;b=(y)/f call mtox call div jrc err3 mv x,[ptrb] call xtom mv x,[ptra] ;a=(y) call xtom ret mtom: ;x -> y mv ba,[x++] ;0,1 mv [y++],ba mv ba,[x++] ;2,3 mv [y++],ba mv ba,[x++] ;4,5 mv [y++],ba mv a,[x] ;6 mv [y],a ret mv0: ;[x] <- 0 mv ba,0 mv [x++],ba ;0,1 mv [x++],ba ;2,3 mv [x++],ba ;4,5 mv [x],a ;6 ret mv1: ;[x] <- 1 mv ba,0 mv [x++],ba ;0,1 mv a,010h mv [x++],a ;2 mv a,0 mv [x++],ba ;3,4 mv [x++],ba ;5,6 ret mv0p5: ;[x] <- 0.5 mv ba,0 mv [x++],a ;0 mv a,0ffh mv [x++],a ;1 mv a,050h mv [x++],a ;2 mv a,0 mv [x++],ba ;3,4 mv [x++],ba ;5,6 ret is0: ;zero flag <- [x]==0 mv a,[x++] ;0 test a,0ffh jrnz is000 mv a,[x++] ;1 test a,0ffh jrnz is000 mv a,[x++] ;2 test a,0ffh jrnz is000 mv a,[x++] ;3 test a,0ffh jrnz is000 mv a,[x++] ;4 test a,0ffh jrnz is000 mv a,[x++] ;5 test a,0ffh jrnz is000 mv a,[x] ;6 test a,0ffh is000: ret chs: ;[x] <- -[x] pushs x call is0 pops x jrz chs00 mv a,[x] xor a,8 mv [x],a chs00: ret ftmpx: ds 7 ftmpy: ds 7 cp: ;[y] - [x] -> zf, cf pushs y mv y,ftmpx call mtom pops x mv y,ftmpy call mtom mv x,ftmpy pushs x call is0 pops x jrz cp00 mv a,[x] cmp a,0 jrz cp01 mv a,0 ;[y]<0 jr cp02 cp00: mv a,1 ;[y]==0 jr cp02 cp01: mv a,2 ;[y]>0 cp02: mv [cps0+1],a mv x,ftmpx pushs x call is0 pops x jrz cp10 mv a,[x] cmp a,0 jrz cp11 mv a,0 ;[x]<0 jr cp12 cp10: mv a,3 ;[x]==0 jr cp12 cp11: mv a,6 ;[x]>0 cp12: cps0: add a,0 cmp a,0 jrz xlt0ylt0 cmp a,1 jrz xlt0yeq0 cmp a,2 jrz xlt0ygt0 cmp a,3 jrz xeq0ylt0 cmp a,4 jrz xeq0yeq0 cmp a,5 jrz xeq0ygt0 cmp a,6 jrz xgt0ylt0 cmp a,7 jrz xgt0yeq0 cmp a,8 jrz xgt0ygt0 call deb mv a,255 ;debug jp err xlt0ylt0: ;(-) - (-) call xgt0ygt0 jrz cp20 jrc cp21 sc ret cp21: rc ret xlt0yeq0: ;(0) - (-) xlt0ygt0: ;(+) - (-) xeq0ygt0: ;(+) - (0) mv a,1 sub a,0 ret xeq0ylt0: ;(-) - (0) xgt0ylt0: ;(-) - (+) xgt0yeq0: ;(0) - (+) mv a,0 sub a,1 ret xeq0yeq0: ;(0) - (0) sub a,a ret xgt0ygt0: ;(+) - (+) mv y,ftmpy+1 mv x,ftmpx+1 mv a,[x++] ;+1 add a,99 mv il,a mv a,[y++] ;+1 add a,99 sub a,il jrnz cp20 mv a,[y++] ;+2 mv il,[x++] sub a,il jrnz cp20 mv a,[y++] ;+3 mv il,[x++] sub a,il jrnz cp20 mv a,[y++] ;+4 mv il,[x++] sub a,il jrnz cp20 mv a,[y++] ;+5 mv il,[x++] sub a,il jrnz cp20 mv a,[y] ;+6 mv il,[x] sub a,il cp20: ret mul: ;y*x -> x mv i,049h func_iocs: mv (cl),9 mv (ch),0 callf iocs ret div: ;y/x -> x mv i,04ah jr func_iocs ad: ;y+x -> x mv i,047h jr func_iocs sb: ;y-x -> x mv i,048h jr func_iocs sqr: ;sqr(x) -> x mv i,059h jr func_iocs exp: mv i,04ch jr func_iocs ln: mv i,05bh jr func_iocs sin: mv i,04dh jr func_iocs cos: mv i,04eh jr func_iocs arctan: mv i,052h jr func_iocs printdot: pushs ba pushs i pushs x mv (cx),00008h mv i,043h mv x,mes00 mv a,010h callf iocs pops x pops i pops ba ret mes00: db 0feh,060h,022h,'.',022h,';',00dh keyscan: mv a,000h key00: mv (cx),00001h mv i,00043h callf iocs ret keywait: mv a,080h jr key00 ninkey: call keywait mv [fresult],a ret deb: pushs a pushs i pushs x mv (cx),00008h mv i,043h mv x,debmes mv a,010h callf iocs call keywait pops x pops i pops a ret debmes: db 0feh,060h,022h,'D','e','b','u','g','!','!',022h,00dh free: charn1: ds 1 charn2: ds 1 ptre0: ds 3 ptre1: ds 3 ptre2: ds 3 ptre3: ds 3 ptre4: ds 3 ptre5: ds 3 ptra: ds 3 ptrb: ds 3 ptrc: ds 3 ptrd: ds 3 ptre: ds 3 ptrf: ds 3 ptrg: ds 3 ptrh: ds 3 ptri: ds 3 ptrj: ds 3 ptrk: ds 3 ptrl: ds 3 ptrm: ds 3 ptrn: ds 3 ptro: ds 3 ptrp: ds 3 ptrq: ds 3 ptrr: ds 3 ptrs: ds 3 ptrt: ds 3 ptru: ds 3 ptrv: ds 3 ptrw: ds 3 ptrx: ds 3 ptry: ds 3 ptrz: ds 3 lengthofmatrix: ds 3 lengthofmdata: ds 3 ptrma: ds 3 ptrmb: ds 3 ptrmc: ds 3 ptrmd: ds 3 ptrme: ds 3 ptrmf: ds 3 ptrmg: ds 3 ptrmh: ds 3 ptrmi: ds 3 ptrmj: ds 3 ptrmk: ds 3 ptrml: ds 3 ptrmm: ds 3 ptrmn: ds 3 ptrmo: ds 3 ptrmp: ds 3 ptrmq: ds 3 ptrmr: ds 3 ptrms: ds 3 ptrmt: ds 3 ptrmu: ds 3 ptrmv: ds 3 ptrmw: ds 3 ptrmx: ds 3 ptrmy: ds 3 ptrmz: ds 3 matrixoffset: ds 2*16*16 end