753 lines
35 KiB
NASM
753 lines
35 KiB
NASM
; =====> SQUISH.ASM
|
||
;***************************************
|
||
;* TIPC Scheme Runtime Support *
|
||
;* Memory Compaction Routines *
|
||
;* *
|
||
;* (C) Copyright 1985 by Texas *
|
||
;* Instruments Incorporated. *
|
||
;* All rights reserved. *
|
||
;* *
|
||
;* Date Written: 23 September 1985 *
|
||
;* Last Modification: 22 October 1985 *
|
||
;* *
|
||
;* rb 2/ 2/88 - put in TC's GC fix *
|
||
;* *
|
||
;***************************************
|
||
.286c ;; Utilize the expanded 80286 instruction set
|
||
include scheme.equ
|
||
|
||
DGROUP group data
|
||
XGROUP group PROGX
|
||
PGROUP group prog
|
||
|
||
MSDOS equ 021h
|
||
|
||
data segment word public 'DATA'
|
||
assume DS:DGROUP
|
||
ret_sav1 dw 0 ; return address save area
|
||
ret_sav2 dw 0 ; return address save area
|
||
;;;msg db " Compacting Memory *",0
|
||
;;;msg1a db "Moving List Cells",LF,0
|
||
;;;msg1b db "Moving Flonums",LF,0
|
||
;;;msg1c db "Moving Bignums",LF,0
|
||
;;;msg1d db "Moving Closures",LF,0
|
||
;;;msg1e db "Moving Code Blocks",LF,0
|
||
;;;msg1f db "Moving Vectors",LF,0
|
||
;;;msg1g db "Moving Continuations",LF,0
|
||
;;;msg1h db "Moving Symbols",LF,0
|
||
;;;msg1i db "Moving Strings",LF,0
|
||
;;;msg2 db "About to Relocate Pointers",LF,0
|
||
;;;msg3 db "Complementing GC Bits",LF,0
|
||
;;;msg4 db "About to Sweep",LF,0
|
||
data ends
|
||
|
||
prog segment byte public 'PROG'
|
||
assume CS:PGROUP
|
||
extrn %allocbl:far ; "alloc_block" linkage routine
|
||
|
||
;************************************************************************
|
||
;* Far Linkage to SUM_SPACE *
|
||
;************************************************************************
|
||
%sumspac proc far
|
||
pop ret_sav1
|
||
pop ret_sav2
|
||
extrn sum_spac:near
|
||
call sum_spac
|
||
push ret_sav2
|
||
push ret_sav1
|
||
ret
|
||
%sumspac endp
|
||
|
||
;************************************************************************
|
||
;* Far Linkage to GCSWEEP *
|
||
;************************************************************************
|
||
%gcsweep proc far
|
||
pop ret_sav1
|
||
pop ret_sav2
|
||
extrn gcsweep:near
|
||
call gcsweep
|
||
push ret_sav2
|
||
push ret_sav1
|
||
ret
|
||
%gcsweep endp
|
||
|
||
IFDEF EXPMEM
|
||
|
||
;************************************************************************
|
||
;* Far Linkage to GCCLEAN *
|
||
;************************************************************************
|
||
%gcclean proc far
|
||
pop ret_sav1
|
||
pop ret_sav2
|
||
extrn gcclean:near
|
||
call gcclean
|
||
push ret_sav2
|
||
push ret_sav1
|
||
ret
|
||
%gcclean endp
|
||
|
||
ENDIF
|
||
|
||
;************************************************************************
|
||
;* ***Temporary Long Linkage to PRINTF*** *
|
||
;************************************************************************
|
||
public %printf,%sdebug
|
||
%printf proc far
|
||
pop ret_sav1
|
||
pop ret_sav2
|
||
extrn printf:near
|
||
call printf
|
||
push ret_sav2
|
||
push ret_sav1
|
||
ret
|
||
%printf endp
|
||
|
||
;************************************************************************
|
||
;* ***Temporary Long Linkage to SDEBUG*** *
|
||
;************************************************************************
|
||
%sdebug proc far
|
||
pop ret_sav1
|
||
pop ret_sav2
|
||
extrn sdebug:near
|
||
call sdebug
|
||
push ret_sav2
|
||
push ret_sav1
|
||
ret
|
||
%sdebug endp
|
||
|
||
prog ends
|
||
|
||
PROGX segment byte public 'PROGX'
|
||
assume CS:XGROUP
|
||
|
||
extrn srelocat:near ; pointer relocation routine
|
||
extrn toggleGC:near ; complement GC bits
|
||
|
||
;************************************************************************
|
||
;* Garbage Collection -- Compaction Phase *
|
||
;************************************************************************
|
||
sq_args struc
|
||
sq_free dw NUMPAGES dup (?) ; amount of free space within each page
|
||
sq_plist dw NUMPAGES dup (?) ; list of pages
|
||
sq_BP dw ? ; caller's BP register
|
||
dw ? ; caller's ES register
|
||
dd ? ; return address (far call)
|
||
dw ? ; return address (near call)
|
||
sq_args ends
|
||
|
||
%squish proc far
|
||
push ES ; save caller's ES register
|
||
push BP ; and BP register
|
||
sub SP,offset sq_BP ; allocate local storage
|
||
mov BP,SP ; and establish addressability
|
||
|
||
; Compute the amount of free space in each page
|
||
lea BX,[BP].sq_free ; load address of size array
|
||
push BX ; and push as argument to "sum_space"
|
||
call %sumspac ; determine available space in each page
|
||
mov SP,BP ; drop argument from TIPC's stack
|
||
|
||
; Initialize table of page numbers
|
||
mov AX,DS ; make ES point to the data
|
||
mov ES,AX ; segment
|
||
mov CX,NUMPAGES ; load page count
|
||
lea DI,[BP].sq_plist ; load address of page number table
|
||
xor AX,AX ; initialize page number index to zero
|
||
pt_loop: stosw ; set page number to current position
|
||
add AX,WORDINCR ; increment page index
|
||
loop pt_loop ; process all page numbers
|
||
|
||
; Reset the similar page type chain headers
|
||
mov CX,NUMTYPES
|
||
mov AX,END_LIST
|
||
mov DI,offset pagelist
|
||
rep stosw
|
||
|
||
; Sort list of pages according to size available
|
||
mov DX,DEDPAGES*WORDINCR
|
||
sort_nxt: mov SI,DX
|
||
mov DI,[BP].sq_plist+[SI]
|
||
mov AX,[BP].sq_free+[DI] ; load amount of space in base page
|
||
sort_mor: add SI,WORDINCR ; increment inner loop index
|
||
mov DI,[BP].sq_plist+[SI] ; load page index
|
||
cmp AX,[BP].sq_free+[DI] ; has current page less space?
|
||
jbe sort_no ; if not, jump
|
||
mov AX,[BP].sq_free+[DI] ; load size of smaller free space
|
||
mov DI,DX
|
||
mov CX,[BP].sq_plist+[SI] ; exchange base page index
|
||
xchg CX,[BP].sq_plist+[DI] ; with current page
|
||
mov [BP].sq_plist+[SI],CX ; index
|
||
sort_no: cmp SI,NUMPAGES*WORDINCR-WORDINCR ; is inner loop complete?
|
||
jl sort_mor ; if not, jump
|
||
add DX,WORDINCR ; increment outer loop index
|
||
cmp DX,NUMPAGES*WORDINCR-WORDINCR ; is outer loop complete?
|
||
jl sort_nxt ; if not, keep on loopin'
|
||
|
||
; Update the similar page type chains
|
||
mov DI,DEDPAGES*WORDINCR
|
||
spt_loop: mov SI,[BP].sq_plist+[DI]
|
||
test attrib+[SI],NOMEMORY
|
||
jnz spt_end
|
||
mov BX,ptype+[SI]
|
||
mov AX,pagelist+[BX]
|
||
mov pagelink+[SI],AX
|
||
mov AX,SI
|
||
CORRPAGE AX
|
||
mov pagelist+[BX],AX
|
||
spt_end: add DI,WORDINCR
|
||
cmp DI,NUMPAGES*WORDINCR
|
||
jl spt_loop
|
||
|
||
IFDEF EXPMEM
|
||
call %gcclean ; Clean out Emm Page table for compaction
|
||
ENDIF
|
||
|
||
; Note: If printing messages, make ES point to the data segment
|
||
;;; mov AX,DS ;* Make ES point to the data
|
||
;;; mov ES,AX ;* segment
|
||
|
||
; Compact List Cells
|
||
;;; mov AX,offset msg1a ;*
|
||
;;; push AX ; * print message indicating we're
|
||
;;; call %printf ;* compacting list cells
|
||
call sq_list
|
||
|
||
; Compact Flonums
|
||
;;; mov AX,offset msg1b ;*
|
||
;;; push AX ; * print message indicating we're
|
||
;;; call %printf ;* compacting flonums
|
||
call sq_flo
|
||
|
||
; Compact Bignums
|
||
;;; mov AX,offset msg1c ;*
|
||
;;; push AX ; * print message indicating we're
|
||
;;; call %printf ;* compacting bignums
|
||
mov AX,BIGTYPE*2 ; load type code index for bignums
|
||
push AX ; and push as argument to "sq_var"
|
||
call sq_var
|
||
mov SP,BP ; drop arguments from stack
|
||
|
||
; Compact Closures
|
||
;;; mov AX,offset msg1d ;*
|
||
;;; push AX ; * print message indicating we're
|
||
;;; call %printf ;* compacting closures
|
||
mov AX,CLOSTYPE*2 ; load type code index for closures
|
||
push AX ; and push as argument to "sq_var"
|
||
call sq_var
|
||
mov SP,BP ; drop arguments from stack
|
||
|
||
; Compact Code Blocks
|
||
;;; mov AX,offset msg1e ;*
|
||
;;; push AX ; * print message indicating we're
|
||
;;; call %printf ;* compacting code blocks
|
||
mov AX,CODETYPE*2 ; load type index for code blocks
|
||
push AX ; and push as argument to "sq_var"
|
||
call sq_var
|
||
mov SP,BP ; drop arguments from stack
|
||
|
||
; Compact Vectors
|
||
;;; mov AX,offset msg1f ;*
|
||
;;; push AX ; * print message indicating we're
|
||
;;; call %printf ;* compacting vectors
|
||
mov AX,VECTTYPE*2 ; load type index for vectors
|
||
push AX ; and push as argument to "sq_var"
|
||
call sq_var
|
||
mov SP,BP ; drop arguments from stack
|
||
|
||
; Compact Continuations
|
||
;;; mov AX,offset msg1g ;*
|
||
;;; push AX ; * print message indicating we're
|
||
;;; call %printf ;* compacting continuations
|
||
mov AX,CONTTYPE*2 ; load type index for continuations
|
||
push AX ; and push as argument to "sq_var"
|
||
call sq_var
|
||
mov SP,BP ; drop arguments from stack
|
||
|
||
;;; Note: Let's not compact symbols for now. There are a few "special"
|
||
;;; symbols which mess things up in the runtime support if they
|
||
;;; move. Notably, CONSOLE_ and QUOTE_reg(?)
|
||
;;;; Compact Symbols
|
||
;;; mov AX,offset msg1h ;*
|
||
;;; push AX ; * print message indicating we're
|
||
;;; call %printf ;* compacting symbols
|
||
;;; mov AX,SYMTYPE*2 ; load type index for symbols
|
||
;;; push AX ; and push as argument to "sq_var"
|
||
;;; call sq_var
|
||
;;; mov SP,BP ; drop arguments from stack
|
||
|
||
; Compact Strings
|
||
;;; mov AX,offset msg1i ;*
|
||
;;; push AX ; * print message indicating we're
|
||
;;; call %printf ;* compacting strings
|
||
mov AX,STRTYPE*2 ; load type index for strings
|
||
push AX ; and push as argument to "sq_var"
|
||
call sq_var
|
||
mov SP,BP ; drop arguments from stack
|
||
|
||
; Relocate all moved pointers
|
||
;;; mov AX,offset msg2 ;*
|
||
;;; push AX ; * print a message that we're about
|
||
;;; call %printf ;* to perform pointer relocation
|
||
call srelocat ; relocate all pointers
|
||
|
||
; Toggle the GC bits used to denote forwarding
|
||
;;; mov AX,offset msg3 ;*
|
||
;;; push AX ; * print a message that we're
|
||
;;; call %printf ; * complementing the GC bits
|
||
call toggleGC ; complement the GC (forwarding) bits
|
||
|
||
IFDEF EXPMEM
|
||
call %gcclean ; Clean out Emm Page table
|
||
ENDIF
|
||
|
||
; Invoke the "sweep" portion of the garbage collector to reclaim memory
|
||
;;; mov AX,offset msg4 ;*
|
||
;;; push AX ; * print a message that it's
|
||
;;; call %printf ; * "sweep" time
|
||
call %gcsweep ; reclaim all freed memory
|
||
|
||
; Return to caller
|
||
mov SP,BP ; deallocate stack temporaries
|
||
add SP,offset sq_BP ; release local storage
|
||
pop BP ; restore caller's BP register
|
||
pop ES ; and ES register
|
||
ret ; return
|
||
%squish endp
|
||
|
||
;************************************************************************
|
||
;* Macro Support for List/Flonum Compaction *
|
||
;* *
|
||
;* Register usage during "move" phase of this routine: *
|
||
;* AX - backward chain header (destination page index) *
|
||
;* BX - (scratch register) *
|
||
;* CX - word count for block move *
|
||
;* DX - forward chain header (source page index) *
|
||
;* DS:[SI] - source list cell *
|
||
;* ES:[DI] - destination list cell *
|
||
;************************************************************************
|
||
sql_arg struc
|
||
sql_rev dw NUMPAGES dup (?) ; reversed linked list of list pages
|
||
sql_bptr dw ? ; reversed list header
|
||
sql_BP dw ? ; caller's BP
|
||
dw ? ; caller's ES
|
||
dw ? ; return address
|
||
sql_type dw ? ; type code index (for variable len objects)
|
||
sql_arg ends
|
||
|
||
sq_L_F macro uppercase,lowercase
|
||
local sql_go,sql_010,sql_020,sql_025,sql_030,sql_035
|
||
local sql_040,sql_050,sql_060,sql_070,sql_done,sql_ret
|
||
push ES ; save caller's ES
|
||
push BP ; save caller's BP
|
||
sub SP,offset sql_BP ; allocate local storage
|
||
mov BP,SP ; establish local addressability
|
||
|
||
; Create a reverse order linked list of pages
|
||
lea BX,[BP].sql_rev ; load addr of reverse linked list array
|
||
mov AX,uppercase&TYPE*2 ; load type code
|
||
pushm <AX,BX> ; push type code, array addr as arguments
|
||
call sq_rever ; create the reverse linked list
|
||
mov SP,BP ; drop arguments off TIPC's stack
|
||
cmp AX,END_LIST ; is list of pages empty?
|
||
jne sql_go ; if list non-empty, continue (jump)
|
||
jmp sql_ret ; if empty list, return
|
||
sql_go: ADJPAGE AX ; convert list header to page index value
|
||
|
||
; Move list cells from least dense pages to most dense pages
|
||
mov DX,lowercase&page ; load page number of least dense
|
||
ADJPAGE DX ; page and convert to page index
|
||
mov BX,DX ; copy page index into BX
|
||
push DS ; save DS register
|
||
|
||
; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||
; * * * WARNING: The DS Register Doesn't Point to the Data Segment * * *
|
||
; * * * in the code which follows: * * *
|
||
; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||
|
||
%LoadPage0 DS,BX ; load paragraph address of source page
|
||
|
||
mov SI,-uppercase&SIZE ; load source page index
|
||
jmp short sql_020 ; jump
|
||
|
||
; Follow backward chain to get new destination page
|
||
sql_010: mov BX,AX ; set next available cell address to
|
||
mov SS:nextcell+[BX],DI ; END_LIST
|
||
mov BX,BP ; calculate address of current element in
|
||
add BX,AX ; reversed page list
|
||
mov AX,SS:[BX].sql_rev ; load next page in backward chain
|
||
ADJPAGE AX ; convert page number to page index
|
||
sql_020: cmp AX,DX ; another destination page available?
|
||
jne sql_025
|
||
jmp sql_done ; if source page = destination page, jump
|
||
sql_025:
|
||
mov BX,AX ; copy destination page index to BX
|
||
|
||
%LoadPage1 ES,BX ; load paragraph address of dest page
|
||
mov DI,SS:nextcell+[BX] ; load free cell header
|
||
IFDEF EXTMEM
|
||
mov BX,DX ; reload dest. page so it won't ever
|
||
%LoadPage0 DS,BX ; get swapped out
|
||
ENDIF
|
||
|
||
; Make sure a cell is available in the destination page
|
||
sql_030: cmp DI,END_LIST
|
||
je sql_010
|
||
|
||
; Is there a cell to move from the source page?
|
||
sql_040: mov BX,DX
|
||
mov BX,SS:psize+[BX] ; load the page size and
|
||
sub BX,uppercase&SIZE ; compute end of page boundary
|
||
sql_050: add SI,uppercase&SIZE ; increment source page offset
|
||
cmp SI,BX ; end of source page?
|
||
ja sql_070 ; if end of page, jump
|
||
cmp [SI].car_page,0FFh ; is this cell referenced?
|
||
je sql_050 ; if an unreferenced cell, jump
|
||
|
||
; Move the cell from source page to destination page
|
||
sql_060: mov BX,ES:[DI].car ; load offset of next free cell in dest page
|
||
IF uppercase&SIZE - (uppercase&SIZE/2)*2
|
||
mov CX,uppercase&SIZE
|
||
rep movsb
|
||
ELSE
|
||
mov CX,uppercase&SIZE/WORDINCR ; load number of words to move
|
||
rep movsw ; copy the contents of the list cell
|
||
ENDIF
|
||
sub SI,uppercase&SIZE ; back up the source and destination
|
||
sub DI,uppercase&SIZE ; pointers
|
||
IFIDN <uppercase>,<LIST>
|
||
mov [SI].car_page,AL ; store a forwarding pointer into the car
|
||
mov [SI].car,DI ; field of the source list cell
|
||
ELSE
|
||
IFIDN <uppercase>,<FLO>
|
||
mov [SI].flo_data,AL
|
||
mov word ptr [SI].flo_data+1,DI
|
||
ELSE
|
||
OOPS invalid data type: uppercase
|
||
ENDIF
|
||
ENDIF
|
||
or byte ptr [SI].&lowercase&_gc,GC_BIT ; set GC bit to indicate
|
||
; forward
|
||
mov DI,BX ; copy next free cell offset into DI
|
||
jmp sql_030 ; process next move
|
||
|
||
; Follow forward pointer to get a next source page
|
||
sql_070: mov BX,DX ; copy forward chain header to BX
|
||
mov DX,SS:pagelink+[BX] ; load next page in forward chain
|
||
ADJPAGE DX ; convert page number to page index
|
||
mov BX,DX
|
||
|
||
%LoadPage0 DS,BX ; load paragraph address of source page
|
||
IFDEF EXTMEM
|
||
mov BX,AX ; reload dest. page so it won't ever
|
||
%LoadPage1 ES,BX ; get swapped out
|
||
ENDIF
|
||
|
||
mov SI,-uppercase&SIZE ; initialize source page index
|
||
cmp AX,DX ; does source page = destination page?
|
||
je sql_035
|
||
jmp sql_040 ; if not, keep on moving cells (jump)
|
||
sql_035:
|
||
; No more cells to move-- update destination page available cell header
|
||
mov BX,AX ; update next available cell pointer
|
||
mov SS:nextcell+[BX],DI ; in the destination page
|
||
|
||
; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||
; * * * WARNING: The DS Register Doesn't Point to the Data Segment * * *
|
||
; * * * in the code above * * *
|
||
; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||
|
||
; Copying complete
|
||
sql_done: pop DS ; restore data segment register (DS)
|
||
|
||
sql_ret: mov SP,BP ; clean up TIPC's stack
|
||
add SP,offset sql_BP ; deallocate local storage
|
||
pop BP ; restore caller's BP
|
||
pop ES ; restore caller's ES
|
||
ret ; return to caller
|
||
endm
|
||
|
||
;************************************************************************
|
||
;* List Cell Compaction *
|
||
;************************************************************************
|
||
sq_list proc near
|
||
sq_L_F LIST,list
|
||
sq_list endp
|
||
|
||
;************************************************************************
|
||
;* Flonum Compaction *
|
||
;************************************************************************
|
||
sq_flo proc near
|
||
sq_L_F FLO,flo
|
||
sq_flo endp
|
||
|
||
;************************************************************************
|
||
;* Variable Length Object Compaction *
|
||
;* *
|
||
;* Register usage during "move" phase of this routine: *
|
||
;* AX - backward chain header (destination page index) *
|
||
;* BX - (scratch register) *
|
||
;* CX - word count for block move *
|
||
;* DX - forward chain header (source page index) *
|
||
;* DS:[SI] - source list cell *
|
||
;* ES:[DI] - destination list cell *
|
||
;* *
|
||
;* Notes: *
|
||
;* *
|
||
;* 1. Any object which is less than 6 bytes in length cannot be moved *
|
||
;* because there's no place to put a forwarding pointer. If a *
|
||
;* page is encountered with such an object (e.g., a zero length *
|
||
;* vector) that object, and the remaining objects in that page are *
|
||
;* not copied. Processing continues with the next source page. *
|
||
;* *
|
||
;* 2. The current code block cannot be relocated, since the offset *
|
||
;* into the current code block is held in register SI in most of *
|
||
;* the code of the Scheme Virtual Machine emulator. Since it is *
|
||
;* not possible to update this offset, the page containing the *
|
||
;* current code block is skipped, if encountered during *
|
||
;* compaction. *
|
||
;************************************************************************
|
||
sq_var proc near
|
||
push ES ; save caller's ES
|
||
push BP ; save caller's BP
|
||
sub SP,offset sql_BP ; allocate local storage
|
||
mov BP,SP ; establish local addressability
|
||
|
||
; Create a reverse order linked list of pages
|
||
lea BX,[BP].sql_rev ; load addr of reverse linked list array
|
||
pushm <[BP].sql_type,BX> ; push type code, array addr as arguments
|
||
call sq_rever ; create the reverse linked list
|
||
mov SP,BP ; drop arguments off TIPC's stack
|
||
cmp AX,END_LIST ; is list of pages empty?
|
||
jne sqv_020 ; if list non-empty, continue (jump)
|
||
sqv_010: jmp sqv_ret ; if empty list, return
|
||
sqv_020: ADJPAGE AX ; convert list header to page index value
|
||
mov [BP].sql_bptr,AX ; save destination list header
|
||
|
||
; Move list cells from least dense pages to most dense pages
|
||
mov BX,[BP].sql_type ; load type index for page type
|
||
mov DX,pagelist+[BX] ; load page number of least dense
|
||
ADJPAGE DX ; page and convert to page index
|
||
cmp AX,DX ; destination page available?
|
||
je sqv_010 ; if source page = destination page, jump
|
||
mov BX,DX ; copy page index into BX
|
||
push DS ; save DS register
|
||
|
||
; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||
; * * * WARNING: The DS Register Doesn't Point to the Data Segment * * *
|
||
; * * * in the code which follows: * * *
|
||
; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||
|
||
cmp DL,byte ptr CB_pag ; does page contain current code block?
|
||
je sqv_052 ; if so, skip it
|
||
IFDEF EXPMEM
|
||
cmp psize+[BX],MIN_PAGESIZE ; page size greater than minimum?
|
||
jne sqv_052
|
||
ENDIF
|
||
%LoadPage0 DS,BX ; load paragraph address of source page
|
||
;;; mov DS,pagetabl,[BX] ; load paragraph address of source page
|
||
xor SI,SI ; load source page index
|
||
|
||
; Is there an object to move from the source page?
|
||
sqv_040: mov BX,DX
|
||
mov BX,SS:psize+[BX] ; load the page size and
|
||
sub BX,BLK_OVHD ; compute end of page boundary
|
||
sqv_050: cmp SI,BX ; end of source page?
|
||
ja sqv_052 ; if end of page, jump
|
||
cmp [SI].car_page,FREETYPE ; is this object referenced?
|
||
jne sqv_060 ; if a referenced object, jump
|
||
add SI,[SI].vec_len
|
||
jmp sqv_050
|
||
|
||
sqv_052: jmp sqv_070 ; process next source page
|
||
|
||
; Find next possible destination page
|
||
sqv_054: mov BX,AX
|
||
add BX,BP
|
||
mov AX,SS:[BX].sql_rev
|
||
ADJPAGE AX
|
||
cmp AX,DX
|
||
jne sqv_061
|
||
jmp sqv_done
|
||
|
||
; Find a block into which to move the referenced object
|
||
sqv_060: mov CX,[SI].vec_len ; load length of object
|
||
cmp CX,0 ;;; check for small string
|
||
jge sqv_001
|
||
mov CX,BLK_OVHD+PTRSIZE ;;; get the right value
|
||
sqv_001: cmp CX,BLK_OVHD+PTRSIZE ; is object "too small" to relocate?
|
||
jae sqv001
|
||
jmp sqv_070 ; if "too small", abandon this page
|
||
sqv001: mov AX,[BP].sql_bptr ; load destination page list header
|
||
sqv_061: mov BX,AX ; copy index for destination page
|
||
IFDEF EXPMEM
|
||
cmp psize+[BX],MIN_PAGESIZE ; page size greater than minimum?
|
||
jne sqv_054
|
||
ENDIF
|
||
%LoadPage1 ES,BX ; load paragraph address of dest page
|
||
IFDEF EXTMEM
|
||
%LoadPage0 DS,DX ; reload src page so it won't get swapped out
|
||
ENDIF
|
||
xor DI,DI ; page and initialize its index pointer
|
||
mov BX,SS:psize+[BX] ; load page size and
|
||
sub BX,BLK_OVHD ; adjust for boundary check
|
||
jmp short sqv_064 ; jump over increment
|
||
sqv_062: cmp ES:[DI].vec_len,0 ;;; check for small string
|
||
jge sqv_002
|
||
add DI,BLK_OVHD+PTRSIZE ;;; add the exact length
|
||
jmp sqv_064
|
||
sqv_002: add DI,ES:[DI].vec_len ; advance destination page index
|
||
sqv_064: cmp DI,BX ; end of page?
|
||
ja sqv_054 ; if end of page, jump
|
||
cmp ES:[DI].vec_type,FREETYPE ; free block?
|
||
jne sqv_062 ; if not a free block, keep looking (jump)
|
||
; Free block found-- is it big enough?
|
||
cmp CX,ES:[DI].vec_len
|
||
ja sqv_062
|
||
je sqv_068 ; if an exact fit, jump
|
||
sub CX,ES:[DI].vec_len
|
||
neg CX
|
||
cmp CX,BLK_OVHD
|
||
jge sqv_066
|
||
mov CX,[SI].vec_len
|
||
cmp CX,0 ;;; check for small string
|
||
jge sqv_062
|
||
mov CX,BLK_OVHD+PTRSIZE ;;; get the right value
|
||
jmp sqv_062
|
||
sqv_066: cmp [SI].vec_len,0 ;;; check for small string
|
||
jge sqv_003
|
||
add DI,BLK_OVHD+PTRSIZE ;;; add the right value
|
||
jmp sqv_004
|
||
sqv_003: add DI,[SI].vec_len
|
||
sqv_004: mov ES:[DI].vec_type,FREETYPE
|
||
mov ES:[DI].vec_len,CX
|
||
mov CX,[SI].vec_len
|
||
cmp CX,0 ;;; check for small string
|
||
jge sqv_005
|
||
mov CX,BLK_OVHD+PTRSIZE
|
||
sqv_005: sub DI,CX
|
||
|
||
; Move the cell from source page to destination page
|
||
sqv_068: mov BX,CX ; save the number of bytes moved
|
||
rep movsb ; copy object from source page to dest page
|
||
sub SI,BX ; back up the source and destination
|
||
sub DI,BX ; pointers
|
||
mov [SI].vec_page,AL ; store a forwarding pointer into the car
|
||
mov [SI].vec_disp,DI ; field of the source object
|
||
or byte ptr [SI].vec_gc,GC_BIT ; set GC bit to indicate forward
|
||
add SI,BX ; advance source page index to next object
|
||
sqv_069: jmp sqv_040 ; process next move
|
||
|
||
; Follow forward pointer to get a next source page
|
||
sqv_070: mov BX,DX ; copy forward chain header to BX
|
||
mov DX,SS:pagelink+[BX] ; load next page in forward chain
|
||
ADJPAGE DX ; convert page number to page index
|
||
cmp AX,DX ; source = destination? ;rb for tc
|
||
je sqv_done ; yes, jump ;rb for tc
|
||
cmp DL,SS:byte ptr CB_pag ; current code block in this page?
|
||
je sqv_070 ; we can't relocate the current code block
|
||
mov BX,DX
|
||
IFDEF EXPMEM
|
||
cmp psize+[BX],MIN_PAGESIZE ; page size greater than minimum?
|
||
jne sqv_070
|
||
ENDIF
|
||
%LoadPage0 DS,BX ; load paragraph address of source page
|
||
IFDEF EXTMEM
|
||
%LoadPage1 ES,AX ; reload dest page so it won't get swapped
|
||
ENDIF
|
||
xor SI,SI ; initialize source page index
|
||
cmp AX,DX ; does source page = destination page?
|
||
jne sqv_069 ; if not, keep on moving objects (jump)
|
||
|
||
; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||
; * * * WARNING: The DS Register Doesn't Point to the Data Segment * * *
|
||
; * * * in the code above * * *
|
||
; * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
|
||
|
||
; Copying complete
|
||
sqv_done: pop DS ; restore data segment register (DS)
|
||
|
||
sqv_ret: mov SP,BP ; clean up TIPC's stack
|
||
add SP,offset sql_BP ; deallocate local storage
|
||
pop BP ; restore caller's BP
|
||
pop ES ; restore caller's ES
|
||
ret ; return to caller
|
||
sq_var endp
|
||
|
||
;************************************************************************
|
||
;* Local Support-- Create Reverse Linked List *
|
||
|
||
;* *
|
||
;* Purpose: To create a reversed copy of the similar page list for *
|
||
;* pages of a given type. *
|
||
;* *
|
||
;* Calling Sequence: header = sq_rever(dest_array, type_index) *
|
||
;* header = header pointer of reversed list. *
|
||
;* dest_array = array to hold the pointers of the reversed *
|
||
;* linked list. *
|
||
;* type_index = type index (type*2) of the page type for *
|
||
;* which the similar page linked list is *
|
||
;* to be reversed (e.g., LISTTYPE*2 causes *
|
||
;* the linked list for list cell pages to *
|
||
;* be reversed. *
|
||
;************************************************************************
|
||
sqr_args struc
|
||
dw ? ; caller's BP
|
||
dw ? ; return address
|
||
sqr_ary dw ? ; pointer to reversed list array
|
||
sqr_typ dw ? ; type code for desired page type
|
||
sqr_args ends
|
||
|
||
sq_rever proc near
|
||
push BP ; save caller's BP
|
||
mov BP,SP ; establish addressability
|
||
mov BX,[BP].sqr_ary ; load address of destination array
|
||
mov SI,[BP].sqr_typ ; load type code for list to reverse
|
||
mov SI,pagelist+[SI] ; load list header to appropriate page type
|
||
mov AX,END_LIST ; load an end of list indicator
|
||
sqr_loop: cmp SI,END_LIST ; end of list?
|
||
je sqr_ret ; if end of list, return
|
||
mov DX,SI ; save current page number in DX
|
||
ADJPAGE SI ; convert page number to page index
|
||
mov [BX]+[SI],AX ; store prev page number into reversed array
|
||
mov SI,pagelink+[SI] ; fetch next page in linked list
|
||
mov AX,DX ; prev page number <- current page number
|
||
jmp sqr_loop ; continue 'til end of list
|
||
sqr_ret: pop BP ; restore caller's BP
|
||
ret ; return with reversed list header in AX
|
||
sq_rever endp
|
||
|
||
PROGX ends
|
||
|
||
prog segment byte public 'PROG'
|
||
assume CS:PGROUP
|
||
;************************************************************************
|
||
;* Long Linkage to gcsquish *
|
||
;* *
|
||
;* Note: The lines which are commented out in the following code were *
|
||
;* used to print the "* compacting memory *" message in the *
|
||
;* who-line. Since it's a real pain in the a.. to allow the *
|
||
;* user to change the GC messages, it was decided that no *
|
||
;* message was the best way to go. *
|
||
;************************************************************************
|
||
public gcsquish
|
||
gcsquish proc near
|
||
push ES ; save caller's ES register
|
||
push BP ; save caller's BP register
|
||
mov BP,SP
|
||
mov AX,DS ; make sure ES points to the data segment
|
||
mov ES,AX
|
||
C_call gc_on ; light up the "garbage collecting" message
|
||
;;; mov AX,offset msg ; load address of compaction message
|
||
;;; push AX ; and push as argument
|
||
;;; C_call who_writ ; display "compacting memory" message
|
||
;;; mov SP,BP ; drop argument from stack
|
||
call %squish ; perform memory compaction
|
||
C_call gc_off ; reset the garbage collection message
|
||
pop BP ; restore caller's BP
|
||
pop ES ; restore caller's ES
|
||
ret ; return to caller
|
||
gcsquish endp
|
||
|
||
prog ends
|
||
end
|
||
|