|
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: 80640 (0x13b00)
Types: TextFile
Names: »kkfptxt2«
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦84635a524⟧ »kkmon4filer«
└─⟦this⟧
m. fp text 2
\f
; fp text 2
; rc 27.11.72 file processor, simple check, page ...1...
; this segment is called when special status bits are set for
; all input/output except for magnetic tapes.
s. k=h13, e48 ; begin
w. 512 ; length ; segment 3:
e0: dl. w0 c11. ; w3,w0:=special, remaining bits;
dl. w2 c5. ; w1,w2:=zone, share;
jl. x3+2 ; goto case special of
jl. e1. ; (0: give up,
jl. e2. ; 2: areas,
jl. e3. ; 4: readers,
jl. e4. ; 6: typewriters,
jl. e5. ; 8: char output,
jl. e6. ; 10: mag tape);
e13: 25<16 ; eom character
e14: 1<22 ; test parity
e15: 1<21 ; test timer
e16: 1<20 ; test overrun
e17: 1<18 ; test end doc
e18: 3 ; chars per word when inserting sub
e19: -8 ; used by insert substitute
e2: al w3 x1+h1+2 ; areas: w3:=name.addr;
sz w0 2.111100 ; if not normal answer
jl. e30. ; then goto dummy answer;
sz. w0 (e16.) ; if overrun
jl. e10. ; then repeat;
so. w0 (e17.) ; test outside: if not end doc
jl. e23. ; then repeat the rest;
bl w3 x2+6 ; if operation=output
sn w3 5 ; then
jl. e46. ; goto extend;
e20: rl w3 x1+h1+12 ; physical eom:
al w3 x3+1 ; file count:= file count+1;
al w0 0 ; block count:= 0;
ds w0 x1+h1+14 ; zone (first addr):= eom char;
rl. w0 e13. ; top transferred:= first addr+2;
rs w0 (x2+8) ; goto normal action;
rl w1 x2+8 ; comment: the following entries set
al w1 x1+2 ; the return point to the
e9: rs w1 x2+22 ; io-segment;
e7: am h86-h87 ; normal return: set return
e8: am h87-h88 ; wait transport: set return
e1: al. w3 h88. ; give up: set return.
dl. w2 c5. ; w1,w2:=zone,share;
ds. w3 c11. ; w3:=return point;
jl. h70. ; call and enter io-segment;
e30: so w0 1<5 ; dummy answer: if existing
jl. e31. ; then goto rejected;
al w0 0 ; create:
rs w0 x3+8 ; name table addr := 0;
jd 1<11+52 ; create area process;
se w0 0 ; if not created then
jl. e1. ; goto give up;
bl w0 x2+6 ; if operation=input
sn w0 3 ; then
jl. e10. ; goto repeat;
\f
; rc 1977.09.08fileprocessor simple check, page ...1a...
e32: jd 1<11+8 ; reserve: reserve process;
se w0 0 ; if not reserved
jl. e1. ; then goto give up;
jl. e10. ; goto repeat;
e31: bl w0 x2+6 ; rejected:
sn w0 5 ; if operation = output
jl. e32. ; then goto reserve;
jl. e1. ; goto give up;
e46: al w3 x1+h1+2 ; extend:
jd 1<11+4 ; process description;
rs. w0 e47. ;
am (0) ;
rl w0 18 ; old size := no of segments (area process);
rl w3 x2+10 ;
ws w3 x2+8 ; new size :=
al w3 x3+2 ; segment(share) +
ls w3 -9 ; (last transfer-first transfer+2)//512;
wa w3 x2+12 ;
sl w0 x3 ; if old size >= newsize then
jl. e10. ; goto repeat;
al w0 x3 ;
al w3 0 ;
am. (e47.) ; device:=area(10);
rl w2 10 ; slice length:=device(26);
sn w2 0 ; if deviceref=0 then
jl. e33. ; jump
wd w0 x2+26 ; new size :=
se w3 0 ; (new size // slice length
ba. w0 1 ; + if remainder = 0 then 0 else 1)
wm w0 x2+26 ; * slice length;
e33: rl w2 0 ;
al w3 x1+h1+2 ;
al. w1 e48. ;
jd 1<11+42 ; lookup entry(area);
rs w2 x1 ; size := new size;
jd 1<11+44 ; change entry;
se w0 0 ; if result <> 0 then
jl. e1. ; goto give up;
dl. w2 c5. ;
dl. w0 c11. ; restore registers;
jl. e10. ; goto repeat;
e48: 0, r.10 ;tail
e47: 0 ; area process descr.
\f
; rc 28.05.72 file processor, simple check, page ...2...
e3: ; readers:
rl. w3 c22. ; if bytes transf <> 0
sn w3 0 ;
jl. e20. ; goto normal action;
jl. e7. ; goto physical eom;
; change paper message to parent:
e25: 13<13+0<5+1 ; m(0) , pattern word, wait;
<:change<32>:> ; m(2:6)
e4: bl w3 x2+6 ; typewriters:
se w3 5 ; if operation = input then
jl. e27. ; goto test stop;
e5: sz. w0 (e15.) ; char output:
jl. e1. ; if timer then goto give up;
e26: so. w0 (e17.) ; test end doc:
jl. e27. ;
al w2 x1+h1+2 ; if end document then
al. w1 e25. ; parent message(<:change :>, doc name);
jl. w3 h35. ;
dl. w0 c11. ;
dl. w2 c5. ;
e27: so w0 1<8 ; test stop:
jl. e7. ; if not stopped then
rl w3 x2+22 ; goto normal action;
rs w3 x2+8 ; first addr:=top transferred;
; repeat
e10: al w3 x1+h1+2 ; block repeat:
al w1 x2+6 ; send message (proc.zone,mess.share);
jd 1<11+16 ; share state:= message buffer address;
rs w2 x1-6 ; goto wait transport;
jl. e8. ;
e23: rl. w0 c10. ; repeat the rest: w0:=total status;
sz. w0 (e17.) ; if end doc in status
jl. e7. ; then return;
rl w0 x2+22 ;
rx w0 x2+8 ; first addr:=top transf
ac w0 (0) ; seg.number:=
wa w0 x2+22 ; seg.numer +
ls w0 -9 ; (top transf - old first)//512
wa w0 x2+12 ;
rs w0 x2+12
jl. e10. ; goto block repeat;
e6=e1 ; mag tape: goto give up;
b. g1 ; begin
g1= (:h13+512-k:)/2 ; fill up segment to 512 bytes
c. -g1 m.length error on fp segment 3
z.w. 0, r.g1 ; zero fill
e. ; end fill up;
m.fp simple check 28.01.74
i. ; maybe names
e. ; end simple check;
\f
; rc 22.08.74 fileprocessor connect in, page ...1...
; connect input
; c4: w0 place result here
; c7: w1 zone descriptor address
; c9: w2 address of file descriptor or of name
; c11: w3 return
s. k=h13, a40, b10, e48, j24 ; begin
w. 512 ; length ; segment 4:
e0: rl. w2 c9. ; c9 = file descr;
dl w0 x2+2 ; if mode < 0 then
sh w3 -1 ; goto descriptor found;
jl. j3. ; name:
al w3 x2+0 ; cat look up:
al w2 x2-2 ; name pointer:= w2+2;
rs. w2 c9. ; comment: to handle not
al. w1 h54. ; found items;
jd 1<11+42 ; lookup (wtail,name words);
se w0 0 ; if result <> 0
jl. e33. ; then goto unknown;
rl w1 x1 ; if mode >= 0
sh w1 -1 ; then
jl. j1. ; move name to wtail;
dl w1 x3+2 ;
ds. w1 h54.+4 ;
dl w1 x3+6 ;
ds. w1 h54.+8 ;
j1: al. w1 h54.+0 ; test mode:
j4: al w2 x1 ; descriptor found:
j3: rl w0 x2+0 ; w2:=file descriptor addr;
sl w0 0 ; if mode >= 0
rl. w0 e47. ; then mode := 1<23+4;
rs. w2 c9. ; save file descr. addr;
rs w0 x2+0 ;
bz w1 1 ; if kind>max kind
ls w1 -1 ; then goto convention error;
sl w1 e16 ;
jl. e34. ;
bl. w0 x1+e13. ; block length:= standard (kind);
hs. w0 e14. ;
al w0 0 ;
rs w0 x2+10 ; name table address :=0;
bz w0 x2+16 ; algol or fortran procedures:
sn w0 4 ; if contents = 4
jl. j8. ; or
sh w0 31 ; contents >= 32
jl. j7. ; then
j8: ld w0 -65 ; file count:=block count:=0;
ds w0 x2+14 ;
j7: rl. w3 c7. ; area claim:
sn w3 0 ; if zone=0 then
jl. j6. ; goto separate proc;
bz w0 x3+h1+1 ; if kind.zone = 4 then
al w3 x3+h1+2 ; remove process (name.zone);
sn w0 4 ; comment: to save the area claim;
jd 1<11+64 ; result irrelevant;
\f
; rc 10.10.72 file processor, connect in, page ...2...
j6: am x1 ; separate proc:
jl. x1+e15. ; goto proc (kind);
e15: jl. e25. ; ip: goto check and init;
jl. e34. ; clock: goto convention error;
jl. e25. ; bs: goto check and init;
jl. e35. ; drum: goto not allowed;
jl. e25. ; tw: goto check and init;
jl. e1. ; tr: goto readers;
jl. e34. ; tp: goto convention error;
jl. e34. ; lp: goto convention error;
jl. e1. ; cr: goto readers;
jl. e43. ; mt: goto reserve tape;
; standard block length :
h. ; bytes ; kind
e13: 512-2 ; 0: 768 chars
0-2 ; 2: 0 -
512-2 ; 4: 768 -
512-2 ; 6: 768 -
104-2 ; 8: 156 -
36-2 ; 10: 56 -
80-2 ; 12: 120 -
80-2 ; 14: 120 -
80-2 ; 16: 120 -
512-2 ; 18: 768 -
e14: 512-2 ; selected block size
e16=e14-e13 ; max kind
w. ;
e24: <:<96>:> ; name format mask
e47: 1<23+4 ; mode,kind for bs
e48: 3<12+1<11 ; constant to be added to mode,kind
; mount tape message to parent:
a1: 7<13+0<5+1 ; m(0) , pattern word, wait
<:mount :>, 0 ; m(2:6)
a5: al. w1 a1. ; mount tape:
al w2 x3 ; parent message(<:mount :>);
jl. w3 h35. ;
e43:
a4: rl. w2 c9. ; reserve tape:
al w3 x2+2 ; initialize process(proc.file);
jd 1<11+6 ;
se w0 0 ; if not ok
jl. a5. ; then goto mount tape;
\f
; rc 03.11.71 file processor, connect in, page ...3...
al w0 2047 ; set mode:
bz w1 x2 ;
la w0 2 ;
al w1 14 ;
hs w1 0 ; operation(message) :=
rs. w0 c10. ; set mode < 12 + mode;
al. w1 c10. ;
jd 1<11+16 ; send message;
jd 1<11+18 ; wait answer;
rl. w2 c9. ; set position:
al w1 6 ;
al w0 8 ;
hs. w0 e48. ; ...change <operation> to <move>...
ls w0 12 ; operation(message) := move < 12;
ds. w1 c10.+2 ; message(2) := 6;
dl w1 x2+14 ; message(4) := file count;
ds. w1 c10.+6 ; message(6) := block count;
al. w1 c10. ; send message;
jd 1<11+16 ;
rs. w2 e37. ; init buf := message buffer address;
jl. e40. ; goto move description;
; check and init:
e25: bz w1 x2+1 ; check and init:
al w3 x2+2 ; w3:=name addr;
jd 1<11+6 ; initialize process(w3);
sn w0 0 ; if result=0 (ok) then
jl. e40. ; goto move description;
\f
; rc 19.02.73 file processor, connect in, page ...4...
sn w0 1 ; if result=1 then goto
jl. e35. ; access not allowed;
sn w0 2 ; if result=2 then goto
jl. e31. ; no resources;
se w1 4 ; if kind<>area then goto
jl. e33. ; not present;
jd 1<11+52 ; create area process(w3);
se w0 0 ; if result <> 0 then goto
jl. a27. ; set result;
; until now the zone descriptor was unchanged:
; move the file descriptor to the zone descriptor.
e40: al. w2 e30. ; move description: return := set ok result;
a29: rs. w2 b3. ; save return;
dl. w2 c9. ;
al w0 0 ; if zone descr addr=0
sn w1 0 ; then goto ok result;
jl. e30. ;
dl w0 x2+2 ; move (mode,kind,name,
ds w0 x1+h1+2 ; name table addr,
dl w0 x2+6 ; file count,
ds w0 x1+h1+6 ; block count) from:
dl w0 x2+10 ; (file descriptor) to:
ds w0 x1+h1+10 ; (zone descriptor);
dl w0 x2+14 ; segment count:=block count;
ds w0 x1+h1+14 ;
rs w0 x1+h1+16 ;
al. w3 h68. ; if give up action<fp std error
sl w3 (x1+h2+2) ; then give up action:=
rs w3 x1+h2+2 ; fp std error addr;
al w0 1 ; partial word:=1<16;
ls w0 16 ;
rs w0 x1+h2+4 ;
ld w0 -65 ; record base:=
ds w0 x1+h3+2 ; last byte:= 0;
rs w0 x1+h3+4 ;
rl w3 x1+h0+6 ; used share:=first share;
rs w3 x1+h0+4 ;
e46: bl w0 x1+h1+0 ; set shares:
wa. w0 e48. ; for share:=first share step
rs w0 x3+6 ; share descr length until last share
rl w0 x3+2 ; do begin
rs w0 x3+8 ; message(0):=(if magtape then move else 3<12)+mode;
ba. w0 e14. ; message(2):=first shared;
rs w0 x3+4 ; message(4):=last shared:=
rs w0 x3+10 ; first shared+block size-2;
al w0 0 ;
rs w0 x3+0 ; state.share:=0 (free);
al w3 x3+h6 ; end;
sh w3 (x1+h0+8) ;
jl. e46. ;
jl. (b3.) ; goto saved return;
; at return to the io-segment w0 must be set to the result of
; the connection, w1 must be unchanged , and the saved values
; of w2,w3 must also be unchanged.
\f
; rc 08.08.73 file processor, connect in, page ...5...
; connection results: if ok then w0=0 else w0<>0.
e36: am 1 ; 6: name format error
e35: am 1 ; 5: not allowed
e34: am 1 ; 4: convention error
e33: am 1 ; 3: not user,non-exist
e32: am 1 ; 2: malfunctioning
e31: al w0 1 ; 1: no resources
jl. a27. ; goto set result;
e30: rl. w1 c7. ; ok result:
rl. w2 e37. ; w0 := result;
se w1 0 ; if zone <> 0 then
rs w2 (x1+h0+4) ; state(first share) := init buf;
se w2 0 ; if init buf = 0
se w1 0 ; or zone <> 0 then
jl. h70. ; return;
al. w1 c10. ; w1 := answer address;
jd 1<11+18 ; wait answer;
se w0 1 ; w0 := if result = 1 then 0 else 5;
am 5 ;
a28: al w0 0 ; ok exit: w0:=0;
a27: rl. w1 c7. ; set result:restore w1;
jl. h70. ; return;
e37: 0 ; init buf;
b2: 1<18 ; test end of paper
b3: 0 ; saved return
b4 = h37+10 ; clock message (jfr. permanent, page 6)
b5 = h37 ; name of clock (jfr. permanent, page 6)
; wait reader message to parent:
b0: 8<13+0<5+0 ; m(0) , pattern word
<:wait for :> ;
; load reader message to parent:
b1: 12<13+0<5+0 ; m(0) , pattern word
<:load :>, 0 ; m(2:6)
e1: al w3 x2+2 ; readers:
jd 1<11+6 ; initialize process;
sn w0 0 ; if initialized then
jl. a36. ; goto init zone;
sn w0 1 ; if reserved by another then
jl. a2. ; goto wait reader:
sn w0 2 ; if result = 2 then
jl. e31. ; goto no resources
jl. e33. ; else goto not user;
a2: al. w1 b0. ; wait reader:
al w2 x2+2 ;
jl. w3 h35. ; parent message(<:wait for:>, doc name);
a30: jl. w3 a33. ; rep: wait a second; w3 := doc name addr;
jd 1<11+6 ; initialize process;
sn w0 1 ; if reserved by another then
jl. a30. ; goto rep;
a36: jl. w2 a29. ; init zone: move description;
rl. w3 c7. ;
al w3 x3+h1+2 ; w3 := addr(document name);
\f
; rc 1976.02.02 file processor, connect in, page ...6...
a31: jl. w2 a34. ; clean reader: read a block;
rl w1 x2+4 ; w1:=result;
jd 1<11+26 ; get event;
se w1 1 ; if not normal answer
jl. a37. ; then goto clear share;
so. w0 (b2.) ; if not end of paper then
jl. a31. ; goto clean reader;
jd 1<11+6 ; initialize process;
al. w1 b1. ;
rl. w2 c9. ;
al w2 x2+2 ;
jl. w3 h35. ; parent message(<:load :>,doc name);
rl. w3 c9. ; w3:=
al w3 x3+2 ; name address;
a32: jl. w2 a34. ; rep1: read a block;
rl w1 x2+10 ; w1 := bytes transferred;
se w1 0 ; if bytes transferred <> 0 then
jl. a28. ; goto okexit;
jd 1<11+26 ; get event;
jl. w3 a33. ; wait a second; w3:=name address;
jl. a32. ; goto rep1;
a33: rs. w3 b3. ; wait a second: save return;
al. w1 b4. ;
al. w3 b5. ;
jd 1<11+16 ; send message(clock);
al. w1 b4.+4 ;
jd 1<11+18 ; wait answer;
rl. w3 c9. ;
al w3 x3+2 ; w3 := doc name addr;
jl. (b3.) ; return;
a34: rs. w2 b3. ; read a block: save return;
rl. w1 c7. ;
rl w1 x1+h0+6 ; w1 := first share;
al w1 x1+6 ; w1 := message addr;
jd 1<11+16 ; send message;
rs w2 x1-6 ; share state := buf addr;
al w2 0 ; w2 := start event queue;
a35: rl w0 x2+8 ; rep2: (w0,w1) := (status,bytes transferred);
sn w2 (x1-6) ; if event = share state then
jl. (b3.) ; return;
jd 1<11+24 ; wait event;
jl. a35. ; goto rep2;
a37: rl. w1 c7. ; clear chare:
rl w1 x1+h0+6 ; share state
al w0 0 ; (first share
rs w0 x1 ; (zone)):=0;
jl. e31. ; goto no resources
b. g1
w.
g1 = (:h13+512-k:)/2
c. -g1, m. length error, connect in
z.
w. 0, r. g1 ; fill segment
e. ; end fill
m.fp connect input 76.02.02
i. ; list names
e. ; end connect in
\f
; rc 02.02.74 fileprocessor connect output, page ...1...
; segment 1
; connect output consists of two backing storage segments. the first
; segment is loaded by the call. the second segment is loaded by con-
; nect output itself.
; entry: c4: w0: segments<1 + <drum or disc>
; c7: w1: zone descriptor address or 0
; c9: w2: address of filedescriptor or of name
; c11: w3: link
; exit: w0: result
; w1: unchanged
; w2: address of filedescriptor
; w3: undefined
; the contents of w0 are only used, if connect output creates (or changes)
; an area on backing storage:
; if w0 is zero no new bs area is created.
; if w0 is non-zero and if w2 defines a name, which is not found in
; the catalog (by a call of lookup_entry), or if the entry exists and it
; describes a backing storage area, which is protected against writing, then
; connect output will create an area on drum (if w0 is even) or on disc (if
; w0 is odd). the name of the area is defined by w2. the size of the area is
; given as the second parameter in w0 (segments). if this parameter is nega-
; tive, the size will be max. claim (for the device defined and key=0) de-
; creased by the absolute value of <segments>. if segments is positive,
; the areasize will be minimum of <segments> and max. claim. if the area al-
; ready exists the areasize is increased if demanded according to
; the rules above. if the area exists in advance the areasize is
; never decreased by connect output.
s. k=h13, a41, b9, e49 ; begin segment: connect output
w. 1024 ; size of connect output
al. w1 h54.-14 ; connect output:
rl. w3 c9. ; w1:=address of look up - area
a36: al w2 x3 ; w2:= addr of file descr or name;
a37: rl w0 x3 ; a36 used as variable,
; a37 ... a37+(max key+1)*4-2 used
; as store to lookup-bs-claims
sl w0 0 ; if w2 param points at filedescriptor then
jl. a0. ; begin
se. w0 (e47.) ; if modekind <> bs then
jl. a13. ; goto descriptor found;
al w3 x3+2 ;
jd 1<11+76 ; lookup head and tail;
sn w0 0 ; if not found
jl. w3 a35. ; or outside bases then
jl. a33. ; goto create new;
rl. w0 h54. ;
sh w0 -1 ; if size < 0 then
jl. a17. ; goto convension error;
jl. a2. ; end;
; else
\f
; rc 1978.09.27 fileprocessor connect output, page ...2...
; segment 1
a0: jd 1<11+76 ; begin comment name parameters;
se w0 0 ; lookup head and tail;
jl. a32. ; if not found then
al. w2 h54. ; goto create blank
rl. w0 h54. ;
se. w0 (e47.) ; if modekind <> bs
sl w0 0 ; and modekind < 0 then
jl. 4 ; goto descriptor found;
jl. a13. ;
jl. w3 a35. ; if outside bases then
jl. a32. ; goto create blank;
se. w0 (e47.) ; if modekind = bs then
jl. b3. ; begin
al w2 2 ;
a1: dl. w0 x2+h54. ; move file descriptor
ds. w0 x2+b0. ; to saved file descriptor;
al w2 x2+4 ;
sh w2 19 ;
jl. a1. ;
al. w2 b0. ;
al w3 x2+2 ;
jd 1<11+76 ; lookup head and tail
sn w0 0 ; if not found
jl. w3 a35. ; or outside bases
jl. a33. ; then goto create new;
rl. w0 h54. ;
sh w0 -1 ; if size < 0 then
jl. a17. ; goto convension error;
jl. a2. ; end name indirect
b3: jl. w3 b8. ; else
dl. w1 h54.+18 ; begin
ds w1 x2+18 ; make blank;
dl. w1 h54.+14 ; move file, block, contry, length;
ds w1 x2+14 ;
rl. w0 h54. ; end;
; end name parameter;
\f
;rc 12.02.74 fileprocessor connect output, page ...2a...
;segment 1
a2: rs. w2 c9. ; make larger: ;comment now size>=0;
rl. w3 c4. ; save address of file descr.
as w3 -1 ;
sl w3 0 ; if wanted segments <= size
sh w0 x3-1 ; and wanted segments > 0
jl. 4 ; then goto move;
jl. a6. ; comment now wantet <>0 size >= 0;
al w0 2.111 ;
la. w0 h54.-14 ; key:= key(entry);
b7: jl. w1 a8. ; get claims (key,entry);
a3: sh w3 0 ; round wanted to integral no slices:
am +2 ; if wanted < 0 then
a4: al w1 -1 ; i:= +1 else i:= -1;
wa w3 2 ;
bl w2 6 ; wanted:= ((wanted+i)
bl w2 4 ; //slice length-i)
wd. w3 h10.+6 ; * slice length;
ws w3 2 ;
wm. w3 h10.+6 ;
sl w3 1 ; if wanted > 0 then
jl. a5. ; goto wanted found;
wa. w3 h54. ; wanted:=
wa w3 0 ; size + claims + wanted;
sl w3 0 ; if wanted > 0 then
jl. a4. ; goto round wanted...;
sh. w1 (h54.) ; if size <=0 then goto no resources
jl. a6. ; else goto move
jl. a18. ; comment it is used that w1=i=1 here;
\f
; rc 02.02.74 fileprocessor connect output, page ...3...
; segment 1
b0: 1<23+4
0, r.9 ; saved file descriptor;
0, b1: 0 ; work for outside bases and make blank
a35: ds. w2 b1. ; boolean procedure outside bases;
am (66) ; returns to x3 if the entry in
dl w2 74 ; h54 is outside max base. else
al w2 x2+1 ; a return to x3+2 is made
sh. w1 (h54.-12) ; (just as skip-instructions do).
sh. w2 (h54.-10) ; the procedure is called with
al w3 x3-2 ; return in w3. w0,w1,w2 are
dl. w2 b1. ; unchanged.
jl x3+2 ;
a5: wa. w0 h54. ; wanted found:
sl w0 x3+1 ; if claims + size >= wanted
sh. w3 (h54.) ; and wanted > size then
jl. a6. ; begin
rs. w3 h54. ; size:= wanted;
al. w1 h54. ;
rl. w3 c9. ; change entry
al w3 x3+2 ; (lookup area, name in descr)
jd 1<11+44 ;
se w0 0 ; if not changed then
jd 1<11+40 ; create entry
se w0 0 ; if not created then
jl. a18. ; goto no resources;
; end;
a6: ; move:
rl. w3 c9. ;
al. w2 h54.+20 ; move file descriptor to
a7: al w3 x3-4 ; lookup area;
al w2 x2-4 ;
dl w1 x3+22 ;
ds w1 x2+2 ;
se. w2 h54. ; w2:= address of lookup area;
jl. a7. ;
jl. a13. ; goto descriptor found;
; procedure move name(from,to);
b8: ; from addr=w1, to addr=w2
al. w2 b0. ; w2:=saved file descriptor
rl. w1 c9. ;
a41: rs. w3 b1. ; store(w3);
dl w0 x1+2 ;
ds w0 x2+4 ;
dl w0 x1+6 ;
ds w0 x2+8 ;
jl. (b1.) ; return;
\f
; rc 02.02.74 fileprocessor connect output, page ...4...
; segment 1
a32: jl. w3 b8. ; create blank: make blank;
a33: rl. w3 c4. ; create new:
sn w3 0 ; if wanted = 0 then
jl. b9. ; goto unknown;
rs. w2 c9. ; save w2;
al w2 18 ;
ld w1 -100 ;
b6: ds. w1 x2+h54. ; for i:= 18 step -2 until 4 do
al w2 x2-4 ; lookup area(i):= 0;
se w2 2 ;
jl. b6. ;
sz w3 1 ; lookup area(2):= drum or disc;
al w1 1 ; lookup area(0):= 0;
ds. w1 h54.+2 ; key:= 0;
as w3 -1 ; wanted:= segments/2;
jl. w1 a8. ; get claims (key,lookup area);
rl. w1 h54.+2 ;
se w1 1 ; if device = preferably drum
se w0 0 ; and claims = 0 then
jl. a3. ;
al w1 1 ; try once more with disk
rs. w1 h54.+2 ; else
jl. b7. ; goto round wanted;
a8: ds. w3 h10.+4 ; get claims: (w0=key), (tail(2:8)=docname);
rs. w1 h10.+0 ; save(w1,w2,w3);
ls w0 2 ; key:=key*4;
hs. w0 b2. ; key := w0;
rl. w2 h54.+2 ; w2 := first word(document);
dl w1 94 ; get top device:
se w0 x1 ; top device := if there is a drum
se w2 0 ; and document is drum (=0) then
rl w1 96 ; last drum else last disc;
ld w0 -100 ;
jl. a9. ;
a11: rl. w0 h10.+10 ;
rl w3 x2-8 ; w3:=slice length.curr device
sl. w0 (h10.+8) ; if min slice>max segm then
a9: ds. w0 h10.+8 ; max segs := min slice;
rl w2 x1-2 ; next device:
sn w1 (92) ; if device < first drum then
jl. a12. ; goto found;
al w1 x1-2 ; device := device-2;
ds. w2 a36. ; store(w1,w2);
rl w1 66 ;
al w1 x1+2 ; w1:=addr(own process name);
al. w2 a0.-2 ; w2:=addr(own process name area);
jl. w3 a41. ; move name(from monitor,to own process);
rl. w1 a36. ; w1:=addr(slice table head.curr device);
al w1 x1-18 ; w1:=addr(device name);
al. w2 a0.+8 ; w2:=addr(device name store);
jl. w3 a41. ; move name(from monitor,to own process);
al w2 x2+2 ;
al. w3 a0. ; w3:=addr(own process);
al. w1 a37. ; w1:=addr(bs-claim-store);
jd 1<11+118 ; lookup bs claims;
b2 = k + 1 ; key ;
al w3 x1;+key*4 ; w3 := addr(claims(key));
jl. a38. ;
a10: sl w0 (x3+2) ; if min slice>=curr.slice then
a38: rl w0 x3+2 ; min slice:=curr.slice;
al w3 x3-4 ; key:=key-1;
sl w3 x1 ; if key>0 then
jl. a10. ; goto a10;
\f
; rc 12.02.74 fileprocessor connect output, page ...5...
; segment 1
dl. w2 a36. ; restore(w1,w2);
rs. w0 h10.+10 ; :=min slices;
dl w0 x2-16 ;
sn. w3 (h54.+2) ;
se. w0 (h54.+4) ;
jl. a11. ; if document <> docname(device)
dl w0 x2-12 ; then goto get next;
sn. w3 (h54.+6) ;
se. w0 (h54.+8) ;
jl. a11. ;
rl w0 x2-8 ; slice :=
rs. w0 h10.+6 ; slice length (device);
rl. w0 h10.+10 ;
rs. w0 h10.+8 ; max segs := min slices;
a12: rl. w0 h10.+8 ; found: w0 := max segs;
dl. w3 h10.+4 ; restore(w2,w3);
jl. (h10.) ; return;
a13: rl w0 x2 ; descriptor found:
rs. w2 c9. ; save file descriptor;
bz w1 1 ;
ls w1 -1 ; if kind > max kind
sl w1 e16 ; then
jl. a17. ; goto convention error;
bl. w0 x1+e13. ;
rs. w0 h10. ; blocklength := standard(kind);
al w0 0 ;
rs w0 x2+10 ; name table address := 0;
e14 = h10
\f
; rc 22.08.74 fileprocessor connect output, page ...6...
; segment 1
bz w0 x2+16 ; algol or fortran procedures:
sn w0 4 ; if contents = 4
jl. a34. ; or
sh w0 31 ; contents >= 32
jl. a14. ; then
a34: ld w0 -65 ; filecount := blockcount := 0;
ds w0 x2+14 ;
a14: rl. w3 c7. ;
sn w3 0 ; if zone = 0 then
jl. a15. ; goto call connect 2;
bz w0 x3+h1+1 ;
al w3 x3+h1+2 ; if zone.kind = 4 then
sn w0 4 ; remove process(zone.name);
jd 1<11+64 ; comment result not checked;
a15: al w0 x1 ; w0:=kind>1;
rl. w1 c7. ; w0 := action(kind); w1 := saved w1;
rl. w3 h41. ;
al w3 x3+1 ; segment(fp) := segment(fp) + 1;
jl. h70.+2 ; call segment 2(connect output);
b9: am -2 ; unknown:
a16: am 1 ; not allowed:
a17: am 3 ; convention error:
a18: al w0 1 ; no resources:
a39: rl. w1 c7. ; w1 := saved w1; w0 := result;
jl. h70. ; return;
e47: 1<23 + 4 ; mode, kind for backing storage;
\f
; rc 05.10.78 fileprocessor connect output, page ...7...
; segment 1
h. ; blocklength table
e13: ; bytes ; kind no of characters
512-2 ; ip 768
0-2 ; clock 0
512-2 ; bs 768
512-2 ; drum 768
104-2 ; tw 156
36-2 ; tr 56
80-2 ; tp 120
80-2 ; lp 120
80-2 ; cr 120
512-2 ; mt 768
80-2 ; pl 120
e16 = k - e13
w.
b. g1 ; fill segment
g1 = (:h13+512-k:)/2
c. -1-g1 m. length error connect output 1
z.
c. -1+g1
w. 0, r.g1
z.
e.
m. fp connect output 1 05.10.78
\f
; rc 10.10.72 fileprocessor connect output, page ...8...
; segment 2
k = h13 ; start segment 2
w. 0 ; dummy word
e0: rl. w2 c9. ; entry segment 2:
rl. w3 c4. ; w2 := addr(file descr);
bl. w3 x3+e15. ; w3:=action address;
jl. x3+e0. ; switch to action(kind);
e24: <:<96>:> ; name format mask
e45:
e49: 1<15 ; write enable bit
e48: 5<12 + 1<11 ; constant to be added to <mode,kind>
; mount ring message to parent:
a19: 9<13 + 0<5 + 1 ; m(0) , pattern word, wait
<:ring:>, 0 ; m(2:6)
; mount tape message to parent:
a20: 7<13 + 0<5 + 1 ; m(0) , pattern word , wait
<:mount:>, 0 ; m(2:6)
a21: al. w1 a20. ; mount tape:
a22: al w2 x3 ;
jl. w3 h35. ; parent message(<:mount:>);
am (x2) ; test work tape:
se w3 x3 ; if first word(doc name) <> 0
jl. a23. ; then goto reserve tape;
dl. w1 h43.+2 ; move name from parent
ds w1 x2+2 ; answer to the file descriptor;
dl. w1 h43.+6 ; it will be moved to the zone-
ds w1 x2+6 ; descriptor later on;
e43 = k - e0 ; entry mag tape
a23: rl. w2 c9. ; reserve tape:
al w3 x2+2 ;
jd 1<11+6 ; initialize process(document);
se w0 0 ; if not ok
jl. a21. ; then goto mount tape;
\f
; rc 03.11.71 fileprocessor connect output, page ...9...
; segment 2
al w0 2047 ; set mode:
bz w1 x2 ;
la w0 2 ;
al w1 14 ;
hs w1 0 ; operation(message) :=
rs. w0 c10. ; set mode < 12 + mode
al. w1 c10. ;
jd 1<11+16 ; send message;
jd 1<11+18 ; wait answer;
rl w0 x1 ; mount ring:
al. w1 a19. ; if writing not enabled then
so. w0 (e49.) ; begin parent message(<:ring:>);
jl. a22. ; goto test work tape);
; end;
rl. w2 c9. ; set position:
al w1 6 ;
al w0 8 ;
hs. w0 e48. ; ...change <operation> to <move>...
ls w0 12 ; message(0) := move < 12;
ds. w1 c10.+2 ; message(2) := 6;
dl w1 x2+14 ; message(4) := filecount;
ds. w1 c10.+6 ; message(6) := blockcount;
al. w1 c10. ;
jd 1<11+16 ; send message;
rs. w2 e37. ; init buf := message buffer address;
jl. e40. ; goto move description;
e25 = k - e0, e26 = e25 ; check and init:
a24: al w3 x2+2 ; check and reserve:
jd 1<11+6 ; initialize process;
bz w1 x2+1 ;
sn w0 0 ; if result = ok
jl. a31. ; then goto blank tape;
sn w0 1 ; if result = 1 then
jl. a26. ; goto access not allowed;
sn w0 2 ; if result = 2 then
jl. a30. ; goto no resources;
se w1 4 ; if kind <> area then
jl. a28. ; goto not present;
jd 1<11+52 ; create area process;
se w0 0 ; if result <> 0 then
jl. e30. ; goto set result;
jl. a24. ; goto check and reserve;
\f
; rc 29.08.72 fileprocessor connect output, page ...10...
; segment 2
e40: dl. w2 c9. ; move description:
al w0 0 ;
sn w1 0 ; if zone = 0 then
jl. e30. ; goto ok result;
dl w0 x2+2 ; move ( mode, kind, name,
ds w0 x1+h1+2 ; name table address = 0,
dl w0 x2+6 ; filecount,
ds w0 x1+h1+6 ; blockcount)
dl w0 x2+10 ; from:
ds w0 x1+h1+10 ; filedescriptor
dl w0 x2+14 ; to:
ds w0 x1+h1+14 ; zone descriptor;
rs w0 x1+h1+16 ; segment count := blockcount;
al w0 1 ;
rs w0 x1+h2+4 ; partial word := 1;
al. w3 h68. ; if give up action < fp std error
sl w3 (x1+h2+2) ; then give up action :=
rs w3 x1+h2+2 ; fp std error;
rl w3 x1+h0+6 ;
rs w3 x1+h0+4 ; used share := first share;
rl w0 x3+2 ;
bs. w0 1 ; record base :=
rs w0 x1+h3+0 ; first share(used share) - 1;
ba. w0 -5 ;
wa. w0 e14. ; last byte :=
rs w0 x1+h3+2 ; record base + 2 + blocklength - 2;
; set shares:
e46: bl w0 x1+h1+0 ; for share := first share step
wa. w0 e48. ; 1 until last share do
rs w0 x3+6 ; begin
rl w0 x3+2 ; message(0) :=(if magtape then move else 5<12)+ mode;
rs w0 x3+8 ; message(2) := first shared;
wa. w0 e14. ; message(4) := last address of transfer :=
rs w0 x3+4 ; first shared + block length(kind) - 2
rs w0 x3+10 ;
al w0 0 ; message(4);
rs w0 x1+h3+4 ; record length := 0;
rs w0 x3 ; share state := 0;
al w3 x3+h6 ; end;
sh w3 (x1+h0+8) ;
jl. e46. ;
jl. e30. ; goto ok result;
\f
; rc 26.07.71 fileprocessor connect output, page ...11...
; segment 2
a25: am 1 ; name format error:
a26: am 1 ; not allowed:
a27: am 1 ; convention error:
a28: am 1 ; not user, not exist:
a29: am 1 ; malfunction:
e34=a27-e0, e35=a26-e0 ;
a30: al w0 1 ; no resources:
e30: rl. w1 c7. ; ok result:
rl. w2 e37. ; w0 := result;
se w1 0 ; if zone <> 0 then
rs w2 (x1+h0+4) ; state(first share) := init buf;
se w2 0 ;
se w1 0 ; if zone <> 0 or init buf = 0 then
jl. h70. ; return;
al. w1 c10. ;
am. (c9.) ;
al w3 2 ; w3 := addr(name);
jd 1<11+18 ; wait answer;
se w0 1 ; w0 :=
am 5 ; if result = 1 then 0
al w0 0 ; else 5;
rl. w1 c7. ; restore w1;
jl. h70. ; resturn;
a31: se w1 12 ; blank tape:
jl. e40. ; if process kind <> punch then
al w1 5 ; goto move description;
ls w1 12 ;
al w1 x1+2 ;
rs. w1 c10. ; operation(message) := 5 < 12 + even parity;
al. w0 b4. ;
al. w1 b5. ; set first core and last core;
ds. w1 c10.+4 ;
al. w1 c10. ;
jd 1<11+16 ; send message;
jd 1<11+18 ; wait answer;
jl. e40. ; goto move description;
h. ; action teable
e15: ; action ; kind action
e26 ; ip check and init
e34 ; clock convention error
e25 ; bs check and reserve
e35 ; drum not allowed
e26 ; tw check and init
e34 ; tr convention error
e25 ; tp check and reserve
e25 ; lp check and reserve
e34 ; cr convention error
e43 ; mt reserve tape
e25 ; pl check and reserve
w.
b4: 0, r.40 ; 100 blanks
b5 = k-2 ;
e37: 0 ; init buf;
b. g1 ; fill segment
g1 = (:h13+512-k:)/2
c. -g1 m. length error connect output 2
z.
w. 0, r.g1
e.
e. ; end connect output
m. fp connect output 2 10.10.72
\f
; rc 26.10.73 file processor stack/unstack, page 0
; implementation of stack/unstack zone
;
; first stack zone is considered. if a stack chain area already
; exists, it is extended (if necessary) and the zone is stacked after
; the latest stacked zone. if either no stack area exists or the area
; cannot be extended, a new area is created, preferably on drum.
; the stack chain is always updated to give the name of the stack
; area, and the area for zone stacking is administered as follows:
; 1. the entire zone buffer occupies an integral number of segments.
; 2. the following segment contains:
; 2.1. the zone descriptor;
; 2.2. all share descriptors (max 498 bytes);
; 2.3. the old stack chain (8 bytes);
; 2.4. length in segments of former stacking (2 bytes);
; 2.5. +-infinity, or if the stacked zone is connected to an area,
; the base of the connected area process (4 bytes).
; if the zone which is to be stacked is connected to an area
; process, the area process is removed.
;
; both stack and unstack will be made at the std base, ensuring
; that the stack area(s) can always be found. after stack/unstack, the
; cat base is reestablished.
; the area entry of the stack area is used like this:
; tail+0 : size ; >=necessary segments
; +(2:12): name of bsdevice, 0, 0;
; +14 : block ; first seg. of latest stacking
; +16 : 5<12+0 ; content=5
; +18 : length (segm) ; segs. used for latest stacking
; note that the length part is in segments, and that the value of
; size is not used.
;
; zone unstacking will proceed in the reverse way of stacking.
; if the unstacked zone had been connected to an area process, this
; is reestablished with a cat base determined by catbase:= if
; saved_base < maxbase then saved_base else maxbase. the name table
; address in the zone is reestablished by means of send (unintell.)
; message - wait answer.
\f
; rc 76.02.02 file processor, stack, page ...1...
; stack medium:
s. k=h13, e48, j24 ; begin
w. 512 ; length ; segment 6:
e0: rl. w2 h16. ; treat break:
dl w0 x2+36 ; save old im and old ia;
ds. w0 e11. ; set interrupt (stack break,0);
al w0 0 ; comment: this is done in order
al. w3 e0.+2 ; to transfer control to the call
jd 1<11+0 ; of remove entry (work area).
jl. j0. ; otherwise the area claim may
10; stack error ; be exceeded and the area forgotten;
jl. 2, r.(:e0+2+h76-k+2:)>1
; goto restore used;
e30: al. w3 e10. ; stack break:
jd 1<11+48 ; remove entry(stack work area);
rl. w3 e11. ; if old ia=0 then
sn w3 0 ; goto fp break;
jl. h10.+h76 ;
dl. w1 e0.+4 ; move registers to old ia area;
ds w1 x3+2 ; comment: if e30 was entered because
dl. w1 e0.+8 ; of errors in stacking the register
ds w1 x3+6 ; values are undefined, however:
dl. w1 e0.+12 ; the cause is set to 10 to indicate
ds w1 x3+10 ; the situation;
rl. w1 e0.+14 ;
rs w1 x3+12 ;
rl. w0 e12. ; set interrupt (old ia, old im);
jd 1<11+0 ; goto old ia+h76;
al w3 x3+h76 ; comment: first is the io-segment
jl. j1. ; restored;
e26: am 1 ; stackerrors: zone descriptor
e27: am 1 ; transport
e28: am 1 ; create error
e29: al w3 0 ; zone size...
rs. w3 e0.+12 ; set breakaddress to errorkey...;
jl. e30. ; goto stack break;
e10: 0, r.5 ; working name, init to zero.
e12: -1 ; old interrupt mask
e11: -1 ; old interrupt address
e9: 0, r.10 ; entry tail for work area
e16: 5<12 ; output message
e15: 0 ; first address
e14: 0 ; last address
e13: 0 ; init to zero ; segment number
-8388608 ;
e17: 8388607 ; saved process bases
e18: 0 ; work size
e19: 0 ; saved length
-8388608 ;
e20: 8388607 ; saved area process bases
e21: -8388608 ; minus infinity
\f
; rc 18.01.74 file processor, stack, page ...2...
; procedure transport (mess)
e23: rs. w3 e0.-2 ; transport: save link;
al. w1 e16. ; repeat:
al. w3 e10. ; mess:= output message;
jl. w2 h11. ; name:=stack work area name;
sn w0 1 ; message (mess,name);
sh w0 (x1+0) ; if result <> 1 or
jl. e27. ; statusword.answer <> 0
rl w2 x1+2 ; then goto stack break;
sh w2 0 ; if bytes transferred = 0
jl. e23.+2 ; then goto repeat;
jl. (e0.-2) ; return;
j0: rl. w1 c16. ; restore used:
rl. w0 c18.-2 ; used share:=saved used share;
rs w0 x1+h0+4 ; record base:=saved record base;
dl. w0 c27.+0 ; last byte:=saved last byte;
ds w0 x1+h3+2 ;
bz w2 x1+h1+1 ; if kind.zone=area then
sn w2 4 ; goto remove area;
jl. w2 e7. ; zone size:=last byte buf - base buf;
rl w3 x1+h0+2 ; if zone size mod 512 <> 0
ws w3 x1+h0+0 ; then goto stack break;
sz w3 511 ;
jl. e29. ; work size:=zone size/512+1;
ls w3 -9 ; first word.tail:=work size;
al w3 x3+1 ;
rs. w3 e18. ;
rl w3 66 ;
dl w1 x3+78 ; std base:=own proc(78);
dl w3 x3+70 ; cat base:=own proc(70);
sn w0 x2 ;
se w1 x3 ; if cat base <> std base then
jl. e5. ; goto save bases;
e4: rl. w3 c17.-2 ;
al. w1 e9. ; look up entry
jd 1<11+42 ; (tail area, chain);
bz. w2 e9.+16 ; if not looked up
rl. w0 e9. ; or content <> 5
sn w2 5 ; or size < 0
sh w0 -1 ; then
jl. e6. ; goto new;
rl. w0 e18. ; w0:=length;
rx. w0 e9.+18 ; length:=work size;
rs. w0 e19. ; saved length:=w0;
wa. w0 e9.+14 ;
rs. w0 e13. ; first segment:=block:=
rs. w0 e9.+14 ; block + saved length;
wa. w0 e18. ;
rs. w0 e9. ; size:=block + work size;
jd 1<11+44 ; change entry;
sn w0 6 ; if claims exceeded then
jl. e6. ; goto new;
se w0 0 ; if other errors then
jl. e28. ; goto create error;
dl w1 x3+2 ;
ds. w1 e10.+2 ; move chain to area name;
dl w1 x3+6 ;
ds. w1 e10.+6 ;
jl. e3. ; goto get area process;
\f
; rc 15.01.74 file processor, stack, page ...3...
e5: ds. w3 e17. ; save bases:
al. w3 e9. ; save process bases;
jd 1<11+72 ; set catbase(standard);
jl. e4. ; return;
e7: rl w3 x1+h1+10 ; remove area:
sl w3 (76) ; if name table address does not
sl w3 (78) ; point at an area process then
jl x2 ; return
rl w3 x3 ;
al w0 4 ; if process kind <>4 then
se w0 (x3) ; then return; comment maybe ps process;
jl x2 ; area process bases:=
dl w0 x3-2 ; bases(area process);
ds. w0 e20. ;
al w3 x1+h1+2 ;
jd 1<11+64 ; remove area process;
jl x2 ; return;
e6: ld w1 -100 ; new:
ds. w1 e9.+4 ;
ds. w1 e9.+8 ; clear entry tail
ds. w1 e9.+12 ;
rs. w1 e9.+14 ;
rs. w1 e13. ; first segm := 0;
rl. w0 e16. ; content := 5;
rl. w1 e18. ; length:=
ds. w1 e9.+18 ; size:=
rs. w1 e19. ; saved length:=
rs. w1 e9. ; work size;
al. w1 e9.
al. w3 e10. ; create entry
jd 1<11+40 ; (tail, entry name);
se w0 0 ; if not created
jl. e28. ; then goto create error;
e3: al. w3 h40. ; get area process:
jd 1<11+64 ; remove process (<:fp:>);
al. w3 e10. ; create area process (work area);
jd 1<11+52 ; reserve process (work area);
jd 1<11+8 ;
rl. w1 c16. ; adjust message:
dl w0 x1+h0+2 ; first addr:= base buf+1;
al w3 x3+1 ; last addr:= last byte buf-1;
bs. w0 1 ; segment no:= 0;
ds. w0 e14. ;
jl. w3 e23. ; dump zone:
rl. w1 c16. ; transport(mess);
al w3 x1+h5+h0 ;
rl w2 x1+h0+0 ; save zone descriptor:
e1: rl w0 x1+h0+0 ; move descriptor to buffer area;
rs w0 x2+1 ;
al w1 x1+2 ; comment: the zone descr and all
al w2 x2+2 ; the share descriptors are moved
se w1 x3-h0-0 ; to the buffer area and output to
jl. e1. ; the last segment of the working area;
\f
; rc 05.02.74 file processor, stack, page ...4...
rl w1 x3-h5+6 ; save shares:
rl w3 x3-h5+8 ; move all share descriptors
e2: rl w0 x1+0 ; to the buffer area;
rs w0 x2+1 ;
al w1 x1+2 ; if not room then
al w2 x2+2 ; then goto stack break;
am. (e15.) ;
sl w2 497 ; comment only 1 segment is
jl. e26. ; used to hold all descriptors;
se w1 x3+h6 ;
jl. e2. ;
rl. w3 c17.-2 ;
dl w1 x3+2 ;
ds w1 x2+3 ; move name (chain) to
dl w1 x3+6 ; first 8 bytes following
ds w1 x2+7 ; the saved shares
rl. w1 e19. ; move old length
rs w1 x2+9 ; and
dl. w1 e20. ; area process bases
ds w1 x2+13 ; to next 6 bytes;
dl. w1 e10.+2 ;
ds w1 x3+2 ; move name of dump area(work)
dl. w1 e10.+6 ; to name(chain)
ds w1 x3+6 ;
\f
;rc 04.02.74 file processor stack, page ...5...
rl. w0 e9.+14 ; dump descriptors:
al w3 510 ; last addr:=first addr+510;
wa. w3 e15. ; segment no := block + work size-1;
wa. w0 e18. ;
bs. w0 1 ;
ds. w0 e13. ; transport(mess);
jl. w3 e23. ;
al. w3 e10. ;
jd 1<11+64 ; remove process (work area);
rl. w0 e12. ;
rl. w3 e11. ; set interrupt (old im, old ia);
jd 1<11+0 ;
dl. w1 c16. ; restore io-segment;
al w2 -2 ;
la w2 x1+h2+0 ;
rs w2 x1+h2+0 ; i-bit := 0;
ld w3 -100 ; clear document name and n.t.addr. of zone
rs w3 x1+h1+10 ; which will cause no release
ds w3 x1+h1+4 ; if unstack is called before
ds w3 x1+h1+8 ; connect is ok;
al w3 x1+h1+2 ;
dl. w1 e17. ;
se. w0 (e21.) ; if saved bases <> infinity then
jd 1<11+72 ; set catbase(saved bases);
dl. w3 c17. ;
j1: ds. w3 c11. ; return to user;
dl. w1 c16. ; restore w0,w1
jl. h70. ;
b. g1 ; begin
g1= (:h13+512-k:)/2 ; fill up segment to 512 bytes;
c. -g1 m.length error on fp segment 6
z. ;
w. 0, r.g1 ; zero fill
e. ; end fill up;
m.fp stack medium 76.02.02
i. ; maybe names;
e. ; end stack medium;
\f
; rc 76.02.02 file processor, unstack, page ...1...
; unstack medium:
s. k=h13, e48, j24 ; begin
w. 512 ; length ; segment 7:
e0: rl. w2 h16. ; treat breaks:
dl w0 x2+36 ; save old im and old ia;
ds. w0 e11. ; set interrupt (unstack break,0);
al w0 0 ; comment: this is done in order
al. w3 e0.+2 ; to transfer control to the call
jd 1<11+0 ; of remove entry (work area);
jl. j0. ; otherwise the area will not be removed;
10 ; stack error ; goto stop transports;
jl. 2, r.(:e0+2+h76-k+2:)>1
e30: al. w3 e10. ; unstack break:
jd 1<11+48 ; remove entry (stack work area);
rl. w3 e11. ; if old ia=0 then
sn w3 0 ; goto fp break;
jl. h10.+h76 ;
dl. w1 e0.+4 ; move registers to old ia area;
ds w1 x3+2 ; comment: if e30 was entered because
dl. w1 e0.+8 ; of errors in the unstacking then
ds w1 x3+6 ; the registers are undefined, however:
dl. w1 e0.+12 ; the cause is set to 10 to indicate
ds w1 x3+10 ; the situation;
rl. w1 e0.+14 ;
rs w1 x3+12 ;
rl. w0 e12. ; set interrupt (old ia, old im);
jd 1<11+0 ; goto old ia+14;
al w3 x3+h76 ; comment: restore the io-segment
rs. w3 c11. ; before leaving the unstack segment;
jl. j1. ;
e27: am 1 ; unstack errors: transport
e28: am 1 ; entry not found
e29: al w3 4 ; zone size...
rs. w3 e0.+12 ; set breakaddress to errorkey...;
jl. e30. ; goto unstack break;
e9: 0, r.10 ; look up area
e10: 0, r.5 ; stack work area name
e12: -1 ; old interrupt mask
e11: -1 ; old interrupt address
e16: 3<12+0 ; input message
e15: 0 ; first address
e14: 0 ; last address
e13: 0 ; segment number
0 ;
e18: 0 ; own process bases
e19: 0 ; null (used as such)
0 ;
e20: 0 ; area process bases
e21: -8388608 ; minus infinity
\f
; rc 30.05.74 file processor, unstack, page ...2...
; procedure transport (mess);
e23: rs. w3 e0.-2 ; transport: save link;
al. w1 e16. ; repeat:
al. w3 e10. ; mess: input message;
jl. w2 h11. ; name:= stack work area name;
sn w0 1 ; message (mess,name);
sh w0 (x1+0) ; if result <> 1 or
jl. e27. ; status word.answer <> 0
rl w2 x1+2 ; then goto unstack break;
sh w2 0 ; if bytes transferred=0
jl. e23.+2 ; then goto repeat;
jl. (e0.-2) ; return;
j0: rl. w2 (c9.) ; stop transports:
sn w2 0 ; if first word (name chain) = 0
jl. j5. ; then goto done1;
rl. w1 c7. ;
rl w3 x1+h0+6 ; zone:= zone in unstack param;
e1: rl w2 x3 ; wait transport:
al. w1 h43. ; for share:= first share step
sl w2 (86) ; share descr length until
jd 1<11+18 ; last share do
rl. w1 c7. ; if transport pending then
al w3 x3+h6 ; wait answer (state.share, irr, irr);
sh w3 (x1+h0+8) ; comment: no checking;
jl. e1. ;
bz w2 x1+h1+1 ; release file:
al w3 x1+h1+2 ; release process (process name.zone);
jd 1<11+10 ; if kind.zone=backing store then
sn w2 4 ; remove process (process name.zone);
jd 1<11+64 ;
rl w3 x1+h0+2 ; length:= last byte.zone - base.zone;
ws w3 x1+h0+0 ; if length modulo 512 <> 0
sz w3 511 ; then goto unstack break;
jl. e29. ;
rl w3 66 ;
dl w1 x3+78 ; saved proc base:=
dl w3 x3+70 ; base(own process);
ds. w3 e18. ;
al. w3 e19. ;
sn w0 x2 ;
se. w1 (e18.) ; if own proc base <> stdbase
jd 1<11+72 ; then set catbase(standard base);
rl. w3 c9. ;
dl w1 x3+2 ; save name at name chain;
ds. w1 e10.+2 ; comment: to save the name;
dl w1 x3+6 ;
ds. w1 e10.+6 ;
\f
;rc 15.10.73 file processor, unstack, page ...3...
al. w1 e9. ;
jd 1<11+42 ; lookup (name, wtail);
se w0 0 ; if not found then
jl. e28. ; goto unstack break;
al. w3 h40. ; get area process:
jd 1<11+64 ; remove process (<:fp:>);
al. w3 e10. ; create area process (entry name);
jd 1<11+52 ; comment: no checking;
rl. w2 c7. ;
rl. w0 e9.+14 ; segment no.mess:= block + length -1;
wa. w0 e9.+18 ;
bs. w0 1 ; first address.mess:= base.zone +1;
al. w1 e16. ; last address.mess:= first address+510;
rs w0 x1+6 ;
rl w3 x2+h0+0 ; transport (saved zone descriptor);
al w3 x3+1 ;
al w0 x3+510 ; init move:
ds w0 x1+4 ; from:= first address;
jl. w3 e23. ; to:= zone descriptor address;
rl. w2 c7. ;
al w2 x2+h0 ; comment:
al w3 x2+h5 ; the zone descriptor is restored from
rl. w1 e15. ; the stacked zone;
\f
; rc 15.01.74 file processor, unstack, page ...4...
e4: rl w0 x1 ; move zone descr:
rs w0 x2 ; word (to):= word (from);
al w2 x2+2 ; to:= to+2;
al w1 x1+2 ; from:= from+2;
se w2 x3 ; if more then goto move zone descr;
jl. e4. ;
am. (c7.) ; move share descriptors:
dl w3 h0+8 ; to:= first share;
al w3 x3+h6 ; move next:
e5: rl w0 x1 ; word (to):= word (from);
rs w0 x2 ; to:= to+2;
al w2 x2+2 ; from:= from+2;
al w1 x1+2 ; if more then goto move next;
se w2 x3 ;
jl. e5. ;
rl. w2 c9. ;
dl w0 x1+2 ;
ds w0 x2+2 ; move unstacked chain-name
dl w0 x1+6 ; to name(chain);
ds w0 x2+6
rl. w0 e9.+14 ; segm no in mess :=
rs. w0 e13. ; size:=
rs. w0 e9. ; block;
rl w3 x1+8 ;
rs. w3 e9.+18 ; length:=saved length;
ws w0 6 ;
rs. w0 e9.+14 ; block:=block - length;
dl w0 x1+12 ;
ds. w0 e20. ; peripheral proc base:= saved base;
rl. w1 c7. ; prepare restoring of zone buffer:
dl w0 x1+h0+2 ;
al w3 x3+1 ; first address.mess:= base.zone+1;
bs. w0 1 ; last address.mess:= last byte.zone-1;
al. w1 e16. ; segment no.mess:= 0;
ds w0 x1+4 ;
jl. w3 e23. ; transport(mess, zone buffer);
\f
; rc 1978.09.27 file processor, unstack, page ...5...
j3: al. w3 e10. ; unstack ok:
rl. w0 e9. ;
se w0 0 ; if entry size = 0
jl. 6 ; then
jd 1<11+48 ; remove entry(work area)
jl. j4. ; else
jd 1<11+64 ; remove area process (work area)
al. w1 e9. ; change entry(tail, work area);
jd 1<11+44 ;
j4: se w0 0 ; if impossible
jl. e28. ; then error(not found);
dl. w1 e20. ; if area process bases
sn. w0 (e21.) ; = infinity
jl. j2. ; then goto unstack done;
rl w3 x2+74 ;
rl w2 66 ; comment always area process: ;
sl w0 (x2+72) ; if area process bases
sl w1 x3+1 ; outside max base
dl w1 x2+74 ; then base:=maxbase else base:=area proc base;
al. w3 e19. ; w3:= nullname;
sn w0 (x2+76) ;
se w1 (x2+78) ; if base <> std base
jd 1<11+72 ; then set catbase(base);
al w0 0 ;
am. (c7.) ;
al w3 h1+2 ;
rs w0 x3+8 ; nametabaddr.zone := 0;
jd 1<11+52 ; create area process(name.zone);
al. w1 e21. ;
jd 1<11+16 ; send dummy message(area process);
al. w1 e9. ; comment in order to establish n.t.addr ;
jd 1<11+18 ; wait answer(dummy message);
j2: dl. w1 e18. ; unstack done:
al. w3 e19. ;
rl w2 66 ; if own proc cat base
sn w1 (x2+70) ; <> saved cat base
se w0 (x2+68) ; then set catbase(
jd 1<11+72 ; own proc, saved catbase);
j5: rl. w0 e12. ; done1:
rl. w3 e11. ; set interrupt (saved im,ia);
jd 1<11+0 ; load and enter io-segment;
j1: dl. w1 c7. ; with return to the user;
jl. h70. ;
b. g1 ; begin
g1= (:h13+512-k:)/2 ; fill up segment to 512 bytes;
c. -g1 m.length error on fp segment 7
z. ;
w. 0, r.g1 ; zero fill
e. ; end fill up;
m.fp unstack medium 1978.09.27
i. ; maybe names
e. ; end unstack medium;
\f
\f
\f
; rc 26.05.72 file processor, magtape check, page ...1...
; this segment is called when special status bits are set for
; operations with magnetic tapes.
s. k=h13, e48 ; begin
w. 512 ; length ; segment 8:
e0: dl. w0 c11. ; w0:=remaining bits;
dl. w2 c5. ; w1,w2:=zone,share;
jl. e1. ; goto magnetic tape;
e2: 1<22+1<7+1<20+1<19 ; test parity, w. defect , overrun and b. l. error
e3: 1<15 ; = 8<12 ; test write-enable; move operation
e4: 1<16 ; test tape mark
e34: 1<16+1<6 ; test tape mark or position error
e5: 6<12 ; erase operation
8<12 ; move operation
e6=h0-h1-2 ; displacement zone-name
e8: 0 ; saved various
e7: 0 ; erasures
e9: 8.5703 6031 ; hard error mask
; repeat:
e10: al w3 x1+h1+2 ; repeat:
e14: al w1 x2+6 ; w3:=name address;
jd 1<11+16 ; w1:=message address;
rs w2 x1-6 ; send message(w3,w1,buf);
al w2 x1-6 ; state.share:=buf addr;
e13: al w2 x2+h6 ; next share:
sh w2 (x3+e6+8) ; share:=share+share descr length;
jl. e11. ; if share>last share
rl w2 x3+e6+6 ; then share:=first share;
e11: rs. w2 e8. ; save share;
sn w2 (x3+e6+4) ; if share=used share
jl. e12. ; then goto check again;
rl w0 x2 ; if share is not pending
sh w0 1 ; then goto next share;
jl. e13. ; wait answer (buf,irr,irr);
al. w1 c10. ; restore saved share;
rl w2 x2 ; goto repeat;
jd 1<11+18 ; check again:
rl. w2 e8. ; goto wait transport;
jl. e14. ; return saved;
\f
; rc 23.05.72 file processor, magtape check, page ...1a...
e22: rl. w0 c22. ; stopped:
sn w0 0 ; if bytes transferred = 0
jl. e10. ; then repeat;
jl. e17. ; goto give up;
e20: se w3 10 ; update position: if operation
sn w3 3 ; is input or output mark
jl. e15. ; then goto test tapemark;
sz w0 1<6 ; no update: if pos error
jl. e17. ; then give up
jl. e16. ; else return;
e15: rl. w0 c10. ; test tapemark: w0:=status;
so. w0 (e4.) ; if nto tapemark
jl. e17. ; then goto give up;
rl w3 x1+h1+12 ; file count := file count+1;
al w3 x3+1 ; block count := 0;
al w0 0 ;
ds w0 x1+h1+14 ;
sn. w3 (c26.) ; if file count <> file answer
se. w0 (c28.) ; or block count <> block answer
jl. e33. ; then goto add pos bit;
dl. w0 c11. ; w0:=remaining bits;
bl w3 x2+6 ;
sn w3 3 ; if operation <> input
so. w0 (e4.) ; or not tape mark
jl. e16. ; then return;
al w0 25 ; top transferred:=
ls w0 16 ; first addr+2;
rs w0 (x2+8) ; goto normal action;
rl w1 x2+8 ; comment: the return point to
al w1 x1+2 ; the io-segment must be set;
rs w1 x2+22 ;
e16: am h86-h87 ; normal action: set return
e12: am h87-h88 ; wait transport: set return
e17: al. w3 h88. ; give up: set return;
dl. w2 c5. ; w1,w2:=zone share;
ds. w3 c11. ; w3:=return point;
jl. h70. ; call and enter io-segment;
e33: al w3 1<6 ; add pos bit:
lo. w3 c10. ; status :=
rs. w3 c10. ; status or pos bit;
jl. e17. ; goto give up;
\f
; rc 26.05.72 file processor, magtape check, page ...2...
e1: bl w3 x2+6 ; magtape: w0:= remaining bits;
sz w0 1<5+1<2 ; if not exist or rejected message
jl. e21. ; then goto mount tape;
sz. w0 (e34.) ; if tape mark or position error
jl. e20. ; then goto update position;
sz. w0 (e2.) ; if parity or word defect or block l. err.
jl. e23. ; then goto parity;
lo w0 x1+h2+0 ; no transport:
sz. w0 (e3.) ; if write-enable or give up mask
jl. e22. ; then goto stopped;
jl. w3 e37. ; parent message (<:mount ring:>);
jl. e24. ; goto reserve tape;
e21: so w3 1 ; mount tape:
jl. e16. ; if not transport then goto return;
sz w0 1<5 ; if not exist then
e25: jl. w3 e38. ; parent message (<:mount:>);
e24: al w3 x1+h1+2 ; reserve tape:
jd 1<11+6 ; initialize process (proc.zone);
sl w0 2 ; if not existing or not user then
jl. e25. ; goto mount tape;
se w0 0 ; if not reserved then
jl. e17. ; goto give up;
rs. w0 c8. ; tries:= 0;
al w3 e40 ; operation:= sense;
hs. w3 e39. ; move action:= repeat;
jl. e26. ; goto send;
e27: dl. w2 c5. ; after move: w1,w2:=zone,share;
rl. w0 c26. ; if file number.answer is undefined
sh w0 -1 ; then move:= rewind
jl. e35. ; else
sn w0 (x1+h1+12) ; if file number=file count then
jl. e28. ; goto position block else
sh w0 (x1+h1+12) ; if file number<=file count then
jl. e29. ; move:= upspace file else
e31: rl. w0 c26. ; spool back:
ls w0 -1 ; if file number//2>=file count
sl w0 (x1+h1+12) ; then
e35: am 2 ; move:= rewind tape else
am 2 ; move:= backspace file;
e29: al w3 0 ; goto spool;
jl. e30. ;
e28: rl. w0 c28. ; position block:
sh w0 -1 ; if block number is undefined
jl. e31. ; then goto spool back else
sn w0 (x1+h1+14) ; if block number=block count
e39=k+1 ; move action ; then goto move action
jl. e39. ; else
\f
; rc 1.7.69 file processor, magtape check, page ...3...
sh w0 (x1+h1+14) ; if block number<=block count
jl. e32. ; then move:= upspace block else
ls w0 -1 ; if block number//2>=block count
sl w0 (x1+h1+14) ; then
jl. e31. ; goto spool back else
am 2 ; move:= backspace block;
e32: al w3 1 ;
e30: rl. w0 e5.+2 ; spool: operation:= 8; move;
e26: rs. w0 c10. ; send: set operation from w0;
rs. w3 c10.+2 ; set move from w3;
al w3 x1+h1+2 ; w3:=name address;
al. w1 c10. ; w1:=message address;
jd 1<11+16 ; send message (w3,w1,buf);
jd 1<11+18 ; wait answer (buf,answer,result);
al w3 1 ; status:= 1 shift result;
ls w3 (0) ; if normal answer (result=1) then
dl. w2 c5. ; status:= status or statusword.answer;
sn w3 1<1 ;
lo. w3 c10. ; if not existing or rejected
rs. w3 c10. ; then goto magnetic tape;
al w0 x3 ;
sz w0 1<5+1<2 ; if hard errors then goto give up;
jl. e1. ;
sz. w0 (e9.) ; goto after move;
jl. e17. ;
jl. e27. ;
e23: rl. w3 c8. ; parity:
sl w3 5 ; if tries=5 then
jl. e17. ; goto give up;
al w3 x3+1 ; tries:= tries+1;
rs. w3 c8. ; erasures:= 0;
al w3 e42 ; move action:= prepare repeat;
hs. w3 e39. ;
rl w3 x1+h1+14 ; saved position:= block count-1;
al w3 x3-1 ; block count:= block count -
al w0 0 ; (if block count>1 then 2 else 1);
ds. w0 e7. ;
sl w3 1 ; goto after move;
al w3 x3-1 ;
jl. e48. ;
e42=k-e39+1 ; prepare repeat:
bl w0 x2+6 ; move action:= if operation
al w3 e40 ; is not output then repeat
sn w0 5 ; else erase;
al w3 e43 ;
hs. w3 e39. ; block count:= saved position;
rl. w3 e8. ; goto after move;
e48: rs w3 x1+h1+14 ;
jl. e27. ;
e40=e10-e39+1 ; define repeat
e41=e16-e39+1 ; define return
\f
; rc 1.6.70 file processor, magtape check, page ...4...
e43=k-e39+1 ; erase:
rl. w3 e7. ; if erasures >= tries
sl. w3 (c8.) ; then goto repeat;
jl. e10. ; erasures:= erasures+1;
al w3 x3+1 ; operation:= erase;
rs. w3 e7. ; goto send;
rl. w0 e5. ;
jl. e26. ;
; mount ring message to parent:
e18: 9<13+0<5+1 ; m(0) , pattern word , wait
<:ring :>, 0 ; m(2:6)
; mount tape message to parent:
e19: 7<13+0<5+1 ; m(0) , pattern word , wait
<:mount :>, 0 ; m(2:6)
e37: am e18-e19 ; call parent message:
e38: al. w2 e19. ; w2 := message;
ds. w0 c22. ; save(w0,w3);
al w1 x1+h1+2 ; w1 := doc name addr;
rx w2 2 ; swap(w2,w1);
jl. w3 h35. ; parent message(w1,w2);
dl. w0 c22. ; restore(w0,w3);
dl. w2 c5. ; restore(w2,w1);
jl x3 ; return;
b. g1 ; begin
g1= (:h13+512-k:)/2 ; fill up segment to 512 bytes:
c. -g1 m.length error on fp segment 9
z. ;
w. 0 , r.g1 ; zero fill
e. ; end fill up;
m.fp magtape check 26.05.72
i. ; maybe names
e. ; end mag tape check;
\f
; rc 29.07.71 file processor, terminate zone, page ...1...
s. k=h13, e8,b3 ; begin segment: terminate zone;
w. 512 ; no of bytes on segment
rl. w1 c16. ; terminate zone:
am. (c17.) ; w1 := zone addr;
se w3 x3+1 ; if called from io segment then
jl. e0. ; begin
rl. w2 c2. ; restore(w2: current share);
jl. (h19.+h4+4) ; return
; end;
e0: al w0 -1 ; start terminate:
rs. w0 h19.+h4+0 ; filemark := -1;
rx. w0 c17. ; called from io segment := true;
rs. w0 h19.+h2+6 ; save return to program;
rl w2 x1+h0+4 ; share := used share;
rs. w2 h19.+h4+2 ; saved used share := share;
e1: bz w0 x2+6 ; stop share:
al w3 18 ;
sn w0 5 ; if operation(share) = output then
rs. w3 h19.+h4+0 ; filemark := kind(magtape);
rl w3 x2 ; w3 := share state(share);
sh w3 1 ; if share is not pending then
jl. e3. ; goto set state;
sn w0 3 ; if operation(share) = input then
jl. e2. ; goto wait only;
jl. w3 e4. ; wait and free(share);
jl. e7. ; goto next share;
e2: ds. w2 c5. ; wait only: save(w1,w2);
al. w1 h66. ; w1 := answer area;
al w2 x3 ; w2 := share state;
jd 1<11+18 ; wait answer;
dl. w2 c5. ; restore(w1,w2);
e3: al w0 0 ; set state:
rs w0 x2 ; share state(share) := free;
e7: al w2 x2+h6 ; next share:
sh w2 (x1+h0+8) ; share := share + share length;
jl. 4 ; if share > last share then
rl w2 x1+h0+6 ; share := first share;
se. w2 (h19.+h4+2) ; if share <> saved used share then
jl. e1. ; goto stop share;
\f
; rc 23.05.73 file processor, terminate zone, page ...2...
bz w0 x1+h1+1 ; may be filemark:
se. w0 (h19.+h4+0) ; if process kind <> filemark then
jl. e8. ; goto blanks;
al w0 10 ; output filemark:
hs w0 x2+6 ; operation(share) := output mark;
al w3 x1+h1+2 ; w3 := addr(doc name);
al w1 x2+6 ; w1 := message address;
jd 1<11+16 ; send message;
sn w2 0 ; if buffer claim exceeded then
jd 1<11+18 ; provoke interrupt cause 6;
rs w2 x1-6 ; share state(share) := buffer address;
rl. w1 c16. ; restore zone addr;
rl. w2 h19.+h4+2 ; w2 := saved used share;
jl. w3 e4. ; wait and free(share);
al w0 10 ; one more filemark:
hs w0 x2+6 ;
al w3 x1+h1+2 ;
al w1 x2+6 ;
jd 1<11+16 ;
sn w2 0 ;
jd 1<11+18 ;
rs w2 x1-6 ;
rl. w1 c16. ;
rl. w2 h19.+h4+2 ;
jl. w3 e4. ;
am (x1+h1+12) ; backspace file:
al w0 -1 ; file count :=
rs w0 x1+h1+12 ; file count - 1;
al w0 8 ; operation :=
hs w0 x2+6 ; backspace file;
al w0 2 ;
rs w0 x2+8 ;
al w3 x1+h1+2 ; send the message:
al w1 x2+6 ;
jd 1<11+16 ;
sn w2 0 ;
jd 1<11+18 ;
rs w2 x1-6 ;
rl. w1 c16. ;
rl. w2 h19.+h4+2 ;
jl. w3 e4. ;
e8: se w0 12 ; blanks:
jl. e5. ; if kind <> punch then
al w3 x1+h1+2 ; goto remove or release;
al. w0 b0. ;
al. w1 b1. ; set first and last core
ds. w1 b3. ; of message;
al. w1 b2. ;
jd 1<11+16 ; send message;
jd 1<11+18 ; wait answer;
rl. w1 c16. ; restore w1;
e5: al w3 x1+h1+2 ; remove or release:
bz w2 x1+h1+1 ; w3 := addr(doc name);
sn w2 4 ; if process kind = backing store
jd 1<11+64 ; then remove process;
se w2 4 ; if process kind <> backing store
jd 1<11+10 ; then release process;
dl. w1 c16. ; finis terminate:
rl. w2 c17.-2 ; restore(w0,w1,w2);
rl. w3 h19.+h2+6 ; restore return to program;
ds. w3 c11. ; saved(w0,w3) := (w0,w3);
jl. h70. ; call and enter io segment;
\f
; rc 29.07.71 fileprocessor terminate zone, page ...2a...
e4: rs. w3 h19.+h4+4 ; call wait and free: save return;
ds. w1 c1. ; save(w0,w1);
al. w3 h78. ; return from io segment :=
ds. w3 c3. ; terminate zone segment;
al. w3 h48.+4 ; w3 := entry at wait and free;
ds. w3 c11. ;
jl. h70. ; call and enter io segment;
b0: 0,r.40 ; 100 blanks
b1=k-2 ;
b2: 5<12+4 ; output, even parity;
0 ; first core;
b3: 0 ; last core;
b. g1 ; begin block: fill segment with zeroes
g1 = (:h13+512-k:)/2 ;
c. -g1 m.length error, terminate zone
z.
w. 0, r.g1 ;
e. ; end block: fill segment
i. ; id list
e. ; end terminate zone
m.fp terminate zone 23.05.73
▶EOF◀