dos_compilers/Logitech Modula-2 v1.1/LOADER.ASM

805 lines
20 KiB
NASM
Raw Normal View History

2024-07-01 00:43:04 +02:00
;*****************************************************************
;
; Copyrigth (C) 1984 Logitech. All Rights Reserved.
;
; Permission is hereby granted to registered users to use or
; abstract the following program in the implementation of
; customized versions. This permission does not include the
; right to redistribute the source code of this program.
;
; LOGITECH SA. CH-1143 Apples, Switzerland
;
; Modula-2/86 Run Time Support package
;
; Module: LOADER.ASM
; Loads Modula-2/86 '.LOD' files in memory
; Version: 8086, RAM-based, MS-DOS 2.0 compatible
; Release: 1.1 - Dec 84
;
;*****************************************************************
CGROUP group code
DGROUP group data
assume CS: CGROUP
assume DS: DGROUP
assume ES: NOTHING
assume SS: NOTHING
include RTS.INC
;*****************************************************************************
; EXPORT QUALIFIED
public LoadProg
;*****************************************************************************
data segment public 'data'
; FROM RTS IMPORT
extrn base_page:byte
extrn START_MEM: word
extrn MEM_SIZE: word
data ends
;*****************************************************************************
;*****************************************************************************
code segment public 'code'
; FROM RTS IMPORT
extrn WRITE_MSG: near
code ends
;*****************************************************************************
;*****************************************************************************
data segment public 'data'
LD_FILE_HANDLE DW ? ; Load file handle
LD_FILE_SPEC DB 64 DUP(?) ; Holds complete filename
DEFAULT_NAME db 'MODULA ' ; default file to load
; must be 8 characters long
DEFAULT_TYPE db 'LOD' ; default filetype for loading
; must be 3 characters long
DEFAULT_PATH db '\M2LOD\' ; default directory for load-files
DEF_PATH_LENGTH equ 7H
FILE_MSG1 db ' '
FILE_MSG2 db ' not found in current directory or in \M2LOD$'
NO_FILE db 'File not found: $'
NO_MEMORY db 'Insufficient Memory: $'
;; - load error table and messages -
badstr db '** Bad Structure - $'
badver db '** Bad Version or Target system - $'
badeof db '** Unexpected EOF - $'
badmem db '** Insufficient Memory - $'
badchk db '** Bad Checksum - $'
baderr db '** LOAD error table fu - $'
even
LdErr dw badstr,badver,badeof,badmem,badchk,baderr
data ends
;*****************************************************************************
;*****************************************************************************
code segment public 'code'
;-----------------------------------------------------------------
LoadProg proc near
; Finds the filename of the program to run and loads it in memory
; It also builds the module-table.
; in: AX prog id to use
; CX:DX most recent entry in module-table
;
; out: BX status (0=ok)
; ES:DI start address of Modula-2 program
; CX:DX last module entry added to modula-table
;
PUSH CX
PUSH DX
PUSH AX
CALL FIND_FILE
POP AX
POP DX
POP CX
CMP BX, 0FFFFH ; FIle found ?
JNE LOAD_IT ; yes
RET ; no
LOAD_IT:
CALL LOAD_FILE
push bx
call CLOSE_LOAD_FILE
pop bx
test bx,bx ; load ok?
jz LOADED ; yes
dec bx
shl bx,1
mov dx,LdErr[bx]
CALL WRITE_MSG
CALL WRITE_FILE_NAME
MOV BX, 0FFFFH ; error return
LOADED:
RET
LoadProg endp
;---------------------------------------------------------------
WRITE_FILE_NAME:
mov di,offset LD_FILE_SPEC
WFN1:
cmp byte ptr[di],0
je WFN3
inc di
jmp WFN1
WFN3:
mov byte ptr[di],'$'
mov dx,offset LD_FILE_SPEC
call WRITE_MSG
ret
;---------------------------------------------------------------
FIND_FILE proc near
; Finds the filename according to a search strategy and opens
; the file. The file handle is stored in LD_FILE_HANDLE.
; Upon return BX indicates if file successfully opened (0FFFFH = not ok)
; First we look for the filename, which the operator
; has entered:
CALL GET_SPECIFIED_NAME
CALL OPEN_LOAD_FILE
JNB FOUND
; Not found. Let's look in the Load-File default directory.
; This second search is not done, if pathname was specified:
MOV SI, OFFSET LD_FILE_SPEC
SEARCH_SLASH:
CMP BYTE PTR [SI],"\"
JE NOT_FOUND ; path speficied, so don't retry
CMP BYTE PTR [SI],0
JE SECOND_LOOKUP
INC SI
JMP SEARCH_SLASH
NOT_FOUND:
MOV DX, OFFSET NO_FILE
CALL WRITE_MSG
CALL WRITE_FILE_NAME
MOV BX, 0FFFFH ; some invalid handle
RET
SECOND_LOOKUP:
; There was no directory specified
CALL GET_SECOND_NAME
CALL OPEN_LOAD_FILE
JNB FOUND
; not in default directory neither:
MOV DX, OFFSET FILE_MSG1
CALL WRITE_MSG
MOV BX, 0FFFFH ; some invalid handle
RET
FOUND:
MOV BX, 0
RET
FIND_FILE endp
;-----------------------------------------------------------
GET_SPECIFIED_NAME:
; Builds the program name out of what the operator typed plus
; the default parts for name and extension. Default drive and
; directory are the current-one. The so constructed filename
; is stored in variable LD_FILE_SPEC
; No parameters for this procedure.
mov di,offset LD_FILE_SPEC
mov si,DEFAULT_DMA + offset base_page
cld
mov cx,0
; check if operator gave a program name:
mov cl,byte ptr[si]
inc si
jcxz USE_DEF_NAME ; no command tail, use default name
; there is a command tail, skip leading blancs:
SKIP_BLANK:
lodsb ; look for first non-blank
cmp al,' '
jne PUT_FN_CHAR ; that must be file name
loop SKIP_BLANK
jmp USE_DEF_NAME ; only blanks, use default name
GET_FN_CHAR: ; read char from name in command tail
lodsb
cmp al,' '
jbe END_PROG_NAME ; until 'wrong' char
cmp al,'*'
jbe put_fn_char
cmp al,','
jbe END_PROG_NAME ; until 'wrong' char
cmp al,'.'
je END_PROG_NAME ; until 'wrong' char
cmp al,'/'
je END_PROG_NAME ; until 'wrong' char
cmp al,':'
jbe put_fn_char
cmp al,'>'
jbe END_PROG_NAME ; until 'wrong' char
cmp al,'Z'
jbe put_fn_char
cmp al,'['
je END_PROG_NAME ; until 'wrong' char
cmp al,']'
je END_PROG_NAME ; until 'wrong' char
cmp al,'^'
je END_PROG_NAME ; until 'wrong' char
cmp al,'~'
ja END_PROG_NAME ; until 'wrong' char
PUT_FN_CHAR:
stosb
loop GET_FN_CHAR ; or end of command line
inc si ; pretend we saw a blank..
END_PROG_NAME:
dec si ; SI is adjusted to pos of terminating blanc
cmp byte ptr[si-1],":" ; was only the device there?
je USE_DEF_NAME ; yes, so set the default name.
SEARCH_DOT:
dec si
cmp byte ptr[si],"."
je EXT_END ; extension already here.
cmp si,DEFAULT_DMA ; at start of command tail?
ja SEARCH_DOT ; no: keep looking for '.'
jmp USE_DEF_EXT ; yes: no extension, supply one.
USE_DEF_NAME:
mov si,offset DEFAULT_NAME
mov cx,8
COPY_FN_CHAR:
movsb
dec cx
jz USE_DEF_EXT
cmp byte ptr[si]," "
jne COPY_FN_CHAR
USE_DEF_EXT: ; end of all the 'write filename' loops
mov byte ptr[di],"."
inc di
mov si,offset DEFAULT_TYPE
mov cx,3
COPY_EXT_CHAR:
cmp byte ptr[si]," "
je EXT_END
movsb
dec cx
jnz COPY_EXT_CHAR
EXT_END: ; name is complete
mov byte ptr[di],0
RET
;------------------------------------------------------------
GET_SECOND_NAME:
mov cx,15
mov di,offset FILE_MSG1
mov si,offset LD_FILE_SPEC
cld
rep movsb
mov cx,64-DEF_PATH_LENGTH
mov di,offset LD_FILE_SPEC+63
mov si,offset LD_FILE_SPEC+63-DEF_PATH_LENGTH
std ; move filename towards the end,
rep movsb ; so path can be inserted.
mov di,offset LD_FILE_SPEC+2
cmp byte ptr[di]-1,":"
je INS_PATH
mov di,offset LD_FILE_SPEC
INS_PATH:
mov si,offset DEFAULT_PATH
cld
mov cx,DEF_PATH_LENGTH
rep movsb ; insert path
ret
;------------------------------------------------------------
OPEN_LOAD_FILE:
MOV AX, 3D00H ; open file for READ only
MOV DX, offset LD_FILE_SPEC
INT OS
MOV LD_FILE_HANDLE, AX
RET
;------------------------------------------------------------
READ_LD_FILE:
mov bx,LD_FILE_HANDLE
mov cx,LdBufSize
mov dx,offset LdBuf
mov ah,3FH
int OS ; sequential read
RET
;------------------------------------------------------------
CLOSE_LOAD_FILE:
MOV AH, 3EH
MOV BX, LD_FILE_HANDLE
INT OS
RET
;------------------------------------------------------------
; Alloc_Mem - called by LoadProg to allocate memory for the 'IPL'
;
; in: AX memory request size, in paragraphs
; out: AX first paragraph of allocated chunk
; BX =0 if ok, <>0 if memory not available
;
Alloc_Mem:
mov bx,1
cmp ax, MEM_SIZE ; can request be satisfied?
ja AllFU ; no
sub MEM_SIZE,ax ; yes
add ax, START_MEM ; compute next free paragraph..
xchg ax, START_MEM ; update start_mem, return old value
xor bx,bx
AllFU: ret
;*****************************************************************************
data segment public 'data'
currentVersion equ 1
targetSystem equ 0
NameLength equ 24 ; bytes of module name
KeyLength equ 6 ; bytes of module key
MDescr struc
MDname db NameLength dup (?) ; module name
MDkey db KeyLength dup (?) ; key
MDproc dw ? ; offset of procedure table
MDcode dw ? ; base of code
MDdata dw ? ; base of data
MDprogid dw ? ; 'owner' program id
MDnext dd ? ; forward link
MDprev dd ? ; backward link
MDescr ends
MDSize equ size MDescr
badStructure equ 1
badVersion equ 2
readEOF equ 3
TooBig equ 4 ; not enough memory
badCheck equ 5
; Object Record Tags:
FormatVersion equ 0
ProgramHeader equ 1
SCModHeader equ 2
ImportElement equ 3
FilledData equ 4
ProcedureCode equ 5
SCModInitCode equ 6
ModuleCode equ 7
SCModuleCall equ 8
RefExtData equ 9
RefExtCode equ 10
RefExtProc equ 11
RefOwnData equ 12
RefOwnCode equ 13
RefOwnProc equ 14
SCModuleEnd equ 15
ProgramEnd equ 16
LoadSP dw ? ; sp inside LoadProg
LdBufSize equ 512
LdBuf db LdBufSize dup (?) ; read buffer
LdCnt dw ? ; bytes left in buffer
LowSum db ? ; low byte of checksum
HiSum db ? ; high byte of checksum
Checksum equ word ptr LowSum
CodeSize dw ? ; code size in paragraphs
DataSize dw ? ; data size in paragraphs
LdProgId dw ? ; id of loading program?
SCMcnt dw ? ; number of SCM's to load
ProgCodeBase dw ? ; base of program code segment
ProgDataBase dw ? ; base of program data segment
ModCodeBase dw ? ; base of module code segment
ModDataBase dw ? ; base of module data segment
StartOff dw ? ; start address of program, ..
StartBase dw ? ; .. offset and segment.
StartPtr equ dword ptr StartOff
MDoff dw ?
MDbase dw ?
MDptr equ dword ptr MDoff
PrevOff dw ?
PrevBase dw ? ; previous module descrip. (init NIL)
PrevPtr equ dword ptr PrevOff
ModCodeSize dw ?
ModDataSize dw ?
LdMCB dw 3 dup (?) ; Memory Control Block
even
data ends
;*****************************************************************************
; LOAD_FILE - load from file
; in: AX prog id to use
; CX:DX most recent entry in module 'tree'
;
; out: BX status
; ES:DI start address
; CX:DX last module entry added
;
LOAD_FILE proc near
mov LdProgId,ax ; save prog id for module descriptors
mov LoadSP,sp ; save stack pointer
mov PrevBase,cx ; current 'top' of module table
mov PrevOff,dx
call ReadSeq ; initialize for subsequent reading
mov Checksum,0 ; reset checksum
call ReadFormatVersion
call ReadProgHdr
call AllocateProgMem ; allocate code, data, module table
call LoadSCM ; load first module
les bx,MDptr ; point to its descriptor
mov bx,ES:MDproc[bx] ; get offset to procedure table
mov ES,StartBase
mov ax,ES:word ptr 2[bx] ; get offset to procedure 0
mov StartOff,ax ; which is offset of start address
dec SCMcnt ; more modules to load?
jz SCMend ; guess not.
SCMloop:
add MDoff,MDSize ; allocate a new module descriptor
call LoadSCM ; load one SCM
dec SCMcnt ; more?
jnz SCMloop ; yes, load them too (why not)
SCMend: call ReadProgEnd ; process ProgramEnd
les di,StartPtr
mov cx,MDbase
mov dx,MDoff ; pointer to last module entry
xor bx,bx ; if no error, return BX=0
LoadFU: mov sp,LoadSP ; reset stack pointer
ret
LOAD_FILE endp
ReadFormatVersion proc near
call GetByte ; record tag
cmp al,FormatVersion
je RFV2
mov bx,badStructure
jmp LoadFU
;
RFV2: call GetByte ; object file format
cmp al,currentVersion
je RFV4 ; right version
mov bx,badVersion
jmp LoadFU
;
RFV4: call GetByte ; read target system
cmp al,targetSystem
je RFV6
mov bx,badVersion
jmp LoadFU
;
RFV6: jmp CheckChecksum
ReadFormatVersion endp
ReadProgHdr proc near
call GetByte
cmp al,ProgramHeader
je RPH2
mov bx,badStructure
jmp LoadFU
;
RPH2: call GetWord
mov CodeSize,ax
call GetWord
mov DataSize,ax
call GetWord
mov SCMcnt,ax
jmp CheckChecksum
ReadProgHdr endp
AllocateProgMem proc near
mov ax,MDSize ; size of a module descriptor
mul SCMcnt ; times number of modules..
add ax,15
mov cl,4
shr ax,cl ; convert to paragraphs
add ax,CodeSize ; add paragraphs of code..
add ax,DataSize ; and paragraphs of data
call Alloc_Mem ; allocate memory, base => AX
test bx,bx ; got it?
jz GotMem ; yes
mov bx,TooBig ; nope.
jmp LoadFU
;
GotMem: mov ProgCodeBase,ax ; start of code segment
mov ModCodeBase,ax ; start of first module
mov StartBase,ax ; save base of start address
add ax,CodeSize
mov ProgDataBase,ax ; start of data segment
mov ModDataBase,ax ; data of first module
add ax,DataSize
mov MDbase,ax ; base of module descriptor table
mov MDoff,0 ; initial offset
ret
AllocateProgMem endp
; LoadSCM - load one module
;
LoadSCM proc near
call ReadSCMHdr
call GetByte ; next field tag..
cmp al,ModuleCode ; ModuleCode record?
je LdSCM2 ; yes
mov bx,badStructure
jmp LoadFU
;
LdSCM2: call RestModCode ; yes, process rest of record
call ReadFixups ; process rest of module (fixups & end)
ret
LoadSCM endp
; ReadSCMhdr - process an SCModHeader record
; out: ModName module name
; ModKey module key
ReadSCMhdr proc near
call GetByte
cmp al,SCModHeader
je RSCMH2
mov bx,badStructure
jmp LoadFU
;
RSCMH2: les di,MDptr
mov ax,ModCodeBase
mov ES:MDcode[di],ax ; code-base for this module
mov ax,ModDataBase
mov ES:MDdata[di],ax ; data base for this module
mov ax,LdProgId
mov ES:MDprogid[di],ax ; owner-program id for this module
;;;;;;;;add di,offset MDname ; DOESN'T WORK!!!
MOV AX, OFFSET MDname
ADD DI, AX
mov ax,NameLength
call GetNBytes ; read module name
les di,MDptr
;;;;;;;;add di,offset MDkey ; DOESN'T WORK
MOV AX, OFFSET MDkey
ADD DI, AX
mov ax,KeyLength
call GetNBytes ; read module key
call GetWord
les di,MDptr
mov ES:MDproc[di],ax ; offset of procedure table
call GetWord
mov ModCodeSize,ax ; bytes of code
call GetWord
mov ModDataSize,ax ; bytes of data
call GetWord ; (internal use by compiler)
jmp CheckChecksum
ReadSCMhdr endp
; RestModCode - read the rest of a ModuleCode record
; (called after the tag has been read)
RestModCode proc near
call GetWord ; length of code (bytes)
mov ES,ModCodeBase ; base
mov di,0 ; offset
call GetNBytes ; read AX bytes at ES:0000
jmp CheckChecksum
RestModCode endp
; ReadFixups - process fixup records until SCModuleEnd record is processed
;
ReadFixups proc near
call GetByte
cmp al,RefOwnCode
jne RFIX2
call GetWord ; offset of fixup (current module)
push ax
call GetWord ; 'bias' (paragraphs from codebase)
add ax,ProgCodeBase ; compute fixup value
pop bx ; fixup offset..
mov ES,ModCodeBase ; fixup base: current module
mov ES:[bx],ax
call CheckChecksum
jmp short ReadFixups
;
RFIX2: cmp al,SCModuleEnd
je RFIX4
mov bx,badStructure
jmp LoadFU
; end of module:
RFIX4: mov ax,ModCodeSize ; adjust base-of-module-code
add ax,15 ; paragraph pointer by size
mov cl,4 ; of module code, rounded up
shr ax,cl ; and converted to paragraphs.
add ModCodeBase,ax
mov ax,ModDataSize
add ax,15
mov cl,4
shr ax,cl
add ModDataBase,ax
call LinkModuleDescriptor
jmp CheckChecksum
ReadFixups endp
LinkModuleDescriptor proc near
les di,PrevPtr
cmp di,NIL_OFF
jne LMD2
mov ax,ES
cmp ax,NIL_SEG
je LMD4 ; IF PrevPtr <> NIL THEN..
LMD2: mov ax,MDoff
mov ES:word ptr MDnext[di],ax
mov ax,MDbase
mov ES:word ptr MDnext+2[di],ax ; PrevPtr^.next := MDptr
LMD4: les di,MDptr ; END
mov ES:word ptr MDnext[di],NIL_OFF
mov ES:word ptr MDnext+2[di],NIL_SEG ; MDptr^.next := NIL
mov ax,PrevOff
mov ES:word ptr MDprev[di],ax
mov ax,PrevBase
mov ES:word ptr MDprev+2[di],ax ; MDptr^.prev := PrevPtr
mov PrevOff,di
mov PrevBase,ES ; PrevPtr := MDptr
ret
LinkModuleDescriptor endp
ReadProgEnd proc near
call GetByte
cmp al,ProgramEnd
je RPE2
mov bx,badStructure
jmp LoadFU
;
RPE2: jmp CheckChecksum
ReadProgEnd endp
; GetWord - get next word from object record (update checksum)
; out: AX data word
; BX status/error code
; <CC> set for BX
GetWord proc near
call GetByte ; read lo byte
mov ah,al
call GetByte ; read hi byte
xchg ah,al ; shuffle into position
ret
GetWord endp
; GetNBytes - get multiple bytes into memory (with Checksum)
; in: AX byte count (must be > 0!)
; ES:DI where to put the bytes
; out: CX =0
; ES:DI points past last byte read
GetNBytes proc near
mov cx,ax
mov dx,Checksum ; move checksum into reg for speed
NBcont: mov bx,LdCnt ; ditto for bytes-left-in-buffer
cld ; make sure direction flag is forward
xor ah,ah ; extend each byte to cardinal
NBytes: lodsb ; fetch next byte from buffer
sub bx,1
jc NBfill ; refill buffer
add dx,ax ; update checksum
stosb ; place byte into memory
loop NBytes ; and repeat N times
mov LdCnt,bx ; bring memory variables up to date
mov Checksum,dx
ret
;
NBfill: call ReadSeq ; read next buffer sequentially
jmp short NBcont
GetNBytes endp
; GetByte - get next byte from object record (updates checksum)
; out: AL data byte
; BX status/error code
; note: CX, DX, DI, ES preserved
GetByte proc near
call ReadByte ; read one raw
add LowSum,al ; update checksum
adc HiSum,0
ret
GetByte endp
CheckChecksum proc near
call ReadWord ; read record checksum field
cmp ax,Checksum ; checksum checks?
jne Struct ; no
ret
;
Struct: mov bx,badCheck ; no
jmp LoadFU ; short-circuit exit
CheckChecksum endp
ReadWord proc near
call ReadByte ; read low byte
mov ah,al ; save it
call ReadByte ; read high byte
xchg ah,al ; swap into position
ret
ReadWord endp
; ReadByte - get next raw byte from input file
; out: AL next byte
; BX status/error code
; note: AH, CX, DX, DI, ES preserved
;
ReadByte proc near
cld
lodsb ; yes: pull next byte from buffer
sub LdCnt,1 ; anything left in buffer?
jc ReadB2 ; no, refill buffer
ret
;
ReadB2: call ReadSeq
jmp short ReadByte ; try again
ReadByte endp
; ReadSeq - read next sequential block into buffer
;
; out: BX status/error code
; SI points to start of buffer
; LdCnt number of bytes read
; note: AX, CX, DX, DI, ES are preserved
ReadSeq proc near
push ax ; just to be polite
push cx
push dx
push di
push ES
push DS
call READ_LD_FILE
pop DS
cmp ax,LdBufSize ; full record?
je RstBuf ; yes
cmp ax,0 ; partial record?
jne RstBuf ; yes
mov bx,readEOF ; no, EOF, which should never happen!
jmp LoadFU
;
RstBuf: mov si,offset LdBuf ; reset buffer scanner
mov LdCnt,LdBufSize ; and buffer count
pop ES
pop di
pop dx
pop cx
pop ax
ret
ReadSeq endp
code ends
;*****************************************************************************
end