|
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: 150528 (0x24c00)
Types: TextFile
Names: »compress1«
└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
└─⟦093e2ad1c⟧
└─⟦this⟧ »compress1«
;;
;; begin lmitxt000c
;;
.m rc 3502 micro-program parameters
;;
.m rev: 801009▶05◀ fh/hlv
;;
;
version= 23 ;
;
;; register def
.w0= 0 ;
.w1= 1 ;
.w2= 2 ;
.w3= 3 ;mem read data
.w4= 4 ;
.w5= 5 ;mem read addr, d
.w6= 6 ;mem read addr, b
.w7= 7 ;last read ic word
.w8= 8 ;
.w9= 9 ;
.w10= 0a ;
.w11= 0b ;
.slu= 8 ;
.slb= 9 ; =pb
.spb= 9 ;
.sic= 0a ;
.sib= 0b ;
.reg= 0c ;
.lev= 0d ;
.errd= 0e ;
.errb= 0f ;
;
cow= 3eb ;
puerrmsk= 3fa ;
;
startlevel= 1 ;
monitrlev= 1 ;
firstreg= 0f ;
ramonitor= 3e7 ;
racom8085= 3ef ;
rawork= 3f7 ;
radummy= 3ff ;
;
autobase= 10 ;
autodisp= 2 ;
lubase= 0 ;
;
setworklen= 0e ; no of bytes used by setinstructions
; to store the internal variables.
.p ;
.m incarnation descr
;
puno= 3 ;
level= 4 ;
regbase= 5 ;
shwt= 7 ;
actq= 0b ;
chainhead= 0f ;
excode= 13 ;
exaddr= 15 ;
exic= 19 ;
dumplm= 1d ; lm, ps, lu, sf, ib, ic
timer= 29 ;
maxstack= 2b ;
statistic= 0ff ;?????????????????????????????????????????????
maxstackrel= maxstack - exic ;
;;
;; message head
;;
msgtype= 4 ;
msgsize= 6 ;; must be msgtype + 2
msgsadr= 8 ;; must be msgsize + 2
msgstack= 18 ;; stackchain
;;
;; input/output parameters
;;
;; ditimer1: din busy timer before sup.int.
;; ditimer1 = 0 : 10 mhz version
;; = 7 : 18 mhz version ( = 2.22425 us )
;;
ditimer1= 0 ; 10 mhz version
ditimer2= 8a - ditimer1 ; -,din busy timeout counter = 29.946 us ( 18 mhz )
;;
;; soft (internal) interrupt parameters
;;
sintmax= 7 ; soft interrupts between 0 and 7 incl.
.p ;
;;
;; instruction codes
;;
jmphc= 1 ;
jmphd= 2 ;
.instruction jmphd , jmphc00 , jmphc00 ;; to be removed in rev.3
jmppd= 3 ;
jmprw= 4 ;
jmcht= 5 ;
jmzeq= 6 ;
jmzne= 7 ;
jmzlt= 8 ;
jmzgt= 9 ;
jmzle= 0a ;
jmzge= 0b ;
;
csign= 10 ;
cwait= 11 ;
csens= 12 ;
csell= 13 ;
cstdr= 14 ;
cstop= 15 ;
cllst= 16 ;
cufst= 17 ;
sched= 18 ;
crget= 19 ;
crput= 1a ;
crram= 1e ;
cwram= 1f ;
crele= 20 ;
cwtac= 21 ;
chpro= 22 ;
.instruction chpro , fetch , fetch ;; to be removed in rev.3
cgreg= 24 ;
cslev= 25 ;
cexch= 26 ;
;
iowc= 30 ;
iogo= 31 ;
iors= 32 ;
iorw= 33 ;
ioww= 34 ;
iogi= 35 ;
iorbb= 36 ;
iorbw= 37 ;
iowbb= 38 ;
iowbw= 39 ;
ioctc= 3a ;
iocci= 3b ;
iocda= 3c ;
ioibx= 3e ;
ionci= 3f ;
;
neg= 50 ;
notinstr= 51 ;
tnill= 52 ;
abs= 53 ;
compl= 54 ;
add= 55 ;
sub= 56 ;
mul= 57 ;
div= 58 ;
mod= 59 ;
sha= 5a ;
andinstr= 5b ;
or= 5c ;
shc= 5d ;
ult= 5e ;
eq= 5f ;
ne= 60 ;
lt= 61 ;
gt= 62 ;
le= 63 ;
ge= 64 ;
setcr= 65 ;
setun= 66 ;
setin= 67 ;
setdi= 68 ;
seteq= 69 ;
setsb= 6a ;
setsp= 6b ;
settm= 6c ;
setad= 6d ;
tlock= 6e ;
topen= 6f ;
;
intrs= 70 ;
index= 71 ;
inprs= 72 ;
inpss= 73 ;
;
renpb= 80 ;
renhb= 81 ;
rechw= 82 ;
rechd= 83 ;
reaxd= 84 ;
reaad= 85 ;
.instruction reaad , rechd00 , rechd00 ;; to be removed in rev.3
reard= 86 ;
reald= 87 ;
reagd= 88 ;
reaid= 89 ;
reasd= 8a ;
;
revpw= 90 ;
revpd= 91 ;
revab= 92 ;
revaw= 93 ;
revad= 94 ;
revaf= 95 ;
revlb= 96 ;
revlw= 97 ;
revld= 98 ;
revlf= 99 ;
revgb= 9a ;
revgw= 9b ;
revgd= 9c ;
revgf= 9d ;
revib= 9e ;
reviw= 9f ;
revid= 0a0 ;
revif= 0a1 ;
revsb= 0a2 ;
revsw= 0a3 ;
revsd= 0a4 ;
revsf= 0a5 ;
revsm= 0a7 ;
;
stnhb= 0b0 ;
stvab= 0b1 ;
stvaw= 0b2 ;
stvad= 0b3 ;
stvaf= 0b4 ;
stvlb= 0b5 ;
stvlw= 0b6 ;
stvld= 0b7 ;
stvlf= 0b8 ;
stvgb= 0b9 ;
stvgw= 0ba ;
stvgd= 0bb ;
stvgf= 0bc ;
stvib= 0bd ;
stviw= 0be ;
stvid= 0bf ;
stvif= 0c0 ;
stvsb= 0c1 ;
stvsw= 0c2 ;
stvsd= 0c3 ;
stvsf= 0c4 ;
stwsa= 0c6 ;
stbsa= 0c7 ;
stxsa= 0c8 ;; to be removed in rev.3
stcea= 0c9 ;
setre= 0cb ;
setst= 0cc ;
;
pcals= 0d0 ;
pcald= 0d1 ;
pexit= 0d2 ;
;
lpush= 0e0 ;
lpop= 0e1 ;
;
mnoop= 0f0 ;
mboot= 0f1 ;
mbtes= 0f2 ;
mbset= 0f3 ;
mxept= 0f4 ;
.p ;
;;
;; error codes
;;
csigne= 1 ; signal: reference = nill
renpbe0= 2 ; a number of words is specified by an odd number of bytes
revafe0= 3 ; xxxxf: illegal field (last < first byte)
stvafe0= 4 ; stvxf: field overflow.
iocdae0= 5 ; iocda/ioibx: nill msgptr
iocdae1= 6 ; iocda: not channel msg
ioibxe0= 8 ; ioibx: not data message
ioibxe1= 9 ; ioibx: size too small
ioibxe2= 0a ; ioibx: top <= first
arite= 0b ; arithmetic overflow
indexe= 0c ; index exception
undefins= 0d ; undefined instruction code
setodde= 0e ; odd addresses or lengths in sets
setade= 0f ; setad truncation error
stackovf= 10 ; stack overflow during stack increase
packe= 11 ; intrs, illegal value
nilade= 12 ; sa address nill
lpushe1= 13 ; lpush: nill r1
lpushe2= 14 ; lpush: not empty(r1)
lpushe3= 15 ; lpush: r1 = r2
lpushe4= 16 ; lpush: locked(r2)
lpope1= 17 ; lpop: not nill(r1)
lpope2= 18 ; lpop: nill(r2)
lpope3= 19 ; lpop: locked(r2)
cexche1= 20 ; cexch: locked(r1) or locked(r2)
;;
;; end of parameters
;;
;; end lmitxt000c
;;
;;
;; begin lmitxt001c
;;
.m lmi microprogram version 801009
auto: ;
,,cjp c7 k ;
sic:=autodisp,, ;
racom8085zd0= racom8085 - 7 ;
ra:=racom8085zd0,,,loop ;
rd:=version,,, ;
;
racom8085m4= racom8085 - 4 ;
w0:=racom8085m4,,loop ; clear the registers 3eb thru 3ff
w1:=0,,push 14 ;
ra:=w0,w0:=w0++,, ;
rd:=,,rfct ;
;
,,push 3e7 ;
ra:=w1,w1:=w1++,, ;
rd:=slu:=7ff,,rfct ; set -1 into the registers 0 thru 3e7
;
ir:=ra:=reg:=firstreg,,loop ; sync itr
zd1:=,, ; firstreg.ps:=0
zd2:=slb:=lubase,,loop ;
rd2:=sib:=autodisp,,loop ;
lev:=startlevel,,loop ;
w0:=lev,,cjs setlint ;
,,cjp fetch ;
.p ;
mma: ;proc mma; (*sel. mem-addr*)
bfm:=0c0,,h ,crtn ; msel:= base+addrsel; return;
;
mma1: ;proc seladdr1;
bfm:=0c0,errd:=w1,h ,crtn ; msel:= ba+seladdr; errd:= w1; return;
;
mma5: ;proc seladdr5;
bfm:=0c0,errd:=w5,h ,crtn ; msel:= ba+seladdr; errd:= w5; return;
;
mmaq: ;proc seladdrq;
bfm:=0c0,errd:=q++,h ,crtn ; msel:= ba+seladdr; errd:= q+1; return;
;
mmd: ;proc mmd; (*sel. mem-data*)
bfm:=0c1,,h ,crtn ; msel:= base+datasel; return;
;
thmmd: ;proc thseldata;
bfm:=0c1,,h ,crtn not pty ; msel:= ba+seldata; if not pty then return
,h ,cjpp herror ; else goto herror;
;
.p ;
stopmode: ;
,,cjp not cr mreqq ; if mreq then goto mreqq;
ir:=ra:=radummy,,, ;
;
;;
;; test af 2910 micro-sequencer stack-overflow
;; the stack should be empty at this point.
;;
,,ldct 2 ;
testmovf1: ;
,,cjs testmovf2 ;
sic,,cjp k ; the last instruction didnot unstack all
testmovf2: ;
,,rpct testmovf1 ;
,,cjs testmovf3 ;
,,cjp testmovfok ;
testmovf3: ;
,,cjs k+1 ;
,,crtn ;
testmovfok: ;
q:=zd,s,ldct 4 ;
testmovfus: ;
,,loop ;
,,rpct testmovfus ;
;
,,cjp zro exec ; if stopmode=0 then goto fetch
,,cjp b0 stopmode1 ; jump if breakpoint-mode
zd:=q--,,cjp exec ; countmode
stopmode1: ;; breakpoint mode
sib-zd0,s, ;
,,cjp not zro exec ;
sic-zd1,s, ;
exec: ; from mreqq with zro=false
ra:=reg,,cjp zro fetch ;
ba:=errb:=sib,s,cjs mma ; ba:= sib; seladdr;
c:=bd:=errd:=sic,h r ,cjp fetch0; xbus:= sic; goto fetch0;
.p ;
setslice: ;;
ra:=reg,, ;
setslice1: ;
sic:=rd,, ;
slu:=zd,, ;
setslice2: ;
slb:=zd2,, ;
sib:=rd2,,crtn ;
;; entries into fetch:
;
fetch1: ;; from fetch with zro=false
lev:=lev xor w0,, ;
rd:=sic,, ;
zd:=slu,, ;
;; no savings of the regs
;; set reg and ra according to lev:
reg:=c:lev clr 700,, ; cry:=external interrupt
bus:=lev and lev,,cjp cry fetch3;
ra:=swp,reg:=swp,,cjp fetch4;
fetch3: ;
reg:=reg++reg,,push 1 ;
ra:=reg:=reg++reg,,rfct ;
fetch4: ;; zro means test stopmode, mreqq, and level shift
slu:=zd,,cjs setslice2 ; set slb, sib
sic:=rd,, ;
execnext: ;; no test on stopmode, mreqq, or level shift
ba:=errb:=sib,s,cjs mma ; ba:= sib; seladdr;
c:=bd:=errd:=sic,h r ,cjp b0 dummyregs; xbus:= sic; read; if sib(0) goto dummyregs;
w7:=bd,h w s,cjp not cry fetch7; w7:= waitmem; if odd(sic) goto fetch7
,,cjp fetch5 ; else goto fetch5;
.p ;
;; logical testsequence in fetch:
;; 1. mreqq
;; 2. stopmode
;; 3. level shift
;; 4. mcb, dummy regs
;; the actual test sequence may because of convenience differ from
;; this scheme. the logical testsequence must, however, as a
;; general rule be as outlined above.
;
sfetch: ;
ra:=reg,,cjs setslice1 ;
;
.instruction mnoop ;
;
fetch: ;
ba:=errb:=sib,s,cjp not c7 stopmode; ba:= sib; if -,run goto stopmode;
bfm:=0c0,,h , ; msel:= ba+seladdr;
c:=bd:=sic,h r ,cjp not cr mreqq; xbus:= sic; read; if -,cr goto mreqq;
fetch0: ; (* from exec with readmem started *)
int,,h ,cjp b0 dummyregs ; if sib(0) goto dummyregs; (* nasty bp *)
w0:=int xor lev,h s,cjp not cry fetch6; x:= int xor lev; if odd(sic) goto fetch6;
w7:=bd,h w s,cjp not zro fetch1; w7:= waitmem; if x<>0 goto fetch1;
fetch5: ;(* from execnext *)
ir:=w3:=w7,h ,cjs pty perror; ir:= w7; if pty then perror;
;;cjs statistics
rd:=sic,sic:=sic++,,jmap 8 ; ic:= sic; sic:= sic+1; goto map(ir);
;
fetch6: ;
w7:=bd,h w s,cjp not zro fetch1; w7:= waitmem; if x<>0 goto fetch1;
fetch7: ;(* from execnext *)
ir:=w3:=swp,h ,cjs pty perror; ir:= swap(w7); if pty then perror;
;;cjs statistics
rd:=sic,sic:=sic++,,jmap 8 ; ic:= sic; sic:= sic+1; goto map(ir);
.p ;
;;
;; procedure terror
;; return if no pty error or puerrmask.b1 (*supp. pty err*)
;;
;; entry: errb, errd, stat(pty)= def.;
;; exit : ra= regs, stat= undf;
;;
;; procedure perror
;; return if puerrmask.b1 (*supp. pty err*)
;;
;; entry: errb, errd: def.;
;; exit : ra= regs, stat= undf;
;;
terror: ;proc terror;
,h ,crtn not pty ; if not pty then return;
perror: ;proc perror;
ra:=puerrmsk,,h , ;
rd,,h s, ; if puerrmask.b1 then
ra:=reg,h ,crtn b1 ; return
,h ,cjp herror ; else goto herror;
;;
;; procedure therror
;; return if no pty error
;;
;; entry: errb, errd, stat(pty)= def.;
;; exit : all unch;
;;
therror: ;proc therror;
,h ,crtn not pty ; if not pty then return;
.p ;
;;
;; procedure herror
;; unconditional pty error
;;
;; entry: errb, errd= def.;
;; exit : to fetch;
;;
herror: ;proc herror;
q:=56,h , ; 01010lr0: q:= memory error;
bd,,h w , ; define left and right parity error
,,cjv 3 ptyerror1 ; w5:= (d+1) - 1;
.loc ;
ptyerror1: ;
q:=q-2,, ; remove both left and right parity error
q:=q-2,, ; remove left parity error
q:=q-2,, ; remove right parity error
;
;;send mess to debug console
;;q,errb,errd=message
ra:=racom8085,,,loop ;
rd1:=q,,loop ;
rd2:=errb,,loop ;
rd:=errd,, ;
led:=6,,, ;
sendmess1: ;
,,cjp cr k ;
,,cjs mrequest ;
,,cjp c7 sendmess1 ; wait while run-mode
,,cjp sfetch ;
;
.p ;
;;
.instruction mxept ;
;;
,,cjs readlucq ;
,,cjp xept ;
;;
;; procedure undefined-instruction
;;
.instruction ;
;;
;; procedure xept(error); (* unconditional program exception *)
;;
;; entry: q= error;
;; exit : (* p.t. n.a *) q= stat= undf, ra= regs;
;;
q:=undefins,, ; error:= undefined instruction;
xept: ;proc xept;
;; o b s : changes ir
ra:=reg,,cjs setslice ; p.t. no return;
ir:=300,w2:=spb,,loop ;
w1:=excode--,,loop ;
w1:=w1+rd1,,loop ; d:= pr+excode-1;
w3:=q,,cjs writenext ; writenext(spb,d,error);
w1:=w1+4,,loop ; d:= pr+exic-1;
w3:=rdx,,cjs writenext ; writenext(spb,d,ib);
w3:=rd,,cjs writenext ; writenext(spb,d,ic);
w5:=w1-8,, ; d:= pr+exadr-1;
w6:=spb,,cjs readnext ; readnext(spb,d);
sib:=bd,h w s, ; sib:= waitmem;
rdx:=sib,,cjs readnextt ; ib:=sib; readnextt(spb,d);
sic:=bd,h w s,cjs terror ; test parity; sic:= waitmem;
w5:=w5+maxstackrel,, ;
,,cjs readnext ; readnext(pb,pr+maxstack);
w3:=bd,h w s,cjs terror ; lm:= waitmem; testparity;
zd0:=w3,, ;
,,cjp fetch ; goto fetch
.p ;
;;
;; procedure tstack
;;
;; entry: exit: slu, lm;
;;
tstack: ;proc tstack;
zd0-slu,s, ;
,,crtn acy ;
;;
;; stack overflow
;;
stackerror: ;
q:=stackovf,, ; error:= stack overflow;
,,cjp xept ; goto exception;
.p ;
swap: ;
q:=swp and w4,, ;
swp,q:=q+w0,, ;
w0:=swp and w5,,crtn ;
;
shiftcom: ;
w3,,cjs swap ;
w1,w3:=q,,cjs swap ;
w2,w1:=q,,cjs swap ;
w0,w2:=q,,crtn ;
;
mrqterror: ;
zd0:=w2,,crtn not pty ; zd0:=the read data
ccr,,,cjp herror ;
;
mreqq: ;
zd:=slu,, ;
rd:=sic,,cjs mrequest ;
,,cjp fetch ;
;
mrequest: ;
ir:=300,,, ;
ra:=racom8085,,, ;
w2:=zd0,, ;
w1:=zd1,, ;
w3:=zd2,, ;
w4:=0ff,, ;
w5:=swp,,cjv 6 mrq5 ;
;
.loc ;
;
mrq5: ;
,,cjp mrq7a ; disp:=2; tti interrupt
c:=w5:=w5--w5,,cjp mrq7 ; disp:=0; timer interrupt
c:=w5:=0,,cjp mrq7 ; disp:=1; tto interrupt
,,cjv 5 mreq ; normal request
;
mreq: ;012345
,,cjv 4 mrq1 ;xx0011
,,cjv 4 mrq2 ;xx0111
,,cjv 4 mrq3 ;xx1011
,,cjv 4 mrq4 ;xx1111
;
mrq1: ;
cd,,,cjp putgetdata ;000011 putgetdata
,,cjp k ;010011
w2:=w2-w2,,cjp mrq14 ;100011 read data
,,cjp mrq9 ;110011 write request
;
mrq2: ;
ccr,w0--w0,s,cjpp exec ;000111 execute
,,cjp k ;010111
,,cjp mrq21 ;100111 putmem
,,cjp mrq19 ;110111 getmem
;
mrq3: ;
w2:=cd and w4,,cjp getregaddr;001011 get register address
w0:=w0--w0,,cjp mrq10 ;011011 test level o b s
ccr,,,jz ;101011 autoload
w0:=reg,,cjp getlev ;111011 get lev
;
mrq4: ;
ccr,w0--w0,s,cjpp execnext ;001111 execute on curr. level
bus:=w3,,cjp selftest ;011111 selfdiagnostic test
ra:=w1,,cjp mrq23 ;101111 putreg
ra:=w3,,cjp mrq22 ;111111 getreg
;
mrq7a: ;;set tti interrupt
c:=w5:=1,, ; disp:=2
mrq7: ;;set timer interrupt or console interrupt
w6:=w6-w6,,cjs readnext ;
w3:=bd,h w s,cjs getbyte ;
,,cjs pty mrqterror ;
w0:=w3,,cjs setlint ; set interrupt
,,cjp mrq10 ;
;
mrq9: ;;write request
;; rd1, rd2, rd3 : message
;; zd3 : data byte
;
w0:=rdw,s, ; w021:=message
w2:=rdx,, ;
w1:=rd,,cjp zro mrq9a ; jump if no message
led:=6,,, ; send interrupt
rdw:=,,cjp mrq10a ; send message
mrq9a: ;; send data byte
w0:=zd,, ;
w2:=swp,, ; w02:=data byte
zd:=,,cjp mrq10a ;
;
putgetdata: ;; bus=data to be put
w0:=swp and w5,,cjs shiftcom;
w0:=swp,,cjp mrq10a ;
;
getregaddr: ;
w2:=w2+w2,,push 1 ;
w2:=w2+w2,,rfct ;
;
mrq22a: ;
ra:=racom8085,,, ;
;
mrq10a: ;;update the cyclic buffer
zd0:=w2,, ;
zd1:=w1,, ;
zdx:=w3,,cjp mrq10 ;
;
getlev: ;
ir:=c:=,,push 2 ;
w0:=>w0,,rfct ;
;
mrq10: ;; end session
cd:=w0,, ;
ccr,,,cjp setslice ;
;
mrq14: ;;read data
q:=w3 and 3f,, ;
w3,w1:=q--,, ;
w3:=swp and w4,,cjs writebnext;
,,cjp mrq10 ;
;
mrq19: ;;get mem
w6:=w1,, ; base
w5:=w3--,,cjs readnext ;
0,,h , ; force ones to the backplane bus
w2:=bd,h w s,cjs mrqterror ; zd0:=data
,,cjp mrq10 ;
;
mrq21: ;;putmem
w1:=w1--,,cjs writenext ;
,,cjp mrq10 ;
;
mrq22: ;;get reg
w2:=rd,,cjp mrq22a ;
;
mrq23: ;;put reg
rd:=w3,,cjp mrq10 ;
;
;;
;; end lmitxt001c
;;
;; begin lmitxt002c
;;
;; rev: 801009 hlv
;
;; procedure readcont (* 8x = 1,74us *)
;; procedure readcontt (* 9x = 1,95us *)
;;
;; entry: w7= if odd(sic) then mem(sib,sic-1) else undf; sib, sic= def.;
;; exit : sic= sic+2, w3= mem(sib,sic); stat(w3) def; errb,errd=def;
;; w7= if odd(sic) then mem(sib,sic+1) else unch.;
;;
readcontt: ;proc readcontt;
,h ,cjs pty perror ; if pty then perror;
readcont: ;proc readcont;
ba:=errb:=sib,, ; ba:= errb:= sib;
bfm:=0c0,errd:=sic++,h , ; msel:= seladdr+ba; errd:= sic+1;;
bd:=errd,sic:=errd++,h r s,; xbus:= sic+1; read; sic:= sic+2;
q:=w7 and 0ff,h , ; lb:= w7(8:15); w3:= waitmem; if even(sic) then
w3:=bd,h w s,cjp b15 therror; begin testpty; return; end;
w7:=w3,h ,cjp pty herror ; if pty then harderror;
w3:=w3 and 700,, ; rb:= w3(0:7);
bus:=w3+q,, ;
w3:=swp,s,crtn ; w3:= lb shift 8 + rb; return;
;;
;; procedure readbcont (* 5,25x = 1,14us *)
;; procedure readbcontt (* 6,25x = 1,36us *)
;;
;; entry: w7= if odd(sic) then mem(sib,sic-1) else undf; sib,sic= def;
;; exit : w4= byte(sib,sic); errb, errd= def; sic= sic+1; stat(w4) def;
;; w7= if even(sic) then mem(sib,sic+1) else undf;
;;
readbcontt: ;proc readbcontt;
,h ,cjs pty perror ; if pty then perror;
readbcont: ;proc readbcont;
bus:=sic,sic:=sic++,s, ; sic:= sic+1; if even(sic) then
w4:=w7 and 0ff,s,crtn b15 ; begin w4:= w7(8:15); return; end;
ba:=errb:=sib,,cjs mma ; ba:= errb:= sib; seladdr;
bd:=errd:=sic--,h r , ; xbus:= errd:= sic-1; read;
w4:=0ff,h , ;
w7:=bd,h w s, ; w7:= waitmem;
w4:=w4 and swp,h s,crtn not pty ; w4:= w7(0:7); if not pty then return
,h ,cjp herror ; else harderror;
.p ;
;;
;; procedure readcont34 (* 18x = 3,91us *)
;;
;; entry: sib= b, sic= d, w7= as readcont;
;; exit : sib= b, sic= d+4, w7= as readcont, w3= memword(b,d+2),
;; w4= memword(b,d); errb,errd= def;
;;
readcont34: ;proc readcont34;
,,cjs readcont ; w4:= readcont(b,d);
w4:=w3,,cjp readcont ; w3:= readcont(b,d+2); return;
;;
;; procedure readcown36 (* 18x = 3,91us *)
;;
;; entry: sib, sic;
;; exit : w3= memword(sib,sic+2), w6= memword(sib,sic);
;;
readcown36: ;proc readcown36;
,,cjs readcont ; w6:= readcont;
w6:=w3,,cjp readcont ; w3:= readcont; return;
;;
;; procedure getsa (* 23x = 5,0us *)
;; procedure getsat (* 24x = 5,2us *)
;;
;; entry: -
;; exit : w1= mem(lu) + rel - 1; w2= mem(lu-2); w3= rel; q= w6= undf;
;; read(mem(lu-2)) started;
;;
getsat: ;proc getsat;
,h ,cjs pty perror ; if pty then perror;
getsa: ;proc getsa;
,,cjs readcont ; rel:= readcont;
w1:=w3--,,cjs readluc ; readluc;
w1:=w1+bd,h w s,cjs readluct; d:= rel-1+waitmem; readluct;
w2:=bd,h w s,cjp terror ; b:= waitmem; testpty; return;
.p ;
;;
;; procedure clearbits(mask); (* 2x = 0,43us *)
;;
;; entry: w0= mask;
;; exit : w0= unch, q= old ps;
;;
clearbits: ;proc clearbits;
q:=zd1,, ; ra.ps:= ra.ps and -,mask;
zd1:=q clr w0,,crtn ; return;
;;
;; procedure getbyte; (* 2,5x = 0,54us *)
;; procedure getbytet; (* 2,5x = 0,54us *)
;;
;; entry: c= even(adr); w3= swp= word(adr);
;; exit : b3= byte, w4= swp(word(adr));
;;
getbyte: ;proc getbyte;
w4:=swp,,cjp cry getby10 ; w4:= swap(word(adr));
w3:=w3 and 0ff,,crtn ; w3:= if cry then w4 and rmask
getby10: ; else w3 and r-mask;
w3:=w4 and 0ff,,crtn ; return;
;
getbytet: ;proc getbytet;
w4:=swp,h ,cjp cry getby20 ; w4:= swap(word(addr));
w3:=w3 and 0ff,h ,crtn not pty ; w3:= if cry then w4 and rmask
,h ,cjp perror ; else w3 and rmask;
getby20: ; if pty then perror;
w3:=w4 and 0ff,h ,crtn not pty ; return;
,h ,cjp perror ;
.p ;
;;
;; procedure testint; (* 2x = 0,43us *)
;; procedure testint1; (* 1x = 0,22us *)
;;
;; entry: -
;; exit : stat(zro)= (int=lev);
;;
testint: ;proc testint;
int,,h , ; (* int must be read twice *)
testint1: ;proc testint1;
int xor lev,h s,crtn ; stat:= (int=lev); return;
;;
;; procedure nill (* 1x = 0,22us *)
;;
nill: ;proc nill;
bus:=40,,,crtn ; swap:= nill; return;
;;
;; procedure read12 (* 3x = 0,65us *)
;; procedure read12t (* 4x = 0,78us *)
;;
;; entry: w1= d-1, w2= b;
;; exit : w1= w2= unch; readmem(b,d) started; errb, errd= def;
read12t: ;proc read12t;
,h ,cjs pty perror ; if pty then perror;
read12: ;proc read12;
ba:=errb:=w2,,cjs mma ; ba:= b; seladdr;
bd:=errd:=w1++,h r ,crtn ; xbus:= d; read; return;
.p ;
;;
;; procedure readluc (* 3x = 0,65us *)
;; procedure readluct (* 4x = 0,87us *)
;;
;; entry: -
;; exit : errb= slb, errd= slu-1; slu= slu-2;
;; readmem(slb,slu-1) started;
;;
readluct: ;proc readluct;
,h ,cjs pty perror ; if pty then perror;
readluc: ;proc readluc;
ba:=errb:=slb,, ; ba:= errb:= slb;
bfm:=0c0,errd:=slu--,h , ; msel:= mamadr+ba; errd:= slu-1;
bd:=errd,slu:=errd--,h r ,crtn ; xbus:= errd; slu:= slu-2; read; return;
;;
;; procedure readlucq (* 6,5x = 1,4us *)
;; entry: -
;; exit: q= mem(slb, slu), slu= slu-2, w5= slu, w6= slb, stat(q) def;
;;
readlucq: ;
,,cjs readluc ;
q:=bd,h w s,cjp therror ;
;;
;; procedure readnext (* 3x = 0,65us *)
;; procedure readnextt (* 4x = 0,87us *)
;;
;; entry: w5 = d-1, w6= b
;; exit: w5 = w5+2, w6 = b, errb, errd def;
;;
readnextt: ;proc readnextt;
,h ,cjs pty perror ; if pty then perror;
readnext: ;proc readnext;
ba:=errb:=w6,, ; ba:= errb:= b;
bfm:=0c0,errd:=w5++,h , ; msel:= ba+memadr; errd:= d+1;
bd:=errd,w5:=errd++,h r ,crtn ; xbus:= errd; d:= d+2; read; return;
.p ;
;;
;; procedure writenext (* 7x = 1,51us *)
;; procedure writenextt (* 8x = 1,74us *)
;;
;; entry: w1= disp-1; w2= base; w3= data;
;; exit : w1= disp+1; w2= w3= unch;
;;
writenextt: ;proc writenextt;
,h ,cjs pty perror ; if pty then perror;
writenext: ;proc writenext;
ba:=w2,,cjs mma ; ba:= base; seladdr;
bd:=w1:=w1++,h ,cjs mmd ; xbus:= disp; w1:= disp+1; seldata;
bd:=w3,w1:=w1++,h w ,crtn ; xbus:= w3; write; return;
;;
;; procedure writebnext (* 7x = 1,51us *)
;; procedure writebnextt (* 8x = 1,74us *)
;;
;; entry: w1= disp-1; w2= base; w3= byte;
;; exit : w1= disp; w2= w3= unch;
;;
writebnextt: ;proc writebnextt;
,h ,cjs pty perror ; if pty then perror;
writebnext: ;proc writebnext;
ba:=w2,,cjs mma ; ba:= base; seladdr;
bd:=w1:=w1++,h ,cjs mmd ; xbus:= w1:= disp; seldata;
bd:=w3,h w b ,crtn ; xbus:= byte; writebyte; return;
.p ;
;;
;; procedure wrfetch (* 8x = 1,74us *)
;; procedure wrfetcht (* 9x = 1,95us *)
;;
;; entry: w3= data;
;; exit : to fetch;
;;
wrfetcht: ;proc wrfetcht;
,h ,cjs pty perror ; if pty then perror;
wrfetch: ;proc wrfetch;
slu-zd0,s, ; if slu>=maxstack then goto stackerror;
ba:=slb,slu:=slu++,,cjp acy stackerror; ba:= slb; seladdr;
bfm:=0c0,,h , ; msel:= ba+seladdr;
bd:=slu,slu:=slu++,h ,cjs mmd; xbus:= slu+1; slu:= slu+2; seldata;
bd:=w3,h w ,cjp fetch ; xbus:= data; write; goto fetch;
;;
;; procedure wr34fetch (* 16x = 3,47us *)
;; procedure wr34fetcht (* 17x = 3,69us *)
;;
;; entry: w3= data1; w4= data2;
;; exit : to fetch;
;;
wr34fetcht: ;proc wr34fetcht;
,h ,cjs pty perror ; if pty then perror;
wr34fetch: ;proc wr34fetch;
slu-zd0,s, ; if slu>=maxstack then goto stackerror;
ba:=slb,slu:=slu++,,cjp acy stackerror; ba:= slb;
bfm:=0c0,,h , ; msel:= ba+seladdr;
bd:=slu,slu:=slu++,h ,cjs mmd; xbus:= slu+1; slu:= slu+2; seldata;
bd:=w4,h w ,cjp wrfetch ; xbus:= data2; write; goto wrfetch;
;;
;; procedure write56 (* 7x = 1,52us *)
;;
;; mem(w6,w5-1):= data;
;; entry: w5= d, w6= b, w7= data;
;; exit : unch;
;;
write56: ;proc write56;
ba:=w6,,cjs mma ; ba:= b; seladdr;
bd:=w5--,h ,cjs mmd ; xbus:= d-1; seldata;
bd:=w7,h w ,crtn ; xbud:= data; write; return;
.p ;
;; procedure clear (* ext: 6x = 1,30us, int: 9x = 1,95us *)
;;
;; entry: lev;
;; exit : w0= level, q= undf, ra= unch, ir= 300, stat= undf;
;;
clear: ;proc clear;
w0:=lev and 0ff,s, ; bplevel:= lev(8:15);
q:=w0 ior 200,, ; if bplevel=0 then goto clearown;
bf:=q,h ,cjp zro clearown ; msel:= bplevel + interrupt;
q:=w0 and 7,h , ; chan:= bplevel(13:15);
bd:=q,h w , ; xbus:= chan + clear interrupt;
ir:=300,,,crtn ; sync-intrp; return;
clearown: ;clearown:
ir:=c:=2,w0:=reg,h ,push 2 ;
w0:=>w0,h ,rfct ; ilevel:= reg shift (-3);
bf:=w0,h , ; msel:= ilevel;
ir:=300,,u ,crtn ; setsoft; sync-intrp; return;
;;
;; procedure setlocalint(level) (* 10x = 2,17us *)
;; procedure setown (* 14x = 3,04us *)
;;
;; entry: w0= level; (* setlint only *)
;; exit : w0= level, q= undf, stat= undf, ir:= 320;
;;
setown: ;proc setown;
ir:=c:=2,w0:=reg,,push 2 ;
w0:=>w0,,rfct ; level:= reg shift (-3);
setlint: ;proc setlint;
q:=w0 ior 200,, ; q:= level ior -,iors0;
bf:=q,, ; msel:= q;
q:=q and 7,, ; q:= lev and dev-mask
q:=q ior 20,, ; + setint;
bd:=q,h w , ; xbus:= q;
w0--sintmax,s, ; if level<=softintmax then
ir:=320,,,crtn acy ;
q:=q xor 28,, ; msel:= level(13:15) ior setsoft;
bf:=q,, ;
ir:=320,,u ,crtn ; sync-intrp; return;
;;
;; end of lmitxt002c
;;
;
;;
;; begin lmitxt003c
;;
;; rev: 801006 fh/hlv
;
dumpregs: ;
;; entry: ra = register address
;; exit: ir=300, w0,1,2,5,6 undefined
;
ir:=300,,, ;
w2:=rdx,s, ;
w1:=rd,,crtn b0 ; return if dummyregs
w5:=rdw,, ;
dumplmp8= dumplm + 8 ;
w5:=w5+dumplmp8,, ; address of dumpib
w6:=zdx,,cjs cwrite21 ; dump ib, ic
w5:=w5-4,, ;
w1:=rd0,, ;
w2:=zd,,cjs cwrite21 ; dump lu, sf
w5:=w5-4,, ;
w2:=zd0,, ;
w1:=zdw,,cjs cwrite21 ; dump lm, ps
rdx:=7ff,,,crtn ; indicate dummyregs; return
.p ;
loadregs: ;
;; entry: w43=nbd=üprocess description
;; exit: w0,1,2,5,6 undefined
;; ra=register address
;; w7=nbdü.level
;; ir=300
;
w5:=w3+level,, ;
w6:=w4,,cjs creadbyte1 ;
w0:=w1,,push 2 ;
ra:=w0:=w0++w0,,rfct ; ra:=w0:=register address
w7:=w1,,cjs dumpregs ; w7:=nbdü.level; dumpregs(ra)
rdw:=w5:=w3,, ; pb, gf := nbd
w5:=w5+dumplm,, ;
zdx:=w6:=w4,,cjs cread21 ;
w5:=w5+4,, ;
zd0:=w2,, ;
zdw:=w1,,cjs cread21 ; load lm, ps
w5:=w5+4,, ;
rd0:=w1,, ; load lu, lf
zd:=w2,,cjs cread21 ;
rdx:=w2,, ; load ib, ic; now dr is cleared
rd:=w1,,crtn ; return
.p ;
;; usage of the registerset with base ramonitor:
;; zd0,zd1=zd0,zdw: üactq(0)
;; zd2=zdx: n
;; zd3=zd: m
;; rd0: k
;; rd1=rdw: nxt
;; rd2,rd3=rdx,rd: dummy loop counter
;;
;; the active queue array is declared as
;; var actq: array(m..n) of addr,
;; where n>=0 and either
;; m < 0 and m <= k < 0 or else
;; m = 0 and k = -1.
;; if n=-1 then dummy looping is performed.
;; k may be changed by the time slice scheduler. if the time slice
;; scheduler is not a level 0 process then it must interrupt level 1
;; after having changed k.
;; k defines the priority sequence amongst the active queues as follows:
;; n, n-1, - - - , 0, k, -1, -2, - - - (not k) - - - , m.
;; nxt is used for scanning the active queues. it is reset to the value
;; n before starting scheduling. nxt=m-1 means dummy looping.
.p ;
dummyregs: ;dummyregs: (* from fetch when sib(0) *)
w0:=int xor lev,s, ; x:= int xor lev;
,,cjp not zro fetch1 ; if x<>0 goto fetch1; (* service intrp *)
reg xor 7,s, ;
ra:=ramonitor,,, ;
q:=rd0,, ; q:=k
w0:=rd1,, ; w0:=w7:=nxt
ir:=c:=300,w7:=w0,, ;
zdx++,s,cjp not zro dci ; if reg<>7 then goto dummy clear
zd--w0,s,cjp zro sch20 ; if n=-1 then goto dummy loop
w0,s,cjp zro sch20 ; if nxt=m-1 then goto dummy loop
w0-q,s,cjp not b0 sch1 ; if nxt>=0 then goto ok
w0++,s,cjp not acy sch1 ; if nxt<k then goto ok
w0:=w0++,,cjp b0 sch1 ; w0:=w0+1; if nxt<-1 then goto ok
w0:=q,, ; w0:=k
sch1: ;ok:
w0:=<w0+w0,, ;
w6:=zd0,, ; w65:=üactq(w0)
w5:=zdw+w0,,cjs cread21 ; w21:=cread21(w65)
w2,s, ;
,,cjp not b1 sch10 ; if -,nill(w21) goto startlevel;
rdw:=w7--,,cjp sfetch ; nxt:=nxt-1; goto sfetch
;
sch10: ;; start level 0
;
,,cjs cread65 ; w65:=üfirst
w4:=w6,, ; nbd:=üfirst
w3:=w5,,cjs loadregs ; loadregs(nbd)
,,cjp sfetch ; goto sfetch
.p ;
sch20: ;; dummy loop counter
;
q:=rd++,s, ;
rd:=q,,cjp not acy sfetch ;
q:=rdx++,, ;
rdx:=q,,cjp sfetch ; goto sfetch
;
dci: ;; dummy clear interrupt
ra:=radummy,,, ;
rd0:=lev,, ;
w0:=rdw,, ;
rdw:=w0++,,cjp dci1 ;
;
;
.instruction sched ;
;; this instruction is executed on level 1 and it starts the
;; scheduling
;
ra:=ramonitor,,, ;
q:=zd2,, ; level1.nxt:=level1.n
rd1:=q,, ;
ra:=7,,, ;
,,cjs dumpregs ; dumpregs(0)
dci1: ;
,,cjs clear ; clear
ra:=reg,,cjp fetch ; goto fetch
;
;
.instruction cstdr ;
,,cjs readlucq ; nbd:=üprocess description
w3:=q,,cjs readlucq ;
w4:=q,,cjs loadregs ; loadregs(nbd)
w0:=w7,,cjs setlint ; setlint(nbdü.level)
ra:=reg,,cjp fetch ; goto fetch
;;
.m rc 3502 micro-program - input/output instructions
;;
.m rev: 801007 hlv
;;
;; file: lmitxt040c
;;
;
;;
;; procedure xmitwordt(dev,func,data);
;; procedure xmitword (dev,func,data);
;;
;; entry: w0= dev, w3= data, w4= func:
;; 00: read data,
;; 40: write data,
;; 80: read status,
;; c0: write control;
;; exit : w0= w3= w4= unch, q= chan= dev and 7;
;;
xmitwordt: ;proc xmitwordt;
,h ,cjs pty perror ; testparity;
xmitword: ;proc xmitword;
q:=w0 ior 100,, ; q:= dev ior iors0;
bf:=q,,cjp not st2 k ; repeat msel:= q until -,busy;
q:=w0 and 7,, ; chan:= dev and chan-mask;
bd:=q ior w4,h w , ; xbus:= func ior chan;
bf:=w0,, ; msel:= dev + iors0 + iors1;
bd:=w3,h w ,crtn ; xbus:= data; return;
.p ;
;;
;; procedure waitrec;
;;
;; entry: -
;; exit : stat(zro)= -,(timeout or eoi);
;;
waitrec: ;proc waitrec;
,h ,push ditimer1 ; rc:= ditimer1;
,h ,twb st5 waitr05 ; repeat
,h i ,cjp waitr07 ; if -,dibusy then goto testeoi
waitr05: ; else rc:= rc-1 until rc=0;
,h i ,push ditimer2 ; rc:= ditimer2;
,h i ,twb st5 waitr10 ; repeat if rc=0 then goto eoi
; else rc:= rc-1 until -,dibusy;
waitr07: ;testeoi:
w0-w0,h i s,crtn st3 ; stat(zro):= true; if -,eoi then return;
waitr10: ;eoi:
w0--w0,h i s,crtn ; stat(zro):= false; return;
;;
;; procedure seteoi;
;;
;; entry: ra= reg;
;; exit : ra= unch, q= 4000;
;;
seteoi: ;proc seteoi;
q:=--2,h , ; q:= fffd; (* = -,eoi *)
q:=q and zd1,h , ; ps:= ps and -,eoi;
zd1:=q,h ,crtn st3 ; if -,eoi then return;
q:=q ior 2,h , ; ps:= ps ior eoi;
zd1:=q,h ,crtn ; return;
.p ;
;;
;; procedure readlu4c (* 15,5x = 3,36us *)
;;
;; entry: -
;; exit : w0= word(slu), w1= word(slu-2), w2= word(slu-4), read(slu-6) started,
;; slu= slu-8, errb,errd= def;
;;
readlu4c: ;proc readlu4c;
ba:=errb:=slb,,cjs mma ; ba:= errb:= slb; seladr;
bd:=errd:=slu--,h r ,cjs readlu4c20; xbus:= errd:= slu-1; read; startreadnext;
w0:=bd,h w s,cjs readlu4c10; w0:= waitmem; startreadmextt;
w1:=bd,h w s,cjs readlu4c10; w1:= waitmem; startreadnextt;
w2:=bd,h w s,cjp readlu4c10; w2:= waitmem; startreadnextt; return;
;
readlu4c10: ;proc startreadnextt;
bd:=errd:=slu--,h r ,cjp pty readlu4c30; xbus:= errd:= slu-1; read;
; if pty then goto readlu4cpty;
readlu4c20: ;proc startreadnext;
slu:=errd--,h ,crtn ; slu:= slu-2; return;
;
readlu4c30: ;readlu4cpty;
bd,,h w ,loop ; waitmem;
bd:=errd:=slu++,h r ,cjp herror; xbus:= errd:= slu; read; goto herror;
.p ;
;;
;; procedure readluptr (* 18,5x = 4,01us *)
;;
;; entry: -
;; exit : w1= q= undf, w2= m.b, readmem56 started;
;;
readluptr: ;proc readluptr;
,,cjs readluc ; readluc;
w5:=bd--,h w s,cjs readluct; d:= waitmem; readluct;
w6:=bd,h w s,cjs readnextt ; b:= waitmem; readnextt(b,d);
w1:=iocdae0,h , ;
w2:=bd,h w s,cjs therror ; m.b:= waitmem; testhparity;
,,cjp not b1 readnext ; if -,nill(m.b) begin readnext(b,d+2); return; end;
q:=w1,,cjp xept ; exception(nill-ptr);
.p ;
;;
.instruction ioctc ; count timeout
;;
;; param:: none;
;; stack:: level: word -> ;
;;
,,cjs readluc ; readluc;
w0:=bd,h w s, ; l:= waitmem;
w4:=w0,,cjs pty perror ; testpatity;
ir:=c:=81,w4:=w4++w4,, ;
w4:=<w4++w4,, ; r:= l shift 3 + 7;
ra:=w4,, ; ra:= r;
bus:=rd2,,s, ; if r.ib = dr then goto end-ioctc;
w5:=rdx--,,cjp b0 ioctc20 ; d:= r.pr;
w6:=zd2,, ; b:= r.pb;
w5:=w5+timer,, ; d:= d+timer-1;
w1:=w5,,cjs readnext ; readnext(b,d);
w2:=w6,h , ;
w3:=bd,h w s,cjs terror ; t:= waitmem; testparity;
ra:=w4,w3:=w3--,s,cjp zro ioctc20; ra:= r; if t=0 then goto end-ioctc;
,,cjp not zro ioctc10 ; t:= t-1; if t=0 then
w4:=zd1,, ; begin (* timeout *)
w4:=w4 ior 4,, ; r.ps.to:= true;
zd1:=w4,, ;
,,cjs setlint ; setlocalint(l);
ioctc10: ; end;
,,cjs writenext ; writenext(b,d,t);
ioctc20: ;end-ioctc:
ra:=reg,,cjp fetch ; ra:= reg; goto fetch;
.p ;
;;
.instruction iocci ; clear-interrupt;
;;
;; param:: none;
;; stack:: -> ;
;;
w3:=zd1,, ;
w3 and 4,s, ;
,,cjs zro clear ; if not sib.to then clear;
,,cjp fetch ; goto fetch;
;;
.instruction ionci ; clear interrupt after next instruction;
;;
;; param:: none;
;; stack:: -> ;
;;
w3:=zd1,, ;
w3 and 4,s, ;
,,cjs zro clear ; if not sib.to then clear;
,,cjp execnext ; goto non-interrupt-fetch;
.p ;
;;
.instruction iocda ; get devno;
;;
;; param:: none;
;; stack:: msgprt: addr -> devno: word;
;;
,,cjs readluptr ; m.b:= readluptr;
w1:=msgtype--,h , ;
w1:=w1+bd,h w s,cjs read12t; m.d:= waitmem+msgkind; read12t(m.b,m.d);
w3:=7f,h , ; devmask:= 07f;
w3:=w3 and bd,h w s,cjs therror; devno:= waitmem and devmask; testpty;
,,cjp not b0 wrfetch ; if waitmem(0)=0 then goto wrfetch(devno)
q:=iocdae1,, ; else exception(msg-type-error);
,,cjp xept ;
;;
.instruction cgreg ;
;;
;; param:: none;
;; stack:: -> regno: word;
;;
w3:=reg,,cjp wrfetch ; goto wrfetch(regno);
;;
.instruction cslev ;
;;
;; param:: none;
;; stack:: level: word -> ;
;;
,,cjs readluc ; readluc;
w0:=bd,h w s,cjs terror ; level:= waitmem; testparity;
,,cjs setlint ; setlocalint(level);
,,cjp fetch ; goto fetch
.p ;
;;
.instruction iowc ;
;;
;; param:: none;
;; stack:: dev, control: word -> ;
;;
,,cjs readluc ; readluc;
w4:=0c0,h , ; func:= writecontrol;
w0:=bd,h w s,cjs readluct ; dev:= waitmem; readluct;
w3:=bd,h w s,cjs xmitwordt ; xmitwordt(dev,func,waitmem);
,,cjp fetch ; goto fetch;
;;
.instruction iors ;
;;
;; param:: none;
;; stack:: dev, control: word -> status: word;
;;
,,cjs readluc ; readluc;
w4:=80,h , ; func:= read status;
w0:=bd,h w s,cjs readluct ; dev:= waitmem; readluct;
w3:=bd,h w s,cjs xmitwordt ; xmitwordt(dev,func,waitmem);
,h ,cjs waitrec ; waitrec;
w3:=bd,h w ,cjp wrfetch ; stat:= xbus; goto wrfetch(stat);
;;
.instruction iogo ; general output
;;
;; param:: none;
;; stack:: dev, func, data: word -> ;
;;
,,cjs readluc ; readluc;
w0:=bd,h w s,cjs readluct ; dev:= waitmem; readluct;
w4:=bd,h w s,cjs readluct ; func:= waitmem; readluct;
,h ,cjp ioww10 ; goto common-write;
.p ;
;;
.instruction iorw ;
;;
;; param:: none;
;; stack:: dev: word -> w: word;
;;
,,cjs readluc ; readluc;
w4:=0,h , ; func:= read data;
w3:=0,h , ; control:= 0;
w0:=bd,h w s,cjs xmitwordt ; xmitwordt(waitmem,func,control);
iorw10: ;common-read:
,h ,cjs waitrec ; waitrec;
w3:=bd,h w ,cjs seteoi ; w:= xbus; seteoi;
,,cjp wrfetch ; goto wrfetch(w);
;;
.instruction ioww ;
;;
;; param:: none;
;; stack:: dev, w: word -> ;
;;
,,cjs readluc ; readluc;
w4:=40,h , ; func:= write data;
w0:=bd,h w s,cjs readluct ; dev:= waitmem; readluct;
ioww10: ;common-write:
w3:=bd,h w s,cjs xmitwordt ; xmitwordt(dev,func,waitmem);
,h ,cjs seteoi ; seteoi;
,,cjp fetch ; goto fetch;
;;
.instruction iogi ; general input;
;;
;; param:: none;
;; stack:: dev, func, dataout: word -> datain: word;
;;
,,cjs readluc ; readluc;
w0:=bd,h w s,cjs readluct ; dev:= waitmem; readluct;
w4:=bd,h w s,cjs readluct ; func:= waitmem; readluct;
w3:=bd,h w s,cjs xmitwordt ; xmitwordt(dev,func,waitmem);
,h ,cjp iorw10 ; goto common-read;
.p ;
;;
.instruction iorbb ;
;;
;; param:: none;
;; stack:: dev: word; faddr: addr; cnt: word -> cnt: word;
;;
,,cjs initiob ; initiob;
w4:=,,cjs readlu4c ; dev,b,d:= readlu4c; func:= readdata;
w3:=w3-w3,h ,ldct iorbb20 ; control:= 0;
w7:=bd,h w s,jsrp not cry xmitwordt; cnt:= waitmem; if to then goto iob-to;
,h ,cjs waitrec ; xmitwordt(dev,func,0); waitrec;
w3:=bd,h w ,cjs seteoi ; byte:= xbus; seteoi;
,h ,cjp not zro iorbb30 ; if eoi or hard-to then goto iob-eoi;
w1:=w1--,,cjs writebnext ; writebnext(b,d-1,byte);
;;
;; entry common-iob;
;;
;; entry: w1= newd-1, w2= b, w5= oldslu-6, w6= slb, w7= newcnt+1,
;; slu= oldslu-8;
;;
iorbb10: ;common-iob:
w7:=w7--,s,ldct write56 ; cnt:= cnt-1; if cnt=0 then iob-cnt
w5:=w5++,,jsrp zro iorbb25 ; else write56(slb,slu+3,cnt);
w5:=slu+6,, ;
w7:=w1++,,cjs write56 ; write56(slb,slu+6,b+1);
slu:=slu+8,, ; slu:= slu + 8;
sic:=sic--,,cjp fetch ; sic:= sic-1; goto fetch;
iorbb20: ;iob-to:
,,cjs pty perror ; testparity;
iorbb25: ;proc iob-cnt;
,,loop ;
iorbb30: ;iob-eoi:
,,cjs setown ; setowninterrupt;
w3:=w7,,cjp wrfetch ; goto wrfetch(cnt);
.p ;
;;
.instruction iorbw ;
;;
;; param:: none;
;; stack:: dev: word; faddr: addr; cnt: word -> cnt: word;
;;
,,cjs initiob ; initiob;
w4:=,,cjs readlu4c ; dev,b,d:= readlu4c; func:= readdata;
w7:=7fe,h , ;
w3:=w3-w3,h ,ldct iorbb20 ; control:= 0;
w7:=bd and w7,h w s,jsrp not cry xmitwordt; cnt:= waitmem; if to then goto iob-to;
,h ,cjs waitrec ; xmitwordt(dev,func,0); waitrec;
w3:=bd,h w ,cjs seteoi ; w:= xbus; seteoi;
w1:=w1--,h ,cjp not zro iorbb30; if eoi or hard-to then goto iob-eoi;
w7:=w7--,,cjs writenext ; cnt:= cnt-1; writenext(b,d-1,w);
,,cjp iorbb10 ; goto common-iob;
;;
;; procedure initiob;
;;
;; entry: -
;; exit : w0= ps, cry= ps.to, level cleared;
;;
initiob: ;proc initiob;
w0:=zd1,, ;
c:w0 and 4,, ; cry:= r.ps.to;
,,cjp clear ; clear; return;
.p ;
;;
.instruction iowbb ;
;;
;; param:: none;
;; stack:: dev: word; faddr: addr; cnt: word -> cnt: word;
;;
,,cjs initiob ; initiob;
w6:=slb,,cjs readlu4c ; dev,b,d:= readlu4c;
w1:=w1--,h ,ldct iorbb20 ;
w7:=bd,h w s,jsrp not cry read12t; cnt:= waitmem; if to then goto iob-to;
c:=w1,w1:=w1++,h , ; read12t(b,d-1);
q:=40,h , ; func:= write data;
w3:=bd,h w s,cjs getbytet ; byte:= getbytet(waitmem);
w4:=q,h ,cjs xmitword ; xmitword(dev,func,byte);
,h ,cjs seteoi ; seteoi;
,h ,cjp st3 iorbb10 ; goto if -,eoi then common-iob
,,cjp iorbb30 ; else iob-eoi;
;;
.instruction iowbw ;
;;
;; param:: none;
;; stack:: dev: word; faddr: addr; cnt: word -> cnt: word;
;;
,,cjs initiob ; initiob;
,,cjs readlu4c ; dev,b,d:= readlu4c;
w1:=w1--,h ,ldct iorbb20 ;
w7:=7fe,h , ;
w7:=bd and w7,h w s,jsrp not cry read12t; cnt:= waitmem; if to then goto iob-to;
w1:=w1+2,h , ; read12t(b,d-1); d:= d+2;
w4:=40,h , ; func:= write data;
w3:=bd,h w s,cjs terror ; data:= waitmem; testparity;
,,cjs xmitword ; xmitword(dev,func,data);
,h ,cjs seteoi ; seteoi;
w7:=w7--,h ,cjp st3 iorbb10; cnt:= cnt-1; goto if -,eoi
,,cjp iorbb30 ; then common-iob else iob-eoi;
.p ;
;;
.instruction ioibx ;
;;
;; param:: none;
;; stack:: dev: word; msg: addr; last, first: word ->
;; dev: word; sad: addr; count, top: word;
;;
slu:=slu-2,, ; slu:= slu-2; (* keep dev *)
,,cjs readluptr ; msg.b:= readluptr;
w1:=msgtype--,h , ;
w1:=w1+bd,h w s,cjs readluct; msg.d:= waitmem+msgtype-1; readluct;
w7:=ioibxe0,h , ;
w3:=bd++,h w s,cjs readluct; top:= waitmem+1 (*last+1*); readluct;
ir:=20,,h , ; ir.shift:= logical;
w0:=bd,h w s,cjs read12t ; first:= waitmem; read12t(msg.b,msg.d);
w5:=w1+2,h , ; msg.d:= msg.d+2;
w6:=w2,h , ;
w4:=bd,h w s,cjs terror ; type:= waitmem; testparity;
q:=w7,,cjp b0 xept ; if type = chtype then exception(datamsg error);
.p ;
,,cjs readnext ; readnext(msg.b,msg.d);
w1:=ioibxe1,h , ; err:= size error;
w4:=>w3++,h , ; wtop:= (top+1) // 2;
w4--bd,h w s,cjs terror ; stat(acy):= (size < wtop); testparity;
q:=w1,,cjs acy xept ; if size<wtop then exception(err);
w1:=slu,,cjs readnext ; readnext(msg.b,msg.d);
c:w3--w0,h , ; cry:= (top > first);
w2:=ioibxe2,h , ; err:= first not less then top;
w7:=bd,h w s,cjs terror ; sad.b:= waitmem; testparity;
q:=w2,,cjs not cry xept ; if top<=first then exception(err);
w2:=slb,,cjs readnext ; readnext(msg.b,msg.d);
w4:=w3,h , ; b:= slb; d:= slu;
w4:=w4-w0,h , ; count:= top - first;
slu:=slu+0a,h , ; slu:= slu + 10;
w0:=w0+bd,h w s,cjs writenextt; sad.d:= waitmem+first; writenextt(b,d,top);
w3:=w4,,cjs writenext ; writenext(b,d,count);
w3:=w7,,cjs writenext ; writenext(b,d,sad.b);
w3:=w0,,cjs writenext ; writenext(b,d,sad.d);
,,cjp fetch ; goto fetch;
.p ;
;;
.instruction mboot ;
;;
;; param:: dev:byte; fadr: addr;
;; stack:: -> ;
;;
,,cjs readbcont ; dev:= readbcont;
w0:=w4,,cjs readcont ; b:= readcont;
w2:=w3,,cjs readcont ; d:= readcont - 1;
w1:=w3--,, ;
w4:=80,, ; func:= read status;
,,cjs xmitword ; xmitword(dev,func,dummy);
w4:=3,h i , ;
,h i ,cjs waitrec ; waitrec;
w4:=w4 and bd,, ; stat:= xbus(reader ready + pok);
w4 xor 3,s, ;
,,cjp not zro mboot30 ; if stat<>pok+ready then goto end-mboot;
w7:=40,, ;
mboot10: ; repeat (* skip until 64 or eoi *)
q:=w0-w0,h ,cjs mboot40 ; char:= intpuchar(dev);
w3 xor w7,s,cjp not zro mboot30; if eoi then goto end-mboot;
,,cjp not zro mboot10 ; until char = 64;
mboot20: ; repeat
q:=w0-w0,h ,cjs mboot40 ; char:= inputchar(dev);
,h ,cjp not zro mboot30 ; if eoi then goto end-boot;
,,cjs writebnext ; writebnext(b,d,char);
,,cjp mboot20 ; until 5 = 7;
mboot30: ;end-mboot:
w7:=1,s, ; (* wait 10 msec *)
w7:=w7++,s,cjp not zro k ; for i:= 0 to 2**16 do ;
w0:=w0+200,, ; (* clear(dev) *)
bf:=w0,, ; msel:= dev + iors1;
bd:=w0-w0,,cjp fetch ; xbus:= 0; goto fetch;
mboot40: ;proc inputchar;
w3:=1,s, ; (* wait 10 msec *)
w3:=w3++,s,cjp not zro k ; for i:= 0 to 2**16 do ;
w4:=w4-w4,,cjs xmitword ; xmitword(dev,read data,dummy);
,h ,cjs waitrec ; waitrec;
w3:=bd,h ,crtn ; char:= xbus; return;
;;
;; end of lmitxt040c
;;
;;
.m rc 3502 micro-program - pascal80 part
;;
.m rev: 801003▶05◀ hlv
;;
;; file: lmitxt050c
;;
;; each instruction is described by:
;;
;; param:: 1.st param, 2.nd param, ... ;
;; (* ascending core => *)
;;
;; stack:: lu-elem before, (lu-n) elem before, ... ->
;; lu-elem after, (lu-m) elem after, ... ;
;; (* descending core => *)
;;
.p ;
;;
;; common procedures
;;
;
;;
;; procedure get-if-rel;
;;
;; entry: -
;; exit : w0= ifdisp, w3= rel, w4= 0, w5= ifdisp+rel, w6= ifbase;
;;
getif: ;proc getifrel;
w0:=rd0,, ; w0:= sf;
,,cjs readbcont ; lev:= readbcont;
w6:=spb,,crtn zro ; while lev<>0 do
getif10: ; begin
w5:=w0,,cjs readnext ; w5:= w0-1; readnext(spb,w5);
w0:=bd,h w s, ; w0:= waitmem;
w4:=w4--,h s,cjp pty herror; lev:= lev-1;
,,cjp not zro getif10 ; end while;
,,crtn ;
getifrel: ;
,,cjs getif ;
w5:=w0,,cjs readcont ; rel:= readcont;
w5:=w5+w3,,crtn ; w5:= ifdisp + rel; return;
;;
;; procedure getfield(word,fbyte);
;;
;; entry: w4= fbyte, q= word;
;; exit : w3= field, w6= w8= rc= undf, q= unch, cry= 1;
;;
getfield: ;proc getfield;
c:=3,,,ldct 3 ; cry:= 1; rc:= 3;
,,cjs unpack ; f,l:= unpack(fbyte);
,,cjs not acy getfie10 ; if f>l then ill-field;
ir:=w3:=0,,cjs makemask ; w3:= 0; makemask;
rc:=w0,, ; rc:= 14-l;
w4:=q,,cjs acy rshift ; w6:= word shift (l-15);
w3:=w3 and w4,,cjp wrfetch ; goto wrfetch(w6 and mask);
getfie10: ;ill-field;
q:=revafe0,, ;
w0:=w4,,cjp xept ; l:= f; goto exception(field-error);
.p ;
;;
;; procedure unpack(fbyte);
;;
;; entry: w4= fbyte, rc= 3;
;; exit : f= w4= fbyte shift (-4), l= w0= fbyte and 0f, ir:= 20,
;; stat(acy)= (l>=f), rc= l-f;
;;
unpack: ;proc unpack;
w0:=w4 and 0f,, ; l:= fbyte and 0f;
;;
;; procedure rshift(word);
;;
;; entry: w4= word, rc= shifts - 1;
;; exit : w4= word shift (-shifts), stat(acy)= (w4<w0), rc= w0-w4;
;;
rshift: ;proc rshift;
ir:=20,,, ; ir.shift:= logic;
rshift10: ;
w4:=>w4,,rpct rshift10 ; word:= word shift (1-rc);
rc:=w0-w4,s,crtn ; rc:= stat:= w0-w4-1; return;
;;
;; procedure makemask(bno);
;;
;; entry: w3= 0, rc= bno-1, ir.shift= 0, cry= shiftin;
;; exit : w3= 2**(bno) - 1, stat= w0= 14-w0, rc= 0;
;;
makemask: ;proc makemask;
w3:=<w3,,rpct makemask ; while bno<>0 do begin
; bno:= bno-1; w3:= w3 shift 1 + cry; end;
w0:=0e-w0,s,crtn ; stat:= w0:= 0e-w0; return;
.p ;
;;
;; procedure setfieldt(word);
;; procedure setfield(word);
;;
;; entry: w1= d-1, w2= b, w3= field, stat(pty) defined;
;; exit : w0= w4= q= ir= rc= cry= undf, w1= w5= d+1, w2= w6= b, w3= res;
;;
setfieldt: ;proc setfieldt;
,,cjs readbcontt ; fb:= readbcontt;
setf05: ;setfield-common:
c:=3,,,ldct 3 ; cry:= 1; rc:= 3;
w6:=w2,,cjs unpack ; f,l:= unpack(fb);
q:=w3,,cjs not acy getfie10; if f>l then ill-field;
ir:=w3:=0,,cjs makemask ; ir.shift:= cyclic; w3:= 0; makemask;
w5:=w1,,cjp not acy setf25 ; if l>14 then goto noshift;
rc:=w0,, ; rc:= 14-l;
ir:=20,w0:=q,,push not cry ; ir.shift:= logic; w0:= q; (*field*)
setf10: ; while rc>0 do begin
w0:=<c<w0,s, ; field:= field shift 1; cry:= field(-1);
w3:=<w3,,twb cry setf30 ; mask:= mask shift 1; if cry then field-ovf;
; end while; goto endshift;
setf20: ;field-ovf:
q:=stvafe0,, ; field:= 0;
w0:=0,,cjs xept ; exception(field-ovf);
setf25: ;noshift:
w0:=q,, ; w0:= q; (* field *)
setf30: ;endshift: (*w0=field,w3=mask*)
w4:=w3,,cjs readnext ; readnext(b,d-1);
w4:=w4 and w0,h , ; w4:= field and mask;
w4 xor w0,h s, ; mask:= -,mask;
w3:=--w3,h , ;
w3:=w3 and bd,h w s,cjp not zro setf20; w:= -,mash and waitmem;
; if w4<>field then field-ovf;
w3:=w3 ior w4,h ,cjp writenextt; w:= w ior w4,call writenextt; return;
setfield: ;proc setfield;
,,cjs readbcont ; fb:= readbcont;
,,cjp setf05 ; goto setfield-common;
.p ;
;;
;; procedure stgetadbc;
;;
;; entry: -
;; exit : w0= bc, w1= op2d-1, w2= op2b, w3= w5= op1d-1, w4= w6= op1b;
;;
stgetadbc: ;proc stgetadbc;
,,cjs readluc ; readluc;
w0:=bd,h w s,cjs readluct ; bc:= waitmem; readluct;
w3:=bd--,h w s,cjs readluct; op1d:= waitmem-1; readluct;
w4:=bd,h w s,cjs stgetad10 ; op1b:= waitmem; readluctnill;
w1:=bd--,h w s,cjs readluct; op2d:= waitmem-1; readluct;
w2:=bd,h w s,cjs terror ; op2b:= waitmem;testparity;
w5:=w3,,cjp b1 nillerr ; if nill(op2b) then goto nillerror;
w6:=w4,,crtn ; return;
;
stgetad10: ;proc readluctnill:
,h ,cjs pty herror ; testparity;
,,cjp not b1 readluc ; if -,nill(op1b) then readluc; return;
;
nillerr: ;nillerror:
q:=nilade,, ; error:= nill address;
,,cjp xept ; exception(error);
.p ;
;;
;; instruction prologues: address calculations and
;; operand retreval.
;;
;; common reva prologue
;;
;; exit: w3= d, w5= d+1, w6= ownb, cry= even(d),
;; readmem(ownb,d) started;
;;
reva: ;reva-common:
,,cjs readcown36 ; b,d:= readcown36;
c:=w5:=w3--,,cjs readnext ; cry:= even(d); readnext(b,d-1);
,h ,jmap not 8 ; goto escmap(ir);
;;
;; common revl prologue
;;
;; exit: w3= rel, w5= sf+rel+1, w6= pb, cry= even(w6,w5),
;; readmem(w6,w5) started;
;;
revl: ;revl-common:
w6:=spb,,cjs readcont ; b:= pb; rel:= readcont;
w5:=rd0--,, ; d:= reg.sf + rel;
c:=w5:=w5+w3,,cjs readnext ; cry:= even(d); readnext(b,d-1);
,h ,jmap not 8 ; goto escmap(ir);
;;
;; common revg prologue
;;
;; exit: w3= rel, w5= pr+rel+1, w6= pb, cry= even(w5-1),
;;
revg: ;revg-common:
w6:=spb,,cjs readcont ; b:= spb; rel:= readcont;
w5:=rd1--,, ; d:= reg.pr + rel;
c:=w5:=w5+w3,,cjs readnext ; cry:= even(d); readnext(b,d-1);
,h ,jmap not 8 ; goto escmap(ir);
.p ;
;;
;; common revi prologue
;;
;; exit: w0= ifdisp, w3= rel, w4= 0, w5= ifdisp+rel+1,
;; w6= ifbase, cry= even(w5-1); readmem(w6,w5-1) started;
;;
revi: ;revi-common:
,,cjs getifrel ; b,d:= getifrel;
c:=w5:=w5--,,cjs readnext ; cry:= even(d); readnext(b,d-1);
,h ,jmap not 8 ; goto escmap(ir);
;;
;; common revs prologue
;;
;; exit: w1= d-1, w2= w6= b, w3= rel, w5= d+1, cry= even(d);
;;
revs: ;revs-common:
,,cjs getsa ; b,d:= getsa;
c:=w5:=w1,,cjp b1 nillerr ; cry:= even(d); if nill(b) then goto nillerror;
w6:=w2,,cjs readnext ; readnext(b,d-1);
,h ,jmap not 8 ; goto escmap(ir);
;;
;; common stva prologue
;;
;; exit: w1= d-1, w2= ownb, w56= lubd, readluc started;
;;
stva: ;stva-common:
,,cjs readcown36 ; b,d:= readcown36;
w1:=w3--,,cjs readluc ; readluc;
w2:=w6,h ,jmap not 8 ; b:= b ior pu; goto escmap(ir);
;;
;; common stvl prologue
;;
;; exit: w1= d-1, w2= b, w3= rel-1, readmem(w2,w1) started;
;;
stvl: ;stvl-common:
w2:=slb,,cjs readcont ; b:= lb; rel:= readcont;
w3:=w3--,,cjs readluc ; readluc;
w1:=rd0+w3,h , ; d:= reg.sf + rel - 1;
,h ,jmap not 8 ; goto escmap(ir);
.p ;
;;
;; common stvg prologue
;;
;; exit: w1= d-1, w2= b, w3= rel-1, readmem(w2,w1) started;
;;
stvg: ;stvg-common:
w2:=slb,,cjs readcont ; b:= lb; rel:= readcont;
w3:=w3--,,cjs readluc ; readluc;
w1:=rd1+w3,h , ; d:= reg.pr + rel - 1;
,h ,jmap not 8 ; goto escmap(ir);
;;
;; common stvi prologue
;;
;; exit: w1= d-1, w2= b, w56= lubd, readlu started;
;;
stvi: ;stvi-common:
w2:=spb,,cjs getifrel ; b:= pb; d:= getifrel - 1;
w1:=w5--,,cjs readluc ; readluc;
,h ,jmap not 8 ; goto escmap(ir);
;;
;; common stvs prologue
;;
;; exit: w0= res.d, w1= d-1, w2= b, w3= w4= res.d or res;
;;
stvsd1: ;stvsd-prologue:
,,cjs readluc ; readluc;
w0:=bd,h w s,cjs terror ; res.d:= waitmem; testparity;
stvs: ;stvs-common:
,,cjs readluc ; readluc;
w4:=bd,h w s,cjs getsat ; res:= waitmem; b,d:= getsat;
,,cjp b1 nillerr ; if nill(b) then goto nillerror;
w3:=w4,,jmap not 8 ; goto escmap(ir);
.p ;
;;
.instruction renpb ;
;;
;; param:: none;
;; stack:: no: word -> garbage: array(1..no/2) of word;
;;
ir:=,,cjs readluc ; ir.x:= 0; readluc;
c:=w3:=bd,h w s,cjs terror ; bc:= waitmem(0:15); cry:= waitmem(15);
renpb05: ;comm-push-garb: (* w3= bc *)
slu:=slu+w3,s,cjp cry renpb10; slu:= slu + bc; if odd(bc) then goto garb-error;
zdx-slu,s,cjp acy stackerror; if ovf then goto stackerror;
,,cjp acy fetch ; if slu<=maxstack then goto fetch
,,cjp stackerror ; else goto stackerror;
renpb10: ;garb-error:
q:=renpbe0,, ;
,,cjp xept ; goto exception(odd-byte-count);
;;
.instruction renhb ;
;;
;; param:: no: word;
;; stack:: -> garbage: array(1..no/2) of word;
;;
ir:=,,cjs readcont ; ir.x:= 0; bc:= readcont;
c:=w3,,cjp renpb05 ; bc:= bc(0:15); cry:= bc(15); goto comm-push-garb;
;;
.instruction rechw ;
;;
;; param:: const: word; stack:: -> const: word;
;;
,,cjs readcont ; const:= readcont;
,,cjp wrfetch ; goto wrfetch(const);
;;
.instruction rechd ;
;;
;; param:: const: addr; stack:: -> const: addr;
;;
rechd00: ;
,,cjs readcont34 ; res.b,res.d:= readcont34;
,,cjp wr34fetch ; goto wr34fetch(res.b,res.d);
.p ;
;;
.instruction reaxd ;
;;
;; param:: none; stack:: -> lu: addr;
;;
w3:=slu,, ;
w4:=slb,,cjp wr34fetch ; goto wr34fetch(slb,slu);
;;
.instruction reard ;
;;
;; param:: rel: word; stack:: -> icrel: addr;
;;
w4:=sib,,cjs readcont ; rel:= readcont;
w3:=w3+rd,,cjp wr34fetch ; goto wr34fetch(sib,ic+rel);
;;
.instruction reald ;
;;
;; param:: rel: word; stack:: -> lfrel: addr;
;;
w4:=slb,,cjs readcont ; rel:= readcont;
w3:=w3+rd0,, ;
,,cjp wr34fetch ; goto wr34fetch(slb,sf+rel);
;;
.instruction reagd ;
;;
;; param:: rel: word; stack:: -> gfrel: addr;
;;
w4:=slb,,cjs readcont ; rel:= readcont;
w3:=w3+rd1,, ;
,,cjp wr34fetch ; goto wr34fetch(slb,pr+rel);
.p ;
;;
.instruction reaid ;
;;
;; param:: lev: byte, rel: word;
;; stack:: -> ifrel: addr;
;;
,,cjs getifrel ; b,d:= getifrel;
w4:=w6,, ;
w3:=w5,,cjp wr34fetch ; goto wr34fetch(b,d);
;;
.instruction reasd ;
;;
;; param:: rel: word;
;; stack:: ad: addr-> adr: addr;
;;
,,cjs getsa ; b,d:= getsa;
w3:=w1++,, ;
w4:=w2,,cjp wr34fetch ; goto wr34fetch(b,d+1);
;;
.instruction revpw ;
;;
;; param:: none; stack:: w: word -> w, w: word;
;;
,,cjs readluc ; readluc;
slu:=slu+2,h , ; slu:= slu+2; (* keep w *)
w3:=bd,h w s,cjp wrfetcht ; goto wrfetcht(waitmem);
;;
.instruction revpd ;
;;
;; param:: none; stack:: a: addr -> a, a: addr;
;;
,,cjs readluc ; readluc;
w3:=bd,h w s,cjs readluct ; d1:= waitmem; readluct;
slu:=slu+4,h , ; slu:= slu+4;
w4:=bd,h w s,cjp wr34fetcht; goto wr34fetcht(waitmem,d1);
.p ;
;;
.instruction revab , reva , revxbfin ;
;;
;; param:: a: addr; stack:: -> byte: word;
;;
revxbfin: ;
w3:=bd,h w s,cjs getbytet ; byte:= getbytet(waitmem);
,,cjp wrfetch ; goto wrfetcht(byte);
;;
.instruction revaw , reva , revxwfin ;
;;
;; param:: a: addr; stack:: -> word: word;
;;
revxwfin: ;
w3:=bd,h w s,cjp wrfetcht ; goto wrfetcht(waitmem);
;;
.instruction revad , reva , revxdfin ;
;;
;; param:: a: addr; stack:: -> sa: addr;
;;
revxdfin: ;
w4:=bd,h w s,cjs readnextt ; res.d:= waitmem; readnextt(b,d+1);
w3:=bd,h w s,cjp wr34fetcht; goto wr34fetcht(res.b,waitmem);
;;
.instruction revaf , reva , revxffin ;
;;
;; param:: a: addr, fb: byte; stack:: -> f: word;
;;
revxffin: ;
w3:=bd,h w s,cjs readbcontt; word:= waitmem; fb:= readbcontt;
q:=w3,,cjp getfield ; goto getfield(word,fb);
,,cjp wrfetch ; goto wrfetch(field);
.p ;
;;
.instruction revlb , revl , revxbfin ;
;;
;; param:: lrel: word;
;; stacl:: -> byte: word;
;;
;
;;
.instruction revlw , revl , revxwfin ;
;;
;; param:: lrel: word;
;; stack:: -> w: word;
;;
;
;;
.instruction revld , revl , revxdfin ;
;;
;; param:: lrel: word;
;; stack:: -> d: addr;
;;
;
;;
.instruction revlf , revl , revxffin ;
;;
;; param:: lrel: word, fb: byte;
;; stack:: -> f: word;
;;
.p ;
;;
.instruction revgb , revg , revxbfin ;
;;
;; param:: grel: word;
;; stack:: -> byte: word;
;;
;
;;
.instruction revgw , revg , revxwfin ;
;;
;; param:: grel: word;
;; stack:: -> res: word;
;;
;
;;
.instruction revgd , revg , revxdfin ;
;;
;; param:: grel: word;
;; stack:: -> res: addr;
;;
;
;;
.instruction revgf , revg , revxffin ;
;;
;; param:: grel: word, fb: byte;
;; stack:: -> f: word;
;;
.p ;
;;
.instruction revib , revi , revxbfin ;
;;
;; param:: lev: byte, irel: word;
;; stack:: byte: word;
;;
;
;;
.instruction reviw , revi , revxwfin ;
;;
;; param:: lev: byte, irel: word;
;; stack:: res: word;
;;
;
;;
.instruction revid , revi , revxdfin ;
;;
;; param:: lev: byte, irel: word;
;; stack:: res: addr;
;;
;
;;
.instruction revif , revi , revxffin ;
;;
;; param:: lev: byte, irel: word, fb: byte;
;; stack:: -> f: word;
;;
.p ;
;;
.instruction revsb , revs , revxbfin ;
;;
;; param:: rel: word;
;; stack:: a: addr -> byte: word;
;;
;
;;
.instruction revsw , revs , revxwfin ;
;;
;; param:: rel: word;
;; stack:: a: addr -> res: word;
;;
;
;;
.instruction revsd , revs , revxdfin ;
;;
;; param:: rel: word;
;; stack:: a: addr -> res: addr;
;;
;
;;
.instruction revsf , revs , revxffin ;
;;
;; param:: rel: word, fb: byte;
;; stack:: a: addr -> f: word;
;;
.p ;
;;
.instruction mbtes ; test selected reg.ps bits
;;
;; param:: mask: word;
;; stack:: -> boolean: word;
;;
,,cjs readcont ; mask:= readcont;
w3 and zd1,s, ; if reg.ps and mask = 0
w3:=,,cjp zro wrfetch ; then goto wrfetch(0)
w3:=w3++,,cjp wrfetch ; else goto wrfetch(1);
;;
.instruction mbset ; set selected reg.ps bits
;;
;; param:: mask: word;
;; stack:: boolean: word -> ;
;;
,,cjs readcont ; mask:= readcont;
,,cjs readluc ; readluc;
ir:=80,w4:=--w3,h , ; ir.x:= 1;
w0:=bd,h w s,cjs terror ; boolean:= waitmem; testparity;
w4:=w4 and zdx,,cjp not b15 mbset10; reg.ps:= if boolean
w4:=w4 ior w3,, ; then reg.ps and -,mask + mask
mbset10: ; else reg.ps and -,mask;
zdx:=w4,,cjp fetch ; goto fetch;
.p ;
;;
.instruction stnhb ;
;;
;; param:: bc: word;
;; stack:: garbage: array (1..bc/2) of word ->;
;;
ir:=,,cjs readcont ; ir.x:= 0; bc:= readcont;
c:=w3,, ; cry:= bc(15);
slu:=slu-w3,,cjp not cry fetch; goto if even(bc) then fetch
,,cjs renpb10 ; else garb-error;
;;
.instruction stvab , stva , stvxbfin ;
;;
;; param:: a: addr;
;; stack:: byte: word -> ;
;;
stvxbfin: ;
w3:=bd,h w s,cjs writebnextt; writebnextt(b,d,waitmem);
,,cjp fetch ; goto fetch;
;;
.instruction stvaw , stva , stvxwfin ;
;;
;; param:: a: addr;
;; stack:: w: word -> ;
;;
stvxwfin: ;
w3:=bd,h w s,cjs writenextt; writenextt(b,d,waitmem);
,,cjp fetch ; goto fetch;
.p ;
;;
.instruction stvad , stva , stvxdfin ;
;;
;; param:: a: addr;
;; stack:: d: addr -> ;
;;
stvxdfin: ;
w4:=bd,h w s,cjs readluct ; res.d:= waitmem; readluct;
w3:=bd,h w s,cjs writenextt; writenextt(b,d-1,waitmem);
w3:=w4,,cjs writenext ; writenext(b,d+1,res.d);
,,cjp fetch ; goto fetch;
;;
.instruction stvaf , stva , stvxffin ;
;;
;; param:: a: addr, fb: byte;
;; stack:: f: word -> ;
;;
stvxffin: ;
w3:=bd,h w s,cjs setfieldt ; setfieldt(b,d-1,waitmem);
,,cjp fetch ; goto fetch;
.p ;
;;
.instruction stvlb , stvl , stvxbfin ;
;;
;; param:: rel: word;
;; stack:: byte: word -> ;
;;
;
;;
.instruction stvlw , stvl , stvxwfin ;
;;
;; param:: rel: word;
;; stack:: w: word -> ;
;;
;
;;
.instruction stvld , stvl , stvxdfin ;
;;
;; param:: rel: word;
;; stack:: d: addr -> ;
;;
;
;;
.instruction stvlf , stvl , stvxffin ;
;;
;; param:: rel: word, fbyte: byte;
;; stack:: f: word -> ;
;;
.p ;
;;
.instruction stvgb , stvg , stvxbfin ;
;;
;; param:: rel: word;
;; stack:: byte: word -> ;
;;
;
;;
.instruction stvgw , stvg , stvxwfin ;
;;
;; param:: rel: word;
;; stack:: w: word -> ;
;;
;
;;
.instruction stvgd , stvg , stvxdfin ;
;;
;; param:: rel: word;
;; stack:: d: addr ->
;;
;
;;
.instruction stvgf , stvg , stvxffin ;
;;
;; param:: rel: word, fbyte: byte;
;; stack:: field: word ->
;;
.p ;
;;
.instruction stvib , stvi , stvxbfin ;
;;
;; param:: lev: byte, rel: word;
;; stack:: byte: word -> ;
;;
;
;;
.instruction stviw , stvi , stvxwfin ;
;;
;; param:: lev: byte, rel: word;
;; stack:: w:word -> ;
;;
;
;;
.instruction stvid , stvi , stvxdfin ;
;;
;; param:: lev: byte, rel: word;
;; stack:: d: addr -> ;
;;
;
;;
.instruction stvif , stvi , stvxffin ;
;;
;; param:: lev: byte, rel: word, fbyte: byte;
;; stack:: field: word -> ;
;;
.p ;
;;
.instruction stvsb , stvs , stvsbfin ;
;;
;; param:: rel: word;
;; stack:: byte: word; a: addr -> ;
;;
stvsbfin: ;
,,cjs writebnext ; writebnext(b,d,byte);
,,cjp fetch ; goto fetch;
;;
.instruction stvsw , stvs , stvswfin ;
;;
;; param:: rel: word;
;; stack:: w: word; a: addr -> ;
;;
stvswfin: ;
,,cjs writenext ; writenext(b,d,w);
,,cjp fetch ; goto fetch;
;;
.instruction stvsd , stvsd1 , stvsdfin ;
;;
;; param:: rel: word;
;; stack:: res, a: addr -> ;
;;
stvsdfin: ;
,,cjs writenext ; writemext(b,d,res.b);
w3:=w0,,cjs writenext ; writenext(b,d,res.d);
,,cjp fetch ; goto fetch;
;;
.instruction stvsf , stvs , stvsffin ;
;;
;; param:: rel: word, fbyte: byte;
;; stack:: f: word, a: addr -> ;
;;
stvsffin: ;
,,cjs setfield ; setfield(b,d,f);
,,cjp fetch ; goto fetch;
.p ;
;;
.instruction stwsa ;
;;
;; param:: none;
;; stack:: bc: word; op,res: addr -> ;
;;
ir:=c:=w0-w0,,cjs stgetadbc; cry:= 0; ir.shift:= cyclic;
; bc,op1,op2:= stgetadbc;
w0:=>c>w0,s, ; cry:= bc(15); wc:= bc(0:14);
,,cjs cry renpb10 ; if cry (*odd(bc)*) then goto garb-error;
stwsa10: ;rep:
ir:=w0,,cjp zro fetch ; if wc=0 then goto fetch;
,,cjs readnext ; readnext(op1b,op1d);
w3:=bd,h w s,cjs writenextt; writenextt(op2b,op2d,waitmem);
int,,h ,cjs testint1 ; wc:= wc - 1;
w0:=w0--,s,cjp zro stwsa10 ; if -,testint then goto rep;
w0:=w0+w0,, ; bc:= wc * 2;
;;
;; the interrupt situation has changed, the stack is reestablished
;; and fetch is entered without incremented ic.
;;
;; entry: w0= bc, w1= op2d-1, w2= op2b, w5= op1d-1, w6= op1b;
;; exit : to fetch;
;;
stwsa20: ;new-interrupt:
w3:=w1++,, ; (* op1b and op2b are not written back to *)
w1:=slu+2,, ; (* the stack,as they are always unchanged *)
w2:=slb,,cjs writenext ; writenext(slb,slu+2,op2d+1);
w1:=w1+2,, ;
w3:=w5++,,cjs writenext ; writenext(slb,slu+7,op1d+1);
w3:=w0,,cjs writenext ; writenext(slb,slu+9,bc);
slu:=slu+0a,, ; slu:= slu+10;
sic:=sic--,,cjp fetch ; sic:= sic-1; goto fetch;
.p ;
;;
.instruction stbsa ;
;;
;; param:: none;
;; stack:: bc: word; op,res: addr -> ;
;;
,,cjs stgetadbc ; bc,op1,op2:= stgetadbc;
w5,s, ;
w0,s,cjp b15 stbsa10 ; if even(op1d) then
,,cjs readnext ; begin readnext(op1b,op1d);
w5:=w5-2,h , ; op1d:= op1d-2;
w7:=bd,h w s,cjs terror ; w7:= waitmem; testparity;
w0,s, ; end;
stbsa10: ;rep:
w5,s,cjp zro fetch ; if bc=0 then goto fetch;
ir:=w0,,cjp not b15 stbsa20; if odd(op1d) then
,,cjs readnext ; begin readnext(op1b,op1d);
w5:=w5--,h , ; op1d:= op1d-1; (* +2-1 = +1 *)
w7:=bd,h w s, ; save:= waitmem;
w3:=swp,h ,cjs writebnextt ; writebnextt(op2b,op2d,swap(save));
w0:=w0--,s,cjp stbsa10 ; bc:= bc-1; goto rep;
stbsa20: ; end else
w3:=w7,,cjs writebnext ; begin writebnext(op2b,op2d,save);
w5:=w5++,,cjs testint ; op1d:= op1d + 1;
w0:=w0--,s,cjp zro stbsa10 ; bc:= bc-1; if -,testint then goto rep;
,,cjp stwsa20 ; end; goto new-interrupt;
.p ;
;;
.instruction stcea ;
;;
;; param:: none;
;; stack:: bc: word; op1, op2: addr -> res: word;
;;
,,cjs stgetadbc ; bc,op1,op2:= stgetadbc;
w1,s, ;
c:=w5,,cjp b15 stcea10 ; if even(op2d) then
,,cjs read12 ; begin read12(op2b,op2d);
w4:=bd,h w s,cjs terror ; w3:= waitmem; testparity;
stcea10: ; end;
w0,s,cjp cry stcea20 ; if even(op1d) then
,,cjs readnext ; begin readnext(op1b,op1d);
w5:=w5-2,h , ; op1d:= op1d-2;
w7:=bd,h w s,cjs terror ; w7:= waitmem; testparity;
w0,s, ; end;
stcea20: ;rep:
ir:=w1:=w1++,s,cjp zro stcea60; op2d:= op2d+1; if bc=0 goto end-true;
w3:=w4,,cjp b15 stcea30 ; if even(op2d) then
w1:=w1--,,cjs read12 ; begin
w1:=w1++,h , ; read12(op2b,op2d-1);
w4:=bd,h w s, ; w3:= waitmem;
w3:=swp,h ,cjs pty perror ; w4:= swap(w3); testparity;
stcea30: ; end else w3:= w4;
w5:=w5++,s, ; op1d:= op1d+1;
q:=w7,,cjp b15 stcea40 ; if even(op1d) then
w5:=w5--,,cjs readnext ; begin
w5:=w5--,h , ; readnext(op1b,op1d-1); op1d:= op1d-2;
w7:=bd,h w s, ; w7:= waitmem;
q:=swp,h ,cjs pty perror ; q:= swap(w7); testparity;
stcea40: ; end else q:= w7;
w3:=w3 xor q,, ;
w3:=w3 and 0ff,s, ; w3:= (w3 xor q) and r-mask;
int,,h , ;
lev xor int,h s,cjp not zro stcea50; if w3<>0 then goto end-false;
w0:=w0--,s,cjp zro stcea20 ; bc:= bc-1; goto if lev=int then rep
,,cjp stwsa20 ; else new-interrupt;
stcea50: ;end-false:
w3:=,,cjp wrfetch ; goto wrfetch(false);
stcea60: ;end-true:
w3:=w0++,,cjp wrfetch ; goto wrfetch(true);
.p ;
;;
.instruction revsm ;
;;
;; param:: none;
;; stack:: bc: word; op: addr -> area: array(1..bc/2) of word;
;;
,,cjs readluc ; readluc;
w6:=slb,h , ;
w3:=renpbe0,h , ; err:= odd-byte-count;
c:=w0:=bd,h w s,cjs terror ; bc:= waitmem; cry:= bc(15); testparity;
w5:=w0+4,, ;
q:=w3,,cjp cry xept ; if odd(bc) then expection(err);
,,cjs readluc ; readluc;
w1:=bd,h w s,cjs readluct ; op.d:= waitmem; readluct;
ir:=20,w2:=slb,h , ; ir.shift:= logical;
w3:=bd,h w s,cjs terror ; op.b:= waitmem; testparity;
w5:=w1--,,cjp b1 nillerr ; op.d:= op.d - 1; if nill(op.b) then goto nillerror;
w6:=w3,, ;
w1:=slu,, ;
w0:=>w0,s, ; wc:= bc//2;
setre10: ;rep:
ir:=,,cjp zro fetch ; sync-itr; if wc=0 then goto fetch;
slu:=w1++,,cjs readnext ; readnext(op.b,op.d);
slu:=slu++,h ,cjs tstack ; slu:= slu + 2; tstack;
w3:=bd,h w s,cjs writenextt; writenextt(slb,slu,waitmem);
int,,h ,cjs testint1 ; wc:= wc - 1;
w0:=w0--,s,cjp zro setre10 ; if -,testint then goto rep;
;;
;; the interrupt situation has changed, the stack operands for the
;; instruction are written on top of stack and ftchl is entered
;; without incremented ic.
;; entry: w0= wc, w1= slu, w2= slb, w5= op.d-1, w6= op.b;
;;
w3:=w6,,cjs writenext ; writenext(slb,slu,op.b);
w3:=w5++,,cjs writenext ; writenext(slb,slu,op.d);
w3:=w0,, ;
w3:=w3+w0,,cjs writenext ; writenext(slb,slu,wc+wc (* bc *));
slu:=w1,,cjs tstack ; slu:= workslu; tstack;
sic:=sic--,,cjp fetch ; sic:= sic-1; goto fetch;
.p ;
;; ****** stxsa to be removed in rev.3 ******
.instruction stxsa ;
ir:=c:=w0-w0,,cjs stgetadbc;
w0:=>c>w0,s, ;
w0,s,cjp cry renpb10 ;
stxsa10: ;
,,cjp zro fetch ;
,,cjs readnext ;
w3:=bd,h w s,cjs read12t ;
w7:=bd,h w s,cjs terror ;
,,cjs writenext ;
,,cjs write56 ;
w0:=w0--,s,cjp stxsa10 ;
;;
;; end of lmitxt050c
;;
;;
;; rc3502 sis instructions.
;;
;; file: lmitxt055
;;
;; vers: 801003 hlv
;;
;
;;
.instruction lpush ;
;;
;; param:: none;
;; stack:: r2a, r1a: addr -> ;
;;
,,cjs cget4 ; r1a,r2a:= cget4; (*zrdw=r1a,w87=r2a*)
,,cjs getshare ; r1:= getshare(r1a); (*zrd=r1*)
q:=lpushe1,, ;
zdx:=w6:=w2,,cjp b1 xept ; if nill(r1) or locked(r1) then
,,cjp b0 xept ; exception(lpushe1);
w5:=w1+msgstack,, ; (*zrdx=r1+stack*)
rdx:=w5,,cjs cread1 ; r1stack:= cread1(r1+stack);
bus:=w3:=w1,s,ldct xept ;
w5:=w7,,cjp b1 lpush10 ; if not nill(r1stack)
q:=lpushe2,,jrp b1 ; then exception(lpushe2);
lpush10: ;
w6:=w8,,cjs cread21 ; r2:= cread21(r2a);
w1 xor rd,s,ldct xept ;
w2 xor zd,s,cjp not zro lpush20; if r1 = r2 then
,,cjp not zro lpush20 ; exception(lpushe3);
q:=lpushe3,,jrp not zro ;
lpush20: ;
w4:=w1,, ;
w1:=w3,, ; (*w34=r2*)
w3:=w2,s, ; if locked(r2) then
w6:=zdw,,cjp b0 xept ; exception(lpushe4);
w5:=rdw,,cjs cwrite1 ; cwrite1(r1a,nill);
w1:=w4,, ;
w6:=zdx,, ;
w5:=rdx,,cjs cwrite21 ; cwrite21(r1+stack,r2);
w5:=w5-msgstack,, ;
w2:=w8,, ;
w1:=w7,,cjs cwrite65 ; cwrite65(r2a,r1);
w5:=w5+msgtype,, ;
w8:=w5,,cjs cread1 ; r1kind:= cread1(r1+kind);
bus:=w3,s, ;
bus:=w1,s,cjp b1 cfin4 ; if not nill(r2) and
w6:=w3,,cjp not zro cfin4 ; r1kind = headerkind then
w5:=w4+msgsize,, ; begin (* copy buf. descr. *)
,,cjs cread1 ; size:= cread1(r2+size);
lpushr1= msgsadr - msgsize ;
w5:=w5+lpushr1,, ;
w7:=w1,,cjs cread21 ; addr:= cread21(r2+addr);
lpushr2= msgsadr - msgtype ;
w5:=w8+lpushr2,, ;
w6:=zdx,,cjs cwrite21 ; cwrite(r1+addr,addr);
w5:=w5-lpushr1,, ;
w1:=w7,,cjs cwrite1 ; cwrite1(r1+size,size);
lpush30: ; end; (* copy buf. descr. *)
,,cjp cfin4 ; goto cfin4;
.p ;
;;
.instruction lpop ;
;;
;; param:: none;
;; stack:: r2a, r1a: addr -> ;
;;
,,cjs cget4 ; r1a,r2a:= cget4; (*zrdw=r1a,w87=r2a*)
w6:=zdw,, ;
w5:=rdw,,cjs cread1 ; r1:= cread1(r1a);
bus:=w1,s,ldct xept ; if not nill(r1) then
w2:=w8,,cjp b1 lpop10 ; exception(lpope1);
q:=lpope1,,jrp b1 ;
lpop10: ;
w1:=w7,,cjs cread65 ; r2:= cread65(r2a);
zd:=w6,s,ldct xept ; if locked(r2) then
rd:=w5,,cjp b0 lpop20 ; exception(lpope3);
w2:=zdw,,cjp not b1 lpop30 ; if nill(r2) then
q:=lpope2,,jrp not b1 ; exception(lpope2);
lpop20: ;
q:=lpope3,,jrp b0 ;
lpop30: ;
w1:=rdw,,cjs cwrite65 ; cwrite65(r1a,r2);
w5:=w5+msgstack,, ;
bus:=40,w1:=w1-w1,, ; r2stack:= nill;
w2:=swp,,cjs cexch21 ; r2stack :=: cexch(r2+stack);
w6:=w8,, ;
w5:=w7,,cjs cwrite21 ; cwrite21(r2a,r2stack);
w6:=zd,, ;
w5:=msgtype,, ;
w5:=w5+rd,,cjs cread1 ; r2kind:= cread1(r2+kind);
bus:=40,w1,s, ; if r2kind=headerkind then
w3:=swp,,cjp not zro cfin4 ; begin (*clear buf. descr.*)
lpopr1= msgsize - msgtype ;
w5:=w5+lpopr1,, ;
,,cjs cwrite1 ; cwrite1(r2+size,0);
lpopr2= msgsadr - msgsize ;
w5:=w5+lpopr2,, ;
w1:=w3,,cjs cwrite1 ; cwrite1(r2+addr,nill);
,,cjp cfin4 ; end; goto cfin4;
;;
;; end of lmitxt055c
;;
;;
;; begin lmitxt075
;;
;; usage of registers in process synchronizing instructions
;;
;; generally z means base, and r means disp
;;
;; w2=level
;; w1=pu
;;
;; w21 and w65 are used as addr and data in the read procedures
;; ra=rawork
;; ir=0300: w=01, x=10
;;
;; z/rd0: lbd b
;; z/rd1= z/rdw: shptr
;; z/rd2= z/rdx: lbd a
;; z/rd3= z/rd: share
;; w43: nbd
;; w87: hbd a
;; w109: hbd b
;; w11: share + semrel
;; w0:
;;
.p ;
;;
;; procedure cwrite21 (* 13x = 2,82us *)
;;
;; entry: w6= b; w5= d; w2= db; w1= dd;
;; exit : w5= w6= w2= w1= unch; w0= w5+1; memaddr(w6,w5)= db,dd;
;;
cwrite21: ;proc cwrite21;
ba:=w6,,cjs mma ; ba:= b; seladdr;
bd:=w5,w0:=w5++,h ,cjs mmd ; xbus:= d; seldata;
bd:=w2,h w ,cjs mma ; xbus:= db; write; seladdr;
bd:=w0++,h ,cjs mmd ; xbus:= d+2; seldata;
bd:=w1,h w ,crtn ; xbus:= dd; write; return;
;;
;; procedure cwrite1 (* 7x = 1,52us *)
;;
;; entry: w6= b; w5= d; w1= data;
;; exit : w6= w5= w1= unch; mem(w6,w5)= data;
;;
cwrite1: ;proc cwrite1;
ba:=w6,,cjs mma ; ba:= b; seladdr;
bd:=w5,h ,cjs mmd ; xbus:= d; seldata;
bd:=w1,h w ,crtn ; xbus:= data; write; return;
;;
;; procedure cwrite65 (* 13x = 2,82us *)
;;
;; entry: w2=b; w1= d; w6= db; w5= dd;
;; exit : w2= w1= w6= w5= unch; w0= w5+1; memaddr(w6,w5)= db,dd;
;;
cwrite65: ;proc cwrite65;
ba:=w2,,cjs mma ; ba:= b; seladdr;
bd:=w1,w0:=w1++,h ,cjs mmd ; xbus:= d; seldata;
bd:=w6,h w ,cjs mma ; xbus:= db; write; seladdr;
bd:=w0++,h ,cjs mmd ; xbus:= d+2; seldata;
bd:=w5,h w ,crtn ; xbus:= dd; write; return;
;;
;; procedure cwrite6 (* 7x = 1,52us *)
;;
;; entry: w2= b; w1= d; w6= data;
;; exit : w2= w1= w6= unch; mem(w2,w1)= data;
;;
cwrite6: ;proc cwrite6;
ba:=w2,,cjs mma ; ba:= b; seladdr;
bd:=w1,h ,cjs mmd ; xbus:= d; seldata;
bd:=w6,h w ,crtn ; xbus:= data; write; return;
;;
;; procedure cexch21 (* 17x = 3,69us *)
;;
;; entry: w6= b; w5= d; w2= db; w1= dd;
;; exit : w6= w5= unch; w0= q= undf;
;; mem(w6,w5) :=: db; mem(w6,w5+2) :=: dd;
;;
cexch21: ;proc cexch21;
ba:=errb:=w6,,cjs mma5 ; ba:= b; seladdr5;
bd:=w5,w0:=w5++,h r , ; xbus:= d; read;
q:=bd,h w s,cjs thmmd ; db1:= waitmem; thseldata;
bd:=w2,w2:=q,h w ,cjs mmaq ; xbus:= db; write; db:= db1; seladdrq;
bd:=w0++,h r , ; xbus:= d+2; read;
q:=bd,h w s,cjs thmmd ; dd1:= waitmem; thseldata;
bd:=w1,w1:=q,h w ,crtn ; xbus:= dd; write; dd:= dd1; return;
;;
;; procedure cread65 (* 10x = 2,17us *)
;;
;; entry: w2= b; w1= d;
;; exit : w2= w1= unch; w0= undf; w6= mem(w2,w1); w5= mem(w2,w1+2);
;;
cread65: ;proc cread65;
ba:=errb:=w2,,cjs mma1 ; ba:= b; seladdr1;
bd:=w1,w0:=w1++,h r , ; xbus:= d; read;
w6:=bd,h w s,cjs therror ; w6:= waitmem; therror;
bd:=errd:=w0++,h r , ; xbus:= errd:= d+2; read;
w5:=bd,h w s,cjp therror ; w5:= waitmem; therror; return;
.p ;
;;
;; procedure cread21 (* 10x = 2,17us *)
;;
;; entry: w6= b; w5= d;
;; exit : w6= w5= unch; w0= undf; w2= mem(w6,w5); w1= mem(w6,w5+2);
;;
cread21: ;proc cread21;
ba:=errb:=w6,,cjs mma5 ; ba:= b; seladdr5;
bd:=w5,w0:=w5++,h r , ; xbus:= d; read;
w2:=bd,h w s,cjs therror ; w2:= waitmem; therror;
bd:=errd:=w0++,h r , ; xbus:= d+2; read;
w1:=bd,h w s,cjp therror ; w1:= waitmem; therror; return;
;;
;; procedure cread1 (* 6x = 1,30us *)
;;
;; entry: w6= b, w5= d;
;; exit : w6= w5= unch; w1= mem(w6,w5);
;;
cread1: ;proc cread1;
ba:=errb:=w6,,cjs mma5 ; ba:= b; seladdr5;
bd:=w5,h r , ; xbus:= d; read;
w1:=bd,h w s,cjp therror ; w1:= waitmem; therror; return;
;;
;; procedure creadbyte1 (* 9,5x = 2,06us *)
;;
;; entry: w6= b; w5= d;
;; exit : w6= w5= unch; w1= membyte(w6,w5); q= 0ff;
;;
creadbyte1: ;proc creadbyte1;
c:=w5,,cjs cread1 ; cry:= odd(d); w1:= cread(w6,w5);
q:=0ff,, ; rmask:= 0ff;
w1,w1:=w1 and q,,crtn cry ; w1:= if cry then w1 and rmask
w1:=swp and q,,crtn ; else swap(w1) and mask;
.p ;
cget2: ;;
,,cjs readluc ;
w0:=bd,h w s,cjs readluct ;
w1:=bd,h w s,cjs terror ;
setrair: ;
ra:=rawork,,, ;
ir:=300,,,crtn ;
;;
;; procedure cget4
;;
;; entry: -
;; exit : w10= w87= op1, w32= zrdw= op2, ra= rawork, ir= 300;
;;
cget4: ;;
,,cjs readlu4c ;
w3:=bd,h w s,cjs terror ;
w7:=w0,,cjs setrair ; w87:=hbd:=semaphore
w8:=w1,s, ;
rdw:=w2,, ; shptr
zdw:=w3,,crtn ;
;
cfin4: ;cfin4:
,,cjs setslice ; setslice must not update stat
ir:=8,slu:=slu-8,, ; sync itr; slu:= slu-8;
sic:=sic++,,cjp fetch ; sic:= sic+1; goto fetch;
;
cfin22: ;cfin22:
,,cjs setslice ; setslice must not update stat
ir:=4,slu:=slu-4,, ; sync itr; slu:= slu-4;
sic:=sic+2,, ; sic:= sic+2;
,,cjp fetch ; goto fetch;
;
cfin0: ;cfin0:
ir:=,,cjs setslice ; setslice must not update stat
sic:=sic++,,cjp fetch ; sic:= sic+1; goto fetch;
.p ;
;;
;; procedure getshare
;;
;; entry: rzdw= shptraddr;
;; exit : zrd= w21= mem(shptraddr); stat(w2) set;
;;
getshare: ;;
w5:=rdw,, ; shptr
w6:=zdw,,cjs cread21 ;
zd:=w2,s, ; share
rd:=w1,,crtn ;
;
reservea: ; return: zrdx= w21= lbd a; stat(lb a) set;
w5:=w7,, ; hdb a
w6:=w8,,cjs cread21 ;
zdx:=w2,s, ; lbd a
rdx:=w1,,crtn ;
;
reserveb: ; return: zrd0= w21= ldb b; stat(lb b) set;
w5:=w9,, ;
w6:=w10,,cjs cread21 ;
zd0:=w2,s, ; lbd b
rd0:=w1,,crtn ;
.p ;
setrefshwt: ;; sets ref (share waited) of receiver (=nbd)
w5:=w3+shwt,, ;
w6:=w4,,cjs cread21 ; w21:=ref
w5:=rd,, ; w65:=share
w6:=zd,,cjp cwrite65 ; ref(share waited):=share
;
setchhead: ;; mem(nbd.chainhead):=hbd b
w5:=w3+chainhead,, ;
w6:=w4,, ;
w1:=w9,, ; chainhead:=hbd b
w2:=w10,,cjp cwrite21 ;
;
unchain: ;;
rdx-w3,s, ; test lbd a - nbd
zdx-w4,s,cjp not zro unchain2;
bus:=40,,, ;
w6:=swp,,cjp zro unchain3 ;
;
unchain2: ;;
w5:=w3,, ;
w6:=w4,,cjs cread21 ; w21:=fbd
w5:=rdx,, ; w65:=lbd a
w6:=zdx,,cjp cwrite21 ;mem(lbd a):=fbd; return;
unchain3: ;;
w2:=w8,, ; w21:=hbd a
w1:=w7,,cjp cwrite6 ; sem:= nill; return;
;
changeab: ;;
w9:=w7,, ; hbd b:=hbd a
w10:=w8,, ;
q:=rdx,, ; lbd b:=lbd a
rd0:=q,, ;
q:=zdx,, ;
zd0:=q,,crtn ;
.p ;
chain: ;; chain nbd to hbd b, lbd b
;; if cry and lbd b was nill then setlevel(membyte(nbd+puno),1)
;;
;
w6:=zd0,s, ; w65:=lbd b
w5:=rd0,, ;
w2:=w4,, ; w21:=nbd
w1:=w3,,cjp b1 chain3 ;
,,cjs cexch21 ; w21:=:mem(lbd b)
w6:=w4,, ; w65:=nbd
w5:=w3,,cjs cwrite21 ; mem(nbd):=w21
;
chain2: ;;
w2:=w10,, ; w21:=hbd b
w1:=w9,,cjp cwrite65 ; mem(hbd b):=nbd
;
chain3: ;; sem=nill
w6:=w4,, ;
w5:=w3,,cjs cwrite21 ; mem(nbd):=nbd
,,cjp not cry chain2 ;
; setlevel(monitor);
w0:=monitrlev,, ;
,,cjs setlint ;
ra:=rawork,,, ;
w5:=w3,,cjp chain2 ;
;
chainfirst: ;
w6:=zd0,s, ;
w2:=w4,,cjp b1 chain ; if nil(lbd b) then goto chain
w5:=rd0,, ; w65:=lbd b; w21:=nbd
w1:=w3,,cjs cexch21 ; w21:=:mem(lbd b)
w6:=w4,, ;
w5:=w3,,cjp cwrite21 ; mem(nbd):=w21; return;
;
putelemptr: ;; mem(elemptr):=nbd
w5:=rdw,, ; w65:=elemptr
w6:=zdw,, ;
w1:=w3,, ; w21:=nbd
w2:=w4,,cjp cwrite21 ; mem(elemptr):=nbd
.p ;
signal: ;;
,,cjs reservea ; lbd a:=w21:=mem(hbd a)
rdx,,s,cjp b1 sig5 ; jump if passive
;
,,cjp not b15 sig5 ; jump if open
,,cjs cread65 ; w21=lbd a
w3:=w5,, ; w43=nbd
w5:=w5+level,, ;
w4:=w6,,cjs creadbyte1 ;
w2:=w1,s, ; w2:=level
,,cjp not zro sig4 ; jump if level>0
w5:=w3+actq,, ;
,,cjs cread21 ;
w9:=w1,, ; w109:=hbd b:=active queue
w10:=w2,,cjs reserveb ;
,,cjs setrefshwt ; ref(nbd.shwt):=share
,,cjs setchhead ; mem(nbd.chainhead):=hbd b
,,cjs unchain ; unchain nbd from hbd a, lbd a
c:w0--w0,,cjs chain ; cry means setlevel
,,cjp sig6 ;
sig4: ; signal to receiver on level>0
w10:=w2,,cjs setrefshwt ; save level; ref(nbd.share waited):=share
w6:=w4,,cjs setlint ;
ra:=rawork,,, ;
w5:=w3+chainhead,, ;
bus:=40,,, ;
w1:=swp,,cjs cwrite1 ; mem(nbd.chainhead):=nill
,,cjs unchain ;
,,cjp sig6 ;
sig5: ; signal to an empty or an open semaphore
,,cjs changeab ;
w4:=c:zd,, ; c=0 means no setlevel
w3:=rd,,cjs chain ; nbd:=share
sig6: ;
w5:=rdw,,cjs nill ;
w1:=swp,, ;
w6:=zdw,,cjp cwrite1 ; shptr:=nill
.p ;
wait0: ;;
,,cjs getshare ; share:=mem(shptr)
,,crtn not b1 ; return if shptr not nill
,,cjs reservea ; lbd a:=w21:=mem(hbd a)
rdx,,s,cjp b1 wait2 ; jump if passive
wait1c: ;;
,,cjp b15 wait2 ; jump if locked
wait1a: ; sem open
,,cjs cread65 ; w21=lbdfrom
w3:=w5,, ; w43:=nbd
w4:=w6,,cjs unchain ;
,,cjp putelemptr ; mem(shptr):=share; return;
wait2: ; nill
ra:=reg,, ;
w4:=zd2,, ; w43:=nbd:=this process
w3:=rd1,, ;
ra:=rawork,w6:=w4,, ;
w5:=w3+shwt,, ;
w1:=rdw,,cjs changeab ; w21:=shptr
w2:=zdw,,cjs cwrite21 ; mem(nbd.shwt):=shptr
reg xor 7,s, ;
,,cjp zro wait3 ; jump if lev=0
,,cjs clear ; clear level
,,cjp wait5 ; goto wait5
;
wait3: ; lev=0
w5:=w3+chainhead,, ;
,,cjs cread21 ;
w7:=w1,, ; hbd a:=active queue
w8:=w2,,cjs reservea ; reserve active queue
,,cjs unchain ;
w0:=monitrlev,, ;
,,cjs setlint ;
wait5: ;; chain process to sem
,,cjs setchhead ; mem(nbd.chainhead):=hbd b
c:=,,cjp chain ; return;
.p ;
.instruction csign ;
,,cjs cget4 ;
,,cjs getshare ; share:=mem(shptr)
,,cjp b1 csign1 ;
,,cjs signal ;
,,cjp cfin4 ;
;
csign1: ;;
q:=csigne,, ;
,,cjp xept ;
;
.instruction crele ;
,,cjs readbcont ; w4:=semrel
,,cjs cget2 ;
rdw:=w0,, ; z/rdw := shptr
zdw:=w1,,cjs getshare ; z/rd := share
w7:=rd+w4,, ; hbd a := share + semrel
w8:=zd,,cjp zro csign1 ; jump if shptr=nill
,,cjs reservea ; reserve pointer to sem
w7:=rdx,, ;
w8:=zdx,,cjs signal ; hbd a:=sem
,,cjp cfin22 ;
.instruction cwait ;
,,cjs cget4 ;
,,cjs wait0 ;
,,cjp cfin0 ;
;
.instruction csens ;
,,cjs cget4 ;
,,cjs getshare ;
,,cjp not b1 cfin4 ; if shptr<>nill then goto fin
,,cjs reservea ;
rdx,,s,cjp b1 csens3 ;
,,cjp b15 csens3 ; jump if not open
,,cjp wait1a ;
;
.p ;
.instruction cwtac ;
,,cjs cget4 ;
w6:=zdw,, ; w65:=shptr
w5:=rdw,,cjs cread1 ;
w6:=w8,h ,cjp not b1 cfin4 ; jump if not nill
,h ,cjs clear ;
,,cjp sfetch ;
;
.instruction cllst ;
,,cjs cget4 ;
w10:=w8,, ; hbdb:=hbda
w9:=w7,,cjs reserveb ;
,,cjs getshare ;
w3:=rd,, ; nbd:=share
w4:=c:zd,,cjs chain ; cry:=false
,,cjp cfin4 ;
;
.instruction cufst ;
,,cjs cget4 ;
,,cjs reservea ;
,,cjp not b1 cufst1 ; jump if not nill
csens3: ;
bus:=40,,, ;
w4:=swp,,cjp cufst2 ; nb:=nill
cufst1: ;;
,,cjs cread65 ; w21=lbda
w3:=w5,, ; w43:=nbd
w4:=w6,,cjs unchain ;
cufst2: ;;
,,cjs putelemptr ; mem(elemptr):=nbd
,,cjp cfin4 ;
.p ;
.instruction csell ;
,,cjs readluc ; newlevel:=unstack
w11:=bd,h w s,terror ;
w3:=rd1,, ; nbd:= (spb, pr)
w4:=spb,, ;
w5:=w3+actq,, ;
w6:=w4,,cjs cread21 ; hbd a:=mem2(nbdü.actq);
w7:=w1,,cjs setrair ;
w8:=w2,,cjs reservea ; reserve a
w0:=lev,,cjs clear ; clear(lev)
w11,s, ;
,,cjp not zro csell3 ; jump if newlevel<>0
reg xor 7,s, ;
,,cjp zro csell4 ; jump if lev=0
; newlevel=0, lev<>0
,,cjs changeab ; change a b
,,cjs setchhead ; setchhead
c:=,,cjs chainfirst ; chainfirst(false)
,,cjp csell4 ;
csell3: ; newlevel<>0
w0:=w11,,cjs setlint ; setlint(newlevel)
reg xor 7,s, ;
,,cjp not zro csell4 ; jump if lev<>0
bus:=40,,, ;
; newlevel<>0, lev=0
w10:=swp,,cjs setchhead ; hbd b.base:=nill; setchhead
,,cjs unchain ; unchain
w0:=monitrlev,, ;
,,cjs setlint ; setlint(monitrlev)
.p ;
csell4: ;
w2:=w4,, ;
levelm1= level - 1 ;
w1:=w3+levelm1,, ;
w3:=w11,,cjs writebnext ; membyte(nbdü.level):=newlevel
w3:=w1-level,, ;
ra:=reg,,cjs dumpregs ; dumpregs(reg)
,,cjs loadregs ; loadregs(nbd); w7:=nbdü.level
reg:=w11,,push 2 ;
ra:=reg:=reg++reg,,rfct ;
w0:=4,, ;
,,cjs clearbits ; to:=false
lev:=w11,,cjs setslice ; lev:=newlevel
slu:=slu-2,, ;
sic:=sic++,,cjp fetch ; goto fetch
.p ;
.instruction cstop ;
,,cjs cget4 ; hbda:=addr; shptr:=process descr
w5:=rdw,, ;
w5:=w5+chainhead,, ;
w6:=zdw,,cjs cread21 ;
w10:=w2,s, ; hbdb:=shptr.chainhead
,,cjp b1 cupro20 ; jump if chainhead nill
w9:=w1,,cjs reserveb ;
w8,s, ;
,,cjp not b1 cupro3 ; jump if nill
cupro4: ; first loop
w7:=rd0,, ; hbda:=lbdb
w8:=zd0,, ;
,,cjp cupro5 ;
cupro3: ; not first loop
w5:=w7,, ; test if the process 'hbda' has been moved
w5:=w5+chainhead,, ; away from the semaphore
w6:=w8,,cjs cread21 ;
w10-w2,s, ;
w9-w1,s,cjp not zro cupro4 ; the process has been moved
,,cjp not zro cupro4 ;
cupro5: ;;
w6:=w8,, ;
w5:=w7,, ;
cupro6: ;;
,,cjs cread21 ;
w1-rdw,s, ;
w2-zdw,s,cjp not zro cupro7;
,,cjp zro cupro8 ;
cupro7: ; the process has not been found yet
ir:=300,w6:=w2,, ;
w5:=w1,,cjs testint ;
,,cjp zro cupro6 ; goto cupro6 if no higher interrupts
;
;; higher interrupts pending
;
w4:=w6,,cjs setslice ;
slu:=slu-8,, ;
w3:=w5,,cjp wr34fetch ;
.p ;
cupro8: ;; the process has been found
;; w65= process just before this process
;; w21= z/rdw= this process
;; w109= the semaphore
;; z/rd0= last
w5-w1,s, ;
w6-w2,s,cjp not zro cupro9 ;
,,cjp not zro cupro9 ;
;; only this process in the queue
bus:=40,,, ;
w2:=swp,,cjp cupro11 ; last:=nill
cupro9: ;;
w4:=w6,, ; w43:=the process just before this process
w3:=w5,,cjs cread65 ; w65:= process after this process
w2:=w4,, ;
w1:=w3,,cjs cwrite65 ; unchain
q:=rd0,, ; last process
q-rdw,s, ; this process
q:=zd0,, ;
q-zdw,s,cjp not zro cupro10;
,,cjp zro cupro11 ;
cupro10: ;;
w2:=zd0,, ; w21:= last
w1:=rd0,, ;
cupro11: ;;
w6:=w10,, ; w65:= head
w5:=w9,,cjs cwrite21 ;
cupro20: ;; chainhead=nill
;; you must never stop a level0 process twice
w5:=rdw,, ;
w5:=w5+level,, ;
w6:=zdw,,cjs creadbyte1 ; w1:=level
w1,s,push 2 ;
ra:=w1:=w1++w1,,rfct ;
,,cjs not zro dumpregs ; dumpregs(level * 8 + 7)
,,cjp cfin4 ;
.p ;
;;
.instruction cexch ;
;;
;; param:: none;
;; stack:: ad1, ad2: addr -> ;
;;
,,cjs cget4 ; ad1, ad2:= cget4;
w6:=w3,, ;
w5:=w2,,cjs cread21 ; ref:= cread21(ad2);
w2,s,ldct xept ; if locked(ref) then
w6:=w8,,cjp b0 cexch20 ; exception(locked);
w5:=w7,,cjs cexch ; ref :=: exch(ad1);
w2,s,ldct xept ; if locked(w21) then
w6:=zdw,,cjp b0 cexch10 ; goto cexchxept;
w5:=rdw,,cjs cwrite21 ; cwrite(ad2,ref);
,,cjp cfin4 ; goto cfin4;
cexch10: ;cexchxept:
w6:=w8,,cjs cwrite21 ; cwrite21(ad1,w21); (* reestablish ref *)
cexch20: ;
q:=w0,,jrp not b0 ; goto exception(locked);
;;
;; end lmitxt075c
;;
;;
;; rc3502 debug micro communication instructions
;;
;; rev: 801002 fh/hlv
;;
;; file: lmitxt077c
;;
;
;;
.instruction crram ;
;;
;; param:: none;
;; stack:: ramdisp: word -> rambyte: word;
;;
w6:=0,,cjs readlucq ; ram.base:= 0; ram.disp:= readlucq;
w5:=q,,cjs creadbyte1 ; byte:= creadbyte1(ram.base,ram.disp);
w3:=w1,,cjp wrfetch ; goto wrfetch(byte);
;
;;
.instruction cwram ;
;;
;; param:: none;
;; stack:: byte, ramdisp: word -> ;
;;
w2:=,,cjs readlucq ; ram.base:= 0; byte:= readlucq;
w3:=q,,cjs readlucq ; ram.disp:= readlucq;
ra:=cow,w1:=q--,, ;
rd,rd,s, ;
bus:=w3,,cjp not zro sfetch;
w0:=w1+swp,,cjs writebnext ;
w0:=w0+81,, ;
rd:=w0,, ;
led:=6,,, ;
ra:=reg,,cjp fetch ;
;;
;; end of lmitxt077c
;;
;;
;; lmitxt078c, set instructions
;;
;; rev: 801003 fh/hlv
;
;
;; all the set instructions, except setcr, share a common
;; code part, which takes care of:
;; 1. calculation of the address and length of the setoperand2
;; 2. calculation of the address and length of the setoperand1
;; 3. fetch of the next words from the setoperands
;; 4. finishing of the setinstructions
;
;; the setinstructions are interruptable by higher priority
;; interrupts. if a setinstruction is interrupted, then the
;; internal variables are stored on top of the stack, and
;; the bit "resume instruction" in the registerset is set
;; equal to one. when resuming an interrupted setinstruction
;; the above mentioned point 1 and 2 are replaced by fetching
;; the internal variables.
;
;; after execution of point 1 and 2 it is checked that the
;; addresses and lengths are even. at that time a preliminary
;; lastused is also calculated, and it should be tested that
;; there is room enough in the stack. this preliminary lastused
;; will not be changed during the execution of the setinstruction,
;; and it will be high enough, so that the internal variables
;; can be stored in the stack without increasing this lastused.
;; the final lastused will be calculated, when the setinstruction
;; is finished.
.p ;
;; parameters and result of the setinstructions:
;;
;; setun, setin, setdi:
;; entry: set1, length1, set2, length2
;; exit: resulting▶7f◀set, resulting▶7f◀length
;;
;; seteq, setsb, setsp:
;; entry: set1, length1, set2, length2
;; exit: boolean
;;
;; setst:
;; entry: address1, set2, length2
;; exit:
;;
;; setre:
;; entry: address2, length2
;; exit: set2, length2
;;
;; revsm:
;; entry: address2, length2
;; exit: set2
;;
;; setad:
;; entry: set2, length2, newlength
;; exit: resulting▶7f◀set, newlength
;;
;; setcr:
;; entry: from, to
;; exit: resulting▶7f◀set, resulting▶7f◀length
.p ;
;; the slice registers are used as follows during execution
;; of the setinstructions:
;;
;; w0 counter: counts the byteno(incremented by 2) of
;; the wordno of the set.
;; w21 address1: current address of the resulting set, and
;; of setoperand1 in case of dyadic setinstructions
;; (f. i. setun and seteq)
;; w3 setop1: the next word of set1, and the next word of
;; the resulting set.
;; w4 setop2: the next word of set2.
;; w65 address2: current addres of setoperand2.
;; in case of setcr w5 and w6 are used as follows:
;; w5 from: start of the interval, which defines the set.
;; w6 to: end of the interval, which defines the set.
;; w7 control bits: a bitmask, that controls the microprogram
;; flow of the setinstruction(for further explanation, see
;; below).
;; w10 length1 ( newlength in case of setad, zero if unused)
;; w11 length2
;; during the above mentioned point1 and 2 the registers w3 and w4
;; are temporaryly used instead of the registers w5 and w6.
.p ;
;; description of the control bits:
;;
;; the control bits, which reside in w7 are used by the common code
;; part to control the microprogram flow. the bits are used as
;; follows:
;;
;; part: 1 2 2 2 3 3 4 4 1
;; bit 8 9 10 11 12 13 14 15 7 hex
;;
;; setun:
;; setin:
;; setdi: . 1 1 . . 1 1 . . 66
;;
;; seteq:
;; setsb:
;; setsp: . 1 1 . . 1 . 1 . 65
;;
;; revsm: . . . . . . 1 1 1 103
;;
;; setre: . . . . . . 1 . 1 102
;;
;; setst: . 1 . . . . . . . 40
;;
;; setad: 1 . . . . . 1 . . 82
;;
;;
;; setcr: 1 . . 1 1 . 1 . 1 19a
;;
;; the bits are used in parts 1 thru 4 of the common code part
;; as indicated above.
.p ;
;; part 1, calculate the address and length of setoperand2.
;
prepset: ;
q:=10,, ;
zd1 and q,s, ; zro:=not resume instruction
w1:=c:slu,,cjp not zro prepset10; c:=0; c,w1 is used to calculate the preliminary lu
; if resume then jump
q:=zd1 ior q,, ; resume:=true
zd1:=q,, ;
w0:=0,,cjs readlucq ;
w7,w10:=0,s, ; length1:=0;
w11:=q,,cjp not b15 prepset2; jump if not revsm and not setre and not setcr;
w4:=w11,,cjs readlucq ;
w7,w3:=q,s, ; w4:=w11; w3:=readlucq;
,,cjp b0 prepset1 ; jump if setcr
w3:=w3--,,cjs readlucq ; w3:=disp2-1
w4:=q,,cjp not b1 prepset4 ; w4:=base2
,,cjp nillerr ;
;
prepset1: ;; setcr
;; w3=from, w4=to
w11:=c:w11+10,, ; w11:=to+16
ir:=2,q:=w1-2,,push 2 ; prepare rotate
c:=7fc,w11:=>w11 and 7fc,,rfct ; length2:= to // 16 * 2 + 2 ;
w1:=c:w11+q,,cjp prepset4 ; c,w1:=newlu
;
prepset2: ;; setdyadic, setst, setad
w4:=slb,,cjp not b0 prepset3; base2:=slb; jump if not setad
w10:=w11,,cjs readlucq ; length1:=newlength
w2:=w10-q,s, ; length2:=readlucq ; acy:=newlength >= length2
w11:=q,,cjp not acy prepset3; jump if not newlength >= length2
w1:=w1+w2,, ; increment preliminary lu
;
prepset3: ;
slu:=slu-w11,, ; skip over set2
w3:=slu,, ; disp2:= the beginning of set2
.p ;
;; part 2, calculation of the address and length of setoperand1
;
prepset4: ;; read the second operand
;; c,w1 + setworklen = preliminary lu
;; w7= control bits
;; w10=if setad then newlength else 0
;; w43=if setcr then (to,from) else address2
;; w11=length2
;; w0=0
;
;; stack overflow is tested now
,,cjp cry stackerror ; overflow into next memory module
q:=w1+setworklen,s, ; q:=preliminary lu
,,cjp acy stackerror ; overflow into next memory module
zd0-q,s, ;
,,cjp not acy stackerror ; overflow if not lm>=preliminary lu
;
w7:=w7+w7,s, ; set preliminary lu
zd:=q,,cjp b0 prepset6 ; jump if setdyadic or setst
;
prepset5: ;
w2:=slb,, ; address1:=lastused
w1:=slu,,cjp prepset8 ;
;
prepset6: ;; setdyadic or setst
,,cjs readlucq ;
w7,s, ;
w1:=q--,,cjp b1 prepset7 ; jump if setdyadic
,,cjs readlucq ;
w2:=q,,cjp not b1 prepset8 ; w21:=address1
,,cjp nillerr ;
;
prepset7: ;; setdyadic
w10:=q,, ; length1:=readlucq
slu:=slu-w10,,cjp prepset5 ; skip over set1
;
prepset8: ;
w7:=<w7+w7,, ;
w7:=w7+w7,s, ; acy:=setcr
w8:=1,, ;
w8:=w8 and w1,,cjp acy prepset9;
w8:=w8 and w3,, ;
prepset9: ;
w8:=w8 clr w10,, ;
w8:=w8 clr w11,s, ; zro means addresses or lengths are odd
q:=setodde,, ;
w5:=w3,,cjpp zro xept ; jump if exception
w6:=w4,,crtn ; w65:=w43
;
prepset10: ;; resume the instruction after interrupt
w7:=<w7+w7,, ;
w7:=<w7+w7,, ; cjs readlucq
w11:=q,,cjs readlucq ;
w10:=q,,cjp stgetadbc ;
.p ;
;; part 3 fetch of the next words from the setoperands
;
getsetop: ;
w0-w10,s, ; acy:= w0>=w10
w0-w11,s,cjp not acy getsetop1;
,,cjp acy setfin ; fin
getsetop1: ;
w0:=w0+2,, ; counter:=counter+2
w7+w7,s, ; status of control bits
w11-w0,s,cjp not acy getsetop3; jump if not setcr
;; setcr
w4:=w0-2,,push 2 ;
w4:=w4+w4,,rfct ; w4:=bitno
w3:=0,,push 0f ; w3:=the next bitword of the set
w3:=w3+w3,, ; shift w3
w4-w5,s, ; acy:=bitno>=from
w6-w4,s,cjp not acy getsetop2; acy:=t0>=bitno
,,cjp not acy getsetop2 ;
w3:=w3++,, ; set a bit
getsetop2: ;
w4:=w4++,,rfct ; loop
w4:=0,,crtn ;
;
getsetop3: ;; not setcr
;; acy: length2>=counter
w8:=w0,, ;
w4:=0,,cjp not acy getsetop3a;
,,cjs readnext ;
w4:=bd,h w s,cjs terror ;
getsetop3a: ;
w7+w7,s, ;
w3:=,,cjp not b0 getsetop4 ; jump if not dyadic
;;
;; fetch setoperand1
;;
w10-w8,s, ;
,,cjp not acy getsetop4 ; jump if length1>=counter
,,cjs read12 ;
w3:=bd,h w s,cjs terror ;
;
getsetop4: ;
w0:=w8,,crtn ;
.p ;
putsetop: ;
ir:=,,cjs writenext ; syncronize itr
settestitr: ;
int,,h ,cjs testint1 ;
w4:=w2,,crtn zro ; return if no interrupt
;
;; interrupt
w8:=w1,, ; save w21
w1:=zd,, ;
w2:=zd2,, ; w21:=lastused
w1:=w1-setworklen,, ;
w3:=w4,,cjs writenext ;
w3:=w8++,,cjs writenext ; write the internal variables
w3:=w6,,cjs writenext ; to the top of stack
w3:=w5++,,cjs writenext ;
w3:=w0,,cjs writenext ;
w3:=w10,,cjs writenext ;
w3:=w11,,cjs writenext ;
,,cjp sfetch ;
;
advance: ;
w1:=w1+2,, ;
,,cjp settestitr ;
.p ;
;; part 4, finishing of the setinstructions
;
setfin: ;
w7:=<w7+w7,,loop ;
w7,s, ;
w3:=w10,,cjp b0 setfin2 ; jump if setresult on top of stack
;
;; no set result on top of stack
,,cjp not b1 setfin1 ; jump if not boolean result
;
;; boolean result
w3:=1,, ; result:=true
w1:=w1-w0,,cjp setfin3 ;
;
setfin1: ;; setst
w1:=w5-4,, ; unstack
w1:=w1-w11,,cjp setfin4 ;
;
setfin2: ;; setresult on top of stack
w10-w11,s,cjp b1 setfin4 ; jump if revsm
,,cjp acy setfin3 ;
w3:=w11,, ; w3:=max( length1, length2 )
;
setfin3: ;
,,cjs writenext ; write length or boolean result
;
setfin4: ;
q:=zd1,, ;
q:=q clr 10,, ; resume instruction:=false
zd1:=q,, ;
zd:=w1,,cjs setslice ; update lastused
sic:=sic++,,cjp fetch ;
;
setfalse: ;
w3:=0,, ;
w0:=w0-2,, ; counter:=counter-2
w1:=w1-w0,,cjp setfin3 ;
.p ;
.instruction setun ; set union
bus:=66,,, ;
setun0: ;
w7:=swp,,cjs prepset ;
setun1: ;
,,cjs getsetop ;
w3:=w3 ior w4,,cjs putsetop;
,,cjp setun1 ;
;
.instruction setin ; set inclusion
bus:=66,,, ;
w7:=swp,,cjs prepset ;
setin1: ;
,,cjs getsetop ;
w3:=w3 and w4,,cjs putsetop;
,,cjp setin1 ;
;
.instruction setdi ; set difference
bus:=66,,, ;
w7:=swp,,cjs prepset ;
setdi1: ;
,,cjs getsetop ;
w3:=w3 clr w4,,cjs putsetop;
,,cjp setdi1 ;
;
.instruction seteq ; set equal
bus:=65,,, ;
w7:=swp,,cjs prepset ;
seteq1: ;
,,cjs getsetop ;
w3-w4,s, ;
,,cjp not zro setfalse ;
,,cjs advance ;
,,cjp seteq1 ;
;
.instruction setsb ; set subset
bus:=65,,, ;
w7:=swp,,cjs prepset ;
setsb1: ;
,,cjs getsetop ;
w3 clr w4,s, ;
,,cjp not zro setfalse ;
,,cjs advance ;
,,cjp setsb1 ;
;
.instruction setsp ; set superset
bus:=65,,, ;
w7:=swp,,cjs prepset ;
setsp1: ;
,,cjs getsetop ;
w4 clr w3,s, ;
,,cjp not zro setfalse ;
,,cjs advance ;
,,cjp setsp1 ;
;
.instruction setcr ; set create
q:=19a,, ;
q,,cjp setun0 ;
;
.instruction setst ; set store
q:=40,, ;
q,,cjp setun0 ;
;
.instruction setre ; set retreive
q:=102,, ;
q,,cjp setun0 ;
.p ;
;;.instruction revsm ; retreive value stack multiple
;; q:=103
;; q, cjp setun0
;
.instruction setad ; set adjust
bus:=82,,, ;
w7:=swp,,cjs prepset ;
setad1: ;
,,cjs getsetop ;
w10-w0,s,cjs setad2 ; acy:=length1>=counter
,,cjp setad1 ;
setad2: ;
w3:=w4,,cjp acy putsetop ; putsetop if length1>=counter
w11-w0,s, ; zro:=last iteration
w4,s,cjp not zro setad3 ;
w11:=0,, ; make sure that length1 >= length2 when finishing
setad3: ;
,,cjp zro settestitr ;
q:=setade,, ;
,,cjpp xept ; exception: the set can not be truncated
.p ;
;; the instruction settm does not use the common set
;; code part. it is not interruptable
;
.instruction settm ; set test membership
,,cjs readlucq ;
w7:=q,, ; w7:=length of the set
slu:=slu-q,,cjs readlucq ; skip over the set
ir:=0f,w1:=q and 0f,, ; w1:=position in the word; prepare rotate
w0:=c:q+10,, ;
,,push 2 ;
c:=7fc,w0:=>w0 and 7fc,,rfct ; w0:=wordno
c:w7-w0,, ; cry:= w7>=w0
w5:=w5+w0,,cjp not cry arit2boo; jump if set too short
,,cjs readnext ;
w3:=bd,h w s,cjs terror ; w3:=the set word
rc:=w1,, ;
w3:=<c<w3,,rpct k ; cry:=the element is a member of the set
ir:=,,cjp arit2boo ;
;;
;; end of lmitxt078c
;;
;;
;; begin lmitxt079c
;;
;; rev: 801002 fh/hlv
;;
;
;;unsigned div
;;w1q=op1 (unsigned)
;;w2=op2 (unsigned)
;;r,ir,c,s used
;;q:=quotient (op1//op2)
;;w1:=remainder
;
unsdiv: ;;
ir:=60,,, ;prepare double shift left
w1:<<c<w1,,ldct 0f ;
unsdiv0: ;
q:=q--,, ;q15:=0
unsdiv1: ;;
w1-w2,s,cjp cry unsdiv2 ;
,,cjp not acy unsdiv3 ;
;
unsdiv2: ;;
w1:<<c<w1-w2,,rpct unsdiv0 ;
swp,q:=-q,,cjp unsdiv4 ;q15:=0; q:=compl q
unsdiv3: ;;
w1:<<c<w1,,rpct unsdiv1 ;
swp,q:=q equ 0,, ;q:=compl q
unsdiv4: ;
w1:=swp,,crtn ; w1:=remainder
.p ;
;;unsigned mult
;;w3=op1
;;w2=op2
;;w1=op3
;;r,ir,c used
;;w1w3:=op1*op2+op3=w3*w2+w1
;
unsmult: ;;
ir:=c:=,,ldct 10 ;prepare rotate, c:=0
,,cjp unsmult3 ; c is considered bit00 of w1
;
unsmult1: ;;
,,cjp not cry unsmult2 ;
w1:=c:w1+w2,, ; c:=bit00
unsmult2: ;;
w1:=>c>w1,, ;
unsmult3: ;;
w3:=>c>w3,,rpct unsmult1 ; c:=multiplicant bit
,,crtn ;
.p ;
;;dyadic compare, fetch operands
;
prepdyad: ;
,,cjs readluc ;
w2:=bd,h w s,cjs readluct ;
w3:=bd,h w s,cjs terror ;
bus:=w2 xor w3,s,jmap not 8 ;
arit2t: ;;
w3:=w3++,,cjp wrfetch ;
arit2boo: ;;
w3:=0,,cjp not cry wrfetch ;
w3:=w3++,,cjp wrfetch ;
;
;; conditional(pointer) jump, fetch
;
prepbranch1: ;
w4:=0,,cjs readcont ;
w0:=w3,,cjs readluc ;
bd,,h w s,cjs readluct ;
,h ,cjp prepbranch2 ;
;
;;conditional jump, fetch
;
prepbranch: ;
,,cjs readcont ;
w0:=w3,,cjs readluc ;
prepbranch2: ;
w3:=bd,h w s,ldct fetch ;
,h ,cjs pty perror ;
w3,s,jmap not 8 ;
jmt: ;;
sic:=rd+w0,,cjp fetch ;
;
.p ;
;
;;
;; end lmitxt079
;;
;;
;; begin lmitxt080c
;;
;; rev: 801003 fh/hlv
;;
.instruction jmzeq , prepbranch ;
,,jrp zro jmt ;
;
.instruction jmzne , prepbranch ;
,,jrp not zro jmt ;
;
.instruction jmzlt , prepbranch ;
,,jrp b0 jmt ;
;
.instruction jmzge , prepbranch ;
,,jrp not b0 jmt ;
;
.instruction jmzgt , prepbranch ;
,,cjp zro fetch ;
,,jrp not b0 jmt ;
;
.instruction jmzle , prepbranch ;
,,cjp zro jmt ;
,,jrp b0 jmt ;
.p ;
;;
;; prepare tnill, tlock, topen;
;;
tprep: ;
w3:=,,cjs readlucq ; d:= readlucq;
w1:=q,,cjs readlucq ; b:= readlucq;
w2:=q,,cjs cread65 ; base,disp:= cread65(b,d);
w6,s,jmap not 8 ; stat(base); goto escmap(ir);
;;
.instruction tnill , tprep ;
;;
;; param:: none;
;; stack:: ptr: addr -> boolean: word;
;;
w3:=,,cjp not b1 wrfetch ; goto wrfetch(if nill(base) then true
w3:=w3++,,cjp wrfetch ; else false);
;;
.instruction topen , tprep ;
;;
;; param:: none;
;; stack:: ptr: addr -> boolean: word;
;;
w5:=w5++,, ; disp.type:= -,disp.type;
;;
.instruction tlock , tprep ;
;;
;; param:: none;
;; stack:: ptr: addr -> boolean: word;
;;
w5,s,cjp b1 wrfetch ; goto wrfetch(if nill(base) then bool
tlock10: ; else
,,cjp not b15 wrfetch ; if disp.type = msg then bool
w3:=w3++,,cjp wrfetch ; else -,bool;
.p ;
.instruction jmprw ;
,,cjs readcont ;
sic:=w3+rd,,cjp fetch ;
;
.instruction jmphc ;
jmphc00: ;
,,cjs readcown36 ;
q:=w6,,cjp jmp1 ;
;
.instruction jmppd ;
,,cjs readlucq ;
w3:=q,,cjs readlucq ;
;
jmp1: ;;
rd2:=sib:=q,, ;
sic:=w3,,cjp fetch ;
;
.instruction neg ;
,,cjs readlucq ;
w3:=-q,s,cjp testovf ;
;
.instruction compl ;
,,cjs readluc ;
w3:=--bd,h w s,cjp wrfetcht;
;
.instruction abs ;
,,cjs readlucq ;
w3:=q,s, ;
,,cjp not b0 wrfetch ;
w3:=-w3,s,cjp testovf ;
;
.instruction notinstr ;
w3:=,,cjs readlucq ;
bus:=--q,s,cjp tlock10 ;
;
.instruction add , prepdyad ;
w3:=w3+w2,s, ;
;
testovf: ;;
,,cjp not ovf wrfetch ;
;
aritovf: ;;
zd1,,s, ;
,,cjp b15 wrfetch ; ignore
q:=arite,, ;
,,cjp xept ;
;
.instruction sub , prepdyad ;
w3:=w3-w2,s,cjp testovf ;
;
.instruction andinstr , prepdyad ;
w3:=w3 and w2,,cjp wrfetch ;
;
.instruction or , prepdyad ;
w3:=w3 ior w2,,cjp wrfetch ;
.p ;
;
.instruction eq , prepdyad ;
w2-w3,s,ldct wrfetch ;
w3:=0,,jrp zro arit2t ;
;
.instruction ne , prepdyad ;
w2-w3,s,ldct wrfetch ;
w3:=0,,jrp not zro arit2t ;
;
.instruction ult , prepdyad ;
c:w2--w3,,cjp arit2boo ;
;
.instruction lt , prepdyad ;
c:w2--w3,,cjp not b0 arit2boo;
c:w3-w2,,cjp arit2boo ;
;
.instruction le , prepdyad ;
c:w2-w3,,cjp not b0 arit2boo;
c:w3-w2,,cjp arit2boo ;
;
.instruction gt , prepdyad ;
c:w3--w2,,cjp not b0 arit2boo;
c:w2-w3,,cjp arit2boo ;
;
.instruction ge , prepdyad ;
c:w3-w2,,cjp not b0 arit2boo;
c:w2-w3,,cjp arit2boo ;
;
.p ;
;
.instruction sha , prepdyad ;
ir:=60,w0:=<c<w2,h , ;arith shift; c:=right shift
w2+0f,s, ;
,,cjp not cry sha2 ;
;;shift right
w3,s,cjp not acy sha4 ; acy: -15<=w2<= -1
rc:=--w2,, ; b0:=sign of w3
w3:=>w3,,rpct k ;
,,cjp wrfetch ;
;
sha2: ;;shift left
w2,s, ;
w1:=w3,s,cjp zro wrfetch ;finish if operand2=0
,,cjp zro wrfetch ;finish if operand1=0
rc:=w2--,,push ;
w3:=w3+w3,s,twb ovf testovf;
;
;;overflow
;
w3:=w1,s, ;
rc:=w2--,,push ;
w3:=w3+w3,s,twb zro k+1 ;
,,cjp aritovf ;
;
sha4: ;; shift right more than 14 times
w3,s, ;
sha5: ;;
w3:=0,,cjp not b0 wrfetch ;
w3:=w3--w3,,cjp aritovf ;
;
.p ;
;
.instruction shc , prepdyad ;
w2:=w2 and 0f,, ;
rc:=w2--,s, ;
,,cjp b0 wrfetch ;
ir:=40,,, ;cyclic shifting
w3:=<w3,,rpct k ;
,,cjp wrfetch ;
;
;
.instruction mul , prepdyad ;
w1:=0,, ;
w4:=w3,,cjs unsmult ;
bus:=w4,s, ;
bus:=w2,s,cjp not b0 mul1 ;
w1:=w1-w2,, ;multiply by extended sign of w4
mul1: ;;
bus:=w3 xor w1,s,cjp not b0 mul2;
w1:=w1-w4,, ;multiply by extended sign of w2
bus:=w3 xor w1,s, ;
mul2: ;;
bus:=w1,s,cjp b0 aritovf ;
bus:=w1++,s,cjp zro wrfetch;
,,cjp zro wrfetch ;
,,cjp aritovf ;
;
.p ;
;
.instruction mod , prepdyad ;
w0:=,,cjp div1 ;
;
.instruction div , prepdyad ;
w0:=1,, ;
;
div1: ;;
q:=w3,s, ;
w6:=w2,s,cjp not b0 div2 ;
q:=-q,, ;
div2: ;;
w2:=-w2,,cjp b0 div3 ;
w2:=-w2,,cjp zro div6 ;
;
div3: ;;
w1:=0,,cjs unsdiv ;
bus:=w0,s, ;zro:=mod
bus:=w3,s,cjp zro div4 ;
w3 xor w6,s, ;stat:=sign of quotient
;
w3:=-q,,cjp b0 wrfetch ;negative result
w3:=-w3,s,cjp not ovf wrfetch;test overflow
,,cjp aritovf ;
;
div4: ;; mod
w3:=w1,,cjp not b0 wrfetch ;
w3:=-w1,,cjp wrfetch ;
;
div6: ;;division by zero
w3:=0,,cjp aritovf ;ovf:-true
;
.p ;
;
.instruction crget ; if you get lu then it will be the old values of lu
,,cjs readluc ;
ra:=bd,,h w s, ;
w3:=rd,, ;
ra:=reg,,cjp wrfetcht ;
;
.instruction crput ;
,,cjs readlucq ;
w2:=q,,cjs readlucq ;
zd:=slu,, ; you may also put lu and ic
rd:=sic,, ;
ra:=w2,, ;
rd:=q,,cjp sfetch ;
;
;;
;; end lmitxt080c
;;
;
;;
;; begin lmitxt085c: index and case instructions
;;
;; rev: 801002 fh/hlv
;;
;
index0: ;;read the range descriptor and test
,,cjs readlucq ;
w1:=q,,cjs readlucq ; qw1:=dope address
index1: ;
bus:=80,w2:=q,, ; w3:=bit0; w21:=dope address
w3:=swp,,cjs readlucq ;
w0:=q xor w3,, ; w0:=index xor bit0
w6:=w2,, ;w6:=range base
w5:=w1,,cjs readnext ;w5:=range disp
w1:=bd xor w3,h w s,cjs readnextt;w1:=lb xor bit0
w2:=bd xor w3,h w s,cjs terror;w2:=ub xor bit0
w2-w0,s, ;
w0:=w0-w1,s,crtn acy ; w0:=index-lb
clearstat: ;
,s,crtn ;
index2: ;;
q:=indexe,, ;
,,cjs not acy xept ;
,,cjs readnext ;
w3:=bd,h w s,cjp terror ;w3:=the third word of the d op vector
index3: ;;w3=position
,,cjs readluc ;
w3:=bd+w3,h w s,cjs readluct;
w4:=bd,h w s,cjp terror ;
;
index4: ;;calculate packed array
q:=0ff,, ;
w3,w3:=w3 and q,, ;w3:=size
w2:=swp and q,, ;w2:=no pr word
q:=w0,,cjs unsdiv ;w0:=wordno
w0:=q,,cjs readluc ;w1:=pos in the word
w2:=bd--,h w s,cjs readluct;
w4:=bd,h w s, ;
w0:=w0+w0,h , ;
w2:=w2+w0,h ,cjs pty perror;
w6:=w4,,cjp b1 nillerr ;w56:=addr of indexed word
w5:=w2,,cjs readnext ;
w0:=bd,h w s, ;w0:=indexed word
w2:=0,h ,cjs pty perror ;
ir:=60,q:=w0,, ;q:=indexed word
w4:=10,s, ;counter:=10(hex)
;; now w2q:=w2q shift w0*w3
;; w4:=10-w1*w3
index5: ;;
bus:=w1:=w1--,s, ;
rc:=w3--,,crtn b0 ;
index6: ;;
w4:=w4--,, ;w4:=no of shifts made
w2:<<w2,,rpct index6 ;
,,cjp index5 ;
;
.p ;
;
.instruction intrs ;
,,cjs index0 ;
slu:=slu+2,, ; don't unstack the index
,,cjp acy fetch ;
q:=packe,, ;
,,cjp xept ;
;
.instruction index ;
,,cjs index0 ;
w1:=0,,cjs index2 ;read length
w2:=w0,,cjs unsmult ;w3:=position
,,cjs index3 ;w34:=resulting address
,,cjp wr34fetch ;
;
.instruction inprs ;
,,cjs index0 ;w0:=index-ln
,,cjs index2 ;w3:=no, size
w1:=0,,cjs index4 ;
;; now the data is left justified in q
rc:=w3--,, ;rc:=length-1
w3:=0,, ;
w3:<<w3,,rpct k ;
,,cjp wrfetch ;
;
.instruction inpss ;
,,cjs readluc ;
w7:=bd,h w s,cjs terror ;w7:=value to be stored
,,cjs index0 ;w0:=index-lb
,,cjs index2 ;w3:=no, size
w1:=0,,cjs index4 ;
;; now the data is left justified in q
;; w2=the data in front of the element
;; w4=16 - the number of shifts already performed
;; w65=the address of the word + 1
;; w7=the value to be stored
;; w3=the size
w0:=0,, ;
rc:=w3--,,push ;
w0:=w0++w0,, ;w0:=mask
w2:<<w2,, ;w2:=front data
w2:=w2 and 7fe,,rfct ;
rc:=w4--w3,s, ;
w7:=w7 and w0,, ;
w3:=w7,, ;the value to be packed
w3:=w3+w2,,cjp b0 inpss1 ;
w3:<<w3,,rpct k ;
inpss1: ;
w1:=w5-2,, ;
w2:=w6,,cjs writenext ;
,,cjp fetch ;
;
.p ;
;
.instruction jmcht ;
,,cjs readcown36 ;
q:=w6,, ; qw1:=dope address
w1:=w3,,cjs index1 ;
w0:=w0++w0,,cjp not acy jmcht1;
w0:=w0++w0,, ;
w5:=w5++w0,, ;
;
jmcht1: ;;
,,cjs readnext ;
w4:=bd,h w s,cjs readnextt ;
w3:=bd,h w s,cjs terror ;
q:=w4,,cjp jmp1 ;
;
;;
;; end lmitxt085
;;
;;
;; begin lmitxt087c: procedure call instructions
;;
;; rev: 801003 fh/hlv
;;
.instruction pcald ;
,,cjs readluc ;
w1:=bd++,h w s,cjs readluct;w1:=distance+1
w2:=bd,h w s,cjs readluct ;
w0:=bd,h w s,cjs readluct ;w02:=link
w3:=bd,h w s,cjs readluct ;
w4:=bd,h w s,cjs terror ; w34:= entry point;
,,cjp pcals1 ;
;
.instruction pcals ;
,,cjs readcont ;
w1:=w3++,,cjs getif ;w1:=distance+1
w2:=w0,, ;w02:=link
w0:=w6,,cjs readcown36 ;w43:=entry point
w4:=w6,, ;
;
pcals1: ;;
w5:=w3,, ;w45=entry point
w1:=slu--w1,, ;
w6:=w2,, ;w06=dynamic link
w2:=slb,, ;
w3:=w0,,cjs writenext ;link
w0:=rd0,, ;w0:=sf
rd0:=w1,, ;
w3:=w6,,cjs writenext ;
w3:=spb,,cjs writenext ;dynamic lic
w3:=w0,,cjs writenext ;
w3:=sib,,cjs writenext ;return point
w3:=sic,,cjs writenext ;
q:=w4,, ;
w3:=w5,,cjp jmp1 ;
.p ;
.instruction pexit ;
w5:=rd0++,, ;w65:=sf
w0:=w5-3,, ;calculate new lastused
w6:=spb,, ;
w5:=w5++,,cjs readnext ;
w2:=bd,h w s,cjs readnextt ;w21:=link
w1:=bd,h w s,cjs readnextt ;
w4:=bd,h w s,cjs readnextt ;w43:=return point
q:=w4,h , ;
w3:=bd,h w s,cjs terror ;
rd0:=w1,, ;update sf
zd:=slu:=w0,,cjp jmp1 ;update lastused
;
;;
;; end lmitxt087c
;;
;;
;; selfdiagnostic test routines.
;;
;; file: lmitxt090
;; rev.: 800807 hlv
;;
;; the test routines are executed as responce to
;; commands recieved from the 8085 debug micro.
;; after each test has been executed, an answer
;; is returned to the debug micro. below is a
;; short description of test commands and answers:
;;
;;fifo: 0 1 2 3 4 5 description
;;*) w3.l w3.r w1.l w1.r w2.l w2.r
;;
;; c: 1 - - - - - xmit 7.5 intrp
;; a: 1 - - - - - to 8085.
;;-------------------------------------------------------------------
;; c: 2 - - - - - w-reg addr. test.
;; a: 2 - - - - 0 test ok.
;; a: 0 read data errorra error error found.
;;-------------------------------------------------------------------
;; c: 3 test pattern - - - w-reg data test.
;; a: 3 - - - - 0 test ok.
;; a: 0 read data error ra error error found.
;;-------------------------------------------------------------------
;; c: 4 module no - - - mem. addr. test.
;; a: 4 - - - - 0 test ok.
;; a: 0 read data error addr error error found.
;;-------------------------------------------------------------------
;; c: 5 module no test pattern - mem. data test.
;; a: 5 - - - - 0 test ok.
;; a: 0 read data error addr error error found.
;;-------------------------------------------------------------------
;;
;; error= +1: left parity, +2: right parity, +4: data error;
;;
;; *) the w-reg bytes refers to the shiftcom fifo:
;; input -> w3.l -> w3.r -> w1.l -> w1.r -> w2.l -> w2.r -> output
.p ;
;;
;; select test
;;
;; entry: w3,w1,w2= microcom fifo; swap= w3; w4= 0ff; w5= 0ff00;
;;
selftest: ;selftest:
w0:=swp,, ;
w3:=w3 and w4,, ;
w6:=w1 and 700,, ;
bus:=w3 ior w6,, ;
w7:=swp,, ; w7:= fifo(1) shift 8 + fifo(2);
w0:=w0 and 7,, ; test:= fifo(0) and 7;
w0:=w0--,s,ldct mrq10 ; goto case test of (
w0:=w0--,s,cjp zro selft100; 1: selftest1;
w0:=w0--,s,cjp zro selft200; 2: selftest2;
w0:=w0--,s,cjp zro selft300; 3: selftest3;
w0:=w0--,s,cjp zro selft400; 4: selftest4;
,,jrp zro selft500 ; 5: selftest5;)
; otherwise end session;
;;
;; at entry to test routine:
;; wo= fifo(0) = test no; w1= fifo(2,3); w2= fifo(4,5);
;; w3= fifo(1); w4= 000ff; w5= 0ff00;
;; w6= fifo(2) shift 8; w7= fifo(1,2);
;;
.p ;
;;
;; selftest 1: generate 7.5 interrupt to 8085.
;;
selft100: ;selftest1:
led:=6,,, ; set8085;
,,cjp mrq10 ; goto end-session;
;;
;; selftest 2: register address test.
;;
selft200: ;selftest2:
w5:=3ff,s, ;
selft210: ; for i:= 1023 step (-1)
ra:=w5,, ; until 0 do
rd:=w5,w5:=w5--,s,cjp not zro selft210; regs(i):= i;
ra:=w5:=w5-w5,,push 3ff ; for i:= 0 step 1
w4:=rd,, ; until 1023 do
w5 xor w4,s, ;
ra:=w5:=w5++,,twb not zro selftok; if regs(i)<>i then goto error;
;;
;; selftest error, deliver errormessage to 8085.
;;
;; entry: w5= addr, w4= read data, q= error;
;;
selfterr4: ;selftesterror4:
q:=4,, ; error:= data error;
selftderr: ;selftestdataerror:
w5:=w5--,, ; addr:= addr-1;
selfterr: ;selftesterror:
bus:=w6:=0ff,, ; w6:= rmask;
w7:=swp,, ; w7:= lmask;
bus:=w5 and w6,, ;
w2:=swp ior q,, ; w2:= addr shift 8 + error;
w5:=w5 and w7,, ;
w1:=w4 and 0ff,, ;
bus:=w5 ior w1,, ; w1:= addr shift (-8) +
w1:=swp,, ; data shift 8;
bus:=w4,, ; w3:= data shift (-8);
w3:=swp and w6,,cjp mrq22a ; goto update-cyclic;
.p ;
;;
;; selftest 3 : register data test.
;;
selft300: ;selftest3:
w4:=w7,, ; d:= testpattern;
w0:=,,push 3ff ; for r:= 0 step 1 until 1023 do
ra:=w0,w0:=w0++,, ; begin
rd:=w4,w4:=--w4,,rfct ; regs(r):= d; d:= -,d;
; end;
w5:=w5-w5,,push 3ff ; for r:= 0 step 1 until 1023 do
ra:=w5,w5:=w5++,, ; begin
w4:=rd,, ; if regs(r)<>testpattern
w4 xor w7,s, ; then goto selftestdataerror;
w7:=--w7,,twb not zro selftok; testpattern:= -,testpattern;
,,cjp selftderr ; end; goto selftestok;
;;
;; selftest 4 : memory address test.
;;
selft400: ;selftest4:
w2:=w7,, ; b:= modulebase;
w3:=,, ; for d:= 0 step 2 until -2 do
selft410: ;
w1:=w3--,,cjs writenext ; writenext(b,d-1,d);
w3:=w3+2,s, ;
w6:=w7,,cjp not zro selft410;
selft420: ; for d:= 0 step 2 until -2 do
w5:=w3--,,cjs readnext ; begin
w4:=bd,h w s, ; readnext(b,d-1); d1:= waitmem;;
,h , ;
bd,,h w ,cjp pty selft430 ; if pty then goto t4parity;
w4 xor w3,s, ;
w3:=w5++,s,cjp not zro selfterr4; if d1<>d then goto selftesterror4;
,,cjp not zro selft420 ; end;
selftok: ;selftestok:
w2:=,,cjp mrq22a ; result:= ok; goto updatecyclic;
.p ;
selft430: ;t4parity:
q:=w0-w0,,cjv 3 selft435 ; error:= 0; case parity of
.loc ;
selft435: ;
,,cjp selft440 ; no pty error: goto testdata;
q:=q++,, ; r pty error: error:= error + 2;
q:=q++,,cjp selft440 ; l pty error: error:= error + 1; goto testdata;
q:=3,, ; lr pty error: error:= 3;
selft440: ;testdata:
w4 xor w3,s,ldct selfterr ; if dataerror then
w5:=w5--,,cjp zro selfterr ; error:= error + 4;
q:=q+4,,jrp zro ; goto selftesterror;
;;
;; selftest 5 : memory data test.
;;
selft500: ;selftest5:
w1:=w1 and w4,, ;
w2:=w2 and w5,, ;
bus:=w1 ior w2,, ; testpattern:=
w3:=swp,, ; fifo(3) shift 8 + fifo(4);
w2:=w7,, ; b:= module no;
w1:=,, ; for d:= 0 step 2 until -2 do
selft510: ; begin
w1:=w1--,,cjs writenext ; writenext(b,d-1,testpattern);
w1:=w1+1,s, ; testpattern:= -,testpattern;
w3:=--w3,,cjp not zro selft510; end;
w6:=w7,, ;
selft520: ; for d:= 0 step 2 until -2 do
w5:=w1--,,cjs readnext ; begin
w4:=bd,h w s, ; readnext(b,d-1);
w1:=w1+2,h , ; t:= waitmem;
bd,w4 xor w3,h w s,cjp pty selft430; if pty then goto t4parity;
w1,s,cjp not zro selfterr4 ; if t<>testpattern then goto selfterror4;
w3:=--w3,,cjp not zro selft520; testpattern:= -,testpattern;
,,cjp selftok ; end; goto selftestok;
;;
;; end of lmitxt090: selfdiagnostic routines
;;
▶EOF◀