|
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: »tmon«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦a2674cfeb⟧ »calgmon«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦a2674cfeb⟧ »calgmon«
└─⟦this⟧
; *** tmon ***
;
;
; this file contains a small set of tools for convenient access to monitor
; functions from algol programs.
;
; the file contains:
;
; code procedure 'mon'
; code procedure 'reflectcore'
; own integers 'monw0', 'monw1', 'monw2' and 'monw3'
;
; 'mon' is a code procedure using the monitor functions in a low level manner
; directly reflecting the register conventions for these functions.
; the registers usually contain addresses, values or they mey be irrelevant
;
; the parameters when calling 'mon' are therefore defined like this:
;
; mon ( function, w0param, w1param, w2param, w3param )
;
; function is an integer value
;
; when a w-param is used as an address an array or an imteger value
; is accepted. in case of an array the address of the first halfword of
; element no 1 is used. in case of an integer value, this value is assumed
; to be an address.
;
; the results from monitor functions as returned in registers are by 'mon'
; stored in the global variables 'monw0', 'monw1', 'monw2' and 'monw3'
;
; 'reflectcore' is a code procedure used for manipulating the dope vector of an
; integer array. 'reflectcore' will change the array in such a way that
; it covers the core with the usual core addresses.
; thus a message buffer address returned by 'mon' may be used like this:
;
; receiver:= core.messbufferref(3);
;
(mon = slang list.no
mon monw0 monw1 monw2 monw3 reflectcore)
b. g1, e5 w.
d.
p. <:fpnames:>
l.
k=10000
s. a10, b10, c10, g3, j100 h.
g0 = 4 ; no of externals
e5: ; start of segment
g1: g3, g2 ;
j8: g0+8, 0 ; end address expression
j30: g0+30, 0 ; saved w2,w3
j4: g0+4, 0 ; take expression
j29: g0+29, 0 ; param alarm
j13: g0+13, 0 ; last used
j42: g0+42, 0 ; base of key variables
j90: 1, 0 ; monw0
j91: 2, 0 ; monw1
j92: 3, 0 ; monw2
j93: 4, 0 ; monw3
g2=k-2-g1 ; end of abs words
g3=k-2-g1 ; end of points
w.
e0: g0 ; no of externals
0 ; no of bytes in own core
<:monw0:>,0,0, 9<18,0 ; external no 1 (integer variable)
<:monw1:>,0,0, 9<18,0 ; external no 2 (integer variable)
<:monw2:>,0,0, 9<18,0 ; external no 3 (integer variable)
<:monw3:>,0,0, 9<18,0 ; external no 4 (integer variable)
260479, 150000 ; date and time
e1: rl. w2 (j13.) ; entry:
ds. w3 (j30.) ;
dl w1 x2+8 ; take function
so w0 16 ; if expression
jl. w3 (j4.) ; then take expression
rl w1 x1 ;
ds. w3 (j30.) ; save w23
sl w1 0 ; if function < 0
sl w1 124 ; or function > 122
jl. w3 (j29.) ; then param alarm
sz w1 1 ; if function is odd
jl. w3 (j29.) ; then param alarm
ls w1 -1 ;
hs w1 x2+7 ; save function/2
bz. w3 x1+b10. ;
sn w3 0 ; if pattern(function/2) = 0
jl. w3 (j29.) ; then param alarm
al w0 -9 ;
hs w0 x2+6 ; shiftcount:=-9
al w0 10 ;
rs w0 x2+8 ; rel address of param:= 10
c0: am (x2+8) ;
dl w1 x2+2 ; take param
so w0 16 ; if expression
jl. w3 (j4.) ; then take expression
bz w3 x2+7 ;
bz. w3 x3+b10. ; w3:=pattern(function/2)
bl w0 x2+6 ;
ls w3 (0) ; shift shiftcount
am (x2+8) ;
rl w0 x2 ; w0:=kind(param)
la. w0 b3. ; extract 5
se w0 10 ; if kind = integer proc
sn w0 2 ; or kind = integer expr
al w0 26 ; then kind:=integer
so w3 2.100 ; if array bit thrn
jl. a2. ; begin
sl w0 17 ; if kind = array
sl w0 24 ; or kind = zone then
jl. a2. ; begin
rl w0 x1 ; w0:=base
ba. w0 1 ; +1
jl. a4. ; end
; end
a2: sz w3 2.010 ; if integer bit
se w0 26 ; and kind = integer then
jl. a3. ; begin
rl w0 x1 ; w0:=value
jl. a4. ; end
a3: so w3 2.001 ; if not irrelevant bit
jl. w3 (j29.) ; then param alarm
al w0 0 ; clear w0
a4: am (x2+8) ;
rs w0 x2 ; save value
bl w3 x2+6 ; w3:=shiftcount
sl w3 0 ; if more parameters then
jl. a5. ; begin
al w3 x3+3 ;
hs w3 x2+6 ; next shiftcount:=shiftcount + 3
rl w3 x2+8 ;
al w3 x3+4 ; next param
rs w3 x2+8 ;
jl. c0. ; end
a5: bz w0 x2+7 ; w0:=function/2
ls w0 1 ; *2
rs. w0 b4. ; save monitor function
wa. w0 b5. ; +(jd1<11+0)
rs. w0 a6. ; set monitor call instruction
rl w3 x2+22 ; load value(w3)
rl w1 x2+14 ; load value(w1)
rl w0 x2+10 ; load value(w0)
rl w2 x2+18 ; load value(w2)
a6: jd 1<11 ; +func ; monitor call
rs. w0 (j90.) ; store w0
rs. w1 (j91.) ; store w1
rs. w2 (j92.) ; store w2
rs. w3 (j93.) ; store w3
rl. w3 b4. ;
se w3 24 ; if wait event
sn w3 66 ; or test event
jl. a8. ; goto test spare message buffer
a7: dl. w3 (j30.) ; reestablish w23
jl. (j8.) ; end address expression
a8: rl. w1 j42. ;
sn w2 (x1+48) ; if w2 = spare message buffer
sh w0 -1 ; and result > 0
jl. a7. ; then return
jl. a6. ; else goto repeat monitor function
b3: 2.11111 ; mask for extracting param kind
b4: 0 ; work for saving monitor function
b5: jd 1<11 ;
b10: h.
; table defining the possible types of actual parameters corresponding
; to the register parameters if the monitor functions
;
; the entries are interpreted like this:
;
; pattern(w0) < 9 + pattern(w1) < 6 +pattern(w2) < 3 + pattern(w3)
;
; pattern:
; 100 = array or zone
; 010 = integer
; 001 = irrelevant
;
; w0 w1 w2 w3
0 ; 0:
0 ; 2:
2. 001 001 001 110 ; 4: process description
2. 001 001 001 110 ; 6: initialize process
2. 001 001 001 110 ; 8: reserve process
2. 001 001 001 110 ; 10: release process
2. 001 010 001 110 ; 12: include user
2. 001 010 001 110 ; 14: exclude user
2. 001 110 001 110 ; 16: send message
2. 001 110 010 001 ; 18: wait answer
2. 001 110 001 110 ; 20: wait message
2. 010 110 010 001 ; 22: send answer
2. 001 001 010 001 ; 24: wait event
2. 001 001 010 001 ; 26: get event
0 ; 28:
0 ; 30:
0 ; 32:
0 ; 34:
2. 001 001 001 001 ; 36: get clock
2. 010 010 001 001 ; 38: set clock
2. 001 110 001 110 ; 40: create entry
2. 001 110 001 110 ; 42: lookup entry
2. 001 110 001 110 ; 44: change entry
2. 001 110 001 110 ; 46: rename entry
2. 001 001 001 110 ; 48: remove entry
2. 001 010 001 110 ; 50: permanent entry
2. 001 001 001 110 ; 52: create area process
2. 001 010 001 110 ; 54: create peripheral process
2. 001 110 001 110 ; 56: create internal process
2. 001 001 001 110 ; 58: start internal process
2. 001 001 001 110 ; 60: stop internal process
2. 001 110 001 110 ; 62: modify internal process
2. 001 001 001 110 ; 64: remove process
2. 001 001 010 001 ; 66: test event
2. 001 001 001 110 ; 68: generate name
2. 001 110 010 110 ; 70: copy core
2. 010 010 001 110 ; 72: set catalog base
2. 010 010 001 110 ; 74: set entry base
2. 001 110 001 110 ; 76: lookup head and tail
2. 001 110 110 110 ; 78: set bs claims
2. 001 001 001 110 ; 80: create pseudo process
2. 001 001 010 001 ; 82: regret message
2. 001 110 010 001 ; 84: general copy
2. 001 110 110 110 ; 86: lookup aux entry
2. 001 001 110 110 ; 88: clear statistics in aux entry
2. 001 010 110 110 ; 90: permanent entry in aux cat
2. 001 001 001 110 ; 92: create entry lock process
2. 001 010 001 110 ; 94: set priority
0 ; 96:
0 ; 98:
0 ; 100:
2. 001 001 001 110 ; 102: prepare bs
2. 001 110 001 110 ; 104: insert entry
2. 001 001 110 001 ; 106: insert bs
2. 001 001 110 001 ; 108: delete bs
2. 001 001 110 001 ; 110: delete entries
2. 001 110 001 110 ; 112: connect main catalog
2. 001 001 001 001 ; 114: remove main catalog
0 ; 116:
2. 001 110 110 110 ; 118: lookup bs claims (HCØ)
2. 001 110 110 110 ; 120: create aux entry and area process
2. 001 110 110 001 ; 122: remove aux entry
w.
e2: rl. w2 (j13.) ; entry (reflectcore)
ds. w3 (j30.) ; save stackref, w3
rl w1 x2+8 ; w1:= base word of array
al w0 -1 ;
rs w0 x1 ; base address:= -1
ba w1 x2+6 ;
rs w0 x1 ; lower index value:= -1
am (66) ;
rl w0 +96 ; w0:= cpa limit of own process
rs w0 x1-2 ; upper index value:= cpa limit
jl. (j8.) ; goto end address expression
e4:
c. e4-e5-506
m. ***code overflow on segment
z.
c. 502-e4+e5, ks-1, r. 252-(:e4-e5:)>1 z.
<:mon proc:>,0 ; alarm text
e. ; end segment
; tails
g0: ; tail(mon)
1 ; segments
0, 0, 0, 0 ; room for name
1<23 + e1-e5 ; entry point
1<18+41<12+41<6+41; no type procedure
41<18+3<12 ; (integer, undef, undef, undef, undef)
4<12 + e0-e5 ; code proc, start of external list
1<12 + 8 ; segments, bytes in own core
1<23 + 4 ; tail(monw0)
0, 0, 0, 0 ; room for name
1 ; byte address in own permanent core
9<18, 0 ; integer variable
4<12 + e0-e5 ;
1<12 + 8 ;
1<23 + 4 ; tail(monw1)
0, 0, 0, 0 ; room for name
3 ; byte address in own perm core
9<18, 0 ; integer variable
4<12 + e0-e5 ;
1<12 + 8 ;
1<23 + 4 ; tail(monw2)
0, 0, 0, 0 ; room for name
5 ; byte address in own perm core
9<18, 0 ; integer variable
4<12 + e0-e5 ;
1<12 + 8 ;
1<23 + 4 ; tail(monw3)
0, 0, 0, 0 ; room for name
7 ; byte address in own permanent core
9<18, 0 ; integer variable
4<12 + e0-e5 ;
1<12 + 8 ;
g1: 1<23 + 4 ; tail(reflectcore)
0, 0, 0, 0 ; room for name
1<23 + e2-e5 ; entry point
1<18 + 25<12, 0 ; no type procedure (boolean array)
4<12 + e0-e5 ;
1<12 + 8 ;
d.
p. <:insertproc:>
▶EOF◀