home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / CLISP-1.LHA / CLISP960530-sr.lha / src / arilev1c.d < prev    next >
Encoding:
Text File  |  1996-04-15  |  33.2 KB  |  960 lines
  1. # Definitionen und portabler C-Code zu ARILEV1.D
  2.  
  3. # Kopierschleife:
  4. # destptr = copy_loop_up(sourceptr,destptr,count);
  5. # kopiert count (uintC>=0) Digits aufwärts von sourceptr nach destptr
  6. # und liefert das neue destptr.
  7.   local uintD* copy_loop_up (uintD* sourceptr, uintD* destptr, uintC count);
  8.   local uintD* copy_loop_up(sourceptr,destptr,count)
  9.     var reg2 uintD* sourceptr;
  10.     var reg1 uintD* destptr;
  11.     var reg3 uintC count;
  12.     { until (count==0) { *destptr++ = *sourceptr++; count--; }
  13.       return destptr;
  14.     }
  15.  
  16. # Kopierschleife:
  17. # destptr = copy_loop_down(sourceptr,destptr,count);
  18. # kopiert count (uintC>=0) Digits abwärts von sourceptr nach destptr
  19. # und liefert das neue destptr.
  20.   local uintD* copy_loop_down (uintD* sourceptr, uintD* destptr, uintC count);
  21.   local uintD* copy_loop_down(sourceptr,destptr,count)
  22.     var reg2 uintD* sourceptr;
  23.     var reg1 uintD* destptr;
  24.     var reg3 uintC count;
  25.     { until (count==0) { *--destptr = *--sourceptr; count--; }
  26.       return destptr;
  27.     }
  28.  
  29. # Füllschleife:
  30. # destptr = fill_loop_up(destptr,count,filler);
  31. # kopiert count (uintC>=0) mal das Digit filler aufwärts nach destptr
  32. # und liefert das neue destptr.
  33.   local uintD* fill_loop_up (uintD* destptr, uintC count, uintD filler);
  34.   local uintD* fill_loop_up(destptr,count,filler)
  35.     var reg1 uintD* destptr;
  36.     var reg3 uintC count;
  37.     var reg2 uintD filler;
  38.     { until (count==0) { *destptr++ = filler; count--; }
  39.       return destptr;
  40.     }
  41.  
  42. # Füllschleife:
  43. # destptr = fill_loop_down(destptr,count,filler);
  44. # kopiert count (uintC>=0) mal das Digit filler abwärts nach destptr
  45. # und liefert das neue destptr.
  46.   local uintD* fill_loop_down (uintD* destptr, uintC count, uintD filler);
  47.   local uintD* fill_loop_down(destptr,count,filler)
  48.     var reg1 uintD* destptr;
  49.     var reg3 uintC count;
  50.     var reg2 uintD filler;
  51.     { until (count==0) { *--destptr = filler; count--; }
  52.       return destptr;
  53.     }
  54.  
  55. # Lösch-Schleife:
  56. # destptr = clear_loop_up(destptr,count);
  57. # löscht count (uintC>=0) Digits aufwärts ab destptr
  58. # und liefert das neue destptr.
  59.   local uintD* clear_loop_up (uintD* destptr, uintC count);
  60.   local uintD* clear_loop_up(destptr,count)
  61.     var reg1 uintD* destptr;
  62.     var reg2 uintC count;
  63.     { until (count==0) { *destptr++ = 0; count--; }
  64.       return destptr;
  65.     }
  66.  
  67. # Lösch-Schleife:
  68. # destptr = clear_loop_down(destptr,count);
  69. # löscht count (uintC>=0) Digits abwärts ab destptr
  70. # und liefert das neue destptr.
  71.   local uintD* clear_loop_down (uintD* destptr, uintC count);
  72.   local uintD* clear_loop_down(destptr,count)
  73.     var reg1 uintD* destptr;
  74.     var reg2 uintC count;
  75.     { until (count==0) { *--destptr = 0; count--; }
  76.       return destptr;
  77.     }
  78.  
  79. # OR-Schleife:
  80. # or_loop_up(xptr,yptr,count);
  81. # verknüpft count (uintC>=0) Digits aufwärts ab xptr und ab yptr
  82. # mit Ziel ab xptr durch OR.
  83.   local void or_loop_up (uintD* xptr, uintD* yptr, uintC count);
  84.   local void or_loop_up(xptr,yptr,count)
  85.     var reg1 uintD* xptr;
  86.     var reg2 uintD* yptr;
  87.     var reg3 uintC count;
  88.     { until (count==0) { *xptr++ |= *yptr++; count--; } }
  89.  
  90. # XOR-Schleife:
  91. # xor_loop_up(xptr,yptr,count);
  92. # verknüpft count (uintC>=0) Digits aufwärts ab xptr und ab yptr
  93. # mit Ziel ab xptr durch XOR.
  94.   local void xor_loop_up (uintD* xptr, uintD* yptr, uintC count);
  95.   local void xor_loop_up(xptr,yptr,count)
  96.     var reg1 uintD* xptr;
  97.     var reg2 uintD* yptr;
  98.     var reg3 uintC count;
  99.     { until (count==0) { *xptr++ ^= *yptr++; count--; } }
  100.  
  101. # AND-Schleife:
  102. # and_loop_up(xptr,yptr,count);
  103. # verknüpft count (uintC>=0) Digits aufwärts ab xptr und ab yptr
  104. # mit Ziel ab xptr durch AND.
  105.   local void and_loop_up (uintD* xptr, uintD* yptr, uintC count);
  106.   local void and_loop_up(xptr,yptr,count)
  107.     var reg1 uintD* xptr;
  108.     var reg2 uintD* yptr;
  109.     var reg3 uintC count;
  110.     { until (count==0) { *xptr++ &= *yptr++; count--; } }
  111.  
  112. # EQV-Schleife:
  113. # eqv_loop_up(xptr,yptr,count);
  114. # verknüpft count (uintC>=0) Digits aufwärts ab xptr und ab yptr
  115. # mit Ziel ab xptr durch EQV (NOT XOR).
  116.   local void eqv_loop_up (uintD* xptr, uintD* yptr, uintC count);
  117.   local void eqv_loop_up(xptr,yptr,count)
  118.     var reg1 uintD* xptr;
  119.     var reg2 uintD* yptr;
  120.     var reg3 uintC count;
  121.     { until (count==0)
  122.       {{var reg4 uintD temp = ~ (*xptr ^ *yptr++); *xptr++ = temp; }
  123.         count--;
  124.     } }
  125.  
  126. # NAND-Schleife:
  127. # nand_loop_up(xptr,yptr,count);
  128. # verknüpft count (uintC>=0) Digits aufwärts ab xptr und ab yptr
  129. # mit Ziel ab xptr durch NAND (NOT AND).
  130.   local void nand_loop_up (uintD* xptr, uintD* yptr, uintC count);
  131.   local void nand_loop_up(xptr,yptr,count)
  132.     var reg1 uintD* xptr;
  133.     var reg2 uintD* yptr;
  134.     var reg3 uintC count;
  135.     { until (count==0)
  136.       {{var reg4 uintD temp = ~ (*xptr & *yptr++); *xptr++ = temp; }
  137.         count--;
  138.     } }
  139.  
  140. # NOR-Schleife:
  141. # nor_loop_up(xptr,yptr,count);
  142. # verknüpft count (uintC>=0) Digits aufwärts ab xptr und ab yptr
  143. # mit Ziel ab xptr durch NOR (NOT OR).
  144.   local void nor_loop_up (uintD* xptr, uintD* yptr, uintC count);
  145.   local void nor_loop_up(xptr,yptr,count)
  146.     var reg1 uintD* xptr;
  147.     var reg2 uintD* yptr;
  148.     var reg3 uintC count;
  149.     { until (count==0)
  150.       {{var reg4 uintD temp = ~ (*xptr | *yptr++); *xptr++ = temp; }
  151.         count--;
  152.     } }
  153.  
  154. # ANDC2-Schleife:
  155. # andc2_loop_up(xptr,yptr,count);
  156. # verknüpft count (uintC>=0) Digits aufwärts ab xptr und ab yptr
  157. # mit Ziel ab xptr durch ANDC2 (AND NOT).
  158.   local void andc2_loop_up (uintD* xptr, uintD* yptr, uintC count);
  159.   local void andc2_loop_up(xptr,yptr,count)
  160.     var reg1 uintD* xptr;
  161.     var reg2 uintD* yptr;
  162.     var reg3 uintC count;
  163.     { until (count==0) { *xptr++ &= ~(*yptr++); count--; } }
  164.  
  165. # ORC2-Schleife:
  166. # orc2_loop_up(xptr,yptr,count);
  167. # verknüpft count (uintC>=0) Digits aufwärts ab xptr und ab yptr
  168. # mit Ziel ab xptr durch ORC2 (OR NOT).
  169.   local void orc2_loop_up (uintD* xptr, uintD* yptr, uintC count);
  170.   local void orc2_loop_up(xptr,yptr,count)
  171.     var reg1 uintD* xptr;
  172.     var reg2 uintD* yptr;
  173.     var reg3 uintC count;
  174.     { until (count==0) { *xptr++ |= ~(*yptr++); count--; } }
  175.  
  176. # NOT-Schleife:
  177. # not_loop_up(xptr,count);
  178. # verknüpft count (uintC>0) Digits aufwärts ab xptr mit Ziel ab xptr
  179. # durch NOT.
  180.   local void not_loop_up (uintD* xptr, uintC count);
  181.   local void not_loop_up(xptr,count)
  182.     var reg1 uintD* xptr;
  183.     var reg2 uintC count;
  184.     { do { {var reg3 uintD temp = ~ (*xptr); *xptr++ = temp; }
  185.            count--;
  186.          }
  187.          until (count==0);
  188.     }
  189.  
  190. # AND-Test-Schleife:
  191. # and_test_loop_up(xptr,yptr,count);
  192. # verknüpft count (uintC>=0) Digits aufwärts ab xptr und ab yptr durch AND
  193. # und testet, ob sich dabei ein Digit /=0 ergibt. Ergebnis /=0, falls ja.
  194.   local boolean and_test_loop_up (uintD* xptr, uintD* yptr, uintC count);
  195.   local boolean and_test_loop_up(xptr,yptr,count)
  196.     var reg1 uintD* xptr;
  197.     var reg2 uintD* yptr;
  198.     var reg3 uintC count;
  199.     { until (count==0) { if (*xptr++ & *yptr++) return TRUE; count--; }
  200.       return FALSE;
  201.     }
  202.  
  203. # Test-Schleife:
  204. # test_loop_up(ptr,count)
  205. # bzw.  if_test_loop_up(ptr,count, statement1, statement2)
  206. # testet count (uintC>=0) Digits aufwärts ab ptr, ob darunter eines /=0 ist.
  207. # Ergebnis /=0, falls ja.
  208.   local boolean test_loop_up (uintD* ptr, uintC count);
  209.   local boolean test_loop_up(ptr,count)
  210.     var reg2 uintD* ptr;
  211.     var reg3 uintC count;
  212.     { until (count==0) { if (*ptr++) return TRUE; count--; }
  213.       return FALSE;
  214.     }
  215.  
  216. # Vergleichsschleife:
  217. # result = compare_loop_up(xptr,yptr,count);
  218. # vergleicht nacheinander xptr[0] mit yptr[0], xptr[1] mit yptr[1], usw.,
  219. # insgesamt count Digits, und liefert 0 falls alle gleich sind,
  220. # +1 falls zuerst ein xptr[i]>yptr[i] ist,
  221. # -1 falls zuerst ein xptr[i]<yptr[i] ist.
  222.   local signean compare_loop_up (uintD* xptr, uintD* yptr, uintC count);
  223.   local signean compare_loop_up(xptr,yptr,count)
  224.     var reg1 uintD* xptr;
  225.     var reg1 uintD* yptr;
  226.     var reg2 uintC count;
  227.     { until (count==0)
  228.         { if (!(*xptr++ == *yptr++))
  229.             # verschiedene Digits gefunden
  230.             return (*--xptr > *--yptr ? signean_plus : signean_minus);
  231.           count--;
  232.         }
  233.       return signean_null; # alle Digits gleich
  234.     }
  235.  
  236. # Additionsschleife:
  237. # übertrag = add_loop_down(sourceptr1,sourceptr2,destptr,count);
  238. # addiert count (uintC>=0) Digits abwärts von sourceptr1, von sourceptr2
  239. # abwärts nach destptr und liefert den Übertrag (0 oder /=0, was 1 bedeutet).
  240.   local uintD add_loop_down (uintD* sourceptr1, uintD* sourceptr2, uintD* destptr, uintC count);
  241.   local uintD add_loop_down(sourceptr1,sourceptr2,destptr,count)
  242.     var reg2 uintD* sourceptr1;
  243.     var reg2 uintD* sourceptr2;
  244.     var reg1 uintD* destptr;
  245.     var reg3 uintC count;
  246.     { var reg4 uintD carry = 0;
  247.       until (count==0)
  248.         { var reg1 uintD source1 = *--sourceptr1;
  249.           var reg1 uintD source2 = *--sourceptr2;
  250.           if (carry)
  251.             if (source1 >= (uintD)(~source2))
  252.               { *--destptr = source1 + source2 + 1; carry = 1; }
  253.               else
  254.               { *--destptr = source1 + source2 + 1; carry = 0; }
  255.             else
  256.             if (source1 > (uintD)(~source2))
  257.               { *--destptr = source1 + source2; carry = 1; }
  258.               else
  259.               { *--destptr = source1 + source2; carry = 0; }
  260.           count--;
  261.         }
  262.       return carry;
  263.     }
  264.  
  265. # Additionsschleife:
  266. # übertrag = addto_loop_down(sourceptr,destptr,count);
  267. # addiert count (uintC>=0) Digits abwärts von sourceptr, von destptr
  268. # abwärts nach destptr und liefert den Übertrag (0 oder /=0, was 1 bedeutet).
  269.   local uintD addto_loop_down (uintD* sourceptr, uintD* destptr, uintC count);
  270.   local uintD addto_loop_down(sourceptr,destptr,count)
  271.     var reg2 uintD* sourceptr;
  272.     var reg1 uintD* destptr;
  273.     var reg3 uintC count;
  274.     { var reg4 uintD carry = 0;
  275.       until (count==0)
  276.         { var reg1 uintD source1 = *--sourceptr;
  277.           var reg1 uintD source2 = *--destptr;
  278.           if (carry)
  279.             if (source1 >= (uintD)(~source2))
  280.               { *destptr = source1 + source2 + 1; carry = 1; }
  281.               else
  282.               { *destptr = source1 + source2 + 1; carry = 0; }
  283.             else
  284.             if (source1 > (uintD)(~source2))
  285.               { *destptr = source1 + source2; carry = 1; }
  286.               else
  287.               { *destptr = source1 + source2; carry = 0; }
  288.           count--;
  289.         }
  290.       return carry;
  291.     }
  292.  
  293. # Incrementierschleife:
  294. # übertrag = inc_loop_down(ptr,count);
  295. # incrementiert count (uintC>=0) Digits abwärts von ptr, so lange bis kein
  296. # Übertrag mehr auftritt und liefert den Übertrag (0 oder /=0, was 1 bedeutet).
  297.   local uintD inc_loop_down (uintD* ptr, uintC count);
  298.   local uintD inc_loop_down(ptr,count)
  299.     var reg1 uintD* ptr;
  300.     var reg2 uintC count;
  301.     { until (count==0)
  302.         { if (!( ++(*--ptr) == 0 )) return 0; # kein weiterer Übertrag
  303.           count--;
  304.         }
  305.       return 1; # weiterer Übertrag
  306.     }
  307.  
  308. # Subtraktionsschleife:
  309. # übertrag = sub_loop_down(sourceptr1,sourceptr2,destptr,count);
  310. # subtrahiert count (uintC>=0) Digits abwärts von sourceptr1, von sourceptr2
  311. # abwärts nach destptr und liefert den Übertrag (0 oder /=0, was -1 bedeutet).
  312.   local uintD sub_loop_down (uintD* sourceptr1, uintD* sourceptr2, uintD* destptr, uintC count);
  313.   local uintD sub_loop_down(sourceptr1,sourceptr2,destptr,count)
  314.     var reg2 uintD* sourceptr1;
  315.     var reg2 uintD* sourceptr2;
  316.     var reg1 uintD* destptr;
  317.     var reg3 uintC count;
  318.     { var reg4 uintD carry = 0;
  319.       until (count==0)
  320.         { var reg1 uintD source1 = *--sourceptr1;
  321.           var reg1 uintD source2 = *--sourceptr2;
  322.           if (carry)
  323.             if (source1 > source2)
  324.               { *--destptr = source1 - source2 - 1; carry = 0; }
  325.               else
  326.               { *--destptr = source1 - source2 - 1; carry = -1; }
  327.             else
  328.             if (source1 >= source2)
  329.               { *--destptr = source1 - source2; carry = 0; }
  330.               else
  331.               { *--destptr = source1 - source2; carry = -1; }
  332.           count--;
  333.         }
  334.       return carry;
  335.     }
  336.  
  337. # Subtraktionsschleife:
  338. # übertrag = subx_loop_down(sourceptr1,sourceptr2,destptr,count,carry);
  339. # subtrahiert count (uintC>=0) Digits abwärts von sourceptr1 und addiert
  340. # einen Carry (0 oder -1), von sourceptr2 abwärts nach destptr und
  341. # liefert den Übertrag (0 oder /=0, was -1 bedeutet).
  342.   local uintD subx_loop_down (uintD* sourceptr1, uintD* sourceptr2, uintD* destptr, uintC count, uintD carry);
  343.   local uintD subx_loop_down(sourceptr1,sourceptr2,destptr,count,carry)
  344.     var reg2 uintD* sourceptr1;
  345.     var reg2 uintD* sourceptr2;
  346.     var reg1 uintD* destptr;
  347.     var reg3 uintC count;
  348.     var reg4 uintD carry;
  349.     { until (count==0)
  350.         { var reg1 uintD source1 = *--sourceptr1;
  351.           var reg1 uintD source2 = *--sourceptr2;
  352.           if (carry)
  353.             if (source1 > source2)
  354.               { *--destptr = source1 - source2 - 1; carry = 0; }
  355.               else
  356.               { *--destptr = source1 - source2 - 1; carry = -1; }
  357.             else
  358.             if (source1 >= source2)
  359.               { *--destptr = source1 - source2; carry = 0; }
  360.               else
  361.               { *--destptr = source1 - source2; carry = -1; }
  362.           count--;
  363.         }
  364.       return carry;
  365.     }
  366.  
  367. # Subtraktionsschleife:
  368. # übertrag = subfrom_loop_down(sourceptr,destptr,count);
  369. # subtrahiert count (uintC>=0) Digits abwärts von sourceptr, von destptr
  370. # abwärts nach destptr (dest := dest - source)
  371. # und liefert den Übertrag (0 oder /=0, was -1 bedeutet).
  372.   local uintD subfrom_loop_down (uintD* sourceptr, uintD* destptr, uintC count);
  373.   local uintD subfrom_loop_down(sourceptr,destptr,count)
  374.     var reg2 uintD* sourceptr;
  375.     var reg1 uintD* destptr;
  376.     var reg3 uintC count;
  377.     { var reg4 uintD carry = 0;
  378.       until (count==0)
  379.         { var reg1 uintD source1 = *--destptr;
  380.           var reg1 uintD source2 = *--sourceptr;
  381.           if (carry)
  382.             if (source1 > source2)
  383.               { *destptr = source1 - source2 - 1; carry = 0; }
  384.               else
  385.               { *destptr = source1 - source2 - 1; carry = -1; }
  386.             else
  387.             if (source1 >= source2)
  388.               { *destptr = source1 - source2; carry = 0; }
  389.               else
  390.               { *destptr = source1 - source2; carry = -1; }
  391.           count--;
  392.         }
  393.       return carry;
  394.     }
  395.  
  396. # Decrementierschleife:
  397. # übertrag = dec_loop_down(ptr,count);
  398. # decrementiert count (uintC>=0) Digits abwärts von ptr, so lange bis kein
  399. # Übertrag mehr auftritt und liefert den Übertrag (0 oder -1).
  400.   local uintD dec_loop_down (uintD* ptr, uintC count);
  401.   local uintD dec_loop_down(ptr,count)
  402.     var reg1 uintD* ptr;
  403.     var reg2 uintC count;
  404.     { until (count==0)
  405.         { if (!( (*--ptr)-- == 0 )) return 0; # kein weiterer Übertrag
  406.           count--;
  407.         }
  408.       return -1; # weiterer Übertrag
  409.     }
  410.  
  411. # Negierschleife:
  412. # übertrag = neg_loop_down(ptr,count);
  413. # negiert count (uintC>=0) Digits abwärts von ptr,
  414. # und liefert den Übertrag (0 oder -1).
  415.   local uintD neg_loop_down (uintD* ptr, uintC count);
  416.   local uintD neg_loop_down(ptr,count)
  417.     var reg1 uintD* ptr;
  418.     var reg2 uintC count;
  419.     { # erstes Digit /=0 suchen:
  420.       until (count==0) { if (!(*--ptr == 0)) goto L1; count--; }
  421.       return 0;
  422.       L1: # erstes Digit /=0 gefunden, ab jetzt gibt's Carrys
  423.       *ptr = - *ptr; count--; # 1 Digit negieren
  424.       until (count==0) { --ptr; *ptr = ~ *ptr; count--; } # alle anderen Digits invertieren
  425.       return -1;
  426.     }
  427.  
  428. # Schiebeschleife um 1 Bit nach links:
  429. # übertrag = shift1left_loop_down(ptr,count);
  430. # schiebt count (uintC>=0) Digits abwärts von ptr um 1 Bit nach links,
  431. # und liefert den Übertrag (0 oder /=0, was 1 bedeutet).
  432.   local uintD shift1left_loop_down (uintD* ptr, uintC count);
  433.   #if HAVE_DD
  434.   local uintD shift1left_loop_down(ptr,count)
  435.     var reg2 uintD* ptr;
  436.     var reg3 uintC count;
  437.     { var reg1 uintDD accu = 0;
  438.       until (count==0)
  439.         { accu = ((uintDD)(*--ptr)<<1)+accu; *ptr = lowD(accu);
  440.           accu = (uintDD)(highD(accu));
  441.           count--;
  442.         }
  443.       return (uintD)accu;
  444.     }
  445.   #else
  446.   local uintD shift1left_loop_down(ptr,count)
  447.     var reg2 uintD* ptr;
  448.     var reg4 uintC count;
  449.     { var reg3 uintD carry = 0;
  450.       until (count==0)
  451.         { var reg1 uintD accu = *--ptr;
  452.           *ptr = (accu<<1) | carry;
  453.           carry = accu>>(intDsize-1);
  454.           count--;
  455.         }
  456.       return carry;
  457.     }
  458.   #endif
  459.  
  460. # Schiebeschleife um i Bits nach links:
  461. # übertrag = shiftleft_loop_down(ptr,count,i,übertrag_init);
  462. # schiebt count (uintC>=0) Digits abwärts von ptr um i Bits (0<i<intDsize)
  463. # nach links, schiebt dabei die i Bits aus übertrag_init rechts rein,
  464. # und liefert den Übertrag (was links rauskommt, >=0, <2^i).
  465.   local uintD shiftleft_loop_down (uintD* ptr, uintC count, uintC i, uintD carry);
  466.   #if HAVE_DD
  467.   local uintD shiftleft_loop_down(ptr,count,i,carry)
  468.     var reg2 uintD* ptr;
  469.     var reg3 uintC count;
  470.     var reg4 uintC i;
  471.     var reg5 uintD carry;
  472.     { var reg1 uintDD accu = (uintDD)carry;
  473.       until (count==0)
  474.         { accu = ((uintDD)(*--ptr)<<i)+accu; *ptr = lowD(accu);
  475.           accu = (uintDD)(highD(accu));
  476.           count--;
  477.         }
  478.       return (uintD)accu;
  479.     }
  480.   #else
  481.   local uintD shiftleft_loop_down(ptr,count,i,carry)
  482.     var reg2 uintD* ptr;
  483.     var reg4 uintC count;
  484.     var reg5 uintC i;
  485.     var reg3 uintD carry;
  486.     { var reg6 uintC j = intDsize-i;
  487.       until (count==0)
  488.         { var reg1 uintD accu = *--ptr;
  489.           *ptr = (accu<<i) | carry;
  490.           carry = accu>>j;
  491.           count--;
  492.         }
  493.       return carry;
  494.     }
  495.   #endif
  496.  
  497. # Schiebe- und Kopierschleife um i Bits nach links:
  498. # übertrag = shiftleftcopy_loop_down(sourceptr,destptr,count,i);
  499. # kopiert count (uintC>=0) Digits abwärts von sourceptr nach destptr
  500. # und schiebt sie dabei um i Bits (0<i<intDsize) nach links,
  501. # wobei ganz rechts mit i Nullbits aufgefüllt wird,
  502. # und liefert den Übertrag (was links rauskommt, >=0, <2^i).
  503.   local uintD shiftleftcopy_loop_down (uintD* sourceptr, uintD* destptr, uintC count, uintC i);
  504.   #if HAVE_DD
  505.   local uintD shiftleftcopy_loop_down(sourceptr,destptr,count,i)
  506.     var reg3 uintD* sourceptr;
  507.     var reg2 uintD* destptr;
  508.     var reg4 uintC count;
  509.     var reg5 uintC i;
  510.     { var reg1 uintDD accu = 0;
  511.       until (count==0)
  512.         { accu = ((uintDD)(*--sourceptr)<<i)+accu; *--destptr = lowD(accu);
  513.           accu = (uintDD)(highD(accu));
  514.           count--;
  515.         }
  516.       return (uintD)accu;
  517.     }
  518.   #else
  519.   local uintD shiftleftcopy_loop_down(sourceptr,destptr,count,i)
  520.     var reg3 uintD* sourceptr;
  521.     var reg2 uintD* destptr;
  522.     var reg5 uintC count;
  523.     var reg6 uintC i;
  524.     { var reg7 uintC j = intDsize-i;
  525.       var reg4 uintD carry = 0;
  526.       until (count==0)
  527.         { var reg1 uintD accu = *--sourceptr;
  528.           *--destptr = (accu<<i) | carry;
  529.           carry = accu>>j;
  530.           count--;
  531.         }
  532.       return carry;
  533.     }
  534.   #endif
  535.  
  536. # Schiebeschleife um 1 Bit nach rechts:
  537. # übertrag = shift1right_loop_up(ptr,count,übertrag_init);
  538. # schiebt count (uintC>=0) Digits aufwärts von ptr um 1 Bit nach rechts,
  539. # wobei links das Bit übertrag_init (sollte =0 oder =-1 sein) hineingeschoben
  540. # wird, und liefert den Übertrag (0 oder /=0, was 1 bedeutet).
  541.   local uintD shift1right_loop_up (uintD* ptr, uintC count, uintD carry);
  542.   #if HAVE_DD
  543.   local uintD shift1right_loop_up(ptr,count,carry)
  544.     var reg2 uintD* ptr;
  545.     var reg3 uintC count;
  546.     var reg4 uintD carry;
  547.     { var reg1 uintDD accu = (sintDD)(sintD)carry & ((uintDD)1 << (2*intDsize-1)); # 0 oder bit(2*intDsize-1)
  548.       until (count==0)
  549.         { accu = (highlowDD_0(*ptr)>>1)+accu; *ptr++ = highD(accu);
  550.           accu = highlowDD_0(lowD(accu));
  551.           count--;
  552.         }
  553.       return highD(accu);
  554.     }
  555.   #else
  556.   local uintD shift1right_loop_up(ptr,count,carry)
  557.     var reg2 uintD* ptr;
  558.     var reg3 uintC count;
  559.     var reg4 uintD carry;
  560.     { carry = carry << (intDsize-1); # carry zu einem einzigen Bit machen
  561.       until (count==0)
  562.         { var reg1 uintD accu = *ptr;
  563.           *ptr++ = (accu >> 1) | carry;
  564.           carry = accu << (intDsize-1);
  565.           count--;
  566.         }
  567.       return carry;
  568.     }
  569.   #endif
  570.  
  571. # Schiebeschleife um i Bits nach rechts:
  572. # übertrag = shiftright_loop_up(ptr,count,i);
  573. # schiebt count (uintC>=0) Digits aufwärts von ptr um i Bits (0<i<intDsize)
  574. # nach rechts, wobei links Nullen eingeschoben werden,
  575. # und liefert den Übertrag (was rechts rauskommt, als Bits intDsize-1..intDsize-i).
  576.   local uintD shiftright_loop_up (uintD* ptr, uintC count, uintC i);
  577.   #if HAVE_DD
  578.   local uintD shiftright_loop_up(ptr,count,i)
  579.     var reg2 uintD* ptr;
  580.     var reg3 uintC count;
  581.     var reg4 uintC i;
  582.     { var reg1 uintDD accu = 0;
  583.       until (count==0)
  584.         { # Die oberen i Bits von (uintD)accu bilden hier den Übertrag.
  585.           accu = highlowDD_0(lowD(accu));
  586.           # Die oberen i Bits von (uintDD)accu bilden hier den Übertrag.
  587.           accu = (highlowDD_0(*ptr)>>i)+accu; *ptr++ = highD(accu);
  588.           count--;
  589.         }
  590.       return lowD(accu);
  591.     }
  592.   #else
  593.   local uintD shiftright_loop_up(ptr,count,i)
  594.     var reg2 uintD* ptr;
  595.     var reg3 uintC count;
  596.     var reg5 uintC i;
  597.     { var reg6 uintC j = intDsize-i;
  598.       var reg4 uintD carry = 0;
  599.       until (count==0)
  600.         { var reg1 uintD accu = *ptr;
  601.           *ptr++ = (accu >> i) | carry;
  602.           carry = accu << j;
  603.           count--;
  604.         }
  605.       return carry;
  606.     }
  607.   #endif
  608.  
  609. # Schiebeschleife um i Bits nach rechts:
  610. # übertrag = shiftrightsigned_loop_up(ptr,count,i);
  611. # schiebt count (uintC>0) Digits aufwärts von ptr um i Bits (0<i<intDsize)
  612. # nach rechts, wobei links das MSBit ver-i-facht wird,
  613. # und liefert den Übertrag (was rechts rauskommt, als Bits intDsize-1..intDsize-i).
  614.   local uintD shiftrightsigned_loop_up (uintD* ptr, uintC count, uintC i);
  615.   #if HAVE_DD
  616.   local uintD shiftrightsigned_loop_up(ptr,count,i)
  617.     var reg2 uintD* ptr;
  618.     var reg3 uintC count;
  619.     var reg4 uintC i;
  620.     { var reg1 uintDD accu = # Übertrag mit i Vorzeichenbits initialisieren
  621.                            highlowDD_0(sign_of_sintD((sintD)(*ptr)))>>i;
  622.       do { # Die oberen i Bits von (uintD)accu bilden hier den Übertrag.
  623.            accu = highlowDD_0(lowD(accu));
  624.            # Die oberen i Bits von (uintDD)accu bilden hier den Übertrag.
  625.            accu = (highlowDD_0(*ptr)>>i)+accu; *ptr++ = highD(accu);
  626.            count--;
  627.          }
  628.          until (count==0);
  629.       return lowD(accu);
  630.     }
  631.   #else
  632.   local uintD shiftrightsigned_loop_up(ptr,count,i)
  633.     var reg2 uintD* ptr;
  634.     var reg3 uintC count;
  635.     var reg5 uintC i;
  636.     { var reg6 uintC j = intDsize-i;
  637.       var reg4 uintD carry;
  638.       { var reg1 uintD accu = *ptr;
  639.         *ptr++ = (sintD)accu >> i;
  640.         carry = accu << j;
  641.         count--;
  642.       }
  643.       until (count==0)
  644.         { var reg1 uintD accu = *ptr;
  645.           *ptr++ = (accu >> i) | carry;
  646.           carry = accu << j;
  647.           count--;
  648.         }
  649.       return carry;
  650.     }
  651.   #endif
  652.  
  653. # Schiebe- und Kopier-Schleife um i Bits nach rechts:
  654. # übertrag = shiftrightcopy_loop_up(sourceptr,destptr,count,i,carry);
  655. # kopiert count (uintC>=0) Digits aufwärts von sourceptr nach destptr
  656. # und schiebt sie dabei um i Bits (0<i<intDsize) nach rechts, wobei carry
  657. # (sozusagen als sourceptr[-1]) die i Bits ganz links bestimmt,
  658. # und liefert den Übertrag (was rechts rauskommt, als Bits intDsize-1..intDsize-i).
  659.   local uintD shiftrightcopy_loop_up (uintD* sourceptr, uintD* destptr, uintC count, uintC i, uintD carry);
  660.   #if HAVE_DD
  661.   local uintD shiftrightcopy_loop_up(sourceptr,destptr,count,i,carry)
  662.     var reg2 uintD* sourceptr;
  663.     var reg2 uintD* destptr;
  664.     var reg3 uintC count;
  665.     var reg4 uintC i;
  666.     var reg5 uintD carry;
  667.     { var reg1 uintDD accu = # Übertrag mit carry initialisieren
  668.                            highlowDD_0(carry)>>i;
  669.       until (count==0)
  670.         { # Die oberen i Bits von (uintD)accu bilden hier den Übertrag.
  671.           accu = highlowDD_0(lowD(accu));
  672.           # Die oberen i Bits von (uintDD)accu bilden hier den Übertrag.
  673.           accu = (highlowDD_0(*sourceptr++)>>i)+accu; *destptr++ = highD(accu);
  674.           count--;
  675.         }
  676.       return lowD(accu);
  677.     }
  678.   #else
  679.   local uintD shiftrightcopy_loop_up(sourceptr,destptr,count,i,carry)
  680.     var reg2 uintD* sourceptr;
  681.     var reg2 uintD* destptr;
  682.     var reg3 uintC count;
  683.     var reg5 uintC i;
  684.     var reg4 uintD carry;
  685.     { var reg6 uintC j = intDsize-i;
  686.       carry = carry << j;
  687.       until (count==0)
  688.         { var reg1 uintD accu = *sourceptr++;
  689.           *destptr++ = (accu >> i) | carry;
  690.           carry = accu << j;
  691.           count--;
  692.         }
  693.       return carry;
  694.     }
  695.   #endif
  696.  
  697. # Multiplikations-Einfachschleife:
  698. # Multipliziert eine UDS mit einem kleinen Digit und addiert ein kleines Digit.
  699. # mulusmall_loop_down(digit,ptr,len,newdigit)
  700. # multipliziert die UDS  ptr[-len..-1]  mit digit (>=2, <=36),
  701. # addiert dabei newdigit (>=0, <digit) zur letzten Ziffer,
  702. # und liefert den Carry (>=0, <digit).
  703.   local uintD mulusmall_loop_down (uintD digit, uintD* ptr, uintC len, uintD newdigit);
  704.   #if HAVE_DD
  705.   local uintD mulusmall_loop_down(digit,ptr,len,newdigit)
  706.     var reg4 uintD digit;
  707.     var reg2 uintD* ptr;
  708.     var reg3 uintC len;
  709.     var reg5 uintD newdigit;
  710.     { var reg1 uintDD carry = newdigit;
  711.       until (len==0)
  712.         { # Hier ist 0 <= carry < digit.
  713.           carry = carry + muluD(digit,*--ptr);
  714.           # Hier ist 0 <= carry < 2^intDsize*digit.
  715.           *ptr = lowD(carry);
  716.           carry = (uintDD)highD(carry); # carry := floor(carry/2^intDsize) < digit
  717.           len--;
  718.         }
  719.       return lowD(carry);
  720.     }
  721.   #else
  722.   local uintD mulusmall_loop_down(digit,ptr,len,newdigit)
  723.     var reg6 uintD digit;
  724.     var reg1 uintD* ptr;
  725.     var reg5 uintC len;
  726.     var reg7 uintD newdigit;
  727.     { var reg4 uintD carry = newdigit;
  728.       until (len==0)
  729.         { # Hier ist 0 <= carry < digit.
  730.           var reg3 uintD hi;
  731.           var reg2 uintD lo;
  732.           muluD(digit,*--ptr,hi=,lo=);
  733.           # Hier ist 0 <= 2^intDsize*hi + lo + carry < 2^intDsize*digit.
  734.           lo += carry; if (lo < carry) { hi += 1; }
  735.           *ptr = lo;
  736.           carry = hi;
  737.           len--;
  738.         }
  739.       return carry;
  740.     }
  741.   #endif
  742.  
  743. # Multiplikations-Einfachschleife:
  744. # Multipliziert eine UDS mit einem Digit und legt das Ergebnis in einer
  745. # zweiten UDS ab.
  746. # mulu_loop_down(digit,sourceptr,destptr,len);
  747. # multipliziert die UDS  sourceptr[-len..-1]  (len>0)
  748. # mit dem einzelnen  digit
  749. # und legt das Ergebnis in der UDS  destptr[-len-1..-1]  ab.
  750.   local void mulu_loop_down (uintD digit, uintD* sourceptr, uintD* destptr, uintC len);
  751.   #if HAVE_DD
  752.   local void mulu_loop_down(digit,sourceptr,destptr,len)
  753.     var reg4 uintD digit;
  754.     var reg2 uintD* sourceptr;
  755.     var reg2 uintD* destptr;
  756.     var reg3 uintC len;
  757.     { var reg1 uintDD carry = 0;
  758.       do { # Hier ist carry=digit=0 oder 0 <= carry < digit.
  759.            carry = carry + muluD(digit,*--sourceptr);
  760.            # Hier ist carry=digit=0 oder 0 <= carry < 2^intDsize*digit.
  761.            *--destptr = lowD(carry);
  762.            carry = (uintDD)highD(carry); # carry := floor(carry/2^intDsize) < digit
  763.            len--;
  764.          }
  765.          until (len==0);
  766.       *--destptr = lowD(carry);
  767.     }
  768.   #else
  769.   local void mulu_loop_down(digit,sourceptr,destptr,len)
  770.     var reg6 uintD digit;
  771.     var reg1 uintD* sourceptr;
  772.     var reg1 uintD* destptr;
  773.     var reg5 uintC len;
  774.     { var reg4 uintD carry = 0;
  775.       do { # Hier ist carry=digit=0 oder 0 <= carry < digit.
  776.            var reg3 uintD hi;
  777.            var reg2 uintD lo;
  778.            muluD(digit,*--sourceptr,hi=,lo=);
  779.            # Hier ist 0 <= 2^intDsize*hi + lo + carry < 2^intDsize*digit oder hi=lo=carry=digit=0.
  780.            lo += carry; if (lo < carry) { hi += 1; }
  781.            *--destptr = lo;
  782.            carry = hi;
  783.            len--;
  784.          }
  785.          until (len==0);
  786.       *--destptr = carry;
  787.     }
  788.   #endif
  789.  
  790. # Multiplikations-Einfachschleife mit Akkumulation:
  791. # Multipliziert eine UDS mit einem Digit und addiert das Ergebnis zu einer
  792. # zweiten UDS auf.
  793. # muluadd_loop_down(digit,sourceptr,destptr,len);
  794. # multipliziert die UDS  sourceptr[-len..-1]  (len>0)
  795. # mit dem einzelnen digit, legt das Ergebnis in der UDS  destptr[-len..-1]
  796. # ab und liefert den weiteren Übertrag.
  797.   local uintD muluadd_loop_down (uintD digit, uintD* sourceptr, uintD* destptr, uintC len);
  798.   #if HAVE_DD
  799.   local uintD muluadd_loop_down(digit,sourceptr,destptr,len)
  800.     var reg4 uintD digit;
  801.     var reg2 uintD* sourceptr;
  802.     var reg2 uintD* destptr;
  803.     var reg3 uintC len;
  804.     { var reg1 uintDD carry = 0;
  805.       if (!(digit==0))
  806.         { do { # Hier ist 0 <= carry <= digit.
  807.                carry = carry + muluD(digit,*--sourceptr) + (uintDD)*--destptr;
  808.                # Hier ist 0 <= carry <= 2^intDsize*digit + 2^intDsize-1.
  809.                *destptr = lowD(carry);
  810.                carry = (uintDD)highD(carry); # carry := floor(carry/2^intDsize) <= digit
  811.                len--;
  812.              }
  813.              until (len==0);
  814.         }
  815.       return lowD(carry);
  816.     }
  817.   #else
  818.   local uintD muluadd_loop_down(digit,sourceptr,destptr,len)
  819.     var reg6 uintD digit;
  820.     var reg1 uintD* sourceptr;
  821.     var reg1 uintD* destptr;
  822.     var reg5 uintC len;
  823.     { var reg4 uintD carry = 0;
  824.       if (!(digit==0))
  825.         { do { # Hier ist 0 <= carry <= digit.
  826.                var reg3 uintD hi;
  827.                var reg2 uintD lo;
  828.                muluD(digit,*--sourceptr,hi=,lo=);
  829.                # Hier ist 0 <= 2^intDsize*hi + lo + carry + *--destptr <= 2^intDsize*digit+2^intDsize-1.
  830.                lo += carry; if (lo < carry) { hi += 1; }
  831.                carry = *--destptr;
  832.                lo += carry; if (lo < carry) { hi += 1; }
  833.                *destptr = lo;
  834.                carry = hi;
  835.                len--;
  836.              }
  837.              until (len==0);
  838.         }
  839.       return carry;
  840.     }
  841.   #endif
  842.  
  843. # Multiplikations-Einfachschleife mit Diminution:
  844. # Multipliziert eine UDS mit einem Digit und subtrahiert das Ergebnis von
  845. # einer zweiten UDS.
  846. # mulusub_loop_down(digit,sourceptr,destptr,len);
  847. # multipliziert die UDS  sourceptr[-len..-1]  (len>0)  mit dem einzelnen
  848. # digit, subtrahiert das Ergebnis von der UDS  destptr[-len..-1]  und liefert
  849. # den weiteren Übertrag (>=0, evtl. von destptr[-len-1] zu subtrahieren).
  850.   local uintD mulusub_loop_down (uintD digit, uintD* sourceptr, uintD* destptr, uintC len);
  851.   #if HAVE_DD
  852.   local uintD mulusub_loop_down(digit,sourceptr,destptr,len)
  853.     var reg4 uintD digit;
  854.     var reg2 uintD* sourceptr;
  855.     var reg2 uintD* destptr;
  856.     var reg3 uintC len;
  857.     { var reg1 uintDD carry = 0;
  858.       if (!(digit==0))
  859.         { do { # Hier ist 0 <= carry <= digit.
  860.                carry = carry + muluD(digit,*--sourceptr) + (uintD)(~(*--destptr));
  861.                # Hier ist 0 <= carry <= 2^intDsize*digit + 2^intDsize-1.
  862.                *destptr = ~lowD(carry);
  863.                carry = (uintDD)highD(carry); # carry := floor(carry/2^intDsize) <= digit
  864.                # Hier ist 0 <= carry <= digit.
  865.                len--;
  866.              }
  867.              until (len==0);
  868.           return lowD(carry);
  869.         }
  870.         else
  871.         return 0; # nichts zu subtrahieren -> kein Übertrag
  872.     }
  873.   #else
  874.   local uintD mulusub_loop_down(digit,sourceptr,destptr,len)
  875.     var reg6 uintD digit;
  876.     var reg1 uintD* sourceptr;
  877.     var reg1 uintD* destptr;
  878.     var reg5 uintC len;
  879.     { var reg4 uintD carry = 0;
  880.       if (!(digit==0))
  881.         { do { # Hier ist 0 <= carry <= digit.
  882.                var reg3 uintD hi;
  883.                var reg2 uintD lo;
  884.                muluD(digit,*--sourceptr,hi=,lo=);
  885.                # Hier ist 0 <= 2^intDsize*hi + lo + carry + ~(*--destptr) <= 2^intDsize*digit+2^intDsize-1.
  886.                lo += carry; if (lo < carry) { hi += 1; }
  887.                carry = *--destptr;
  888.                *destptr = carry - lo; if (carry < lo) { hi += 1; }
  889.                carry = hi;
  890.                len--;
  891.              }
  892.              until (len==0);
  893.           return carry;
  894.         }
  895.         else
  896.         return 0; # nichts zu subtrahieren -> kein Übertrag
  897.     }
  898.   #endif
  899.  
  900. # Divisions-Einfachschleife:
  901. # Dividiert eine UDS durch ein Digit.
  902. # divu_loop_up(digit,ptr,len)
  903. # dividiert die UDS  ptr[0..len-1] durch digit,
  904. # legt das Ergebnis in derselben UDS ab, und liefert den Rest (>=0, <digit).
  905.   local uintD divu_loop_up (uintD digit, uintD* ptr, uintC len);
  906.   #if HAVE_DD
  907.   local uintD divu_loop_up(digit,ptr,len)
  908.     var reg4 uintD digit;
  909.     var reg1 uintD* ptr;
  910.     var reg3 uintC len;
  911.     { var reg2 uintD rest = 0;
  912.       until (len==0)
  913.         { divuD(highlowDD(rest,*ptr),digit,*ptr =, rest =); ptr++; len--; }
  914.       return rest;
  915.     }
  916.   #else
  917.   local uintD divu_loop_up(digit,ptr,len)
  918.     var reg4 uintD digit;
  919.     var reg1 uintD* ptr;
  920.     var reg3 uintC len;
  921.     { var reg2 uintD rest = 0;
  922.       until (len==0)
  923.         { divuD(rest,*ptr,digit,*ptr =, rest =); ptr++; len--; }
  924.       return rest;
  925.     }
  926.   #endif
  927.  
  928. # Divisions-Einfachschleife:
  929. # Dividiert eine UDS durch ein Digit und legt das Ergebnis in einer
  930. # zweiten UDS ab.
  931. # divucopy_loop_up(digit,sourceptr,destptr,len)
  932. # dividiert die UDS  sourceptr[0..len-1]  durch digit,
  933. # legt das Ergebnis in der UDS  destptr[0..len-1]  ab,
  934. # und liefert den Rest (>=0, <digit).
  935.   local uintD divucopy_loop_up (uintD digit, uintD* sourceptr, uintD* destptr, uintC len);
  936.   #if HAVE_DD
  937.   local uintD divucopy_loop_up(digit,sourceptr,destptr,len)
  938.     var reg5 uintD digit;
  939.     var reg3 uintD* sourceptr;
  940.     var reg2 uintD* destptr;
  941.     var reg4 uintC len;
  942.     { var reg1 uintD rest = 0;
  943.       until (len==0)
  944.         { divuD(highlowDD(rest,*sourceptr++),digit,*destptr++ =, rest =); len--; }
  945.       return rest;
  946.     }
  947.   #else
  948.   local uintD divucopy_loop_up(digit,sourceptr,destptr,len)
  949.     var reg5 uintD digit;
  950.     var reg3 uintD* sourceptr;
  951.     var reg2 uintD* destptr;
  952.     var reg4 uintC len;
  953.     { var reg1 uintD rest = 0;
  954.       until (len==0)
  955.         { divuD(rest,*sourceptr++,digit,*destptr++ =, rest =); len--; }
  956.       return rest;
  957.     }
  958.   #endif
  959.  
  960.