|
|
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: 11520 (0x2d00)
Types: TextFile
Names: »retsys3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »retsys3tx «
mode list.yes
system4tx=edit system3tx
; ny entry 15 : free core, low as well as high end partition
; and virtual data file name
; i entry 5 : move core, mh instruktion benyttes hvis monitor
; er ny nok og ikke cpu985
l./page ...1/, r/86.04.04/88.05.24/
l./s. i6/, r/i6 /i20/
l./page ...2/, d./s4 ; time/, i#
\f
; jz.fgs 1988.05.24 algol 8, system(fnc, i, arr or s), page ...2...
b. a21, b6, c30, d1, f1, g5, j104 ; begin segment 1
w.
k = 0, g0 = 0 ; no of externals + no of globals = 0
h.
d0: g1 , g2 ; rel of last point , rel of last absword
j3: g0+ 3, 0 ; rs entry 3 : reserve
j4: g0+ 4, 0 ; rs entry 4 : take expression
j6: g0+ 6, 0 ; rs entry 6 : end register expression
j13: g0+ 13, 0 ; rs entry 13 : last used
j21: g0+ 21, 0 ; rs entry 21 : general alarm
j26: g0+ 26, 0 ; rs entry 26 : in (current input zone address)
j29: g0+ 29, 0 ; rs entry 29 : param alarm
j30: g0+ 30, 0 ; rs entry 30 : saved stackreference , saved w3
j38: g0+ 38, 0 ; rs entry 38 : console process address
j39: g0+ 39, 0 ; rs entry 39 : trap base
j41: g0+ 41, 0 ; rs entry 41 : parent process address
j54: g0+ 54, 0 ; rs entry 54 : field alarm
j104: g0+104, 0 ; rs entry 104 : own proc descr addr
j42: 1<11+1 , 0 ; ref to second segment
j43: 1<11+2 , 0 ; ref to third segment
g2 = k - d0 - 2 ; define rel of last absword
g1 = k - d0 - 2 ; define rel of last point
w. ;
e0: 0 ; start of external list:
0 ;
s3 ; date
s4 ; time
#
l./page ...3/, r/86.04.04/88.06.08/
l./e1:/, l./al w1 -2/, r/-2/-4/
l1, r/two/four/
l1, r/ter;/ter and 2 * fnc;/
l./rs w1 x2+6/, l1, i/
ls w1 1 ;
rs w1 x2-4 ; sref - 4 := 2 * value of fnc;
/, p-1
l./page ...4/, r/87.11.06/88.06.08/
l./; maybe check array:/, d1, i/
am (x2-4) ; w0 :=
rl. w0 f1. ; entry table (2 * fnc);
/, p-4
l./a0:/, d2, i#
a0: am (x2-4) ; call action:
rl. w1 f1. ; entry := entry table (2 * fnc);
el w3 2 ; absw := entry.rel addr absword;
el w1 3 ; rel := entry.relative entry ;
hs. w1 b4. ;
d1: rl. w3 (x3) ; goto segtable (absw) +
b4 = k + 1 ; rel:
jl x3+0 ; rel;
#
l./; exit conditions :/, i#
\f
; jz.fgs 1988.05.24 algol 8, system(fnc, i, arr or s), page ...4a...
#
l./c12:/, d2, i#
rs w0 (x2+8) ; exit 2: i := w0; system := w1;
c0: rs. w2 (j13.) ; exit 3: release reservation;
jl. (j6.) ; end register expression;
i11 = k - d0 ; external entry exit2:
ds. w3 (j30.) ; save sref, w3;
rl w3 x2-2 ; restore w3;
jl. c11. ; goto exit2;
#
l./page ...5/, r/87.11.06/88.06.07/
l./c2:/, l-1, d./c3:/, d
l./page ...6/, r/87.07.08/88.06.07/
l./; integer parameter:/, d./goto exit3;/, i#
rl w0 x3+2 ; integer parameter:
rl. w3 b3. ; w3 :=
sl w0 0 ; sign extension of w0;
al w3 0 ;
rx w1 x2-2 ; swop (w1, type third param);
sh w1 4 ; if type third param = integer or long array then
sn w1 3 ; arr (first two words) := value of param
ci w0 0 ; else
am (x2+14) ; arr (first two words) := float(value of param);
ds w0 2 ;
rx w1 x2-2 ; restore (w1, type third param);
jl. c0. ; goto exit3;
#
l./; entry 5, move core/, i#
\f
; jz.fgs 1988.06.08 algol 8, system, page ...6a...
#
l./attempt move:/, r/ rl w1/a8: rl w1/,
i#
gg w3 34 ;
sh w3 79 ; if cpu reg >= 80
sh w3 59 ; or cpu reg < 60 then
jl. a8. ; goto attempt move;
rl w3 x2+16 ; halfs to move :=
ws w3 x2+14 ; addr last array word -
al w3 x3+2 ; addr first array word + 2;
rl w0 x2+14 ; to field := addr first array word;
rl w1 (x2+8) ; from field := addr i;
mh w1 (6) ; move halfwords (w0, w1, w3);
jl. a11. ; goto moving ok;
#, p1
l./a10:/, l-1, r/ am 1 /a11: am 1 /
l./page ...7/, r/85.03.08/88.06.07/
l./page ...8/, d./c16:/, d
l./page ...9/, r/87.11.06/88.05.25/
l1, d./g3 = k - f1 - 1/, d, i#
; type table (type requirements for third parameter:
; (cmplx or double)<4+(long or real)<3+integer<2+boolean<1+string):
h. ;
f0 = k - 1 ;
; ; fnc:
1<4+1<3+1<2+1<1+1 ; 1 floating point precision
1<4+1<3+1<2 ; 2 free core, program name
1<4+1<3+1<2+1<1 ; 3 array bounds
1<4+1<3+1<2 ; 4 fileprocessor parameter
1<4+1<3+1<2 ; 5 move core area
1<4+1<3+1<2 ; 6 any message, own process
1<4+1<3+1<2 ; 7 console description
1<4+1<3+1<2 ; 8 parent description
1 ; 9 run time alarm
1<4+1<3+1<2 +1 ; 10 parent message
1<4+1<3+1<2 ; 11 intervals
1<4+1<3+1<2 ; 12 activity description
1<4+1<3+1<2 ; 13 fp, release, rs segments
1<4+1<3+1<2 ; 14 latest answer
1<4+1<3+1<2 ; 15 free core, data file name
w. ;
\f
; jz.fgs 1988.06.07 algol 8, system, page ...9a...
; action table (+1 means that third parameter in the call
; must be real array with length >=2):
h. ;
f1 = k - 2 ;
; ; fnc:
d0- d1, c1 -d0 ; 1 floating point precision
j43-d1, i7 ; 2 free core, program name (+1)
j42-d1, i0 ; 3 array bounds
d0- d1, c4 -d0+1 ; 4 fileprocessor parameter (+1)
d0- d1, c5 -d0+1 ; 5 move core area (+1)
d0- d1, c6 -d0+1 ; 6 any message, own process (+1)
d0- d1, c7 -d0+1 ; 7 console description (+1)
d0- d1, c8 -d0+1 ; 8 parent description (+1)
j42-d1, i1 ; 9 run time alarm
j42-d1, i2 ; 10 parent message (+1)
j42-d1, i3 ; 11 intervals (+1)
j43-d1, i4 ; 12 activity description (+1)
j42-d1, i5 ; 13 fp, release, rs segments (+1)
j43-d1, i6 ; 14 latest answer (+1)
j43-d1, i7 ; 15 free core, data file name (= entry 2)
w. ;
g3 = (:k-f1-2:) > 1 ; no of entries in system
#
l./g4:/, i/
\f
; jz.fgs 1988.06.07 algol 8, system, page ...9b...
m. end code on segment 0
/
l./code too long/, r/code/code on segment 0/
l./...16/, r/87.11.06/88.06.07/, r/.../page .../
l./i0=/, d./i5=/, i#
i0 = c4 - d0 ; define rel entry for system 3 code
i1 = c1 - d0 ; define rel entry for system 9 code
i2 = c2 - d0 + 1 ; define rel entry for system 10 code (+check array)
i3 = c3 - d0 + 1 ; define rel entry for system 11 code (+check array)
i5 = c5 - d0 + 1 ; define rel entry for system 13 code (+check array)
#
l./g4:/, i/
\f
; jz.fgs 1988.06.07 algol 8, system, page ...16a...
m. end code on segment 1
/
l./segment 2 too/, r/2/1/
l./page ...17/, d./g1=k - d0 - 2/, i#
\f
; jz.fgs 1988.06.07 algol 8, system, page ...17...
b. a40, b5, c5, d1, g5, j120 ; begin of segment 3
h.
d0: g1 , g2 ; rel of last point, rel of last absword
j0 :1<11o.(:-2:), 0 ; own segment 0
j4 : 4 , 0 ; rs entry 4: take expression
j5 : 5 , 0 ; rs entry 5: goto point
j6 : 6 , 0 ; rs entry 6: end register expression
j13 : 13 , 0 ; rs entry 13: last used
j15 : 15 , 0 ; rs entry 15: first of program
j18 : 18 , 0 ; rs entry 18: zone alarm, prints the text <:index:>
j21 : 21 , 0 ; rs entry 21: general alarm
j23 : 23 , 0 ; rs entry 23: youngest zone
j30 : 30 , 0 ; rs entry 30: saved sref, saved w3
j32 : 32 , g5 ; rs entry 32: stderror with chain for rel
j40 : 40 , 0 ; rs entry 40: name of program
j61 : 61 , 0 ; rs entry 61: csr, cza
j64 : 64 , 0 ; rs entry 64: virtual data file name
j74 : 74 , 0 ; rs entry 74: max last used
j75 : 75 , 0 ; rs entry 75: limit last used
j78 : 78 , 0 ; rs entry 78: no of activities
j79 : 79 , 0 ; rs entry 79: base of activity table
j80 : 80 , 0 ; rs entry 80: (azone, aref)
j85 : 85 , 0 ; rs entry 85: current activity no
j91 : 91 , 0 ; rs entry 91: trap chain
j99 : 99 , 0 ; rs entry 99: saved parity count
j101: 101 , 0 ; rs entry 101: latest answer
j110: 110 , 0 ; rs entry 110: switch to low end partition
j111: 111 , 0 ; rs entry 111: switch to high end partition
g2=k - d0 - 2 ; define rel of last absword
j33: 33 , 0 ; rs point 33 : check
g1=k - d0 - 2 ; define rel of last point
#
l./page ...18/, r/84.01.27/88.06.07/
l./i4 =/, r/d0 /d0 + 1/, r/12/12 (+check array)/
l./page ...21/, r/84.01.27/88.06.07/
l./i6 =/, r/d0 /d0 + 1/, r/14/14 (+check array)/
l./page ...22/, i#
\f
; jz.fgs 1988.06.08 algol 8, system(fnc, i, arr or s), page ...21a..
; entry 2, free core, program name
i7 = k - d0 + 1 ; define entry system (2, ...) (+check array)
ds. w3 (j30.) ; save sref, w3;
rl. w1 (j13.) ; w1 := last used;
rl. w0 (j74.) ; w0 := max last used;
se w0 0 ; if max last used = 0 then
jl. a21. ; begin
rl. w0 (j15.) ; w0 := first of program;
al w1 x1-1024 ; w1 := w1 - 1024;
a21: ws w1 0 ; end;
al w1 x1+8 ; system := w1 := free core low part :=
ba w1 x2+4 ; w1 - w0 + 2 + 6 + appetite;
; (two halfs reserved for type third param)
rl w3 x2+6 ;
se w3 2 ; if fnc = 2 then
jl. a22. ; i := w0 := w1;
al w0 x1 ; else
jl. a23. ; begin <*fnc = 15*>
a22: jl. w3 (j111.) ; switch to high end partition;
rl. w0 (j15.) ; w0 := first of program;
rl. w3 (j13.) ; w3 := last used -
al w3 x3-1024 ; 1024 -
ws w3 0 ; w0 ; <*free core high part*>
sh w3 0 ; if w3 < = 0 then
al w3 0 ; w3 := 0;
al w0 x3 ; i := w0 := w3;
jl. w3 (j110.) ; switch to low end partition;
am j64-j40 ; modify address program name to data file name;
a23: rl. w3 j40. ; end;
rs w3 x2-2 ; w3 := address program file name;
rl. w3 (j0.) ; save w3;
jl x3+i11 ; goto exit1 on segment 0;
#
l./page ...22/, r/84.01.27/88.06.07/
l./; procedure blockproc(z/, i#
\f
; jz.fgs 1988.06.07 algol 8, system, page ...22a...
#
l./g4:/, i/
\f
; jz.fgs 1988.06.07 algol 8, system, page ...22b...
m. end code on segment 2
/
l./segment 3 too/, r/3/2/
l./page ...23/, l./g1:/, l./m./, r/87.11.06/88.08.17/
l1, r/ system/ system/
f
end
▶EOF◀