リンクその３

リンクその３：１９８０年代の古いパソコンで複素行列の固有値と固有ベクトルを求める

[コード]

;Matrix 21 for MZ-80B (C) 2008-2009, 2016

org &12a0, &12a0

jp start
jp hotstart

matrixsize= 8 ;++++

jordanmsg00: db 'Jordan ﾌﾞﾝｶｲﾉｺ-ﾅ- ﾍﾖｳｺｿ (ｵﾏｹｺ-ﾅ-)',13
jordanmsg01: db 'ﾄﾞﾚｶｷ- ｦｵｼﾃｸﾀﾞｻｲ',13
jordanmsg02: db '1: JORDAN ﾌﾞﾝｶｲ',13
jordanmsg03: db '2: EXP',13
jordanmsg04: db '3: LN',13
jordanmsg05: db 'ｿﾉﾀﾉｷ-: ﾓﾄﾞﾙ',13
jordanmsg10: db 'ｺﾕｳﾍﾞｸﾄﾙｶﾞｱﾘﾏｾﾝ',13
jordanmsg11: db 'ﾀｲｶｸｶﾃﾞｷﾏｾﾝ',13
jordanmsg12: db 'ﾌﾞﾝｶｲﾃﾞｷﾏｾﾝ',13
jordanmsg20: db 'ｴﾗ- ﾊｱﾘﾏｾﾝ',13
jordanmsg30: db 'JORDAN ﾌﾞﾝｶｲｼﾃｲﾏｽ',13
jordanmsg31: db 'EXP ｦﾓﾄﾒﾃｲﾏｽ',13
jordanmsg32: db 'LN ｦﾓﾄﾒﾃｲﾏｽ',13

powerhl2: ;[hl]=[hl]^2, cf=status
push hl
call power2
pop hl
call xtom
and a
ret

