        .globl  ml,mul,getargs,numa,numb,numc,numd,nume
        .globl  ggt,sub,pot,binoct,div2,loop2,mulend,clear
;
; Subroutine ML:
; Multiplikation zweier beliebig langer Oktalzahlen und Ausgabe des
; Ergebnisses.
;
ml:     jsr     pc,getargs
        mov     #numa,r0
        mov     #numb,r1
        mov     #numc,r2
        jsr     pc,mul
        mov     #numc,r1
        jsr     pc,binoct
        rts     pc
;
; Subroutine MUL:
; Multipliziert die Zahl, auf die R0 zeigt, mit der, auf die R1 zeigt,
; und bringt das Ergebnis nach (R2).
;
mul:    mov     r4,-(sp)        ; R4 bis R5 sichern
        mov     r5,-(sp)
        mov     r2,resul        ; Resultatsadresse merken
        mov     #100,r4
clear:  clr     (r2)+           ; Resultat loeschen
        sob     r4,clear
        mov     resul,r2
        mov     (r0),r4
        add     (r1),r4
        mov     r4,(r2)+        ; Stellenzahl des Produktes
        mov     (r0)+,plac1
        mov     (r1)+,plac2
        mov     r1,bstart       ; Start des zweiten Faktors
loop1:  clr     carry
        mov     plac2,count
loop2:  mov     (r0),r4
        mul     (r1)+,r4        ; Teilprodukt ist in R4 und R5
        add     (r2),r5
        adc     r4
        add     carry,r5
        adc     r4              ; Produkt in zwei 15-Bit-Bloecke
        ashc    #1,r4           ;   aufteilen
        asr     r5
        bic     #100000,r5
        mov     r5,(r2)+
        mov     r4,carry
        dec     count
        bne     loop2
        mov     carry,(r2)+
        tst     (r0)+           ; zum Erhoehen von R0 um 2
        sub     plac2,r2        ; Zeiger auf Produkt entsprechend zurueck
        sub     plac2,r2
        mov     bstart,r1       ; R1 wieder auf NUMB setzen
        dec     plac1
        bne     loop1
        mov     resul,r2        ; Zeiger auf das Resultat
        mov     r2,r1
        add     (r2),r1
        add     (r2),r1
        tst     (r1)            ; Null im MSW?
        bne     mulend
        dec     (r2)            ; Dann eine Stelle weniger
        bne     mulend
        inc     (r2)            ; Aber eine muss bleiben
mulend: mov     (sp)+,r5
        mov     (sp)+,r4
        rts     pc
;
; Datenbereich:
;
plac1:  .blkw   1
plac2:  .blkw   1
carry:  .blkw   1
count:  .blkw   1
bstart: .blkw   1
resul:  .blkw   1
;
; Subroutine GGT:
; Berechnet den groessten gemeinsamen Teiler zweier beliebig langer Zahlen.
;
ggt:    jsr     pc,getargs
        clr     twoexp
        mov     #numa,r0
        mov     #numb,r1
        cmp     #1,(r0)
        bne     notzero
        tst     2(r0)
        beq     endggt          ; erste Zahl ist Null
notzero:cmp     #1,(r1)
        bne     pwrof2
        tst     2(r1)
        bne     pwrof2
        mov     r0,r1
        br      endggt          ; zweite Zahl ist Null
pwrof2: bit     #1,2(r0)        ; erste Zahl ungerade?
        bne     odd             ;   ja
        bit     #1,2(r1)        ; zweite Zahl ungerade?
        bne     odd             ;   ja
        inc     twoexp          ; beide gerade
        mov     r0,r5
        jsr     pc,div2
        mov     r1,r5
        jsr     pc,div2
        br      pwrof2
odd:    mov     r1,r2
        bit     #1,2(r0)
        bne     evtst
        mov     r0,r2
;
; An dieser Stelle ist die Zahl, auf die R2 zeigt, mit Sicherheit gerade
; und wird deshalb durch zwei geteilt.
;
halve:  mov     r2,r5
        jsr     pc,div2
evtst:  bit     #1,2(r2)
        beq     halve
        jsr     pc,sub          ; Subtrahiere die beiden Zahlen
        mov     r1,r2
        cmp     #1,(r2)
        bne     halve
        tst     2(r2)
        bne     halve
        mov     #numa,r1
        cmp     r1,r2
        bne     tim2
        mov     #numb,r1
