335 lines
12 KiB
NASM
335 lines
12 KiB
NASM
|
; =====> SGCSWEEP.ASM
|
|||
|
|
;***************************************
|
|||
|
|
;* TIPC Scheme '84 Runtime Support *
|
|||
|
|
;* Garbage Collector - Sweep Phase *
|
|||
|
|
;* *
|
|||
|
|
;* (C) Copyright 1984,1985 by Texas *
|
|||
|
|
;* Instruments Incorporated. *
|
|||
|
|
;* All rights reserved. *
|
|||
|
|
;* *
|
|||
|
|
;* Date Written: April 1984 *
|
|||
|
|
;* Last Modification: 06 January 1986 *
|
|||
|
|
;***************************************
|
|||
|
|
include scheme.equ
|
|||
|
|
|
|||
|
|
DGROUP group data
|
|||
|
|
data segment word public 'DATA'
|
|||
|
|
assume DS:DGROUP
|
|||
|
|
m_fix_er db "[VM INTERNAL ERROR] swpage: logical page not found",LF,0
|
|||
|
|
data ends
|
|||
|
|
|
|||
|
|
PGROUP group prog
|
|||
|
|
prog segment byte public 'PROG'
|
|||
|
|
assume CS:PGROUP
|
|||
|
|
public gcsweep
|
|||
|
|
gcsweep proc near
|
|||
|
|
push BP
|
|||
|
|
mov BP,SP
|
|||
|
|
; Initialize similar page type chain headers
|
|||
|
|
push ES ; save the caller's ES register
|
|||
|
|
mov AX,DS ; set ES to point to the current
|
|||
|
|
mov ES,AX ; data segment
|
|||
|
|
mov AX,END_LIST ; load the end of list indicator
|
|||
|
|
mov CX,NUMTYPES ; load table length
|
|||
|
|
mov DI,offset pagelist ; load table address
|
|||
|
|
cld ; move direction = forward
|
|||
|
|
rep stosw ; initialize the pagelist table
|
|||
|
|
pop ES ; restore the caller's ES
|
|||
|
|
; Process all except the "special" non-garbage collected pages
|
|||
|
|
; mov DX,DEDPAGES-1 ;;;; mov dx,NUMPAGES
|
|||
|
|
; Increment loop index, test for completion
|
|||
|
|
;gcsloop: inc DX ;;;; dec dx
|
|||
|
|
; cmp DX,NUMPAGES ;;;; cmp dx,DEDPAGES-1
|
|||
|
|
; jl gcsl010 ;;;; ja gcsl010
|
|||
|
|
|
|||
|
|
mov DX,NUMPAGES
|
|||
|
|
gcsloop: dec DX
|
|||
|
|
cmp DX,DEDPAGES-1
|
|||
|
|
ja gcsl010
|
|||
|
|
|
|||
|
|
pop BP
|
|||
|
|
ret
|
|||
|
|
gcsl010: push DX
|
|||
|
|
call swpage ; "sweep" the page (GC it)
|
|||
|
|
pop DX
|
|||
|
|
mov BX,DX ; copy current page number
|
|||
|
|
sal BX,1 ; double for use as index
|
|||
|
|
test attrib+[BX],NOMEMORY ; is page frame allocated?
|
|||
|
|
jnz gcsloop ; if not, skip list update
|
|||
|
|
mov AX,DX ; copy current page number
|
|||
|
|
mov SI,ptype+[BX] ; move current page's type to SI
|
|||
|
|
xchg pagelist+[SI],AX ; pagelist[type] <- page
|
|||
|
|
mov pagelink+[BX],AX ; pagelink[page] <- old pagelist[type]
|
|||
|
|
jmp short gcsloop
|
|||
|
|
gcsweep endp
|
|||
|
|
|
|||
|
|
arguments struc
|
|||
|
|
page_len dw ? ; page boundary (length - fudge factor)
|
|||
|
|
args_BP dw ? ; Caller's BP
|
|||
|
|
dw ? ; Return address
|
|||
|
|
page_no dw ?
|
|||
|
|
arguments ends
|
|||
|
|
|
|||
|
|
; Test the current page to see if it's been allocated
|
|||
|
|
public swpage
|
|||
|
|
swpage proc near
|
|||
|
|
push BP
|
|||
|
|
sub SP,offset args_BP ; reserve local storage
|
|||
|
|
mov BP,SP
|
|||
|
|
push ES ; save caller's ES
|
|||
|
|
mov BX,[BP].page_no
|
|||
|
|
sal BX,1 ; double page number for index
|
|||
|
|
test DGROUP:attrib+[BX],NOMEMORY ; allocated?
|
|||
|
|
jz swp020 ; if not allocated, loop
|
|||
|
|
swpfix: ; Fixnums are handled as immediates
|
|||
|
|
swpchar: ; Characters are handled as immediates
|
|||
|
|
swpfree: ; Why are we processing a free page?
|
|||
|
|
swpref: ; Ref cells no longer exist?
|
|||
|
|
swpret: pop ES
|
|||
|
|
add SP,offset args_BP ; drop local storage from stack
|
|||
|
|
pop BP
|
|||
|
|
ret
|
|||
|
|
swp020:
|
|||
|
|
; Dispatch on the type of data stored in this page
|
|||
|
|
mov DI,DGROUP:ptype+[BX] ; load data type for this page
|
|||
|
|
cmp DI,FREETYPE*2 ; Ignore free pages [HS]
|
|||
|
|
jz swpfree ; to relieve the swapper... [HS]
|
|||
|
|
LoadPage ES,BX ; define base paragraph for this page[HS]
|
|||
|
|
mov DI,CS:btable+[DI]
|
|||
|
|
jmp DI
|
|||
|
|
|
|||
|
|
; Process List Cells (and other fixed length pointer objects)
|
|||
|
|
swplist: mov AX,LISTSIZE
|
|||
|
|
swpl010: xor SI,SI ; SI <- 0
|
|||
|
|
xor DI,DI ; zero referenced cell counter
|
|||
|
|
mov CX,END_LIST ; load end of list marker
|
|||
|
|
mov DX,-1 ; marker for unused cell header
|
|||
|
|
push BX ; save page number index
|
|||
|
|
mov BX,psize+[BX] ; load page length and
|
|||
|
|
sub BX,AX ; adjust for boundary check
|
|||
|
|
swpl020: markedp ES:[SI].list_gc,swpl030 ; branch, if marked
|
|||
|
|
; add cell to free list
|
|||
|
|
mov ES:[SI].car,CX
|
|||
|
|
mov ES:[SI].car_page,DL ; make page=FF for unused cell
|
|||
|
|
mov CX,SI
|
|||
|
|
jmp short swpl040
|
|||
|
|
; clear GC bit
|
|||
|
|
swpl030: and byte ptr ES:[SI].list_gc,NOT_GC_BI ; clear GC "marked" bit
|
|||
|
|
inc DI ; increment referenced cell counter
|
|||
|
|
; increment cell pointer and test for end of page
|
|||
|
|
swpl040: add SI,AX
|
|||
|
|
cmp SI,BX ; test for end of page
|
|||
|
|
jbe swpl020
|
|||
|
|
; end of page-- update free list header and process next page
|
|||
|
|
pop BX ; restore page table index
|
|||
|
|
mov DGROUP:nextcell+[BX],CX
|
|||
|
|
cmp DI,0 ; any referenced cells in this page?
|
|||
|
|
jne swpret ; if ref'd cells in page, branch
|
|||
|
|
mov ptype+[BX],FREETYPE*2 ; mark empty page as free
|
|||
|
|
mov attrib+[BX],0
|
|||
|
|
jmp short swpret
|
|||
|
|
|
|||
|
|
; Process Page of Flonums
|
|||
|
|
swpflo: mov AX,FLOSIZE ; load size of a single flonum
|
|||
|
|
xor SI,SI ; SI <- 0
|
|||
|
|
xor DI,DI ; zero referenced cell counter
|
|||
|
|
mov CX,END_LIST ; load end of list marker
|
|||
|
|
mov DX,-1 ; marker for unused cell header
|
|||
|
|
push BX ; save page number index
|
|||
|
|
mov BX,psize+[BX] ; load page length and
|
|||
|
|
sub BX,AX ; adjust for boundary check
|
|||
|
|
swpf020: cmp ES:[SI].flo_type,DL ; tag = free?
|
|||
|
|
je swpf025 ; if a non-allocated cell, jump
|
|||
|
|
markedp ES:[SI].flo_gc,swpf030 ; branch, if marked
|
|||
|
|
; add flonum to free list
|
|||
|
|
mov ES:[SI].car_page,DL ; make page=FF for unused cell
|
|||
|
|
swpf025: mov ES:[SI].car,CX
|
|||
|
|
mov CX,SI
|
|||
|
|
jmp short swpf040
|
|||
|
|
; clear GC bit
|
|||
|
|
swpf030: and byte ptr ES:[SI].flo_gc,NOT_GC_BI ; clear GC "marked" bit
|
|||
|
|
inc DI ; increment referenced cell counter
|
|||
|
|
; increment cell pointer and test for end of page
|
|||
|
|
swpf040: add SI,AX
|
|||
|
|
cmp SI,BX ; test for end of page
|
|||
|
|
jbe swpf020
|
|||
|
|
; end of page-- update free list header and process next page
|
|||
|
|
pop BX ; restore page table index
|
|||
|
|
mov DGROUP:nextcell+[BX],CX
|
|||
|
|
cmp DI,0 ; any referenced cells in this page?
|
|||
|
|
jne swpf050 ; if ref'd cells in page, branch
|
|||
|
|
mov ptype+[BX],FREETYPE*2 ; mark empty page as free
|
|||
|
|
mov attrib+[BX],0
|
|||
|
|
swpf050: jmp swpret
|
|||
|
|
|
|||
|
|
; Process variable length data object
|
|||
|
|
swpbig:
|
|||
|
|
swpsym:
|
|||
|
|
swpstr:
|
|||
|
|
swpary:
|
|||
|
|
swpclos:
|
|||
|
|
swpcont:
|
|||
|
|
swpcode:
|
|||
|
|
swpenv:
|
|||
|
|
xor SI,SI
|
|||
|
|
mov DI,-1
|
|||
|
|
push BX ; save page table index
|
|||
|
|
mov BX,psize+[BX] ; load size of current page and
|
|||
|
|
sub BX,PTRSIZE ; adjust for boundary check
|
|||
|
|
swpvloop: mov DX,ES:[SI].vec_len ; load length of current object
|
|||
|
|
cmp DX,0
|
|||
|
|
jge swp001
|
|||
|
|
mov DX,BLK_OVHD+PTRSIZE
|
|||
|
|
swp001: markedp ES:[SI].vec_gc,swpv020 ; branch if object referenced
|
|||
|
|
; Object not referenced-- can we combine with previous free area?
|
|||
|
|
cmp DI,0
|
|||
|
|
jge swpv010 ; If prev obj free, branch
|
|||
|
|
; Object not referenced, but previous area was
|
|||
|
|
mov ES:[SI].vec_type,FREETYPE ; Mark this object as free
|
|||
|
|
cmp ES:[SI].vec_len,0
|
|||
|
|
jge swp002
|
|||
|
|
mov ES:[SI].vec_len,BLK_OVHD+PTRSIZE
|
|||
|
|
swp002: mov DI,SI ; Record this fact for next iteration
|
|||
|
|
jmp short swpvnxt
|
|||
|
|
; Object was not referenced and can be combined with prev free area
|
|||
|
|
swpv010: add ES:[DI].vec_len,DX ; add length into previous free obj
|
|||
|
|
jmp short swpvnxt
|
|||
|
|
; Object was referenced
|
|||
|
|
swpv020: and ES:[SI].vec_gc,NOT_GC_BI ; clear gc bit
|
|||
|
|
mov DI,-1 ; Remember last object was referenced
|
|||
|
|
; Processing of current object finished-- add length and iterate
|
|||
|
|
swpvnxt: add SI,DX ; Increment area pointer by block length
|
|||
|
|
cmp SI,BX ; Last object in block?
|
|||
|
|
jb swpvloop ; Branch, if more space
|
|||
|
|
; Processing of this page finished-- update next free area pointer
|
|||
|
|
swppfin: pop BX ; Restore page table index
|
|||
|
|
cmp DI,-1
|
|||
|
|
je swpv030 ; If last block not free, skip it
|
|||
|
|
sub SI,psize+[BX] ; Adjust in case last byte of page
|
|||
|
|
neg SI ; not accounted for
|
|||
|
|
add ES:[DI].vec_len,SI
|
|||
|
|
mov nextcell+[BX],DI ; Update free pool header
|
|||
|
|
cmp DI,0 ; is page empty?
|
|||
|
|
jne swpv040 ; if not, jump
|
|||
|
|
mov ptype+[BX],FREETYPE*2 ; mark page as being free
|
|||
|
|
mov attrib+[BX],0
|
|||
|
|
mov AX,psize+[BX]
|
|||
|
|
cmp AX,PAGESIZE ; is page larger than default page size?
|
|||
|
|
ja fix_big ; if a "large" page, must fix memory tables
|
|||
|
|
jmp swpret
|
|||
|
|
swpv030: mov nextcell+[BX],END_LIST ; Indicate no free pool
|
|||
|
|
swpv040: jmp swpret
|
|||
|
|
|
|||
|
|
; Process page of ports-- close any open files before salvaging memory
|
|||
|
|
swpport:
|
|||
|
|
xor SI,SI
|
|||
|
|
mov DI,-1
|
|||
|
|
push BX ; save page table index
|
|||
|
|
mov BX,psize+[BX] ; load size of current page and
|
|||
|
|
sub BX,PTRSIZE ; adjust for boundary check
|
|||
|
|
swpploop: mov DX,ES:[SI].pt_len ; load length of current object
|
|||
|
|
markedp ES:[SI].port_gc,swpp020 ; branch if object referenced
|
|||
|
|
cmp ES:[SI].pt_type,FREETYPE
|
|||
|
|
je not_file
|
|||
|
|
; Object not referenced-- is it an open file?
|
|||
|
|
test ES:[SI].pt_pflgs,WINDOW+STRIO
|
|||
|
|
; is this a file or a window?
|
|||
|
|
jnz not_file ; if a window, don't bother with close (jump)
|
|||
|
|
test ES:[SI].pt_pflgs,OPEN ; is file opened?
|
|||
|
|
jz not_open ; if not open, skip close (jump)
|
|||
|
|
; Close the file
|
|||
|
|
push BX ; save BX across call
|
|||
|
|
mov BX,ES:[SI].pt_handl ; load handle
|
|||
|
|
push BX ; and push as argument
|
|||
|
|
extrn zclose:near
|
|||
|
|
call zclose
|
|||
|
|
pop BX ; drop argument off stack
|
|||
|
|
pop BX ; restore register BX
|
|||
|
|
not_file:
|
|||
|
|
not_open:
|
|||
|
|
; Object not referenced-- can we combine with previous free area?
|
|||
|
|
cmp DI,0
|
|||
|
|
jge swpp010 ; If prev obj free, branch
|
|||
|
|
; Object not referenced, but previous area was
|
|||
|
|
mov ES:[SI].pt_type,FREETYPE ; Mark this object as free
|
|||
|
|
mov DI,SI ; Record this fact for next iteration
|
|||
|
|
jmp short swppnxt
|
|||
|
|
; Object was not referenced and can be combined with prev free area
|
|||
|
|
swpp010: add ES:[DI].pt_len,DX ; add length into previous free obj
|
|||
|
|
jmp short swppnxt
|
|||
|
|
; Object was referenced
|
|||
|
|
swpp020: and ES:[SI].port_gc,NOT_GC_BI ; clear gc bit
|
|||
|
|
mov DI,-1 ; Remember last object was referenced
|
|||
|
|
; Processing of current object finished-- add length and iterate
|
|||
|
|
swppnxt: add SI,DX ; Increment area pointer by block length
|
|||
|
|
cmp SI,BX ; Last object in block?
|
|||
|
|
jb swpploop ; Branch, if more space
|
|||
|
|
jmp swppfin ; complete processing
|
|||
|
|
|
|||
|
|
public fix_big
|
|||
|
|
; Restore memory management tables due to release of large page
|
|||
|
|
fix_big label near
|
|||
|
|
mov AX,PAGESIZE ; update page size of large page to
|
|||
|
|
xchg AX,psize+[BX] ; the default page size
|
|||
|
|
LoadPage DX,BX ; load para address of large page
|
|||
|
|
IFDEF EXTMEM
|
|||
|
|
and pagetabl+[BX],0FF00h
|
|||
|
|
ENDIF
|
|||
|
|
IFDEF PROMEM
|
|||
|
|
mov CX,8 ; amount to get to next selector
|
|||
|
|
ELSE
|
|||
|
|
mov CX,PAGESIZE ; CX <- PAGESIZE/16
|
|||
|
|
shr CX,1
|
|||
|
|
shr CX,1
|
|||
|
|
shr CX,1
|
|||
|
|
shr CX,1
|
|||
|
|
ENDIF
|
|||
|
|
mov BX,PAGESIZE
|
|||
|
|
fix_lop: sub AX,PAGESIZE ; decrease extended page size by one page
|
|||
|
|
jbe fix_ret ; if all pages fixed, return
|
|||
|
|
add DX,CX ; compute pointer to next physical page
|
|||
|
|
mov SI,DEDPAGES*2 ; initialize page table index
|
|||
|
|
fix_more: push BX
|
|||
|
|
LoadPage BX,SI ; is this the page we're looking for?
|
|||
|
|
cmp DX,BX
|
|||
|
|
pop BX
|
|||
|
|
je fix_fnd ; if so, jump
|
|||
|
|
inc SI ; increment the page table index
|
|||
|
|
inc SI ; twice
|
|||
|
|
cmp SI,NUMPAGES*2 ; more pages?
|
|||
|
|
jl fix_more ; if so, jump
|
|||
|
|
lea BX,m_fix_er ; error-- loop should not exit
|
|||
|
|
push BX
|
|||
|
|
mov AX,DS ; set TIPC register ES for call to
|
|||
|
|
mov ES,AX ; Lattice C routines
|
|||
|
|
C_call print_an ; print error message and exit
|
|||
|
|
fix_fnd: mov psize+[SI],BX ; reset page size to default
|
|||
|
|
mov attrib+[SI],0 ; reset "no memory" bit in attribute table
|
|||
|
|
IFDEF EXTMEM
|
|||
|
|
and pagetabl+[SI],0FF00h ; strip attributes
|
|||
|
|
ENDIF
|
|||
|
|
mov ptype+[SI],FREETYPE*2 ; mark page as free
|
|||
|
|
jmp short fix_lop ; continue to free extended pages
|
|||
|
|
fix_ret: jmp swpret ; all pages released-- return
|
|||
|
|
; Branch table for processing each data type
|
|||
|
|
btable dw swplist ; [0] List cells
|
|||
|
|
dw swpfix ; [1] Fixnums
|
|||
|
|
dw swpflo ; [2] Flonums
|
|||
|
|
dw swpbig ; [3] Bignums
|
|||
|
|
dw swpsym ; [4] Symbols
|
|||
|
|
dw swpstr ; [5] Strings
|
|||
|
|
dw swpary ; [6] Arrays
|
|||
|
|
dw swpcont ; [7] Continuations
|
|||
|
|
dw swpclos ; [8] Closures
|
|||
|
|
dw swpfree ; [9] Free space (unallocated)
|
|||
|
|
dw swpcode ; [10] Code
|
|||
|
|
dw swpref ; [11] Reference cells
|
|||
|
|
dw swpport ; [12] Port data objects
|
|||
|
|
dw swpchar ; [13] Characters
|
|||
|
|
dw swpenv ; [14] Environments
|
|||
|
|
|
|||
|
|
swpage endp
|
|||
|
|
prog ends
|
|||
|
|
end
|
|||
|
|
|
|||
|
|
|