|
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: 12288 (0x3000)
Types: TextFile
Names: »lpos4tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »lpos4tx «
(
message pos len
pos=slang
pos len
)
; *** pos ***
b. g1,e4 ; insertproc
d.
p. <:fpnames:> ; fpnames
l.
k=10000
s. j54,g3,a2,b15,i9; code procedure
h.
g0=0 ; number of externals
e4: ; start segment
g1: g3 , g2 ; head word
j4: g0+ 4 , 0 ; rs entry 4: take expression
j6: g0+ 6 , 0 ; - 6: end register expr
j13: g0+13 , 0 ; - 13: last used
j21: g0+21 , 0 ; - 21: general alarm
j29: g0+29 , 0 ; - 29: param alarm
j30: g0+30 , 0 ; - 30: save stack ref, save w3
j54: g0+54 , 0 ; - 54: field alarm
g2=k-2-g1 ; end of abs words
g3=k-2-g1 ; end of points
w.
e0: g0 ; external list, no ext
0 ; no of bytes
09 02 88 ; date of version
14 43 07 ; time of version\f
; integer procedure pos(lille) i :(stor) startende fra :(startpos)
; <* any type *> array lille, stor
; <* optional *> integer startpos
;
; Proceduren søger i strengen stor fra startpos (eller 1) efter første
; forekomst af strengen lille.
; Såfremt strengen findes returneres dens startposition i pos,
; ellers 0.
;
;
; integer procedure len(streng)
; <* any type *> array streng
;
; Proceduren søger i strengen streng efter et 0-tegn, og returnerer antallet
; af tegn den møder inden 0-tegnet.
;
i0: 255<16 ; 1. tegn
255<8 ; 2. tegn
255 ; 3. tegn
i1: 0 ; sidste adr. ; øvre grænse
i2: 0 ; basis adr. ; nedre grænse
i3: 3 ; tre tegn pr. ord
i4: 0 ; tegn<16
0 ; tegn<8
0 ; tegn
i5: 0 ; sidste adr.
i6: 0 ; basis adr.
i7: 0 ; maske
i8: 0 ; cu tegn
i9: 0 ; cu pos
; procedure test adresse;
; kald retur
; w1 adresse adresse
; w3 link
a0: sl. w1 ( i1.) ; if adresse<øvre grænse and
jl x3 ; adresse>=første param adresse then
sl. w1 ( i2.) ; øvre grænse:= adresse;
rs. w1 i1. ;
jl x3 ;
; procedure take array;
; kald retur
; w2 formaladr formaladr
; w3 link dope address
a1: dl w1 x2 ; get formals;
rs w3 x2-2 ;
al w3 2.11111;
la w3 0 ; w3:= kind
sh w3 23 ; if kind > 23 <*zone rec*>
sh w3 16 ; or kind < 17 then <*bool arr*>
jl. w3 ( j29.) ; alarm(<:param:>)
jl. w3 a0. ; test adresse;
rl w3 x1 ; w3:= base_addr
rs w3 x2 ; last formal:= w3
ba w1 0 ;
al w1 x1-2 ;
jl. w3 a0. ; test adresse;
al w3 x1+2 ; w3:= dope address
rl w1 x3-2 ; w3:= last_half
wa w1 x2 ; + base_addr
rx w1 x2-2 ; first formal:= last_addr;
jl x1 ;
; procedure længde
; kald retur
; w0 ?
; w1 lastaddr (0-tegns placering - 1) * 2
; w2 baseaddr adr. næstsidste ord
; w3 link ?
a2: ds. w2 i2. ;entry længde:
am -2 ; cur_adr:= base_adr-2;
b0: al w2 x2+2 ; for (cur_adr:= cur_adr+2
al w1 0 ; tegnnr:= 0)
sl. w2 ( i1.) ; while cur_addr<last_addr do
jl x3 ; begin
rl x2+2 ; w0:= word(cur_addr+2);
sz. (x1+i0.) ; if tegn1 = 0 then return(0)
al w1 2 ;
sz. (x1+i0.) ; if tegn2 = 0 then return(2)
al w1 4 ;
sz. (x1+i0.) ; if tegn3 = 0 then return(4)
jl. b0. ; end;
jl x3 ; return(0)
e1: rl. w2 ( j13.) ; entry pos
ds. w3 ( j30.) ;
al w1 x2+6 ;
al x1 ;
ba x2+4 ; øvre grænse:= stack ref+6+appetite
ds. w1 i2. ; nedre grænse:= stack ref+6
al w2 x2+9 ; get first param
jl. w3 a1. ;
al w1 1 ; if limitcheck(byte1) then
sh w1 (x3-2) ;
sh w1 (x3) ;
jl. w3 ( j54.) ; field alarm;
al w2 x2+4 ; get second param
jl. w3 a1. ;
al w1 1 ;
al w2 x2+4 ; if 3. param then
sl. w2 ( i1.) ; begin
jl. b1. ;
dl w1 x2 ; get formals
rs w3 x2 ;
al w2 x2-17 ;
so 2.01010; if kind<>integer
jl. w3 ( j29.) ; param alarm
sz 2.00101;
jl. w3 ( j29.) ;
so 2.10000; if expression then
jl. w3 ( j4.) ; take expression
ds. w3 ( j30.) ;
al w2 x2+17 ;
rl w3 x2 ;
rl w1 x1 ; end;
b1: sl w1 0 ; w0:= startpos mod 3;
am 1 ; w1:= startpos // 3;
al -1 ;
wd. w1 i3. ;
sl 1 ; if w0<=0 then
jl. b2. ; begin
al w1 x1-1 ; w1:= w1-1;
wa. i3. ; w0:= w0+3
b2: rs. i8. ; end; cu_tegn:= w0;
as w1 1 ; w1:= w1*2
sl w1 (x3-2) ; if w1 >= upper limit then
jl. b14. ; return(0);
al w1 x1+2 ; w1:= w1 + 2;
sh w1 (x3) ; if w1 <= lower limit then
jl. w3 ( j54.) ; field alarm;
al w1 x1-2 ; w1:= w1 - 2;
dl x2-4 ; get (sidsteadr, basis) af stor
ds. i6. ;
wa 2 ;
rs. i9. ; cu_pos:= basis+w1
dl w2 x2-8 ; get (sidsteadr, basis) af lille;
jl. w3 a2. ; længde;
ac x2 ;
wa. i2. ;
wa. i5. ; last(stor):= last(stor)-len(lille);
rs. i5. ;
se w1 0 ;
al w2 x2+2 ;
rs. w2 i1. ;
sh. w2 ( i2.) ; if len(lille)=0 then
jl. b15. ; return(1);
rl. i0. ; maske:= (-1) shift (-16);
se w1 2 ; if 0-tegn ikke andet tegn then
lo. i0.+2 ; maske:= (-1) shift (-8);
sn w1 0 ; if 0-tegn som første tegn then
lo. i0.+4 ; maske:= -1;
rs. i7. ;
am. ( i2.) ;
rl 2 ; w0:= første(lille);
la. i0. ; w0:= w0 and 255<16;
rs. i4. ; tegn1:= w0;
ls -8 ; w0:= w0 shift (-8);
rs. i4.+2 ; tegn2:= w0;
ls -8 ; w0:= w0 shift (-8);
rs. i4.+4 ; tegn3:= w0;
am -1 ; cu_tegn:= cu_tegn-1;
b3: al 1 ;næste:
wa. i8. ; cu_tegn:= cu_tegn+1;
rl. w2 i9. ;
rl. w3 i5. ;
; w0 tegnnr (1-4)
; w2 baseadr
; w3 lastadr
al w1 10 ;
wm w1 0 ;
rl x2+2 ;
jl. x1-6 ; repeat
b4: rl x2+2 ; w0:= ord(cur_addr+2);
rl. w1 i0. ;t1:
la w1 0 ; w1:= tegn1;
se. w1 ( i4.) ; if w1=tegn
sn w1 0 ; or w1=0 then
jl. b5. ; goto fundet1;
rl. w1 i0.+2 ;t2:
la w1 0 ; w1:= tegn2;
se. w1 ( i4.+2) ; if w1=tegn
sn w1 0 ; or w1=0 then
jl. b6. ; goto fundet2;
rl. w1 i0.+4 ;t3:
la w1 0 ; w1:= tegn3;
se. w1 ( i4.+4) ; if w1=tegn
sn w1 0 ; or w1=0 then
jl. b7. ; goto fundet3;
al w2 x2+2 ;t4: cur_addr:= cur_addr+2
sh w2 x3-1 ; until cur_addr>=last_addr;
jl. b4. ; if end of area then
jl. b14. ; return(0)
b5: am -1 ;fundet1: tegn:= 1; if false then
b6: am -1 ;fundet2: tegn:= 2; if false then
b7: al 3 ;fundet3: tegn:= 3;
sn w1 0 ; if w1=0 then
jl. b14. ; return(0)
rs. i8. ;
rs. w2 i9. ;
rl. w3 i2. ;
se 1 ; if første tegn then
jl. b9. ; repeat
b8: al w2 x2+2 ; cu_pos:= cu_pos+2
al w3 x3+2 ; lille:= lille+2
rl x2 ; tegn:= ord(cu_pos)
sl. w3 ( i1.) ; if sidste ord then
jl. b13. ; goto sidste
sn (x3) ; until tegn<>ord(lille)
jl. b8. ;
jl. b3. ; goto næste;
b9: se 2 ; if andet tegn then
jl. b11. ; repeat
b10:al w2 x2+2 ; cu_pos:= cu_pos+2
al w3 x3+2 ; lille:= lille+2
dl w1 x2+2 ; tegn:= dord(cu_pos+2) shift (-16)
ld w1 8 ;
sl. w3 ( i1.) ; if sidste ord then
jl. b13. ; goto sidste
sn (x3) ; until tegn<>ord(lille)
jl. b10. ;
jl. b3. ; goto næste
b11:al w1 x3 ; repeat
b12:al w2 x2+2 ; cu_pos:= cu_pos+2
al w1 x1+2 ; lille:= lille+2
dl x2+2 ; tegn:= dord(cu_pos+2) shift (-8)
ld -8 ;
sl. w1 ( i1.) ; if sidste ord then
jl. b13. ; goto sidste
sn (x1) ; until tegn<>ord(lille)
jl. b12. ;
jl. b3. ; goto næste;
b13:lx. ( i1.) ;sidste:
la. i7. ; tegn:= (tegn exor sidsteord(lille)) and maske;
se 0 ; if tegn<>0 then
jl. b3. ; goto næste;
rl. w1 i9. ;
ws. w1 i6. ; w1:= cur_addr-base_addr
wm. w1 i3. ; w0,w1:= w1 * 3
as w1 -1 ; // 2
wa. w1 i8. ; tegn:= w1+tegn;
jl. w3 ( j6.) ; return(tegn);
b14:am -1 ;0:tegn:= 0;
b15:al w1 1 ;1:tegn:= 1;
jl. w3 ( j6.) ; return(tegn);
e2: rl. w2 ( j13.) ; entry len
ds. w3 ( j30.) ;
al w2 x2+9 ;
jl. w3 a1. ; take array;
al w1 1 ; if limitcheck(byte1) then
sh w1 (x3-2) ;
sh w1 (x3) ;
jl. w3 ( j54.) ; field alarm;
dl w2 x2 ;
jl. w3 a2. ; længde
as w1 -1 ;
ws. w2 i2. ; w2:= cur_addr-base_addr
al x2 ; w0:= w2;
wm. i3. ; w0:= w0 * 3
as -1 ; // 2
wa w1 0 ; char:= w0+char
jl. w3 ( j6.) ;
e3: 0,r.252-(:e3-e4:)>1 ; fill
<:pos:>, 0, 0, 0; alarm text
e.\f
w.
; pos
g0: ; first tail
1 ; size of area
0,0,0,0 ; room for name
1<23+e1-e4 ; entry point
3<18+40<12+41<6 ; parameters
0 ; parameters
4<12+e0-e4 ; code proc , start ext. list
1<12+0 ; 1 segm , 0 bytes
g1: ; last tail
1<23+4 ; size of area
0,0,0,0 ; room for name
1<23+e2-e4 ; entry point
3<18+41<12 ; parameters
0 ; parameters
4<12+e0-e4 ; code proc , start ext. list
1<12+0 ; 1 segm , 0 bytes
d.
p. <:insertproc:> ;
▶EOF◀