|
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: 35081 (0x8909)
Types: TextFile
Names: »SYS35022.S35«
└─⟦b6837b237⟧ Bits:30010500 SW2103 REL 1.11 Sourcer DVBS1.SW2103.rel.1.11-1 MASTER 31-1-192
└─⟦this⟧ »SYS35022\SYS35022.S35«
sys35022libenv;\r
\r
-- 870303 bb 3.2 check on positive indices and bytes params\r
-- removed from btofrom\r
-- 870305 bb 3.3 open routine for rtp86 top function\r
-- 871022 bb 3.4 eventkind changed to beventkind (eventkind is\r
-- now a closed routine\r
-- 871110 bb 3.5 the above change temporary removed\r
-- 871228 bb 3.6 balloc initializes u1 to u4, imcattributes to zero\r
-- and first, last and next to 6, bufsize-1 and 6.\r
-- 880304 bb 3.7 eventkind changed to beventkind\r
-- 880323 bb 3.8 seteventkind updates u2 to 6 to cooperate with eventkind.\r
-- 880329 bb 3.9 beventkind changed to eventkind again.\r
-- Update of u2 in seteventkind removed again.\r
-- 890123 bb 3.10 Bcrc16buf handed over by JKK.\r
-- 890913 bb 3.11 Setabsindex changed from byte save to word save.\r
-- 900324 bb 3.12 Signal and Return updates eventkind.\r
-- Signalx and Returnx introdused as the old routines\r
-- Signal and Return with no update of eventkind.\r
-- 900517 bb 3.13 Control0 to output controlword to device 0 for RC9330\r
-- lamp control.\r
\r
$version 3.13\r
\r
.\r
\r
prefix clearinterrupt;\r
procedure clearinterrupt;\r
beginbody 0:\r
iocci ; clear interrupt\r
endbody;\r
\r
\r
prefix ___exit___rc;\r
procedure ___exit___rc;\r
beginbody 2:\r
b. loop.\r
loop:\r
mhalt ; halt\r
jmprw loop ;\r
e.\r
endbody;\r
\r
\r
prefix increment_mod_64k;\r
procedure increment_mod_64k( var int : integer );\r
beginbody 4:\r
revpd ; load int\r
revsw 0\r
uadhw 1 ; increment\r
stvsw 0 ; restore\r
endbody;\r
\r
\r
prefix outbyteblock;\r
procedure outbyteblock\r
(var next : integer;\r
first, last : integer;\r
var msg : reference);\r
beginbody 0:\r
ioibx ; initblock_io\r
iowbbc ; write_block_of_bytes\r
stvsw 0 ; pop next\r
endbody;\r
\r
\r
prefix outwordblock;\r
procedure outwordblock\r
(var next : integer;\r
first, last : integer;\r
var msg : reference );\r
beginbody 0:\r
ioibx ; initblock_io\r
iowbwc ;write_block_of_words\r
stvsw 0 ; pop next\r
endbody;\r
\r
\r
prefix setinterrupt;\r
procedure setinterrupt( var ch : reference );\r
beginbody 0:\r
iocda ; get device addr\r
cslev ; set interrupt\r
endbody;\r
\r
\r
prefix _bufsize__rc;\r
function _bufsize__rc (var r: reference): integer;\r
beginbody 0:\r
revsa 1\r
revsw msize \r
endbody;\r
\r
\r
\r
prefix _first____rc;\r
function _first____rc (var r: reference): integer;\r
beginbody 0:\r
revsa 1\r
revsd mstart\r
revsw mfirst\r
endbody;\r
\r
\r
prefix _last_____rc;\r
function _last_____rc (var r: reference): integer;\r
beginbody 0:\r
revsa 1\r
revsd mstart\r
revsw mlast\r
endbody;\r
\r
\r
prefix get_heap;\r
function get_heap (var inc : incarnation_descriptor) : ^ niltype;\r
beginbody 0:\r
revsa heap;\r
endbody;\r
\r
\r
prefix set_heap;\r
procedure set_heap (p : ^ niltype);\r
beginbody 0:\r
stvga heap\r
endbody;\r
\r
\r
\r
prefix abs;\r
function abs(x : niltype) : niltype;\r
beginbody 0:\r
abs ;\r
endbody;\r
\r
\r
prefix absindex;\r
function absindex(var r : reference): integer;\r
beginbody 2:\r
revsa 1\r
revsw connix\r
endbody;\r
\r
\r
prefix addptr;\r
function addptr (p : ^ niltype; inc : integer) : ^ niltype;\r
beginbody 0:\r
madd\r
endbody;\r
\r
\r
prefix addrptr;\r
function addrptr(p : ^niltype) : addr;\r
beginbody 0:\r
stvsd 0\r
endbody;\r
\r
\r
prefix balloc;\r
procedure balloc;\r
beginbody 8:\r
b. d#, l#, firstparam.\r
firstparam = lastparam - 11 ; \r
d#1 = firstparam + 1; ^ r\r
d#2 = d#1 + 4 ; ^ p\r
d#3 = d#2 + 4 ; ^ sem\r
\r
revla d#1 ; push ^ r\r
revla d#2 ; push ^ p\r
cwait ; wait\r
revla d#1 ; push ^ r\r
revsa 1 ; push r\r
revla d#3 ; push ^ sem\r
revsd 0 ; dummy retrieve to force exception if nil\r
stnhb 4 ; pop dummy contents of semaphore\r
resta 4 ; ^ message_header\r
revpd ; init user fields\r
rechw 0 ;\r
revpw ;\r
stvsd u1 ; u1,u2,u3,u4 := 0\r
revpd ; init imc fields\r
rechw 0 ;\r
revpw ;\r
stvsd connix ; conix, credit, reason, event := 0\r
revpd ; test buffer start is not nil\r
reasd mstart+1 ;\r
tnill ;\r
jmzne l#0 ; if not nil\r
revpd ;\r
revsd mstart ; \r
revpd ; init first\r
rechw 6 ;\r
stvsw mfirst ;\r
revpd ; init next\r
rechw 6 ;\r
stvsw mnext ;\r
revla d#1 ; init last\r
revsa 1 ;\r
revsw msize ;\r
rechw 2 ;\r
mmul ;\r
rechw 1 ;\r
msub ;\r
stvsw mlast ; bufsize*2 - 1\r
l#0:\r
revla d#3 ; get ^ sem once again\r
stvsa answer ;\r
e.\r
endbody;\r
\r
\r
prefix asgnaddrref;\r
procedure asgnaddrref(var a:addr; var r: reference);\r
beginbody 0:\r
revsd 0\r
stvsd 0\r
endbody;\r
\r
\r
prefix asgnrefaddr;\r
procedure asgnrefaddr(var ref: reference; a: addr);\r
beginbody 0:\r
stvsd 0\r
endbody;\r
\r
\r
prefix baseinteger;\r
function baseinteger (i : integer) : addr;\r
beginbody 2:\r
rechw 128\r
or\r
rechw 254\r
and\r
rechw 0\r
stvsd 0\r
endbody;\r
\r
\r
prefix bufsize;\r
function bufsize (var r: reference): integer;\r
beginbody 0:\r
revsa 1\r
revsw msize \r
rechw 2\r
umul\r
endbody;\r
\r
\r
prefix bufstart;\r
function bufstart (var r : reference) : ^ niltype;\r
beginbody 0:\r
revsa 1\r
revsd mstart\r
endbody;\r
\r
\r
prefix byteclear;\r
procedure byteclear (var b : byte; i : integer);\r
beginbody 0:\r
ionci\r
stvsb 0\r
endbody;\r
\r
\r
prefix carry;\r
function carry : boolean;\r
beginbody 2:\r
mbtes 4 ; carry bit\r
rechw 0 \r
mbset 4 ; clear carry bit\r
endbody;\r
\r
\r
prefix bcheck;\r
procedure bcheck;\r
beginbody 4:\r
b. wappetite, ifelse.\r
wappetite = lastparam - 1;\r
; appetite in words in wappetite\r
; *** minimum 1 + 8 + 2 = 11 words are checked ***\r
\r
revlw wappetite ; +2 2 get actual param\r
revpw ; +2 4 \r
uadd ; -2 2 bappetite := 2*wappetite \r
; note: bappetite left on top of stack\r
rechw 10 ; +2 4 actual and anonymous param length\r
sub ; -2 2 bappetite := bappetite - delta\r
revpw ; +2 4 if bappetite > 0 then\r
jmzle ifelse ; -2 2\r
renpb ; check stack\r
ifelse:\r
stnhb 2 ;\r
e.\r
endbody;\r
\r
\r
prefix checkeval;\r
procedure checkeval;\r
beginbody 0:\r
renhb appeval ; check room for evaluation stack in this block\r
stnhb appeval ; repair\r
endbody;\r
\r
\r
prefix control;\r
procedure control(control_word : integer; var ch_msg : reference);\r
beginbody 0:\r
iocda ; get device address\r
iowc ; write control\r
endbody;\r
\r
\r
prefix control0;\r
procedure control0 (control_word : integer);\r
beginbody 2:\r
rechw 0 ; get device address\r
iowc ; write control\r
endbody;\r
\r
\r
prefix controlclr;\r
procedure controlclr(control_word : integer );\r
beginbody 0:\r
revgb level ; get device address\r
ionci ; next clear interrupt\r
iowc ; write control\r
endbody;\r
\r
\r
prefix crc16;\r
function crc16 ( a,b : integer ) : integer;\r
beginbody 0:\r
crc16\r
endbody;\r
\r
\r
prefix bcrc16buffer;\r
function bcrc16buffer( frombyte, tobyte: integer; var r: reference ): integer;\r
(*\r
function crc16buffer( var r: reference; frombyte, tobyte: integer; \r
quotient, startvalue: integer ): integer;\r
var\r
count: integer;\r
dummy: byte;\r
start: ^dummy;\r
*)\r
beginbody 8:\r
b. quotient, startvalue, firstparam.\r
b. start, startdisp, count, carry.\r
b. ent16, loop16, start4, loop4, start1, loop1, endcrc.\r
\r
firstparam = lastparam - 13\r
quotient = firstparam + 10\r
startvalue = firstparam + 12\r
\r
carry = 4\r
count = 8\r
start = 10\r
startdisp = 12\r
\r
ioibx ; check buffer and calculate startaddress\r
stvld start ; save startaddress\r
stvlw count ; save count\r
stnhb 2 ; remove top\r
\r
revlw startvalue ; calculated crc is stored on stack\r
jmprw ent16 ; jump to entry point\r
\r
loop16: ; repeat \r
stvlw count ; save count\r
\r
revld start ; get address of next byte\r
revsb 0 ; get byte\r
xor ;\r
revlw quotient ; get quotient\r
crc16 ; calculate crc\r
\r
revld start ; and the same for byte 1\r
revsb 1 ;\r
xor ;\r
revlw quotient ;\r
crc16 ;\r
\r
revld start ; and the same for byte 2\r
revsb 2 ;\r
xor ;\r
revlw quotient ;\r
crc16 ;\r
\r
revld start ; and the same for byte 3\r
revsb 3 ;\r
xor ;\r
revlw quotient ;\r
crc16 ;\r
\r
revld start ; and the same for byte 4\r
revsb 4 ;\r
xor ;\r
revlw quotient ;\r
crc16 ;\r
\r
revld start ; and the same for byte 5\r
revsb 5 ;\r
xor ;\r
revlw quotient ;\r
crc16 ;\r
\r
revld start ; and the same for byte 6\r
revsb 6 ;\r
xor ;\r
revlw quotient ;\r
crc16 ;\r
\r
revld start ; and the same for byte 7\r
revsb 7 ;\r
xor ;\r
revlw quotient ;\r
crc16 ;\r
\r
revld start ; and the same for byte 8\r
revsb 8 ;\r
xor ;\r
revlw quotient ;\r
crc16 ;\r
\r
revld start ; and the same for byte 9\r
revsb 9 ;\r
xor ;\r
revlw quotient ;\r
crc16 ;\r
\r
revld start ; and the same for byte 10\r
revsb 10 ;\r
xor ;\r
revlw quotient ;\r
crc16 ;\r
\r
revld start ; and the same for byte 11\r
revsb 11 ;\r
xor ;\r
revlw quotient ;\r
crc16 ;\r
\r
revld start ; and the same for byte 12\r
revsb 12 ;\r
xor ;\r
revlw quotient ;\r
crc16 ;\r
\r
revld start ; and the same for byte 13\r
revsb 13 ;\r
xor ;\r
revlw quotient ;\r
crc16 ;\r
\r
revld start ; and the same for byte 14\r
revsb 14 ;\r
xor ;\r
revlw quotient ;\r
crc16 ;\r
\r
revld start ; and the same for byte 15\r
revsb 15 ;\r
xor ;\r
revlw quotient ;\r
crc16 ;\r
\r
revlw startdisp ; increase displacement of start with 16\r
uadhw 16 ; \r
stvlw startdisp ;\r
\r
ent16:\r
revlw count ; decrease count\r
rechw -16 ;\r
madd\r
mbtes carry ; until count < 0\r
jmzgt loop16 ;\r
\r
start4: ; try with 4 bytes part\r
uadhw 12 ; adjust count with 16 - 4\r
revpw\r
jmzlt start1 ; if count >= 0\r
\r
loop4: ; repeat\r
stvlw count ; save count\r
\r
revld start ; get address of next byte\r
revsb 0 ; get byte\r
xor ;\r
revlw quotient ; get quotient\r
crc16 ; calculate crc\r
\r
revld start ; and the same for byte 1\r
revsb 1 ;\r
xor ;\r
revlw quotient ;\r
crc16 ;\r
\r
revld start ; and the same for byte 2\r
revsb 2 ;\r
xor ;\r
revlw quotient ;\r
crc16 ;\r
\r
revld start ; and the same for byte 3\r
revsb 3 ;\r
xor ;\r
revlw quotient ;\r
crc16 ;\r
\r
revlw startdisp ; increase displacement of startaddress with 4\r
uadhw 4 ; \r
stvlw startdisp ;\r
\r
revlw count ; decrease count\r
uadhw -4 ;\r
\r
revpw ; until count < 0\r
jmzge loop4 ;\r
\r
start1: ; try with 1 bytes part\r
uadhw 3 ; adjust count with 4 - 1\r
revpw\r
jmzlt endcrc ; if count >= 0\r
\r
loop1: ; repeat\r
stvlw count ; save count\r
\r
revld start ; get address of next byte\r
revsb 0 ; get byte\r
xor ;\r
revlw quotient ; get quotient\r
crc16 ; calculate crc\r
\r
revlw startdisp ; increase displacement of startaddress with 1\r
uadhw 1 ; \r
stvlw startdisp ;\r
\r
revlw count ; decrease count\r
uadhw -1 ;\r
\r
revpw ; until count < 0\r
jmzge loop1 ;\r
\r
endcrc:\r
stvlw count ; remove count from stack\r
e.\r
e.\r
e.\r
endbody;\r
\r
\r
prefix creditcount;\r
function creditcount(var r : reference): 0..maxint;\r
beginbody 0:\r
revsa 1\r
revsb credit\r
endbody;\r
\r
\r
prefix ctrwaitid;\r
function ctrwaitid (c: integer; delay : integer): activation;\r
beginbody 0:\r
stvgw timer ; own.timer := delay\r
mcit\r
endbody;\r
\r
\r
prefix ctrwaitis;\r
function ctrwaitis (c: integer; var r: reference; var s: semaphore): activation;\r
beginbody 0:\r
mcis\r
endbody;\r
\r
\r
prefix ctrwaitisd;\r
function ctrwaitisd (c: integer; var r: reference; var s: semaphore; delay: integer): activation;\r
beginbody 0:\r
stvgw timer ; own.timer := delay\r
mcist\r
endbody;\r
\r
\r
prefix ctrwaitist;\r
function ctrwaitist (c: integer; var r: reference; var s: semaphore): activation;\r
beginbody 0:\r
mcist\r
endbody;\r
\r
\r
prefix ctrwaitit;\r
function ctrwaitit (c: integer): activation;\r
beginbody 0:\r
mcit\r
endbody;\r
\r
\r
prefix dump_hwstack;\r
procedure dump_hwstack (regset : integer);\r
beginbody 0:\r
mstst\r
endbody;\r
\r
\r
prefix eoi;\r
function eoi : boolean;\r
beginbody 2:\r
b. f#.\r
mbtes 2 ; push eoi\r
e.\r
endbody;\r
\r
\r
prefix beventkind;\r
function beventkind(var r : reference): event_type;\r
beginbody 0:\r
revsa 1\r
revsb eventkind\r
endbody;\r
\r
\r
prefix eventkind;\r
function eventkind(var r : reference): event_type;\r
beginbody 0:\r
revsa 1\r
revsb eventkind\r
endbody;\r
\r
\r
prefix excptcall;\r
procedure excptcall (excode : integer);\r
beginbody 0:\r
mtrs ; trap stack\r
endbody;\r
\r
\r
prefix first;\r
function first(var r: reference): integer;\r
beginbody 0:\r
revsa 1\r
revsd mstart\r
revsw mfirst\r
endbody;\r
\r
\r
prefix getaddr;\r
procedure getaddr(var dest : addr; source : addr);\r
beginbody 0:\r
revsd 0\r
stvsd 0\r
endbody;\r
\r
\r
prefix getbasereg;\r
procedure getbasereg (var b : byte; index : integer);\r
beginbody 0:\r
crget ; getregister\r
stvsb 0 ; pop result\r
endbody;\r
\r
\r
prefix getbufparam;\r
procedure getbufparam\r
(var i : record\r
saddr : addr;\r
count,top : integer\r
end;\r
first,last : integer;\r
var msg : reference);\r
beginbody 2:\r
ioibx\r
rechw 8 ; push length to setst\r
resta 0 ; dump hw stack\r
setst\r
endbody;\r
\r
\r
prefix getbyte;\r
procedure getbyte (var result: byte; pointer: addr);\r
beginbody 0:\r
revsb 0\r
stvsb 0\r
endbody;\r
\r
\r
prefix getid;\r
function getid : integer;\r
beginbody 2:\r
rechw 0; read from device 0\r
iorw ;\r
endbody;\r
\r
\r
prefix getinteger;\r
procedure getinteger(var result : integer; pointer : addr);\r
beginbody 0:\r
revsw 0 ; push operand\r
stvsw 0 ; pop result\r
endbody;\r
\r
\r
prefix getlfgf;\r
procedure getlfgf (var lf, gf: addr);\r
beginbody 4:\r
reagd 0\r
stvsd 0 ; get global frame ( even disp )\r
reald 0\r
stvsd 0 ; get local frame\r
endbody;\r
\r
\r
prefix getregister;\r
procedure getregister (var result : integer; index : integer);\r
beginbody 0:\r
crget ; getregister\r
stvsw 0 ; pop result\r
endbody;\r
\r
\r
prefix inbyteblock;\r
procedure inbyteblock\r
(var next : integer;\r
first, last : integer;\r
var msg : reference );\r
beginbody 0:\r
ioibx ; initblock_io\r
iorbb ; rbb\r
stvsw 0 ; pop next\r
endbody;\r
\r
\r
prefix index;\r
function index (var r : reference): 0..maxint;\r
beginbody 0:\r
revsa 1\r
revsb connix\r
endbody;\r
\r
\r
prefix initref;\r
procedure initref (var r : reference;\r
var msg_header : message_header);\r
beginbody 0:\r
stvsd 0 ;\r
endbody;\r
\r
\r
prefix integerclear;\r
procedure integerclear (var i : integer; j : integer);\r
beginbody 0:\r
ionci\r
stvsw 0\r
endbody;\r
\r
\r
prefix intel;\r
function intel(i : integer) : record\r
low,high : byte\r
end;\r
beginbody 0:\r
shc8\r
stvsw 0\r
endbody;\r
\r
\r
prefix inwaitqueue;\r
procedure inwaitqueue (mregset : integer);\r
beginbody 0:\r
cinwq\r
endbody;\r
\r
\r
prefix inword;\r
procedure inword(var word : integer; var ch_msg : reference);\r
beginbody 0:\r
iocda ; get device address\r
iorw ; readword\r
stvsw 0 ; pop word\r
endbody;\r
\r
\r
prefix inwordblock;\r
procedure inwordblock\r
(var next : integer;\r
first, last : integer;\r
var msg : reference );\r
beginbody 0:\r
ioibx ; initblock_io\r
iorbw ; read_block_of_words\r
stvsw 0 ; pop next\r
endbody;\r
\r
\r
prefix inwordclr;\r
procedure inwordclr (var word : integer);\r
beginbody 2:\r
revgb level ; get device address\r
ionci ; next clear interrupt\r
iorw ; read word\r
stvsw 0 ; store word\r
endbody;\r
\r
\r
prefix iogi;\r
procedure iogi (var res : integer; data,func : integer; var r : reference);\r
beginbody 0:\r
iocda\r
iogi\r
stvsw 0\r
endbody;\r
\r
\r
prefix iogo;\r
procedure iogo (data, func : integer; var r : reference);\r
beginbody 0:\r
iocda\r
iogo\r
endbody;\r
\r
\r
prefix iowbwc;\r
procedure iowbwc (bufparam : record \r
top, count : integer;\r
datastart : addr;\r
end );\r
beginbody 0:\r
iowbwc\r
stnhb 2\r
endbody;\r
\r
\r
prefix jumpto;\r
procedure jumpto(address : addr);\r
beginbody 0:\r
stvga exic\r
jmpga exic\r
endbody;\r
\r
\r
prefix lambda;\r
function lambda( ii : record low,high : byte end ) : integer;\r
beginbody 0:\r
shc8\r
endbody;\r
\r
\r
prefix last;\r
function last (var r: reference): integer;\r
beginbody 0:\r
revsa 1\r
revsd mstart\r
revsw mlast\r
endbody;\r
\r
\r
prefix linkmessage;\r
procedure linkmessage (var r : reference);\r
beginbody 8:\r
revsa 1\r
revpd\r
revga msgchain\r
stvsa mmsgchain\r
stvga msgchain\r
endbody;\r
\r
\r
prefix load_hwstack;\r
procedure load_hwstack ( regset : integer );\r
beginbody 0:\r
mrest\r
endbody;\r
\r
\r
prefix locked;\r
function locked (var sem : semaphore) : boolean;\r
beginbody 0:\r
tlock ;test locked\r
endbody;\r
\r
\r
prefix locktest;\r
function locktest (var r : reference) : boolean;\r
beginbody 0:\r
revsb 0 ; get count byte\r
rechw 0 ;\r
gt ; true if count > 0\r
endbody;\r
\r
\r
prefix madd;\r
function madd (a,b : integer) : integer;\r
beginbody 0:\r
madd\r
endbody;\r
\r
\r
prefix mmul;\r
function mmul (a,b : integer) : integer;\r
beginbody 0:\r
mmul\r
endbody;\r
\r
\r
prefix moveb;\r
procedure moveb( count : integer; var frombyte : byte; fromindex : integer;\r
var tobyte : byte; toindex : integer);\r
(* move 'count' bytes starting at 'frombyte(fromindex)' to\r
'tobyte(toindex)'. nb nb nb no check at all !!!!!!!!!! *)\r
(* 81 03 03 jaba *)\r
(* corrected uadd to madd 81 10 15 bbl *)\r
beginbody 6 :\r
madd ; index\r
reaxd ; get top - the hw stack is dumped \r
reasd -9 ; addr of frombyte\r
rechw 6 ; prepare move\r
revsm ; push frombyte and fromindex\r
resta 4 ;\r
madd ; index\r
reaxd ; get top\r
revsw -15; count\r
resta 10 ;\r
moveb ; move in bytemode\r
stnhb 8 ; unstack \r
endbody;\r
\r
\r
prefix move_bytes;\r
procedure move_bytes (dest,source : ^ niltype; bytes : integer);\r
beginbody 0:\r
moveg\r
endbody;\r
\r
\r
prefix moveg;\r
procedure moveg( count : integer; var frombyte : byte; fromindex : integer;\r
var tobyte : byte; toindex : integer);\r
(* move 'count' bytes starting at 'frombyte(fromindex)' to\r
'tobyte(toindex)'. nb nb nb no check at all !!!!!!!!!! *)\r
(* 81 03 03 jaba *)\r
(* corrected uadd to madd 81 10 15 bbl *)\r
beginbody 6 :\r
madd ; index\r
reaxd ; get top - the hw stack is also dumped\r
reasd -9 ; addr of frombyte\r
rechw 6 ; prepare move\r
revsm ; push frombyte and fromindex\r
resta 4 ;\r
madd ; index\r
reaxd ; get top\r
revsw -15; count\r
resta 10 ;\r
moveg ; move mainly in wordmode\r
stnhb 8 ; unstack \r
endbody;\r
\r
\r
prefix msub;\r
function msub (a,b : integer) : integer;\r
beginbody 0:\r
msub\r
endbody;\r
\r
\r
prefix mtime;\r
procedure mtime (var p : incarnation_descriptor);\r
beginbody 0:\r
mtime\r
endbody;\r
\r
\r
prefix next;\r
function next (var r: reference): integer;\r
beginbody 0:\r
revsa 1\r
revsd mstart\r
revsw mnext\r
endbody;\r
\r
\r
prefix nextrefp;\r
procedure nextrefp (var refp : ^ reference);\r
beginbody 4:\r
revpd ; double tos\r
revsa 0 ; push refp\r
revsa 4 ; push refp^.next\r
stvsa 0 ;\r
endbody;\r
\r
\r
prefix open;\r
function open (var sem : semaphore) : boolean;\r
beginbody 0:\r
topen ;test opened\r
endbody;\r
\r
\r
prefix openpool;\r
function openpool (var p: pool 1): boolean;\r
beginbody 0:\r
topen ;test opened\r
endbody;\r
\r
\r
prefix outword;\r
procedure outword (word : integer; var ch_msg : reference);\r
beginbody 0:\r
iocda ; get device address\r
ioww ; write word\r
endbody;\r
\r
\r
prefix outwordclr;\r
procedure outwordclr (word : integer);\r
beginbody 2:\r
revgb level ; get device address\r
ionci ; next clear interrupt\r
ioww ; write word\r
endbody;\r
\r
\r
prefix ownertest;\r
function ownertest (var p : pool 1; var r : reference) : boolean;\r
beginbody 0:\r
revsa 1\r
revsa owner\r
teqad\r
endbody;\r
\r
\r
prefix passive;\r
function passive (var sem : semaphore) : boolean;\r
beginbody 0:\r
uadhw 1 ; adjust address to base byte\r
tnill ;test nill\r
endbody;\r
\r
\r
prefix pexit3;\r
procedure pexit3;\r
beginbody 0:\r
pexit 3\r
endbody;\r
\r
\r
prefix pop;\r
procedure pop (var r1, r2 : reference);\r
beginbody 0:\r
lpop\r
endbody;\r
\r
\r
prefix ptr;\r
function ptr (var i : integer) : ^ niltype;\r
beginbody 0:\r
endbody;\r
\r
\r
prefix ptr;\r
function ptr (var b : byte) : ^ niltype;\r
beginbody 0:\r
endbody;\r
\r
\r
prefix ptr;\r
function ptr (var p : ^ niltype) : ^ niltype;\r
beginbody 0:\r
endbody;\r
\r
\r
prefix ptr;\r
function ptr (var a : addr) : ^ niltype;\r
beginbody 0:\r
endbody;\r
\r
\r
prefix ptraddr;\r
function ptraddr (a : addr) : ^niltype;\r
beginbody 0:\r
endbody;\r
\r
\r
prefix push;\r
procedure push (var r1, r2 : reference);\r
beginbody 0:\r
lpush\r
endbody;\r
\r
\r
prefix putaddr;\r
procedure putaddr (dest,source : addr);\r
beginbody 0:\r
stvsd 0 ;\r
endbody;\r
\r
\r
prefix readbyte;\r
procedure readbyte (var destination, source : byte);\r
beginbody 0:\r
readb ; revsb without parity check\r
stvsb 0 ; store result\r
endbody;\r
\r
\r
prefix readram;\r
procedure readram (var result : byte; index : integer);\r
beginbody 0:\r
crram ; read_controleprocessor_ram\r
stvsb 0 ; pop byte\r
endbody;\r
\r
\r
prefix readword;\r
procedure readword (var destination, source : integer);\r
beginbody 0:\r
readw ; revsw without parity check\r
stvsw 0 ; store result\r
endbody;\r
\r
\r
prefix reason;\r
function reason (var r : reference): reason_type;\r
beginbody 0:\r
revsa 1\r
revsb reason\r
endbody;\r
\r
\r
prefix rechain;\r
function rechain (regset : integer) : integer;\r
beginbody 0:\r
mrecha\r
endbody;\r
\r
\r
prefix ref;\r
function ref (var sem : semaphore) : ^ niltype;\r
beginbody 0:\r
endbody;\r
\r
\r
prefix refpool;\r
function refpool (var p : pool 1) : ^ niltype;\r
beginbody 0:\r
endbody;\r
\r
\r
prefix refshadow;\r
function refshadow (var sh : shadow) : ^ niltype;\r
beginbody 0:\r
endbody;\r
\r
\r
prefix release;\r
procedure release (var r : reference);\r
beginbody 0:\r
crele owner ;\r
endbody;\r
\r
\r
prefix resetevent;\r
procedure resetevent (var r : reference);\r
beginbody 2:\r
revsa 1\r
rechw 0\r
stvsb eventkind\r
endbody;\r
\r
\r
prefix return;\r
procedure return (var r : reference);\r
beginbody 6:\r
revpd ; double stacktop\r
revsa 1 ; push address of message header\r
rechw 2 ; answer event\r
stvsb eventkind ;\r
crele answer ;\r
endbody;\r
\r
\r
prefix returnx;\r
procedure returnx (var r : reference);\r
beginbody 0:\r
crele answer ;\r
endbody;\r
\r
\r
prefix rotate;\r
function rotate (a,b : integer) : integer;\r
beginbody 0:\r
shc\r
endbody;\r
\r
\r
prefix selectlevel;\r
procedure selectlevel (level : integer);\r
beginbody 0:\r
csell ; select level\r
endbody;\r
\r
\r
prefix sense;\r
procedure sense\r
(var status_in : integer;\r
status_out : integer;\r
var ch_msg : reference);\r
beginbody 0:\r
iocda ; get device address\r
iors ; read status\r
stvsw 0 ; pop result\r
endbody;\r
\r
\r
prefix senseclr;\r
procedure senseclr (var status_in : integer; status_out,comp,mask : integer);\r
beginbody 0:\r
iorsc\r
stvsw 0\r
endbody;\r
\r
\r
prefix sensesem;\r
procedure sensesem (var r : reference; var sem : semaphore);\r
beginbody 0:\r
csens\r
endbody;\r
\r
\r
prefix setabsindex;\r
procedure setabsindex (var r : reference; index : integer);\r
beginbody 2:\r
rechw 1;\r
stvgb exopcode;\r
stvgw excode\r
revsa 1\r
revgw excode\r
stvsw connix\r
rechw 0;\r
stvgb exopcode\r
endbody;\r
\r
\r
prefix setbasereg;\r
procedure setbasereg (r : byte; index : integer);\r
beginbody 0:\r
crput\r
endbody;\r
\r
\r
prefix setcreditcount;\r
procedure setcreditcount (var r : reference; credit : byte);\r
beginbody 2:\r
rechw 1;\r
stvgb exopcode;\r
stvgb excode\r
revsa 1\r
revgb excode\r
stvsb credit\r
rechw 0;\r
stvgb exopcode\r
endbody;\r
\r
\r
prefix seteventkind;\r
procedure seteventkind (var r : reference; event : event_type);\r
beginbody 6:\r
rechw 1;\r
stvgb exopcode;\r
stvgb excode; save actual event value\r
revsa 1\r
; revpd\r
; revpd\r
; revsb u2\r
; rechw 248\r
; and\r
; rechw 6\r
; or\r
; stvsb u2\r
revgb excode\r
stvsb eventkind\r
rechw 0;\r
stvgb exopcode\r
endbody;\r
\r
\r
prefix setexcept;\r
procedure setexcept;\r
beginbody 4:\r
b. expnt.\r
reaad expnt ; gf.exception-routine := just after here\r
stvga expoint\r
pexit 1\r
expnt:\r
e.\r
endbody;\r
\r
\r
prefix bsetfirst;\r
procedure bsetfirst;\r
(* var r: reference; first: integer *)\r
beginbody 6:\r
revla -5\r
revsa 1\r
revsd mstart\r
revlw -2\r
stvsw mfirst\r
endbody;\r
\r
\r
prefix setindex;\r
procedure setindex (var r : reference; index : byte);\r
beginbody 2:\r
rechw 1;\r
stvgb exopcode;\r
stvgb excode\r
revsa 1\r
revgb excode\r
stvsb connix\r
rechw 0;\r
stvgb exopcode\r
endbody;\r
\r
\r
prefix bsetlast;\r
procedure bsetlast;\r
(* var r: reference; last: integer *)\r
beginbody 6:\r
revla -5\r
revsa 1\r
revsd mstart\r
revlw -2\r
stvsw mlast\r
endbody;\r
\r
\r
prefix bsetnext;\r
procedure bsetnext;\r
(* var r: reference; next: integer *)\r
beginbody 6:\r
revla -5\r
revsa 1\r
revsd mstart\r
revlw -2\r
stvsw mnext\r
endbody;\r
\r
\r
prefix setreason;\r
procedure setreason (var r : reference; reason : reason_type);\r
beginbody 2:\r
rechw 1;\r
stvgb exopcode;\r
stvgb excode\r
revsa 1\r
revgb excode\r
stvsb reason\r
rechw 0;\r
stvgb exopcode\r
endbody;\r
\r
\r
prefix setregister;\r
procedure setregister (walue,index : integer);\r
beginbody 0:\r
crput ; putregister\r
endbody;\r
\r
\r
prefix bsetu1; \r
procedure bsetu1;\r
(* var r: reference; val: byte *)\r
beginbody 6:\r
revla -5\r
revsa 1\r
revlb -1\r
stvsb u1\r
endbody;\r
\r
\r
prefix bsetu2; \r
procedure bsetu2;\r
(* var r: reference; val: byte *)\r
beginbody 6:\r
revla -5\r
revsa 1\r
revlb -1\r
stvsb u2\r
endbody;\r
\r
\r
prefix bsetu3; \r
procedure bsetu3;\r
(* var r: reference; val: byte *)\r
beginbody 6:\r
revla -5\r
revsa 1\r
revlb -1\r
stvsb u3\r
endbody;\r
\r
\r
prefix bsetu4; \r
procedure bsetu4;\r
(* var r: reference; val: byte *)\r
beginbody 6:\r
revla -5\r
revsa 1\r
revlb -1\r
stvsb u4\r
endbody;\r
\r
\r
prefix signal;\r
procedure signal (var r : reference; var mbx : semaphore);\r
beginbody 6:\r
reaxd ; push LU\r
revsa -6 ; address of r\r
revsa 1 ; ^ message header\r
rechw 1 ; message event\r
stvsb eventkind ;\r
resta 8 ;\r
csign ; signal;\r
endbody;\r
\r
\r
prefix signalx;\r
procedure signal (var r : reference; var mbx : semaphore);\r
beginbody 0:\r
csign\r
endbody;\r
\r
\r
prefix start;\r
procedure start (regset, level : integer);\r
beginbody 0:\r
cstart;\r
endbody;\r
\r
\r
prefix stcea;\r
function stcea\r
(count : integer;\r
var frombyte : byte; fromindex : integer;\r
var tobyte : byte; toindex : integer) : integer;\r
(* compares 'count' bytes starting at 'frombyte(fromindex)' with *)\r
(* 'count' bytes starting at 'tobyte(toindex)'. *)\r
beginbody 6 :\r
madd ; index\r
reaxd ; get top - the hw stack is dumped \r
reasd -9 ; addr of frombyte\r
rechw 6 ; prepare move\r
revsm ; push frombyte and fromindex\r
resta 4 ;\r
madd ; index\r
reaxd ; get top\r
revsw -15; count\r
resta 10 ;\r
stcea ;\r
reaxd ; get top - the hw stack is dumped\r
revpd ; one more\r
revsw -1 ; get result\r
stvsw -9 ; put result in the count parameter\r
stnhb 8 ; pop parameters\r
resta 2 ; result in hw stack\r
endbody;\r
\r
\r
prefix stop;\r
function stop (var inc : incarnation_descriptor) : integer;\r
beginbody 0:\r
cstop\r
endbody;\r
\r
\r
prefix stvsb0;\r
procedure stvsb0 (var d,s: byte);\r
beginbody 0:\r
revsb 0\r
stvsb 0\r
endbody;\r
\r
\r
prefix stvsd0;\r
procedure stvsd0 (var a : addr; b : ^ niltype);\r
beginbody 0:\r
stvsd 0\r
endbody;\r
\r
\r
prefix stvsd0;\r
procedure stvsd0 (var a : ^ niltype; b : addr);\r
beginbody 0:\r
stvsd 0\r
endbody;\r
\r
\r
prefix stvsw0;\r
procedure stvsw0 (var a : integer; b : integer);\r
beginbody 0:\r
stvsw 0\r
endbody;\r
\r
\r
prefix swap;\r
function swap (i : integer) : integer;\r
beginbody 0:\r
shc8\r
endbody;\r
\r
\r
prefix timedout;\r
function timedout : boolean;\r
beginbody 2:\r
rechw 0\r
stvgw timer; own.timer := 0;\r
mbtes 1 ; timeout bit\r
rechw 0 \r
mbset 1 ; clear time out bit\r
endbody;\r
\r
\r
prefix btofrom;\r
procedure btofrom;\r
(* var to_ref : reference; to_index : integer;\r
var from_ref : reference; from_index : integer;\r
bytes : integer;\r
*)\r
beginbody 10:\r
revla -13\r
revlw -10\r
revlw -2\r
uadd \r
uadhw 1; \r
rechw 2\r
udiv \r
llock 8\r
revpd \r
lrese \r
resta 0\r
revla -7\r
revlw -4\r
revlw -2\r
uadd \r
uadhw 1; \r
rechw 2\r
udiv \r
llock 11\r
revpd \r
lrese \r
resta 0\r
revla 8\r
revlw -10\r
uadd \r
revla 11\r
revlw -4\r
uadd \r
revlw -2\r
moveg \r
resta 4\r
lrele ; \r
resta 4\r
lrele ; \r
endbody;\r
\r
\r
prefix top;\r
function top (var r : reference) : integer;\r
beginbody 0:\r
revsa 1 ;\r
revsd mstart;\r
revsw mlast ;\r
uadhw 1 ;\r
endbody;\r
\r
\r
prefix uadd;\r
function uadd (a, b : integer) : integer;\r
beginbody 0:\r
uadd\r
endbody;\r
\r
\r
prefix udiv;\r
function udiv (a,b : integer) : integer;\r
beginbody 0:\r
udiv \r
endbody;\r
\r
\r
prefix ult;\r
function ult (i,j : integer): boolean;\r
beginbody 0:\r
ult; unsigned less-than\r
endbody;\r
\r
\r
prefix umod;\r
function umod (a,b : integer) : integer;\r
beginbody 0:\r
umod\r
endbody;\r
\r
\r
prefix umul;\r
function umul (a,b : integer) : integer;\r
beginbody 0:\r
umul\r
endbody;\r
\r
\r
prefix usub;\r
function usub (a, b : integer) : integer;\r
beginbody 0:\r
usub\r
endbody;\r
\r
\r
prefix u1;\r
function u1 (var r: reference): byte;\r
beginbody 0:\r
revsa 1\r
revsb u1\r
endbody;\r
\r
\r
prefix u2;\r
function u2 (var r: reference): byte;\r
beginbody 0:\r
revsa 1\r
revsb u2\r
endbody;\r
\r
\r
prefix u3;\r
function u3 (var r: reference): byte;\r
beginbody 0:\r
revsa 1\r
revsb u3\r
endbody;\r
\r
\r
prefix u4;\r
function u4 (var r: reference): byte;\r
beginbody 0:\r
revsa 1\r
revsb u4\r
endbody;\r
\r
\r
prefix wait;\r
procedure wait(var r : reference; var sem : semaphore);\r
beginbody 0:\r
cwait ; wait\r
endbody;\r
\r
\r
prefix waitd;\r
procedure waitd (delay : integer);\r
beginbody 0:\r
stvgw timer ; own.timer := delay\r
mwt\r
stnhb 2 ; skip result\r
endbody;\r
\r
\r
prefix waiti;\r
procedure waiti;\r
beginbody 0:\r
mwi\r
stnhb 2 ; skip result\r
endbody;\r
\r
\r
prefix waitid;\r
function waitid (delay : integer): activation;\r
beginbody 0:\r
stvgw timer ; own.timer := dealy\r
mwit\r
endbody;\r
\r
\r
prefix waitis;\r
function waitis (var r: reference; var s: semaphore): activation;\r
beginbody 0:\r
mwis\r
endbody;\r
\r
\r
prefix waitisd;\r
function waitisd\r
(var r: reference;\r
var s: semaphore;\r
delay : integer): activation;\r
beginbody 0:\r
stvgw timer ; own.timer := delay\r
mwist\r
endbody;\r
\r
\r
prefix waitisdwq;\r
function waitisdwq (var r : reference; var s : semaphore; delay : integer) : integer;\r
beginbody 0:\r
stvgw timer\r
coutwq\r
mwist\r
endbody;\r
\r
\r
prefix waitist;\r
function waitist (var r: reference; var s: semaphore): activation;\r
beginbody 0:\r
mwist\r
endbody;\r
\r
\r
prefix waitit;\r
function waitit: activation;\r
beginbody 0:\r
mwit\r
endbody;\r
\r
\r
prefix waits;\r
procedure waits (var r : reference; var s : semaphore);\r
beginbody 0:\r
cwait\r
endbody;\r
\r
\r
prefix waitsd;\r
function waitsd\r
(var r: reference;\r
var s: semaphore; delay : integer): activation;\r
beginbody 0:\r
stvgw timer ; own.timer := delay\r
mwst\r
endbody;\r
\r
\r
prefix waitst;\r
function waitst (var r: reference; var s: semaphore): activation;\r
beginbody 0:\r
mwst\r
endbody;\r
\r
\r
prefix waitt;\r
procedure waitt;\r
beginbody 2:\r
mwt\r
stnhb 2 ; skip result\r
endbody;\r
\r
\r
prefix writeram;\r
procedure writeram (index,walue : integer);\r
beginbody 0:\r
cwram\r
endbody;\r
\r
\r
prefix writeramclr;\r
procedure writeramclr (index,walue : integer);\r
beginbody 0:\r
ionci ; next clear interrupt\r
cwram ; write ram\r
endbody;\r
\r
.\r