h24071
s 00309/00000/00000
d D 1.1 83/03/17 14:38:03 tes 1 0
c date and time created 83/03/17 14:38:03 by tes
e
u
4
U
t
T
I 1
GSX_Code	CSeg	Byte	Public

; PLoad		Load a program.  Usually a driver via Gdos Open Workstation.

; 	Call PLoad(FcbPtr,HeaderPtr,LayerPtr)	{Near PL/M invocation}

;	Dword Ptr FcbPtr points to the opened Fcb of the program to load.
;	Dword Ptr HeaderPtr points to a BuffStruct which holds the header
;	 record of the program, which has been read and size- and
;	 validity-checked, but not fixed up with actual addresses.
;	Dword Ptr LayerPtr points to the layer table entry, where
;	 BasePageSegment and ModuleSize can be found and ProcPtr can be set
;	 upon successful load.

; Only Al and flags changed upon return:
;	  Al and flags hold error code upon return:
;	  0	successful load
;	  8	load error -- previous driver trashed

NoErrors	Equ	0
LoadError	Equ	8

; ProcPtr is set upon successful return.

; Program is loaded in one contiguous chunk at BasePageSegment.  It must be
; small enough to not exceed ModuleSize (no check made here).  There must be no
; absolute groups, and no MP/M shared code groups.

; There must be a code group.  If there is a data group, it is allocated first
; and ProcPtr is set to 00000h offset in the code group.  If there is no data
; group, ProcPtr is set to 00100h in the code group.
	Eject

		Public	PLoad

		Extrn	FGetCh		:Near
		Extrn	FClose		:Far

; Layer table entry variables
		Extrn	BasePageSegment	:Word
		Extrn	ProcPtr		:Dword

; Buffer structure offsets

	Include	BStruct.A86

OldDs		Equ	Ss:(Word Ptr 18)[Bp]
OldAx		Equ	Ss:(Word Ptr 16)[Bp]
OldAl		Equ	Ss:(Word Ptr 16)[Bp]
OldBx		Equ	Ss:(Word Ptr 14)[Bp]
OldCx		Equ	Ss:(Word Ptr 12)[Bp]
OldDx		Equ	Ss:(Word Ptr 10)[Bp]
OldSi		Equ	Ss:(Word Ptr 8)[Bp]
OldDi		Equ	Ss:(Word Ptr 6)[Bp]
OldEs		Equ	Ss:(Word Ptr 4)[Bp]
OldFlags	Equ	Ss:(Word Ptr 2)[Bp]
OldBp		Equ	Ss:(Word Ptr 0)[Bp]
ReturnAddress	Equ	Ss:(Word Ptr (OldDs+2))[Bp]
LayerPtr	Equ	Ss:(Dword Ptr (ReturnAddress+2))[Bp]
HeaderPtr	Equ	Ss:(Dword Ptr (LayerPtr+4))[Bp]
FcbPtr		Equ	Ss:(Dword Ptr (HeaderPtr+4))[Bp]
BSBase		Equ	Ss:(Byte Ptr (-BuffStructSize))[Bp]

GForm		Equ	Ds:(Byte Ptr (BSBuffer))[Bx]
GLength		Equ	Ds:(Word Ptr (BSBuffer+1))[Bx]
ABase		Equ	Ds:(Word Ptr (BSBuffer+3))[Bx]
GMin		Equ	Ds:(Word Ptr (BSBuffer+5))[Bx]
GMax		Equ	Ds:(Word Ptr (BSBuffer+7))[Bx]
GDLen		Equ	9
	Eject

PLoad:	Push	Ds			; Save caller's Ds (PL/M sequence)
	Mov	Al,NoErrors		; Assume no errors
	Push	Ax			;  and save other registers
	Push	Bx
	Push	Cx
	Push	Dx
	Push	Si
	Push	Di
	Push	Es
	Pushf				; Save caller's direction flag
	Push	Bp			; Save stack frame
	Mov	Bp,Sp			; Make local stack frame
	Sub	Sp,BuffStructSize	; Make room for local buffer

	Mov	BSBase+BSUpZ,01ah	; ^Z just below buffer for Eof
	Mov	BSBase+BSBufferPtr,BSBufferSize	; Force FGetRec on first FGetCh

	Lds	Bx,LayerPtr		; Point to layer table entry
	Mov	Si,BasePageSegment[Bx]	; Get base address of place to put prog

	Lds	Bx,HeaderPtr		; Point to header record
	Mov	Cx,8			; Look through 8 groups

