home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / bp7os2 / os2rtl / sys / wmem.asm < prev    next >
Encoding:
Assembly Source File  |  1993-08-16  |  17.5 KB  |  392 lines
  1. ;//////////////////////////////////////////////////////
  2. ;/                                                    /
  3. ;/ Run-time Library für Borland Pascal 7.0 unter OS/2 /
  4. ;/ Heap-Memory-Manager.                               /
  5. ;/                                                    /
  6. ;/ 1993 Matthias Withopf / c't                        /
  7. ;/ Originalversion (c) 1988,92 Borland International  /
  8. ;/                                                    /
  9. ;//////////////////////////////////////////////////////
  10.  
  11.                 .286p                                         
  12.  
  13.                 _NOMACROS_ = 1                  ; keine Macros definieren
  14.                 INCLUDE SE.ASM
  15.                 INCLUDE OS2.ASM
  16.  
  17.                 ; Header jedes Heap-Segments.
  18.  
  19. hsSignature     EQU     (WORD PTR 0)
  20. hsReserved      EQU     (WORD PTR 2)
  21. hsFreeList      EQU     (BYTE PTR 4)
  22. hsMemFree       EQU     (WORD PTR 8)
  23. hsNextHeap      EQU     (WORD PTR 10)
  24. hsHeapOrg       EQU     (BYTE PTR 12)
  25.  
  26.                 ; Header jedes Heap-Blocks.
  27.  
  28. hbNext          EQU     (WORD PTR 0)
  29. hbSize          EQU     (WORD PTR 2)
  30.  
  31. DATA            SEGMENT WORD PUBLIC
  32.                 EXTRN   HeapList:WORD,HeapLimit:WORD,HeapBlock:WORD
  33.                 EXTRN   HeapError:DWORD,HeapAllocFlags:WORD
  34.  
  35. AllocSize       DW      ?       ; Lokale Variable
  36. DATA            ENDS
  37.  
  38. CODE            SEGMENT BYTE PUBLIC
  39.                 ASSUME  CS:CODE,DS:DATA
  40.  
  41.                 EXTRN   HaltError:NEAR
  42.  
  43.                 ;
  44.                 ; Procedure New(Var p : Pointer);
  45.                 ; Procedure GetMem(Var p : Pointer;Size : Word);
  46.                 ;
  47.  
  48.                 PUBLIC  NewPtr
  49. NewPtr          PROC    PASCAL FAR
  50.                 ARG     A_Size : WORD
  51.                 MOV     AX,A_Size               ; lese Größe des Speicherblocks
  52.                 CALL    NewMemory               ; fordere Speicher an
  53.                 JC      @@Error                 ; falls nicht genügend Speicher -> Fehler
  54.                 RET
  55.  
  56. @@Error:        LEAVE                           ; verlasse den Stack-Frame
  57.                 MOV     AX,203                  ; Fehler: 'Heap overflow error'
  58.                 JMP     HaltError
  59. NewPtr          ENDP
  60.  
  61.                 ;
  62.                 ; Procedure Dispose(Var p : Pointer);
  63.                 ; Procedure FreeMem(Var p : Pointer;Size : Word);
  64.                 ;
  65.  
  66.                 PUBLIC  DisposePtr
  67. DisposePtr      PROC    PASCAL FAR
  68.                 ARG     A_Ptr  : DWORD, \
  69.                         A_Size : WORD
  70.                 MOV     AX,A_Size               ; lese Größe des Speicherblocks
  71.                 MOV     CX,A_Ptr.offs           ; lese Zeiger auf den 
  72.                 MOV     BX,A_Ptr.segm           ; freizugebenden Speicherblock
  73.                 CALL    DisMemory               ; gebe Speicher frei
  74.                 JC      MemError                ; falls nicht ok -> Fehler
  75.                 RET
  76. DisposePtr      ENDP
  77.  
  78.                 ;
  79.                 ; Procedure Mark(Var p : Pointer);
  80.                 ; Procedure Release(Var p : Pointer);
  81.                 ;
  82.  
  83.                 PUBLIC  MarkPtr
  84.                 PUBLIC  ReleasePtr
  85. MarkPtr:
  86. MemError:
  87. ReleasePtr:
  88.                 MOV     AX,204                  ; Fehler: 'Invalid pointer operation'
  89.                 JMP     HaltError
  90.  
  91.                 ;
  92.                 ; Function MemAvail : LongInt;
  93.                 ;
  94.  
  95.                 PUBLIC  GetFreMem
  96. GetFreMem       PROC    PASCAL FAR
  97.                 LOCAL   L_AvailMem : DWORD
  98.                 LEA     BX,L_AvailMem           ; lese Zeiger 
  99.                 PUSH    SS                      ; auf Speicher für
  100.                 PUSH    BX                      ; Größe des freien Speichers
  101.                 CALL    DosMemAvail             ; erfrage freien Speicher
  102.                 MOV     AX,L_AvailMem.offs      ; lese Größe des 
  103.                 MOV     DX,L_AvailMem.segm      ; freien Speichers in DX/AX
  104.                 MOV     CX,HeapList             ; lese Segment der Heap-Liste
  105.                 JCXZ    @@End                   ; falls keine Blöcke alloziert -> Ende
  106. @@Loop:         MOV     ES,CX                   ; setze Segment des Heap-Segements
  107.                 ADD     AX,ES:hsMemFree         ; addiere freier Speicher
  108.                 ADC     DX,0                    ; des Heap-Segments
  109.                 MOV     CX,ES:hsNextHeap        ; lese Segment des nächsten Heap-Segments
  110.                 CMP     CX,HeapList             ; ist zu Ende ?
  111.                 JNE     @@Loop                  ; nein -> zurück und weiter suchen
  112. @@End:          RET
  113. GetFreMem       ENDP
  114.  
  115.                 ;
  116.                 ; Function MaxAvail : LongInt;
  117.                 ;
  118.  
  119.                 PUBLIC  GetFreMax
  120. GetFreMax       PROC    PASCAL FAR
  121.                 LOCAL   L_AvailMem : DWORD
  122.                 LEA     BX,L_AvailMem           ; lese Zeiger 
  123.                 PUSH    SS                      ; auf Speicher für
  124.                 PUSH    BX                      ; Größe des freien Speichers
  125.                 CALL    DosMemAvail             ; erfrage freien Speicher
  126.                 MOV     AX,L_AvailMem.offs      ; lese Größe des 
  127.                 MOV     DX,L_AvailMem.segm      ; freien Speichers in DX/AX
  128.                 OR      DX,DX                   ; mehr als 64K ?
  129.                 JNE     @@End                   ; ja -> Ende
  130.                 MOV     CX,HeapList             ; lese Segment der Heap-Liste
  131.                 JCXZ    @@End                   ; falls keine Blöcke alloziert -> Ende
  132. @@Loop:         MOV     ES,CX                   ; setze Segment des Heap-Segements
  133.                 CMP     AX,ES:hsMemFree         ; falls in diesem Heap-Segment mehr
  134.                 JAE     @@LessMem               ; Speicher frei ist als auf OS/2-Heap
  135.                 MOV     AX,ES:hsMemFree         ; -> lese freie Speichermenge
  136. @@LessMem:      MOV     CX,ES:hsNextHeap        ; lese Segment des nächsten Heap-Segments
  137.                 CMP     CX,HeapList             ; ist zu Ende ?
  138.                 JNE     @@Loop                  ; nein -> zurück und weiter suchen
  139. @@End:          RET
  140. GetFreMax       ENDP
  141.  
  142.                 ;
  143.                 ; Alloziere einen Speicherblock, dessen Größe in AX
  144.                 ; übergeben wird.
  145.                 ; Falls am Ende das Carry-Flag gelöscht ist, enthält
  146.                 ; DX:AX den Zeiger auf den Speicherblock (oder Nil),
  147.                 ; anderenfalls ist ein Fehler aufgetreten.
  148.                 ;
  149.  
  150.                 PUBLIC  NewMemory
  151. NewMemory       PROC    NEAR
  152.                 OR      AX,AX                   ; soll Block der Größe 0 angefordert werden ?
  153.                 JE      @@ReturnNil             ; ja -> gebe Nil zurück
  154.                 MOV     AllocSize,AX            ; speichere Blockgröße
  155. @@Retry:        CMP     AX,HeapLimit            ; ist es ein 'Small Block' ?
  156.                 JB      @@AllocSmall            ; ja -> weiter
  157.                 CALL    NewGlobal               ; fordere einen globalen Block an
  158.                 JNC     @@End                   ; falls ok -> Ende
  159.                 CMP     HeapLimit,0             ; ist 'Sub-Allocation' deaktiviert ?
  160.                 JE      @@HeapError             ; ja -> rufe HeapError-Funktion auf
  161.                 MOV     AX,AllocSize            ; lese gewünschte Blockgröße
  162.                 MOV     BX,HeapBlock            ; lese Größe eines globalen Blocks
  163.                 SUB     BX,hsHeapOrg
  164.                 CMP     AX,BX
  165.                 JA      @@HeapError
  166.                 CALL    NewHeapMem
  167.                 JMP     SHORT @@ChkHeapErr      ; -> teste auf Fehler
  168.  
  169.                 ; Fordere einen 'Small Block' an.
  170.  
  171. @@AllocSmall:   CALL    NewHeapMem
  172.                 JNC     @@End                   ; falls ok -> Ende
  173.                 MOV     AX,AllocSize            ; lese gewünschte Blockgröße
  174.                 CALL    NewGlobal               ; fordere einen globalen Block an
  175. @@ChkHeapErr:   JNC     @@End                   ; falls ok -> Ende
  176. @@HeapError:    MOV     AX,HeapError.offs       ; ist eine
  177.                 OR      AX,HeapError.segm       ; HeapError-Funktion definiert ?
  178.                 JE      @@NoErrFunc             ; nein -> weiter
  179.                 PUSH    AllocSize               ; rufe die HeapError-Funktion mit
  180.                 CALL    HeapError               ; der gewünschten Blockgröße auf
  181. @@NoErrFunc:    CMP     AX,1                    ; lese Ergebnis der HeapError-Funktion
  182.                 MOV     AX,AllocSize            ; lese gewünschte Größe des Blocks
  183.                 JA      @@Retry                 ; falls nochmals versuchen -> zurück
  184.                 JB      @@End                   ; falls Runtime error -> Ende mit gesetztem Carry
  185. @@ReturnNil:    XOR     AX,AX                   ; lese Nil-Zeiger
  186.                 CWD                             ; (0:0) in DX:AX
  187. @@End:          RET
  188. NewMemory       ENDP
  189.  
  190.                 ;
  191.                 ; Alloziere einen Block (Größe in AX) auf dem OS/2-Heap.
  192.                 ; Falls das Carry gelöscht ist, wird in DX:AX ein 
  193.                 ; Zeiger auf den Speicherblock zurückgegeben.
  194.                 ;
  195.  
  196. NewGlobal       PROC    PASCAL NEAR
  197.                 LOCAL   L_Sel : WORD
  198.                 PUSH    AX                      ; übergebe die gewünschte Größe
  199.                 LEA     BX,L_Sel                ; übergebe Zeiger auf 
  200.                 PUSH    SS                      ; Speicher für ein Word,
  201.                 PUSH    BX                      ; in dem der Selektor zurückgegeben wird
  202.                 PUSH    HeapAllocFlags          ; übergebe Allozierungs-Flags
  203.                 CALL    DosAllocSeg             ; fordere Speicher an
  204.                 OR      AX,AX                   ; Fehler aufgetreten ?
  205.                 JNZ     @@Error                 ; ja -> Fehler
  206.                 MOV     DX,L_Sel                ; lese Zeiger auf neuen 
  207.                 XOR     AX,AX                   ; Block in DX:AX, Carry gelöscht
  208.                 RET
  209.  
  210. @@Error:        STC                             ; setze Fehlerflag
  211.                 RET
  212. NewGlobal       ENDP
  213.  
  214.                 ;
  215.                 ; Allocate heap block
  216.                 ; In    AX    = Block size
  217.                 ; Out   DX:AX = Block pointer
  218.                 ;       CF    = 1 if error
  219.                 ;
  220.  
  221. NewHeapMem      PROC    NEAR
  222.                 ADD     AX,3                    ; runde gewünschte Blockgröße
  223.                 AND     AL,0FCH                 ; auf nächstes Vielfaches von 4 auf
  224.                 MOV     CX,HeapList             
  225.                 JCXZ    @@2
  226. @@1:            MOV     ES,CX
  227.                 CALL    NewBlock
  228.                 JNC     @@Ok                    ; falls ok -> gebe Zeiger zurück
  229.                 MOV     CX,ES:hsNextHeap
  230.                 CMP     CX,HeapList
  231.                 JNE     @@1
  232. @@2:            CALL    NewSegment
  233.                 JC      @@Exit                  ; falls Fehler -> Ende
  234.                 CALL    NewBlock
  235. @@Ok:           MOV     HeapList,ES
  236.                 MOV     AX,BX                   ; gebe den Zeiger auf den
  237.                 MOV     DX,ES                   ; Block in DX:AX zurück
  238. @@Exit:         RET
  239. NewHeapMem      ENDP
  240.  
  241.                 ;
  242.                 ; Allocate heap segment
  243.                 ; Out   ES = Heap segment
  244.                 ;       CF = 1 if error
  245.                 ;
  246.  
  247. NewSegment      PROC    NEAR
  248.                 PUSH    AX                      ; rette Akku
  249.                 MOV     AX,HeapBlock            ; lese Größe eines globalen Blocks
  250.                 CALL    NewGlobal               ; fordere einen globalen Block an
  251.                 JC      @@Error                 ; falls Fehler -> Ende
  252.                 MOV     ES,DX                   ; lese Zeiger auf das neue
  253.                 XOR     DI,DI                   ; Heap-Segment in ES:DI
  254.                 CLD                             ; setze Signatur 
  255.                 MOV     AX,'PT'                 ; in 
  256.                 STOSW                           ; hsSignature
  257.                 XOR     AX,AX                   ; lösche 
  258.                 STOSW                           ; hsReserved
  259.                 MOV     AX,hsHeapOrg            
  260.                 STOSW                           ; hsFreeList.hbNext
  261.                 XOR     AX,AX
  262.                 STOSW                           ; hsFreeList.hbSize
  263.                 MOV     AX,HeapBlock            ; lese Größe eines globalen Blocks
  264.                 SUB     AX,hsHeapOrg
  265.                 STOSW                           ; hsMemFree
  266.                 PUSH    AX
  267.                 MOV     AX,ES
  268.                 MOV     CX,HeapList
  269.                 JCXZ    @@1
  270.                 PUSH    DS
  271.                 MOV     DS,CX
  272.                 XCHG    AX,DS:hsNextHeap
  273.                 POP     DS
  274. @@1:            STOSW                           ; hsNextHeap
  275.                 XOR     AX,AX
  276.                 STOSW                           ; hbNext
  277.                 POP     AX
  278.                 STOSW                           ; hbSize
  279. @@Error:        POP     AX
  280.                 RET
  281. NewSegment      ENDP
  282.  
  283.                 ;
  284.                 ; Allocate block from heap segment
  285.                 ; In    AX = Block size
  286.                 ;       ES = Heap segment
  287.                 ; Out   BX = Block offset
  288.                 ;       CF = 1 if error
  289.                 ;
  290.  
  291. NewBlock        PROC    NEAR
  292.                 MOV     BX,hsFreeList
  293. @@1:            MOV     SI,BX
  294.                 MOV     BX,ES:[BX].hbNext
  295.                 CMP     BX,1
  296.                 JB      @@Exit
  297.                 MOV     DX,ES:[BX].hbSize
  298.                 SUB     DX,AX
  299.                 JB      @@1
  300.                 MOV     CX,ES:[BX].hbNext
  301.                 JE      @@2
  302.                 MOV     DI,BX
  303.                 ADD     DI,AX
  304.                 MOV     ES:[DI].hbNext,CX
  305.                 MOV     ES:[DI].hbSize,DX
  306.                 MOV     CX,DI
  307. @@2:            MOV     ES:[SI].hbNext,CX
  308.                 SUB     ES:hsMemFree,AX
  309.                 CLC
  310. @@Exit:         RET
  311. NewBlock        ENDP
  312.  
  313.                 ;
  314.                 ; Dispose memory
  315.                 ; In    AX    = Block size
  316.                 ;       BX:CX = Block pointer
  317.                 ; Out   CF    = 1 if error
  318.                 ;
  319.  
  320.                 PUBLIC  DisMemory
  321. DisMemory       PROC    NEAR
  322.                 OR      AX,AX                   ; soll Block der Größe 0 freigegeben werden ?
  323.                 JE      @@End                   ; ja -> Ende
  324.                 JCXZ    @@FreeGlobal            ; falls globalen Block freigeben -> weiter
  325.                 ADD     AX,3                    ; runde Blockgröße auf nächstes
  326.                 AND     AL,0FCH                 ; Vielfache von 4 auf
  327.                 MOV     ES,BX                   ; lese Zeiger auf freizugebenden 
  328.                 MOV     BX,CX                   ; Block in ES:BX
  329.                 CMP     ES:hsSignature,'PT'     ; hat der Block gültige Signatur 'TP' ?
  330.                 JNE     @@Error                 ; nein -> Fehler
  331.                 TEST    BL,3                    ; ist Block auf DWORD-Grenze aligned ?
  332.                 JNE     @@Error                 ; nein -> Fehler
  333.                 MOV     SI,hsFreeList           ; lese Offset der Frei-Liste
  334. @@1:            MOV     DI,SI                   ; rette Offset
  335.                 MOV     SI,ES:[SI].hbNext       ; lese Offset des nächsten Blocks
  336.                 OR      SI,SI                   ; Ende der Liste erreicht ?
  337.                 JE      @@2                     ; ja -> weiter
  338.                 CMP     BX,SI                   ; ist freizugebender Block gefunden ?
  339.                 JA      @@1                     ; nein -> zurück
  340.                 JE      @@Error                 
  341. @@2:            MOV     ES:[BX].hbNext,SI
  342.                 MOV     ES:[BX].hbSize,AX
  343.                 ADD     AX,ES:hsMemFree
  344.                 MOV     ES:hsMemFree,AX
  345.                 ADD     AX,hsHeapOrg
  346.                 CMP     AX,HeapBlock            ; vergleiche mit Größe für einen globalen Block
  347.                 JE      @@7
  348.                 CALL    @@3
  349.                 MOV     ES:[DI].hbNext,BX
  350.                 MOV     BX,DI                   
  351. @@3:            MOV     SI,BX
  352.                 ADD     SI,ES:[BX].hbSize
  353.                 CMP     SI,ES:[BX].hbNext
  354.                 JNE     @@End
  355.                 MOV     AX,ES:[SI].hbNext
  356.                 MOV     ES:[BX].hbNext,AX
  357.                 MOV     AX,ES:[SI].hbSize
  358.                 ADD     ES:[BX].hbSize,AX
  359. @@End:          CLC                             ; lösche Fehlerflag
  360.                 RET                             
  361.  
  362. @@Error:        STC                             ; setze Fehlerflag
  363.                 RET
  364.  
  365. @@FreeGlobal:   MOV     AX,DS                   ; soll Datensegment als Heap-Block
  366.                 CMP     AX,BX                   ; freigegeben werden ?
  367.                 JE      @@Error                 ; ja -> Fehler
  368.                 PUSH    BX                      ; übergebe Selektor des Blocks
  369.                 CALL    DosFreeSeg              ; gebe globalen Block frei
  370.                 CLC                             ; lösche Fehlerflag
  371.                 RET
  372.  
  373. @@7:            XOR     AX,AX
  374.                 MOV     BX,ES
  375.                 MOV     DX,ES:hsNextHeap
  376.                 CMP     BX,DX
  377.                 JE      @@9
  378.                 MOV     AX,HeapList
  379. @@8:            MOV     ES,AX
  380.                 MOV     AX,ES:hsNextHeap
  381.                 CMP     AX,BX
  382.                 JNE     @@8
  383.                 MOV     ES:hsNextHeap,DX
  384.                 MOV     AX,ES
  385. @@9:            MOV     HeapList,AX
  386.                 JMP     @@FreeGlobal            ; -> globalen Block freigeben
  387. DisMemory       ENDP
  388.  
  389. CODE            ENDS
  390.  
  391.                 END
  392.