;
; R1 zeigt nun auf das Ergebnis, das allerdings noch mit 2 ^ TWOEXP
; multipliziert werden muss.
;
tim2:   tst     twoexp
        beq     endggt
tim2lp: mov     r1,r5
        jsr     pc,mul2
        dec     twoexp
        bne     tim2lp
endggt: jsr     pc,binoct
        rts     pc
;
; Subroutine DIV2:
; Ganzzahlige Division einer beliebig langen Zahl durch zwei.
; Parameter: R5 - Zeiger auf die Zahl
;
div2:   mov     r4,-(sp)        ; R4 sichern (Stellenzaehler)
        mov     r3,-(sp)        ; R3 sichern (XOR-Maske)
        mov     #140000,r3
        mov     (r5)+,r4
        add     r4,r5           ; R5 soll hinter das Ende der Zahl zeigen (MSW)
        add     r4,r5
        clc
divlp:  ror     -(r5)
        bpl     dlpend
        xor     r3,(r5)
dlpend: sob     r4,divlp
        mov     -(r5),r4        ; Stellenzahl restaurieren
        asl     r4
        add     r4,r5
        tst     (r5)            ; Null im MSW?
        bne     div2end
        sub     r4,r5
        dec     (r5)            ; Dann eine Stelle weniger
        bne     div2end
        inc     (r5)            ; Aber eine Stelle muss bleiben
div2end:mov     (sp)+,r3
        mov     (sp)+,r4
        rts     pc
;
; Subroutine MUL2:
; Multiplikation einer beliebig langen Zahl mit zwei.
; Parameter: R5 - Zeiger auf die Zahl
;
mul2:   mov     r4,-(sp)        ; R4 sichern
        mov     r5,ptr          ; Zeiger auf die Zahl merken
        mov     (r5)+,r4        ; Stellenzahl
        clc
mullp:  rol     (r5)+
        clc
        bpl     nocarr
        bic     #100000,-2(r5)
        sec
nocarr: sob     r4,mullp
        bcc     mul2end
        mov     #1,(r5)
        inc     @ptr
mul2end:mov     (sp)+,r4
        rts     pc
;
; Datenbereich:
;
twoexp: .blkw   1
ptr:    .blkw   1
;
; Subroutine POT:
; Potenziert zwei beliebig lange Zahlen.
;
pot:    jsr     pc,getargs
        mov     #numc,r4
        mov     #1,(r4)+        ; Y := 1
        mov     #1,(r4)
        tst     -(r4)           ; Zum Zuruecksetzen von R4
        mov     #nume,yptr
        xor     r4,yptr
        mov     yptr,r4         ; XOR-Maske zum Wechseln zwischen C und E
        mov     #numc,yptr
        mov     #numa,r3
        mov     #numd,zptr
        xor     r3,zptr
        mov     zptr,r3         ; XOR-Maske zum Wechseln zwischen A und D
        mov     #numa,zptr
;
; Ab hier zeigt YPTR jeweils auf das Ergebnis Y und ZPTR zeigt auf Z
; (die ehemalige Basis).
;
        mov     #numb,r5
        cmp     #1,(r5)         ; Test, ob Exponent = 0
        bne     evtest
        tst     2(r5)
        beq     zero
evtest: bit     #1,2(r5)        ; Exponent gerade?
        beq     sqr             ;   ja, dann Z quadrieren
        jsr     pc,div2         ; Exponent durch zwei teilen
        mov     yptr,r0
        mov     zptr,r1
        xor     r4,yptr         ; YPTR wechselt zwischen C und E
        mov     yptr,r2
        jsr     pc,mul          ; Y := Y * Z
        mov     #numb,r5        ; Zeiger auf Exponent restaurieren
        cmp     #1,(r5)         ; Test, ob Exponent = 0
        bne     sqr2
        tst     2(r5)
        bne     sqr2
zero:   mov     yptr,r1
        jsr     pc,binoct
        rts     pc
sqr:    jsr     pc,div2         ; Exponent durch zwei teilen
        mov     #numb,r5        ; Zeiger auf Exponent restaurieren
sqr2:   mov     zptr,r0
        mov     zptr,r1
        xor     r3,zptr         ; ZPTR wechselt zwischen A und D
        mov     zptr,r2
        jsr     pc,mul          ; Z := Z ^ 2
        br      evtest
;
; Datenbereich:
;
yptr:   .blkw   1
zptr:   .blkw   1
        .end