FindFirstToAllocate:
	Mov	Al,GForm		; Get Group Format code
	And	Al,00fh			; Only right 4 bits matter
	Cmp	Al,2			; Data bucket?
	Jne	FindFirstLoop		; Jump if nope

	Mov	ABase,Si		; Allocate first DSeg first
	Add	Si,GMin			;  with length G-min
	Jmps	AllocateMemory		;  then allocate the rest

FindFirstLoop:
	Add	Bx,GDLen		; Bump to next possible group
	Loop	FindFirstToAllocate	;  & loop until 8 groups scanned
	Eject

AllocateMemory:
	Lds	Bx,HeaderPtr		; Point to beginning of header again
	Mov	Cl,8			; Look through 8 groups

AllocateGroup:
	Cmp	ABase,0			; Already allocated?
	Jne	AllocateLoop		; Jump if yes

	Test	GForm,00fh		; No group present?
	Jz	AllocateLoop		; Jump if group absent

AllocateIt:
	Mov	ABase,Si		; Allocate memory for group
	Add	Si,GMin			;  at current base

AllocateLoop:
	Add	Bx,GDLen		; Bump to next group
	Loop	AllocateGroup		; Loop until 8 groups looked at
	Eject

	Lds	Bx,HeaderPtr		;Point to header yet again
	Mov	Cl,8			; 8 groups to load

LoadGroup:
	Test	GForm,00fh		; Group present?
	Jz	LoadNextGroup		; Jump if nope

	Push	Cx			; Save group count
	Mov	Cx,GLength		; Get number of paragraphs in group
	Jcxz	LoadGroupDone		; Jump if empty

	Mov	Es,ABase		; Point to first place to load

LoadParagraph:
	Sub	Di,Di			; Point Es:Di at byte to load
	Push	Cx			; Save paragraph count
	Mov	Cx,16			; 16 bytes in a paragraph

LoadByte:
	Call	LoadGetCh		; Get a byte
	Cld				; Move up in address
	Jnc	StuffByte		; Jump if no unexpected Eof

	Mov	OldAl,LoadError		; Flag lethal load error
	Jmp	RelocateDone		;  & return

StuffByte:
	Stos	Es:(Byte Ptr 0)[Di]	; Put it here
	Loop	LoadByte		; Loop until paragraph moved

	Mov	Ax,Es			; Bump Es to next paragraph
	Inc	Ax
	Mov	Es,Ax

	Pop	Cx			; Get paragraph count
	Loop	LoadParagraph		; Loop until group loaded

LoadGroupDone:
	Pop	Cx			; Restore group counter

LoadNextGroup:
	Add	Bx,GDLen		; Point to next group in header
	Loop	LoadGroup		;  & loop until all groups loaded
	Eject

	Les	Si,LayerPtr		; Get pointer to layer table entry
	Mov	Es,BasePageSegment[Si]	; Get base page paragraph pointer

	Mov	Di,0			; 48 bytes of base page locate groups
	Mov	Ax,0			;  & start clear
	Mov	Cl,24			; Clear 24 words
    Rep	Stos	Es:(Byte Ptr 0)[Di]	; Clear group locators in base page

	Lds	Bx,HeaderPtr		; Point once again to header
	Mov	Cl,8			; Once again scan 8 groups

FixGroupBase:
	Mov	Al,GForm		; Get G-Form
	And	Ax,0000fh		;  as word
; Note no provision for MP/M shared code
	Add	Ax,Ax			; *2:  Group present?
	Jz	FixGroupNext		; Jump if nope

	Mov	Di,Ax			; Save *2
	Add	Ax,Ax			; *4
	Add	Di,Ax			; Di has G-Form*6

	Mov	Ax,ABase		; Get base paragraph
	Mov	Es:(Word Ptr (-3))[Di],Ax;  into base page

	Mov	Ax,GMin			; Get number of paragraphs
	Mov	Dx,16			; 16 bytes per paragraph
	Mul	Dx			; To number of bytes
	Sub	Ax,1			; Less 1 for address of last
	Sbb	Dx,0
	Mov	Es:(Word Ptr (-6))[Di],Ax; Low two bytes to base page
	Mov	Es:(Byte Ptr (-4))[Di],Dl; High byte to base page

