|
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: 9216 (0x2400)
Types: TextFile
Names: »lmitxt080«
└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
└─⟦093e2ad1c⟧
└─⟦this⟧ »lmitxt080«
;;
;; begin lmitxt080
;;
;;
.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 ;
;;
.instruction teqad , prepdyad ;; (* test equal addresses *)
;; w2=top disp, w3=top base
;
w4:=,,cjs readlucq ;
w2:=w2-q,,cjs readlucq ;
w3,w3:=w3-q,s,cjp b1 tnill10;
w2,s,cjp not zro teqad10 ;
eq1: ;
w3:=w4++,,cjp zro wrfetch ;
teqad10: ;
w3:=w4,,cjp wrfetch ;
.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;
;;
tnill10: ;testnill:
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 ;
,,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 ;
;
.instruction xorinstr , prepdyad ;
w3:=w3 xor w2,,cjp wrfetch ; goto wrfetch(op1 xor op2);
;
.instruction crc16 , prepdyad ;
ir:=c:=,,push 7 ; w3=bitstream, w2=polynomium (except x**16)
w3:=>w3,s, ; shift
,,cjp not b15 crc16a ; jump if a zero was shifted out
w3:=w3 xor w2,, ; divide by the polynomium
crc16a: ;
,,rfct ; repeat
,,cjp wrfetch ;
;
.instruction shc8 ;
,,cjs readlucq ; q:= readlucq;
bus:=q,, ;
w3:=swp,,cjp wrfetch ; goto wrfetch(swap(q));
.p ;
;
.instruction eq , prepdyad ;
w2-w3,s,cjp eq1 ;
;
.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 ;
;; 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;
mul3: ;
,,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,s,cjp b0 wrfetch ;negative result
w3:=-w3,,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
.instruction crget ; getting lu gives the old value
,,cjs readluc ;
ra:=bd,,h w s, ;
w3:=rd,h , ;
ra:=reg,h ,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 lmitxt080
;;
.p ;
▶EOF◀