home *** CD-ROM | disk | FTP | other *** search
/ Frozen Fish 1: Amiga / FrozenFish-Apr94.iso / bbs / alib / d9xx / d999 / adam.lha / ADAM / ADAM_V3.source < prev    next >
Text File  |  1994-04-05  |  71KB  |  4,720 lines
  1.  
  2.  
  3.  
  4.  
  5.  
  6. ; **************************************************
  7. ; ******************* ADAM_V3 **********************
  8. ; **************** rechenprogramm ******************
  9. ; ****** verbesserte version : mehr als 5mal *******
  10. ; ********** schneller als version 2 !!! ***********
  11. ; ************** bcd-codierte zahlen ***************
  12. ; ****** dokumentation siehe in file `dokuv3` ******
  13. ; **************************************************
  14.  
  15.  
  16. ; ************ konstanten ************
  17.  
  18. ; vst und nst müssen durch 4 teilbar sein !!!
  19.  
  20. vst=200;    vorkommastellen
  21. nst=200;    nachkommastellen
  22.  
  23. variab_anz=10;    anzahl der zahlenvariablen
  24. rech_anz=5;    anzahl der rechenfelder
  25. dez_anz=3;    anzahl der konstanten
  26.  
  27. vsb=vst/2
  28. nsb=nst/2
  29. st=vst+nst
  30. sb=vsb+nsb
  31. st1=sb+2
  32. st2=sb+4
  33. st3=sb+6
  34. ast1=st+2
  35. ast2=st+4
  36. ast3=st+6
  37.  
  38. rt1_gr=sb*3+50
  39. tabr_gr=sb+4*21+50
  40. feldgr=sb+10
  41.  
  42. ; libraryoffsets
  43.  
  44. allocmem=-198
  45. freemem=-210
  46. openlib=-552
  47. closelib=-414
  48. open=-30
  49. close=-36
  50. read=-42
  51. write=-48
  52. input=-54
  53. forbid=-132
  54. permit=-138
  55. mode_old=1005
  56. mode_new=1006
  57.  
  58.  
  59. ; *************** makros ****************
  60.  
  61. ; 1 --> startadresse  2 --> end-adresse
  62. prtxt:    macro
  63.         move.l    #?1*8,d3
  64.         bsr    print_text
  65. endm
  66.  
  67. ; 1 --> anzahl der zeichen
  68. p_buf:    macro
  69.         moveq    #?1,d3
  70.         bsr    print_buf
  71.     endm
  72.  
  73. ; 1 --> startadresse  2 --> länge
  74. print:    macro
  75.         lea    ?1(pc),a0
  76.         moveq    #?2,d3
  77.         bsr    print_sub
  78.     endm
  79.  
  80.  
  81. ; ************ hauptprogramm ************
  82.  
  83. x:
  84.     movem.l    d1-d7/a0-a6,-(sp)
  85.     lea    stackpt(pc),a0
  86.     move.l    a7,(a0)
  87.  
  88.     lea    fdruck(pc),a0
  89.     clr.w    (a0)
  90.  
  91.     bra    allocmemory
  92. alloc_rueck:
  93.     bra    openwind
  94. openw_rueck:
  95.     bra    st_pruefen
  96. st_pr_rueck:
  97.     bra    dezwandel
  98. haupt:
  99.     prtxt    10;        hauptmenubild malen
  100.     move.w    #vst,d4
  101.     bsr    zahlaus
  102.     move.l    buffer(pc),a0
  103.     move.l    #$0a099b36,(a0)+
  104.     move.b    #$43,(a0)
  105.     p_buf    5
  106.     move.w    #nst,d4
  107.     bsr    zahlaus
  108.  
  109. readfunk:
  110.     move.l    buffer(pc),a4
  111.     move.l    conhandle(pc),d1
  112.     move.l    a4,d2
  113.     moveq    #1,d3
  114.     jsr    read(a6)
  115.  
  116.     cmp.b    #$1b,(a4)
  117.     beq.s    a
  118.     cmp.b    #$9b,(a4)
  119.     bne.s    readfunk
  120.  
  121.     addq.l    #1,a4
  122.     move.l    conhandle(pc),d1
  123.     move.l    a4,d2
  124.     moveq    #4,d3
  125.     jsr    read(a6)
  126.  
  127.     move.b    (a4),d4
  128.     lea    cmp_tab(pc),a3
  129.     moveq    #4,d5
  130. suchz:
  131.     cmp.b    (a3)+,d4
  132.     beq.s    gefund
  133.     dbf    d5,suchz
  134.  
  135.     bra.s    readfunk
  136. pidisp:
  137.     bsr    pi1
  138.     bra    haupt
  139. help1:
  140.     bsr    helptext
  141.     bra    haupt
  142. change_lang:
  143.     lea    text_tab+4(pc),a0
  144.     tst.l    (a0)
  145.     beq.s    text_ger_eng
  146.  
  147.     clr.l    (a0)
  148.     bra    haupt
  149. text_ger_eng:
  150.     move.l    #eng_ttab-text_tabanf,(a0)
  151.     bra    haupt
  152.  
  153. gefund:
  154.     print    sicht,3
  155.     lea    cmp_tab(pc),a3
  156.  
  157.     cmp.b    (a3)+,d4
  158.     beq.s    a
  159.     cmp.b    (a3)+,d4
  160.     beq.s    rechnen
  161.     cmp.b    (a3)+,d4
  162.     beq.s    pidisp
  163.     cmp.b    (a3)+,d4
  164.     beq.s    help1
  165.     cmp.b    (a3)+,d4
  166.     beq.s    change_lang
  167.  
  168. a:
  169.     move.l    conhandle(pc),d1
  170.     jsr    close(a6)
  171. close_dos:
  172.     move.l    4.w,a6
  173.     move.l    dosbase(pc),a1
  174.     jsr    closelib(a6)
  175. dosoperr:
  176.  
  177.     bra    freememory
  178. freem_rueck:
  179.  
  180. ende:
  181.     move.l    stackpt(pc),a7
  182.     movem.l    (a7)+,d1-d7/a0-a6
  183.     moveq    #0,d0
  184.  
  185.     rts
  186.  
  187.  
  188. ; ************ rechnen *************
  189.  
  190. rechnen:
  191.     bsr    bild
  192.  
  193.     move.l    bcd1(pc),a0
  194.     bsr    zahlein
  195. kopin:
  196.     move.l    buffer(pc),a0
  197.     bsr    feldloesch
  198.  
  199.     bra    operand
  200. rueckoperand:
  201.     move.l    bcd2(pc),a0
  202.     bsr    zahlein
  203.  
  204.     bra    operation
  205. rueck1:
  206.     bra    ergebnis
  207. rueck2:
  208.     prtxt    2
  209. readin:
  210.     move.l    buffer(pc),a4
  211.     move.l    conhandle(pc),d1
  212.     move.l    a4,d2
  213.     moveq    #2,d3
  214.     jsr    read(a6)
  215.  
  216.     cmp.b    #$1b,(a4)
  217.     beq    haupt
  218.     cmp.b    #$9b,(a4)
  219.     bne.s    readin
  220.  
  221.     addq.l    #1,a4
  222.     move.l    conhandle(pc),d1
  223.     moveq    #2,d3
  224.     jsr    read(a6)
  225.  
  226.     move.b    -1(a4),d0
  227.  
  228.     cmp.b    #$30,d0
  229.     beq    haupt
  230.     cmp.b    #$31,d0
  231.     beq    rechnen
  232.     cmp.b    #$32,d0
  233.     beq.s    nochmalkop
  234.     cmp.b    #$33,d0
  235.     beq.s    format_ae
  236.     cmp.b    #$34,d0
  237.     beq.s    speich_nochm
  238.     cmp.b    #$35,d0
  239.     beq.s    help2
  240.  
  241.     bra    readin
  242. nochmalkop:
  243.     bsr    bild
  244.     move.l    bcd1(pc),a0
  245.     bsr    druck
  246.     bra    kopin
  247. format_ae:
  248.     lea    format(pc),a0
  249.     tst.b    (a0)
  250.     bne.s    formj_n
  251.  
  252.     move.b    #1,(a0)
  253.     prtxt    39
  254.     bra    rueck2
  255. formj_n:
  256.     clr.b    (a0)
  257.     prtxt    38
  258.     bra    rueck2
  259. speich_nochm:
  260.     move.l    bcd1(pc),a0
  261.     move.l    speicher(pc),a1
  262.     bsr    kopieren
  263.     bra    rechnen
  264. help2:
  265.     bsr    helptext
  266.     bsr    bild
  267.     move.l    bcd1(pc),a0
  268.     bsr    druck
  269.     prtxt    2
  270.     bra    readin
  271. bild:
  272.     prtxt    7
  273.     move.l    speicher(pc),a0
  274.     bsr    druck
  275.     print    home,2
  276.     rts
  277. helptext:
  278.     prtxt    1
  279.     bsr    r_buf
  280.     print    sicht,3
  281.     rts
  282.  
  283.  
  284. ;********** weitere makros ***************
  285.  
  286. mkopieren:    macro
  287.     move.l    ?1,a0
  288.     move.l    ?2,a1
  289.     bsr    kopieren
  290. endm
  291. mquadrat:    macro
  292.     move.l    ?1,a0
  293.     bsr    quadrat
  294. endm
  295. mfeldloesch:    macro
  296.     move.l    ?1,a0
  297.     bsr    feldloesch
  298. endm
  299. mplusu:    macro
  300.     move.l    ?1,a0
  301.     move.l    ?2,a1
  302.     bsr    plusu
  303. endm
  304. mminusu:    macro
  305.     move.l    ?1,a0
  306.     move.l    ?2,a1
  307.     bsr    minusu
  308. endm
  309. mmals:    macro
  310.     move.l    ?1,a0
  311.     move.l    ?2,a1
  312.     bsr    mals
  313. endm
  314. mdiv:    macro
  315.     move.l    ?1,a0
  316.     move.l    ?2,a1
  317.     bsr    div
  318. endm
  319. mdruck:    macro
  320.     move.l    ?1,a0
  321.     bsr    druck
  322. endm
  323. mincrem:    macro
  324.     move.l    ?1,a0
  325.     bsr    increm
  326. endm
  327. mveru:    macro
  328.     move.l    ?1,a0
  329.     move.l    ?2,a1
  330.     bsr    veru
  331. endm
  332.  
  333. mal10:    macro;    multipliziert ein register mit #10
  334.     move.w    ?1,d0
  335.     add.w    d0,d0
  336.     add.w    d0,d0
  337.     add.w    d0,?1
  338.     add.w    ?1,?1
  339. endm
  340.  
  341.  
  342. ;************* fehlermeldungen **************
  343.  
  344. allocerr:
  345.     move.l    4.w,a6
  346.     lea    dosname(pc),a1
  347.     moveq    #0,d0
  348.     jsr    openlib(a6);    dos.library öffnen
  349.     lea    dosbase(pc),a0
  350.     move.l    d0,(a0)
  351.     beq    dosoperr
  352.  
  353.     move.l    dosbase(pc),a6
  354.     jsr    -54(a6)
  355.     lea    conhandle(pc),a0
  356.     move.l    d0,(a0)
  357.     beq    close_dos
  358.  
  359.     prtxt    44
  360.  
  361.     bra    close_dos
  362. vst_nst_falsch:
  363.     bsr    prtxt12
  364.     prtxt    6
  365.     print    lflf,2
  366.     prtxt    13
  367.     bsr    r_buf
  368.     bra    a
  369. st3fehler:
  370.     bsr    prtxt12
  371.     prtxt    14
  372.     bra    fehleraus
  373. div_null:
  374.     bsr    prtxt12
  375.     prtxt    21
  376.     bra    fehleraus
  377. sqr_negativ:
  378.     bsr.s    prtxt12
  379.     prtxt    15
  380.     bra.s    fehleraus
  381. add_uberlauf:
  382.     bsr.s    prtxt12
  383.     prtxt    27
  384.     bra.s    fehleraus
  385. mal_uberlauf:
  386.     bsr.s    prtxt12
  387.     prtxt    29
  388.     bra.s    fehleraus
  389. div_uberlauf:
  390.     bsr.s    prtxt12
  391.     prtxt    28
  392.     bra.s    fehleraus
  393. fakfehler:
  394.     bsr.s    prtxt12
  395.     prtxt    34
  396. fehleraus:
  397.     print    lflf,2
  398.     prtxt    13
  399.     bsr    r_buf
  400.  
  401.     move.l    stackpt(pc),a7
  402.     bra    haupt
  403. prtxt12:
  404.     prtxt    12
  405.     rts
  406.  
  407. ;************* unterprogramme **************
  408.  
  409. ;----------------------------------
  410.  
  411. openwind:
  412.     move.l    4.w,a6
  413.     lea    dosname(pc),a1
  414.     moveq    #0,d0
  415.     jsr    openlib(a6);    dos.library öffnen
  416.     lea    dosbase(pc),a0
  417.  
  418.     move.l    d0,(a0)
  419.     beq    dosoperr
  420.  
  421. ; maximale fenstergröße suchen
  422.  
  423.     lea    intname(pc),a1
  424.     moveq    #33,d0
  425.     jsr    openlib(a6);    intuition.lib öffnen
  426.     tst.l    d0
  427.     beq.s    no_intui
  428.     move.l    d0,a6
  429.  
  430.     move.l    56(a6),a1;    aktueller screen
  431.  
  432.     lea    windsize(pc),a0
  433.     moveq    #0,d0
  434.     move.w    12(a1),d0;    smax_width
  435.     moveq    #10,d1
  436.     moveq    #$30,d2
  437.  
  438.     bsr.s    maked0
  439.  
  440.     move.b    #`/`,(a0)+
  441.     moveq    #0,d0
  442.     move.w    14(a1),d0;    smax_height
  443.  
  444.     bsr.s    maked0
  445.  
  446.     move.l    a6,a1
  447.     move.l    4.w,a6
  448.     jsr    closelib(a6)
  449. no_intui:
  450.     move.l    dosbase(pc),a6
  451.  
  452.     lea    name(pc),a0
  453.     move.l    a0,d1
  454.     move.l    #mode_old,d2
  455.     jsr    open(a6);    fenster öffnen
  456.     lea    conhandle(pc),a0
  457.     move.l    d0,(a0)
  458.     beq.s    no_window
  459.  
  460.     bra    openw_rueck
  461. no_window:
  462.     jsr    -54(a6)
  463.     lea    conhandle(pc),a0
  464.     move.l    d0,(a0)
  465.     beq    close_dos
  466.  
  467.     prtxt    45
  468.  
  469.     bra    close_dos
  470.  
  471.  
  472. maked0:
  473.     divu    d1,d0
  474.     swap    d0
  475.     add.b    d2,d0
  476.     move.w    d0,-(sp)
  477.     clr.w    d0
  478.     swap    d0
  479.  
  480.     divu    d1,d0
  481.     swap    d0
  482.     add.b    d2,d0
  483.     move.w    d0,-(sp)
  484.     swap    d0
  485.  
  486.     add.b    d2,d0
  487.     move.b    d0,(a0)+
  488.  
  489.     move.w    (sp)+,d0
  490.     move.b    d0,(a0)+
  491.     move.w    (sp)+,d0
  492.     move.b    d0,(a0)+
  493.  
  494.     rts
  495.  
  496. ;----------------------------------
  497.  
  498. st_pruefen:
  499.     move.w    #vst,d4
  500.     cmp.w    #30000,d4
  501.     bhs    vst_nst_falsch
  502.     cmp.w    #20,d4
  503.     blo    vst_nst_falsch
  504.     and.w    #%11,d4
  505.     bne    vst_nst_falsch
  506.  
  507.     move.w    #nst,d4
  508.     cmp.w    #30000,d4
  509.     bhs    vst_nst_falsch
  510.     cmp.w    #20,d4
  511.     blo    vst_nst_falsch
  512.     and.w    #%11,d4
  513.     bne    vst_nst_falsch
  514.  
  515.     bra    st_pr_rueck
  516.  
  517. ;----------------------------------
  518.  
  519. ; 1 ---> länge
  520. ; 2 ---> adresse
  521.  
  522. alloc:    macro
  523.     move.l    #?1,d0
  524.     move.l    d6,d1
  525.     jsr    allocmem(a6)
  526.     tst.l    d0
  527.     beq    allocerr
  528.  
  529.     move.l    #?1,(a4)+
  530.     move.l    d0,(a4)+
  531.     lea    ?2(pc),a0
  532.     move.l    d0,(a0)
  533. endm
  534.  
  535.  
  536. ; der belegte speicher wird in die memlist eingetragen,
  537. ; die mit 0,0 abgeschlossen ist.
  538.  
  539. allocmemory:
  540.     move.l    4.w,a6
  541.     lea    memlist(pc),a4
  542.     moveq    #29,d0
  543. alloccl:
  544.     clr.l    (a4)+
  545.     dbf    d0,alloccl
  546.  
  547.     lea    memlist(pc),a4
  548.     move.l    #$10000,d6
  549.  
  550. ; speicher für buffer, byte1, rt1, r1 und tabr
  551.  
  552.     alloc    st+48,buffer
  553.     alloc    rt1_gr,rt1
  554.     alloc    tabr_gr,tabr
  555.     alloc    st+10,byte1
  556.     alloc    st+10,r1
  557.     alloc    sb+10,pi
  558.  
  559. ; speicher für variablen speicher,bcd1-9
  560.  
  561.     move.w    #feldgr,d0
  562.     mulu    #variab_anz,d0
  563.     move.l    d0,d7
  564.     move.l    d6,d1
  565.     jsr    allocmem(a6)
  566.     tst.l    d0
  567.     beq    allocerr
  568.  
  569.     move.l    d7,(a4)+
  570.     move.l    d0,(a4)+
  571.  
  572.     moveq    #variab_anz-1,d1
  573.     lea    speicher(pc),a0
  574. makev:
  575.     move.l    d0,(a0)+
  576.     add.l    #feldgr,d0
  577.     dbf    d1,makev
  578.  
  579. ; speicher für rechenfelder sqr1-4,quadrat
  580.  
  581.     move.w    #feldgr,d0
  582.     mulu    #rech_anz,d0
  583.     move.l    d0,d7
  584.     move.l    d6,d1
  585.     jsr    allocmem(a6)
  586.     tst.l    d0
  587.     beq    allocerr
  588.  
  589.     move.l    d7,(a4)+
  590.     move.l    d0,(a4)+
  591.  
  592.     moveq    #rech_anz-1,d1
  593.     lea    sqr1(pc),a0
  594. makerech:
  595.     move.l    d0,(a0)+
  596.     add.l    #feldgr,d0
  597.     dbf    d1,makerech
  598.  
  599. ; speicher für konstantenfelder dez1-6
  600.  
  601.     move.w    #feldgr,d0
  602.     mulu    #dez_anz,d0
  603.     move.l    d0,d7
  604.     move.l    d6,d1
  605.     jsr    allocmem(a6)
  606.     tst.l    d0
  607.     beq    allocerr
  608.  
  609.     move.l    d7,(a4)+
  610.     move.l    d0,(a4)+
  611.  
  612.     moveq    #dez_anz-1,d1
  613.     lea    dez1(pc),a0
  614. makedez:
  615.     move.l    d0,(a0)+
  616.     add.l    #feldgr,d0
  617.     dbf    d1,makedez
  618.  
  619.     clr.l    (a4)+
  620.     clr.l    (a4)
  621.  
  622.     bra    alloc_rueck
  623.  
  624. ;----------------------------------
  625.  
  626. freememory:
  627.     move.l    4.w,a6
  628.     lea    memlist(pc),a4
  629. freem_in:
  630.     move.l    (a4)+,d0
  631.     beq.s    freem_aus
  632.     move.l    (a4)+,a1
  633.     jsr    freemem(a6)
  634.  
  635.     bra.s    freem_in
  636. freem_aus:
  637.     bra    freem_rueck
  638.  
  639. ;----------------------------------
  640.  
  641. ; diese routine kopiert alle zahlenkonstanten in die
  642. ; konstantenfelder dez1, dez2, ...
  643.  
  644. dezwandel:
  645.     movem.l    d0-d7/a0-a3,-(sp)
  646.  
  647.     moveq    #dez_anz-1,d6
  648.     lea    dezdat1(pc),a0
  649.     lea    dez1(pc),a3
  650.     move.l    byte1(pc),a2
  651. wanf:
  652.     move.l    a2,a1
  653.     move.w    #st/2+3,d0
  654. clrb1:
  655.     clr.w    (a1)+
  656.     dbf    d0,clrb1
  657.  
  658.     move.l    a2,a1
  659.     move.w    (a0)+,ast1(a2)
  660.     move.w    (a0)+,ast2(a2)
  661.     move.w    (a0)+,ast3(a2)
  662.  
  663.     cmp.w    #1,ast3(a2)
  664.     beq.s    gerade
  665.  
  666.     tst.w    ast1(a2)
  667.     beq.s    nachw
  668.  
  669.     move.w    ast1(a2),d5
  670.     move.l    #vst,d4
  671.     sub.w    d5,d4
  672.     add.l    d4,a1
  673.     subq.w    #1,d5
  674. vorwand:
  675.     move.b    (a0)+,(a1)+
  676.     dbf    d5,vorwand
  677. nachw:
  678.     tst.w    ast2(a2)
  679.     beq.s    wandaus
  680.  
  681.     move.l    byte1(pc),a1
  682.     move.w    ast2(a2),d5
  683.     subq.w    #1,d5
  684.     add.l    #vst,a1
  685. nachwand:
  686.     move.b    (a0)+,(a1)+
  687.     dbf    d5,nachwand
  688. wandaus:
  689.     move.l    a0,d0
  690.  
  691.     btst    #0,d0
  692.     beq    gerade
  693. ungerade:
  694.     addq.l    #1,a0
  695. gerade:
  696.     movem.l    a0/a1,-(sp)
  697.     move.l    byte1(pc),a0
  698.     move.l    (a3)+,a1
  699.     bsr    wandbyte_bcd;    zahl in bcd-format wandeln
  700.     movem.l    (sp)+,a0/a1
  701.  
  702.     dbf    d6,wanf
  703.  
  704.     mfeldloesch    speicher(pc)
  705.  
  706.     mkopieren    dez1(pc),bcd1(pc)
  707.     mdiv        dez3(pc),bcd1(pc)
  708.     mkopieren    bcd1(pc),dez3(pc)
  709.  
  710. ; pi einlesen
  711.  
  712.     move.l    pi(pc),a0
  713.     bsr    feldloesch
  714.     move.b    #3,vsb-1(a0)
  715.     move.w    #1,st1(a0)
  716.     move.w    #2,st3(a0)
  717.  
  718.     move.l    a0,a4
  719.  
  720.     lea    piname(pc),a0
  721.     move.l    a0,d1
  722.     move.l    #mode_old,d2
  723.     jsr    open(a6)
  724.     move.l    d0,d7;        datei öffnen
  725.     beq.s    pi_notfound
  726.  
  727.     move.l    d7,d1
  728.     move.l    pi(pc),d2
  729.     add.l    #vsb,d2
  730.     move.l    #nsb,d3
  731.     cmp.w    #2000,d3
  732.     bls.s    pireadd3ok
  733.     move.l    #2000,d3
  734. pireadd3ok:
  735.     jsr    read(a6);        datei schreiben
  736.  
  737.     move.l    d7,d1
  738.     jsr    close(a6);        und wieder schließen
  739.  
  740. ; nachkommastellenzahl von pi ermitteln
  741.  
  742.     move.l    a4,a0
  743.     move.l    a0,a1
  744.     add.l    #sb,a0
  745.     move.w    #nsb,d0
  746. pinachm:
  747.     tst.b    -(a0)
  748.     bne.s    pinachex
  749.  
  750.     subq.w    #1,d0
  751.     bne.s    pinachm
  752.  
  753.     bra.s    pinachaus
  754. pinsubeine:
  755.     subq.w    #1,d0
  756.     bra.s    pinachaus
  757. pinachex:
  758.     add.w    d0,d0
  759.     move.b    (a0),d1
  760.     lsl.b    #4,d1
  761.     beq.s    pinsubeine
  762. pinachaus:
  763.     move.w    d0,st2(a1)
  764.     bra.s    piliesaus
  765. pi_notfound:
  766.     prtxt    41
  767.     bsr    r_buf
  768.     move.l    #$14159265,vsb(a4)
  769.     move.w    #8,st2(a4)
  770. piliesaus:
  771.     movem.l    (sp)+,d0-d7/a0-a3
  772.  
  773.     bra    haupt
  774.  
  775. ;----------- operand nach op holen ------------
  776.  
  777. operand:
  778.     print    miplu+1,4
  779. opin:
  780.     move.l    conhandle(pc),d1
  781.     lea    op(pc),a2
  782.     move.l    a2,d2
  783.     moveq    #1,d3
  784.     jsr    read(a6)
  785.  
  786.     move.b    (a2),d4
  787.  
  788.     cmp.b    #"+",d4
  789.     beq.s    op1
  790.     cmp.b    #"-",d4
  791.     beq.s    op1
  792.     cmp.b    #"*",d4
  793.     beq.s    op1
  794.     cmp.b    #"/",d4
  795.     beq.s    op1
  796.     cmp.b    #"v",d4
  797.     beq.s    op1
  798.     cmp.b    #"m",d4
  799.     beq.s    op1
  800.     cmp.b    #"s",d4
  801.     beq.s    op1
  802.     cmp.b    #"q",d4
  803.     beq.s    op1
  804.     cmp.b    #"w",d4
  805.     beq.s    op1
  806.     cmp.b    #"!",d4
  807.     beq.s    op1
  808.     cmp.b    #"i",d4
  809.     beq.s    op1
  810.     cmp.b    #"k",d4
  811.     beq.s    op1
  812.     cmp.b    #"S",d4
  813.     beq.s    op1
  814.     bra     opin
  815. op1:
  816.     print    op,1
  817. op2:
  818.     move.l    conhandle(pc),d1
  819.     lea    op+1(pc),a0
  820.     move.l    a0,d2
  821.     moveq    #1,d3
  822.     jsr    read(a6)
  823.  
  824.     move.b    op+1(pc),d4
  825.     cmp.b    #$d,d4
  826.     beq.s    opaus
  827.     cmp.b    #8,d4
  828.     beq.s    oploe
  829.     bra.s    op2
  830. oploe:
  831.     bsr    backspace
  832.     bra    opin
  833. opaus:
  834.     lea    op(pc),a0
  835.     move.b    (a0),d4
  836.     cmp.b    #"m",d4
  837.     beq.s    memin
  838.     cmp.b    #"s",d4
  839.     beq.s    opwurzel
  840.     cmp.b    #"q",d4
  841.     beq.L    opquadrat
  842.     cmp.b    #"w",d4
  843.     beq    opwechsel
  844.     cmp.b    #"!",d4
  845.     beq    opfak
  846.     cmp.b    #"k",d4
  847.     beq    opkehr
  848.     cmp.b    #"i",d4
  849.     beq    opinteg
  850.     cmp.b    #"S",d4
  851.     beq    opsin
  852.  
  853.     bsr    lf_cr
  854.     bra    rueckoperand
  855.  
  856. ;---------- speichern ---------------
  857.  
  858. memin:
  859.     mkopieren    bcd1(pc),speicher(pc)
  860.     bra    rechnen
  861.  
  862. ;------------ wurzelziehen -----------------
  863.  
  864. opwurzel:
  865.     prtxt    8
  866.     move.l    bcd1(pc),a0
  867.     bsr    sqrroot
  868.     mdruck    bcd1(pc)
  869.     bra    rueck2
  870.  
  871. ;-------------- quadrieren -----------------
  872.  
  873. opquadrat:
  874.     prtxt    9
  875.     mquadrat    bcd1(pc)
  876.     mdruck        bcd1(pc)
  877.     bra    rueck2
  878.  
  879. ;------------ vorzeichen wechseln ------------
  880.  
  881. opwechsel:
  882.     prtxt    35
  883.     move.l    bcd1(pc),a0
  884.     bsr    vorz_wechsel
  885.     mdruck    bcd1(pc)
  886.     bra    rueck2
  887.  
  888. ;------------ fakultät ------------
  889.  
  890. opfak:
  891.     prtxt    20
  892.     move.l    bcd1(pc),a0
  893.     bsr    fakultaet
  894.     mdruck    bcd1(pc)
  895.     bra    rueck2
  896.  
  897. ;------------ kehrwert ------------
  898.  
  899. opkehr:
  900.     prtxt    36
  901.     mkopieren    bcd1(pc),bcd2(pc)
  902.     mkopieren    dez1(pc),bcd1(pc)
  903.     mdiv        bcd2(pc),bcd1(pc)
  904.     mdruck        bcd1(pc)
  905.     bra    rueck2
  906.  
  907. ;------------ integer ------------
  908.  
  909. opinteg:
  910.     prtxt    37
  911.     move.l    bcd1(pc),a0
  912.     bsr    integer
  913.     mdruck    bcd1(pc)
  914.     bra    rueck2
  915.  
  916. ;------------ fakultät ------------
  917.  
  918. opsin:
  919.     prtxt    42
  920.     move.l    bcd1(pc),a0
  921.     bsr    sinus
  922.     mdruck    bcd1(pc)
  923.     bra    rueck2
  924.  
  925. ;---------- operation ausführen -----------
  926.  
  927. operation:
  928.     lea    op(pc),a0
  929.     move.b    op(pc),d4
  930.     cmp.b    #"v",d4
  931.     beq    vergleich
  932.     cmp.b    #"+",d4
  933.     beq.s    opplus
  934.     cmp.b    #"-",d4
  935.     beq.s    opminus
  936.     cmp.b    #"*",d4
  937.     beq.s    opmal
  938.     cmp.b    #"/",d4
  939.     beq.s    opdiv
  940.  
  941.     bra    a
  942. opplus:
  943.     move.l    bcd2(pc),a0
  944.     move.l    bcd1(pc),a1
  945.     bsr    pluss
  946.     bra.s    operationaus
  947. opminus:
  948.     move.l    bcd2(pc),a0
  949.     move.l    bcd1(pc),a1
  950.     bsr    minuss
  951.     bra.s    operationaus
  952. opmal:
  953.     move.l    bcd2(pc),a0
  954.     move.l    bcd1(pc),a1
  955.     bsr    mals
  956.     bra.s    operationaus
  957. opdiv:
  958.     move.l    bcd2(pc),a0
  959.     move.l    bcd1(pc),a1
  960.     bsr    div
  961.     bra.s    operationaus
  962. vergleich:
  963.     move.l    bcd1(pc),a0
  964.     move.l    bcd2(pc),a1
  965.     bsr    vers
  966. operationaus:
  967.     bra    rueck1
  968.  
  969. ;---------- ergebnis ausgeben -----------
  970.  
  971. ergebnis:
  972.     lea    op(pc),a0
  973.     cmp.b    #"v",(a0)
  974.     beq.s    verglergebnis
  975.  
  976.     print    ergeb,8
  977.     mdruck    bcd1(pc)
  978.  
  979.     bra.s    ergaus
  980. verglergebnis:
  981.     cmp.w    #1,(a0)
  982.     beq.s    glei
  983.     cmp.w    #2,(a0)
  984.     beq.s    v1gr2
  985.     prtxt    5
  986.     bra.s    ergaus
  987. glei:
  988.     prtxt    3
  989.     bra.s    ergaus
  990. v1gr2:
  991.     prtxt    4
  992. ergaus:
  993.     bra    rueck2
  994.  
  995. ;************** subroutinen **************
  996.  
  997. ;========== zeichenausgabe ==========
  998.  
  999. lf_cr:
  1000.     print    lflf,1
  1001.     rts
  1002. backspace:
  1003.     print    bs1,3
  1004.     rts
  1005.  
  1006. ; liest ein zeichen in feld `buffer`
  1007. r_buf:
  1008.     move.l    conhandle(pc),d1
  1009.     move.l    buffer(pc),d2
  1010.     moveq    #1,d3
  1011.     jsr    read(a6)
  1012.     rts
  1013.  
  1014. ; subroutinen für die macros prtxt, p_buf und print
  1015.  
  1016. print_text:
  1017.     lea    text_tab(pc),a0
  1018.     move.l    (a0)+,d1
  1019.     move.l    (a0)+,d2
  1020.     add.l    d3,a0
  1021.     add.l    d2,a0
  1022.     move.l    (a0)+,d2
  1023.     move.l    (a0)+,d3
  1024.     jsr    write(a6)
  1025.     rts
  1026. print_buf:
  1027.     move.l    conhandle(pc),d1
  1028.     move.l    buffer(pc),d2
  1029.     jsr    write(a6)
  1030.     rts
  1031. print_sub:
  1032.     move.l    conhandle(pc),d1
  1033.     move.l    a0,d2
  1034.     jsr    write(a6)
  1035.     rts
  1036.  
  1037. ;============================================
  1038.  
  1039. ; zahl in d4 (wort)
  1040.  
  1041. zahlaus:
  1042.     movem.l    d0-d5/a4/a5,-(sp)
  1043.  
  1044.     tst.w    d4
  1045.     beq.s    znull
  1046.  
  1047.     move.l    buffer(pc),a4
  1048.     and.l    #$ffff,d4
  1049. dodez:
  1050.     move.l    d4,d5
  1051.     divu    #10,d5
  1052.     move.w    d5,d4
  1053.     swap    d5
  1054.     add.b    #$30,d5
  1055.     move.b    d5,(a4)+
  1056.  
  1057.     tst.w    d4
  1058.     bne.s    dodez
  1059.  
  1060.     move.l    buffer(pc),d5
  1061.     move.l    d5,a5
  1062.     addq.l    #5,a5
  1063.     addq.l    #5,a5
  1064.     move.l    a5,d2
  1065.     sub.l    a4,d5
  1066.     neg.l    d5
  1067.     move.l    d5,d3
  1068. zahlin:
  1069.     move.b    -(a4),(a5)+
  1070.     dbf    d5,zahlin
  1071.  
  1072.     move.l    conhandle(pc),d1
  1073.     jsr    write(a6)
  1074.     bra.s    zahlausex
  1075. znull:
  1076.     print    nu,1
  1077. zahlausex:
  1078.     movem.l    (sp)+,d0-d5/a4/a5
  1079.  
  1080.     rts
  1081.  
  1082. ;==========================================
  1083.  
  1084. ; stellenzahl in d4
  1085.  
  1086. rechts:
  1087.     movem.l    d4/a0,-(sp)
  1088.  
  1089.     lea    r(pc),a0
  1090.     move.l    a0,d2
  1091.  
  1092.     move.b    #$9b,(a0)+
  1093.  
  1094.     and.l    #$ffff,d4
  1095.     divu    #10,d4
  1096.     tst.b    d4
  1097.     beq.s    nur_eine
  1098.  
  1099.     add.b    #$30,d4
  1100.     move.b    d4,(a0)+
  1101. nur_eine:
  1102.     swap    d4
  1103.  
  1104.     add.w    #$30,d4
  1105.     move.b    d4,(a0)+
  1106.  
  1107.     move.b    #$43,(a0)+
  1108.  
  1109.     move.l    conhandle(pc),d1
  1110.     move.l    a0,d3
  1111.     sub.l    d2,d3
  1112.     jsr    write(a6)
  1113.  
  1114.     movem.l    (sp)+,d4/a0
  1115.  
  1116.     rts
  1117.  
  1118. ;===========================================
  1119.  
  1120. nullsetzen:
  1121.     move.l    buffer(pc),a0
  1122.     move.w    #st2+1,d4
  1123. nullsetz1:
  1124.     clr.b    (a0)+
  1125.     dbf    d4,nullsetz1
  1126.  
  1127.     moveq    #variab_anz,d4
  1128.     subq.w    #1,d4
  1129.     lea    buffer(pc),a1
  1130. nullsetz2:
  1131.     move.l    (a1)+,a0
  1132.     bsr    feldloesch
  1133.     dbf    d4,nullsetz2
  1134.  
  1135.     clr.l    -(sp)
  1136.     movem.l    (sp),d0-d7/a0-a5
  1137.     addq.l    #4,sp
  1138.  
  1139.     lea    op(pc),a0
  1140.     clr.b    (a0)
  1141.  
  1142.     rts
  1143.  
  1144. ;================================================
  1145.  
  1146. ; diese routine liest eine zahl in das feld ein, das in a0
  1147. ; angegeben ist
  1148.  
  1149. zahlein:
  1150.     movem.l    d4-d7/a0-a5,-(sp)
  1151.  
  1152. ; (a5) : punknum
  1153. ; 2(a5) : vor
  1154. ; 4(a5) : nach
  1155. ; 6(a5) : vorzei
  1156. vorp=2
  1157. nachp=4
  1158. vorzeip=6
  1159.  
  1160.     move.l    a0,a3
  1161.     bsr    feldloesch
  1162.  
  1163.     lea    punknum(pc),a5
  1164.     clr.l    (a5)
  1165.     clr.w    4(a5)
  1166.     clr.b    6(a5)
  1167.  
  1168.     print    miplu+1,4
  1169.     move.l    buffer(pc),a4
  1170. ein2:    
  1171.     move.l    conhandle(pc),d1
  1172.     move.l    a4,d2
  1173.     moveq    #1,d3
  1174.     jsr    read(a6)
  1175.  
  1176.     move.b    (a4),d4
  1177.  
  1178.     cmp.b    #$d,d4
  1179.     beq    return
  1180.     cmp.b    #8,d4
  1181.     beq    fbackspace
  1182.     cmp.b    #"-",d4
  1183.     beq    minzei
  1184.     cmp.b    #".",d4
  1185.     beq    punkt
  1186.     cmp.b    #"0",d4
  1187.     beq    zeinull
  1188.     cmp.b    #"m",d4
  1189.     beq    memory_pi
  1190.     cmp.b    #"p",d4
  1191.     beq    memory_pi
  1192.     cmp.b    #$30,d4
  1193.     blo.s    ein2
  1194.     cmp.b    #$39,d4
  1195.     bhi.s    ein2
  1196. zeichein:
  1197.     tst.w    (a5)
  1198.     beq.s    verglvor
  1199.  
  1200.     cmp.w    #nst,nachp(a5)
  1201.     beq.s    ein2
  1202.  
  1203.     bra.s    verglnach
  1204. zeinull:
  1205.     cmp.l    buffer(pc),a4
  1206.     beq    ein2
  1207.     bra.s    zeichein
  1208. verglvor:
  1209.     cmp.w    #vst,vorp(a5)
  1210.     beq    ein2
  1211. verglnach:
  1212.     move.l    conhandle(pc),d1
  1213.     move.l    a4,d2
  1214.     moveq    #1,d3
  1215.     jsr    write(a6)
  1216.  
  1217.      tst.w    (a5)
  1218.     beq.s    vorincrem
  1219.  
  1220.     addq.w    #1,nachp(a5)
  1221.     bra    vorret
  1222. vorincrem:
  1223.     addq.w    #1,vorp(a5)
  1224. vorret:
  1225.     addq.l    #1,a4
  1226.     bra    ein2
  1227. memory_pi:
  1228.     cmp.l    buffer(pc),a4
  1229.     bne    ein2
  1230.  
  1231.     move.l    conhandle(pc),d1
  1232.     move.l    a4,d2
  1233.     moveq    #1,d3
  1234.     jsr    write(a6)
  1235.     addq.l    #1,a4
  1236. mem:
  1237.     move.l    conhandle(pc),d1
  1238.     move.l    a4,d2
  1239.     moveq    #1,d3
  1240.     jsr    read(a6)
  1241.  
  1242.     move.b    (a4),d4
  1243.  
  1244.     cmp.b    #$d,d4
  1245.     beq.s    memaus
  1246.     cmp.b    #$8,d4
  1247.     beq.s    mback
  1248.     bra.s    mem
  1249. mback:
  1250.     bsr    backspace
  1251.     move.l    buffer(pc),a4
  1252.     clr.w    (a4)
  1253.     bra    ein2
  1254. memaus:
  1255.     cmp.b    #"m",-1(a4)
  1256.     beq.s    memsp
  1257.  
  1258.     move.l    pi(pc),a0
  1259.     bra.s    memsp1
  1260. memsp:
  1261.     move.l    speicher(pc),a0
  1262. memsp1:
  1263.     move.l    a3,a1
  1264.     bsr    kopieren
  1265.     print    plumi,1
  1266.     move.l    a3,a0
  1267.     bsr    druck
  1268.     bra    zahleinex1
  1269. return:
  1270.     cmp.l    buffer(pc),a4
  1271.     beq    nullzahl
  1272.  
  1273.     tst.w    nachp(a5)
  1274.     bne    nulloesch
  1275. loein:
  1276.     move.l    a4,d6
  1277.     sub.l    buffer(pc),d6
  1278.  
  1279.     cmp.w    (a5),d6
  1280.     beq    punktloesch
  1281.  
  1282.     bra    einaus
  1283. nullzahl:
  1284.     cmp.b    #1,vorzeip(a5)
  1285.     beq.s    minloe
  1286. minloeret:
  1287.     print    nu,1
  1288.     bra    zahleinex
  1289. minloe:
  1290.     move.l    byte1(pc),a0
  1291.     move.l    a0,d2
  1292.     move.l    #$0d3e2020,(a0)+
  1293.     move.b    #$20,(a0)+
  1294.     move.l    conhandle(pc),d1
  1295.     moveq    #5,d3
  1296.     jsr    write(a6)
  1297.  
  1298.     clr.b    vorzeip(a5)
  1299.     bra.s    minloeret
  1300. nulloesch:
  1301.     move.l    buffer(pc),a0
  1302.     add.w    vor(pc),a0
  1303.     add.w    nach(pc),a0
  1304.  
  1305.     cmp.b    #$30,(a0)
  1306.     beq.s    nullo
  1307.     bra    loein
  1308. nullo:
  1309.     subq.w    #1,nachp(a5)
  1310.     subq.l    #1,a4
  1311.     bsr    backspace
  1312.     bra    nulloesch
  1313. punktloesch:
  1314.     bsr    backspace
  1315.     move.l    a4,d4
  1316.     subq.l    #1,d4
  1317.  
  1318.     cmp.l    buffer(pc),d4
  1319.     beq    nullzahl
  1320. einaus:
  1321.     moveq    #0,d4
  1322.     moveq    #0,d5
  1323.     moveq    #0,d6
  1324.     move.w    vor(pc),d4
  1325.     move.w    nach(pc),d5
  1326.     move.b    vorzei(pc),d6
  1327.     move.l    buffer(pc),a2
  1328.     move.l    a3,a4
  1329.     move.l    byte1(pc),a3
  1330.  
  1331.     move.l    a3,a0
  1332.     move.w    #st/2+3,d7
  1333. lbyte1:
  1334.     clr.w    (a0)+
  1335.     dbf    d7,lbyte1
  1336.  
  1337.     bsr    mittwandord
  1338.     move.l    byte1(pc),a0
  1339.     move.l    a4,a1
  1340.     bsr    wandbyte_bcd
  1341. zahleinex:
  1342.     bsr    lf_cr
  1343. zahleinex1:
  1344.     movem.l    (sp)+,d4-d7/a0-a5
  1345.  
  1346.     rts
  1347.  
  1348. ;------------ backspace ------------ 
  1349.  
  1350. fbackspace:
  1351.     cmp.l    buffer(pc),a4
  1352.     beq    ein2
  1353.  
  1354.     move.l    buffer(pc),a0
  1355.     addq.l    #1,a0
  1356.  
  1357.     cmp.l    a0,a4
  1358.     beq    loeschen
  1359.  
  1360.     addq.l    #1,a0
  1361.  
  1362.     cmp.l    a0,a4
  1363.     beq    loeschen2
  1364. rueckk:
  1365.     tst.w    (a5)
  1366.     bne    backpunkt
  1367. backein:
  1368.     bsr    backspace
  1369.  
  1370.     tst.w    (a5)
  1371.     beq.s    vordecr
  1372.  
  1373.     subq.w    #1,nachp(a5)
  1374.     bra.s    backweiter
  1375. vordecr:
  1376.     subq.w    #1,vorp(a5)
  1377. backweiter:
  1378.     clr.b    (a4)
  1379.     subq.l    #1,a4
  1380.  
  1381.     bra     ein2
  1382. loeschen:
  1383.     cmp.w    #1,(a5)
  1384.     beq    nullpuloe
  1385.  
  1386.     tst.b    vorzeip(a5)
  1387.     beq.s    backein
  1388.  
  1389.     move.l    buffer(pc),a0
  1390.     move.l    #$08200d3e,(a0)+
  1391.     move.l    #$20202020,(a0)+
  1392.     p_buf    8
  1393.  
  1394.     subq.w    #1,vorp(a5)
  1395.     subq.l    #1,a4
  1396.     clr.b    vorzeip(a5)
  1397.     bra    ein2
  1398. loeschen2:
  1399.     cmp.w    #1,(a5)
  1400.     bne    rueckk
  1401.  
  1402.     lea    vorzei(pc),a0
  1403.     tst.b    (a0)
  1404.     beq    rueckk
  1405.  
  1406.     move.l    buffer(pc),a0
  1407.     move.l    #$9b302070,(a0)+
  1408.     move.l    #$08200d3e,(a0)+
  1409.     move.l    #$20209b31,(a0)+
  1410.     move.l    #$439b2070,(a0)
  1411.     p_buf    16
  1412.  
  1413.     subq.w    #1,a4
  1414.     subq.w    #1,nachp(a5)
  1415.     clr.b    vorzeip(a5)
  1416.     bra    ein2
  1417. backpunkt:
  1418.     move.l    buffer(pc),d5
  1419.     move.l    a4,d6
  1420.     sub.l    d5,d6
  1421.  
  1422.     cmp.w    (a5),d6
  1423.     bne    backein
  1424.  
  1425.     clr.w    (a5)
  1426.     addq.w    #1,vorp(a5)
  1427.     bra    backein
  1428. nullpuloe:
  1429.     subq.l    #1,a4
  1430.     clr.w    (a5)
  1431.     bsr    backspace
  1432.  
  1433.     bra    ein2
  1434.  
  1435. ;-------- minuszeichen --------------
  1436.  
  1437. minzei:
  1438.     cmp.l    buffer(pc),a4
  1439.     beq    ein2
  1440.  
  1441.     move.l    buffer(pc),a0
  1442.     addq.l    #1,a0
  1443.  
  1444.     cmp.l    a0,a4
  1445.     beq.s    stell1
  1446.     bra.s    stellgr1
  1447. stell1:
  1448.     cmp.b    #`.`,-1(a4)
  1449.     beq    ein2
  1450. stellgr1:
  1451.     tst.b    vorzeip(a5)
  1452.     beq.s    plumin
  1453.  
  1454.     print    miplu,4
  1455.     clr.b    vorzeip(a5)
  1456.     bra.s    wechsaus
  1457. plumin:
  1458.     print    plumi,4
  1459.     move.b    #1,vorzeip(a5)
  1460. wechsaus:
  1461.     move.l    a4,d6
  1462.     sub.l    buffer(pc),d6
  1463.     addq.w    #1,d6
  1464.  
  1465.     move.w    d6,d4
  1466.     bsr    rechts
  1467.  
  1468.     bra    ein2
  1469.  
  1470. ;---------------- punkt ----------------
  1471.  
  1472. punkt:
  1473.     tst.w    (a5)
  1474.     bne    ein2
  1475.  
  1476.     print    pu,1
  1477.  
  1478.     move.l    a4,d7
  1479.     sub.l    buffer(pc),d7
  1480.     lea    punknum(pc),a0
  1481.     move.w    d7,(a0)
  1482.     addq.w    #1,(a0)
  1483.  
  1484.     addq.l    #1,a4
  1485.     bra    ein2
  1486.  
  1487. ;============================================
  1488.  
  1489. ; quelladresse in a2 , zieladrsse in a3
  1490. ; vorkomma in d4 , nachkomma in d5
  1491. ; vorzeichen in d6 : 0 = + , 1 = -
  1492.  
  1493. mittwandord:
  1494.     movem.l    d0-d7/a0-a5,-(sp)
  1495.     move.w    d4,ast1(a3)
  1496.     move.w    d5,ast2(a3)
  1497.  
  1498.     cmp.w    #1,d6
  1499.     beq.s    vorz_min
  1500.  
  1501.     tst.w    d4
  1502.     beq.s    vor_nix
  1503. mrueck3:
  1504.     move.w    #2,ast3(a3)
  1505.     bra    anford
  1506. vor_nix:
  1507.     tst.w    d5
  1508.     beq.s    mittwausnull
  1509.     bra.s    mrueck3
  1510. vorz_min:
  1511.     move.w    #3,ast3(a3)
  1512. anford:
  1513.     move.l    d4,d6
  1514.     move.l    a2,a4
  1515.     move.l    a3,a5
  1516.  
  1517.     tst.w    d4
  1518.     beq.s    s2
  1519.  
  1520.     add.l    d4,a2
  1521.     add.l    #vst,a3
  1522.     subq.w    #1,d4
  1523. s1:
  1524.     move.b    -(a2),-(a3)
  1525.     sub.b    #$30,(a3)
  1526.     dbf    d4,s1
  1527. s2:
  1528.     tst.w    d5
  1529.     beq.s    s4
  1530.  
  1531.     cmp.b    #$2e,(a2)
  1532.     beq.s    nullp
  1533.     bra.s    nuk
  1534. nullp:
  1535.     addq.l    #1,a2
  1536. nuk:
  1537.     move.l    a4,a2
  1538.     move.l    a5,a3
  1539.     add.l    d6,a4
  1540.     add.l    #vst,a5
  1541.     addq.l    #1,a4
  1542.     subq.w    #1,d5
  1543. s3:
  1544.     move.b    (a4)+,(a5)+
  1545.     sub.b    #$30,-1(a5)
  1546.     dbf    d5,s3
  1547. s4:
  1548.     bra.s    mittwaus
  1549. mittwausnull:
  1550.     move.w    #1,ast3(a3)
  1551.     move.l    a3,a0
  1552.     bsr    feldloesch
  1553. mittwaus:
  1554.     movem.l    (sp)+,d0-d7/a0-a5
  1555.     rts
  1556.  
  1557. ;====================================================
  1558.  
  1559. ; adresse des feldes in a0
  1560. ; außerdem wichtige variablen :
  1561. ;    fdruck : 0 = druck im fenster, 1 = druck in datei
  1562. ;    format : 0 = druck nicht formatiert, 1 = druck formatiert
  1563.  
  1564. druck:
  1565.     bsr    testa0
  1566.  
  1567.     movem.l    d0-d7/a0-a6,-(sp)
  1568.  
  1569.     lea    fehler(pc),a1
  1570.     clr.w    (a1)
  1571.  
  1572.     move.l    byte1(pc),a1
  1573.     bsr    wandbcd_byte
  1574.     move.l    a1,a0
  1575.  
  1576.     move.l    a0,a1
  1577.     move.l    buffer(pc),a2
  1578.  
  1579.     cmp.w    #1,ast3(a0)
  1580.     beq.s    dnullzahl
  1581.  
  1582.     cmp.w    #3,ast3(a0)
  1583.     beq.s    negativ
  1584. positiv:
  1585.     move.l    #$3e202020,(a2)+
  1586.     bra.s    dru1
  1587. negativ:
  1588.     move.l    #$3e202d20,(a2)+
  1589. dru1:
  1590.     tst.b    fdruck
  1591.     bne.s    nouns
  1592.     move.l    #$9b302070,(a2)+
  1593. nouns:
  1594.     moveq    #0,d4
  1595.     moveq    #0,d5
  1596.     moveq    #0,d7
  1597.  
  1598.     move.w    ast1(a0),d4
  1599.     move.w    ast2(a0),d5
  1600.  
  1601.     tst.w    d4
  1602.     beq.s    drvornull
  1603.  
  1604.     bra.s    vorkop
  1605. drvornull:
  1606.     move.w    #$302e,(a2)+
  1607.     bra.s    nachkop
  1608. dnullzahl:
  1609.     move.l    #$3e202020,(a2)+
  1610.     move.b    #$30,(a2)+
  1611.     bra    ausdruck
  1612. vorkop:
  1613.     subq.w    #1,d4
  1614.     move.l    #vst,d6
  1615.     sub.w    ast1(a0),d6
  1616.     add.l    d6,a1
  1617. vkop:
  1618.     move.b    (a1)+,(a2)
  1619.     add.b    #$30,(a2)+
  1620.     dbf    d4,vkop
  1621.  
  1622.     tst.w    ast2(a0)
  1623.     beq    ausdruck
  1624.  
  1625.     move.b    #$2e,(a2)+
  1626. nachkop:
  1627.     move.l    a0,a1
  1628.     move.w    ast2(a0),d4
  1629.     subq.w    #1,d4
  1630.     move.l    a0,a1
  1631.     add.l    #vst,a1
  1632.     lea    z1(pc),a3
  1633.     move.w    #5,(a3)
  1634.     move.w    #11,2(a3)
  1635.     moveq    #0,d7
  1636.  
  1637.     tst.b    format
  1638.     beq.s    nkop
  1639.  
  1640.     move.w    #$30,4(a3)
  1641.     move.b    #$a,(a2)+
  1642.     move.b    #$30,(a2)+
  1643.     move.b    #$20,(a2)+
  1644. nkop:
  1645.     move.b    (a1)+,d0
  1646.  
  1647.     tst.b    format
  1648.     beq.s    z1rueck
  1649.  
  1650.     subq.w    #1,(a3)
  1651.     bcs.s    z1neu
  1652. z1rueck:
  1653.     add.b    #$30,d0
  1654.     move.b    d0,(a2)+
  1655.     dbf    d4,nkop
  1656.  
  1657.     bra.s    ausdruck
  1658. z1neu:
  1659.     move.b    #$20,(a2)+
  1660.     addq.w    #1,d7
  1661.     cmp.w    #6,d7
  1662.     beq.s    zd71w
  1663. zd71r:
  1664.     move.w    #4,(a3)
  1665.     subq.w    #1,2(a3)
  1666.     bcc.s    z1rueck
  1667.     move.b    #$a,(a2)+
  1668.     move.w    #11,2(a3)
  1669.     moveq    #0,d7
  1670.     addq.w    #1,4(a3)
  1671.     cmp.w    #$39,4(a3)
  1672.     bhi.s    z3neu
  1673. z3ok:
  1674.     move.b    z3+1(pc),(a2)+
  1675.     move.b    #$20,(a2)+
  1676.     bra.s    z1rueck
  1677. zd71w:
  1678.     move.b    #$20,(a2)+
  1679.     move.b    #$20,(a2)+
  1680.     bra.s    zd71r
  1681. z3neu:
  1682.     move.w    #$30,4(a3)
  1683.     bra.s    z3ok
  1684. ausdruck:
  1685.     lea    fdruck(pc),a0
  1686.     tst.b    (a0)
  1687.     beq.s    winddruck
  1688.  
  1689. ; datei schreiben
  1690.  
  1691.     lea    datname(pc),a0
  1692.     move.l    a0,d1
  1693.     move.l    #mode_new,d2
  1694.     jsr    open(a6)
  1695.     move.l    d0,d7;        datei öffnen
  1696.     beq.s    dat_fehler
  1697.  
  1698.     move.l    d7,d1
  1699.     move.l    buffer(pc),d2
  1700.     move.l    a2,d3
  1701.     sub.l    d2,d3
  1702.     jsr    write(a6);        datei schreiben
  1703.  
  1704.     move.l    d7,d1
  1705.     jsr    close(a6);        und wieder schließen
  1706.  
  1707.     bra.s    druck2aus
  1708. dat_fehler:
  1709.     lea    fehler(pc),a0
  1710.     move.w    #1,(a0)
  1711.     bra.s    druck2aus
  1712. winddruck:
  1713.     move.b    #$9b,(a2)+
  1714.     move.b    #$4b,(a2)+
  1715.     move.b    #$a,(a2)+
  1716.     move.b    #$9b,(a2)+
  1717.     move.b    #$20,(a2)+
  1718.     move.b    #$70,(a2)+
  1719.  
  1720.     move.l    a2,d3
  1721.     move.l    buffer(pc),d2
  1722.     sub.l    d2,d3
  1723.     move.l    conhandle(pc),d1
  1724.     jsr    write(a6)
  1725. druck2aus:
  1726.     movem.l    (sp)+,d0-d7/a0-a6
  1727.  
  1728.     rts
  1729.  
  1730. ; =================================================
  1731.  
  1732. ; adresse des bcdfeldes in a0
  1733. ; benutzt feld : buffer
  1734.  
  1735. alldruck:
  1736.     movem.l    d4-d7/a0-a6,-(sp)
  1737.  
  1738.     move.l    a0,a1
  1739.     move.l    buffer(pc),a2
  1740.  
  1741.     move.l    #$3e202020,(a2)+
  1742.  
  1743.     move.w    #vsb/2-1,d4
  1744.     bsr    makehex
  1745.  
  1746. ; nachkommateil kopieren
  1747.  
  1748.     move.b    #".",(a2)+
  1749.     move.w    #nsb/2-1,d4
  1750.     bsr    makehex
  1751.     move.b    #" ",(a2)+
  1752.     moveq    #3,d4
  1753.     bsr    makehex
  1754.  
  1755.     move.b    #$9b,(a2)+
  1756.     move.b    #$4b,(a2)+
  1757.     move.b    #$a,(a2)+
  1758.  
  1759.     move.l    a2,d3
  1760.     sub.l    buffer(pc),d3
  1761.  
  1762.     move.l    conhandle(pc),d1
  1763.     move.l    buffer(pc),d2
  1764.     jsr    write(a6)
  1765.  
  1766.     movem.l    (sp)+,d4-d7/a0-a6
  1767.  
  1768.     rts
  1769.  
  1770. makehex:
  1771.     moveq    #3,d3
  1772.     move.w    (a1)+,d5
  1773. makehex1:
  1774.     rol.w    #4,d5
  1775.     move.w    d5,d6
  1776.     and.w    #$f,d6
  1777.  
  1778.     cmp.w    #9,d6
  1779.     bhi.s    abuchst
  1780.  
  1781.     add.b    #$30,d6
  1782.     bra.s    az_ok
  1783. abuchst:
  1784.     add.b    #$37,d6
  1785. az_ok:
  1786.     move.b    d6,(a2)+
  1787.     dbf    d3,makehex1
  1788.     dbf    d4,makehex
  1789.     rts
  1790.  
  1791.  
  1792. ;==================================================
  1793. ;================ rechenroutinen ==================
  1794. ;====== teil 1 : grundrechenarten und andere ======
  1795. ;======= basis operationen wie vergleichen ========
  1796. ;================ und feld löschen ================
  1797. ;==================================================
  1798.  
  1799.  
  1800. testa0:
  1801.     tst.w    st3(a0)
  1802.     beq    st3fehler
  1803.     cmp.w    #3,st3(a0)
  1804.     bhi    st3fehler
  1805.  
  1806.     rts
  1807. testa0a1:
  1808.     tst.w    st3(a0)
  1809.     beq    st3fehler
  1810.     cmp.w    #3,st3(a0)
  1811.     bhi    st3fehler
  1812.  
  1813.     tst.w    st3(a1)
  1814.     beq    st3fehler
  1815.     cmp.w    #3,st3(a1)
  1816.     bhi    st3fehler
  1817.  
  1818.     rts
  1819.  
  1820.  
  1821. ; adresse von bytefeld in a0
  1822. ; adresse von bcdfeld und Ergebnisfeld in a1
  1823.  
  1824. wandbyte_bcd:
  1825.     movem.l    d0/d1/a0/a1,-(sp)
  1826.  
  1827.     move.w    #sb-1,d0
  1828. byte_bcd:
  1829.     move.b    (a0)+,d1
  1830.     lsl.b    #4,d1
  1831.     add.b    (a0)+,d1
  1832.     move.b    d1,(a1)+
  1833.     dbf    d0,byte_bcd
  1834.  
  1835.     move.l    (a0)+,(a1)+
  1836.     move.l    (a0)+,(a1)+
  1837.  
  1838.     movem.l    (sp)+,d0/d1/a0/a1
  1839.  
  1840.     rts
  1841.  
  1842. ;==============================================
  1843.  
  1844. ; adresse von bcdfeld in a0
  1845. ; adresse von bytefeld und Ergebnisfeld in a1
  1846.  
  1847. wandbcd_byte:
  1848.     movem.l    d0-d2/a0/a1,-(sp)
  1849.  
  1850.     move.w    #sb-1,d0
  1851. bcd_byte:
  1852.     move.b    (a0)+,d1
  1853.     move.b    d1,d2
  1854.     lsr.b    #4,d1
  1855.     move.b    d1,(a1)+
  1856.     and.b    #$f,d2
  1857.     move.b    d2,(a1)+
  1858.     dbf    d0,bcd_byte
  1859.  
  1860.     move.l    (a0)+,(a1)+
  1861.     move.l    (a0)+,(a1)+
  1862.  
  1863.     movem.l    (sp)+,d0-d2/a0/a1
  1864.  
  1865.     rts
  1866.  
  1867. ;=======================================================
  1868.  
  1869. ; adresse von feld in a0
  1870. ; teilt ein feld durch 2
  1871.  
  1872. durch2:
  1873.     bsr    testa0
  1874.  
  1875.     movem.l    d3-d5/a0/a1,-(sp)
  1876.  
  1877.     cmp.w    #1,st3(a0)
  1878.     beq    durch2aus
  1879.  
  1880.     bsr    dist_st
  1881.  
  1882.     move.l    a0,a1
  1883.     lsr.w    #1,d4
  1884.     bcc.s    no2a
  1885.  
  1886.     btst    #0,d5
  1887.     bne.s    no2a
  1888.  
  1889.     addq.l    #2,d5
  1890. no2a:
  1891.     add.l    d4,a1
  1892.     addq.w    #1,d5
  1893.     lsr.w    #1,d5
  1894.     add.l    d5,a1
  1895.  
  1896.     subq.w    #1,d5
  1897. durch21:
  1898.     move.b    -(a1),d4
  1899.     move.b    d4,d3
  1900.     and.b    #$f,d4
  1901.     lsr.b    #1,d4
  1902.     bcc.s    nopl51
  1903.     add.b    #$50,1(a1)
  1904. nopl51:
  1905.     lsr.b    #4,d3
  1906.     lsr.b    #1,d3
  1907.     bcc.s    nopl52
  1908.     addq.b    #5,d4
  1909. nopl52:
  1910.     lsl.b    #4,d3
  1911.     add.b    d3,d4
  1912.     move.b    d4,(a1)
  1913.  
  1914.     dbf    d5,durch21
  1915.  
  1916.     moveq    #0,d4
  1917.     move.w    st1(a0),d4
  1918.     beq.s    d2vaus
  1919.  
  1920.     move.l    a0,a1
  1921.     add.l    #vsb,a1
  1922.     clr.w    d5
  1923.     lsr.w    #1,d4
  1924.     addx.w    d5,d5
  1925.     sub.l    d4,a1
  1926.     tst.w    d5
  1927.     beq.s    tsteq
  1928.  
  1929.     tst.b    -1(a1)
  1930.     bne.s    d2vaus
  1931.     bra.s    subd2v
  1932. tsteq:
  1933.     cmp.b    #9,(a1)
  1934.     bhi.s    d2vaus
  1935. subd2v:
  1936.     subq.w    #1,st1(a0)
  1937. d2vaus:
  1938.     moveq    #0,d4
  1939.     move.w    st2(a0),d4
  1940.  
  1941.     move.l    a0,a1
  1942.     add.l    #vsb,a1
  1943.     clr.w    d5
  1944.     lsr.w    #1,d4
  1945.     addx.w    d5,d5
  1946.     add.l    d4,a1
  1947.  
  1948.     tst.w    d5
  1949.     beq.s    tst2eq
  1950.  
  1951.     move.b    (a1),d4
  1952.     and.b    #$f,d4
  1953.     beq.s    durch2aus
  1954.     bra.s    d2npl
  1955. tst2eq:
  1956.     tst.b    (a1)
  1957.     beq.s    durch2aus
  1958. d2npl:
  1959.     addq.w    #1,st2(a0)
  1960.     cmp.w    #nst,st2(a0)
  1961.     bls.s    durch2aus
  1962.     clr.w    sb(a0)
  1963.     move.w    #nst,st2(a0)
  1964. durch2aus:
  1965.     movem.l    (sp)+,d3-d5/a0/a1
  1966.  
  1967.     rts
  1968.  
  1969. ;=================================================
  1970.  
  1971. ; plus mit vorzeichen
  1972. ; adresse von Summand 1 in a0
  1973. ; adresse von Summand 2 und Ergebnisfeld in a1
  1974.  
  1975. pluss:
  1976.     bsr    testa0a1
  1977.  
  1978.     movem.l    d4/d5/a0/a1,-(sp)
  1979.  
  1980.     move.w    st3(a0),d4
  1981.     move.w    st3(a1),d5
  1982.  
  1983.     cmp.w    #1,d4
  1984.     beq    plussex
  1985.  
  1986.     cmp.w    #2,d4
  1987.     beq.s    p_pl1
  1988.  
  1989.     bra.s    p_mi1
  1990. p_kop_plussex:
  1991.     bsr    kopieren
  1992.     bra.s    plussex
  1993. p_pl1:
  1994.     cmp.w    #1,d5
  1995.     beq.s    p_kop_plussex
  1996.  
  1997.     cmp.w    #2,d5
  1998.     beq.s    p_pl1_pl2
  1999. p_pl1_mi2:
  2000.     bsr    minusu
  2001.  
  2002.     cmp.w    #2,st3(a1)
  2003.     beq.s    p_pl_mi
  2004.  
  2005.     move.w    #2,st3(a1)
  2006.  
  2007.     bra.s    plussex
  2008. p_pl_mi:
  2009.     move.w    #3,st3(a1)
  2010.     bra.s    plussex
  2011. p_mi1:
  2012.     cmp.w    #1,d5
  2013.     beq.s    p_kop_plussex
  2014.  
  2015.     cmp.w    #2,d5
  2016.     beq.s    p_mi1_pl2
  2017. p_mi1_mi2:
  2018.     bsr    plusu
  2019.     move.w    #3,st3(a1)
  2020.     bra.s    plussex
  2021. p_pl1_pl2:
  2022.     bsr    plusu
  2023.     bra.s    plussex
  2024. p_mi1_pl2:
  2025.     bsr    minusu
  2026. plussex:
  2027.     movem.l    (sp)+,d4/d5/a0/a1
  2028.  
  2029.     rts
  2030.  
  2031. ;=====================================================
  2032.  
  2033. ; minus mit vorzeichen
  2034. ; adresse von minuend 1 in a0
  2035. ; adresse von subtrahent und ergebnisfeld in a1
  2036.  
  2037. minuss:
  2038.     bsr    testa0a1
  2039.  
  2040.     movem.l    d4/d5/a0/a1,-(sp)
  2041.  
  2042.     move.w    st3(a0),d4
  2043.     move.w    st3(a1),d5
  2044.  
  2045.     cmp.w    #1,d4
  2046.     beq.s    minussex
  2047.  
  2048.     cmp.w    #2,d4
  2049.     beq.s    m_pl1
  2050. m_mi1:
  2051.     cmp.w    #1,d5
  2052.     beq.s    kop_minussex
  2053.  
  2054.     cmp.w    #2,d5
  2055.     beq.s    m_mi1_pl2
  2056. m_mi1_mi2:
  2057.     bsr    minusu
  2058.  
  2059.     cmp.w    #2,st3(a1)
  2060.     beq.s    m_pl_mi
  2061.  
  2062.     move.w    #2,st3(a1)
  2063.     bra.s    minussex
  2064. m_pl_mi:
  2065.     move.w    #3,st3(a1)
  2066.     bra.s    minussex
  2067. m_pl1:
  2068.     cmp.w    #1,d5
  2069.     beq.s    m_pl1_n2
  2070.  
  2071.     cmp.w    #2,d5
  2072.     beq.s    m_pl1_pl2
  2073. m_pl1_mi2:
  2074.     bsr    plusu
  2075.     move.w    #3,st3(a1)
  2076.     bra.s    minussex
  2077. m_pl1_n2:
  2078.     bsr    kopieren
  2079.     move.w    #3,st3(a1)
  2080.     bra.s    minussex
  2081. m_pl1_pl2:
  2082.     bsr    minusu
  2083.     bra.s    minussex
  2084. kop_minussex:
  2085.     bsr    kopieren
  2086.     bra.s    minussex
  2087. m_mi1_pl2:
  2088.     bsr    plusu
  2089.     move.w    #2,st3(a1)
  2090. minussex:
  2091.     movem.l    (sp)+,d4/d5/a0/a1
  2092.  
  2093.     rts
  2094.  
  2095. ;====================================================
  2096.  
  2097. ; vergleich mit vorzeichen
  2098. ; adresse der felder in a0 und in a1
  2099. ; ergebnis in d4
  2100. ; 1 : beide gleich
  2101. ; 2 : a0 grösser a1
  2102. ; 3 : a1 grösser a0
  2103.  
  2104. vers:
  2105.     bsr    testa0a1
  2106.  
  2107.     movem.l    d5/a0/a1,-(sp)
  2108.  
  2109.     move.w    st3(a0),d4
  2110.     move.w    st3(a1),d5
  2111.  
  2112.     cmp.w    #1,d4
  2113.     beq.s    v_n1
  2114.  
  2115.     cmp.w    #2,d4
  2116.     beq.s    v_pl1
  2117.  
  2118.     bra.s    v_mi1
  2119. v_n1:
  2120.     cmp.w    #1,d5
  2121.     beq.s    v_n1_n2
  2122.  
  2123.     cmp.w    #2,d5
  2124.     beq.s    v_n1_pl2
  2125. v_n1_mi2:
  2126.     moveq    #2,d4
  2127.     bra.s    versex
  2128. v_pl1:
  2129.     cmp.w    #1,d5
  2130.     beq.s    v_pl1_n2
  2131.  
  2132.     cmp.w    #2,d5
  2133.     beq.s    v_pl1_pl2
  2134. v_pl1_mi2:
  2135.     moveq    #2,d4
  2136.     bra.s    versex
  2137. v_mi1:
  2138.     cmp.w    #1,d5
  2139.     beq.s    v_mi1_n2
  2140.  
  2141.     cmp.w    #2,d5
  2142.     beq.s    v_mi1_pl2
  2143. v_mi1_mi2:
  2144.     bsr    veru
  2145.  
  2146.     cmp.b    #2,d4
  2147.     beq.s    v_gr_kl
  2148.  
  2149.     cmp.b    #1,d4
  2150.     beq.s    v_gl
  2151. v_kl_gr:
  2152.     moveq    #2,d4
  2153.  
  2154.     bra.s    versex
  2155. v_gr_kl:
  2156.     moveq    #3,d4
  2157.     bra.s    versex
  2158. v_gl:
  2159.     move.l    #1,d4
  2160.     bra    versex
  2161. v_n1_n2:
  2162.     moveq    #1,d4
  2163.     bra    versex
  2164. v_n1_pl2:
  2165.     moveq    #3,d4
  2166.     bra    versex
  2167. v_pl1_n2:
  2168.     moveq    #2,d4
  2169.     bra.s    versex
  2170. v_pl1_pl2:
  2171.     bsr    veru
  2172.     bra.s    versex
  2173. v_mi1_n2:
  2174. v_mi1_pl2:
  2175.     moveq    #3,d4
  2176. versex:
  2177.     movem.l    (sp)+,d5/a0/a1
  2178.  
  2179.     rts
  2180.  
  2181. ;==================================================
  2182.  
  2183. ; plus ohne vorzeichen
  2184. ; adresse von Summand 1 in a0
  2185. ; adresse von Summand 2 und Ergebnisfeld in a1
  2186.  
  2187. plusu:
  2188.     bsr    testa0a1
  2189.  
  2190.     movem.l    d4-d7/a0-a4,-(sp)
  2191.  
  2192.     cmp.w    #1,st3(a0)
  2193.     beq    pende
  2194.  
  2195.     move.b    (a0),d4
  2196.     move.b    (a1),d5
  2197.     sub.w    d6,d6
  2198.     abcd    d5,d4
  2199.     bcs    add_uberlauf
  2200.  
  2201.     cmp.w    #1,st3(a1)
  2202.     beq    kop0
  2203.  
  2204.     bsr    findrausgrkl
  2205.  
  2206.     move.w    d4,st1(a1)
  2207.     move.w    d5,st2(a1)
  2208.  
  2209.     move.l    a0,a3;    a3 : summand 1
  2210.     move.l    a1,a4;    a4 : summand 2 und ergebnis
  2211.  
  2212.     add.l    #vsb,a3
  2213.     add.l    #vsb,a4
  2214.  
  2215.     move.w    d4,d6
  2216.     addq.w    #1,d4
  2217.     addq.w    #1,d5
  2218.     lsr.w    #1,d4
  2219.     lsr.w    #1,d5
  2220.     move.l    d5,d7
  2221.     add.l    d5,a3
  2222.     add.l    d5,a4
  2223.     move.l    a4,a2
  2224.     add.w    d4,d5
  2225.     sub.w    d4,d4;        x-flag löschen
  2226. plus1:
  2227.     abcd    -(a3),-(a4)
  2228.     dbf    d5,plus1
  2229.  
  2230. ; vorkomma
  2231.  
  2232.     btst    #0,d6
  2233.     beq.s    plu_ger
  2234.  
  2235.     move.b    1(a4),d4
  2236.     lsr.b    #4,d4
  2237.     bne.s    addeinestelle
  2238.     bra.s    plaus
  2239. plu_ger:
  2240.     tst.b    (a4)
  2241.     bne.s    addeinestelle
  2242.  
  2243.     bra.s    plaus
  2244. addeinestelle:
  2245.     addq.w    #1,st1(a1)
  2246. plaus:
  2247.     move.w    #2,st3(a1)
  2248.  
  2249.     move.w    d7,d4
  2250.     beq.s    movd4a1
  2251.  
  2252.     move.l    a1,a3
  2253.     add.l    #vsb,a3
  2254.     add.l    d7,a3
  2255. pin:
  2256.     tst.b    -(a3)
  2257.     beq.s    subeinestelle
  2258.  
  2259.     bra.s    paus
  2260. subeinestelle:
  2261.     subq.w    #1,d4
  2262.     beq.s    paus0
  2263.     bra.s    pin
  2264. paus0:
  2265.     clr.w    st2(a1)
  2266.     bra.s    pende
  2267. paus:
  2268.     add.w    d4,d4
  2269.     move.b    (a3),d5
  2270.     and.b    #$f,d5
  2271.     beq.s    plnaeinweni
  2272. movd4a1:
  2273.     move.w    d4,st2(a1)
  2274.     bra.s    pende
  2275. plnaeinweni:
  2276.     subq.w    #1,d4
  2277.     bra.s    movd4a1
  2278. kop0:
  2279.     bsr    kopieren
  2280. pende:
  2281.     movem.l    (sp)+,d4-d7/a0-a4
  2282.  
  2283.     rts
  2284.  
  2285. ;=======================================================
  2286.  
  2287. ; minus ohne vorzeichen
  2288. ; adresse von Subtrahent in a0
  2289. ; adresse von Subtraktor und Ergebnisfeld in a1
  2290.  
  2291. minusu:
  2292.     bsr    testa0a1
  2293.  
  2294.     movem.l    d3-d7/a0-a4,-(sp)
  2295.  
  2296.     move.l    a0,a2
  2297.     move.l    a1,a3
  2298.     bsr    veru
  2299.     move.b    d4,d3
  2300.  
  2301.     cmp.b    #1,d4
  2302.     beq    minnull
  2303.  
  2304.     bsr    findrausgrkl
  2305.     move.w    d4,st1(a1)
  2306.     move.w    d5,st2(a1)
  2307.  
  2308.     move.l    a0,a3;    a3 : summand 1
  2309.     move.l    a1,a4;    a4 : summand 2 und ergebnis
  2310.  
  2311.     add.l    #vsb,a3
  2312.     add.l    #vsb,a4
  2313.  
  2314.     addq.w    #1,d4
  2315.     addq.w    #1,d5
  2316.     lsr.w    #1,d4
  2317.     lsr.w    #1,d5
  2318.     move.w    d4,d6
  2319.     move.l    d5,d7
  2320.     add.l    d5,a3
  2321.     add.l    d5,a4
  2322.     move.l    a4,a2
  2323.     add.w    d4,d5
  2324.  
  2325.     cmp.b    #2,d3
  2326.     beq.s    tauschsubtr
  2327.  
  2328.     move.w    #2,st3(a1)
  2329.     bra.s    subtr_ok
  2330. tauschsubtr:
  2331.     movem.l    d0/a0/a1,-(sp)
  2332.  
  2333.     move.l    a4,a0
  2334.     move.l    rt1(pc),a1
  2335.     add.l    #sb,a1
  2336.     move.w    d5,d0
  2337. tauschsub:
  2338.     move.b    -(a0),-(a1)
  2339.     move.b    -(a3),(a0)
  2340.     dbf    d0,tauschsub
  2341.  
  2342.     movem.l    (sp)+,d0/a0/a1
  2343.     move.l    rt1(pc),a3
  2344.     add.l    #sb,a3
  2345.     move.w    #3,st3(a1)
  2346. subtr_ok:
  2347.     sub.w    d4,d4;        x-flag löschen
  2348. minus1:
  2349.     sbcd    -(a3),-(a4)
  2350.     dbf    d5,minus1
  2351.  
  2352. ; vorkommastellenzahl errechnen
  2353.  
  2354.     tst.w    d6
  2355.     beq.s    mind6ok
  2356.     addq.l    #1,a4
  2357. minsubback:
  2358.     tst.b    (a4)
  2359.     beq.s    minsubein
  2360.     bra.s    minvaus
  2361. minsubein:
  2362.     subq.w    #1,d6
  2363.     beq.s    mind6ok
  2364.     addq.l    #1,a4
  2365.     bra.s    minsubback
  2366. minvaus:
  2367.     add.w    d6,d6
  2368.     move.b    (a4),d4
  2369.     lsr.b    #4,d4
  2370.     beq.s    subnaein
  2371.     bra.s    mind6ok
  2372. subnaein:
  2373.     subq.w    #1,d6
  2374. mind6ok:
  2375.     move.w    d6,st1(a1)
  2376.  
  2377. ; nachkommastellenzahl errechnen
  2378.  
  2379.     move.w    d7,d4
  2380.     beq.s    mid4ok
  2381.  
  2382.     move.l    a1,a3
  2383.     add.l    #vsb,a3
  2384.     add.l    d7,a3
  2385. miin:
  2386.     tst.b    -(a3)
  2387.     beq.s    misubnein
  2388.  
  2389.     bra.s    miaus
  2390. misubnein:
  2391.     subq.w    #1,d4
  2392.     beq.s    miaus0
  2393.     bra.s    miin
  2394. miaus0:
  2395.     clr.w    st2(a1)
  2396.     bra.s    minex
  2397. miaus:
  2398.     add.w    d4,d4
  2399.     move.b    (a3),d5
  2400.     and.b    #$f,d5
  2401.     beq.s    minaeinweni
  2402. mid4ok:
  2403.     move.w    d4,st2(a1)
  2404.     bra.s    minex
  2405. minaeinweni:
  2406.     subq.w    #1,d4
  2407.     bra.s    mid4ok
  2408. minnull:
  2409.     move.l    a1,a0
  2410.     bsr    feldloesch
  2411. minex:
  2412.     movem.l    (sp)+,d3-d7/a0-a4
  2413.  
  2414.     rts
  2415.  
  2416. ;=======================================================
  2417.  
  2418. ; multiplikation mit vorzeichen
  2419. ; adresse von faktor 1 in a0
  2420. ; adresse von faktor 2 und ergebnisfeld in a1
  2421.  
  2422. mals:
  2423.     bsr    testa0a1
  2424.  
  2425.     movem.l    d0-d7/a0-a5,-(sp)
  2426.  
  2427.     cmp.w    #1,st3(a0)
  2428.     beq    malnull1
  2429.     cmp.w    #1,st3(a1)
  2430.     beq    malsaus
  2431.  
  2432. ; vorzeichen des ergebnisses ermitteln
  2433.  
  2434.     move.w    st3(a0),d0
  2435.     cmp.w    st3(a1),d0
  2436.     beq.s    mgleich
  2437.     move.w    #3,st3(a1)
  2438.     bra.s    mvorzaus
  2439. mgleich:
  2440.     move.w    #2,st3(a1)
  2441. mvorzaus:
  2442.  
  2443. ; rechenfeld rt1 loeschen
  2444.  
  2445.     move.w    #sb*3/2+10,d4
  2446.     move.l    rt1(pc),a3
  2447. mlo:
  2448.     clr.w    (a3)+
  2449.     dbf    d4,mlo
  2450.  
  2451. ; stellenzahlen und distanzwerte
  2452.  
  2453.     moveq    #0,d4
  2454.     moveq    #0,d5
  2455.     move.l    a0,a2;        a3 : adresse von faktor 1
  2456.     move.l    a1,a3;        a4 : adresse von faktor 2
  2457.  
  2458.     bsr    dist_st
  2459.  
  2460.     move.l    d4,d0
  2461.     move.l    d5,d1
  2462.  
  2463.     bsr    maketab
  2464.  
  2465.     move.l    a1,a5;        a5 : adresse des ergebnisfeldes
  2466.     moveq    #0,d4
  2467.     moveq    #0,d5
  2468.     move.l    a1,a0
  2469.     bsr    dist_st
  2470.  
  2471.     moveq    #0,d7
  2472.     move.w    d4,d7
  2473.     clr.w    d6
  2474.     lsr.w    #1,d7
  2475.     addx.w    d6,d6
  2476.     tst.w    d6
  2477.     sne    d6
  2478.     add.l    d7,a0
  2479.  
  2480. ; anfangsadresse im rechenfeld rt1 ermitteln 
  2481.  
  2482.     move.l    rt1(pc),a3
  2483.     move.l    #vst+8,d2
  2484.     move.l    d0,d3
  2485.     sub.l    #vst,d3
  2486.     add.l    d3,d2
  2487.     sub.l    #vst,d4
  2488.     add.l    d4,d2
  2489.     moveq    #0,d7
  2490.     asr.l    #1,d2
  2491.     addx.w    d7,d7
  2492.     tst.w    d7
  2493.     sne    d7
  2494.  
  2495.     moveq    #0,d3
  2496.     btst    d3,d4
  2497.     beq.s    d0test
  2498.     subq.l    #1,d2
  2499.     bra.s    d2aus1
  2500. d0test:
  2501.     btst    d3,d0
  2502.     bne.s    d2aus1
  2503.     subq.l    #2,d2
  2504. d2aus1:
  2505.     btst    d3,d0
  2506.     bne.s    d1test
  2507.     btst    d3,d1
  2508.     beq.s    d2aus2
  2509.     addq.l    #1,d2
  2510.     bra.s    d2aus2
  2511. d1test:
  2512.     btst    d3,d1
  2513.     bne.s    d2aus2
  2514.     subq.l    #1,d2
  2515. d2aus2:
  2516.     cmp.w    #2,d2
  2517.     blo    mal_uberlauf
  2518.     tst.w    d2
  2519.     bmi    mal_uberlauf
  2520.  
  2521.     moveq    #0,d3
  2522.     move.w    d1,d3
  2523.     lsr.w    #1,d3
  2524.     add.l    d3,d2
  2525.     add.l    d2,a3
  2526.  
  2527.     move.l    tabr(pc),a1
  2528.     subq.w    #1,d5
  2529.  
  2530.     move.w    d1,d2
  2531.     lsr.w    #1,d1
  2532.     addq.w    #1,d2
  2533.     lsr.w    #1,d2
  2534.     move.w    d2,d1
  2535.  
  2536.     move.l    r1(pc),a5
  2537.     move.w    #sb+10/2-1,d0
  2538. clrr1a:
  2539.     clr.w    (a5)+
  2540.     dbf    d0,clrr1a
  2541.  
  2542.     move.l    a5,d2
  2543.     move.w    #sb+4,d3
  2544.     move.l    #sb+4*10+2,d4
  2545.  
  2546. ; verwendete rechenfelder:
  2547. ;
  2548. ; r1 : 01
  2549. ; rt1:    rechenfeld für subtraktion (rest, 3-fache länge)
  2550. ; tabr: tabelle fur multiplikation von 1 bis 10
  2551. ;
  2552. ; register:
  2553. ;
  2554. ; d0 : rechenregister
  2555. ; d1 : laufzahl multergebnis
  2556. ; d2 : zeiger auf r1, rechts
  2557. ; d3 : sb+4
  2558. ; d4 : sb+4*10+2
  2559. ; d5 : laufzahl gesamt
  2560. ; d6 : bit für wechsel von neuer zahl
  2561. ; d7 : bit für wechsel von tabr
  2562. ;
  2563. ; a0 : zeiger auf nächste zahl
  2564. ; a1 : zeiger auf tabr
  2565. ; a2 : rechenregister
  2566. ; a3 : zeiger auf rt1 rechts
  2567. ; a4 : rechenregister
  2568. ; a5 : adresse von nullbytes (ende)
  2569. ; a6 : nicht benutzt
  2570.  
  2571.  
  2572. mmulanf:
  2573.     moveq    #0,d0
  2574.     not.b    d6
  2575.     beq.s    mbcdr
  2576.  
  2577.     move.b    (a0),d0
  2578.     lsr.b    #4,d0
  2579.     bra.s    mbcdraus
  2580. mbcdr:
  2581.     move.b    (a0)+,d0
  2582.     and.b    #$f,d0
  2583. mbcdraus:
  2584.     tst.b    d0
  2585.     beq.s    muladdnull
  2586.  
  2587.     mulu    d3,d0
  2588.     move.l    a1,a2
  2589.     add.l    d0,a2
  2590.  
  2591.     not.b    d7
  2592.     beq.s    noadd
  2593.     add.l    d4,a2
  2594.     addq.l    #1,a3
  2595. noadd:
  2596.     move.l    a3,a4
  2597.     sub.w    d0,d0
  2598.     move.w    d1,d0
  2599. muladd:
  2600.     abcd    -(a2),-(a4)
  2601.     dbf    d0,muladd
  2602.     bcs.s    weiadd
  2603.  
  2604.     bra.s    muladdaus
  2605. muladdnull:
  2606.     not.b    d7
  2607.     beq.s    muladdaus
  2608.     addq.l    #1,a3
  2609.     bra.s    muladdaus
  2610. weiadd:
  2611.     abcd    -(a5),-(a4)
  2612.     bcs.s    weiadd
  2613.  
  2614.     move.l    d2,d0
  2615.     sub.l    a5,d0
  2616.     subq.w    #1,d0
  2617. clrr1b:
  2618.     clr.b    (a5)+
  2619.     dbf    d0,clrr1b
  2620.     move.l    d2,a5
  2621. muladdaus:
  2622.     dbf    d5,mmulanf
  2623.  
  2624.     move.l    4*9(sp),a5
  2625.  
  2626.     move.l    rt1,a0
  2627.     tst.w    (a0)
  2628.     bne    mal_uberlauf
  2629.  
  2630. ; ergebnis vom rechenfeld zum ergebnisfeld kopieren
  2631.  
  2632.     addq.l    #2,a0
  2633.     move.l    a5,a4
  2634.     move.w    #sb/2-1,d0
  2635.     moveq    #0,d1
  2636.     moveq    #0,d2
  2637. kopmal:
  2638.     move.w    (a0)+,(a4)+
  2639.     sne    d1
  2640.     or.w    d1,d2
  2641.     dbf    d0,kopmal
  2642.  
  2643.     tst.w    d2
  2644.     beq    malnullerg
  2645.  
  2646. ; letzte stelle aufrunden
  2647.  
  2648.     cmp.b    #$49,(a0)
  2649.     bhi.s    maufrd
  2650.     bra.s    maufrdaus
  2651. maufrd:
  2652.     move.l    a4,a3
  2653.  
  2654.     move.l    rt1(pc),a0
  2655.     move.w    #sb,d0
  2656. mclrrt1:
  2657.     clr.w    (a0)+
  2658.     dbf    d0,mclrrt1
  2659.  
  2660.     move.b    #1,-1(a0)
  2661.     sub.w    d0,d0
  2662. contrm:
  2663.     abcd    -(a0),-(a4)
  2664.     bcs.s    contrm
  2665.  
  2666.     move.l    a3,a4
  2667. maufrdaus:
  2668.  
  2669. ; nachkommastellenzahl ermitteln
  2670.  
  2671.     move.w    #nsb,d0
  2672. mnachm:
  2673.     tst.b    -(a4)
  2674.     bne.s    mnachex
  2675.  
  2676.     subq.w    #1,d0
  2677.     bne.s    mnachm
  2678.  
  2679.     bra.s    mnachaus
  2680. mnsubeine:
  2681.     subq.w    #1,d0
  2682.     bra.s    mnachaus
  2683. mnachex:
  2684.     add.w    d0,d0
  2685.     move.b    (a4),d1
  2686.     lsl.b    #4,d1
  2687.     beq.s    mnsubeine
  2688. mnachaus:
  2689.     move.w    d0,st2(a5)
  2690.  
  2691. ; vorkommastellen ermitteln
  2692.  
  2693.     move.l    a5,a4
  2694.     move.w    #vsb-1,d0
  2695. tsta4:
  2696.     tst.b    (a4)+
  2697.     bne.s    mvor
  2698.     dbf    d0,tsta4
  2699.     clr.w    d0
  2700.     bra.s    mvoraus
  2701. mvor:
  2702.     addq.w    #1,d0
  2703.     add.w    d0,d0
  2704.     move.b    -1(a4),d1
  2705.     lsr.b    #4,d1
  2706.     bne.s    mvoraus
  2707.  
  2708.     subq.w    #1,d0
  2709. mvoraus:
  2710.     move.w    d0,st1(a5)
  2711.     bra.s    malsaus
  2712. malnullerg:
  2713.     clr.l    (a4)+
  2714.     move.l    #$00000001,(a4)
  2715.     bra.s    malsaus
  2716. malnull1:
  2717.     move.l    a1,a0
  2718.     bsr    feldloesch
  2719. malsaus:
  2720.     movem.l    (sp)+,d0-d7/a0-a5
  2721.  
  2722.     rts
  2723.  
  2724. ;===========================================================
  2725.  
  2726. ; division mit vorzeichen
  2727. ; adresse von dividend in a0
  2728. ; adresse von divisor und ergebnisfeld in a1
  2729.  
  2730. ; f1 ist das feld in a0
  2731. ; f2 ist das feld in a1
  2732.  
  2733. div:
  2734.     bsr    testa0a1
  2735.  
  2736.     cmp.w    #1,st3(a0)
  2737.     beq    div_null
  2738.  
  2739.     movem.l    d0-d7/a0-a5,-(sp)
  2740.  
  2741.     cmp.w    #1,st3(a1)
  2742.     beq    divaus
  2743.  
  2744. ; vorzeichen ermitteln
  2745.  
  2746.     move.w    st3(a1),d4
  2747.     cmp.w    st3(a0),d4
  2748.     beq.s    dgleich
  2749.  
  2750.     move.w    #3,st3(a1)
  2751.     bra.s    dvorzaus
  2752. dgleich:
  2753.     move.w    #2,st3(a1)
  2754. dvorzaus:
  2755.  
  2756. ; rechenfeld rt1 löschen
  2757.  
  2758.     move.l    rt1(pc),a5
  2759.     move.w    #sb*3/2,d4
  2760. div1:
  2761.     clr.w    (a5)+
  2762.     dbf    d4,div1
  2763.  
  2764. ; distanzwert und stellenzahl für f1 ermitteln
  2765.  
  2766.     exg    a0,a1
  2767.     bsr    dist_st
  2768.     exg    a0,a1
  2769.  
  2770.     move.l    d4,d0
  2771.     move.l    d5,d1
  2772.  
  2773.     clr.w    d7
  2774.     lsr.w    #1,d4
  2775.     bcs.s    koprt11
  2776.  
  2777.     move.l    a1,a4
  2778.     add.l    d4,a4
  2779.     subq.w    #1,d5
  2780.     move.l    rt1(pc),a5
  2781.     addq.l    #2,a5
  2782. div2:
  2783.     move.b    (a4)+,(a5)+
  2784.     dbf    d5,div2
  2785.  
  2786.     bra.s    koprt1aus
  2787. koprt11:
  2788.     move.l    a1,a4
  2789.     add.l    d4,a4
  2790.     moveq    #0,d7
  2791.     lsr.w    #1,d5
  2792.     addx.w    d7,d7
  2793.     add.l    d5,a4
  2794.     addq.l    #1,a4
  2795.     move.l    rt1(pc),a5
  2796.     addq.l    #2,a5
  2797.     add.l    d5,a5
  2798.     tst.w    d7
  2799.     beq.s    d7eq
  2800.     bra.s    kop_rt12
  2801. d7eq:
  2802.     move.b    (a4),d7
  2803.     lsr.b    #4,d7
  2804.     move.b    d7,(a5)
  2805. kop_rt12:
  2806.     move.b    -(a4),d7
  2807.     move.b    d7,d4
  2808.     lsl.b    #4,d4
  2809.     add.b    d4,(a5)
  2810.     lsr.b    #4,d7
  2811.     move.b    d7,-(a5)
  2812.     dbf    d5,kop_rt12
  2813. koprt1aus:
  2814.  
  2815. ; distanzwert und stellenzahl für f2 ermitteln
  2816.  
  2817.     bsr    dist_st
  2818.     move.w    d4,d2
  2819.  
  2820. ; beginn des ergebnisses ermitteln
  2821.  
  2822.     cmp.w    d0,d2
  2823.     beq.s    d0gld2
  2824.     cmp.w    #vst,d2
  2825.     beq.s    d2_vst
  2826.     cmp.w    #vst,d2
  2827.     bhi.s    grglvst
  2828. klvst:
  2829.     cmp.w    d2,d0
  2830.     bhi.s    d2_gr_d0
  2831.     move.w    #vst,d1
  2832.     sub.w    d2,d1
  2833.     add.w    d1,d0
  2834.     subq.w    #1,d0
  2835.     bra.s    staus
  2836. d2_gr_d0:
  2837.     move.w    #vst-1,d1
  2838.     sub.w    d2,d1
  2839.     add.w    d1,d0
  2840.     bra.s    staus
  2841. d2_vst:
  2842.     subq.w    #1,d0
  2843.     bra.s    staus
  2844. d0gld2:
  2845.     move.w    #vst-1,d0
  2846.     bra.s    staus
  2847. grglvst:
  2848.     sub.w    #vst-1,d2
  2849.     sub.w    d2,d0
  2850. staus:
  2851.  
  2852. ; in d0 : distanzwert für anfang des ergebnisses
  2853. ; tabelle erstellen
  2854.  
  2855.     bsr    maketab
  2856.  
  2857.     move.l    d0,d2
  2858.     clr.w    d3
  2859.     lsr.w    #1,d2
  2860.     addx.w    d3,d3;    d3 : flag für wechsel von ergebnis
  2861.     tst.w    d3
  2862.     seq    d3
  2863.  
  2864.     move.l    a1,a2
  2865.     add.l    d2,a2;    a2 : zeiger auf ergebnisfeld, richtige stelle
  2866.  
  2867.     move.w    d0,a5
  2868.     move.w    #st,d6
  2869.     sub.w    d0,d6
  2870.     bcs    divergnull
  2871.     cmp.w    #st+1,d6
  2872.     bhi    div_uberlauf;    wenn das ergebnis zu groß ist
  2873.     lea    divzaeh(pc),a3
  2874.     move.w    d6,(a3);    divzaeh : divisionszähler
  2875.  
  2876. ; die ersten 3 zahlen von f2 nach d6
  2877.  
  2878.     move.l    a0,a3
  2879.     moveq    #0,d0
  2880.     move.w    d4,d0
  2881.     clr.w    d1
  2882.     lsr.w    #1,d0
  2883.     addx.w    d1,d1
  2884.  
  2885.     add.l    d0,a3;    a3 : zeiger auf f2, links
  2886.  
  2887.     moveq    #0,d6
  2888.     moveq    #0,d7
  2889.  
  2890.     tst.b    d1
  2891.     bne.s    deiw
  2892.  
  2893.     move.b    (a3)+,d6
  2894.     move.b    d6,d7
  2895.     lsr.w    #4,d6
  2896.     mal10    d6
  2897.     and.w    #$f,d7
  2898.     add.w    d7,d6
  2899.     move.b    (a3),d7
  2900.     lsr.w    #4,d7
  2901.     mal10    d6
  2902.     add.w    d7,d6
  2903.  
  2904.     bra.s    deiwaus
  2905. deiw:
  2906.     move.b    (a3)+,d6
  2907.     move.b    (a3),d7
  2908.     lsr.w    #4,d7
  2909.     mal10    d6
  2910.     add.w    d7,d6
  2911.     move.b    (a3),d7
  2912.     and.w    #$f,d7
  2913.     mal10    d6
  2914.     add.w    d7,d6
  2915. deiwaus:
  2916.     tst.w    d1
  2917.     bne.s    vb
  2918.  
  2919.     btst    #0,d5
  2920.     bne.s    ok
  2921.     bra.s    lk
  2922. vb:
  2923.     btst    #0,d5
  2924.     beq.s    ok
  2925.     bra.s    lk
  2926. ok:
  2927.     bchg    #0,d1
  2928. lk:
  2929.     lsr.w    #1,d5
  2930.  
  2931. ; f2 (ergebnisfeld) löschen
  2932.  
  2933.     move.w    #sb/2+1,d7
  2934. div4:
  2935.     clr.w    (a1)+
  2936.     dbf    d7,div4
  2937.  
  2938.     move.l    rt1(pc),a0;      a0 : zeiger auf rechenfeld, links
  2939.     addq.l    #1,a0
  2940.     move.l    tabr(pc),a4
  2941.     addq.l    #1,a4;    a4 : basisadresse des multiplikationsfeldes
  2942.  
  2943.     tst.w    d1
  2944.     sne    d1
  2945.     st    d4
  2946.  
  2947. ; verwendete rechenfelder :
  2948. ;
  2949. ; rt1:    rechenfeld für subtraktion (rest, 3-fache länge)
  2950. ; tabr: tabelle fur multiplikation von 1 bis 10
  2951. ;
  2952. ; register:
  2953. ;
  2954. ; d0 : rechenregister
  2955. ; d1 : bit für wechsel von tabr
  2956. ; d2 : rechenregister
  2957. ; d3 : bit für wechsel von ergebnis
  2958. ; d4 : bit für wechsel von rt1
  2959. ; d5 : stellenzahl von f2
  2960. ; d6 : 3 zahlen von f2 (konstant)
  2961. ; d7 : 4 zahlen von rt1
  2962. ;
  2963. ; a0 : zeiger auf rechenfeld rt1
  2964. ; a1 : arbeitsregister für subtraktion
  2965. ; a2 : zeiger auf ergebnisfeld, richtige stelle
  2966. ; a3 : adresse des multiplikationsergebnisses, rechts
  2967. ; a4 : basis des multiplikationsfeldes
  2968. ; a5 : zähler für division (stellen insgesamt)
  2969. ; a6 : nicht benutzt
  2970.  
  2971. divanf:
  2972.  
  2973. ; 4 zahlen vom rest nach d7
  2974.  
  2975.     moveq    #0,d7
  2976.     moveq    #0,d2
  2977.     move.l    a4,a3
  2978.     move.l    a0,a1
  2979.  
  2980.     not.b    d4
  2981.     beq.s    wandrt11
  2982.  
  2983.     move.b    1(a0),d7
  2984.     move.b    d7,d2
  2985.     lsr.b    #4,d7
  2986.     mal10    d7
  2987.     and.b    #$f,d2
  2988.     add.b    d2,d7
  2989.     mal10    d7
  2990.     move.b    2(a0),d2
  2991.     lsr.b    #4,d2
  2992.     add.w    d2,d7
  2993.     mal10    d7
  2994.     move.b    2(a0),d2
  2995.     and.b    #$f,d2
  2996.     add.w    d2,d7
  2997.  
  2998.     addq.l    #1,a0
  2999.     add.l    #sb+4*10,a3
  3000.  
  3001.     addq.l    #2,a1
  3002.     not.b    d1
  3003.     bne.s    wandrt1aus
  3004.  
  3005.     addq.l    #1,a3
  3006.     bra.s    wandrt1aus
  3007. wandrt11:
  3008.     move.b    (a0),d7
  3009.     mal10    d7
  3010.     move.b    1(a0),d2
  3011.     lsr.b    #4,d2
  3012.     add.b    d2,d7
  3013.     mal10    d7
  3014.     move.b    1(a0),d2
  3015.     and.b    #$f,d2
  3016.     add.w    d2,d7
  3017.     mal10    d7
  3018.     move.b    2(a0),d2
  3019.     lsr.b    #4,d2
  3020.     add.w    d2,d7
  3021.  
  3022.     subq.l    #1,a3
  3023.  
  3024.     not.b    d1
  3025.     bne.s    nomuladd2
  3026.  
  3027.     addq.l    #2,a1
  3028.     bra.s    wandrt1aus
  3029. nomuladd2:
  3030.     addq.l    #1,a1
  3031. wandrt1aus:
  3032.     divu    d6,d7
  3033.  
  3034.     not.b    d3
  3035.     beq.s    ergli
  3036.     add.b    d7,(a2)+
  3037.     bra.s    divergaus
  3038. ergli:
  3039.     lsl.b    #4,d7
  3040.     move.b    d7,(a2)
  3041.     lsr.b    #4,d7
  3042. divergaus:
  3043.     tst.b    d7
  3044.     beq.s    dminaus
  3045.  
  3046. ; adresse des multiplikationsergebnisses errechnen
  3047.  
  3048. mulanf:
  3049.     move.w    d7,d0
  3050.     mulu    #sb+4,d0
  3051.     add.l    d0,a3
  3052.  
  3053. ; mult.ergebnis von rt1 abziehen
  3054. ; adresse des mult.ergebnisses in a3
  3055.  
  3056. divminin:
  3057.     move.w    d5,d2
  3058.     addq.w    #1,d2
  3059.     add.l    d5,a1
  3060.     sub.w    d0,d0
  3061. divmin:
  3062.     sbcd    -(a3),-(a1)
  3063.     dbf    d2,divmin
  3064.     bcs.s    wiederadd
  3065. dminaus:
  3066.     lea    divzaeh(pc),a1
  3067.     subq.w    #1,(a1)
  3068.     bcc    divanf
  3069.  
  3070.     bra.s    divschleifaus
  3071.  
  3072. ; wenn fehler, dann f2 wieder auf rt1 addieren
  3073.  
  3074. wiederadd:
  3075.     move.w    d5,d2
  3076.     addq.w    #1,d2
  3077.     add.l    d5,a1
  3078.     addq.l    #2,a1
  3079.     add.l    d5,a3
  3080.     addq.l    #2,a3
  3081.     sub.w    d0,d0
  3082. divadd:
  3083.     abcd    -(a3),-(a1)
  3084.     dbf    d2,divadd
  3085.  
  3086.     tst.b    d3
  3087.     beq.s    neuerg1
  3088.  
  3089.     subq.b    #1,-1(a2)
  3090.     bra.s    neuergaus
  3091. neuerg1:
  3092.     sub.b    #%10000,(a2)
  3093. neuergaus:
  3094.     subq.w    #1,d7
  3095.     beq.s    dminaus
  3096.  
  3097.     addq.l    #2,a1
  3098.     add.l    d5,a3
  3099.     sub.l    #sb+2,a3
  3100.  
  3101.     bra.s    divminin
  3102. divschleifaus:
  3103.  
  3104. ; letzte stelle aufrunden
  3105.  
  3106.     cmp.b    #$49,(a2)
  3107.     bhi.s    daufrd
  3108.     bra.s    aufrdaus
  3109. daufrd:
  3110.     move.l    a2,a1
  3111.  
  3112.     move.l    rt1(pc),a0
  3113.     move.w    #sb,d0
  3114. dclrrt1:
  3115.     clr.w    (a0)+
  3116.     dbf    d0,dclrrt1
  3117.  
  3118.     move.b    #1,-1(a0)
  3119.     sub.w    d0,d0
  3120. contrd:
  3121.     abcd    -(a0),-(a2)
  3122.     bcs.s    contrd
  3123.  
  3124.     move.l    a1,a2
  3125. aufrdaus:
  3126.     clr.b    (a2)
  3127.  
  3128.     move.l    9*4(sp),a4
  3129.  
  3130. ; vorkommastellenzahl
  3131.  
  3132.     cmp.w    #vst,a5
  3133.     bhi.s    dvornull
  3134.  
  3135.     move.w    #vst,d0
  3136.     sub.w    a5,d0
  3137.     beq.s    dvoraus
  3138.  
  3139.     move.w    d0,d1
  3140.     clr.w    d2
  3141.     lsr.w    #1,d1
  3142.     addx.w    d2,d2
  3143.  
  3144.     move.l    a4,a5
  3145.     add.l    #vsb,a5
  3146.     and.l    #$ffff,d1
  3147.     sub.l    d1,a5
  3148.  
  3149.     tst.w    d2
  3150.     beq.s    tsta0cl
  3151.  
  3152.     tst.b    -1(a5)
  3153.     beq.s    subeine
  3154.  
  3155.     bra.s    dvoraus
  3156. tsta0cl:
  3157.     move.b    (a5),d1
  3158.     lsr.b    #4,d1
  3159.     beq.s    subeine
  3160.  
  3161.     bra.s    dvoraus
  3162. subeine:
  3163.     subq.w    #1,d0
  3164.     bra.s    dvoraus
  3165. dvornull:
  3166.     clr.w    d0
  3167. dvoraus:
  3168.     move.w    d0,st1(a4)
  3169.  
  3170. ; nachkommastellenzahl ermitteln
  3171.  
  3172.     move.l    a4,a5
  3173.     add.l    #sb,a5
  3174.     move.w    #nsb,d4
  3175. dnachm:
  3176.     tst.b    -(a5)
  3177.     bne.s    dnachex
  3178.  
  3179.     subq.w    #1,d4
  3180.     bne.s    dnachm
  3181.  
  3182.     bra.s    dnachaus
  3183. dnsubeine:
  3184.     subq.w    #1,d4
  3185.     bra.s    dnachaus
  3186. dnachex:
  3187.     add.w    d4,d4
  3188.     move.b    (a5),d0
  3189.     lsl.b    #4,d0
  3190.     beq.s    dnsubeine
  3191. dnachaus:
  3192.     move.w    d4,st2(a4)
  3193.     bra.s    divaus
  3194. divergnull:
  3195.     move.l    a1,a0
  3196.     bsr    feldloesch
  3197. divaus:
  3198.     movem.l    (sp)+,d0-d7/a0-a5
  3199.  
  3200.     rts
  3201.  
  3202. ;==================================================
  3203.  
  3204. ;  adresse des feldes in a0
  3205. ; ergebnis:    distanzwert in d4
  3206. ;        stellenzahl in d5
  3207.  
  3208. dist_st:
  3209.     movem.l    d3/d6/d7/a0,-(sp)
  3210.  
  3211.     move.w    st2(a0),d7
  3212.     move.w    st1(a0),d6
  3213.     beq.s    vnull
  3214.  
  3215.     move.l    #vst,d4
  3216.     sub.w    d6,d4
  3217.  
  3218.     tst.w    d7
  3219.     beq.s    suchen
  3220.  
  3221.     moveq    #0,d5
  3222.     move.w    d6,d5
  3223.     add.w    d7,d5
  3224.     bra.s    distaus
  3225. suchen:
  3226.     add.l    #vsb,a0
  3227.     moveq    #0,d7
  3228. nnull1:
  3229.     tst.b    -(a0)
  3230.     bne.s    naus
  3231.  
  3232.     addq.w    #1,d7
  3233.     bra.s    nnull1
  3234. naus:
  3235.     add.w    d7,d7
  3236.     move.b    (a0),d3
  3237.     and.b    #$f,d3
  3238.     beq.s    nauspl1
  3239.     bra.s    nausd4ok
  3240. nauspl1:
  3241.     addq.w    #1,d7
  3242. nausd4ok:
  3243.     moveq    #0,d5
  3244.     move.w    d6,d5
  3245.     sub.w    d7,d5
  3246.     bra.s    distaus
  3247. distnullaus:
  3248.     moveq    #0,d4
  3249.     moveq    #0,d5
  3250.     bra.s    distaus
  3251. vnull:
  3252.     tst.w    d7
  3253.     beq.s    distnullaus
  3254.  
  3255.     move.l    #vsb,d4
  3256. vnull1:
  3257.     tst.b    (a0,d4.w)
  3258.     bne.s    vaus
  3259.  
  3260.     addq.w    #1,d4
  3261.     bra.s    vnull1
  3262. vaus:
  3263.     move.b    (a0,d4.w),d6
  3264.     add.w    d4,d4
  3265.     lsr.b    #4,d6
  3266.     beq.s    vnullpl1
  3267.     bra.s    vnulld4ok
  3268. vnullpl1:
  3269.     addq.w    #1,d4
  3270. vnulld4ok:
  3271.     moveq    #0,d5
  3272.     move.w    d7,d5
  3273.     add.w    #vst,d5
  3274.     sub.w    d4,d5
  3275. distaus:
  3276.     movem.l    (sp)+,d3/d6/d7/a0
  3277.  
  3278.     rts
  3279.  
  3280. ;==========================================
  3281.  
  3282. ; diese routine erstellt die tabelle für multiplikation und
  3283. ; division bei tabr. alle register bleiben unverändert.
  3284. ; kann direkt im anschluß an dist_st aufgerufen werden.
  3285. ; a0 : zeiger auf feld
  3286. ; d4 : distanzwert
  3287. ; d5 : stellenzahl
  3288.  
  3289. maketab:
  3290.     movem.l    d2-d7/a0-a3,-(sp)
  3291.  
  3292.     move.l    #sb+4,d2
  3293.     subq.w    #1,d5
  3294.  
  3295.     move.l    tabr(pc),a1
  3296.     move.w    #sb+4*20+20/4,d6
  3297. clrtabr:
  3298.     clr.l    (a1)+
  3299.     dbf    d6,clrtabr
  3300.  
  3301.     lsr.w    #1,d4
  3302.     bcs.s    kop1m
  3303.  
  3304.     add.l    d4,a0
  3305.     lsr.w    #1,d5
  3306.     add.l    d5,a0
  3307.     addq.l    #1,a0;        a0 : zeiger rechts
  3308.     move.l    a0,a1
  3309.     move.l    tabr(pc),a2
  3310.     add.l    d2,a2
  3311.     move.w    d5,d6
  3312. kop_f1:
  3313.     move.b    -(a1),-(a2)
  3314.     dbf    d6,kop_f1
  3315.     bra.s    addtab1aus
  3316. kop1m:
  3317.     add.l    d4,a0
  3318.     moveq    #0,d7
  3319.     lsr.w    #1,d5
  3320.     addx.w    d7,d7
  3321.     add.l    d5,a0;        a0 : f2 rechts
  3322.     addq.l    #1,a0
  3323.     move.l    a0,a1
  3324.     move.l    tabr(pc),a2
  3325.     add.l    #sb+3,a2
  3326.     move.w    d5,d6
  3327.     addq.w    #1,d6
  3328.     tst.w    d7
  3329.     bne    d7ne
  3330.     bra.s    kop_f11
  3331. d7ne:
  3332.     move.b    (a1),d7
  3333.     lsr.b    #4,d7
  3334.     move.b    d7,(a2)
  3335.     addq.w    #1,d5
  3336. kop_f11:
  3337.     move.b    -(a1),d7
  3338.     move.b    d7,d4
  3339.     lsl.b    #4,d4
  3340.     add.b    d4,(a2)
  3341.     lsr.b    #4,d7
  3342.     move.b    d7,-(a2)
  3343.     dbf    d6,kop_f11
  3344. addtab1aus:
  3345.     move.l    tabr(pc),a0
  3346.     move.l    a0,a2
  3347.     add.l    d2,a0
  3348.     add.l    d2,a2
  3349.     add.l    d2,a2
  3350.     moveq    #8,d7
  3351. addtab1:
  3352.     move.w    d5,d6
  3353.     move.l    a0,a1
  3354.     move.l    a2,a3
  3355. addtab2:
  3356.     move.b    -(a1),-(a3)
  3357.     dbf    d6,addtab2
  3358.  
  3359.     move.l    a2,a1
  3360.     move.l    a2,a3
  3361.     sub.l    d2,a1
  3362.  
  3363.     move.w    d5,d6
  3364.     addq.w    #1,d6
  3365.     sub.w    d3,d3
  3366. addtab3:
  3367.     abcd    -(a1),-(a3)
  3368.     dbf    d6,addtab3
  3369.  
  3370.     add.l    d2,a2
  3371.     dbf    d7,addtab1
  3372.  
  3373. ; verschobene tabelle erstellen
  3374.  
  3375.     move.l    tabr(pc),a0
  3376.     move.l    a0,a2
  3377.     add.l    d2,a0
  3378.     add.l    #sb+4*11+2,a2
  3379.     moveq    #9,d7
  3380. verschtab1:
  3381.     move.w    d5,d6
  3382.     addq.w    #1,d6
  3383.     move.l    a0,a1
  3384.     move.l    a2,a3
  3385. verschtab2:
  3386.     move.b    -(a1),d4
  3387.     move.b    d4,d3
  3388.     lsl.b    #4,d3
  3389.     add.b    d3,-(a3)
  3390.     lsr.b    #4,d4
  3391.     move.b    d4,-1(a3)
  3392.     dbf    d6,verschtab2
  3393.  
  3394.     add.l    d2,a0
  3395.     add.l    d2,a2
  3396.     dbf    d7,verschtab1
  3397.  
  3398.     movem.l    (sp)+,d2-d7/a0-a3
  3399.  
  3400.     rts
  3401.  
  3402. ;==============================================
  3403.  
  3404. ; setzt ein feld auf null
  3405. ; feldadresse in a0
  3406.  
  3407. feldloesch:
  3408.     movem.l    d0/a0,-(sp)
  3409.  
  3410.     move.w    #sb/2+2,d0
  3411. lanf:
  3412.     clr.w    (a0)+
  3413.     dbf    d0,lanf
  3414.     move.w    #1,(a0)+
  3415.  
  3416.     movem.l    (sp)+,d0/a0
  3417.  
  3418.     rts
  3419.  
  3420. ;================================================
  3421.  
  3422. ; adresse des 1. feldes in a0
  3423. ; adresse des 2. feldes in a1
  3424. ; grössere vorkommazahl in d4
  3425. ; grössere nachkommazahl in d5
  3426.  
  3427. findrausgrkl:
  3428.     move.l    d6,-(sp)
  3429.  
  3430.     moveq    #0,d4
  3431.     moveq    #0,d5
  3432.  
  3433.     move.w    st1(a1),d6
  3434.     cmp.w    st1(a0),d6
  3435.     blt.s    vor1grvor2
  3436.     bgt.s    vor1klvor2
  3437.     move.w    st1(a0),d4
  3438. frueck1:
  3439.     move.w    st2(a1),d6
  3440.     cmp.w    st2(a0),d6
  3441.     blt.s    nach1grnach2
  3442.     bgt.s    nach1klnach2
  3443.     move.w    st2(a1),d5
  3444.  
  3445.     bra.s    findaus
  3446. vor1grvor2:
  3447.     move.w    st1(a0),d4
  3448.     bra.s    frueck1
  3449. vor1klvor2:
  3450.     move.w    st1(a1),d4
  3451.     bra.s    frueck1
  3452. nach1grnach2:
  3453.     move.w    st2(a0),d5
  3454.     bra.s    findaus
  3455. nach1klnach2:
  3456.     move.w    st2(a1),d5
  3457. findaus:
  3458.     move.l    (sp)+,d6
  3459.  
  3460.     rts
  3461.  
  3462. ;=====================================================
  3463.  
  3464. ; kopiert feld in a0 auf feld in a1
  3465. ; adresse des quellfeldes in a0
  3466. ; adresse des zielfeldes in a1
  3467.  
  3468. kopieren:
  3469.     movem.l    d4/a0/a1,-(sp)
  3470.  
  3471.     move.w    #sb/2+3,d4
  3472. kopieren1:
  3473.     move.w    (a0)+,(a1)+
  3474.     dbf    d4,kopieren1
  3475.  
  3476.     movem.l    (sp)+,d4/a0/a1
  3477.  
  3478.     rts
  3479.  
  3480. ;=====================================================
  3481.  
  3482. ; tauscht felder in a0 und a1 aus
  3483. ; adresse der felder in a0 und in a1
  3484.  
  3485. tausch:
  3486.     movem.l    d4/d5/a0/a1,-(sp)
  3487.  
  3488.     move.w    #sb/2+3,d4
  3489. tau1:
  3490.     move.w    (a0),d5
  3491.     move.w    (a1),(a0)+
  3492.     move.w    d5,(a1)+
  3493.     dbf    d4,tau1
  3494.  
  3495.     movem.l    (sp)+,d4/d5/a0/a1
  3496.  
  3497.     rts
  3498.  
  3499. ;=====================================================
  3500.  
  3501. ; vergleich ohne vorzeichen
  3502. ; adresse der felder in a0 und in a1
  3503. ; ergebnis in d4
  3504. ; 1 : beide gleich
  3505. ; 2 : a0 grösser a1
  3506. ; 3 : a1 grösser a0
  3507.  
  3508. veru:
  3509.     bsr    testa0a1
  3510.  
  3511.     movem.l    a0/a1,-(sp)
  3512.  
  3513.     move.w    #sb/2-1,d4
  3514. ver1:
  3515.     cmpm.w    (a1)+,(a0)+
  3516.     blo.s    a1_gr_a0
  3517.     bhi.s    a0_gr_a1
  3518.     dbf    d4,ver1
  3519.  
  3520.     moveq    #1,d4
  3521.     bra.s    veraus
  3522. a1_gr_a0:
  3523.     moveq    #3,d4
  3524.     bra.s    veraus
  3525. a0_gr_a1:
  3526.     moveq    #2,d4
  3527. veraus:
  3528.     movem.l    (sp)+,a0/a1
  3529.  
  3530.     rts
  3531.  
  3532. ;=================================================
  3533.  
  3534. ; feld(a0) := feld(a0) - 1
  3535. ; adresse des feldes in a0
  3536.  
  3537. decrem:
  3538.     bsr    testa0
  3539.  
  3540.     movem.l    d0/d1/a0-a2,-(sp)
  3541.  
  3542.     cmp.w    #1,st3(a0)
  3543.     beq.s    decremex
  3544.     tst.w    st2(a0)
  3545.     bne.s    decremex
  3546.  
  3547.     move.l    dez1(pc),a2
  3548.     add.l    #vsb,a2
  3549.  
  3550.     move.l    a0,a1
  3551.     add.l    #vsb,a1
  3552.     sub.w    d0,d0
  3553. decweiadd:
  3554.     sbcd    -(a2),-(a1)
  3555.     bcs.s    decweiadd
  3556.  
  3557.     move.w    st1(a0),d0
  3558.     moveq    #0,d1
  3559.     move.w    d0,d1
  3560.     lsr.w    #1,d1
  3561.     move.l    a0,a1
  3562.     add.l    #vsb,a1
  3563.     sub.l    d1,a1
  3564.  
  3565.     btst    #0,d0
  3566.     bne.s    tstm1
  3567.  
  3568.     move.b    (a1),d0
  3569.     lsr.b    #4,d0
  3570.     beq.s    dec1weniger
  3571.  
  3572.     bra.s    decremex
  3573. tstm1:
  3574.     tst.b    -1(a1)
  3575.     beq.s    dec1weniger
  3576.  
  3577.     bra.s    decremex
  3578. alloe:
  3579.     move.w    #1,st3(a0)
  3580.     bra.s    decremex
  3581. dec1weniger:
  3582.     subq.w    #1,st1(a0)
  3583.     beq.s    alloe
  3584. decremex:
  3585.     movem.l    (sp)+,d0/d1/a0-a2
  3586.  
  3587.     rts
  3588.  
  3589. ;==============================================
  3590.  
  3591. ; feld(a0) := feld(a0) + 1
  3592. ; adresse des feldes in a0
  3593.  
  3594. increm:
  3595.     bsr    testa0
  3596.  
  3597.     movem.l    d0/d1/a0-a2,-(sp)
  3598.  
  3599.     cmp.w    #1,st3(a0)
  3600.     beq.s    increm0_1
  3601.     tst.w    st2(a0)
  3602.     bne.s    incremex
  3603.  
  3604.     move.l    dez1(pc),a2
  3605.     add.l    #vsb,a2
  3606.  
  3607.     move.l    a0,a1
  3608.     add.l    #vsb,a1
  3609.     sub.w    d0,d0
  3610. incweiadd:
  3611.     abcd    -(a2),-(a1)
  3612.     bcs.s    incweiadd
  3613.  
  3614.     move.w    st1(a0),d0
  3615.     moveq    #0,d1
  3616.     move.w    d0,d1
  3617.     lsr.w    #1,d1
  3618.     move.l    a0,a1
  3619.     add.l    #vsb-1,a1
  3620.     sub.l    d1,a1
  3621.  
  3622.     btst    #0,d0
  3623.     bne.s    itstm1
  3624.  
  3625.     tst.b    (a1)
  3626.     bne.s    inc1mehr
  3627.  
  3628.     bra.s    incremex
  3629. itstm1:
  3630.     move.b    (a1),d0
  3631.     lsr.b    #4,d0
  3632.     bne.s    inc1mehr
  3633.  
  3634.     bra.s    incremex
  3635. increm0_1:
  3636.     move.w    #1,st1(a0)
  3637.     move.w    #2,st3(a0)
  3638.     move.b    #1,vsb-1(a0)
  3639.     bra.s    incremex
  3640. inc1mehr:
  3641.     addq.w    #1,st1(a0)
  3642. incremex:
  3643.     movem.l    (sp)+,d0/d1/a0-a2
  3644.  
  3645.     rts
  3646.  
  3647. ;==============================================
  3648.  
  3649. ; wechselt das vorzeichen
  3650. ; adresse des feldes in a0
  3651.  
  3652. vorz_wechsel:
  3653.     bsr    testa0
  3654.  
  3655.     move.l    d0,-(sp)
  3656.  
  3657.     move.w    st3(a0),d0
  3658.  
  3659.     cmp.w    #1,d0
  3660.     beq.s    vor_wechsaus
  3661.  
  3662.     cmp.w    #2,d0
  3663.     beq.s    plus_minus
  3664.  
  3665.     move.w    #2,st3(a0)
  3666.     bra.s    vor_wechsaus
  3667. plus_minus:
  3668.     move.w    #3,st3(a0)
  3669. vor_wechsaus:
  3670.     move.l    (sp)+,d0
  3671.  
  3672.     rts
  3673.  
  3674. ;==================================================
  3675.  
  3676. ; löscht den nachkommateil des feldes in a0
  3677. ; adresse des feldes in a0
  3678.  
  3679. integer:
  3680.     bsr    testa0
  3681.  
  3682.     movem.l    d0/a0,-(sp)
  3683.  
  3684.     cmp.w    #1,st3(a0)
  3685.     beq.s    integ_aus
  3686.     tst.w    st2(a0)
  3687.     beq.s    integ_aus
  3688.  
  3689.     tst.w    st1(a0)
  3690.     bne.s    integnnull
  3691.  
  3692.     move.w    #1,st3(a0)
  3693. integnnull:
  3694.     clr.w    st2(a0)
  3695.  
  3696.     move.w    #nsb/2-1,d0
  3697.     add.l    #vsb,a0
  3698. clrinteg:
  3699.     clr.w    (a0)+
  3700.     dbf    d0,clrinteg
  3701. integ_aus:
  3702.     movem.l    (sp)+,d0/a0
  3703.  
  3704.     rts
  3705.  
  3706. ;===========================================
  3707. ;============= rechenroutinen ==============
  3708. ;=== teil 2 : routinen, die die grund- =====
  3709. ;====== rechenfunktionen benutzen. =========
  3710. ;======== z.b. sqrroot oder pi1 ============
  3711. ;===========================================
  3712.  
  3713.  
  3714. ; adresse des feldes in a0
  3715.  
  3716. sinus:
  3717.     bsr    testa0
  3718.  
  3719.     movem.l    d0/d1/a0-a2,-(sp)
  3720.  
  3721.     move.l    a0,a2
  3722.  
  3723. ; zahl zwischen +pi/2 und -pi/2 bringen
  3724.  
  3725.     mkopieren    a2,sqr1(pc)
  3726.     mdiv        pi(pc),sqr1(pc)
  3727.  
  3728.     move.l    sqr1(pc),a0
  3729.     cmp.b    #$49,vsb(a0)
  3730.     bhi.s    sinaufrd
  3731.  
  3732.     bsr    integer
  3733.     bra.s    sinaufrdaus
  3734. sinaufrd:
  3735.     bsr    integer
  3736.     bsr    increm
  3737. sinaufrdaus:
  3738.     mmals        pi(pc),sqr1(pc)
  3739.     mminusu        sqr1(pc),a2
  3740.  
  3741.     mkopieren    a2,sqr1(pc)
  3742.     mkopieren    a2,sqr2(pc)
  3743.     mquadrat    sqr2(pc)
  3744.     mkopieren    dez1(pc),sqr3(pc)
  3745.     mkopieren    dez1(pc),sqr4(pc)
  3746.  
  3747. ; sin(x) = x - x^3/3! + x^5/5! -x^7/7! ...
  3748. ; sqr1 : jeweiliges x^n
  3749. ; sqr2 : x^2
  3750. ; sqr3 : n!
  3751. ; sqr4 : n
  3752.  
  3753.     st    d4
  3754.     moveq    #82,d5
  3755. makesin:
  3756.     mincrem        sqr4(pc)
  3757.     mmals        sqr4(pc),sqr3(pc)
  3758.     mincrem        sqr4(pc)
  3759.     mmals        sqr4(pc),sqr3(pc)
  3760.  
  3761.     mmals        sqr2(pc),sqr1(pc)
  3762. sin_in:
  3763.     mfeldloesch    sqr5(pc)
  3764.     mkopieren    sqr1(pc),sqr5(pc)
  3765.     mdiv        sqr3(pc),sqr5(pc)
  3766.  
  3767.     cmp.w    #1,st3(a1)
  3768.     beq.s    sin_aus
  3769.  
  3770.     not.b    d4
  3771.     beq.s    sinabzieh
  3772.  
  3773.     mplusu    sqr5(pc),a2
  3774.     bra.s    sin_2
  3775. sinabzieh:
  3776.     mminusu    sqr5(pc),a2
  3777. sin_2:
  3778.     dbf    d5,makesin
  3779. sin_aus:
  3780.     movem.l    (sp)+,d0/d1/a0-a2
  3781.  
  3782.     rts
  3783.  
  3784. ;================================================
  3785.  
  3786. ; adresse des feldes in a0
  3787.  
  3788. fakultaet:
  3789.     bsr    testa0
  3790.  
  3791.     movem.l    d0/d1/a0-a2,-(sp)
  3792.  
  3793.     cmp.w    #1,st3(a0)
  3794.     beq    fak_1
  3795.  
  3796.     cmp.w    #3,st3(a0)
  3797.     beq    fakfehler
  3798.     tst.w    st2(a0)
  3799.     bne    fakfehler
  3800.  
  3801.     moveq    #0,d0
  3802.     move.b    vsb-2(a0),d0
  3803.     move.w    d0,d1
  3804.     lsr.w    #4,d0
  3805.     mulu    #10,d0
  3806.     and.w    #$f,d1
  3807.     add.w    d1,d0
  3808.     mulu    #10,d0
  3809.  
  3810.     moveq    #0,d1
  3811.     move.b    vsb-1(a0),d1
  3812.     lsr.w    #4,d1
  3813.     add.w    d1,d0
  3814.     mulu    #10,d0
  3815.     move.b    vsb-1(a0),d1
  3816.     and.w    #$f,d1
  3817.     add.w    d1,d0
  3818.  
  3819.     tst.w    d0
  3820.     beq    fakfehler
  3821.     cmp.w    #1,d0
  3822.     beq    fakaus
  3823.     cmp.w    #2,d0
  3824.     beq    fakaus
  3825.  
  3826.     move.l    a0,a2
  3827.  
  3828.     move.l    sqr1(pc),a1
  3829.     bsr    kopieren
  3830.  
  3831.     subq.w    #2,d0
  3832. fak:
  3833.     move.l    sqr1(pc),a0
  3834.     bsr    decrem
  3835.     mmals    sqr1(pc),a2
  3836.     dbf    d0,fak
  3837.  
  3838.     bra.s    fakaus
  3839. fak_1:
  3840.     bsr    feldloesch
  3841.     move.b    #1,vsb-1(a0)
  3842.     move.w    #1,st1(a0)
  3843.     move.w    #2,st3(a0)
  3844. fakaus:
  3845.     movem.l    (sp)+,d0/d1/a0-a2
  3846.  
  3847.     rts
  3848.  
  3849. ;===============================================
  3850.  
  3851. ; adresse des feldes in a0
  3852.  
  3853. sqrroot:
  3854.     bsr    testa0
  3855.  
  3856.     cmp.w    #3,st3(a0)
  3857.     beq    sqr_negativ
  3858.  
  3859.     cmp.w    #1,st3(a0)
  3860.     beq    wurzaus2
  3861.  
  3862.     movem.l    d4-d7/a0-a5,-(sp)
  3863.  
  3864.     move.l    sqr1(pc),a1
  3865.     bsr    kopieren
  3866.  
  3867.     cmp.w    #4,st1(a0)
  3868.     bhi.s    kleinermachen
  3869.  
  3870.     bsr    dist_st
  3871.  
  3872.     cmp.w    #vst,d4
  3873.     bhi.s    groessermachen
  3874.  
  3875.     bra.s    anfwurz
  3876. groessermachen:
  3877.     sub.w    #vst-1,d4
  3878.     lsr.w    #1,d4
  3879.     add.w    #vst-1,d4
  3880.     moveq    #0,d5
  3881.     move.w    d4,d5
  3882.  
  3883.     lsr.w    #1,d5
  3884.     move.l    sqr1(pc),a1
  3885.     add.l    d5,a1
  3886.     move.b    #5,(a1)
  3887.  
  3888.     bra.s    anfwurz
  3889. kleinermachen:
  3890.     move.w    st1(a0),d4
  3891.     lsr.w    #1,d4
  3892.  
  3893.     move.l    #vst,d5
  3894.     sub.w    d4,d5
  3895.     lsr.w    #1,d5
  3896.     move.l    sqr1,a1    
  3897.     add.l    d5,a1
  3898.     move.w    d5,d4
  3899.     subq.w    #1,d5
  3900.     move.b    #$50,(a1)
  3901. kl1:
  3902.     clr.b    -(a1)
  3903.     dbf    d5,kl1
  3904.  
  3905.     move.w    #vsb,d5
  3906.     sub.w    d4,d5
  3907.     add.w    d5,d5
  3908.     move.l    sqr1,a1
  3909.     move.w    d5,st1(a1)
  3910.  
  3911. ; x[n+1] = 0.5 * ( x[n] + a / x[n] )
  3912. ; sqr1 : x[n]
  3913. ; sqr3 : rechenfeld für überprüfung
  3914. ; sqr4 : zwischenergebnis der division
  3915.  
  3916. anfwurz:
  3917.     move.l    a0,a4;        a4 : originaladresse
  3918.     moveq    #10,d4;        anzahl der iterationen
  3919.     move.l    sqr1(pc),d6
  3920.     move.l    sqr4(pc),d7
  3921.     move.l    sqr3(pc),a5
  3922.  
  3923. wurz:
  3924.     mkopieren    a4,sqr4(pc)
  3925.  
  3926.     mdiv        d6,d7
  3927.     mplusu        d7,d6
  3928.     move.l        d6,a0
  3929.     bsr        durch2
  3930.     dbf        d4,wurz
  3931.  
  3932. ueberpruefen:
  3933.     mkopieren    d6,a5;    sqr3 : x[n]
  3934.     mkopieren    a4,d7
  3935.     mdiv        d6,d7
  3936.     mplusu        d7,d6
  3937.     move.l        d6,a0
  3938.     bsr        durch2;            sqr1 : x[n+1]
  3939.  
  3940.     mveru        d6,a5
  3941.  
  3942.     cmp.b    #1,d4
  3943.     beq.s    wurzaus1
  3944.  
  3945.     bra.s    ueberpruefen
  3946. wurzaus1:
  3947.     mkopieren    d6,a4
  3948. wurzaus:
  3949.     movem.l    (sp)+,d4-d7/a0-a5
  3950. wurzaus2:
  3951.     rts
  3952.  
  3953. ;=============================================
  3954.  
  3955. ; adresse des feldes in a0
  3956.  
  3957. quadrat:
  3958.     bsr    testa0
  3959.  
  3960.     movem.l    a0/a1,-(sp)
  3961.  
  3962.     move.l    sqr1(pc),a1
  3963.     bsr    kopieren
  3964.     exg    a0,a1
  3965.     bsr    mals
  3966.  
  3967.     movem.l    (sp)+,a0/a1
  3968.  
  3969.     rts
  3970.  
  3971. ;=============================================
  3972.  
  3973. ; adresse des feldes in a0
  3974.  
  3975.  
  3976. pi1:
  3977.     movem.l    d4-d7/a0-a6,-(sp)
  3978.  
  3979.     prtxt    16
  3980.  
  3981.     move.l    buffer(pc),a4
  3982.     moveq    #0,d6
  3983. piein:
  3984.     move.l    conhandle(pc),d1
  3985.     move.l    a4,d2
  3986.     moveq    #1,d3
  3987.     jsr    read(a6)
  3988.  
  3989.     move.b    (a4),d4
  3990.  
  3991.     cmp.b    #$d,d4
  3992.     beq    pireturn
  3993.     cmp.b    #$8,d4
  3994.     beq    pibackspace
  3995.     cmp.b    #$30,d4
  3996.     beq    pizeinull
  3997.  
  3998.     cmp.b    #$30,d4
  3999.     blt.s    piein
  4000.     cmp.b    #$39,d4
  4001.     bgt.s    piein
  4002.  
  4003.     move.l    buffer(pc),a0
  4004.     addq.l    #4,a0
  4005.  
  4006.     cmp.l    a0,a4
  4007.     beq    piein
  4008. inordnung:
  4009.     move.l    conhandle(pc),d1
  4010.     move.l    a4,d2
  4011.     moveq    #1,d3
  4012.     jsr    write(a6)
  4013.  
  4014.     sub.b    #$30,(a4)
  4015.     addq.l    #1,a4
  4016.     addq.w    #1,d6
  4017.     bra    piein
  4018. pibackspace:
  4019.     cmp.l    buffer(pc),a4
  4020.     beq    piein
  4021.  
  4022.     bsr    backspace
  4023.  
  4024.     clr.b    (a4)
  4025.     subq.l    #1,a4
  4026.     subq.w    #1,d6
  4027.     bra    piein
  4028. pizeinull:
  4029.     cmp.l    buffer(pc),a4
  4030.     beq    piein
  4031.  
  4032.     bra    inordnung
  4033. pireturn:
  4034.     cmp.l    buffer(pc),a4
  4035.     beq    pi1aus
  4036.  
  4037.     subq.w    #1,d6
  4038.     move.l    buffer(pc),a4
  4039.     clr.l    d5
  4040.     clr.w    d7
  4041. wand:
  4042.     move.b    (a4)+,d7
  4043.     mulu    #10,d5
  4044.     add.w    d7,d5
  4045.     dbf    d6,wand
  4046.  
  4047. ; felder vorbesetzen
  4048.  
  4049.     prtxt    19
  4050.  
  4051.     mkopieren    dez2(pc),bcd1(pc)
  4052.     mquadrat    bcd1(pc)
  4053.     mkopieren    dez3(pc),bcd2(pc)
  4054.     mquadrat    bcd2(pc)
  4055.  
  4056.     mkopieren    dez2(pc),bcd3(pc)
  4057.     mkopieren    dez3(pc),bcd4(pc)
  4058.     mkopieren    dez2(pc),bcd5(pc)
  4059.     mkopieren    dez3(pc),bcd6(pc)
  4060.     mkopieren    dez1(pc),bcd7(pc)
  4061.  
  4062.     prtxt    22
  4063.     move.w    #vst,d4
  4064.     bsr    zahlaus
  4065.     prtxt    23
  4066.     move.w    #nst,d4
  4067.     bsr    zahlaus
  4068.     prtxt    11
  4069.     move.w    d5,d4
  4070.     bsr    zahlaus
  4071.  
  4072.  
  4073. ; pi = 4 * ( 4*arctan(1/5) - arctan(1/239) )
  4074. ; arctan(x) = x  -  x^3/3  +  x^5/5  -  x^7/7  +  x^9/9  ...
  4075. ; bcd1 : (1/5)^2
  4076. ; bcd2 : (1/239)^2
  4077. ; bcd3 : zwischenergebnis arctan(1/5)
  4078. ; bcd4 : zwischenergebnis arctan(1/239)
  4079. ; bcd5 : (1/5)^n
  4080. ; bcd6 : (1/239)^n
  4081. ; bcd7 : zähler
  4082.  
  4083.     move.w    d5,d6
  4084.     moveq    #1,d7;    anzeigen
  4085.     lea    plflag(pc),a0
  4086.     st    (a0)
  4087.     move.l    4.w,a5
  4088.     lea    bcd1(pc),a3
  4089. schlanf1:
  4090.     print    str2,6
  4091.  
  4092.     move.w    d5,d4
  4093.     sub.w    d6,d4
  4094.     bsr    zahlaus
  4095.  
  4096.     print    miplu+2,1
  4097.  
  4098.     cmp.w    #2,d7
  4099.     beq.s    ueberspring
  4100.  
  4101.     prtxt    18
  4102.     bsr    berecherg
  4103.     mdruck        bcd8(pc)
  4104. ueberspring:
  4105.     btst    #6,$bfe001
  4106.     beq    piweiter
  4107.     cmp.b    #$3d,$bfec01
  4108.     beq    piweiter
  4109. berechwei:
  4110.     exg    a5,a6
  4111.     jsr    forbid(a6)
  4112.  
  4113.     mmals        (a3),4*4(a3);    v6 : v3 : (1/5)^2
  4114.     mkopieren    4*4(a3),7*4(a3)
  4115.  
  4116.     mmals        4(a3),5*4(a3);    v7 : v4 * (1/239)^2
  4117.     mkopieren    5*4(a3),8*4(a3)
  4118.  
  4119.     mincrem        6*4(a3)
  4120.     mincrem        6*4(a3);    v5 := v5+2
  4121.     mdiv        6*4(a3),7*4(a3)
  4122.     mdiv        6*4(a3),8*4(a3)
  4123.  
  4124.     lea    plflag(pc),a0
  4125.     not.b    (a0)
  4126.     beq.s    plabzieh
  4127.  
  4128.     mplusu        7*4(a3),2*4(a3)
  4129.     mplusu        8*4(a3),3*4(a3)
  4130.     bra.s    arcaus
  4131. plabzieh:
  4132.     mminusu        7*4(a3),2*4(a3)
  4133.     mminusu        8*4(a3),3*4(a3)
  4134. arcaus:
  4135.     jsr    permit(a6)
  4136.     exg    a5,a6
  4137.  
  4138.     dbf    d6,schlanf1
  4139.  
  4140.     prtxt    18
  4141.     bsr    berecherg
  4142.     mdruck        bcd8
  4143.     print    dt24,5
  4144.     bra    fragsave0
  4145. berechweiin:
  4146.     cmp.w    #2,d7
  4147.     beq.s    q_ja
  4148.  
  4149.     move.l    buffer(pc),a0
  4150.     move.l    #$0d9b4b00,(a0)
  4151.     p_buf    3
  4152.     bra    berechwei
  4153. q_ja:
  4154.     prtxt    25
  4155.     bra    berechwei
  4156. zquiet:
  4157.     cmp.w    #1,d7
  4158.     beq.s    anz_qu
  4159. qu_wiederanz:
  4160.     moveq    #1,d7
  4161.     bra.s    berechweiin
  4162. anz_qu:
  4163.     moveq    #2,d7
  4164.     prtxt    25
  4165.     bra    berechwei
  4166. piweiter:
  4167.     cmp.w    #1,d7
  4168.     beq.s    qtext
  4169.     prtxt    24
  4170.     bra.s    pireadin
  4171. qtext:
  4172.     prtxt    17
  4173. pireadin:
  4174.     move.l    buffer(pc),a4
  4175.     move.l    conhandle(pc),d1
  4176.     move.l    a4,d2
  4177.     moveq    #1,d3
  4178.     jsr    read(a6)
  4179.  
  4180.     move.b    (a4),d4
  4181.  
  4182.     cmp.b    #"y",d4
  4183.     beq.s    piread1
  4184.     cmp.b    #"n",d4
  4185.     beq.s    piread1
  4186.     cmp.b    #"q",d4
  4187.     beq.s    piread1
  4188.     bra.s    pireadin
  4189. piread1:
  4190.     move.l    buffer(pc),a4
  4191.     lea    z1(pc),a0
  4192.     move.l    (a4),(a0)
  4193.  
  4194.     p_buf    1
  4195. piread2:
  4196.     move.l    buffer(pc),a4
  4197.     move.l    conhandle(pc),d1
  4198.     move.l    a4,d2
  4199.     moveq    #1,d3
  4200.     jsr    read(a6)
  4201.  
  4202.     move.b    (a4),d4
  4203.  
  4204.     cmp.b    #$d,d4
  4205.     beq    pireadaus
  4206.     cmp.b    #8,d4
  4207.     beq.s    pireadloe
  4208.     bra.s    piread2
  4209. pireadloe:
  4210.     bsr    backspace
  4211.     bra.s    pireadin
  4212. pireadaus:
  4213.     move.b    z1(pc),d4
  4214.  
  4215.     cmp.b    #"y",d4
  4216.     beq    berechweiin
  4217.     cmp.b    #"q",d4
  4218.     beq    zquiet
  4219. fragsave0:
  4220.     prtxt    30
  4221. fragsave:
  4222.     move.l    buffer(pc),a4
  4223.     move.l    conhandle(pc),d1
  4224.     move.l    a4,d2
  4225.     moveq    #1,d3
  4226.     jsr    read(a6)
  4227.  
  4228.     move.b    (a4),d4
  4229.  
  4230.     cmp.b    #"y",d4
  4231.     beq.s    fragsave2
  4232.     cmp.b    #"n",d4
  4233.     beq.s    fragsave2
  4234.     bra.s    fragsave
  4235. fragsave2:
  4236.     move.l    buffer(pc),a4
  4237.     lea    z1(pc),a0
  4238.     move.l    (a4),(a0)
  4239.     p_buf    1
  4240. fragsave3:
  4241.     move.l    buffer(pc),a4
  4242.     move.l    conhandle(pc),d1
  4243.     move.l    a4,d2
  4244.     moveq    #1,d3
  4245.     jsr    read(a6)
  4246.  
  4247.     move.b    (a4),d4
  4248.  
  4249.     cmp.b    #$d,d4
  4250.     beq.s    fragsaveaus
  4251.     cmp.b    #$8,d4
  4252.     beq.s    fragsaveloe
  4253.     bra.s    fragsave3
  4254. fragsaveloe:
  4255.     bsr    backspace
  4256.     bra.s    fragsave
  4257. fragsaveaus:
  4258.     move.b    z1(pc),d4
  4259.  
  4260.     cmp.b    #"n",d4
  4261.     beq    berechaus
  4262.  
  4263.     bsr    namein;        dateinamen eingeben
  4264.  
  4265.     lea    datname(pc),a0
  4266.     tst.b    (a0)
  4267.     beq.s    no_name
  4268.  
  4269.     bsr    berecherg
  4270.  
  4271.     lea    fdruck(pc),a3
  4272.     move.b    #1,(a3)
  4273.     mdruck    bcd8(pc);    zahl in datei speichern
  4274.     clr.b    (a3)
  4275.  
  4276.     lea    fehler(pc),a0
  4277.     tst.w    (a0)
  4278.     bne    piwrite_err
  4279.     bsr    namedruck
  4280.     prtxt    33
  4281.     bsr    r_buf
  4282.     bra    pi1aus
  4283. piwrite_err:
  4284.     prtxt    40
  4285.     bsr    r_buf
  4286.     bra.s    pi1aus
  4287. no_name:
  4288.     prtxt    43
  4289.     bra.s    pi1aus1
  4290. berechaus:
  4291.     print    str3,5
  4292.     prtxt    13
  4293. pi1aus1:
  4294.     bsr    r_buf
  4295. pi1aus:
  4296.     movem.l    (sp)+,d4-d7/a0-a6
  4297.  
  4298.     rts
  4299.  
  4300. ;--------------------
  4301.  
  4302. berecherg:
  4303.     mkopieren    2*4(a3),7*4(a3)
  4304.     mkopieren    2*4(a3),8*4(a3)
  4305.     mplusu        7*4(a3),8*4(a3)
  4306.     mkopieren    8*4(a3),7*4(a3)
  4307.     mplusu        8*4(a3),7*4(a3);    v8 : 4*arctan(1/5)
  4308.  
  4309.     mminusu    3*4(a3),7*4(a3);  v8 : 4*arctan(1/5)-arctan(1/239)
  4310.  
  4311.     mkopieren    7*4(a3),8*4(a3)
  4312.     mplusu        7*4(a3),8*4(a3)
  4313.     mkopieren    8*4(a3),7*4(a3)
  4314.     mplusu        8*4(a3),7*4(a3);    v8 : pi-ergebnis
  4315.  
  4316.     rts
  4317.  
  4318. ;--------------------
  4319.  
  4320. namein:
  4321.     prtxt    32
  4322.     lea    datname(pc),a4
  4323.  
  4324.     move.l    conhandle(pc),d7
  4325. nnamein:
  4326.     move.l    d7,d1
  4327.     move.l    a4,d2
  4328.     moveq    #1,d3
  4329.     jsr    read(a6)
  4330.  
  4331.     cmp.b    #$d,(a4)
  4332.     beq.s    nameex
  4333.     cmp.b    #$8,(a4)
  4334.     beq.s    nback
  4335.     cmp.b    #$9b,(a4)
  4336.     beq.s    frgs_ctrl
  4337.     cmp.l    #datname+40,a4
  4338.     beq.s    nnamein
  4339.  
  4340.     move.l    d7,d1
  4341.     move.l    a4,d2
  4342.     move.l    #1,d3
  4343.     jsr    write(a6)
  4344.  
  4345.     addq.l    #1,a4
  4346.     bra.s    nnamein
  4347. frgs_ctrl:
  4348.     move.l    d7,d1
  4349.     move.l    a4,d2
  4350.     moveq    #10,d3
  4351.     jsr    read(a6)
  4352.  
  4353.     bra.s    nnamein
  4354. nback:
  4355.     lea    datname(pc),a0
  4356.     cmp.l    a0,a4
  4357.     beq.s    nnamein
  4358.  
  4359.     bsr    backspace
  4360.     subq.l    #1,a4
  4361.     bra.s    nnamein
  4362. nameex:
  4363.     clr.b    (a4)
  4364.  
  4365.     rts
  4366.  
  4367. ;--------------------
  4368.  
  4369. namedruck:
  4370.     prtxt    31
  4371.  
  4372.     lea    datname(pc),a4
  4373.     move.l    a4,d2
  4374.     moveq    #0,d3
  4375. addname:
  4376.     tst.b    (a4)+
  4377.     beq.s    addraus
  4378.     addq.w    #1,d3
  4379.     bra.s    addname
  4380. addraus:
  4381.     move.l    conhandle(pc),d1
  4382.     jsr    write(a6)
  4383.  
  4384.     print    zeiloe,2
  4385.  
  4386.     rts
  4387.  
  4388.  
  4389. ;************ daten,variablen ***********
  4390.  
  4391. dosname:dc.b    `dos.library`,0
  4392. intname:dc.b    `intuition.library`,0
  4393. piname:    dc.b    `pidat`,0
  4394. name:    dc.b    `raw:0/0/`
  4395. windsize: dc.b    `640/200/**************  ADAM_V3  **************`,0
  4396.  
  4397. ; deutsche texte
  4398.  
  4399. dt1:
  4400. dc.b    $c,$9b,`0 p`,$9b,`20C`,$9b,`4;31;40mManulle Eingabe`
  4401. dc.b    $9b,`0;31;40m`,$a,$a
  4402. dc.b    `   Das Prompt-Zeichen > fordert zur Eingabe auf. In der`
  4403. dc.b    ` ersten und in der`,$a,` dritten Zeile`
  4404. dc.b    ` wird die Eingabe einer Zahl erwartet, in der`,$a
  4405. dc.b    ` zweiten Zeile die Eingabe eines Befehls.`,$a
  4406. dc.b    `   Hier können die Zeichen +, -, *, /`
  4407. dc.b    ` oder ein Buchstabe eingegegeben werden.`,$a
  4408. dc.b    ` Buchstaben, die Befehle auslösen:`,$a,$a,9
  4409. dc.b    `m = speichern`,9,9,9,`q = quadrieren`,$a,9
  4410. dc.b    `s = Wurzel ziehen`,9,9,`v = vergleichen`,$a,9
  4411. dc.b    `k = Kehrwert`,9,9,9,`! = Fakultät`,$a,9
  4412. dc.b    `w = Vorzeichen wechseln`,9,9,`i = Integer`,$a,9
  4413. dc.b    `S = Sinus`,$a,$a
  4414. dc.b    ` Anstatt eine Zahl einzugeben kann auch`,$a
  4415. dc.b    `    - p für pi`,$a
  4416. dc.b    `    - m für die Zahl im Speicher`,$a
  4417. dc.b    ` eingegeben werden.`,$a
  4418. dc.b    `   Jede Eingabe kann mit der Backspace-Taste gelöscht`
  4419. dc.b    ` werden`,$a,` und muß mit Return-Taste abgeschlossen`
  4420. dc.b    ` werden.`,$a,$a,9,9,`Drücke eine Taste `
  4421. dt2:
  4422. dc.b    $9b,`0 p`,$9b
  4423. dc.b    `K f1, Esc = Hauptmenü`,9,9,9,`f2 = nochmal`,$a,$9b
  4424. dc.b    `K f3 = nochmal mit dem Ergebnis`,9,9,`f4 = format ändern `
  4425. dc.b    $a,$9b,`K f5 = Ergebnis speichern und nochmal    f6 = help `
  4426. dc.b    $9b,` p`
  4427. dt3:    dc.b    ` Beide Zahlen sind gleich gross`,$a
  4428. dt4:    dc.b    ` Die erste Zahl ist grösser als die zweite`,$a
  4429. dt5:    dc.b    ` Die zweite Zahl ist grösser als die erste`,$a
  4430. dt6:    dc.b    ` Bedingungen für nst und vst:`,$a,9
  4431.     dc.b    `- vst und nst müssen durch 4 teilbar sein`,$a,9
  4432.     dc.b    `- vst und nst müssen kleiner als 30000 und größer`
  4433.     dc.b    `als 19 sein`
  4434. dt7:    dc.b    $c,$9b,`20B Speicher =`,$a
  4435. dt8:    dc.b    `qr =`,$a
  4436. dt9:    dc.b    8,`^2 =`,$a
  4437. dt10:    dc.b    $9b,`0 p`,$c,$a,$9b,`24C`,$9b,`4;31;40mHauptmenü`
  4438.     dc.b    $9b,`0;31;40m`,$9b
  4439.     dc.b    `3E    f1, Esc = Ende`,$9b
  4440.     dc.b    `2E    f2 = rechnen`,$9b
  4441.     dc.b    `2E    f3 = Pi berechnen`,$9b
  4442.     dc.b    `2E    f4 = Hilfe `,$9b
  4443.     dc.b    `2E    f5 = Sprache : Deutsch`,$9b,`3E `
  4444.     dc.b    $9b,`4;31;40mFeldgröße :`,$9b,`0;31;40m`,$a,$a
  4445.     dc.b    9,`vst =`,$a,9,`nst = `,$b
  4446. dt11:    dc.b    $9b,`1;42H`,$9b,`4;31;40mIterationen :`
  4447.     dc.b    $9b,`0;31;40m       von  `
  4448. dt12:    dc.b    $c,$a,$9b,`24C`,$9b,`4;33;40mFehlermeldung`
  4449.     dc.b    $9b,`0;31;40m`,$a,$a
  4450. dt13:    dc.b    $d,` Bitte eine Taste drücken `,$9b,$4b
  4451. dt14:    dc.b    ` Im Artwort des Feldes (st3) ist eine Null statt`
  4452.     dc.b    ` 1,2 oder 3`
  4453. dt15:    dc.b    ` Wurzel aus einer negativen Zahl`
  4454. dt16:    dc.b    $c,` Anzahl der Iterationen ?`,$9b,`4E`
  4455.     dc.b    ` Die Berechnung kann mit dem linken Mausknopf und`
  4456.     dc.b    ` der rechten Shifttaste`,$a,` unterbrochen werden`
  4457.     dc.b    $9b,`3F>   `
  4458. dt17:    dc.b    $9b,`3;1H`
  4459.     dc.b    ` Weitermachen (y/n) oder quiet (q) ? `,$9b,$4b
  4460. dt18:    dc.b    $9b,`5;1H Pi = `,$a
  4461. dt19:    dc.b    $9b,`5E Einen Moment ... `
  4462. dt20:    dc.b    ` =`,$9b,$4b,$a
  4463. dt21:    dc.b    ` Division durch null`
  4464. dt22:    dc.b    $c,` `,$9b,`4;31;40mFeldgröße :`
  4465.     dc.b    $9b,`0;31;40m vst = `
  4466. dt23:    dc.b    `, nst = `
  4467. dt24:    dc.b    $9b,`3;1H Weitermachen`
  4468.     dc.b    ` (y/n) oder wieder anzeigen (q) ? `,$9b,$4b
  4469. dt25:    dc.b    $d,` quiet`,$9b,$4b
  4470. dt26:
  4471. dt27:    dc.b    ` Überlauf bei Addition`
  4472. dt28:    dc.b    ` Überlauf bei Division`
  4473. dt29:    dc.b    ` Überlauf bei Multiplikation`
  4474. dt30:    dc.b    $d,` Zahl speichern (y/n) ? `,$9b,$4b
  4475. dt31:    dc.b    $d,` Zahl gespeichert als : `,$9b,$4b
  4476. dt32:    dc.b    $d,` Dateiname : `,$9b,$4b
  4477. dt33:    dc.b    `   < Taste > `,$9b,$4b
  4478. dt34:    dc.b    ` Fakultät einer negativen Zahl und einer nicht`
  4479.     dc.b    `ganzen Zahl ist nicht erlaubt`
  4480. dt35:    dc.b    8,`* -1 =`,$a
  4481. dt36:    dc.b    8,`^ -1 =`,$a
  4482. dt37:    dc.b    8,`integer =`,$a
  4483. dt38:    dc.b    $a,` Format : unformatiert`,$9b,$4b,$9b,`3F`
  4484. dt39:    dc.b    $a,` Format : formatiert`,$9b,$4b,$9b,`3F`
  4485. dt40:    dc.b    $d,` Fehler : Datei konnte nicht geöffnet werden `
  4486.     dc.b    `     < Taste >`,$9b,$4b
  4487. dt41:    dc.b    $a,`  Datei `,34,`pidat`,34,` konnte nicht`
  4488.     dc.b    ` geöffnet werden     < Taste > `,$9b,$4b
  4489. dt42:    dc.b    8,`Sinus =`,$a
  4490. dt43:    dc.b    $d,` Nicht gespeichert     < Taste > `
  4491. dt44:    dc.b    $a,9,`Nicht genug Speicher !`
  4492. dt45:    dc.b    $a,9,`Konnte Fenster nicht öffnen !`
  4493. dt46:
  4494.  
  4495. ; englische texte
  4496.  
  4497. et1:
  4498. dc.b    $c,$9b,`0 p`,$9b,`20C`,$9b,`4;31;40mHow to enter a`
  4499. dc.b    ` number`,$9b,`0;31;40m`,$a,$a
  4500. dc.b    `   The prompt > requests your enters. `
  4501. dc.b    `In the first`,$a,` and third line`
  4502. dc.b    ` you are expected to type in a number,`,$a
  4503. dc.b    ` in the second line a command.`,$a
  4504. dc.b    ` These are the commands :`,$a,$a
  4505. dc.b    9,`+, -, *, / = add, subract, multiply, divide`,$a
  4506. dc.b    9,`m = copy to memory`,9,9,`q = square`,$a
  4507. dc.b    9,`s = square root`,9,9,9,`v = compare`,$a
  4508. dc.b    9,`k = reciprocal`,9,9,9,`! = faculty`,$a
  4509. dc.b    9,`w = change sign`,9,9,9,`i = integer`,$a
  4510. dc.b    9,`S = sine`,$a,$a
  4511. dc.b    ` Instead of typing a number you can type`,$a
  4512. dc.b    `    - m for the number that is currently in the `
  4513. dc.b    `memory and `,$a,9,`    is displayed at the bottom or `
  4514. dc.b    $a,`    - p for pi`
  4515. dc.b    $a,`   Each number and command must be concluded by `
  4516. dc.b    `<RETURN>`,$a,` and can be erased by <BACKSPACE>.`
  4517. dc.b    $a,$a,9,9,` Press any key `
  4518. et2:
  4519. dc.b    $9b,`0 p`,$9b
  4520. dc.b    `K f1, Esc = Main Menu`,9,9,9,`f2 = once again`,$a,$9b
  4521. dc.b    `K f3 = once again with result`,9,9,`f4 = change format`
  4522. dc.b    $a,$9b,`K f5 = store result and once again    f6 = help `
  4523. dc.b    $9b,` p`
  4524. et3:    dc.b    ` The numbers are equal`,$a
  4525. et4:    dc.b    ` The first number is higher`,$a
  4526. et5:    dc.b    ` The second number is higher`,$a
  4527. et6:    dc.b    ` Conditions for st : `,$a,$a
  4528. dc.b    `    vst and nst can be divided by 4 without a rest`
  4529. dc.b    $a,`    vst and nst must be smaller than 30000 and `
  4530. dc.b    `greater than 19`
  4531. et7:    dc.b    $c,$9b,`20B memory =`,$a
  4532. et8:    dc.b    `qr =`,$a
  4533. et9:    dc.b    8,`^2 =`,$a
  4534. et10:    dc.b    $9b,`0 p`,$c,$a,$9b,`24C`,$9b,`4;31;40mMain menu`
  4535.     dc.b    $9b,`0;31;40m`,$9b
  4536.     dc.b    `3E    f1, Esc = Exit`,$9b
  4537.     dc.b    `2E    f2 = calculate`,$9b
  4538.     dc.b    `2E    f3 = calculate pi`,$9b
  4539.     dc.b    `2E    f4 = help `,$9b
  4540.     dc.b    `2E    f5 = language : English`,$9b,`3E `
  4541.     dc.b    $9b,`4;31;40mSize of numbers :`,$9b,`0;31;40m`
  4542.     dc.b    $a,$a,9,`vst =`,$a,9,`nst = `,$b
  4543. et11:    dc.b    $9b,`1;43H`,$9b,`4;31;40mIterations :`
  4544.     dc.b    $9b,`0;31;40m       of  `
  4545. et12:    dc.b    $c,$a,$9b,`24C`,$9b,`4;33;40mErrormessage`
  4546.     dc.b    $9b,`0;31;40m`,$a,$a
  4547. et13:    dc.b    $d,` Press any key `,$9b,$4b
  4548. et14:    dc.b    ` In the signword of the array is 0 instead of`
  4549.     dc.b    ` 1,2 or 3`
  4550. et15:    dc.b    ` Squareroot of a negative number`
  4551. et16:    dc.b    $c,` How many iterations ?`,$9b,`4`,$45
  4552.     dc.b    ` The calculation can be interrupted by pressing `
  4553.     dc.b    `the left mousebutton`,$a,` or pressing the right`
  4554.     dc.b    ` shift-key`,$9b,`3F>   `
  4555. et17:    dc.b    $9b,`3;1H`
  4556.     dc.b    ` Go on (y/n) oder quiet (q) ? `,$9b,$4b
  4557. et18:    dc.b    $9b,`5;1H pi = `,$a
  4558. et19:    dc.b    $9b,`5`,$45,` one moment please ... `
  4559. et20:    dc.b    ` =`,$9b,$4b,$a
  4560. et21:    dc.b    ` Division by 0`
  4561. et22:    dc.b    $c,` `,$9b,`4;31;40mSize of numbers :`
  4562.     dc.b    $9b,`0;31;40m vst = `
  4563. et23:    dc.b    `, nst = `
  4564. et24:    dc.b    $9b,`3;1H Go on`
  4565.     dc.b    ` (y/n) or print pi (q) ? `,$9b,$4b
  4566. et25:    dc.b    $d,` quiet`,$9b,$4b
  4567. et26:
  4568. et27:    dc.b    ` Overflow at addition`
  4569. et28:    dc.b    ` Overflow at division`
  4570. et29:    dc.b    ` Overflow at multiplikation`
  4571. et30:    dc.b    $d,` Write pi to file (y/n) ? `,$9b,$4b
  4572. et31:    dc.b    $d,` Number saved as : `,$9b,$4b
  4573. et32:    dc.b    $d,` File name : `,$9b,$4b
  4574. et33:    dc.b    `   < press any key > `,$9b,$4b
  4575. et34:    dc.b    ` Faculty of a negative and of a not integer number`
  4576.     dc.b    `is not allowed`
  4577. et35:    dc.b    8,`* -1 =`,$a
  4578. et36:    dc.b    8,`^ -1 =`,$a
  4579. et37:    dc.b    8,`integer =`,$a
  4580. et38:    dc.b    $a,` format : not formatted`,$9b,$4b,$9b,`3F`
  4581. et39:    dc.b    $a,` format : formatted`,$9b,$4b,$9b,`3F`
  4582. et40:    dc.b    $a,` File `,34,`pidat`,34,` could not be opened `
  4583.     dc.b    `     < press any key >`,$9b,$4b
  4584. et41:    dc.b    $a,`  File `,34,`pidat`,34,` not found`
  4585.     dc.b    `    < press any key >`,$9b,$4b
  4586. et42:    dc.b    8,`sine =`,$a
  4587. et43:    dc.b    $d,$9b,`K Not done        < press any key >`
  4588. et44:    dc.b    $a,9,`ADAM : short of memory !`
  4589. et45:    dc.b    $a,9,`Could not open window !`
  4590. et46:
  4591. even
  4592.  
  4593. conhandle:
  4594. text_tab:
  4595. dc.l    0;            conhandle
  4596. dc.l    eng_ttab-text_tabanf;    distanzwert für sprache
  4597. text_tabanf:
  4598. dc.l    0,0;    text0 gibt es nicht
  4599. dc.l    dt1,dt2-dt1,dt2,dt3-dt2,dt3,dt4-dt3,dt4,dt5-dt4
  4600. dc.l    dt5,dt6-dt5,dt6,dt7-dt6,dt7,dt8-dt7,dt8,dt9-dt8
  4601. dc.l    dt9,dt10-dt9,dt10,dt11-dt10,dt11,dt12-dt11
  4602. dc.l    dt12,dt13-dt12,dt13,dt14-dt13,dt14,dt15-dt14
  4603. dc.l    dt15,dt16-dt15,dt16,dt17-dt16,dt17,dt18-dt17
  4604. dc.l    dt18,dt19-dt18,dt19,dt20-dt19,dt20,dt21-dt20
  4605. dc.l    dt21,dt22-dt21,dt22,dt23-dt22,dt23,dt24-dt23
  4606. dc.l    dt24,dt25-dt24,dt25,dt26-dt25,dt26,dt27-dt26
  4607. dc.l    dt27,dt28-dt27,dt28,dt29-dt28,dt29,dt30-dt29
  4608. dc.l    dt30,dt31-dt30,dt31,dt32-dt31,dt32,dt33-dt32
  4609. dc.l    dt33,dt34-dt33,dt34,dt35-dt34,dt35,dt36-dt35
  4610. dc.l    dt36,dt37-dt36,dt37,dt38-dt37,dt38,dt39-dt38
  4611. dc.l    dt39,dt40-dt39,dt40,dt41-dt40,dt41,dt42-dt41
  4612. dc.l    dt42,dt43-dt42,dt43,dt44-dt43,dt44,dt45-dt44
  4613. dc.l    dt45,dt46-dt45
  4614. eng_ttab:
  4615. dc.l    0,0,et1,et2-et1,et2,et3-et2,et3,et4-et3,et4,et5-et4
  4616. dc.l    et5,et6-et5,et6,et7-et6,et7,et8-et7,et8,et9-et8
  4617. dc.l    et9,et10-et9,et10,et11-et10,et11,et12-et11
  4618. dc.l    et12,et13-et12,et13,et14-et13,et14,et15-et14
  4619. dc.l    et15,et16-et15,et16,et17-et16,et17,et18-et17
  4620. dc.l    et18,et19-et18,et19,et20-et19,et20,et21-et20
  4621. dc.l    et21,et22-et21,et22,et23-et22,et23,et24-et23
  4622. dc.l    et24,et25-et24,et25,et26-et25,et26,et27-et26
  4623. dc.l    et27,et28-et27,et28,et29-et28,et29,et30-et29
  4624. dc.l    et30,et31-et30,et31,et32-et31,et32,et33-et32
  4625. dc.l    et33,et34-et33,et34,et35-et34,et35,et36-et35
  4626. dc.l    et36,et37-et36,et37,et38-et37,et38,et39-et38
  4627. dc.l    et39,et40-et39,et40,et41-et40,et41,et42-et41
  4628. dc.l    et42,et43-et42,et43,et44-et43,et44,et45-et44
  4629. dc.l    et45,et46-et45
  4630.  
  4631. ; schriftzeichen
  4632. pu:    dc.b    `.`
  4633. nu:    dc.b    `0`
  4634.  
  4635. ; steuerzeichen
  4636. bs1:    dc.b    8,$20,8
  4637. home:    dc.b    $9b,$48
  4638. str2:    dc.b    $9b,`1;56H`
  4639. str3:    dc.b    $9b,`3;1H`
  4640. plumi:    dc.b    $d,`> -`
  4641. miplu:    dc.b    $d,`>   `
  4642. zeiloe:    dc.b    $9b,$4b
  4643. lflf:    dc.b    $a,$a
  4644. ergeb:    dc.b    `>   =`,$9b,$4b,$a
  4645. cmp_tab:dc.b    `01234`
  4646. sicht:    dc.b    $9b,` p`
  4647. r:    dc.b    0,0,0,0
  4648.  
  4649. ; variablenfelder (anzahl auch bei variab_anz ändern !)
  4650.  
  4651. even
  4652. speicher:    dc.l    0;    memoryfeld
  4653. bcd1:        dc.l    0
  4654. bcd2:        dc.l    0
  4655. bcd3:        dc.l    0
  4656. bcd4:        dc.l    0
  4657. bcd5:        dc.l    0
  4658. bcd6:        dc.l    0
  4659. bcd7:        dc.l    0
  4660. bcd8:        dc.l    0
  4661. bcd9:        dc.l    0
  4662.  
  4663. ; rechenfelder  (anzahl auch bei rech_anz ändern !)
  4664.  
  4665. sqr1:        dc.l    0;    für sqrroot
  4666. sqr2:        dc.l    0;    für sqrroot
  4667. sqr3:        dc.l    0;    für sqrroot
  4668. sqr4:        dc.l    0;    für sqrroot
  4669. sqr5:        dc.l    0;    für sqrroot
  4670.  
  4671. ; dezimalkonstanten   (anzahl auch bei dez_anz ändern !)
  4672.  
  4673. dez1:        dc.l    0
  4674. dez2:        dc.l    0
  4675. dez3:        dc.l    0
  4676.  
  4677. ; sonstige felder
  4678.  
  4679. r1:        dc.l    0; für mals
  4680. rt1:        dc.l    0; für div und mals und minusu und decrem
  4681. tabr:        dc.l    0; multiplikationstabelle für div und mals
  4682. byte1:        dc.l    0; für zahlein und druck
  4683. buffer:        dc.l    0; eingabe- und ausgabefeld
  4684. pi:        dc.l    0
  4685.  
  4686. ; daten fur die zahlenkonstanten. bevor das ausgabefenster geöffnet
  4687. ; wird, werden die daten in die variablen dez1,dez2... übertragen.
  4688. ; sie dürfen vom programm nicht verändert werden !!!
  4689.  
  4690. dezdat1:    dc.w    1,0,2;        1
  4691.         dc.b    1,0
  4692.         dc.w    0,1,2;        0.2
  4693.         dc.b    2,0
  4694.         dc.w    3,0,2;        1/239
  4695.         dc.b    2,3,9,0
  4696.  
  4697. stackpt:    dc.l    0
  4698. dosbase:    dc.l    0
  4699. datname:    blk.b    44,0
  4700. memlist:    blk.l    30,0
  4701. fehler:        dc.w    0
  4702. divzaeh:    dc.w    0
  4703.  
  4704. ; die folgenden variablen nicht umstellen !!!
  4705.  
  4706. z1:        dc.w    0
  4707. z2:        dc.w    0
  4708. z3:        dc.w    0
  4709. punknum:    dc.w    0
  4710. vor:        dc.w    0
  4711. nach:        dc.w    0
  4712. vorzei:        dc.b    0
  4713.  
  4714. plflag:        dc.b    0
  4715. fdruck:        dc.b    0
  4716. format:        dc.b    0
  4717. op:        dc.b    0
  4718.  
  4719.  
  4720.