FixGroupNext:
	Add	Bx,GDLen		; Point to next group
	Loop	FixGroupBase		;  & loop until all groups scanned

	Lds	Bx,LayerPtr		; Point to layer table entry

	Mov	Ax,Es:(Word Ptr .3)	; Get code group base
	Mov	(Word Ptr ProcPtr+2)[Bx],Ax	;  into ProcPtr
	Mov	(Word Ptr ProcPtr)[Bx],0	; Assume not 8080 model

	Cmp	Es:(Word Ptr .9),0	; DSeg present?
	Jne	FixupReloc		; Jump if yes -- not 8080 model

	Mov	Al,1			; 8080 model:
	Mov	(Byte Ptr ProcPtr+1)[Bx],Al	; Set ProcPtr offset to 00100h
	Mov	Es:(Byte Ptr .5),Al	; Set M80 byte
	Eject

FixupReloc:	
	Mov	BSBase+BSBufferPtr,BSBufferSize	; Force FGetRec for reloc

; Es still points at base page

RelocateLoop:
	Call	LoadGetCh		; Get Location|Target byte, if any
	Jc	RelocateDone		; Quit if Eof
	Or	Al,Al			; Zero means no more relocate poop
	Jz	RelocateDone		; Quit if done relocating

	Mov	Si,Ax			; Location!Target to Si
	And	Si,0000fh		; Mask to Target
	Mov	Di,Si			; Save *1 for *3
	Add	Si,Si			; *2
	Add	Si,Di			; *3
	Add	Si,Si			; *6 index into base page for Target

	And	Ax,000f0h		; Mask Ax to Location
	Shr	Ax,1			; *8
	Shr	Ax,1			; *4
	Mov	Di,Ax			; *4 to Di
	Shr	Ax,1			; *2
	Add	Di,Ax			; *6 index into base page for Location

	Call	LoadGetCh		; Get low byte of segment offset
	Jc	RelocateDone		; Quit if Eof
	Xchg	Al,Ah			; Save low byte in Ah
	Call	LoadGetCh		; Get high byte of segment offset
	Jc	RelocateDone		; Quit if Eof
	Xchg	Al,Ah			; Low to low, high to high

	Add	Ax,Es:(Word Ptr (-3))[Di]	; Add base of segment to reloc
	Mov	Ds,Ax			; Ds <- segbase of word to reloc

	Call	LoadGetCh		; Get byte offset from segbase
	Jc	RelocateDone		; Quit if Eof

	Xchg	Bx,Ax			; Bl is byte offset
	Mov	Bh,0			; Bx is byte offset

	Mov	Ax,Es:(Word Ptr (-3))[Si]	; Get base of Target bucket

	Add	Ds:(Word Ptr 0)[Bx],Ax	; Relocate Location word by Target seg

	Jmps	RelocateLoop		; Loop until done relocating

RelocateDone:
	Mov	Sp,Bp			; Trash record buffer

	Lds	Si,FcbPtr		; Get pointer to Fcb
	Push	Ds			; Pointer to Fcb is
	Push	Si			;  parameter to FClose
	Push	Cs			; Make a Callf
	Call	FClose			; Close the file
	Jnc	LoadQuit		; Quit if close successful

	Mov	OldAl,LoadError		; Close error found

LoadQuit:
	Pop	Bp			; Restore caller's Bp
	Popf				;  & flags
	Pop	Es			;  & other registers
	Pop	Di
	Pop	Si
	Pop	Dx
	Pop	Cx
	Pop	Bx
	Pop	Ax			;   (with error code in Al)
	Pop	Ds			;  & Ds
	Or	Al,Al			; Set flags
	Ret	12			;  & return

; Get a byte via FGetCh
LoadGetCh:
	Push	Word Ptr (FcbPtr+2)	; Fcb segbase
	Push	Word Ptr (FcbPtr)	;  & offset
	Push	Ss			; Buffer structure segbase
	Lea	Dx,BSBase		;  &
	Push	Dx			;  offset
	Call	FGetCh			; Get a byte
	Ret				;  & return with it

	End
E 1
