home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MOS / OLD_RUNT.I < prev    next >
Encoding:
Text File  |  1990-06-13  |  44.0 KB  |  3 lines
  1. ⓪ IMPLEMENTATION MODULE Runtime;
  2. ⓪ (*$Y+,L-,R-,N+,C-,M-*)
  3. ⓪ 
  4. ⓪ (**********************************************************************
  5. ⓪ 
  6. ⓪,Runtime Support fuer Atari Modula-Compiler   V#097
  7. ⓪ 
  8. ⓪!30.10.86   Version fuer Atari, mit neuem Stringformat:
  9. ⓪,CAP, STAS angepasst,
  10. ⓪,RangeCheck fuer CHR.
  11. ⓪"1.11.86   STAS fuer Stringlaenge > 32K korrigiert;
  12. ⓪,Prozeduren zur Coroutinen-Unterstuetzung als Dummy.
  13. ⓪"3.11.86   CHR und CAP fuer neue Char-Darstellung (mit folgendem SyncByte)
  14. ⓪!30.11.86   Set-Operationen verkraften ungerade Laengenangaben
  15. ⓪!19.12.86   TrapCode 7 fuer Zugriff ueber NIL-Pointer definiert
  16. ⓪!22.01.87   TRAP-Auswertung wieder impl.
  17. ⓪!04.02.87   STAS: BCS ok2 statt BEQ ok2.
  18. ⓪!27.02.87   TRAP 15: trp0->trp9; GEM-Alert impl.; DivByZero,TRAPV,Addr- und
  19. ⓪,Bus-Error abgefangen; Vektor-Restauration per SetTerminateProc;
  20. ⓪,trp7 (access via NIL-Ptr) raus.
  21. ⓪!02.03.87   Traps:USP wird gerettet; Scan-Aufruf impl.
  22. ⓪!19.03.87   Fehlerbehandlung -> GEMError-Modul
  23. ⓪!09.05.87   TRAP-Nummern geändert
  24. ⓪!19.06.87   neue Real-Arithmetik
  25. ⓪!30.06.87   IOTransfer impl.
  26. ⓪!08.07.87   D7->#1; bei Fehler wird Aufrufer angescanned.
  27. ⓪!22.07.87   IOTransfer, LISTEN, usw. impl.;
  28. ⓪!23.07.87   @PRIO impl, IOTransfer kann auch auf Vektoren >= $400 ange-
  29. ⓪,wendet werden.
  30. ⓪!11.08.87   abermals D7->#1 in Set-Funktionen (wie kam D7 da wieder hin ??)
  31. ⓪!29.08.87   @IDIV korrigiert (UNLK u. MOVEM vertauscht)
  32. ⓪!08.09.87   @IOCA neu
  33. ⓪!27.10.87   FLOAT und TRUNC auf LONGCARD-Parameter umgestellt
  34. ⓪!13.11.87   @LSTN decr. IR um Eins
  35. ⓪!16.12.87   Realvergleiche korrigiert (Null galt als größer als Zahlen
  36. ⓪-mit negativem Exponenten): RELE, REGE, RELT, REGT
  37. ⓪!17.12.87   Realvergleiche jetzt hoffentlich ok
  38. ⓪!16.01.88   @PRIO geht auch im Superv.-Mode
  39. ⓪!01.04.88   @FPDIV für negativen Divisor korrigiert; @IOCA geht jetzt.
  40. ⓪!09.04.88   Coroutinen-Anpassung f. 68020.
  41. ⓪!28.05.88   @RES1 und @RES2 für Procedure Entries (ab Comp 3.6a) verwendet
  42. ⓪!19.07.88   @SMEM, @RELE, @REGE, @RELT, @REGT zerstören nicht mehr D3/D4.
  43. ⓪!12.08.88   CAP berücksichtigt auch nicht-deutsche Umlaute.
  44. ⓪!01.01.88   TRUNC löst Runtime-Error bei neg. Arg. aus
  45. ⓪!19.01.89   881-Unterstützung von MR (26.8.88) übernommen (Cond: A68881)
  46. ⓪!15.06.89   Include-File f. Prozessoren
  47. ⓪!16.06.89   881-Routinen überarbeitet (optimiert, Errors)
  48. ⓪!04.07.89   @STAS korrigiert - machte bei ungeradem Source-String Mist
  49. ⓪!19.08.89   Runtime läuft nun gleichzeitg mit 68000 & 68020
  50. ⓪!30.11.89   Optimierungen in Long-Mul/Div/Mod (LINK verlagert)
  51. ⓪ ***********************************************************************)
  52. ⓪ 
  53. ⓪ FROM SYSTEM IMPORT ASSEMBLER, ADDRESS, WORD;
  54. ⓪ 
  55. ⓪ IMPORT SysInfo;
  56. ⓪ 
  57. ⓪ FROM SFP004 IMPORT FPUInit, FPUError;
  58. ⓪ 
  59. ⓪ CONST
  60. ⓪ 
  61. ⓪ (*$I FPU.CNF *)
  62. ⓪ 
  63. ⓪(DftSF = $0010;
  64. ⓪ 
  65. ⓪ VAR     has020: BOOLEAN;
  66. ⓪ 
  67. ⓪ (*$? A68881:
  68. ⓪ CONST
  69. ⓪(fpstat  =  $fffa40;       (* Response word of MC68881 read *)
  70. ⓪(fpstatlo=  $fffa41;
  71. ⓪(fpctrl  =  $fffa42;       (* Control  word of MC68881 write *)
  72. ⓪(fpcmd   =  $fffa4a;       (* Command  word of MC68881 write *)
  73. ⓪(fpcond  =  $fffa4e;       (* Condition word of MC68881 write *)
  74. ⓪(fpop    =  $fffa50;       (* Operand  long of MC68881 read/write *)
  75. ⓪ *)
  76. ⓪ 
  77. ⓪ (************** Coroutinen-Unterstuetzung **************)
  78. ⓪ 
  79. ⓪ 
  80. ⓪ PROCEDURE BadReturn;  (* RTS aus CoRoutine anmeckern *)
  81. ⓪"BEGIN
  82. ⓪$ASSEMBLER
  83. ⓪(TRAP    #6
  84. ⓪(DC.W    -15-$6000       ; kein cont, scan prev
  85. ⓪$END
  86. ⓪"END BadReturn;
  87. ⓪ 
  88. ⓪ 
  89. ⓪ (*
  90. ⓪#Transferdaten beim Usermode:
  91. ⓪(2  Byte - 0: zeigt Usermode an / 1: Vektor zus. restaurieren
  92. ⓪(4  Byte - PC
  93. ⓪(2  Byte - SR
  94. ⓪(4  Byte - A6
  95. ⓪(56 Byte - D0-A5
  96. ⓪ 
  97. ⓪#Transferdaten beim Supervisormode:
  98. ⓪(2  Byte - $FFxx, zeigt Supervisormode an
  99. ⓪(4  Byte - USP
  100. ⓪(60 Byte - D0-A6
  101. ⓪(4  Byte - Dummy
  102. ⓪(2  Byte - SR
  103. ⓪(4  Byte - PC
  104. ⓪ *)
  105. ⓪ 
  106. ⓪ (* Kennung:      Zustand:
  107. ⓪$0             Normal u. Exc-Rückkehr - Usermode
  108. ⓪$1             Warten auf Exc - Usermode, Vektor restaurieren
  109. ⓪$$FF           Exc-Rückkehr - Supervisormode
  110. ⓪ *)
  111. ⓪ 
  112. ⓪ PROCEDURE @NEWP ( p:PROC; a:ADDRESS; n:LONGCARD; VAR prc:ADDRESS );
  113. ⓪"BEGIN
  114. ⓪$ASSEMBLER
  115. ⓪(LINK    A5,#0
  116. ⓪(
  117. ⓪(MOVE.L  -(A3),A1        ; 'prc'
  118. ⓪(MOVE.L  -(A3),A0        ; SIZE (workspace)
  119. ⓪(MOVE.L  A0,D1
  120. ⓪(BCLR    #0,D1
  121. ⓪(MOVE.L  -(A3),D0        ; ADR (workspace)
  122. ⓪(ADDQ.L  #1,D0
  123. ⓪(BCLR    #0,D0
  124. ⓪(ADDA.L  D0,A0           ; ENDADR (workspace)
  125. ⓪(MOVE.L  -(A3),D2        ; ADR (procedure)
  126. ⓪(CMPI.L  #90,D1          ; ist workspace groß genug ?
  127. ⓪(BCC     wspOk
  128. ⓪(
  129. ⓪(TRAP    #6
  130. ⓪(DC.W    -10-$4000       ; 'out of stack'
  131. ⓪(UNLK    A5
  132. ⓪(RTS
  133. ⓪(
  134. ⓪&wspOk:
  135. ⓪(MOVEM.L A3/A5,-(A7)
  136. ⓪(
  137. ⓪(MOVE.L  D0,A3
  138. ⓪(
  139. ⓪(MOVE.L  D2,-(A0)         ;Adresse für scan
  140. ⓪(ADDQ.L  #2,(A0)          ;scan-Adr etwas vorsetzen
  141. ⓪(CLR.L   -(A0)            ;voriges A5
  142. ⓪(MOVE.L  A0,A5            ;für UNLK in backScan()
  143. ⓪(MOVE.L  #BadReturn,-(A0) ;Fehlerbehandlung bei RTS aus Coroutine
  144. ⓪(
  145. ⓪(MOVEM.L D0-A5,-(A0)      ; Bis auf A3,A5 nur Dummy-Werte
  146. ⓪(MOVE.L  A6,-(A0)
  147. ⓪(MOVE.W  SR,-(A0)
  148. ⓪(MOVE.L  D2,-(A0)
  149. ⓪(CLR.W   -(A0)
  150. ⓪(
  151. ⓪(; nun den SP in 'prc' ablegen
  152. ⓪(MOVE.L  A0,(A1)
  153. ⓪(
  154. ⓪(MOVEM.L (A7)+,A3/A5
  155. ⓪(UNLK    A5
  156. ⓪$END
  157. ⓪"END @NEWP;
  158. ⓪ 
  159. ⓪ PROCEDURE @TRAN ( VAR source,dest:ADDRESS );  (* Transfer *)
  160. ⓪"BEGIN
  161. ⓪$ASSEMBLER
  162. ⓪(; Aufruf erfolgt immer im Usermode, der zu startende Prozeß
  163. ⓪(; kann in beiden Modi ablaufen
  164. ⓪(
  165. ⓪(MOVE.L  -(A3),A2        ; dest
  166. ⓪(MOVE.L  -(A3),A1        ; source
  167. ⓪(MOVE    SR,D2
  168. ⓪(
  169. ⓪(; JSR     EnterSupervisorMode
  170. ⓪(
  171. ⓪(MOVE    #$2700,SR       ; keine Interrupts !
  172. ⓪(
  173. ⓪(; ③aktiven Prozeß beenden④
  174. ⓪(MOVE.L  USP,A0
  175. ⓪(MOVE.L  (A0)+,D0        ; Rücksprungadr. hinter TRANSFER
  176. ⓪(MOVEM.L D0-A5,-(A0)
  177. ⓪(MOVE.L  A6,-(A0)
  178. ⓪(MOVE.W  D2,-(A0)
  179. ⓪(MOVE.L  D0,-(A0)
  180. ⓪(CLR.W   -(A0)
  181. ⓪(
  182. ⓪(MOVE.L  (A2),D0         ; zuerst retten, falls A1=A2
  183. ⓪(MOVE.L  A0,(A1)
  184. ⓪(MOVE.L  D0,A6
  185. ⓪(
  186. ⓪(; ③neuen Prozeß starten④
  187. ⓪(TST.W   (A6)+
  188. ⓪(BEQ     stUsr
  189. ⓪(BMI     stSup
  190. ⓪(
  191. ⓪(; starte Usermode, vorher Vektor restaurieren
  192. ⓪(MOVE.L  (A6)+,D0        ; alter Vektor
  193. ⓪(MOVE.L  4+2+4+4(A6),A0  ; D1: Vektoradr.
  194. ⓪(MOVE.L  D0,(A0)
  195. ⓪(TST     has020
  196. ⓪(BEQ     no20
  197. ⓪(MOVE    #DftSF,-(A7)
  198. ⓪ no20:
  199. ⓪(MOVE.L  (A6)+,-(A7)     ; PC
  200. ⓪(MOVE.W  (A6)+,-(A7)     ; SR
  201. ⓪(MOVE.L  (A6)+,-(A7)     ; A6
  202. ⓪(MOVEM.L (A6)+,D0-A5
  203. ⓪(MOVE.L  A6,USP
  204. ⓪(MOVE.L  (A7)+,A6
  205. ⓪(RTE
  206. ⓪(
  207. ⓪ stUsr:  ; starte Usermode
  208. ⓪(TST     has020
  209. ⓪(BEQ     no20b
  210. ⓪(MOVE    #DftSF,-(A7)
  211. ⓪ no20b:
  212. ⓪(MOVE.L  (A6)+,-(A7)     ; PC
  213. ⓪(MOVE.W  (A6)+,-(A7)     ; SR
  214. ⓪(MOVE.L  (A6)+,-(A7)     ; A6
  215. ⓪(MOVEM.L (A6)+,D0-A5
  216. ⓪(MOVE.L  A6,USP
  217. ⓪(MOVE.L  (A7)+,A6
  218. ⓪(RTE
  219. ⓪(
  220. ⓪ stSup:  ; starte Supervisormode
  221. ⓪(MOVE.L  A6,A7
  222. ⓪(MOVE.L  (A7)+,A0
  223. ⓪(MOVE.L  A0,USP
  224. ⓪(MOVEM.L (A7)+,D0-A6
  225. ⓪(ADDQ.L  #4,A7
  226. ⓪(TST     has020
  227. ⓪(BEQ     no20c
  228. ⓪(MOVE.W  (A7),-(A7)
  229. ⓪(MOVE.L  4(A7),2(A7)
  230. ⓪(MOVE    #DftSF,6(A7)
  231. ⓪ no20c:
  232. ⓪(RTE
  233. ⓪$END
  234. ⓪"END @TRAN;
  235. ⓪ 
  236. ⓪ PROCEDURE @LSTN;
  237. ⓪"BEGIN
  238. ⓪$ASSEMBLER
  239. ⓪(; JSR     EnterSupervisorMode
  240. ⓪(MOVE    SR,-(A7)
  241. ⓪(MOVE    SR,D0
  242. ⓪(ANDI    #$0700,D0
  243. ⓪(BEQ     ok
  244. ⓪(MOVE    SR,D0
  245. ⓪(SUBI    #$0100,D0
  246. ⓪(MOVE    D0,SR
  247. ⓪(NOP
  248. ⓪(NOP
  249. ⓪&ok:
  250. ⓪(MOVE    (A7)+,SR
  251. ⓪(ANDI    #$FFFF-$2000,SR ; Back into user mode
  252. ⓪$END
  253. ⓪"END @LSTN;
  254. ⓪ 
  255. ⓪ PROCEDURE hdlExc;
  256. ⓪"(* Für IOTRANSFER-Auslösungen per Exception *)
  257. ⓪"BEGIN
  258. ⓪$ASSEMBLER
  259. ⓪(; Der Aufruf kann aus beiden Modi kommen, der zu startende
  260. ⓪(; Prozeß ist immer im Usermode
  261. ⓪(
  262. ⓪(MOVE    #$2700,SR       ; keine Interrupts !
  263. ⓪(
  264. ⓪(BTST.B  #5,4(A7)        ; aus welchem mode ?
  265. ⓪(BNE     frSup
  266. ⓪(
  267. ⓪(; Entry aus User mode
  268. ⓪(
  269. ⓪(; Daten auf den USP retten
  270. ⓪(MOVE.L  A6,-(A7)
  271. ⓪(MOVE.L  USP,A6
  272. ⓪(MOVEM.L D0-A5,-(A6)
  273. ⓪(MOVE.L  (A7)+,-(A6)
  274. ⓪(MOVE.L  (A7)+,A0        ; ^Transfer-Daten
  275. ⓪(MOVE    (A7)+,-(A6)     ; SR
  276. ⓪(MOVE.L  (A7)+,-(A6)     ; PC
  277. ⓪(CLR.W   -(A6)
  278. ⓪(
  279. ⓪(; A0 zeigt auf:
  280. ⓪(; 2  Byte - 1, zeigt IOTR an
  281. ⓪(; 4  Byte - alter Exc-Vektor
  282. ⓪(; 4  Byte - PC
  283. ⓪(; 2  Byte - SR
  284. ⓪(; 4  Byte - A6
  285. ⓪(; 56 Byte - D0-A5
  286. ⓪(
  287. ⓪(MOVE.L  2+4+4+2+4+32+8(A0),A2  ; A2: alter dest^
  288. ⓪(MOVE.L  A6,(A2)
  289. ⓪(
  290. ⓪(MOVE.L  2+4+4+2+4+4(A0),A3  ; D1: Vektoradr.
  291. ⓪(LEA     2(A0),A6
  292. ⓪(MOVE.L  (A6)+,(A3)      ; alten Vektor restaurieren
  293. ⓪(TST     has020
  294. ⓪(BEQ     no20d
  295. ⓪(MOVE    #DftSF,-(A7)
  296. ⓪ no20d:
  297. ⓪(MOVE.L  (A6)+,-(A7)     ; PC
  298. ⓪(MOVE.W  (A6)+,-(A7)     ; SR
  299. ⓪(MOVE.L  (A6)+,-(A7)     ; A6
  300. ⓪(MOVEM.L (A6)+,D0-A5
  301. ⓪(MOVE.L  A6,USP
  302. ⓪(MOVE.L  (A7)+,A6
  303. ⓪(RTE
  304. ⓪(
  305. ⓪ frSup:  ; Entry aus Supervisor mode
  306. ⓪(
  307. ⓪(; Daten auf den USP retten
  308. ⓪(MOVEM.L D0-A6,-(A7)
  309. ⓪(MOVE.L  USP,A6
  310. ⓪(MOVE.L  A6,-(A7)
  311. ⓪(ST.B    -(A7)
  312. ⓪(
  313. ⓪(MOVE.L  2+4+60(A7),A0         ; ^Transfer-Daten
  314. ⓪(
  315. ⓪(; A0: (s.o.)
  316. ⓪(
  317. ⓪(MOVE.L  2+4+4+2+4+32+8(A0),A2   ; A2: alter dest^
  318. ⓪(MOVE.L  A7,(A2)
  319. ⓪(
  320. ⓪(MOVE.L  2+4+4+2+4+4(A0),A3  ; D1: Vektoradr.
  321. ⓪(LEA     2(A0),A6
  322. ⓪(MOVE.L  (A6)+,(A3)      ; alten Vektor restaurieren
  323. ⓪(TST     has020
  324. ⓪(BEQ     no20e
  325. ⓪(MOVE    #DftSF,-(A7)
  326. ⓪ no20e:
  327. ⓪(MOVE.L  (A6)+,-(A7)     ; PC
  328. ⓪(MOVE.W  (A6)+,-(A7)     ; SR
  329. ⓪(MOVE.L  (A6)+,-(A7)     ; A6
  330. ⓪(MOVEM.L (A6)+,D0-A5
  331. ⓪(MOVE.L  A6,USP
  332. ⓪(MOVE.L  (A7)+,A6
  333. ⓪(RTE
  334. ⓪$END
  335. ⓪"END hdlExc;
  336. ⓪ 
  337. ⓪ PROCEDURE hdlCall;
  338. ⓪"(* Für IOTRANSFER-Auslösungen per JSR *)
  339. ⓪"BEGIN
  340. ⓪$ASSEMBLER
  341. ⓪(; Der Aufruf kann aus beiden Modi kommen, der zu startende
  342. ⓪(; Prozeß ist immer im Usermode
  343. ⓪(
  344. ⓪(MOVE.L  D1,-(A7)
  345. ⓪(MOVE    SR,D1
  346. ⓪(BTST    #13,D1          ; aus welchem Mode ?
  347. ⓪(BNE     frSup
  348. ⓪(
  349. ⓪(; Entry aus User mode
  350. ⓪(
  351. ⓪(; JSR     EnterSupervisorMode
  352. ⓪(
  353. ⓪(;BREAK
  354. ⓪(MOVE    #$2700,SR       ; keine Interrupts !
  355. ⓪(
  356. ⓪(; ③aktiven Prozeß beenden, Daten auf den USP retten
  357. ⓪(; auf USP stehen noch: D1.L, 2 Byte,  ^Dest-Transfer-Daten, PC.L
  358. ⓪(MOVE.L  A0,-(A7)
  359. ⓪(MOVE.L  USP,A0
  360. ⓪(MOVE.L  (A0)+,-(A7)     ; D1 retten
  361. ⓪(MOVE.L  (A0)+,-(A7)     ; ^Transfer-Daten
  362. ⓪(MOVE.L  (A0)+,-(A7)     ; PC retten
  363. ⓪(MOVEM.L D0-A5,-(A0)
  364. ⓪(MOVE.L  A6,-(A0)
  365. ⓪(MOVE.W  D1,-(A0)        ; SR
  366. ⓪(MOVE.L  (A7)+,-(A0)     ; PC
  367. ⓪(MOVE.L  (A7)+,14(A0)    ; D1 in Transfer-Daten ablegen
  368. ⓪(MOVE.L  (A7)+,A1        ; ^Transfer-Daten
  369. ⓪(MOVE.L  (A7)+,42(A0)    ; A0 in Transfer-Daten ablegen
  370. ⓪(CLR.W   -(A0)
  371. ⓪(
  372. ⓪(; A1 zeigt auf:
  373. ⓪(; 2  Byte - 1, zeigt IOTR an
  374. ⓪(; 4  Byte - alter Exc-Vektor
  375. ⓪(; 4  Byte - PC
  376. ⓪(; 2  Byte - SR
  377. ⓪(; 4  Byte - A6
  378. ⓪(; 56 Byte - D0-A5
  379. ⓪(
  380. ⓪(MOVE.L  2+4+4+2+4+32+8(A1),A2  ; A2: alter dest^
  381. ⓪(MOVE.L  A6,(A2)
  382. ⓪(
  383. ⓪(MOVE.L  2+4+4+2+4+4(A1),A3  ; D1: Vektoradr.
  384. ⓪(LEA     2(A1),A6
  385. ⓪(MOVE.L  (A6)+,(A3)      ; alten Vektor restaurieren
  386. ⓪(TST     has020
  387. ⓪(BEQ     no20f
  388. ⓪(MOVE    #DftSF,-(A7)
  389. ⓪ no20f:
  390. ⓪(MOVE.L  (A6)+,-(A7)     ; PC
  391. ⓪(MOVE.W  (A6)+,-(A7)     ; SR
  392. ⓪(MOVE.L  (A6)+,-(A7)     ; A6
  393. ⓪(MOVEM.L (A6)+,D0-A5
  394. ⓪(MOVE.L  A6,USP
  395. ⓪(MOVE.L  (A7)+,A6
  396. ⓪(RTE
  397. ⓪(
  398. ⓪ frSup:  ; Entry aus Supervisor mode
  399. ⓪(
  400. ⓪(MOVE.L  (A7),D1
  401. ⓪(ADDQ.L  #2,A7
  402. ⓪(MOVE.L  2(A7),(A7)      ; ^Transfer-Daten 2 Byte tiefer
  403. ⓪(MOVE    SR,4(A7)        ; SR darüber
  404. ⓪(
  405. ⓪(;BREAK
  406. ⓪(MOVE    #$2700,SR       ; keine Interrupts !
  407. ⓪(
  408. ⓪(; ③aktiven Prozeß beenden, Daten auf den USP retten
  409. ⓪(MOVEM.L D0-A6,-(A7)
  410. ⓪(MOVE.L  USP,A0
  411. ⓪(MOVE.L  A0,-(A7)
  412. ⓪(ST.B    -(A7)
  413. ⓪(
  414. ⓪(MOVE.L  2+4+60(A7),A0         ; ^Transfer-Daten
  415. ⓪(
  416. ⓪(; A0: (s.o.)
  417. ⓪(
  418. ⓪(MOVE.L  2+4+4+2+4+32+8(A0),A2   ; A2: alter dest^
  419. ⓪(MOVE.L  A7,(A2)
  420. ⓪(
  421. ⓪(MOVE.L  2+4+4+2+4+4(A0),A3  ; D1: Vektoradr.
  422. ⓪(LEA     2(A0),A6
  423. ⓪(MOVE.L  (A6)+,(A3)      ; alten Vektor restaurieren
  424. ⓪(TST     has020
  425. ⓪(BEQ     no20g
  426. ⓪(MOVE    #DftSF,-(A7)
  427. ⓪ no20g:
  428. ⓪(MOVE.L  (A6)+,-(A7)     ; PC
  429. ⓪(MOVE.W  (A6)+,-(A7)     ; SR
  430. ⓪(MOVE.L  (A6)+,-(A7)     ; A6
  431. ⓪(MOVEM.L (A6)+,D0-A5
  432. ⓪(MOVE.L  A6,USP
  433. ⓪(MOVE.L  (A7)+,A6
  434. ⓪(RTE
  435. ⓪$END
  436. ⓪"END hdlCall;
  437. ⓪ 
  438. ⓪ 
  439. ⓪ PROCEDURE @IOTR ( VAR source,dest:ADDRESS; vecAddr:ADDRESS );
  440. ⓪"CONST JSRInstr = $4EB9;
  441. ⓪"BEGIN
  442. ⓪$ASSEMBLER
  443. ⓪(; Aufruf erfolgt immer im Usermode, der zu startende Prozeß
  444. ⓪(; kann in beiden Modi ablaufen
  445. ⓪(
  446. ⓪(MOVE.L  -(A3),D1        ; vector
  447. ⓪(MOVE.L  -(A3),A2        ; dest
  448. ⓪(MOVE.L  -(A3),A1        ; source
  449. ⓪(MOVE    SR,D2
  450. ⓪(
  451. ⓪(; JSR     EnterSupervisorMode
  452. ⓪(
  453. ⓪(MOVE    #$2700,SR       ; keine Interrupts !
  454. ⓪(
  455. ⓪(; Daten für 'hdlExc' und 'hdlCall':
  456. ⓪(; 2  Byte - 1, zeigt IOTR an
  457. ⓪(; 4  Byte - alter Exc-Vektor
  458. ⓪(; 4  Byte - PC
  459. ⓪(; 2  Byte - SR
  460. ⓪(; 4  Byte - A6
  461. ⓪(; 56 Byte - D0-A5
  462. ⓪(
  463. ⓪(; ③aktiven Prozeß beenden④
  464. ⓪(MOVE.L  USP,A0
  465. ⓪(MOVE.L  (A0)+,D0        ; Rücksprungadr. hinter IOTRANSFER
  466. ⓪(MOVEM.L D0-A5,-(A0)
  467. ⓪(MOVE.L  A6,-(A0)
  468. ⓪(MOVE.W  D2,-(A0)
  469. ⓪(MOVE.L  D0,-(A0)
  470. ⓪(
  471. ⓪(MOVE.L  D1,A3
  472. ⓪(MOVE.L  (A3),-(A0)      ; alten vektor retten
  473. ⓪(
  474. ⓪(MOVE    #1,-(A0)
  475. ⓪(
  476. ⓪(MOVE.L  (A2),D0         ; zuerst retten, falls A1=A2
  477. ⓪(MOVE.L  A0,(A1)
  478. ⓪(MOVE.L  D0,A6
  479. ⓪(
  480. ⓪(CMPA.W  #$400,A3
  481. ⓪(BCS     isExc
  482. ⓪(MOVE.L  #hdlCall,-(A0)
  483. ⓪(BRA     cont0
  484. ⓪ isExc   MOVE.L  #hdlExc,-(A0)
  485. ⓪ cont0   MOVE    #JSRInstr,-(A0)
  486. ⓪(
  487. ⓪(MOVE.L  A0,(A3)         ; neuen vektor auf 'JSR hdlExc/hdlCall'
  488. ⓪(
  489. ⓪(; ③neuen Prozeß starten④
  490. ⓪(TST.W   (A6)+
  491. ⓪(BEQ     stUsr
  492. ⓪(BMI     stSup
  493. ⓪(
  494. ⓪(; starte Usermode, vorher Vektor restaurieren
  495. ⓪(MOVE.L  (A6)+,D0        ; alter Vektor
  496. ⓪(MOVE.L  4+2+4+4(A6),A0  ; D1: Vektoradr.
  497. ⓪(MOVE.L  D0,(A0)
  498. ⓪(TST     has020
  499. ⓪(BEQ     no20h
  500. ⓪(MOVE    #DftSF,-(A7)
  501. ⓪ no20h:
  502. ⓪(MOVE.L  (A6)+,-(A7)     ; PC
  503. ⓪(MOVE.W  (A6)+,-(A7)     ; SR
  504. ⓪(MOVE.L  (A6)+,-(A7)     ; A6
  505. ⓪(MOVEM.L (A6)+,D0-A5
  506. ⓪(MOVE.L  A6,USP
  507. ⓪(MOVE.L  (A7)+,A6
  508. ⓪(RTE
  509. ⓪(
  510. ⓪ stUsr:  ; starte Usermode
  511. ⓪(TST     has020
  512. ⓪(BEQ     no20i
  513. ⓪(MOVE    #DftSF,-(A7)
  514. ⓪ no20i:
  515. ⓪(MOVE.L  (A6)+,-(A7)     ; PC
  516. ⓪(MOVE.W  (A6)+,-(A7)     ; SR
  517. ⓪(MOVE.L  (A6)+,-(A7)     ; A6
  518. ⓪(MOVEM.L (A6)+,D0-A5
  519. ⓪(MOVE.L  A6,USP
  520. ⓪(MOVE.L  (A7)+,A6
  521. ⓪(RTE
  522. ⓪(
  523. ⓪ stSup:  ; starte Supervisormode
  524. ⓪(MOVE.L  A6,A7
  525. ⓪(MOVE.L  (A7)+,A0
  526. ⓪(MOVE.L  A0,USP
  527. ⓪(MOVEM.L (A7)+,D0-A6
  528. ⓪(ADDQ.L  #4,A7
  529. ⓪(TST     has020
  530. ⓪(BEQ     no20j
  531. ⓪(MOVE.W  (A7),-(A7)
  532. ⓪(MOVE.L  4(A7),2(A7)
  533. ⓪(MOVE    #DftSF,6(A7)
  534. ⓪ no20j:
  535. ⓪(RTE
  536. ⓪$END
  537. ⓪"END @IOTR;
  538. ⓪ 
  539. ⓪ 
  540. ⓪ PROCEDURE @IOCA ( vecAddr:ADDRESS );
  541. ⓪"BEGIN
  542. ⓪$ASSEMBLER
  543. ⓪(MOVE.L  -(A3),A1
  544. ⓪(CMPA.L  #$400,A1
  545. ⓪(BCS     isExc
  546. ⓪(MOVEM.L D3-D7/A3-A6,-(A7)
  547. ⓪(; JSR     EnterSupervisorMode     ; Regs D0,A0 können verändert werden !
  548. ⓪(MOVE.L  (A1),A1
  549. ⓪(JSR     (A1)
  550. ⓪(ANDI    #$CFFF,SR
  551. ⓪(MOVEM.L (A7)+,D3-D7/A3-A6
  552. ⓪(RTS
  553. ⓪&isExc:
  554. ⓪(MOVE.L  (A7)+,A2
  555. ⓪(MOVE    SR,D1
  556. ⓪(; JSR     EnterSupervisorMode     ; Regs D0,A0 können verändert werden !
  557. ⓪(MOVE.L  (A1),A1
  558. ⓪(TST     has020
  559. ⓪(BEQ     no20k
  560. ⓪(MOVE    #DftSF,-(A7)
  561. ⓪ no20k:
  562. ⓪(MOVE.L  A2,-(A7)
  563. ⓪(MOVE    D1,-(A7)
  564. ⓪(JMP     (A1)            ; rettet sicher alle Register
  565. ⓪$END
  566. ⓪"END @IOCA;
  567. ⓪ 
  568. ⓪ 
  569. ⓪ PROCEDURE @PRIO;  (* Set Interrupt Priority *)
  570. ⓪"BEGIN
  571. ⓪$(* IR-level in D2, auf Bitpos. wie SR; A2 nicht verändern ! *);
  572. ⓪$ASSEMBLER
  573. ⓪(MOVE    SR,D0
  574. ⓪(BTST    #13,D0
  575. ⓪(BNE     sup                     ; wir sind im Supervisormode
  576. ⓪(; JSR     EnterSupervisorMode
  577. ⓪(MOVE    D2,SR
  578. ⓪(RTS
  579. ⓪&sup:
  580. ⓪(ANDI    #$F0FF,D0
  581. ⓪(ANDI    #$0F00,D2
  582. ⓪(OR      D2,D0
  583. ⓪(MOVE    D0,SR
  584. ⓪$END
  585. ⓪"END @PRIO;
  586. ⓪ 
  587. ⓪ 
  588. ⓪ PROCEDURE @EXCL; (* Exclude Element aus Set *)
  589. ⓪"
  590. ⓪"BEGIN (* SetAdr und Element auf Stack *)
  591. ⓪$ASSEMBLER
  592. ⓪'MOVE.W  -(A3),D0
  593. ⓪'MOVE.W  D0,D1
  594. ⓪'LSR.W   #3,D0
  595. ⓪'MOVE.L  -(A3),A0
  596. ⓪'BCLR    D1,0(A0,D0.W)   END
  597. ⓪"END @EXCL;
  598. ⓪"
  599. ⓪ 
  600. ⓪ PROCEDURE @INCL; (* Include Element in Set *)
  601. ⓪ 
  602. ⓪"BEGIN (* SetAdr und Element auf Stack *)
  603. ⓪$ASSEMBLER
  604. ⓪(MOVE.W  -(A3),D0
  605. ⓪(MOVE.W  D0,D1
  606. ⓪(LSR.W   #3,D0
  607. ⓪(MOVE.L  -(A3),A0
  608. ⓪(BSET    D1,0(A0,D0.W)   END
  609. ⓪$END @INCL;
  610. ⓪"
  611. ⓪ 
  612. ⓪ PROCEDURE @SAND; (* '*' auf Sets *)
  613. ⓪ 
  614. ⓪#BEGIN (* zwei Sets auf Stack, Laenge in D0 *)
  615. ⓪)ASSEMBLER
  616. ⓪+MOVE.L  A3,A0
  617. ⓪+ADDQ.W  #1,D0
  618. ⓪+BCLR    #0,D0    ;sync. D0
  619. ⓪+SUBA.W  D0,A0
  620. ⓪%Lp    MOVE.W  -(A3),D1
  621. ⓪+AND.W   D1,-(A0)
  622. ⓪+SUBQ.W  #2,D0
  623. ⓪+BHI     Lp
  624. ⓪)END
  625. ⓪#END @SAND;
  626. ⓪!
  627. ⓪ 
  628. ⓪ PROCEDURE @SXOR; (* '/' auf Sets *)
  629. ⓪ 
  630. ⓪"BEGIN (* zwei Sets auf Stack, Laenge in D0 *)
  631. ⓪(ASSEMBLER
  632. ⓪*MOVE.L  A3,A0
  633. ⓪*ADDQ.W  #1,D0
  634. ⓪*BCLR    #0,D0    ;sync. D0
  635. ⓪*SUBA.W  D0,A0
  636. ⓪$Lp    MOVE.W  -(A3),D1
  637. ⓪*EOR.W   D1,-(A0)
  638. ⓪*SUBQ.W  #2,D0
  639. ⓪*BHI     Lp
  640. ⓪(END
  641. ⓪"END @SXOR;
  642. ⓪!
  643. ⓪ 
  644. ⓪ PROCEDURE @SSUM; (* '+' auf Sets *)
  645. ⓪ 
  646. ⓪"BEGIN (* zwei Sets auf Stack, Laenge in D0 *)
  647. ⓪(ASSEMBLER
  648. ⓪*MOVE.L  A3,A0
  649. ⓪*ADDQ.W  #1,D0
  650. ⓪*BCLR    #0,D0    ;sync. D0
  651. ⓪*SUBA.W  D0,A0
  652. ⓪$Lp    MOVE.W  -(A3),D1
  653. ⓪*OR.W    D1,-(A0)
  654. ⓪*SUBQ.W  #2,D0
  655. ⓪*BHI     Lp
  656. ⓪(END
  657. ⓪"END @SSUM;
  658. ⓪!
  659. ⓪ 
  660. ⓪ PROCEDURE @SDIF; (* '-' auf Sets *)
  661. ⓪ 
  662. ⓪"BEGIN (* zwei Sets auf Stack, Laenge in D0 *)
  663. ⓪(ASSEMBLER
  664. ⓪*MOVE.L  A3,A0
  665. ⓪*ADDQ.W  #1,D0
  666. ⓪*BCLR    #0,D0    ;sync. D0
  667. ⓪*SUBA.W  D0,A0
  668. ⓪$Lp    MOVE.W  -(A3),D1
  669. ⓪*AND.W   -(A0),D1
  670. ⓪*EOR.W   D1,(A0)
  671. ⓪*SUBQ.W  #2,D0
  672. ⓪*BHI     Lp
  673. ⓪(END
  674. ⓪"END @SDIF;
  675. ⓪ 
  676. ⓪ 
  677. ⓪ PROCEDURE @SMEM; (* IN-Operator auf Sets *)
  678. ⓪ 
  679. ⓪"BEGIN (* Element.W und Set auf Stack, SetLaenge in D0 *)
  680. ⓪$ASSEMBLER
  681. ⓪(MOVE.W  D0,D1
  682. ⓪(NEG.W   D1
  683. ⓪(BCLR    #0,D1
  684. ⓪(LEA     0(A3,D1.W),A0       ;A0 ist ^SetAnfang
  685. ⓪(MOVE.W  -(A0),D2
  686. ⓪(MOVE.W  D2,D1
  687. ⓪(LSR.W   #3,D2
  688. ⓪(CMP.W   D0,D2
  689. ⓪(BCC     NOMEM
  690. ⓪(BTST    D1,2(A0,D2.W)
  691. ⓪(BEQ     NOMEM
  692. ⓪(MOVE.L  A0,A3
  693. ⓪(MOVE.W  #1,(A3)+
  694. ⓪(RTS
  695. ⓪&NOMEM
  696. ⓪(MOVE.L  A0,A3
  697. ⓪(CLR     (A3)+
  698. ⓪$END
  699. ⓪"END @SMEM;
  700. ⓪"
  701. ⓪ 
  702. ⓪ PROCEDURE @SEQL; (* '=' auf Sets *)
  703. ⓪ 
  704. ⓪"BEGIN (* zwei Sets auf Stack, Laenge in D0 *)
  705. ⓪(ASSEMBLER
  706. ⓪*MOVE.W  D0,D1
  707. ⓪*NEG.W   D1
  708. ⓪*BCLR    #0,D1
  709. ⓪*LEA     0(A3,D1.W),A0   ;^Anfang des 2. Sets
  710. ⓪*LEA     0(A0,D1.W),A1   ;^Anfang des 1. Sets
  711. ⓪*MOVE.L  A1,D1
  712. ⓪*SUBQ.W  #1,D0
  713. ⓪$Lp    CMPM.B  (A0)+,(A1)+
  714. ⓪*DBNE    D0,Lp
  715. ⓪*SEQ     D0
  716. ⓪*AND.W   #1,D0
  717. ⓪*MOVE.L  D1,A3
  718. ⓪*MOVE.W  D0,(A3)+
  719. ⓪(END
  720. ⓪"END @SEQL;
  721. ⓪ 
  722. ⓪ 
  723. ⓪ PROCEDURE @SNEQ; (* '#' auf Sets *)
  724. ⓪ 
  725. ⓪"BEGIN (* zwei Sets auf Stack, Laenge in D0 *)
  726. ⓪(ASSEMBLER
  727. ⓪*MOVE.W  D0,D1
  728. ⓪*NEG.W   D1
  729. ⓪*BCLR    #0,D1
  730. ⓪*LEA     0(A3,D1.W),A0   ;^Anfang des 2. Sets
  731. ⓪*LEA     0(A0,D1.W),A1   ;^Anfang des 1. Sets
  732. ⓪*MOVE.L  A1,D1
  733. ⓪*SUBQ.W  #1,D0
  734. ⓪$Lp    CMPM.B  (A0)+,(A1)+
  735. ⓪*DBNE    D0,Lp
  736. ⓪*SNE     D0
  737. ⓪*AND.W   #1,D0
  738. ⓪*MOVE.L  D1,A3
  739. ⓪*MOVE.W  D0,(A3)+
  740. ⓪(END
  741. ⓪"END @SNEQ;
  742. ⓪ 
  743. ⓪ 
  744. ⓪ PROCEDURE @SLEQ; (* '<=' auf Sets *)
  745. ⓪ 
  746. ⓪"BEGIN (* zwei Sets auf Stack, Laenge in D0 *)
  747. ⓪(ASSEMBLER
  748. ⓪*MOVE.W  D0,D1
  749. ⓪*NEG.W   D1
  750. ⓪*BCLR    #0,D1
  751. ⓪*LEA     0(A3,D1.W),A0   ;^Anfang des 2. Sets
  752. ⓪*LEA     0(A0,D1.W),A1   ;^Anfang des 1. Sets
  753. ⓪*MOVE.L  A1,D2
  754. ⓪*SUBQ.W  #1,D0
  755. ⓪$Lp    MOVE.B  (A1),D1
  756. ⓪*AND.B   (A0)+,D1
  757. ⓪*EOR.B   D1,(A1)+        ;Set1 * Set2 =! Set1
  758. ⓪*DBNE    D0,Lp
  759. ⓪*SEQ     D0
  760. ⓪*AND.W   #1,D0
  761. ⓪*MOVEA.L D2,A3
  762. ⓪*MOVE.W  D0,(A3)+
  763. ⓪(END
  764. ⓪"END @SLEQ;
  765. ⓪ 
  766. ⓪ 
  767. ⓪ PROCEDURE @SGEQ; (* '>=' auf Sets *)
  768. ⓪ 
  769. ⓪"BEGIN (* zwei Sets auf Stack, Laenge in D0 *)
  770. ⓪(ASSEMBLER
  771. ⓪*MOVE.W  D0,D1
  772. ⓪*NEG.W   D1
  773. ⓪*BCLR    #0,D1
  774. ⓪*LEA     0(A3,D1.W),A0   ;^Anfang des 2. Sets
  775. ⓪*LEA     0(A0,D1.W),A1   ;^Anfang des 1. Sets
  776. ⓪*MOVE.L  A1,D2
  777. ⓪*SUBQ.W  #1,D0
  778. ⓪$Lp    MOVE.B  (A0),D1
  779. ⓪*AND.B   (A1)+,D1
  780. ⓪*EOR.B   D1,(A0)+        ;Set1 * Set2 =! Set2
  781. ⓪*DBNE    D0,Lp
  782. ⓪*SEQ     D0
  783. ⓪*AND.W   #1,D0
  784. ⓪*MOVEA.L D2,A3
  785. ⓪*MOVE.W  D0,(A3)+
  786. ⓪(END
  787. ⓪"END @SGEQ;
  788. ⓪ 
  789. ⓪ (********* Real-Vergleiche *********)
  790. ⓪ 
  791. ⓪ PROCEDURE @REEQ (a,b:LONGREAL):BOOLEAN;        (* a = b *)
  792. ⓪ BEGIN
  793. ⓪"ASSEMBLER
  794. ⓪$; !!! sind bei 881 nicht unbenutzte Bits, die hier falsche Erg. liefern k?
  795. ⓪$MOVE.L -(A3),D0
  796. ⓪$MOVE.L -(A3),D1
  797. ⓪$MOVE.L -(A3),D2
  798. ⓪$CMP.L  -(A3),D1
  799. ⓪$BNE    NE
  800. ⓪$CMP.L  D0,D2
  801. ⓪$BNE    NE
  802. ⓪$MOVE.W #true,(A3)+
  803. ⓪$RTS
  804. ⓪ !NE CLR.W (A3)+
  805. ⓪"END
  806. ⓪ END @REEQ;
  807. ⓪ 
  808. ⓪ PROCEDURE @RENE (a,b:LONGREAL):BOOLEAN;        (* a # b *)
  809. ⓪ BEGIN
  810. ⓪"ASSEMBLER
  811. ⓪$; !!! sind bei 881 nicht unbenutzte Bits, die hier falsche Erg. liefern k?
  812. ⓪$MOVE.L -(A3),D0
  813. ⓪$MOVE.L -(A3),D1
  814. ⓪$MOVE.L -(A3),D2
  815. ⓪$CMP.L  -(A3),D1
  816. ⓪$BNE    NE
  817. ⓪$CMP.L  D0,D2
  818. ⓪$BNE    NE
  819. ⓪$CLR.W (A3)+
  820. ⓪$RTS
  821. ⓪ !NE MOVE.W #true,(A3)+
  822. ⓪"END
  823. ⓪ END @RENE;
  824. ⓪ 
  825. ⓪ (*********** Longint - Arithmetik ***********)
  826. ⓪ 
  827. ⓪ PROCEDURE @IMUL (a,b:LONGINT):LONGINT;
  828. ⓪ BEGIN
  829. ⓪#ASSEMBLER
  830. ⓪'MOVE.L D3,-(A7)
  831. ⓪'CLR.W  D3
  832. ⓪'MOVE.L -(A3),D0
  833. ⓪'BPL    IMUL5
  834. ⓪'NEG.L  D0
  835. ⓪'MOVEQ  #1,D3
  836. ⓪ !IMUL5 MOVE.L -(A3),D1
  837. ⓪'BPL    IMUL4
  838. ⓪'NEG.L  D1
  839. ⓪'BCHG   #0,D3
  840. ⓪ !IMUL4 MOVE.L D0,D2
  841. ⓪'MULU   D1,D0
  842. ⓪'SWAP   D1
  843. ⓪'TST.W  D1
  844. ⓪'BEQ    IMUL1
  845. ⓪'SWAP   D2
  846. ⓪'TST.W  D2
  847. ⓪'BEQ    IMUL2
  848. ⓪'BNE    IMERR
  849. ⓪ !IMUL1 SWAP   D1
  850. ⓪ !IMUL2 SWAP   D2
  851. ⓪'MULU   D1,D2
  852. ⓪'SWAP   D2
  853. ⓪'TST.W  D2
  854. ⓪'BNE    IMERR
  855. ⓪'ADD.L  D2,D0
  856. ⓪'BVS    IMERR
  857. ⓪'BMI    IMERR
  858. ⓪'TST.W  D3
  859. ⓪'BEQ    IMUL3
  860. ⓪'NEG.L  D0
  861. ⓪ !IMUL3 MOVE.L D0,(A3)+
  862. ⓪'MOVE.L (A7)+,D3
  863. ⓪'RTS
  864. ⓪'
  865. ⓪ !IMERR LINK   A5,#0
  866. ⓪'TRAP    #6          ; Overflow
  867. ⓪'DC.W    -7-$4000
  868. ⓪'CLR.L   (A3)+
  869. ⓪'MOVE.L (A7)+,D3
  870. ⓪'UNLK   A5
  871. ⓪#END
  872. ⓪ END @IMUL;
  873. ⓪ 
  874. ⓪ PROCEDURE @CMUL (a,b:LONGCARD):LONGCARD;
  875. ⓪ BEGIN
  876. ⓪"ASSEMBLER
  877. ⓪'MOVE.L -(A3),D0
  878. ⓪'MOVE.L -(A3),D1
  879. ⓪'MOVE.L D0,D2
  880. ⓪'MULU   D1,D0
  881. ⓪'SWAP   D1
  882. ⓪'TST.W  D1
  883. ⓪'BEQ    CMUL1
  884. ⓪'SWAP   D2
  885. ⓪'TST.W  D2
  886. ⓪'BEQ    CMUL2
  887. ⓪'BNE    CMERR
  888. ⓪ !CMUL1 SWAP   D1
  889. ⓪ !CMUL2 SWAP   D2
  890. ⓪'MULU   D1,D2
  891. ⓪'SWAP   D2
  892. ⓪'TST.W  D2
  893. ⓪'BNE    CMERR
  894. ⓪'ADD.L  D2,D0
  895. ⓪'BCS    CMERR
  896. ⓪'MOVE.L D0,(A3)+
  897. ⓪'RTS
  898. ⓪'
  899. ⓪ !CMERR LINK   A5,#0
  900. ⓪'TRAP    #6          ; Overflow
  901. ⓪'DC.W    -7-$4000
  902. ⓪'CLR.L   (A3)+
  903. ⓪'UNLK   A5
  904. ⓪#END
  905. ⓪ END @CMUL;
  906. ⓪ 
  907. ⓪ PROCEDURE @IDIV (a,b:LONGINT):LONGINT;
  908. ⓪ BEGIN
  909. ⓪#ASSEMBLER
  910. ⓪(MOVEM.L D4-D5,-(A7)
  911. ⓪(
  912. ⓪(CLR.W  D5
  913. ⓪(MOVE.L -(A3),D0
  914. ⓪(BEQ    IDERR
  915. ⓪(BPL    IDIV5
  916. ⓪(NEG.L  D0
  917. ⓪(MOVEQ  #1,D5
  918. ⓪ !IDIV5  MOVE.L -(A3),D1
  919. ⓪(BPL    IDIV6
  920. ⓪(NEG.L  D1
  921. ⓪(BCHG   #0,D5
  922. ⓪ !IDIV6  CLR.L  D2
  923. ⓪(CLR.L  D4
  924. ⓪ !IDIV1  CMP.L  D0,D1
  925. ⓪(BLS    IDIV2
  926. ⓪(LSL.L  #1,D0
  927. ⓪(ADDQ.W #1,D2
  928. ⓪(BRA    IDIV1
  929. ⓪ !IDIV3  LSR.L  #1,D0
  930. ⓪ !IDIV2  LSL.L  #1,D4
  931. ⓪(CMP.L  D0,D1
  932. ⓪(BCS    IDIV4
  933. ⓪(SUB.L  D0,D1
  934. ⓪(ADDQ.W #1,D4
  935. ⓪ !IDIV4  DBF    D2,IDIV3
  936. ⓪(TST.W  D5
  937. ⓪(BEQ    IDIV7
  938. ⓪(NEG.L  D4
  939. ⓪ !IDIV7  MOVE.L D4,(A3)+
  940. ⓪(MOVEM.L (A7)+,D4-D5
  941. ⓪(RTS
  942. ⓪(
  943. ⓪ !IDERR  LINK   A5,#0
  944. ⓪(TRAP    #6          ; Div by zero
  945. ⓪(DC.W    -5-$4000
  946. ⓪(CLR.L   (A3)+
  947. ⓪(MOVEM.L (A7)+,D4-D5
  948. ⓪(UNLK   A5
  949. ⓪$END
  950. ⓪ END @IDIV;
  951. ⓪ 
  952. ⓪ PROCEDURE @CDIV (a,b:LONGCARD):LONGCARD;
  953. ⓪ BEGIN
  954. ⓪ ASSEMBLER
  955. ⓪'MOVE.L D3,-(A7)
  956. ⓪'MOVE.L -(A3),D0
  957. ⓪'BEQ    CDERR
  958. ⓪'MOVE.L -(A3),D1
  959. ⓪'CLR.L  D2
  960. ⓪'CLR.L  D3
  961. ⓪'TST.L  D0
  962. ⓪'BMI    CDIV2
  963. ⓪ !CDIV1 CMP.L  D0,D1
  964. ⓪'BLS    CDIV2
  965. ⓪'ADDQ   #1,D2
  966. ⓪'ASL.L  #1,D0
  967. ⓪'BPL    CDIV1
  968. ⓪ !CDIV2 ASL.L  #1,D3
  969. ⓪'CMP.L  D0,D1
  970. ⓪'BCS    CDIV3
  971. ⓪'SUB.L  D0,D1
  972. ⓪'ADDQ   #1,D3
  973. ⓪ !CDIV3 LSR.L  #1,D0
  974. ⓪'DBF    D2,CDIV2
  975. ⓪'MOVE.L D3,(A3)+
  976. ⓪'MOVE.L (A7)+,D3
  977. ⓪'RTS
  978. ⓪'
  979. ⓪ !CDERR LINK   A5,#0
  980. ⓪'TRAP    #6          ; Div by zero
  981. ⓪'DC.W    -5-$4000
  982. ⓪'CLR.L   (A3)+
  983. ⓪'MOVE.L (A7)+,D3
  984. ⓪'UNLK   A5
  985. ⓪ END
  986. ⓪ END @CDIV;
  987. ⓪ 
  988. ⓪ PROCEDURE @IMOD (a,b:LONGINT):LONGINT;
  989. ⓪ BEGIN
  990. ⓪ ASSEMBLER
  991. ⓪'MOVE.L D5,-(A7)
  992. ⓪'CLR.W  D5
  993. ⓪'CLR.L  D2
  994. ⓪'MOVE.L -(A3),D0
  995. ⓪'BEQ    IMODER
  996. ⓪'BPL    IMOD2
  997. ⓪'NEG.L  D0
  998. ⓪ !IMOD2 MOVE.L -(A3),D1
  999. ⓪'BPL    IMOD1
  1000. ⓪'NEG.L  D1
  1001. ⓪'MOVEQ  #1,D5
  1002. ⓪ !IMOD1 CMP.L  D0,D1
  1003. ⓪'BLS    IMOD5
  1004. ⓪'LSL.L  #1,D0
  1005. ⓪'ADDQ.W #1,D2
  1006. ⓪'BRA    IMOD1
  1007. ⓪ !IMOD3 LSR.L  #1,D0
  1008. ⓪ !IMOD5 CMP.L  D0,D1
  1009. ⓪'BCS    IMOD4
  1010. ⓪'SUB.L  D0,D1
  1011. ⓪ !IMOD4 DBEQ   D2,IMOD3
  1012. ⓪'TST.W  D5
  1013. ⓪'BEQ    IMOD6
  1014. ⓪'NEG.L  D1
  1015. ⓪ !IMOD6 MOVE.L D1,(A3)+
  1016. ⓪'MOVE.L (A7)+,D5
  1017. ⓪'RTS
  1018. ⓪'
  1019. ⓪ IMODER LINK   A5,#0
  1020. ⓪'TRAP    #6          ; Div by zero
  1021. ⓪'DC.W    -5-$4000
  1022. ⓪'CLR.L   (A3)+
  1023. ⓪'MOVE.L (A7)+,D5
  1024. ⓪'UNLK   A5
  1025. ⓪#END
  1026. ⓪ END @IMOD;
  1027. ⓪ 
  1028. ⓪ PROCEDURE @CMOD (a,b:LONGCARD):LONGCARD;
  1029. ⓪ BEGIN
  1030. ⓪ ASSEMBLER
  1031. ⓪'MOVE.L D3,-(A7)
  1032. ⓪'MOVE.L -(A3),D0
  1033. ⓪'BEQ    CMERR
  1034. ⓪'MOVE.L -(A3),D1
  1035. ⓪'CLR.L  D2
  1036. ⓪'MOVE.L D0,D3
  1037. ⓪'BMI    CMOD2
  1038. ⓪ !CMOD1 CMP.L  D0,D1
  1039. ⓪'BLS    CMOD2
  1040. ⓪'ADDQ   #1,D2
  1041. ⓪'ASL.L  #1,D0
  1042. ⓪'BPL    CMOD1
  1043. ⓪ !CMOD2 CMP.L  D0,D1
  1044. ⓪'BCS    CMOD3
  1045. ⓪'SUB.L  D0,D1
  1046. ⓪ !CMOD3 LSR.L  #1,D0
  1047. ⓪'CMP.L  D1,D3
  1048. ⓪'DBHI   D2,CMOD2
  1049. ⓪'
  1050. ⓪'MOVE.L D1,(A3)+
  1051. ⓪'MOVE.L (A7)+,D3
  1052. ⓪'RTS
  1053. ⓪'
  1054. ⓪ !CMERR LINK   A5,#0
  1055. ⓪'TRAP    #6          ; Div by zero
  1056. ⓪'DC.W    -5-$4000
  1057. ⓪'CLR.L   (A3)+
  1058. ⓪'MOVE.L (A7)+,D3
  1059. ⓪'UNLK   A5
  1060. ⓪#END
  1061. ⓪ END @CMOD;
  1062. ⓪ 
  1063. ⓪ PROCEDURE @ASGN;
  1064. ⓪ BEGIN
  1065. ⓪#ASSEMBLER
  1066. ⓪'MOVE.L   -(A3),A0
  1067. ⓪$!X MOVE.W   (A0)+,(A4)+
  1068. ⓪'DBF      D0,X
  1069. ⓪#END
  1070. ⓪ END @ASGN;
  1071. ⓪ 
  1072. ⓪ PROCEDURE @STAS;
  1073. ⓪ (* D0: LAENGE DES SOURCESTRING/BYTE; D1: LAENGE DEST.STRING/BYTE *)
  1074. ⓪ BEGIN
  1075. ⓪#ASSEMBLER
  1076. ⓪'MOVE.L  A3,A0
  1077. ⓪'MOVE.L  D0,D2
  1078. ⓪'ADDQ.L  #1,D0     ; D0 als StackOffset: muss synch. werden!
  1079. ⓪'ANDI.W  #$FFFE,D0 ; nicht BCLR verwenden, sonst Fehler bei DBEQ (unten)
  1080. ⓪'SUBA.L  D0,A0     ; A0 zeigt auf Sourcestring
  1081. ⓪'BRA     y
  1082. ⓪$
  1083. ⓪$z  SWAP    D1        ;*** Kopierschleife
  1084. ⓪$x  SUBQ.L  #1,D2
  1085. ⓪'BCS     ok2       ; Source-Ende, Dest. muss Endmarke bekommen
  1086. ⓪'MOVE.B  (A0)+,(A4)+
  1087. ⓪$y  DBEQ    D1,x
  1088. ⓪'BEQ     ok        ; Endmarke der Source wurde eben kopiert
  1089. ⓪'SWAP    D1
  1090. ⓪'DBF     D1,z
  1091. ⓪'
  1092. ⓪'TST.L   D2        ;*** Ende der Schleife, weil Dest voll
  1093. ⓪'BEQ     ok        ; Source komplett kopiert (hatte keine Endmarke)
  1094. ⓪'TST.B   (A0)
  1095. ⓪'BEQ     ok        ; sonst muss die Endmarke das naechste Zeichen sein
  1096. ⓪'SUBA.L  D0,A3     ; leider nein: String Overflow
  1097. ⓪'TRAP    #6
  1098. ⓪'DC.W    -8-$4000
  1099. ⓪#ok2 CLR.B   (A4)+
  1100. ⓪#ok  SUBA.L  D0,A3
  1101. ⓪#END
  1102. ⓪ END @STAS;
  1103. ⓪ 
  1104. ⓪ 
  1105. ⓪ PROCEDURE @COPY;
  1106. ⓪"BEGIN
  1107. ⓪$ASSEMBLER
  1108. ⓪&move.l  (a7)+,A1          ;Ruecksprung-Adr
  1109. ⓪&
  1110. ⓪&; Platzbedarf ausrechnen
  1111. ⓪&
  1112. ⓪&move.w  -2(a3),d1         ;High-Wert
  1113. ⓪&addq.w  #1,d1             ;Anzahl Elemente
  1114. ⓪&mulu    d0,d1             ; * Elementlaenge = Anzahl Bytes
  1115. ⓪&addq.l  #1,d1             ;synchronisieren
  1116. ⓪&bclr    #0,d1
  1117. ⓪&
  1118. ⓪&; Platz reservieren, Pointer bereitstellen
  1119. ⓪&
  1120. ⓪&suba.l  d1,a7
  1121. ⓪&movea.l -6(a3),A2         ;^ Source-Daten
  1122. ⓪&move.l  a7,-6(a3)         ;neuer ^ Kopie
  1123. ⓪&movea.l a7,a0             ;^ fuer Kopierschleife
  1124. ⓪&move.l  d1,-(a7)          ;fuer Release
  1125. ⓪&
  1126. ⓪&; Kopierschleife
  1127. ⓪&
  1128. ⓪&bra     lp2
  1129. ⓪!lp1  swap    d1
  1130. ⓪!lp   move.b  (A2)+,(a0)+       ;schoen langsam umkopieren...
  1131. ⓪!lp2  dbf     d1,lp
  1132. ⓪&swap    d1
  1133. ⓪&dbf     d1,lp1
  1134. ⓪&
  1135. ⓪&jmp     (A1)              ;zurueck zum Aufrufer
  1136. ⓪$END
  1137. ⓪"END @COPY;
  1138. ⓪ 
  1139. ⓪ 
  1140. ⓪ PROCEDURE @COPS;
  1141. ⓪"BEGIN
  1142. ⓪$ASSEMBLER
  1143. ⓪&move.l  (a7)+,A1          ;Ruecksprung-Adr
  1144. ⓪&move.l  (a7)+,d2          ;Adresse der zu rufenden Prozedur retten
  1145. ⓪&
  1146. ⓪&; Platzbedarf ausrechnen
  1147. ⓪&
  1148. ⓪&move.w  -2(a3),d1         ;High-Wert
  1149. ⓪&addq.w  #1,d1             ;Anzahl Elemente
  1150. ⓪&mulu    d0,d1             ; * Elementlaenge = Anzahl Bytes
  1151. ⓪&addq.l  #1,d1             ;synchronisieren
  1152. ⓪&bclr    #0,d1
  1153. ⓪&
  1154. ⓪&; Platz reservieren, Pointer bereitstellen
  1155. ⓪&
  1156. ⓪&suba.l  d1,a7
  1157. ⓪&movea.l -6(a3),A2         ;^ Source-Daten
  1158. ⓪&move.l  a7,-6(a3)         ;neuer ^ Kopie
  1159. ⓪&movea.l a7,a0             ;^ fuer Kopierschleife
  1160. ⓪&move.l  d1,-(a7)          ;fuer Release
  1161. ⓪&
  1162. ⓪&; Kopierschleife
  1163. ⓪&
  1164. ⓪&bra     lp2
  1165. ⓪!lp1  swap    d1
  1166. ⓪!lp   move.b  (A2)+,(a0)+       ;schoen langsam umkopieren...
  1167. ⓪!lp2  dbf     d1,lp
  1168. ⓪&swap    d1
  1169. ⓪&dbf     d1,lp1
  1170. ⓪&
  1171. ⓪&move.l  d2,-(a7)
  1172. ⓪&jmp     (A1)              ;zurueck zum Aufrufer
  1173. ⓪$END
  1174. ⓪"END @COPS;
  1175. ⓪ 
  1176. ⓪ PROCEDURE @SCAS; END @SCAS;
  1177. ⓪ 
  1178. ⓪ PROCEDURE @RES1;  (* Procedure Entry ohne Priority *)
  1179. ⓪"BEGIN
  1180. ⓪$ASSEMBLER
  1181. ⓪(; Null-Link (keine Parameter, keine lok. Vars), norm. $200 Stack-Check
  1182. ⓪(LEA     $200(A3),A0
  1183. ⓪(CMPA.L  A7,A0
  1184. ⓪(BCC     stackerror
  1185. ⓪&cont
  1186. ⓪(MOVE.L  (A7)+,A0
  1187. ⓪(LINK    A5,#$0000
  1188. ⓪(MOVE.L  A7,A2
  1189. ⓪(MOVEM.L A4/A6,-(A7)
  1190. ⓪(MOVE.L  A2,A6
  1191. ⓪(JMP     (A0)
  1192. ⓪&stackerror
  1193. ⓪(TRAP    #6
  1194. ⓪(DC.W    $BFF6    ; Stack overflow, caller caused
  1195. ⓪(BRA     cont
  1196. ⓪$END
  1197. ⓪"END @RES1;
  1198. ⓪ 
  1199. ⓪ PROCEDURE @RES2;  (* Procedure Entry ohne Priority *)
  1200. ⓪"BEGIN
  1201. ⓪$ASSEMBLER
  1202. ⓪(; D0.W: Link-Wert
  1203. ⓪(; als Stacksicherheitswert wird $200 angenommen
  1204. ⓪(LEA     $200(A3),A0
  1205. ⓪(ADDA.W  D0,A0
  1206. ⓪(CMPA.L  A7,A0
  1207. ⓪(BCC     stackerror
  1208. ⓪&cont
  1209. ⓪(MOVE.L  (A7)+,A0
  1210. ⓪(; LINK #<D0>,A5:
  1211. ⓪(MOVE.L  A5,-(A7)
  1212. ⓪(MOVE.L  A7,A5
  1213. ⓪(SUBA.W  D0,A7
  1214. ⓪(
  1215. ⓪(MOVE.L  A7,A2
  1216. ⓪(MOVEM.L A4/A6,-(A7)
  1217. ⓪(MOVE.L  A2,A6
  1218. ⓪(JMP     (A0)
  1219. ⓪&stackerror
  1220. ⓪(TRAP    #6
  1221. ⓪(DC.W    $BFF6    ; Stack overflow, caller caused
  1222. ⓪(BRA     cont
  1223. ⓪$END
  1224. ⓪"END @RES2;
  1225. ⓪ 
  1226. ⓪ PROCEDURE @RES3; END @RES3;
  1227. ⓪ PROCEDURE @RES4; END @RES4;
  1228. ⓪ PROCEDURE @RES5; END @RES5;
  1229. ⓪ PROCEDURE @RES6; END @RES6;
  1230. ⓪ PROCEDURE @RES7; END @RES7;
  1231. ⓪ PROCEDURE @RES8; END @RES8;
  1232. ⓪ PROCEDURE @RES9; END @RES9;
  1233. ⓪ 
  1234. ⓪ 
  1235. ⓪ PROCEDURE CAP (ch: CHAR): CHAR;
  1236. ⓪ BEGIN
  1237. ⓪"ASSEMBLER
  1238. ⓪(CLR     D0
  1239. ⓪(MOVE.B  -2(A3),D0
  1240. ⓪(LEA     tab(PC),A0
  1241. ⓪(MOVE.B  0(A0,D0.W),-2(A3)
  1242. ⓪(RTS
  1243. ⓪"
  1244. ⓪"tab:  DC.B $00,$01,$02,$03,$04,$05,$06,$07,$08,$09,$0A,$0B,$0C,$0D,$0E,$0F
  1245. ⓪(DC.B $10,$11,$12,$13,$14,$15,$16,$17,$18,$19,$1A,$1B,$1C,$1D,$1E,$1F
  1246. ⓪(DC.B ' ','!','"','#','$','%','&',$27,'(',')','*','+',',','-','.','/'
  1247. ⓪(DC.B '0','1','2','3','4','5','6','7','8','9',':',';','<','=','>','?'
  1248. ⓪(DC.B '@','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O'
  1249. ⓪(DC.B 'P','Q','R','S','T','U','V','W','X','Y','Z','[','\',']','^','_'
  1250. ⓪(DC.B '`','A','B','C','D','E','F','G','H','I','J','K','L','M','N','O'
  1251. ⓪(DC.B 'P','Q','R','S','T','U','V','W','X','Y','Z','{','|','}','~',''
  1252. ⓪(DC.B 'Ç','Ü','É','A','Ä','À','Å','Ç','E','E','E','I','I','I','Ä','Å'
  1253. ⓪(DC.B 'É','Æ','Æ','O','Ö','O','U','U','ÿ','Ö','Ü','¢','£','¥','ß','ƒ'
  1254. ⓪(DC.B 'A','I','O','U','Ñ','Ñ','ª','º','¿','⌐','¬','½','¼','¡','«','»'
  1255. ⓪(DC.B 'Ã','Õ','Ø','Ø','Œ','Œ','À','Ã','Õ','¨','´','†','¶','©','®','™'
  1256. ⓪(DC.B 'IJ','IJ','א','ב','ג','ד','ה','ו','ז','ח','ט','י','כ','ל','מ','נ'
  1257. ⓪(DC.B 'ס','ע','פ','צ','ק','ר','ש','ת','ן','ך','ם','ף','ץ','§','∧','∞'
  1258. ⓪(DC.B 'α','β','Γ','π','Σ','σ','µ','τ','Φ','Θ','Ω','δ','∮','ϕ','∈','∩'
  1259. ⓪(DC.B '≡','±','≥','≤','⌠','⌡','÷','≈','°','∙','·','√','ⁿ','²','³','¯'
  1260. ⓪"END
  1261. ⓪ END CAP;
  1262. ⓪ 
  1263. ⓪ 
  1264. ⓪ PROCEDURE CHR (c: WORD): CHAR;
  1265. ⓪ BEGIN ASSEMBLER
  1266. ⓪(MOVE.B  -(A3),D0        ;Low-Byte wird Char
  1267. ⓪(TST.B   -(A3)
  1268. ⓪(BEQ     ok              ;High-Byte muss 0 sein
  1269. ⓪(LINK    A5,#0
  1270. ⓪(TRAP    #6
  1271. ⓪(DC.W    -7-$4000 ;Overflow
  1272. ⓪(UNLK    A5
  1273. ⓪#ok   MOVE.B  D0,(A3)+
  1274. ⓪(CLR.B   (A3)+
  1275. ⓪'END
  1276. ⓪ END CHR;
  1277. ⓪ 
  1278. ⓪ PROCEDURE HALT;
  1279. ⓪ BEGIN
  1280. ⓪"ASSEMBLER
  1281. ⓪(LINK    A5,#0
  1282. ⓪(TRAP    #6
  1283. ⓪(DC.W    -11-$4000       ; HALT
  1284. ⓪(UNLK    A5
  1285. ⓪"END
  1286. ⓪ END HALT;
  1287. ⓪ 
  1288. ⓪ PROCEDURE FLOAT(i: LONGCARD): LONGREAL;
  1289. ⓪ BEGIN
  1290. ⓪"ASSEMBLER
  1291. ⓪ (*$? ~A68881 & ~M68881:
  1292. ⓪&MOVE.W #$0102,D0  ;Exponent 32
  1293. ⓪&MOVE.L -(A3),D1
  1294. ⓪&BEQ    ZERO
  1295. ⓪&BMI    Large      ;ist linksbündig
  1296. ⓪ POS   SUBQ.W #8,D0      ;linksbündig machen
  1297. ⓪&LSL.L  #1,D1
  1298. ⓪&BPL    POS
  1299. ⓪ Large SWAP   D0
  1300. ⓪&SWAP   D1
  1301. ⓪&MOVE.W D1,D0
  1302. ⓪&CLR.W  D1
  1303. ⓪&MOVE.L D0,(A3)+
  1304. ⓪&MOVE.L D1,(A3)+
  1305. ⓪&RTS
  1306. ⓪ !ZERO CLR.L (A3)+
  1307. ⓪&CLR.L (A3)+
  1308. ⓪ *)
  1309. ⓪ (*$? M68881:
  1310. ⓪(FMOVE.L -(A3),FP0    ; kein Runtime-Fehler möglich
  1311. ⓪(FMOVE.D FP0,(A3)+
  1312. ⓪ *)
  1313. ⓪ (*$? A68881:
  1314. ⓪(; FMOVE.L -(A3),FP0    ; kein Runtime-Fehler möglich
  1315. ⓪(MOVE.W  #$4000,fpcmd
  1316. ⓪ DoDl1   TST.B   fpstatlo
  1317. ⓪(BEQ     DoDl1
  1318. ⓪(MOVE.L  -(A3),fpop
  1319. ⓪(; FMOVE.D FP0,(A3)+
  1320. ⓪(MOVE.W  #$7400,fpcmd
  1321. ⓪ DoDl3   MOVE.B  fpstatlo,D0
  1322. ⓪(BEQ     DoDl3
  1323. ⓪(MOVE.L  fpop,(A3)+
  1324. ⓪(MOVE.L  fpop,(A3)+
  1325. ⓪(TST.B   fpstatlo
  1326. ⓪ *)
  1327. ⓪"END
  1328. ⓪ END FLOAT;
  1329. ⓪ 
  1330. ⓪ PROCEDURE TRUNC(r: LONGREAL): LONGCARD;
  1331. ⓪ BEGIN
  1332. ⓪"ASSEMBLER
  1333. ⓪ (*$? ~A68881 & ~M68881:
  1334. ⓪'LINK   A5,#0
  1335. ⓪'MOVEM.L D3-D4,-(A7)
  1336. ⓪ 
  1337. ⓪'MOVE.L -(A3),D0
  1338. ⓪'MOVE.L -(A3),D1
  1339. ⓪'SWAP   D1
  1340. ⓪'BTST   #0,D1
  1341. ⓪'BNE    nega      ;Zahl ist negativ -> Fehler
  1342. ⓪'ASR.W  #3,D1
  1343. ⓪'MOVE.W #32,D4
  1344. ⓪'SUB.W  D1,D4
  1345. ⓪'BLT    Err       ;Exponent war > 32: 0.FFF.. * 2^32 ist MaxLCard
  1346. ⓪'CMP.W  #32,D4
  1347. ⓪'BCC    ZERO      ;Exponent war <= 0
  1348. ⓪'MOVE.L D1,D2
  1349. ⓪'SWAP   D0
  1350. ⓪'MOVE.W D0,D2
  1351. ⓪'LSR.L  D4,D2
  1352. ⓪'BRA    X
  1353. ⓪!!ZERO CLR.L  D2
  1354. ⓪!!X    MOVE.L D2,(A3)+
  1355. ⓪'MOVEM.L (A7)+,D3-D4
  1356. ⓪'UNLK   A5
  1357. ⓪'RTS
  1358. ⓪ 
  1359. ⓪!!NEGA TRAP    #6
  1360. ⓪'DC.W    -6-$4000          ; Out of range: Arg. ist negativ
  1361. ⓪'BRA     cont
  1362. ⓪!!ERR  TRAP    #6
  1363. ⓪'DC.W    -7-$4000          ; Overflow: Arg. ist > MaxLCard
  1364. ⓪!!CONT CLR.L   (A3)+
  1365. ⓪'MOVEM.L (A7)+,D3-D4
  1366. ⓪'UNLK   A5
  1367. ⓪ *)
  1368. ⓪ (*$? M68881:
  1369. ⓪(; !!! Abfrage auf neg. Ergebnis und Überlauf fehlt noch!
  1370. ⓪(FINTRZ.D -(A3),FP0
  1371. ⓪(FMOVE.L  FP0,(A3)+
  1372. ⓪ *)
  1373. ⓪ (*$? A68881:
  1374. ⓪(; !!! Abfrage auf neg. Ergebnis fehlt noch!
  1375. ⓪(; FINTRZ.D -(A3),FP0
  1376. ⓪(MOVE.W  #$5403,fpcmd
  1377. ⓪ DoDl1   MOVE.B  fpstatlo,D0
  1378. ⓪(BEQ     DoDl1
  1379. ⓪(CMPI.B  #8,D0
  1380. ⓪(BNE     error2
  1381. ⓪(MOVE.L  -8(A3),fpop
  1382. ⓪(MOVE.L  -(A3),fpop
  1383. ⓪(SUBQ.L  #4,A3
  1384. ⓪(; FMOVE.L  FP0,(A3)+
  1385. ⓪(MOVE.W  #$6000,fpcmd
  1386. ⓪ DoDl3   MOVE.B  fpstatlo,D0
  1387. ⓪(BEQ     DoDl3
  1388. ⓪(CMPI.B  #2,D0
  1389. ⓪(BNE     error
  1390. ⓪(MOVE.L  fpop,(A3)+
  1391. ⓪(TST.B   fpstatlo
  1392. ⓪(RTS
  1393. ⓪ error2  SUBQ.L  #8,A3
  1394. ⓪ error   LINK    A5,#0
  1395. ⓪(JSR     FPUError
  1396. ⓪(UNLK    A5
  1397. ⓪(CLR.L   (A3)+
  1398. ⓪ *)
  1399. ⓪"END
  1400. ⓪ END TRUNC;
  1401. ⓪ 
  1402. ⓪ 
  1403. ⓪ (*$? A68881:
  1404. ⓪ PROCEDURE DoComp;
  1405. ⓪ BEGIN
  1406. ⓪"ASSEMBLER
  1407. ⓪+LEA     -16(A3),A3
  1408. ⓪+MOVE.L  A3,A0
  1409. ⓪+MOVE.W  #$5400,fpcmd
  1410. ⓪"!DoCl1   TST.B   fpstatlo
  1411. ⓪+BEQ     DoCl1
  1412. ⓪+MOVE.L  (A0)+,fpop
  1413. ⓪+MOVE.L  (A0)+,fpop
  1414. ⓪+MOVE.W  #$5438,fpcmd        ;FCMP  ?,FP0
  1415. ⓪"!DoCl2   MOVE.B  fpstatlo,D0
  1416. ⓪+BEQ     DoCl2
  1417. ⓪+CMPI.B  #8,D0
  1418. ⓪+BNE     DoCError
  1419. ⓪+MOVE.L  (A0)+,fpop
  1420. ⓪+MOVE.L  (A0)+,fpop
  1421. ⓪+MOVE.W  D1,fpcond
  1422. ⓪+CLR.W   D0
  1423. ⓪+MOVE.B  fpstatlo,D0
  1424. ⓪+MOVE.W  D0,(A3)+
  1425. ⓪+RTS
  1426. ⓪"!DoCError
  1427. ⓪+LINK    A5,#0
  1428. ⓪+JSR     FPUError
  1429. ⓪+UNLK    A5
  1430. ⓪+CLR     (A3)+
  1431. ⓪"END;
  1432. ⓪ END DoComp;
  1433. ⓪ *)
  1434. ⓪ 
  1435. ⓪ 
  1436. ⓪ PROCEDURE @RELE (a,b:LONGREAL):BOOLEAN;        (* Op1 <= Op2, neu *)
  1437. ⓪ BEGIN ASSEMBLER
  1438. ⓪&(*$? ~A68881:
  1439. ⓪(MOVEM.L D3/D4,-(A7)
  1440. ⓪(MOVEQ  #16,D4
  1441. ⓪(MOVE.L -(A3),D0    ;zweiter Operand
  1442. ⓪(MOVE.L -(A3),D1
  1443. ⓪(BEQ    zer2
  1444. ⓪(MOVE.L -(A3),D2    ;erster Operand
  1445. ⓪(MOVE.L -(A3),D3
  1446. ⓪(BEQ    zer1
  1447. ⓪(BTST   D4,D3
  1448. ⓪(BNE    neg1        ;Op1 negativ
  1449. ⓪(BTST   D4,D1
  1450. ⓪(BNE    neg2        ;Op2 negativ
  1451. ⓪(CMP.L  D1,D3       ;beide Operanden positiv
  1452. ⓪(BLT    neg3
  1453. ⓪(BGT    neg2
  1454. ⓪(CMP.L  D0,D2
  1455. ⓪(BLS    neg3
  1456. ⓪(BRA    neg2
  1457. ⓪!neg1   BTST   D4,D1
  1458. ⓪(BEQ    neg3        ;Op1 negativ, Op2 positiv
  1459. ⓪(CMP.L  D3,D1
  1460. ⓪(BLT    neg3
  1461. ⓪(BGT    neg2
  1462. ⓪(CMP.L  D2,D0
  1463. ⓪(BLS    neg3
  1464. ⓪!neg2   CLR.W  (A3)+       ;Op1 positiv, Op2 negativ
  1465. ⓪(MOVEM.L (A7)+,D3/D4
  1466. ⓪(RTS
  1467. ⓪!zer2   SUBQ.L #4,A3       ;Op2 Null, Op1 <= 0 ?
  1468. ⓪(MOVE.L -(A3),D3
  1469. ⓪(BEQ    neg3        ;Op1 = Op2 = 0
  1470. ⓪(BTST   D4,D3
  1471. ⓪(BNE    neg3        ;Op2 = 0; Op1 < 0
  1472. ⓪(BRA    neg2
  1473. ⓪!zer1   BTST   D4,D1       ;Op1 Null, Op2 # 0: ist Op2 < 0?
  1474. ⓪(BNE    neg2        ; ja
  1475. ⓪!neg3   MOVEM.L (A7)+,D3/D4
  1476. ⓪(MOVE.W #TRUE,(A3)+
  1477. ⓪&*)
  1478. ⓪&(*$? A68881:
  1479. ⓪(MOVE.W #$15,D1     ;Conditional LE
  1480. ⓪(JMP    DoComp
  1481. ⓪&*)
  1482. ⓪'END
  1483. ⓪ END @RELE;
  1484. ⓪ 
  1485. ⓪ PROCEDURE @REGE (a,b:LONGREAL):BOOLEAN;
  1486. ⓪ BEGIN ASSEMBLER
  1487. ⓪&(*$? ~A68881:
  1488. ⓪(MOVEM.L D3/D4,-(A7)
  1489. ⓪(MOVEQ  #16,D4
  1490. ⓪(MOVE.L -(A3),D0    ;zweiter Operand
  1491. ⓪(MOVE.L -(A3),D1
  1492. ⓪(BEQ    zer2
  1493. ⓪(MOVE.L -(A3),D2    ;erster Operand
  1494. ⓪(MOVE.L -(A3),D3
  1495. ⓪(BEQ    zer1
  1496. ⓪(BTST   D4,D3
  1497. ⓪(BNE    neg1        ;Op1 negativ
  1498. ⓪(BTST   D4,D1
  1499. ⓪(BNE    neg2        ;Op2 negativ
  1500. ⓪(CMP.L  D1,D3       ;beide Operanden positiv
  1501. ⓪(BLT    neg3
  1502. ⓪(BGT    neg2
  1503. ⓪(CMP.L  D0,D2
  1504. ⓪(BCS    neg3
  1505. ⓪(BRA    neg2
  1506. ⓪!neg1   BTST   D4,D1
  1507. ⓪(BEQ    neg3        ;Op1 negativ, Op2 positiv
  1508. ⓪(CMP.L  D3,D1
  1509. ⓪(BLT    neg3
  1510. ⓪(BGT    neg2
  1511. ⓪(CMP.L  D2,D0
  1512. ⓪(BCS    neg3
  1513. ⓪!neg2   MOVE.W #true,(A3)+ ;Op1 positiv, Op2 negativ
  1514. ⓪(MOVEM.L (A7)+,D3/D4
  1515. ⓪(RTS
  1516. ⓪!zer2   SUBQ.L #4,A3       ;Op2 Null, Op1 <= 0 ?
  1517. ⓪(MOVE.L -(A3),D3
  1518. ⓪(BEQ    neg2        ;beide Null
  1519. ⓪(BTST   D4,D3
  1520. ⓪(BNE    neg3        ;Op2 = 0, Op1 < 0
  1521. ⓪(BRA    neg2        ;Op2 = 0, Op1 > 0
  1522. ⓪!zer1   BTST   D4,D1       ;Op1 = 0, Op2 # 0: ist Op2 > 0?
  1523. ⓪(BNE    neg2        ; nein
  1524. ⓪!neg3   CLR.W  (A3)+       ;Op1 negativ, Op2 positiv
  1525. ⓪(MOVEM.L (A7)+,D3/D4
  1526. ⓪&*)
  1527. ⓪&(*$? A68881:
  1528. ⓪(MOVE.W #$13,D1     ;Conditional GE
  1529. ⓪(JMP    DoComp
  1530. ⓪&*)
  1531. ⓪#END
  1532. ⓪ END @REGE;
  1533. ⓪ 
  1534. ⓪ PROCEDURE @RELT (a,b:LONGREAL):BOOLEAN;
  1535. ⓪ BEGIN ASSEMBLER
  1536. ⓪&(*$? ~A68881:
  1537. ⓪(MOVEM.L D3/D4,-(A7)
  1538. ⓪(MOVEQ  #16,D4
  1539. ⓪(MOVE.L -(A3),D0    ;zweiter Operand
  1540. ⓪(MOVE.L -(A3),D1
  1541. ⓪(BEQ    zer2
  1542. ⓪(MOVE.L -(A3),D2    ;erster Operand
  1543. ⓪(MOVE.L -(A3),D3
  1544. ⓪(BEQ    zer1
  1545. ⓪(BTST   D4,D3
  1546. ⓪(BNE    neg1        ;Op1 negativ
  1547. ⓪(BTST   D4,D1
  1548. ⓪(BNE    neg2        ;Op2 negativ
  1549. ⓪(CMP.L  D1,D3       ;beide Operanden positiv
  1550. ⓪(BLT    neg3
  1551. ⓪(BGT    neg2
  1552. ⓪(CMP.L  D0,D2
  1553. ⓪(BCS    neg3
  1554. ⓪(BRA    neg2
  1555. ⓪!neg1   BTST   D4,D1
  1556. ⓪(BEQ    neg3        ;Op1 negativ, Op2 positiv
  1557. ⓪(CMP.L  D3,D1
  1558. ⓪(BLT    neg3
  1559. ⓪(BGT    neg2
  1560. ⓪(CMP.L  D2,D0
  1561. ⓪(BCS    neg3
  1562. ⓪!neg2   CLR.W  (A3)+       ;Op1 positiv, Op2 negativ
  1563. ⓪(MOVEM.L (A7)+,D3/D4
  1564. ⓪(RTS
  1565. ⓪!zer2   SUBQ.L #4,A3       ;Op2 Null, Op1 <= 0 ?
  1566. ⓪(MOVE.L -(A3),D3
  1567. ⓪(BEQ    neg2        ;beide Null
  1568. ⓪(BTST   D4,D3
  1569. ⓪(BNE    neg3        ;Op2 = 0, Op1 < 0
  1570. ⓪(BRA    neg2        ;Op2 = 0, Op1 > 0
  1571. ⓪!zer1   BTST   D4,D1       ;Op1 = 0, Op2 # 0: ist Op2 > 0?
  1572. ⓪(BNE    neg2        ; nein
  1573. ⓪!neg3   MOVE.W #TRUE,(A3)+ ;Op1 negativ, Op2 positiv
  1574. ⓪(MOVEM.L (A7)+,D3/D4
  1575. ⓪&*)
  1576. ⓪&(*$? A68881:
  1577. ⓪(MOVE.W #$14,D1     ;Conditional LT
  1578. ⓪(JMP    DoComp
  1579. ⓪&*)
  1580. ⓪&END
  1581. ⓪ END @RELT;
  1582. ⓪ 
  1583. ⓪ PROCEDURE @REGT (a,b:LONGREAL):BOOLEAN;
  1584. ⓪ BEGIN
  1585. ⓪"ASSEMBLER
  1586. ⓪"(*$? ~A68881:
  1587. ⓪(MOVEM.L D3/D4,-(A7)
  1588. ⓪(MOVEQ  #16,D4
  1589. ⓪(MOVE.L -(A3),D0    ;zweiter Operand
  1590. ⓪(MOVE.L -(A3),D1
  1591. ⓪(BEQ    zer2
  1592. ⓪(MOVE.L -(A3),D2    ;erster Operand
  1593. ⓪(MOVE.L -(A3),D3
  1594. ⓪(BEQ    zer1
  1595. ⓪(BTST   D4,D3
  1596. ⓪(BNE    neg1        ;Op1 negativ
  1597. ⓪(BTST   D4,D1
  1598. ⓪(BNE    neg2        ;Op2 negativ
  1599. ⓪(CMP.L  D1,D3       ;beide Operanden positiv
  1600. ⓪(BLT    neg3
  1601. ⓪(BGT    neg2
  1602. ⓪(CMP.L  D0,D2
  1603. ⓪(BLS    neg3
  1604. ⓪(BRA    neg2
  1605. ⓪!neg1   BTST   D4,D1
  1606. ⓪(BEQ    neg3        ;Op1 negativ, Op2 positiv
  1607. ⓪(CMP.L  D3,D1
  1608. ⓪(BLT    neg3
  1609. ⓪(BGT    neg2
  1610. ⓪(CMP.L  D2,D0
  1611. ⓪(BLS    neg3
  1612. ⓪!neg2   MOVE.W #true,(A3)+ ;Op1 positiv, Op2 negativ
  1613. ⓪(MOVEM.L (A7)+,D3/D4
  1614. ⓪(RTS
  1615. ⓪!zer2   SUBQ.L #4,A3       ;Op2 Null, Op1 <= 0 ?
  1616. ⓪(MOVE.L -(A3),D3
  1617. ⓪(BEQ    neg3        ;beide Null
  1618. ⓪(BTST   D4,D3
  1619. ⓪(BNE    neg3        ;Op2 = 0, Op1 < 0
  1620. ⓪(BRA    neg2        ;Op2 = 0, Op1 > 0
  1621. ⓪!zer1   BTST   D4,D1       ;Op1 = 0, Op2 # 0: ist Op2 > 0?
  1622. ⓪(BNE    neg2        ; nein
  1623. ⓪!neg3   CLR.W  (A3)+       ;Op1 negativ, Op2 positiv
  1624. ⓪(MOVEM.L (A7)+,D3/D4
  1625. ⓪!*)
  1626. ⓪!(*$? A68881:
  1627. ⓪(MOVE.W #$12,D1     ;Conditional GT
  1628. ⓪(JMP    DoComp
  1629. ⓪!*)
  1630. ⓪&END
  1631. ⓪ END @REGT;
  1632. ⓪ 
  1633. ⓪ 
  1634. ⓪ (********* Real-Arithmetik *********)
  1635. ⓪ PROCEDURE @RNEG (a:LONGREAL):LONGREAL;
  1636. ⓪ BEGIN
  1637. ⓪"ASSEMBLER
  1638. ⓪"(*$? ~A68881:
  1639. ⓪(TST.W  -8(A3)
  1640. ⓪(BEQ    ZERO
  1641. ⓪(BCHG   #0,-7(A3)
  1642. ⓪"!ZERO
  1643. ⓪"*)
  1644. ⓪"(*$? A68881:
  1645. ⓪(TST     -8(A3)
  1646. ⓪(BEQ     zero
  1647. ⓪(BCHG    #7,-8(A3)
  1648. ⓪"!zero RTS
  1649. ⓪"*)
  1650. ⓪$RTS
  1651. ⓪"END
  1652. ⓪ END @RNEG;
  1653. ⓪ 
  1654. ⓪ (*$? A68881:
  1655. ⓪ PROCEDURE DoDouble;
  1656. ⓪ (* Erwartet in Register D1 eine Co-Instruction *)
  1657. ⓪ BEGIN
  1658. ⓪"ASSEMBLER
  1659. ⓪+LEA     -16(A3),A3
  1660. ⓪+MOVE.L  A3,A0
  1661. ⓪+MOVE.W  #$5400,fpcmd
  1662. ⓪"!DoDl1   TST.B   fpstatlo
  1663. ⓪+BEQ     DoDl1
  1664. ⓪+MOVE.L  (A0)+,fpop
  1665. ⓪+MOVE.L  (A0)+,fpop
  1666. ⓪+MOVE.W  D1,fpcmd
  1667. ⓪"!DoDl2   TST.B   fpstatlo
  1668. ⓪+BEQ     DoDl2
  1669. ⓪+MOVE.L  (A0)+,fpop
  1670. ⓪+MOVE.L  (A0)+,fpop
  1671. ⓪+MOVE.W  #$7400,fpcmd
  1672. ⓪"!DoDl3   MOVE.B  fpstatlo,D0
  1673. ⓪+BEQ     DoDl3
  1674. ⓪+CMPI.B  #8,D0
  1675. ⓪+BNE     DoDErr
  1676. ⓪"!GoBack  MOVE.L  fpop,(A3)+
  1677. ⓪+MOVE.L  fpop,(A3)+
  1678. ⓪+MOVE.W  fpstat,D0
  1679. ⓪+CMPI.B  #2,D0
  1680. ⓪+BNE     DoDErr2
  1681. ⓪+RTS
  1682. ⓪"!DoDErr2 SUBQ.L  #8,A3
  1683. ⓪"!DoDErr  LINK    A5,#0
  1684. ⓪+JSR     FPUError
  1685. ⓪+UNLK    A5
  1686. ⓪+CLR.L   (A3)+        ; RETURN 0.0
  1687. ⓪+CLR.L   (A3)+
  1688. ⓪"END;
  1689. ⓪ END DoDouble;
  1690. ⓪ *)
  1691. ⓪ 
  1692. ⓪ PROCEDURE @RMUL (a,b:LONGREAL):LONGREAL;
  1693. ⓪ BEGIN
  1694. ⓪"ASSEMBLER
  1695. ⓪"(*$? ~A68881:
  1696. ⓪+LINK    A5,#0
  1697. ⓪+MOVEM.L D3-D7,-(A7)
  1698. ⓪+MOVEM.W -16(A3),D0-D7
  1699. ⓪+TST.W   D0           ;Op1 = 0 ?
  1700. ⓪+BEQ.L   ZERO
  1701. ⓪+TST.W   D4           ;Op2 = 0 ?
  1702. ⓪+BEQ.L   ZERO
  1703. ⓪+ADD.W   D0,D4        ;vorl. Exponent; neues Sign in bit0
  1704. ⓪+BVS.L   range        ;Ueber/Unterlauf
  1705. ⓪+MOVE.W  D4,-(A7)
  1706. ⓪+MOVE.W  D3,D4
  1707. ⓪+MULU    D7,D4
  1708. ⓪+CLR.W   D4
  1709. ⓪+SWAP    D4
  1710. ⓪+CLR.W   D5
  1711. ⓪+MOVE.W  D3,D0
  1712. ⓪+MULU    D6,D0
  1713. ⓪+ADD.L   D0,D4
  1714. ⓪+BCC     L0
  1715. ⓪+ADDQ.W  #1,D5
  1716. ⓪"!L0      MOVE.W  D2,D0
  1717. ⓪+MULU    D7,D0
  1718. ⓪+ADD.L   D0,D4
  1719. ⓪+BCC     L1
  1720. ⓪+ADDQ.W  #1,D5
  1721. ⓪"!L1      MOVE.W  D5,D4
  1722. ⓪+SWAP    D4
  1723. ⓪+CLR.W   D5
  1724. ⓪+MULU    D1,D7
  1725. ⓪+ADD.L   D7,D4
  1726. ⓪+BCC     L2
  1727. ⓪+ADDQ.W  #1,D5
  1728. ⓪"!L2      MOVE.W  -6(A3),D7
  1729. ⓪+MOVE.W  D2,D0
  1730. ⓪+MULU    D6,D0
  1731. ⓪+ADD.L   D0,D4
  1732. ⓪+BCC     L3
  1733. ⓪+ADDQ.W  #1,D5
  1734. ⓪"!L3      MULU    D7,D3
  1735. ⓪+ADD.L   D3,D4
  1736. ⓪+BCC     L4
  1737. ⓪+ADDQ.W  #1,D5
  1738. ⓪"!L4      MOVE.W  D4,D3
  1739. ⓪+MOVE.W  D5,D4
  1740. ⓪+SWAP    D4
  1741. ⓪+CLR.W   D5
  1742. ⓪+MULU    D7,D2
  1743. ⓪+ADD.L   D2,D4
  1744. ⓪+BCC     L5
  1745. ⓪+ADDQ.W  #1,D5
  1746. ⓪"!L5      MULU    D1,D6
  1747. ⓪+ADD.L   D6,D4
  1748. ⓪+BCC     L6
  1749. ⓪+ADDQ.W  #1,D5
  1750. ⓪"!L6      MOVE.W  D4,D6
  1751. ⓪+MOVE.W  D5,D4
  1752. ⓪+SWAP    D4
  1753. ⓪+MULU    D7,D1
  1754. ⓪+
  1755. ⓪+MOVE.W  (A7)+,D7
  1756. ⓪+ADD.L   D1,D4
  1757. ⓪+BMI     ISADJ
  1758. ⓪+ADD.W   D3,D3
  1759. ⓪+ADDX.W  D6,D6
  1760. ⓪+ADDX.L  D4,D4
  1761. ⓪+SUBQ.W  #8,D7
  1762. ⓪+BVS     ZERO
  1763. ⓪"!ISADJ   TST.W   D3
  1764. ⓪+BPL     NORND
  1765. ⓪+ADDQ.W  #1,D6
  1766. ⓪+BCC     NORND
  1767. ⓪+ADDQ.L  #1,D4
  1768. ⓪+BCC     NORND
  1769. ⓪+ADDQ.W  #8,D7
  1770. ⓪+BSET    #31,D4
  1771. ⓪"!NORND   BSET    #1,D7        ;markiere als # 0
  1772. ⓪+BCLR    #2,D7        ;loesche Schutzbit
  1773. ⓪+SUBA.W  #16,A3
  1774. ⓪+MOVE.W  D7,(A3)+
  1775. ⓪+MOVE.L  D4,(A3)+
  1776. ⓪+MOVE.W  D6,(A3)+
  1777. ⓪+MOVEM.L (A7)+,D3-D7
  1778. ⓪+UNLK    A5
  1779. ⓪+RTS
  1780. ⓪+
  1781. ⓪"range    BMI     ovfl         ;Summe der Exponenten war so gross,
  1782. ⓪@;dass sie ins negative ueberlief
  1783. ⓪"zero     SUBA.W  #16,A3
  1784. ⓪+CLR.L   (A3)+
  1785. ⓪+CLR.L   (A3)+
  1786. ⓪+MOVEM.L (A7)+,D3-D7
  1787. ⓪+UNLK    A5
  1788. ⓪+RTS
  1789. ⓪+
  1790. ⓪"ovfl     SUBA.W  #16,A3
  1791. ⓪+TRAP    #6
  1792. ⓪+DC.W    -7-$4000     ;overflow
  1793. ⓪+CLR.L   (A3)+
  1794. ⓪+CLR.L   (A3)+
  1795. ⓪+MOVEM.L (A7)+,D3-D7
  1796. ⓪+UNLK    A5
  1797. ⓪"*)
  1798. ⓪"(*$? A68881:
  1799. ⓪+MOVE.W  #$5423,D1
  1800. ⓪+JMP     DoDouble
  1801. ⓪"*)
  1802. ⓪"END
  1803. ⓪ END @RMUL;
  1804. ⓪ 
  1805. ⓪ 
  1806. ⓪ PROCEDURE @RDIV (a,b:LONGREAL):LONGREAL;
  1807. ⓪ BEGIN
  1808. ⓪"ASSEMBLER
  1809. ⓪"(*$? ~A68881:
  1810. ⓪(LINK    A5,#0
  1811. ⓪(MOVEM.L D3-D7,-(A7)
  1812. ⓪(MOVE.W  -(A3),D5
  1813. ⓪(MOVE.L  -(A3),D4
  1814. ⓪(MOVE.W  -(A3),D1
  1815. ⓪(MOVE.W  -(A3),D3
  1816. ⓪(MOVE.L  -(A3),D2
  1817. ⓪(MOVE.W  -(A3),D0
  1818. ⓪(JSR     @FPDIV
  1819. ⓪(MOVEM.L (A7)+,D3-D7
  1820. ⓪(UNLK    A5
  1821. ⓪"*)
  1822. ⓪"(*$? A68881:
  1823. ⓪'MOVE.W   #$5420,D1
  1824. ⓪'JMP      DoDouble
  1825. ⓪"*)
  1826. ⓪"END
  1827. ⓪ END @RDIV;
  1828. ⓪ 
  1829. ⓪ PROCEDURE @FPDIV;
  1830. ⓪ BEGIN
  1831. ⓪"ASSEMBLER
  1832. ⓪"(*$? ~A68881:
  1833. ⓪+TST.W   D0
  1834. ⓪+BEQ.L   ZERO1
  1835. ⓪+TST.W   D1
  1836. ⓪+BEQ.L   DIVBY0
  1837. ⓪+BCLR    #1,D1        ; !TT 01.04.88
  1838. ⓪+SUB.W   D1,D0        ;vorl. Exponent und Sign in D0
  1839. ⓪+BVS.L   range        ;Ueber/Unterlauf
  1840. ⓪+CLR.L   D7
  1841. ⓪+MOVEQ   #49,D1
  1842. ⓪+BRA     L1
  1843. ⓪"!L0      ADD.L   D7,D7
  1844. ⓪+ADDX.L  D6,D6
  1845. ⓪+ADD.W   D3,D3
  1846. ⓪+ADDX.L  D2,D2
  1847. ⓪+BCS     ONEBIT
  1848. ⓪"!L1      CMP.L   D2,D4
  1849. ⓪+BHI     ZERBIT
  1850. ⓪+BNE     ONEBIT
  1851. ⓪+CMP.W   D3,D5
  1852. ⓪+BHI     ZERBIT
  1853. ⓪"!ONEBIT  SUB.W   D5,D3
  1854. ⓪+SUBX.L  D4,D2
  1855. ⓪+ADDQ.B  #1,D7
  1856. ⓪"!ZERBIT  DBF     D1,L0
  1857. ⓪+BTST    #17,D6
  1858. ⓪+BEQ     LESS05
  1859. ⓪+LSR.L   #1,D6
  1860. ⓪+ROXR.L  #1,D7
  1861. ⓪+ADDQ.W  #8,D0
  1862. ⓪+BVS     ovfl
  1863. ⓪"!LESS05  LSR.L   #1,D6
  1864. ⓪+ROXR.L  #1,D7
  1865. ⓪+BCC     NORND
  1866. ⓪+ADDQ.L  #1,D7
  1867. ⓪+BCC     NORND
  1868. ⓪+ADDQ.W  #1,D6
  1869. ⓪+BCC     NORND
  1870. ⓪+ROXR.W  #1,D6
  1871. ⓪+ADDQ.W  #8,D0
  1872. ⓪+BVS     ovfl
  1873. ⓪"noRnd    BSET    #1,D0
  1874. ⓪+BCLR    #2,D0
  1875. ⓪+MOVE.W  D0,(A3)+
  1876. ⓪+MOVE.W  D6,(A3)+
  1877. ⓪+MOVE.L  D7,(A3)+
  1878. ⓪+RTS
  1879. ⓪+
  1880. ⓪"range    BMI     ovfl         ;Differenz der Exponenten war so gross,
  1881. ⓪@;dass sie ins negative ueberlief
  1882. ⓪"zero1    CLR.L   (A3)+
  1883. ⓪+CLR.L   (A3)+
  1884. ⓪+RTS
  1885. ⓪+
  1886. ⓪"ovfl     TRAP    #6
  1887. ⓪+DC.W    -7-$4000     ;overflow
  1888. ⓪+BRA     errend
  1889. ⓪+
  1890. ⓪"DivBy0   TRAP    #6
  1891. ⓪+DC.W    -5-$4000
  1892. ⓪"errend:  CLR.L   (A3)+
  1893. ⓪+CLR.L   (A3)+
  1894. ⓪"*)
  1895. ⓪"(*$? A68881:
  1896. ⓪+MOVE.W  D0,(A3)+
  1897. ⓪+MOVE.L  D2,(A3)+
  1898. ⓪+MOVE.W  D3,(A3)+
  1899. ⓪+MOVE.W  D1,(A3)+
  1900. ⓪+MOVE.L  D4,(A3)+
  1901. ⓪+MOVE.W  D5,(A3)+
  1902. ⓪+MOVE.W  #$5420,D1
  1903. ⓪+JMP     DoDouble
  1904. ⓪"*)
  1905. ⓪"END
  1906. ⓪ END @FPDIV;
  1907. ⓪ 
  1908. ⓪ 
  1909. ⓪ PROCEDURE @RADD (a,b:LONGREAL):LONGREAL;
  1910. ⓪ BEGIN
  1911. ⓪%ASSEMBLER
  1912. ⓪%(*$? ~A68881:
  1913. ⓪+LINK    A5,#0
  1914. ⓪+MOVEM.L D3-D7,-(A7)
  1915. ⓪+MOVEM.W -16(A3),D0-D7
  1916. ⓪+SWAP    D1
  1917. ⓪+MOVE.W  D2,D1        ;höchste 32 Mant.-Stellen (a) in D1
  1918. ⓪+SWAP    D5
  1919. ⓪+MOVE.W  D6,D5        ;höchste 32 Mant.-Stellen (b) in D5
  1920. ⓪+
  1921. ⓪+ANDI.W  #$FFFE,D0
  1922. ⓪+BEQ.L   RETN2        ;ein Argument ist 0
  1923. ⓪+ANDI.W  #$FFFE,D4
  1924. ⓪+BEQ.L   RETN1        ;ein Argument ist 0
  1925. ⓪+CLR.W   D6
  1926. ⓪+CMP.W   D0,D4
  1927. ⓪+BLT     PASST
  1928. ⓪+BNE     TAUSCH
  1929. ⓪+CMP.L   D1,D5
  1930. ⓪+BCS.L   PASST1
  1931. ⓪+BNE     TAUSCH
  1932. ⓪+CMP.W   D3,D7
  1933. ⓪+BLS.L   PASST1
  1934. ⓪"!TAUSCH  EXG     D0,D4
  1935. ⓪+EXG     D1,D5
  1936. ⓪+EXG     D3,D7
  1937. ⓪+MOVE.W  -16(A3),D2
  1938. ⓪+MOVE.W  -8(A3),-16(A3)
  1939. ⓪+MOVE.W  D2,-8(A3)
  1940. ⓪"
  1941. ⓪"!PASST   SUB.W   D4,D0        ;Exp.differenz immer positiv!
  1942. ⓪+LSR     #3,D0
  1943. ⓪+BEQ.L   PASST1
  1944. ⓪+CMP.W   #16,D0
  1945. ⓪+BEQ     S16
  1946. ⓪+BHI     SGT16
  1947. ⓪+SWAP    D7
  1948. ⓪+MOVE.W  D5,D7
  1949. ⓪+SWAP    D7
  1950. ⓪+LSR.L   D0,D5
  1951. ⓪+LSR.L   D0,D7
  1952. ⓪+BRA.L   DONE
  1953. ⓪"!S16     ADD.W   D7,D7
  1954. ⓪+MOVE.W  D5,D7
  1955. ⓪+CLR.W   D5
  1956. ⓪+SWAP    D5
  1957. ⓪+BRA     DONE
  1958. ⓪"!SGT16   CMP.W   #32,D0
  1959. ⓪+BEQ     S32
  1960. ⓪+BHI     SGT32
  1961. ⓪+SUB.W   #16,D0
  1962. ⓪+LSR.L   D0,D5
  1963. ⓪+MOVE.W  D5,D7
  1964. ⓪+CLR.W   D5
  1965. ⓪+SWAP    D5
  1966. ⓪+BRA     DONE
  1967. ⓪"!S32     ADD.W   D5,D5
  1968. ⓪+SWAP    D5
  1969. ⓪+MOVE.W  D5,D7
  1970. ⓪+CLR.L   D5
  1971. ⓪+BRA     DONE
  1972. ⓪"!S48     CLR.L   D5
  1973. ⓪+CLR.W   D7
  1974. ⓪+MOVEQ   #$FF,D6
  1975. ⓪+BRA     PASST1
  1976. ⓪"!SGT32   CMP.W   #48,D0
  1977. ⓪+BEQ     S48
  1978. ⓪+BHI.L   RETN1
  1979. ⓪+SUB.W   #32,D0
  1980. ⓪+SWAP    D5
  1981. ⓪+MOVE.W  D5,D7
  1982. ⓪+CLR.L   D5
  1983. ⓪+LSR.W   D0,D7
  1984. ⓪"!DONE    ROXR.W  #1,D6
  1985. ⓪"!PASST1  MOVE.W  -16(A3),D2   ;Vorzeichen beider Operanden gleich?
  1986. ⓪+MOVE.W  -8(A3),D0
  1987. ⓪+ADD.W   D2,D0
  1988. ⓪+BTST    #0,D0
  1989. ⓪+BNE     SUBTR
  1990. ⓪+ADD.W   D7,D3
  1991. ⓪+ADDX.L  D5,D1
  1992. ⓪+BCC     NOFL
  1993. ⓪+ROXR.L  #1,D1
  1994. ⓪+ROXR.W  #1,D3
  1995. ⓪+BCC     INCEX
  1996. ⓪+ADDQ.W  #1,D3
  1997. ⓪+BCC     INCEX
  1998. ⓪+ADDQ.L  #1,D1
  1999. ⓪"!INCEX   ADDQ.W  #8,D2        ;D2 ist Exp. der betr.mäßig größeren Zahl
  2000. ⓪+BVS.L   OVFL
  2001. ⓪"!FERTIG  SUBA.W  #16,A3
  2002. ⓪+MOVE.W  D2,(A3)+
  2003. ⓪+MOVE.L  D1,(A3)+
  2004. ⓪+MOVE.W  D3,(A3)+
  2005. ⓪+MOVEM.L (A7)+,D3-D7
  2006. ⓪+UNLK    A5
  2007. ⓪+RTS
  2008. ⓪+
  2009. ⓪"!NOFL    TST.W   D6
  2010. ⓪+BPL     FERTIG
  2011. ⓪+ADDQ.W  #1,D3
  2012. ⓪+BCC     FERTIG
  2013. ⓪+ADDQ.L  #1,D1
  2014. ⓪+BCC     FERTIG
  2015. ⓪+ROXR.L  #1,D1
  2016. ⓪+BRA     INCEX
  2017. ⓪"
  2018. ⓪"!SUBTR   ADD.W   D6,D6
  2019. ⓪+SCS     D6
  2020. ⓪+SUBX.W  D7,D3
  2021. ⓪+SUBX.L  D5,D1
  2022. ⓪+TST.L   D1
  2023. ⓪+BMI     FERTIG
  2024. ⓪+SUBQ.W  #8,D2
  2025. ⓪+ADD.W   D6,D6
  2026. ⓪+ADDX.W  D3,D3
  2027. ⓪+ADDX.L  D1,D1
  2028. ⓪+BMI.L   fertig
  2029. ⓪+BEQ     LGT32        ;Ausloeschung in der Mantisse.. normalisieren
  2030. ⓪+SWAP    D1
  2031. ⓪+TST.W   D1
  2032. ⓪+BNE     LLT16
  2033. ⓪+MOVE.W  D3,D1
  2034. ⓪+CLR.W   D3
  2035. ⓪+SUB.W   #128,D2      ;8 * (16 bit Shift)
  2036. ⓪+BVS     zero
  2037. ⓪+TST.L   D1
  2038. ⓪+BMI     fertig
  2039. ⓪"!L0      SUBQ.W  #8,D2
  2040. ⓪+BVS     zero
  2041. ⓪+ADD.L   D1,D1
  2042. ⓪+BPL     L0
  2043. ⓪+BRA     fertig
  2044. ⓪"!LLT16   SWAP    D1
  2045. ⓪"!L1      SUBQ.W  #8,D2
  2046. ⓪+BVS     zero
  2047. ⓪+ADD.W   D3,D3
  2048. ⓪+ADDX.L  D1,D1
  2049. ⓪+BPL     L1
  2050. ⓪+BRA     fertig
  2051. ⓪"!LGT32   SUB.W   #256,D2      ;8 * (32 bit Shift)
  2052. ⓪+BVS     zero
  2053. ⓪+MOVE.W  D3,D1
  2054. ⓪+BEQ.L   ZERO
  2055. ⓪+BMI     L3
  2056. ⓪"!L2      SUBQ.W  #8,D2
  2057. ⓪+BVS     zero
  2058. ⓪+ADD.W   D1,D1
  2059. ⓪+BPL     L2
  2060. ⓪"!L3      SWAP    D1
  2061. ⓪+CLR.W   D3
  2062. ⓪+BRA     fertig
  2063. ⓪"!ZERO    SUBA.W  #16,A3
  2064. ⓪+CLR.L   (A3)+
  2065. ⓪+CLR.L   (A3)+
  2066. ⓪+MOVEM.L (A7)+,D3-D7
  2067. ⓪+UNLK    A5
  2068. ⓪+RTS
  2069. ⓪+
  2070. ⓪"!RETN1   SUBA.W  #14,A3       ;Exponent stimmt schon
  2071. ⓪+MOVE.L  D1,(A3)+     ;Mantisse muß (bei Ausgang 2 hierher)
  2072. ⓪+MOVE.W  D3,(A3)+     ; noch getauscht werden!
  2073. ⓪+MOVEM.L (A7)+,D3-D7
  2074. ⓪+UNLK    A5
  2075. ⓪+RTS
  2076. ⓪+
  2077. ⓪"!RETN2   MOVE.L  -(A3),-8(A3)
  2078. ⓪+MOVE.L  -(A3),-8(A3)
  2079. ⓪+MOVEM.L (A7)+,D3-D7
  2080. ⓪+UNLK    A5
  2081. ⓪+RTS
  2082. ⓪+
  2083. ⓪"!OVFL    TRAP    #6
  2084. ⓪+DC.W    -7-$4000      ;overflow
  2085. ⓪+BRA     ZERO
  2086. ⓪"*)
  2087. ⓪"(*$? A68881:
  2088. ⓪+MOVE.W  #$5422,D1
  2089. ⓪+JMP     DoDouble
  2090. ⓪"*)
  2091. ⓪"END
  2092. ⓪ END @RADD;
  2093. ⓪ 
  2094. ⓪ PROCEDURE @RSUB (a,b:LONGREAL):LONGREAL;
  2095. ⓪ BEGIN
  2096. ⓪"ASSEMBLER
  2097. ⓪"(*$? ~A68881:
  2098. ⓪$TST.W  -8(A3)
  2099. ⓪$BEQ    N
  2100. ⓪$BCHG   #0,-7(A3)
  2101. ⓪"N JMP    @RADD
  2102. ⓪"*)
  2103. ⓪"(*$? A68881:
  2104. ⓪$MOVE.W #$5428,D1
  2105. ⓪$JMP    DoDouble
  2106. ⓪"*)
  2107. ⓪"END
  2108. ⓪ END @RSUB;
  2109. ⓪ 
  2110. ⓪ 
  2111. ⓪ BEGIN
  2112. ⓪"has020:= SysInfo.Has020 ();
  2113. ⓪ (*$? A68881:
  2114. ⓪"FPUInit
  2115. ⓪ *)
  2116. ⓪ END Runtime.
  2117. ⓪ ə
  2118. (* $00000A8D$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFEE685A$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34$FFFB3F34Ç$00000A3FT.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$00000028$FFEE685A$000014A5$00001A0C$00002342$00002CC0$00003461$0000352F$0000372B$00003739$00000A3F$000097A0$00009EAD$00009EB7$0000AC5E$0000AC68¼Çâ*)
  2119.