matrixjordan: ; (2x2限定）+++++
ld a,[charn]
cp 3
jp nc,err30

ld hl,jordanmsg00
call message
call crlf
ld hl,jordanmsg01
call message
call crlf
ld hl,jordanmsg02
call message
call crlf
ld hl,jordanmsg03
call message
call crlf
ld hl,jordanmsg04
call message
call crlf
ld hl,jordanmsg05
call message
call crlf

call keywait
cp '1'
jr z,jordan
cp '2'
jp z,jordanexp
cp '3'
jp z,jordanln
ret

err34: ld a,34 ;error on jordan
jp err

jordan: ;[matrixa,n]=s1, [matrixb,o]=j1 (2x2限定）+++++
ld hl,jordanmsg30
call message
call crlf
;jordan[A_] := Module[{n, e, e1, e2, j1, s1, sj, s, j},
; n = Dimensions[A][[1]];
; If[n != 2, Print["2x2以外は対応していません"]; Return[];];
; e = Eigensystem[A];
;matrixeigen [matrixa,n]の固有値、固有ベクトルを求める
; [matrixa,n]=固有ベクトル
; [complextmpatof~]=固有値
xor a
ld b,12
call atobmatrix

call matrixeigen

; e1 = e[[1]]; e2 = e[[2]]; e1=固有値、e2=固有ベクトル
; j1 = Table[0, {n}, {n}]; [matrixf,s]
ld hl,matrixf+(matrixsize*0+1)*6
call mv0
ld hl,matrixs+(matrixsize*0+1)*6
call mv0
ld hl,matrixf+(matrixsize*1+0)*6
call mv0
ld hl,matrixs+(matrixsize*1+0)*6
call mv0
; j1[[1, 1]] = e1[[1]]; j1[[2, 2]] = e1[[2]];
ld hl,complextmpatof+12*0+0
ld de,matrixf+(matrixsize*0+0)*6
call mtom
ld hl,complextmpatof+12*0+6
ld de,matrixs+(matrixsize*0+0)*6
call mtom
ld hl,complextmpatof+12*1+0
ld de,matrixf+(matrixsize*1+1)*6
call mtom
ld hl,complextmpatof+12*1+6
ld de,matrixs+(matrixsize*1+1)*6
call mtom

; If[(e2[[1, 1]] == 0) && (e2[[1, 2]] == 0), ;transpose e2=[matrixa,n]
ld hl,matrixa+(matrixsize*0+0)*6+1
ld a,[hl]
ld hl,matrixn+(matrixsize*0+0)*6+1
or [hl]
ld hl,matrixa+(matrixsize*1+0)*6+1
or [hl]
ld hl,matrixn+(matrixsize*1+0)*6+1
or [hl]
jr nz,majo00

; e2[[1, 1]] = e2[[2, 1]]; e2[[1, 2]] = e2[[2, 2]];
ld de,matrixa+(matrixsize*0+0)*6
ld hl,matrixa+(matrixsize*0+1)*6
call mtom
ld de,matrixn+(matrixsize*0+0)*6
ld hl,matrixn+(matrixsize*0+1)*6
call mtom
ld de,matrixa+(matrixsize*1+0)*6
ld hl,matrixa+(matrixsize*1+1)*6
call mtom
ld de,matrixn+(matrixsize*1+0)*6
ld hl,matrixn+(matrixsize*1+1)*6
call mtom
; e2[[2, 1]] = 0; e2[[2, 2]] = 0;];
ld hl,matrixa+(matrixsize*0+1)*6
call mv0
ld hl,matrixn+(matrixsize*0+1)*6
call mv0
ld hl,matrixa+(matrixsize*1+1)*6
call mv0
ld hl,matrixn+(matrixsize*1+1)*6
call mv0
majo00:
ld hl,matrixa+(matrixsize*0+1)*6+1
ld a,[hl]
ld hl,matrixn+(matrixsize*0+1)*6+1
or [hl]
ld hl,matrixa+(matrixsize*1+1)*6+1
or [hl]
ld hl,matrixn+(matrixsize*1+1)*6+1
or [hl]
jp z,majo11

ld hl,matrixa+(matrixsize*0+0)*6
call mtox
ld hl,matrixa+(matrixsize*0+1)*6
call mtox
call sb
jp c,err34
ld hl,floata
push hl
call xtom
pop hl
call powerhl2
jp c,err34

ld hl,matrixn+(matrixsize*0+0)*6
call mtox
ld hl,matrixn+(matrixsize*0+1)*6
call mtox
call sb
jp c,err34
ld hl,floatb
push hl
call xtom
pop hl
call powerhl2
jp c,err34

ld hl,matrixa+(matrixsize*1+0)*6
call mtox
ld hl,matrixa+(matrixsize*1+1)*6
call mtox
call sb
jp c,err34
ld hl,floatc
push hl
call xtom
pop hl
call powerhl2
jp c,err34

ld hl,matrixn+(matrixsize*1+0)*6
call mtox
ld hl,matrixn+(matrixsize*1+1)*6
call mtox
call sb
jp c,err34
ld hl,floatd
push hl
call xtom
pop hl
call powerhl2
jp c,err34

ld hl,floata
call mtox
ld hl,floatb
call mtox
call ad
jp c,err34
ld hl,floatc
call mtox
call ad
jp c,err34
ld hl,floatd
call mtox
call ad
jp c,err34
call sqr
jp c,err34
ld hl,floate
push hl
call xtom
pop hl
ld de,floate6
call fcp ;E6 - abs(vr + vi)
jp c,majo10
majo11:
; If[(e2[[2, 1]] == 0) && (e2[[2, 2]] == 0),
; Print["固有ベクトルがありません"]; (msg10)
ld hl,jordanmsg10
call message
call crlf
; e2[[2]] = LinearSolve[A(12番) - e1[[1]]*IdentityMatrix[n], e2[[1]]];
;[a,n]=transpose e2

ld hl,matrixm+(matrixsize*0+0)*6 ;re A00
call mtox
ld hl,complextmpatof+12*0+0 ;re e1
call mtox
call sb
jp c,err34
ld hl,matrixc+(matrixsize*0+0)*6
call xtom
ld hl,matrixz+(matrixsize*0+0)*6 ;im A00
call mtox
ld hl,complextmpatof+12*0+6 ;im e1
call mtox
call sb
jp c,err34
ld hl,matrixp+(matrixsize*0+0)*6
call xtom

ld hl,matrixm+(matrixsize*1+1)*6 ;re A11
call mtox
ld hl,complextmpatof+12*0+0 ;re e1
call mtox
call sb
jp c,err34
ld hl,matrixc+(matrixsize*1+1)*6
call xtom
ld hl,matrixz+(matrixsize*1+1)*6 ;im A11
call mtox
ld hl,complextmpatof+12*0+6 ;im e1
call mtox
call sb
jp c,err34
ld hl,matrixp+(matrixsize*1+1)*6
call xtom

ld hl,matrixm+(matrixsize*1+0)*6 ;re A10
ld de,matrixc+(matrixsize*1+0)*6
call mtom
ld hl,matrixz+(matrixsize*1+0)*6 ;im A10
ld de,matrixp+(matrixsize*1+0)*6
call mtom
ld hl,matrixm+(matrixsize*0+1)*6 ;re A01
ld de,matrixc+(matrixsize*0+1)*6
call mtom
ld hl,matrixz+(matrixsize*0+1)*6 ;im A01
ld de,matrixp+(matrixsize*0+1)*6
call mtom

ld hl,matrixa+(matrixsize*0+0)*6 ;e2の１列目
ld de,matrixh+(matrixsize*0+0)*6
call mtom
ld hl,matrixn+(matrixsize*0+0)*6
ld de,matrixu+(matrixsize*0+0)*6
call mtom
ld hl,matrixa+(matrixsize*1+0)*6
ld de,matrixh+(matrixsize*1+0)*6
call mtom
ld hl,matrixn+(matrixsize*1+0)*6
ld de,matrixu+(matrixsize*1+0)*6
call mtom

ld a,1
ld [linearsolvemode],a
ld a,1 ;e2の２列目
ld [charm],a
call nnscp00

; j1[[1, 2]] = 1;
ld hl,matrixf+(matrixsize*0+1)*6
call mv1
ld hl,matrixs+(matrixsize*0+1)*6
call mv0
; ];
majo10:
; s1 = Transpose[e2];
; Return[{s1, j1}];
ld a,5 ;[b,o]=[f,s](j1)
ld b,1
call atobmatrix
; ];
ld hl,jordanmsg20
call message
call crlf
jp messagekeywait

jordanln: ;[matrixa,n]=ln [matrixa,n] (2x2限定）+++++
;jordanlog[A_] := Module[{n, sj, s, j, z, l, lj, lj1, j1, k, j2, ans},
; n = Dimensions[A][[1]];
; If[n != 2, Print["2x2以外は対応していません"]; Return[];];
; sj = FullSimplify[jordan[A]];
call jordan

ld hl,jordanmsg32
call message
call crlf

; s = sj[[1]]([a,n]); j = sj[[2]]([b,o]);
xor a
ld b,3
call atobmatrix ;[d,q]=s
ld a,1
ld b,4
call atobmatrix ;[e,r]=j
; z = Table[0, {n}, {n}];
; l = Tr[j, List]; [c,p]=j([e,r])の対角成分を取ったもの
ld hl,matrixc+(matrixsize*0+1)*6
call mv0
ld hl,matrixp+(matrixsize*0+1)*6
call mv0
ld hl,matrixc+(matrixsize*1+0)*6
call mv0
ld hl,matrixp+(matrixsize*1+0)*6
call mv0

ld hl,matrixe+(matrixsize*0+0)*6
ld de,matrixc+(matrixsize*0+0)*6
call mtom
ld hl,matrixr+(matrixsize*0+0)*6
ld de,matrixp+(matrixsize*0+0)*6
call mtom

ld hl,matrixe+(matrixsize*1+1)*6
ld de,matrixc+(matrixsize*1+1)*6
call mtom
ld hl,matrixr+(matrixsize*1+1)*6
ld de,matrixp+(matrixsize*1+1)*6
call mtom

; lj = DiagonalMatrix[Log[l]]; [f,s]=lj
ld hl,matrixf+(matrixsize*0+1)*6
call mv0
ld hl,matrixs+(matrixsize*0+1)*6
call mv0
ld hl,matrixf+(matrixsize*1+0)*6
call mv0
ld hl,matrixs+(matrixsize*1+0)*6
call mv0

ld hl,matrixc+(matrixsize*0+0)*6
ld de,floata
call mtom
ld hl,matrixp+(matrixsize*0+0)*6
ld de,floatb
call mtom
call nln
ld hl,floata
ld de,matrixf+(matrixsize*0+0)*6
call mtom
ld hl,floatb
ld de,matrixs+(matrixsize*0+0)*6
call mtom

ld hl,matrixc+(matrixsize*1+1)*6
ld de,floata
call mtom
ld hl,matrixp+(matrixsize*1+1)*6
ld de,floatb
call mtom
call nln
ld hl,floata
ld de,matrixf+(matrixsize*1+1)*6
call mtom
ld hl,floatb
ld de,matrixs+(matrixsize*1+1)*6
call mtom

; lj1 = z; [g,t]=lj1
call ldmatrixzero
xor a
ld b,6
call atobmatrix
; If[j([e,r]) - DiagonalMatrix[l]([c,p]) != z,
ld a,4
ld b,0
call atobmatrix
ld a,2
ld b,1
call atobmatrix
call msub
ld hl,matrixa+(matrixsize*0+0)*6+1
ld a,[hl]
ld hl,matrixn+(matrixsize*0+0)*6+1
or [hl]
ld hl,matrixa+(matrixsize*0+1)*6+1
or [hl]
ld hl,matrixn+(matrixsize*0+1)*6+1
or [hl]
ld hl,matrixa+(matrixsize*1+0)*6+1
or [hl]
ld hl,matrixn+(matrixsize*1+0)*6+1
or [hl]
ld hl,matrixa+(matrixsize*1+1)*6+1
or [hl]
ld hl,matrixn+(matrixsize*1+1)*6+1
or [hl]

jr z,majol00

; Print["対角化できません"]; (msg11)
ld hl,jordanmsg11
call message
call crlf
; j1([a,n]) = FullSimplify[
; j([e,r]).Inverse[DiagonalMatrix[l]([c,p])] - IdentityMatrix[n]];
call ldmatrixidentity
xor a
ld b,7
call atobmatrix ;[h,u]=identity
ld a,2
ld b,0
call atobmatrix
call nrcpcp
xor a
ld b,1
call atobmatrix
ld hl,charp0
ld [hl],4 ;[e,r]
inc hl
ld [hl],1 ;[b,o]==inverse
inc hl
ld [hl],0
call mpmul
ld a,7 ;[h,u]==identity
ld b,1
call atobmatrix
call msub ;[a,n]=answer j1

; For[k = 1, k <= n, k++, j1[[k, k]] = 0;];
; j2 = j1;
; k = 1;
; While[j1 != z,
; lj1 = FullSimplify[lj1([g,t]) + j1([a,n])/k*(-1)^(k + 1)];
ld a,6 ;[g,t]
ld b,1
call atobmatrix
call madd ;[a,n]=answer lj1
xor a
ld b,6
call atobmatrix ;[g,t]=lj1
; j1 = FullSimplify[j1.j2];
; k++;
; ];
; Print[k - 1, "回ループしました"];
; ];
majol00:
; ans = FullSimplify[s([d,q]).(lj([f,s]) + lj1([g,t])).Inverse[s([d,q])]];
ld a,3 ;[d,q]
ld b,0
call atobmatrix
call nrcpcp ;[a,n]=inverse
xor a
ld b,7
call atobmatrix ;[h,u]=inverse
ld a,5
ld b,0
call atobmatrix ;[a,n]=[f,s]
ld a,6
ld b,1
call atobmatrix ;[b,o]=[g,t]
call madd ;[a,n]=(lj + lj1)
ld hl,charp0
ld [hl],3 ;[d,q]==s
inc hl
ld [hl],0 ;[a,n]==(lj + lj1)
inc hl
ld [hl],1
call mpmul ;[b,o]=s.(lj+lj1)
ld hl,charp0
ld [hl],1 ;[b,o]
inc hl
ld [hl],7 ;[h,u]==inverse s
inc hl
ld [hl],0
call mpmul

; Print["誤差：", FullSimplify[ans - MatrixLog[A]]];
; Return[];
; ];
ld hl,jordanmsg20
call message
call crlf
jp messagekeywait

jordanexp: ;[matrixa,n]=exp [matrixa,n] (2x2限定）+++++
;jordanexp[A_] := Module[{n, sj, s, j, z, l, lj, lj1, j1, k, j2, ans},
; n = Dimensions[A][[1]];
; If[n != 2, Print["2x2以外は対応していません"]; Return[];];
; sj = FullSimplify[jordan[A]];
call jordan

ld hl,jordanmsg31
call message
call crlf

; s = sj[[1]]([a,n]); j = sj[[2]]([b,o]);
; z = Table[0, {n}, {n}];
; l = Tr[j, List];
; lj = DiagonalMatrix[Exp[l]]; ([c,p])
ld hl,matrixc+(matrixsize*0+1)*6
call mv0
ld hl,matrixp+(matrixsize*0+1)*6
call mv0
ld hl,matrixc+(matrixsize*1+0)*6
call mv0
ld hl,matrixp+(matrixsize*1+0)*6
call mv0

ld hl,matrixb+(matrixsize*0+0)*6
ld de,floata
call mtom
ld hl,matrixo+(matrixsize*0+0)*6
ld de,floatb
call mtom
call nexp
ld hl,floata
ld de,matrixc+(matrixsize*0+0)*6
call mtom
ld hl,floatb
ld de,matrixp+(matrixsize*0+0)*6
call mtom

ld hl,matrixb+(matrixsize*1+1)*6
ld de,floata
call mtom
ld hl,matrixo+(matrixsize*1+1)*6
ld de,floatb
call mtom
call nexp
ld hl,floata
ld de,matrixc+(matrixsize*1+1)*6
call mtom
ld hl,floatb
ld de,matrixp+(matrixsize*1+1)*6
call mtom

; lj1 = IdentityMatrix[n];
; If[j([b,o]) - DiagonalMatrix[l] != z,
ld hl,matrixb+(matrixsize*0+0)*6
call mv0
ld hl,matrixo+(matrixsize*0+0)*6
call mv0
ld hl,matrixb+(matrixsize*1+1)*6
call mv0
ld hl,matrixo+(matrixsize*1+1)*6
call mv0

ld hl,matrixb+(matrixsize*1+0)*6+1
ld a,[hl]
ld hl,matrixo+(matrixsize*1+0)*6+1
or [hl]
ld hl,matrixb+(matrixsize*0+1)*6+1
or [hl]
ld hl,matrixo+(matrixsize*0+1)*6+1
or [hl]
jr z,majoe00

; Print["対角化できません"]; (msg11)
ld hl,jordanmsg11
call message
call crlf
; j1 = j; [b,o]
; For[k = 1, k <= n, k++, j1[[k, k]] = 0;];
; j2 = j1;
; k = 1;
; While[j1 != z,
; lj1 = FullSimplify[lj1 + j1/k!];
ld hl,matrixb+(matrixsize*0+0)*6
call mv1
ld hl,matrixo+(matrixsize*0+0)*6
call mv0
ld hl,matrixb+(matrixsize*1+1)*6
call mv1
ld hl,matrixo+(matrixsize*1+1)*6
call mv0

; j1 = FullSimplify[j1.j2];
; k++;
; ];
; Print[k - 1, "回ループしました"];
; ];
; ans = FullSimplify[s.(lj[c,p].lj1).Inverse[s]];
;[a,n].([c,p].[b,o]).inverse[a,n]
ld hl,charp0
ld [hl],2 ;[c,p]
inc hl
ld [hl],1 ;[b,o]
inc hl
ld [hl],3 ;[d,q]
call mpmul
ld a,3 ;[d,q]
ld b,2 ;[c,p]
call atobmatrix
; Print["誤差：", FullSimplify[ans - MatrixExp[A]]];
; Return[];
; ];
majoe00:
;[a,n].[c,p].inverse[a,n]
xor a ;[a,n]
ld b,3 ;[d,q]=[a,n]
call atobmatrix
call nrcpcp
xor a
ld b,1 ;[b,o]=inverse[a,n]
call atobmatrix
ld hl,charp0
ld [hl],3 ;[d,q]==[a,n]
inc hl
ld [hl],2 ;[c,p]
inc hl
ld [hl],4 ;[e,r]
call mpmul
ld hl,charp0
ld [hl],4 ;[e,r]
inc hl
ld [hl],1 ;[b,o]==inverse[a,n]
inc hl
ld [hl],0 ;[a,n]
call mpmul

ld hl,jordanmsg20
call message
call crlf
jp messagekeywait

matrixtestmsg00: db 'ｺﾞｻﾉﾙﾑｦｹｲｻﾝｼﾏｽ',13

matrixtest: ;matrixeigenを実行し、A.x-λ.xを検算する
;9400 I=12:Z=0:GOSUB "MREAD"
ld b,12
xor a
call atobmatrix
;9410 GOSUB "MEIGEN"
call matrixeigen
;9420 P0=12:P1=0:P2=1:GOSUB "MP*"
ld hl,charp0
ld [hl],12
inc hl
ld [hl],0
inc hl
ld [hl],1
call mpmul

ld hl,matrixtestmsg00
call message
call crlf
;9431 FOR J=0TO N-1
xor a
ld [charj],a
matrixtest9433:
;9433 FOR K=0TO N-1
xor a
ld [chark],a
;9432 NO=0
ld hl,fss
call mv0
matrixtest9434:
;9434 A=CR(J):B=CI(J)
ld a,[charj]
call getoffsetcomplex
ld hl,complextmpatof
add hl,bc
ld de,floata
ld bc,12
ldir
;:C=MA(K,J):D=MN(K,J):CALL FMUL
ld a,[chark]
ld [ptr1],a
ld a,[charj]
ld [ptr2],a
call getoffset
ld hl,matrixa
add hl,bc
ld de,floatc
call mtom
ld hl,matrixn
add hl,bc
ld de,floatd
call mtom
call nmul
;9435 A=A-MB(K,J):
call getoffset
ld hl,matrixb
add hl,bc
ld de,floatc
call mtom
;B=B-MO(K,J)
ld hl,matrixo
add hl,bc
ld de,floatd
call mtom
call nsub
;9436 NO=NO+A*A+B*B
ld hl,floata
call power2
ld hl,floatb
call power2
call ad
jp c,err24
ld hl,fss
push hl
call mtox
call ad
jp c,err24
pop hl
call xtom
;9437 NEXT K (to n-1, matrixtest9434)
ld hl,chark
inc [hl]
ld a,[charn]
cp [hl]
jr nz,matrixtest9434
;9438 print SQR NO
ld a,[charj]
add a,'1'
call pcha
ld a,':'
call pcha
ld hl,fss
push hl
call mtox
call sqr
jp c,err2
pop hl
push hl
call xtom
pop hl
ld de,acc1
call mtom
ld ix,buffer
call printbcdacc1
ld [ix],13
ld hl,buffer
call message
call crlf
;9440 NEXT J (to n-1, matrixtest9433)
ld hl,charj
inc [hl]
ld a,[charn]
cp [hl]
jp nz,matrixtest9433
;9460 RETURN
jp messagekeywait

power2: ;[hl]=float --> [stack~]=[hl]^2
push hl
call mtox
pop hl
call mtox
call mul
ret nc
jp err2

matrixul: ;[matrix a,n]上三角要素を下三角要素にコピーして、対称行列にする
ld a,1
ld [ptr2],a
matrixul00:
xor a
ld [ptr1],a
matrixul10:
call getoffset
ld [inttmp0],bc
ld hl,ptr1
ld de,ptr2
push hl
push de
ld a,[de]
ld c,[hl]
ex de,hl
ld [de],a
ld [hl],c
call getoffset
ld [inttmp1],bc

ld bc,[inttmp0]
ld hl,matrixa
add hl,bc
call mtox
ld hl,matrixn
add hl,bc
call mtox

ld bc,[inttmp1]
ld hl,matrixn
add hl,bc
call xtom
ld hl,matrixa
add hl,bc
call xtom

pop de
pop hl
ld a,[de]
ld c,[hl]
ex de,hl
ld [de],a
ld [hl],c

ld hl,ptr1
inc [hl]
ld a,[ptr2]
cp [hl]
jr nz,matrixul10

ld hl,ptr2
inc [hl]
ld a,[charn]
cp [hl]
jr nz,matrixul00

ret

matrixut: ;[matrix a,n]下三角要素を0にして、上三角にする
ld a,1
ld [ptr1],a
matrixut00:
xor a
ld [ptr2],a
matrixut10:
call getoffset
ld hl,matrixa
add hl,bc
call mv0
ld hl,matrixn
add hl,bc
call mv0

ld hl,ptr2
inc [hl]
ld a,[ptr1]
cp [hl]
jr nz,matrixut10

ld hl,ptr1
inc [hl]
ld a,[charn]
cp [hl]
jr nz,matrixut00

ret

matrixlt: ;[matrix a,n]上三角要素を0にして、下三角にする
ld a,1
ld [ptr2],a
matrixlt00:
xor a
ld [ptr1],a
matrixlt10:
call getoffset
ld hl,matrixa
add hl,bc
call mv0
ld hl,matrixn
add hl,bc
call mv0

ld hl,ptr1
inc [hl]
ld a,[ptr2]
cp [hl]
jr nz,matrixlt10

ld hl,ptr2
inc [hl]
ld a,[charn]
cp [hl]
jr nz,matrixlt00

ret

matrixre: ;[matrix a,n]各要素の虚数部を0にする
ld a,[charn]
ld c,a
matrixre00:
ld a,[charn]
ld b,a
matrixre10:
push bc
dec c
dec b
ld [ptr1],bc
call getoffset
ld hl,matrixn
add hl,bc
call mv0
pop bc
djnz matrixre10
dec c
jr nz,matrixre00
ret

matrixrnd: ;[matrix a,n]=乱数で(-1~1)+(-1~1)iの要素を持つ密行列を作成する
xor a
ld [ptr1],a
matrixrnd00:
xor a
ld [ptr2],a
matrixrnd10:
call matrixrnd20
call getoffset
push bc
ld hl,matrixa
add hl,bc
ex de,hl
ld hl,acc1
call mtom

call matrixrnd20
pop bc
ld hl,matrixn
add hl,bc
ex de,hl
ld hl,acc1
call mtom

ld hl,ptr2
inc [hl]
ld a,[charn]
cp [hl]
jr nz,matrixrnd10

ld hl,ptr1
inc [hl]
ld a,[charn]
cp [hl]
jr nz,matrixrnd00

ret

matrixrnd20: ;acc1=-1~1の乱数
call frnd ;1~2
ld hl,floatrndacc
call mtox
ld hl,float1
call mtox
call sb ;0~1
ld hl,float1div2
call mtox
call sb ;-0.5~0.5
ld hl,acc1
push hl
call xtom
pop hl
jp mul2 ;-1~1

err30: ld a,30 ;ｺﾉﾌﾟﾛｸﾞﾗﾑﾊｼﾞｯｿｳｻﾚﾃｲﾏｾﾝ
jp err

mspower: ;[matrixa,n]^=[floatx,y] 行列のべき乗
;7040 "M^"
;7041 IF Y=0THEN IF X=INT X THEN IF 1<=X THEN IF X<=10THEN 7060
ld hl,floaty+1
ld a,[hl]
and a
jr nz,mspo7042

ld hl,floatx
ld de,acc1
call mtom
call ftoi
jr c,mspo7042
and a
jr z,mspo7042
bit 7,c
jr nz,mspo7042
cp 10+1
jr nc,mspo7042

push af
ld hl,acc1
ld de,acc2
call mtom
pop af
push af
call itof
ld hl,acc1
ld de,acc2
call fcp
pop bc
jr z,mspo7060
mspo7042:
ld hl,npowerxy
ld [ptrmatrixfunction],hl
jr matrixfunction
;7042 GOSUB "MEIGEN":I=2:Z=0:GOSUB "MREAD":GOSUB "MRCP"
;7043 I=3:Z=0:GOSUB "MREAD":Z=2:GOSUB "MREAD0"
;7044 FOR J=0TO N-1:FOR K=0TO N-1
;7045 IF J=K THEN
;7046 A=CR(J):B=CI(J):C=X:D=Y:GOSUB "C^"
;7047 MB(J,J)=A:MO(J,J)=B
;7048 ELSE
;7049 MB(J,K)=0:MO(J,K)=0
;7050 ENDIF
;7051 NEXT K:NEXT J
;7052 GOSUB "M*":I=1:Z=3:GOSUB "MREAD":GOTO "M*"
mspo7060: ;b=X
;7060 IF X=1THEN RETURN
djnz mspo00
ret
mspo00:
push bc
;7061 I=1:Z=0:GOSUB "MREAD":JJ=2
ld b,1
xor a
call atobmatrix
pop bc
;7062 GOSUB "M*":JJ=JJ+1:IF JJ<=X THEN 7062
mspo01:
push bc
call mmul
pop bc
djnz mspo01
;7063 RETURN
ret

matrixfunction: ;[ptrmatrixfunction]=複素関数処理アドレス --> 行列の関数を求める
;9100 FOR J=0TO N-1:FOR K=0TO N-1
xor a
ld [charj],a
mafu00:
xor a
ld [chark],a
mafu01:
;9101 IF J=K THEN NEXT K:NEXT J:GOTO 9110
ld a,[charj]
ld hl,chark
cp [hl]
jr z,mafu02

;9102 IF MA(J,K)<>0THEN K=N:J=N:NEXT K:NEXT J:GOTO 9120
ld a,[charj]
ld [ptr1],a
ld a,[chark]
ld [ptr2],a
call getoffset

ld hl,matrixa+1
add hl,bc
ld a,[hl]
and a
jr nz,mafu9120

;9103 IF MN(J,K)<>0THEN K=N:J=N:NEXT K:NEXT J:GOTO 9120
ld hl,matrixn+1
add hl,bc
ld a,[hl]
and a
jr nz,mafu9120
mafu02:
;k=0 to n-1, mafu01
ld hl,chark
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jr nz,mafu01

;j=0 to n-1, mafu00
ld hl,charj
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jr nz,mafu00

mafu9110: ;最初から対角行列になっている
;9110 FOR J=0TO N-1
ld a,[charn1]
ld b,a
mafu10:
push bc
ld a,b
ld [ptr1],a
ld [ptr2],a
;9111 A=MA(J,J):B=MN(J,J)
call getoffset
ld hl,matrixa
add hl,bc
push hl
ld de,floata
call mtom
ld hl,matrixn
add hl,bc
push hl
ld de,floatb
call mtom

;9112 GOSUB "C"+C$
ld hl,mafu11
push hl
ld hl,[ptrmatrixfunction]
jp [hl]
mafu11:
;9113 MA(J,J)=A:MN(J,J)=B
pop de ;matrix n
ld hl,floatb
call mtom
pop de ;matrix a
ld hl,floata
call mtom

;9114 NEXT J:RETURN
pop bc
dec b
ld a,b
cp -1
jr nz,mafu10

ret

mafu9120: ;一般の密行列
;9120 GOSUB "MEIGEN"
call matrixeigen
;9130 I=2:Z=0:GOSUB "MREAD"
ld b,2
xor a
call atobmatrix
;9140 GOSUB "MRCP"
call nrcpcp
;9145 FOR J=0TO N-1
ld a,[charn1]
ld b,a
mafu20:
push bc
ld a,b
call getoffsetcomplex
;9146 A=CR(J):B=CI(J):GOSUB "C"+C$
ld hl,complextmpatof
add hl,bc
push hl
ld de,floata
ld bc,12
ldir
ld hl,mafu21
push hl
ld hl,[ptrmatrixfunction]
jp [hl]
mafu21:
;9147 CR(J)=A:CI(J)=B
pop de ;complextmpatof
ld hl,floata
ld bc,12
ldir

;9148 NEXT J
pop bc
dec b
ld a,b
cp -1
jr nz,mafu20

;9150 POKE RESULT,0:CALL FMLDIA:GOSUB *ERRCHK
call nmldia
;9160 P0=1:P1=0:P2=2:GOSUB "MP*"
ld hl,charp0
ld [hl],1
inc hl
ld [hl],0
inc hl
ld [hl],2
call mpmul
;9170 Z=2:GOTO "MREAD0"
ld b,0
ld a,2
jp atobmatrix

getoffsetcomplex: ;a=complexへのポインタ --> bc=offset ++++
push hl
ld c,a
add a,a ;*2
add a,c ;*3
add a,a ;*6 (max 144)
ld l,a
ld h,0
add hl,hl ;*12 (max 288)
ld b,h
ld c,l
pop hl
ret

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
xor a
ld [charj],a
nd00:
; mv a,0
; mv [chark],a
xor a
ld [chark],a
nd10:
; ;9151 A=MC(J,K):B=MP(J,K)
; mv a,[charj]
ld a,[charj]
; mv [ptr1],a
ld [ptr1],a
; mv a,[chark]
ld a,[chark]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp0],i
ld [inttmp0],bc
; mv x,[ptrmc]
ld hl,matrixc
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmp]
ld hl,matrixp
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
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
ld a,[chark]
call getoffsetcomplex
ld hl,complextmpatof
add hl,bc
ld de,floatc
ld bc,12
ldir
; ;9153 CALL FMUL
; call nmul
call nmul
; ;9154 MB(J,K)=A:MO(J,K)=B
; mv i,[inttmp0]
ld bc,[inttmp0]
; mv x,[ptra]
ld hl,floata
; mv y,[ptrmb]
ld de,matrixb
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
call mtom
; mv x,[ptrb]
ld hl,floatb
; mv y,[ptrmo]
ld de,matrixo
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
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

ld hl,chark
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jr nz,nd10
;
; mv a,[charj]
; inc a
; mv [charj],a
; mv il,[charn1]
; sub il,a
; jrnc nd00

ld hl,charj
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jr nz,nd00
;
; ret
ret

;err12: ld a,12 ;error on mldia
; jp err

mdiv: ;[matrixa,n] /= [matrixb,o]
;[matrixc,p]ワークエリア使用
;7030 "M/"
;7031 I=2:Z=0:GOSUB "MREAD"
ld b,2
xor a
call atobmatrix
;7032 Z=1:GOSUB "MREAD0"
ld b,0
ld a,1
call atobmatrix
;7033 GOSUB "MRCP"
call nrcpcp
;7034 I=1:Z=0:GOSUB "MREAD"
ld b,1
xor a
call atobmatrix
;7035 P0=2:P1=1:P2=0:GOTO "MP*"
ld hl,charp0
ld [hl],2
inc hl
ld [hl],1
inc hl
ld [hl],0
jp mpmul

meigen: ;[matrixa,n]の固有値、固有ベクトルを求める
;n>2のとき QR法を使用する
;[matrixa,n]=固有ベクトル
;[matrixb,o]の縦１列目=固有値
;[complextmpatof~]=ワークエリア使用
call matrixeigen

ld hl,complextmpatof+0*6
ld de,matrixb+(0*matrixsize+0)*6
call matrixeigenset00
ld hl,complextmpatof+1*6
ld de,matrixo+(0*matrixsize+0)*6
;
matrixeigenset00:
exx
ld a,[charn]
ld b,a
matrixeigenset10:
exx
ld bc,6
ldir
ld c,6
add hl,bc
ex de,hl
ld bc,matrixsize*6-6
add hl,bc
ex de,hl
exx
djnz matrixeigenset10

ret

printcharm:
ld a,[charm]
add a,'0'
jp pcha

matrixe210:
push bc
ld hl,matrixa
add hl,bc
push de
call mtom
pop de
ex de,hl
ld bc,6
add hl,bc
ex de,hl
ld hl,matrixn
pop bc
add hl,bc
jp mtom

matrixe200:
;7680 A00R=MA(M-2,M-2):A00I=MN(M-2,M-2)
ld a,[charm]
sub 2
ld [ptr1],a
ld [ptr2],a
call getoffset
ld de,floata00r
call matrixe210
;7681 A01R=MA(M-2,M-1):A01I=MN(M-2,M-1)
ld a,[charm1]
ld [ptr2],a
call getoffset
ld de,floata01r
call matrixe210
;7682 A10R=MA(M-1,M-2):A10I=MN(M-1,M-2)
ld a,[charm1]
ld [ptr1],a
ld a,[charm]
sub 2
ld [ptr2],a
call getoffset
ld de,floata10r
call matrixe210
;7683 A11R=MA(M-1,M-1):A11I=MN(M-1,M-1)
ld a,[charm1]
ld [ptr2],a
call getoffset
ld de,floata11r
call matrixe210
;
matrixe2: ;2x2小行列の固有値
;7200 "ME2"
;7210 A=A01R:B=A01I:C=A10R:D=A10I:CALL FMUL:P=A:Q=B
ld hl,floata01r
ld de,floata
ld bc,12
ldir
ld hl,floata10r
ld de,floatc
ld c,12
ldir
call nmul
call ldpaldqb

;7211 A=A00R-A11R:B=A00I-A11I:C=A:D=B:CALL FMUL
ld hl,floata00r
call mtox
ld hl,floata11r
call mtox
call sb
jp c,err5
ld hl,floata
call xtom
ld hl,floata00i
call mtox
ld hl,floata11i
call mtox
call sb
jp c,err5
ld hl,floatb
call xtom
call ldcalddb
call nmul

;7212 A=A+4*P:
ld hl,floata
push hl
call mtox
ld hl,floatp
pop de
push de
call mtom
pop hl
push hl
call mul4
jp c,err5
pop hl
push hl
call mtox
call ad
jp c,err5
pop hl
call xtom

;B=B+4*Q:GOSUB "CSQR"
ld hl,floatb
push hl
call mtox
ld hl,floatq
pop de
push de
call mtom
pop hl
push hl
call mul4
jp c,err5
pop hl
push hl
call mtox
call ad
jp c,err5
pop hl
call xtom

call nsqr

;7213 C=A00R+A11R:D=A00I+A11I
ld hl,floata00r
call mtox
ld hl,floata11r
call mtox
call ad
jp c,err5
ld hl,floatc
call xtom

ld hl,floata00i
call mtox
ld hl,floata11i
call mtox
call ad
jp c,err5
ld hl,floatd
call xtom

;7214 AR=(C-A)/2:AI=(D-B)/2
ld de,floatar
ld hl,sb
ld [inttmp2],hl
call matrixe220
;7215 BR=(C+A)/2:BI=(D+B)/2
ld de,floatbr
ld hl,ad
ld [inttmp2],hl
;
;7216 RETURN
matrixe220:
push de
ld hl,floatc
call mtox
ld hl,floata
call mtox
ld hl,matrixe221
push hl
ld hl,[inttmp2]
jp [hl]
matrixe221:
jp c,err5
pop hl
push hl
call xtom
pop hl
push hl
call fatn30
pop hl
ld bc,6
add hl,bc
push hl
ld hl,floatd
call mtox
ld hl,floatb
call mtox
ld hl,matrixe222
push hl
ld hl,[inttmp2]
jp [hl]
matrixe222:
jp c,err5
pop hl
push hl
call xtom
pop hl
jp fatn30

setcharm:
ld [charm],a
dec a
ld [charm1],a
ret

mqrmsg00: db 'ｺﾕｳﾁｦﾓﾄﾒﾃｲﾏｽ ',13
mqrmsg01: db 'ｺﾕｳﾁｶﾞﾓﾄﾒﾗﾚﾏｼﾀ',13
mqrmsg02: db 'ｺﾕｳﾍﾞｸﾄﾙｦﾓﾄﾒﾃｲﾏｽ',13
mqrmsg03: db 'ｺｳｿｸﾇﾙｽﾍﾟ-ｽｶﾞｼｯﾊﾟｲｼﾏｼﾀ.ﾋﾟﾎﾞｯﾄｦｺｺﾛﾐﾏｽ',13
mqrmsg04: db 'ｺﾕｳﾍﾞｸﾄﾙｶﾞﾓﾄﾒﾗﾚﾏｼﾀ',13
mqrmsg10: db 'ｳｴｻﾝｶｸﾃﾞｽ',13
mqrmsg11: db 'ｼﾀｻﾝｶｸﾃﾞｽ',13

matrixqr: ;[matrixa,n]の固有値、固有ベクトルを求める
;n>2のとき、ここに来る。QR法を使用する
;[matrixa,n]=固有ベクトル
;[complextmpatof~]=固有値
;7600 "MQR"
;7601 FOR J=1TO N-1:FOR K=0TO J-1
ld a,1
ld [ptr1],a
mqr760100:
xor a
ld [ptr2],a
mqr760110:
call getoffset
;7602 IF MA(J,K)<>0THEN K=N:J=N:NEXT K:NEXT J:GOTO 7605
ld hl,matrixa
add hl,bc
call is0
jr nz,mqr7605
;7603 IF MN(J,K)<>0THEN K=N:J=N:NEXT K:NEXT J:GOTO 7605
ld hl,matrixn
add hl,bc
call is0
jr nz,mqr7605
;7604 NEXT K(TO J-1):NEXT J(TO N-1):WAIT 0:PRINT "ｳｴｻﾝｶｸﾃﾞｽ":GOTO 7900
ld hl,ptr2
inc [hl]
ld a,[ptr1]
cp [hl]
jr nz,mqr760110

ld hl,ptr1
inc [hl]
ld a,[charn]
cp [hl]
jr nz,mqr760100

ld hl,mqrmsg10
call message
call crlf
jp mqr7900
mqr7605:
;7605 FOR J=1TO N-1:FOR K=0TO J-1
ld a,1
ld [ptr2],a
mqr760500:
xor a
ld [ptr1],a
mqr760510:
call getoffset
;7606 IF MA(K,J)<>0THEN K=N:J=N:NEXT K:NEXT J:GOTO 7610
ld hl,matrixa
add hl,bc
call is0
jr nz,mqr7610
;7607 IF MN(K,J)<>0THEN K=N:J=N:NEXT K:NEXT J:GOTO 7610
ld hl,matrixn
add hl,bc
call is0
jr nz,mqr7610
;7608 NEXT K(TO J-1):NEXT J(TO N-1):WAIT 0:PRINT "ｼﾀｻﾝｶｸﾃﾞｽ":GOTO 7900
ld hl,ptr1
inc [hl]
ld a,[ptr2]
cp [hl]
jr nz,mqr760510

ld hl,ptr2
inc [hl]
ld a,[charn]
cp [hl]
jr nz,mqr760500

ld hl,mqrmsg11
call message
call crlf
jp mqr7900
mqr7610:
;7610 FOR J=0TO N-1:FOR K=0TO N-1 ******
;7611 IF MN(J,K)<>0THEN K=N:J=N:NEXT K:NEXT J:GOTO 7640
;7612 NEXT K:NEXT J
;7620 FOR J=1TO N-1:FOR K=0TO J-1
;7621 IF MA(J,K)<>MA(K,J)THEN K=N:J=N:NEXT K:NEXT J:WAIT 0:PRINT "ｼﾞﾂﾋﾀｲｼｮｳﾃﾞｽ":GOTO "MFRAME"
;7622 NEXT K:NEXT J:WAIT 0:PRINT "ｼﾞﾂﾀｲｼｮｳﾃﾞｽ":GOTO "MJACOBI"

;7640 I=4:Z=0:GOSUB "MREAD" --> I=3に変更
ld b,3
xor a
call atobmatrix
;7641 SC=1:IF MUSTSCALE2=1 THEN GOSUB "MSCALE2"
ld hl,float1
ld de,floatsc
call mtom

ld a,[mustscale2]
and a
call nz,nscale2
;7645 IF N=3 THEN IF MUSTEIGEN34=1 THEN GOTO *EIGEN330 ******
;7646 IF N=4 THEN IF MUSTEIGEN34=1 THEN GOTO *EIGEN440 ******
;7647 *QRRESUME

;7650 GOSUB "MHH"
call nhh
;7651 WAIT 0:PRINT "ｺﾕｳﾁｦﾓﾄﾒﾃｲﾏｽ";
ld hl,mqrmsg00
call message
;7652 M=N:FL=1:PRINT M;
ld a,[charn]
call setcharm
call printcharm

;7653 WHILE FL=1
mqr7653:
;7654 PRINT ".";
call printdot
;7660 IF M<>1 THEN 7670
ld a,[charm]
cp 1
jr nz,mqr7670
;7661 CR(N)=MA(0,0):CI(N)=MN(0,0):FL=0:GOTO 7740
ld a,[charn]
call getoffsetcomplex
ld hl,complextmpatof
add hl,bc
push hl
xor a
ld [ptr1],a
ld [ptr2],a
call getoffset
ld hl,matrixa
add hl,bc
pop de
push de
call mtom
ld hl,matrixn
add hl,bc
ex de,hl
pop hl
ld bc,6
add hl,bc
ex de,hl
call mtom

jp mqr7750

;7670 IF M<>2 THEN 7680
mqr7670:
ld a,[charm]
cp 2
jp nz,mqr7680

;7671 A00R=MA(0,0):A00I=MN(0,0)
xor a
ld [ptr1],a
ld [ptr2],a
call getoffset
ld hl,matrixa
add hl,bc
ld de,floata00r
call mtom
ld hl,matrixn
add hl,bc
ld de,floata00i
call mtom
;7672 A01R=MA(0,1):A01I=MN(0,1)
ld a,1
ld [ptr2],a
call getoffset
ld hl,matrixa
add hl,bc
ld de,floata01r
call mtom
ld hl,matrixn
add hl,bc
ld de,floata01i
call mtom
;7673 A10R=MA(1,0):A10I=MN(1,0)
ld a,1
ld [ptr1],a
xor a
ld [ptr2],a
call getoffset
ld hl,matrixa
add hl,bc
ld de,floata10r
call mtom
ld hl,matrixn
add hl,bc
ld de,floata10i
call mtom
;7674 A11R=MA(1,1):A11I=MN(1,1)
ld a,1
ld [ptr2],a
call getoffset
ld hl,matrixa
add hl,bc
ld de,floata11r
call mtom
ld hl,matrixn
add hl,bc
ld de,floata11i
call mtom
;7675 GOSUB "ME2"
call matrixe2
;7676 CR(N)=AR:CI(N)=AI:CR(N+1)=BR:CI(N+1)=BI:FL=0:GOTO 7740
ld a,[charn]
call getoffsetcomplex
ld hl,complextmpatof
add hl,bc
ld de,floatar
ex de,hl
ld bc,12
ldir
ld a,[charn]
inc a
call getoffsetcomplex
ld hl,complextmpatof
add hl,bc
ld de,floatbr
ex de,hl
ld bc,12
ldir
jp mqr7750

mqr7680:
;7680 A00R=MA(M-2,M-2):A00I=MN(M-2,M-2)
;7681 A01R=MA(M-2,M-1):A01I=MN(M-2,M-1)
;7682 A10R=MA(M-1,M-2):A10I=MN(M-1,M-2)
;7683 A11R=MA(M-1,M-1):A11I=MN(M-1,M-1)
;7684 GOSUB "ME2"

call matrixe200

;7690 POKE RESULT,0:POKE CHARM,M:CALL FDBLQRLP:GOSUB *ERRCHK

call ndblqrlp

;7700 A=MA(M-1,M-2):B=MN(M-1,M-2)
ld a,[charm1]
ld [ptr1],a
dec a
ld [ptr2],a
call getoffset
call mqr00 ;SQR (A*A+B*B) - E0
;7701 IF SQR (A*A+B*B)<E0 THEN M=M-1:CR(N+M)=MA(M,M):
jr nc,mqr7710

ld hl,charm
dec [hl]
ld a,[hl]
call setcharm
ld a,[hl]
ld [ptr1],a
ld [ptr2],a
ld a,[charn]
add a,[hl]
call getoffsetcomplex

push bc

ld hl,complextmpatof
add hl,bc
push hl
call getoffset
ld hl,matrixa
add hl,bc
pop de
call mtom

;CI(N+M)=MN(M,M):PRINT M;:GOTO 7740
pop bc

ld hl,complextmpatof+6
add hl,bc
push hl
call getoffset
ld hl,matrixn
add hl,bc
pop de
call mtom

call printcharm
jp mqr7653
mqr7710:
;7710 A=MA(M-2,M-3):B=MN(M-2,M-3)
ld a,[charm1]
dec a
ld [ptr1],a
dec a
ld [ptr2],a
call getoffset
call mqr00 ;SQR (A*A+B*B) - E0
;7711 IF SQR (A*A+B*B)<E0 THEN
jp nc,mqr7653

;7720 A00R=MA(M-2,M-2):A00I=MN(M-2,M-2)
;7721 A01R=MA(M-2,M-1):A01I=MN(M-2,M-1)
;7722 A10R=MA(M-1,M-2):A10I=MN(M-1,M-2)
;7723 A11R=MA(M-1,M-1):A11I=MN(M-1,M-1)
;7724 GOSUB "ME2"
call matrixe200

;7730 M=M-1:CR(N+M)=AR:CI(N+M)=AI:PRINT M;
ld hl,floatar
call mqr10
;7731 M=M-1:CR(N+M)=BR:CI(N+M)=BI:PRINT M;
ld hl,floatbr
call mqr10
;7735 ENDIF
;7740 WEND
jp mqr7653
mqr7750:
;7750 FOR J=0TO N-1
;7751 CR(J)=CR(N+J)*SC:CI(J)=CI(N+J)*SC
;7752 NEXT J
ld hl,floatsc
ld de,floatc
call mtom
ld hl,floatd
call mv0

ld a,[charn]
ld b,a
mqr7760:
push bc
dec b
ld a,[charn]
add a,b
call getoffsetcomplex
ld hl,complextmpatof
add hl,bc
ld de,floata
ld bc,12
ldir

call nmul

pop af
push af
dec a
call getoffsetcomplex
ld hl,complextmpatof
add hl,bc
ld de,floata
ex de,hl
ld bc,12
ldir
pop bc
djnz mqr7760

;7760 WAIT 0:PRINT "ｺﾕｳﾁｶﾞﾓﾄﾒﾗﾚﾏｼﾀ"
ld hl,mqrmsg01
call message
call crlf

;7761 PRINT "ｺﾕｳﾍﾞｸﾄﾙｦﾓﾄﾒﾃｲﾏｽ";
ld hl,mqrmsg02
call message
;7770 FOR P3=0 TO N-1
xor a
ld [charp3],a
mqr7771:
;7771 PRINT ".";
call printdot
;7775 IF MUSTNSFAST=0 THEN 7791
ld a,[mustnsfast]
and a
jr z,mqr7791
;7780 POKE RESULT,0:POKE CHARM,P3:CALL FNSFAST
ld a,[charp3]
ld [charm],a
call nnsfast
jr nc,mqr7800
;7781 IF PEEK RESULT=&HF1 THEN 7790
;7782 GOSUB *ERRCHK:GOTO 7800
;7790 WAIT 0:PRINT "ｺｳｿｸﾇﾙｽﾍﾟ-ｽｶﾞｼｯﾊﾟｲｼﾏｼﾀ.ﾋﾟﾎﾞｯﾄｦｺｺﾛﾐﾏｽ"
ld hl,mqrmsg03
call message
call crlf
;
mqr7791:
call mqr20
mqr7800:
;7800 NEXT P3 (p3++, to charn-1)
ld hl,charp3
inc [hl]
ld a,[charn]
cp [hl]
jr nz,mqr7771
;7810 PRINT "ｺﾕｳﾍﾞｸﾄﾙｶﾞﾓﾄﾒﾗﾚﾏｼﾀ":RETURN
jr mqr10250

mqr7900:
;7900 FOR J=0TO N-1
ld a,[charn]
ld b,a
mqr7901:
push bc
;7901 CR(J)=MA(J,J):CI(J)=MN(J,J)
ld a,b
dec a
ld [ptr1],a
ld [ptr2],a
call getoffsetcomplex
push bc
call getoffset
ld hl,matrixa
add hl,bc
call mtox ;a
ld hl,matrixn
add hl,bc
call mtox ;n
pop bc
ld hl,complextmpatof+6 ;ci
add hl,bc
call xtom ;n
ld hl,complextmpatof ;cr
add hl,bc
call xtom ;a
;7902 NEXT J
pop bc
djnz mqr7901
;7910 I=4:Z=0:GOSUB "MREAD":GOTO 10200 --> I=3に変更
ld b,3
xor a
call atobmatrix
;10200 WAIT 0:PRINT "ｺﾕｳﾁｶﾞﾓﾄﾒﾗﾚﾏｼﾀ"
ld hl,mqrmsg01
call message
call crlf
;10201 PRINT "ｺﾕｳﾍﾞｸﾄﾙｦﾓﾄﾒﾃｲﾏｽ";
ld hl,mqrmsg02
call message
;10210 FOR P3=0 TO N-1
xor a
ld [charp3],a
mqr10211:
;10211 PRINT ".";
call printdot

call mqr20
;10240 NEXT P3
ld hl,charp3
inc [hl]
ld a,[charn]
cp [hl]
jr nz,mqr10211
;10250 PRINT "ｺﾕｳﾍﾞｸﾄﾙｶﾞﾓﾄﾒﾗﾚﾏｼﾀ":RETURN
mqr10250:
ld hl,mqrmsg04
call message
jp crlf

mqr20:
;7791 I=3:Z=4:GOSUB "MREAD" --> I=2、Z=3に変更
ld b,2
ld a,3
call atobmatrix
;7792 A=CR(P3):B=CI(P3) --> c=cr、d=ciに変更
ld a,[charp3]
call getoffsetcomplex
ld hl,complextmpatof
add hl,bc
ld de,floatc
ld bc,12
ldir
;7793 FOR J=0 TO N-1
ld a,[charn]
ld b,a
mqr7794:
push bc
;7794 MD(J,J)=MD(J,J)-A:MQ(J,J)=MQ(J,J)-B --> mc=mc-c、mp=mp-dに変更
ld a,b
dec a
ld [ptr1],a
ld [ptr2],a
call getoffset
ld hl,matrixc
add hl,bc
push hl ;mc
ld de,floata
call mtom
ld hl,matrixp
add hl,bc
push hl ;mp
ld de,floatb
call mtom
call nsub
ld hl,floatb
pop de ;mp
call mtom
ld hl,floata
pop de ;mc
call mtom
;7795 NEXT J
pop bc
djnz mqr7794
;7796 GOSUB "MNS"
ld a,[charp3]
ld [charm],a
jp nnscp

mqr10: ;M=M-1:CR(N+M)=[hl]:CI(N+M)=[hl+6]:PRINT M;
push hl
ld hl,charm
dec [hl]
ld a,[hl]
call setcharm
ld a,[charn]
add a,[hl]
call getoffsetcomplex
ld hl,complextmpatof
add hl,bc
pop de
ex de,hl
ld bc,12
ldir
jp printcharm

mqr00: ;bc=offset --> zf,cf = sqr([matrix a+bc]^2+[matrix n+bc]^2)-float e0
push bc

ld hl,matrixa
add hl,bc
push hl
call mtox
pop hl
call mtox
call mul
jp c,err5

pop bc

ld hl,matrixn
add hl,bc
push hl
call mtox
pop hl
call mtox
call mul
jp c,err5

call ad
jp c,err5
call sqr
jp c,err5
ld hl,floata
push hl
call xtom
pop de
ld hl,floate0
jp fcp ;float a - float e0

ndblqrlp: ;ダブルシフトQR分解
; 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
ld a,[charm]
dec a
ld [charm1],a
;
; ;For[i = 1, i < m, i++,
; mv a,0
xor a
; mv [chari],a
ld [chari],a
nd50:
; ; If[i == 1,
; mv a,[chari]
ld a,[chari]
; cmp a,0
and a
; jpnz nd60
jp nz,nd60
; ; b1 = a[[1, 1]]^2
; mv a,0
xor a
; mv [ptr1],a
ld [ptr1],a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp0],i
ld [inttmp0],bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; pushs x
push hl
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; pops x
pop hl
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; pushs x
push hl
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; pops x
pop hl
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
; call nmul
call nmul
; mv x,[ptra]
ld hl,floata
; mv y,fb1r
ld de,fb1r
; call mtom
call mtom
; mv x,[ptrb]
ld hl,floatb
; mv y,fb1i
ld de,fb1i
; call mtom
call mtom
; ; - (s1 + s2)*a[[1, 1]]
; mv x,[ptrar]
ld hl,floatar
; call mtox
call mtox
; mv x,[ptrbr]
ld hl,floatbr
; call mtox
call mtox
; call ad
call ad
; jpc err5
jp c,err5
; mv x,fsr
ld hl,fsr
; pushs x
push hl
; call xtom
call xtom
; pops x
pop hl
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrai]
ld hl,floatai
; call mtox
call mtox
; mv x,[ptrbi]
ld hl,floatbi
; call mtox
call mtox
; call ad
call ad
; jpc err5
jp c,err5
; mv x,fsi
ld hl,fsi
; pushs x
push hl
; call xtom
call xtom
; pops x
pop hl
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; mv i,[inttmp0]
ld bc,[inttmp0]
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
; call nmul
call nmul
;
; mv x,fb1r
ld hl,fb1r
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptra]
ld hl,floata
; call mtox
call mtox
; call sb
call sb
; jpc err5
jp c,err5
; pops x
pop hl
; call xtom
call xtom
; mv x,fb1i
ld hl,fb1i
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptrb]
ld hl,floatb
; call mtox
call mtox
; call sb
call sb
; jpc err5
jp c,err5
; pops x
pop hl
; call xtom
call xtom
;
; ; + s1*s2
; mv x,[ptrar]
ld hl,floatar
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrai]
ld hl,floatai
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; mv x,[ptrbr]
ld hl,floatbr
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrbi]
ld hl,floatbi
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
; call nmul
call nmul
;
; call addfb1ab
call addfb1ab
;
; ; + a[[1, 2]]*a[[2, 1]];
; mv a,0
xor a
; mv [ptr1],a
ld [ptr1],a
; mv a,1
ld a,1
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
;
; mv a,1
ld a,1
; mv [ptr1],a
ld [ptr1],a
; mv a,0
xor a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp1],i
ld [inttmp1],bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
;
; call nmul
call nmul
;
; call addfb1ab
call addfb1ab
;
; ; b2 = (a[[1, 1]] + a[[2, 2]] - s1 - s2)
; mv i,[inttmp0]
ld bc,[inttmp0]
; mv x,[ptrma]
ld hl,matrixa
; pushs x
push hl
; add x,i
add hl,bc
; call mtox
call mtox
; mv a,1
ld a,1
; mv [ptr1],a
ld [ptr1],a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp2],i
ld [inttmp2],bc
; pops x
pop hl
; add x,i
add hl,bc
; call mtox
call mtox
; call ad
call ad
; jpc err5
jp c,err5
; mv x,fsr
ld hl,fsr
; call mtox
call mtox
; call sb
call sb
; jpc err5
jp c,err5
; mv x,[ptra]
ld hl,floata
; call xtom
call xtom
;
; mv i,[inttmp0]
ld bc,[inttmp0]
; mv x,[ptrmn]
ld hl,matrixn
; pushs x
push hl
; add x,i
add hl,bc
; call mtox
call mtox
; mv i,[inttmp2]
ld bc,[inttmp2]
; pops x
pop hl
; add x,i
add hl,bc
; call mtox
call mtox
; call ad
call ad
; jpc err5
jp c,err5
; mv x,fsi
ld hl,fsi
; call mtox
call mtox
; call sb
call sb
; jpc err5
jp c,err5
; mv x,[ptrb]
ld hl,floatb
; call xtom
call xtom
;
; ;*a[[2, 1]];
; mv i,[inttmp1]
ld bc,[inttmp1]
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
; call nmul
call nmul
; mv x,[ptra]
ld hl,floata
; mv y,fb2r
ld de,fb2r
; call mtom
call mtom
; mv x,[ptrb]
ld hl,floatb
; mv y,fb2i
ld de,fb2i
; call mtom
call mtom
;
; ; b3 = a[[3, 2]]*a[[2, 1]];
; mv a,2
ld a,2
; mv [ptr1],a
ld [ptr1],a
; mv a,1
ld a,1
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; mv i,[inttmp1]
ld bc,[inttmp1]
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
; call nmul
call nmul
; mv x,[ptra]
ld hl,floata
; mv y,fb3r
ld de,fb3r
; call mtom
call mtom
; mv x,[ptrb]
ld hl,floatb
; mv y,fb3i
ld de,fb3i
; call mtom
call mtom
;
; jr nd70
jr nd70
; ,
nd60:
; ; b1 = a[[i, i - 1]];
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; dec a
dec a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,fb1r
ld de,fb1r
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,fb1i
ld de,fb1i
; call mtom
call mtom
;
; ; b2 = a[[i + 1, i - 1]];
; mv a,[chari]
ld a,[chari]
; inc a
inc a
; mv [ptr1],a
ld [ptr1],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,fb2r
ld de,fb2r
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,fb2i
ld de,fb2i
; call mtom
call mtom
;
;; b3 = If[i == m - 2, 0, a[[i + 2, i - 1]]];
; mv a,[chari]
ld a,[chari]
; add a,2
add a,2
; mv il,[charm]
; sub il,a
; jrz nd61
ld hl,charm
cp [hl]
jr z,nd61
;
; mv [ptr1],a
ld [ptr1],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,fb3r
ld de,fb3r
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,fb3i
ld de,fb3i
; call mtom
call mtom
;
; jr nd62
jr nd62
nd61:
; mv x,fb3r
ld hl,fb3r
; call mv0
call mv0
; mv x,fb3i
ld hl,fb3i
; call mv0
call mv0
nd62:
; ];
nd70:
; If[Im[b1] != 0, b2 /= b1; b3 /= b1; b1 = 1;];
; mv x,fb1i
ld hl,fb1i
; mv y,[ptrb]
ld de,floatb
; pushs y
push de
; call mtom
call mtom
; pops x
pop hl
; mv a,0
xor a
; mv [x],a
ld [hl],a
; mv y,[ptre3]
ld de,floate3
; call cp ;E3 - ABS Im[b1]
call fcp
; jrnc nd71
jr nc,nd71
;
; mv x,fb1r
ld hl,fb1r
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,fb1i
ld hl,fb1i
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
;
; mv x,fb2r
ld hl,fb2r
; pushs x
push hl
; mv y,[ptra]
ld de,floata
; pushs y
push de
; call mtom
call mtom
; mv x,fb2i
ld hl,fb2i
; pushs x
push hl
; mv y,[ptrb]
ld de,floatb
; pushs y
push de
; call mtom
call mtom
; call ndiv
call ndiv
; pops x ;[ptrb]
pop hl
; pops y ;fb2i
pop de
; call mtom
call mtom
; pops x ;[ptra]
pop hl
; pops y ;fb2r
pop de
; call mtom
call mtom
;
; mv x,fb3r
ld hl,fb3r
; pushs x
push hl
; mv y,[ptra]
ld de,floata
; pushs y
push de
; call mtom
call mtom
; mv x,fb3i
ld hl,fb3i
; pushs x
push hl
; mv y,[ptrb]
ld de,floatb
; pushs y
push de
; call mtom
call mtom
; call ndiv
call ndiv
; pops x ;[ptrb]
pop hl
; pops y ;fb3i
pop de
; call mtom
call mtom
; pops x ;[ptra]
pop hl
; pops y ;fb3r
pop de
; call mtom
call mtom
;
; mv x,fb1r
ld hl,fb1r
; call mv1
call mv1
; mv x,fb1i
ld hl,fb1i
; call mv0
call mv0
nd71:
;; no = Norm[{b2, b3}];
; mv x,fb2r
ld hl,fb2r
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err5
jp c,err5
; mv x,fb2i
ld hl,fb2i
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err5
jp c,err5
; call ad
call ad
; jpc err5
jp c,err5
; mv x,fb3r
ld hl,fb3r
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err5
jp c,err5
; mv x,fb3i
ld hl,fb3i
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err5
jp c,err5
; call ad
call ad
; jpc err5
jp c,err5
; call ad
call ad
; jpc err5
jp c,err5
; mv x,fss
ld hl,fss
; call xtom
call xtom
;; r = Norm[{b1, no}];
; mv x,fb1r
ld hl,fb1r
; mv a,[x]
ld a,[hl]
; pushs a
push af
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err5
jp c,err5
; mv x,fb1i
ld hl,fb1i
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err5
jp c,err5
; call ad
call ad
; jpc err5
jp c,err5
; mv x,fss
ld hl,fss
; call mtox
call mtox
; call ad
call ad
; jpc err5
jp c,err5
; call sqr
call sqr
; jpc err5
jp c,err5
;; b1 = b1 + r*If[Re[b1] >= 0, 1, -1];
; pops a
pop af
; cmp a,0
and a
; jrz nd72
jr z,nd72
;
; call sb
call sb
; jr nd73
jr nd73
nd72:
; call ad
call ad
nd73:
; jpc err5
jp c,err5
; mv x,fb1r
ld hl,fb1r
; call xtom
call xtom
;
;; no = Norm[{b1, no}]^2;
; mv x,fb1r
ld hl,fb1r
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err5
jp c,err5
; mv x,fb1i
ld hl,fb1i
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err5
jp c,err5
; call ad
call ad
; jpc err5
jp c,err5
; mv x,fss
ld hl,fss
; pushs x
push hl
; call mtox
call mtox
; call ad
call ad
; jpc err5
jp c,err5
; pops x
pop hl
; call xtom
call xtom
;; If[no > 0, (==0, nd40)
; mv x,fss
ld hl,fss
; call is0
call is0
; jpz nd40
jp z,nd40
;; d2 = Sqrt[2]/Sqrt[no];
; mv x,fc_sqrt2
ld hl,floatsqrt2
; call mtox
call mtox
; mv x,fss
ld hl,fss
; call mtox
call mtox
; call sqr
call sqr
; jpc err5
jp c,err5
; call div
call div
; jpc err5
jp c,err5
; mv x,fd2r
ld hl,fd2r
; call xtom
call xtom
;
; mv x,fb1r
ld hl,fb1r
; call mulxd2
call mulxd2
; mv x,fb1i
ld hl,fb1i
; call mulxd2
call mulxd2
; mv x,fb2r
ld hl,fb2r
; call mulxd2
call mulxd2
; mv x,fb2i
ld hl,fb2i
; call mulxd2
call mulxd2
; mv x,fb3r
ld hl,fb3r
; call mulxd2
call mulxd2
; mv x,fb3i
ld hl,fb3i
; call mulxd2
call mulxd2
;
;; If[i - 1 >= 1, j = i - 1, j = 1];
; mv a,[chari]
ld a,[chari]
; sub a,1
sub 1
; jrnc nd74
jr nc,nd74
; mv a,0
xor a
nd74: ;mv [charj],a
ld [charj],a
;; For[k = j, k <= m, k++,
; mv a,[charj]
ld a,[charj]
; mv [chark],a
ld [chark],a
nd20:
;; d1 = Conjugate[b1]*a[[i, k]];
; mv x,fb1r
ld hl,fb1r
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,fb1i
ld hl,fb1i
; mv y,[ptrb]
ld de,floatb
; pushs y
push de
; call mtom
call mtom
; pops x
pop hl
; call chs
call chs
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,[chark]
ld a,[chark]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp0],i
ld [inttmp0],bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
; call nmul
call nmul
; mv x,[ptra]
ld hl,floata
; mv y,fd1r
ld de,fd1r
; call mtom
call mtom
; mv x,[ptrb]
ld hl,floatb
; mv y,fd1i
ld de,fd1i
; call mtom
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
ld hl,charn1
ld a,[chari]
inc a
cp [hl]
jr z,nd210
jr nc,nd21
nd210:
;
; mv [ptr1],a
ld [ptr1],a
; call getoffset
call getoffset
; mv [inttmp1],i
ld [inttmp1],bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; mv x,fb2r
ld hl,fb2r
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,fb2i
ld hl,fb2i
; mv y,[ptrd]
ld de,floatd
; pushs y
push de
; call mtom
call mtom
; pops x
pop hl
; call chs
call chs
; call nmul
call nmul
;
; call addfd1ab
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
ld hl,charn1
ld a,[chari]
add a,2
cp [hl]
jr z,nd220
jr nc,nd22
nd220:
;
; mv [ptr1],a
ld [ptr1],a
; call getoffset
call getoffset
; mv [inttmp2],i
ld [inttmp2],bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; mv x,fb3r
ld hl,fb3r
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,fb3i
ld hl,fb3i
; mv y,[ptrd]
ld de,floatd
; pushs y
push de
; call mtom
call mtom
; pops x
pop hl
; call chs
call chs
; call nmul
call nmul
;
; call addfd1ab
call addfd1ab
nd22:
;
;; a[[i, k]] -= b1*d1;
; mv x,fd1r
ld hl,fd1r
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,fd1i
ld hl,fd1i
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
;
; mv x,fb1r
ld hl,fb1r
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,fb1i
ld hl,fb1i
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; call nmul
call nmul
; mv i,[inttmp0]
ld bc,[inttmp0]
; call submamnab
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
ld hl,charn1
ld a,[chari]
inc a
cp [hl]
jr z,nd230
jr nc,nd23
nd230:
;
; mv x,fb2r
ld hl,fb2r
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,fb2i
ld hl,fb2i
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; call nmul
call nmul
; mv i,[inttmp1]
ld bc,[inttmp1]
; call submamnab
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
ld hl,charn1
ld a,[chari]
add a,2
cp [hl]
jr z,nd240
jr nc,nd24
nd240:
;
; mv x,fb3r
ld hl,fb3r
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,fb3i
ld hl,fb3i
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; call nmul
call nmul
; mv i,[inttmp2]
ld bc,[inttmp2]
; call submamnab
call submamnab
nd24:
;; ]; (k++, to [charm]-1, nd20)
; mv a,[chark]
; inc a
; mv [chark],a
; mv il,[charm1]
; sub il,a
; jpnc nd20
ld hl,chark
inc [hl]
ld a,[charm]
cp [hl]
jp nz,nd20

