|
DataMuseum.dkPresents historical artifacts from the history of: RC3500 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC3500 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 26880 (0x6900)
Types: TextFileVerbose
Names: »lmitxt050«
└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
└─⟦093e2ad1c⟧
└─⟦this⟧ »lmitxt050«
;;
.m rc 3502 micro-program - pascal80 part
;;
;;
;; file: lmitxt050
;;
;; 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;
w6:=spb,,cjs readbcont ; lev:=readbcont; w0:= sf;
w0:=rd0,,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;
,h ,cjs pty rerror ; test parity error
setfield: ;proc setfield
,,cjs readbcont ; fb:= readbcont;
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*)
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 readonext ; w:= readonext(b,d-1);
w4:=w4 and w0,, ; w4:= field and mask;
w4 xor w0,s, ; mask:= -,mask;
w3:=--w3,, ;
w3:=w3 and q,,cjp not zro setf20; w:= -,mash and w;
; if w4<>field then field-ovf;
w3:=w3 ior w4,,cjp writenext; w:= w ior w4,call writenext; return;
.p ;
;;
;; procedure stgetadbc;
;;
;; time : 32x = 6,9us
;; 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 readluct ; op1b:= waitmem; readluct;
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;
;
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= b;
;;
reva: ;reva-common:
,,cjs readcown36 ; b,d:= readcown36;
w5:=w3--,,jmap not 8 ; goto escmap(ir);
;;
;; common revl prologue
;;
;; exit: w3= rel, w5= sf+rel-1, w6= pb;
;;
revl: ;revl-common:
w6:=spb,,cjs readcont ; b:= pb; rel:= readcont;
revls1: ;
w5:=rd0--,, ; d:= reg.sf + rel;
w5:=w5+w3,,jmap not 8 ; goto escmap(ir);
;;
;; common revg prologue
;;
;; exit: w3= rel, w5= pr+rel-1, w6= pb;
;;
revg: ;revg-common:
w6:=spb,,cjs readcont ; b:= spb; rel:= readcont;
revgs1: ;
w5:=rd1--,, ; d:= reg.pr + rel;
w5:=w5+w3,,jmap not 8 ; goto escmap(ir);
.p ;
;;
;; common revi prologue
;;
;; exit: w0= ifdisp, w3= rel, w4= 0, w5= ifdisp+rel-1, w6= ifbase;
;;
revi: ;revi-common:
,,cjs getifrel ; b,d:= getifrel;
w5:=w5--,,jmap not 8 ; goto escmap(ir);
;;
;; common revs prologue
;;
;; exit: w1= d-1, w2= w6= b, w3= rel, w5= d-1;
;;
revs: ;revs-common:
,,cjs getsa ; b,d:= getsa;
revss1: ;
w5:=w1,,cjp b1 nillerr ; if nill(b) then goto nillerror;
w6:=w2,,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;
stvls1: ;
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;
stvss1: ;
,,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;
;;
,,cjs readcown36 ; res.b,res.d:= readcont34;
w4:=w6,,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;
;;
,,cjs readcont ; rel:= readcont;
realds1: ;
w3:=w3+rd0,, ;
w4:=slb,,cjp wr34fetch ; goto wr34fetch(slb,sf+rel);
;;
.instruction reagd ;
;;
;; param:: rel: word; stack:: -> gfrel: addr;
;;
,,cjs readcont ; rel:= readcont;
reagds1: ;
w3:=w3+rd1,, ;
w4:=slb,,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: ;
,,cjs readb65next ; w3:=readb65next
,,cjp wrfetch ; goto wrfetch(byte);
;;
.instruction revaw , reva , revxwfin ;
;;
;; param:: a: addr; stack:: -> word: word;
;;
revxwfin: ;
,,cjs readonext ; w:= readonext(b,d-1);
w3:=q,,cjp wrfetch ; goto wrfetch(w);
;;
.instruction revad , reva , revxdfin ;
;;
;; param:: a: addr; stack:: -> sa: addr;
;;
revxdfin: ;
,,cjs readonext ; w1:= readonext(b,d-1);
w4:=q,,cjs readonext ; w2:= readonext(b,d+1);
w3:=q,,cjp wr34fetch ; goto wrfetch34(w1,w2);
;;
.instruction revaf , reva , revxffin ;
;;
;; param:: a: addr, fb: byte; stack:: -> f: word;
;;
revxffin: ;
,,cjs readbcont ; fb:= readbcont;
,,cjs readonext ; word:= readonext(b,d-1);
,,cjp getfield ; goto getfield(word,fb);
.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 moveg ;
;;
;; 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,cjp b1 nillerr ; cry:= bc(15); wc:= bc(0:14);
w0,s,cjp not cry moveg10 ; if odd(bc) then
,,cjs readb65next ; begin w3:=readb65next; (* move one byte first *)
,,cjs writebnext ; writebnext(op2,w3)
w0,s, ; end;
moveg10: ;rep:
,,cjp zro fetch ; sync-intrp; if wc=0 then goto fetch;
,,cjs readonext ; w:= readonext(op1b,op1d);
ir:=w3:=q,,cjs writenext ; writenext(op2b,op2d,w);
int,,h ,cjs testint1 ; wc:= wc - 1;
w0:=w0--,s,cjp zro moveg10 ; 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;
;;
moveg20: ;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 moveb ;
;;
;; param:: none;
;; stack:: bc: word; op,res: addr -> ;
;;
,,cjs stgetadbc ; bc,op1,op2:= stgetadbc;
w0,s,cjp b1 nillerr ;
moveb10: ;rep:
,,cjp zro fetch ; sync-intrp; if bc=0 then goto fetch;
,,cjs readb65next ; w3:=readb65next
ir:=,,cjs writebnext ; writebnext(op2,b);
int,,h ,cjs testint1 ; goto
w0:=w0--,s,cjp zro moveb10 ; if -,testint then rep
,,cjp moveg20 ; else new-interrupt;
.p ;
;;
.instruction stcea ;
;;
;; time : 49,5x + (17x * bc) = 10,74us + (3,69us * bc)
;; param:: none;
;; stack:: bc: word; op1, op2: addr -> res: word;
;;
,,cjs stgetadbc ; bc,op1,op2:= stgetadbc;
w0,s,cjp b1 nillerr ;
stcea10: ;rep:
,,cjp zro stcea20 ; if bc=0 then goto endtrue;
,,cjs readb65next ; w7:=readb65next
w7:=w3,,cjs readb21next ; w7:= w7 xor readb21next;
int,w7:=w7 xor w3,h s, ; if w7<>0 then goto endfalse
lev xor int,h s,cjp not zro stcea30;
w0:=w0--,s,cjp zro stcea10 ; bc:=bc-1; goto if testinterrupt
,,cjp moveg20 ; then newinterrupt else rep;
stcea20: ;endtrue:
w3:=w0++,,cjp wrfetch ; goto wrfetch(true);
stcea30: ;endfalse:
w3:=,,cjp wrfetch ; goto wrfetch(false);
.p ;
;;
.instruction revsm ;
;;
;; param:: none;
;; stack:: bc: word; op: addr -> area: array(1..bc/2) of word;
;;
,,cjs readluc ; readluc;
w3:=renpbe0,h , ; err:= odd-byte-count;
c:=w0:=bd,h w s,cjs terror ; bc:= waitmem; cry:= bc(15); testparity;
q:=w3,,cjp cry xept ; if odd(bc) then expection(err);
,,cjs readluc ; readluc;
w5:=bd--,h w s,cjs readluct; op.d:= waitmem; readluct;
ir:=20,w2:=slb,h , ; ir.shift:= logical;
w6:=bd,h w s,cjs terror ; op.b:= waitmem; testparity;
w1:=slu,,cjp b1 nillerr ; sslu:= slu; if nill(op.b) goto nillerror;
slu:=slu+6,s, ; (* test stackoverflow *)
slu:=slu+w0,s,cjp acy stackerror; slu:= slu + bc + 6; (* incl. intrp-save *)
zdx-slu,s,cjp acy stackerror; if ovf or slu > lm goto stackerror;
w0:=>w0,s,cjp not acy stackerror; wc:= bc//2;
revsm10: ;rep:
slu:=w1,,cjp zro fetch ; if wc=0 then goto fetch;
ir:=,,cjs readonext ; sync-itr; w:= readonext(op.b,op.d);
w3:=q,,cjs writenext ; writenext(slb,slu,w);
int,slu:=w1,h ,cjs testint1; slu:= slu+2; wc:= wc - 1;
w0:=w0--,s,cjp zro revsm10 ; 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:=slu+6,, ; slu:= slu+6;
sic:=sic--,,cjp fetch ; sic:= sic-1; goto fetch;
.p ;
.instruction readb prepdyad ;
w5:=w2--,,ldct puterraddr ;
w6:=w3,,cjs readb65n1 ; return to readberror if error
,,cjp wrfetch ; parity ok
;
puterraddr: ;; put w6,w5 into the dummy register set
ra:=radummy,,, ;
rd2:=w6,, ;
rd:=w5,, ;
ra:=reg,,cjpp wrfetch ; ra:=reg
;
.instruction readw prepdyad ;
w5:=w2 and 7fe,, ; make the address even
w5:=w5--,, ;
w6:=w3,,cjs readnext ;
,h ,ldct righterror ;
w1:=bd,h w s,cjs testbyte ; return to righterror if right error;
w3:=w1,,cjp not pty wrfetch; w3:=saved data; goto wrfetch if no parity error;
w5:=w5--,, ; only left parity error: disp:=disp-1
righterror: ;
w3:=w1,,cjp puterraddr ; w3:=saved data; goto puterraddr
.p ;
;;
;; end of lmitxt050
;;
.p ;
«eof»