home *** CD-ROM | disk | FTP | other *** search
/ Aminet 18 / aminetcdnumber181997.iso / Aminet / dev / m2 / CycloneModules.lha / modules / txt / ModulaLib.mod < prev    next >
Text File  |  1996-10-20  |  15KB  |  688 lines
  1. IMPLEMENTATION MODULE ModulaLib;
  2.  
  3. (* 
  4.  * (C) Copyright 1993 Marcel Timmermans. All rights reserved. 
  5.  *  
  6.  * This is the startup module for the Cyclone Modula-2 Compiler.
  7.  * It contains some basic routines, type and variables that are
  8.  * needed to start and run Cyclone Modula-2 program's
  9.  *
  10.  * The compiler depends on the existance of the variables and routines
  11.  * defined in ModulaLib.def and ModulaLib.mod!!
  12.  * Modifying on of the modules without knowledge of this module and compiler
  13.  * will very likely cause several nasty problems
  14.  *
  15.  * VERSION     DATE      Author     Comment
  16.  * -------   --------    ------     -------
  17.  *  0.80     23.09.96    MT         First public release of this Module
  18.  *  0.81     20.09.96    MT         Removed ModDiv function and added 
  19.  *                                  BreakPoint procedure.
  20.  *)
  21.  
  22.  
  23. FROM SYSTEM IMPORT 
  24.   ASSEMBLE,ADDRESS,ADR,CAST;
  25.  
  26. IMPORT ExecD,DosD;
  27.  
  28. PROCEDURE CloseLibraryOwn(exec{14},n{9}: ADDRESS); CODE -414;
  29. PROCEDURE OpenLibraryOwn(exec{14},n{9}:ADDRESS;v{0}:LONGINT):ADDRESS;CODE -552;
  30. PROCEDURE AutoRequestOwn(intu{14},w{8},b{9},p{10},n{11},pf{0},nf{1}:ADDRESS;
  31.                          w{2},h{3}: INTEGER): LONGINT; CODE -348;
  32.  
  33.  
  34.  
  35. TYPE
  36.   IntuiText=RECORD
  37.    frontPen,backPen:SHORTCARD; (* the pen numbers for the rendering *)
  38.    drawMode:SHORTCARD;         (* the mode for rendering the text *)
  39.    leftEdge:INTEGER;           (* relative start location for the text *)
  40.    topEdge:INTEGER;            (* relative start location for the text *)
  41.    iTextFont:ADDRESS;          (* if NULL, you accept the default *)
  42.    iText:ADDRESS;              (* pointer to null-terminated text *)
  43.    nextText:ADDRESS;           (* pointer to another IntuiText to render *)
  44.   END;
  45.  
  46.   MemElementPtr = POINTER TO MemElement;
  47.   MemElement =  RECORD
  48.                  succ,pred: MemElementPtr;
  49.                  size: LONGINT;            (* the block's size  *)
  50.                  mem: INTEGER;             (* the actual data   *)
  51.                 END;
  52.  
  53.   MemList = RECORD
  54.               head, tail, tailPred: MemElementPtr;
  55.             END;            
  56.  
  57.  
  58. VAR oldTrap     : PROC;         (* Opaque typ for old trapcode *)
  59.     closeAll    : PROC;         (* Opaque typ for closing procedure *)
  60.     stackPtr    : LONGINT;
  61.     oldStack    : ADDRESS;
  62.     dosBase     : ADDRESS;
  63.     exec[4]     : ADDRESS;
  64.     oldDir      : ADDRESS;
  65.     oldData     : ADDRESS;      (* oldTrapdata address *)
  66.     AllocatedMem: LONGINT;
  67.     first       : MemList;
  68.  
  69. CONST 
  70.   dosName = "dos.library";
  71.   CurrentDir=-126;
  72.   AllocMem=-198;
  73.   OpenLibrary=-552;
  74.   CloseLibrary=-414;
  75.   WaitPort=-384;
  76.   GetMsg=-372;
  77.   Forbid=-132;
  78.   ReplyMsg=-378;
  79.   FreeMem=-210;
  80.   AddHead=-240;
  81.   Permit=-138;
  82.   Remove=-252;
  83.  
  84.  
  85. PROCEDURE InitIntuiText(VAR it{8}: IntuiText; left{0},top{1}: INTEGER;
  86.                          txt{2}: ADDRESS);
  87. (*$ EntryExitCode- *)
  88. BEGIN
  89.   ASSEMBLE(
  90.         MOVE.L  #$00010100,(A0)+ 
  91.         MOVE.W  D0,(A0)+ 
  92.         MOVE.W  D1,(A0)+ 
  93.         CLR.L   (A0)+   
  94.         MOVE.L  D2,(A0)+ 
  95.         CLR.L   (A0)+   
  96.         RTS
  97.   END);
  98. END InitIntuiText;
  99.  
  100.  
  101. PROCEDURE Requester(head,msg,pos,neg:ADDRESS):BOOLEAN;
  102. VAR 
  103.    body, text, ok, cancel : IntuiText;
  104.    win:ADDRESS;
  105.    intuition:ADDRESS;
  106.    RetVal:BOOLEAN;
  107.    OkAdr:ADDRESS;
  108. BEGIN
  109.  win:=NIL;
  110.  intuition:=OpenLibraryOwn(exec,ADR("intuition.library"),0);
  111.  IF intuition#NIL THEN
  112.   InitIntuiText(body,12,5,head);
  113.   InitIntuiText(text,12,16,msg); body.nextText:=ADR(text);
  114.   InitIntuiText(cancel,6,3,neg);
  115.   IF pos#NIL THEN 
  116.     InitIntuiText(ok,6,3,pos);  
  117.     OkAdr:=ADR(ok);
  118.   ELSE
  119.     OkAdr:=NIL;
  120.   END;
  121.   RetVal:=AutoRequestOwn(intuition,win,ADR(body),OkAdr,ADR(cancel),NIL,NIL,320,65)#0;
  122.   CloseLibraryOwn(exec,intuition);
  123.  END;
  124.  RETURN RetVal;
  125. END Requester;
  126.  
  127. PROCEDURE Terminate;
  128. (*$ EntryExitCode- *)
  129. BEGIN
  130.  ASSEMBLE(
  131.     MOVEA.L  closeAll(A4),A0
  132.     JMP     (A0)
  133.     END);
  134. END Terminate;
  135.  
  136. PROCEDURE Exit(returnCode{0}:LONGINT);
  137. (*$ EntryExitCode- *)
  138. BEGIN
  139. ASSEMBLE(
  140.     MOVE.L  D0,returnVal(A4)
  141.     BSR     Terminate   
  142.     END);
  143. END Exit;
  144.  
  145. PROCEDURE TerminateRequester(Msg:ADDRESS);
  146. BEGIN
  147.  IGNORE Requester(ADR("Amiga Modula-2 Terminator"),Msg,NIL,ADR("Oophs"));
  148.  Exit(10);
  149. END TerminateRequester;
  150.  
  151.  
  152. PROCEDURE TermOpenLib(Msg{9}:ADDRESS);
  153. BEGIN
  154.  IGNORE Requester(ADR("Error opening library "),Msg,NIL,ADR("Oophs"));
  155.  Exit(10);
  156. END TermOpenLib;
  157.  
  158. PROCEDURE Assert(cc: BOOLEAN; Msg:ADDRESS);
  159. BEGIN
  160.  IF  NOT cc THEN 
  161.    IF Requester(ADR("Amiga Modula-2 Assert"),Msg,ADR("Abort"),ADR("Continue")) THEN
  162.      Terminate;
  163.    END; 
  164.  END; 
  165. END Assert;
  166.  
  167. PROCEDURE BreakPoint(data : ADDRESS);
  168. (*$ EntryClear- RangeChk- OverflowChk- *)
  169. TYPE 
  170.  CPtr = POINTER TO ARRAY[0..100] OF CHAR;
  171. VAR 
  172.  title:ADDRESS;
  173.  len:SHORTINT; 
  174. BEGIN
  175.   IF (CAST(ExecD.TaskPtr,thisTask)^.node.type=ExecD.process) AND (CAST(DosD.ProcessPtr,thisTask)^.cli#NIL) THEN
  176.     title:=CAST(DosD.ProcessPtr,thisTask)^.cli^.commandName;   
  177.     len:=CAST(SHORTINT,(CAST(CPtr,title)^[0])); 
  178.     INC(title);
  179.     CAST(CPtr,title)^[len]:=0C;
  180.   ELSE
  181.     title:=CAST(ExecD.TaskPtr,thisTask)^.node.name;
  182.   END;
  183.   IGNORE Requester(title,data,NIL,ADR('OK')); 
  184. END BreakPoint;
  185.  
  186.  
  187. PROCEDURE Halt;
  188. BEGIN
  189.  Assert(FALSE,ADR("HALT!"));
  190. END Halt;
  191.  
  192. PROCEDURE New(VAR adr:ADDRESS;size:LONGINT);
  193. (* VAR mem{11}:MemElementPtr;*)
  194. (*$ EntryExitCode- *)
  195. BEGIN
  196. (*****
  197.  INC(size,12+SIZE(LONGINT));
  198.  Forbid;
  199.  mem:=AllocMem(size,MemReqSet{memClear});
  200.  IF mem=NIL THEN
  201.     adr:=NIL;
  202.  ELSE
  203.    mem^.size:=size;
  204.    AddHead(ADR(first),mem);
  205.    adr:=ADR(mem^.mem);
  206.  END;
  207.  Permit;
  208. *****)
  209.  ASSEMBLE(
  210.     LINK    A5,#0
  211.     MOVEM.L D7/A2-A3/A6,-(A7)
  212.     ADDI.L    #$00000010,8(A5)
  213.     MOVE.L  $4,A6
  214.     JSR    Forbid(A6)
  215.     MOVE.L    8(A5),D0
  216.     MOVE.L    #$00010000,D1
  217.     JSR    AllocMem(A6)
  218.     MOVEA.L D0,A3
  219.     MOVE.L    A3,D7
  220.     BNE.S    Else
  221.     MOVEA.L 12(A5),A2
  222.     CLR.L    (A2)
  223.     BRA.S    Quit
  224. Else:
  225.     MOVE.L    8(A5),8(A3)
  226.     LEA    first(A4),A0
  227.     MOVEA.L A3,A1
  228.     MOVE.L  $4,A6
  229.     JSR    AddHead(A6)
  230.     LEA    12(A3),A2
  231.     MOVEA.L 12(A5),A1
  232.     MOVE.L    A2,(A1)
  233. Quit:
  234.     MOVE.L  $4,A6
  235.     JSR    Permit(A6)
  236.     MOVEM.L (A7)+,D7/A2-A3/A6
  237.     UNLK    A5
  238.     MOVEA.L (A7)+,A0
  239.     ADDQ.L    #8,A7
  240.     JMP    (A0)
  241.  END);
  242. END New;
  243.  
  244. PROCEDURE Dispose(VAR adr: ADDRESS);
  245. (* VAR  mem{11}: MemElementPtr;*)
  246. (*$ EntryExitCode- *)
  247. BEGIN
  248. (****
  249.   IF adr#NIL THEN
  250.     mem := ADDRESS(LONGINT(adr)-12);
  251.     Forbid; 
  252.     Remove(mem);
  253.     FreeMem(mem,mem^.size);
  254.     Permit;
  255.     adr := NIL;
  256.   END;
  257.  ****)
  258.  ASSEMBLE(
  259.     LINK    A5,#0
  260.     MOVEM.L D7/A2-A3/A6,-(A7)
  261.     MOVEA.L 8(A5),A2
  262.     TST.L    (A2)
  263.     BEQ.S    Quit
  264.     MOVEA.L 8(A5),A2
  265.     MOVE.L    (A2),D7
  266.     SUBI.L    #$0000000C,D7
  267.     MOVEA.L D7,A3
  268.     MOVE.L  $4,A6
  269.     JSR    Forbid(A6)
  270.     MOVEA.L A3,A1
  271.     JSR    Remove(A6)
  272.     MOVEA.L A3,A1
  273.     MOVE.L    8(A3),D0
  274.     JSR    FreeMem(A6)
  275.     JSR    Permit(A6)
  276.     MOVEA.L 8(A5),A2
  277.     CLR.L    (A2)
  278. Quit:
  279.     MOVEM.L (A7)+,D7/A2-A3/A6
  280.     UNLK    A5
  281.     MOVEA.L (A7)+,A0
  282.     ADDQ.L    #4,A7
  283.     JMP    (A0)
  284.  END);
  285. END Dispose;
  286.  
  287. PROCEDURE ClearMemList;
  288. (*VAR e1{10},e2{11}:MemElementPtr;*)
  289. (*$ EntryExitCode- *)
  290. BEGIN
  291. (*****
  292.   e1 := first.head;
  293.   LOOP
  294.     e2 := e1^.succ;
  295.     IF e2=NIL THEN EXIT END;
  296.     FreeMem(e1,e1^.size);
  297.     e1:=e2;
  298.   END; 
  299.  ****)
  300.  ASSEMBLE(
  301.     MOVEM.L D7/A2-A3/A6,-(A7)
  302.     MOVEA.L first.head(A4),A2
  303. L0:
  304.     MOVEA.L (A2),A3
  305.     MOVE.L    A3,D7
  306.     BNE.S    L1
  307.     BRA.S    L2
  308. L1:
  309.     MOVEA.L A2,A1
  310.     MOVE.L    8(A2),D0
  311.     MOVE.L  $4,A6
  312.     JSR    FreeMem(A6)
  313.     MOVEA.L A3,A2
  314.     BRA.S    L0
  315. L2:
  316.     MOVEM.L (A7)+,D7/A2-A3/A6
  317.     RTS
  318.  END);
  319. END ClearMemList;
  320.  
  321. PROCEDURE StoredA4; 
  322. (*$ EntryExitCode- *)
  323. BEGIN 
  324.  ASSEMBLE(DC.L 0 END); 
  325. END StoredA4;
  326.  
  327. PROCEDURE LoadA4;
  328. (*$ EntryExitCode- *)
  329. (* restoring global data address *)
  330. BEGIN
  331.  ASSEMBLE(
  332.     MOVE.L  A0,-(A7)
  333.     LEA     StoredA4(PC),A0
  334.     MOVEA.L (A0),A4
  335.     MOVE.L  (A7)+,A0
  336.     RTS
  337.  END);
  338. END LoadA4;
  339.  
  340. PROCEDURE easystartup;
  341. (*$ EntryExitCode- *)
  342. BEGIN
  343.  ASSEMBLE(
  344.         XREF    VAR_MemSize, VAR_MemSet
  345.         XREF    __main,__mainEND
  346.  
  347.         MOVEM.L D2-D7/A2-A6,-(A7)
  348.  
  349.         (* Save Dos cmdBuf & cmdLen *)
  350.         MOVEA.L  A0,A2
  351.         MOVE.L   D0,D2
  352.  
  353.         MOVEA.L exec,A6           (* exec to a6 *)
  354.  
  355.         (* Need to clear al of our global var's *)
  356.         MOVE.L  #VAR_MemSize,D0
  357.         MOVE.L  #VAR_MemSet,D1
  358.         MOVE.L  D0,D2
  359.         JSR     AllocMem(A6)
  360.         TST.L   D0
  361.         BNE.S   MemOk
  362.         MOVEQ   #20,D0
  363.         BRA     ByeBye
  364.   MemOk:
  365.         MOVEA.L D0,A4
  366.         MOVE.L  D2,AllocatedMem(A4)
  367.         MOVE.L  A7,stackPtr(A4)
  368.  
  369.         (* Keep our task in address A3 & thisTask *)
  370.         MOVEA.L (*ExecBase.thisTask*) 276(A6),A3
  371.         MOVE.L  A3,thisTask(A4)
  372.  
  373.         (* Save some var's *)
  374.         MOVE.W  (*Library.version*) 20(A6),kickVersion(A4)
  375.  
  376.         (* Save the current directory *)
  377.         MOVE.L  (*Process.currentDir*) 152(A3),oldDir(A4)
  378.  
  379.  
  380. (* open dos library *) 
  381.         LEA     dosName(PC),A1
  382.         MOVEQ   #0,D0
  383.         JSR     OpenLibrary(A6) 
  384.         MOVE.L  D0,dosBase(A4)
  385.  
  386. (* from cli or wb ? *)
  387.         TST.L   172(A3)
  388.         SEQ     wbStarted(A4)
  389.         BEQ.S   fromWorkbench
  390.  
  391. (* CLI Startup Code *)
  392.  
  393.         MOVE.L  D2,dosCmdLen(A4)
  394.         MOVE.L  A2,dosCmdBuf(A4)
  395.                 
  396.         BRA.S   EndStartup
  397.  
  398. fromWorkbench:
  399.         LEA     92(A3),A0
  400.         JSR     WaitPort(A6)
  401.         LEA     92(A3),A0
  402.         JSR     GetMsg(A6)
  403.         MOVE.L  D0,wbenchMsg(A4)
  404.         (* get lock *)
  405.         MOVE.L  D0,A2
  406.         MOVE.L  (* WBStartup.argList*) 36(A2),D0
  407.         BEQ.S   doCons
  408.         MOVEA.L D0,A0
  409.         MOVE.L  dosBase(A4),A6
  410.         MOVE.L  (* WBArg.lock*) 0(A0),D1
  411.         JSR     CurrentDir(A6)
  412. doCons:
  413.  
  414. EndStartup:
  415.         MOVE.L  (*Task.trapCode*) 50(A3),oldTrap(A4)
  416.         LEA     StoredA4(PC),A0
  417.         MOVE.L  A4,(A0)  (* Store Globaldata address *)
  418.  
  419.         LEA     goEnd(PC),A0
  420.         MOVE.L  A0,closeAll(A4)
  421.         MOVE.L  A7,oldStack(A4)
  422.  
  423.         JSR     __main(PC)
  424.  
  425. goEnd:
  426.         LEA     StoredA4(PC),A0
  427.         MOVE.L  (A0),A4 (* Make sure A4 is correctly loaded *)
  428.  
  429.         MOVEA.L  oldStack(A4),A7
  430.         
  431.         JSR     __mainEND(PC)
  432.  
  433.         BSR     ClearMemList(PC)
  434.  
  435. (* retore stackptr *)
  436.         MOVEA.L stackPtr(A4),A7
  437.  
  438. (* restore old current directory *)
  439.         MOVEA.L  dosBase(A4),A6
  440.         MOVE.L  oldDir(A4),D1
  441.         JSR     CurrentDir(A6)
  442.  
  443. (*   restore trapcode *)
  444.         MOVEA.L thisTask(A4),A3
  445.         MOVE.L  oldTrap(A4),(*Task.trapCode*) 50(A3)
  446.         MOVE.L  oldData(A4),(*Task.trapData*) 46(A3)
  447. (*  close dos.library  *)
  448.         MOVEA.L dosBase(A4),A1
  449.         MOVEA.L $4,A6    (* exec to a6 *)
  450.         JSR     CloseLibrary(A6)
  451.  
  452.         MOVE.L  wbenchMsg(A4),D2
  453.         BEQ.S   noWbClose
  454. (* workbench cleanup *)
  455.         JSR     Forbid(A6)
  456.         MOVEA.L  D2,A1
  457. (*      MOVE.W  returnVal+2(A4),Message.length(A1) *)
  458.         JSR     ReplyMsg(A6)
  459. noWbClose:
  460.         MOVE.L  returnVal(A4),D2
  461.         MOVEA.L  A4,A1
  462.         MOVE.L  AllocatedMem(A4),D0
  463.         JSR     FreeMem(A6)
  464.         MOVE.L  D2,D0
  465. ByeBye:
  466.         MOVEM.L (A7)+,D2-D7/A2-A6
  467.         RTS
  468.  
  469.         END);
  470. END easystartup;
  471.  
  472. PROCEDURE StackChk(space{0}:LONGINT);
  473. (*$ EntryExitCode- *)
  474. BEGIN
  475.  ASSEMBLE(
  476.     ADD.L   A7,D0     (* stacksize + actual stackpointer *) 
  477.     MOVE.L  A0,-(A7)
  478.     MOVEA.L $4,A0
  479.     MOVEA.L (*ExecBase.thisTask*) 276(A0),A0
  480.     CMP.L   (*Task.spLower*) 58(A0),D0
  481.     BHI.S   Ok
  482.     TRAP    #3        (* stack overflow *)
  483. Ok:
  484.     MOVEA.L  (A7)+,A0
  485.     RTS
  486.  END);
  487. END StackChk;
  488.  
  489. PROCEDURE Raise(i{0}:LONGINT);
  490. (*$ EntryExitCode- *)
  491. BEGIN
  492.  ASSEMBLE(
  493.         MOVE.L  D0,ExceptNr(A4)
  494.         MOVE.L  ExceptStck(A4),D0
  495.         BEQ     close
  496.         MOVE.L  D0,A0
  497.         MOVE.L  saveA7(A4),A7
  498.         MOVE.L  saveA5(A4),A5
  499.         MOVE.L  (A7)+,saveA5(A4)
  500.         MOVE.L  (A7)+,ExceptStck(A4)
  501.         MOVE.L  (A7)+,saveA7(A4)
  502.         JMP     (A0)
  503.   close:
  504.         MOVEA.L  closeAll(A4),A0
  505.         JMP     (A0)
  506.  END);
  507. END Raise;
  508.  
  509.  
  510.  
  511. PROCEDURE Mulu32(x{0},y{1}:LONGINT):LONGINT;
  512. (*$ EntryExitCode- *)
  513. (*
  514.  * [A*hi + B]*[C*hi + D] = [A*C*hi^2 + (A*D + B*C)*hi + B*D]
  515.  *)
  516. (* CONST T1=d2; A=d3; C=d4;*)
  517. BEGIN
  518.   ASSEMBLE(
  519.         MOVEM.L D2-D4,-(A7)
  520.         MOVE.L  D0,D2
  521.         MOVE.L  D0,D3
  522.         SWAP    D3
  523.         MOVE.L  D1,D4
  524.         SWAP    D4
  525.         MULU    D1,D0
  526.         MULU    D3,D1
  527.         MULU    D4,D2
  528.         MULU    D4,D3
  529.         SWAP    D0
  530.         ADD.W   D1,D0
  531.         MOVEQ   #0,D4
  532.         ADDX.L  D4,D4
  533.         ADD.W   D2,D0
  534.         ADDX.L  D4,D3
  535.         SWAP    D0
  536.         CLR.W   D1
  537.         SWAP    D1
  538.         CLR.W   D2
  539.         SWAP    D2
  540.         ADD.L   D2,D1
  541.         ADD.L   D3,D1
  542.         MOVEM.L (A7)+,D2-D4
  543.         RTS
  544.   END);
  545. END Mulu32;
  546.  
  547. PROCEDURE Muls32(x{0},y{1}:LONGINT):LONGINT;
  548. (*$ EntryExitCode- *)
  549. (* CONST X1=d2; Y1=d3;*)
  550. BEGIN
  551.   ASSEMBLE(
  552.         MOVEM.L D2-D3,-(A7)
  553.         MOVE.L  D0,D2
  554.         MOVE.L  D1,D3
  555.         BSR.S   Mulu32
  556.         TST.L   D2
  557.         BPL.S   L000029
  558.         SUB.L   D3,D1
  559.   L000029:
  560.         TST.L   D3
  561.         BPL.S   L000030
  562.         SUB.L   D2,D1
  563.   L000030:
  564.         TST.L   D0
  565.         BPL.S   L000031
  566.         NOT.L   D1
  567.   L000031:
  568.         MOVEM.L (A7)+,D2-D3
  569.         RTS
  570.   END);
  571. END Muls32;
  572.  
  573.  
  574. PROCEDURE Divu32(x{0},y{1}:LONGINT):LONGINT;
  575. (*$ EntryExitCode- *)
  576. (*
  577.  * [A*hi + B] DIV y = [(A DIV y)*hi + (A MOD y*hi + B) DIV y]
  578.  *)
  579. (* CONST QUO=d2; T1=d3;*)
  580. BEGIN
  581.   ASSEMBLE(
  582.     MOVEM.L D2-D3,-(A7)
  583.     MOVEQ   #0,D2
  584.     CMP.L   #$0000FFFF,D1
  585.     BHI.S   L000025
  586.     DIVU    D1,D0
  587.     BVC.S   L000024
  588.     MOVE.W  D0,D3
  589.     CLR.W   D0
  590.     SWAP    D0
  591.     DIVU    D1,D0
  592.     MOVE.W  D0,D2
  593.     SWAP    D2
  594.     MOVE.W  D3,D0
  595.     DIVU    D1,D0
  596. L000024:
  597.     MOVE.W  D0,D2
  598.     CLR.W   D0
  599.     SWAP    D0
  600.     BRA.S   L000028
  601. L000025:
  602.     MOVE.W  D0,D2
  603.     SWAP    D2
  604.     CLR.W   D0
  605.     SWAP    D0
  606.     MOVEQ       #15,D3
  607. L000026:
  608.     LSL.L   #1,D2
  609.     ROXL.L  #1,D0
  610.     CMP.L   D1,D0
  611.     BCS.S   L000027
  612.     SUB.L   D1,D0
  613.     ADDQ.W  #1,D2
  614. L000027:
  615.     DBRA    D3,L000026
  616. L000028:
  617.     MOVE.L  D2,D1
  618.     MOVEM.L (A7)+,D2-D3
  619.     RTS          (* d0=REM, d1=QUO *)
  620.   END);
  621. END Divu32;
  622.  
  623. PROCEDURE Divs32(x{0},y{1}:LONGINT):LONGINT;
  624. (*$ EntryExitCode- *)
  625. (* CONST sX=d2; sY=d3;*)
  626. BEGIN
  627.   ASSEMBLE(
  628.     MOVEM.L D2-D3,-(A7)
  629.     TST.L   D0
  630.     SMI     D2
  631.     BPL.S   L000033
  632.     NEG.L   D0
  633. L000033:
  634.     TST.L   D1
  635.     SMI     D3
  636.     BPL.S   L000034
  637.     NEG.L   D1
  638. L000034:
  639.     BSR     Divu32
  640.     CMP.B   D2,D3       
  641.     BEQ.S   L000035
  642.     NEG.L   D1
  643. L000035:
  644.     TST.B   D2  
  645.     BEQ.S   L000036
  646.     NEG.L   D0
  647. L000036:
  648.     MOVEM.L (A7)+,D2-D3
  649.     RTS
  650.   END);
  651. END Divs32;
  652.  
  653. (*$ EntryExitCode- *)
  654. PROCEDURE SFix(x{0}:REAL):LONGINT; 
  655. BEGIN
  656.   ASSEMBLE(
  657.         MOVE.L  D7,-(A7)
  658.         TST.L   D0
  659.         SMI     D7     
  660.         MOVEQ   #0,D1
  661.         ADD.L   D0,D0           (* left rol *)
  662.         ROL.L   #8,D0
  663.         MOVE.B  D0,D1           (* save exponent *)
  664.         MOVE.B  #1,D0           (* 1.f *)
  665.         ROR.L   #1,D0           (* 1.f on bit 31 *)
  666.         SUBI.W  #$7F,D1         (* e - 127 *)
  667.         BGE.S   notlowzero
  668.         MOVEQ   #0,D0
  669.         BRA     ret
  670. notlowzero:
  671.         SUBI.B  #$1F,D1         (* 31 - e *)
  672.         NEG.B   D1
  673.         LSR.L   D1,D0           (* Shift (31-e), D0 *)
  674.         TST.B   D7
  675.         BEQ     ret
  676.         NEG.L   D0
  677. ret:     
  678.         MOVE.L  (A7)+,D7
  679.         RTS
  680. END);
  681. END SFix;
  682.  
  683. BEGIN
  684.   first.head     := ADR(first.tail);
  685.   first.tailPred := ADR(first.head);
  686.   first.tail     := NIL;
  687. END ModulaLib.
  688.