home *** CD-ROM | disk | FTP | other *** search
/ Computer Club Elmshorn Atari PD / CCE_PD.iso / pc / 0600 / CCE_0626.ZIP / CCE_0626.PD / STOBERON.1_0 / RUNTIME.M < prev    next >
Text File  |  1993-06-24  |  32KB  |  767 lines
  1. MODULE Runtime;
  2.  
  3. (* Runtime module for OP2 68000-variant *)
  4.  
  5. IMPORT SYSTEM;
  6.  
  7. CONST ResMem      = 100000;  (* Memory available for other applications than Oberon *)
  8.       MinMem      = 100000;  (* Minimum of memory resource necessary to run Oberon *)
  9.       ResStack    = 1000;    (* Security amount between maximum of heap and act. SP at 'GetBlock' *)
  10.       ArrDescSize = 28;      (* Size of an array descriptor without pointer offsets incl tag *)
  11.       RecDescSize = 40;      (* Size of a record descriptor without pointer offsets incl tag *)
  12.  
  13. TYPE
  14.     Module*        = POINTER TO ModuleDesc;
  15.     ModuleDesc*    = RECORD
  16.                        next*       : Module;
  17.                        entries*    : LONGINT;
  18.                        commands*   : LONGINT;
  19.                        pointerRefs*: LONGINT;
  20.                        imports*    : LONGINT;
  21.                        constants*  : LONGINT;
  22.                        code*       : LONGINT;
  23.                        variables*  : LONGINT;
  24.                        filename*   : POINTER TO ARRAY 132 OF CHAR;
  25.                        modname*    : POINTER TO ARRAY 20 OF CHAR;
  26.                        dsize*      : LONGINT;
  27.                        blocksize*  : LONGINT;
  28.                        key*        : LONGINT;
  29.                        bofdlink*   : LONGINT;
  30.                        dlnkx*      : INTEGER;
  31.                        nofptrs*    : INTEGER;
  32.                        nofGmod*    : INTEGER
  33.                      END;
  34.     BasePage*      = POINTER TO BasePageDesc;
  35.     BasePageDesc*  = RECORD
  36.                        LowTPA*, HiTPA* : LONGINT;
  37.                        CodeBase*       : LONGINT;
  38.                        CodeLen*        : LONGINT;
  39.                        DataBase*       : LONGINT;
  40.                        DataLen*        : LONGINT;
  41.                        BssBase*        : LONGINT;
  42.                        BssLen*         : LONGINT;
  43.                        EnvPtr*         : POINTER TO ARRAY 80 OF CHAR;
  44.                        CmdLine*        : ARRAY 220 OF CHAR
  45.                      END;
  46.  
  47. TYPE
  48.     Initialization = PROCEDURE;
  49.     String         = ARRAY 128 OF CHAR;
  50.  
  51. VAR
  52.     modroot*  : Module;   (* ancore of module descriptor list *)
  53.     loadsize* : LONGINT;  (* the size of the loaded Oberon application (txtlen + datalen + bsslen) *)
  54.     lowmem*   : LONGINT;  (* lowest memory location usable for heap *)
  55.     currmem   : LONGINT;  (* lowest free memory location *)
  56.     highmem*  : LONGINT;  (* highest memory location assigned by TOS *)
  57.     basepage* : BasePage; (* Start of the TOS basepage of Oberon *)
  58.  
  59. VAR
  60.     free      : ARRAY 5 OF LONGINT;
  61.     mod       : Module;
  62.     init      : Initialization;
  63.     n         : LONGINT;
  64.  
  65.  
  66. PROCEDURE- BConIn(dev: INTEGER) : LONGINT
  67. 3FH, 3CH, 0, 2H,   (* MOVE.W  #2,-(SP) *)
  68. 4EH, 4DH,          (* TRAP    #13      *)
  69. 54H, 8FH;          (* ADDQ.L  #2,SP    *)
  70.  
  71. PROCEDURE- BConOut(ch, dev: INTEGER)
  72. 3FH, 3CH, 0, 3H,   (* MOVE.W  #3,-(SP) *)
  73. 4EH, 4DH,          (* TRAP    #13      *)
  74. 54H, 8FH;          (* ADDQ.L  #2,SP    *)
  75.  
  76. PROCEDURE- DSetPath(VAR path: String)
  77. 3FH, 3CH, 0, 3BH,  (* MOVE.W  #$3B,-(SP) *)
  78. 4EH, 41H,          (* TRAP    #1         *)
  79. 54H, 8FH;          (* ADDQ.L  #2,SP      *)
  80.  
  81. PROCEDURE- MAlloc(length: LONGINT) : LONGINT
  82. 3FH, 3CH, 0, 48H,  (* MOVE.W  #$48,-(SP) *)
  83. 4EH, 41H,          (* TRAP    #1         *)
  84. 54H, 8FH;          (* ADDQ.L  #2,SP      *)
  85.  
  86. PROCEDURE- MFree(adr: LONGINT)
  87. 3FH, 3CH, 0, 49H,  (* MOVE.W  #$49,-(SP) *)
  88. 4EH, 41H,          (* TRAP    #1         *)
  89. 54H, 8FH;          (* ADDQ.L  #2,SP      *)
  90.  
  91. PROCEDURE- PExec(VAR env, cmd, name: String; mode: INTEGER) : LONGINT
  92. 3FH, 3CH, 0, 4BH,  (* MOVE.W  #$4B,-(SP) *)
  93. 4EH, 41H,          (* TRAP    #1         *)
  94. 54H, 8FH;          (* ADDQ.L  #2,SP      *)
  95.  
  96. PROCEDURE- Super(ssp: LONGINT): LONGINT
  97. 3FH, 3CH, 0, 20H,  (* MOVE.W  #$20,-(SP) *)
  98. 4EH, 41H,          (* TRAP    #1         *)
  99. 54H, 8FH;          (* ADDQ.L  #2,SP      *)
  100.  
  101. PROCEDURE- SetBlock(length, adr: LONGINT) : LONGINT
  102. 3FH, 3CH, 0, 0,    (* MOVE.W  #0,-(SP)   *)
  103. 3FH, 3CH, 0, 4AH,  (* MOVE.W  #$4A,-(SP) *)
  104. 4EH, 41H,          (* TRAP    #1         *)
  105. 58H, 8FH;          (* ADDQ.L  #4,SP      *)
  106.  
  107. PROCEDURE- Terminate(value: INTEGER)
  108. 3FH, 3CH, 0, 4CH,  (* MOVE.W  #$4C,-(SP) *)
  109. 4EH, 41H,          (* TRAP    #1         *)
  110. 54H, 8FH;          (* ADDQ.L  #2,SP      *)
  111.  
  112. PROCEDURE Write(ch: CHAR);
  113. BEGIN BConOut(ORD(ch), 2)
  114. END Write;
  115.  
  116. PROCEDURE WriteString(str: String);
  117.   VAR i: SHORTINT;
  118. BEGIN
  119.   i:=0;
  120.   WHILE str[i] # 0X DO BConOut(ORD(str[i]), 2); INC(i) END
  121. END WriteString;
  122.  
  123. PROCEDURE WriteNum(num: LONGINT; len: INTEGER);
  124.   VAR i: INTEGER; signed: BOOLEAN; str: ARRAY 16 OF CHAR;
  125. BEGIN
  126.   i:=0; signed:=FALSE;
  127.   IF num < 0 THEN num:=-num; DEC(len); signed:=TRUE END;
  128.   WHILE num # 0 DO
  129.     str[i]:=CHR(SHORT(num MOD 10 + 30H)); num:=num DIV 10; INC(i)
  130.   END;
  131.   IF i = 0 THEN str[i]:="0"; INC(i) END;
  132.   WHILE len > i DO Write(" "); DEC(len) END;
  133.   IF signed THEN Write("-") END;
  134.   WHILE i > 0 DO DEC(i); Write(str[i]) END
  135. END WriteNum;
  136.  
  137. PROCEDURE WriteLn;
  138. BEGIN
  139.   BConOut(0DH, 2); BConOut(0AH, 2)
  140. END WriteLn;
  141.  
  142. PROCEDURE CallDisass;
  143.   VAR env, cmd, name: String;
  144. BEGIN
  145.   COPY("C:\UTILITY\DEC68000.PRG", name);
  146.   COPY("C:\UTILITY\", env); DSetPath(env); env:=""; cmd:="";
  147.   IF PExec(env, cmd, name, 0) = 0 THEN END
  148. END CallDisass;
  149.  
  150. (* Runtime support routines *)
  151.  
  152. PROCEDURE LIntToReal*;
  153. END LIntToReal;
  154.  
  155. PROCEDURE LIntToLReal*;
  156. END LIntToLReal;
  157.  
  158. PROCEDURE RealToLInt*;
  159. END RealToLInt;
  160.  
  161. PROCEDURE RealToLReal*;
  162. END RealToLReal;
  163.  
  164. PROCEDURE LRealToLInt*;
  165. END LRealToLInt;
  166.  
  167. PROCEDURE LRealToReal*;
  168. END LRealToReal;
  169.  
  170. PROCEDURE Cmp*;
  171. END Cmp;
  172.  
  173. PROCEDURE Add*;
  174. END Add;
  175.  
  176. PROCEDURE Sub*;
  177. END Sub;
  178.  
  179. PROCEDURE Mul*;
  180. END Mul;
  181.  
  182. PROCEDURE Div*;
  183. END Div;
  184.  
  185. PROCEDURE- IntMul321
  186.    4EH, 5EH,     (* UNLK         A6    *)
  187.    24H, 00H,     (* MOVE.L       D0,D2 *)
  188.    6AH, 02H,     (* BPL.S        2     *)
  189.    44H, 80H,     (* NEG.L        D0    *)
  190.    0B3H, 82H,    (* EOR.L        D1,D2 *)
  191.    20H, 42H,     (* MOVE.L       D2,A0 *)
  192.    4AH, 81H,     (* TST.L        D1    *)
  193.    6AH, 02H,     (* BPL.S        2     *)
  194.    44H, 81H,     (* NEG.L        D1    *)
  195.    24H, 00H,     (* MOVE.L       D0,D2 *)
  196.    48H, 42H,     (* SWAP         D2    *)
  197.    4AH, 42H,     (* TST.W        D2    *)
  198.    66H, 22H,     (* BNE.S        $22   *)
  199.    24H, 01H,     (* MOVE.L       D1,D2 *)
  200.    48H, 42H,     (* SWAP         D2    *)
  201.    4AH, 42H,     (* TST.W        D2    *)
  202.    66H, 0AH,     (* BNE.S        $A    *)
  203.    0C0H, 0C1H,   (* MULU         D1,D0 *)
  204.    24H, 08H,     (* MOVE.L       A0,D2 *)
  205.    6AH, 02H,     (* BPL.S        2     *)
  206.    44H, 80H,     (* NEG.L        D0    *)
  207.    4EH, 75H,     (* RTS                *)
  208.    0C4H, 0C0H,   (* MULU         D0,D2 *)
  209.    48H, 42H,     (* SWAP         D2    *)
  210.    0C0H, 0C1H,   (* MULU         D1,D0 *)
  211.    0D0H, 82H,    (* ADD.L        D2,D0 *)
  212.    24H, 08H,     (* MOVE.L       A0,D2 *)
  213.    6AH, 02H,     (* BPL.S        2     *)
  214.    44H, 80H,     (* NEG.L        D0    *)
  215.    4EH, 75H,     (* RTS                *)
  216.    0C4H, 0C1H,   (* MULU         D1,D2 *)
  217.    48H, 42H,     (* SWAP         D2    *)
  218.    0C0H, 0C1H,   (* MULU         D1,D0 *)
  219.    0D0H, 82H,    (* ADD.L        D2,D0 *)
  220.    24H, 08H,     (* MOVE.L       A0,D2 *)
  221.    6AH, 02H,     (* BPL.S        2     *)
  222.    44H, 80H,     (* NEG.L        D0    *)
  223.    4EH, 75H;     (* RTS                *)
  224.  
  225. PROCEDURE IntMul32*;
  226. BEGIN IntMul321
  227. END IntMul32;
  228.  
  229. PROCEDURE- IntDiv321
  230.   4EH, 5EH,                     (* UNLK         A6     *)
  231.   24H, 00H,                     (* MOVE.L       D0,D2  *)
  232.   6AH, 02H,                     (* BPL.S        2      *)
  233.   44H, 80H,                     (* NEG.L        D0     *)
  234.   0B3H, 82H,                    (* EOR.L        D1,D2  *)
  235.   22H, 42H,                     (* MOVE.L       D2,A1  *)
  236.   4AH, 81H,                     (* TST.L        D1     *)
  237.   6AH, 02H,                     (* BPL.S        2      *)
  238.   44H, 81H,                     (* NEG.L        D1     *)
  239.   24H, 01H,                     (* MOVE.L       D1,D2  *)
  240.   48H, 42H,                     (* SWAP         D2     *)
  241.   4AH, 42H,                     (* TST.W        D2     *)
  242.   66H, 34H,                     (* BNE.S        $34    *)
  243.   24H, 00H,                     (* MOVE.L       D0,D2  *)
  244.   48H, 42H,                     (* SWAP         D2     *)
  245.   4AH, 42H,                     (* TST.W        D2     *)
  246.   66H, 10H,                     (* BNE.S        $10    *)
  247.   80H, 0C1H,                    (* DIVU         D1,D0  *)
  248.   48H, 40H,                     (* SWAP         D0     *)
  249.   42H, 40H,                     (* CLR.W        D0     *)
  250.   48H, 40H,                     (* SWAP         D0     *)
  251.   24H, 09H,                     (* MOVE.L       A1,D2  *)
  252.   6AH, 02H,                     (* BPL.S        2      *)
  253.   44H, 80H,                     (* NEG.L        D0     *)
  254.   4EH, 75H,                     (* RTS                 *)
  255.   42H, 40H,                     (* CLR.W        D0     *)
  256.   48H, 40H,                     (* SWAP         D0     *)
  257.   48H, 42H,                     (* SWAP         D2     *)
  258.   80H, 0C1H,                    (* DIVU         D1,D0  *)
  259.   30H, 40H,                     (* MOVE.W       D0,A0  *)
  260.   30H, 02H,                     (* MOVE.W       D2,D0  *)
  261.   80H, 0C1H,                    (* DIVU         D1,D0  *)
  262.   48H, 40H,                     (* SWAP         D0     *)
  263.   30H, 08H,                     (* MOVE.W       A0,D0  *)
  264.   48H, 40H,                     (* SWAP         D0     *)
  265.   24H, 09H,                     (* MOVE.L       A1,D2  *)
  266.   6AH, 02H,                     (* BPL.S        2      *)
  267.   44H, 80H,                     (* NEG.L        D0     *)
  268.   4EH, 75H,                     (* RTS                 *)
  269.   20H, 41H,                     (* MOVE.L       D1,A0  *)
  270.   48H, 40H,                     (* SWAP         D0     *)
  271.   72H, 00H,                     (* MOVEQ.L      #0,D1  *)
  272.   32H, 00H,                     (* MOVE.W       D0,D1  *)
  273.   42H, 40H,                     (* CLR.W        D0     *)
  274.   74H, 0FH,                     (* MOVEQ.L      #15,D2 *)
  275.   0D0H, 80H,                    (* ADD.L        D0,D0  *)
  276.   0D3H, 81H,                    (* ADDX.L       D1,D1  *)
  277.   92H, 88H,                     (* SUB.L        A0,D1  *)
  278.   64H, 02H,                     (* BCC.S        2      *)
  279.   0D2H, 88H,                    (* ADD.L        A0,D1  *)
  280.   0D1H, 80H,                    (* ADDX.L       D0,D0  *)
  281.   0D3H, 81H,                    (* ADDX.L       D1,D1  *)
  282.   051H, 0CAH, 0FFH, 0F4H,       (* DBF          D2,-12 *)
  283.   46H, 40H,                     (* NOT.W        D0     *)
  284.   24H, 09H,                     (* MOVE.L       A1,D2  *)
  285.   6AH, 02H,                     (* BPL.S        2      *)
  286.   44H, 80H,                     (* NEG.L        D0     *)
  287.   4EH, 75H;                     (* RTS                 *)
  288.  
  289. PROCEDURE IntDiv32*;
  290. BEGIN IntDiv321
  291. END IntDiv32;
  292.  
  293. PROCEDURE- IntMod321
  294.   4EH, 5EH,                     (* UNLK         A6     *)
  295.   22H, 40H,                     (* MOVE.L       D0,A1  *)
  296.   24H, 00H,                     (* MOVE.L       D0,D2  *)
  297.   6AH, 02H,                     (* BPL.S        2      *)
  298.   44H, 80H,                     (* NEG.L        D0     *)
  299.   4AH, 81H,                     (* TST.L        D1     *)
  300.   6AH, 02H,                     (* BPL.S        2      *)
  301.   44H, 81H,                     (* NEG.L        D1     *)
  302.   24H, 01H,                     (* MOVE.L       D1,D2  *)
  303.   48H, 42H,                     (* SWAP         D2     *)
  304.   4AH, 42H,                     (* TST.W        D2     *)
  305.   66H, 2EH,                     (* BNE.S        $2E    *)
  306.   24H, 00H,                     (* MOVE.L       D0,D2  *)
  307.   48H, 42H,                     (* SWAP         D2     *)
  308.   4AH, 42H,                     (* TST.W        D2     *)
  309.   66H, 0EH,                     (* BNE.S        $E     *)
  310.   80H, 0C1H,                    (* DIVU         D1,D0  *)
  311.   42H, 40H,                     (* CLR.W        D0     *)
  312.   48H, 40H,                     (* SWAP         D0     *)
  313.   24H, 09H,                     (* MOVE.L       A1,D2  *)
  314.   6AH, 02H,                     (* BPL.S        2      *)
  315.   44H, 80H,                     (* NEG.L        D0     *)
  316.   4EH, 75H,                     (* RTS                 *)
  317.   42H, 40H,                     (* CLR.W        D0     *)
  318.   48H, 40H,                     (* SWAP         D0     *)
  319.   48H, 42H,                     (* SWAP         D2     *)
  320.   80H, 0C1H,                    (* DIVU         D1,D0  *)
  321.   30H, 02H,                     (* MOVE.W       D2,D0  *)
  322.   80H, 0C1H,                    (* DIVU         D1,D0  *)
  323.   42H, 40H,                     (* CLR.W        D0     *)
  324.   48H, 40H,                     (* SWAP         D0     *)
  325.   24H, 09H,                     (* MOVE.L       A1,D2  *)
  326.   6AH, 02H,                     (* BPL.S        2      *)
  327.   44H, 80H,                     (* NEG.L        D0     *)
  328.   4EH, 75H,                     (* RTS                 *)
  329.   20H, 41H,                     (* MOVE.L       D1,A0  *)
  330.   22H, 00H,                     (* MOVE.L       D0,D1  *)
  331.   42H, 40H,                     (* CLR.W        D0     *)
  332.   48H, 40H,                     (* SWAP         D0     *)
  333.   48H, 41H,                     (* SWAP         D1     *)
  334.   42H, 41H,                     (* CLR.W        D1     *)
  335.   74H, 0FH,                     (* MOVEQ.L      #15,D2 *)
  336.   0D2H, 81H,                    (* ADD.L        D1,D1  *)
  337.   0D1H, 80H,                    (* ADDX.L       D0,D0  *)
  338.   90H, 88H,                     (* SUB.L        A0,D0  *)
  339.   64H, 02H,                     (* BCC.S        2      *)
  340.   0D0H, 88H,                    (* ADD.L        A0,D0  *)
  341.   0D3H, 81H,                    (* ADDX.L       D1,D1  *)
  342.   0D1H, 80H,                    (* ADDX.L       D0,D0  *)
  343.   51H, 0CAH, 0FFH, 0F4H,        (* DBF          D2,-12 *)
  344.   0E2H, 90H,                    (* ROXR.L       #1,D0  *)
  345.   24H, 09H,                     (* MOVE.L       A1,D2  *)
  346.   6AH, 02H,                     (* BPL.S        2      *)
  347.   44H, 80H,                     (* NEG.L        D0     *)
  348.   4EH, 75H;                     (* RTS                 *)
  349.  
  350. PROCEDURE IntMod32*;
  351. BEGIN IntMod321
  352. END IntMod32;
  353.  
  354. PROCEDURE- UMul321
  355.   4EH, 5EH,     (* UNLK         A6    *)
  356.   24H, 00H,     (* MOVE.L       D0,D2 *)
  357.   48H, 42H,     (* SWAP         D2    *)
  358.   4AH, 42H,     (* TST.W        D2    *)
  359.   66H, 16H,     (* BNE.S        $16   *)
  360.   24H, 01H,     (* MOVE.L       D1,D2 *)
  361.   48H, 42H,     (* SWAP         D2    *)
  362.   4AH, 42H,     (* TST.W        D2    *)
  363.   66H, 04H,     (* BNE.S        4     *)
  364.   0C0H, 0C1H,   (* MULU         D1,D0 *)
  365.   4EH, 75H,     (* RTS                *)
  366.   0C4H, 0C0H,   (* MULU         D0,D2 *)
  367.   48H, 42H,     (* SWAP         D2    *)
  368.   0C0H, 0C1H,   (* MULU         D1,D0 *)
  369.   0D0H, 82H,    (* ADD.L        D2,D0 *)
  370.   4EH, 75H,     (* RTS                *)
  371.   0C4H, 0C1H,   (* MULU         D1,D2 *)
  372.   48H, 42H,     (* SWAP         D2    *)
  373.   0C0H, 0C1H,   (* MULU         D1,D0 *)
  374.   0D0H, 82H,    (* ADD.L        D2,D0 *)
  375.   4EH, 75H;     (* RTS                *)
  376.  
  377. PROCEDURE UMul32*;
  378. BEGIN UMul321
  379. END UMul32;
  380.  
  381. PROCEDURE GetBlock(index: LONGINT; size: LONGINT): LONGINT;
  382.   VAR node1, node2, node3, node4, nsize: LONGINT; found: BOOLEAN;
  383. BEGIN
  384.   IF size > 128 THEN
  385.     IF free[4] = 0 THEN (* free list is empty *)
  386.       SYSTEM.GETREG(15, node1);
  387.       IF currmem <= node1 - size - ResStack THEN
  388.         node1:=currmem; INC(currmem, size)
  389.       ELSE
  390.         node1:=0
  391.       END
  392.     ELSE
  393.       node1:=0; node2:=free[4]; found:=FALSE;
  394.       WHILE (node2 # 0) & ~found DO
  395.         SYSTEM.GET(node2 + 8, nsize);
  396.         IF size <= nsize THEN found:=TRUE
  397.         ELSE node1:=node2; SYSTEM.GET(node2 + 4, node2)
  398.         END
  399.       END;
  400.       IF found THEN (* first fit found *)
  401.         node3:=node2 + size; SYSTEM.GET(node2 + 4, node4); DEC(nsize, size);
  402.         IF nsize # 0 THEN
  403.           SYSTEM.PUT(node3, LONG(LONG(0))); SYSTEM.PUT(node3 + 8, nsize)
  404.         END;
  405.         IF nsize = 128 THEN (* remaining part to small to stay in this list *)
  406.           SYSTEM.PUT(node3 + 4, free[3]);
  407.           free[3]:=node3;
  408.       IF node1 # 0 THEN SYSTEM.PUT(node1 + 4, node4)
  409.       ELSE free[4]:=node4
  410.       END
  411.         ELSE
  412.           IF nsize # 0 THEN
  413.             SYSTEM.PUT(node3 + 4, node4)
  414.           END;
  415.           IF node1 # 0 THEN SYSTEM.PUT(node1 + 4, node3) (* nsize = 0 ==> node3 = node4 *)
  416.           ELSE free[4]:=node3
  417.           END
  418.         END;
  419.         node1:=node2
  420.       ELSE (* no block fits => allocate block from free memory *)
  421.         SYSTEM.GETREG(15, node1);
  422.         IF currmem <= node1 - size - ResStack THEN
  423.           node1:=currmem; INC(currmem, size)
  424.         ELSE
  425.           node1:=0
  426.         END
  427.       END
  428.     END
  429.   ELSE (* get block of sizes 16, 32, 64, or 128 *)
  430.     IF free[index] = 0 THEN (* no free fitting block => get larger block and split *)
  431.       node1:=GetBlock(index + 1, 2 * size);
  432.       IF node1 # 0 THEN
  433.         node2:=node1 + size;
  434.         SYSTEM.PUT(node2, LONG(LONG(0)));
  435.         SYSTEM.PUT(node2 + 4, free[index]); (* as a side effect of 'GetBlock' the list may *)
  436.         SYSTEM.PUT(node2 + 8, size);        (* no longer be empty                          *)
  437.         free[index]:=node2
  438.       END
  439.     ELSE (* take first block in free list *)
  440.       node1:=free[index]; SYSTEM.GET(node1 + 4, free[index])
  441.     END
  442.   END;
  443.   RETURN node1
  444. END GetBlock;
  445.  
  446. PROCEDURE- New1
  447.   4AH, 80H,                       (* TST.L        D0           *)
  448.   67H, 22H,                       (* BEQ.S        $22          *)
  449.   58H, 80H,                       (* ADDQ.L       #4,D0        *)
  450.   20H, 6EH, 00H, 0EH,             (* MOVE.L       14(A6),A0    *)
  451.   20H, 80H,                       (* MOVE.L       D0,(A0)      *)
  452.   20H, 40H,                       (* MOVE.L       D0,A0        *)
  453.   21H, 6EH, 00H, 08H, 0FFH, 0FCH, (* MOVE.L       8(A6),-4(A0) *)
  454.   20H, 2EH, 0FFH, 0FCH,           (* MOVE.L       -4(A6),D0    *)
  455.   0E4H, 80H,                      (* ASR.L        #2,D0        *)
  456.   53H, 80H,              (* SUBQ.L       #1,D0        *)
  457.   72H, 00H,                       (* MOVEQ.L      #0,D1        *)
  458.   20H, 0C1H,                      (* MOVE.L       D1,(A0)+     *)
  459.   53H, 80H,                       (* SUBQ.L       #1,D0        *)
  460.   66H, 0FAH,                      (* BNE.S        -6           *)
  461.   60H, 06H,                       (* BRA.S        6            *)
  462.   20H, 6EH, 00H, 0EH,             (* MOVE.L       14(A6),A0    *)
  463.   42H, 90H;                       (* CLR.L        (A0)         *)
  464.   
  465. PROCEDURE New*(adr: LONGINT; isArray: BOOLEAN; tag: LONGINT);
  466.   VAR size, node: LONGINT; index: LONGINT;
  467. BEGIN
  468.   SYSTEM.GET(tag, size);
  469.   IF isArray THEN INC(tag, 40000000H) END;
  470.   IF size > 128 THEN
  471.     index:=4
  472.   ELSE
  473.     index:=0; node:=size DIV 32;
  474.     WHILE node > 0 DO node:=node DIV 2; INC(index) END
  475.   END;
  476.   SYSTEM.PUTREG(0, GetBlock(index, size));
  477.   New1
  478. END New;
  479.  
  480. PROCEDURE SYSNew*(adr: LONGINT; isArray: BOOLEAN; tag, size: LONGINT);
  481.   VAR node, m, s0, realsize: LONGINT; index: LONGINT;
  482. BEGIN
  483.   INC(size, size MOD 2); realsize:=size;
  484.   IF isArray THEN INC(realsize, ArrDescSize)
  485.   ELSE INC(realsize, RecDescSize)
  486.   END;
  487.   m:=4; s0:=16;
  488.   WHILE (m > 0) & (realsize > s0) DO s0:=2 * s0; DEC(m) END;
  489.   IF realsize > s0 THEN s0:=(realsize + 127) DIV 128 * 128 END;
  490.   realsize:=s0;
  491.   IF realsize > 128 THEN
  492.     index:=4
  493.   ELSE
  494.     index:=0; node:=realsize DIV 32;
  495.     WHILE node > 0 DO node:=node DIV 2; INC(index) END
  496.   END;
  497.   node:=GetBlock(index, realsize);
  498.   IF node # 0 THEN
  499.     SYSTEM.PUT(adr, node + 4); s0:=size;
  500.     IF isArray THEN INC(s0, 40000000H) END;
  501.     SYSTEM.PUT(node, node + s0);
  502.     INC(node, 4); DEC(size, 4);
  503.     WHILE size > 0 DO (* erase block to set potential pointer fields to NIL, *)
  504.                       (* although no offset table entries are generated in the TD *)
  505.       SYSTEM.PUT(node, LONG(0)); DEC(size, 2); INC(node, 2);
  506.     END;
  507.     SYSTEM.PUT(node, realsize);
  508.     IF isArray THEN
  509.       SYSTEM.PUT(node + 4, LONG(LONG(0))); SYSTEM.PUT(node + 8, LONG(LONG(0)));
  510.       SYSTEM.PUT(node + 12, LONG(LONG(-12))); SYSTEM.PUT(node + 16, realsize)
  511.     ELSE
  512.       m:=7; INC(node, 4);
  513.       WHILE m > 0 DO SYSTEM.PUT(node, LONG(LONG(0))); INC(node, 4); DEC(m) END;
  514.       SYSTEM.PUT(node, LONG(LONG(-32)))
  515.     END
  516.   ELSE SYSTEM.PUT(adr, LONG(LONG(0)))
  517.   END
  518. END SYSNew;
  519.  
  520. PROCEDURE- GCInit
  521.   48H, 0E7H, 0F0H, 0FEH,           (* MOVEM.L   A0-A6/D0-D3,-(SP) *)
  522.   40H, 0E7H,                       (* MOVE.W    SR,-(SP)          *)
  523.   00H, 7CH, 03H, 00H;              (* ORI       #$300,SR          *)
  524.   
  525. PROCEDURE- GCMark1 (* P == (A6 = modroot.next) *)
  526.   26H, 0EH,                        (* MOVE.L    A6,D3          *)
  527.   67H, 00H, 01H, 1AH,              (* BEQ       282            *)
  528.   28H, 6EH, 00H, 0CH,              (* MOVE.L    12(A6),A4      *)
  529.   24H, 54H,                        (* MOVE.L    (A4),A2        *)
  530.   26H, 0AH,                        (* MOVE.L    A2,D3          *)
  531.   6AH, 04H,                        (* BPL.S     4              *)
  532.   2CH, 56H,                        (* MOVE.L    (A6),A6        *)
  533.   60H, 0ECH,                       (* BRA.S     -20            *)
  534.   2AH, 52H,                        (* MOVE.L    (A2),A5        *)
  535.   26H, 0DH,                        (* MOVE.L    A5,D3          *)
  536.   67H, 06H,                        (* BEQ.S     6              *)
  537.   4AH, 0ADH, 0FFH, 0FCH,           (* TST.L     -4(A5)         *)
  538.   6AH, 04H,                        (* BPL.S     4              *)
  539.   58H, 8CH,                        (* ADDQ.L    #4,A4          *)
  540.   60H, 0E6H,                       (* BRA.S     -26            *)
  541.   28H, 8EH,                        (* MOVE.L    A6,(A4)        *)
  542.   24H, 8CH,                        (* MOVE.L    A4,(A2)        *)
  543.   2CH, 4AH,                        (* MOVE.L    A2,A6          *)
  544.   08H, 0ADH, 00H, 06H, 0FFH, 0FCH, (* BCLR.B    #6,-4(A5)      *)
  545.   56H, 0C1H,                       (* SNE       D1             *)
  546.   28H, 6DH, 0FFH, 0FCH,            (* MOVE.L    -4(A5),A4      *)
  547.   24H, 14H,                        (* MOVE.L    (A4),D2        *)
  548.   4AH, 01H,                        (* TST.B     D1             *)
  549.   66H, 08H,                        (* BNE.S     8              *)
  550.   0D9H, 0FCH, 00H, 00H, 00H, 1CH,  (* ADD.L     #8*4-4,A4      *)
  551.   60H, 06H,                        (* BRA.S     4              *)
  552.   2BH, 8DH, 28H, 0F8H,             (* MOVE.L    A5,-8(A5,D2.L) *)
  553.   50H, 8CH,                        (* ADDQ.L    #8,A4          *)
  554.   58H, 8CH,                        (* ADDQ.L    #4,A4          *)
  555.   20H, 14H,                        (* MOVE.L    (A4),D0        *)
  556.   6BH, 52H,                        (* BMI.S     82             *)
  557.   4AH, 01H,                        (* TST.B     D1             *)
  558.   67H, 2CH,                        (* BEQ.S     44             *)
  559.   0D1H, 0B5H, 28H, 0F8H,           (* ADD.L     D0,-8(A5,D2.L) *)
  560.   22H, 75H, 28H, 0F8H,             (* MOVE.L    -8(A5,D2.L),A1 *)
  561.   26H, 51H,                        (* MOVE.L    (A1),A3        *)
  562.   26H, 0BH,                        (* MOVE.L    A3,D3          *)
  563.   67H, 0E8H,                       (* BEQ.S     -24            *)
  564.   4AH, 0ABH, 0FFH, 0FCH,           (* TST.L     -4(A3)         *)
  565.   6BH, 0E2H,                       (* BMI.S     -30            *)
  566.   2BH, 4CH, 0FFH, 0FCH,            (* MOVE.L    A4,-4(A5)      *)
  567.   08H, 0EDH, 00H, 07H, 0FFH, 0FCH, (* BSET.B    #7,-4(A5)      *)
  568.   08H, 0EDH, 00H, 06H, 0FFH, 0FCH, (* BSET.B    #6,-4(A5)      *)
  569.   22H, 8AH,                        (* MOVE.L    A2,(A1)        *)
  570.   24H, 4DH,                        (* MOVE.L    A5,A2          *)
  571.   2AH, 4BH,                        (* MOVE.L    A3,A5          *)
  572.   60H, 0AAH,                       (* BRA.S     -86            *)
  573.   26H, 75H, 08H, 00H,              (* MOVE.L    0(A5,D0.L),A3  *)
  574.   26H, 0BH,                        (* MOVE.L    A3,D3          *)
  575.   67H, 0C2H,                       (* BEQ.S     -62            *)
  576.   4AH, 0ABH, 0FFH, 0FCH,           (* TST.L     -4(A3)         *)
  577.   6BH, 0BCH,                       (* BMI.S     -68            *)
  578.   2BH, 4CH, 0FFH, 0FCH,            (* MOVE.L    A4,-4(A5)      *)
  579.   08H, 0EDH, 00H, 07H, 0FFH, 0FCH, (* BSET.B    #7,-4(A5)      *)
  580.   2BH, 8AH, 08H, 00H,              (* MOVE.L    A2,0(A5,D0.L)  *)
  581.   24H, 4DH;                        (* MOVE.L    A5,A2          *)
  582.   
  583. PROCEDURE- GCMark2
  584.   2AH, 4BH,                        (* MOVE.L    A3,A5          *)
  585.   60H, 88H,                        (* BRA.S     -120           *)
  586.   0D9H, 0C0H,                      (* ADD.L     D0,A4          *)
  587.   4AH, 01H,                        (* TST.B     D1             *)
  588.   67H, 14H,                        (* BEQ.S     20             *)
  589.   26H, 2CH, 00H, 04H,              (* MOVE.L    4(A4),D3       *)
  590.   0D7H, 0B5H, 28H, 0F8H,           (* ADD.L     D3,-8(A5,D2.L) *)
  591.   26H, 35H, 28H, 0F8H,             (* MOVE.L    -8(A5,D2.L),D3 *)
  592.   96H, 0ACH, 00H, 08H,             (* SUB.L     8(A4),D3       *)
  593.   0B6H, 8DH,                       (* CMP.L     A5,D3          *)
  594.   65H, 8CH,                        (* BCS.S     -116           *)
  595.   2BH, 4CH, 0FFH, 0FCH,            (* MOVE.L    A4,-4(A5)      *)
  596.   08H, 0EDH, 00H, 07H, 0FFH, 0FCH, (* BSET.B    #7,-4(A5)      *)
  597.   4AH, 01H,                        (* TST.B     D1             *)
  598.   67H, 06H,                        (* BEQ.S     6              *)
  599.   08H, 0EDH, 00H, 06H, 0FFH, 0FCH, (* BSET.B    #6,-4(A5)      *)
  600.   0BDH, 0CAH,                      (* CMP.L     A2,A6          *)
  601.   66H, 0CH,                        (* BNE.S     12             *)
  602.   28H, 52H,                        (* MOVE.L    (A2),A4        *)
  603.   2CH, 54H,                        (* MOVE.L    (A4),A6        *)
  604.   24H, 8DH,                        (* MOVE.L    A5,(A2)        *)
  605.   28H, 8AH,                        (* MOVE.L    A2,(A4)        *)
  606.   60H, 00H, 0FFH, 42H,             (* BRA       -190           *)
  607.   26H, 4DH,                        (* MOVE.L    A5,A3          *)
  608.   2AH, 4AH,                        (* MOVE.L    A2,A5          *)
  609.   08H, 0ADH, 00H, 07H, 0FFH, 0FCH, (* BCLR.B    #7,-4(A5)      *)
  610.   08H, 0ADH, 00H, 06H, 0FFH, 0FCH, (* BCLR.B    #6,-4(A5)      *)
  611.   56H, 0C1H,                       (* SNE       D1             *)
  612.   28H, 6DH, 0FFH, 0FCH,            (* MOVE.L    -4(A5),A4      *)
  613.   4AH, 01H,                        (* TST.B     D1             *)
  614.   67H, 16H,                        (* BEQ.S     22             *)
  615.   4AH, 9CH,                        (* TST.L     (A4)+          *)
  616.   6AH, 0FCH,                       (* BPL.S     -4             *)
  617.   24H, 14H,                        (* MOVE.L    (A4),D2        *)
  618.   28H, 6DH, 0FFH, 0FCH,            (* MOVE.L    -4(A5),A4      *)
  619.   22H, 75H, 28H, 0F8H,             (* MOVE.L    -8(A4,D2.L),A1 *)
  620.   24H, 51H,                        (* MOVE.L    (A1),A2        *)
  621.   22H, 8BH,                        (* MOVE.L    A3,(A1)        *)
  622.   60H, 00H, 0FFH, 3CH,             (* BRA       -196           *)
  623.   20H, 14H,                        (* MOVE.L    (A4),D0        *)
  624.   24H, 75H, 08H, 00H,              (* MOVE.L    0(A5,D0.L),A2  *)
  625.   2BH, 8BH, 08H, 00H,              (* MOVE.L    A3,0(A5,D0.L)  *)
  626.   60H, 00H, 0FFH, 2EH;             (* BRA       -210           *)
  627.  
  628. PROCEDURE- GCScan1 (* P == (A0 = ADR(free)) *)
  629.   20H, 2EH, 0FFH, 0FCH,            (* MOVE.L    -4(A6),D0       *)
  630.   0E5H, 80H,                       (* ASL.L     #2,D0           *)
  631.   41H, 0F0H, 08H, 00H,             (* LEA       0(A0,D0.L),A0   *)
  632.   43H, 0F6H, 08H, 0DCH,            (* LEA       -36(A6,D0.L),A1 *)
  633.   4AH, 91H,                        (* TST.L     (A1)            *)
  634.   67H, 0EH,                        (* BEQ.S     14              *)
  635.   50H, 0EEH, 0FFH, 0DBH,           (* ST        -37(A6)         *)
  636.   24H, 51H,                        (* MOVE.L    (A1),A2         *)
  637.   25H, 50H, 00H, 04H,              (* MOVE.L    (A0),4(A2)      *)
  638.   20H, 8AH,                        (* MOVE.L    A2,(A0)         *)
  639.   42H, 91H;                        (* CLR.L     (A1)            *)
  640.   
  641. PROCEDURE GCScan;
  642.   VAR i, j, p,
  643.       k, size : LONGINT;
  644.       V       : ARRAY 5 OF LONGINT;
  645.       inserted: BOOLEAN;
  646.  
  647. BEGIN
  648.   i:=0;
  649.   WHILE i <= 4 DO free[i]:=0; V[i]:=0; INC(i) END;
  650.   p:=lowmem;
  651.   WHILE p < currmem DO
  652.     IF SYSTEM.BIT(p, 7) THEN
  653.       i:=0;  (* Insert possible predecessors blocks in the free lists *)
  654.       WHILE i <= 4 DO
  655.         IF V[i] # 0 THEN
  656.           SYSTEM.PUT(V[i] + 4, free[i]); free[i]:=V[i]; V[i]:=0
  657.         END;
  658.         INC(i)
  659.       END;
  660.       SYSTEM.GET(p, i); i:=SYSTEM.LSH(SYSTEM.LSH(i, 1), -1); SYSTEM.PUT(p, i);
  661.       i:=i MOD 40000000H; SYSTEM.GET(i, size)
  662.     ELSE
  663.       SYSTEM.GET(p, i);
  664.       IF i # 0 THEN
  665.         i:=i MOD 40000000H; SYSTEM.GET(i, size); SYSTEM.PUT(p, LONG(LONG(0)));
  666.         SYSTEM.PUT(p + 8, size)
  667.       ELSE
  668.         SYSTEM.GET(p + 8, size)
  669.       END;
  670.       IF size > 128 THEN
  671.         k:=4
  672.       ELSE
  673.         k:=0; i:=size DIV 32;
  674.         WHILE i > 0 DO i:=i DIV 2; INC(k) END
  675.       END;
  676.       i:=0; inserted:=FALSE;
  677.       WHILE i < k DO
  678.         IF V[i] # 0 THEN
  679.           inserted:=TRUE; SYSTEM.PUT(V[i] + 4, free[i]); free[i]:=V[i]; V[i]:=0
  680.         END;
  681.         INC(i)
  682.       END;
  683.       IF inserted THEN
  684.         WHILE i <= 4 DO
  685.           IF V[i] # 0 THEN
  686.             SYSTEM.PUT(V[i] + 4, free[i]); free[i]:=V[i]; V[i]:=0
  687.           END;
  688.           INC(i)
  689.         END;
  690.         V[k]:=p
  691.       ELSE (* Melt predecessor and block together *)
  692.            (* enlarge the resulting block as far as possible *)
  693.         WHILE (k < 4) & (V[k] # 0) DO
  694.           p:=V[k]; V[k]:=0; size:=size * 2; SYSTEM.PUT(p + 8, size); INC(k)
  695.         END;
  696.         IF (k < 4) OR (V[4] = 0) THEN
  697.           V[k]:=p
  698.         ELSE (* (k = 4) & (V[k] # 0) *)
  699.           p:=V[k]; SYSTEM.GET(p + 8, i); INC(size, i); SYSTEM.PUT(p + 8, size)
  700.         END
  701.       END
  702.     END;
  703.     INC(p, size)
  704.   END;
  705.   i:=0;
  706.   WHILE i <= 4 DO
  707.     IF V[i] # 0 THEN
  708.       SYSTEM.PUT(V[i] + 4, free[i]); free[i]:=V[i]; V[i]:=0
  709.     END;
  710.     INC(i)
  711.   END
  712. END GCScan;
  713.  
  714. PROCEDURE- GCExit
  715.   46H, 0DFH,                       (* MOVE.W    (SP)+,SR          *)
  716.   4CH, 0DFH, 7FH, 0FH;             (* MOVEM.L   (SP)+,A0-A6/D0-D3 *)
  717.  
  718. PROCEDURE GC*;
  719.   VAR ssp: LONGINT;
  720. BEGIN
  721.   ssp:=Super(0);
  722.   GCInit;
  723.   SYSTEM.PUTREG(14, modroot.next); (* Skip 'Runtime' *)
  724.   GCMark1; GCMark2;
  725.   GCScan;
  726.   GCExit;
  727.   ssp:=Super(ssp)
  728. END GC;
  729.  
  730. BEGIN
  731.   SYSTEM.GETREG(15, n); SYSTEM.GET(n + 4, basepage);
  732.   IF SetBlock(loadsize + SIZE(BasePageDesc), SYSTEM.VAL(LONGINT, basepage)) = 0 THEN
  733.     highmem:=MAlloc(-1) - ResMem + lowmem;
  734.     IF highmem - lowmem >= MinMem THEN
  735.       IF MAlloc(highmem - lowmem) = lowmem THEN
  736.         SYSTEM.PUTREG(15, highmem);
  737. (*
  738.         SYSTEM.PUTREG(14, 0); (* End condition for stack dumper *)
  739. *)
  740.         n:=0;
  741.         WHILE n < 5 DO free[n]:=0; INC(n) END;
  742.         currmem:=lowmem;
  743.         mod:=modroot.next;  (* skip 'Runtime' *)
  744.         WHILE mod # NIL DO
  745.           init:=SYSTEM.VAL(Initialization, mod.code);
  746.           init();
  747.           mod:=mod.next
  748.         END;
  749. (*
  750.         CallDisass;
  751. *)
  752.       ELSE
  753.         WriteString("Runtime: Heap allocation failed!"); WriteLn
  754.       END
  755.     ELSE
  756.       WriteString("Runtime: Unsufficient memory resources!"); WriteLn
  757.     END
  758.   ELSE
  759.     WriteString("Runtime: Initial heap allocation failed!"); WriteLn
  760.   END;
  761. (*
  762.   n:=BConIn(2);
  763. *)
  764.   Terminate(0)
  765. END Runtime.
  766.  
  767.