conservatory
/
pcs
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
pcs/squish.asm

753 lines
35 KiB
NASM
Raw Normal View History

Unpack disk3.tgz
2023-05-20 05:57:06 -04:00
; =====> 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