|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 20736 (0x5100)
Types: TextFile
Names: »coderoutine«
└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
└─⟦6b41451d2⟧
└─⟦this⟧ »coderoutine«
prefix abs;
function abs(x : niltype) : niltype;
beginbody 0:
abs ;
endbody;
.
prefix addrptr;
function addrptr(p : ^niltype) : addr;
beginbody 0:
stvsd 0
endbody;
.
prefix addr_of;
function addr_of(var a: addr): addr;
beginbody 0:
stvsd 0
endbody;
.
prefix addr_of_core;
function addr_of_core(var a : corearray) : addr;
beginbody 0:
stvsd 0
endbody;
.
prefix addr_of_proc;
function addr_of_proc(var pr : process_descriptor) : addr;
beginbody 0:
stvsd 0
endbody;
.
prefix asgnaddrinc;
procedure asgnaddrinc(var a: addr; var p: ext_incarnation_descriptor);
beginbody 0:
stvsd 0
endbody;
.
prefix asgnaddrpref;
procedure asgnaddrpref(var a : addr; p : ^ process_descriptor);
beginbody 0:
stvsd 0
endbody;
.
prefix asgnaddrref;
procedure asgnaddrref(var a:addr; var r: reference);
beginbody 0:
revsd 0
stvsd 0
endbody;
.
prefix asgnaddrsec;
procedure asgnaddrsec(var a:addr; p: ^ secret_vector);
beginbody 0:
stvsd 0
endbody;
.
prefix asgnbyteint;
procedure asgnbyteint(var b : record left,right : byte end;
word : integer);
beginbody 0:
stvsw 0
endbody;
.
prefix asgnintset;
procedure asgnintset(var dest: integer; source: pat16);
beginbody 0:
stvsw 0
endbody;
.
prefix asgnpntradr;
function asgnpntradr( a : addr ) : ^ integer;
beginbody 0:
endbody;
.
prefix asgnptraddr;
function asgnptraddr ( a : addr ) : ^ integer (* or something else *);
beginbody 0:
endbody;
.
prefix asgnptradr;
function asgnptradr ( a : addr ) : ^ integer (* or something else *);
beginbody 0:
endbody;
.
prefix asgnrefaddr;
procedure asgnrefaddr(var ref: reference; a: addr);
beginbody 0:
stvsd 0
endbody;
.
prefix asgnrefset;
procedure asgnrefset(var ref: reference; s: pat32);
beginbody 0:
stvsd 0
endbody;
.
prefix asgnsempaddr;
procedure asgnsempaddr(var p : ^ semaphore; var address : addr);
beginbody 0:
stvsd 0
endbody;
.
prefix asgnsetint;
procedure asgnsetint(var d: pat16; s: integer);
beginbody 0:
stvsw 0
endbody;
.
prefix asgnsetref;
procedure asgnsetref(var d: pat32; var s: reference);
beginbody 0:
revsd 0
stvsd 0
endbody;
.
prefix assign2;
procedure assign2(var map : mem_map_type; mask : integer);
beginbody 0:
;
stvsw 0 ;
endbody;
.
prefix balloc;
procedure balloc;
beginbody 8:
b. d#, firstparam.
firstparam = lastparam - 11 ;
d#1 = firstparam ; ^ r
d#2 = d#1 + 4 ; ^ p
d#3 = d#2 + 4 ; ^ sem
revld d#1 ; push ^ r
revld d#2 ; push ^ p
cwait ; wait
cwtac ; test and clear
revld d#1 ; push ^ r
revsd 0 ; push r
revld d#3 ; push ^ sem
stvsd answer ;
e.
endbody;
.
prefix ownertest;
function ownertest(var p : pool 1; var r : reference) : boolean;
beginbody 0:
revsd 0
revsd owner
teqad
endbody;
.
prefix bcheck;
procedure bcheck;
beginbody 0:
revlw lastparam-1
revpw ; convert appetite in words to bytes
uadd ;
renpb ;
endbody;
.
prefix clearlevel;
procedure clearlevel;
beginbody 0:
;
iocci ; clear interrupt
endbody;
.
prefix control;
procedure control(control_word : integer; var ch_msg : reference);
beginbody 0:
;
iocda ; get device address
iowc ; write control
endbody;
.
prefix controlclr;
procedure controlclr(control_word : integer; var ch_msg : reference);
beginbody 0:
stnhb 4 ; skip last param
revgb level ; get device address
ionci ; next clear interrupt
iowc ; write control
endbody;
.
prefix controlclr;
procedure controlclr(control_word : integer );
beginbody 0:
revgb level ; get device address
ionci ; next clear interrupt
iowc ; write control
endbody;
.
prefix copywords;
procedure copywords(destination : addr; source : addr; count : integer);
beginbody 2:
rechw 1
shc
moveg
endbody;
.
prefix defincpntr;
procedure defincpntr(var owner : ^ ext_incarnation_descriptor;
base : integer;
disp : integer);
beginbody 0:
;
stvsd 0 ;
endbody;
.
prefix defineptr;
procedure defineptr(var pointer : addr;
start : addr;
index : integer;
var dope : dope_vector);
beginbody 0:
;
index ;
stvsd 0 ;
endbody;
.
prefix eoi;
function eoi : boolean;
beginbody 2:
b. f#.
mbtes 2 ; push eoi
e.
endbody;
.
prefix equalref;
function equalref(var a,b : reference):boolean;
beginbody 2:
rechw 4
stcea
endbody;
.
prefix excptcall;
procedure excptcall(excode : integer);
beginbody 0:
mxept
endbody;
.
prefix exchange;
procedure exchange(var r: reference; var p: ^message_header);
beginbody 0:
cexch ; exchange 4 bytes
endbody;
.
prefix getaddr;
procedure getaddr(var dest : addr; source : addr);
beginbody 0:
revsd 0
stvsd 0
endbody;
.
prefix getbufparam;
procedure getbufparam(var i : record
saddr : addr;
count,top : integer
end;
first,last : integer;
var msg : reference);
beginbody 2:
ioibx
rechw 8 ; push length to setst
setst
endbody;
.
prefix getbyte;
procedure getbyte(var result: byte; pointer: addr);
beginbody 0:
revsb 0
stvsb 0
endbody;
.
prefix getincpntr;
procedure getincpntr(var pr: ^ ext_incarnation_descriptor;
var p : ext_incarnation_descriptor);
beginbody 0:
stvsd 0
endbody;
.
prefix getinteger;
procedure getinteger(var result : integer; pointer : addr);
beginbody 0:
;
revsw 0 ; push operand
stvsw 0 ; pop result
endbody;
.
prefix getlfgf;
procedure getlfgf (var lf, gf: addr);
beginbody 4:
reagd -1
stvsd 0 ; get global frame ( even disp )
reald 0
stvsd 0 ; get local frame
endbody;
.
prefix getoflowmask;
function getoflowmask : boolean;
beginbody 2:
mbtes 1 ; 'suppress overlow bit'
endbody;
.
prefix getregister;
procedure getregister(var value : integer; index : integer);
beginbody 0:
;
crget ; getregister
stvsw 0 ; pop result
endbody;
.
prefix initextref;
procedure initextref(var r : reference; var msg_header : ext_message_header);
beginbody 0:
stvsd 0 ;
endbody;
.
prefix initref;
procedure initref(var r : reference;
var msg_header : message_header);
beginbody 0:
;
stvsd 0 ;
endbody;
.
prefix initscrtref;
procedure initscrtref(var secretref : ^ secret_vector; address : addr);
beginbody 0:
stvsd 0
endbody;
.
prefix jumpto;
procedure jumpto(address : addr);
beginbody 0:
jmppd
endbody;
.
prefix linklast;
procedure linklast(queueaddr: addr;elemptr : ^ ext_incarnation_descriptor);
beginbody 8:
reasd 1 ; make address odd
reaxd
reasd -3
reaxd
revsd -11
cllst
stnhb 8
endbody;
.
prefix linkmessage;
procedure linkmessage(var r : reference);
beginbody 8:
revsd 0
revpd
revgd msgchain
stvsd mmsgchain
stvgd msgchain
endbody;
.
prefix locked;
function locked(var sem : semaphore) : boolean;
beginbody 0:
tlock ;test locked
endbody;
.
prefix movebytes;
procedure movebytes( count : integer; var frombyte : byte; fromindex : integer;
var tobyte : byte; toindex : integer);
(* move 'count' bytes starting at 'frombyte(fromindex)' to
'tobyte(toindex)'. nb nb nb no check at all !!!!!!!!!! *)
(* 81 03 03 jaba *)
beginbody 6 :
uadd ; index
reaxd ; get top
reasd -9 ; addr of frombyte
rechw 6 ; prepare move
revsm ; push frombyte and fromindex
uadd ; index
reaxd ; get top
revsw -15; count
moveg ; move
stnhb 8 ; unstack
endbody;
.
prefix nextrefp;
procedure nextrefp(var refp : ^ reference);
beginbody 4:
revpd ; double tos
revsd 0 ; push refp
revsd 4 ; push refp^.next
stvsd 0 ;
endbody;
.
prefix nil;
function nil(var r : ^ niltype) : boolean;
beginbody 0:
tnill ;test nill
endbody;
.
prefix open;
function open(var sem : semaphore) : boolean;
beginbody 0:
topen ;test opened
endbody;
.
prefix openpool;
function openpool(var p: pool 1): boolean;
beginbody 0:
topen ;test opened
endbody;
.
prefix passive;
function passive(var sem : semaphore) : boolean;
beginbody 0:
tnill ;test nill
endbody;
.
prefix pop;
procedure pop(var r1, r2: reference);
beginbody 0:
lpop
endbody;
.
prefix push;
procedure push(var r1, r2: reference);
beginbody 0:
lpush
endbody;
.
prefix ptraddr;
function ptraddr(a : addr) : ^niltype;
beginbody 0:
endbody;
.
prefix putaddr;
procedure putaddr(dest,source : addr);
beginbody 0:
;
stvsd 0 ;
endbody;
.
prefix putinteger;
procedure putinteger(dest : addr; source : integer);
beginbody 0:
stvsw 0
endbody;
.
prefix inbyteblock;
procedure inbyteblock
(var next : integer;
first,last : integer;
var msg : reference;
var ch_msg : reference);
beginbody 0:
stnhb 4 ;skip last param temporary
ioibx ; initblock_io
iorbb ; rbb
stvsw 0 ; pop next
endbody;
.
prefix inbyteblock;
procedure inbyteblock
(var next : integer;
first, last : integer;
var msg : reference );
beginbody 0:
ioibx ; initblock_io
iorbb ; rbb
stvsw 0 ; pop next
endbody;
prefix inwordblock;
procedure inwordblock
(var next : integer;
first,last : integer;
var msg : reference;
var ch_msg : reference);
beginbody 0:
stnhb 4 ; skip last param temporary
ioibx ; initblock_io
iorbw ; read_block_of_words
stvsw 0 ; pop next
endbody;
.
prefix inwordblock;
procedure inwordblock
(var next : integer;
first, last : integer;
var msg : reference );
beginbody 0:
ioibx ; initblock_io
iorbw ; read_block_of_words
stvsw 0 ; pop next
endbody;
prefix readbyte;
procedure readbyte( var destination, source : byte );
beginbody 0:
;
readb ; revsb without parity check
stvsb 0 ; store result
endbody;
.
prefix readword;
procedure readword( var destination, source : integer );
beginbody 0:
readw ; revsw without parity check
stvsw 0 ; store result
endbody;
.
prefix readram;
procedure readram(var result : byte; index : integer);
beginbody 0:
;
crram ; read_controleprocessor_ram
stvsb 0 ; pop byte
endbody;
.
prefix inword;
procedure inword(var word : integer; var ch_msg : reference);
beginbody 0:
;
iocda ; get device address
iorw ; readword
stvsw 0 ; pop word
endbody;
.
prefix ref;
function ref(var sem : semaphore) : ^ semaphore;
beginbody 0:
endbody;
.
prefix refpool;
function refpool(var p : pool 1) : ^ pool 1;
beginbody 0:
endbody;
.
prefix refshadow;
function refshadow(var sh : shadow) : ^ shadow;
beginbody 0:
endbody;
.
prefix release;
procedure release(var r : reference);
beginbody 0:
crele owner ;
endbody;
.
prefix return;
procedure return(var r : reference);
beginbody 0:
crele answer ;
endbody;
.
prefix requeue;
procedure requeue (var q: addr);
beginbody 0:
cskip
endbody;
.
prefix scheduler;
procedure scheduler;
beginbody 6:
b. r#.
reaad r#1
rechw 15
crput ;level1.ic:= r#1
rechw 14
crput
jmprw r#2
r#1: sched ; scheduler loop
jmprw r#1
r#2:
e.
endbody;
.
prefix selectlevel;
procedure selectlevel(level : integer);
beginbody 0:
;
csell ; select level
endbody;
.
prefix sense;
procedure sense(var status_in : integer;
status_out : integer;
var ch_msg : reference);
beginbody 0:
;
iocda ; get device address
iors ; read status
stvsw 0 ; pop result
endbody;
.
prefix sensesem;
procedure sensesem(var r : reference; var sem : semaphore);
beginbody 0:
csens
endbody;
.
prefix setexcept;
procedure setexcept;
beginbody 4:
b. expnt.
reaad expnt ; gf.exception-routine := just after here
stvgd expoint
pexit 2
expnt:
e.
endbody;
.
prefix setinterrupt;
procedure setinterrupt( var ch : reference );
beginbody 0:
iocda ; get device addr
cslev ; set interrupt
endbody;
.
prefix setoflowmask;
procedure setoflowmask (overflow: boolean);
beginbody 0:
mbset 1 ; 'overflow mask bit'
endbody;
.
prefix setqueueptr;
procedure setqueueptr(var queueptr : addr; var queue : addr);
beginbody 2:
reasd 1 ; make address odd
stvsd 0
endbody;
.
prefix setregcouble;
procedure setregcouble(index: integer; var a: addr);
beginbody 4:
reaxd ;push lu
revsw -5 ;push index
rechw 1 ;push 1
add
crput ;register(index+1):=a.disp
reaxd ;push lu
revsw -3 ;push index
crput ;register(index):=a.base
stnhb 2 ;
endbody;
.
prefix setregister;
procedure setregister(walue,index : integer);
beginbody 0:
crput ; putregister
endbody;
.
prefix signal;
procedure signal(var r : reference; var sem : semaphore);
beginbody 0:
csign
endbody;
.
prefix startdriver;
procedure startdriver(var p: ext_incarnation_descriptor);
beginbody 0:
reasd 1 ; make address odd
cstdr
endbody;
.
prefix startschedule;
procedure startschedule;
beginbody 2:
rechw 1
cslev ; set interrupt 1 (= scheduler level)
endbody;
.
prefix stopprocess;
procedure stopprocess(var p: ext_incarnation_descriptor);
beginbody 4:
reasd 1 ; make address odd
rechw 16384 ; get nill addr
revpw ; ( dummy displacement )
cstop
endbody;
.
prefix stvsb0;
procedure stvsb0(var d,s: byte);
beginbody 0:
revsb 0
stvsb 0
endbody;
.
prefix stvsd0;
procedure stvsd0(var a : addr; b : ^ niltype);
beginbody 0:
stvsd 0
endbody;
.
prefix stvsd0;
procedure stvsd0(var a : ^ niltype; b : addr);
beginbody 0:
stvsd 0
endbody;
.
prefix stvsw0;
procedure stvsw0(var a : integer; b : integer);
beginbody 0:
stvsw 0
endbody;
.
prefix timestep;
procedure timestep (p: addr);
beginbody 0:
mtime
endbody;
.
prefix timedout;
function timedout : boolean;
beginbody 2:
rechw 0
stvgw timeroffset ; own.timer := 0;
mbtes 4 ; timeout bit
rechw 0
mbset 4 ; clear time out bit
endbody;
.
prefix uadd;
function uadd( a, b : integer) : integer;
beginbody 0:
uadd
endbody;
.
prefix udiv;
function udiv(a,b : integer) : integer;
beginbody 0:
udiv
endbody;
.
prefix ult;
function ult (i,j : integer): boolean;
beginbody 0:
ult; unsigned less-than
endbody;
.
prefix umod;
function umod(a,b : integer) : integer;
beginbody 0:
umod
endbody;
.
prefix umul;
function umul(a,b : integer) : integer;
beginbody 0:
umul
endbody;
.
prefix usub;
function usub( a, b : integer ) : integer;
beginbody 0:
usub
endbody;
.
prefix wait;
procedure wait(var r : reference; var sem : semaphore);
beginbody 0:
cwait ; wait
cwtac ; test and clear
endbody;
.
prefix waiti;
procedure waiti;
beginbody 0:
mwi
mwtac
stnhb 2 ; skip result
endbody;
.
prefix waitd;
procedure waitd(delay : integer);
beginbody 0:
stvgw timeroffset ; own.timer := delay
mwt
mwtac
stnhb 2 ; skip result
endbody;
.
prefix waitt;
procedure waitt;
beginbody 2:
mwt
mwtac
stnhb 2 ; skip result
endbody;
.
prefix waitid;
function waitid(delay : integer): activation;
beginbody 0:
stvgw timeroffset ; own.timer := dealy
mwit
mwtac
endbody;
.
prefix waitit;
function waitit: activation;
beginbody 0:
mwit
mwtac
endbody;
.
prefix waitis;
function waitis (var r: reference; var s: semaphore): activation;
beginbody 0:
mwis
mwtac
endbody;
.
prefix waitsd;
function waitsd (var r: reference; var s: semaphore; delay : integer): activation;
beginbody 0:
stvgw timeroffset ; own.timer := delay
mwst
mwtac
endbody;
.
prefix waitst;
function waitst(var r: reference; var s: semaphore): activation;
beginbody 0:
mwst
mwtac
endbody;
.
prefix waitisd;
function waitisd (var r: reference; var s: semaphore; delay : integer): activation;
beginbody 0:
stvgw timeroffset ; own.timer := delay
mwist
mwtac
endbody;
prefix waitist;
function waitist (var r: reference; var s: semaphore): activation;
beginbody 0:
mwist
mwtac
endbody;
.
.
prefix ctrwaitid;
function ctrwaitid (c: integer; delay : integer): activation;
beginbody 0:
stvgw timeroffset ; own.timer := delay
mcit
mwtac
endbody;
.
prefix ctrwaitit;
function ctrwaitit (c: integer): activation;
beginbody 0:
mcit
mwtac
endbody;
.
prefix ctrwaitis;
function ctrwaitis (c: integer; var r: reference; var s: semaphore): activation;
beginbody 0:
mcis
mwtac
endbody;
prefix ctrwaitisd;
function ctrwaitisd (c: integer; var r: reference; var s: semaphore; delay: integer): activation;
beginbody 0:
stvgw timeroffset ; own.timer := delay
mcist
mwtac
endbody;
.
prefix ctrwaitist;
function ctrwaitist (c: integer; var r: reference; var s: semaphore): activation;
beginbody 0:
mcist
mwtac
endbody;
.
prefix outbyteblock;
procedure outbyteblock
(var next : integer;
first,last : integer;
var msg : reference;
var ch_msg : reference);
beginbody 0:
stnhb 4 ; skip last param temporary
ioibx ; initblock_io
iowbbc ; write_block_of_bytes
stvsw 0 ; pop next
endbody;
.
prefix outbyteblock;
procedure outbyteblock
(var next : integer;
first, last : integer;
var msg : reference);
beginbody 0:
ioibx ; initblock_io
iowbbc ; write_block_of_bytes
stvsw 0 ; pop next
endbody;
prefix outwordblock;
procedure outwordblock
(var next : integer;
first,last : integer;
var msg : reference;
var ch_msg : reference);
beginbody 0:
stnhb 4 ; skip last param temporary
ioibx ; initblock_io
iowbwc ; write_block_of_words
stvsw 0 ; pop next
endbody;
.
prefix outwordblock;
procedure outwordblock
(var next : integer;
first, last : integer;
var msg : reference );
beginbody 0:
ioibx ; initblock_io
iowbwc ;write_block_of_words
stvsw 0 ; pop next
endbody;
prefix writeram;
procedure writeram(index,walue : integer);
beginbody 0:
cwram
endbody;
.
prefix writeramclr;
procedure writeramclr(index,walue : integer);
beginbody 0:
ionci ; next clear interrupt
cwram ; write ram
endbody;
.
prefix outword;
procedure outword(word : integer; var ch_msg : reference);
beginbody 0:
;
iocda ; get device address
ioww ; write word
endbody;
.
prefix outwordclr;
procedure outwordclr(word : integer; var ch_msg : reference);
beginbody 0:
stnhb 4 ; skip last param
revgb level ; get device address
ionci ; next clear interrupt
ioww ; write word
endbody;
.
prefix outwordclr;
procedure outwordclr( word : integer );
beginbody 0:
revgb level ; get device address
ionci ; next clear interrupt
ioww ; write word
endbody;
.
▶EOF◀