;; If[i + 3 <= m, j = i + 3, j = m];
; mv a,[chari]
; add a,3
; mv il,[charm1]
; sub il,a
; jrnc nd25
ld a,[chari]
add a,3
ld hl,charm1
cp [hl]
jr z,nd25
jr c,nd25

; mv a,[charm1]
ld a,[charm1]

nd25: ;mv [charj],a
ld [charj],a

;; For[k = 1, k <= j, k++,
; mv a,0
xor a
; mv [chark],a
ld [chark],a
nd30:
;; d1 = b1*a[[k, i]];
; mv x,fb1r
ld hl,fb1r
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,fb1i
ld hl,fb1i
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; mv a,[chark]
ld a,[chark]
; mv [ptr1],a
ld [ptr1],a
; mv a,[chari]
ld a,[chari]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp0],i
ld [inttmp0],bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
; call nmul
call nmul
; mv x,[ptra]
ld hl,floata
; mv y,fd1r
ld de,fd1r
; call mtom
call mtom
; mv x,[ptrb]
ld hl,floatb
; mv y,fd1i
ld de,fd1i
; call mtom
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
ld hl,charn1
ld a,[chari]
inc a
cp [hl]
jr z,nd310
jr nc,nd31
nd310:
;
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp1],i
ld [inttmp1],bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; mv x,fb2r
ld hl,fb2r
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,fb2i
ld hl,fb2i
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
; call nmul
call nmul
;
; call addfd1ab
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
ld hl,charn1
ld a,[chari]
add a,2
cp [hl]
jr z,nd320
jr nc,nd32
nd320:
;
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp2],i
ld [inttmp2],bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; mv x,fb3r
ld hl,fb3r
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,fb3i
ld hl,fb3i
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
; call nmul
call nmul
;
; call addfd1ab
call addfd1ab
nd32:
;; a[[k, i]] -= Conjugate[b1]*d1;
; mv x,fd1r
ld hl,fd1r
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,fd1i
ld hl,fd1i
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
;
; mv x,fb1r
ld hl,fb1r
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,fb1i
ld hl,fb1i
; mv y,[ptrb]
ld de,floatb
; pushs y
push de
; call mtom
call mtom
; pops x
pop hl
; call chs
call chs
; call nmul
call nmul
; mv i,[inttmp0]
ld bc,[inttmp0]
; call submamnab
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
ld hl,charn1
ld a,[chari]
inc a
cp [hl]
jr z,nd330
jr nc,nd33
nd330:
;
; mv x,fb2r
ld hl,fb2r
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,fb2i
ld hl,fb2i
; mv y,[ptrb]
ld de,floatb
; pushs y
push de
; call mtom
call mtom
; pops x
pop hl
; call chs
call chs
; call nmul
call nmul
; mv i,[inttmp1]
ld bc,[inttmp1]
; call submamnab
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
ld hl,charn1
ld a,[chari]
add a,2
cp [hl]
jr z,nd340
jr nc,nd34
nd340:
;
; mv x,fb3r
ld hl,fb3r
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,fb3i
ld hl,fb3i
; mv y,[ptrb]
ld de,floatb
; pushs y
push de
; call mtom
call mtom
; pops x
pop hl
; call chs
call chs
; call nmul
call nmul
; mv i,[inttmp2]
ld bc,[inttmp2]
; call submamnab
call submamnab
nd34:
;; ]; (k++, to [charj], nd30)
; mv a,[chark]
; inc a
; mv [chark],a
; mv il,[charj]
; sub il,a
; jpnc nd30
ld hl,chark
inc [hl]
ld a,[charj]
inc a
cp [hl]
jp nz,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
ld hl,chari
inc [hl]
ld a,[charm1]
cp [hl]
jp nz,nd50

ret

submamnab:
; pushs i
push bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptra]
ld hl,floata
; call mtox
call mtox
; call sb
call sb
; jpc err5
jp c,err5
; pops x
pop hl
; call xtom
call xtom
; pops i
pop bc
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptrb]
ld hl,floatb
; call mtox
call mtox
; call sb
call sb
; jpc err5
jp c,err5
; pops x
pop hl
jp xtom

mulxd2:
; pushs x
push hl
; call mtox
call mtox
; mv x,fd2r
ld hl,fd2r
; call mtox
call mtox
; call mul
call mul
; jrc err5
jr c,err5
; pops x
pop hl
jp xtom

addfb1ab:
; mv x,fb1r
ld hl,fb1r
; call addfd1ab00
call addfd1ab00
; mv x,fb1i
ld hl,fb1i
jr addfd1ab01

addfd1ab:
; mv x,fd1r
ld hl,fd1r
; call addfd1ab00
call addfd1ab00
; mv x,fd1i
ld hl,fd1i
;
addfd1ab01:
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptrb]
ld hl,floatb
; call mtox
call mtox
; call ad
call ad
; jrc err5
jr c,err5
; pops x
pop hl
jp xtom

addfd1ab00:
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptra]
ld hl,floata
; call mtox
call mtox
; call ad
call ad
; jrc err5
jr c,err5
; pops x
pop hl
jp xtom

err5: ld a,5 ;error on dblqrlp
jp err

;12000 "MNS"
;12010 IF MUSTSCALE=1 THEN GOSUB "MSCALE"
;12100 Z=3:I=2:GOSUB "MREAD" --> 不要
;12101 POKE RESULT,0:POKE CHARM,P3:CALL FNSCP --> やってある
;12102 IF PEEK RESULT=&HF0 THEN WAIT :PRINT "ｶｲｶﾞﾑｹﾞﾝﾀﾞｲﾆﾅﾘﾏｼﾀ.ｹｲｻﾝﾃﾞｷﾏｾﾝ":GOTO 12120
;12103 IF PEEK RESULT=&HF1 THEN WAIT :PRINT "ﾇﾙｽﾍﾟ-ｽﾊｱﾘﾏｾﾝ":GOTO 12120
;12110 GOTO *ERRCHK
;12120 POKE RESULT,0:WAIT 0:RETURN

nnerrmsg: db 'ﾇﾙｽﾍﾟ-ｽﾊｱﾘﾏｾﾝ.ｺﾕｳﾍﾞｸﾄﾙﾊ 0 ﾆﾅﾘﾏｽ',13

errf0: ;ｶｲｶﾞﾑｹﾞﾝﾀﾞｲﾆﾅﾘﾏｼﾀ.ｹｲｻﾝﾃﾞｷﾏｾﾝ
err33: ld a,33
jp err

errf1: ld sp,[sp_work2]
ld hl,nnerrmsg ;ﾇﾙｽﾍﾟ-ｽﾊｱﾘﾏｾﾝ
call message
call crlf
jp messagekeywait

nnscp: ;完全ピボット・ヌル・スペース
ld a,[mustscale]
and a
call nz,nscale

xor a
ld [linearsolvemode],a
nnscp00:
ld [sp_work2],sp
; ;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
call initcharpvph
;
; ;12230 FOR J=0 TO N-2
; mv a,0
xor a
; mv [charj],a
ld [charj],a
nn60:
; ;12240 A=MC(PV(J),PH(J)):B=MP(PV(J),PH(J))
; mv a,[charj]
ld a,[charj]
ld c,a
ld b,0
; mv x,charpv
ld hl,charpv
; add x,a
add hl,bc
; mv y,charph
ld de,charph
; add y,a
ex de,hl
add hl,bc
ex de,hl
; mv a,[x]
ld a,[hl]
; mv [ptr1],a
ld [ptr1],a
; mv a,[y]
ld a,[de]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; pushs i
push bc
; mv x,[ptrmc]
ld hl,matrixc
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err16
jp c,err16
; pops i
pop bc
; mv x,[ptrmp]
ld hl,matrixp
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err16
jp c,err16
; ;:P=A*A+B*B
; call ad
call ad
; jpc err16
jp c,err16
; mv x,[ptrp]
ld hl,floatp
; call xtom
call xtom
;
; ;12250 FOR K=J TO N-1:FOR L=J TO N-1
; mv a,[charj]
ld a,[charj]
; mv [chark],a
ld [chark],a
nn61:
; mv a,[charj]
ld a,[charj]
; mv [charl],a
ld [charl],a
nn62:
; ;12251 A=MC(PV(K),PH(L)):B=MP(PV(K),PH(L))
; mv a,[chark]
ld a,[chark]
; mv x,charpv
ld hl,charpv
; add x,a
ld c,a
ld b,0
add hl,bc
; mv a,[x]
ld a,[hl]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charl]
ld a,[charl]
; mv x,charph
ld hl,charph
; add x,a
ld c,a
add hl,bc
; mv a,[x]
ld a,[hl]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; pushs i
push bc
; mv x,[ptrmc]
ld hl,matrixc
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err16
jp c,err16
; pops i
pop bc
; mv x,[ptrmp]
ld hl,matrixp
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err16
jp c,err16
; ;:PP=A*A+B*B
; call ad
call ad
; jpc err16
jp c,err16
; mv x,fpp
ld hl,fpp
; call xtom
call xtom
; ;12252 IF PP>=P THEN K0=K:L0=L:P=PP
; mv y,fpp
ld de,fpp
; mv x,[ptrp]
ld hl,floatp
; call cp ;PP - P
call fcp
; jrc nn63
jr c,nn63
;
; mv a,[chark]
ld a,[chark]
; mv [chark0],a
ld [chark0],a
; mv a,[charl]
ld a,[charl]
; mv [charl0],a
ld [charl0],a
; mv x,fpp
ld hl,fpp
; mv y,[ptrp]
ld de,floatp
; call mtom
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
ld hl,charl
inc [hl]
ld a,[charn]
cp [hl]
jr nz,nn62
;
; mv a,[chark]
; inc a
; mv [chark],a
; mv il,[charn1]
; sub il,a
; jrnc nn61
ld hl,chark
inc [hl]
ld a,[charn]
cp [hl]
jp nz,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
ld a,[charj]
ld c,a
ld a,[chark0]
cp c
jr z,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
ld b,0
ld hl,charpv
push hl
pop de
add hl,bc ;pv[j]
ex de,hl
ld c,a
add hl,bc ;pv[k0]
ld a,[de]
ld c,[hl]
ex de,hl
ld [de],a
ld [hl],c
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
ld a,[charj]
ld c,a
ld a,[charl0]
cp c
jr z,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
ld b,0
ld hl,charph
push hl
pop de
add hl,bc ;pv[j]
ex de,hl
ld c,a
add hl,bc ;pv[l0]
ld a,[de]
ld c,[hl]
ex de,hl
ld [de],a
ld [hl],c
nn71:
; ;12270 A=MC(PV(J),PH(J)):B=MP(PV(J),PH(J))
; mv a,[charj]
ld a,[charj]
; mv x,charpv
ld hl,charpv
; add x,a
ld c,a
ld b,0
add hl,bc
; mv y,charph
ld de,charph
; add y,a
ex de,hl
add hl,bc
ex de,hl
; mv a,[x]
ld a,[hl]
; mv [ptr1],a
ld [ptr1],a
; mv a,[y]
ld a,[de]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; pushs i
push bc
; mv x,[ptrmc]
ld hl,matrixc
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err16
jp c,err16
; pops i
pop bc
; mv x,[ptrmp]
ld hl,matrixp
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err16
jp c,err16
; ;:P=SQR (A*A+B*B)
; call ad
call ad
; jpc err16
jp c,err16
; call sqr
call sqr
; jpc err16
jp c,err16
; mv x,[ptrp]
ld hl,floatp
; pushs x
push hl
; call xtom
call xtom
; ;12271 IF P<=E1 THEN 12280
; pops x
pop hl
; mv y,[ptre1]
ld de,floate1
; call cp ;E1 - P
call fcp
; jpnc nn12280
jp nc,nn12280
;
; ;12272 FOR K=J+1 TO N-1
; mv a,[charj]
ld a,[charj]
; inc a
inc a
; mv [chark],a
ld [chark],a
nn80:
; ;12273 A=MC(PV(K),PH(J)):B=MP(PV(K),PH(J))
; mv a,[chark]
ld a,[chark]
; mv x,charpv
ld hl,charpv
; add x,a
ld c,a
ld b,0
add hl,bc
; mv a,[x]
ld a,[hl]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charj]
ld a,[charj]
; mv x,charph
ld hl,charph
; add x,a
ld c,a
add hl,bc
; mv a,[x]
ld a,[hl]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmc]
ld hl,matrixc
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmp]
ld hl,matrixp
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; ;:C=MC(PV(J),PH(J)):D=MP(PV(J),PH(J))
; mv a,[charj]
ld a,[charj]
; mv x,charpv
ld hl,charpv
; add x,a
ld c,a
ld b,0
add hl,bc
; mv a,[x]
ld a,[hl]
; mv [ptr1],a
ld [ptr1],a
; call getoffset
call getoffset
; mv x,[ptrmc]
ld hl,matrixc
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmp]
ld hl,matrixp
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
; ;12274 CALL FDIV:C=A:D=B
; call ndiv
call ndiv
; mv x,[ptra]
ld hl,floata
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrb]
ld hl,floatb
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom

ld a,[linearsolvemode]
and a
jr z,nn12275

ld a,[charj]
ld hl,charpv
ld c,a
ld b,0
add hl,bc
ld a,[hl]
ld [ptr1],a
xor a
ld [ptr2],a
call getoffset
ld hl,matrixh
add hl,bc
ld de,floata
call mtom
ld hl,matrixu
add hl,bc
ld de,floatb
call mtom

call nmul

ld a,[chark]
ld hl,charpv
ld c,a
ld b,0
add hl,bc
ld a,[hl]
ld [ptr1],a
call getoffset
ld hl,matrixh
add hl,bc
push bc
push hl
call mtox
ld hl,floata
call mtox
call sb
jp c,err16
pop hl
call xtom
ld hl,matrixu
pop bc
add hl,bc
push hl
call mtox
ld hl,floatb
call mtox
call sb
jp c,err16
pop hl
call xtom
nn12275:
; ;12275 FOR L=J+1 TO N-1
; mv a,[charj]
ld a,[charj]
; inc a
inc a
; mv [charl],a
ld [charl],a
nn81:
; ;12276 A=MC(PV(J),PH(L)):B=MP(PV(J),PH(L)):CALL FMUL
; mv a,[charj]
ld a,[charj]
; mv x,charpv
ld hl,charpv
; add x,a
ld c,a
ld b,0
add hl,bc
; mv a,[x]
ld a,[hl]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charl]
ld a,[charl]
; mv x,charph
ld hl,charph
; add x,a
ld c,a
add hl,bc
; mv a,[x]
ld a,[hl]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmc]
ld hl,matrixc
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmp]
ld hl,matrixp
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; call nmul
call nmul
; ;12277 MC(PV(K),PH(L))=MC(PV(K),PH(L))-A
; mv a,[chark]
ld a,[chark]
; mv x,charpv
ld hl,charpv
; add x,a
ld c,a
ld b,0
add hl,bc
; mv a,[x]
ld a,[hl]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charl]
ld a,[charl]
; mv x,charph
ld hl,charph
; add x,a
ld c,a
add hl,bc
; mv a,[x]
ld a,[hl]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; pushs i
push bc
; mv x,[ptrmc]
ld hl,matrixc
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptra]
ld hl,floata
; call mtox
call mtox
; call sb
call sb
; jpc err16
jp c,err16
; pops x
pop hl
; call xtom
call xtom
; ;12278 MP(PV(K),PH(L))=MP(PV(K),PH(L))-B
; pops i
pop bc
; mv x,[ptrmp]
ld hl,matrixp
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptrb]
ld hl,floatb
; call mtox
call mtox
; call sb
call sb
; jpc err16
jp c,err16
; pops x
pop hl
; call xtom
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
ld hl,charl
inc [hl]
ld a,[charn]
cp [hl]
jp nz,nn81
;
; mv a,[chark]
; inc a
; mv [chark],a
; mv il,[charn1]
; sub il,a
; jpnc nn80
ld hl,chark
inc [hl]
ld a,[charn]
cp [hl]
jp nz,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
ld hl,charj
inc [hl]
ld a,[charn1]
cp [hl]
jp nz,nn60
; ;12290 FL=0
; mv a,0
xor a
; mv [charfl],a
ld [charfl],a
; ;12300 FOR J=N-1 TO 0 STEP -1
; mv a,[charn1]
ld a,[charn1]
; mv [charj],a
ld [charj],a
nn90:
; ;12301 SR=0:SI=0
ld a,[linearsolvemode]
and a
jr z,nn12301

ld a,[charj]
ld hl,charpv
ld c,a
ld b,0
add hl,bc
ld a,[hl]
ld [ptr1],a
xor a
ld [ptr2],a
call getoffset
ld hl,matrixh
add hl,bc
ld de,fsr
call mtom
ld hl,matrixu
add hl,bc
ld de,fsi
call mtom

jr nn12302
nn12301:
; mv x,fsr
ld hl,fsr
; call mv0
call mv0
; mv x,fsi
ld hl,fsi
; call mv0
call mv0
nn12302:
; ;12302 IF J=N-1 THEN 12310
; mv a,[charj]
; mv il,[charn1]
; sub il,a
; jrz nn12310
ld a,[charj]
ld c,a
ld a,[charn1]
cp c
jp z,nn12310
; ;12303 FOR K=N-1 TO J+1 STEP -1
; mv a,[charn1]
; mv [chark],a
ld [chark],a
nn91:
; ;12304 A=MA(PH(K),P3):B=MN(PH(K),P3)
; mv a,[chark]
ld a,[chark]
; mv x,charph
ld hl,charph
; add x,a
ld c,a
ld b,0
add hl,bc
; mv a,[x]
ld a,[hl]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charm]
ld a,[charm]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; ;:C=MC(PV(J),PH(K)):D=MP(PV(J),PH(K))
; mv a,[charj]
ld a,[charj]
; mv x,charpv
ld hl,charpv
; add x,a
ld c,a
ld b,0
add hl,bc
; mv a,[x]
ld a,[hl]
; mv [ptr1],a
ld [ptr1],a
; mv a,[chark]
ld a,[chark]
; mv x,charph
ld hl,charph
; add x,a
ld c,a
add hl,bc
; mv a,[x]
ld a,[hl]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmc]
ld hl,matrixc
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmp]
ld hl,matrixp
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
; ;12305 CALL FMUL:SR=SR-A:SI=SI-B
; call nmul
call nmul
;
; mv x,fsr
ld hl,fsr
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptra]
ld hl,floata
; call mtox
call mtox
; call sb
call sb
; jpc err16
jp c,err16
; pops x
pop hl
; call xtom
call xtom
;
; mv x,fsi
ld hl,fsi
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptrb]
ld hl,floatb
; call mtox
call mtox
; call sb
call sb
; jpc err16
jp c,err16
; pops x
pop hl
; call xtom
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
ld hl,chark
dec [hl]
ld a,[charj]
cp [hl]
jp nz,nn91
nn12310:
; ;12310 P=MC(PV(J),PH(J)):Q=MP(PV(J),PH(J))
; mv a,[charj]
ld a,[charj]
; mv x,charpv
ld hl,charpv
; add x,a
ld c,a
ld b,0
add hl,bc
; mv y,charph
ld de,charph
; add y,a
ex de,hl
add hl,bc
ex de,hl
; mv a,[x]
ld a,[hl]
; mv [ptr1],a
ld [ptr1],a
; mv a,[y]
ld a,[de]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmc]
ld hl,matrixc
; add x,i
add hl,bc
; mv y,[ptrp]
ld de,floatp
; call mtom
call mtom
; mv x,[ptrmp]
ld hl,matrixp
; add x,i
add hl,bc
; mv y,[ptrq]
ld de,floatq
; call mtom
call mtom
;
; ;12311 IF SQR (P*P+Q*Q)>E1 THEN 12320
; mv x,[ptrp]
ld hl,floatp
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err16
jp c,err16
; mv x,[ptrq]
ld hl,floatq
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err16
jp c,err16
; call ad
call ad
; jpc err16
jp c,err16
; call sqr
call sqr
; jpc err16
jp c,err16
; mv x,fcc
ld hl,fcc
; pushs x
push hl
; call xtom
call xtom
; mv y,[ptre1]
ld de,floate1
; pops x
pop hl
; call cp
call fcp
; jrc nn12320
jr c,nn12320
;
; ;12312 IF SQR (SR*SR+SI*SI)>E1 THEN J=-1:NEXT J:WAIT :PRINT "ｶｲｶﾞﾑｹﾞﾝﾀﾞｲﾆﾅﾘﾏｼﾀ.ｹｲｻﾝﾃﾞｷﾏｾﾝ":RETURN
; mv x,fsr
ld hl,fsr
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err16
jp c,err16
; mv x,fsi
ld hl,fsi
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jrc err16
jp c,err16
; call ad
call ad
; jrc err16
jp c,err16
; call sqr
call sqr
; jrc err16
jp c,err16
; mv x,fcc
ld hl,fcc
; pushs x
push hl
; call xtom
call xtom
; mv y,[ptre1]
ld de,floate1
; pops x
pop hl
; call cp
call fcp
; jpc errf0
jp c,errf0
;
; ;12313 MA(PH(J),P3)=1:MN(PH(J),P3)=0:FL=1:GOTO 12330
; mv a,[charj]
ld a,[charj]
; mv x,charph
ld hl,charph
; add x,a
ld c,a
ld b,0
add hl,bc
; mv a,[x]
ld a,[hl]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charm]
ld a,[charm]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc

ld a,[linearsolvemode]
and a
jr z,nnmv1

call mv0
jr nnmvs
nnmv1:
; call mv1
call mv1
nnmvs:
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; call mv0
call mv0
; mv a,1
ld a,1
; mv [charfl],a
ld [charfl],a
; jr nn12330
jr nn12330
nn12320:
; ;12320 A=SR:B=SI:C=P:D=Q:CALL FDIV
; mv x,fsr
ld hl,fsr
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,fsi
ld hl,fsi
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; mv x,[ptrp]
ld hl,floatp
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrq]
ld hl,floatq
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
; call ndiv
call ndiv
; ;12321 MA(PH(J),P3)=A:MN(PH(J),P3)=B
; mv a,[charj]
ld a,[charj]
; mv x,charph
ld hl,charph
; add x,a
ld c,a
ld b,0
add hl,bc
; mv a,[x]
ld a,[hl]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charm]
ld a,[charm]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptra]
ld hl,floata
; mv y,[ptrma]
ld de,matrixa
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
call mtom
; mv x,[ptrb]
ld hl,floatb
; mv y,[ptrmn]
ld de,matrixn
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
call mtom
nn12330:
; ;12330 NEXT J (TO 0 STEP -1, nn90)
; mv a,[charj]
; dec a
; mv [charj],a
; cmp a,0ffh
; jpnz nn90
ld hl,charj
dec [hl]
ld a,-1
cp [hl]
jp nz,nn90
; ;12331 IF FL=0 THEN WAIT :PRINT "ﾇﾙｽﾍﾟ-ｽﾊｱﾘﾏｾﾝ"
; mv a,[charfl]
ld a,[charfl]
; cmp a,0
and a
; jpz errf1
jp z,errf1
; ;12340 RETURN
ret

err16: ld a,16 ;error on nscp
jp err

nscale: ;前置スケーリング（ヌル・スペースの前）
; call findsingle
;
; mv a,'D' --> cに変更
; call findmat00
; mv [ptrmd],x
;
; mv a,'Q' --> pに変更
; call findmat00
; mv [ptrmq],x
;
; ;12400 "MSCALE"
; ;12410 FOR J=0TO N-1
; mv a,0
xor a
; mv [charj],a
ld [charj],a
ns00:
; ;12411 S=0:FOR K=0TO N-1
; mv x,fss
ld hl,fss
; call mv0
call mv0
; mv a,0
xor a
; mv [chark],a
ld [chark],a
ns10:
; ;12412 A=MD(J,K):B=MQ(J,K):T=A*A+B*B
; mv a,[charj]
ld a,[charj]
; mv [ptr1],a
ld [ptr1],a
; mv a,[chark]
ld a,[chark]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; pushs i
push bc
; mv x,[ptrmd] ;c
ld hl,matrixc
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err8
jp c,err8
; pops i
pop bc
; mv x,[ptrmq] ;p
ld hl,matrixp
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jrc err8
jp c,err8
; call ad
call ad
; jrc err8
jp c,err8
; mv x,[ptrt]
ld hl,floatt
; call xtom
call xtom
;
; ;12413 IF T>S THEN S=T
; mv y,fss
ld de,fss
; mv x,[ptrt]
ld hl,floatt
; call cp
call fcp
; jrnc ns11
jr nc,ns11
; mv x,[ptrt]
ld hl,floatt
; mv y,fss
ld de,fss
; call mtom
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
ld hl,chark
inc [hl]
ld a,[charn]
cp [hl]
jr nz,ns10
;
; ;12415 IF S<>0 THEN (ns20)
; mv x,fss
ld hl,fss
; call is0
call is0
; jrz ns20
jr z,ns20
; ;12416 S=1/SQR S:FOR K=0TO N-1
; mv x,[ptra]
ld hl,floata
; pushs x
push hl
; call mv1
call mv1
; pops x
pop hl
; call mtox
call mtox
; mv x,fss
ld hl,fss
; pushs x
push hl
; call mtox
call mtox
; call sqr
call sqr
; jrc err8
jr c,err8
; call div
call div
; jrc err8
jr c,err8
; pops x
pop hl
; call xtom
call xtom
;
; mv a,0
xor a
; mv [chark],a
ld [chark],a
ns30:
; ;12417 MD(J,K)=MD(J,K)*S
; mv a,[charj]
ld a,[charj]
; mv [ptr1],a
ld [ptr1],a
; mv a,[chark]
ld a,[chark]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; pushs i
push bc
; mv x,[ptrmd] ;c
ld hl,matrixc
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,fss
ld hl,fss
; call mtox
call mtox
; call mul
call mul
; jrc err8
jr c,err8
; pops x
pop hl
; call xtom
call xtom
; ;12418 MQ(J,K)=MQ(J,K)*S
; pops i
pop bc
; mv x,[ptrmq] ;p
ld hl,matrixp
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,fss
ld hl,fss
; call mtox
call mtox
; call mul
call mul
; jrc err8
jr c,err8
; pops x
pop hl
; call xtom
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
ld hl,chark
inc [hl]
ld a,[charn]
cp [hl]
jr nz,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
ld hl,charj
inc [hl]
ld a,[charn]
cp [hl]
jp nz,ns00
;
ret

err8: ld a,8 ;error on scale
jp err

nscale2: ;前置スケーリング 2（QR法の前）
; 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]
ld hl,floatq
; call mv0
call mv0
; mv a,0
xor a
; mv [charj],a
ld [charj],a
ns40:
; mv a,0
xor a
; mv [chark],a
ld [chark],a
ns41:
; ;12511 P=MA(J,K)^2+MN(J,K)^2
; mv a,[charj]
ld a,[charj]
; mv [ptr1],a
ld [ptr1],a
; mv a,[chark]
ld a,[chark]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; pushs i
push bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err13
jp c,err13
; pops i
pop bc
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err13
jp c,err13
; call ad
call ad
; jpc err13
jp c,err13
; mv x,[ptrp]
ld hl,floatp
; call xtom
call xtom
;
; ;12512 IF Q<P THEN Q=P
; mv y,[ptrq]
ld de,floatq
; mv x,[ptrp]
ld hl,floatp
; call cp
call fcp
; jrnc ns42
jr nc,ns42
; mv x,[ptrp]
ld hl,floatp
; mv y,[ptrq]
ld de,floatq
; call mtom
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
ld hl,chark
inc [hl]
ld a,[charn]
cp [hl]
jr nz,ns41
;
; mv a,[charj]
; inc a
; mv [charj],a
; mv il,[charn1]
; sub il,a
; jrnc ns40
ld hl,charj
inc [hl]
ld a,[charn]
cp [hl]
jr nz,ns40
;
; ;12520 IF Q>0 THEN
; mv x,[ptrq]
ld hl,floatq
; call is0
call is0
; jrz ns50
jp z,ns50
; ;12521 SC=SQR Q:Q=1/SC
; mv x,[ptrq]
ld hl,floatq
; call mtox
call mtox
; call sqr
call sqr
; jrc err13
jp c,err13
; mv x,[ptrsc]
ld hl,floatsc
; call xtom
call xtom
;
; mv x,[ptrp]
ld hl,floatp
; pushs x
push hl
; call mv1
call mv1
; pops x
pop hl
; call mtox
call mtox
; mv x,[ptrsc]
ld hl,floatsc
; call mtox
call mtox
; call div
call div
; jrc err13
jr c,err13
; mv x,[ptrq]
ld hl,floatq
; call xtom
call xtom
;
; ;12522 FOR J=0TO N-1:FOR K=0TO N-1
; mv a,0
xor a
; mv [charj],a
ld [charj],a
ns60:
; mv a,0
xor a
; mv [chark],a
ld [chark],a
ns61:
; ;12523 MA(J,K)=MA(J,K)*Q
; ;12524 MN(J,K)=MN(J,K)*Q
; mv a,[charj]
ld a,[charj]
; mv [ptr1],a
ld [ptr1],a
; mv a,[chark]
ld a,[chark]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; pushs i
push bc
;
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptrq]
ld hl,floatq
; call mtox
call mtox
; call mul
call mul
; jrc err13
jr c,err13
; pops x
pop hl
; call xtom
call xtom
;
; pops i
pop bc
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptrq]
ld hl,floatq
; call mtox
call mtox
; call mul
call mul
; jrc err13
jr c,err13
; pops x
pop hl
; call xtom
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
ld hl,chark
inc [hl]
ld a,[charn]
cp [hl]
jr nz,ns61
;
; mv a,[charj]
; inc a
; mv [charj],a
; mv il,[charn1]
; sub il,a
; jrnc ns60
ld hl,charj
inc [hl]
ld a,[charn]
cp [hl]
jr nz,ns60
;
; ;12526 ENDIF
ns50:
; ;12530 RETURN

ret

err13: ld a,13 ;error on scale2
jp err

nsfasterrf1:
ld sp,[sp_work2]
scf
ret

