|
DataMuseum.dkPresents historical artifacts from the history of: DANOSI |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DANOSI Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 21294 (0x532e)
Types: TextFile
Names: »RTPSTD86.SRC«
└─⟦289818552⟧ Bits:30010516 DVBS1.SW2114.src.2.7-3 SW2114 3/4 Real Time Pascal 2.7
└─⟦this⟧ »RTPSTD\RTPSTD86.SRC«
└─⟦783187a02⟧ Bits:30010525 DVBS1.SW2114.src.2.6-3 RTP compiler source SW2104+SW2114 Disk#3 30/1-92 HHA
└─⟦this⟧ »RTPSTD\RTPSTD86.SRC«
└─⟦ca921ce75⟧ Bits:30010528 DVBS1.SW2114.src.2.6-6 RTP Compiler Source SW2104+SW2114 Disk 3 92.02.03 HEJ HHA
└─⟦this⟧ »RTPSTD\RTPSTD86.SRC«
└─⟦d5707feda⟧ Bits:30010512 DVBS1.SW2114.src.2.14-3 SW2114 REAL #3/4 TIME PASCAL SOURCE REL 2.14 92.09.01
└─⟦this⟧ »RTPSTD\RTPSTD86.SRC«
$listoff\r
stdenv; (* standard environment TOG 870927 *)\r
\r
(***** PREDEFINED CONSTANTS *****)\r
CONST\r
maxint = 32767;\r
minint = -32768;\r
\r
\r
(***** PREDEFINED TYPES *****)\r
TYPE\r
\r
bit = 0..1;\r
\r
byte = 0..255;\r
\r
conn_service = (cs_normal, cs_high);\r
\r
const create_ok=0;\r
-- no_memory=1;\r
create_no_memory=1;\r
\r
type create_result = create_ok .. create_no_memory;\r
\r
const\r
minpriority = 254;\r
stdpriority = 200;\r
maxpriority = 129;\r
\r
type\r
prio_type=maxpriority..minpriority;\r
\r
event_type = (not_event, message_event, answer_event,\r
process_removed, port_closed, disconnected,\r
letter_sent, letter_arrived,\r
local_connect, remote_connect,\r
reset_indication, reset_completion,\r
credit, data_sent, data_arrived, data_overrun,\r
dummy_letter, dummy_lcnct, dummy_rcnct,\r
dummy_rindic, dummy_rcmpl, dummy_credit,\r
dummy_sent, dummy_arrived);\r
\r
const link_ok=0;\r
file_not_found=1;\r
file_not_object=2;\r
no_mem=3;\r
missing_subprogram=4;\r
link_already_linked=5;\r
link_not_found=6;\r
\r
-- already_linked=5;\r
-- external_not_found=6;\r
\r
type link_result=link_ok..link_not_found;\r
\r
const unlink_ok=0;\r
unlink_no_program_linked=1;\r
unlink_program_busy=2;\r
-- no_program_linked=1;\r
-- existing_incarnations=2;\r
\r
type unlink_result = unlink_ok .. unlink_program_busy;\r
\r
const mem_private = 0;\r
mem_dualport = 1;\r
mem_bord = 2;\r
\r
type mem_type = MEM_PRIVATE .. MEM_BORD;\r
\r
reason_type = (reason_ok, reason_name, reason_resource,\r
reason_closed, reason_network);\r
\r
scope_type = (anonymous, local, regional, global);\r
\r
string(length: byte) = ARRAY(1..length) OF CHAR;\r
\r
alfa = string(12);\r
\r
activation = (a_mailbox, a_delay);\r
\r
control_type = packed record \r
rcv_all,\r
get_credit: boolean;\r
end;\r
\r
(* shielded type declarations *)\r
(******************************)\r
\r
mailbox_ = record\r
mbx: INTEGER;\r
s: INTEGER;\r
next: ^integer; --^mailbox_\r
end;\r
\r
pool_ = record\r
mbx: INTEGER;\r
s: INTEGER;\r
size: INTEGER;\r
mem: BYTE;\r
bufs: INTEGER;\r
next: ^integer; --^pool_\r
end;\r
\r
process_ = record\r
proc: INTEGER;\r
next: ^integer; --^process_\r
end;\r
\r
reference_ = record\r
topbuf: INTEGER;\r
locked: INTEGER;\r
next: ^integer; --^reference_\r
end;\r
\r
chain_ = record\r
curbuf: INTEGER;\r
locked: INTEGER;\r
start: INTEGER;\r
length: INTEGER;\r
next: ^integer; --^chain_\r
end;\r
\r
port_ = record\r
prt: INTEGER;\r
state: BYTE;\r
next: ^integer; --^port_\r
end;\r
\r
program_descriptor= record\r
state: BYTE;\r
paramdesc: ^integer;\r
poolparam: BYTE;\r
LBDR: ^integer; --^extenal_lbdr\r
prgname: array(1..13) of char;\r
count: INTEGER;\r
paramptr: ^integer;\r
noparams: BYTE;\r
next: ^integer; --program_descriptor\r
end;\r
\r
\r
(***** PREDEFINED ROUTINES *****)\r
(*********************************)\r
\r
code\r
$ save nolist\r
$ include(pi3.dcl)\r
$ restore\r
\r
%set(xvarno,0)\r
\r
%*define(beginopen(rtn))(\r
rtne%rtn DW size%rtn\r
x%eval(%xvarno) DW y%eval(%xvarno)\r
)\r
\r
%*define(endopen(rtn))(\r
size%rtn EQU $-rtne%rtn\r
y%eval(%xvarno) EQU $-x%eval(%xvarno)-2\r
%set(xvarno,%xvarno+1)\r
)\r
\r
%*define(extcall(routine))(\r
y%eval(%xvarno) EQU $-x%eval(%xvarno)-2\r
DB 1 ; external call\r
DW %routine\r
%set(xvarno,%xvarno+1)\r
x%eval(%xvarno) DW y%eval(%xvarno)\r
)\r
\r
F_RANGE EQU 52\r
\r
routine_fault EQU 1\r
routine_resume EQU 2\r
routine_allocpool EQU 3\r
\r
CodeMacro PUSH src:Db(-128,127)\r
DB 6AH\r
DB src\r
endM\r
\r
\r
%*define(fault(fcode))(\r
PUSH %fcode\r
%extcall(routine_fault) \r
)\r
\r
%*define(get_buf_seg) local nonfault\r
(POP SI ;ES:SI:=ptr_reference\r
POP ES\r
CMP ES:[SI].LOCKED,0;\r
JGE %NONFAULT\r
%fault(F_NIL)\r
; MOV AL,F_NIL ;reference=NIL\r
; INT 31\r
%NONFAULT:\r
MOV ES,ES:[SI].TOPBUF ;ES:=buffer-frame)\r
end;\r
\r
function abs(n: integer): 0..maxint;\r
begin 1\r
POP AX ;AX:=abs(topword)\r
CMP AX,0\r
JGE ABS_EXIT\r
NEG AX\r
INTO\r
ABS_EXIT:\r
END;\r
\r
procedure alloc = getbuf( var r: reference; var p: pool; var ra: mailbox);\r
external;\r
\r
function allocdelay = getbufdelay(var r: reference; var p:pool; var ra: mailbox; \r
ms: 0..maxint): activation;\r
external;\r
\r
function allocmempool = allocpool(var p: pool; no_of_bufs, bufsize: 0..maxint;\r
mem: mem_type): 0..maxint;\r
EXTERNAL;\r
\r
function allocpool(var p: pool; no_of_bufs, bufsize: 0..maxint): 0..maxint;\r
begin 1\r
XOR AX,AX\r
PUSH AX\r
%extcall(routine_allocpool)\r
end;\r
\r
procedure break(VAR proc: process; fault: integer);\r
EXTERNAL;\r
\r
function bufcount(var r: reference): 0..maxint;\r
begin 0\r
%GET_BUF_SEG\r
MOV AX,ES:BUFCOUNT\r
END;\r
\r
function bufsize(var r: rtype ): 0..maxint;\r
begin 0\r
%GET_BUF_SEG\r
MOV AX,ES:DATASIZE\r
END;\r
\r
function bytecount(var r: rtype ): 0..maxint;\r
begin 0\r
%get_buf_seg\r
MOV AX,ES: bytecount\r
end;\r
\r
procedure chaindequeue(var ref: reference; var ch: chain);\r
external;\r
\r
procedure chaindown(var ch: chain);\r
external;\r
\r
procedure chainenqueue(var ref: reference; var ch: chain);\r
external;\r
\r
function chainlength(var ch: chain): 0..maxint;\r
begin 0\r
POP SI\r
POP ES\r
MOV AX,ES:[SI].c_length\r
end;\r
\r
procedure chainreset(var ch: chain);\r
external;\r
\r
procedure chainstart(var ch: chain);\r
external;\r
\r
procedure chainup(var ch: chain);\r
external;\r
\r
function ord(v: btype): integer;\r
begin 0\r
POP AX\r
XOR AH,AH\r
END;\r
\r
function chr(v: byte): char; and\r
function ord(v: wtype): integer; \r
begin 0\r
POP AX\r
END;\r
\r
function create(inspect incname: string; var prog: program_descriptor;\r
var pr: process; size: 0..maxint; prio: prio_type): create_result;\r
external;\r
\r
function creditcount(var r: reference): 0..maxint;\r
begin 0\r
%get_buf_seg\r
MOV AL,ES:creditcount\r
end;\r
\r
procedure dec(var v: byte);\r
begin 0\r
POP SI\r
POP ES\r
DEC ES:BYTE ptr[SI]\r
end;\r
\r
procedure dec(var v: integer);\r
begin 0\r
POP SI\r
POP ES\r
DEC ES:WORD ptr[SI]\r
end;\r
\r
procedure delay(ms: 0..maxint);\r
external;\r
\r
function eventkind(var r: rtype): event_type;\r
begin 0\r
%get_buf_seg\r
MOV AL,ES: eventkind\r
end;\r
\r
procedure exception = fault(c: integer);\r
external;\r
\r
function hometest(var r: rtype; var p: pool): boolean;\r
begin 0\r
POP BX ; BX:=pool.offset \r
POP AX ; AX:=pool.segment \r
%get_buf_seg ; ES:=buffer frame\r
CMP BX,ES:WORD PTR home ; ZF:=(home.offs=pool.offs)\r
JNE hometest_1 ; if ZF then\r
SUB AX,ES:WORD PTR home+2; ZF:=(home.base=pool.base)\r
JE hometest_2 ; if ZF then AL:=FF else AL:=0\r
hometest_1:\r
MOV AL,0FFH\r
hometest_2:\r
INC AL\r
end;\r
\r
procedure inc(var v:byte);\r
begin 0\r
POP SI\r
POP ES\r
INC ES:BYTE PTR[SI]\r
end;\r
\r
procedure inc(var v:integer);\r
begin 0\r
POP SI\r
POP ES\r
INC ES:WORD PTR[SI]\r
end;\r
\r
function index(var r:reference): byte;\r
begin 0\r
%get_buf_seg\r
MOV AL,ES:index\r
end;\r
\r
function link(inspect incname: string;var prog: program_descriptor): \r
link_result;\r
external;\r
\r
function locked(var m:mailbox): boolean;\r
begin 0\r
POP SI\r
POP ES\r
SUB AX,AX\r
CMP AX,ES:[SI].s\r
JLE loced_1\r
INC AX\r
loced_1:\r
end;\r
\r
procedure new(var p: ptype); external;\r
\r
function nil(var p:ptype ): boolean;\r
begin 0\r
POP SI\r
POP ES\r
SUB AX,AX\r
CMP ES:WORD PTR [SI]+2,0\r
JNE nil_1\r
INC AX\r
nil_1:\r
end;\r
\r
function nil(var p:reference): boolean;\r
begin 0\r
POP SI\r
POP ES\r
SUB AX,AX\r
CMP ES:WORD PTR [SI]+2,0FFFFH\r
JNE nil_2\r
INC AX\r
nil_2:\r
end;\r
\r
function nil(var p:process): boolean;\r
begin 0\r
POP SI\r
POP ES\r
SUB AX,AX\r
CMP AX,ES:WORD PTR [SI]\r
JNE nil_3\r
INC AL\r
nil_3:\r
end;\r
\r
function offset(var r:rtype ): 0..maxint;\r
begin 0\r
%get_buf_seg\r
MOV AX,ES:dataoffset\r
end;\r
\r
function open(var m:mailbox): boolean; and\r
function openpool(var p: pool): boolean;\r
begin 0\r
POP SI\r
POP ES\r
SUB AX,AX\r
CMP AX,ES:[SI].s\r
JGE open_1\r
INC AX\r
open_1:\r
end;\r
\r
(* ord see chr *)\r
\r
function passive(var m:mailbox): boolean;\r
begin 0\r
POP SI\r
POP ES\r
SUB AX,AX\r
CMP AX,ES:[SI].s\r
JNE passive_1\r
INC AX\r
passive_1:\r
end;\r
\r
procedure pop(var b,s: reference);\r
external;\r
\r
function pred(v: btype): btype;\r
begin 0\r
POP BX\r
POP AX\r
CMP AL,BL\r
JNE pred_1\r
%fault(F_RANGE)\r
pred_1:\r
DEC AL\r
end;\r
\r
function pred(v: wtype): wtype;\r
begin 0\r
POP BX\r
POP AX\r
CMP AX,BX\r
JNE pred_2\r
%fault(F_RANGE)\r
pred_2:\r
DEC AX\r
end;\r
\r
procedure push(var b,s: reference);\r
external;\r
\r
function reason(var r:reference): reason_type;\r
begin 0\r
%get_buf_seg\r
MOV AL,ES:reason\r
end;\r
\r
procedure release = putbuf(var r: reference);\r
external;\r
\r
function releasepool(var p:pool; bufs: 1..maxint): 0..maxint;\r
external;\r
\r
procedure remove(var pr: process);\r
external;\r
\r
procedure resetevent(var r: rtype);\r
begin 0\r
%get_buf_seg\r
MOV ES:eventkind,not_event\r
end;\r
\r
procedure resume(var pr: process);\r
external;\r
\r
procedure return(var r:reference);\r
external;\r
\r
procedure setbytecount(var r: rtype ; v: 0..maxint);\r
begin 0\r
pop BX\r
%get_buf_seg\r
MOV ES:bytecount,BX\r
end;\r
\r
procedure setoffset(var r: rtype ; v: 0..maxint);\r
begin 0\r
pop BX\r
%get_buf_seg\r
cmp BX,ES:datasize\r
jle setoff_1\r
%fault(F_RANGE)\r
; int 29 \r
setoff_1:\r
MOV ES:dataoffset,BX\r
end;\r
\r
procedure settop(var r: rtype ; v: 0..maxint);\r
begin 0\r
pop BX\r
%get_buf_seg\r
cmp BX,ES:datasize\r
jle settop_1\r
%fault(F_RANGE)\r
; int 29 \r
settop_1:\r
MOV ES:top,BX\r
end;\r
\r
procedure setu1(var r: rtype ; v: byte);\r
begin 0\r
pop BX\r
%get_buf_seg\r
MOV ES:u1,BL\r
end;\r
\r
procedure setu2(var r: rtype ; v: byte);\r
begin 0\r
pop BX\r
%get_buf_seg\r
MOV ES:u2,BL\r
end;\r
\r
procedure setu3(var r: rtype ; v: byte);\r
begin 0\r
pop BX\r
%get_buf_seg\r
MOV ES:u3,BL\r
end;\r
\r
procedure setu4(var r: rtype ; v: byte);\r
begin 0\r
pop BX\r
%get_buf_seg\r
MOV ES:u4,BL\r
end;\r
\r
procedure signal(var r: reference; var m:mailbox);\r
external;\r
\r
function stackdepth(var r:reference ): 0..maxint;\r
begin 0\r
%get_buf_seg\r
MOV AX,ES:depth\r
end;\r
\r
procedure start(var pr: process; prio: prio_type);\r
begin 0\r
pop ax\r
cli \r
test DS: byte ptr own.p_state, 1\r
JNZ start_1\r
mov DS: byte ptr own.priority, al\r
start_1:\r
sti\r
%extcall(routine_resume)\r
end;\r
\r
procedure stop(var p: process);\r
external;\r
\r
function succ(v:btype): btype;\r
begin 0\r
POP BX\r
POP AX\r
CMP AL,BL\r
JNE SUCC_1\r
%fault(F_RANGE)\r
succ_1:\r
INC AL\r
end;\r
\r
function succ(v:wtype): wtype;\r
begin 0\r
POP BX\r
POP AX\r
CMP AX,BX\r
JNE SUCC_2\r
%fault(F_RANGE)\r
succ_2:\r
INC AX\r
end;\r
\r
procedure tofrom(var toref: reference; toindex: integer;\r
var fromref: reference; fromindex: integer;\r
bytes: integer );\r
EXTERNAL;\r
\r
function top(var r:rtype ): 0..maxint;\r
begin 0\r
%get_buf_seg\r
MOV AX,ES:top\r
end;\r
\r
procedure trace(f: integer);\r
external;\r
\r
procedure stacktrace = dtrace(f: integer);\r
external;\r
\r
function unlink(var prog: program_descriptor): unlink_result; external;\r
\r
function u1(var r:rtype ): byte;\r
begin 0\r
%get_buf_seg\r
MOV AL,ES:u1\r
end;\r
\r
function u2(var r:rtype ): byte;\r
begin 0\r
%get_buf_seg\r
MOV AL,ES:u2\r
end;\r
\r
function u3(var r:rtype ): byte;\r
begin 0\r
%get_buf_seg\r
MOV AL,ES:u3\r
end;\r
\r
function u4(var r:rtype ): byte;\r
begin 0\r
%get_buf_seg\r
MOV AL,ES:u4\r
end;\r
\r
procedure wait( var r: reference; var m: mailbox);\r
external;\r
\r
function waitdelay(var r: reference; var m: mailbox;\r
ms: 0..maxint): activation;\r
external;\r
\r
procedure closeport(var p: port);\r
external;\r
\r
procedure connect(var p:port; index:1..maxint; var compl, disc: reference;\r
inspect remote_name:string; service: conn_service);\r
external;\r
\r
procedure disconnect(var p:port; index:1..maxint);\r
external;\r
\r
procedure getconnection(var p:port; index:1..maxint; var compl, disc:reference);\r
external;\r
\r
procedure getcredit(var p:port; index:1..maxint; var credbuf: reference);\r
external;\r
\r
procedure getreset(var p:port; index:1..maxint; var indic: reference);\r
external;\r
\r
function maxconnections:0..maxint;\r
external;\r
\r
procedure openport(var p:port; var closebuf: reference;\r
inspect name:string; scope: scope_type;\r
no_of_cons: byte; cntrl: control_type);\r
external;\r
\r
procedure receive(var p:port; index:1..maxint; var databuf: reference);\r
external;\r
\r
procedure receiveall(var p:port; var databuf: reference);\r
external;\r
\r
procedure reset(var p:port; index:1..maxint; var compl: reference);\r
external;\r
\r
procedure send(var p:port; index:1..maxint; var databuf: reference);\r
external;\r
\r
(* general implementation dependent standard routines and types *)\r
\r
type\r
coded_date=RECORD\r
year_after_1900: 0..127;\r
month: 0..12;\r
day: 0..31;\r
END;\r
\r
coded_time=RECORD\r
? : 0..31;\r
hour: 0..23;\r
minute: 0..59;\r
END;\r
\r
coded_secs=RECORD\r
sec: 0..59;\r
msec: 0..999;\r
END;\r
\r
coded_inc= RECORD\r
days: 0..31;\r
hours: 0..23;\r
mins: 0..59;\r
secs: 0..59;\r
msecs: 0..999;\r
END;\r
\r
delaytype= PACKED RECORD\r
prev_date: coded_date;\r
prev_time: coded_time;\r
prev_secs: coded_secs;\r
inc : coded_inc;\r
END;\r
\r
clocktype= PACKED RECORD\r
date: coded_date;\r
time: coded_time;\r
secs: coded_secs;\r
END;\r
\r
tversion= RECORD\r
release, subrelease: byte;\r
END;\r
\r
tmoduleversion= RECORD\r
moduledate: coded_date;\r
moduletime: coded_time;\r
moduleversion: tversion;\r
compilationdate: coded_date;\r
compilationtime: coded_time;\r
END;\r
\r
function clock_difference( var t1, t2: clocktype ): coded_inc;\r
external;\r
\r
function clock_increment( var t: clocktype; var inc: coded_inc ): clocktype;\r
external;\r
\r
function clock_less_than( var t1, t2: clocktype ): boolean;\r
external;\r
\r
FUNCTION deletemailbox(INSPECT mbx_name: string): integer;\r
EXTERNAL;\r
\r
FUNCTION getclock: clocktype;\r
EXTERNAL;\r
\r
FUNCTION namemailbox(VAR m: mailbox; INSPECT mbx_name: string): integer;\r
EXTERNAL;\r
\r
FUNCTION ownname = own_name(VAR name:string): byte;\r
EXTERNAL;\r
\r
FUNCTION ownprogramname(VAR name:string): byte;\r
EXTERNAL;\r
\r
PROCEDURE ownversion(VAR myversion: tmoduleversion);\r
EXTERNAL;\r
\r
FUNCTION searchmailbox(INSPECT mbx_name: string): ^mailbox;\r
EXTERNAL;\r
\r
PROCEDURE sendtimer(VAR ref: reference );\r
EXTERNAL;\r
\r
PROCEDURE setownname(INSPECT name: string );\r
EXTERNAL;\r
\r
function swap(n: integer): integer;\r
begin 1\r
POP AX\r
XCHG AL,AH\r
END;\r
\r
(* implementation dependent open routines *)\r
\r
procedure breakpoint;\r
begin 4\r
INT 3\r
end;\r
\r
function data_segment(var r:rtype ): integer;\r
begin 0\r
%get_buf_seg\r
MOV AX,ES:datapart\r
end;\r
\r
procedure disable;\r
begin 0\r
CLI\r
end;\r
\r
procedure enable;\r
begin 0\r
STI\r
end;\r
\r
function equalhome(var a: rtype ; var b: rtype ): boolean;\r
begin 0\r
%GET_BUF_SEG\r
MOV AX,ES: WORD PTR HOME\r
MOV BX,ES: WORD PTR HOME+2\r
%GET_BUF_SEG\r
SUB AX,ES: WORD PTR HOME\r
JNE EQUALHOME_1\r
SUB BX,ES: WORD PTR HOME+2\r
JE EQUALHOME_2\r
EQUALHOME_1:\r
MOV AL,0FFH\r
EQUALHOME_2:\r
INC AL\r
END;\r
\r
function first(var r:rtype ): 0..maxint;\r
begin 0\r
%get_buf_seg\r
MOV AX,ES:dataoffset\r
end;\r
\r
function homeless(var r: rtype ): boolean; external;\r
\r
function input_byte(ioport: integer): byte;\r
begin 0\r
pop dx\r
in al,dx\r
end;\r
\r
function input_word(ioport: integer): integer;\r
begin 0\r
pop dx\r
in ax,dx\r
end;\r
\r
function last(var r:rtype ): -1..maxint-1;\r
begin 0\r
%get_buf_seg\r
MOV AX,ES:top\r
DEC AX\r
end;\r
\r
function next(var r: rtype ): 0..maxint;\r
begin 0\r
%get_buf_seg\r
MOV AX,ES: bytecount\r
ADD AX,ES: dataoffset\r
end;\r
\r
function mailbox_state(var m:mailbox): integer; and\r
function pool_state(var m:pool): integer;\r
begin 0\r
POP SI\r
POP ES\r
MOV AX,ES:[SI].s\r
end;\r
\r
procedure output_byte(ioport: integer; data: byte);\r
begin 0\r
pop ax\r
pop dx\r
out dx,al\r
end;\r
\r
procedure output_word(ioport: integer; data: integer);\r
begin 0\r
pop ax\r
pop dx\r
out dx,ax\r
end;\r
\r
function own_stack_bound: integer;\r
begin 0\r
mov ax, word ptr own.stackbound\r
end;\r
\r
function own_stack_size: integer;\r
begin 0\r
mov ax, word ptr own.stacksize\r
end;\r
\r
function ownpriority: byte;\r
begin 0\r
mov al, DS: byte ptr own.priority\r
end;\r
\r
function priority(var p: process): byte;\r
begin 0\r
pop di\r
pop es\r
mov ax, es: [di].procvar\r
cmp ax,0\r
jnz priority_1\r
%fault(F_NIL)\r
; mov al, f_nil\r
; int 31\r
priority_1:\r
mov es, ax\r
mov al, es: priority\r
end;\r
\r
function ref(var m: mailbox):^mailbox;\r
begin\r
POP BX\r
POP ES\r
end;\r
\r
function rest_of_delay: integer;\r
begin 0\r
mov ax, word ptr own.timer\r
end;\r
\r
procedure setfirst(var r: rtype ; v: 0..maxint);\r
begin 0\r
pop BX\r
%get_buf_seg\r
cmp BX,ES:datasize\r
jle setfir_1\r
%fault(F_RANGE)\r
; int 29 \r
setfir_1:\r
MOV CX,ES:dataoffset\r
SUB CX,BX\r
MOV ES:dataoffset,BX\r
ADD ES:bytecount,CX\r
CMP ES:depth,1\r
JBE setfir_2\r
MOV AX,ES:bufcount\r
MOV ES,ES:stack\r
CMP ES:bufcount,AX\r
JZ setfir_1\r
setfir_2:\r
end;\r
\r
procedure setlast(var r: rtype ; v: -1..maxint-1);\r
begin 0\r
pop BX\r
inc BX\r
%get_buf_seg\r
cmp BX,ES:datasize\r
jle setlas_1\r
%fault(F_RANGE)\r
; int 29 \r
setlas_1:\r
MOV ES:top,BX\r
CMP ES:depth,1\r
JBE setlas_2\r
MOV AX,ES:bufcount\r
MOV ES,ES:stack\r
CMP ES:bufcount,AX\r
JZ setlas_1\r
setlas_2:\r
end;\r
\r
procedure setnext(var r: rtype ; v: 0..maxint);\r
begin 0\r
pop BX\r
%get_buf_seg\r
setnex_1: \r
MOV CX,BX\r
SUB CX,ES:dataoffset\r
MOV ES:bytecount,CX\r
CMP ES:depth,1\r
JBE setnex_2\r
MOV AX,ES:bufcount\r
MOV ES,ES:stack\r
CMP ES:bufcount,AX\r
JZ setnex_1\r
setnex_2:\r
end;\r
\r
procedure setpriority(prio: integer);\r
begin 0\r
pop ax\r
cli \r
test DS: byte ptr own.p_state, 1\r
JNZ set_priority_1\r
mov DS: byte ptr own.priority, al\r
set_priority_1:\r
sti\r
end;\r
\r
function stack_bound(var p: process): integer;\r
begin 0\r
pop di\r
pop es\r
mov ax, es: [di].procvar\r
cmp ax,0\r
jnz stackbound_1\r
%fault(F_NIL)\r
; mov al, f_nil\r
; int 31\r
stackbound_1:\r
mov es, ax\r
mov al, es: priority\r
end;\r
\r
function stack_size(var p: process): integer;\r
begin 0\r
pop di\r
pop es\r
mov ax, es: [di].procvar\r
cmp ax,0\r
jnz stacksize_1\r
%fault(F_NIL)\r
; mov al, f_nil\r
; int 31\r
stacksize_1:\r
mov es, ax\r
mov ax, es: stacksize\r
end;\r
\r
\r
.\r