dos_compilers/Logitech Modula-2 v1.1/RTS.ASM
2024-06-30 15:43:04 -07:00

742 lines
27 KiB
NASM
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;*****************************************************************************
;
; 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