nnsfast: ;高速ヌル・スペース cf=status
ld [sp_work2],sp
; 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]
ld a,[charn1]
; mv [charnn],a
ld [charnn],a
; ; v[[nn, j]] = 1;
; mv [ptr1],a
ld [ptr1],a
; mv a,[charm]
ld a,[charm]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; call mv1
call mv1
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; call mv0
call mv0
;
; ; While[nn > 1,
nn100:
; mv a,[charnn]
ld a,[charnn]
; cmp a,0
and a
; jpz nn101
jp z,nn101
; ; nn--;
; dec a
dec a
; mv [charnn],a
ld [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
ld a,[charm]
ld c,a
ld a,[charn]
add a,c
call getoffsetcomplex
;
; mv [inttmp0],i
ld [inttmp0],bc
;
; mv x,[ptrcr]
ld hl,complextmpatof
; add x,i
add hl,bc
; call mtox
call mtox
;
; mv a,[charnn]
ld a,[charnn]
; inc a
inc a
; mv [ptr1],a
ld [ptr1],a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
;
; mv [inttmp1],i
ld [inttmp1],bc
;
; mv x,[ptrmg]
ld hl,matrixg
; add x,i
add hl,bc
; call mtox
call mtox
;
; call sb
call sb
; jpc err18
jp c,err18
;
; mv x,[ptra]
ld hl,floata
; call xtom
call xtom
;
; mv x,[ptrci]
ld hl,complextmpatof+6
; mv i,[inttmp0]
ld bc,[inttmp0]
; add x,i
add hl,bc
; call mtox
call mtox
;
; mv x,[ptrmt]
ld hl,matrixt
; mv i,[inttmp1]
ld bc,[inttmp1]
; add x,i
add hl,bc
; call mtox
call mtox
;
; call sb
call sb
; jpc err18
jp c,err18
;
; mv x,[ptrb]
ld hl,floatb
; call xtom
call xtom
;
; mv a,[charm]
ld a,[charm]
; mv [ptr2],a
ld [ptr2],a
;
; mv a,[charnn]
ld a,[charnn]
; inc a
inc a
; mv [ptr1],a
ld [ptr1],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
;
; call nmul
call nmul
;
; mv a,[charnn]
ld a,[charnn]
; mv [ptr1],a
ld [ptr1],a
; call getoffset
call getoffset
; mv y,[ptrma]
ld de,matrixa
; add y,i
ex de,hl
add hl,bc
ex de,hl
; mv x,[ptra]
ld hl,floata
; call mtom
call mtom
; mv y,[ptrmn]
ld de,matrixn
; add y,i
ex de,hl
add hl,bc
ex de,hl
; mv x,[ptrb]
ld hl,floatb
; call mtom
call mtom
;
; ; For[i = nn + 2, i <= n, i++,
; mv a,[charnn]
ld a,[charnn]
; add a,2
add a,2
; mv [chari],a
ld [chari],a
ld c,a
; mv il,[charn1]
ld a,[charn1]
; sub il,a
; jrc nn111
cp c
jp c,nn111
nn110:
; ; v[[nn, j]] -= v[[i, j]]*a[[nn + 1, i]];
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charm]
ld a,[charm]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
;
; mv a,[charnn]
ld a,[charnn]
; inc a
inc a
; mv [ptr1],a
ld [ptr1],a
; mv a,[chari]
ld a,[chari]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmg]
ld hl,matrixg
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmt]
ld hl,matrixt
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
;
; call nmul
call nmul
;
; mv a,[charnn]
ld a,[charnn]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charm]
ld a,[charm]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp0],i
ld [inttmp0],bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptra]
ld hl,floata
; call mtox
call mtox
; call sb
call sb
; jpc err18
jp c,err18
; pops x
pop hl
; call xtom
call xtom
;
; mv i,[inttmp0]
ld bc,[inttmp0]
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptrb]
ld hl,floatb
; call mtox
call mtox
; call sb
call sb
; jpc err18
jp c,err18
; pops x
pop hl
; call xtom
call xtom
;
; ; ]; (i++, to n-1,nn110)
; mv a,[chari]
; inc a
; mv [chari],a
; mv il,[charn1]
; sub il,a
; jrnc nn110
ld hl,chari
inc [hl]
ld a,[charn]
cp [hl]
jp nz,nn110
nn111:
; ; v[[nn, j]] /= a[[nn + 1, nn]];
; mv a,[charnn]
ld a,[charnn]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charm]
ld a,[charm]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp0],i
ld [inttmp0],bc
;
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
;
; mv a,[charnn]
ld a,[charnn]
; mv [ptr2],a
ld [ptr2],a
; inc a
inc a
; mv [ptr1],a
ld [ptr1],a
; call getoffset
call getoffset
;
; mv x,[ptrmg]
ld hl,matrixg
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmt]
ld hl,matrixt
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
;
; mv x,[ptrc]
ld hl,floatc
; call is0
call is0
; jrnz nn112
jr nz,nn112
; mv x,[ptrd]
ld hl,floatd
; call is0
call is0
; jpz errf1
jp z,nsfasterrf1
nn112:
; call ndiv
call ndiv
;
; mv i,[inttmp0]
ld bc,[inttmp0]
;
; mv y,[ptrma]
ld de,matrixa
; add y,i
ex de,hl
add hl,bc
ex de,hl
; mv x,[ptra]
ld hl,floata
; call mtom
call mtom
; mv y,[ptrmn]
ld de,matrixn
; add y,i
ex de,hl
add hl,bc
ex de,hl
; mv x,[ptrb]
ld hl,floatb
; call mtom
call mtom
; jp nn100
jp nn100
nn101:
; ; ];
;
; ;no = Norm[v[[All, j]]]; If[no != 0, v[[All, j]] /= no, GOTO ERRF1;];
; mv x,fss
ld hl,fss
; call mv0
call mv0
; mv a,[charm]
ld a,[charm]
; mv [ptr2],a
ld [ptr2],a
; mv a,0
xor a
; mv [ptr1],a
ld [ptr1],a
nn200:
; call getoffset
call getoffset
; pushs i
push bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err18
jp c,err18
; pops i
pop bc
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err18
jp c,err18
; mv x,fss
ld hl,fss
; pushs x
push hl
; call mtox
call mtox
; call ad
call ad
; jpc err18
jp c,err18
; call ad
call ad
; jpc err18
jp c,err18
; pops x
pop hl
; call xtom
call xtom
;
; mv a,[ptr1]
; inc a
; mv [ptr1],a
; mv il,[charn1]
; sub il,a
; jrnc nn200
ld hl,ptr1
inc [hl]
ld a,[charn]
cp [hl]
jr nz,nn200
;
; mv x,fss
ld hl,fss
; call is0
call is0
; jpz errf1
jp z,nsfasterrf1
;
; mv x,[ptra]
ld hl,floata
; pushs x
push hl
; call mv1
call mv1
; pops x
pop hl
; call mtox
call mtox
; mv x,fss
ld hl,fss
; pushs x
push hl
; call mtox
call mtox
; call sqr
call sqr
; jpc err18
jp c,err18
; call div
call div
; jpc err18
jp c,err18
; pops x
pop hl
; call xtom
call xtom
;
; mv a,0
xor a
; mv [ptr1],a
ld [ptr1],a
nn202:
; call getoffset
call getoffset
; pushs i
push bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,fss
ld hl,fss
; call mtox
call mtox
; call mul
call mul
; jpc err18
jp c,err18
; pops x
pop hl
; call xtom
call xtom
; pops i
pop bc
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,fss
ld hl,fss
; call mtox
call mtox
; call mul
call mul
; jpc err18
jp c,err18
; pops x
pop hl
; call xtom
call xtom
;
; mv a,[ptr1]
; inc a
; mv [ptr1],a
; mv il,[charn1]
; sub il,a
; jrnc nn202
ld hl,ptr1
inc [hl]
ld a,[charn]
cp [hl]
jr nz,nn202
;
; ;no = 0; For[i = 1, i <= n, i++,
; mv x,fd1r
ld hl,fd1r
; call mv0
call mv0
; mv x,fd1i
ld hl,fd1i
; call mv0
call mv0
; mv a,0
xor a
; mv [chari],a
ld [chari],a
nn210:
; ; no += v[[i, j]]*If[i == 1, a[[1, i]] - e[[j]], a[[1, i]]];
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charm]
ld a,[charm]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
;
; mv a,0
xor a
; mv [ptr1],a
ld [ptr1],a
; mv a,[chari]
ld a,[chari]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmg]
ld hl,matrixg
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmt]
ld hl,matrixt
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
;
; mv a,[chari]
ld a,[chari]
; cmp a,0
and a
; jrnz nn211
jr nz,nn211
;
; mv x,[ptrc]
ld hl,floatc
; pushs x
push hl
; call mtox
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
ld a,[charm]
ld c,a
ld a,[charn]
add a,c
call getoffsetcomplex
;
; mv [inttmp0],i
ld [inttmp0],bc
;
; mv x,[ptrcr]
ld hl,complextmpatof
; add x,i
add hl,bc
; call mtox
call mtox
; call sb
call sb
; jpc err18
jp c,err18
;
; pops x
pop hl
; call xtom
call xtom
;
; mv x,[ptrd]
ld hl,floatd
; pushs x
push hl
; call mtox
call mtox
; mv i,[inttmp0]
ld bc,[inttmp0]
; mv x,[ptrci]
ld hl,complextmpatof+6
; add x,i
add hl,bc
; call mtox
call mtox
; call sb
call sb
; jpc err18
jp c,err18
; pops x
pop hl
; call xtom
call xtom
nn211:
; call nmul
call nmul
;
; mv x,fd1r
ld hl,fd1r
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptra]
ld hl,floata
; call mtox
call mtox
; call ad
call ad
; jpc err18
jp c,err18
; pops x
pop hl
; call xtom
call xtom
;
; mv x,fd1i
ld hl,fd1i
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptrb]
ld hl,floatb
; call mtox
call mtox
; call ad
call ad
; jpc err18
jp c,err18
; pops x
pop hl
; call xtom
call xtom
;
; ; ]; (i++, to n-1,nn210)
; mv a,[chari]
; inc a
; mv [chari],a
; mv il,[charn1]
; sub il,a
; jpnc nn210
ld hl,chari
inc [hl]
ld a,[charn]
cp [hl]
jp nz,nn210
;
; ;If[Abs[no] < eps,
; mv x,fd1r
ld hl,fd1r
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err18
jp c,err18
; mv x,fd1i
ld hl,fd1i
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err18
jp c,err18
; call ad
call ad
; jpc err18
jp c,err18
; call sqr
call sqr
; jpc err18
jp c,err18
; mv x,fss
ld hl,fss
; pushs x
push hl
; call xtom
call xtom
; pops y
pop de
; mv x,[ptre4]
ld hl,floate4
; call cp ;Abs[no] - eps
call fcp
; jpnc errf1
jp nc,nsfasterrf1
;
; ; v[[All, charm]] = qh[[2]].v[[All, charm]];
; mv a,0
xor a
; mv [charj],a
ld [charj],a
nn220:
; mv x,fd1r
ld hl,fd1r
; call mv0
call mv0
; mv x,fd1i
ld hl,fd1i
; call mv0
call mv0
; mv a,0
xor a
; mv [chark],a
ld [chark],a
nn221:
; mv a,[charj]
ld a,[charj]
; mv [ptr1],a
ld [ptr1],a
; mv a,[chark]
ld a,[chark]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmf]
ld hl,matrixf
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrms]
ld hl,matrixs
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
;
; mv a,[chark]
ld a,[chark]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charm]
ld a,[charm]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
;
; call nmul
call nmul
;
; mv x,fd1r
ld hl,fd1r
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptra]
ld hl,floata
; call mtox
call mtox
; call ad
call ad
; jpc err18
jp c,err18
; pops x
pop hl
; call xtom
call xtom
;
; mv x,fd1i
ld hl,fd1i
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptrb]
ld hl,floatb
; call mtox
call mtox
; call ad
call ad
; jrc err18
jp c,err18
; pops x
pop hl
; call xtom
call xtom
;
; mv a,[chark]
; inc a
; mv [chark],a
; mv il,[charn1]
; sub il,a
; jrnc nn221
ld hl,chark
inc [hl]
ld a,[charn]
cp [hl]
jp nz,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
ld a,[charn]
ld c,a
ld a,[charj]
add a,c
add a,c
call getoffsetcomplex
;
; mv y,[ptrcr]
ld de,complextmpatof
; add y,i
ex de,hl
add hl,bc
ex de,hl
; mv x,fd1r
ld hl,fd1r
; call mtom
call mtom
;
; mv y,[ptrci]
ld de,complextmpatof+6
; add y,i
ex de,hl
add hl,bc
ex de,hl
; mv x,fd1i
ld hl,fd1i
; call mtom
call mtom
;
; mv a,[charj]
; inc a
; mv [charj],a
; mv il,[charn1]
; sub il,a
; jrnc nn220
ld hl,charj
inc [hl]
ld a,[charn]
cp [hl]
jp nz,nn220
;
; mv a,[charm]
ld a,[charm]
; mv [ptr2],a
ld [ptr2],a
; mv a,0
xor a
; mv [ptr1],a
ld [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
ld a,[charn]
ld c,a
ld a,[ptr1]
add a,c
add a,c
call getoffsetcomplex
;
; mv [inttmp0],i
ld [inttmp0],bc
;
; mv x,[ptrcr]
ld hl,complextmpatof
; add x,i
add hl,bc
;
; pushs x
push hl
;
; call getoffset
call getoffset
;
; mv [inttmp1],i
ld [inttmp1],bc
;
; mv y,[ptrma]
ld de,matrixa
; add y,i
ex de,hl
add hl,bc
ex de,hl
;
; pops x
pop hl
;
; call mtom
call mtom
;
; mv i,[inttmp0]
ld bc,[inttmp0]
; mv x,[ptrci]
ld hl,complextmpatof+6
; add x,i
add hl,bc
; mv i,[inttmp1]
ld bc,[inttmp1]
; mv y,[ptrmn]
ld de,matrixn
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
call mtom
;
; mv a,[ptr1]
; inc a
; mv [ptr1],a
; mv il,[charn1]
; sub il,a
; jrnc nn230
ld hl,ptr1
inc [hl]
ld a,[charn]
cp [hl]
jr nz,nn230
;
and a
ret ;cf=0

err18: ld a,18 ;error on nsfast
jp err

nhhmsg00: db 'ﾊｳｽﾎﾙﾀﾞ-ﾍﾝｶﾝｼﾃｲﾏｽ',13
nhhmsg01: db 'ﾍﾝｶﾝｶﾞｶﾝﾘｮｳｼﾏｼﾀ',13
nhhmsg02: db 'ｺﾉﾚﾂﾊｽﾃﾞﾆﾍｯｾﾝﾍﾞﾙｸﾞｶﾞﾀﾆﾅｯﾃｲﾏｽ',13

matrixhh: ;ハウスホルダー変換
ld a,[charn]
cp 3
jp c,err30
;
;7220 "MHH"
;7221 WAIT 0:PRINT "ﾊｳｽﾎﾙﾀﾞ-ﾍﾝｶﾝｼﾃｲﾏｽ";
;7222 POKE RESULT,0:CALL FHH:GOSUB *ERRCHK
;7223 PRINT "ﾍﾝｶﾝｶﾞｶﾝﾘｮｳｼﾏｼﾀ":RETURN

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 "ﾊｳｽﾎﾙﾀﾞ-ﾍﾝｶﾝｼﾃｲﾏｽ";

ld hl,nhhmsg00
call message
;
;;qh の領域は MF, MS に取る。
;
;;qh=I

; mv a,0
; mv [ptr1],a
xor a
ld [ptr1],a
nh100:
; mv a,0
; mv [ptr2],a
xor a
ld [ptr2],a
nh110:
; call getoffset
call getoffset
; mv x,[ptrms]
ld hl,matrixs
; add x,i
add hl,bc
; call mv0
call mv0
; mv x,[ptrmf]
ld hl,matrixf
; add x,i
add hl,bc
; mv a,[ptr1]
; mv il,[ptr2]
; sub il,a
; jrz nh111
ld a,[ptr1]
ld e,a
ld a,[ptr2]
cp e
jr z,nh111
; call mv0
; jr nh112
call mv0
jr nh112
nh111:
; call mv1
call mv1
nh112:
; mv a,[ptr2]
; inc a
; mv [ptr2],a
; mv il,[charn1]
; sub il,a
; jrnc nh110
ld hl,ptr2
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jr nz,nh110

;
; mv a,[ptr1]
; inc a
; mv [ptr1],a
; mv il,[charn1]
; sub il,a
; jrnc nh100
ld hl,ptr1
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jr nz,nh100

;
; ;7230 FOR K=0TO N-3
; mv a,0
; mv [chark],a
xor a
ld [chark],a
nh00:
; ;7231 PRINT ".";
; call printdot
call printdot
;
; ;7240 FOR I=0TO K
; mv a,0
; mv [chari],a
xor a
ld [chari],a
nh01:
; ;7241 MB(I,0)=0:MO(I,0)=0
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,0
xor a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; call mv0
call mv0
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; call mv0
call mv0
; ;7242 NEXT I
; mv a,[chari]
; inc a
; mv [chari],a
; mv il,[chark]
; sub il,a
; jrnc nh01
ld hl,chari
inc [hl]
ld a,[chark]
cp [hl]
jr nc,nh01

;
; ;7243 FOR I=K+1TO N-1
; mv a,[chark]
ld a,[chark]
; inc a
inc a
; mv [chari],a
ld [chari],a
nh02:
; ;7244 MB(I,0)=MA(I,K)
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,[chark]
ld a,[chark]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp0],i
ld [inttmp0],bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; pushs x
push hl
; mv a,0
xor a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp1],i
ld [inttmp1],bc
; mv y,[ptrmb]
ld de,matrixb
; add y,i
ex de,hl
add hl,bc
ex de,hl
; pops x
pop hl
; call mtom
call mtom
; ;7245 MO(I,0)=MN(I,K)
; mv x,[ptrmn]
ld hl,matrixn
; mv i,[inttmp0]
ld bc,[inttmp0]
; add x,i
add hl,bc
; mv y,[ptrmo]
ld de,matrixo
; mv i,[inttmp1]
ld bc,[inttmp1]
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
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
ld hl,chari
inc [hl]
ld a,[charn]
cp [hl]
jr nz,nh02

; ;7250 D=MO(K+1,0)
; mv a,[chark]
ld a,[chark]
; inc a
inc a
; mv [ptr1],a
ld [ptr1],a
; mv a,0
xor a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp0],i
ld [inttmp0],bc
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
; ;7251 IF ABS D>E3 THEN
; mv x,[ptrd]
ld hl,floatd
; mv y,[ptrf]
ld de,floatf
; pushs y
push de
; call mtom
call mtom
; pops x
pop hl
; mv a,0
xor a
; mv [x],a
ld [hl],a
; mv y,[ptre3]
ld de,floate3
; call cp ;E3 - ABS D
call fcp
; jrnc nh7255
jp nc,nh7255
;
; ;7252 C=MB(K+1,0):A=1:B=0:CALL FDIV:C=A:D=B
; mv x,[ptrmb]
ld hl,matrixb
; mv i,[inttmp0]
ld bc,[inttmp0]
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptra]
ld hl,floata
; call mv1
call mv1
; mv x,[ptrb]
ld hl,floatb
; call mv0
call mv0
; call ndiv
call ndiv
; mv x,[ptra]
ld hl,floata
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrb]
ld hl,floatb
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
; ;FOR I=K+1TO N-1
; mv a,[chark]
ld a,[chark]
; inc a
inc a
; mv [chari],a
ld [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]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,0
xor a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp0],i
ld [inttmp0],bc
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; call nmul
call nmul
; mv x,[ptra]
ld hl,floata
; mv y,[ptrmb]
ld de,matrixb
; mv i,[inttmp0]
ld bc,[inttmp0]
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
call mtom
; mv x,[ptrb]
ld hl,floatb
; mv y,[ptrmo]
ld de,matrixo
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
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
ld hl,chari
inc [hl]
ld a,[charn]
cp [hl]
jr nz,nh03

; ;7255 ENDIF
nh7255:
; ;7260 SS=0:FOR I=K+2TO N-1
; mv x,fss
ld hl,fss
; call mv0
call mv0
; mv a,[chark]
ld a,[chark]
; add a,2
add a,2
; mv [chari],a
ld [chari],a
nh04:
; ;7261 A=MB(I,0):B=MO(I,0):SS=SS+A*A+B*B
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,0
xor a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; pushs i
push bc
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err7
jp c,err7
; pops i
pop bc
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err7
jp c,err7
; call ad
call ad
; jpc err7
jp c,err7
; mv x,fss
ld hl,fss
; call mtox
call mtox
; call ad
call ad
; jpc err7
jp c,err7
; mv x,fss
ld hl,fss
; call xtom
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
ld hl,chari
inc [hl]
ld a,[charn]
cp [hl]
jr nz,nh04

; ;7270 IF SS=0THEN 7320
; mv x,fss
ld hl,fss
; call is0
call is0
; jpz nh7320 ;この列はすでにヘッセンベルグ型になっています
jp nz,nh7271
call crlf
ld hl,nhhmsg02
call message
call crlf
jp nh7320
nh7271:
; ;7271 A=MB(K+1,0):S=SQR (SS+A*A)
; mv a,[chark]
ld a,[chark]
; inc a
inc a
; mv [ptr1],a
ld [ptr1],a
; mv a,0
xor a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; pushs i
push bc
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptra]
ld hl,floata
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err7
jp c,err7
; mv x,fss
ld hl,fss
; call mtox
call mtox
; call ad
call ad
; jpc err7
jp c,err7
; call sqr
call sqr
; jpc err7
jp c,err7
; mv x,[ptrs]
ld hl,floats
; call xtom
call xtom
; ;7272 IF A>=0THEN S=-S
; mv x,[ptra]
ld hl,floata
; mv a,[x]
ld a,[hl]
; cmp a,8
cp 128
; jrz nh7273
jr z,nh7273
; mv x,[ptrs]
ld hl,floats
; call chs
call chs
nh7273:
; ;7273 A=A-S:MB(K+1,0)=A
; mv x,[ptra]
ld hl,floata
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptrs]
ld hl,floats
; call mtox
call mtox
; call sb
call sb
; jpc err7
jp c,err7
; pops x
pop hl
; call xtom
call xtom
; mv x,[ptra]
ld hl,floata
; mv y,[ptrmb]
ld de,matrixb
; pops i
pop bc
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
call mtom
; ;7274 UN=SQR (SS+A*A)
; mv x,[ptra]
ld hl,floata
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err7
jp c,err7
; mv x,fss
ld hl,fss
; call mtox
call mtox
; call ad
call ad
; jpc err7
jp c,err7
; call sqr
call sqr
; jpc err7
jp c,err7
; mv x,fun
ld hl,fun
; call xtom
call xtom
; ;7275 FOR I=K+1TO N-1
; mv a,[chark]
ld a,[chark]
; inc a
inc a
; mv [chari],a
ld [chari],a
nh05:
; ;7276 MB(I,0)=MB(I,0)/UN
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,0
xor a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; pushs i
push bc
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,fun
ld hl,fun
; call mtox
call mtox
; call div
call div
; jpc err7
jp c,err7
; pops x
pop hl
; call xtom
call xtom
; ;7277 MO(I,0)=MO(I,0)/UN
; pops i
pop bc
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,fun
ld hl,fun
; call mtox
call mtox
; call div
call div
; jpc err7
jp c,err7
; pops x
pop hl
; call xtom
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
ld hl,chari
inc [hl]
ld a,[charn]
cp [hl]
jr nz,nh05

; ;7280 FOR I=0TO N-1
; mv a,0
xor a
; mv [chari],a
ld [chari],a
nh10:
; ;7281 D1R=0:D1I=0:D2R=0:D2I=0
call nhhldd12zero

; ;7282 FOR J=K+1TO N-1
; mv a,[chark]
ld a,[chark]
; inc a
inc a
; mv [charj],a
ld [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]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charj]
ld a,[charj]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
;
; mv a,[charj]
ld a,[charj]
; mv [ptr1],a
ld [ptr1],a
; mv a,0
xor a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
;
; call nmul
call nmul
; ;7284 D1R=D1R+A:D1I=D1I+B
call nhhaddd1riab

; ;7285 A=MA(J,I):B=-MN(J,I):CALL FMUL
; mv a,[charj]
ld a,[charj]
; mv [ptr1],a
ld [ptr1],a
; mv a,[chari]
ld a,[chari]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; pushs y
push de
; call mtom
call mtom
; pops x
pop hl
; call chs
call chs
; call nmul
call nmul
; ;7286 D2R=D2R+A:D2I=D2I+B
call nhhaddd2riab

; ;7287 NEXT J (TO N-1, nh11)
; mv a,[charj]
; inc a
; mv [charj],a
; mv il,[charn1]
; sub il,a
; jpnc nh11
ld hl,charj
inc [hl]
ld a,[charn]
cp [hl]
jp nz,nh11

; ;7288 MB(I,1)=D1R:MO(I,1)=D1I
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,1
ld a,1
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,fd1r
ld hl,fd1r
; mv y,[ptrmb]
ld de,matrixb
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
call mtom
; mv x,fd1i
ld hl,fd1i
; mv y,[ptrmo]
ld de,matrixo
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
call mtom
; ;7289 MB(I,2)=D2R:MO(I,2)=D2I
; mv a,2
ld a,2
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,fd2r
ld hl,fd2r
; mv y,[ptrmb]
ld de,matrixb
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
call mtom
; mv x,fd2i
ld hl,fd2i
; mv y,[ptrmo]
ld de,matrixo
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
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
ld hl,chari
inc [hl]
ld a,[charn]
cp [hl]
jp nz,nh10

; ;7291 D1R=0:D1I=0:D2R=0:D2I=0
call nhhldd12zero

; ;7292 FOR I=K+1TO N-1
; mv a,[chark]
ld a,[chark]
; inc a
inc a
; mv [chari],a
ld [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]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,1
ld a,1
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
;
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,0
xor a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; pushs y
push de
; call mtom
call mtom
; pops x
pop hl
; call chs
call chs
;
; call nmul
call nmul

; ;7294 D1R=D1R+A:D1I=D1I+B
call nhhaddd1riab

; ;7295 A=MB(I,2):B=MO(I,2):CALL FMUL
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,2
ld a,2
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; call nmul
call nmul

; ;7296 D2R=D2R+A:D2I=D2I+B
call nhhaddd2riab

; ;7297 NEXT I (TO N-1, nh20)
; mv a,[chari]
; inc a
; mv [chari],a
; mv il,[charn1]
; sub il,a
; jpnc nh20
ld hl,chari
inc [hl]
ld a,[charn]
cp [hl]
jr nz,nh20

; ;7300 FOR I=0TO N-1
; mv a,0
xor a
; mv [chari],a
ld [chari],a
nh30:
; ;7301 C=MB(I,0):D=MO(I,0)
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,0
xor a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom

; ;7302 A=D1R:B=D1I:CALL FMUL
; mv x,fd1r
ld hl,fd1r
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,fd1i
ld hl,fd1i
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; call nmul
call nmul

; ;7303 MB(I,1)=2*(MB(I,1)-A)
; mv a,1
ld a,1
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; pushs i
push bc
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptra]
ld hl,floata
; call mtox
call mtox
; call sb
call sb
; jpc err7
jp c,err7
; pops x
pop hl
; pushs x
push hl
; call xtom
call xtom
; pops x
pop hl
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; pushs x
push hl
; call mtox
call mtox
; call ad
call ad
; jpc err7
jp c,err7
; pops x
pop hl
; call xtom
call xtom

; ;7304 MO(I,1)=2*(MO(I,1)-B)
; pops i
pop bc
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptrb]
ld hl,floatb
; call mtox
call mtox
; call sb
call sb
; jpc err7
jp c,err7
; pops x
pop hl
; pushs x
push hl
; call xtom
call xtom
; pops x
pop hl
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; pushs x
push hl
; call mtox
call mtox
; call ad
call ad
; jpc err7
jp c,err7
; pops x
pop hl
; call xtom
call xtom

; ;7305 A=D2R:B=D2I:CALL FMUL
; mv x,fd2r
ld hl,fd2r
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,fd2i
ld hl,fd2i
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; call nmul
call nmul

; ;7306 MB(I,2)=2*(MB(I,2)-A)
; mv a,2
ld a,2
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; pushs i
push bc
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptra]
ld hl,floata
; call mtox
call mtox
; call sb
call sb
; jpc err7
jp c,err7
; pops x
pop hl
; pushs x
push hl
; call xtom
call xtom
; pops x
pop hl
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; pushs x
push hl
; call mtox
call mtox
; call ad
call ad
; jpc err7
jp c,err7
; pops x
pop hl
; call xtom
call xtom

; ;7307 MO(I,2)=2*(MO(I,2)-B)
; pops i
pop bc
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptrb]
ld hl,floatb
; call mtox
call mtox
; call sb
call sb
; jpc err7
jp c,err7
; pops x
pop hl
; pushs x
push hl
; call xtom
call xtom
; pops x
pop hl
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; pushs x
push hl
; call mtox
call mtox
; call ad
call ad
; jpc err7
jp c,err7
; pops x
pop hl
; call xtom
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
ld hl,chari
inc [hl]
ld a,[charn]
cp [hl]
jp nz,nh30

; ;7310 FOR I=0TO N-1:FOR J=0TO N-1
; mv a,0
xor a
; mv [chari],a
ld [chari],a
nh40:
; mv a,0
xor a
; mv [charj],a
ld [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]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,0
xor a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
;
; mv a,[charj]
ld a,[charj]
; mv [ptr1],a
ld [ptr1],a
; mv a,2
ld a,2
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; pushs y
push de
; call mtom
call mtom
; pops x
pop hl
; call chs
call chs
;
; call nmul
call nmul

; ;7312 P=A:Q=B
; mv x,[ptra]
; mv y,[ptrp]
; call mtom
; mv x,[ptrb]
; mv y,[ptrq]
; call mtom
call ldpaldqb

; ;7313 A=MB(I,1):B=MO(I,1):C=MB(J,0):D=-MO(J,0):CALL FMUL
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,1
ld a,1
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
;
; mv a,[charj]
ld a,[charj]
; mv [ptr1],a
ld [ptr1],a
; mv a,0
xor a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; pushs y
push de
; call mtom
call mtom
; pops x
pop hl
; call chs
call chs
;
; call nmul
call nmul
; ;7314 MA(I,J)=MA(I,J)-P-A
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charj]
ld a,[charj]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; pushs i
push bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptrp]
ld hl,floatp
; call mtox
call mtox
; call sb
call sb
; jpc err7
jp c,err7
; mv x,[ptra]
ld hl,floata
; call mtox
call mtox
; call sb
call sb
; jpc err7
jp c,err7
; pops x
pop hl
; call xtom
call xtom

; ;7315 MN(I,J)=MN(I,J)-Q-B
; pops i
pop bc
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptrq]
ld hl,floatq
; call mtox
call mtox
; call sb
call sb
; jpc err7
jp c,err7
; mv x,[ptrb]
ld hl,floatb
; call mtox
call mtox
; call sb
call sb
; jpc err7
jp c,err7
; pops x
pop hl
; call xtom
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
ld hl,charj
inc [hl]
ld a,[charn]
cp [hl]
jp nz,nh41
;
; mv a,[chari]
; inc a
; mv [chari],a
; mv il,[charn1]
; sub il,a
; jpnc nh40
ld hl,chari
inc [hl]
ld a,[charn]
cp [hl]
jp nz,nh40
;
; ;qh の領域は MF, MS に取る。
; For[i = 1, i ? n, i++, ←　新たに付け加えた「qh *= q」
; mv a,0
xor a
; mv [chari],a
ld [chari],a
nh200:
; ; d3 = 0;
; mv x,fd1r
ld hl,fd1r
; call mv0
call mv0
; mv x,fd1i
ld hl,fd1i
; call mv0
call mv0
; ; For[j = k + 1, j ? n, j++,
; mv a,[chark]
ld a,[chark]
; inc a
inc a
; mv [charj],a
ld [charj],a
nh210:
; d3 += qh[[i, j]]*u[[j]] --> u[[j]]=MB(j,0), MO(j,0);
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charj]
ld a,[charj]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmf]
ld hl,matrixf
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrms]
ld hl,matrixs
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
;
; mv a,[charj]
ld a,[charj]
; mv [ptr1],a
ld [ptr1],a
; mv a,0
xor a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
;
; call nmul
call nmul
;
call nhhaddd1riab
;
; ; ]; (j++, to n-1, nh210)
; mv a,[charj]
; inc a
; mv [charj],a
; mv il,[charn1]
; sub il,a
; jrnc nh210
ld hl,charj
inc [hl]
ld a,[charn]
cp [hl]
jr nz,nh210
;
; ; For[j = k + 1, j ? n, j++,
; mv a,[chark]
ld a,[chark]
; inc a
inc a
; mv [charj],a
ld [charj],a
nh220:
; qh[[i, j]] -= (2*Conjugate[u[[j]]]*d3) --> u[[j]]=MB(j,0), MO(j,0);
; mv a,[charj]
ld a,[charj]
; mv [ptr1],a
ld [ptr1],a
; mv a,0
xor a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; pushs y
push de
; call mtom
call mtom
; pops x
pop hl
; call chs
call chs
; mv x,fd1r
ld hl,fd1r
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,fd1i
ld hl,fd1i
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
; call nmul
call nmul
;
; mv x,[ptra]
ld hl,floata
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; pushs x
push hl
; call mtox
call mtox
; call ad
call ad
; jrc err7
jp c,err7
; pops x
pop hl
; call xtom
call xtom
;
; mv x,[ptrb]
ld hl,floatb
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; pushs x
push hl
; call mtox
call mtox
; call ad
call ad
; jrc err7
jp c,err7
; pops x
pop hl
; call xtom
call xtom
;
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charj]
ld a,[charj]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; pushs i
push bc
;
; mv x,[ptrmf]
ld hl,matrixf
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptra]
ld hl,floata
; call mtox
call mtox
; call sb
call sb
; jrc err7
jp c,err7
; pops x
pop hl
; call xtom
call xtom
;
; pops i
pop bc
;
; mv x,[ptrms]
ld hl,matrixs
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptrb]
ld hl,floatb
; call mtox
call mtox
; call sb
call sb
; jrc err7
jp c,err7
; pops x
pop hl
; call xtom
call xtom
;
; ; ]; (j++, to n-1, nh220)
; mv a,[charj]
; inc a
; mv [charj],a
; mv il,[charn1]
; sub il,a
; jrnc nh220
ld hl,charj
inc [hl]
ld a,[charn]
cp [hl]
jp nz,nh220
;
; ; ]; (i++, to n-1, nh200)
; mv a,[chari]
; inc a
; mv [chari],a
; mv il,[charn1]
; sub il,a
; jpnc nh200
ld hl,chari
inc [hl]
ld a,[charn]
cp [hl]
jp nz,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
ld hl,chark
inc [hl]
ld a,[charn2]
cp [hl]
jp nz,nh00

ld hl,nhhmsg01
call message
call crlf
;
; 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
;
;matrix g = matrix a, matrix t = matrix n
ld b,6
xor a
jp atobmatrix

nhhldd12zero:
; mv x,fd1r
ld hl,fd1r
; call mv0
call mv0
; mv x,fd1i
ld hl,fd1i
; call mv0
call mv0
; mv x,fd2r
ld hl,fd2r
; call mv0
call mv0
; mv x,fd2i
ld hl,fd2i
; call mv0
jp mv0

nhhaddd2riab:
; mv x,fd2r
ld hl,fd2r
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptra]
ld hl,floata
; call mtox
call mtox
; call ad
call ad
; jpc err7
jp c,err7
; pops x
pop hl
; call xtom
call xtom
;
; mv x,fd2i
ld hl,fd2i
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptrb]
ld hl,floatb
; call mtox
call mtox
; call ad
call ad
; jpc err7
jp c,err7
; pops x
pop hl
; call xtom
jp xtom

nhhaddd1riab:
; mv x,fd1r
ld hl,fd1r
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptra]
ld hl,floata
; call mtox
call mtox
; call ad
call ad
; jpc err7
jp c,err7
; pops x
pop hl
; call xtom
call xtom
;
; mv x,fd1i
ld hl,fd1i
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptrb]
ld hl,floatb
; call mtox
call mtox
; call ad
call ad
; jpc err7
jp c,err7
; pops x
pop hl
; call xtom
jp xtom

err7: ld a,7 ;error on hh
jp err

printdot:
call breaky
jr z,printdot00
ld a,'.'
jp pcha
printdot00:
ld hl,breakmsg
call message
printdot01:
call breaky
jr z,printdot01

ld a,32
jp err ;break

breakmsg: db 'break...',13

mul4: ;[hl]=[hl]*4, cf=status
push hl
call mul2
pop hl
ret c
jp mul2

ldculddv: ;c=u, d=v
ld hl,floatu
ld de,floatc
call mtom
ld hl,floatv
ld de,floatd
jp mtom

matrixeigen: ;[matrixa,n]の固有値、固有ベクトルを求める
;[matrixa,n]=固有ベクトル
;[complextmpatof~]=固有値
;7100 "MEIGEN"
;7110 IF N>2THEN "MQR"
ld a,[charn]
cp 3
jp nc,matrixqr
;7115 IF MA(1,0)=0THEN IF MN(1,0)=0THEN 7150
ld hl,matrixa+(1*matrixsize+0)*6+1
ld a,[hl]
ld hl,matrixn+(1*matrixsize+0)*6+1
or [hl]
jp z,maei7150

;7120 A=MA(0,0)-MA(1,1):B=MN(0,0)-MN(1,1):
ld hl,matrixa+(0*matrixsize+0)*6
call mtox
ld hl,matrixa+(1*matrixsize+1)*6
call mtox
call sb
jp c,err25
ld hl,floata
push hl
call xtom

ld hl,matrixn+(0*matrixsize+0)*6
call mtox
ld hl,matrixn+(1*matrixsize+1)*6
call mtox
call sb
jp c,err25
ld hl,floatb
push hl
call xtom

