home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / bcpl / BCPL / b / cgi < prev    next >
Encoding:
Text File  |  1988-05-09  |  10.4 KB  |  417 lines
  1. SECTION "CGI"
  2.  
  3. GET "b.CGheader"
  4.  
  5. STATIC {
  6.  /* Version of 11 Sep 87 13:41:44
  7.  */
  8.    dummy = VersionMark;
  9.    version = 1*256+7 };
  10.  
  11. STATIC {
  12.    deferredShift = 0;
  13.    secondOp = 0;
  14.    secondMultiplier = 0;
  15.    thirdMultiplier = 0;
  16.    registerForMultiply = 0 }
  17.  
  18. LET LowBit(n) = n & (-n)
  19.  
  20. AND DivByPowerOf2Minus1(n) = VALOF
  21. {  LET t = TABLE     #x7fffff, #x3fffff, #x1fffff,
  22.         #xfffff,  #x7ffff,  #x3ffff,  #x1ffff,
  23.          #xffff,   #x7fff,   #x3fff,   #x1fff,
  24.           #xfff,    #x7ff,    #x3ff,    #x1ff,
  25.            #xff,     #x7f,     #x3f,     #x1f,
  26.             #xf,      #x7,    #x3,        0;
  27.    LET i = 0;
  28.    LET x = ?;
  29.    {  x := t!i;
  30.       IF x=0 THEN RESULTIS Null;
  31.       IF (n REM x)=0 THEN RESULTIS x
  32.       i := i+1
  33.    } REPEAT
  34. }
  35.  
  36. AND DivByPowerOf2Plus1(n) = VALOF
  37. {  LET t = TABLE     #x400001, #x200001, #x100001,
  38.         #x80001,  #x40001,  #x20001,  #x10001,
  39.          #x8001,   #x4001,   #x2001,   #x1001,
  40.           #x801,    #x401,    #x201,    #x101,
  41.            #x81,     #x41,     #x21,     #x11,
  42.             #x9,      #x5,      0;
  43.    LET i = 0;
  44.    LET x = ?
  45.    {  x := t!i;
  46.       IF x=0 THEN RESULTIS Null;
  47.       IF (n REM x)=0 THEN RESULTIS x
  48.       i := i+1
  49.    } REPEAT
  50. }
  51.  
  52. AND IsPowerOf2(n) = n>0 & LowBit(n)=n
  53.  
  54. AND IsSimpleMultiply(k) = IsPowerOf2(k) |
  55.               IsPowerOf2(k+1) |
  56.               IsPowerOf2(k-1)
  57.  
  58. AND FindSourceAndDestinationRegisters(lvs, x, mustBeDistinct) = VALOF
  59. {  LET s = IsInARegister(x);
  60.    LET nextop = PeekN();
  61.    LET r = nextop=s.res | nextop=s.fnrn -> 1,
  62.            1<=argumentNumber<=4 -> ArgumentRegister(argumentNumber),
  63.                       -1;
  64.    argumentNumber := Null;
  65.    TEST s=Null | (h1!x=k.loc & h3!x>=ssp-2) | h1!x=k.reg THEN {
  66.       IF r>0 & mustBeDistinct THEN Lock(r, k.reg);
  67.       s := MoveToAnyR(x); Lock(s, k.reg);
  68.       IF r<0 THEN
  69.      TEST mustBeDistinct THEN
  70.         r := NextR()
  71.      ELSE
  72.         r := s }
  73.    ELSE {
  74.       TEST r=s & mustBeDistinct THEN {
  75.      Lock(r, k.reg); s := MoveToAnyR(x) }
  76.       ELSE
  77.      MoveToR(s, x);
  78.       IF r<0 THEN r := NextR() };
  79.    FlushPendingUsesOfReg(r);
  80.    !lvs := s;
  81.    RESULTIS r
  82. }
  83.  
  84. AND DoTwoSimpleMultiplies(x, m, n) BE
  85. {  LET s = ?;
  86.    LET r = FindSourceAndDestinationRegisters(@s, x, FALSE);
  87.    registerForMultiply := r;
  88.    SimpleMultiply(r, n, s, FALSE);
  89.    SimpleMultiply(r, m, r, TRUE)
  90. }
  91.  
  92. AND FRandShiftedR(f, r, s, t, k) BE
  93.    F1Inst(f, r, s, t, 0, sh.asl, LogBase2(k), m.always)
  94.  
  95. AND MultiplyBySumOrDifferenceOfPowers(f, x, n, k) BE
  96. {  LET s = ?;
  97.    LET r = FindSourceAndDestinationRegisters(@s, x, TRUE);
  98.    registerForMultiply := r;
  99.    SimpleMultiply(r, n, s, FALSE);
  100.    FRandShiftedR(f, r, r, s, k);
  101.    Unlock(s, k.reg)
  102. }
  103.  
  104.  
  105. AND TwoInstructionMultiply(k, x) = VALOF
  106. {  LET bottombit = LowBit(k);
  107.    LET n = ?;
  108.  
  109.    IF bottombit~=1 THEN {
  110.       n := k/bottombit;
  111.       IF IsSimpleMultiply(n) THEN {  // multiplier is 2^n * (2^m+-1)
  112.      DoTwoSimpleMultiplies(x, bottombit, n);
  113.      RESULTIS TRUE } };
  114.  
  115.    n := DivByPowerOf2Minus1(k);
  116.    IF n~=Null THEN
  117.    {  LET m = k/n;
  118.       IF IsSimpleMultiply(m) THEN {  // multiplier is (2^n-1)(2^m+-1)
  119.      DoTwoSimpleMultiplies(x, n, m);
  120.      RESULTIS TRUE } };
  121.  
  122.    n := DivByPowerOf2Plus1(k);
  123.    IF n~=Null THEN {
  124.       LET m = k/n;
  125.       IF IsSimpleMultiply(m) THEN {  // multiplier is (2^n+1)(2^m+1)
  126.      DoTwoSimpleMultiplies(x, n, m)
  127.      RESULTIS TRUE } };
  128.  
  129.    n := IsSumOfPowers(k, 2);
  130.    IF n~=Null THEN {  // multiplier is 2^n+2^m+-1
  131.       // 2^n+2^m is of course detected earlier
  132.       MultiplyBySumOrDifferenceOfPowers(f.add, x, n, k-n);
  133.       RESULTIS TRUE };
  134.  
  135.    n := IsDifferenceOfPowers(k, 2);
  136.    IF n~=Null THEN {  // multiplier is 2^n-2^m+-1
  137.       MultiplyBySumOrDifferenceOfPowers(f.rsb, x, n, k+n);
  138.       RESULTIS TRUE };
  139.  
  140.    RESULTIS FALSE
  141. }
  142.  
  143.  
  144. AND IsSumOrDifferenceOfPowersOf2(k) = VALOF
  145. {  LET bottombit = LowBit(k);
  146.    LET n = k-bottombit;
  147.  
  148.    IF IsPowerOf2(n) THEN {
  149.       secondOp := f.add;
  150.       secondMultiplier := bottombit;
  151.       thirdMultiplier := n;
  152.       RESULTIS TRUE };
  153.  
  154.    n := k+bottombit;
  155.    IF IsPowerOf2(n) THEN {
  156.       secondOp := f.rsb;
  157.       secondMultiplier := bottombit;
  158.       thirdMultiplier := n;
  159.       RESULTIS TRUE };
  160.  
  161.    RESULTIS FALSE
  162. }
  163.  
  164. AND IsSumOfPowers(k, p) = VALOF
  165. {  LET n = LowBit(k-1)+1;
  166.    LET m = LowBit(k+1)-1;
  167.  
  168.    RESULTIS      IsPowerOf2(k-n) -> n,
  169.           IsPowerOf2(k-m) -> m,
  170.                   p=2 -> Null,
  171. IsSumOrDifferenceOfPowersOf2(k-n) -> n,
  172. IsSumOrDifferenceOfPowersOf2(k-m) -> m,
  173.                      Null
  174. }
  175.  
  176. AND IsDifferenceOfPowers(k, p) = VALOF
  177. {  LET n = LowBit(k+1)+1;
  178.    LET m = LowBit(k-1)-1;
  179.  
  180.    RESULTIS      IsPowerOf2(k+n) -> n,
  181.           IsPowerOf2(k+m) -> m,
  182.                   p=2 -> Null,
  183. IsSumOrDifferenceOfPowersOf2(k+n) -> n,
  184. IsSumOrDifferenceOfPowersOf2(k+m) -> m,
  185.                      Null
  186. }
  187.  
  188. AND SimpleMultiply(res, k, r, deferShift) BE
  189.    TEST IsPowerOf2(k) THEN
  190.       TEST res=r & deferShift THEN
  191.      deferredShift := sh.asl*32+LogBase2(k)
  192.       ELSE
  193.      ShiftRegisterDS(res, r, sh.asl, LogBase2(k))
  194.    ELSE TEST IsPowerOf2(k+1)
  195.       THEN FRandShiftedR(f.rsb, res, r, r, k+1)
  196.    ELSE TEST IsPowerOf2(k-1)
  197.       THEN FRandShiftedR(f.add, res, r, r, k-1)
  198.       ELSE CGError(FALSE, "SimpleMultiply wrongly called (k=%n)", k)
  199.  
  200.  
  201. AND CGMult() BE
  202. {  LET a, b = arg1, arg2;
  203.    IF Class(arg1, TRUE) < Class(arg2, TRUE) THEN
  204.       a, b := arg2, arg1;
  205.    deferredShift := Null;
  206.    IF IsConst(a) THEN {
  207.       LET k = h3!a;
  208.       LET r = Null;
  209.       TEST k=0 | IsConst(b) THEN {
  210.      LET k2 = h3!b;
  211.      Stack(ssp-2);
  212.      Load(k.number, k*k2);
  213.      RETURN }
  214.  
  215.       ELSE TEST k=1 THEN
  216.       {  LET t, ind, n, k = h1!b, h2!b, h3!b, h4!b;
  217.      Stack(ssp-1);
  218.      h1!arg1, h2!arg1, h3!arg1, h4!arg1 := t, ind, n, k;
  219.      RETURN }
  220.  
  221.       ELSE TEST IsSimpleMultiply(k) THEN {  // multipler is 2^n[+-1]
  222.      LET s = ?;
  223.      r := FindSourceAndDestinationRegisters(@s, b, FALSE);
  224.      SimpleMultiply(r, k, s, TRUE);
  225.      UnLock(s, k.reg) }
  226.  
  227.       ELSE TEST TwoInstructionMultiply(k, b) THEN
  228.      r := registerForMultiply
  229.  
  230.       ELSE TEST (k&1)=0 & TwoInstructionMultiply(k/LowBit(k), b) THEN {
  231.      r := registerForMultiply;
  232.      SimpleMultiply(r, LowBit(k), r, TRUE) }
  233.  
  234.       ELSE {
  235.      LET n = DivByPowerOf2minus1(k);
  236.      IF n~=Null & TwoInstructionMultiply(k/n, b) THEN {
  237.         r := registerForMultiply;
  238.         SimpleMultiply(r, n, r, FALSE);
  239.         GOTO done };
  240.  
  241.      n := DivByPowerOf2plus1(k);
  242.      IF n~=Null & TwoInstructionMultiply(k/n, b) THEN {
  243.         r := registerForMultiply;
  244.         SimpleMultiply(r, n, r, FALSE);
  245.         GOTO done };
  246.  
  247.      n := IsSumOfPowers(k, 3);
  248.      IF n~=Null THEN {
  249.         LET s = ?;
  250.         LET r = FindSourceAndDestinationRegisters(@s, b, TRUE);
  251.         SimpleMultiply(r, n, s, FALSE);
  252.         FRandShiftedR(secondOp, r, r, s, secondMultiplier)
  253.         FRandShiftedR(secondOp, r, r, s, thirdMultiplier)
  254.         Unlock(r, k.reg); Unlock(s, k.reg);
  255.         GOTO done };
  256.  
  257.      n := IsDifferenceOfPowers(k, 3);
  258.      IF n~=Null THEN {
  259.         LET s = ?;
  260.         LET r = FindSourceAndDestinationRegisters(@s, b, TRUE);
  261.         SimpleMultiply(r, n, s, FALSE);
  262.         FRandShiftedR((secondOp=f.rsb -> f.add, f.rsb),
  263.               r, r, s, secondMultiplier)
  264.         FRandShiftedR(secondOp, r, r, s, thirdMultiplier)
  265.         Unlock(r, k.reg); Unlock(s, k.reg) } };
  266.  
  267. done:
  268.       IF r~=Null THEN
  269.       {  LoseR(r, deferredShift);
  270.      RETURN } };
  271.  
  272.    {  LET s = ?;
  273.       LET r = FindSourceAndDestinationRegisters(@s, b, FALSE);
  274.       LET r2 = ?;
  275.       FlushPendingUsesOfReg(r);
  276.       Lock(s, k.reg);
  277.       r2 := MoveToAnyCR(a);
  278.       IF r = r2 = s THEN {
  279.      r2 := NextR();
  280.      MoveToR(r2, a) };
  281.       IF r=s THEN { LET temp = s; s := r2; r2 := temp };
  282.       MultiplyInst(f.mul, r, s, r2, 0);
  283.       Lose(r, k.reg);
  284.       UnLock(s, k.reg) }
  285. }
  286.  
  287. AND CallArithmeticRoutine(offset, a1, a2, res) BE
  288. {  MoveToR(ArgumentRegister(1), a1);
  289.    MoveToR(ArgumentRegister(2), a2);
  290.    FlushPendingUsesOfReg(ArgumentRegister(1));
  291.    FlushPendingUsesOfReg(ArgumentRegister(2));
  292.    FlushPendingUsesOfReg(r.14);
  293.    TEST CompactCode THEN
  294.       F5InstL(m.always, (offset=sr.multiply -> MultLab, QuotLab), f.bl)
  295.    ELSE
  296.       CallSub(offset);
  297.    DiscardReg(ArgumentRegister(1), k.reg);
  298.    DiscardReg(ArgumentRegister(2), k.reg);
  299.    DiscardReg(r.14, k.reg);
  300.    Lose(ArgumentRegister(res), k.reg)
  301. }
  302.  
  303. AND CGMinus() BE
  304.    TEST IsConst(arg1) THEN {
  305.       h3!arg1 := -h3!arg1;
  306.       CGPlus() }
  307.    ELSE {
  308.       LET f, x, y = f.sub, arg1, arg2;
  309.       LET r, s = ?, ?;
  310.       IF Class(x, TRUE) < Class(y, TRUE) THEN
  311.      f, x, y := f.rsb, arg2, arg1;
  312.       r := FindSourceAndDestinationRegisters(@s, y, FALSE);
  313.       GenFDS(f, r, s, x);
  314.       Lose(r, k.reg);
  315.       UnLock(s, k.reg) }
  316.  
  317. AND CGPlus() BE
  318. {  IF Isconst(arg2) THEN
  319.       SwapSS(arg1, arg2);
  320.  
  321.    IF IsConst(arg1) & h1!arg2~=k.shreg THEN
  322.    {  LET k = h3!arg1;
  323.       IF k~=0 THEN
  324.       {  IF h2!arg2>=0 THEN MoveToAnyR(arg2);
  325.      h4!arg2 := h4!arg2+k };
  326.       IsConst(arg2);
  327.       Stack(ssp-1);
  328.       RETURN };
  329.  
  330.    {  LET NextOp = PeekN();
  331.       TEST NextOp=s.rv THEN {
  332.      CGVecap(); RETURN }
  333.       ELSE IF NextOp=s.stind THEN {
  334.      CGVecSt(); RETURN } };
  335.  
  336.    {  LET x, y = arg1, arg2;
  337.       LET r, s = ?, ?;
  338.       LET k = 0;
  339.       IF h2!arg1<0 & h1!arg1~=k.shreg THEN {  k := h4!arg1; h4!arg1 := 0 };
  340.       IF h2!arg2<0 & h1!arg2~=k.shreg THEN {  k := k+h4!arg2; h4!arg2 := 0 };
  341.       IF Class(x, TRUE)<Class(y, TRUE)
  342.      THEN x, y := arg2, arg1;
  343.       r := FindSourceAndDestinationRegisters(@s, y, FALSE);
  344.       GenFDS(f.add, r, s, x);
  345.       Lose(r, k.reg);
  346.       h4!arg1 := k;
  347.       UnLock(s, k.reg) }
  348. }
  349.  
  350. AND CGDiv() BE
  351. {  IF IsConst(arg1) THEN
  352.    {  LET n = h3!arg1;
  353.       IF n=1 THEN {
  354.      Stack(ssp-1);
  355.      RETURN };
  356.  
  357.       IF n=0 THEN {
  358.      CGError(FALSE, "Compiling division by zero");
  359.      Stack(ssp-2);
  360.      Load(k.number, 0);
  361.      RETURN };
  362.  
  363.       IF IsConst(arg2) THEN
  364.       {  LET k = h3!arg2;
  365.      Stack(ssp-2);
  366.      Load(k.number, k/n);
  367.      RETURN };
  368.  
  369.       IF [n&(-n)]=n THEN
  370.       {  LET s = ?;
  371.      LET r = FindSourceAndDestinationRegisters(@s, arg2, FALSE);
  372.      GenRR(f.movs, r, 0, s);
  373.      TEST n=2 THEN {
  374.         F1Inst(f.sub, r, s, s, 0, sh.asr, 1, m.mi)
  375.         F1Inst(f.mov, r, 0, s, 0, sh.asr, 1, m.pl) }
  376.      ELSE {
  377.         F1Inst(f.rsb, r, r, Null, 0, Null, 0, m.mi);
  378.         ShiftRegisterDS(r, r, sh.asr, LogBase2(n));
  379.         F1Inst(f.rsb, r, r, Null, 0, Null, 0, m.mi) };
  380.      LoseR(r, Null);
  381.      UnLock(s, k.reg);
  382.      RETURN } };
  383.  
  384.    CallArithmeticRoutine(sr.quotrem, arg2, arg1, 1)
  385. }
  386.  
  387. AND CGRem() BE
  388. {  IF IsConst(arg1) THEN
  389.    {  LET n = h3!arg1;
  390.       LET lowbit = n & (-n);
  391.  
  392.       IF n=1 | IsConst(arg2) THEN {
  393.      LET k = h3!arg2;
  394.      Stack(ssp-2);
  395.      Load(k.number, k REM n);
  396.      RETURN };
  397.  
  398.       IF n=0 THEN {
  399.      CGError(FALSE, "Compiling division by zero");
  400.      Stack(ssp-2);
  401.      Load(k.number, 0);
  402.      RETURN };
  403.  
  404.       IF lowbit=n THEN
  405.       {  LET s = ?;
  406.      LET r = FindSourceAndDestinationRegisters(@s, arg2, FALSE);
  407.      h3!arg1 := n-1;
  408.      CompareAgainstK(s, 0, m.lt);
  409.      GenFDS(f.and, r, s, arg1);
  410.      F1Inst(f.sub, r, r, Null, n, Null, 0, m.lt);
  411.      Lose(r, k.reg);
  412.      UnLock(s, k.reg);
  413.      RETURN } };
  414.  
  415.    CallArithmeticRoutine(sr.quotrem, arg2, arg1, 2)
  416. }
  417.