home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / SIMTEL / CPMUG / CPMUG023.ARK / STOICINT.STC < prev    next >
Text File  |  1984-04-29  |  4KB  |  151 lines
  1.  
  2.  
  3.  
  4. % ***************************************************************************
  5. % ** COPYRIGHT (C) MASSACHUSETTS INSTITUTE OF TECHNOLOGY AND HARVARD       **
  6. % ** UNIVERSITY, BIOMEDICAL ENGINEERING CENTER 1977.  ALL RIGHTS RESERVED. **
  7. % ***************************************************************************
  8.  
  9. % DOUBLE PRECISION INTEGER ARITHMETIC PACKAGE
  10. % J. SACHS 3/4/77
  11.  
  12. % ON THE STACK, MOST SIGNIFICANT WORD IS AT TOP
  13. % LEAST SIGNIFICANT WORD IS AT TOP - 1
  14. %
  15. % IN MEMORY, MOST SIGNIFICANT WORD IS AT ADDRESS
  16. % LEAST SIGNIFICANT WORD IS AT ADDRESS + 2
  17.  
  18. RADIX @ OCTAL
  19.  
  20. % DOUBLE WORD STORE
  21. 'D! CODE<  H POP,  B POP,  D POP,  C M MOV,  H INX,  B M MOV,
  22.   H INX,  E M MOV,  H INX,  D M MOV,  NEXT JMP, >
  23.  
  24. % DOUBLE WORD LOAD
  25. 'D@ CODE<  H POP,  M C MOV,  H INX,  M B MOV,  H INX,
  26.   M E MOV,  H INX,  M D MOV,  D PUSH,  B PUSH,  NEXT JMP, >
  27.  
  28. % DOUBLE PRECISION LITERAL
  29. 'D() CODE<  .I LHLD,  H INX,  H INX,  M C MOV,  H INX,  M B MOV,  H INX,
  30.   .I SHLD,  M E MOV,  H INX,  M D MOV,  D PUSH,  B PUSH,  NEXT JMP,  >
  31.  
  32. % DOUBLE WORD ADD
  33. 'D+ CODE<  H POP,  B POP,  D POP,  D DAD,  XCHG,  H POP,  B DAD,
  34.   IFNC,  D INX,  THEN,  H PUSH,  D PUSH,  NEXT JMP,  >
  35.  
  36. % DOUBLE WORD NEGATE
  37. 'DMINUS CODE<  H POP,  D POP,  -HLDE CALL,  DPUSH JMP,  >
  38.  
  39. % DOUBLE WORD SUBTRACT
  40. 'D- : DMINUS D+ ;
  41.  
  42. % DOUBLE PRECISION CONSTANT AND VARIABLE DEFINITIONS
  43. 'DCONSTANT : CONSTANT , ;CODE<  XCHG,  () D@ 1+ JMP,  >
  44. 'DVARIABLE : VARIABLE , ;
  45.  
  46. % DOUBLE PRECISION ABSOLUTE VALUE
  47. 'DABS CODE<  H POP,  D POP,  H A MOV,  A ORA,  -HLDE CM,  DPUSH JMP,  >
  48.  
  49. % EXTEND SINGLE TO DOUBLE WORD
  50. 'EXTEND CODE<  D POP,  D PUSH,  D A MOV,  A ORA,  0PUSH JP,  -1PUSH JMP,  >
  51.  
  52. % DOUBLE PRECISIONS COMPARISONS WITH ZERO
  53.  
  54. 'DEQZ CODE<  H POP,  D POP,  H A MOV,  .  L ORA,  D ORA,  E ORA,
  55.   -1PUSH JZ,  0PUSH JMP,  >
  56. 'DLEZ CODE<  H POP,  D POP,  H A MOV,  A ORA,  -1PUSH JM,  JMP,  >
  57.  
  58. 'DNEZ CODE<  H POP,  D POP,  H A MOV,  .  L ORA,  D ORA,  E ORA,
  59.   0PUSH JZ,  -1PUSH JMP,  >
  60. 'DGTZ CODE<  H POP,  D POP,  H A MOV,  A ORA,  -1PUSH JP,  JMP,  >
  61.  
  62. 'DLTZ CODE<  H POP,  D POP,  H A MOV,  A ORA,  -1PUSH JM,  0PUSH JMP,  >
  63. 'DGEZ CODE<  H POP,  D POP,  H A MOV,  A ORA,  -1PUSH JP,  0PUSH JMP,  >
  64.  
  65. % DOUBLE PRECISION COMPARISONS
  66.  
  67. 'DEQ : D- DEQZ ;
  68. 'DNE : D- DNEZ ;
  69. 'DLT : D- DLTZ ;
  70. 'DLE : D- DLEZ ;
  71. 'DGE : D- DGEZ ;
  72. 'DGT : D- DGTZ ;
  73.  
  74. % DOUBLE PRECISION NUMBER CONVERSION PACKAGE
  75.  
  76. % DIVIDE DOUBLE PRECISION NUMBER BY SINGLE PRECISION NUMBER
  77. % YIELDING A DOUBLE PRECISION QUOTIENT AND A SINGLE PRECISION REMAINDER
  78. 'UE/MOD : DUP <L U/MOD 2SWAP L> UM/MOD 2SWAP ;
  79.  
  80. % INITIATE AND TERMINATE NUMBER CONVERSION
  81. 'D<# : <# ;
  82. 'D#> : DROP #> ;
  83.  
  84. % CONVERT NEXT DIGIT
  85. 'D# : RADIX @ UE/MOD #A #PUT ;
  86.  
  87. % CONVERT DIGITS UNTIL RESULT IS ZERO
  88. 'D#S : BEGIN D# DDUP DEQZ END ;
  89.  
  90. % UNSIGNED CONVERT
  91. 'DU<#> : D<# D#S D#> ;
  92.  
  93. % UNSIGNED CONVERT AND TYPE
  94. 'DU= : DU<#> TYPE SPACE ;
  95.  
  96. % TYPE UNSIGNED NUMBER ADDRESSED BY TOP
  97. 'DU? : D@ DU= ;
  98.  
  99. % SIGNED NUMBER CONVERT
  100. 'D<#> : DDUP <L <L DABS D<# D#S L> L> DLTZ IF 55 #PUT THEN D#> ;
  101.  
  102. % SIGNED NUMBER CONVERT AND TYPE
  103. 'D= : D<#> TYPE SPACE ;
  104.  
  105. % TYPE SIGNED NUMBER ADDRESSED BY TOP
  106. 'D? : D@ D= ;
  107.  
  108. % DOUBLE PRECISION LITERAL PROCESSOR
  109.  
  110. . ASSEMBLER<
  111.   T1 4 + LHLD,  M A MOV,  H INX,  T1 4 + SHLD,  RET,
  112. 'LITG CONSTANT
  113.  
  114. 'DILITERAL CODE<
  115.   H POP,  H INX,  T1 4 + SHLD,  0 H LXI,  T1 2 + SHLD,  T1 6 + SHLD,
  116.   T1 10 + SHLD,  LITG CALL,  104 CPI,  0PUSH JNZ,
  117.   LITG CALL,  53 CPI,  IFZ,  55 CPI,  IFNZ,  -1 H LXI,  T1 2 + SHLD,
  118.   . <L SWAP THEN,
  119.  
  120.   LITG CALL, THEN,  A ORA,  IFZ,  60 SUI,
  121.   0PUSH JC,  12 CPI,  IFC,  21 CPI,  0PUSH JC,  7 SUI,  THEN,
  122.   RADIX LHLD,  L CMP,  0PUSH JNC,  T1 STA,
  123.  
  124.   RADIX LHLD,  XCHG,  T1 6 + LHLD,  MUL CALL,  T1 12 + SHLD,  XCHG,
  125.   T1 6 + SHLD,  RADIX LHLD,  XCHG,  T1 10 + LHLD,  MUL CALL,  H A MOV,
  126.   L ORA,  0PUSH JNZ,  T1 12 + LHLD,  D DAD,  0PUSH JC,  T1 10 + SHLD,
  127.  
  128.   T1 LDA,  A L MOV,  0 H MVI,  XCHG,  T1 6 + LHLD,  D DAD,
  129.   T1 6 + SHLD,  IFNC,  T1 10 + LHLD,  H INX,  T1 10 + SHLD,
  130.   THEN,  L> JMP,
  131.  
  132.   THEN,  T1 2 + LHLD,  H A MOV,  A ORA,  T1 6 + LHLD,
  133.   XCHG,  T1 10 + LHLD,  -HLDE CM,  D PUSH,  H PUSH,  -1PUSH JMP,  >
  134.  
  135. % CAUSE COMPILER TO PROCESS DOUBLE PRECISION LITERALS
  136. 'DILIT : // LIT @ C, // IF
  137.   -1 ELSE . DILITERAL IF () D() C, C, C, -1 ELSE 0 THEN THEN ;
  138. () DILIT LIT !
  139.  
  140. D-1 'D-1 DCONSTANT
  141. D0 'D0 DCONSTANT
  142. D1 'D1 DCONSTANT
  143.  
  144. RADIX !
  145. ;F
  146.  
  147.  
  148.  
  149. ***EOF***
  150.  
  151.