;GOSUB "CSQU":P=A:Q=B
pop hl ;b
ld de,floatd
call mtom
pop hl ;a
ld de,floatc
call mtom
call nmul

call ldpaldqb

;7121 A=MA(0,1):B=MN(0,1):C=MA(1,0):D=MN(1,0):CALL FMUL
ld hl,matrixa+(0*matrixsize+1)*6
ld de,floata
call mtom
ld hl,matrixn+(0*matrixsize+1)*6
ld de,floatb
call mtom
ld hl,matrixa+(1*matrixsize+0)*6
ld de,floatc
call mtom
ld hl,matrixn+(1*matrixsize+0)*6
ld de,floatd
call mtom
call nmul

;7122 A=4*A+P:B=4*B+Q:
ld hl,floata
push hl
call mul4
jp c,err2
pop hl
push hl
call mtox
ld hl,floatp
call mtox
call ad
jp c,err24
pop hl
call xtom

ld hl,floatb
push hl
call mul4
jp c,err2
pop hl
push hl
call mtox
ld hl,floatq
call mtox
call ad
jp c,err24
pop hl
call xtom

;GOSUB "CSQR":P=A:Q=B
call nsqr
call ldpaldqb

;7123 R=MA(0,0)+MA(1,1):S=MN(0,0)+MN(1,1)
ld hl,matrixa+(0*matrixsize+0)*6
call mtox
ld hl,matrixa+(1*matrixsize+1)*6
call mtox
call ad
jp c,err24
ld hl,floatr
call xtom

ld hl,matrixn+(0*matrixsize+0)*6
call mtox
ld hl,matrixn+(1*matrixsize+1)*6
call mtox
call ad
jp c,err24
ld hl,floats
call xtom

;7124 CR(0)=(R-P)/2
ld hl,floatr
call mtox
ld hl,floatp
call mtox
call sb
jp c,err25
ld hl,complextmpatof+0*12+0*6
push hl
call xtom
pop hl
call fatn30 ;[hl]/2
;7125 CI(0)=(S-Q)/2
ld hl,floats
call mtox
ld hl,floatq
call mtox
call sb
jp c,err25
ld hl,complextmpatof+0*12+1*6
push hl
call xtom
pop hl
call fatn30 ;[hl]/2
;7126 CR(1)=(R+P)/2
ld hl,floatr
call mtox
ld hl,floatp
call mtox
call ad
jp c,err24
ld hl,complextmpatof+1*12+0*6
push hl
call xtom
pop hl
call fatn30 ;[hl]/2
;7127 CI(1)=(S+Q)/2
ld hl,floats
call mtox
ld hl,floatq
call mtox
call ad
jp c,err24
ld hl,complextmpatof+1*12+1*6
push hl
call xtom
pop hl
call fatn30 ;[hl]/2
;7130 R=MA(0,0)-MA(1,1):S=MN(0,0)-MN(1,1)
ld hl,matrixa+(0*matrixsize+0)*6
call mtox
ld hl,matrixa+(1*matrixsize+1)*6
call mtox
call sb
jp c,err25
ld hl,floatr
call xtom

ld hl,matrixn+(0*matrixsize+0)*6
call mtox
ld hl,matrixn+(1*matrixsize+1)*6
call mtox
call sb
jp c,err25
ld hl,floats
call xtom

;7131 U=2*MA(1,0):V=2*MN(1,0)
ld hl,matrixa+(1*matrixsize+0)*6
ld de,floatu
push de
call mtom
pop hl
call mul2
jp c,err2

ld hl,matrixn+(1*matrixsize+0)*6
ld de,floatv
push de
call mtom
pop hl
call mul2
jp c,err2

;7132 A=R-P:B=S-Q:C=U:D=V:CALL FDIV
ld hl,floatr
call mtox
ld hl,floatp
call mtox
call sb
jp c,err25
ld hl,floata
call xtom

ld hl,floats
call mtox
ld hl,floatq
call mtox
call sb
jp c,err25
ld hl,floatb
call xtom

call ldculddv

call ndiv

;7133 MA(0,0)=A:MN(0,0)=B
ld hl,floata
ld de,matrixa+(0*matrixsize+0)*6
call mtom
ld hl,floatb
ld de,matrixn+(0*matrixsize+0)*6
call mtom

;7134 MA(1,0)=1:MN(1,0)=0
ld hl,matrixa+(1*matrixsize+0)*6
call mv1
ld hl,matrixn+(1*matrixsize+0)*6
call mv0

;7135 A=R+P:B=S+Q:C=U:D=V:CALL FDIV
ld hl,floatr
call mtox
ld hl,floatp
call mtox
call ad
jp c,err24
ld hl,floata
call xtom

ld hl,floats
call mtox
ld hl,floatq
call mtox
call ad
jp c,err24
ld hl,floatb
call xtom

call ldculddv

call ndiv

;7136 MA(0,1)=A:MN(0,1)=B
ld hl,floata
ld de,matrixa+(0*matrixsize+1)*6
call mtom
ld hl,floatb
ld de,matrixn+(0*matrixsize+1)*6
call mtom

;7137 MA(1,1)=1:MN(1,1)=0
ld hl,matrixa+(1*matrixsize+1)*6
call mv1
ld hl,matrixn+(1*matrixsize+1)*6
call mv0

;7140 RETURN
ret

maei7150:
;7150 IF MA(0,0)=MA(1,1)THEN IF MN(0,0)=MN(1,1)THEN 7180
ld hl,matrixa+(0*matrixsize+0)*6
ld de,matrixa+(1*matrixsize+1)*6
call fcp
jr nz,maei7160

ld hl,matrixn+(0*matrixsize+0)*6
ld de,matrixn+(1*matrixsize+1)*6
call fcp
jp z,maei7180
maei7160:
;7160 CR(0)=MA(0,0):CI(0)=MN(0,0)
ld hl,matrixa+(0*matrixsize+0)*6
ld de,complextmpatof+0*12+0*6
call mtom
ld hl,matrixn+(0*matrixsize+0)*6
ld de,complextmpatof+0*12+1*6
call mtom
;7161 CR(1)=MA(1,1):CI(1)=MN(1,1)
ld hl,matrixa+(1*matrixsize+1)*6
ld de,complextmpatof+1*12+0*6
call mtom
ld hl,matrixn+(1*matrixsize+1)*6
ld de,complextmpatof+1*12+1*6
call mtom
;7162 A=MA(0,1):B=MN(0,1)
ld hl,matrixa+(0*matrixsize+1)*6
ld de,floata
call mtom
ld hl,matrixn+(0*matrixsize+1)*6
ld de,floatb
call mtom

;:C=MA(1,1)-MA(0,0):D=MN(1,1)-MN(0,0):CALL FDIV
ld hl,matrixa+(1*matrixsize+1)*6
call mtox
ld hl,matrixa+(0*matrixsize+0)*6
call mtox
call sb
jp c,err25
ld hl,floatc
call xtom

ld hl,matrixn+(1*matrixsize+1)*6
call mtox
ld hl,matrixn+(0*matrixsize+0)*6
call mtox
call sb
jp c,err25
ld hl,floatd
call xtom

call ndiv

;7163 MA(0,0)=1:MN(0,0)=0
ld hl,matrixa+(0*matrixsize+0)*6
call mv1
ld hl,matrixn+(0*matrixsize+0)*6
call mv0
;7164 MA(1,0)=0:MN(1,0)=0
ld hl,matrixa+(1*matrixsize+0)*6
call mv0
ld hl,matrixn+(1*matrixsize+0)*6
call mv0
;7165 MA(0,1)=A:MN(0,1)=B
ld hl,floata
ld de,matrixa+(0*matrixsize+1)*6
call mtom
ld hl,floatb
ld de,matrixn+(0*matrixsize+1)*6
call mtom
;7166 MA(1,1)=1:MN(1,1)=0
ld hl,matrixa+(1*matrixsize+1)*6
call mv1
ld hl,matrixn+(1*matrixsize+1)*6
call mv0
;7170 RETURN
ret

maei7180:
;7180 CR(0)=MA(0,0):CI(0)=MN(0,0)
ld hl,matrixa+(0*matrixsize+0)*6
ld de,complextmpatof+0*12+0*6
push de
call mtom
ld hl,matrixn+(0*matrixsize+0)*6
ld de,complextmpatof+0*12+1*6
push de
call mtom
;7181 CR(1)=CR(0):CI(1)=CI(0)
pop hl ;ci
ld de,complextmpatof+1*12+1*6
call mtom
pop hl ;cr
ld de,complextmpatof+1*12+0*6
call mtom
;7182 MA(0,0)=1:MN(0,0)=0
ld hl,matrixa+(0*matrixsize+0)*6
call mv1
ld hl,matrixn+(0*matrixsize+0)*6
call mv0
;7183 MA(1,0)=0:MN(1,0)=0
ld hl,matrixa+(1*matrixsize+0)*6
call mv0
ld hl,matrixn+(1*matrixsize+0)*6
call mv0
;7184 MA(0,1)=0:MN(0,1)=0
ld hl,matrixa+(0*matrixsize+1)*6
call mv0
ld hl,matrixn+(0*matrixsize+1)*6
call mv0
;7185 MA(1,1)=0:MN(1,1)=0
ld hl,matrixa+(1*matrixsize+1)*6
call mv0
ld hl,matrixn+(1*matrixsize+1)*6
call mv0
;7190 RETURN
ret

exchange: ;[hl] <-> [de]
ld b,6
exchange00:
ld a,[de]
ld c,[hl]
ex de,hl
ld [de],a
ld [hl],c
ex de,hl
inc hl
inc de
djnz exchange00
ret

;8000 "MRCPCP"
;8001 POKE RESULT,0:CALL FRCPCP
;8002 IF PEEK RESULT=&HF2 THEN WAIT :PRINT "ﾄｸｲｷﾞｮｳﾚﾂｶﾞｹﾝｼｭﾂｻﾚﾏｼﾀ.ｹｲｻﾝﾃﾞｷﾏｾﾝ":POKE RESULT,0:RETURN

initcharpvph:
ld a,[charn]
ld b,a
xor a
ld hl,charpv
ld de,charph
nr60: ld [hl],a
inc hl
ld [de],a
inc de
inc a
djnz nr60
ret

nrcpcp: ;逆行列完全ピボット [matrixa,n]=inverse[matrixa,n]
;[matrixb,o], [float e2] 使用
; ;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
call initcharpvph
;
; ;8020 DR=1:DI=0
; mv x,fdr
; call mv1
; mv x,fdi
; call mv0
ld hl,fdr
call mv1
ld hl,fdi
call mv0
;
; ;8030 FOR K=0TO N-1
; mv a,0
; mv [chark],a
xor a
ld [chark],a
nr70:
; ;8040 A=MA(K,K):B=MN(K,K)
; mv a,[chark]
; mv [ptr1],a
; mv [ptr2],a
ld a,[chark]
ld [ptr1],a
ld [ptr2],a
; call getoffset
call getoffset
; pushs i
push bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err17
jp c,err17
; pops i
pop bc
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err17
jp c,err17
; call ad
call ad
; jpc err17
jp c,err17
; ;:AW=A*A+B*B
; mv x,faw
ld hl,faw
; call xtom
call xtom
;
; ;8050 P=K:Q=K
; mv a,[chark]
; mv [charp],a
; mv [charq],a
ld a,[chark]
ld [charp],a
ld [charq],a
;
; ;8060 FOR J=K TO N-1
; mv a,[chark]
; mv [charj],a
ld a,[chark]
ld [charj],a
nr71:
; ;8070 FOR I=K TO N-1
; mv a,[chark]
; mv [chari],a
ld a,[chark]
ld [chari],a
nr72:
; ;8080 A=MA(I,J):B=MN(I,J)
; mv a,[chari]
; mv [ptr1],a
; mv a,[charj]
; mv [ptr2],a
ld a,[chari]
ld [ptr1],a
ld a,[charj]
ld [ptr2],a
; call getoffset
call getoffset
; pushs i
push bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err17
jp c,err17
; pops i
pop bc
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; pops x
pop hl
; call mtox
call mtox
; call mul
call mul
; jpc err17
jp c,err17
; call ad
call ad
; jpc err17
jp c,err17
; ;:C=A*A+B*B
; mv x,[ptrc]
ld hl,floatc
; call xtom
call xtom
;
; ;8081 IF AW<C THEN AW=C:P=I:Q=J
; mv y,faw
ld de,faw
; mv x,[ptrc]
ld hl,floatc
; call cp ;AW - C
call fcp
; jrnc nr73
jr nc,nr73
;
; mv x,[ptrc]
ld hl,floatc
; mv y,faw
ld de,faw
; call mtom
call mtom
; mv a,[chari]
; mv [charp],a
; mv a,[charj]
; mv [charq],a
ld a,[chari]
ld [charp],a
ld a,[charj]
ld [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
ld hl,chari
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jr nz,nr72

; mv a,[charj]
; inc a
; mv [charj],a
; mv il,[charn1]
; sub il,a
; jrnc nr71
ld hl,charj
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jr nz,nr71
;
; ;8100 IF SQR AW<=E2 THEN WAIT :PRINT "ﾄｸｲｷﾞｮｳﾚﾂｶﾞｹﾝｼｭﾂｻﾚﾏｼﾀ.ｹｲｻﾝﾃﾞｷﾏｾﾝ":RETURN
; mv x,faw
ld hl,faw
; pushs x
push hl
; call mtox
call mtox
; call sqr
call sqr
; jpc err17
jp c,err17
; pops x
pop hl
; pushs x
push hl
; call xtom
call xtom
; pops x
pop hl
; mv y,[ptre2]
ld de,floate2
; call cp ;E2 - SQR AW
call fcp
; jpnc errf2
jp nc,err29 ;特異行列
;
; ;8110 IF K<>P THEN
; mv a,[chark]
; mv il,[charp]
; sub il,a
; jrz nr80
ld a,[chark]
ld b,a
ld a,[charp]
cp b
jp z,nr80
; ;8120 DR=-DR:DI=-DI
; mv x,fdr
; call chs
; mv x,fdi
; call chs
ld hl,fdr
call chs
ld hl,fdi
call chs
; ;8130 FOR J=0TO N-1
; mv a,0
; mv [charj],a
xor a
ld [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
ld a,[charj]
ld [ptr2],a
ld a,[chark]
ld [ptr1],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; pushs x
push hl
; add x,i
add hl,bc
; pushs x
push hl
; mv a,[charp]
ld a,[charp]
; mv [ptr1],a
ld [ptr1],a
; call getoffset
call getoffset
; pops x
; pops y
; add y,i
; call exchange
pop de
pop hl
add hl,bc
call exchange
; ;8132 A=MN(K,J):MN(K,J)=MN(P,J):MN(P,J)=A
; mv a,[chark]
ld a,[chark]
; mv [ptr1],a
ld [ptr1],a
; call getoffset
call getoffset
; mv x,[ptrmn]
ld hl,matrixn
; pushs x
push hl
; add x,i
add hl,bc
; pushs x
push hl
; mv a,[charp]
ld a,[charp]
; mv [ptr1],a
ld [ptr1],a
; call getoffset
call getoffset
; pops x
; pops y
; add y,i
; call exchange
pop de
pop hl
add hl,bc
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
ld hl,charj
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jr nz,nr81
; ;8140 A=PH(K):PH(K)=PH(P):PH(P)=A
; mv a,[chark]
ld a,[chark]
; mv x,charph
ld hl,charph
; mv y,x
ld d,h
ld e,l
; add x,a
ld c,a
ld b,0
add hl,bc
; mv a,[charp]
ld a,[charp]
; add y,a
ex de,hl
ld c,a
add hl,bc
; mv a,[x]
; mv il,[y]
; mv [x],il
; mv [y],a
ld a,[de]
ld b,[hl]
ex de,hl
ld [de],a
ld [hl],b
nr80:
; ;8150 ENDIF
; ;8160 IF K<>Q THEN
; mv a,[chark]
; mv il,[charq]
; sub il,a
; jrz nr82
ld a,[chark]
ld b,a
ld a,[charq]
cp b
jp z,nr82
; ;8170 DR=-DR:DI=-DI
; mv x,fdr
; call chs
; mv x,fdi
; call chs
ld hl,fdr
call chs
ld hl,fdi
call chs
; ;8180 FOR I=0TO N-1
; mv a,0
; mv [chari],a
xor a
ld [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
ld a,[chari]
ld [ptr1],a
ld a,[chark]
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; pushs x
push hl
; add x,i
add hl,bc
; pushs x
push hl
; mv a,[charq]
ld a,[charq]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; pops x
; pops y
; add y,i
; call exchange
pop de
pop hl
add hl,bc
call exchange
; ;8182 A=MN(I,K):MN(I,K)=MN(I,Q):MN(I,Q)=A
; mv a,[chark]
ld a,[chark]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrmn]
ld hl,matrixn
; pushs x
push hl
; add x,i
add hl,bc
; pushs x
push hl
; mv a,[charq]
ld a,[charq]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; pops x
; pops y
; add y,i
; call exchange
pop de
pop hl
add hl,bc
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
ld hl,chari
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jr nz,nr83
; ;8190 A=PV(K):PV(K)=PV(Q):PV(Q)=A
; mv a,[chark]
ld a,[chark]
; mv x,charpv
ld hl,charpv
; mv y,x
ld d,h
ld e,l
; add x,a
ld c,a
ld b,0
add hl,bc
; mv a,[charq]
ld a,[charq]
; add y,a
ld c,a
ex de,hl
add hl,bc
; mv a,[x]
; mv il,[y]
; mv [x],il
; mv [y],a
ld a,[de]
ld b,[hl]
ex de,hl
ld [de],a
ld [hl],b
nr82:
; ;8200 ENDIF
; ;8210 C=MA(K,K):D=MN(K,K)
; mv a,[chark]
; mv [ptr1],a
; mv [ptr2],a
ld a,[chark]
ld [ptr1],a
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; pushs x
push hl
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; pushs x
push hl
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
; ;8220 MA(K,K)=1:MN(K,K)=0
; pops x
pop hl
; call mv0
call mv0
; pops x
pop hl
; call mv1
call mv1
; ;8230 A=DR:B=DI:CALL FMUL:DR=A:DI=B
; mv x,fdr
ld hl,fdr
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,fdi
ld hl,fdi
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; call nmul
call nmul
; mv x,[ptra]
ld hl,floata
; mv y,fdr
ld de,fdr
; call mtom
call mtom
; mv x,[ptrb]
ld hl,floatb
; mv y,fdi
ld de,fdi
; call mtom
call mtom
; ;8240 FOR J=0TO N-1
; mv a,0
; mv [charj],a
xor a
ld [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
ld a,[chark]
ld [ptr1],a
ld a,[charj]
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; pushs x
push hl
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; pushs x
push hl
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; call ndiv
call ndiv
; pops y
pop de
; mv x,[ptrb]
ld hl,floatb
; call mtom
call mtom
; pops y
pop de
; mv x,[ptra]
ld hl,floata
; call mtom
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
ld hl,charj
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jr nz,nr84
; ;8270 FOR I=0TO N-1
; mv a,0
; mv [chari],a
xor a
ld [chari],a
nr85:
; ;8280 IF I<>K THEN
; mv a,[chari]
; mv il,[chark]
; sub il,a
; jrz nr86
ld a,[chari]
ld b,a
ld a,[chark]
cp b
jp z,nr86
; ;8290 C=MA(I,K):D=MN(I,K)
; mv a,[chari]
; mv [ptr1],a
; mv a,[chark]
; mv [ptr2],a
ld a,[chari]
ld [ptr1],a
ld a,[chark]
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; pushs x
push hl
; mv y,[ptrc]
ld de,floatc
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; pushs x
push hl
; mv y,[ptrd]
ld de,floatd
; call mtom
call mtom
; ;8300 MA(I,K)=0:MN(I,K)=0
; pops x
pop hl
; call mv0
call mv0
; pops x
pop hl
; call mv0
call mv0
; ;8310 FOR J=0TO N-1
; mv a,0
; mv [charj],a
xor a
ld [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
ld a,[chark]
ld [ptr1],a
ld a,[charj]
ld [ptr2],a
; call getoffset
call getoffset
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptra]
ld de,floata
; call mtom
call mtom
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv y,[ptrb]
ld de,floatb
; call mtom
call mtom
; call nmul
call nmul
; ;8321 MA(I,J)=MA(I,J)-A
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; call getoffset
call getoffset
; pushs i
push bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptra]
ld hl,floata
; call mtox
call mtox
; call sb
call sb
; jpc err17
jp c,err17
; pops x
pop hl
; call xtom
call xtom
; ;8322 MN(I,J)=MN(I,J)-B
; pops i
pop bc
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; pushs x
push hl
; call mtox
call mtox
; mv x,[ptrb]
ld hl,floatb
; call mtox
call mtox
; call sb
call sb
; jpc err17
jp c,err17
; pops x
pop hl
; call xtom
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
ld hl,charj
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jr nz,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
ld hl,chari
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jp nz,nr85
; ;8360 NEXT K (TO N-1, nr70)
; mv a,[chark]
; inc a
; mv [chark],a
; mv il,[charn1]
; sub il,a
; jpnc nr70
ld hl,chark
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jp nz,nr70
; ;8370 FOR J=0TO N-1
; mv a,0
; mv [charj],a
xor a
ld [charj],a
nr90:
; ;8380 FOR I=0TO N-1
; mv a,0
; mv [chari],a
xor a
ld [chari],a
nr91:
; ;8390 P=PV(I)
; mv a,[chari]
ld a,[chari]
; mv x,charpv
ld hl,charpv
; add x,a
ld c,a
ld b,0
add hl,bc
; ;8400 MB(P,0)=MA(I,J)
; mv a,[x]
ld a,[hl]
; mv [ptr1],a
ld [ptr1],a
; mv a,0
xor a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp0],i
ld [inttmp0],bc
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charj]
ld a,[charj]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp1],i
ld [inttmp1],bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptrmb]
ld de,matrixb
; mv i,[inttmp0]
ld bc,[inttmp0]
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
call mtom
; ;8401 MO(P,0)=MN(I,J)
; mv i,[inttmp1]
ld bc,[inttmp1]
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv i,[inttmp0]
ld bc,[inttmp0]
; mv y,[ptrmo]
ld de,matrixo
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
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
ld hl,chari
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jr nz,nr91
; ;8420 FOR I=0TO N-1
; mv a,0
; mv [chari],a
xor a
ld [chari],a
nr92:
; ;8430 MA(I,J)=MB(I,0)
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charj]
ld a,[charj]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp0],i
ld [inttmp0],bc
; mv a,0
xor a
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp1],i
ld [inttmp1],bc
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; mv y,[ptrma]
ld de,matrixa
; mv i,[inttmp0]
ld bc,[inttmp0]
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
call mtom
; ;8431 MN(I,J)=MO(I,0)
; mv i,[inttmp1]
ld bc,[inttmp1]
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; mv i,[inttmp0]
ld bc,[inttmp0]
; mv y,[ptrmn]
ld de,matrixn
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
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
ld hl,chari
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jr nz,nr92
; ;8450 NEXT J (TO N-1, nr90)
; mv a,[charj]
; inc a
; mv [charj],a
; mv il,[charn1]
; sub il,a
; jrnc nr90
ld hl,charj
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jp nz,nr90
; ;8460 FOR I=0TO N-1
; mv a,0
; mv [chari],a
xor a
ld [chari],a
nr93:
; ;8470 FOR J=0TO N-1
; mv a,0
; mv [charj],a
xor a
ld [charj],a
nr94:
; ;8480 Q=PH(J)
; mv a,[charj]
ld a,[charj]
; mv x,charph
ld hl,charph
; add x,a
ld c,a
ld b,0
add hl,bc
; ;8490 MB(0,Q)=MA(I,J)
; mv a,[x]
ld a,[hl]
; mv [ptr2],a
ld [ptr2],a
; mv a,0
xor a
; mv [ptr1],a
ld [ptr1],a
; call getoffset
call getoffset
; mv [inttmp0],i
ld [inttmp0],bc
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charj]
ld a,[charj]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp1],i
ld [inttmp1],bc
; mv x,[ptrma]
ld hl,matrixa
; add x,i
add hl,bc
; mv y,[ptrmb]
ld de,matrixb
; mv i,[inttmp0]
ld bc,[inttmp0]
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
call mtom
; ;8491 MO(0,Q)=MN(I,J)
; mv i,[inttmp1]
ld bc,[inttmp1]
; mv x,[ptrmn]
ld hl,matrixn
; add x,i
add hl,bc
; mv i,[inttmp0]
ld bc,[inttmp0]
; mv y,[ptrmo]
ld de,matrixo
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
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
ld hl,charj
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jr nz,nr94
; ;8510 FOR J=0TO N-1
; mv a,0
; mv [charj],a
xor a
ld [charj],a
nr95:
; ;8520 MA(I,J)=MB(0,J)
; mv a,[chari]
ld a,[chari]
; mv [ptr1],a
ld [ptr1],a
; mv a,[charj]
ld a,[charj]
; mv [ptr2],a
ld [ptr2],a
; call getoffset
call getoffset
; mv [inttmp0],i
ld [inttmp0],bc
; mv a,0
xor a
; mv [ptr1],a
ld [ptr1],a
; call getoffset
call getoffset
; mv [inttmp1],i
ld [inttmp1],bc
; mv x,[ptrmb]
ld hl,matrixb
; add x,i
add hl,bc
; mv y,[ptrma]
ld de,matrixa
; mv i,[inttmp0]
ld bc,[inttmp0]
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
call mtom
; ;8521 MN(I,J)=MO(0,J)
; mv i,[inttmp1]
ld bc,[inttmp1]
; mv x,[ptrmo]
ld hl,matrixo
; add x,i
add hl,bc
; mv i,[inttmp0]
ld bc,[inttmp0]
; mv y,[ptrmn]
ld de,matrixn
; add y,i
ex de,hl
add hl,bc
ex de,hl
; call mtom
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
ld hl,charj
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jr nz,nr95
; ;8540 NEXT I (TO N-1, nr93)
; mv a,[chari]
; inc a
; mv [chari],a
; mv il,[charn1]
; sub il,a
; jrnc nr93
ld hl,chari
inc [hl]
ld a,[hl]
ld hl,charn
cp [hl]
jp nz,nr93
; ;8550 RETURN
; ret
ret

err17: ld a,17 ;error on rcpcp
jp err

err29: ld a,29 ;特異行列
jp err

xymul: ;[x]=[x]*[y]: ワークエリア[w]
xor a
ld [ptr1],a
ld hl,matrixx
ld [intwork20],hl
xymul00:
xor a
ld [ptr2],a
ld hl,matrixy
ld [intwork22],hl
xymul10:
call getoffset
ld hl,matrixw
add hl,bc
push hl
call mv0
pop hl
push hl

call mtox

ld hl,[intwork20] ;ptr x
ld [intwork21],hl
ld hl,[intwork22] ;ptr y
ld [intwork23],hl

ld a,[charn]
ld b,a
xymul20:
push bc

ld hl,[intwork21] ;ptr x
push hl
call mtox
ld hl,[intwork23] ;ptr y
push hl
call mtox
call mul
jp c,err2
call ad
jp c,err24
pop hl ;ptr y
ld bc,6*matrixsize ;縦移動
add hl,bc
ld [intwork23],hl
pop hl ;ptr x
ld bc,6 ;横移動
add hl,bc
ld [intwork21],hl

pop bc
djnz xymul20

pop hl
call xtom

ld hl,[intwork22] ;ptr y
ld bc,6 ;横移動
add hl,bc
ld [intwork22],hl

ld hl,ptr2
inc [hl]
ld a,[charn]
cp [hl]
jr nz,xymul10

ld hl,[intwork20] ;ptr x
ld bc,6*matrixsize ;縦移動
add hl,bc
ld [intwork20],hl

ld hl,ptr1
inc [hl]
ld a,[charn]
cp [hl]
jp nz,xymul00

ld hl,matrixw
ld de,matrixx
jp mtommatrix

xyadd: ld hl,ad
jr xyadsb

xysub: ld hl,sb
;
xyadsb: ;[x] op= [y]
ld [ptrformula_execaddress],hl
xor a
ld [ptr1],a
xyadsb00:
xor a
ld [ptr2],a
xyadsb10:
call getoffset
ld hl,matrixx
add hl,bc
push hl
call mtox
ld hl,matrixy
add hl,bc
call mtox
ld hl,xyadsb11
push hl
ld hl,[ptrformula_execaddress]
jp [hl]
xyadsb11:
jp c,err24 ;add or sub のエラー
pop hl
call xtom

ld hl,ptr2
inc [hl]
ld a,[charn]
cp [hl]
jr nz,xyadsb10

ld hl,ptr1
inc [hl]
ld a,[charn]
cp [hl]
jr nz,xyadsb00

ret

mmul: ;[2]=[0]*[1]
ld hl,charp0
ld [hl],0
inc hl
ld [hl],1
inc hl
ld [hl],2
call mpmul
;[0]=[2]
ld a,[charp2]
call mtoxmatrix
ld a,[charp0]
call xtommatrix
ld a,[charp2]
add a,13+enhancememorysize
call mtoxmatrix
ld a,[charp0]
add a,13+enhancememorysize
jp xtommatrix

mpmul: ;[charp2]=[charp0]*[charp1]: ワークエリア[x],[y],[w]
;7016 "MP*"
;POKE &HBFE00,9,1,&H53,&H41+P1:CALL &HFFFDC:mAp1->x
ld a,[charp1]
call mtoxmatrix
;POKE &HBFE00,9,1,&H4A:CALL &HFFFDC:x<>y
call xtoymatrix
;POKE &HBFE00,9,1,&H53,&H41+P0:CALL &HFFFDC:mAp0->x
ld a,[charp0]
call mtoxmatrix
;POKE &HBFE00,9,1,&H43:CALL &HFFFDC:x*y->x
call xymul
;POKE &HBFE00,9,1,&H52,&H41+P2:CALL &HFFFDC:x->mAp2
ld a,[charp2]
call xtommatrix
;POKE &HBFE00,9,1,&H53,&H4E+P1:CALL &HFFFDC:mNp1->x
ld a,[charp1]
add a,13+enhancememorysize
call mtoxmatrix
;POKE &HBFE00,9,1,&H4A:CALL &HFFFDC:x<>y
call xtoymatrix
;POKE &HBFE00,9,1,&H53,&H4E+P0:CALL &HFFFDC:mNp0->x
ld a,[charp0]
add a,13+enhancememorysize
call mtoxmatrix
;POKE &HBFE00,9,1,&H43:CALL &HFFFDC:x*y->x
call xymul
;POKE &HBFE00,9,1,&H4A:CALL &HFFFDC:x<>y
call xtoymatrix
;POKE &HBFE00,9,1,&H53,&H41+P2:CALL &HFFFDC:mAp2->x
ld a,[charp2]
call mtoxmatrix
;POKE &HBFE00,9,1,&H42:CALL &HFFFDC:x-y->x
call xysub
;POKE &HBFE00,9,1,&H52,&H41+P2:CALL &HFFFDC:x->mAp2
ld a,[charp2]
call xtommatrix
;POKE &HBFE00,9,1,&H53,&H41+P1:CALL &HFFFDC:mAp1->x
ld a,[charp1]
call mtoxmatrix
;POKE &HBFE00,9,1,&H4A:CALL &HFFFDC:x<>y
call xtoymatrix
;POKE &HBFE00,9,1,&H53,&H4E+P0:CALL &HFFFDC:mNp0->x
ld a,[charp0]
add a,13+enhancememorysize
call mtoxmatrix
;POKE &HBFE00,9,1,&H43:CALL &HFFFDC:x*y->x
call xymul
;POKE &HBFE00,9,1,&H52,&H4E+P2:CALL &HFFFDC:x->mNp2
ld a,[charp2]
add a,13+enhancememorysize
call xtommatrix
;POKE &HBFE00,9,1,&H53,&H4E+P1:CALL &HFFFDC:mNp1->x
ld a,[charp1]
add a,13+enhancememorysize
call mtoxmatrix
;POKE &HBFE00,9,1,&H4A:CALL &HFFFDC:x<>y
call xtoymatrix
;POKE &HBFE00,9,1,&H53,&H41+P0:CALL &HFFFDC:mAp0->x
ld a,[charp0]
call mtoxmatrix
;POKE &HBFE00,9,1,&H43:CALL &HFFFDC:x*y->x
call xymul
;POKE &HBFE00,9,1,&H4A:CALL &HFFFDC:x<>y
call xtoymatrix
;POKE &HBFE00,9,1,&H53,&H4E+P2:CALL &HFFFDC:mNp2->x
ld a,[charp2]
add a,13+enhancememorysize
call mtoxmatrix
;POKE &HBFE00,9,1,&H41:CALL &HFFFDC:x+y->x
call xyadd
;POKE &HBFE00,9,1,&H52,&H4E+P2:CALL &HFFFDC:x->mNp2
;RETURN
ld a,[charp2]
add a,13+enhancememorysize
jp xtommatrix

matrixmrmin:
call matrixmrmin00
ret c
call spcs
ld a,[ix]
cp 13
scf
ret nz ;cf=1
and a
ret ;cf=0

matrixmrmin00:
call inba30 ;[ix~]の整数読み出し --> b=整数
ret c
ld a,b
cp 12+enhancememorysize+1
ccf
ret

matrixmr: ;mr 0~12 読み出し
call matrixmrmin
jp c,err1
;b --> [currentmatrix]
ld a,[currentmatrix]
jr bmtoammatrix

matrixmin: ;min 0~12 書き込み
call matrixmrmin
jp c,err1
;[currentmatrix] --> b
ld a,[currentmatrix]
push af
push bc
pop af
pop bc
;
bmtoammatrix: ;a=00~12, b=00~12
; --> [complex matrix(a)~] = [complex matrix(b)~]
push bc
call getoffsetmatrix
ld [intwork10],bc ;matrix(a)
pop af
call getoffsetmatrix ;bc=matrix(b)

ld hl,matrixa
add hl,bc ;matrix(b)の実数部
push hl
ex de,hl
ld hl,matrixa
ld bc,[intwork10]
add hl,bc ;matrix(a)の実数部
push hl
ex de,hl
call mtommatrix
pop hl
ld bc,offsetcomplexmatrix
add hl,bc ;matrix(a)の虚数部
ex de,hl
pop hl
add hl,bc ;matrix(b)の虚数部
jp mtommatrix

msadd: ld hl,nadd
jr mscalar

mssub: ld hl,nsub
jr mscalar

