OS_Develop/dos_compilers
OS_Develop/dos_compilers
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
b298b45d2b
dos_compilers/Logitech Modula-2 v1.1/RTS.ASM

742 lines
27 KiB
NASM
Raw Normal View History

Logitech Modula-2 v1.10
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
;
; Module: RTS.ASM
; Mainline of Modula-2/86(tm) Run Time System
;
; Version: 8086, RAM-based, MS-DOS 2.0
;
; Release: 1.1 - Dec 84
;
;*****************************************************************************
;
; process descriptors are always allocated at a paragraph address
;
;*****************************************************************************
CGROUP group code
DGROUP group data
SGROUP group stack
assume CS: CGROUP
assume DS: DGROUP
assume ES: NOTHING
assume SS: SGROUP
include RTS.INC
;*****************************************************************************
; EXPORT QUALIFIED
; (* data: variables *)
public START_MEM, MEM_SIZE
public m2_start_mark
public m2_end_mark
public RTS_PROCESS
public cur_proc_addr
public cur_process
public BASE_PAGE_PTR;
public base_page
public SAVED_DISK, RTS_DISK
public device_mask
public term_proc_addr
public old_NMI_vector
; (* code: procedures, labels *)
public DUMMY_ISR
public AFTER_RESIDENT
public RTS_DS
public SYS_RESET
public TERMINATE
public COMP_STACK
public WRITE
public WRITE_MSG
public WRITE_LN
public WRITE_STATUS
public NORM_ADDR
public GET_CURR_DISK
public SELECT_DISK
;
;***********************************************************************
code segment public 'code'
; FROM LOADER IMPORT
extrn LoadProg:NEAR ; resident loader
; FROM SERVICES IMPORT
extrn RTS_BRANCH:NEAR ; interrupt dispatcher
extrn STACK_OVF:NEAR ; stack overflow
extrn DIV_BY_ZERO:NEAR ; divide by zero handler
; FROM TRANSFER IMPORT
extrn REST_I_V:NEAR ; restore interrupt vectors
extrn STOPPED_1B:NEAR ; break handler interrupt 1bH
extrn STOPPED_23:NEAR ; break handler interrupt 23H
extrn GET_INTERRUPT_MASK:NEAR ; reads the current interrupt mask
extrn SET_INTERRUPT_MASK:NEAR ; restores the interrupt mask
extrn NMI_server:near ; interrupts from 8087
; FROM DBUG IMPORT
extrn DEBUGGER : near
code ends
;*****************************************************************************
;*****************************************************************************
data segment public 'data'
; Workspace of the MAIN process, starting with RTS:
org 0
cur_process label ProcessDescriptor
BASE_PAGE db 100H dup (?) ; required for the Main-Module
; BASE_PAGE has to be at offset 0 !!!!!!!
; RTS_PROCESS has to be on paragraph boundary. keep it here, and never
; insert any definitions between BASE_PAGE and RTS_PROCESS
RTS_PROCESS ProcessDescriptor <>
cur_proc_addr dd ? ; pointer to current process
TOP_OF_MEMORY equ word ptr BASE_PAGE+2
; last free paragraph, +1. Set up by DOS loader
TRANS_COM_SIZE equ 440H ; transient part of COMMAND.COM (in parag)
m2_start_mark dw ? ; this two variables show the region of
m2_end_mark dw ? ; possibly loaded m2 programs
START_MEM dw ? ; points behind the loaded modula program
MEM_SIZE dw ? ; number of free paragraphs at START_MEM
DOS dd ? ; jump to DOS
START_ADDR dd ? ; start address of Modula program (.LOD file)
term_proc_addr dd term_procedure ; termination procedure
; - saved interrupt vectors -
old_NMI_vector dd ?
OLD_RTS_VECTOR dd ?
OLD_DIV0_VECTOR dd ?
OLD_INTO_VECTOR dd ?
OLD_BREAK_VECTOR_23 dd ?
OLD_BREAK_VECTOR_1B dd ?
old_interrupt_controller_mask dw ?
device_mask dw ? ; initial value is the old interrupt mask
; of the interrupt controller
; a device may be enabled/disabled, by setting
; the corresponding bit to 0/1
; two functions to do operations on this mask
; are provided:
; get_device_status, set_device_status
set_CW8087 dw 360H ; init 8087 with interrupts
get_CW8087 dw 0
BASE_PAGE_PTR dd BASE_PAGE ; ptr to program segment prefix
MAIN_SP dw ?
MAIN_SS dw ?
START_DISK db ?
RTS_DISK db ?
SAVED_DISK DB ?
; string constants and jump or index tables
SOME_ERROR DB '===> $'
NORMAL_MSG DB 'normal termination$'
WARNED_MSG DB 'warning$'
STOP_MSG DB 'stopped$'
ASSERT_MSG DB 'wrong assertion$'
HALT_MSG DB 'HALT called$'
CASE_MSG DB 'case-tag error$'
STACK_MSG DB 'stack overflow$'
HEAP_MSG DB 'heap overflow$'
FCT_ERR_MSG DB 'function return error$'
ADDR_OVF_MSG DB 'address overflow$'
REAL_OVF_MSG DB 'real overflow$'
real_udf_msg db 'real underflow$'
bad_op_msg db 'bad operand$'
CARD_OVF_MSG DB 'cardinal overflow$'
INTEGER_OVF_MSG DB 'integer overflow$'
RANGE_ERR_MSG DB 'range error$'
ZERO_DIV_MSG DB 'division by zero$'
PROC_END_MSG DB 'coroutine end$'
LOAD_MSG DB 'cannot load$'
CALL_MSG DB 'unsuccessfull program call$'
NO_PROG_MSG DB 'program not found$'
NO_MOD_MSG DB 'module not found$'
INCOMPAT_MSG DB 'incompatible module keys$'
BAD_FILE_MSG DB 'bad structure in file$'
ILL_INSTR_MSG DB 'illegal instruction encountered$'
ILL_FCT_MSG DB 'illegal RTS call$'
NO_MORE_ISR DB 'too many concurrent IO-Processes$'
even
STATUS_MSG DW NORMAL_MSG, WARNED_MSG, STOP_MSG, ASSERT_MSG
DW HALT_MSG, CASE_MSG, STACK_MSG, HEAP_MSG
DW FCT_ERR_MSG, ADDR_OVF_MSG, REAL_OVF_MSG
dw real_udf_msg,bad_op_msg,CARD_OVF_MSG
DW INTEGER_OVF_MSG, RANGE_ERR_MSG, ZERO_DIV_MSG
DW PROC_END_MSG, LOAD_MSG, CALL_MSG
DW NO_PROG_MSG, NO_MOD_MSG, INCOMPAT_MSG, BAD_FILE_MSG
DW ILL_INSTR_MSG, ILL_FCT_MSG, NO_MORE_ISR
data ends
;*****************************************************************************
;*****************************************************************************
stack segment stack 'stack'
; the stack will be used to load and start the modula-2 program
dw 400h dup (?) ; MS-DOS loader will set up stack
stack ends
;*****************************************************************************
;*****************************************************************************
code segment public 'code'
; We return to DOS through a jump to location 0 of the Program Segment Prefix
; There is no explicit release of memory or stack reset.
; After loading of the RTS, memory has the following structure:
; 0000H .. 03FFH : interrupt vectors
; 0400H .. DOS_END : resident portion of DOS
; DOS_END .. DOS_END + 0FFH : Program Segment Prefix (PSP), set up by DOS
; DOS_END + 100H .. xx : Code of RTS
; xx .. yy : Data of RTS ( xx = RTS_DS)
; yy .. zz : Stack of RTS
; zz .. end_of_memory - 17K : free memory ( zz = START_MEM)
; last 17K of RAM : DOS command interpreter (COMMAND.COM)
RTS_DS DW ? ; We need a way to set the DS later on
RTS_START: ; start address of the RTS
push DS ; base of PSP
; read and store data-segment of RTS:
mov ax,DGROUP
mov ES,ax ; point to data segment
mov RTS_DS,ax ; (make it easy to access later, in ISR's)
; copy the PSP into the privat variable BASE_PAGE:
mov di,offset BASE_PAGE
mov si,0
mov cx,size BASE_PAGE
cld
rep movsb ; copy PSP into BASE_PAGE
mov DS,ax ; now switch to RTS data segment
; store return point:
pop word ptr DOS+2 ; set up exit vector, which
mov word ptr DOS,0 ; goes to PSP:0
; Find the current disk:
CALL GET_CURR_DISK
mov START_DISK, al ; save for Postmortem dump
mov RTS_DISK, al
STI ; Allow interruptions
;-------------------------------------------------------
; Initial Memory Allocation
;-------------------------------------------------------
; find the beginning of not used memory (right after the RTS):
mov m2_start_mark,SS ; bottom of last segment ..
mov ax,sp
mov cl,4
shr ax,cl ; plus paragraphs of stack..
add ax,10 ; (plus fudge factor..)
add m2_start_mark,ax ; ..gives first free paragraph
; after the RTS
mov ax, m2_start_mark
mov start_mem, ax ; initialize start_mem
; will be updated by loader
; now find out, how much memory is available for the Modula program:
mov ax,TOP_OF_MEMORY
sub ax,m2_start_mark
IF KEEP_COM
sub ax, TRANS_COM_SIZE
ENDIF
cmp ax, MAX_MEM_FOR_M2 ; more than we need?
jbe N2MUCH ; nope
mov ax, MAX_MEM_FOR_M2 ; yes, just take what is needed
N2MUCH:
mov MEM_SIZE,ax ; compute free paragraphs
; initialize cur_proc_addr with normalized address of RTS_PROCESS
; where the offset is calculated to 0 (if not ERROR !!!!!!!)
mov bx,ds
mov ax,offset rts_process
call norm_addr
mov word ptr cur_proc_addr,ax
mov word ptr cur_proc_addr + 2,bx
; Load the Modula-2 program to run. It will be loaded at START_MEM and
; START_MEM will be updated to point behind that loaded program:
;
mov ax,RTS_PROCESS.PD_PROG_ID ; AX = current prog id
mov dx,word ptr RTS_PROCESS.PD_MOD_TABLE
mov cx,word ptr RTS_PROCESS.PD_MOD_TABLE+2 ; CX:DX = old mod tab
call LoadProg ; load it and return error
; code in BX (0=ok).
mov word ptr RTS_PROCESS.PD_MOD_TABLE,dx
mov word ptr RTS_PROCESS.PD_MOD_TABLE+2,cx ; CX:DX = new mod tab
mov word ptr START_ADDR,di
mov word ptr START_ADDR+2,ES ; ES:DI = start address
test bx,bx ; load ok?
jz LOADED ; yes
jmp SYS_RESET ; no
LOADED:
; At this point START_MEM is the first free paragraph after code and data
; of the Modula program. This space will be used for heap (starting at
; the lowest address) and for stack (starting at the high end of memory).
; Switch to real run-time stack. The stack of the main process is set
; to the end of the free memory:
MOV AX, MEM_SIZE
MOV BX, START_MEM
mov m2_end_mark, bx ; upper limit for a m2 codesegment
add m2_end_mark, ax
CALL COMP_STACK ; BX becomes SS, AX becomes SP
MOV MAIN_SS, BX
MOV MAIN_SP, AX
MOV SS, BX ; No need to disable Interrupts,
MOV SP, AX ; the processor does it here
;-------------------------------------------------------
; Fill in the Default Process Descriptor:
;-------------------------------------------------------
; First we put the Return Address in RTS on the
; Stack. It will be used in case of an error
; in the Main program.
PUSHF
PUSH CS
MOV AX, OFFSET AFTER_RESIDENT
PUSH AX
PUSH BP
; Now put all the significant registers at
; their places in P.D:
PUSHF
POP RTS_PROCESS.PD_FLAGS
MOV RTS_PROCESS.PD_SP, SP
MOV RTS_PROCESS.PD_SS, SS
MOV RTS_PROCESS.PD_DS, DS
; and the initial values for the heap managment:
MOV AX, START_MEM ; Paragraph addr
MOV word ptr RTS_PROCESS.PD_HEAP_BASE + 2,AX ; first para of heap
MOV word ptr RTS_PROCESS.PD_HEAP_TOP + 2,AX ; top para. of heap
; Only the minimum is done here, to be as
; independant from the implementation of the
; heap manager as possible. See also NEW_PROCESS
; Set all the values needed for TRANSFER
; and error handling:
MOV RTS_PROCESS.PD_dbug_status,0 ; for debugger
MOV word ptr RTS_PROCESS.PD_PROG_END, SP
MOV word ptr RTS_PROCESS.PD_PROG_END+2, SS
;-------------------------------------------------------
; Prepare the interrupt system:
;-------------------------------------------------------
CALL GET_INTERRUPT_MASK
MOV rts_process.PD_PRIO_MASK, 0 ; no priority
MOV old_interrupt_controller_mask,AX ; save it
mov device_mask, AX ; initial value
; Compute physical address of RTS vector:
mov bx,RTS_INT*4
MOV AX, 0
MOV ES, AX
; Set entry point for RTS-interrupt-vector:
MOV AX, ES: [BX] ; Save the old value
MOV word ptr OLD_RTS_VECTOR, AX
MOV AX, ES: 2[BX]
MOV word ptr OLD_RTS_VECTOR + 2, AX
MOV ES:word ptr [BX], offset RTS_BRANCH
MOV ES:word ptr 2[BX], CS ; Set the new-one
; Interrupt vector 0, used for 'divide by zero':
mov bx,0*4
mov ax,ES:[bx] ; Save the old value
mov word ptr OLD_DIV0_VECTOR, ax
mov ax,ES:2[bx]
mov word ptr OLD_DIV0_VECTOR + 2,ax
mov ES:word ptr 2[bx], CS ; Set the new-one
mov ES:word ptr[bx], offset DIV_BY_ZERO
; Interrupt vector 4 (used for INTO) has also
; to point to the RTS:
mov bx,4*4
MOV AX, ES:[bx] ; Save the old value
MOV word ptr OLD_INTO_VECTOR, AX
MOV AX, ES:2[bx]
MOV word ptr OLD_INTO_VECTOR + 2, AX
MOV ES:word ptr [bx], offset RTS_BRANCH
MOV ES:word ptr 2[bx], CS ; Set the new-one
; Note, that there is no special entry for the
; interrupt on overflow. The calling program
; has to set the function code in AX as for the
; other RTS calls. Needed, because an overflow
; may occur in several error conditions
; (INTEGER, CARDINAL, SUBRANGE...)
; Interrupt vector 2, used for '8087 interrupts':
esc 1cH,BX ; FNINIT: clear and init 8087
esc 0DH,set_CW8087 ; FLDCW: set ctrl word interrupt enabled
esc 0FH,get_CW8087 ; FNSTCW: read it again
; save old value in any case, it is always restored
mov bx,2*4
mov ax,ES:[bx] ; Save the old value
mov word ptr old_NMI_vector, ax
mov ax,ES:2[bx]
mov word ptr old_NMI_vector + 2,ax
mov ax,set_CW8087 ; simulate WAIT (dont execute it!!)
mov ax,set_CW8087
mov ax,set_CW8087
mov ax,set_CW8087
cmp ax,get_CW8087 ; if equal, the 8087 is assumed present
jne No8087
; install interrupt service routine only if 8087 is present
mov ES:word ptr 2[bx], CS ; Set the new-one
mov ES:word ptr[bx], offset NMI_server
No8087:
; Interrupt vector 1BH (used for BREAK) has also
; to point to the RTS:
mov bx,4*1BH
MOV AX, ES:[bx] ; Save the old value
MOV word ptr OLD_BREAK_VECTOR_1B, AX
MOV AX, ES:2[bx]
MOV word ptr OLD_BREAK_VECTOR_1B + 2, AX
MOV ES:word ptr [bx], offset STOPPED_1b
MOV ES:word ptr 2[bx], CS ; Set the new-one
; Interrupt vector 23H (used for ^C) has also
; to point to the RTS:
mov bx,4*23H
MOV AX, ES:[bx] ; Save the old value
MOV word ptr OLD_BREAK_VECTOR_23, AX
MOV AX, ES:2[bx]
MOV word ptr OLD_BREAK_VECTOR_23 + 2, AX
MOV ES:word ptr [bx], offset stopped_23
MOV ES:word ptr 2[bx], CS ; Set the new-one
;-------------------------------------------------------
; Call the MODULA program:
;-------------------------------------------------------
; For debugger, to detect first
; procedure in calling sequence:
MOV BP, 0
CALL_RESIDENT:
CALL START_ADDR ; call loaded program
; We are back from the MODULA program.
AFTER_RESIDENT:
; if program terminated normally, we came here not through
; an interrupt, but by a RET instruction (therefore interrupts
; are enabled:
CLI
MOV DS, RTS_DS ; restore data segment
; Restore the old interrupt vectors for every IO-Process,
; waiting on an interrupt:
mov ax,word ptr cur_proc_addr + 2
mov es,ax
mov ES:CUR_PROCESS.PD_PROG_ID, 0
; 0 as program id is a sort of a joker.
; Restore the old Interrupt Mask:
mov ES:CUR_PROCESS.PD_PRIO_MASK, 0 ; no priority
MOV AX, old_interrupt_controller_mask
CALL SET_INTERRUPT_MASK
CALL REST_I_V
; set break vector to a dummy interrupt service routine,
; because the following write functions will enable
; interrupts; we don't want to be interrupted by a ^break
mov ax, 0
mov es, ax
mov bx,4*1BH
MOV ES:word ptr [bx], offset DUMMY_ISR
MOV ES:word ptr 2[bx], CS ; Set the new-one
mov ax,word ptr cur_proc_addr + 2
mov es,ax
MOV AX,ES: CUR_PROCESS.PD_STATUS
test ax,ax
jz RTS_END ; 0 = No error
CALL WRITE_LN
MOV DX,OFFSET SOME_ERROR
CALL WRITE_MSG
MOV BX,ES:CUR_PROCESS.PD_STATUS
CALL WRITE_STATUS
CALL WRITE_LN
; It is safer to return to DOS and possibly reload the
; RTS rather then restarting its execution, since the
; code might have been overwritten.
;-------------------------------------------------------
; Back from the MODULA program:
;-------------------------------------------------------
RTS_END:
CallTermProc:
;============
; this 'procedure' is the equivalent to 'CallTermProc' in module
; 'System'. It has to be repeated here, because the termination
; of the base layer does not pass through module 'Program', and
; therefore 'System.CallTermProc' is not called
mov ds,rts_ds ; set data segment
mov ax,word ptr term_proc_addr + 2 ; segement addr
mov bx,cs
cmp ax,bx
je CallTermProc_end ; OwnTermProc
call term_proc_addr ; invoke termination procedure
jmp CallTermProc
CallTermProc_end:
; Restore the modified interrupt vectors
; mov ds,rts_ds
MOV AX, 0
MOV ES, AX
MOV BX, RTS_INT*4
MOV AX,word ptr OLD_RTS_VECTOR ; The RTS entry
MOV ES:word ptr [BX],AX
MOV AX,word ptr OLD_RTS_VECTOR + 2
MOV ES:word ptr [BX]+2,AX
MOV AX,word ptr OLD_DIV0_VECTOR ; The entry for DIV0
MOV ES:word ptr 0, AX
MOV AX,word ptr OLD_DIV0_VECTOR + 2
MOV ES:word ptr 2, AX
MOV AX,word ptr OLD_INTO_VECTOR ; The entry for INTO
MOV ES:word ptr 16, AX
MOV AX,word ptr OLD_INTO_VECTOR + 2
MOV ES:word ptr 18, AX
MOV AX,word ptr old_NMI_vector ; The entry for NMI
MOV ES:word ptr 4*2, AX
MOV AX,word ptr old_NMI_vector + 2
MOV ES:word ptr 4*2 + 2, AX
MOV AX,word ptr OLD_BREAK_VECTOR_1B ; The entry for BREAK 1BH
MOV ES:word ptr 4*1bH, AX
MOV AX,word ptr OLD_BREAK_VECTOR_1B + 2
MOV ES:word ptr 4*1bH + 2, AX
MOV AX,word ptr OLD_BREAK_VECTOR_23 ; The entry for BREAK 23H
MOV ES:word ptr 4*23H, AX
MOV AX,word ptr OLD_BREAK_VECTOR_23 + 2
MOV ES:word ptr 4*23H + 2, AX
; select the same drive that was selected at beginning:
MOV DL, START_DISK
CALL SELECT_DISK
SYS_RESET:
jmp DOS ; Back to DOS
;-------------------------------------------------------
; Termination procedure, called after end of main
; program. If System announced one, then this is
; called, else an empty procedure is called
;-------------------------------------------------------
Term_Procedure proc far ; MUST be FAR !!!!!
ret
Term_Procedure endp
; We arrive here, when a program is terminated (exept level 0) or
; if any error had occured. In the former case, status is 'normal',
; in the latter case the error-code is set in the Status-field of
; Current Process Descriptor.
TERMINATE:
;=========
MOV DS, RTS_DS
; Free the resources, managed by RTS:
CALL REST_I_V ; only Interrupt Vectors
; Call the debugger in any case. It will take an
; action according to status and presence or absence
; of a run-time debugger:
CALL DEBUGGER
TERMINATION:
MOV DS, CS:RTS_DS
mov ax,word ptr cur_proc_addr + 2
mov ds,ax
; Prepare return:
MOV SS,word ptr CUR_PROCESS.PD_PROG_END+2
MOV SP,word ptr CUR_PROCESS.PD_PROG_END
POP BP ; BP of Father Program
DUMMY_ISR: ; we use the following IRET also for
; a dummy interrupt service routine
IRET ; from here we go either to Get_Old_Program
; or to After_Resident
;------------------------------------------------------
; Some Utilities:
;------------------------------------------------------
; public COMP_STACK
COMP_STACK:
; Upon Entry:
; AX holds size of free memory (in paragraphs)
; BX holds (paragraph) start address of free memory
; Upon Exit:
; AX holds SP and BX holds SS
; Policy:
; Set STACK to the end of memory. Check if
; there is room for a minimal stack.
CMP AX, 1000H
JBE SMALL_MEM
; There is more than 64K of free memory:
SUB AX, 1000H
ADD BX, AX
; Set SS to end of memory - 64K
MOV AX, 0
; and SP to 0
RET
SMALL_MEM:
; Less than 64K of free memory
; SS is start of free memory
MOV CL, 4
SHL AX, CL
; SP is length * 16
CMP AX, SP_INI_SIZE + SP_RESERVE + 4
; 4 is for the call of the Modula program
JAE LARGE_ENOUGH
JMP STACK_OVF
; Not enough for initial stack and
; for some reserve!
LARGE_ENOUGH:
RET
; public WRITE
WRITE:
; The character to be printed is in DL
MOV AH, 2 ; Console Output
INT OS
RET
; public WRITE_MSG
WRITE_MSG:
; The address of the message is in CS:DX
MOV AH, 9 ; Print String
INT OS
RET
; public WRITE_LN
WRITE_LN:
MOV DL, 0DH ; Print CR
CALL WRITE
MOV DL, 0AH ; Print LF
CALL WRITE
RET
; public WRITE_STATUS
WRITE_STATUS:
; prints on the screen the meaning of a
; program status (passed in BL):
push bx
MOV DL, ' '
CALL WRITE
pop bx
xor bh,bh
ADD BX, BX
MOV DX, STATUS_MSG [BX]
CALL WRITE_MSG
RET
; public NORM_ADDR
NORM_ADDR:
; To normalize a address with segment and offset,
; i.e the segment value is as large as possible
; and the offset is smaller than 16.
; Upon entry:
; BX holds the old segment and AX the old offset.
; Upon exit:
; BX holds the normalized segment and AX the offset.
; If an overflow occurs, the 'CF' flag is set.
MOV DX, AX
AND AX, 0FH
MOV CL, 4
SHR DX, CL
ADD BX, DX
RET
; public GET_CURR_DISK
GET_CURR_DISK:
; gets the currently logged in disk and stores
; the value in the variable 'SAVED_DISK'
mov ah, 25
int OS
mov SAVED_DISK, al
ret
; public SELECT_DISK
SELECT_DISK:
; the drive to be selected is passed in DL
mov ah, 14
int OS
ret
code ends
;*****************************************************************************
end RTS_START ; defines startaddress of the RTS

Reference in New Issue Copy Permalink