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

1322 lines
34 KiB
NASM
Raw Permalink 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
;
; Modula-2/86 Run Time Support package
;
; Module: SERVICES.ASM
; Provides most of the functions to execute
; Modula-2/86 programs.
;
; Version: 8086, RAM-based, MS-DOS 1.1 and MS-DOS 2.0
; 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 RTS_BRANCH
public SAVE_CPU_INFO
public STACK_OVF
public DIV_BY_ZERO
public NMI_server
;
;*****************************************************************
;*****************************************************************
code segment public 'code'
; FROM RTS IMPORT
extrn RTS_DS:word ; yes, this goes in CODE segment!
extrn SYS_RESET:near
extrn TERMINATE:near
extrn COMP_STACK:near
extrn NORM_ADDR:near
extrn WRITE_STATUS:near
; FROM TRANSFER IMPORT
extrn SET_INTERRUPT_MASK:near
extrn TRANSFER:near
extrn IOTRANSFER:near
extrn NEWPROCESS:near
extrn MON_ENTRY:near
extrn MON_EXIT:near
extrn LISTEN:near
extrn FREE_INT_VECT:near
extrn get_device_status:near
extrn set_device_status:near
; FROM DBUG IMPORT
extrn RTD_AFTER_LOAD : near
extrn INSTALL_DEBUG:near
code ends
;*****************************************************************************
;*****************************************************************************
data segment public 'data'
; FROM RTS IMPORT
extrn cur_process:byte ; :ProcessDescriptor
extrn CUR_PROC_addr:dword ; (ptr to current ProcessDesc)
extrn BASE_PAGE_PTR:dword ; pointer to prog seg prefix
extrn term_proc_addr:dword ; pointer to termination proc
extrn old_NMI_vector:dword ; ISR to be ex. if no 8087
data ends
;*****************************************************************************
;*****************************************************************************
data segment public 'data'
even
TempWord dw ? ; temporary word storage..
TEMP_W dw ? ; another temporary word..
OldIP dw ? ; interrupt frame, saved and
OldCS dw ? ; restored by DYN_PAR_COPY
OldFlags dw ? ;
data ends
;*****************************************************************************
;*****************************************************************************
code segment public 'code'
; Run Time Support system JUMP TABLE
;
; The entries in this table cannot be changed without
; corresponding changes to the Modula-2/86 Compiler!
; It is suggested that extensions to the RTS be implemented
; with a different interrupt than the standard RTS interrupt.
;
RTS_JMP_TBL dw SYS_RESET ; 00h slow
dw M2_HALT ; 01h slow
dw TRANSFER ; 02h slow, but saves itself
dw IOTRANSFER ; 03h slow, but saves itself
dw NEWPROCESS ; 04h slow
dw MON_ENTRY ; 05h slow
dw MON_EXIT ; 06h slow
dw LISTEN ; 07h slow
dw GET_RETURN_POINT ; 08h slow
dw SET_RETURN_POINT ; 09h slow
dw RUN_PROGRAM ; 0Ah slow
dw slow_TERMINATE ; 0Bh slow
dw COM_CASE ; 0Ch
dw COM_CASE ; 0Dh
dw COM_CASE ; 0Eh
dw COM_CASE ; 0Fh
dw COM_CASE ; 10h
dw CASE_ERROR ; 11h slow
dw PAR_COPY ; 12h
dw DYN_PAR_COPY ; 13h slow
dw STACK_CHECK ; 14h
dw FREE_INT_VECT ; 15h slow
dw WRITE_STAT ; 16h slow
dw GET_PD_ADDR ; 17h slow
dw ALLOC_HEAP ; 18h
dw FCT_RET_ERR ; 19h slow
dw NORM_ADDRESS ; 1Ah
dw ADD_ADDR ; 1Bh
dw ADD_A_C ; 1Ch
dw SUB_ADDR ; 1Dh
dw SUB_A_C ; 1Eh
dw EQ_ADDR ; 1Fh
dw GT_EQ_ADDR ; 20h
dw GT_EQ_ADDR ; 21h
dw CONV_A_C ; 22h
dw CARD_OVF ; 23h slow
dw INTEGER_OVF ; 24h slow
dw RANGE_ERROR ; 25h slow
dw PSP_POINTER ; 26H slow
dw INSTALL_DEBUG ; 27H
dw addr_ovf ; 28H slow
dw install_termP ; 29H slow
dw real_ovf ; 2AH slow
dw real_udf ; 2BH slow
dw get_device_status ; 2CH slow
dw set_device_status ; 2DH slow
; public RTS_BRANCH
RTS_BRANCH:
;==========
; This is the entry point for all the functions
; of RTS. During execution of these functions,
; interrupts are disabled.
; Upon entry:
; AL contains the function code. Parameters
; for the functions are on stack or in registers.
; SI and ES must not be used for parameters,
; they are overwritten here.
; We don't need to save all the registers, since we
; come here on explicite demande (SWI 228) and not
; through a hardware interrupt.
; Set the ES to data segment of RTS:
; Note: in the current release, the compiler
; does not assume the DS to hold the
; value of the current data segment.
; It is however safer not just to destroy it.
MOV ES,RTS_DS
xor ah,ah
; AL contains the function code, test if legal
CMP AL, NBR_FCT
JB VALID_FCT
mov si,ES:word ptr cur_proc_addr + 2
mov es,si
MOV ES:CUR_PROCESS.PD_STATUS,ILL_FCT_CODE
mov es,rts_ds
call save_cpu_info
JMP TERMINATE
VALID_FCT:
MOV SI,AX
SHL SI,1
; At this point:
; AL holds the RTS-Function-Code, SI = 2 * AX.
; ES holds the Data Segment of RTS,
; nothing saved up to now
JMP RTS_JMP_TBL [SI]
;*********************** That's the branch
;-----------------------------------------------------------
; public SAVE_CPU_INFO
SAVE_CPU_INFO PROC NEAR
;============
; Utility routine to save registers in the process descr:
; Upon entry: ES is data segment of RTS
; Upon exit: DS:0 point to current process
mov si,ES:word ptr cur_proc_addr + 2
mov es,si
MOV ES:CUR_PROCESS.PD_DS, DS ; save process' DS
mov si, es
mov ds, si
; We have to save some more information
; (used for the P_M_DUMP and for TRANSFER):
MOV CUR_PROCESS.PD_SP,SP
MOV CUR_PROCESS.PD_BP,BP
MOV CUR_PROCESS.PD_SS,SS
mov bp,sp
mov si,[bp]+2
mov CUR_PROCESS.PD_IP,si ; offset of return address
mov si,[bp]+4
mov CUR_PROCESS.PD_CS,si ; segment of return address
mov si,[bp]+6
mov CUR_PROCESS.PD_FLAGS,si
mov bp,cur_process.pd_bp
ret
SAVE_CPU_INFO ENDP
;-----------------------------------------------------------
slow_TERMINATE:
;==============
; This procedure had to be introduced to make sure that a call
; to SAVE_CPU_INFO is executed when coming via System.Terminate
call save_cpu_info
jmp terminate
;-----------------------------------------------------------
install_termP:
;=============
; input:
; cx:bx contains address of term proc to be installed
; IF bx=MAXCARD THEN just get current value
; ELSE exchange old and new value
; output:
; cx:bx contains former/current value of term_proc_addr
; this allows chaining to be done in System
inc bx ; if bx=MAXCARD ==> bx=0
jnz install_and_get
get:
mov bx,ES:word ptr term_proc_addr
mov cx,ES:word ptr term_proc_addr + 2
iret
install_and_get:
dec bx ; restore old value
xchg bx,ES:word ptr term_proc_addr
xchg cx,ES:word ptr term_proc_addr + 2
iret
;-----------------------------------------------------------
STACK_CHECK:
;===========
; BX = stack clearance requested, in bytes
; we first have to check, if the current stack is the one
; of the modula program. If we are interrupted inside MS-DOS,
; the stack points to an area inside MS-DOS and the test for
; stack-overflow we make here has no sense.
mov dx,ds ; save ds
mov ax,ES:word ptr cur_proc_addr + 2
mov ds,ax
mov ax, ss
cmp ax,rts_ds
jb SP_OK
add bx, sp_reserve ; BX is space required on stack
mov ax, sp
sub ax, bx ; compute new limit
jb STACK_BOO ; oops, wrap thru 0
mov bx, ss
mov cl,4
shr ax,cl
add bx,ax ; convert SP to paragraph pointer
mov ax,word ptr CUR_PROCESS.PD_HEAP_TOP
shr ax,cl
add ax,word ptr CUR_PROCESS.PD_HEAP_TOP+2 ;ditto with heap top ptr
sub bx,ax ; stack below HeapTop?
jbe STACK_BOO ; yup
SP_OK: mov ds,dx ; restore ds
IRET
STACK_BOO:
mov ds,dx ; restore ds
mov es,rts_ds
CALL SAVE_CPU_INFO
;;; JMP SHORT STACK_OVF
;-----------------------------------------------------------
; public STACK_OVF
STACK_OVF:
;=========
; This is the entry through RTS_BRANCH for treatment
; of a stack overflow:
mov ds,rts_ds ; in case we come from somewhere
lds si,cur_proc_addr
MOV CUR_PROCESS.PD_STATUS,STACK_OVF_CODE
JMP TERMINATE ; No return!
page
;-----------------------------------------------------------
; public NMI_server
NMI_server:
;==========
invalid_op_bit equ 1 ; 2**0
denorm_op_bit equ 2 ; 2**1
zero_divide_bit equ 4 ; 2**2
real_ovf_bits equ 11 ; 2**3 + 2**1 + 2**0
real_udf_bit equ 16 ; 2**4
unmasked_bits equ 31 ; sum of above values !!!!!
; wait ; wait til 8087 is ready, 8087 is present !!!!!
; the WAIT resulted in an endless wait
push ax ; save value of AX
push ds ; save value of ds
mov ds,rts_ds ; to address TempWord AND old_NMI_vec
esc 2FH,TempWord ; FNSTSW: get status word of 8087
mov ax,TempWord
and ax,unmasked_bits ; erase all uninteresting bits
jnz from8087
; none of the expected 8087 interrupts, call old server
inc sp ; restore stack, DS was only saved for
inc sp ; those interrupts from the 8087
pop ax ; restore value of AX
jmp old_NMI_vector
from8087:
pop ds ; restore value of ds
inc sp ; restore stack, AX was only saved for
inc sp ; those interrupts not from the 8087
; clear lines etc for next time !!!!!!!!!!!!!!!!!!!!!!!!!!!!
; it is absolutely necessary that this statement is executed
; any further access to 8087 via WAIT results in endless wait,
; if the interrupt lines are not cleared
esc 1CH,dx ; this generates 0DBE2H = FNCLEX for 8087
test ax,zero_divide_bit
jnz div_by_zero
test ax,real_ovf_bits
jnz real_ovf
test ax,real_udf_bit
jnz real_udf
;-----------------------------------------------------------
; public DIV_BY_ZERO
DIV_BY_ZERO:
;===========
; We arrive here NOT through RTS_BRANCH, but directly
; from the interrupt, that the CPU performs in case
; of a division by zero. So, we have to save the registers
; that are relevant for the dump and the debugger:
MOV ES, RTS_DS
CALL SAVE_CPU_INFO
; Set the function code to some reasonable value:
MOV CUR_PROCESS.PD_STATUS,ZERO_DIVIDE_CODE
JMP TERMINATE
;-----------------------------------------------------------
real_ovf:
;========
MOV ES, RTS_DS
CALL SAVE_CPU_INFO
MOV CUR_PROCESS.PD_STATUS,real_ovf_CODE
JMP TERMINATE
;-----------------------------------------------------------
real_udf:
;========
MOV ES, RTS_DS
CALL SAVE_CPU_INFO
MOV CUR_PROCESS.PD_STATUS,real_udf_code
JMP TERMINATE
;-----------------------------------------------------------
M2_HALT:
;=======
; The following registers are destroyed: SI, ES.
; (DS is already saved)
call save_cpu_info
MOV CUR_PROCESS.PD_STATUS,HALT_CODE
JMP TERMINATE
;-----------------------------------------------------------
GET_RETURN_POINT:
;================
SET_RETURN_POINT:
;================
JMP NOT_YET
; Reserved entries for use in connection with
; separate program loading and execution.
;-----------------------------------------------------------------
GET_OLD_PROGRAM:
; We arrive here after termination of an
; overlay and - more precisely - after
; execution of TERMINATE. Stack is already set
; to top-of-stack of father program.
; BP and DS are restored for father program.
MOV ES, RTS_DS
mov ax,ES:word ptr cur_proc_addr + 2
mov ds,ax
; swap to the main process of the terminating program
; if father_proc <> NIL ( process ended )
mov ax,word ptr cur_process.pd_father_proc+2
cmp ax,nil_seg
je rest_old_pd
mov cx,cur_process.pd_status
mov si,word ptr cur_process.pd_father_proc + 2
mov ds,si
mov cur_process.pd_status,cx
mov ES: word ptr cur_proc_addr+2,ds
REST_OLD_PD:
; Restore old P.D.:
POP word ptr CUR_PROCESS.PD_FATHER_PROC
POP word ptr CUR_PROCESS.PD_FATHER_PROC + 2
POP word ptr CUR_PROCESS.PD_PROG_END
POP word ptr CUR_PROCESS.PD_PROG_END + 2
POP AX
MOV CUR_PROCESS.PD_PRIO_MASK, AX ; reset priority
CALL SET_INTERRUPT_MASK
POP DS ; has to be restored last
; Return to the father program:
IRET
data segment public 'data'
NEW_PROG_START DW ? ; variable for 'RUN_PROGRAM'
NEW_PROG_ENTRY DW ?,? ; the same
data ends
RUN_PROGRAM:
;===========
; This function prepares the stack and
; starts a new program. Parameters:
; BX= segment addr of program area
; (used to prepare the new stack).
; DX:CX segment:offset of program entry point,
; Save the parameters:
call save_cpu_info
mov es,rts_ds
MOV ES:NEW_PROG_START, BX
MOV ES:NEW_PROG_ENTRY, CX
MOV ES:NEW_PROG_ENTRY + 2, DX
; The old stack (current-one) still holds
; the return block, to go back to the father
; program upon termination.
; Save some values of the P.D. on the old stack:
PUSH CUR_PROCESS.PD_DS ; has to be first
PUSH CUR_PROCESS.PD_PRIO_MASK
PUSH word ptr CUR_PROCESS.PD_PROG_END + 2
PUSH word ptr CUR_PROCESS.PD_PROG_END
PUSH word ptr CUR_PROCESS.PD_FATHER_PROC + 2
PUSH word ptr CUR_PROCESS.PD_FATHER_PROC
; Now, we push the entry of the termination
; routine and set the new values for PROG_END:
MOV AX, 0 ; interrupt disable
PUSH AX ; flags
PUSH CS
MOV AX, OFFSET GET_OLD_PROGRAM
PUSH AX
PUSH CUR_PROCESS.PD_BP
MOV word ptr CUR_PROCESS.PD_PROG_END + 2, SS
MOV word ptr CUR_PROCESS.PD_PROG_END, SP
; New value for father process. It becomes
; NIL, because the current process will be
; the main of the new program:
MOV AX, NIL_OFF
MOV BX, NIL_SEG
MOV word ptr CUR_PROCESS.PD_FATHER_PROC + 2, BX
MOV word ptr CUR_PROCESS.PD_FATHER_PROC, AX
; Now, we create the new stack:
MOV AX,word ptr CUR_PROCESS.PD_HEAP_TOP
MOV BX,word ptr CUR_PROCESS.PD_HEAP_TOP + 2
CALL NORM_ADDR
INC BX
; BX= seg of free memory
MOV AX,ES:NEW_PROG_START
SUB AX, BX
JA NEW_PROG_OK
MOV CUR_PROCESS.PD_STATUS,CALL_ERR_CODE
POP BP
IRET
; To return in this case (error), we
; execute the termination routine
NEW_PROG_OK:
; Set the new stack:
CALL COMP_STACK
MOV SS, BX
MOV SP, AX
; the old value is stored in PROG_END
; Put the address of the termination routine
; on the new stack. In case of normal termination,
; a RETF will be executed by the program and
; we will arrive in TERMINATE with status=normal.
PUSH CS
MOV AX, OFFSET TERMINATE
PUSH AX
; Now push the entry address of
; the new program:
PUSH CUR_PROCESS.PD_FLAGS
PUSH ES:word ptr NEW_PROG_ENTRY + 2
PUSH ES:word ptr NEW_PROG_ENTRY
; BP is set to 0FFFFH, so the debugger
; can recognize the beginning
; of a new overlay:
MOV BP, 0FFFFH
; it will be pushed in new program
; make sure ES=rts_ds and DS:[SI]='current process'
CALL RTD_AFTER_LOAD
;...and call the new program:
IRET
;---------------------------------------------------------------------------
COM_CASE:
;========
; Common Entry Point for all kind of CASE evaluations
; The actual value of the tag is in BX.
; The parameters are in the code segment, right after the INT instr.
; First fetch the return addr, to get the addr of the parameters:
POP DI
POP ES
PUSH ES ; Restore it, used for IRET
; Get the first parameter:
MOV CX, ES: [DI]
; Set DI to the next parameter:
INC DI
INC DI
; Now select the corresponding routine:
CMP AL, CASE_3_CARD_FCT
JAE CASE_3
CMP AL, CASE_2_CARD_FCT
JAE CASE_2
; otherwise, it must be CASE_1:
CASE_1:
MOV DX, CX ; just to save it
INC CX
; Search 1 more than the actual number of value. This is needed
; distinguish the case where the last element matches from the case
; where no element matches.
MOV AX, BX
cld
REPNE SCASW ; Search the actual tag in the list
; DI points now to the element after the one that matches the actual
; tag. If no value matches, DI points to the word 2 positions after
; the last one in the list. DI is now used as the index in the table
; with the entry points:
SHL DX, 1 ; Size of list to skip
ADD DI, DX
PUSH ES: WORD PTR [DI] - 2
; Entry point for actual tag. The '-2' corrects for the incrementation
; of DI after the search. If no element had matched, we will find the
; address of the ELSE part.
IRET
CASE_2:
MOV DX, ES: [DI] ; Lowest value
; CX holds the highest value, DX the lowest one.
; Set DI to poin to the jumptable:
INC DI
INC DI
INC CX ; highest value + 1
CMP AL, CASE_2_CARD_FCT
JNE CASE_2_INT
CASE_2_CARD: ; The tag is a CARDINAL
CMP BX, DX ; Test if lower than lowest value
JAE CASE_2_1
MOV BX, CX ; actual tag was below lowest value
CASE_2_1: ; The tag is above or equal to lowest value
CMP BX, CX ; Test if higher than highest value
JB CASE_2_OK
MOV BX, CX
JMP SHORT CASE_2_OK
CASE_2_INT: ; The tag is an INTEGER
CMP BX, DX ; Test for lowest value
JGE CASE_2_2
MOV BX, CX
CASE_2_2: ; Tag is greater or equal to lowest value
CMP BX, CX ; Test for highest value
JL CASE_2_OK
MOV BX, CX
CASE_2_OK:
SUB BX, DX ; Tag - Lowest Value
SHL BX, 1
PUSH ES: WORD PTR [BX + DI]
IRET
CASE_3:
PUSH DI ; just to save it
MOV DX, 0 ; Counter
CASE_3_NEXT:
INC DX
CMP DX, CX
JA CASE_3_FOUND
; The tag value was not found: proceed with the counter (DX)
; pointing to the ELSE part.
MOV SI, ES: [DI] ; low limit of next intervall
; Set DI to the next high limit:
INC DI
INC DI
CMP AL, CASE_3_CARD_FCT
JNE CASE_3_INT
CASE_3_CARD: ; Tag is a CARDINAL
CMP BX, SI
JB CASE_3_BELOW
MOV SI, ES: [DI] ; high limit
CMP BX, SI
JBE CASE_3_FOUND
JMP SHORT CASE_3_ABOVE ; It's not this one
CASE_3_INT: ; Tag is an INTEGER
CMP BX, SI
JL CASE_3_BELOW
MOV SI, ES: [DI] ; high limit
CMP BX, SI
JLE CASE_3_FOUND
JMP SHORT CASE_3_ABOVE ; It's not this one
CASE_3_BELOW:
INC DI
INC DI
CASE_3_ABOVE:
; Set DI to the low limit of next intervall
INC DI
INC DI
JMP SHORT CASE_3_NEXT
CASE_3_FOUND:
; DX is the index in the jumptable
; CX is the number of listed intervalls
SHL CX, 1
SHL CX, 1 ; CX is now size of list
POP DI
INC DI
INC DI ; DI is the addr of the list
ADD DI, CX
SHL DX, 1
ADD DI, DX
PUSH ES: WORD PTR [DI]
IRET
CASE_ERROR:
;==========
call save_cpu_info
MOV CUR_PROCESS.PD_STATUS, CASE_ERR_CODE
JMP TERMINATE
; END CASE
;---------------------------------------------------------------------------
PAR_COPY:
;========
; Used to copy a fix size value-parameter from its actual argument
; into the place inside the local variables of a procedure, reserved
; for that copy:
; Upon entry: CX = size of parameter,
; BX = offset, relativ to BP, where the addr of argument is
; DI = offset, relativ to BP, where to copy it.
MOV SI, BX
LDS SI, DWORD PTR [BP+SI] ; (DS,SI) hold source addr
MOV AX, SS
MOV ES, AX
ADD DI, BP ; (ES,DI) hold dest addr
MOV AX, CX ; save the counter
SHR CX, 1 ; number of words to copy
REP MOVSW
AND AX, 1 ; check if odd
JZ PAR_COPY_1
MOVSB ; move the last byte, if any
PAR_COPY_1:
mov ds,rts_ds
mov si,word ptr cur_proc_addr + 2
mov ds,si
MOV DS,CUR_PROCESS.PD_DS
IRET
DYN_PAR_COPY:
;============
; Used to copy a value-parameter of type ARRAY OF T from the actual
; argument on the stack of the called procedure. The copy is placed
; topstack and its address (SS and offset) is put in the procedure
; interface.
; Upon entry: CX holds size of the element of the array.
; DI holds offset, relativ to BP, where the address and
; the high index stand (Offset, Segment, High).
; The low index is assumed to be zero.
; Upon exit: The address of the copy replaces the address of the
; original ([BP+DI] upon entry).
call save_cpu_info
mov es,rts_ds
MOV AX, [BP+DI] + 4 ; High index value
INC AX ; # of elements = high+1
CMP CX, 1
JE SIZE_IN_AX ; no multiplication needed
CMP CX, 4
JA MUL_NEEDED
SHL AX, 1
CMP CX, 2
JBE SIZE_IN_AX ; NOTE: in case the size was an odd
; number, we still have to multiply
; by the next higher even number.
SHL AX, 1
JMP SHORT SIZE_IN_AX
MUL_NEEDED:
MUL CX
SIZE_IN_AX:
; Save the return block from the stack:
POP ES:OldIP
POP ES:OldCS
POP ES:OldFlags
; Check, if there is enough room on the stack:
MOV BX, AX
PUSH AX ; just to save it
PUSH DI ; just to save it
CALL SP_TEST ; returns AX<>0, if error
CMP AX, 0
JZ STACK_GOOD
CALL STACK_OVF ; no room for the copy
STACK_GOOD:
POP DI ; restore it
POP CX ; restore it
SUB SP, CX
AND SP, 0FFFEH ; Mask out last bit, to
; ensure an even address.
MOV DX, es ; save es (don't use stack)
LDS SI, DWORD PTR [BP+DI] ; Source address
MOV [BP+DI], SP ; Store the destination addr
MOV [BP+DI] + 2, SS
MOV DI, SP
MOV AX, SS
MOV ES, AX ; (ES,DI) = Dest addr
INC CX ; number of bytes
SHR CX, 1 ; CX = number of words
REP MOVSW
; Restore the return block:
MOV es, DX ; restore es
PUSH ES:OldFlags
PUSH ES:OldCS
PUSH ES:OldIP
lds si,ES:cur_proc_addr
MOV DS, CUR_PROCESS.PD_DS
IRET
; END PARAMETER_COPY
;---------------------------------------------------------------------------
SP_TEST PROC near ; only called by DYN_PAR_COPY
; Used registers: AX, BX, CX, DX, SI, DI
; BX holds the required size. SP is checked for room to grow by
; the required number of bytes + some reserve. AX returns 0 if ok
; and 0FFH if overflow occurs.
mov ax,ss
cmp ax,rts_ds
jb stack_ok
ADD BX, SP_RESERVE
; first check, if SP does not go through zero:
CMP BX, SP
JA STACK_BAD
MOV AX, SP
SUB AX, BX ; that's the new stack limit
MOV BX, SS
CALL NORM_ADDR ; Returns: BX=seg, AX=offset (<16)
MOV cx, AX
MOV DI, BX
MOV AX,word ptr CUR_PROCESS.PD_HEAP_TOP ; DS: --> P.D.
MOV BX,word ptr CUR_PROCESS.PD_HEAP_TOP + 2
CALL NORM_ADDR ; Returns: BX=seg, AX=offset (<16)
CMP DI, BX ; test segment
JA STACK_OK
JB STACK_BAD
CMP cx, AX ; test offset
JA STACK_OK
STACK_BAD:
MOV AX, 0FFH ; means: error
RET
STACK_OK:
MOV AX, 0 ; means: no error
RET
SP_TEST ENDP
WRITE_STAT:
;==========
; BX holds the status value to be interpreted
call save_cpu_info
mov ds,rts_ds ; expected by WRITE_STATUS
CALL WRITE_STATUS
lds si,cur_proc_addr
MOV DS, CUR_PROCESS.PD_DS
IRET
;---------------------------------------------------------------------------
GET_PD_ADDR:
;===========
; Upon entry: (DX,BX) hold address, where to put the addr of CUR_PROCESS
call save_cpu_info
MOV ES, DX
MOV ES:WORD PTR [BX], OFFSET CUR_PROC_addr
mov ax,rts_ds
MOV ES:WORD PTR 2[BX],ax ; DS of RTS
MOV DS, CUR_PROCESS.PD_DS
IRET
;---------------------------------------------------------------------------
ALLOC_HEAP:
;==========
; Increases the Heap by the requested size
; (in register BX). Checks for collision
; Heap - Stack.
;;;;;;;;; Fast procedure
mov ax,es:word ptr cur_proc_addr + 2
mov es,ax
MOV ES: CUR_PROCESS.PD_DS, DS
MOV AX,ES:word ptr CUR_PROCESS.PD_HEAP_TOP + 2
ADD BX,ES:word ptr CUR_PROCESS.PD_HEAP_TOP
JC FIX_OFFSET
; save the new heap_top:
PUSH AX ; segment
PUSH BX ; offset
JMP SHORT NORM_HEAP_TOP
FIX_OFFSET:
; there was an overflow of the offset:
ADD AX, 1000H
PUSH AX ; new segment
PUSH BX ; and old offset
JC HEAP_BAD ; we ask for too much
NORM_HEAP_TOP:
MOV CL, 4
SHR BX, CL
INC BX
ADD BX, AX ; normalized new segment
JC HEAP_BAD
; BX is the segment value just above the new
; Heap_Top. On the stack we have saved that
; new Heap_Top. Now we have to normalize the stack:
MOV AX, SP
MOV CL, 4
SHR AX, CL
MOV DX, SS
ADD AX, DX ; norm. stack segment
CMP AX, BX ; compare segments only
JB HEAP_BAD
HEAP_OK:
POP word ptr CUR_PROCESS.PD_HEAP_TOP
POP word ptr CUR_PROCESS.PD_HEAP_TOP + 2
HEAP_RET:
MOV DS, CUR_PROCESS.PD_DS
IRET
HEAP_BAD:
MOV CUR_PROCESS.PD_STATUS, HEAP_OVF_CODE
POP AX ; dummy
POP AX
JMP SHORT HEAP_RET
;---------------------------------------------------------------------------
FCT_RET_ERR:
;===========
; This error will occur, if a function terminates without an
; explicite RETURN statement.
call save_cpu_info
MOV CUR_PROCESS.PD_STATUS, FCT_RET_ERR_CODE
JMP TERMINATE ; No return!
;---------------------------------------------------------------------------
NORM_ADDRESS:
;============
; GOAL: brings an address variable in its normalized form,
; i.e. segment as large as possible, offset = [0..15].
; The program is terminated in case of overflow.
; INPUT: the address in (DS,BX)
; OUTPUT: same as input
MOV AX, BX
MOV BX, DS
CALL NORM_ADDR
MOV DS, BX
MOV BX, AX
JC ADDR_OVF ; address larger than 20 Bits!
IRET
;---------------------------------------------------------------------------
ADD_ADDR:
;========
; GOAL: Adds two addresses and checks the result for overflow.
; INPUT: the 2 addresses to add are in (DX,DI) and (DS,BX).
; OUTPUT: the resulting address in (DS,BX).
MOV AX, DI
; add the offsets:
ADD AX, BX
JNC OFF_OK_1
; IF CARRY means: the sum of the offsets gives an overflow,
; we have to add 1000H to the segment values:
ADD DX, 1000H
JC ADDR_OVF
OFF_OK_1:
MOV BX, DS
; add the segments:
ADD BX, DX
JC ADDR_OVF
;;; Don't make the following shortcut!
;;; It returns a non-normalized address and
;;; therefore the address comparison is slower!
;;; CMP BX, 0F000H
;;; JB ADD_ADDR_DONE ; overflow not possible
; check for overflow:
CALL NORM_ADDR
JC ADDR_OVF
ADD_ADDR_DONE:
MOV DS, BX
MOV BX, AX
IRET
ADD_A_C:
;=======
; GOAL: Adds an ADDRESS and a CARDINAL and checks the result
; for overflow.
; INPUT: the ADDRESS is in (DS,BX) and the CARDINAL in (DX)
; OUTPUT: the resulting ADDRESS in (DS,BX).
MOV AX, DX
; add the offsets:
ADD AX, BX
MOV BX, DS
JNC OFF_OK_2
; IF CARRY means: the sum of the offsets gives an overflow,
; so we have to add 1000H to the segment values:
ADD BX, 1000H
JC ADDR_OVF
OFF_OK_2:
;;; Don't make the following shortcut!
;;; It returns a non-normalized address and
;;; therefore the address comparison is slower!
;;; CMP BX, 0F000H
;;; JB ADD_A_C_DONE ; overflow not possible
; check for overflow:
CALL NORM_ADDR
JC ADDR_OVF
ADD_A_C_DONE:
MOV DS, BX
MOV BX, AX
IRET
;---------------------------------------------------------------------------
ADDR_OVF:
; This is the treatment of the overflow
; of an address variable.
CALL SAVE_CPU_INFO
MOV CUR_PROCESS.PD_STATUS, ADDR_OVF_CODE
JMP TERMINATE ; No return!
;---------------------------------------------------------------------------
COMM_SUB_ADDR PROC NEAR
; performs (BX,AX) - DX, and returns result in BX (seg) and AX (off):
CMP AX, DX ; to check, which offset is larger
JAE SUB_OFFSET
; IF BELOW means: the offset to subtract is larger then the offset
; of the address, so we have to borrow as much as we need from the
; segment:
SUB DX, AX
MOV AX, DX ; DX saves the difference
ADD AX, 0FH ; AX := (AX + 15) MOD 16
MOV CL, 4
SHR AX, CL ; AX = number of paragraphs to borrow
SUB BX, AX ; BX = corrected segment value
JB ADDR_OVF
AND DX, 0FH ; normalized offset to subtract
MOV AX, 0
JZ OFF_OK_3 ; the resulting offset is zero
MOV AX, 10H
SUB_OFFSET:
SUB AX, DX
OFF_OK_3:
RET
COMM_SUB_ADDR ENDP
SUB_ADDR:
;========
; GOAL: Subtracts the ADDRESS in (DX,DI) from the
; ADDRESS in (DS,BX). The result is checked
; for overflow and returned in (DS,BX).
MOV AX, BX
MOV BX, DS
MOV DS, DX
MOV DX, DI
CALL COMM_SUB_ADDR
; subtract the segments:
CALL NORM_ONE ; result in (BX,AX)
MOV CX, DS
SUB BX, CX
JB ADDR_OVF
; check for overflow:
CALL NORM_ADDR
JC ADDR_OVF
MOV DS, BX
MOV BX, AX
IRET
SUB_A_C:
;=======
; GOAL: Subtracts the CARDINAL in (DX) from the
; ADDRESS in (DS,BX). The result is checked
; for overflow and returned in (DS,BX).
MOV AX, BX
MOV BX, DS
CALL COMM_SUB_ADDR
; check for overflow:
CALL NORM_ADDR
JC ADDR_OVF
MOV DS, BX
MOV BX, AX
IRET
;---------------------------------------------------------------------------
NORM_ONE PROC NEAR
; Normalizes 'partially' ADDRESS in (BX,AX), result in (BX,AX).
; 'Partially' means: segment is as large as possible, offset
; as small as possible, but the offset might be larger than 15
; (in case of addresses out of range).
MOV DX, AX
AND AX, 0FH
MOV CL, 4
SHR DX, CL
ADD BX, DX ; that's the regular normalization
JC TOO_LARGE_ADDR
RET
TOO_LARGE_ADDR:
MOV CL, 4
INC BX ; add 1 paragraph, since the maximum
; value for the segment is 0FFFFH.
SHL BX, CL ; transform remaining paragraphs in offset
ADD AX, BX ; complete the offset
MOV BX, 0FFFFH ; the highest value for the segment
RET
NORM_ONE ENDP
EQ_ADDR:
;=======
; Compares two ADDRESSes for equality. The values are passed
; in (DS,BX) and (DX,DI) and the result is in BL (0 = FALSE,
; 1 = TRUE). The input values are allowed to be out of the
; legal ADDRESS-range.
; FAST routine. We optimize the path, where the addresses are
; not equal, but have the same segment value. This is the most
; frequent case, when searching elements allocated in the same heap.
; first check, if they differ in the last 4 bits:
MOV AX, BX
AND BL, 0FH ; mask out the last 4 bits
MOV CX, DI
AND CL, 0FH
CMP BL, CL
JNE THEY_ARE_DIFF
; next we check if 1 part of addr is equal:
MOV BX, DS
CMP AX, DI ; compare offsets
JE SAME_OFFSET
CMP BX, DX ; compare segments
JNE DO_NORMALIZE
THEY_ARE_DIFF:
MOV BL, 0 ; value for NOT EQUAL
IRET
SAME_OFFSET:
CMP BX, DX ; compare segments
JNE THEY_ARE_DIFF
THEY_ARE_EQUAL:
MOV BL, 1 ; value for EQUAL
IRET
DO_NORMALIZE:
MOV SI, DX ; second par in (SI,DI)
CALL NORM_ONE
XCHG BX, SI
XCHG AX, DI
CALL NORM_ONE
; now, compare the 2 norm. addresses
CMP BX, SI
JNE THEY_ARE_DIFF
CMP AX, DI
JNE THEY_ARE_DIFF
JMP SHORT THEY_ARE_EQUAL
GT_EQ_ADDR:
;==========
; This routine performs both comparisons, GREATER and
; GREATER or EQUAL of two ADDRESSes (a1 > a2, a1 >= a2).
; The ADDRESS a1 is passed in (DX,DI), a2 in (DS,BX).
; They are allowed to be out of the legal ADDRESS-range.
; The result is in BL (0 = FALSE, 1 = TRUE).
; FAST routine. We optimize the path, where the addresses
; have same segment value, but different offset.
MOV SI, AX ; the function code
MOV AX, BX
MOV BX, DS
; check if segments are equal:
CMP BX, DX
JNE DIFF_SEGMENTS
; segments are equal:
CMP AX, DI ; compare offsets
JA COND_FALSE ; its LESS THAN
JB COND_TRUE ; its GREATER
; they are equal:
CMP SI, GT_ADDR_FCT
JE COND_FALSE
COND_TRUE:
MOV BL, 1
IRET
COND_FALSE:
MOV BL, 0
IRET
DIFF_SEGMENTS:
MOV DS, SI
MOV SI, DX ; a1 is in (SI,DI)
CALL NORM_ONE ; normalize a2
XCHG BX, SI
XCHG AX, DI
CALL NORM_ONE ; normalize a1
; now compare the 2 normalized addresses:
CMP BX, SI ; compare segments
JA COND_TRUE
JB COND_FALSE
; the segments are equal, now we compare the offsets:
; Here we have to distinguish between the comp. GT / GT_EQ:
MOV SI, DS
CMP SI, GT_ADDR_FCT
JNE GT_EQ_TEST
GT_TEST:
CMP AX, DI
JA COND_TRUE
JMP SHORT COND_FALSE
GT_EQ_TEST:
CMP AX, DI
JAE COND_TRUE
JMP SHORT COND_FALSE
;---------------------------------------------------------------------------
CONV_A_C:
;========
; Converts an address in (DS,BX) into a CARDINAL and returns
; it in DX. The result is checked for overflow:
MOV DX, DS
MOV CL, 4
SHL DX, CL ; base * 16
JC BAD_CONVERT
ADD DX, BX ; result = (base * 16) + offset
JC BAD_CONVERT
IRET
BAD_CONVERT:
;;; JMP SHORT CARD_OVF
;---------------------------------------------------------------------------
CARD_OVF:
;========
; Treats the CARDINAL overflow: generate a P_M_DUMP, set the process
; status to CARD_OVF_CODE and terminates the current program:
CALL SAVE_CPU_INFO
MOV CUR_PROCESS.PD_STATUS, CARD_OVF_CODE
JMP TERMINATE ; No return!
;---------------------------------------------------------------------------
INTEGER_OVF:
;===========
; Treats the INTEGER overflow: generate a P_M_DUMP, set the process
; status to INTEGER_OVF_CODE and terminates the current program:
CALL SAVE_CPU_INFO
MOV CUR_PROCESS.PD_STATUS, INTEGER_OVF_CODE
JMP TERMINATE ; No return!
;---------------------------------------------------------------------------
RANGE_ERROR:
;===========
; Treats the RANGE ERROR: generate a P_M_DUMP, set the process
; status to RANGE_ERR_CODE and terminates the current program:
CALL SAVE_CPU_INFO
MOV CUR_PROCESS.PD_STATUS, RANGE_ERR_CODE
JMP TERMINATE ; No return!
;------------------------------------------------------------------------
PSP_POINTER:
;==========
; Returns a pointer to a static copy of the program segment
; prefix (PSP) for the RTS.
; The address is returned in (CX:BX)
CALL SAVE_CPU_INFO
mov es, rts_ds
LeS BX,ES: BASE_PAGE_PTR
MOV CX,eS
MOV DS,CUR_PROCESS.PD_DS
IRET
;------------------------------------------------------------------------
;data segment public 'data'
;NYI DB 'RTS-function not yet implemented: $'
;data ends
NOT_YET:
;=======
; This function can be called by RTS-functions
; that are not yet implemented:
call save_cpu_info
MOV CUR_PROCESS.PD_STATUS, ILL_FCT_CODE
JMP TERMINATE
; No Return!
;*****************************************************************************
code ends
end