msmul: ld hl,nmul
jr mscalar

msdiv: ld hl,ndiv
;
mscalar: ;[matrixa,n] op= [floatx,y] スカラー計算
ld [ptrformula_execaddress],hl

xor a
ld [ptr1],a
msca00:
xor a
ld [ptr2],a
msca10:
call getoffset
ld hl,matrixa
add hl,bc
push hl
ld de,floata
call mtom
ld hl,matrixn
add hl,bc
push hl
ld de,floatb
call mtom

ld hl,floatx
ld de,floatc
ld bc,12
ldir

ld hl,msca11
push hl
ld hl,[ptrformula_execaddress]
jp [hl]
msca11:
ld hl,floatb
pop de ;[matrixn~]
call mtom
ld hl,floata
pop de ;[matrixa~]
call mtom

ld hl,ptr2
inc [hl]
ld a,[charn]
cp [hl]
jr nz,msca10

ld hl,ptr1
inc [hl]
ld a,[charn]
cp [hl]
jr nz,msca00

ret

madd: ;[matrixa,n]+=[matrixb,o]
xor a
ld [ptr1],a
madd00:
xor a
ld [ptr2],a
madd10:
call getoffset
push bc
ld hl,matrixa
add hl,bc
push hl
call mtox
ld hl,matrixb
add hl,bc
call mtox
call ad
jp c,err24
pop hl
call xtom

pop bc
ld hl,matrixn
add hl,bc
push hl
call mtox
ld hl,matrixo
add hl,bc
call mtox
call ad
jp c,err24
pop hl
call xtom

ld hl,ptr2
inc [hl]
ld a,[charn]
cp [hl]
jr nz,madd10

ld hl,ptr1
inc [hl]
ld a,[charn]
cp [hl]
jr nz,madd00

ret

msub: ;[matrixa,n]-=[matrixb,o]
xor a
ld [ptr1],a
msub00:
xor a
ld [ptr2],a
msub10:
call getoffset
push bc
ld hl,matrixa
add hl,bc
push hl
call mtox
ld hl,matrixb
add hl,bc
call mtox
call sb
jp c,err25
pop hl
call xtom

pop bc
ld hl,matrixn
add hl,bc
push hl
call mtox
ld hl,matrixo
add hl,bc
call mtox
call sb
jp c,err25
pop hl
call xtom

ld hl,ptr2
inc [hl]
ld a,[charn]
cp [hl]
jr nz,msub10

ld hl,ptr1
inc [hl]
ld a,[charn]
cp [hl]
jr nz,msub00

ret

msg20: db 'ｶｸｼｭﾊﾟﾗﾒ-ﾀ- ｦﾍﾝｺｳｼﾏｽ',13
msg30: db 'ﾋﾟﾎﾞｯﾄﾇﾙｽﾍﾟ-ｽﾉﾏｴﾆｽｹ-ﾘﾝｸﾞｽﾙ (ON=1, OFF=0)=',13
msg31: db 'ｺﾕｳﾁｹｲｻﾝﾉﾏｴﾆｽｹ-ﾘﾝｸﾞｽﾙ (ON=1, OFF=0)=',13
msg32: db 'EIGEN33&44 ｦｼﾞｯｺｳｽﾙ (ON=1, OFF=0)=',13
msg33: db 'ｺｳｿｸﾇﾙｽﾍﾟ-ｽｦｼﾞｯｺｳｽﾙ (ON=1, OFF=0)=',13
msg40: db 'E0(QR)=',13
msg41: db 'E1(ﾋﾟﾎﾞｯﾄﾇﾙｽﾍﾟ-ｽ)=',13
msg42: db 'E2(ｷﾞｬｸｷﾞｮｳﾚﾂ)=',13
msg43: db 'E3(ﾊｳｽﾎﾙﾀﾞ-ﾍﾝｶﾝ)=',13
msg44: db 'E4(ｺｳｿｸﾇﾙｽﾍﾟ-ｽ)=',13
msg45: db 'E5(EIGEN33&44)=',13
msg46: db 'E6(Jordan ﾌﾞﾝｶｲ)=',13

mainparaset: ;デフォルトのしきい値、アクションを変更する
call mainparaset00
jp main00

mainparaset00:
ld [sp_work2],sp

ld hl,0+10
call setcursor
ld hl,msg20
call message
call crlf

;PRINT "ﾋﾟﾎﾞｯﾄﾇﾙｽﾍﾟ-ｽﾉﾏｴﾆｽｹ-ﾘﾝｸﾞｽﾙ (ON=1, OFF=0)=";MUSTSCALE;:INPUT MUSTSCALE
mainparaset01:
ld hl,msg30
ld de,mustscale
call mainparaset10
call c,mainparaset30
jr c,mainparaset01
;PRINT "ｺﾕｳﾁｹｲｻﾝﾉﾏｴﾆｽｹ-ﾘﾝｸﾞｽﾙ (ON=1, OFF=0)=";MUSTSCALE2;:INPUT MUSTSCALE2
mainparaset02:
ld hl,msg31
ld de,mustscale2
call mainparaset10
call c,mainparaset30
jr c,mainparaset02
;PRINT "EIGEN33&44 ｦｼﾞｯｺｳｽﾙ (ON=1, OFF=0)=";MUSTEIGEN34;:INPUT MUSTEIGEN34
mainparaset03:
ld hl,msg32
ld de,musteigen34
call mainparaset10
call c,mainparaset30
jr c,mainparaset03
;PRINT "ｺｳｿｸﾇﾙｽﾍﾟ-ｽｦｼﾞｯｺｳｽﾙ (ON=1, OFF=0)=";MUSTNSFAST;:INPUT MUSTNSFAST
mainparaset04:
ld hl,msg33
ld de,mustnsfast
call mainparaset10
call c,mainparaset30
jr c,mainparaset04

;PRINT "E0(QR)=";E0;:INPUT E0
mainparaset05:
ld hl,msg40
ld de,floate0
call mainparaset20
call c,mainparaset30
jr c,mainparaset05
;PRINT "E1(ﾋﾟﾎﾞｯﾄﾇﾙｽﾍﾟ-ｽ)=";E1;:INPUT E1
mainparaset06:
ld hl,msg41
ld de,floate1
call mainparaset20
call c,mainparaset30
jr c,mainparaset06
;PRINT "E2(ｷﾞｬｸｷﾞｮｳﾚﾂ)=";E2;:INPUT E2
mainparaset07:
ld hl,msg42
ld de,floate2
call mainparaset20
call c,mainparaset30
jr c,mainparaset07
;PRINT "E3(ﾊｳｽﾎﾙﾀﾞ-ﾍﾝｶﾝ)=";E3;:INPUT E3
mainparaset08:
ld hl,msg43
ld de,floate3
call mainparaset20
call c,mainparaset30
jr c,mainparaset08
;PRINT "E4(ｺｳｿｸﾇﾙｽﾍﾟ-ｽ)=";E4;:INPUT E4
mainparaset09:
ld hl,msg44
ld de,floate4
call mainparaset20
call c,mainparaset30
jr c,mainparaset09
;PRINT "E5(EIGEN33&44)=";E5;:INPUT E5
mainparaset0a:
ld hl,msg45
ld de,floate5
call mainparaset20
call c,mainparaset30
jr c,mainparaset0a

mainparaset0b: ;jordan分解
ld hl,msg46
ld de,floate6
call mainparaset20
call c,mainparaset30
jr c,mainparaset0b
;
mainparasetend:
ld sp,[sp_work2]
ret

mainparaset10: ;cf=status
push de
call message
pop hl
push hl
ld a,[hl]
add a,'0'
call pcha
call crlf
call input
jr c,mainparasetend
ld ix,_ptrinputdata
ld a,[ix]
cp 13
jr z,mainparaset13
cp '0'
jr z,mainparaset11
cp '1'
jr z,mainparaset11
mainparaset12:
pop hl
scf
ret ;cf=1
mainparaset11:
ld b,a
ld a,[ix+1]
cp 13
jr nz,mainparaset12
ld a,b
sub '0'
pop hl
ld [hl],a
and a
ret ;cf=0
mainparaset13:
pop hl
and a
ret ;cf=0

mainparaset20: ;cf=status
push de
call message
pop hl
push hl
ld de,acc1
call mtom
ld ix,buffer
call printbcdacc1
ld [ix],13
ld hl,buffer
call message
call crlf
call input
jr c,mainparasetend
ld ix,_ptrinputdata
call spcs
ld a,[ix]
cp 13
jr z,mainparaset23
call inputbcdacc1
jr nc,mainparaset21
mainparaset22:
pop hl
scf
ret ;cf=1
mainparaset21:
call spcs
ld a,[ix]
cp 13
jr nz,mainparaset22
pop de
ld hl,acc1
call mtom
and a
ret ;cf=0
mainparaset23:
pop hl
and a
ret ;cf=0

mainparaset30:
push af
ld hl,errmsg01
call message
call crlf
pop af
ret

inputmatrix: ;複素行列[matrixa,n][matrixb,o]の入力
;--> [ix~]=行列に対するコマンド文字列
;enterが押された:cf=0、breakが押された:cf=1
ld [sp_work],sp
xor a
ld [currentmatrix],a
call mtoxymatrix
main00:
ld a,[charn]
cp 5
jr nc,main02
main03:
call drawmatrixinit
xor a
ld [ismodified],a
main02:
call drawmatrix

maink00:call keywait
cp '8'
jp z,maink8
cp '2'
jp z,maink2
cp '4'
jp z,maink4
cp '6'
jp z,maink6

ld hl,ismodified
ld [hl],1

cp 'e'
jp z,mainparaset

cp '+'
jp z,mainkp
cp '-'
jp z,mainkm

cp '/'
jp z,mainkd

cp 13
jr nz,maink00

ld hl,0+10
call setcursor
main01:
ld hl,msg00 ;formula入力
call message
call crlf
call input
jr c,main00

ld ix,_ptrinputdata
call spcs
ld a,[ix]
cp 13
jr z,main10

ld hl,main01
ld [ptrresume],hl
call initstackpointer
call getformula
call spcs
ld a,[ix]
cp 13
jp nz,err1

ld hl,[usercursor1]
ld [ptr1],hl
call getoffset
ld hl,matrixx
add hl,bc
ld de,floata
ex de,hl
call mtom
ld hl,matrixy
add hl,bc
ld de,floatb
ex de,hl
call mtom

jp main00
main10:
ld hl,msg10 ;function入力
call message
call crlf
call input
ret c

ld ix,_ptrinputdata
call spcs
ld a,[ix]
cp 13
jp z,main03 ;再描画

ld a,[currentmatrix]
call xytommatrix

and a
ret ;cf=0

maink8: ld hl,usercursor1
dec [hl]
jr maink2468

maink2: ld hl,usercursor1
inc [hl]
jr maink2468

maink4: ld hl,usercursor2
dec [hl]
jr maink2468

maink6: ld hl,usercursor2
inc [hl]
;
maink2468:
ld a,[charn]
cp [hl]
jr nz,maink24681
ld [hl],0
jp main02
maink24681:
ld a,[hl]
cp 255
jp nz,main02
ld a,[charn1]
ld [hl],a
jp main02

mainkp: ld a,[charn]
inc a
cp 8+1
jr mainkpm

mainkm: ld a,[charn]
dec a
cp 2-1
mainkpm:
call nz,setcharn
ld hl,0
ld [usercursor1],hl
jp main00

mainkd: ld a,[currentmatrix]
push af
call xytommatrix
pop af
xor 1
ld [currentmatrix],a
call mtoxymatrix
jp main00

msg00: db 'Formula=',13
msg10: db 'Function=',13

xytommatrix: ;a=00~12 --> [complex matrix(a)~]=[matrixx,y]
call getoffsetmatrix
ld hl,matrixa
add hl,bc
push hl
ld de,matrixx
ex de,hl
call mtommatrix
pop hl
ld bc,offsetcomplexmatrix
add hl,bc
ld de,matrixy
ex de,hl
jr mtommatrix

mtoxymatrix: ;a=00~12 --> [matrixx,y]=[complex matrix(a)~]
call getoffsetmatrix
ld hl,matrixa
add hl,bc
push hl
ld de,matrixx
call mtommatrix
pop hl
ld bc,offsetcomplexmatrix
add hl,bc
ld de,matrixy
jr mtommatrix

xtommatrix: ;a=00~25 --> [matrix(a)~]=[matrixx]
call getoffsetmatrix
ld hl,matrixa
add hl,bc
ld de,matrixx
ex de,hl
jr mtommatrix

mtoxmatrix: ;a=00~25 --> [matrixx]=[matrix(a)~]
call getoffsetmatrix
ld hl,matrixa
add hl,bc
ld de,matrixx
;
mtommatrix: ;[de]=[hl] ++++
push bc

ld a,[charn]
ld c,a
add a,a ;*2
add a,c ;*3
add a,a ;*6
ld c,a
ld b,0
ld [intwork20],bc ;charn*6

ld a,[charn]
ld c,a
ld a,matrixsize
sub c
ld c,a
add a,a ;*2
add a,c ;*3
add a,a ;*6
ld c,a ;(matrixsize-charn)*6
ld b,0

ld a,[charn]
mtomm00:
push af
push bc

ld bc,[intwork20] ;charn*6
ldir

pop bc
add hl,bc ;+(matrixsize-charn)*6
ex de,hl
add hl,bc
ex de,hl
pop af
dec a
jr nz,mtomm00

pop bc
ret

xtoymatrix: ;[matrixy]=[matrixx]
ld hl,matrixx
ld de,matrixy
jr mtommatrix

atobmatrix: ;a=00~12, b=00~12 --> [complex matrix b]=[complex matrix a]
push bc
call getoffsetmatrix
ld [intwork30],bc ;source
pop af
call getoffsetmatrix
ld [intwork31],bc ;destination
ld hl,matrixa
ld d,h
ld e,l
add hl,bc ;destination
ex de,hl
ld bc,[intwork30]
add hl,bc ;source
call mtommatrix
ld hl,matrixn
ld d,h
ld e,l
add hl,bc ;source
ex de,hl
ld bc,[intwork31]
add hl,bc ;destination
ex de,hl
jr mtommatrix

getoffsetmatrix: ;a=00~25 --> bc=offset ++++
push hl
push de
ld hl,0
ld de,6*matrixsize*matrixsize
ld b,a
inc b
jr getoffsetm00
getoffsetm01:
add hl,de
getoffsetm00:
djnz getoffsetm01
ld b,h
ld c,l
pop de
pop hl
ret

setcharn: ;a=行列次数 --> [charn],[charn1],[charn2]をセットする
ld [charn],a
dec a
ld [charn1],a
dec a
ld [charn2],a
ret

drawmatrix: ;[currentmatrix]=0~25 --> 左上に行列名(A~Z)を表示する
;[ismodified]=0のとき
;[buffer+usercursor1,2]を全表示する
;[ismodified]=1のとき
;[matrixx,y+usercursor1,2]の要素を表示する
call clearscreen

ld hl,0
call setcursor
ld a,[currentmatrix]
add a,'A'
call pcha

xor a
drawm20:push af
ld l,a
inc l
ld h,0
call setcursor
pop af
push af
add a,'1'
call pcha
pop af
inc a
ld hl,charn
cp [hl]
jr nz,drawm20

ld a,[ismodified]
and a
jr z,drawm30

;１要素のみ表示
ld hl,[usercursor1] ;l=usercursor1, h=usercursor2
ld [ptr1],hl

push hl
ld hl,2*256+0
call setcursor
pop hl
push hl
ld a,h
add a,'1'
call pcha
pop hl

ld h,2
inc l
call setcursor

call getoffset
ld hl,matrixx
add hl,bc
ld de,floata
call mtom
ld hl,matrixy
add hl,bc
ld de,floatb
call mtom
ld ix,buffer
call printcomplex
ld [ix],13
ld hl,buffer
call message
jp drawm70

drawm30: ;全表示
call drawm50

ld hl,2*256+0
drawm32:
push hl
push af
call setcursor
pop af
push af
add a,'1'
call pcha
pop af
pop hl
ex af,af'
ld a,h
add a,[ix]
inc ix
add a,2
ld h,a
cp 39
jr nc,drawm31
ex af,af'
inc a
exx
ld hl,charn
cp [hl]
exx
jr nz,drawm32
drawm31:
ld hl,buffer
ld a,[usercursor2]
ld e,a
inc e
jr drawm40
drawm41:
ld a,[charn]
ld d,a
drawm42:
ld c,255
ld a,13
cpir
dec d
jr nz,drawm42
drawm40:
dec e
jr nz,drawm41

exx

call drawm50
ld h,2
drawm63:
ld l,1
drawm60:
push de
push hl
call setcursor

exx
drawm61:
ld a,[hl]
inc hl
cp 13
jr z,drawm62
call pcha

exx
inc h
ld a,h
exx
cp 39
jr c,drawm61
drawm64:
ld a,[hl]
inc hl
cp 13
jr nz,drawm64
drawm62:
exx

pop hl
pop de

inc l
ld a,[charn]
inc a
cp l
jr nz,drawm60

inc e
dec a
cp e
jr z,drawm70

ld a,h
add a,[ix]
inc ix
add a,2
ld h,a
cp 39
jr c,drawm63
drawm70:
ld a,[usercursor1]
inc a
ld l,a
ld h,1
call setcursor

ld a,'>'
jp pcha

drawm50:ld ix,charwork10
ld a,[usercursor2]
ld e,a
ld d,0
add ix,de
ret

drawmatrixinit: ;[matrixx~],[matrixy~]=複素行列要素、[charn]=次数
;--> すべて[buffer~]へ文字出力する、[charwork10~]=横方向最大文字数
ld ix,buffer
xor a
ld [ptr2],a
ld hl,charwork10
ld de,charwork10+1
ld bc,8-1
ld [hl],a
ldir
drawm00:
xor a
ld [ptr1],a
drawm10:
call getoffset
ld hl,matrixx
add hl,bc
ld de,floata
call mtom
ld hl,matrixy
add hl,bc
ld de,floatb
call mtom

push ix
call printcomplex
ld [ix],13
inc ix
pop de
push ix
pop hl
and a
sbc hl,de
ex de,hl ;e=この要素の文字数
ld a,[ptr2]
ld c,a
ld b,0
ld hl,charwork10
add hl,bc
ld a,e
cp [hl]
jr c,drawm11
ld [hl],a ;横方向の最大文字数
drawm11:
ld hl,ptr1
inc [hl]
ld a,[charn]
cp [hl]
jr nz,drawm10

ld hl,ptr2
inc [hl]
ld a,[charn]
cp [hl]
jr nz,drawm00

ret

getoffset: ;bc=matrix offset [ptr1], [ptr2] ++++
push hl
ld hl,[ptr1] ;l=ptr1, h=ptr2
ld a,l
add a,a ;*2
add a,a ;*4
add a,a ;*8
add a,h
ld l,a
ld h,0
ld b,h
ld c,l
add hl,hl ;*2
add hl,bc ;*3
add hl,hl ;*6
ld b,h
ld c,l
pop hl
ret

ldcalddb: ;c=a, d=b
ld hl,floata
ld de,floatc
call mtom
ld hl,floatb
ld de,floatd
jp mtom

ldgaldhb: ;g=a, h=b
ld hl,floata
ld de,floatg
call mtom
ld hl,floatb
ld de,floath
jp mtom

ldpaldqb: ;p=a, q=b
ld hl,floata
ld de,floatp
call mtom
ld hl,floatb
ld de,floatq
jp mtom

ldagldbh: ;a=g, b=h
ld hl,floatg
ld de,floata
call mtom
ld hl,floath
ld de,floatb
jp mtom

addagaddbh: ;a=a+g, b=b+h
ld hl,floata
push hl
call mtox
ld hl,floatg
call mtox
call ad
jp c,err24
pop hl
call xtom

ld hl,floatb
push hl
call mtox
ld hl,floath
call mtox
call ad
jp c,err24
pop hl
jp xtom

;5050 "CHCS"G=A:H=B:GOSUB "CEXP":P=A:Q=B:A=-G:B=-H:GOSUB "CEXP":A=(P+A)/2:B=(Q+B)/2:RETURN
ncosh:
call ldgaldhb
call nexp
call ldpaldqb
call ldagldbh
call nchs
call nexp

ld hl,floatp
call mtox
ld hl,floata
push hl
call mtox
call ad
jp c,err24
pop hl
push hl
call xtom
pop hl
call fatn30 ;[hl]/2

ld hl,floatq
call mtox
ld hl,floatb
push hl
call mtox
call ad
jp c,err24
pop hl
push hl
call xtom
pop hl
jp fatn30 ;[hl]/2

;5060 "CHSN"G=A:H=B:GOSUB "CEXP":P=A:Q=B:A=-G:B=-H:GOSUB "CEXP":A=(P-A)/2:B=(Q-B)/2:RETURN
nsinh:
call ldgaldhb
call nexp
call ldpaldqb
call ldagldbh
call nchs
call nexp

ld hl,floatp
call mtox
ld hl,floata
push hl
call mtox
call sb
jp c,err25
pop hl
push hl
call xtom
pop hl
call fatn30 ;[hl]/2

ld hl,floatq
call mtox
ld hl,floatb
push hl
call mtox
call sb
jp c,err25
pop hl
push hl
call xtom
pop hl
jp fatn30 ;[hl]/2

mul2: ;[hl]=[hl]*2, cf=status
inc hl
ld a,[hl]
and a
ret z ;cf=0
inc a
scf
ret z ;cf=1
ld [hl],a
and a
ret ;cf=0

;5070 "CHTN"A=-2*A:B=-2*B:GOSUB "CEXP":
ntanh:
ld hl,floata
push hl
call mul2
jp c,err2
pop hl
call chs

ld hl,floatb
push hl
call mul2
jp c,err2
pop hl
call chs

call nexp

;C=1+A:D=B:A=1-A:B=-B:GOTO "C/"
ld hl,float1
call mtox
ld hl,floata
call mtox
call ad
jp c,err24
ld hl,floatc
call xtom

ld hl,floatb
ld de,floatd
call mtom

ld hl,float1
call mtox
ld hl,floata
push hl
call mtox
call sb
jp c,err25
pop hl
call xtom

ld hl,floatb
call chs

jp ndiv

;5080 "CAHC"G=A:H=B:C=A:D=B:CALL FMUL:A=A-1:GOSUB "CSQR":A=A+G:B=B+H:GOTO "CLN"
narccosh:
call ldgaldhb
call ldcalddb
call nmul
ld hl,floata
push hl
call mtox
ld hl,float1
call mtox
call sb
jp c,err25
pop hl
call xtom
call nsqr
call addagaddbh
jp nln

;5090 "CAHS"G=A:H=B:C=A:D=B:CALL FMUL:A=A+1:GOSUB "CSQR":A=A+G:B=B+H:GOTO "CLN"
narcsinh:
call ldgaldhb
call ldcalddb
call nmul
ld hl,floata
push hl
call mtox
ld hl,float1
call mtox
call ad
jp c,err24
pop hl
call xtom
call nsqr
call addagaddbh
jp nln

;5100 "CAHT"C=1-A:D=-B:
narctanh:
ld hl,float1
call mtox
ld hl,floata
call mtox
call sb
jp c,err25
ld hl,floatc
call xtom

ld hl,floatb
ld de,floatd
push de
call mtom
pop hl
call chs

;A=1+A:CALL FDIV:GOSUB "CLN":A=A/2:B=B/2:RETURN
ld hl,float1
call mtox
ld hl,floata
push hl
call mtox
call ad
jp c,err24
pop hl
call xtom

call ndiv
call nln

ld hl,floata
call fatn30 ;[hl]/2
ld hl,floatb
jp fatn30 ;[hl]/2

err27: ld a,27 ;error on cos
jp err

;5110 "CCOS"C=COS A*HCS B:
ncos:
ld hl,floata
call mtox
call cos
jr c,err27
ld hl,floatb
call mtox
call cosh
jr c,err27
call mul
jr c,err27
ld hl,floatc
call xtom

;B=-SIN A*HSN B:A=C:RETURN
ld hl,floata
call mtox
call sin
jr c,err27
ld hl,floatb
call mtox
call sinh
jr c,err27
call mul
jr c,err27
ld hl,floatb
push hl
call xtom
pop hl
call chs

ld hl,floatc
ld de,floata
jp mtom

err28: ld a,28 ;error on sin
jp err

;5120 "CSIN"C=SIN A*HCS B
nsin:
ld hl,floata
call mtox
call sin
jr c,err28
ld hl,floatb
call mtox
call cosh
jr c,err28
call mul
jr c,err28
ld hl,floatc
call xtom

;:B=COS A*HSN B:A=C:RETURN
ld hl,floata
call mtox
call cos
jr c,err28
ld hl,floatb
call mtox
call sinh
jr c,err28
call mul
jr c,err28
ld hl,floatb
call xtom

ld hl,floatc
ld de,floata
jp mtom

;5130 "CTAN"G=A:H=B:GOSUB "CCOS":P=A:Q=B:A=G:B=H:GOSUB "CSIN":C=P:D=Q:GOTO "C/"
ntan:
call ldgaldhb
call ncos
call ldpaldqb
call ldagldbh
call nsin
ld hl,floatp
ld de,floatc
call mtom
ld hl,floatq
ld de,floatd
call mtom
jp ndiv

;5140 "CATN"C=-A:D=1-B:B=1+B
narctan:
ld hl,floata
ld de,floatc
push de
call mtom
pop hl
call chs

ld hl,float1
call mtox
ld hl,floatb
call mtox
call sb
jp c,err25
ld hl,floatd
call xtom

ld hl,float1
call mtox
ld hl,floatb
call mtox
call ad
jp c,err24
ld hl,floatb
call xtom

;:CALL FDIV:GOSUB "CLN":C=-B/2:B=A/2:A=C:RETURN
call ndiv
call nln

ld hl,floatb
ld de,floatc
push de
call mtom
pop hl
push hl
call fatn30 ;[hl]/2
pop hl
call chs

ld hl,floata
ld de,floatb
push de
call mtom
pop hl
call fatn30 ;[hl]/2

ld hl,floatc
ld de,floata
jp mtom

;5150 "CASN"G=-B:H=A:C=A:D=B:CALL FMUL:A=1-A:B=-B:GOSUB "CSQR"
narcsin:
ld hl,floatb
ld de,floatg
push de
call mtom
pop hl
call chs
ld hl,floata
ld de,floath
call mtom
call ldcalddb
call nmul
call nchs
ld hl,float1
call mtox
ld hl,floata
push hl
call mtox
call ad
jp c,err24
pop hl
call xtom
call nsqr
;5151 A=A-G:B=B-H:GOSUB "CLN":C=-B:B=A:A=C:RETURN
ld hl,floatg
call chs
ld hl,floath
call chs
call addagaddbh
call nln
ld hl,floatb
ld de,floatc
push de
call mtom
pop hl
call chs
ld hl,floata
ld de,floatb
call mtom
ld hl,floatc
ld de,floata
jp mtom

;5160 "CACS"GOSUB "CASN":A=PI /2-A:B=-B:RETURN
narccos:
call narcsin
call nchs
ld hl,floatpidiv2
call mtox
ld hl,floata
push hl
call mtox
call ad
jp c,err24
pop hl
jp xtom

ncomma: ld hl,floatc
ld de,floata
call mtom
ld hl,floatd
ld de,floatb
jp mtom

err26: ld a,26 ;not left value
jp err

nequal: ld a,[charformula_leftvalue]
and a
jr z,err26
call ncomma
dec a
ld c,a
ld b,0
add a,a ;*2
add a,c ;*3
add a,a ;*6
add a,a ;*12
ld c,a
ld hl,complextmpatof
add hl,bc
ex de,hl
ld hl,floata
ld bc,12
ldir
ret

float1div3: db &00,&7e,&ab,&aa,&aa,&aa ;1/3

npowerxy: ;complex[a,b]^=complex[x,y]
ld hl,floatx
ld de,floatc
ld bc,12
ldir
;
npower: ;complex[a, b] ^= complex[c, d]
;5350 "C^"IF A=0THEN IF B=0THEN IF C>0THEN RETURN
ld a,[floata+1]
ld b,a
ld a,[floatb+1]
or b
jr nz,npower10

ld a,[floatc+1]
and a
jr z,err23
ld a,[floatc+0]
and a
ret z
npower10:
;5351 E=C:F=D:GOSUB "CLN":C=E:D=F:CALL FMUL:GOTO "CEXP"
ld hl,floatc
ld de,floate
call mtom
ld hl,floatd
ld de,floatf
call mtom
call nln
ld hl,floate
ld de,floatc
call mtom
ld hl,floatf
ld de,floatd
call mtom
call nmul
jp nexp

err23: ld a,23 ;error on power
jp err

nsqr: ld a,[floatb+1]
and a
jr nz,nsqr00
ld hl,floata
inc hl
ld a,[hl]
and a
ret z ;sqrt(0+0i)
dec hl
ld a,[hl]
add a,a
jr c,nsqr00

call mtox
call sqr
jr c,err23
ld hl,floata
jp xtom
nsqr00:
ld hl,float1div2
jr npowerfloat

ncur: ld hl,float1div3
;
npowerfloat: ;complex[a, b] ^= float[hl]
push hl

ld hl,floata
call is0
jr nz,npower00
ld hl,floatb
call is0
jr z,npower01
npower00:
call nln

ld hl,floata
call mtox
pop hl
push hl
call mtox
call mul
jr c,err23
ld hl,floata
call xtom

ld hl,floatb
call mtox
pop hl
call mtox
call mul
jr c,err23
ld hl,floatb
call xtom

call nexp

ret

npower01:
pop hl
ret

nln:
;5030 "CLN"
;5031 IF ABS A>=ABS B THEN
ld hl,floata
ld de,fnlna
push de
call mtom
pop de
push de
xor a
ld [de],a
ld hl,floatb
ld de,fnlnb
push de
call mtom
pop de
xor a
ld [de],a
pop hl
call fcp ;ABS B - ABS A
jr nc,nln00

;5032 C=ABS A*SQR (1+(B/A)^2)
ld hl,floatb
call mtox
ld hl,floata
call mtox
call div
jp c,err22
ld hl,fnlnc
push hl
push hl
call xtom
pop hl
push hl
call mtox
pop hl
call mtox
call mul
jp c,err22
pop hl
push hl
call mv1
pop hl
call mtox
call ad
jp c,err22
call sqr
jp c,err22
ld hl,fnlna
jr nln01
;5033 ELSE
nln00:
;5034 C=ABS B*SQR (1+(A/B)^2)
ld hl,floata
call mtox
ld hl,floatb
call mtox
call div
jp c,err22
ld hl,fnlnc
push hl
push hl
call xtom
pop hl
push hl
call mtox
pop hl
call mtox
call mul
jp c,err22
pop hl
push hl
call mv1
pop hl
call mtox
call ad
jp c,err22
call sqr
jp c,err22
ld hl,fnlnb
;5035 ENDIF
nln01:
call mtox
call mul
jp c,err22
ld hl,floatc
call xtom

;5036 D=(SGN B+1)*10+SGN A+1
ld hl,floata
push hl
call is0
pop hl
jr z,nln11
ld a,[hl]
and a
jr z,nln12
xor a ;A<0
jr nln13
nln11: ld a,1 ;A==0
jr nln13
nln12: ld a,2 ;A>0
nln13: ld b,a

ld hl,floatb
push hl
call is0
pop hl
jr z,nln21
ld a,[hl]
and a
jr z,nln22
xor a ;B<0
jr nln23
nln21: ld a,3 ;B==0
jr nln23
nln22: ld a,6 ;B>0
nln23:
add a,b
cp 3*1+0
jr z,nln5038
cp 3*1+1
jr z,nln5039
cp 3*1+2
jr z,nln5040
cp 3*2+0
jr z,nln5041
cp 3*2+1
jr z,nln5042
cp 3*2+2
jr z,nln5043
cp 3*0+0
jr z,nln5044
cp 3*0+1
jr z,nln5045
cp 3*0+2
jr z,nln5046

;5037 SWITCH D

nln5038: ;5038 CASE 10:B=PI
ld hl,floatpi
ld de,floatb
call mtom
jr nln5047

nln5039: ;5039 CASE 11:PRINT "LN 0"
jr err22

nln5040: ;5040 CASE 12:B=0
ld hl,floatb
call mv0
jr nln5047

nln5041: ;5041 CASE 20:B=PI +ATN (B/A)
call nln30
ld hl,floatpi
nln40: call mtox
call ad
jr c,err22
jr nln42

nln5042: ;5042 CASE 21:B=PI /2
ld hl,floatpidiv2
nln41: ld de,floatb
call mtom
jr nln5047

nln5046: ;5046 CASE 2:B=ATN (B/A)
nln5043: ;5043 CASE 22:B=ATN (B/A)
call nln30
nln42: ld hl,floatb
call xtom
jr nln5047

nln5044: ;5044 CASE 0:B=-PI +ATN (B/A)
call nln30
ld hl,floatmpi
jr nln40

nln5045: ;5045 CASE 1:B=-PI /2
ld hl,floatmpidiv2
jr nln41

;5047 ENDSWITCH
nln5047:
;5048 A=LN C:RETURN
ld hl,floatc
call mtox
call ln
jr c,err22
ld hl,floata
call xtom
ret

nln30: ld hl,floatb
ld de,acc1
call mtom
ld hl,floata
ld de,acc2
call mtom
call farctan
jr c,err22
ld hl,acc1
jp mtox

err22: ld a,22 ;error on ln
jp err

nexp:
;5020 "CEXP"IF B=0THEN A=EXP A:RETURN
ld hl,floatb
call is0
jr nz,nexp00
ld hl,floata
push hl
call mtox
call exp
jr c,err21
pop hl
call xtom
ret
nexp00:
;5021 F=EXP A:E=F*COS B:B=F*SIN B:A=E:RETURN
ld hl,floata
push hl
call mtox
call exp
jr c,err21
ld hl,floatf
push hl
call xtom
pop hl
push hl
call mtox
pop hl
call mtox
ld hl,floatb
push hl
push hl
call mtox
call cos
jr c,err21
call mul
jr c,err21
ld hl,floate
call xtom
pop hl
call mtox
call sin
jr c,err21
call mul
jr c,err21
pop hl
call xtom
ld hl,floate
pop de
call mtom
ret

err21: ld a,21 ;error on exp
jp err

err2: ld a,2 ;error on mul
jp err

nmul:
;E=A*C-B*D

ld hl,floata
call mtox
ld hl,floatc
call mtox
call mul
jr c,err2

ld hl,floatb
call mtox
ld hl,floatd
call mtox
call mul
jr c,err2

