home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 04 / review / sievesto.lst < prev    next >
Encoding:
File List  |  1991-01-05  |  4.8 KB  |  138 lines
  1.  
  2.  
  3. Stony Brook Modula-2  MOD\SIEVESTO.MOD
  4.  
  5.  
  6.  
  7.      1  MODULE SieveFitted;
  8.      2  
  9.      3  FROM InOut  IMPORT  Read, Write, WriteString, WriteCard, WriteLn;
  10.      4  
  11.      5  CONST
  12.      6      Size = 8190;
  13.      7      ITER = 2000;
  14.      8  
  15.      9  VAR
  16.     10      flag                    :ARRAY [0..Size] OF BOOLEAN;
  17.     11      ch                      :CHAR;
  18.     12      count                   :CARDINAL;
  19.     13  
  20.     14  PROCEDURE SieveTest;
  21.     15  VAR  i, j, k, prime   :CARDINAL;
  22.     16  BEGIN
  23.     17    FOR i := 1 TO ITER DO
  24.     18        count := 0;
  25.     19        FOR j := 0 TO Size DO
  26.     20            flag[j] := TRUE;
  27.     21        END;
  28.     22        FOR j := 0 TO Size DO
  29.     23            IF flag[j] THEN
  30.     24                prime := j+j+3;
  31.     25                k := j+prime;
  32.     26                WHILE k <= Size DO
  33.     27                    flag[k] := FALSE;
  34.     28                    INC(k,prime);
  35.     29                END;
  36.     30                INC(count);
  37.     31            END;
  38.     32        END;
  39.     33    END;
  40.     34  END SieveTest;
  41.     35  
  42.     36  BEGIN
  43.  
  44.         0000                                  
  45.         0000 31 ED                    XOR     BP, BP
  46.         0002 55                       PUSH    BP
  47.         0003 89 E5                    MOV     BP, SP
  48.         0005 9A 00000000              CALL    FAR SYSTEM_StartSmall
  49.         000A 83 EC 02                 SUB     SP, 0002
  50.         000D                                  
  51.         000D 9A 00000000              CALL    FAR InOut
  52.  
  53.     37      WriteString("Hit a key to start 2000 ITERATIONS");
  54.  
  55.         0012 B8 0022                  MOV     AX, 0022
  56.         0015 50                       PUSH    AX
  57.         0016 B8 0000                  MOV     AX, OFFSET _CONST+0000
  58.         0019 1E                       PUSH    DS
  59.         001A 50                       PUSH    AX
  60.         001B 9A 00000000              CALL    FAR InOut_WriteString
  61.  
  62. Stony Brook Modula-2  MOD\SIEVESTO.MOD
  63.  
  64.  
  65.  
  66.     38      Read(ch);  WriteLn;
  67.  
  68.         0020 8D 46 FF                 LEA     AX, WORD PTR  FFFF[BP]
  69.         0023 16                       PUSH    SS
  70.         0024 50                       PUSH    AX
  71.         0025 9A 00000000              CALL    FAR InOut_Read
  72.         002A 9A 00000000              CALL    FAR InOut_WriteLn
  73.  
  74.     39      SieveTest;
  75.  
  76.         002F BE 0001                  MOV     SI, 0001
  77.         0032                          EVEN    
  78.         0032                   L0010
  79.         0032 C7 06 00000000           MOV     WORD PTR  _BSS+0000, 0000
  80.         0038 BF 0002                  MOV     DI, OFFSET _BSS+0002
  81.         003B 1E                       PUSH    DS
  82.         003C 07                       POP     ES
  83.         003D B8 0101                  MOV     AX, 0101
  84.         0040 FC                       CLD     
  85.         0041 B9 0FFF                  MOV     CX, 0FFF
  86.         0044 F2                       REP     
  87.         0045 AB                       STOSW   
  88.         0046 AA                       STOSB   
  89.         0047 31 FF                    XOR     DI, DI
  90.         0049 90                       EVEN    
  91.         004A                   L0016
  92.         004A 80 BD 000200             CMP     BYTE PTR  _BSS+0002[DI], 0000
  93.         004F 74 22                    JE      L0019
  94.         0051 89 FA                    MOV     DX, DI
  95.         0053 01 D2                    ADD     DX, DX
  96.         0055 83 C2 03                 ADD     DX, 0003
  97.         0058 89 FB                    MOV     BX, DI
  98.         005A 01 D3                    ADD     BX, DX
  99.         005C 81 FB 1FFE               CMP     BX, 1FFE
  100.         0060 77 0D                    JA      L001B
  101.         0062                          EVEN    
  102.         0062                   L001A
  103.         0062 C6 87 000200             MOV     BYTE PTR  _BSS+0002[BX], 0000
  104.         0067 01 D3                    ADD     BX, DX
  105.         0069 81 FB 1FFE               CMP     BX, 1FFE
  106.         006D 76 F3                    JBE     L001A
  107.         006F                   L001B
  108.         006F FF 06 0000               INC     WORD PTR  _BSS+0000
  109.         0073                   L0019
  110.         0073 47                       INC     DI
  111.         0074 81 FF 1FFE               CMP     DI, 1FFE
  112.         0078 76 D0                    JBE     L0016
  113.         007A 46                       INC     SI
  114.         007B 81 FE 07D0               CMP     SI, 07D0
  115.         007F 76 B1                    JBE     L0010
  116.  
  117.     40      Write(7C); WriteCard(count,5);
  118.  
  119.         0081 B8 0007                  MOV     AX, 0007
  120.  
  121. Stony Brook Modula-2  MOD\SIEVESTO.MOD
  122.  
  123.  
  124.         0084 50                       PUSH    AX
  125.         0085 9A 00000000              CALL    FAR InOut_Write
  126.         008A FF 36 0000               PUSH    WORD PTR  _BSS+0000
  127.         008E B8 0005                  MOV     AX, 0005
  128.         0091 50                       PUSH    AX
  129.         0092 9A 00000000              CALL    FAR InOut_WriteCard
  130.  
  131.     41  END SieveFitted.
  132.  
  133.         0097                   L000F
  134.         0097                                  
  135.         0097 31 C0                    XOR     AX, AX
  136.         0099 50                       PUSH    AX
  137.         009A 9A 00000000              CALL    FAR SYSTEM_HALT
  138.