billr@saab.CNA.TEK.COM (Bill Randle) (11/23/89)
Submitted-by: Izchak Miller <izchak@linc.cis.upenn.edu>
Posting-number: Volume 8, Issue 55
Archive-name: NetHack3/Patch6b
Patch-To: NetHack3: Volume 7, Issue 56-93
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 2 (of 15)."
# Contents: patches06d
# Wrapped by billr@saab on Wed Nov 22 10:50:06 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'patches06d' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'patches06d'\"
else
echo shar: Extracting \"'patches06d'\" \(58568 characters\)
sed "s/^X//" >'patches06d' <<'END_OF_FILE'
X*** /dev/null Sun Nov 19 14:15:21 1989
X--- others/ovlmgr.asm Sat Nov 18 17:17:30 1989
X***************
X*** 0 ****
X--- 1,1179 ----
X+ ; SCCS Id: @(#)ovlmgr.asm 3.0 89/11/16
X+ ; Copyright (c) Pierre Martineau and Stephen Spackman, 1989.
X+ ; This product may be freely redistributed. See NetHack license for details.
X+
X+ PAGE 60,132
X+ TITLE 'Overlay manager for use with Microsoft overlay linker'
X+ SUBTTL 'Brought to you by Pierre Martineau and Stephen Spackman'
X+
X+ ; acknowledgements: - No thanks to Microsoft
X+ ; - alltrsidsctysti!!!
X+ ; - izchak and friends for impetus
X+ ; - us for brilliance
X+ ; - coffee for speed
X+ ; - others as necessary
X+
X+ ; assumptions: - all registers are preserved including flags
X+ ; - the stack is preserved
X+ ; - re-entrancy is not required
X+
X+ DOSALLOC equ 48h ; memory allocation
X+ DOSFREE equ 49h ; free allocated memory
X+ DOSREALLOC equ 4ah ; modify memory block
X+ DOSREAD equ 3fh ; read bytes from handle
X+ DOSSEEK equ 42h ; logical handle seek
X+ DOSOPEN equ 3dh ; open handle
X+ DOSCLOSE equ 3eh ; close handle
X+ DOSGETVEC equ 35h ; get interrupt vector
X+ DOSSETVEC equ 25h ; set interrupt vector
X+ DOSEXEC equ 4bh ; exec child process
X+ DOS equ 21h ; Dos interrupt #
X+ PRINT equ 09h ; print string
X+ TERMINATE equ 4ch ; terminate process
X+ CR equ 0dh
X+ LF equ 0ah
X+ BELL equ 07h
X+ FAERIE equ 0h ; Used for dummy segment allocation
X+ PARSIZ equ 10h ; this is the size of a paragraph - this better not change!
X+
X+ ; The following extrns are supplied by the linker
X+
X+ extrn $$OVLBASE:byte ; segment of OVERLAY_AREA
X+ extrn $$MPGSNOVL:byte ; ^ to module table
X+ extrn $$MPGSNBASE:word ; ^ to module segment fixups
X+ extrn $$INTNO:byte ; interrupt number to be used
X+ extrn $$COVL:word ; number of physical overlays
X+ extrn $$CGSN:word ; number of modules
X+ extrn $$MAIN:far ; ^ to function main()
X+
X+ public $$OVLINIT ; Our entry point
X+ ; called by the c startup code
X+
X+ ovlflgrec record running:1=0,locked:1=0,loaded:1=0 ; overlay flags
X+
X+ ; This is a dirty hack. What we need is a virtual segment that will be built
X+ ; by the (our) loader in multiple copies, one per overlay. Unfortunately, this
X+ ; doesn't seem to be a sensible idea in the minds of the folks at Microsoft.
X+ ; Declaring this segment AT will ensure that it never appears in the exefile,
X+ ; and ASSUME is dumb enough to be fooled.
X+ ;
X+ ; The reason we want to do this is also not-to-be-tried-at-home: it turns out
X+ ; that we can code a faster interrupt handler if we map overlay numbers to
X+ ; segment values. Normally I would consider this unacceptable programming
X+ ; practise because it is 86-mode specific, but the *need* for this entire
X+ ; programme is 86-mode specific, anyway.
X+
X+ pspseg segment para at FAERIE ; dummy segment for psp
X+ org 2ch ; ^ to segment of environmemt in psp
X+ pspenv LABEL WORD
X+ pspseg ends
X+
X+ ovltbl segment para at FAERIE ; Dummy segment definition for overlay table
X+
X+ ; NOTE: This segment definition MUST be exactly 16 bytes long
X+
X+ ovlflg ovlflgrec <0,0,0> ; overlay flags
X+ ovltblpad1 db ? ; go ahead, delete me!
X+ ovlmemblk dw ? ; ^ to allocated memory block
X+ ovlseg dw 0 ; ovl segment physical add.
X+ ovlfiloff dw ? ; ovl file offset in pages (512 bytes)
X+ ovlsiz dw ? ; ovl size in paragraphs
X+ ovllrudat dd 0 ; misc lru data (pseudo time stamp)
X+ ovltblpad2 dw ? ; go ahead, delete me!
X+
X+ if1
X+ if $ gt PARSIZ
X+ .err
X+ %out This segment MUST be no more than 16 bytes, REALLY!!!
X+ endif
X+ endif
X+
X+ ovlsegsiz equ PARSIZ ; this had better be true!!! (16 bytes)
X+
X+ ovltbl ends
X+
X+ EXEHDR struc ; structure of an EXE header
X+ exesign dw 5a4dh ; signature
X+ exelstpgesiz dw ? ; last page size (512 byte pages)
X+ exesiz dw ? ; total pages (including partial last page)
X+ relocitems dw ? ; number of relocation entries
X+ hdrparas dw ? ; number of paragraphs in the header
X+ minalloc dw ? ; minimum paragraph allocation
X+ maxalloc dw ? ; maximum patagraph allocation
X+ exess dw ? ; initial stack segment
X+ exesp dw ? ; initial stack pointer
X+ exechksum dw ? ; checksum
X+ exeip dw ? ; initial instruction pointer
X+ execs dw ? ; initial code segment
X+ reloctbloff dw ? ; offset from beginning of header to relocation table
X+ exeovlnum dw ? ; overlay number
X+ EXEHDR ends
X+
X+ MASK_used equ 1 ; memory block flag
X+
X+ memctlblk struc ; memory block structure
X+ memblkflg db 0 ; flags
X+ memblkpad1 db 0 ; go ahead, delete me!
X+ memblknxt dw 0 ; ^ to next block
X+ memblkprv dw 0 ; ^ to previous block
X+ memblkovl dw 0 ; ^ to overlay occupying this block
X+ memblksiz dw 0 ; size in paragraphs
X+ memblkpad db PARSIZ - ($ - memblkflg) mod parsiz dup (?) ; pad to 16 bytes
X+ memctlblk ends
X+
X+ memctlblksiz equ memblkpad + SIZE memblkpad ; should equal 1 paragraph (16 bytes)
X+
X+ ;-------------------------------------------------------------------------------
X+
X+ code segment public
X+
X+ ovlexefilhdl dw -1 ; always-open file handle of our .EXE
X+ ovltim dd 0 ; pseudo-lru time variable
X+ curovl dw offset framestk ; ^ into stack frame
X+ ovlcnt dw 0 ; # overlays
X+ modcnt dw 0 ; # of modules
X+ ovltblbse dw -1 ; segment of first overlay descriptor
X+ ovlrootcode dw 0 ; logical segment of OVERLAY_AREA
X+ ovldata dw 0 ; logical segment of OVERLAY_END
X+ memblk1st dw 0 ; first memory block
X+ pspadd dw 0 ; our psp address + 10h (for relocations)
X+ oldvec dd -1 ; saved interrupt vector
X+ oldint21 dd -1 ; saved int 21 vector
X+ memstat db 0ffh ; must we re-allocate some memory
X+ bxreg dw 0 ; temp save area
X+ esreg dw 0 ; temp save area
X+ farcall dd 0 ; internal trampoline.
X+ hdr EXEHDR <> ; EXE header work area
X+ hdrsize equ $ - hdr
X+
X+ framestk dw 100h dup (0) ; internal stack
X+
X+ moduletbl dw 256*2 dup (0) ; module lookup table
X+
X+ noroom db CR,LF,'Not enough memory to run this program. Time to go to the store.',CR,LF,BELL,'$'
X+ nocore db CR,LF,'Your dog eats all your remaining memory! You die.',CR,LF,BELL,'$'
X+ nofile db CR,LF,'The Nymph stole your .EXE file! You die.',CR,LF,BELL,'$'
X+ exitmsg db CR,LF,'$'
X+
X+ ;-------------------------------------------------------------------------------
X+
X+ $$OVLINIT proc far ; Init entry point
X+
X+ assume cs:code,ds:pspseg,es:nothing
X+
X+ push ax
X+ push bx
X+ push cx
X+ push dx
X+ push si
X+ push di
X+ push bp
X+ push ds
X+ push es ; save the world
X+ mov ax,ds ; get our psp
X+ add ax,10h
X+ mov pspadd,ax ; save it
X+ mov ds,pspenv ; get environment segment
X+ mov si,-1
X+ envloop: ; search for end of environment
X+ inc si
X+ cmp word ptr [si],0
X+ jnz envloop
X+ add si,4 ; point to EXE filename
X+ mov al,0 ; access code
X+ mov ah,DOSOPEN
X+ mov dx,si
X+ int DOS ; open EXE
X+ jnc dontdie
X+ mov al,5
X+ mov dx,offset nofile
X+ jmp putserr ; cry to the world!
X+ dontdie:
X+ mov ovlexefilhdl,ax ; save handle
X+ mov ax,SEG $$OVLBASE ; OVERLAY_AREA segment
X+ mov ovlrootcode,ax
X+
X+ ; Now allocate memory
X+ mov bx,0900h ; allocate memory for malloc()
X+ mov ah,DOSALLOC
X+ int DOS
X+ jnc getmore
X+ jmp buyram
X+ getmore:
X+ mov es,ax ; find largest free memory
X+ mov ah,DOSALLOC
X+ mov bx,0ffffh ; Everything
X+ int DOS
X+ mov ah,DOSALLOC ; allocate our own memory
X+ int DOS
X+ jnc gotitall
X+ jmp buyram
X+ gotitall:
X+ mov memstat,0 ; indicate that we have memory
X+ mov ovltblbse,ax ; overlay descriptor table begins at start of memory block
X+ mov ax,SEG $$COVL ; segment of DGROUP
X+ mov ds,ax
X+ mov cx,$$CGSN ; number of modules
X+ mov modcnt,cx ; save for later use
X+ mov cx,$$COVL ; number of physical overlays
X+ mov ovlcnt,cx ; save for later use
X+ sub bx,cx ; enough mem for ovl tbl?
X+ jnc memloop
X+ jmp buyram
X+ memloop:
X+ push bx
X+ mov ah,DOSFREE ; free first block for malloc()
X+ int DOS
X+ jnc cockadoodledoo
X+ jmp buyram
X+ cockadoodledoo:
X+
X+ assume es:ovltbl
X+
X+ xor bp,bp
X+ xor di,di
X+ xor si,si
X+ filsegtbllpp: ; initialise ovl table
X+ call gethdr ; get an EXE header
X+ mov ax,ovltblbse
X+ add ax,hdr.exeovlnum
X+ mov es,ax ; ^ to ovl table entry
X+ xor ax,ax
X+ mov word ptr ovllrudat,ax ; initialise ovl lru
X+ mov word ptr ovllrudat+2,ax
X+ mov ovlseg,ax ; initialise ovl segment
X+ mov ovlflg,al ; initialise ovl flags
X+ mov ax,hdr.exesiz
X+ shl ax,1
X+ shl ax,1
X+ shl ax,1
X+ shl ax,1
X+ shl ax,1 ; * 32
X+ mov dx,hdr.exelstpgesiz
X+ or dx,dx
X+ jz emptypage
X+ shr dx,1
X+ shr dx,1
X+ shr dx,1
X+ shr dx,1 ; / 16
X+ inc dx
X+ sub ax,20h
X+ add ax,dx
X+ emptypage:
X+ mov ovlsiz,ax ; overlay size in paragraphs
X+ sub ax,hdr.hdrparas ; actual size of code and relocation table
X+ cmp hdr.exeovlnum,0 ; skip if ovl 0 (root code)
X+ jz notlargest
X+ cmp ax,di ; find largest ovl
X+ jc notlargest
X+ mov di,ax
X+ mov si,ovlsiz
X+ notlargest:
X+ mov ovlfiloff,bp ; initialise ovl file offset
X+ add bp,hdr.exesiz ; ^ to next overlay
X+ mov dx,bp
X+ mov cl,dh
X+ mov dh,dl
X+ xor ch,ch
X+ xor dl,dl
X+ shl dx,1
X+ rcl cx,1 ; cx:dx = bp * 512
X+ mov al,0
X+ mov ah,DOSSEEK ; seek to next ovl
X+ int DOS
X+ mov ax,ovlcnt
X+ dec ax
X+ cmp ax,hdr.exeovlnum ; all overlays done?
X+ jz makmemblk
X+ jmp filsegtbllpp ; Nope, go for more.
X+ makmemblk:
X+ push si ; contains largest ovl size in paragraphs
X+
X+ assume es:nothing ; prepare first two memory blocks
X+ ; OVERLAY_AREA and allocated memory block
X+ mov ax,ovlrootcode ; OVERLAY_AREA segment
X+ mov es,ax
X+ mov si,ovltblbse
X+ add si,ovlcnt ; end of ovl table
X+ mov es:memblkflg,0 ; clear mem flags
X+ mov es:memblknxt,si ; point to next
X+ mov es:memblkprv,0 ; set previous to nothing
X+ mov es:memblksiz,di ; di contains OVERLAY_AREA size in paragraphs
X+ add di,ax
X+ mov ovldata,di ; end of OVERLAY_END
X+ mov es,si ; end of ovl tbl (first memory block in allocated memory)
X+ mov es:memblkflg,0 ; clear mem flags
X+ mov es:memblknxt,0 ; set next to nothing
X+ mov es:memblkprv,ax ; point to previous
X+ pop si
X+ pop bx
X+ mov es:memblksiz,bx ; allocated memory block size less ovl table
X+ mov memblk1st,ax ; save pointer to first mem block
X+ mov word ptr ovltim,0 ; initialise global lru time stamp
X+ mov word ptr ovltim+2,0
X+ mov ax,offset framestk
X+ mov curovl,ax ; initialise stack frame pointer
X+ mov di,ax
X+ mov word ptr cs:[di],-1 ; initialise stack frame
X+ add di,6
X+ mov ax,ovltblbse
X+ mov cs:[di],ax
X+ mov curovl,di
X+ mov es,ax
X+ mov es:ovlflg,MASK running OR MASK locked OR MASK loaded ; set flags on ovl 0
X+ inc si ; largest ovl size + 1 paragraph
X+ cmp bx,si ; enough memory to alloc largest?
X+ jnc chgintvec
X+ buyram:
X+ mov al,5
X+ mov dx,OFFSET noroom ; free up some TSRs or something
X+ jmp putserr
X+ chgintvec:
X+ mov ax,SEG $$INTNO
X+ mov ds,ax
X+ mov ah,DOSGETVEC
X+ mov al,$$INTNO ; get int number to use
X+ int DOS ; get original vector
X+ mov word ptr oldvec,bx ; save original vector
X+ mov word ptr oldvec+2,es
X+
X+ mov ah,DOSGETVEC
X+ mov al,21h
X+ int DOS ; get original vector
X+ mov word ptr oldint21,bx ; save original vector
X+ mov word ptr oldint21+2,es
X+
X+ mov ax,SEG $$INTNO
X+ mov ds,ax
X+ mov ah,DOSSETVEC
X+ mov al,$$INTNO
X+ mov bx,cs
X+ mov ds,bx
X+ mov dx,OFFSET ovlmgr ; point to ovlmgr
X+ int DOS ; set vector
X+
X+ mov ah,DOSSETVEC
X+ mov al,21h
X+ mov bx,cs
X+ mov ds,bx
X+ mov dx,OFFSET int21 ; point to int21
X+ int DOS ; set vector
X+
X+ mov cx,modcnt ; module count
X+ mov ax,SEG $$MPGSNBASE
X+ mov es,ax
X+ mov ax,cs
X+ mov ds,ax
X+
X+ assume ds:code
X+
X+ mov bx,offset $$MPGSNBASE ; ^ to linker provided overlay segment fixups
X+ mov si,offset $$MPGSNOVL ; ^ to linker provided module table
X+ mov di,offset moduletbl ; ^ to our module table
X+ modloop:
X+ mov al,es:[si] ; real physical ovl number
X+ xor ah,ah
X+ add ax,ovltblbse ; ovlctlseg address
X+ mov [di],ax ; save in module table
X+ mov ax,es:[bx] ; get seg fixup
X+ sub ax,ovlrootcode ; adjust for relative reference
X+ mov [di+2],ax ; save in module table
X+ add di,4
X+ add bx,2
X+ inc si
X+ loop modloop
X+
X+ pop es
X+ pop ds
X+ pop bp
X+ pop di
X+ pop si
X+ pop dx
X+ pop cx
X+ pop bx
X+ pop ax ; restore the world
X+ jmp $$MAIN ; And away we go!
X+
X+ $$OVLINIT endp
X+
X+ ;-------------------------------------------------------------------------------
X+
X+ ovlmgr proc far ; This the it!
X+
X+ assume cs:code,ds:nothing,es:nothing
X+
X+ mov bxreg,bx ; preserve bx
X+ mov esreg,es ; and es
X+ pop bx ; retrieve caller ip
X+ pop es ; " " cs
X+ push ax
X+ push si
X+ mov ax,es:[bx+1] ; offset in ovl to call
X+ mov word ptr farcall,ax ; into trampoline
X+ xor ah,ah
X+ mov al,es:[bx] ; module # to call
X+ add bx,3 ; fix return address
X+ mov si,curovl ; get stack frame pointer
X+ mov cs:[si+2],es ; save return seg
X+ mov cs:[si+4],bx ; and return offset
X+
X+ mov bx,ax
X+ shl bx,1
X+ shl bx,1 ; * 4 (2 words/entry in module tbl)
X+ add bx,offset moduletbl
X+ mov es,cs:[bx] ; ovl tbl entry
X+ mov ax,cs:[bx+2] ; segment fixup
X+ mov cs:[si+6],es ; ovl entry into stack frame
X+ add curovl,6 ; update stack
X+
X+ assume es:ovltbl
X+
X+ mov si,WORD PTR ovltim ; lru time stamp
X+ inc si ; time passes!
X+ mov WORD PTR ovltim,si ; update global clock
X+ mov WORD PTR ovllrudat,si ; as well as ovl clock
X+ jz ininc ; dword increment
X+ cryupcdon: test ovlflg,mask loaded ; ovl loaded?
X+ jz inload ; load it then.
X+ ovlloadedupc:
X+ add ax,ovlseg ; add fixup and segment address
X+ mov word ptr farcall+2,ax ; into trampoline
X+ mov bx,bxreg ; retore all registers
X+ mov es,esreg
X+ pop si
X+ pop ax
X+ popf ; don't forget these!
X+ call DWORD PTR farcall ; and GO
X+ pushf ; preserve registers again!
X+ mov esreg,es
X+ mov bxreg,bx
X+ mov bx,curovl ; stack frame pointer
X+ mov es,cs:[bx-6] ; retrieve ovl tbl entry
X+ push cs:[bx-4] ; set return address
X+ push cs:[bx-2]
X+ push cx
X+ mov cx,WORD PTR ovltim ; do the lru thing again
X+ inc cx
X+ mov WORD PTR ovltim,cx
X+ mov WORD PTR ovllrudat,cx
X+ jz outinc
X+ crydncdon: test ovlflg,mask loaded ; ovl loaded?
X+ jz outload ; better get it before someone notices
X+ jmpback:
X+ sub curovl,6 ; adjust stack
X+ mov bx,bxreg ; get registers back
X+ mov es,esreg
X+ pop cx
X+ iret ; and GO back
X+
X+ ininc:
X+ mov si,WORD PTR ovltim+2 ; high word of lru
X+ inc si
X+ mov WORD PTR ovltim+2,si ; update global and
X+ mov WORD PTR ovllrudat+2,si ; ovl clocks
X+ jmp cryupcdon
X+
X+ inload:
X+ call loadoverlay ; self explanatory
X+ jmp ovlloadedupc
X+
X+ outinc:
X+ mov cx,WORD PTR ovltim+2
X+ inc cx
X+ mov WORD PTR ovltim+2,cx
X+ mov WORD PTR ovllrudat+2,cx
X+ jmp crydncdon
X+
X+ outload:
X+ call loadoverlay
X+ jmp jmpback
X+
X+ ovlmgr endp
X+
X+ ;-------------------------------------------------------------------------------
X+
X+ loadoverlay proc near ; load overlay pointed to by es
X+
X+ assume cs:code,ds:nothing,es:ovltbl
X+
X+ push ax
X+ push bx
X+ push cx
X+ push dx
X+ push si
X+ push di
X+ push bp
X+ push ds
X+ push es ; just in case
X+ cmp memstat,0
X+ jz dontrealloc
X+ call reallocmem
X+ dontrealloc:
X+ call setrunning ; set the running flags
X+ test ovlflg,MASK running ; was it already running?
X+ jnz fxdadr ; Yup, it's a toughie
X+ mov ax,ovlsiz ; How much?
X+ call getpages ; never fail mem alloc, you bet.
X+ jmp gleaner
X+ fxdadr:
X+ call releasepages ; free memory where this ovl should be loaded
X+ gleaner:
X+ mov ovlmemblk,ax ; memory block to use
X+ add ax,memctlblksiz / PARSIZ; skip mem ctl blk
X+ mov ds,ax
X+ mov dx,ovlfiloff ; where in the file is it?
X+ mov cl,dh
X+ mov dh,dl
X+ xor ch,ch
X+ xor dl,dl
X+ shl dx,1
X+ rcl cx,1 ; cx:dx = dx * 512
X+ mov ah,DOSSEEK ; lseek to position
X+ mov al,0
X+ mov bx,ovlexefilhdl ; never closing handle
X+ int DOS
X+ jc burnhead ; oops!
X+ xor dx,dx
X+ mov cx,ovlsiz ; number of paragraphs to load
X+ shl cx,1
X+ shl cx,1
X+ shl cx,1
X+ shl cx,1 ; * 16 = number of bytes
X+ mov ah,DOSREAD ; prevent random DOS behaviour
X+ int DOS
X+ jc burnhead ; double oops!
X+ call ovlrlc ; perform relocation normally done by DOS EXE loader
X+ pop es ; retrieve ovl tbl entry
X+ or ovlflg,MASK loaded ; because it is now
X+ pop ds
X+ pop bp
X+ pop di
X+ pop si
X+ pop dx
X+ pop cx
X+ pop bx
X+ pop ax
X+ ret
X+
X+ burnhead:
X+ mov al,5
X+ mov dx,offset nofile
X+ jmp putserr
X+
X+ loadoverlay endp
X+
X+ ;-------------------------------------------------------------------------------
X+
X+ ovlrlc proc near ; ds:0 -> the overlay to relocate
X+
X+ assume cs:code,ds:nothing,es:ovltbl
X+
X+ mov cx,ds:relocitems ; roto-count
X+ mov ax,ds
X+ add ax,ds:hdrparas ; skip header
X+ mov ovlseg,ax ; actual code starts here
X+ mov di,ax
X+ sub di,ovlrootcode ; segment fixup value
X+ mov si,ds:reloctbloff ; ^ relocation tbl in header
X+ jcxz relocdone ; not such a good idea, after all
X+ dorelocs: ; labels don't GET comments
X+ lodsw ; offset into load module
X+ mov bx,ax
X+ lodsw ; segment in load module (zero reference)
X+ add ax,pspadd ; now it is psp relative
X+ add ax,di ; and now it is relative to the actual load address
X+ mov es,ax
X+ mov ax,es:[bx] ; pickup item to relocate
X+ add ax,pspadd ; make it psp relative
X+ cmp ax,ovlrootcode ; is it below the OVERLAY_AREA?
X+ jc reloccomputed ; yup. it's relocated
X+ cmp ax,ovldata ; is it above OVERLAY_AREA
X+ jnc reloccomputed ; yup. it's relocated
X+ add ax,di ; it's in OVERLAY_AREA, this one's ours.
X+ reloccomputed:
X+ mov es:[bx],ax ; RAM it home!?!
X+ loop dorelocs ; what goes around, comes around.
X+ relocdone: ret
X+
X+ ovlrlc endp
X+
X+ ;-------------------------------------------------------------------------------
X+
X+ getvictim proc near ; select a victim to discard (and free up some memory)
X+
X+ assume cs:code,ds:ovltbl,es:nothing
X+
X+ push bx
X+ push cx
X+ push dx
X+ push si
X+ push di
X+ push bp
X+ push ds
X+ mov ds,ovltblbse ; ^ ovl tbl
X+ xor ax,ax ; will contain the low word of lru
X+ mov dx,ax ; will contain the high word of lru
X+ mov bp,ax ; will contain ovl tbl entry
X+ mov bx,ax ; ovl tbl ptr
X+ ; mov cx,ovlcnt ; number of ovl's to scan
X+ ;foon: test ovlflg[bx],MASK loaded ; is this one loaded?
X+ ; jz skip ; nope, try next one
X+ ; test ovlflg[bx],MASK locked ; is this one loacked?
X+ ; jnz skip ; yup, try next one
X+ ; test ovlflg[bx],MASK running ; is this one running?
X+ ; jnz skip ; yup, try next one
X+ ; mov si,WORD PTR ovltim ; get global lru
X+ ; mov di,WORD PTR ovltim+2
X+ ; sub si,WORD PTR ovllrudat[bx] ; subtract from ovl lru
X+ ; sbb di,WORD PTR ovllrudat[bx+2]
X+ ; cmp dx,di ; is this one older?
X+ ; jc better ; it sure is
X+ ; jnz skip ; it definitely isn't
X+ ; cmp ax,si
X+ ; jnc skip ; it really isn't
X+ ;better: mov ax,si ; save the lru stuff and ovl ptr
X+ ; mov dx,di
X+ ; mov bp,bx
X+ ;skip: add bx,ovlsegsiz ; do next ovl
X+ ; loop foon
X+ ; or bp,bp ; did we find anyone to kill?
X+ ; jnz gotvictim ; yes we did, partner.
X+ ; xor bx,bx ; Oh well, do it again disregarding the running flag
X+ mov cx,ovlcnt
X+ foon1: test ovlflg[bx],MASK loaded
X+ jz skip1
X+ test ovlflg[bx],MASK locked
X+ jnz skip1
X+ mov si,WORD PTR ovltim
X+ mov di,WORD PTR ovltim+2
X+ sub si,WORD PTR ovllrudat[bx]
X+ sbb di,WORD PTR ovllrudat[bx+2]
X+ cmp dx,di
X+ jc better1
X+ jnz skip1
X+ cmp ax,si
X+ jnc skip1
X+ better1: mov ax,si
X+ mov dx,di
X+ mov bp,bx
X+ skip1: add bx,ovlsegsiz
X+ loop foon1
X+ or bp,bp ; were we more successful this time?
X+ jnz gotvictim ; now we got one.
X+ nomoremem:
X+ mov al,5 ; were really %$# now!
X+ mov dx,offset nocore
X+ jmp putserr
X+ gotvictim:
X+ shr bp,1 ; convert offset to segment
X+ shr bp,1
X+ shr bp,1
X+ shr bp,1
X+ mov ax,ds
X+ add ax,bp
X+ pop ds
X+ pop bp
X+ pop di
X+ pop si
X+ pop dx
X+ pop cx
X+ pop bx
X+ ret
X+ getvictim endp
X+
X+ ;-------------------------------------------------------------------------------
X+
X+ setrunning proc near ; set running flag on overlays still running
X+
X+ assume cs:code,ds:nothing,es:ovltbl
X+
X+ push es
X+ mov es,ovltblbse
X+ mov cx,ovlcnt
X+ xor bx,bx
X+ jim: and ovlflg[bx],NOT MASK running ; start by clearing them all
X+ add bx,ovlsegsiz
X+ loop jim
X+
X+ ; Now chain down the stack links, setting running flags
X+
X+ mov bx,curovl
X+ sub bx,6
X+ jmp jam
X+ jamloop:
X+ mov ds,cs:[bx]
X+ assume ds:ovltbl
X+ or ovlflg,MASK running
X+ sub bx,6
X+ jam:
X+ cmp word ptr cs:[bx],-1 ; end of stack ?
X+ jnz jamloop
X+ pop es
X+ ret
X+
X+ setrunning endp
X+
X+ ;-------------------------------------------------------------------------------
X+
X+ int21 proc near
X+
X+ ; free almost all overlay memory if app. tries to call the DOS exec function.
X+
X+ cmp ah,DOSEXEC
X+ jz freeall
X+ cmp ah,TERMINATE
X+ jz saybyebye
X+ jmp cs:oldint21
X+ saybyebye:
X+ pop ax ; clean up stack
X+ pop ax
X+ pop ax
X+ mov al,0 ; return code 0
X+ mov dx,offset exitmsg
X+ jmp putserr
X+ freeall:
X+ push ax
X+ push bx
X+ push cx
X+ push dx
X+ push si
X+ push di
X+ push bp
X+ push es
X+ push ds ; preserve calling env.
X+
X+ assume cs:code,ds:nothing,es:ovltbl
X+
X+ mov ax,cs:memblk1st ; start de-allocating from first blk
X+ jmp short lastblk
X+ unloadlp:
X+ mov ds,ax
X+ cmp ax,cs:ovltblbse ; in alloced area ?
X+ jc nextmemblk
X+ test ds:memblkflg,MASK_used ; mem blk used ?
X+ jz nextmemblk
X+ mov es,ds:memblkovl
X+ and ovlflg,NOT MASK loaded ; flag overlay as unloaded
X+ nextmemblk:
X+ mov ax,ds:memblknxt
X+ lastblk:
X+ or ax,ax ; keep going till no more
X+ jnz unloadlp
X+
X+ mov ax,cs:ovltblbse
X+ add ax,cs:ovlcnt
X+ mov es,ax ; ^ to first mem blk in alloced mem
X+ mov es:memblksiz,2 ; adjust size
X+ mov es:memblknxt,0 ; no other blocks after this one
X+ mov es:memblkflg,0 ; not used
X+ mov cs:memstat,0ffh ; memory needs to be re-alloced some day
X+
X+ mov dx,word ptr cs:oldint21
X+ mov ds,word ptr cs:oldint21+2
X+ mov ah,DOSSETVEC ; put back DOS vector to avoid calling ourselves again!
X+ mov al,21h
X+ int DOS
X+
X+ mov es,cs:ovltblbse
X+ mov bx,cs:ovlcnt
X+ add bx,2 ; re-adjust alloced size
X+ mov ah,DOSREALLOC
X+ int DOS
X+ pop ds
X+ pop es
X+ pop bp
X+ pop di
X+ pop si
X+ pop dx
X+ pop cx
X+ pop bx
X+ pop ax
X+ jmp cs:oldint21 ; allow DOS to continue!
X+
X+ int21 endp
X+
X+ ;-------------------------------------------------------------------------------
X+
X+ reallocmem proc near
X+
X+ ; re-allocate our memory after a DOS exec function
X+
X+ push es
X+ mov ah,DOSREALLOC
X+ mov es,cs:ovltblbse ; mem blk handle
X+ mov bx,0ffffh ; find out how much there is
X+ int DOS
X+ mov ah,DOSREALLOC ; re-allocate our own memory
X+ mov es,cs:ovltblbse
X+ push bx ; contains largest available blk
X+ int DOS
X+ mov cs:memstat,0 ; flag it re-alloced
X+ mov ax,cs:ovltblbse
X+ add ax,cs:ovlcnt
X+ mov es,ax ; ^ to first mem blk in alloced mem
X+ pop ax
X+ sub ax,cs:ovlcnt ; remove ovl rbl size
X+ mov es:memblksiz,ax ; fix mem blk size
X+
X+ mov ah,DOSGETVEC
X+ mov al,21h
X+ int DOS ; get original vector
X+ mov word ptr cs:oldint21,bx ; save original vector
X+ mov word ptr cs:oldint21+2,es
X+
X+ mov ah,DOSSETVEC
X+ mov al,21h
X+ mov bx,cs
X+ mov ds,bx
X+ mov dx,OFFSET int21 ; point to int21
X+ int DOS ; set vector
X+
X+ pop es
X+ ret
X+
X+ reallocmem endp
X+
X+ ;-------------------------------------------------------------------------------
X+
X+ releasepages proc near ; Arg in es, result in ax
X+
X+ ; release any memory (and overlays) where this overlay should reside
X+
X+ assume es:ovltbl
X+
X+ mov bx,es:ovlmemblk ; start of memory to release
X+ doitagain:
X+ mov ax,memblk1st ; first memory blk
X+ jmp dvart
X+ dvartloop:
X+ mov ds,ax ; memory blk to check
X+ cmp bx,ax ; does it start below the memory to release?
X+ jnc dvartsmaller ; yup
X+ mov dx,bx
X+ add dx,es:ovlsiz
X+ add dx,memctlblksiz / PARSIZ; end of memory to release
X+ cmp ax,dx ; does it start above?
X+ jnc dvartsilly ; yup
X+ call killmem ; it's in the way. Zap it.
X+ jmp chkmemblk
X+ dvartsmaller:
X+ add ax,ds:memblksiz ; end of this memory blk
X+ cmp bx,ax ; does it end below the memory to release?
X+ jnc dvartsilly ; yup
X+ call killmem ; Oh well, zap it too.
X+ chkmemblk: ; was that enough?
X+ mov ax,ds ; recently freed memory blk
X+ cmp bx,ax ; does it start in the memory to be released?
X+ jc dvartsilly ; yup, wasn't enough
X+ mov dx,bx
X+ add dx,es:ovlsiz
X+ add dx,memctlblksiz / PARSIZ; end of memory to be released
X+ add ax,ds:memblksiz ; end of freed memory
X+ cmp ax,dx ; does it end in the memory to be released?
X+ jc dvartsilly ; yup, release more
X+ dvartgotblk:
X+ mov ax,ds ; this is it!
X+ mov cx,bx
X+ sub cx,ax ; # of paragraphs between start of memory to release and mem blk
X+ jz nosplit
X+ call splitblkhigh ; split the block
X+ nosplit:
X+ mov cx,es:ovlsiz
X+ add cx,memctlblksiz / PARSIZ; paragraphs needed to load ovl
X+ jmp splitblklow ; split remaining block
X+ dvartsilly:
X+ mov ax,ds:memblknxt
X+ dvart:
X+ or ax,ax ; enf of mem list?
X+ jz dvartnocore
X+ jmp dvartloop ; play it again Sam.
X+ dvartnocore:
X+ mov al,5 ; super OOPS!
X+ mov dx,offset nocore
X+ jmp putserr
X+
X+ releasepages endp
X+
X+ ;-------------------------------------------------------------------------------
X+
X+ getpages proc near ; get enough memory to load ovl
X+
X+ mov cx,ax
X+ add cx,memctlblksiz / PARSIZ; total paragraphs needed
X+ call largestmem ; find largest free blk
X+ cmp dx,cx ; large enough?
X+ jnc gotdork ; yup.
X+ dorkkill:
X+ call getvictim ; select a victim to release
X+ call killovl ; kill the selected victim
X+ cmp ds:memblksiz,cx ; was it enough?
X+ jc dorkkill ; nope, select another one
X+ gotdork:
X+ jmp splitblklow ; split the free blk
X+
X+ getpages endp
X+
X+ ;-------------------------------------------------------------------------------
X+
X+ splitblklow proc near
X+
X+ ; split a block of memory returning the lower one to be used.
X+
X+ push es
X+ or ds:memblkflg,MASK_used ; set low block used
X+ mov ax,ds
X+ add ax,cx
X+ mov es,ax ; ^ to upper blk to be created
X+ mov ax,ds:memblksiz
X+ sub ax,cx
X+ cmp ax,1 ; must be at least 1 para remaining to split
X+ jc noodorksplit ; don't split
X+ mov ds:memblksiz,cx ; fix blk sizes
X+ mov es:memblksiz,ax
X+ mov ax,ds:memblknxt ; fix pointers
X+ mov es:memblknxt,ax
X+ mov ds:memblknxt,es
X+ mov es:memblkprv,ds
X+ mov es:memblkflg,0 ; set upper to not used
X+ push ds
X+ mov ax,es:memblknxt
X+ or ax,ax
X+ jz domergelow
X+ mov ds,ax ; fix blk after upper to point to upper
X+ mov ds:memblkprv,es
X+ domergelow:
X+ mov ax,es
X+ mov ds,ax
X+ call mergemem ; merge remaining free memory
X+ pop ds
X+ noodorksplit:
X+ pop es
X+ mov ds:memblkovl,es ; fix ptr to ovl
X+ mov ax,ds ; return lower blk segment
X+ ret
X+
X+ splitblklow endp
X+
X+ ;-------------------------------------------------------------------------------
X+
X+ splitblkhigh proc near
X+
X+ ; split a block of memory returning the upper one to be used.
X+
X+ push es
X+ mov ax,ds
X+ add ax,cx
X+ mov es,ax ; ^ to upper blk to be created
X+ mov ax,ds:memblksiz
X+ sub ax,cx ; # of para remaining in upper blk
X+ mov ds:memblksiz,cx ; fix blk sizes
X+ mov es:memblksiz,ax
X+ mov ax,ds:memblknxt ; fix blk pointers
X+ mov es:memblknxt,ax
X+ mov ds:memblknxt,es
X+ mov es:memblkprv,ds
X+ mov ds:memblkflg,0 ; set lower to not used
X+ or es:memblkflg,MASK_used ; set upper to used
X+ mov ax,es:memblknxt
X+ or ax,ax
X+ jz domergehigh
X+ push ds ; fix blk after upper to point to upper
X+ mov ds,ax
X+ mov ds:memblkprv,es
X+ pop ds
X+ domergehigh:
X+ call mergemem ; merge remaining free memory
X+ nodorksplit:
X+ mov ax,es
X+ mov ds,ax
X+ pop es
X+ mov ds:memblkovl,es ; fix ovl ptr
X+ mov ax,ds ; return upper blk segment
X+ ret
X+
X+ splitblkhigh endp
X+
X+ ;-------------------------------------------------------------------------------
X+
X+ largestmem proc near ; returns seg in ax, size in dx; clobbers bx,ds,es
X+ ; retruns first block that's large enough if possible
X+
X+ mov ax,memblk1st ; first mem blk
X+ xor dx,dx ; largest size found
X+ jmp gook
X+ gookloop: mov ds,ax
X+ test ds:memblkflg,MASK_used ; is this blk used?
X+ jnz gookme ; yup
X+ cmp ds:memblksiz,cx ; is it large enough?
X+ jc gookme ; nope
X+ mov dx,ds:memblksiz ; got one!
X+ ret
X+ gookme:
X+ mov ax,ds:memblknxt
X+ gook: or ax,ax ; end of list?
X+ jnz gookloop ; around and around
X+ ret
X+
X+ largestmem endp
X+
X+ ;-------------------------------------------------------------------------------
X+
X+ killmem proc near
X+
X+ test ds:memblkflg,MASK_used ; is it used?
X+ jz memnotused ; don't kill ovl
X+ push es
X+ mov es,ds:memblkovl
X+ and es:ovlflg,NOT MASK loaded ; zap ovl associated with this blk
X+ pop es
X+ memnotused:
X+ jmp mergemem ; merge free memory
X+
X+ killmem endp
X+
X+ ;-------------------------------------------------------------------------------
X+
X+ killovl proc near ; preserves bx
X+
X+ mov ds,ax
X+ assume ds:ovltbl
X+ and ovlflg,NOT MASK loaded ; ovl no longer loaded
X+ mov ax,ovlmemblk ; get mem blk
X+ mov ds,ax
X+ jmp mergemem ; merge free memory
X+
X+ killovl endp
X+
X+ ;-------------------------------------------------------------------------------
X+
X+ mergemem proc near
X+
X+ ; merge physically adjacent free memory blocks. Preserves es. ds -> a free block.
X+
X+ push es
X+ and ds:memblkflg,NOT MASK_used ; set current free
X+ mov ax,ds:memblkprv ; get previous blk
X+ or ax,ax ; was there a previous blk?
X+ jz gibber ; nope
X+ mov es,ax
X+ test es:memblkflg,MASK_used ; is the previous blk used?
X+ jnz gibber ; yup
X+ add ax,es:memblksiz ; end of previous blk
X+ mov dx,ds
X+ cmp dx,ax ; physically adjacent?
X+ jnz gibber ; nope
X+ mov ax,ds:memblksiz
X+ add es:memblksiz,ax ; adjust size of new larger blk
X+ mov ax,ds:memblknxt ; fix pointers
X+ mov es:memblknxt,ax
X+ or ax,ax
X+ jz almostgibber
X+ mov ds,ax ; fix pointer of next blk
X+ mov ds:memblkprv,es
X+ almostgibber:
X+ mov ax,es
X+ mov ds,ax ; new blk segment
X+ gibber:
X+ mov ax,ds:memblknxt ; get next blk
X+ or ax,ax ; was there a next blk?
X+ jz killdone ; nope
X+ mov es,ax
X+ test es:memblkflg,MASK_used ; is the nxt blk used?
X+ jnz killdone ; yup
X+ mov ax,ds
X+ add ax,ds:memblksiz ; end of this blk
X+ mov dx,es
X+ cmp ax,dx ; physically adjacent?
X+ jnz killdone ; nope
X+ mov ax,es:memblksiz
X+ add ds:memblksiz,ax ; adjust size of new larger blk
X+ mov ax,es:memblknxt ; fix pointers
X+ mov ds:memblknxt,ax
X+ or ax,ax
X+ jz killdone
X+ mov es,ax ; fix pointer of blk after nxt
X+ mov es:memblkprv,ds
X+ killdone:
X+ and ds:memblkflg,NOT MASK_used ; make sure it's free
X+ pop es
X+ ret
X+
X+ mergemem endp
X+
X+ ;-------------------------------------------------------------------------------
X+
X+ gethdr proc near ; read EXE header from handle
X+
X+ push cx
X+ mov ax,cs
X+ mov ds,ax
X+ mov dx,offset hdr ; a place to put it
X+ mov bx,ovlexefilhdl ; the file handle
X+ mov cx,hdrsize ; header size in bytes
X+ mov ah,DOSREAD
X+ int DOS ; read from file
X+ jc exegone ; oops
X+ cmp ax,cx ; got correct number of bytes?
X+ jnz exegone ; nope
X+ pop cx
X+ ret ; Wow, it worked!
X+ exegone:
X+ mov al,5 ; You lose!
X+ mov dx,offset nofile
X+ jmp putserr
X+
X+ gethdr endp
X+
X+ ;-------------------------------------------------------------------------------
X+
X+ putserr proc near
X+
X+ ; display error msg, close file, restore int vectors, free mem and return to DOS.
X+
X+ push ax ; keep return code for later
X+ mov ax,cs
X+ mov ds,ax
X+ mov ah,PRINT
X+ int DOS ; display error msg
X+ mov dx,word ptr oldvec ; get old vector
X+ cmp dx,-1 ; was it ever replaced?
X+ jz free21 ; nope
X+ push ds
X+ mov ds,word ptr oldvec+2
X+ mov ah,DOSSETVEC ; put it back then.
X+ mov al,$$INTNO
X+ int DOS
X+ pop ds
X+ free21:
X+ mov dx,word ptr oldint21
X+ cmp dx,-1
X+ jz freemem
X+ push ds
X+ mov ds,word ptr oldint21+2
X+ mov ah,DOSSETVEC ; put it back then.
X+ mov al,21h
X+ int DOS
X+ pop ds
X+ freemem:
X+ mov ax,ovltblbse ; get memory blk segment
X+ cmp ax,-1 ; was one ever allocated?
X+ jz closefile ; nope
X+ mov es,ax
X+ mov ah,DOSFREE ; must free it.
X+ int DOS
X+ closefile:
X+ mov bx,ovlexefilhdl ; get file handle
X+ cmp bx,-1 ; was the file ever opened?
X+ jz byebye ; nope
X+ mov ah,DOSCLOSE ; close it
X+ int DOS
X+ byebye:
X+ pop ax ; return code in al
X+ mov ah,TERMINATE
X+ int DOS ; terminate this process
X+
X+ putserr endp
X+
X+ code ends
X+
X+ end
X*** /dev/null Sun Nov 19 14:15:44 1989
X--- others/ovlmgr.doc Tue Nov 14 21:11:07 1989
X***************
X*** 0 ****
X--- 1,200 ----
X+ Brief notes about ovlmgr.asm
X+ ----------------------------
X+ (revised 1989nov12)
X+
X+ OVLMGR.ASM is a preliminary version of a multiple-residency overlay
X+ manager for use with the Microsoft Overlay Linker. It is functionally
X+ compatible with the one in the MSC library _except_:
X+
X+ - it doesn't support setjmp()/longjmp().
X+ - it leaves only a SMALL, fixed space for your heap (1).
X+ - it usually accesses the disk less often and is a lot faster in some
X+ applications.
X+ - it has different tuning characteristics.
X+ - you must (of course) link OVLMGR.OBJ into the root overlay (that is,
X+ outside any parentheses in the link command).
X+
X+ See also the bugs list below.
X+
X+ As with other Microsoft-compatible overlay handlers you must be *very*
X+ careful never to call a function in an overlay through a pointer,
X+ unless the initiator of the call resides in the *same* physical
X+ overlay as the target (2).
X+
X+ Although using the overlay manager is in essence much like using
X+ Microsoft's, they operate on a slightly different principle, and tuning
X+ for them is rather different. Technical part begins.
X+
X+ When overlay linking is requested (see you linker manual), the MS
X+ overlay linker changes all far calls into overlays from the (normal,
X+ 8086) format:
X+
X+ offset contents
X+ ------ --------
X+ :0000 CALL
X+ :0001 target-offset
X+ :0003 target-segment
X+
X+ to this:
X+ :0000 INT
X+ :0001 int# target-mod#
X+ :0003 target-offset
X+
X+ (note that here we are looking at the actual layout of the machine
X+ code, not at the assembly code as such) and relocates the code parts
X+ of all the different overlays into the *same* physical area. The
X+ overlaid code is all actually placed at the end of the .EXE file,
X+ after the 'normal' executable image, along with all its administrative
X+ data (fixups etc.).
X+ When this altered 'call' is executed, of course, the interrupt
X+ handler int# is invoked. Its job is to ensure that the target overlay
X+ module is in memory (reading it from the tail of the .EXE file if it
X+ isn't already loaded) and then transfer to the given offset within it,
X+ 'faking up' the effect of the 'real' far call that would normally have
X+ occurred. Something similar must be done when the call returns, to
X+ ensure that the thing being returned *into* is still (or is once more)
X+ loaded.
X+ The Microsoft linker, as we have said, relocates all the
X+ overlays to the same load address; and, in fact, it allocates am empty
X+ block of memory there that is at least as large as the largest
X+ overlay. Into this area all the overlays are loaded without further
X+ change; thus, there can only ever be one overlay in memory at one
X+ time. Transferring from one overlay to another causes one overlay to
X+ replace the other in the allocated overlay swap area.
X+ Our overlay manager does not use the space allocated by the
X+ linker in the same way. Rather, it allocates almost all of the memory
X+ available from MS-DOS (including the original overlay area). As
X+ overlays are needed, they are loaded wherever they will fit, and
X+ dynamically relocated to that address. Thus, many more than one
X+ overlay may be loaded at any given time, greatly increasing potential
X+ performance. Managament of space is more or less according to an LRU
X+ policy - once all of memory is full, the least recently used overlay
X+ is selected as the most likely candidate for replacement.
X+
X+ The implications of this difference are as follows: while with the
X+ conventional (default) overlay manager, the best strategy is to group
X+ object modules together in an overlay whenever they are known to be
X+ used in rapid succession, to make each overlay as big as possible (all
X+ things being equal) in order to take advantage of all available
X+ memory, and to make as few overlays as possible (to reduce the amount
X+ of disk access), the best strategy with our overaly manager is almost
X+ the reverse. Having a lot of small overlays will increase the amount
X+ of useful stuff that can be resident in memory at the same time; all
X+ of memory will automatically be employed; and there is no advantage at
X+ all to uniformity of size (except perhaps in the unlikely case of
X+ *exact* uniformity!).
X+ One thing that is no longer a problem with this version
X+ (though it was with all earlier versions of this overlay manager) is
X+ that the DOS exec() call works normally. The memory that is allocated
X+ for administering the overlay system is freed before the exec call is
X+ made and reallocated afterwards (we trap the DOS function request
X+ vector to do this, which isn't very nice as a programming practise but
X+ makes the existence of the overlay manager far more transparent).
X+ There is, however, one circumstance under which this can be
X+ problematic: if you use the exec() call to load a TSR application,
X+ thereby causing memory that the overlay manager was using to become
X+ unavailable, you may make it impossible for the overlaid application
X+ to proceed. This is because code that is nominally 'running' (i.e. is
X+ currently on the stack) cannot be relocated and must be reloaded
X+ at the *same address* that previously held it. If another process now
X+ owns that area of memory, there is nothing we can do.
X+ We believe that this should not be a serious concern in normal
X+ use.
X+
X+ NOTA BENE: This is a preliminary version of the overlay manager, but
X+ by now it should be fairly well debugged. If you are considering
X+ upgrading it please be aware that the following improvements are
X+ planned for the next version (though who knows when delivery will
X+ occur):
X+ Twice the speed
X+ EMS support
X+ compatible versions of setjmp() and longjmp()
X+ Integration with malloc() so the heap can grow
X+ Major code revamping
X+
X+ Enjoy!
X+ ------------------------------------------------------------------------
X+ MESSAGES
X+
X+ Not enough memory to run this program. Time to go to the store.
X+ Although DOS successfully loaded the programme, it proved
X+ impossible to allocate enough additional contiguous memory to
X+ load one or more of the overlays. Either reduce the
X+ RAM-loading of the application by reducing the size of either
X+ the root or the largest overlays, or increase the amount of
X+ memory available by unloading TSRs and/or simplifying your
X+ CONFIG.SYS.
X+
X+ Your dog eats all your remaining memory! You die.
X+ Either an internal error has occurred in ovlmgr or the
X+ application programme, or some event has caused memory that
X+ ovlmgr believed it could count on becoming unavailable. A
X+ typical example of the latter would be the result of
X+ attempting to load a TSR while an overlaid application is
X+ running.
X+
X+ The Nymph stole your .EXE file! You die.
X+ For some reason ovlmgr could not locate or read the original
X+ .EXE file in which the overlays reside. This could be due to
X+ your attempting to use a very old version of DOS,
X+ an abject shortage of file handles, some strange event causng
X+ the file to be deleted, a disk error, or the diskette that
X+ contained the executable has been removed.
X+ ------------------------------------------------------------------------
X+ KNOWN BUGS
X+
X+ The present version cannot always be used as a direct replacement for
X+ Microsoft's overlay manager (even granted the documented differences)
X+ because the minimum size required for an overlaid programme to run is
X+ at least the size of the root plus TWICE the size of the largest
X+ overlay. If a programme has previously had its overlay structure tuned
X+ to take best advantage of Microsoft overlays, this may well cause a
X+ problem. The overlays themselves will need to be split up.
X+
X+ The error messages are whimsical and NetHack-culture-specific.
X+ Somewhat more informative versions appeared in one version of the
X+ programme but they seem to have been lost.
X+
X+ Transfers between overlays are very slow in machine terms, even if
X+ both overlays happen to reside in memory at the time.
X+
X+ Locking overlays into memory is not really implemeted even though
X+ reading the source code might make you think it was.
X+ ------------------------------------------------------------------------
X+ BUG ALERT
X+
X+ To repeat a point made above, if you ever try to call a function in an
X+ overlay through a pointer, you *may* die with the Microsoft overlay
X+ manager. If you ever try to call a function in an overlay through a
X+ pointer, you *will* die with ours. Nothing in an overlay ever ends up
X+ in the same segment as the linker anticipated. You have been warned!
X+ ------------------------------------------------------------------------
X+ FOOTNOTES
X+
X+ (1) If you hunt through the code you will find a magic constant you
X+ can play with to vary this allotment, if you're brave enough. It's
X+ currently tuned for NetHack 3.0. If you should get a message to the
X+ effect that NetHack can't allocate 28000 and some bytes when entering
X+ a maze level, that isn't our problem! In all probability you forgot to
X+ rebuild your special level files when you changed the compiler flags.
X+ We got that one, too, at one point.
X+
X+ (2) This problem can be circumvented through the use of surrogate
X+ 'trampoline' functions: functions that reside in the root overlay and
X+ simply pass right through to the 'real', overlaid, implementations.
X+ This can even be made transparent to the source code through the use
X+ of the C macro preprocessor, with a locution of the form
X+ #define foo(x) foo_(x)
X+ visible everywhere except at the actual definition point of the
X+ trampoline. This has been implemented in Nethack 3.0h.
X+ ----------------------------------------------------------------------
X+ NOTICE
X+
X+ OVLMGR.ASM is brought to you by Pierre Martineau and Stephen Spackman.
X+ It, and this document, are copyright. They are, however, provided as
X+ part of NetHack and may be freely distributed as described in the
X+ NetHack license.
X+ ----------------------------------------------------------------------
X+ Stephen P Spackman stephen@concour.cs.concordia.ca
X+ ----------------------------------------------------------------------
X+ Copyright (C) 1989 Pierre G Martineau and Stephen P Spackman
X*** others/Old/pcmain.c Sun Nov 19 14:16:14 1989
X--- others/pcmain.c Tue Nov 14 20:32:13 1989
X***************
X*** 1,4 ****
X! /* SCCS Id: @(#)pcmain.c 3.0 88/11/23
X /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
X /* NetHack may be freely redistributed. See license for details. */
X /* main.c - PC, ST, and Amiga NetHack */
X--- 1,4 ----
X! /* SCCS Id: @(#)pcmain.c 3.0 89/10/25
X /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
X /* NetHack may be freely redistributed. See license for details. */
X /* main.c - PC, ST, and Amiga NetHack */
X***************
X*** 8,13 ****
X--- 8,14 ----
X #ifndef NO_SIGNAL
X #include <signal.h>
X #endif
X+ #include <ctype.h>
X #ifdef MACOS
X extern WindowPtr HackWindow;
X extern short *switches;
X***************
X*** 21,27 ****
X char SAVEF[FILENAME];
X
X char *hname = "NetHack"; /* used for syntax messages */
X! #ifndef AMIGA
X char obuf[BUFSIZ]; /* BUFSIZ is defined in stdio.h */
X #endif
X int hackpid; /* not used anymore, but kept in for save files */
X--- 22,28 ----
X char SAVEF[FILENAME];
X
X char *hname = "NetHack"; /* used for syntax messages */
X! #if !defined(AMIGA) && !defined(MACOS)
X char obuf[BUFSIZ]; /* BUFSIZ is defined in stdio.h */
X #endif
X int hackpid; /* not used anymore, but kept in for save files */
X***************
X*** 57,62 ****
X--- 58,65 ----
X # endif
X #endif
X
X+ static const char *classes = "ABCEHKPRSTVW";
X+
X int
X main(argc,argv)
X int argc;
X***************
X*** 160,166 ****
X # endif /* DGK && !OLD_TOS */
X
X initoptions();
X! # ifdef TOS
X if (flags.IBMBIOS && flags.use_color)
X set_colors();
X # endif
X--- 163,169 ----
X # endif /* DGK && !OLD_TOS */
X
X initoptions();
X! # if defined(TOS) && defined(TEXTCOLOR)
X if (flags.IBMBIOS && flags.use_color)
X set_colors();
X # endif
X***************
X*** 236,242 ****
X case 'D':
X # ifdef WIZARD
X /* Must have "name" set correctly by NETHACK.CNF,
X! * NETHACKOPTIONS, or -U
X * before this flag to enter wizard mode. */
X if(!strcmp(plname, WIZARD)) {
X wizard = TRUE;
X--- 239,245 ----
X case 'D':
X # ifdef WIZARD
X /* Must have "name" set correctly by NETHACK.CNF,
X! * NETHACKOPTIONS, or -u
X * before this flag to enter wizard mode. */
X if(!strcmp(plname, WIZARD)) {
X wizard = TRUE;
X***************
X*** 263,269 ****
X argv++;
X (void) strncpy(plname, argv[0], sizeof(plname)-1);
X } else
X! Printf("Player name expected after -U\n");
X break;
X #ifdef DGK
X /* Player doesn't want to use a RAM disk
X--- 266,272 ----
X argv++;
X (void) strncpy(plname, argv[0], sizeof(plname)-1);
X } else
X! Printf("Player name expected after -u\n");
X break;
X #ifdef DGK
X /* Player doesn't want to use a RAM disk
X***************
X*** 273,281 ****
X break;
X #endif
X default:
X! /* allow -T for Tourist, etc. */
X! (void) strncpy(pl_character, argv[0]+1,
X! sizeof(pl_character)-1);
X }
X }
X
X--- 276,302 ----
X break;
X #endif
X default:
X! if (index(classes, toupper(argv[0][1]))) {
X! /* allow -T for Tourist, etc. */
X! (void) strncpy(pl_character, argv[0]+1,
X! sizeof(pl_character)-1);
X! break;
X! } else Printf("\nUnknown switch: %s\n", argv[0]);
X! case '?':
X! Printf("\nUsage: %s [-d dir] -s [-[%s]] [maxrank] [name]...", hname, classes);
X! Printf("\n or");
X! Printf("\n %s [-d dir] [-u name] [-[%s]]", hname, classes);
X! #if defined(WIZARD) || defined(EXPLORE_MODE)
X! Printf(" [-[DX]]");
X! #endif
X! #ifdef NEWS
X! Printf(" [-n]");
X! #endif
X! #ifdef DGK
X! Printf(" [-r]");
X! #endif
X! putchar('\n');
X! return 0;
X }
X }
X
X***************
X*** 288,300 ****
X Strcpy(plname, "wizard");
X else
X #endif
X- #if defined(KR1ED) && defined(WIZARD) && defined(MACOS)
X- if (!strcmp(plname,WIZARD))
X- Strcpy(plname, "wizard");
X- else
X- #endif
X if (!*plname)
X askname();
X plnamesuffix(); /* strip suffix from name; calls askname() */
X /* again if suffix was whole name */
X /* accepts any suffix */
X--- 309,326 ----
X Strcpy(plname, "wizard");
X else
X #endif
X if (!*plname)
X askname();
X+ #if defined(WIZARD) && defined(MACOS)
X+ # ifdef KR1ED
X+ if (!strcmp(plname,WIZARD_NAME)) {
X+ # else
X+ if (!strcmp(plname,WIZARD)) {
X+ # endif
X+ Strcpy(plname, "wizard");
X+ wizard = true;
X+ }
X+ #endif
X plnamesuffix(); /* strip suffix from name; calls askname() */
X /* again if suffix was whole name */
X /* accepts any suffix */
X***************
X*** 431,437 ****
X }
X
X /*
X! * plname is filled either by an option (-U Player or -UPlayer) or
X * explicitly (by being the wizard) or by askname.
X * It may still contain a suffix denoting pl_character.
X */
X--- 457,463 ----
X }
X
X /*
X! * plname is filled either by an option (-u Player or -uPlayer) or
X * explicitly (by being the wizard) or by askname.
X * It may still contain a suffix denoting pl_character.
X */
X*** /dev/null Sun Nov 19 14:17:50 1989
X--- others/trampoli.c Fri Nov 17 20:45:08 1989
X***************
X*** 0 ****
X--- 1,420 ----
X+ /* SCCS Id: @(#)trampoli.c 3.0 89/11/15 */
X+ /* Copyright (c) 1989, by Norm Meluch and Stephen Spackman */
X+ /* NetHack may be freely redistributed. See license for details. */
X+
X+ #include "hack.h"
X+
X+ /****************************************************************************/
X+ /* */
X+ /* This file contains a series of declarations of "one liner" */
X+ /* functions. These functions are to avoid calls to functions via */
X+ /* pointers. This is necessary when the function called is in an */
X+ /* overlay segment. */
X+ /* The original function (eg foo) has been defined to be foo_ and */
X+ /* now the declaration of foo is placed in this file calling foo */
X+ /* directly. This module is _never_ placed in an overlay so */
X+ /* calls via pointers to these functions will not cause difficulties. */
X+ /* */
X+ /****************************************************************************/
X+
X+ #ifdef OVERLAY
X+
X+ /* ### apply.c ### */
X+ #undef dig
X+ #undef doapply
X+ #undef dojump
X+ #undef dorub
X+
X+ int dig() { return dig_(); }
X+ int doapply() { return doapply_(); }
X+ int dojump() { return dojump_(); }
X+ int dorub() { return dorub_(); }
X+
X+
X+ /* ### cmd.c ### */
X+ #undef doextcmd
X+ #undef doextlist
X+
X+ #ifdef POLYSELF
X+ #undef domonability
X+ #endif /* POLYSELF */
X+
X+ #undef timed_occupation
X+
X+ #if defined(WIZARD) || defined(EXPLORE_MODE)
X+ #undef wiz_attributes
X+ #endif
X+
X+ #ifdef WIZARD
X+ #undef wiz_detect
X+ #undef wiz_genesis
X+ #undef wiz_identify
X+ #undef wiz_level_tele
X+ #undef wiz_map
X+ #undef wiz_where
X+ #undef wiz_wish
X+ #endif
X+
X+ int doextcmd() { return doextcmd_(); }
X+ int doextlist() { return doextlist_(); }
X+
X+ #ifdef POLYSELF
X+ int domonability() { return domonability_(); }
X+ #endif /* POLYSELF */
X+
X+ int timed_occupation() { return timed_occupation_(); }
X+
X+ #if defined(WIZARD) || defined(EXPLORE_MODE)
X+ int wiz_attributes() { return wiz_attributes_(); }
X+ #endif
X+
X+ #ifdef WIZARD
X+ int wiz_detect() { return wiz_detect_(); }
X+ int wiz_genesis() { return wiz_genesis_(); }
X+ int wiz_identify() { return wiz_identify_(); }
X+ int wiz_level_tele() { return wiz_level_tele_(); }
X+ int wiz_map() { return wiz_map_(); }
X+ int wiz_where() { return wiz_where_(); }
X+ int wiz_wish() { return wiz_wish_(); }
X+ #endif
X+
X+
X+ /* ### do.c ### */
X+ #undef doddrop
X+ #undef dodown
X+ #undef dodrop
X+ #undef donull
X+ #undef doup
X+ #undef dowipe
X+ #undef drop
X+ #undef wipeoff
X+
X+ int doddrop() { return doddrop_(); }
X+ int dodown() { return dodown_(); }
X+ int dodrop() { return dodrop_(); }
X+ int donull() { return donull_(); }
X+ int doup() { return doup_(); }
X+ int dowipe() { return dowipe_(); }
X+ int drop(obj)
X+ register struct obj *obj; { return drop_(obj); }
X+ int wipeoff() { return wipeoff_(); }
X+
X+
X+ /* ### do_name.c ### */
X+ #undef ddocall
X+ #undef do_mname
X+
X+ int ddocall() { return ddocall_(); }
X+ int do_mname() { return do_mname_(); }
X+
X+
X+ /* ### do_wear.c ### */
X+
X+ /* ### do_wear.c ### */
X+ #undef Armor_off
X+ #undef Boots_off
X+ #undef Gloves_off
X+ #undef Helmet_off
X+ #undef Armor_on
X+ #undef Boots_on
X+ #undef Gloves_on
X+ #undef Helmet_on
X+ #undef doddoremarm
X+ #undef doputon
X+ #undef doremring
X+ #undef dotakeoff
X+ #undef dowear
X+ #undef select_off
X+ #undef take_off
X+
X+ int Armor_off() { return Armor_off_(); }
X+ int Boots_off() { return Boots_off_(); }
X+ int Gloves_off() { return Gloves_off_(); }
X+ int Helmet_off() { return Helmet_off_(); }
X+ /* int Armor_on() { return Armor_on_(); } */
X+ int Boots_on() { return Boots_on_(); }
X+ int Gloves_on() { return Gloves_on_(); }
X+ int Helmet_on() { return Helmet_on_(); }
X+ int doddoremarm() { return doddoremarm_(); }
X+ int doputon() { return doputon_(); }
X+ int doremring() { return doremring_(); }
X+ int dotakeoff() { return dotakeoff_(); }
X+ int dowear() { return dowear_(); }
X+ int select_off(otmp) struct obj *otmp; { return select_off_(otmp); }
X+ int take_off() { return take_off_(); }
X+
X+
X+ /* ### dokick.c ### */
X+ #undef dokick
X+
X+ int dokick() { return dokick_(); }
X+
X+
X+ /* ### dothrow.c ### */
X+ #undef dothrow
X+
X+ int dothrow() { return dothrow_(); }
X+
X+
X+ /* ### eat.c ### */
X+ #undef Hear_again
X+ #undef Meatdone
X+ #undef doeat
X+ #undef eatfood
X+ #undef opentin
X+ #undef unfaint
X+
X+ int Hear_again() { return Hear_again_(); }
X+ int Meatdone() { return Meatdone_(); }
X+ int doeat() { return doeat_(); }
X+ int eatfood() { return eatfood_(); }
X+ int opentin() { return opentin_(); }
X+ int unfaint() { return unfaint_(); }
X+
X+
X+ /* ### end.c ### */
X+ #undef done2
X+
X+ int done2() { return done2_(); }
X+
X+
X+ /* ### engrave.c ### */
X+ #undef doengrave
X+
X+ int doengrave() { return doengrave_(); }
X+
X+
X+ /* ### hack.c ### */
X+ #undef dopickup
X+ #undef identify
X+
X+ int dopickup() { return dopickup_(); }
X+ int identify(otmp) struct obj *otmp; { return identify_(otmp); }
X+
X+
X+ /* ### invent.c ### */
X+ #undef ckunpaid
X+ #undef ddoinv
X+ #undef dolook
X+ #undef dopramulet
X+ #undef doprarm
X+ #undef doprgold
X+ #undef doprring
X+ #undef doprtool
X+ #undef doprwep
X+ #undef dotypeinv
X+
X+ int ckunpaid(obj) struct obj *obj; { return ckunpaid_(obj); }
X+ int ddoinv() { return ddoinv_(); }
X+ int dolook() { return dolook_(); }
X+ int dopramulet() { return dopramulet_(); }
X+ int doprarm() { return doprarm_(); }
X+ int doprgold() { return doprgold_(); }
X+ int doprring() { return doprring_(); }
X+ int doprtool() { return doprtool_(); }
X+ int doprwep() { return doprwep_(); }
X+ int dotypeinv() { return dotypeinv_(); }
X+
X+
X+ /* ### ioctl.c ### */
X+ /*
X+ #ifdef UNIX
X+ #ifdef SUSPEND
X+ #undef dosuspend
X+
X+ int dosuspend() { return dosuspend_(); }
X+ #endif
X+ #endif
X+ */
X+
X+
X+ /* ### lock.c ### */
X+ #undef doclose
X+ #undef doforce
X+ #undef doopen
X+ #undef forcelock
X+ #undef picklock
X+
X+ int doclose() { return doclose_(); }
X+ int doforce() { return doforce_(); }
X+ int doopen() { return doopen_(); }
X+ int forcelock() { return forcelock_(); }
X+ int picklock() { return picklock_(); }
X+
X+
X+ /* ### o_init.c ### */
X+ #undef dodiscovered
X+
X+ int dodiscovered() { return dodiscovered_(); }
X+
X+
X+ /* ### objnam.c ### */
X+ #undef doname
X+ #undef xname
X+
X+ char *doname(obj) struct obj *obj; { return doname_(obj); }
X+ char *xname(obj) struct obj *obj; { return xname_(obj); }
X+
X+
X+ /* ### options.c ### */
X+ #undef doset
X+ #undef dotogglepickup
X+
X+ int doset() { return doset_(); }
X+ int dotogglepickup() { return dotogglepickup_(); }
X+
X+
X+ /* ### pager.c ### */
X+ #undef dohelp
X+ #undef dohistory
X+ #undef dowhatdoes
X+ #undef dowhatis
X+ #ifdef UNIX
X+ #ifdef SHELL
X+ #undef dosh
X+
X+ int dosh() { return dosh_(); }
X+ #endif
X+ #endif
X+
X+ int dohelp() { return dohelp_(); }
X+ int dohistory() { return dohistory_(); }
X+ int dowhatdoes() { return dowhatdoes_(); }
X+ int dowhatis() { return dowhatis_(); }
X+
X+
X+ /* ### pickup.c ### */
X+ #undef ck_bag
X+ #undef ck_container
X+ #undef doloot
X+ #undef in_container
X+ #undef out_container
X+
X+ int ck_bag() { return ck_bag_(); }
X+ int ck_container(obj) struct obj *obj; { return ck_container_(obj); }
X+ int doloot() { return doloot_(); }
X+ int in_container(obj) struct obj *obj; { return in_container_(obj); }
X+ int out_container(obj) struct obj *obj; { return out_container_(obj); }
X+
X+
X+ /* ### potion.c ### */
X+ #undef dodrink
X+ #undef dodip
X+
X+ int dodrink() { return dodrink_(); }
X+ int dodip() { return dodip_(); }
X+
X+
X+ /* ### pray.c ### */
X+ #undef doturn
X+ #ifdef THEOLOGY
X+ #undef dopray
X+ #undef dosacrifice
X+
X+ int dopray() { return dopray_(); }
X+ int dosacrifice() { return dosacrifice_(); }
X+ #endif /* THEOLOGY */
X+
X+ int doturn() { return doturn_(); }
X+
X+
X+ /* ### pri.c ### */
X+ #undef doredraw
X+
X+ int doredraw() { return doredraw_(); }
X+
X+
X+ /* ### read.c ### */
X+ #undef doread
X+
X+ int doread() { return doread_(); }
X+
X+
X+ /* ### save.c ### */
X+ #undef dosave
X+
X+ int dosave() { return dosave_(); }
X+
X+
X+ /* ### search.c ### */
X+ #undef doidtrap
X+ #undef dosearch
X+
X+ int doidtrap() { return doidtrap_(); }
X+ int dosearch() { return dosearch_(); }
X+
X+
X+ /* ### shk.c ### */
X+ #undef dopay
X+
X+ int dopay() { return dopay_(); }
X+
X+
X+ /* ### sit.c ### */
X+ #undef dosit
X+
X+ int dosit() { return dosit_(); }
X+
X+
X+ /* ### sounds.c ### */
X+ #undef dotalk
X+
X+ int dotalk() { return dotalk_(); }
X+
X+
X+ /* ### spell.c ### */
X+ #ifdef SPELLS
X+ #undef learn
X+ #undef docast
X+ #undef dovspell
X+
X+ int learn() { return learn_(); }
X+ int docast() { return docast_(); }
X+ int dovspell() { return dovspell_(); }
X+ #endif
X+
X+
X+ /* ### steal.c ### */
X+ #undef stealarm
X+
X+ int stealarm() { return stealarm_(); }
X+
X+
X+ /* ### topl.c ### */
X+ #undef doredotopl
X+
X+ int doredotopl() { return doredotopl_(); }
X+
X+
X+ /* ### trap.c ### */
X+ #undef dotele
X+ #undef dountrap
X+ #undef float_down
X+
X+ int dotele() { return dotele_(); }
X+ int dountrap() { return dountrap_(); }
X+ int float_down() { return float_down_(); }
X+
X+
X+ /* ### version.c ### */
X+ #undef doversion
X+
X+ int doversion() { return doversion_(); }
X+
X+
X+ /* ### wield.c ### */
X+ #undef dowield
X+
X+ int dowield() { return dowield_(); }
X+
X+
X+ /* ### zap.c ### */
X+ #undef bhitm
X+ #undef bhito
X+ #undef dozap
X+
X+ int bhitm(mtmp, otmp) struct monst *mtmp; struct obj *otmp;
X+ { return bhitm_(mtmp, otmp); }
X+ int bhito(obj, otmp) struct obj *obj, *otmp; { return bhito_(obj, otmp); }
X+ int dozap() { return dozap_(); }
X+ #endif /* OVERLAY */
END_OF_FILE
if test 58568 -ne `wc -c <'patches06d'`; then
echo shar: \"'patches06d'\" unpacked with wrong size!
fi
# end of 'patches06d'
fi
echo shar: End of archive 2 \(of 15\).
cp /dev/null ark2isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 15 archives.
rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0