call sb
jr c,err2

;B=A*D+B*C:A=E

ld hl,floata
call mtox
ld hl,floatd
call mtox
call mul
jr c,err2

ld hl,floatb
call mtox
ld hl,floatc
call mtox
call mul
jr c,err2

call ad ;b=(y1)+(y0)
jr c,err2
ld hl,floatb
call xtom

ld hl,floata
call xtom

ret

err3: ld a,3 ;error on div
jp err

ndiv:
;F=C*C+D*D

ld hl,floatc
call mtox
ld hl,floatc
call mtox
call mul
jr c,err3

ld hl,floatd
call mtox
ld hl,floatd
call mtox
call mul
jr c,err3

call ad
jr c,err3
ld hl,floatf
call xtom

;E=(A*C+B*D)/F

ld hl,floata
call mtox
ld hl,floatc
call mtox
call mul
jr c,err3

ld hl,floatb
call mtox
ld hl,floatd
call mtox
call mul
jr c,err3

call ad
jr c,err3
ld hl,floatf
call mtox
call div
jr c,err3

;B=(B*C-A*D)/F:A=E

ld hl,floatb
call mtox
ld hl,floatc
call mtox
call mul
jr c,err3

ld hl,floata
call mtox
ld hl,floatd
call mtox
call mul
jp c,err3

call sb
jp c,err3

ld hl,floatf
call mtox
call div
jp c,err3
ld hl,floatb
call xtom

ld hl,floata
call xtom

ret

err24: ld a,24 ;error on add
jp err

nadd: ld hl,floata
call mtox
ld hl,floatc
call mtox
call ad
jr c,err24
ld hl,floata
call xtom

ld hl,floatb
call mtox
ld hl,floatd
call mtox
call ad
jr c,err24
ld hl,floatb
jp xtom

err25: ld a,25 ;error on sub
jp err

nsub: ld hl,floata
call mtox
ld hl,floatc
call mtox
call sb
jr c,err25
ld hl,floata
call xtom

ld hl,floatb
call mtox
ld hl,floatd
call mtox
call sb
jr c,err25
ld hl,floatb
jp xtom

mv0: ;[hl] = 0
inc hl
ld [hl],0
ret

mv1: ;[hl] = 1
push de
push bc
ex de,hl
ld hl,float1
mv100: call mtom
ex de,hl
pop bc
pop de
ret

mv0p5: ;[hl] = 0.5
push de
push bc
ex de,hl
ld hl,float1div2
jr mv100

nchs: ld hl,floata
call chs
ld hl,floatb
;
chs: ;[hl] = -[hl]
ld a,[hl]
xor 128
ld [hl],a
nnop: ret

mul: ;y*x -> x
call popacc12
call fmul
mtox100:push af
ld hl,acc1
call mtox
pop af
ret

div: ;y/x -> x
call popacc12
call fdiv
jr mtox100

ad: ;y+x -> x
call popacc12
call fadd
jr mtox100

sb: ;y-x -> x
call popacc12
call fsub
jr mtox100

sqr: ;sqr(x) -> x
call popacc1
call fsqrt
jr mtox100

exp: call popacc1
call fexp
jr mtox100

ln: call popacc1
call flog
jr mtox100

sin: call popacc1
call fsin
jr mtox100

cos: call popacc1
call fcos
jr mtox100

sinh: call popacc1
call fsinh
jr mtox100

cosh: call popacc1
call fcosh
jr mtox100

printcomplex: ;[ix~] = bcd complex [floata],[floatb]
ld hl,floata
ld de,acc1
call mtom

ld a,[floata+1]
ld b,a
ld a,[floatb+1]
ld c,a
or b
jp z,printbcdacc1 ;0+0i

inc b
dec b
jr z,printcmp00

push bc
call printbcdacc1
pop bc

inc c
dec c
ret z

printcmp00:
ld hl,floatb
ld de,acc1
call mtom
call printbcdacc1
ld [ix],'i'
inc ix
ret

getx: xor a
ld [charformula_leftvalue],a

call spcs

call inputbcdacc1
jr c,getx00

call spcs
ld hl,acc1
ld a,[ix]
cp 'i'
jr nz,getx01

inc ix
xor a
ld [floata+1],a
ld de,floatb
jp mtom
getx01:
xor a
ld [floatb+1],a
ld de,floata
jp mtom
getx00:
ld a,[ix]
call isoperator1
ld c,a
ld b,0
ld hl,ptroperator1
add hl,bc
add hl,bc
ld e,[hl]
inc hl
ld d,[hl]
ex de,hl
jp [hl]
getx10:
call getalphalength
dec b
jr nz,getx20

ld a,[ix]

cp 'm' ;行列要素指定
jr z,getxmatrix

sub 'a'
cp 6
jp nc,err1

inc ix

inc a
ld [charformula_leftvalue],a
dec a

ld c,a
add a,a ;*2
add a,c ;*3
add a,a ;*6
add a,a ;*12
ld c,a
ld b,0
ld hl,complextmpatof
add hl,bc
ld de,floata
ld c,12
ldir
ret
getx20:
inc b
call isstringoperator1
jp c,err1

push hl ;exp, ln などの処理アドレス

call getalphalength
push hl
pop ix

getx31: call getx

xor a
ld [charformula_leftvalue],a ;左辺値ではない

ret ;関数処理へ

getxnop: ;'+'
ld hl,nnop
jr getx30

getxnchs: ;'-'
ld hl,nchs
;
getx30: push hl
inc ix
jr getx31

getxparentheses: ;'('
call mtox16
inc ix
call getformula
call xtom16

call spcs
ld a,[ix]
cp ')'
jp nz,err1
inc ix

xor a
ld [charformula_leftvalue],a ;左辺値ではない

ret

getxmatrix: ;m11~m88
call getxm00
ld [ptr1],a
call getxm00
ld [ptr2],a
inc ix

call getoffset
ld hl,matrixx
add hl,bc
ld de,floata
call mtom
ld hl,matrixy
add hl,bc
ld de,floatb
call mtom

xor a
ld [charformula_leftvalue],a ;左辺値ではない

ret

getxm00:inc ix
ld a,[ix]
call isnumber
jp c,err1
and a
jp z,err1
dec a
ld hl,charn
cp [hl]
jp nc,err1
ret

getalphalength: ;[ix~]アルファベット文字の長さを調べる --> b=長さ, hl=次のアドレス
ld b,0
push ix
pop hl
geta00: ld a,[hl]
cp 'a'
ret c
cp 'z'+1
ret nc
inc hl
inc b
jr geta00

isstringoperator1: ;[ix~]=character, b=長さ --> 一致する文字列を探す
;hl=関数処理アドレス,cf=status
ld hl,stringoperator1
isst00: ld a,[hl]
and a
scf
ret z
cp b
jr nz,isst10

ex af,af'
push bc
push hl
exx
pop hl
pop bc
push ix
pop de
isst01: ld a,[de]
inc hl
cp [hl]
jr nz,isst02
inc de
djnz isst01
inc hl
ld a,[hl]
inc hl
ld h,[hl]
ld l,a
and a
ret ;cf=0

isst02: ex af,af'
exx

isst10: add a,1+2
ld e,a
ld d,0
add hl,de
jr isst00

isoperator1: ;a=character --> a=単項演算子コード
ld hl,charoperator1
ld b,charoperator1e-charoperator1
isop100:cp [hl]
jr z,isop110
inc hl
djnz isop100
isop110:
ld a,charoperator1e-charoperator1
sub b
ret

charoperator1:
db '+', '-', '('
charoperator1e:

ptroperator1:
dw getxnop, getxnchs, getxparentheses, getx10

stringoperator1:
db 3,'exp'
dw nexp
db 2,'ln'
dw nln
db 3,'sqr'
dw nsqr
db 4,'sqrt'
dw nsqr
db 3,'cur'
dw ncur
db 4,'cosh'
dw ncosh
db 4,'sinh'
dw nsinh
db 4,'tanh'
dw ntanh
db 7,'arccosh'
dw narccosh
db 7,'arcsinh'
dw narcsinh
db 7,'arctanh'
dw narctanh
db 3,'cos'
dw ncos
db 3,'sin'
dw nsin
db 3,'tan'
dw ntan
db 6,'arctan'
dw narctan
db 6,'arcsin'
dw narcsin
db 6,'arccos'
dw narccos
db 2,'re'
dw nreal
db 2,'im'
dw nimage
db 0

nreal: ;complex[a,b]の[b]を0にして、実数部をとる
xor a
ld [floatb+1],a
ret

nimage: ;complex[a,b]の[a]を0にして、虚数部をとる
xor a
ld [floata+1],a
ret

getformula: ;[ix~] = character --> [floata],[b] = complex number
ld a,255
ld [charformula_entrylevel],a
;
getformula00:
;bool getformula00(bool mustfindlabel, unsigned char entrylevel)
;{
; long x;
; unsigned char q;
;
; if(getx(mustfindlabel)) {return(TRUE);};
call getx
;
;lbl00:;
getf00:
;
; x=result;
ld hl,floata
ld de,floatformula_a
call mtom
ld hl,floatb
ld de,floatformula_b
call mtom
;
; spcs();
call spcs
;
; operator2[7]=*p;
; q=0;
; while(operator2[q]!=*p) {q++;};
ld a,[ix]
call isoperator2
;
; if(operator2priority[q]<entrylevel)
ld c,a
ld b,0
ld hl,charpriorityoperator2
add hl,bc
ld a,[charformula_entrylevel]
ld e,a
ld a,[hl]
cp e
ret nc
; {
; p++;
inc ix
;a=現在の priority level, bc=２項演算子番号
ld hl,ptroperator2
add hl,bc
add hl,bc
ld e,[hl]
inc hl
ld d,[hl]
ld [ptrformula_execaddress],de
call mtox16 ;a保存
ld [charformula_entrylevel],a
; if(getformula00(mustfindlabel, operator2priority[q])) {return(TRUE);};
call getformula00
; if(execoperator2(x, q)) {return(TRUE);}; //result=(x op2 result)
call xtom16
ld hl,floata
ld de,floatc
call mtom
ld hl,floatb
ld de,floatd
call mtom
ld hl,floatformula_a
ld de,floata
call mtom
ld hl,floatformula_b
ld de,floatb
call mtom
ld hl,getf01
push hl
ld hl,[ptrformula_execaddress]
jp [hl]
; goto lbl00;
getf01:
xor a
ld [charformula_leftvalue],a ;左辺値ではない

jr getf00
; }
; else
; {
; return(FALSE);
; };
;}
;
;bool getformula(bool mustfindlabel)
;{
; labelnotfound=FALSE;
;
; return(getformula00(mustfindlabel, 255));
;//エラーの時 TRUE を返す
;//エラー申告は関数最深部にて
;}

charoperator2:
db '+', '-', '*', '/', '^', '=', ','
charoperator2e:

ptroperator2:
dw nadd, nsub, nmul, ndiv, npower, nequal, ncomma

charpriorityoperator2:
db 3, 3, 2, 2, 1, 4, 5, 255

isoperator2: ;a=character --> a=２項演算子コード
ld hl,charoperator2
ld b,charoperator2e-charoperator2
isop200:cp [hl]
jr z,isop210
inc hl
djnz isop200
isop210:
ld a,charoperator2e-charoperator2
sub b
ret

spcs00: inc ix
spcs: ld a,[ix]
cp ' '
jr z,spcs00
ret

mtox16: ;stack push = [formulawork~]
ld hl,[ptrstackpointer]
ld bc,16
and a
sbc hl,bc
;cf=0
ld bc,floatstack
sbc hl,bc
jr c,err4
add hl,bc
ld [ptrstackpointer],hl
ld de,formulawork
ex de,hl
;
mtom16: ;[de~] = [hl~]
ld bc,16
ldir
ret

xtom16: ;[formulawork~] = stack pop
ld hl,[ptrstackpointer]
ld bc,floatstacktop
and a
sbc hl,bc
jr nc,err4 ;スタックが空である
add hl,bc
ld de,formulawork
call mtom16
ld [ptrstackpointer],hl
ret

mtox: ;float stack push = float [hl]
push bc
ex de,hl
ld hl,[ptrstackpointer]
ld bc,6
and a
sbc hl,bc
;cf=0
ld bc,floatstack
sbc hl,bc
jr c,err4
add hl,bc
ld [ptrstackpointer],hl
ex de,hl
pop bc
;
mtom: ;float [de] = float [hl]
push bc
ld bc,6
ldir
pop bc
ret

popacc12:
ld hl,acc2
call xtom
;
popacc1:ld hl,acc1
;
xtom: ;float [hl] = float stack pop
push bc
ex de,hl
ld hl,[ptrstackpointer]
ld bc,floatstacktop
and a
sbc hl,bc
jr nc,err4 ;スタックが空である
add hl,bc
pop bc
call mtom
ld [ptrstackpointer],hl
ret

err1: ld a,1 ;syntax error
jr err

err31: ld a,31 ;unknown error
jr err

err4: ld a,4 ;stack over flow
;
err: ld b,a
ld hl,errmsg
jr errchk00

errchk01:
ld a,[hl]
and a
jr z,err31 ;定義されていないエラー

push bc
ld bc,0
ld a,13
cpir
pop bc

errchk00:
djnz errchk01

ld sp,[sp_work]

call message
call crlf

ld hl,[ptrresume]
jp [hl]

messagekeywait:
ld hl,title10
call message
call keywait
jp crlf

errmsg: ;エラーメッセージ
errmsg01:
db 'syntax/value input error',13 ;1
db 'error on mul',13 ;2
db 'error on div',13 ;3
db 'stack over flow',13 ;4
db 'error on dblqrlp',13 ;5
db 13 ;6
db 'error on hh',13 ;7
db 'error on scale',13 ;8
db 13 ;9
db 13 ;10
db 13 ;11
db 13 ;12
db 'error on scale2',13 ;13
db 13 ;14
db 13 ;15
db 'error on nscp',13 ;16
db 'error on rcpcp',13 ;17
db 'error on nsfast',13 ;18
db 13 ;19
db 13 ;20
db 'error on exp',13 ;21
db 'error on ln',13 ;22
db 'error on power',13 ;23
db 'error on add',13 ;24
db 'error on sub',13 ;25
db 'not left value',13 ;26
db 'error on cos',13 ;27
db 'error on sin',13 ;28
db 'ﾄｸｲｷﾞｮｳﾚﾂｶﾞｹｲｻﾝﾃﾞｷﾏｾﾝ',13 ;29
db 'ｺﾉﾌﾟﾛｸﾞﾗﾑﾊｼﾞｯｿｳｻﾚﾃｲﾏｾﾝ',13 ;30
db 'unknown error',13 ;31
db 'ﾁｭｳﾀﾞﾝｻﾚﾏｼﾀ',13 ;32
db 'ｶｲｶﾞﾑｹﾞﾝﾀﾞｲﾆﾅﾘﾏｼﾀ.ｹｲｻﾝﾃﾞｷﾏｾﾝ',13 ;33
db 'error on jordan',13 ;34
db 0

floatsqrt2: db &00,&80,&33,&f3,&04,&b5 ;sqrt(2)

fsqrt: ;acc1=sqrt(acc1), cf=status
ld hl,acc1
push hl
call is0
pop hl
ret z ;cf=0
bit 7,[hl]
scf
ret nz ;acc1<0

inc hl
ld a,[hl] ;指数部
ld [charwork00],a
ld [hl],128 ;1<=acc1<2とする

;6040 Y0=Y:Y=1+(Y-1)/2 ；SQR Yの概略の近似値を出しておく
ld hl,acc1
ld de,acc3
ld bc,6
ldir

ld hl,float1
ld de,acc2
ld c,6
ldir
call fsub
ret c

ld hl,acc1
call fatn30

ld hl,float1
ld de,acc2
ld bc,6
ldir
call fadd
ret c

;6050 K=1
ld b,8

fsqr00: push bc

;6051 Y1=Y:Y=(Y0/Y+Y)/2:IF Y1<>Y THEN K=K+1:GOTO 6051；平方根を求めるループ
ld hl,acc1
push hl
push hl
ld de,acc4
ld bc,6
ldir
pop hl
ld de,acc2
ld c,6
ldir
ld hl,acc3
pop de
ld c,6
ldir
call fdiv
jr c,fsqrerr

ld hl,acc4
ld de,acc2
ld bc,6
ldir
call fadd
jr c,fsqrerr

ld hl,acc1
call fatn30

ld hl,acc4
ld de,acc1
call fcp

pop bc

jr z,fsqr10

djnz fsqr00

;++++
ld a,'R'
call pcha
call space

jr fsqr10

fsqrerr:pop bc
scf
ret

fsqr10: ld a,[charwork00]
sub 128
sra a
push af
add a,128
ld [acc1+1],a
pop af
ret nc

ld hl,floatsqrt2
ld de,acc2
ld bc,6
ldir

jp fmul

float1div2: db &00,&7f,&00,&00,&00,&80 ;1/2

farctan: ;acc1=arctan(acc1/acc2), cf=status
ld hl,acc1+0
ld a,[hl]
ld [hl],0
ld hl,acc2+0
ld b,[hl]
ld [hl],0
xor b
ld [charwork00],a

ld de,acc2
ld hl,acc1
call fcp
jr c,fatn00

call fdiv
ret c

call fatn10
ret c
jr fatn02
fatn00:
ld hl,acc1
ld de,acc2
ld b,6
fatn01: ld c,[hl]
ld a,[de]
ex de,hl
ld [hl],c
ld [de],a
ex de,hl
inc hl
inc de
djnz fatn01

call fdiv
ret c

call fatn10
ret c

ld hl,floatpidiv2
ld de,acc2
ld bc,6
ldir
ld hl,acc1+0
ld a,[hl]
xor 128
ld [hl],a
call fadd
ret c
fatn02:
ld a,[charwork00]
ld hl,acc1+0
xor [hl]
ld [hl],a
and a
ret ;cf=0

floatfatn0to1div2:
db &00,&7b,&a4,&81,&94,&9d ;x^6
db &80,&7c,&27,&5b,&2c,&a3 ;x^5
db &00,&7c,&fc,&2a,&fd,&df ;x^4
db &80,&7d,&09,&43,&24,&92 ;x^3
db &00,&7d,&22,&69,&cb,&cc ;x^2
db &80,&7e,&6b,&a8,&aa,&aa ;x^1
db &00,&80,&00,&00,&00,&80 ;1

floatfatn1div2to1:
db &80,&7c,&e9,&b8,&13,&8e ;x^5
db &00,&7c,&aa,&a2,&6a,&de ;x^4
db &80,&7d,&3f,&4f,&25,&92 ;x^3
db &00,&7d,&3d,&f0,&cb,&cc ;x^2
db &80,&7e,&ce,&a9,&aa,&aa ;x^1
db &00,&80,&00,&00,&00,&80 ;1

floatarctan1div2:
db &00,&7e,&2b,&38,&63,&ed ;arctan(1/2)

fatn10: ;acc1=arctan(acc1)ただし0<=acc1<=1,cf=status
ld de,float1div2
ld hl,acc1
call fcp
jr c,fatn20

;acc1 <= 1/2
ld hl,acc1
push hl
ld de,acc4
ld bc,6
ldir
pop hl
ld de,acc2
ld c,6
ldir
call fmul
ret c

ld hl,floatfatn0to1div2
ld b,7
call fpolynomial
ret c

ld hl,acc4
ld de,acc2
ld bc,6
ldir
jp fmul

fatn20: ;acc1 > 1/2
;(acc1 - 1/2)/(1 + acc1/2)
ld hl,acc1
push hl
ld de,acc3
ld bc,6
ldir
pop hl
call fatn30
ld hl,float1
ld de,acc2
ld bc,6
ldir
call fadd
ret c
ld hl,acc1
ld de,acc4
ld bc,6
ldir

ld hl,acc3
ld de,acc1
ld bc,6
ldir
ld hl,float1div2
ld de,acc2
ld c,6
ldir
call fsub
ret c

ld hl,acc4
ld de,acc2
ld bc,6
ldir
call fdiv
ret c

ld hl,acc1
push hl
ld de,acc4
ld bc,6
ldir
pop hl
ld de,acc2
ld c,6
ldir
call fmul
ret c

ld hl,floatfatn1div2to1
ld b,6
call fpolynomial
ret c

ld hl,acc4
ld de,acc2
ld bc,6
ldir
call fmul
ret c

ld hl,floatarctan1div2
ld de,acc2
ld bc,6
ldir

jp fadd

fatn30: ;[hl]/2
inc hl
ld a,[hl]
and a
ret z
dec a
ld [hl],a
ret

floatpidiv2: db &00,&80,&a3,&da,&0f,&c9 ;pi/2
floatmpidiv2: db &80,&80,&a3,&da,&0f,&c9 ;-pi/2

floatpi: db &00,&81,&a3,&da,&0f,&c9 ;pi
floatmpi: db &80,&81,&a3,&da,&0f,&c9 ;-pi

floatfsin:
db &80,&66,&04,&5b,&36,&cd ;x^5
db &00,&6d,&2e,&8e,&b8,&b8 ;x^4
db &80,&73,&22,&f1,&0b,&d0 ;x^3
db &00,&79,&39,&86,&88,&88 ;x^2
db &80,&7d,&a5,&aa,&aa,&aa ;x^1
db &00,&80,&00,&00,&00,&80 ;1

floatfcos:
db &00,&63,&15,&5a,&ce,&88 ;x^6
db &80,&6a,&83,&de,&c5,&93 ;x^5
db &00,&70,&85,&d9,&0b,&d0 ;x^4
db &80,&76,&d9,&5c,&0b,&b6 ;x^3
db &00,&7b,&9f,&aa,&aa,&aa ;x^2
db &80,&7f,&00,&00,&00,&80 ;x^1
db &00,&80,&00,&00,&00,&80 ;1

fcos: ;acc1=cos(acc1), cf=status
ld hl,floatpidiv2
ld de,acc2
ld bc,6
ldir
call fadd
ret c
;
fsin: ;acc1=sin(acc1), cf=status
ld hl,acc1+0
ld a,[hl]
ld [charwork00],a
ld [hl],0

ld b,16
fsin00: push bc

ld de,floatpi
ld hl,acc1
call fcp
jr nc,fsin10

ld hl,floatpi
ld de,acc2
ld bc,6
ldir
call fsub

pop bc
ret c
djnz fsin00
scf
ret

fsin10: pop af
ld [charwork01],a

ld de,floatpidiv2
ld hl,acc1
call fcp
jr c,fsin20

;acc1 <= pi/2

ld hl,acc1
push hl
ld de,acc4
ld bc,6
ldir
pop hl
ld de,acc2
ld c,6
ldir
call fmul
ret c

ld hl,floatfsin
ld b,6
call fpolynomial
ret c

ld hl,acc4
ld de,acc2
ld bc,6
ldir
call fmul
ret c

jr fsin30

fsin20: ;acc1 > pi/2
ld hl,floatpidiv2
ld de,acc2
ld bc,6
ldir
call fsub
ret c

ld hl,acc1
ld de,acc2
ld bc,6
ldir
call fmul
ret c

ld hl,floatfcos
ld b,7
call fpolynomial
ret c
;
fsin30: ld a,[charwork01]
rrca
and 128
ld b,a
ld a,[charwork00]
xor b
ld [acc1+0],a
and a
ret ;cf=0

inputbcdacc1: ;[ix~]=character --> acc1=number, cf=status
;cf=0のとき、正常終了、ix=next address
;cf=1のとき、エラー終了、ix=保存
;[acc5]=小数点以上の合計
;[acc6]=小数点以下の合計
;[acc7]=10, 100, 1000, 10000, ...
;[acc8]=10のべき乗

ld [intwork00],ix

ld hl,float1
ld de,acc8
ld bc,6
ldir

xor a
ld [acc5+1],a
ld [acc6+1],a

ld a,[ix]
cp '.'
jp z,inba10

call isnumber
ret c

inba00: push af
ld hl,acc5
ld de,acc1
ld bc,6
ldir
ld hl,float10
ld de,acc2
ld c,6
ldir
call fmul
ld hl,acc1
ld de,acc2
ld bc,6
ldir
pop bc
jr c,inbaerr
ld a,b
call itof
call fadd
jr c,inbaerr
ld hl,acc1
ld de,acc5
ld bc,6
ldir

inc ix
ld a,[ix]
cp '.'
jr z,inba10
cp 'e'
jp z,inba20

call isnumber
jr nc,inba00
;
inbaend:ld hl,acc5
ld de,acc1
ld bc,6
ldir
ld hl,acc6
ld de,acc2
ld c,6
ldir
call fadd
jr c,inbaerr
ld hl,acc8
ld de,acc2
ld bc,6
ldir
call fmul
ret nc
;
inbaerr:ld ix,[intwork00]
scf
ret

inba10: ;[ix]='.'
ld hl,float10
ld de,acc7
ld bc,6
ldir

inba11: inc ix
ld a,[ix]
cp 'e'
jr z,inba20

call isnumber
jr c,inbaend

call itof
ld hl,acc7
ld de,acc2
ld bc,6
ldir
call fdiv
jr c,inbaerr
ld hl,acc6
ld de,acc2
ld bc,6
ldir
call fadd
jr c,inbaerr

ld hl,acc1
ld de,acc6
ld bc,6
ldir

ld hl,acc7
ld de,acc1
ld c,6
ldir

ld hl,float10
ld de,acc2
ld c,6
ldir

call fmul
jr c,inbaerr

ld hl,acc1
ld de,acc7
ld bc,6
ldir

jr inba11

inba20: ;[ix]='e'
inc ix
ld a,[ix]
cp '+'
jr z,inba21
cp '-'
jr z,inba21
call isnumber
jp c,inbaerr
ld a,'+'
dec ix
inba21: inc ix
ex af,af'
call inba30
jp c,inbaerr
ex af,af'
cp '+'
jr z,inba22
ld a,b
neg
ld b,a
inba22: ld a,b
call itof
call fexp10
jp c,inbaerr
ld hl,acc1
ld de,acc8
ld bc,6
ldir
jp inbaend

inba30: ld b,0
ld a,[ix]
call isnumber
ret c
inba31: ld c,a
ld a,b
add a,a
ret c
add a,a
ret c
add a,b
ret c
add a,a
ret c
add a,c
ret c
cp 100
ccf
ret c
ld b,a
inc ix
ld a,[ix]
call isnumber
jr nc,inba31
and a
ret ;cf=0

isnumber: ;a=character --> 数字のとき cf=0, a=数、数字でないとき cf=1
sub '0'
ret c
cp 10
ccf
ret

float10:db &00,&83,&00,&00,&00,&a0 ;10

printbcdacc1: ;[ix~]=bcd acc1
ld hl,[acc1+0]
ld a,h
and a
jr nz,prba00

ld [ix],'0'
inc ix
ret
prba00:
ld a,l
ld [charwork00],a
xor a
ld [acc1+0],a

ld hl,acc1
ld de,acc5
ld bc,6
ldir

ld iy,charwork02

call flog10
call ftoi
bit 7,c
jr z,prba13
neg
prba13:
ld [iy],a
call itof
call fexp10

ld hl,acc1
ld de,acc2
ld bc,6
ldir
ld hl,acc5
ld de,acc1
ld c,6
ldir
call fdiv
prba10:
ld de,acc1
ld hl,float1
call fcp
jr nc,prba11
;acc1<1
ld hl,float10
ld de,acc2
ld bc,6
ldir
call fmul
dec [iy]
jr prba10
prba11:
ld de,acc1
ld hl,float10
call fcp
jr c,prba12
;acc1>=10
ld hl,float10
ld de,acc2
ld bc,6
ldir
call fdiv
inc [iy]
jr prba10
prba12:
ld iy,charwork01

call ftoi
ld [iy],a
inc iy

ld b,8
prba20:
push bc

ld hl,acc1
ld de,acc2
ld bc,6
ldir
call itof
ld a,128
ld [acc1+0],a
call fadd
ld hl,acc1
ld de,acc2
ld bc,6
ldir
ld a,10
call itof
call fmul
call ftoi
ld [iy],a
inc iy

pop bc
djnz prba20

ld hl,charwork00
ld a,[hl]
and a
ld a,'+'
jr z,prba30
ld a,'-'
prba30: ld [ix],a
inc ix

ld hl,charwork01+8
ld a,[hl]
ld [hl],0
cp 5
jr c,prba31
ld b,8
prba32:
ld [hl],0
dec hl
inc [hl]
ld a,[hl]
cp 10
jr c,prba31
djnz prba32

ld [hl],1
ld hl,charwork02
inc [hl]
prba31:
ld hl,charwork01
ld a,[charwork02]
ld c,a
ld b,8
and a
jp m,prba33
cp 8
jr nc,prba40

;xxxx.yyyy
inc c
prba60:
ld a,[hl]
inc hl
add a,'0'
ld [ix],a
inc ix
dec b
dec c
jr nz,prba60

inc b
dec b
ret z

call prba70
ret z

ld [ix],'.'
inc ix
prba61:
ld a,[hl]
inc hl
add a,'0'
ld [ix],a
inc ix
call prba70
ret z
djnz prba61
ret

prba33: cp -3
jr c,prba40
;
prba50: ;0.000xxxx
ld [ix],'0'
inc ix
ld [ix],'.'
inc ix
jr prba51
prba52:
ld [ix],'0'
inc ix
prba51: inc c
jr nz,prba52
jr prba61

prba40: ;x.yyyyyezz
ld a,[hl]
inc hl
add a,'0'
ld [ix],a
inc ix

ld b,7

call prba70
jr z,prba42

ld [ix],'.'
inc ix
prba41:
ld a,[hl]
inc hl
add a,'0'
ld [ix],a
inc ix
call prba70
jr z,prba42
djnz prba41
prba42:
ld [ix],'e'
inc ix
ld a,[charwork02]
ld b,a
jp printbcdb

prba70: push bc
push hl
prba71: ld a,[hl]
inc hl
and a
jr nz,prba72
djnz prba71
prba72: pop hl
pop bc
ret

fcp: ;[de] - [hl] --> zf,cf=status
push de
ld de,ftmpx ;[ftmpx]=[hl]
ld bc,6
ldir
pop hl
ld de,ftmpy ;[ftmpy]=[de]
ld c,6
ldir

ld hl,ftmpy
push hl
call is0
pop hl
jr z,cp00
ld a,[hl]
and a
jr z,cp01
ld b,0 ;[y]<0
jr cp02
cp00: ld b,1 ;[y]==0
jr cp02
cp01: ld b,2 ;[y]>0
cp02:
ld hl,ftmpx
push hl
call is0
pop hl
jr z,cp10
ld a,[hl]
and a
jr z,cp11
ld a,0 ;[x]<0
jr cp12
cp10: ld a,3 ;[x]==0
jr cp12
cp11: ld a,6 ;[x]>0
cp12:
add a,b
jr z,xlt0ylt0
dec a
jr z,xlt0yeq0
dec a
jr z,xlt0ygt0
dec a
jr z,xeq0ylt0
dec a
jr z,xeq0yeq0
dec a
jr z,xeq0ygt0
dec a
jr z,xgt0ylt0
dec a
jr z,xgt0yeq0
dec a
jr z,xgt0ygt0

xlt0ylt0: ;(-) - (-)
call xgt0ygt0
ret z
jr c,cp21
scf
ret
cp21: ld a,1
and a
ret ;zf=0, cf=0

xlt0yeq0: ;(0) - (-)
xlt0ygt0: ;(+) - (-)
xeq0ygt0: ;(+) - (0)
ld a,1
sub 0
ret

xeq0ylt0: ;(-) - (0)
xgt0ylt0: ;(-) - (+)
xgt0yeq0: ;(0) - (+)
ld a,0
sub 1
ret

xeq0yeq0: ;(0) - (0)
sub a
ret

xgt0ygt0: ;(+) - (+)
ld de,ftmpy+1
ld hl,ftmpx+1
ld a,[de]
cp [hl]
ret nz
ld de,ftmpy+5
ld hl,ftmpx+5
ld b,4
xgt0ygt000:
ld a,[de]
dec de
cp [hl]
dec hl
ret nz
djnz xgt0ygt000
ret

floatflog2:
db &00,&7e,&18,&2d,&73,&b4 ;x^5
db &00,&7e,&ff,&2c,&0b,&9e ;x^4
db &00,&7e,&45,&ad,&66,&d3 ;x^3
db &00,&7f,&e8,&3d,&ba,&93 ;x^2
db &00,&7f,&42,&51,&38,&f6 ;x^1
db &00,&81,&29,&3b,&aa,&b8 ;x^0

float2: db &00,&81,&00,&00,&00,&80 ;2

floatlog2divlog10:
db &00,&7e,&85,&9a,&20,&9a ;log 2 / log 10

floatlog2:
db &00,&7f,&f8,&17,&72,&b1 ;log 2

flog: ;acc1=x --> acc1=log(x), cf=status
call flog2
ret c
ld hl,floatlog2
ld de,acc2
ld bc,6
ldir
jp fmul

flog10: ;acc1=x --> acc1=log10(x), cf=status
call flog2
ret c
ld hl,floatlog2divlog10
ld de,acc2
ld bc,6
ldir
jp fmul

flog2: ;acc1=x --> acc1=log2(x), cf=status
ld hl,[acc1+0]
ld a,h
and a
scf
ret z
bit 7,l
scf
ret nz

sub 128
push af

ld a,128
ld [acc1+1],a
ld hl,float1
ld de,acc2
ld bc,6
ldir
call fsub
jp c,flog2e

;acc4 = acc1/(2 + acc1)
ld hl,acc1
ld de,acc3
ld bc,6
ldir
ld hl,float2
ld de,acc2
ld c,6
ldir
call fadd
jr c,flog2e
ld hl,acc1
ld de,acc2
ld bc,6
ldir
ld hl,acc3
ld de,acc1
ld c,6
ldir
call fdiv
jr c,flog2e
ld hl,acc1
push hl
ld de,acc4
ld bc,6
ldir
;acc1=acc4^2
pop hl
ld de,acc2
ld c,6
ldir
call fmul
jr c,flog2e

ld hl,floatflog2
ld b,6
call fpolynomial
jr c,flog2e

ld hl,acc4
ld de,acc2
ld bc,6
ldir
call fmul
jr c,flog2e

ld hl,acc1
ld de,acc2
ld bc,6
ldir

pop af

call itof

jp fadd

flog2e: pop bc
scf
ret

fsinh: ;acc1=x --> acc1=sinh(x), cf=status ==(exp(x) - exp(-x))/2
call fexp
jp c,err21
ld hl,acc1
ld de,acc3
call mtom ;acc3=exp(x)
call frcp ;acc1=exp(-x)
jp c,err3

