|
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: 49920 (0xc300)
Types: TextFile
Names: »tpascrun«
└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
└─⟦6b41451d2⟧
└─⟦this⟧ »tpascrun«
(pascrun = slang
pascrun)
; pascal runtime system
; version 16
; date 81.05.05▶05◀
b. g3 w.
d.
p. <:fpnames:>
l.
k = h55
s. c10, d50, e30, f25, p20, r155 w.
; the first part of the variables are used
; by various library procedures
d0: 0, r.5 ; +0: (not used)
0, r.5 ;+10: (not used)
0, r.5 ;+20: (not used)
0, r.5 ;+30: stack chain for output
; the following variables describe the core-layout and some
; paging-dependant variables
; description of partitioning of core:
;
;
; low addresses
;
; ! !
; ! runtime !
; ! system !
; ! !
; !-----------!
; d1 --> ! ! first of stack
; ! !
; ! !
; !-----------!
; d2 --> ! ! stacktop
; ! !
; ! !
; !-----------!
; d6 --> ! ! first of proc nearest to stack
; ! !
; ! !
; !-----------!
; d8 --> ! ! first of last loaded proc (=top of next to load)
; ! !
; ! !
; !-----------!
; d9 --> ! ! last killed by heap-reservation
; ! !
; ! !
; !-----------!
; d10--> ! ! last used of heap
; ! !
; ! !
; !-----------!
; d11--> ! ! first of resident code
; ! !
; ! !
; !-----------!
; d12--> ! ! first of procedure table
; ! !
; ! !
; !-----------!
; d13--> ! ! first of library table
; ! !
; ! !
; !-----------!
; d14--> ! ! top of procedure table
; ! !
; ! fpstack !
; ! !
; ! !
;
; high addresses
d1: 0-0-0 ; first of stack
d2: 0-0-0 ; top of stack
d3: 512 ; (minimum room between (d2) and (d6))
d6: 0-0-0 ; first of proc nearest to stack
d7: 512 + 00 + 00 ; (minimum room between (d2) and (d10))
d8: 0-0-0 ; first of last loaded procedure
d9: 0-0-0 ; last killed by heap-reserve
d10: 0-0-0 ; last used of heap
d11: 0-0-0 ; first of resident procedures
d12: 0-0-0 ; first of procedure table
d13: 0-0-0 ; first of library table
d14: 0-0-0 ; top of proc table
d15: 000 ; maximum page size (to be reserved above (d10)
; the next variables are used for page-transfers
d4: <:pascallib:>,0,0 ; name of library
d5: 0, r.5 ; name of program file
d20: 0 ; zero ; dummy name (also used as illegal instruction by io-error)
d21: 3 < 12 ; input message
0 ;+2: first address
0 ;+4: last address (may also be top address)
0 ;+6: segment number
d22: 0 ; spare message buffer
d23: 0, r.8 ; answer
; format of procedure table:
p0 = 0 ; segment number in program/library file
p2 = 2 ; if not in core: negative size of procedure
; if in core : top address of procedure
p4 = 4 ; if pascal procedure: size of stack-space
; if library procedure: address of runtime error
p6 = 6 ; if in core : first address of procedure
; if not in core: zero, if never used
; else old first address
p8 = 8 ; if pascal procedure: virtual address of first error line
; if library procedure: saved stackref
p12 = 12 ; accumulated time (double word)
p14 = 14 ; number of calls
p10 =16 ; (size of entry)
; transfer
;
; call: w0 = segment number
; w2 = return
;
; exit: return+0: transfer not ok: w0 = logical status
; return+2: transfer ok : w0 = 2
b. a10, b10 w.
b0: 0 ; return
am d4-d5 ;f0-2: w3 := library name;
f0: al. w3 d5. ;f0+0: w3 := program name;
rs. w0 d21.+6 ; save segment number in message;
rs. w2 b0. ; save(return);
al. w1 d23. ; w1 := answer area;
al w2 0 ;
rx. w2 d22. ; spare mess buf := 0;
se w2 0 ; if spare mess buf was <> 0 then
jd 1<11+18; wait answer(spare mess buf);
; (it will only be zero just after startup,
; and in case of a break in this very procedure)
rl. w1 d44. ;
al w1 x1+1 ; increase(blocksread);
rs. w1 d44. ;
a0: ; rep:
al. w1 d21. ; w1 := message;
jd 1<11+16; send message(w1, w3);
al. w1 d23. ; w1 := answer;
jd 1<11+18; w0 := wait answer(w1, w2);
al w2 1 ; w2 := logical status :=
ls w2 (0) ; 1 shift result
sn w2 1<1 ;
lo w2 x1 ; + maybe status(answer);
sn w2 1<1 ; if status = 2 and
sh w2 (x1+2) ; bytes transferred < 2 then
jl. a1. ;
jl. a0. ; goto rep;
a1: ;
sz w2 1<1 ; if result <> ok then
jl. a2. ; begin
jd 1<11+52; create area process (name);
rs w0 x3+8 ; name table addr := undef;
sn w0 0 ; if ok then
jl. a0. ; goto rep;
al w1 x3 ; (prepare w1=name, for fp-exit)
sn. w1 d5. ; if name = library name then
jl. h7. ; goto fp-end-program(name,status);
a2: ; end;
al w0 x2 ; w0 := logical status;
al. w3 d20. ; w3 := dummy name;
jd 1<11+16; spare mess buf := send dummy message;
rs. w2 d22. ;
rl. w2 b0. ;
sn w0 1<1 ; if transfer ok then
jl x2+2 ; normal return
jl x2 ; else error return;
e. ;
; kill
;
; call: w0 = first addr to kill
; w1 = top addr to kill
; w3 = return
;
; exit: w0 = unchanged
; w1 = last addr to kill
; w2 = unchanged
; w3 = undef
b. a10, b10 w.
b0: 0 ; first addr to kill
b1: 0 ; last addr to kill
b2: 0 ; return
f1: ;
al w1 x1-2 ; w1 := last addr to kill;
ds. w1 b1. ; save (first addr, last addr);
rs. w3 b2. ; save (return);
rl. w3 d14. ; entry := top of proc table;
a0: ; next:
sn. w3 (d12.) ; if entry = first of proc table then
jl. (b2.) ; return;
al w3 x3-p10 ; decrease(entry);
sl w1 (x3+p6) ; if last to kill < first (entry) or
sl w0 (x3+p2) ; first to kill >= top (entry) then
jl. a0. ; goto next;
; if 'returnaddr' is killed then
; convert abs addr to: abs proc table entry, rel addr
rl. w0 d40. ; w0 := return addr;
sl w0 (x3+p6) ; if returnaddr inside proc (entry) then
sl w0 (x3+p2) ; <* note: can't be equal to top(proc) *>
jl. a5. ; begin
ws w0 x3+p6 ; rel return addr := returnaddr - first (entry);
ds. w0 d42. ; returnproc := entry;
al. w0 f2. ; returnaddr :=
rs. w0 d40. ; restore and return;
c. -1
m.*** begin testversion
rs. w3 b9.
al. w0 b10.
rl. w3 b2.
sh. w3 r8. ; if not called from 'new' then
jl. w3 h31.-2 ; outtext (warning)
rl. w3 b9.
jl. a5.
b9: 0
b10: <:<10>***pascal warning: calling procedure killed<10><0>:>
m.*** end testversion
z.
a5: ; end;
rl w0 x3+p6 ; w0 := first (entry);
; optimize stack-reservation
rl. w1 d6. ; if proc was nearest to stack then
sl w1 (x3+p6) ;
sl w1 (x3+p2) ;
jl. a6. ; begin
rl w1 x3+p2 ;
rs. w1 d6. ; closest to stack := top(entry);
a6: ; end;
ws w0 x3+p2 ; last (entry) :=
rs w0 x3+p2 ; negative size of procedure;
dl. w1 b1. ; restore (first,last to kill);
jl. a0. ; goto next;
e. ;
; restore and return
;
; (called because returnaddr was kill'ed)
;
; call: d41, d42 = return point
;
; exit: w2 = unchanged
f2: ;
jl. w1 f4. ; restore returnproc;
jl (0) ; return;
; get procedure and enter
;
; (called because procedure was not in core)
;
; call: w3 = rel (or abs) proc table entry
;
; exit: w1 = unchanged
; w2 = unchanged
; (w3 = abs proc table entry)
f3: ;
al w0 x1 ; (save w1);
jl. w1 f5. ; get procedure;
rl w1 0 ; (restore w1);
jl (x3+p6) ; goto procedure;
; restore returnproc
;
; call: w1 = return
; d41, d42 = return point
;
; exit: w0 = abs return addr
; w2 = unchanged
b. b10 w.
b0: 0 ;
f4: ;
rs. w1 b0. ; (save return);
dl. w0 d42. ; w0 := rel; w3 := proc table entry;
jl. w1 f5. ; get procedure;
wa w0 x3+p6 ; w0 := abs return := rel + first (entry);
rs. w0 d40. ; returnaddr := abs return;
jl. (b0.) ; return;
e. ;
; get procedure
;
; call: w1 = return
; w3 = abs proc table entry
;
; exit: w0 = unchanged
; w1 = undef
; w2 = unchanged
; w3 = abs proc table entry
b. a10, b10 w.
b0: 0 ; saved w0
b1: 0 ; return
b2: 0 ; saved w2
b3: 0 ; abs proc table entry
b4: 0 ; expected top
b5: 0 ; calling proc
f5: ;
ds. w1 b1. ;
ds. w3 b3. ;
rl w0 x3+p2 ; if top (entry) > 0 then
sl w0 0 ; <* proc is in core *>
jl. a10. ; goto return;
rl. w1 d43. ; calling proc :=
rs. w1 b5. ; current pascal proc;
; w0 = negative size of procedure
; step 1: try to fit just above last loaded procedure
wa. w0 d8. ; w0 := expected first addr;
a0: ; test against stack:
al w1 -1<9 ; ps stacktop :=
la w1 x3+p2 ; (rounded size of procedure
ac w1 x1 ;
wa w1 x3+p2 ; + negative size of procedure
wa. w1 d2. ; + stacktop
wa. w1 d3. ; + min room between stack and code;
sl w0 x1 ; if expected first >= ps stacktop then
jl. a2. ; goto found;
; step 2: try to fit just above heap
rl w0 x3+p2 ; w0 := expected first addr;
wa. w0 d10. ;
sh w0 x1-2 ; if expected first < ps stacktop then
jl. e1. ; alarm (process too small);
; <* should never occur, if 'd7' is properly set *>
a2: ; found:
; step 3: set (first,last) in procedure table
rs w0 x3+p6 ; first (entry) := expected first;
ws w0 x3+p2 ; expected top := expected first
rs. w0 b4. ; - negative size of procedure;
; step 4: compute first addr of transfer
; (it has already been tested that it will
; not interfere with the stack)
al w0 -1<9 ; w0 := negative size
la w0 x3+p2 ; rounded to integral number of used segments
wa. w0 b4. ; + top of procedure;
rl. w1 b4. ; w1 := top of procedure;
al w1 x1-2 ; w1 := last of procedure;
ds. w1 d21.+4 ; save (first,last) in message;
; step 4a: the procedure may not cross the maxpage boundary
; just above the heap
rl. w3 d10. ; boundary := last used of heap
ws. w3 d15. ; - maximum page size;
sl w1 x3 ; if last of transfer >= boundary and
sl w0 x3 ; first of transfer < boundary then
jl. a3. ; begin
al w0 x3 ; first := boundary;
jl. a5. ; goto set expected first;
a3: ; end;
; step 5: avoid killing of calling procedure
; (used by: call library procedure (optimization)
; call pascal procedure (because of string params)
al w3 0 ; calling proc := 0;
rx. w3 b5. ; w3 := old calling proc;
sn w3 0 ; if calling proc <> 0 then
jl. a6. ; begin
sl w1 (x3+p6) ; if last of transfer >= first (proc) and
sl w0 (x3+p2) ; first of transfer < top (proc) then
jl. a6. ; begin
; the calling proc was about to get kill'ed.
; try to fit the call'ed procedure just above it.
; repeat from step 1a.
rl w0 x3+p6 ; w0 := first (calling proc);
a5: ; set expected first:
rl. w3 b3. ; (restore called proc entry);
wa w0 x3+p2 ; w0 := expected first addr :=
; first(calling) + negative size(called);
jl. a0. ; goto test against stack;
a6: ; end;
; end;
; step 6: kill all procedures touched by the transfer
;
; w0 = first of transfer
; w1 = last of transfer
al w1 x1+2 ; w1 := top of transfer;
jl. w3 f1. ; kill;
rl. w3 b3. ; (restore proc entry);
al w1 x1+2 ;
; step 7: compute top addr for next procedure to be loaded
rl w0 x3+p6 ; w0 := first of procedure;
rs. w0 d8. ; first of last loaded := first of procedure;
; step 8: optimize stack-reserve and heap-reserve
sh. w0 (d6.) ; if top of next loaded <= closest to stack then
rs. w0 d6. ; closest to stack := top of next loaded;
sl. w1 (d9.) ; if top (entry) >= last killed by heap then
rs. w1 d9. ; last killed by heap := top (entry);
; step 9: load the procedure from program- or library file
rl w0 x3+p0 ; w0 := segm number (entry);
sl. w3 (d13.) ; if entry >= first of library table then
am -2 ; transfer from library file
jl. w2 f0. ; else transfer from program file;
jl. e3. ;+2: io-error
dl. w3 b3. ; restore(w2, proc table entry);
rl. w0 b4. ;
rs w0 x3+p2 ; top(entry) := expected top;
; step 10: exit
a10: ; return:
dl. w1 b1. ;
jl x1 ; return;
e. ;
; break routine
b. a10 w.
c0: ; interrupt address:
jd 1<11+0 ; set interrupt address;
rs. w1 d2. ; top of stack := w1;
al w0 0 ; w0 := procedure number of main program;
jl w3 (x2-2047) ; call pascal procedure
0 ;+2: occupied in stack = 0
r. (:c0.+h76:)>1+1; (fill up to size of dumped regs)
c1: ; top of regdump
dl. w3 c0.+12 ; w3 := cause; w2 := ic;
se w3 0 ; if cause = 0 and
jl. a2. ;
bl w0 x2-2 ; (w0 := break'ed instruction)
h. se w0, ks w. ; instruction = 'ks' then
jl. a2. ; begin
a0: ; enter fp-break:
al. w1 h10. ; move registers to fp;
a1: ;
rl w0 x1+c0-h10 ;
rs w0 x1 ;
al w1 x1+2 ;
se. w1 h10.+h76;
jl. a1. ;
jl x1 ; goto fp-break routine;
a2: ; end;
m.*** temporary: prevent calling break recursively
al w0 2
hs. w0 a0.-1
; if break occured inside runtime system then don't destroy returnaddr
sl. w2 (d2.) ; if ic >= stacktop then
rs. w2 d40. ; returnaddr := ic;
rl. w0 c0.+14 ; w0 := effective address;
se w0 -2047 ; if w0=nilvalue (e.g. after indirect)
bs w0 x2-1 ; or w0 - instr.disp = nilvalue
sn w0 -2047 ; (e.g. before indirect) then
am 24-5 ; errorcode := illegal pointer value
; else
am 5-3 ; errorcode := break;
e3: am 3-1 ; ioerror:
e1: am 1-25 ; process too small:
e25: al w1 25 ; dispose outside heap:
; call alarm-segment and transfer the returnpoint
c2: ; call and enter alarm:
; call: w0 = additional error inf
; w1 = text number
; d39 = stackref
; d40 = returnaddr (i.e. addr where error occured)
; (d41,d42 = returnpoint, if returnaddr just kill'ed)
rs. w0 d46. ; save (additional error inf);
rs. w1 d38. ; save (text number);
rl. w0 d40. ; w0 := returnaddr;
rl. w3 d14. ; w3 := top of library table
a3: ; next:
sn. w3 (d12.) ; if entry = first of proc table then
jl. a4. ; goto returnpoint set;
al w3 x3-p10 ; decrease (entry);
sh w0 (x3+p2) ; if returnaddr > top (entry) or
sh w0 (x3+p6) ; returnaddr <= first (entry) then
jl. a3. ; goto next;
; <* returnaddr can never be the first instruction
; in a procedure, but may well be the last *>
ws w0 x3+p6 ; w0 := rel addr := returnaddr - first(entry);
ds. w0 d42. ; save in return point;
a4: ; return point set:
; call alarm:
rl. w3 d13. ;
jl. w1 f5. ; get procedure ( alarm segment);
rl w0 x3+p6 ;
rl w1 x3+p6 ;
al w1 x1+512 ;
jl. w3 f1. ; kill first segment of procedure;
ds. w1 d21.+4 ; first,last in message := first of procedure;
rl. w0 d12. ; w0 := first of procedure table;
al. w1 c0. ; w1 := addr of interrupt routine;
rl. w2 d13. ; w2 := first of library table;
jl w3 (x2+p6) ; enter alarm procedure;
d38: 0 ;+0: error number
d39: 0 ;+2: stackref when error occured
d40: 0 ;+4: abs returnaddr where error occured
d41: 0 ;+6: return point: abs proc table entry
d42: 0 ;+8: rel return addr
d43: 0 ;+10: current pascal procedure
jl. a0. ;+12: goto enter fp-break
jl. f0. ;+14: goto transfer from program file
d44: 0 ;+16: blocksread
d45: 0 ;+18: abs return addr of last library call
d46: 0 ;+20: additional error inf
0
d47: 0 ; +22, +24: time stamp
e. ;
; runtime error
;
; call: w0 = additional error inf
; w1 = error number (0==program end)
; w2 = stackref
; w3 = address where error occured
r1: ;
ds. w3 d40. ;
jl. c2. ; goto call and enter alarm
; call library procedure
;
; call: w0w1 = parameters
; w2 = stackref
; w3 = return inf
; x3+0: library pageno < 12 + rel entry addr
; x3+2: maybe further parameters to library procedure
b. b10 w.
b0: 0 ; saved w0
b1: 0 ; saved w1
b10: p10 ; const: size of entry in proc tables
r3: ;
ds. w3 d40. ; save (stackref, return);
ds. w1 b1. ; save params;
bl w1 x3 ;
wm. w1 b10. ; w0 := 0; w1 := rel library entry;
wa. w1 d13. ;
al w3 x1 ; w3 := abs library proctable entry;
rs w2 x3+p8 ; save stackref in library proctable entry;
sl w0 (x3+p2) ; if library proc not in core then
jl. w1 f5. ; get procedure;
al w2 x3 ; w2 := library proc entry;
; since the library procedure may need to access parameters on
; the calling procedure page, it will be checked that the calling
; procedure is in core (but maybe at a new place)
rl. w0 d40. ;
sn. w0 f2. ; if calling proc just kill'ed then
jl. w1 f4. ; restore returnproc;
; begin test version
rl w1 x2+p2 ; if library proc not in core anymore then
sh w1 -1 ;
jl. e1. ; alarm...
; end test version
rl. w3 d40. ; w3 := abs return addr;
rs. w3 d45. ; (remember return addr, in case of errors)
bz w0 x3+1 ; w0 := rel entry addr
wa w0 x2+p6 ; + first (library proc);
rx. w0 b0. ;
rl. w1 b1. ; restore (params);
jl. (b0.) ; goto library proc;
; at entry to library proc:
; w0w1 = params
; w2 = abs addr of library proc table entry
; x2+p8 = saved stackref
; w3 = abs return addr
e. ;
; call pascal procedure
;
; call: w0 = procedure number
; w1 = abs addr of old display
; w2 = current stackref
; w3 = addr of call descriptor
; x3+0: stack space used by calling procedure
b. a10, b10 w.
b0: 0 ; calling proctable entry
b1: 0 ; old display
r4: ;
ds. w3 d40. ; save (stackref, return);
rs. w1 b1. ; save (old display);
al w1 x2 ; w1 := old stackref;
wa w2 x3+0 ; new stackref := old stackref + used space;
rs w1 x2-2037 ; activation record.dynamic list := old sref;
al w1 p10 ; w1 := entry size * procedure number
wm w1 0 ;
wa. w1 d12. ; + first of procedure table;
al w0 x3+2 ; w0 := abs return address; (* i.e. skip param *)
al w3 x1 ; w3 := abs addr of called proc table entry;
rl. w1 d43. ; w1 := current pascal procedure;
ws w0 x1+p6 ; w0 := rel return;
ds w1 x2-2041 ; activation record.return point :=
; (rel return, proc table entry);
al w1 x2 ; w1 := abs stacktop :=
wa w1 x3+p4 ; new sref + reserve (called proc);
; test that the new stackspace can be reserved
; step 1: first test that it is possible to reserve that much stack
rl. w0 d10. ; limit := last used of heap
ws. w0 d7. ; - room between stack and heap;
sh w0 x1-2 ; if abs stacktop > limit then
jl. e1. ; alarm(process too small);
; step 2: second, if new stacktop does not kill any pages then ok
; (remember to leave some room between stack and program)
rl. w0 d6. ; limit := first of proc nearest to stack
ws. w0 d3. ; - room between stack and program;
sl w0 x1 ; if abs stacktop <= limit then
jl. a5. ; goto stack reserved;
rs. w3 b0. ; save (entry);
rl. w0 d2. ; w0 := first to kill := old stacktop;
rs. w1 d2. ; stacktop := new stacktop;
wa. w1 d3. ; w1 := top to kill := new stacktop + spare room;
sl. w1 (d6.) ; if top to kill >= first of proc nearest to stack then
rs. w1 d6. ; first of proc nearest to stack := top to kill;
jl. w3 f1. ; kill;
rl. w3 b0. ; restore (entry);
rl. w1 d2. ; restore (new stacktop);
a5: ; stack reserved:
rs. w1 d2. ; stacktop := new stacktop;
sl w1 (x3+p2) ; if called proc not in core then
jl. w1 f5. ; get procedure;
rs. w3 d43. ; current pascal procedure := called proc;
; prepare alarm-inf, in case the procedure is breaked
; before it makes any runtime-system calls
rl w3 x3+p6 ;
ds. w3 d40. ; save (stackref, returnaddr);
rl. w1 b1. ; w1 := old display;
jl x3 ; goto procedure start;
; at entry to pascal procedure:
; w1 = abs addr of old display
; w2 = new stackref
e. ;
; return from pascal procedure
;
; call: w2 = current stackref
b. a10, b10 w.
b10: p10 ; size of procedure table entry
r6: ;
ds. w3 d40. ; save (stackref, return);
dl w1 x2-2041 ; w0 := rel return; w1 := return proc entry;
sh. w1 0 ; if after 'goto' to surrounding block then
jl. w3 a10. ; convert procedure number to abs proc table entry;
al w3 x1 ; w3 := abs proc table entry;
rl w2 x2-2037 ; w2 := dynamic link;
al w1 x2 ; stacktop :=
wa w1 x3+p4 ; stackref + reserve (return proc);
rs. w1 d2. ;
; prepare nice printout, in case of break before procedure is loaded
ds. w0 d42. ; returnpoint := (abs proc entry, rel return);
al. w1 f2. ; simulate just kill'ed;
rs. w1 d40. ;
rs. w2 d39. ; save stackref;
rs. w3 d43. ; current pascal proc := return proc;
sl w1 (x3+p2) ; if proc not in core then
jl. w1 f5. ; get procedure;
wa w0 x3+p6 ; abs return := rel return + first (entry);
jl (0) ; goto procedure;
a10: ; convert procedure number to abs proc table entry:
wm. w1 b10. ; w1 := proc entry := procedure number * entry size;
wa. w1 d12. ; w1 := abs procedure table entry;
rl w0 x2-2043 ; (restore w0)
jl x3 ; return;
e. ;
; value initialization
;
; call: w0 := abs address in stack
; w1 = no of segms to read
; w2 = stackref
; w3 = return addr
; x3+0: segment number in program file
; exit: w0 = undef
; w1 = undef
; w2 = stackref
; w3 = undef
b. b10 w.
b0: 0
b1: 0
r7: ;
ds. w3 d40. ; save (stackref, returnaddr);
ls w1 9 ; top of transfer := segments * 512
wa w1 0 ; + first of transfer;
ds. w1 d21.+4 ; save (first, top) in message;
rl w0 x3 ; w0 := segment number;
al w3 x3+2 ; (prepare eventual kill of program-page)
rs. w3 d40. ; return := after param;
jl. w2 f0. ; transfer;
jl. e3. ;+2: ioerror;
; the previous transfer did'nt test for overwriting of any
; program-pages
dl. w1 d21.+4 ; w0w1 := first,last to kill;
jl. w3 f1. ; kill;
dl. w3 d40. ; restore (stackref, returnaddr);
jl x3 ; return; (notice: automatic page-recovery)
e.
; new
;
; call: w0 = number of halfwords to reserve
; w1 = address of pointer variable
; w2 = stackref
; w3 = return
;
; exit: w0 = undef
; w1 = undef
; w2 = stackref
; w3 = undef
b. a10, b10 w.
b0: 0 ; number of halfwords
b1: 0 ; addr of pointer variable
r8: ;
ds. w3 d40. ; save (stackref, returnaddress);
ds. w1 b1. ; save (number of halfwords, addr of pointer);
; test that it is possible to allocate the wanted number of halfwords
; without having to kill any program pages
rl. w0 d10. ; new last of heap := last of heap
ws. w0 b0. ; - wanted space;
sl. w0 (d9.) ; if new last of heap >= last killed by heap then
jl. a5. ; goto heap reserved;
; it was nescessary to kill some pages.
; start by checking the amount to reserve
rl. w1 d2. ; limit := stacktop
wa. w1 d7. ; + room between stack and heap;
sh w0 x1-2 ; if new last of heap < limit then
jl. e1. ; alarm(process too small);
rs. w0 d9. ; last killed by heap := new last of heap;
sh. w0 (d8.) ; if first to kill <= first of last loaded then
rs. w0 d8. ; first of last loaded := first to kill;
rl. w1 d10. ; top to kill := last of heap;
jl. w3 f1. ; kill;
a5: ; heap reserved:
rs. w0 (b1.) ; pointer variable := last of head;
a7: ; kill at maxpage boundary:
; w0 = new last used of heap
rs. w0 d10. ; last used of heap := new last of heap;
ws. w0 d15. ; boundary := last used of heap- maxpage size;
rl w1 0 ; first,top to kill := boundary;
jl. w3 f1. ; kill;
jl. (d40.) ; return;
; dispose
;
; call: w0 = number of halfwords to release
; w1 = addr of pointer variable, pointing to the heap
; w2 = stackref
; w3 = return
;
; exit:
; w0 = undef
; w1 = undef
; w2 = stackref
; w3 = undef
r9: ;
ds. w3 d40. ; save (stackref, returnaddress);
wa w0 x1 ; w0 := new last of heap := top of record;
; test that the record really was within the heap
rl w3 x1 ; w3 := first of record;
bs. w0 1 ; w0 := last of record;
sl. w3 (d10.) ; if first of record < last of heap or
sl. w0 (d11.) ; last of record >= first of resident code then
jl. e25. ; alarm(try to release not used area);
ba. w0 1 ; w0 := new last used of heap := top of record;
al w3 -2047 ;
rs w3 x1 ; pointer variable := nil;
jl. a7. ; goto kill at maxpage boundary;
e. ;
r15: ; top of resident code, if not mode listing:
; alternative call and return from procedure
; accumulate time spent in procedure, and count number of activations
b. a10, b10 w.
b0: 0 ; saved w0
b1: 0 ; saved w1
r41:
ds. w3 d40. ; save (stackref, return )
ds. w1 b1. ; save ( old display )
dl w1 110 ; time of day
dl. w3 d47. ; old time
ds. w1 d47. ; update old time
ss w1 6 ; w0 1 := time delta
rl. w3 d43. ; address ( proc table )
aa w1 x3+p12 ; add time delta
ds w1 x3+p12 ; restore new acc. time
dl. w3 d40. ; goto normal call procedure
dl. w1 b1.
jl. r4.+2
e.
b. w.
r61:
ds. w3 d40. ; alternative return
dl w1 110 ; time of day
dl. w3 d47. ; old time
ds. w1 d47. ; updated old time
ss w1 6 ; w0 1 := time delta
rl. w3 d43. ; addrss ( proc table )
aa w1 x3+p12 ; add time spent
ds w1 x3+p12 ;
rl w1 x3+p14 ; increment( number of calls )
al w1 x1+1
rs w1 x3+p14
dl. w3 d40. ; goto normal return from procedure
jl. r6.+2
e.
r151: ; top of resident code if mode listing:
\f
; initialization code.
; at entry the situation is as follows :
; w0 - abs add of process start + h55
; w1 - abs add of process start
; w2 - abs add of first item in fp-stack
; w3 - abs add of item containing program name
;
; the init code takes care of the following points :
; 1) test for correct program call
; 2) set interrupt address
; 3) set abs add of some runtime entries in bottom of stack
; 4) create area process to object file and pascallib
; 5) read procedure table into core from object file
; 6) initialize procedure table entries (incl. entries concerning pascallib)
; 6a) input resident procedures
; 7) input main program and jump to entry of main
; 8) global variables are initialized when the values
; become available
;
\f
; the object file contains the following :
; - code for each procedure
; - value blocks to value initialization
; - procedure table
; - information segment (heapsize,noofproc * 10 etc)
; - line error table
;
; each of these types of items occupies an integral
; number of bs-segments. this means that a new item always
; starts on a bs-segment boundary.
; the segment number of the information segment is found in
; the catalog tail for the object file.
; the catalog entry tail contains in +17 cont key<12 + segmno of inf
;
; the information segment contains :
; +0 heapsize
; +2 no of procedures
; +4 segment no of procedure table
; +6 segment no of line error table
; +8 proc number of first resident procedure
; +10 - - - second - -
; .
; .
; +n -1 (end of resident procedures)
b. a40, b20 w.
b0 = 8 ; size of proc table entry in inf segment
b1: 4<12 + 10 ; spacename
b3: 0, r.10 ; tail for lookup entry
b4: 0 ; first of process
b5: 0, r.256 ; buffer for init-segment
b7: ; list of library procedure sizes
1536 ; page 0
512 ; page 1
512 ; page 2
512 ; page 3
1024 ; page 4
1024 ; page 5
1024 ; page 6
512 ; page 7
b8: (: k - b7 :) / 2 * p10 ; size of library proc table
b9: 0 ; proc table entry
b10: 0 ; size of proc
b11: 0 ; pointer variable
g3: ; start of initialization:
rs. w1 b4. ; save (first of process);
rs. w2 d14. ; top of proc table := first of command;
rl. w0 d5. ; if program file name already set then
se w0 0 ;
jl. a2. ; goto program file name found;
rs. w3 d14. ; save (addr of program name item, i.e. 'pascrun')
a0: ; get program file name:
ba w3 x3+1 ; w3 := first parameter;
rl w0 x3 ; if separator <> spacename then
se. w0 (b1.) ;
jl. a20. ; init error (error in call);
dl w1 x3+4 ; w0w1 := first part of program file name;
se w0 0 ; if first part = 0 then
jl. a1. ; begin <* after replace *>
am. (b4.) ;
rs w1 h51 ; fp-modebits := second word;
jl. a0. ; goto get program file name;
a1: ; end;
ds. w1 d5.+2 ;
dl w1 x3+8 ; move param to program file name;
ds. w1 d5.+6 ;
; remove the 'pascrun'-name from the command stack
; (this will make it easier for 'system'...)
rl. w2 d14. ; w2 := addr of program name item;
bl w0 x2+0 ; w0 := preceding separator;
se w0 6 ; if separator = 'equal' then
jl. a3. ; begin
dl w1 x2-0 ; move lefthand side up in
ds w1 x3-0 ; front of file name;
dl w1 x2-4 ;
ds w1 x3-4 ;
dl w1 x2-8 ; (don't forget the '=' item...)
ds w1 x3-8 ;
al w3 x3-10 ; first of command := addr of lefthand item;
a3: ; end;
rs. w3 d14. ; top of proc table := first of command;
rl. w2 b4. ;
rs w3 x2+h8 ; current command := first of command;
a2: ; program file name found:
al. w1 b3. ;
al. w3 d5. ;
jd 1<11+42; lookup entry (file name);
se w0 0 ; if not ok then
jl. a21. ; init error (object file not ok);
sh w0 (x1) ; if size < 0 then
jl. a4. ; begin
dl. w1 b3.+4 ; move docname( entry ) to filename
ds w1 x3+2 ;
dl. w1 b3.+8 ;
ds w1 x3+6 ;
al. w1 b3. ;
jd 1<11+42 ; lookup entry (file name)
se w0 0 ; if not ok then
jl. a21. ; init error (object file not ok);
a4: ; end;
jd 1<11+52; create area process (file name);
se w0 0 ; if not ok then
jl. a22. ; init error (area process not created);
al. w3 d4. ;
jd 1<11+52; create area process(library file);
se w0 0 ; if not ok then
jl. a22. ; init error (area process not created);
; prepare initialization of primary input/output
rl. w1 b4. ;
al. w0 d20. ;
rs w0 x1+h20+h2+2; primary input.giveup action := 'dummy name';
rs w0 x1+h21+h2+2; primary output.giveup action:= 'dummy name';
al w0 0 ;
al w2 1 ;
al w3 10 ;
; initialize primary input
hs w0 x1+h20+h4+0; primary input.eof := false;
hs w2 x1+h20+h4+1; primary input.eoln := true;
rs w3 x1+h20+h4+4; primary input.filebuf := newline char;
hs w2 x1+h20+h2+6; primary input.zonestate := after read char;
hs w2 x1+h20+h2+7; primary input.kind := textfile;
; initialize primary output
hs w2 x1+h21+h4+0; primary output.eof := true;
hs w2 x1+h21+h2+7; primary output.kind := textfile;
al w2 3 ;
hs w2 x1+h21+h2+6; primary output.zonestate := after write char;
; step 2: get inf segment
al. w3 b5. ;
al w0 x3+510 ;
ds. w0 d21.+4 ; save (first,last) in message;
rl. w2 b3.+0 ; w2 := entry size;
al w0 x2-1 ; w0 := segment number := size - 1;
jl. w2 f0. ; transfer from program file;
jl. a23. ;+2: io-error
; step 3: initialize pointers
rl. w3 d14. ; w3 := top := top of procedure table;
ws. w3 b8. ; top := top - size of library table;
rs. w3 d13. ; first of library table := top;
al w1 p10 ; size of procedure table :=
wm. w1 b5.+2 ; entry size * number of procedures;
ws w3 2 ; top := top - size of procedure table;
rs. w3 d12. ; first of procedure table := top;
rs. w3 d11. ; first of resident := top;
rs. w3 d10. ; last used of heap := top;
rs. w3 d9. ; last killed by heap := top;
rs. w3 d8. ; first of last loaded := top;
rs. w3 d6. ; first of proc nearest to stack := top;
; step 4: read procedure table into core
al w3 b0 ; w3 := size of entry in inf segment
wm. w3 b5.+2 ; * number of procedures
al w3 x3+511 ;
ls w3 -9 ;
ls w3 9 ; rounded up to size of used segments;
al. w3 x3+b6. ; w3 := last of transfer;
al w3 x3-2 ;
sl. w3 (d12.) ; if last of transfer >= first of procedure table then
jl. a24. ; init error(process too small);
al. w2 b6. ; w2 := first of transfer;
ds. w3 d21.+4 ;
rl. w0 b5.+4 ; w0 := segment number of procedure table;
jl. w2 f0. ; transfer from program file;
jl. a23. ;+2: ioerror
; step 5: initialize procedure table
al. w2 b6. ; w2 := first of procedure table buffer;
rl. w3 d12. ; w3 := first of procedure table;
rs. w3 d43.
dl w1 110
ds. w1 d47.
a10: ; next:
rl w0 x2+0 ; move segment number;
rs w0 x3+p0 ;
ac w0 (x2+2) ; move negative size of procedure;
rs w0 x3+p2 ;
rl w0 x2+4 ; move number of halfwords on stack;
rs w0 x3+p4 ;
al w0 0
rs w0 x3+p12-2 ; accumulated time := 0
rs w0 x3+p12
rs w0 x3+p14 ; number of calls := 0
rs w3 x3+p6 ; first addr := 'greater than runtime syst'
rl. w1 b5.+6 ; move (abs) virtual address of first line error entry;
ls w1 9 ;
wa w1 x2+6 ;
wa w1 x2+6 ; (it was a word number)
rs w1 x3+p8 ;
al w2 x2+b0 ; increase pointers;
al w3 x3+p10 ;
se. w3 (d13.) ; if not all procedures initialized then
jl. a10. ; goto next;
; step 6: initialize library procedure table
al. w2 b7. ; w2 := first of library procedure sizes;
al w0 0 ; w0 := current segment := 0;
a15: ; next:
rs w0 x3+p0 ; segm := current segment;
ac w1 (x2+0) ; move negative size of procedure;
rs w1 x3+p2 ;
as w1 -9 ; current segment := current segment
ws w0 2 ; + segments used by this procedure;
al. w1 r1. ; initialize addr of runtime error;
rs w1 x3+p4 ;
al w1 0 ; first addr := 0;
rs w1 x3+p6 ;
al w2 x2+2 ; increase pointers;
al w3 x3+p10 ;
se. w3 (d14.) ; if not all library procedures initialized then
jl. a15. ; goto next;
rl. w3 d13. ; first proc := first of library proc table;
jl. w2 f20. ; set maxsize;
; step 7: get resident procedures to core
al. w3 b6. ; safety limit := top of init code;
rs. w3 d1. ; first of stack := safety limit;
rs. w3 d2. ; stacktop := safety limit;
jl. w3 f21. ; test room;
al. w2 b5.+8 ; w2 := first of resident list;
a18: ; next resident:
al w1 p10 ; proc entry := proc table entry size
wm w1 x2 ; * procedure number (entry);
sh w1 -1 ; if procedure number >= 0 then
jl. a25. ; begin
al w3 x1 ; w3 := abs proc table entry;
wa. w3 d12. ;
ac w0 (x3+p2) ; w0 := positive size of procedure;
ds. w0 b10. ; save (proc table entry, proc size);
; check room for resident procedure, by means of calls of: 'new' and 'dispose'
al. w1 b11. ; w1 := address of working cell;
jl. w3 r8. ; allocate on heap;
rl. w0 b10. ; w0 := size of procedure;
al. w1 b11. ; w1 := working cell;
jl. w3 r9. ; release heap;
; there was room enough, therefore load it
rl. w3 b9. ; w3 := proc entry;
rl. w1 d10. ;
rs. w1 d8. ; first of last loaded := last used of heap;
jl. w1 f5. ; get procedure;
rl w1 x3+p6 ;
rs. w1 d11. ; first of resident := first(proc);
rs. w1 d10. ; last used of heap := first(proc);
rs. w1 d9. ; last killed by heap reserve := first(proc);
al w2 x2+2 ; increase(entry);
jl. a18. ; goto next resident;
a25: ; end;
; step 8: compute max size of nonresident procedures
rl. w3 d12. ; first proc := first of procedure table;
jl. w2 f20. ; set maxsize;
; step 9: pre-reserve the heap (but don't check yet)
rl. w1 d10. ; limit := last used of heap
ws. w1 b5. ; - std heap size;
rs. w1 d9. ; last killed by heap := limit;
rs. w1 d8. ; first of last loaded procedure := limit;
rs. w1 d6. ; first of proc nearest to stack := limit;
; step 11: set correct first of stack, and check heapsize
al. w1 r15. ;
am. (b4.) ; get fp-mode bits
rl w3 h51
sz w3 1<8 ; if mode listing
al. w1 r151. ; then top of rs := r151
rs. w1 d1. ; first of stack := top of runtime system;
jl. w3 f21. ; test room;
; step 12: initialize stackref and entry-addresses to runtime system
am. (b4.) ; get mode bits
rl w3 h51
al w2 x1+2047 ; w2 := stackref;
al w2 x2+1 ;
sz w3 1<8
am r41-r4 ; alternative call procedure
al. w0 r4. ; init: call pascal procedure
rs w0 x2-2047 ;
sz w3 1<8
am r61-r6 ; alternative return from procedure
al. w0 r6. ; return from pascal procedure
rs w0 x2-2045 ;
al. w0 r3. ; call library procedure
rs w0 x2-2035 ;
al. w0 r1. ; runtime error
rs w0 x2-2033 ;
al. w0 r7. ; value initialization
rs w0 x2-2031 ;
al. w0 r8. ; new
rs w0 x2-2029 ;
al. w0 r9. ; dispose
rs w0 x2-2027 ;
al w0 -15 ; (old versions: start of proctable)
rs w0 x2-2025 ;
al w0 -2 ; (old versions: get procedure)
rs w0 x2-2023 ;
; step 13: prepare call of set interrupt, and start main program
al w0 0 ; interrupt mask := 0;
al. w3 c0. ; interrupt address := break-routine;
; w0 = interrupt mask
; w1 = stacktop
; w2 = stackref
; w3 = interrupt address
jl. c0. ; goto init-code;
; set maxsize
;
; call: w2 = return
; w3 = first proc
b. a10 w.
f20: ;
al w0 0 ; w0 := maxsize := 0; <*notice: negative values *>
a0: ; rep:
sn. w3 (d14.) ; if entry = top of procedure table then
jl. a1. ; goto set max;
sl w0 (x3+p2) ; if maxsize >= size of procedure then
rl w0 x3+p2 ; maxsize := negative size of procedure;
al w3 x3+p10 ; increase(entry);
jl. a0. ; goto rep;
a1: ; set max:
; w0 = largest (negative) procedure size
ls w0 -9 ;
ls w0 9 ;
ac w0 (0) ; max := - maxsize rounded up;
rs. w0 d15. ; maximum page size above 'd10' := max;
ls w0 1 ;
wa. w0 d3. ; minimum room between stack and heap :=
rs. w0 d7. ; 2 * max + min room between stack and code;
jl x2 ; return;
e. ;
; test room
;
; call: w3 = return
f21: ;
rl. w0 d10. ; room := last used of heap
ws. w0 d7. ; - room between stack and heap
ws. w0 d1. ; - first of stack;
sh w0 -1 ; if room < 0 then
jl. a24. ; init error (process too small);
jl x3 ; return;
\f
; errorreturn :
b. c10, e2 w.
e1: 0 ;
0 ;
c0: <:<10><10> *** pascal init trouble <10> w0=:>;
c1: <: error in program call<0> :>;
c2: <: cannot create area process<0> :>;
c3: <: wrong answer<0> :>;
c4: <: process too small<0> :>;
c5: <: cannot transfer procedure table<0> :>;
a20: am c1.-c2.; error in program call
a22: am c2.-c3.; cannot create area process
a23: ; ioerror:
a21: am c3.-c4.; object file not ok
a24: am c4.-c5.; program too big
a5: al. w1 c5. ; transfer proc table
ds. w1 e1.+2 ;
rl. w2 b4. ;
al. w0 c0. ;
jl w3 x2+h31-2 ; outtext(init trouble)
rl. w0 e1. ;
jl w3 x2+h32-2 ; outinteger(w0)
1<23 + 32<12 + 3 ;
rl. w0 e1.+2 ;
jl w3 x2+h31-2 ; outtext(cause)
rl. w1 b4. ;
al w2 10 ;
jl w3 x1+h26-2 ; outchar(nl)
al w2 1 ; terminate program(not ok)
rl. w1 b4. ;
jl x1+h7 ; goto fp-end program
e.
\f
; dump procedure
; call :
; w1 - lower bound
; w2 - upper bound
; w3 - return
b. a3 w.
a1: 0,r.4
f22: ds. w1 a1.+2
ds. w3 a1.+6
a3: rl. w2 b4.
rl. w0 a1.+2 ;
jl w3 x2+h32-2 ; outinteger(addr);
32<12 + 6 ;
rl. w1 b4. ;
al w2 58 ;
jl w3 x1+h26-2 ; outchar(colon);
rl. w2 b4. ;
rl. w0 (a1.+2)
jl w3 x2+h32-2
1<23+32<12+9
al w2 10
rl. w1 b4.
jl w3 x1+h26-2
rl. w1 a1.+2
al w1 x1+2
rs. w1 a1.+2
sh. w1 (a1.+4)
jl. a3.
dl. w1 a1.+2
dl. w3 a1.+6
jl x3
e.
b6: ; top of init code:
e. ; end initialization block;
e. ; end segment
g2=k-h55
; the runtime system is generated by a job like
; the following :
; job bbj 3 1 time 30 size 25000 perm disc1 40 1
; clear user pascrun
; pascrun=set 40 disc1
; (pascrun=slang tpascrun entry.no proc.fpnames proc.insertproc
; pascrun)
; scope user pascrun
; finis
;
; the job looks like this because the catalog entry
; is set by insertproc, which requires the name of the
; entry to appear right after the translation. the
; parenthesis is present to ensure that the name is
; read at the same time as the call of the slang-
; assembler.
g0:
g1: (:g2+511:)>9 ; segments
0,r.4 ; document
s2 ; short clock
0 ; file
0 ; block
2<12+g3-h55 ; contents key <12 + entry point
g2 ; load length
d.
p.<:insertproc:>
▶EOF◀