|
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: 15360 (0x3c00)
Types: TextFile
Names: »editlib«, »edl«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦this⟧ »editlib«
└─⟦this⟧ »edl«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦this⟧ »edl«
;edit of tpascallib 80 07 27 13 30
;insert description
tnpascallib=set 10
tnpascallib=edit tpascallib
l./version/,r/8/8 hcø 1
;Anders Lindgård
;hcø 80 07 27 13 30 0/,
l./s.s10w./,i/
;
; 12 description page 8
; initproc
; reserveproc
; releaseproc
; include
; exclude
; sendmessage
; waitanswer
; waitmessage
; sendanswer
; waitevent
; getevent
; testevent
; createinternal
; startinternal
; stopinternal
; modifyinternal
; removeprocess
; regretmessage
; (fpproc)
; connectcuri
; unstackcuri
; moncall
; monitormode
; cpumask
; systemaddress
; sendfurther
/,
l./;segment5-6/,
l./replace(<prog/,
l./a10/,r/10/20/,
l1,i/
a8: ;
2<12+2 ;sep=NL, l=2
2<12+10 ;sep=NL, l=10
<:i:>,0,0,0 ;program name= i
4<12+10 ;sep=SP, l=10
a9: 0,r.4 ; file name
2<12+2 ;sep=NL, l=2
-4<12+0 ;sep='end', l=0
a10: 0,0 ; first of process, command stack
a4: 0,r.10 ; tail
/,
l./h51/,d4,
l./jl.a5./,
l1,i/
ds. w3 a10.+2 ; save first of process, command pointer
al. w3 a2. ; w3:=name address
al. w1 a4. ; w1:=tail address
;ks -1501
jd 1<11+42; lookup entry
;ks-1601
se w0 0 ; if res<>0 then
jl. a14. ; goto error lookup
dl. w3 a10.+2 ; w3:=first of proc, w2:=command
bz w0 x1+16 ; w0:=content
;ks -1502
sn w0 2 ; if program then
jl. a11. ; goto pascal
se w0 0 ; if not text file
jl. c2. ; goto error
dl. w1 a2.+2 ; move name
ds. w1 a9.+2 ;
dl. w1 a2.+6 ;
ds. w1 a9.+6
al. w1 a10. ; w1:=top of prog stack
a12:al w2 x2-2 ; rep:
al w1 x1-2 ; decrease pointers
rl w0 x1 ;
rs w0 x2 ; move one word
se. w1 a8. ; if w1<> start of prog stack
jl. a12. ; then goto rep
;ks -1503
rs w2 x3+h8 ; cur command :=command pointer
c.-1
rl w0 x2
rl w1 x2+2
ks-1505
z.
al w2 0 ; w2:=ok:=true,warning:=false
jl x3+h7 ; goto fp-endprogram
a14: ; lookup error
rl. w2 a10.+2 ; w2:=fp-base
jl w3 x2+h32-2 ; outinteger (result);
1<23+32<12+12 ; layout
al. w0 a2. ; w0:=address of text
jl w3 x2+h31-2 ; outtext(name);
c.-1
rl. w0 a2. ;
jl w3 x2+h32-2 ; outinteger(word(1));
1<23+32<12+12 ; layout
rl. w0 a2.+2 ;
jl w3 x2+h32-2 ; outinteger (word(2));
1<23+32<12+12 ;
rl. w0 a2.+4 ;
jl w3 x2+h32-2 ; outinteger (word(3));
1<23+32<12+12 ;
rl. w0 a2.+6 ;
jl w3 x2+h32-2 ; outinteger (word(4));
1<23+32<12+12 ;
z.
jl. c1. ;
a11:rl w2 x3+h51 ;
rs. w2 a1. ; move fp-mode bits to program
sz w2 2.1 ; remove list-bit
al w2 x2-2.1 ;
rs w2 x3+h51 ;
rl. w2 a10. ;
;ks-1504
/,
l./40:createentry/,d3,
i/
; all functions>0 are alllowed. Sensible or not.
/,l./slw240/,r/sl/sh/,r/40/ 0/,
l1,d,
l./;segment7-8/,
l./writestring/,
l./b.a5w./,r/5/8/,
l./a5:/,l1,i/
/,
l./rsw0x2/,
i/
; correction for writing datastructures outside process
sz w3 255 ;if last char= <0> then
m. **** hcø change in writestring ****
/,l./dl.w1a0.+2/,i/
a7: ; write:
/,
l./rsw0x2/,i/
rl. w3 a3. ; w3:=switch
sz w3 255 ; if outside then skip
/,
l./6146/,d,i@
\f
; segment 12
; monitor code procedures
; call parameters :
; w0 - see each procedure
; w1 - see each procedure
; w2 - abs add of proc table entry
; w3 - return - 2
;
;
; the organization of the code
;
; description (i1) 8<12 + 0
; initproc (i2) 8<12 + 2
; reserveproc (i3) 8<12 + 4
; releaseproc (i4) 8<12 + 6
; include (i5) 8<12 + 8
; exclude (i6) 8<12 + 10
; send message (i9) 8<12 + 12
; wait answer (i10) 8<12 + 14
; wait message (i11) 8<12 + 16
; send answer (i12) 8<12 + 18
; wait event (i13) 8<12 + 20
; get event (i14) 8<12 + 22
; test event (i15) 8<12 + 24
; create internal (i16) 8<12 + 26
; start internal (i17) 8<12 + 28
; stop internal (i18) 8<12 + 30
; modify internal (i19) 8<12 + 32
; remove process (i20) 8<12 + 34
; regret message (i21) 8<12 + 36
; (fpproc) (i22) 8<12 + 38
; connectcuri (i23) 8<12 + 40
; unstackcuri (i24) 8<12 + 42
; mon call (i25) 8<12 + 44
; monitormode (i26) 8<12 + 46
; cpumask (i27) 8<12 + 48
; systemaddress (i28) 8<12 + 50
; sendfurther (i29) 8<12 + 52
; error return
;
; b-variables are global variables for all procedures
; c-variables are error returns
;
\f
b. b20, c10, i35 w.
m. begin hcø code procedures
0,r.(:512*12+2-k:)>1
jl. i0. ;+0
jl. i0. ;+2
jl. i0. ;+4
jl. i0. ;+6
jl. i0. ;+8
jl. i0. ;+10
jl. i0. ;+12
jl. i0. ;+14
jl. i0. ;+16
jl. i0. ;+18
jl. i0. ;+20
jl. i0. ;+22
jl. i0. ;+24
jl. i0. ;+26
jl. i0. ;+28
jl. i0. ;+30
jl. i0. ;+32
jl. i0. ;+34
jl. i0. ;+36
jl. i0. ;+38
jl. i0. ;+40
jl. i0. ;+42
jl. i0. ;+44
jl. i0. ;+46
jl. i0. ;+48
jl. i0. ;+50
jl. i0. ;+52
b0: 0 ; saved w0: (sometimes addr of name)
b1: 0 ; saved w1:
b2: 0 ; saved w2: proc table entry
b3: 0 ; saved w3: (increased) return
b4: 0 ; first of process
b5: 0, r.5 ; local name
i0: ; common entry:
;ks -1300 ; entry test
al w3 x3+2 ; (increase entry);
ds. w1 b1. ;
ds. w3 b3. ; save (registers);
bl w2 x3-1 ; w2 := rel entry;
am (66) ;
rl w3 +22 ; w3 := first of process;
rs. w3 b4. ; save (first of process);
; w3 = first of process
jl. x2+2 ; switch to:
jl. i1. ; description
jl. i2. ; initproc
jl. i3. ; reserveproc
jl. i4. ; releaseproc
jl. i5. ; include
jl. i6. ; exclude
jl. i9. ; sendmessage
jl. i10. ; waitanswer
jl. i11. ; waitmessage
jl. i12. ; sendanswer
jl. i13. ; waitevent
jl. i14. ; get event
jl. i15. ; testevent
jl. i16. ; createinternal
jl. i7. ; startinternal
jl. i7. ; stop internal
jl. i7. ; modify internal
jl. i20. ; remove process
jl. i21. ; regret message
jl. i7. ; fpproc
jl. i23. ; connectcuri
jl. i24. ; unstackcuri
jl. i25. ; moncall
jl. i26. ; monitormode
jl. i27. ; cpumask
jl. i28. ; system address
jl. i29. ; send further
\f
; replace of spaces with binary zero in file name
; call: save w0 = name address
; w3 = return
; exit: w3 = local name address
; all other regs undef
b. a10, f10 w.
f0: 0 ; start of filename
f1: 0 ; saved return
i8: ; replaces spaces:
ds. w3 f1. ; save (filename addr, return);
rl. w3 b0. ; w3:=name address of name padded
al. w2 b5. ; w2:=local name address
dl w1 x3+2 ;
ds w1 x2+2 ; move name
dl w1 x3+6 ;
ds w1 x2+6 ;
rs. w2 f0. ; save local name address
al w2 x2+8 ; wordaddr := top of filename;
a0: ; next word:
al w2 x2-2 ; decrease (wordaddr);
rl w0 x2 ; word := filename (wordaddr);
al w3 0 ; shift := 0;
a1: ; next char:
al w3 x3-8 ; shift := shift - 8;
ld w1 x3 ; w0 := first char(s);
ls w1 -16 ; w1 := char (shift);
se w1 32 ; if char <> space then
jl. f2. ; return;
ac w1 x3 ;
ls w0 x1 ; w0 := first char(s) leftjustified;
rs w0 x2 ; filename (wordaddr) := word;
se w3 -24 ; if not all chars in word tested then
jl. a1. ; goto next char;
se. w2 (f0.) ; if not all filename converted then
jl. a0. ; goto next word;
f2: al. w3 b5. ; w3:=name address local
jl. (f1.) ; return
e.
; monitor procedure process description
;
; the procedure sets up a monitor call
;
;
; call: w0: name address (may be padded with blank)
; w2: proc table entry
; w3: return-4
; +0 : segm<12 + rel
b. a10 w.
p.<:fpnames:>
i1: ;
jl. w3 i8. ; remove spaces;
jd 1<11+4 ; process description
;ks -1301
jl. i7. ; return;
i2: jl. w3 i8. ; remove spaces
jd 1<11+6; initialize process
;ks-1302
jl. i7. ; return
i3: jl. w3 i8. ; remove spaces
jd 1<11+8; reserve process
;ks-1303
jl. i7. ; return
i4: jl. w3 i8. ; remove spaces
jd 1<11+10; release process
ks-1304
jl. i7. ; return
i5: jl. w3 i8. ; remove spaces
rl. w1 (b1.) ; w1:=device
jd 1<11+12; include user
ks-1305
jl. i7. ; return
i6: jl. w3 i8. ; remove spaces
rl. w1 (b1.) ; w1:=device
jd 1<11+14; exclude user
ks-1306
jl. i7. ; return
i9: rl. w2 b3. ;
al w0 x2+2 ; advance return
rs. w0 b3.
jl. w3 i8. ; remove spaces
rl. w1 b1. ; w1:=address(message)
al w2 x2 ; flag:=first param
ks-1307
jd 1<11+16; send message
al w0 x2 ; w0:=buffer address
ks-1309
jl. i7. ; return
i10: rl. w1 b1. ; w1:=messageaddress
rl. w2 (b0.) ; w2:=buffer address
ks-1308
jd 1<11+18; wait answer
ks-1310
jl. i7. ; return
i11: ;
al w0 -1 ; result:=-1;
; jd 1<11+20 ; wait message
jl. i7. ; return
i12: rl. w2 b3. ; advance return
al w0 x2+2 ;
rs. w0 b3. ;
rl w0 x2 ; w0:=result
rl. w1 b1. ; w1:=message address
rl. w2 (b0.) ; w2:=buffer
ks-1312
jd 1<11+22 ; send answer
jl. i7. ; return
i13: rl. w2 b0. ; w2:=buffer address
jd 1<11+24 ; wait event
rl w0 4 ; w0:=next buffer
jl. i7. ; return
i14: ;
rl. w2 (b0.) ; w2:=buffer
ks-1314
jd 1<11+26 ; getevent
jl. i7. ; return
i15: ;
rl. w2 (b0.) ; w2:=buffer
ks-1315
jd 1<11+66 ; test event
rs. w1 (b1.) ; flag:=w1
rs. w2 (b0.) ; buffer:=nex buffer;
jl. i7. ; return
i16: ; create intenal:
jl. w3 i8. ; remove spaces
rl. w1 b1. ; w1:=param address
jd 1<11+56 ; create internal process
jl. i7. ; return
i20: ; remove process
jl. w3 i8. ; remove spacess
ks-1320
jd 1<11+64 ; remove process
jl. i7. ; return
i21: ; regret message:
rl. w2 (b0.) ; w2:=buffer
ks-1321
jd 1<11+82 ; regret message
jl. i7. ; return
i23: ; connectcuri:
jl. w3 i8. ; remove spaces
rs. w3 b0. ; save name address
;ks-1323
am. (b4.) ;
jl w3 h29-4 ; stack current input
rl. w3 b0. ; w3:=name address
;ks-1423
am. (b4.) ;
jl w3 h27-2 ; connect current input
se w0 0 ; if result<>0 then
jl. i24. ; goto unstack
rl. w3 b4. ; w3:=fp-base
al w1 x3+h20 ; w1:=current input zone
al w0 8 ; zonestate:=after open
hs w0 x1+h2+6 ;
rl w2 x1+h0+6 ; w2:=first share
al w2 x2+14 ; save name in share
rl. w3 b0. ; w3:=name
dl w1 x3+2 ; move name
ds w1 x2+2 ;
dl w1 x3+6 ;
ds w1 x2+6 ;
al w0 0 ; result:=0;
jl. i7. ; return
i24: ; unstackcuri:
;ks-1324
am. (b4.) ;
jl w3 h30-4 ; unstackcuri
jl. i7. ; return
i25: ; moncall:
rl. w2 b3. ;
al w0 x2+6 ; advance return
rs. w0 b0. ;
rl w3 x2 ; w3:=call(w3)
rl w1 x2-2 ; w1:=call(w1);
rl w0 x2-4 ; w0:=monitor call number
hs. w0 a1. ;
rl. w0 (b0.) ; w0:=call(w0);
rl. w2 (b1.) ; w2:=call(w2);
jd 1<11+0 ; call monitor
a1=k-1
rs. w0 (b0.) ; call(w0):=w0;
rs. w2 (b1.) ; call(w2):=w2;
jl. i7. ; return
i26: ;monitor mode:
jd 1<11+28 ;
jl. i7. ; return
i27:rl. w0 b0. ; w0:=mask
jd 1<11+30 ; set cpu mask
jl. i7. ; return
i28:jl. w3 i8. ; remove spaces
rl. w0 (b1.) ; w0:=func
jd 1<11+32 ; system address
jl. i7. ; return
i29:jl. w3 i8. ; remove spaces
rl. w2 (b1.) ; w2:=buf
jd 1<11+34 ; send further
jl. i7. ; return
e. ;
\f
; error return
c6: am 13-19 ;13: illegal zonestate:
c1: am 1 ;19 - file cannot be looked up
c2: am 1 ;18 - file does not exist
c3: am 1 ;17 - file cannot be removed
c4: am 1 ;16 - file cannot be changed
c5: al w1 15 ;15 - - - - connected for i/o
rl. w2 b0.+4 ;
rl w3 x2+4 ; w3 := add of rt error
ks-1398
rs. w3 b0.+4 ;
rl w2 x2+8 ; w2 := stacktop
rl. w3 b0.+6 ; w3 := add where error occurred
al w0 -1 ;
ks-1399
jl. (b0.+4); jump to rt error
; normal return
i7: rl. w2 b0.+4 ;
rl w2 x2+8 ; w2 := stacktop
;ks -1397
jl. (b0.+6); return
m. end hcø codeprocedures
e.
0,r.(:13*512-k+2:)>1
e.
@,f
scope user tnpascallib
mode list.no
▶EOF◀