|
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: »epascallib«
└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
└─⟦6b41451d2⟧
└─⟦this⟧ »epascallib«
ntpascallib = edit tpascallib
l./; segment 0-1/,
l./g0: ; start of buffer/,
d./g2:/, i/
g0: ; start of buffer
jl. g1. ; goto init;
; initcode for pascal-program:
; insert the programname 'pascrun' just before the old program name
b. a10, b10 w.
a0: ; start of initcode
b10 ; size of initcode (number of words)
rl w0 x1+h51 ; move fp-modebits to program stack
rs. w0 b3. ;
la. w0 b0. ; remove fp-modebits: pause and list;
rs w0 x1+h51 ;
al w0 x2+b5 ; current command := current command - simulated;
rs w0 x1+h8 ;
rl. w0 b1. ; insert dummy 'end' in front;
a1: rs w0 x2+b5 ;
rl w0 x2 ; move a possible lefthand side and
al w2 x2+2 ; the delimiter preceding the program name;
sh w2 x3+2 ;
jl. a1. ;
; now there is room for inserting a new program name etc.
al. w3 b2. ; w3 := start of new program name etc.;
a5: rl w0 x3 ;
rs w0 x2+b5 ; move new program name to fp-program stack;
al w2 x2+2 ;
al w3 x3+2 ;
se. w3 b4. ;
jl. a5. ;
al w2 0 ; w2 := normal return to fp;
jl x1+h7 ; goto fp-end-program;
b0: -1 - 1<3 - 1<0 ; mask out: pause + list from modebits
b1: 2<12 + 2 ; dummy 'end'-element;
b2: ; start of new program name etc:
<:pascrun:>, 0 ;
4<12 + 10 ;
0 ;
b3: 0-0-0 ; (old fp-mode bits)
0 ;
0 ;
4<12 + 10 ;
b4: ; top of new program name etc:
b5 = b2 - b4 - 2 ; size of inserted elements (negative)
b10 = (:k - a0:) > 1 ; number of words in init-code
e. ;
æ12æ
g2: ; start of text-table:
/,
l./c6:/, d, i/
c6:<:giveup, blocklength = <0>:>
/,
l./c8:/, d,
l./c9:/, d,
l./c15:/, r/<0>/: <0>/,
l./c16:/, d,
l./c17:/, d,
l./c18:/, r/exist/exist: /,
l./c19:/, d, i/
c8:c9:c16:c17:c19: <: unused error code! ???<0>:>
/,
l./c24:/, r/<::>/<:illegal pointer value<0>:>/,
l./b. a20, b30,/, r/m50/m99/,
l./d44 = 16 ;/, l1, i/
d45 = 18 ; abs return address of last library call
d46 = 20 ; additional error inf
/,
l./b6:/, i/
m66: h66+2 ; bytes transferred in fp-answer
m68: h68 ; fp-stderror
/,
l./m0:/,
l./i1:/,
l./dl w2 x3-2041/, i/
sl. w1 (b2.) ; if proc table entry >= first library entry then
jl. i3. ; goto after library call;
/,
l./ba. w0 1;/, i/
i2: ; next:
/,
l./jl. i1. ;/, l1, i/
i3: ; after library call:
rl. w1 b3. ;
rl w2 x1+d45 ; w2 := rel return from last library call;
rl w1 x1+d43 ; w1 := current pascal procedure;
ws w2 x1+p6 ;
jl. i2. ; goto next;
/,
l./g1: ; init:/,
l./a0:/,
l./jl. (m30.);/, l1, i/
rl. w0 m68. ; primary output.error action := fp-stderror;
rs w0 x1+h2+2 ;
/,
l./bz w0 x1-2;/, d, i/
rl w0 x3+12 ; w0 := break-cause;
se w0 0 ; if cause <> instruction-error then
jl. a2. ; goto print error text;
rl w0 x1-2 ; w0 := erroneous instruction;
se w0 0 ; if all zero then
jl. a11. ; begin <* io-errors are trapped as such *>
rl. w0 (m66.) ; value := bytes transferred in fp-answer;
al w1 6 ; error number := io-error;
jl. a12. ; goto set value and error;
a11: ; end;
/,
l./ls w0 -6/, r/-6 /-18/,
l./rs. w0 b25./, d,
l./rs w1 x2+d38/, i/
a12: ; set value and error:
rs. w0 b25. ;
/,
l./a2:/,
l./se w0 2 ; if error number = 2/, i/
se w0 15 ; if file connect errors then
sn w0 18 ;
jl. a4. ; goto print file name;
sn w0 6 ; if error number = io-error then
al w0 2 ; error number := 2; <* force printing *>
/,
l./a3:/, i/
jl. a3. ; (skip print file name)
a4: ; print file name:
rl w1 x2+d46 ; zone := additional error inf;
rl w1 x1+h0+6 ; w1 := first share;
al w0 x1+14 ; w0 := file name addr;
jl. w3 (m31.) ; outtext (file name);
/,
l./a10:/,
l./al w2 1; else 1/, r/1/0/, ; rettet 80.04.10: ok-bit vendte forkert
l./se w0 5 ; if not break then/, i/
sn w0 6 ; if io-error then
jl. a13. ; goto stderror;
/,
l./jl x3+f9/, l1, i/
a13: rl. w3 b1. ; stderror:
dl w1 x3+2 ; restore (w0,w1,w2,w3) from regdump;
dl w3 x3+6 ;
jl. (m68.) ; goto fp-stderror;
/,
l./; segment 2/,
d, i/
æ12æ
0, r.(:(:k+511:)>9<9-k:)>1 + 1 ; fill to segment boundary
m. start of page 1
/,
l./0,r.(:1026/, d,
l./; clock (real function)/,
l./; call:/,
l1 , d, i/
; w2 = proc table entry
; w3 = return-2
; +0: segm<12 + rel
/,
l./d6:/, d, i/
d6: ; clock:
ds. w3 d0. ;
rl w1 66 ;
/,
l./jl x3;/, d, i/
jl. d4. ; return;
/,
l./; segment 3/,
d, i/
æ12æ
0, r.(:(:k+511:)>9<9-k:)>1 + 1 ; fill to segment boundary
m. start of page 2
/,
l./0,r.(:1538/, d,
l./d12: am 1 ; date/,
l./b4:/,
l./rl. w1 b3./, d,
l./b10:/,
l./jl x2 ;/, i/
rl. w1 b3. ;
/,
l./; segment 4/, d, i/
æ12æ
0, r.(:(:k+511:)>9<9-k:)>1 + 1 ; fill to segment boundary
m. start of page 3
/,
l./0,r.(:/, d,
l./0,r.(:2562-k/, d,
l./; segment 5-6/,
d, i/
æ12æ
0, r.(:(:k+511:)>9<9-k:)>1 + 1 ; fill to segment boundary
m. start of page 4
/,
l./; file initialization/,
l./a2:/,
l./rs w0 x1+h2+2/, r/:=0/:= pascal runtime system/,
i/
rl. w3 b4. ;
rl w0 x3+h20+h2+2; (use same giveup action as in primary input);
/,
l./i2:;reset:/,
l./jd 1<11+42;/, l1, i/
rl. w1 b1. ; w1 := zone;
/,
l./al w2 x3;/,
l./rl. w1 b1.;/, d,
l./c6:/, r/19/18/,
l./c1:/, d,
l./c2:/, r/1 /18-15/,
l./c3:/, d,
l./c4:/, d,
l./c5:/, r/w1/w0/,
l./al w0 -1/, d, i/
rx w1 0 ; w0 := additional inf (= zone), w1 = errorcode
/,
l./; segment 7-8/,
d, i/
æ12æ
0, r.(:(:k+511:)>9<9-k:)>1 + 1 ; fill to segment boundary
m. start of page 5
/,
l./0,r.(:/, d,
l./d13:/, r/17-13/7-13 /,r/17/ 7/,
l./; segment 9-10/,
d, i/
æ12æ
0, r.(:(:k+511:)>9<9-k:)>1 + 1 ; fill to segment boundary
m. start of page 6
/,
l./0,r.(:/, d,
; ret i read(char): convert nl,ff to sp
l./i3:/,
l./se w2 10;/, l1, i/
sn w2 12 ; if char = newline or char = formfeed then
al w2 32 ; char := space;
/,
; btj 80.05.08: null/lf/del skal være blinde
l./f0: h./,
l1, r/10/16/, r/10,10 /16,10 /,
l./; 120-127/, r/10 /16 /,
l./c4:/,
l./; state action table/,
l./; 0 2 4 6/, r/14/14 16/,
l1, r/em/em blinds/,
l./r0=/, l1, r/ ;/, c0-f2,r0 ;/,
l2, r/ ;/, c0-f2,r1 ;/,
l2, r/ ;/, c0-f2,r2 ;/,
l2, r/ ;/, c0-f2,r3 ;/,
; btj 791219: ff blev skipped
l./i2:/,
l./a3:/,
l./jl. i2. ; goto get next char;/, i/
se w2 12 ; if last char = ff then goto return;
/,
; btj 80.05.08: null osv skal være blinde
l./r20=/, l-3, r/14/14 16/,
l1, r/em/em blinds/,
l./r20=/,
l1, r/;/, c0-f2,r20;/,
l2, r/;/, c0-f2,r21;/,
l2, r/;/, c0-f2,r22;/,
l2, r/;/, c0-f2,r23;/,
l2, r/;/, c0-f2,r24;/,
l2, r/;/, c0-f2,r25;/,
l2, r/;/, c0-f2,r26;/,
;; btj 791219: ff blev skipped
;l./i2:/,
;l./a3:/,
;l./jl. i2. ; goto get next char;/, i/
;
; se w2 12 ; if last char = ff then goto return;
;/,
l./; segment 11/,
d, i/
æ12æ
0, r.(:(:k+511:)>9<9-k:)>1 + 1 ; fill to segment boundary
m. start of page 7
/,
l./0,r.(:/, d,
l./a12: al w1 22 ; try to read past eof/,
l./rl w0 x2+4/, r/rutime/runtime/,
l./; pack (limited to string/,
l./f2:/,
l./a4:/, l1, i/
; w0 contains: 0, 1 or 2 characters, rigthjustified
sn w0 1 ; if partial word is empty (i.e. = flag) then
jl. f5. ; goto return;
/,
l./ld w0 8/, r/up/up with spaces/,
l1, i/
al w2 32 ; w2 := space;
lo w0 4 ;
/,
l./ld w0 8/, l1, d1, i/
lo w0 4 ;
/,
l./0,r.(:6146-k/, d,
i/
0, r.(:(:k+511:)>9<9-k:)>1 + 1; fill to segment boundary
/,
f
▶EOF◀