ld hl,acc1
call chs

fsinh00:ld hl,acc3
ld de,acc2
call mtom

call fadd
jp c,err24

ld hl,acc1
call fatn30 ;[hl]/2
and a
ret ;cf=0

fcosh: ;acc1=x --> acc1=cosh(x), cf=status ==(exp(x) + exp(-x))/2
call fexp
jp c,err21
ld hl,acc1
ld de,acc3
call mtom ;acc3=exp(x)
call frcp ;acc1=exp(-x)
jr nc,fsinh00
jp err3

floatfexp2:
db &00,&70,&a1,&b5,&b8,&b5 ;x^7
db &00,&73,&33,&21,&f0,&95 ;x^6
db &00,&76,&a0,&08,&05,&b0 ;x^5
db &00,&79,&e5,&78,&82,&9d ;x^4
db &00,&7b,&38,&75,&59,&e3 ;x^3
db &00,&7d,&09,&e7,&fd,&f5 ;x^2
db &00,&7f,&0e,&18,&72,&b1 ;x^1
float1: db &00,&80,&00,&00,&00,&80 ;1

floatlog10divlog2:
db &00,&81,&4b,&78,&9a,&d4 ;log 10 / log 2

float1divlog2:
db &00,&80,&29,&3b,&aa,&b8 ;1 / log(2)

fexp: ;acc1=x --> acc1=e^x, cf=status
ld hl,float1divlog2
ld de,acc2
ld bc,6
ldir
call fmul
ret c
jr fexp2

fexp10: ;acc1=x --> acc1=10^x, cf=status
ld hl,floatlog10divlog2
ld de,acc2
ld bc,6
ldir
call fmul
ret c
;
fexp2: ;acc1=x --> acc1=2^x, cf=status
ld a,[acc1+0]
add a,a
jr nc,fexp200

call ftoi
jr c,fexp210 ;2^LT(-127)

xor a
ld [acc1+0],a
call fexp200
ret c
ld hl,acc1
ld de,acc2
ld bc,6
ldir
ld hl,float1
ld de,acc1
ld c,6
ldir
jp fdiv

fexp210:xor a
ld [acc1+1],a
ret ;cf=0

fexp200:call ftoi
ret c
push af
ld hl,acc1
ld de,acc2
ld bc,6
ldir
call itof
ld a,128
ld [acc1+0],a
call fadd
pop bc
ret c
push bc
ld hl,floatfexp2
ld b,8
call fpolynomial
pop bc
ret c
ld a,[acc1+1]
and a
ret z ;cf=0
add a,b
ld [acc1+1],a
ret ;cf=status

fpolynomial: ;acc1=x, hl=ptr constant, b=count --> acc1=polynomial, cf=status
exx
ld hl,acc1
ld de,acc3
ld bc,6
ldir
exx
push bc
ld de,acc2
ld bc,6
ldir
push hl
call fmul
pop hl
pop bc
ret c

djnz fpoly00

ret ;cf=0

fpoly01:
exx
ld hl,acc3
ld de,acc2
ld bc,6
ldir
exx
push bc
push hl
call fmul
pop hl
pop bc
ret c
fpoly00:
push bc
ld de,acc2
ld bc,6
ldir
push hl
call fadd
pop hl
pop bc
ret c

djnz fpoly01

ret ;cf=0

printbcdb: ;[ix~] = bcd b
inc b
dec b
jr nz,pbcdb00

ld [ix],'0'
inc ix
ret
pbcdb00:
bit 7,b
ld a,'+'
jr z,pbcdb10
ld a,b
neg
ld b,a
ld a,'-'
pbcdb10:
ld [ix],a
inc ix

ld c,0
ld a,b

ld b,100
call pbcdb20
ld b,10
call pbcdb20
add a,'0'
ld [ix],a
inc ix
ret

pbcdb20:ld d,-1
pbcdb21:
inc d
sub b
jr nc,pbcdb21

add a,b

ex af,af'
ld a,d
and a
jr z,pbcdb22

add a,'0'
ld [ix],a
inc ix
ld c,1
jr pbcdb23
pbcdb22:
inc c
dec c
jr z,pbcdb23

ld [ix],'0'
inc ix

pbcdb23:ex af,af'
ret

itof: ;a=int --> acc1=float
and a
jr nz,itof00

ld [acc1+1],a
ret
itof00:
jp p,itof02

ex af,af'
ld a,128
ld [acc1+0],a
ex af,af'
neg
jr itof01
itof02:
ex af,af'
xor a
ld [acc1+0],a
ex af,af'
itof01:
ld bc,(128+8)*256+0
itof10: dec b
add a,a
jr nc,itof10
rra
ld hl,acc1+1
ld [hl],b
inc hl
ld [hl],c ;+2
inc hl
ld [hl],c ;+3
inc hl
ld [hl],c ;+4
inc hl
ld [hl],a ;+5
ret

ftoi: ;acc1 --> a=int abs acc1, c=sign, cf=status
ld bc,[acc1+0]
ld a,b
and a
ret z ;cf=0
sub 128
jr c,ftoi00
inc a
ld b,a
ld hl,[acc1+5]
ld h,0
ftoi10:
add hl,hl
bit 7,h
scf
ret nz
djnz ftoi10
ld a,h
and a
ret ;cf=0

ftoi00: xor a
ret ;cf=0

fsub: ;acc1=acc1-acc2, cf=status
ld a,[acc2+0]
xor 128
ld [acc2+0],a
;
fadd: ;acc1=acc1+acc2, cf=status
ld hl,acc2
call is0
ret z ;cf=0
ld hl,acc1
call is0
jr nz,fadd00

ld hl,acc2
ld de,acc1
ld bc,6
ldir
and a ;cf=0
ret
fadd00:
ld bc,0
ld hl,[acc1+2]
ld de,[acc2+2]
exx
ld hl,[acc1+4]
ld de,[acc2+4]

ld a,[acc2+1]
ld b,a
ld a,[acc1+1]
sub b
ld b,a
jr nz,fadd10

ld a,h
cp d
jr nz,fadd10
ld a,l
cp e
jr nz,fadd10

exx
ld a,h
cp d
jr nz,fadd11
ld a,l
cp e

fadd11: exx

fadd10:
jr nc,fadd20

;abs acc2 > abs acc1

ld a,[acc2+1]
ld [acc1+1],a

ld a,[acc2+0]
ld c,a
ex af,af'
ld a,[acc1+0]
cp c
ex af,af'
ld [acc1+0],a

ld a,b
neg
ld b,a

ex de,hl
exx
ex de,hl
exx
jr fadd21

fadd20:
;abs acc1 >= abs acc2

ld a,[acc1+0]
ld c,a
ex af,af'
ld a,[acc2+0]
cp c
ex af,af'
fadd21:
ld a,b
and a
jr z,fadd22

cp 40
jp nc,fadd30

cp 8
jr c,fadd23

sub 8
ld b,a
exx
ld c,e
ld e,d
exx
ld a,e
exx
ld d,a
exx
ld e,d
ld d,0
jr fadd21
fadd23:
srl d
rr e
exx
rr d
rr e
rr c
exx
djnz fadd23
fadd22:
ld a,[acc1+1]
ld b,a

ex af,af'
jr nz,fsub40

;同符号
exx
ld a,b
add a,c
ld b,a
adc hl,de
exx
adc hl,de
jr nc,fadd41

inc b
scf
ret z ;cf=1
rr h
rr l
exx
rr h
rr l
rr b
exx
fadd41:
;丸め
exx
bit 7,b
jr z,fadd42

inc l
jr nz,fadd42
inc h
jr nz,fadd42
exx
inc l
jr nz,fadd43
inc h
jr nz,fadd43
ld h,&80
inc b
scf
ret z ;cf=1
jr fadd43

fadd42: exx

fadd43: ld [acc1+0],bc
ld [acc1+4],hl
exx
ld [acc1+2],hl
and a ;cf=0
ret

fsub40: ;異符号
exx
ld a,b
sub c
ld b,a
sbc hl,de
exx
sbc hl,de

ld a,h
or l
exx
or h
or l
or b
exx
jr nz,fsub41

fsub43: xor a
ld [acc1+1],a
ret ;cf=0

fsub41: ld a,h
and a
jr nz,fsub42

ld a,b
sub 8
jr c,fsub43
jr z,fsub43
ld b,a

ld h,l
exx
ld a,h
exx
ld l,a
exx
ld h,l
ld l,b
exx
jr fsub41

fsub42: bit 7,h
jr nz,fadd41 ;丸め

exx
sla b
adc hl,hl
exx
adc hl,hl

dec b
jr nz,fsub42
jr fsub43

fadd30: ld a,c
ld [acc1+0],a
ld [acc1+4],hl
exx
ld [acc1+2],hl
and a ;cf=0
ret

frcp: ;acc1=1/acc1, cf=status
ld hl,acc1
ld de,acc2
call mtom
ld hl,float1
ld de,acc1
call mtom
;
fdiv: ;acc1=acc1/acc2, cf=status
ld hl,acc2
call is0
scf
ret z
ld hl,acc1
call is0
ret z ;cf=0

ld hl,[acc1+2]
ld de,[acc2+2]
ld bc,0
exx
ld hl,[acc1+4]
ld de,[acc2+4]

ld bc,&0800
call fdiv00
jr nc,fdiv12
exx
inc b
add hl,hl
exx
adc hl,hl
;(cf=1)
jr fdiv15

fdiv10: call fdiv00
jr c,fdiv14

fdiv12: scf
fdiv15: rl c
exx
;(cf=0)
sbc hl,de
exx
sbc hl,de
;
fdiv11: exx
add hl,hl
exx
adc hl,hl
jr nc,fdiv13

djnz fdiv15 ;cf=1

ld a,c
ld [acc1+5],a
;next(sub32 OK)
ld bc,&0800
jr fdiv22

fdiv14: and a ;cf=0
rl c
jr fdiv11

fdiv13: djnz fdiv10
ld a,c
ld [acc1+5],a
;next

ld bc,&0800
fdiv20: call fdiv00
jr c,fdiv24

fdiv22: scf
fdiv25: rl c
exx
;(cf=0)
sbc hl,de
exx
sbc hl,de
;
fdiv21: exx
add hl,hl
exx
adc hl,hl
jr nc,fdiv23

djnz fdiv25 ;cf=1

ld a,c
ld [acc1+4],a
;next(sub32 OK)
ld bc,&0800
jr fdiv32

fdiv24: and a ;cf=0
rl c
jr fdiv21

fdiv23: djnz fdiv20
ld a,c
ld [acc1+4],a
;next

ld bc,&0800
fdiv30: call fdiv00
jr c,fdiv34

fdiv32: scf
fdiv35: rl c
exx
;(cf=0)
sbc hl,de
exx
sbc hl,de
;
fdiv31: exx
add hl,hl
exx
adc hl,hl
jr nc,fdiv33

djnz fdiv35 ;cf=1

ld a,c
ld [acc1+3],a
;next(sub32 OK)
ld bc,&0800
jr fdiv42

fdiv34: and a ;cf=0
rl c
jr fdiv31

fdiv33: djnz fdiv30
ld a,c
ld [acc1+3],a
;next

ld bc,&0800
fdiv40: call fdiv00
jr c,fdiv44

fdiv42: scf
fdiv45: rl c
exx
;(cf=0)
sbc hl,de
exx
sbc hl,de
;
fdiv41: exx
add hl,hl
exx
adc hl,hl
jr nc,fdiv43

djnz fdiv45 ;cf=1

ld a,c
ld [acc1+2],a
;next(sub32 OK)
jr fdiv52

fdiv44: and a ;cf=0
rl c
jr fdiv41

fdiv43: djnz fdiv40
ld a,c
ld [acc1+2],a
;next

call fdiv00
jr c,fdiv51
fdiv52:
ld hl,[acc1+4]
exx
ld hl,[acc1+2]
inc l
jr nz,fdiv53
inc h
jr nz,fdiv53
exx
inc l
jr nz,fdiv54
inc h
jr nz,fdiv54
ld h,&080
exx
inc c
exx
;
fdiv54: exx
fdiv53: ld [acc1+2],hl
exx
ld [acc1+4],hl
fdiv51:
ld a,[acc1+1]
ld b,a
ld a,[acc2+1]
sub 128
jr nc,fdiv60

neg
ld c,a
ld a,b
add a,c
jr nc,fdiv61
ret ;cf=1

fdiv60: ld c,a
ld a,b
sub c
jr z,fdiv70
jr c,fdiv70
;
fdiv61: exx
sub b
jr z,fdiv70
add a,c
ret c

ld [acc1+1],a

ld a,[acc1+0]
ld b,a
ld a,[acc2+0]
xor b
ld [acc1+0],a

ret ;cf=0

fdiv70: xor a
ld [acc1+1],a
ret ;cf=0

fdiv00: ;compare hl:hl' - de:de'--> cf=status
ld a,h
cp d
ret nz
ld a,l
cp e
ret nz
exx
ld a,h
cp d
jr nz,fdiv01
ld a,l
cp e
;
fdiv01: exx
ret

fmul: ;acc1=acc1*acc2, cf=status
ld hl,acc1
call is0
ret z ;cf=0
ld hl,acc2
call is0
jp z,fmul00

ld a,[acc1+2]
ld d,a
exx
ld bc,[acc1+3]
ld a,[acc1+5]
ld d,a
xor a
ex af,af'
xor a
ld h,a
ld l,a
exx
ld e,a
ld h,a
ld l,a

ld bc,[acc2+5]
ld b,8
fmul10: sla c
jr c,fmul11
exx
jr fmul12
fmul11: add hl,de
exx
adc hl,bc
adc a,d
jr nc,fmul12
ex af,af'
inc a
ex af,af'
fmul12: srl d
rr b
rr c
exx
rr d
rr e
djnz fmul10

ld bc,[acc2+4]
inc c
dec c
jr nz,fmul201

push af
ld e,d
exx
ld a,c
exx
ld d,a
exx
ld c,b
ld b,d
exx
pop af
jr fmul300

fmul201:
ld b,8
fmul20: sla c
jr c,fmul21
exx
jr fmul22
fmul21: add hl,de
exx
adc hl,bc
adc a,d
jr nc,fmul22
ex af,af'
inc a
ex af,af'
fmul22: srl b
rr c
exx
rr d
rr e
djnz fmul20

fmul300:
ld bc,[acc2+3]
inc c
dec c
jr nz,fmul301

push af
ld e,d
exx
ld a,c
exx
ld d,a
exx
ld c,b
exx
pop af
jr fmul400

fmul301:
ld b,8
fmul30: sla c
jr c,fmul31
exx
jr fmul32
fmul31: add hl,de
exx
adc hl,bc
adc a,d
jr nc,fmul32
ex af,af'
inc a
ex af,af'
fmul32: srl c
exx
rr d
rr e
djnz fmul30

fmul400:
ld bc,[acc2+2]
inc c
dec c
jr z,fmul501

ld b,8
fmul40: sla c
jr nc,fmul41
add hl,de
exx
adc hl,bc
adc a,d
jr nc,fmul42
ex af,af'
inc a
ex af,af'
fmul42: exx
fmul41: srl d
rr e
djnz fmul40

fmul501:
exx
ld c,a
ld a,[acc1+1]
ld b,a
ex af,af'

fmul50: and a
jr z,fmul51
;cf=0
rra
rr c
rr h
rr l
exx
rr h
rr l
exx
inc b
jr nz,fmul50

fmul54: scf
ret ;over flow
fmul51:
exx
bit 7,l
jr z,fmul52
inc h
jr nz,fmul52
exx
inc l
jr nz,fmul53
inc h
jr nz,fmul53
inc c
jr nz,fmul53
ld c,&80
inc b
jr z,fmul54

fmul53: exx

fmul52:
ld a,h
ld [acc1+2],a
exx
ld [acc1+3],hl
ld a,c
ld [acc1+5],a

ld a,[acc2+1]
sub 128
jr nc,fmul60

neg
ld c,a
ld a,b
sub c

jr c,fmul00
jr z,fmul00

jr fmul61
fmul60:
ld c,a
ld a,b
add a,c
jr c,fmul54

fmul61:
ld [acc1+1],a

ld a,[acc1+0]
ld b,a
ld a,[acc2+0]
xor b
ld [acc1+0],a

ret ;cf=0

fmul00: xor a
ld [acc1+1],a
ret ;cf=0

is0: ;hl==ptr acc --> zf=status, cf=0
inc hl
ld a,[hl]
and a
ret

frnd: ;[floatrndacc]=1.0~2.0の乱数
ld hl,floatrndacc
push hl
call mtox
ld hl,floatpi
call mtox
call mul
pop hl
call xtom
frnd00:
ld hl,float1
ld de,floatrndacc
push de
call fcp ;rndacc - float1
pop hl
jr c,frnd10

push hl
call mtox
ld hl,float1
call mtox
call sb
pop hl
call xtom
jr frnd00
frnd10:
push hl
call mtox
ld hl,float1
call mtox
call ad
pop hl
jp xtom

title00: db 'Matrix for MZ-80B Ver 2.10',13
title01: db '(C) 2008-2009, 2016 by someone',13
title10: db 'ﾂﾂﾞｹﾙﾆﾊﾄﾞﾚｶｷ- ｦｵｼﾃｸﾀﾞｻｲ...',13
title20: db 'Matrix ｦｼｭｳﾘｮｳｼﾏｽｶ ?(y/n)',13
title30: db 'ｷﾞｮｳﾚﾂﾒﾓﾘ- ﾘｮｳｲｷ=',13
title31: db 'ﾊﾟﾗﾒ-ﾀﾒﾓﾘ- ﾘｮｳｲｷ=',13

initstackpointer:
ld hl,floatstacktop
ld [ptrstackpointer],hl
ret

;2009 E0=0.000001:E1=0.000001:E2=0.000001:E3=0:E4=0.000001:E5=0.000001
floatinite0:
db &00,&6c,&05,&bd,&37,&86 ;e0 デフォルト値
db &00,&6c,&05,&bd,&37,&86 ;e1 デフォルト値
db &00,&6c,&05,&bd,&37,&86 ;e2 デフォルト値
db &00,&00,&00,&00,&00,&00 ;e3 デフォルト値
db &00,&6c,&05,&bd,&37,&86 ;e4 デフォルト値
db &00,&6c,&05,&bd,&37,&86 ;e5 デフォルト値
db &00,&6c,&05,&bd,&37,&86 ;e6 デフォルト値 (jordan分解)

;MUSTSCALE=1:MUSTSCALE2=1:MUSTEIGEN34=1:MUSTNSFAST=1
actionparameterinit:
db 1 ;mustscale デフォルト値
db 1 ;mustscale2 デフォルト値
db 1 ;musteigen34 デフォルト値
db 1 ;mustnsfastデフォルト値

inite0e5:
ld hl,floatinite0
ld de,floate0
ld bc,6*7
ldir

ld hl,actionparameterinit
ld de,actionparameter
ld bc,actionparameterend-actionparameter
ldir

ret

initrndacc: ;乱数アキュムレーターの初期化
ld hl,float1
ld de,floatrndacc
jp mtom

init: ;a=0ならばコールドスタート、a=0でなければホットスタート
push af

call initstackpointer

call initrndacc

ld hl,complextmpatof
ld de,complextmpatof+1
ld bc,12*matrixsize*3-1
ld [hl],0
ldir

pop af
and a
jr nz,init00

call inite0e5

ld hl,matrixa
ld de,matrixa+1
ld bc,6*(13+enhancememorysize)*2*matrixsize*matrixsize-1
ld [hl],0
ldir
init00:
ld a,2
call setcharn

ld hl,0
ld [usercursor1],hl

call drawmatrixinit
xor a
ld [ismodified],a

ret

hotstart: ;ホットスタート
ld [sp_work],sp

ld a,1
call init

jr main

start: ld [sp_work],sp

xor a
call init

ld hl,title00
call message
call crlf
ld hl,title01
call message
call crlf
ld hl,title10
call message
call keywait
call crlf
;
main:
call inputmatrix
ld [sp_work],sp
jr nc,main20

ld hl,title20
call message
call keywait
cp 'y'
jp z,mainend
jr main
main20:
;[ix~]=行列に対するコマンド文字列
ld hl,mainerr
ld [ptrresume],hl

ld a,[ix]

cp '0'
jr nz,func30
call ldmatrixzero
jr main
func30:
cp '1'
jr nz,func31
call ldmatrixidentity
jr main
func31:
call ismatrixoperator1
cp charmatrixoperator1e-charmatrixoperator1
jr z,func10

ex af,af'
inc ix
call spcs
ld a,[ix]
cp 13
jr z,func00

;スカラー計算
ex af,af'
ld hl,ptrmatrixscalar
call func0000

ld de,main
push de
push hl

call initstackpointer
call getformula
ld a,[ix]
cp 13
jp nz,err1

ld hl,floata
ld de,floatx
ld bc,12
ldir

ret

func00: ;行列同士の計算
ex af,af'
ld hl,ptrmatrixoperator1
call func0000

ld de,main
push de
jp [hl]
func10:
call getalphalength
inc b
dec b
jp z,err1

ld hl,stringmatrixcommand
call isst00
jr c,func20

;各種コマンド
push hl
call getalphalength
push hl
pop ix
pop hl

ld de,main
push de
jp [hl]

func20: call isstringoperator1
jp c,err1

;行列の関数
push hl
call getalphalength
push hl
pop ix
pop hl
call spcs
ld a,[ix]
cp 13
jp nz,err1

ld [ptrmatrixfunction],hl
call matrixfunction
jp main

mainerr:call messagekeywait
jp main

mainend:ld sp,[sp_work]
call crlf

ld hl,title30
call message
ld hl,datastart70
call hex
ld a,'-'
call pcha
ld hl,datastart80
call hex
call crlf

ld hl,title31
call message
ld hl,datastartp
call hex
ld a,'-'
call pcha
ld hl,dataendp
call hex
call crlf

jp monitor

ldmatrixzero: ;[matrixa,n]=zero matrix
call ldmz00
ld hl,matrixa
ld de,matrixa+1
ld bc,6*matrixsize*matrixsize-1
ld [hl],0
ldir
ld hl,matrixn
ld de,matrixn+1
ld bc,6*matrixsize*matrixsize-1
ld [hl],0
ldir
ret

ldmatrixidentity: ;[matrixa,n]=identity matrix
call ldmatrixzero
xor a
ldmi00: push af

ld [ptr1],a
ld [ptr2],a
call getoffset
ld hl,matrixa
add hl,bc
call mv1

pop af
inc a
ld hl,charn
cp [hl]
jr nz,ldmi00
ret

ldmz00: inc ix
call spcs
ld a,[ix]
cp 13
ret z
jp err1

func0000: ;a=コード、hl=実行アドレステーブル --> hl=実行アドレス
ld c,a
ld b,0
add hl,bc
add hl,bc
ld a,[hl]
inc hl
ld h,[hl]
ld l,a
ret

ismatrixoperator1: ;a=character --> a=単項演算子コード
ld hl,charmatrixoperator1
ld b,charmatrixoperator1e-charmatrixoperator1
ismo100:cp [hl]
jr z,ismo110
inc hl
djnz ismo100
ismo110:
ld a,charmatrixoperator1e-charmatrixoperator1
sub b
ret

charmatrixoperator1:
db '+', '-', '*', '/', '^'
charmatrixoperator1e:

ptrmatrixoperator1:
dw madd, msub, mmul, mdiv, err1

ptrmatrixscalar:
dw msadd, mssub, msmul, msdiv, mspower

stringmatrixcommand:
db 2,'mr'
dw matrixmr
db 3,'min'
dw matrixmin
db 7,'inverse'
dw nrcpcp
db 5,'eigen'
dw meigen
db 2,'hh'
dw matrixhh
db 3,'rnd'
dw matrixrnd
db 2,'ul'
dw matrixul
db 2,'ut'
dw matrixut
db 2,'lt'
dw matrixlt
db 2,'re'
dw matrixre
db 4,'test'
dw matrixtest
db 6,'jordan'
dw matrixjordan
db 0

;****** bios for mz-80b

_monitor= &00b1
_pcha= &08c6
_hex4= &05f3
_input= &06a4
_maxinputstroke=&06a2
_ptrinputdata= &1093
_inkey= &0832
_dspxy= &11d1
_breaky= &0562

breaky: jp _breaky ;breakキーが押されているときzf=1、押されていないときzf=0

clearscreen: ;画面をクリアする
ld a,6
jp _pcha

setcursor: ;h=0~39, l=0~19 --> カーソル設定
ld a,h
ld [_dspxy+0],a
ld a,l
ld [_dspxy+1],a
ret

keywait: ;キー入力待ち --> a=key code（待っている間、乱数を発生し続ける）
push ix
push iy
push hl
push de
push bc
exx
push hl
push de
push bc
call frnd
pop bc
pop de
pop hl
exx
pop bc
pop de
pop hl
pop iy
pop ix
call _inkey
and a
jr z,keywait
cp 'A'
ret c
cp 'Z'+1
ret nc
add a,&20
ret

;_input de=入力バッファアドレス
; [_maxinputstroke]: 最大入力文字数（最大79まで設定可）
; [_ptrinputdata+0]=&0b :breakキーが押された
; [_ptrinputdata~]=入力データ（13で終わる）

input: ;cf=0:enterキーが押された
;cf=1:breakキーが押された
;[_ptrinputdata~]=入力データ（大文字を小文字に変換、13で終わる）
ld a,79
ld [_maxinputstroke],a
ld de,_ptrinputdata
call _input ;de保存
ex de,hl
ld a,[hl]
cp &0b
scf
ret z ;cf=1

input00:ld a,[hl]
cp 13
ret z ;cf=0
cp 'A'
jr c,input01
cp 'Z'+1
jr nc,input01
add a,&20
ld [hl],a
input01:inc hl
jr input00

monitor:jp _monitor

crlf: ld a,13
;
pcha: jp _pcha

space: ld a,' '
jr pcha

hex: push hl
push hl
ld a,h
call hex8
pop hl
ld a,l
call hex8
pop hl
ret

hex8: push af
rra
rra
rra
rra
and &0f
call _hex4
call _pcha
pop af
and &0f
call _hex4
jr pcha

message: ;hl:pointer, end mark=&0d
ld a,[hl]
cp &0d
ret z
call _pcha
inc hl
jr message

;******プログラム終了
endaddress:

datastart00=endaddress ;float 作業用

acc1= datastart00+6*0
acc2= datastart00+6*1
acc3= datastart00+6*2
acc4= datastart00+6*3
acc5= datastart00+6*4
acc6= datastart00+6*5
acc7= datastart00+6*6
acc8= datastart00+6*7
ftmpx= datastart00+6*8
ftmpy= datastart00+6*9
fnlna= datastart00+6*10
fnlnb= datastart00+6*11
fnlnc= datastart00+6*12
fdr= datastart00+6*13
fdi= datastart00+6*14
faw= datastart00+6*15
fd1r= datastart00+6*16
fd1i= datastart00+6*17
fd2r= datastart00+6*18
fd2i= datastart00+6*19
fss= datastart00+6*20
fun= datastart00+6*21
floatar= datastart00+6*22
floatai= datastart00+6*23
floatbr= datastart00+6*24
floatbi= datastart00+6*25
fsr= datastart00+6*26
fsi= datastart00+6*27
fb1r= datastart00+6*28
fb1i= datastart00+6*29
fb2r= datastart00+6*30
fb2i= datastart00+6*31
fb3r= datastart00+6*32
fb3i= datastart00+6*33
floata00r= datastart00+6*34
floata00i= datastart00+6*35
floata01r= datastart00+6*36
floata01i= datastart00+6*37
floata10r= datastart00+6*38
floata10i= datastart00+6*39
floata11r= datastart00+6*40
floata11i= datastart00+6*41
fpp= datastart00+6*42
fcc= datastart00+6*43
floatrndacc= datastart00+6*44 ;乱数アキュムレーター
floatsc= datastart00+6*45 ;スケール倍率(scale2)

datastart10=datastart00+6*46 ;int 作業用

intwork00=datastart10+2*0
sp_work=datastart10+2*1 ;spレジスタ保存
ptrresume=datastart10+2*2 ;エラー発生時の復帰アドレス
ptrmatrixfunction=datastart10+2*3 ;行列の関数(nexp, nlnなど)
intwork10=datastart10+2*4
intwork20=datastart10+2*5
intwork21=datastart10+2*6
intwork22=datastart10+2*7
intwork23=datastart10+2*8
intwork30=datastart10+2*9
intwork31=datastart10+2*10
inttmp0=datastart10+2*11
inttmp1=datastart10+2*12
inttmp2=datastart10+2*13
sp_work2=datastart10+2*14

datastart20=datastart10+2*15 ;char 作業用

charwork00=datastart20+1*0
charwork01=datastart20+1*1
charwork02=datastart20+1*10
ptr1=datastart20+1*11 ;行列へのポインタ
ptr2=datastart20+1*12 ;行列へのポインタ
charwork10=datastart20+1*13 ;行列表示用8バイト：横方向最大文字数
charn= datastart20+1*21 ;行列の次数 n
charn1= datastart20+1*22 ;n-1
ismodified=datastart20+1*23 ;行列要素の変更があったとき=1、無いとき=0
usercursor1=datastart20+1*24 ;ユーザーカーソル
usercursor2=datastart20+1*25 ;ユーザーカーソル
chari= datastart20+1*26
charj= datastart20+1*27
chark= datastart20+1*28
charl= datastart20+1*29
charz= datastart20+1*30
currentmatrix=datastart20+1*31
charp0= datastart20+1*32
charp1= datastart20+1*33
charp2= datastart20+1*34
charpv= datastart20+1*35 ;ds 8 ++++matrixsize
charph= datastart20+1*43 ;ds 8 ++++matrixsize
charp= datastart20+1*51
charq= datastart20+1*52
charn2= datastart20+1*53
charm= datastart20+1*54
charm1= datastart20+1*55
charp3= datastart20+1*56
chark0= datastart20+1*57
charl0= datastart20+1*58
charfl= datastart20+1*59
charnn= datastart20+1*60
linearsolvemode= datastart20+1*61

datastart30=datastart20+1*62

datastartp=datastart30 ;パラメーター（セーブ対象領域）
actionparameter= datastartp ;アクションパラメーター
mustscale= datastartp+1*0
mustscale2= datastartp+1*1
musteigen34= datastartp+1*2
mustnsfast= datastartp+1*3
actionparameterend= datastartp+1*4
floate0= actionparameterend+6*0 ;しきい値
floate1= actionparameterend+6*1 ;しきい値
floate2= actionparameterend+6*2 ;しきい値
floate3= actionparameterend+6*3 ;しきい値
floate4= actionparameterend+6*4 ;しきい値
floate5= actionparameterend+6*5 ;しきい値
floate6= actionparameterend+6*6 ;しきい値
dataendp= actionparameterend+6*7

complextmpatof=dataendp ;complex tmp a～f 式評価用一時変数 12*6
;固有値計算作業用（兼用） 12*matrixsize*3

datastart40=complextmpatof+12*matrixsize*3 ;float a～z 作業用

floata= datastart40+6*0
floatb= datastart40+6*1
floatc= datastart40+6*2
floatd= datastart40+6*3
floate= datastart40+6*4
floatf= datastart40+6*5
floatg= datastart40+6*6
floath= datastart40+6*7
floati= datastart40+6*8
floatj= datastart40+6*9
floatk= datastart40+6*10
floatl= datastart40+6*11
floatm= datastart40+6*12
floatn= datastart40+6*13
floato= datastart40+6*14
floatp= datastart40+6*15
floatq= datastart40+6*16
floatr= datastart40+6*17
floats= datastart40+6*18
floatt= datastart40+6*19
floatu= datastart40+6*20
floatv= datastart40+6*21
floatw= datastart40+6*22
floatx= datastart40+6*23
floaty= datastart40+6*24
floatz= datastart40+6*25

datastart50=datastart40+6*26 ;計算用スタック

ptrstackpointer=datastart50
floatstack=datastart50+2*1
floatstacktop=floatstack+256

datastart60=datastart50+2+256 ;式計算作業用

formulawork=datastart60
floatformula_a=datastart60
floatformula_b=datastart60+6
charformula_entrylevel=datastart60+12
ptrformula_execaddress=datastart60+13
charformula_leftvalue=datastart60+15

datastart70=datastart60+16

matrixa= datastart70+6*0*matrixsize*matrixsize
matrixb= datastart70+6*1*matrixsize*matrixsize
matrixc= datastart70+6*2*matrixsize*matrixsize
matrixd= datastart70+6*3*matrixsize*matrixsize
matrixe= datastart70+6*4*matrixsize*matrixsize
matrixf= datastart70+6*5*matrixsize*matrixsize
matrixg= datastart70+6*6*matrixsize*matrixsize
matrixh= datastart70+6*7*matrixsize*matrixsize
matrixi= datastart70+6*8*matrixsize*matrixsize
matrixj= datastart70+6*9*matrixsize*matrixsize
matrixk= datastart70+6*10*matrixsize*matrixsize
matrixl= datastart70+6*11*matrixsize*matrixsize
matrixm= datastart70+6*12*matrixsize*matrixsize

enhancememorysize= 30 ;拡張メモリー個数
datastart71= datastart70+6*(13+enhancememorysize)*matrixsize*matrixsize

matrixn= datastart71+6*0*matrixsize*matrixsize
matrixo= datastart71+6*1*matrixsize*matrixsize
matrixp= datastart71+6*2*matrixsize*matrixsize
matrixq= datastart71+6*3*matrixsize*matrixsize
matrixr= datastart71+6*4*matrixsize*matrixsize
matrixs= datastart71+6*5*matrixsize*matrixsize
matrixt= datastart71+6*6*matrixsize*matrixsize
matrixu= datastart71+6*7*matrixsize*matrixsize
matrixv= datastart71+6*8*matrixsize*matrixsize
matrixw= datastart71+6*9*matrixsize*matrixsize ;システム予約ワークエリア
matrixx= datastart71+6*10*matrixsize*matrixsize ;実数部アキュムレータ
matrixy= datastart71+6*11*matrixsize*matrixsize ;虚数部アキュムレータ
matrixz= datastart71+6*12*matrixsize*matrixsize

offsetcomplexmatrix= matrixn-matrixa

datastart80= datastart71+6*(13+enhancememorysize)*matrixsize*matrixsize

buffer=datastart80 ;文字表示用バッファー
maxlengthofbuffer=30*matrixsize*matrixsize

dataend=datastart80+maxlengthofbuffer