|
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: 125952 (0x1ec00)
Types: TextFile
Names: »mcatinit «
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦2ba378e4a⟧
└─⟦this⟧ »mcatinit «
\f
m. moncatinit - initialisation of catalog, links ... 17.0 beta
;88.05.05 13.33 kak link of dlc/ioc main deviceses
;88.05.12 10.04 kak connect and oldcat (g11) corrected to the new connect protecol
;88.05.16 10.15 kak ioc/dlc devices from the autloadlist are linked after autoload
;88.06.07 11.45 kak initial prepare dump included
;88 10 06 13.27 hsi changed text to oldcat (g11) (R15)
;88 11 21 14 42 kak bskind removed from kitlabel (always disc kind);
;88 11 21 15 30 kak number of modes increased in binin
;88 11 28 10.52 kak error in binin corrected
;89 01 27 13.15 kak a new block with stepping stones included
; g40,...,g50 <--> g70,...,g80
b.i30 w.
i0=89 01 27
i1=13 15 00
; if newtime (i0,i1) > oldtime (a133,a134) then oldtime:=newtime;
c.i0-a133
c.i0-a133-1, a133=i0, a134=i1, z.
c.i1-a134-1, a134=i1, z.
z.
i10=i0, i20=i1
i15=i10/100000 , i10=i10-i15*100000 , i25=i20/100000 , i20=i20-i25*100000
i14=i10/10000 , i10=i10-i14*10000 , i24=i20/10000 , i20=i20-i24*10000
i13=i10/1000 , i10=i10-i13*1000 , i23=i20/1000 , i20=i20-i23*1000
i12=i10/100 , i10=i10-i12*100 , i22=i20/100 , i20=i20-i22*100
i11=i10/10 , i10=i10-i11*10 , i21=i20/10 , i20=i20-i21*10
i2: <: date :>
(:i15+48:)<16+(:i14+48:)<8+46
(:i13+48:)<16+(:i12+48:)<8+46
(:i11+48:)<16+(:i10+48:)<8+32
(:i25+48:)<16+(:i24+48:)<8+46
(:i23+48:)<16+(:i22+48:)<8+46
(:i21+48:)<16+(:i20+48:)<8+ 0
i3: al. w0 i2. ; write date:
rs w0 x2+0 ; first free:=start(text);
al w2 0 ;
jl x3 ; return to slang(status ok);
jl. i3. ;
e.
j.
; segment 9: initialize catalog on backing store
s.k=k, m2, h13,g80,f60,e27,d80,c25
w.b127=k, c25, k=k-2
; segment structure:
; definitions (c names)
; variables (d names)
; textstrings (e names)
; utility procedures (f names)
; command actions (g names)
; tables and buffers (h names)
;
; (i and j names are used locally)
d0=k-2 ; start s:
w. jl. (d40.) ; first instruction: goto init catalog;
h2: h3 ; link for initcat command-table
d54=0 , d53=1 ; first slice.cat, keys
d52=4 ; interval
d55=6 ; name
d56=14 ; tail
d57=d56+0 ; size
d61=d56+2 ; doc name
d64=d56+12 ; slicelength
d66=d56+14, d67=d56+15 ; last slice, first reserved slice
e5: <:result<0>:>, e6=k-2
e7: <:status<0>:>, e8=k-2
; generate start up header.
; the text generated below is printed during start up of the monitor.
e19:
<: <10>monitor release : :>
b.i1,j1 w.
i0=a135/10, j0=a136/10
i1=a135/1 , j1=a136/1
(:i0+48:)<16+(:i1-i0*10+48:)<8+46
(:j0+48:)<16+(:j1-j0*10+48:)<8+32
0
e.
e20:
<:monitor version : :>
b.i10,j5 w.
i0=a133/100000, j0=a134/100000
i1=a133/10000 , j1=a134/10000
i2=a133/1000 , j2=a134/1000
i3=a133/100 , j3=a134/100
i4=a133/10 , j4=a134/10
i5=a133/1 , j5=a134/1
(:i0 +48:)<16+(:i1-i0*10+48:)<8+46
(:i2-i1*10+48:)<16+(:i3-i2*10+48:)<8+46
(:i4-i3*10+48:)<16+(:i5-i4*10+48:)<8+32
32<16+(:j0 +48:)<8+(:j1-j0*10+48:)
46<16+(:j2-j1*10+48:)<8+(:j3-j2*10+48:)
46<16+(:j4-j3*10+48:)<8+(:j5-j4*10+48:)
0
e.
e21:
c.a130-1
b.i5,j5 w.
i0=a130/100000, j0=a131/100000
i1=a130/10000 , j1=a131/10000
i2=a130/1000 , j2=a131/1000
i3=a130/100 , j3=a131/100
i4=a130/10 , j4=a131/10
i5=a130/1 , j5=a131/1
<:date of options : :>
(:i0 +48:)<16+(:i1-i0*10+48:)<8+46
(:i2-i1*10+48:)<16+(:i3-i2*10+48:)<8+46
(:i4-i3*10+48:)<16+(:i5-i4*10+48:)<8+32
32<16+(:j0 +48:)<8+(:j1-j0*10+48:)
46<16+(:j2-j1*10+48:)<8+(:j3-j2*10+48:)
46<16+(:j4-j3*10+48:)<8+(:j5-j4*10+48:)
e.z.
<:<10><0>:>
e18:
<:<10>initialize date using the date command <10>:>
; print out start-up head under assembly.
b.j0 w.
j0: al. w0 e19. ; text:=start-up header;
al w2 0 ; status:=ok;
jl x3 ; return to slang;
jl. j0. ; entry: goto start;
e.
j.
b. j0 w.
j0: al. w0 e20. ; text = mon version
al w2 0 ;
jl x3 ; return to slang
jl. j0. ; entry: goto start
e. ;end
j.
b. j0 w.
j0: al. w0 e21. ; text = mon options
al w2 0 ;
jl x3 ; return to slang
jl. j0. ; entry: goto start
e. ; end
j.
; description of main catalog:
; (format resembles a normal catalog-entry)
d8: ; start of entry
a110 ; (key)
a107,a108 ; (interval)
d9: <:catalog:>, 0 ; name of main catalog
d10: -1 ; size of main catalog (initially not defined)
0, r.4 ; (document name)
d11: 0 ; maincat shortclock
0 ; (file)
d12: 0 ; (no of keys or block)
-1 ; (contents and entry)
0, r.(:a88+d8.+2:)>1; (rest of tail)
; stepping stones
g70: jl. (2), g40
g71: jl. (2), g41
g72: jl. (2), g42
g73: jl. (2), g43
g74: jl. (2), g44
g75: jl. (2), g45
g76: jl. (2), g46
g77: jl. (2), g47
g78: jl. (2), g48
g79: jl. (2), g49
;
;
c. (:g79-b110:) - (:1<14:)
m. address overflow in initcat command table
z.
; procedure type newline
; outputs a newline char on the console
;
; call: w3 = link
; exit: w0 = undef, w1,w2,w3 = unch
f3: ; type newline:
al w0 10 ; char := newline;
; continue with type char;
; procedure type char
; outputs the given char on the console
; (if the char is <newline>, the buffer is sent)
; ***** note: return inf etc are not saved for reentrant use of this code!!!
;
; call: w0 = char, w3 = link;
; exit: all regs unch
f0: ; type char:
b. i24 w.
ds. w2 i0. ; save regs;
ds. w0 i1. ;
rl w2 0 ;
i10: ; put char: (w0 = w2 = char)
jl. w3 f42. ; write char (char);
rl. w3 (i2.) ; if write mode <> memory and
se w3 1 ;
se w2 10 ; if char = newline then
jl. i15. ; begin
jl. w3 f44. ; type line (buf);
jl. w3 f45. ; save work (buf);
am ;+2: error: (continue)
; (maybe status-errors ougth to repeat a couple of times ???)
jl. w3 f41. ; init write;
i15: ; end;
dl. w2 i0. ; restore regs;
dl. w0 i1. ;
jl x3 ; return;
; procedure typetextline (text);
; outputs the text on the console, terminated by a newline char
; call: w1=text addr, w3=link
; exit: w0,w1,w3=unch, w2 = undef
f2: ; typetextline:
am 10-32 ; char := newline;
; continue with typeout;
; procedure typetext (text);
; outputs the text on the console, terminated by a space
; call: w1=text addr, w3=link
; exit: w0,w1,w3=unch, w2=undef
f1: ; typetext:
al w2 32 ; char := space;
ds. w2 i0. ; save regs;
ds. w0 i1. ;
jl. w3 f43. ; writetext (text);
al w0 x2 ;
jl. i10. ; goto put char
i0=k+2, 0, 0 ; saved w1,w2
i1=k+2, 0, 0 ; saved w3,w0
i2: b144 ; pointer to write mode (e54)
e. ;
; procedure typeresult(name,result)
; comment: outputs a name and result on the console.
; call: return:
; w0 result result
; w1 unchanged
; w2 link link
; w3 name name
b.i24 ; begin
w.f5: ds. w1 i2. ;
ds. w3 i3. ;
al w1 x3+0 ;
jl. w3 f1. ; typeout(name);
al. w1 e5. ;
jl. w3 f1. ; typeout(<:result:>);
wa. w0 i1. ;
jl. w3 f0. ; typechar(result+48);
i0: ; end with newline:
jl. w3 f3. ; type newline;
dl. w1 i2. ;
dl. w3 i3. ;
jl x2+0 ;
i1: 48 ;
0, i2: 0 ;
0, i3: 0 ; end
; procedure typestatus(name,status)
; comment: outputs a name and the number of the
; leftmost status bit.
; call: return:
; w0 status status
; w1 unchanged
; w2 link link
; w3 name name
; begin
w.f6: ds. w1 i2. ;
ds. w3 i3. ;
al w1 x3+0 ;
jl. w3 f1. ; typeout(name);
al. w1 e7. ;
jl. w3 f1. ; typeout(<:status:>);
rl w1 0 ; w1 := status;
al w2 -1 ;
i4: sl w1 0 ; rep:
am 46-49 ; if leftmost bit(w1) = 0 then
al w0 49 ; outchar(point) else
jl. w3 f0. ; outchar(one);
ld w2 1 ; w1 := w1 shift 1;
se w2 0 ; if not all status is printed then
jl. i4. ; goto rep;
jl. i0. ; goto end with newline;
e. ; end
; procedure inchar(char, trouble)
; comment: inputs the next character from the <input>
; call: return:
; w0 char
; w1 unchanged
; w2 unchanged
; w3 link link
b.i24 ; begin
w.f7: ds. w2 i8. ;
rs. w3 i9. ;
rl. w2 d18. ;
al w2 x2+1 ; cur char:=cur char+1;
i0: rs. w2 d18. ; while cur char=characters do
se. w2 (d17.) ; begin
jl. i3. ;
jl. w3 f9. ; inblock
jl. (i9.) ;+2: trouble: goto trouble;
jl. i4. ;+4: end area: goto simulated end-character;
;+6: ok:
al w2 0 ; end;
jl. i0. ; cur char:=0;
i3: al w1 0 ; end;
wd. w2 i6. ;
ls w1 3 ; pos:=(cur char mod 3)*8-16;
ls w2 1 ;
wa. w2 d22. ; addr:=input buf+cur char/3*2;
rl w0 x2+0 ;
ls w0 x1-16 ; char:=word(addr) shift pos;
sz w0 255 ; if char = null-char then
jl. i5. ; begin
rl. w1 d40. ; if modekind <> tro then
sn w1 m2 ;
jl. i5. ;
i4: ; simulated end-char:
al w0 255 ; char := 255;
jl. i10. ; end
i5: ; else
la. w0 i7. ; char := char extract 7;
i10: ;
dl. w2 i8. ;
rl. w3 i9. ;
jl x3+2 ;
i6: 3 ;
i7: 8.177 ;
0, i8: 0 ;
i9: 0 ;
e. ; end
; procedure inword(word, trouble, endseg)
; comment: inputs a binary word from the <input>. at the
; end of an input segment the checksum is checked.
; call: return:
; w0 word
; w1 unchanged
; w2 unchanged
; w3 link link
b.i24 ; begin
w.f8: ds. w2 i7. ;
rs. w3 i8. ;
al w0 0 ; word:=0;
al w1 18 ; pos:=18;
rl. w2 d35. ;
i0: rs. w0 i6. ; repeat
jl. w3 f7. ; inchar(char, trouble);
jl. (i8.) ;
sl w0 64 ; if char>63
jl. i1. ; then goto checksum;
wa w2 0 ; sum:=sum+char;
ls w0 x1+0 ;
lo. w0 i6. ; word:=word or char shift pos;
al w1 x1-6 ; pos:=pos-6;
sl w1 0 ; until pos<0;
jl. i0. ;
rs. w2 d35. ;
dl. w2 i7. ;
rl. w3 i8. ;
jl x3+4 ; goto exit;
i1: se w1 18 ; checksum:
jl. i2. ; if pos<>18
sn w0 255 ; (if null-char read
se w2 0 ; and sum=0 then
jl. i9. ; begin
dl. w2 i7. ; restore (w1, w2);
sn w1 x2 ; if null-char allowed then
jl. (i10.) ; goto end-action;
jl. i2. ; goto sumerror;
i9: ; end)
la. w0 i4. ;
la. w2 i4. ; or char(18:23)<>sum(18:23)
sn w0 x2+0 ;
jl. i3. ; then
i2: al. w1 e9. ; begin
jl. w3 f2. ; type textline (<:input sumerror:>);
jl. (i8.) ; end;
i3: al w0 0 ;
rs. w0 d35. ; sum:=0;
dl. w2 i7. ;
rl. w3 i8. ;
jl x3+2 ; goto endseg;
i4: 8.77 ;
i5: 0, i6: 0 ;
0, i7: 0 ;
i8: 0 ; exit:
i10:g54 ; end-action address
e. ; end
; procedure inoutseg(name, mess, trouble)
; comment: inputs or outputs the load buffer from or to the backing store
; call: return:
; w0 logical status
; w1 mess mess
; w2 link link
; w3 name name
b.i24 ; begin
w.f10:am 3-5 ; input:
f12:al w0 5 ; output:
hs w0 x1 ; set operation in message;
ds. w3 i5. ;
rs. w1 i6. ;
jd 1<11+16 ; send mess(name,area mess,buf);
al. w1 d15. ; wait answer(buf,answer,result);
jd 1<11+18 ;
al w2 1 ; logical status :=
ls w2 (0) ; 1 shift result
sn w2 1<1 ;
lo w2 x1 ; + if ok then status;
al w0 x2 ; w0 := logical status;
dl. w2 i4. ; restore(w1,w2);
se w0 1<1 ; if any errors then
jl. f6. ; type status (logical status) and trouble return;
rl w3 x1+6 ;
al w3 x3+1 ;
rs w3 x1+6 ; cur seg:=cur seg+1;
rl. w3 i5. ;
jl x2+2 ;
i3: 1<18 ;
i6: 0 ; saved message address
i4: 0, i5: 0 ;
e. ; end
; procedure clear(first,last)
; comment: initializes a storage area with -1.
; call: return:
; w0 -1
; w1 last last
; w2 first last+2
; w3 link link
b.i24 ; begin
w.f11:al w0 -1 ;
i0: rs w0 x2+0 ; repeat
al w2 x2+2 ; word(first):=-1;
sh w2 x1+0 ; first:=first+2;
jl. i0. ; until first=last+2;
jl x3+0 ;
e. ; end
; read block
;
; return address: link+0: trouble
; +2: end area
; +4: ok (w2 = start of buffer)
;
; comment delivers one block from input;
; call return
; w0 - destroyed
; w1 - destroyed
; w2 - start of buffer
; w3 link destroyed
; on return d17 is initialized
b. i20, j10
w.
f9: am 3-5 ; read double buffered:
f13: al w0 5 ; write double buffered:
rx. w3 j3. ; save (return); get mess addr;
hs w0 (x3+8) ; save (operation) in opposite message;
rl w2 x3+10 ; get buffer address;
i0: al. w1 d15. ; wait: get answer address;
rs. w3 d42. ; save current message address;
jd 1<11+18 ; wait transfer;
se w0 1 ; if result <> 1 then
jl. i1. ; goto result error;
rl w0 x1+0 ; test status;
sz. w0 (j0.) ; if any error then
jl. i2. ; goto read error;
i6: rl w0 x3+2 ; continue:
rs. w0 d22. ; save buffer start;
rl w2 x1+2 ; no of characters :=
ls w2 -1 ; no of bytes +
wa w2 x1+2 ; no of no of bytes//2;
rs. w2 d17. ;
rl w2 x1+2 ; w2 := bytes transferred;
ls w2 -9 ;
wa w2 x3+6 ; w2 := segm := segms transferred + last segm;
rl w1 x3+8 ; get new message address;
i5: ; start transfer:
rs w2 x1+6 ; save segmno in message;
; prepare an empty catalog buffer, in case of kitlabel
dl w3 x1+4 ; w2 := first of buffer; w3 := last of buffer;
al w0 -1 ;
i10: rs w0 x2 ; clear all buffer;
al w2 x2+2 ;
se w2 x3 ;
jl. i10. ;
al w0 0 ; last word of buffer := 0;
rs w0 x2 ;
rs. w0 j4. ; error count := 0;
al. w3 e1. ; w3 := name;
jd 1<11+16 ; start transfer;
rs w2 x1+10 ; save buffer address;
rl. w2 d22. ; w2 := start of buffer;
rx. w1 j3. ; save message address;
jl x1+4 ; return;
; result error
i1: al. w1 f6. ;
al w2 1 ;
ls w2 (0) ; logical status := 1 shift result;
al w0 x2 ;
jl. i4. ; out error(type result);
; read error
i2: rl. w2 d40. ; w2 := modekind;
sn w2 m2 ; if kind = <tr> then goto
jl. i7. ; goto test end of tape;
rs. w3 j2. ; save message address;
sn w2 m0 ; if kind = <bs> then
jl. i11. ; goto test end area;
so. w0 (j1.) ; if not parity error then
jl. i3. ; goto hard error;
al. w1 j5. ; insert move message address;
al. w3 e1. ; insert name address;
jd 1<11+16 ;
al. w1 d15. ; insert answer address;
jd 1<11+18 ; wait move;
rl. w0 j1. ; (status := parity error);
i9: ; repeat:
rl. w1 j4. ;
al w1 x1+1 ; increase (error count);
rs. w1 j4. ;
sl w1 5 ; if error count >= max then
jl. i3. ; goto hard error;
al. w3 e1. ; w3 := name;
rl. w1 j2. ; restore message address;
jd 1<11+16 ; start new input;
rl w3 2 ; w3 := message address;
jl. i0. ; goto wait;
i11: ; test end area:
so. w0 (j10.) ; if not end document then
jl. i9. ; goto repeat;
i13: ; end document:
al w2 0 ; pending answer := false;
rx. w2 j3. ;
jl x2+2 ; goto end-area return;
; hard error:
i3: al. w1 f6. ; out error( type status);
al w2 1<1 ; logical status := status + (result ok) shift 1;
lo w0 4 ;
; out error:
i4: al. w3 e1. ; get name address;
jl w2 x1+0 ; type error;
al w2 0 ; pending answer := false;
rx. w2 j3. ;
jl x2 ; goto error return;
; test end of tape
i7: sz. w0 (j6.) ; if end of tape then
jl. i12. ; goto test empty;
jl. i3. ; goto hard error;
; test empty: if nothing was read from the paper tape reader then
; return via end-document-return;
i12: rl w2 x1+2 ; if bytes transferred <> 0 then
se w2 0 ; goto continue;
jl. i6. ;
jl. i13. ; goto end document;
; procedure start transfer
; comment initializes reading from input
; call return
; w0 - destroyed
; w1 - destroyed
; w2 - destroyed
; w3 link destroyed
f15: am 3-5 ; start transfer input:
f16: al w0 5 ; start transfer output:
ls w0 12 ;
hl. w0 d40. ; w0 := operation shift 12 + mode;
al w3 x3-4 ; (prepare ok return via start-transfer-action)
rs. w3 j3. ; save return;
al. w1 d38. ;
al. w2 d39. ; get message addresses;
rs w0 x1 ; save operation and mode in messages;
rs w0 x2 ;
rs w1 x2+8 ; establish chain;
rs w2 x1+8 ;
al w0 512-2 ; block length := 512 bytes;
rl. w3 j7. ;
; insert buffer addresses;
rs w3 x1+2 ;
wa w3 0 ;
rs w3 x1+4 ;
al w3 x3+2 ;
rs w3 x2+2 ;
wa w3 0 ;
rs w3 x2+4 ;
al. w3 e1. ; w3 := name;
jd 1<11+8 ; reserve process;
rl. w2 d41. ; w2 := first segment;
rl. w0 d40. ; w0 := kind;
bz w0 1 ;
se w0 m1 ; if kind <> <mt> then
jl. i5. ; goto start transfer;
rs. w2 j9. ; save position in setposition-message;
al. w1 j8. ;
bz. w0 d40. ; mode.message := mode;
hs w0 x1+1 ;
jd 1<11+16 ; send message (setposition);
al. w1 d15. ;
jd 1<11+18 ; wait answer; (no status check)
al. w1 d38. ; w1 := first message;
jl. i5. ; goto start transfer;
; procedure end transfer
; comment the last answer is checked.
;
; registers call return
; w0 - destroyed
; w1 - destroyed
; w2 - destroyed
; w3 link name
f17: rx. w3 j3. ; save return;
sn w3 0 ; if no pending answer then
jl. i8. ; goto exit;
rl w2 x3+10 ; get buffer address
al. w1 d15. ; insert answer address;
jd 1<11+18 ; wait answer;
i8: al w2 0 ; exit:
rx. w2 j3. ; change(0, return);
al. w3 e1. ; w3 := name;
jd 1<11+10 ; release process(name);
jl x2+0 ; return;
j0: 8.77 20 00 00 ; error bits
j1: 8.20 00 00 00 ; parity error bit
j2: 0 ; saved message address
j3: 0 ; saved return or message address
j4: 5 ; error count
j5: 8<12, 3 ; backspace message
j6: 8.01 20 00 00 ; end of tape bit
j7: h10 ; 1. input buffer
j8: 8 < 12 ; move operation:
6 ; setposition
j9: 0 ; file number
0 ; (block = 0)
j10: 1<18 ; end document status
e.
; procedure read chain f26
; procedure write chain f27
;
; procedure read chain and prepare bs
; procedure write chain and prepare bs
;
; the chainbuffer is either read from the device or written onto the device
; given by ..device number..
;
; call: w3 = link
; exit: link+0: error (all regs undef)
; +2: ok (w3 = chainhead address, other regs undef)
b. i30, j10 w.
f26: am 3-5 ; read chain
f27: al w0 5 ; write chain
hs. w0 j1. ; set operation
al w0 -1 ; prepare bs := false
jl. i2. ;
f21: am 3-5 ; read chain:
f22: al w0 5 ; write chain:
hs. w0 j1. ; set operation in message;
al w0 0 ; prepare bs := true
i2 : rs. w0 j9. ;
rs. w3 j0. ; save (return);
jl. w3 f39. ; move catname,docname to chainhead;
; (in case of write chain)
; give the device a wrk-name and reserve it
al. w3 j5. ; w3 := wrk-name address;
al w0 0 ;
rs. w0 j6. ; (repeat count := 0;)
rs w0 x3 ; (clear first of name to get a new wrk-name)
rs w0 x3+8 ; (clear name table address)
; convert device number to text
rl. w1 d43. ; w0w1 := devno;
wd. w1 j8. ;
rl w2 0 ; w2 := last digit;
al w0 0 ;
wd. w1 j8. ;
ld w1 8 ;
ls w1 8 ;
wa w2 0 ; w2 := two rigthmost digits;
wa w2 2 ; w2 := three digits;
lo. w2 j7. ; convert digits to letters;
rs. w2 (j10.) ; save in text;
i0: ; create process:
rl. w1 d43. ; w1 := devno;
jd 1<11+54; create peripheral process (wrkname, devno);
se w0 0 ; if result not ok then
jl. i10. ; goto alarm;
jd 1<11+8 ; reserve process;
se w0 0 ; if result not ok then
jl. i11. ; goto alarm;
; start reading/writing one segment, and later read/write the rest
rl. w1 j2. ; addr := first address of chainhead buffer;
i1: ; try greater size of transfer:
al w1 x1+510+1 ; last.mess :=
rs. w1 j3. ; addr + 510 + round up;
al. w1 j1. ;
jd 1<11+16; send message;
al. w1 d15. ;
jd 1<11+18; wait answer;
al w2 1 ;
ls w2 (0) ; w2 := logical status.answer;
sn w0 1 ;
lo w2 x1 ;
sn w2 1<1 ; if no errors then
jl. i5. ; goto test transferred;
; the only allowed error is disconnected (or intervention)
se w2 1<5 ; if not after intervention then
jl. i12. ; goto alarm;
; intervention is only allowed a limited number of times
rl. w1 j6. ;
al w1 x1+1 ; increase (repeat count);
rs. w1 j6. ;
se w1 2 ; if first time then
jl. i0. ; goto create process;
bz. w0 j1. ;
sn w0 3 ; if operation = input then
jl. (j0.) ; return (no chain);
jl. i13. ; goto alarm;
i5: ; test transferred:
rl. w1 j2. ; w1 := first of chainhead buffer;
bz w2 x1+d66 ; w2 := last slice number.chainhead
al w2 x2+a88+1-1; + size of chainhead + 1;
wa w1 4 ; addr := first + bytes in chain;
sl. w2 (d14.) ; if bytes in chain > bytes transferred then
jl. i1. ; goto try greater size of transfer;
; the chainhead has been transferred succesfully:
jl. w3 f39. ; move catname,docname to chainhead;
; (in case of read chain, i.e. after kit <name> )
; the chainbuffer now contains a chainhead
al. w3 j5. ;
jd 1<11+64; remove process(wrk-name);
rl. w3 j2. ; if not prepare bs then
rl. w0 j9. ;
sn w0 -1 ; then return
jl. i9. ;
jl. w3 f38. ; move catname,docname from chainhead;
; (in case of read chain, i.e. after kit <devno> )
rl. w1 d43. ; w1 := device number;
al. w3 e2. ; w3 := docname;
jd 1<11+54; create peripheral process (docname, devno);
se w0 0 ; if result not ok then
jl. i14. ; goto alarm;
jd 1<11+8 ; reserve process (docname);
rl. w3 j2. ; w3 := chainhead buffer;
jd 1<11+102; prepare bs (chainhead);
se w0 0 ; if result not ok then
jl. i15. ; goto alarm;
i9 : am. (j0.) ;
jl +2 ; return ok;
i10: ; error at create wrk-name:
jl. w1 i20. ;
<:create peripheral process wrkname<0>:>
i11: ; error at reserve process wrk-name:
jl. w1 i20. ;
<:reserve process wrkname<0>:>
i12: ; error at transfer:
jd 1<11+64; remove process (wrk name);
al w0 x2 ; w0 := logical status;
al. w3 d47. ; w3 := <:on <devno>:>;
jl. w2 f6. ; typestatus (text, status);
jl. (j0.) ; return (no chain);
i13: ; intervention:
jd 1<11+64; remove process (wrk name);
jl. w1 i20. ;
<:intervention<0>:>
i14: ; error at create peripheral process:
jl. w1 i20. ;
<:create peripheral process documentname<0>:>
i15: ; error at prepare bs:
rl w2 0 ; save (result);
al w3 x3+d61 ;
jd 1<11+64; remove process (doc name.chain buffer);
al w0 x2 ; restore (result);
jl. w1 i20. ;
<:prepare bs<0>:>
i20: ; outerror:
jl. w3 f1. ; typeout (text);
al. w3 d47. ; w3 := <:on <devno>:>;
jl. w2 f5. ; typeresult (text, result);
jl. (j0.) ; return (no chain);
j0: 0 ; return
j1: 5<12+0 ; message: operation
j2: h8 ; first address
j3: 0 ; last address
0 ; always ; segment number
j5: 0, r.5 ; wrkname (+ name table address)
j6: 0 ; repeat count
j7: <:000:> ; mask for converting to letters
j8: 10 ; constant for converting ti digits
j9: 0 ; boolean : prepare bs ; 0: true -1 :false
j10: d48 ; pointer to text
e. ;
; procedure insert all entries
;
; call: w3 = link
; exit: link+0: trouble
; link+2: ok (w3 = chainhead, other regs undef)
b. i30, j20 w.
j0: 0 ; return
j1: 0 ; writeback (0==false, else true)
j2: 0 ; error in segment
j3: h8 ; start of chainhead
j4: 0 ; top segmentno
j5: 0 ; cur segmentno
j6: 8.20000000 ; status: parity
j7: <:segment<0>:>
j8: <:entry deleted<0>:>
j9: <:repair not possible<0>:>
j10: <:insert entry<0>:>
j11: <:entry format (head)<0>:>
j12: <:+0: first slice, keys:<0>:>
j13: <:+2: lower upper base :<0>:>
j14: <:+6: name :<0>:>
j15: <:size trouble - end area at segment<0>:>
j17: 0 ; save w0 (for subroutines)
j18: 0 ; " w1 ( " - " - )
j19: 0 ; " w2 ( " - " - )
j20: 0 ; " w3 ( " - " - )
f23: ; insert all entries:
rs. w3 j0. ; save (return);
al w0 m0 ;
rs. w0 d40. ; modekind := bs;
al w0 0 ;
rs. w0 d41. ; first segment := 0;
rs. w0 j1. ; writeback := false;
rs. w0 j5. ; cur segmentno := 0;
rl. w3 j3. ;
rl w1 x3+d57 ; top segmentno := aux catalogsize;
rs. w1 j4. ;
jl. w3 f15. ; start transfer input;
i2: ; next auxcat segment:
al w0 0 ;
rs. w0 j2. ; error in segment := false;
rx. w0 j1. ; writeback := false;
sn w0 0 ; if writeback was false already then
jl. i5. ; goto read;
; the catalog segment was inconsistent in some way
; the segment must be written back:
rl. w1 d42. ; w1 := current message address;
al. w3 e1. ; w3 := catname;
jl. w2 f12. ; outsegment (name, buffer);
jl. i20. ;+2: trouble: goto alarm;
;comment start the inputoperation again -
; it has been stoped after a read error;
jl. w3 f15. ; start transfer;
i5: ; read:
dl. w2 j5. ; if cur segmentno = top segmentno then
sl w2 (2) ;
jl. i15. ; goto terminate;
;
jl. w3 f9. ; input block;
jl. i21. ;+0: trouble: goto test status;
jl. i17. ;+2: endarea: goto end area error return;
;+4: ok:
i6: ; (and enter here after teststatus = parity)
; w2 = start of buffer
al w1 x2-a88 ; entry := base of buffer;
al w2 x2+510 ; top := top of last entry;
i8: ; next entry:
; w1 = old entry addr
; w2 = top entry
al w1 x1+a88 ; increase (entry);
sl w1 x2 ; if all entries processed then
jl. i16. ; goto increment;
rl w0 x1 ; if empty entry then
sn w0 -1 ;
jl. i8. ; goto next entry;
rl. w0 j2. ; if not error insegment then
se w0 0 ;
jl. i10. ;
jl. w3 i13. ; begin
; normalinsert(result);
jl. i8. ; goto nextentry;
; end;
i10: ;
rl. w0 j1. ; if not writeback then
sn w0 0 ;
jl. i16. ; goto increment;
;comment
; there has been a parity error in the catalog
; segment - contens of segment is perhaps undefined.
; show the entry and try to insert it.
;
jl. w3 i14. ; printentry(entry);
jl. w3 i13. ; normalinsert(result);
se w0 5 ; if result=5 or result=6 then
sn w0 6 ;
jl. i11. ; goto deleteentry;
jl. i8. ; goto nextentry;
i11: al w0 -1 ; importen information in the entry has been
rs w0 x1+d54 ; destroyed - delete it!
;
ds. w2 j19. ;
al. w1 j8. ; typetextline(<:entry deleted:>);
jl. w3 f2. ;
dl. w2 j19. ;
jl. i8. ; goto next entry;
;
;
i16: ; increment:
rl. w1 j5. ; cur segmentno := cursegment + 1;
al w1 x1+1 ;
rs. w1 j5. ;
jl. i2. ; goto next auxcat segment;
;
;
i13: ; normal insert;
ds. w2 j19. ; save regs.
rs. w3 j20. ;
rl. w3 j3. ; insert entry(entry, chainhead);
jd 1<11+104 ;
se w0 0 ; if result=ok or result=maincat not present then
sn w0 7 ; (continue - the chains must be moved to the
; monitor chaintable)
jl. (j20.) ; return;
al. w1 j10. ; typetext(<:insert entry<0>:>);
jl. w3 f1. ;
rl. w1 j18. ;
al w3 x1+d55 ; typeresult(name,result);
jl. w2 f5. ;
dl. w2 j19. ;
jl. (j20.) ;
; return;
;
i14: ; print entry;
ds. w1 j18. ; save regs.
ds. w3 j20. ;
;
al. w1 j11. ; typetextline(<:entry format:>);
jl. w3 f2. ;
al. w1 j12. ; typetext(<:+0: ...:>);
jl. w3 f1. ;
rl. w2 j18. ;
zl w1 x2+d54 ; writeinteger(first slice);
jl. w3 f49. ;
zl w1 x2+d53 ; writeinteger(segmentkey & permkey);
jl. w3 f49. ;
jl. w3 f3. ; typenewline;
;
al. w1 j13. ; typetext(<: base ..:>);
jl. w3 f1. ;
rl. w2 j18. ;
rl w1 x2+d54+2 ; writeinteger(lowerbase);
jl. w3 f49. ;
;
rl w1 x2+d54+4 ; writeinteger(upperbase);
jl. w3 f49. ;
jl. w3 f3. ; typenewline;
;
al. w1 j14. ;
jl. w3 f1. ; typetext(<:name:>;
rl. w2 j18. ;
al w1 x2+d55 ; typetextline(name);
jl. w3 f2. ;
jl. w3 f3. ; typenewline;
;
dl. w1 j18. ; restore regs.
dl. w3 j20. ;
jl x3 ; return;
;
i15: ; terminate:
jl. w3 f17. ; end transfer;
jd 1<11+64; remove process (auxcat);
rl. w3 j3. ; w3 := chainhead start;
am. (j0.) ;
jl +2 ; return ok;
i17: ; end area error:
al. w1 e1. ; writetext(catname);
jl. w3 f1. ;
al. w1 j15. ; writetext(<:size trouble ...:>);
jl. w3 f1. ;
;
rl. w1 j5. ; writeinteger(segmentno);
jl. w3 f49. ;
jl. w3 f3. ; typenewline;
; goto error return;
i18: ; error return;
jl. w3 f17. ; end transfer;
jd 1<11+64; remove process (auxcat);
jl. (j0.) ; error return;
i20: ; error at output catsegment:
al. w1 j9. ;
jl. w3 f2. ; type textline (<:repair not possible:>);
; comment start the input transfer again.
; the parameter has been initialized in
jl. w3 f15. ; 'test status';
; start transfer;
jl. i5. ; goto read;
i21: ;test status;
al. w1 e1. ; writetext(auxcatalogname);
jl. w3 f1. ;
al. w1 j7. ; writetext(<:segment:>);
jl. w3 f1. ;
rl. w1 j5. ;
jl. w3 f49. ; writeinteger(cur segmentno);
jl. w3 f3. ; typenewline;
;
rl. w1 d15. ; if status<>parity then
so. w1 (j6.) ;
jl. i18. ; goto error return;
;
al w0 0 ; clear startup area name to prevent automatic
rs. w0 d49. ; startup after parity error;
al w0 1 ;
rs. w0 j2. ; error insegment := true;
; prepare new start of reading after error;
rl. w2 j5. ;
al w2 x2+1 ; first segment := cur segment + 1;
rs. w2 d41. ;
;
jl. w3 f40. ; testrepair allowed;
jl. i22. ;+0: not allowed: return;
rs. w0 j1. ;+2: allowed: writeback := true;
;
rl. w2 d42. ; get inputbuffer address where bad segment
rl w2 x2+2 ; is stored;
jl. i6. ; return (and try to insert the entries);
;
i22: jl. w3 f15. ; start transfer; (when no write back is possible)
jl. i16. ; goto increment;
;
e. ;
; description of auxcat:
d3: 0 ; bs kind
d4: 0 ; catsize
d5: 0 ; slice length
d6: 0 ; number of slices
d15: 0, r.8 ; answer
d14 = d15 + 2 ; bytes transferred
d17: 0 ; characters
d18: -1 ; cur char
d19: h0 ; start of action table
d20: h1 ; end of action table
d21: 0 ; cur action
d22: 0 ; input buf
d24: h4 ; start of command buf
d25: h5 ; last of command buf
d26: 0 ; cur command
d27: 0 ; top command
d28: h6 ; start of load buf
d29: h7 ; last of load buf
d30: 5<12, h6, h7, 0 ; load buf message
d33: 0 ; input segment
d34: 0 ; max segment
d35: 0 ; checksum
d36: 0 ; initcat switches: writetext (by entry byte0 holds load flag)
d37: 0 ; initcat switches: medium
d49: 0, r.4 ; initcat switches: automatic startup area name
d38: 3<12,0,0,0,0,0 ; message 1
d39: 3<12,0,0,0,0,0 ; message 2
d40: g0 ; modekind (initially: start of initcat)
d41: 0 ; first segment or position
d42: 0 ; current message address
d43: 0 ; device number
d44: 0 ; repair allowed ( 0==false, else true)
d45: b118 ; address of integer just read
d46: b119 ; address of name just read
e1: 0, r.5 ; auxcatname or devicename
e2: 0, r.5 ; document name
e9: <:input sumerror<0>:>
e11: <:input sizeerror<0>:>
e13: <:syntax error<0>:>
; stepping stones:
jl. d0. , d0 = k-2
jl. f0. , f0 = k-2
jl. f1. , f1 = k-2
jl. f2. , f2 = k-2
jl. f3. , f3 = k-2
jl. f5. , f5 = k-2
jl. f6. , f6 = k-2
jl. f8. , f8 = k-2
jl. f12. , f12 = k-2
jl. f15. , f15 = k-2
jl. f17. , f17 = k-2
jl. f21. , f21 = k-2
jl. f22. , f22 = k-2
; procedure dismount kit
;
; search through the chaintables to find a possible chaintable connected to
; the current device.
; if found then remove chaintable etc
;
; call: w3 = link
; exit: link+0: error, all regs undef
; link+2: ok , all regs undef
b. i20, j10 w.
j0: 0 ; return
j1: 0, r.4 ; docname to be removed
j5: <:delete bs<0>:>
j7: <:delete entries<0>:>
f24: ; dismount kit:
rl. w0 d43. ; w0 := device number;
ls w0 1 ;
wa w0 b4 ; w0 := name table address of device;
rl w1 b22 ; entry := first chain in nametable;
al w1 x1-2 ;
i1: ; next chain:
al w1 x1+2 ; increase (entry);
sn w1 (b24) ; if all chaintables tested then
jl x3+2 ; return ok; (i.e. not found)
rl w2 x1 ; chain := nametable (entry);
se w0 (x2+d61+8-a88); if document name table address.chain <> w0 then
jl. i1. ; goto next chain;
dl w1 x2+d61+2-a88;
ds. w1 j1.+2 ; move docname.chain;
dl w1 x2+d61+6-a88;
ds. w1 j1.+6 ;
rs. w3 j0. ; save (return);
sn w2 (b25) ; if maincat on document then
jd 1<11+114; remove main catalog;
al. w2 j1. ;
jd 1<11+108; delete backing storage (docname);
se w0 0 ; if result not ok then
jl. i10. ; goto alarm;
i5: ; rep:
jd 1<11+110; delete entries (docname);
sn w0 3 ; if not all entries deleted then
jl. i5. ; goto rep;
se w0 0 ; if result not ok then
jl. i11. ; goto alarm;
jl x3+2 ; return ok;
i10: ; error at delete bs:
sn w0 2 ; if result = catalog io-error then
jl. i5. ; goto rep;
am j5-j7 ; text := <:delete bs:>
i11: ; error at delete entries:
al. w1 j7. ; text := <:delete entries:>;
i15: ; typeout:
jl. w3 f1. ; typeout (text);
al. w3 j1. ;
jl. w2 f5. ; typeresult (docname, result);
jl. (j0.) ; error return;
e. ;
; procedure mount main catalog
;
; call: w3 = link
; exit: link+0: error , all regs undef
; +2: ok , all regs undef
b. i30, j20 w.
j0: 0 ; return
j1: h8 ; start of chainhead buffer
j2: 0, r.4 ; wrk-name
j3: <:remove aux entry<0>:>
j5: <:connect main catalog<0>:>
j7: <:main catalog not defined<0>:>
j9: <:create aux entry<0>:>
j11: <:no main catalog connected<0>:>
f25: ; mount maincat:
rs. w3 j0. ; save (return);
i0: ; try again:
al. w3 e1. ;
jd 1<11+10; release process (aux catalog);
rl. w2 d10. ; w2 := preferred size of maincat;
rl. w3 j1. ; w3 := chainhead;
al. w1 d9. ; w1 := maincat name;
jd 1<11+112; connect main catalog (chainhead, maincat name);
al w3 x1 ; w3 := maincat name;
se w0 0 ; if result not ok then
jl. i10. ; goto test create;
; maincat was connected, but has it the rigth size
sh w2 0 ; if preferred size undefined then
jl. i30. ; goto return ok; (i.e. accept any size)
; maincat exists, but a specific size was wanted
jd 1<11+4 ; w0 := proc descr (maincat area process);
am (0) ; if areaproces.size = wanted size
se w2 (+a61) ;
jl. i1. ; and
am (0) ; areaprocess.noofkeys = wanted noofkeys then
zl w2 +a58 ;
sn. w2 (d12.) ;
jl. i30. ; goto ok return;
i1:
; another size was wanted
jd 1<11+114; remove main catalog;
al. w3 e1. ; remove process (aux catalog);
jd 1<11+64;
rl. w2 j1. ;
al w2 x2+d61 ; w2 := docname.chainhead;
al. w1 d8. ; w1 := maincat entry;
jd 1<11+122; remove aux entry (docname, entry);
se w0 0 ; if result not ok then
jl. i15. ; goto alarm;
i5: ; clean up:
jl. w3 f24. ; dismount kit; (i.e. release all chains)
jl. i20. ;+2: error: goto error exit;
jl. w3 f21. ; read chain;
jl. i20. ;+2: error: goto error exit;
jl. i0. ; goto try again;
i10: ; test create:
se w0 3 ; if neither unknown nor already exist then
jl. i17. ; goto alarm;
; it will be assumed that the entry did'nt exist in auxcat
sh w2 0 ; if preferred size not defined then
jl. i18. ; goto alarm;
; before a maincat can be created, all chains on the document must
; be transferred
; the auxcat areaprocess has been released.
; in order to be able to repair the auxcat during the
; following cat-scan, the auxcat must be reserved again.
; this may be done by means of a call of ..prepare bs..
al. w3 e1. ;
jd 1<11+64; remove process (auxcat);
jl. w3 f24. ; dismount kit;
jl. i20. ;+2: error: goto error exit;
jl. w3 f21. ; read chain;
jl. i20. ;+2: error: goto error exit;
jl. w3 f23. ; insert all entries; (i.e. all chains)
jl. i20. ;+2: error: goto error exit;
jd 1<11+36; w0w1 := get clock;
ld w1 5 ; w0 := shortclock;
al. w1 d8. ; w1 := maincat entry;
rs w0 x1+d11-d8 ; save shortclock in tail;
rl. w2 j1. ;
al w2 x2+d61 ; w2 := docname.chainhead;
al w0 0 ;
al. w3 j2. ; w3 := wrkname area;
rs w0 x3 ; (clear first word of name);
jd 1<11+120; create aux entry and area process;
se w0 0 ; if result not ok then
jl. i19. ; goto alarm;
jd 1<11+64; remove process (aux area process);
jl. i5. ; goto clean up;
i15: ; error at remove aux entry:
am j3-j5 ; text := <:remove aux entry:>;
i17: ; error at connect main catalog:
am j5-j9 ; text := <:connect main catalog:>;
i19: ; error at create main catalog:
al. w1 j9. ; text := <:create aux entry:>;
i16: ; typeout:
jl. w3 f1. ; typeout (text);
al. w3 d9. ; w3 := main cat name;
jl. w2 f5. ; typeresult (maincat name, result);
jl. i20. ; goto error exit;
i18: ; size of main cat not defined:
al. w1 j7. ; type textline (<:maincatalog not defined:>);
jl. w3 f2. ;
i20: ; error exit:
al. w1 j11. ; type textline (<:no maincat connected:>);
jl. w3 f2. ;
al. w3 e1. ;
jd 1<11+64; remove process (aux catalog);
jl. (j0.) ; error return;
i30: ; return ok:
am. (j0.) ;
jl +2 ; return ok;
e. ;
; procedure get bskind
;
; call: w3 = link
; exit: all regs undef
; error exit: syntax alarm
b. i10, j10 w.
j0: ; start of table
<:fast:>, 0 ;
<:slow:>, 1 ;
j1: ; top of table
j2 = 6 ; size of entry
f29: ; get bskind:
am. (d46.) ;
dl w1 +2 ; w0w1 := two first word of name;
al. w2 j0.-j2 ; entry := base of kind-table;
i0: ; next kind:
al w2 x2+j2 ; increase (entry);
sn. w2 j1. ; if all kinds tested then
jl. f30. ; goto syntax alarm;
sn w0 (x2+0) ;
se w1 (x2+2) ; if name <> kindname.entry then
jl. i0. ; goto next kind;
rl w0 x2+4 ; bskind := kind.entry;
rs. w0 d3. ;
jl x3 ; return;
e. ;
; stepping stones
jl. f12. , f12 = k-2
f30: jl. (2),b115; goto syntax error;
f31: jl. (2),b116; goto next command;
f32: jl. (2),b117; goto exam command;
f33: jl. (2),b112; call next param;
f34: jl. (2),b113; call next name;
f35: jl. (2),b114; call next integer;
f41: jl. (2),b121; call init write;
f42: jl. (2),b122; call write char;
f43: jl. (2),b123; call write text;
f44: jl. (2),b124; call type line;
f45: jl. (2),b125; call save work;
f46: jl. (2),b133; call connect;
f47: jl. (2),b129; goto catalog error;
f48: jl. (2),b130; call stack input;
f49: jl. (2),b131; call write integer;
f50: jl. (2),b134; call linkall;
f51: jl. (2),b137; call read segment;
f52: jl. (2),b138; call write segment;
f53: jl. (2),b140; call writebits;
f55: jl. (2),b143; call change writemode
f58: jl. (2),b150; call prepare dump
f60: jl. (2),b153; call initialize main
; procedure read name
;
; call: w2 = name address, w3 = link
; exit: all regs undef
f36: ; read name:
al w1 x3 ;
jl. w3 f34. ; next name;
al w3 x1 ;
; procedure move name
;
; call: w2 = name address, w3 = link
; exit: w0w1 = undef, w2w3 = unchanged
f37: ; move name:
am. (d46.) ;
dl w1 +2 ; move name just read to name-area;
ds w1 x2+2 ;
am. (d46.) ;
dl w1 +6 ;
ds w1 x2+6 ;
jl x3 ; return;
; procedure move catname,docname from chainbuffer
;
; call: w3 = link
; exit: all regs undef
b. j10 w.
f38: ; move catname,docname from chainbuffer:
rl. w2 j2. ; w2 := first of chainbuffer;
dl w1 x2+d61+2 ;
ds. w1 e2.+2 ; move docname from chainbuffer;
dl w1 x2+d61+6 ;
ds. w1 e2.+6 ;
dl w1 x2+d55+2 ;
ds. w1 e1.+2 ; move catname from chainbuffer;
dl w1 x2+d55+6 ;
ds. w1 e1.+6 ;
jl x3 ; return;
; procedure move catname,docname to chainbuffer
;
; call: w3 = link
; exit: all regs undef
f39: ; move catname etc to chainbuffer:
rl. w2 j2. ; w2 := first of chainbuffer;
dl. w1 e2.+2 ; if docname(0) not defined then
sn w0 -1 ;
jl x3 ; return;
ds w1 x2+d61+2 ; move docname to chainhead;
dl. w1 e2.+6 ;
ds w1 x2+d61+6 ;
dl. w1 e1.+2 ; move catname to chainhead;
ds w1 x2+d55+2 ;
dl. w1 e1.+6 ;
ds w1 x2+d55+6 ;
rl. w1 d3. ;
ls w1 3 ; if bskind defined then
al w1 x1+a110 ; kind.chainhead := bskind;
sl w1 0 ; permkey.chainhead := max cat key;
hs w1 x2+d53 ;
jl x3 ; return;
j2: h8 ; first of chainbuffer
e. ;
; procedure test repair allowed
;
; call: w3 = link
; exit: link+0: not allowed, all regs undef
; +2: allowed , w0 = undef, other regs unchanged
b. j10 w.
f40: ; test repair allowed:
rl. w0 d44. ;
se w0 0 ; if repair was allowed then
jl x3+2 ; return ok;
jl. w1 f2. ; type textline... and return;
<:auxcat to be repaired<0>:>
e. ;
; procedure save memory buffer(segment, name);
; writes the buffer specified in the message (e44) to the area specified
; by name.
;
; call return
; w0 segment # destroyed
; w1 - destroyed
; w2 name addr destroyed
; w3 link destroyed
;
b. i10 w.
f56: ; save memory buffer
rs. w3 i3. ;
rl. w1 i4. ; message.segment := segment;
rs w0 x1+6 ;
rl. w3 i5. ;
dl w1 x2+2 ; receiver.name := name;
ds w1 x3+2 ;
dl w1 x2+6 ;
ds w1 x3+6 ;
jd 1<11+52 ; create area process(name);
jd 1<11+8 ; reserve process(name);
rl. w1 i4. ;
jd 1<11+16 ; send message;
rl. w1 i6. ;
jd 1<11+18 ; wait answer;
jd 1<11+64 ; remove process;
jl. (i3.) ; (iggnore all error status)
; return;
i3: 0 ; saved return
i4: b145 ; e44, pointer to message
i5: b146 ; e40, pointer to name (receiver)
i6: b147 ; e32, pointer to answer area
;
e.
; stepping stones
jl. f0. , f0 = k-2
jl. f1. , f1 = k-2
jl. f2. , f2 = k-2
jl. f3. , f3 = k-2
jl. f5. , f5 = k-2
\f
; *********************************************
; *********************************************
; ** **
; ** main control of monitor initialization **
; ** **
; *********************************************
; *********************************************
b. i15, j10 w.
; initialize catalog system
g0: ;
al w0 0 ;
jl. w3 f55. ; change write mode(terminal);
am (b4) ;
rl w1 +a199<1 ;
rs. w1 (i1.) ; save main console;
;
jl. w3 f57. ; link dlc/ioc main
rl. w0 d36. ;
se w0 0 ; if diskload then
jl. w3 (i2.) ; autoload device controllers;
;
;
rl. w0 d36. ;
sn w0 0 ; if not diskload then
jl. w3 (i4.) ; load ida-ifp;
;
sn w0 0 ; if not diskload then
rs. w0 d49. ; startarea := 0;
;
jl. w3 (i3.) ; start device controllers;
;
rl. w1 (i1.) ;
rl w3 x1+a10 ; if main console.kind <> perm link and
; console.kind <> csp_terminal then
dl. w2 (i5.) ; change write mode(memory, buf.start, buf.top);
rx w2 2 ;
al w1 x1-2 ;
al w0 1 ;
se w3 84 ;
sn w3 8 ;
sz ;
jl. w3 f55. ;
;
rl. w1 i6. ;
jl. w3 f2. ; type text(mon release);
rl. w1 i7. ;
jl. w3 f2. ; type text(mon version);
rl. w1 i8. ;
jl. w3 f2. ; type text(mon options);
rl. w0 d49. ;
rl. w1 i9. ;
sn w0 0 ; if no start area then
jl. w3 f2. ; type text(date note);
;
jl. w3 g11. ; automatic oldcat;
;
rl. w0 (i10.) ;
sn w0 0 ; if write mode = memory then
jl. j1. ; begin
;
al w0 25 ;
jl. w3 f0. ; write char(em);
rl. w0 (i14.) ;
rl. w2 i13. ; message.last address := top of write buffer;
rs w0 x2+4 ;
al w0 0 ;
rl. w2 i11. ; save memory buffer(0, s log area);
jl. w3 f56. ;
al w0 0 ;
jl. w3 f55. ; change write mode(terminal);
; end;
j1: dl. w1 i12. ;
al. w2 d49. ;
rl w3 x2+0 ; if start area <> 0 then
se w3 0 ; stack input(catalog base, name);
jl. w3 f48. ;
jl. f31. ; goto next command;
;
i1: b132 ; e90 ; terminal address
i2: f19 ; autoload device controllers
i3: f20 ; start device controllers
i4: f18 ; load ida-ifp controllers
i5: b142 ; e17 ; pointer to address of memory buffer
i6: e19 ; addr of mon release text
i7: e20 ; addr of mon version text
i8: e21 ; addr of mon options text
i9: e18 ; addr of date note text
i10: b144 ; e53 ; address of write mode
i11: b148 ; c36 ; address of s log area name
a107 ;
i12: a108-1 ; max catalog base
i13: b145 ; e44 ; output message
i14: b149 ; e42 ; top of write buffer
;
e.
; ************************************************
; ************************************************
\f
; command syntax: clearcat
b. i10, j10 w.
g40: ; clearcat:
rl w2 b22 ; entry := first chain in name table;
jl. i3. ; (skip)
i1: ; next chain:
rl. w2 j1. ; restore (entry);
i2: al w2 x2+2 ; increase (entry);
i3: sn w2 (b24) ; if all chains tested then
jl. f31. ; goto next command;
rl w3 x2+0 ; chain := name table (entry);
rl w0 x3+d61-a88;
sn w0 0 ; if docname(0) = 0 then
jl. i2. ; goto next chain;
rs. w2 j1. ; save (entry);
rl w1 x3+d61+8-a88; devno := (document name table address.chain
ws w1 b4 ; - first device in name table )
ls w1 -1 ; / 2 ;
rs. w1 d43. ;
jl. w3 f24. ; dismount kit;
jl. i1. ;+2: error: goto next chain;
;
; note : the following is done tomakeit possible to load a
; monitor version older than 9.0 where the chainhead field
; "no of keys " is used to hold first slice of chaintable chain.
; always 0. the following code can be removed in a later release.
;
al w0 -1 ;
rs. w0 e2. ; docname unchanged
jl. w3 f26. ; read chain
jl. i1. ;+2 error : goto next chain
rl w2 x3+d57 ;
sl w2 513 ; if size.catalog <= 512 then
jl. i1. ;
al w0 0 ; noof keys := 0
hs w0 x3+d67 ; (previous first slice of chain )
al w0 -17 ; new drum disc bit mask (see m38 in p fnc2)
la w0 x3+d53 ; chainkind := new chainkind excluded
hs w0 x3+d53 ; new chainkind bit;
al w0 -1 ;
rs. w0 e2. ; docname unchanged
jl. w3 f27. ; write chain
jl. i1. ;+2 error : goto next chain
jl. i1. ; goto next chain;
j1: 0 ; cur entry for chain
e. ;
; command syntax: nokit <device number>
g41: ; nokit:
jl. w3 f35. ; devno :=
rs. w0 d43. ; next integer;
jl. w3 f24. ; dismount kit;
jl. f31. ;+2: error: goto next command;
jl. f31. ; goto next command;
; command syntax: maincat <maincat name> <maincat size>
; or: maincat <maincat name> <partitions> <no of keys>
b. i10, j10 w.
g42: ; maincat:
rl. w2 j9. ; maincatname :=
jl. w3 f36. ; readname;
jl. w3 f35. ; first integer := next integer;
rs. w0 j1. ;
jl. w3 f33. ; type := nextparam;
rs. w0 j4. ;
se w0 2 ; if type = integer then
jl. i1. ; begin comment no of partitions and no of keys;
rl. w0 j1. ; if noofpart <= 0 then
sh w0 0 ;
jl. i4. ; goto number error;
rl. w0 (d45.) ;
rs. w0 j3. ; noofkeys := nextinteger;
;
sh w0 0 ; if noofkeys < 1 or
jl. i4. ;
sl w0 513 ; noofkeys > 512 then
jl. i4. ; goto number error;
;
rl. w1 j1. ; size := noofkeys * first integer;
wm w0 2 ;
rs. w0 j1. ;
rs. w1 j2. ; noofparti := first integer;
jl. i2. ; end else
;
i1: rl. w0 j1. ; begin
; comment size have been given;
sh w0 0 ; if size <= 0 then
jl. i4. ; goto number error;
rl w1 0 ;
;
ls w1 -9 ;
ea. w1 1 ; noofpart := (size//512) + 1;
so w1 2.1 ; if mod(noofpart,2) = 0 then
ea. w1 1 ; noofpart := noofpart + 1;
rs. w1 j2. ;
;
al w3 0 ; noofkeys := size//noofpart;
rl. w0 j1. ;
wd w0 2 ;
rs. w0 j3. ;
;
wm w0 2 ; size := noofkeys * noofpart;
rs. w0 j1. ; end;
;
;comment type maincatalog size information;
i2: ;
rl. w1 j9. ; writetext(catalogname);
jl. w3 f43. ;
al. w1 j5. ; writetext(<:size:>);
jl. w3 f43. ;
rl. w1 j1. ; writeinteger(size);
jl. w3 f49. ;
;
al. w1 j6. ; writetext(<:partitions:>);
jl. w3 f43. ;
rl. w1 j2. ; writeinteger(noofpart);
jl. w3 f49. ;
;
al. w1 j7. ; writetext(<:keys:>);
jl. w3 f43. ;
rl. w1 j3. ; writeinteger(noofkeys);
jl. w3 f49. ;
jl. w3 f3. ; typenewline;
;
rl. w2 j9. ;
rl. w0 j3. ;
hs w0 x2+d12-d9+1; save noofkeys in maincatalog;
rl. w0 j1. ;
rs w0 x2+d10-d9 ; save size of maincat in maincat;
;
i3: rl. w0 j4. ; if type = integer then
sn w0 2 ; goto next command
jl. f31. ;
jl. f32. ; else goto exam command;
;
i4: ; number error:
rs. w0 j1. ; save erroneous number
al. w1 j10. ; writetext(<:erroneous number::>);
jl. w3 f43. ;
rl. w1 j1. ; writeinteger(number);
jl. w3 f49. ;
jl. w3 f3. ; typetextline;
jl. i3. ; goto return;
;
;
j1: 0 ; first integer
j2: 0 ; no of partitions
j3: 0 ; no of keys
j4: 0 ; type
j5: <: size:<0>:>
j6: <: partitions:<0>:>
j7: <: keys:<0>:>
j9: d9 ; maincatalog name address
j10: <:erroneous number:<0>:>
e. ;
; command syntax: oldcat
b. i10, j15 w.
; oldcat action:
g48: ; oldcat-command:
al. w3 f31. ; return := next command;
g11: ; automatic oldcat:
rs. w3 j6. ; save (return);
rl. w0 j7. ;
rs. w0 j9. ; number index := first bs device;
al. w0 i0. ;
rs. w0 j10. ; read action := get next from list;
jl. i1. ; goto next kitnumber;
i0: ; get next from list:
rl. w1 j9. ; if number index = top of list then
sn. w1 (j8.) ;
jl. (j6.) ; return;
rl w0 x1 ;
rs. w0 (d45.) ; param := device number (number index);
al w1 x1+2 ; increase (number index);
rs. w1 j9. ;
rl w1 0 ;
ls w1 +1 ;
wa w1 b4 ;
sl w1 (b4) ; if devno not within external then
sl w1 (b5) ; skip it and goto get next from list;
jl. i0. ;
rl w1 x1 ;
rl w2 x1+a10 ; if device(devno).kind = idamain then
se w2 20 ; begin
jl. i3. ;
al w1 x1+a11 ;
al. w2 j5. ;
jl. w3 f46. ; connect(idamain,param);
am j14 ; +0: if error then text := <:connect error:>
al. w1 j12. ; +2: else text := <:disc 0 0 connected to:>;
rs. w0 j13. ; <*save logical status*>
jl. w3 f43. ; write(text);
rl. w0 j13. ;
se w0 1<1 ;
am -4 ;
rl w1 4 ;
se w0 1<1 ; if logical status <> ok then
am f53-f49; writebits(logical status)
jl. w3 f49. ; else writeinteger(devno);
al w0 10 ;
jl. w3 f0. ; type char(nl);
rl. w0 j13. ;
se w0 1<1 ; if connect status <> ok then
jl. i0. ; goto get next from list;
al w0 x2 ;
jl. w3 f50. ; linkall(devno);
c.(:a399>21a.1:)-1
jl. w3 f59. ; initial_preparedump;
z.
jl. i0. ; goto get next from list;
; end
i3: ; else begin
al w0 2 ; param kind := integer;
jl. i5. ; return to kit;
; command syntax: kit <docname> (<auxcatname> (<kind>)) <device number>
; or: kit (<device number>)*
; g47 entrypoint used from resident linkall command
; at entry: w2: devno
; w3: link
g47:
rs. w2 (d45.) ; kit: 2nd entry point
rs. w3 j10. ;
al w0 -1 ;
rs. w0 e2. ; docname := unchanged;
rs. w0 d3. ; bskind := unchanged;
al w0 2 ; param.kind := integer;
jl. i5. ; goto test;
g43: ; kit:
al. w3 f33. ; read action := next param;
rs. w3 j10. ;
al w0 -1 ;
rs. w0 e2. ; docname := unchanged;
rs. w0 d3. ; bskind := unchanged;
jl. w3 f33. ; next param;
se w0 1 ; if kind <> name then
jl. i5. ; goto test;
al. w2 e2. ; docname := name;
jl. w3 f37. ;
rl. w0 j0. ; (prepare no auxcatname parameter)
rs. w0 e1. ;
al. w2 e1.+2 ; auxcatname := <:cat:> + docname;
jl. w3 f37. ;
jl. w3 f33. ; next param;
se w0 1 ; if kind <> name then
jl. i5. ; goto test;
al. w2 e1. ; auxcatname := name;
jl. w3 f37. ;
jl. w3 f33. ; next param;
se w0 1 ; if kind <> name then
jl. i5. ; goto test;
jl. w3 f29. ; get bskind;
jl. i2. ; goto get devno;
i1: ; next kitnumber:
al w0 -1 ;
rs. w0 e2. ; docname := unchanged;
rs. w0 d3. ; bskind := unchanged;
i2: ; get devno:
jl. w3 (j10.) ; next param;
i5: ; test:
se w0 2 ; if kind <> integer then
jl. f32. ; goto exam command;
rl. w0 (d45.) ; devno :=
rs. w0 d43. ; param;
jl. w3 f21. ; read chain;
jl. i1. ;+2: error: goto next kitnumber;
; w3 = chainhead address
dl w1 x3+d61+2 ; outtextline ( <docname> mounted on <devno>);
lo. w0 j1. ;
lo. w1 j1. ;
ds. w1 j3. ;
dl w1 x3+d61+6 ;
lo. w0 j1. ;
lo. w1 j1. ;
ds. w1 j4. ;
al. w1 j2. ;
jl. w3 f2. ;
rl w0 b25 ; if no maincat yet then
se w0 0 ;
jl. i8. ; begin
jl. w3 f25. ; mount maincat;
jl. f47. ;+2: error: goto catalog error;
i8: ; end;
jl. w3 f23. ; insert all entries;
jl. i1. ;+2: error: goto next kitnumber;
; w3 = chainhead address
al w2 x3+d61 ;
jd 1<11+106; insert bs (docname.chainhead);
sn w0 0 ; if result ok then
jl. i1. ; goto next kitnumber;
al. w2 i1. ; typeresult ( <:insert bs:>, result);
jl. w3 f5. ; goto next kitnumber;
<:insert bs <0>:> ;
j0: <:cat:> ; standard start of cat-name
j1: <: :> ; spaces for converting text to fixed length
j2: 0, r.4 ; text: <docname>
j3=j2+2 ;
j4=j2+6 ;
<: mounted :> ;
d47: <:on :> ;
d48: 0, r.3 ; <device number as text>
0 ; (end of text)
j6: 0 ; return from oldcat
j7: d1 ; start of device number list for oldcat
j8: d2 ; top of device number list
j9: 0 ; number index
j10: 0 ; address of read action
j5: ; connect param area
0 ; control module
0 ; slave unit
b136 ; devno of connection
h. 6, 0 w. ; disc kind=6, irr
5 ; max outstanding operation
j11: <:createlink error<0>:>
j12: <:first physical disc linked to<0>:>
j13: 0
j14 = j11 - j12
e. ;
; command syntax: kitlabel <devno> <docname> <auxcatname> <bskind> ,
; <catsize> <slicelength> (<number of slices> )
b. i10, j10 w.
g44: ; kitlabel:
jl. w3 f35. ; device number := next integer;
rs. w0 d43. ;
rl. w0 (d45.) ;
rs. w0 d43. ; device number := param;
al. w2 e2. ; docname := read name;
jl. w3 f36. ;
al. w2 e1. ; auxcatname := read name;
jl. w3 f36. ;
jl. w3 f35. ; catsize := next integer;
rs. w0 d4. ;
jl. w3 f35. ; slicelength := next integer;
rs. w0 d5. ;
jl. w3 f33. ; next param;
rs. w0 j4. ; save kind := kind;
; if next param = integer then no of slices has been defined
; compute max number of slices.
al w3 1 ;
rs. w3 d3. ; bskind:=disc;
rl. w3 d43. ;
ls w3 +1 ; disc := nametable(devno);
wa w3 b4 ;
sl w3 (b4) ; if disc within external then
sl w3 (b5) ; begin
jl. i6. ;
rl w3 x3 ;
rs. w3 j1. ;
rl w1 x3+a74 ; number of slices :=
al w0 0 ; disc.no of segments // slicelength;
wd. w1 d5. ;
rs. w1 d6. ;
rl. w0 j4. ; if savekind = integer and
se w0 2 ; integer > 0 and
jl. i9. ; integer < number of slices then
rl. w1 (d45.) ; number of slices := integer;
sl w1 0 ;
sl. w1 (d6.) ;
rl. w1 d6. ;
rs. w1 d6. ;
i9: ;
sh w1 2046 ; if number of slices > max number of slices then
jl. i7. ; begin
al. w3 i0. ; write(:<slicelength...:>);
jl. w1 f2. ; goto next label;
<:slicelength too small<0>:>
; end;
i6: ; end else
al. w3 i0. ; begin
jl. w1 f2. ; typetextline(<:illegal devno:>);
<:illegal devno<0>:> ; goto next label;
; end;
i7: ;
; notice: if the device is already included in the bs-system, it will
; not automaticly be dismounted
rl. w3 j0. ; w3 := start of chainhead buffer;
; move:
rl. w1 d4. ; auxcat size
rs w1 x3+d57 ;
rl. w1 d5. ; slice length
rs w1 x3+d64 ;
rl. w1 d6. ; last slice
al w1 x1-1 ; (= number of slices - 1)
hs w1 x3+d66 ;
al w1 x1+a88+1+511; first slice of aux catalog
ls w1 -9 ;
al w0 0 ; ( = (size of chainhead + number of slices)
wd w1 x3+d64 ; / slice length )
se w0 0 ;
al w1 x1+1 ; (rounded up to an integral number of slices))
hs w1 x3+d54 ;
al w1 0 ; first slice in chaintable
hs w1 x3+d67 ; (= 0)
; setup chains for the whole chaintable etc
al w0 1 ;
bz w1 x3+d66 ; w1 := last slice number;
i5: ; next slice:
am x3+a88 ;
hs w0 x1 ; slice (w1) := 1;
al w1 x1-1 ; decrease (w1);
sl w1 0 ; if not all slices initialized then
jl. i5. ; goto next slice;
jl. w3 f22. ; write chain;
jl. i0. ;+2: error: goto next label;
; clear auxcat
rl. w1 d29. ; w1 := last of load buffer;
rl. w2 d28. ; w2 := first of load buffer;
am -2048 ;
jl. w3 f11.+2048; clear (from, to);
al w0 0 ; last word of buffer := 0;
rs w0 x1 ;
al. w1 d30. ; w1 := load buffer message;
rs w0 x1+6 ; segment.message := 0;
al. w3 e1. ; name := auxcat name;
i8: ; next segment:
jl. w2 f12. ; outsegment (auxcat, buffer);
jl. i10. ;+2: trouble: goto dismount;
rl w0 x1+6 ; w0 := segment number of message;
se. w0 (d4.) ; if segment.message <> auxcat size then
jl. i8. ; goto next segment;
jd 1<11+64; remove process (aux catalog);
rl. w1 j1. ;
rl w0 x1+a10 ; if disc = idadisc and
se w0 6 ; disc.type = logical then
jl. i0. ; begin
zl w0 x1+a57 ;
so w0 2.01 ;
jl. i0. ;
;
rl w1 x1+a50 ; for autodisc := disc.main.next logical disc, next do
i1: rl w1 x1+a70 ; if autodisc = 0 then
sn w1 0 ; goto next label
jl. i0. ; else
rl w0 x1+a73 ; if autodisc.first segment = 0 then
se w0 0 ; goto found0;
jl. i1. ;
; found0:
rl w2 b4 ; for external := first external, next do
i2: sn w2 (b5) ; if external = area then
jl. i0. ; goto next label
rl w3 x2 ; else
sn w3 x1 ; if external = autodisc then
jl. i3. ; goto found1;
al w2 x2+2 ;
jl. i2. ;
; found1:
i3: ws w2 b4 ; devno of autodisc :=
ls w2 -1 ; (nametable(autodisc) - nametablestart) / 2;
rs. w2 j2. ;
;
al w1 x2 ;
al w0 0 ;
jl. w3 f51. ; read segment(autodisc.devno, 0);
jl. i0. ; +0: if error then goto next label;
; +2:
rl. w1 j3. ; pointer :=
rl w2 x1+0 ; (buffer.no of file * 2 + 1) * 2;
ls w2 +1 ;
al w2 x2+1 ;
ls w2 +1 ; pointer :=
am x1 ; pointer + buffer start + 2;
al w2 x2+2 ; <*skip no of logical disc*>
al w1 x1+512 ; if pointer outside buffer then goto next label;
sl. w2 (j3.) ; <*uninitialized buffer*>
sl w2 x1 ;
jl. i0. ;
zl w1 x2-2 ; size := buffer(pointer - 2);
rs. w1 j5. ;
;
rl. w1 j1. ;
sz ;
i4: wa. w2 j5. ; for descr := buffer(pointer) step descr size do
dl w0 x2+2 ; begin
sn w3 -1 ;
jl. i0. ; if descr.first segment = -1 then
; goto next label;
sn w3 (x1+a73) ; if descr.first segment = disc.first segment and
se w0 (x1+a74) ; descr.no of segments= disc.no of segments then
jl. i4. ; begin
;
al w0 2.010 ; descr.type := descr.type or with catalog;
ls w0 +12 ;
lo w0 x2+4 ;
rs w0 x2+4 ;
al w0 0 ;
rl. w1 j2. ;
jl. w3 f52. ; write segment(autodisc.devno, 0);
jl. i0. ; +0:
; +2:
; end;
; end;
; end *** ida disc ***;
jl. i0. ; goto next label;
i10: ; dismount:
jd 1<11+64; remove process (aux catalog);
jl. w3 f24. ; dismount kit;
jl. i0. ;+2: error: goto next label;
i0: ; next label: <*next command!!*>
rl. w0 j4. ; if saved kind <> integer then
se w0 2 ; examine command
jl. f32. ; else
jl. f31. ; next command;
j0: h8 ; start of chainhead
j1: 0 ; disc process address
j2: 0 ; devno of autodisc
j3: b139 ; start of disc description buffer
j4: 0 ; kind of next param
j5: 0 ; size of log disc description
e. ;
jl. f60. , f60= k-2 ; stepping stone
; command syntax: repair
g45: ; repair:
al w0 -1 ; repair allowed := true;
rs. w0 d44. ;
jl. f31. ; goto next command;
; command syntax: auxclear (<bskind>) <device number> (<lower> <upper> <name>)*
b. i10, j10 w.
g49: ; auxclear:
al. w3 e1. ;
jd 1<11+68; get wrk-name (auxcat name);
al. w3 e2. ;
jd 1<11+68; get wrk-name (docname);
al w0 -1 ;
rs. w0 d3. ; bskind := unchanged;
jl. w3 f33. ; next param;
se w0 1 ; if kind = name then
jl. i1. ; begin
jl. w3 f29. ; get bskind;
jl. w3 f33. ; next param;
i1: ; end;
se w0 2 ; if kind <> integer then
jl. f30. ; goto syntax error;
rl. w0 (d45.) ;
rs. w0 d43. ; devno := integer;
jl. w3 f21. ; read chain;
jl. f30. ;+2: error: goto syntax (or better: goto ready);
al w3 x3+d55 ;
jd 1<11+64; remove process (aux cat);
i3: ; next entry:
jl. w3 f33. ; next param;
se w0 2 ; if kind <> integer then
jl. i9. ; goto dismount;
rl. w0 (d45.) ;
rs. w0 j1. ; lower interval := param;
jl. w3 f35. ;
rs. w0 j2. ; upper interval := next integer;
al. w2 j3. ; entry name :=
jl. w3 f36. ; read name;
al. w1 j0. ; w1 := entry;
al. w2 e2. ; w2 := docname;
jd 1<11+122; remove aux entry (entry, docname);
sn w0 0 ; if result ok then
jl. i3. ; goto next entry;
al. w1 j5. ;
jl. w3 f1. ; typeout (<:remove aux entry:>);
al. w3 j2. ; w3 := entry name;
jl. w2 f5. ; typeresult (result, entry name);
jl. i3. ; goto next entry;
i9: ; dismount:
jl. w3 f24. ; dismount kit;
jl. f32. ;+2: error: goto exam command;
jl. f32. ; goto exam command;
j0 = k-2 ; entry:
j1: 0 ; lower interval
j2: 0 ; upper interval
j3: 0, r.4 ; entry name
j5: <:remove aux entry<0>:>
e. ;
; command syntax: binin <modekind> <docname> (<position>)*
b. i10, j21 w.
m. binin included
g46: ; binin:
jl. w3 f34. ; next name;
rl. w3 d46. ;
dl w0 x3+2 ; w3w0 := parameter;
jl. i9. ; goto search modekind
i0:
; w2 = entry in mode-table
rl w3 x2+j4 ; modekind := table-contents;
rs. w3 d40. ;
al. w2 e1. ; device name := read name;
jl. w3 f36. ;
jl. w3 f35. ; position := next integer;
jl. g13. ; goto initialize input;
i5: ; modekind illegal:
al. w1 j8. ; type textline (<:modekind illegal:>);
jl. w3 f2. ;
jl. f31. ; goto next command;
g54: ; end:
jl. w3 f17. ; end transfer;
jl. w3 f33. ; next param;
se w0 2 ; if kind <> integer then
jl. f32. ; goto exam command;
rl. w0 (d45.) ; position := param;
g13: ;
rs. w0 d41. ; save (position);
; initialize input
al w0 0 ;
al w1 -1 ; characters := 0;
ds. w1 d18. ; cur char := -1;
rs. w0 d35. ; sum := 0;
jl. w3 f15. ; start transfer input;
g1: rl. w1 d24. ; input commands:
rs. w1 d26. ; cur command:=
al w2 x1 ; null-char allowed at start of buffer;
g2: jl. w3 f8. ; top command:=command buf;
jl. g54. ;
jl. g4. ; repeat
sh. w1 (d25.) ; input word(input, end-action,next command);
jl. g3. ; if top command>command end then
al. w1 e11. ; begin
; type textline (<:input sizeerror:>);
jl. w3 f2. ; goto end-action;
jl. g54. ; end;
g3: rs w0 x1+0 ; word(command top):=input;
al w1 x1+2 ; command top:=command top+2;
jl. g2. ; until no limit;
g4: rs. w1 (j9.) ;
g5: rl. w1 (j7.) ; next command:
rl. w3 (j9.) ;
sl w1 x3 ; if cur command>=command end
jl. g1. ; then goto input commands;
dl w1 x1+2 ; w0 := first word of command;
ds. w1 j20. ; save command;
; cur action := action table;
g6: rl. w2 (j18.) ; repeat
g7: sn w0 (x2+0) ; if word(cur action)=word(cur command)
jl. g8. ; then goto before command;
al w2 x2+6 ; cur action:=cur action+6;
rl. w1 (j17.) ;
sh w2 x1 ;
jl. g7. ; until cur action>action end;
jl. w2 f4. ; typecommand;
al. w1 e13. ;
jl. w3 f2. ; type textline(<:syntaxerror:>);
jl. g54. ; goto end-action;
g8: rs. w2 (j16.) ; before command:
rl. w3 (j7.) ;
al w3 x3+4 ;
al w1 x3+8 ;
jl (x2+2) ; goto word(cur action+2);
; w1=cur command+12 w3=cur command+4
g9: rl. w2 (j16.) ; after command:
rl. w1 (j7.) ;
wa w1 x2+4 ; cur command:=
rs. w1 (j7.) ; cur command+word(cur action+4);
jl. g5. ; goto next command;
; local procedure type command;
;
; call: w2=link
; exit: w0,w2,w3=unch, w1=undef
f4: rs. w2 j21. ; type command:
ds. w0 j6. ; save regs;
al. w1 j19. ;
jl. w3 f1. ; typetext (command name);
dl. w0 j6. ; restore regs;
jl. (j21.) ; return;
j21: 0
; create:
g20:jd 1<11+48 ; (remove maybe an old entry)
jd 1<11+40 ; create entry(name,tail,result);
jl. g25. ; goto test result;
; change:
g21:jd 1<11+44 ; change entry(name,tail,result);
jl. g25. ; goto test result;
; rename:
g22:jd 1<11+46 ; rename entry(name,result);
jl. g25. ; goto test result;
; remove:
g23:jd 1<11+48 ; remove entry(name,tail,result);
jl. g25. ; goto test result;
g24:rl w1 x1+0 ; perman:
jd 1<11+50 ; permanent entry(name,key,result);
; test result:
g25:sn w0 0 ; if result<>0 then
jl. g9. ; begin
jl. w2 f4. ; typecommand;
jl. w2 f5. ; typeresult(result, name);
jl. g54. ; goto end-action;
; end;
; goto after command;
g30:al w0 0 ; load:
rl w1 x1+0 ; input seg:=0;
ds. w1 (j12.) ; max seg:mand param;
sh w1 0 ; if max seg<=0
jl. g9. ; then goto after command;
am. (j14.) ;
rs w0 +6 ; cur seg:=0;
jd 1<11+52 ; create area process(name,result);
se w0 0 ; if result<>0
jl. g25. ; then goto test result;
jd 1<11+8 ; reserve process(name,result);
g31:rl. w1 (j13.) ; next buf: addr:=load buf;
al w2 0 ; null-char := not allowed;
g32:jl. w3 f8. ; next word:
jl. g35. ;
jl. g33. ; inword(binword,after trouble,next segment;
rs w0 x1+0 ; word(addr):=bin word;
al w1 x1+2 ; addr:=addr+2;
rl. w3 (j15.) ; if addr<=load end
sh w1 x3 ;
jl. g32. ; then goto next word;
rl. w1 j14. ;
rl. w3 (j7.) ;
al w3 x3+4 ;
jl. w2 f12. ; outseg(name, area output,
jl. g35. ; after trouble);
jl. g31. ; goto next buf;
g33:rl. w3 (j11.) ; next segment:
al w3 x3+1 ;
rs. w3 (j11.) ; input seg:=input seg+1;
rl. w2 (j12.) ; if input seg<>max seg
se w3 x2 ;
jl. g32. ; then goto next word;
rl. w2 (j13.) ;
sn w1 x2 ;
jl. g34. ; if addr<>load buf then
rl. w1 j14. ;
rl. w3 (j7.) ;
al w3 x3+4 ;
jl. w2 f12. ; outseg(name, area output,
jl. g35. ; after trouble);
g34:rl. w3 (j7.) ; after load:
al w3 x3+4 ;
jd 1<11+64 ; remove process(name,result);
jl. g9. ; goto after command;
g35:rl. w3 (j7.) ; after trouble:
al w3 x3+4 ;
jd 1<11+64 ; remove process(name,result);
jl. g54. ; goto end-action;
j7: d26 ;
j9: d27 ;
j11: d33 ;
j12: d34 ;
j13: d28 ;
j14: d30 ;
j15: d29 ;
j16: d21 ;
j17: d20 ;
j18: d19 ;
m0 = 0 ; bs-kind
m1 = 2 ; mt-kind
m2 = 4 ; tr-kind
; name , modekind, tabelentry size
j3=0 , j4=2 , j1=j4+2
j0: ; start of table:
; mode<12 + devicekind
<:bs:> , m0 ;
<:mto:> , 0+m1 ;
<:nrz:> , 4<12+m1 ;
<:tro:> , m2 ;
<:flx:> , m1 ;
<:mt0:> ,12<12+m1 ; mt08
<:mt3:> , 8<12+m1 ; mt32
<:mt1:> , 4<12+m1 ; mt16
<:mt6:> , 0<12+m1 ; mt62
j2: ; top of table
i9: al. w2 j0.-j1 ; search modekind:
i1: ;
al w2 x2+j1 ; if modekind unknown then
sn w0 0 ;
sn. w2 j2. ;
jl. i5. ; goto alarm;
se w3 (x2+j3) ; if name in table<>param then
jl. i1. ; then goto next in table else
jl. i0. ; goto found;
j8: <:modekind illegal<0>:>
j19: 0 ; current command name
j20: 0 ;
0 ; (end of name)
j5: 0 ; saved w3
j6: 0 ; saved w0
e. ; end binin-command
\f
; initialize main
; call w3=link, return: all registers changed
;
b. p2,s12,m3 w.
s0:
t.m. link dlc/ioc main processes included
s1=k ; end of dlc/ioc devices
p0=0 ; name
p1=8 ; max buffers
p2= 10 ; length
;
s2: 0 ; return
s3: 0 ; current main
s10: <:clock:>,0,0,0 ; clock-name and name table entry
s11: 0<12 ; delay message
5 ; time (in seconds)
s12: 0,r.8 ; answer area
f57: rs. w3 s2. ;
al. w3 s10. ; wait:
al. w1 s11. ;
jd 1<11+16 ; send message(clock,wait);
al. w1 s12. ;
jd 1<11+18 ; wait answer(answer area);
;
al. w1 s0. ; first main
m0: rs. w1 s3. ;
sl. w1 s1. ; if list exchausted then
jl. (s2.) ; return
m2: rl. w1 s3. ; end;
rl w2 x1+8 ; w1:=name; w2:=param
jl. w3 f60. ; initialize main
am 0 ;
rl. w1 s3. ;
al w1 x1+p2 ; next main
jl. m0. ;
e.
c.(:a399>21a.1:)-1
; initial prepare dump
b. i5,j17 w.
f59: rs. w3 j3. ;
al. w3 j4. ;
al. w1 j5. ;
jd 1<11+42; lookup_entry(name,tail);
se w0 0 ; if dumparea exist then
jl. i5. ; begin
rl w0 x1 ;
sl. w0 (j6.) ; if tail.size < min_size then
jl. i0. ; begin
rl. w0 j6. ;
rs w0 x1 ;
jd 1<11+44; change_entry(name,tail);
se w0 0 ; if new size set then
jl. i5. ; begin
i0: jd 1<11+52; create area process;
jd 1<11+4 ; processs description;
sn w0 0 ; if process exist then
jl. i5. ; begin
rs. w0 j14. ;
rl. w2 j5. ; segm_count:=file_size;
; end;
; end;
; end;
; end;
i1: ; calculate_low_and_high_addresses:
sl w2 (b225) ; if sgm_count > 8388608/512 then
rl w2 b225 ; segm_count:=16384;
ls w2 9 ; last_file_addr:=segm_count*512;
sl w2 0 ; if last_file_addr>8388607 then
rl w2 b212 ; last_file_addr:=8388607;
sl w2 (b12) ; if last_file_addr>top_core then
rl w2 b12 ; last_file_addr:=top_core;
ls w2 -1 ;
ls w2 1 ;
rl. w3 j15. ;
sh w3 (b3) ; if process descr in low core then
jl. i3. ;
i2: ; set_low:
; begin
rs. w2 j11. ; low.last:= last_file_addr;
rs. w2 j11. ; low.last:= last_file_addr;
rs. w2 j11. ; high.first:=last_file_addr;
jl. i4. ; goto start_pp;
; end;
i3: sh w2 x3 ; if last_file_addr>s_top then
jl. i2. ; begin
rs. w3 j11. ; low.last:=s_top;
rl w1 b3 ;
rs. w1 j12. ; high.first:=name table start;
ws w2 6 ; top_size:=last_file_addr-s_top;
ld w3 -24 ; extend top_size;
al w0 0 ;
aa w3 2 ; last_address:=high.first+top_size;
ls w3 1 ;
ls w3 -2 ;
ls w3 1 ;
rs. w3 j13. ; high.last:=last_file_addr-s_top+name_table_start;
; end;
i4: ; start_pp:
al. w2 j10. ;
rl. w1 j14. ;
jl. w3 f58. ; prepare_dump(pda ext/area_proc,address_buff);
am 0 ;
jl. (j3.) ;
j3: 0 ; return address
j4: <:dumparea:>,0 ;
j5: 0,r.10 ; tail
j6: b151 ; min size (=162 segments)
j10: a398 ; low.first
j11: 0 ; low.last
j12: 0 ; high.first
j13: 0 ; high.last
;
j14: 0 ; pda of external_proc or area_proc
j15: h12 ; s_top
j16: b139 ; first of data buffer
j17: b152 ; e102 ; device number for first physical disc
;
i5: rl. w3 (j17.) ;
ls w3 1 ;
wa w3 b4 ;
rl w3 (x3) ;
se w3 q6 ; if kind=disc_kind then
jl. (j3.) ; begin
al w0 0 ;
rl. w1 (j17.) ;
jl. w3 f51. ; read_segm(devno,segm_no);
jl. (j3.) ;
rl. w3 j16. ;
rl w1 x3 ;
sh w1 0 ; if empty then
jl. (j3.) ; return else
rl w2 x3+4 ; segm_count:=dump_area.last_segm;
ls w1 2 ;
al w1 x1+4 ; disc_descr:=first_logical_disc_descr;
el w3 x1+5 ;
ls w3 1 ;
wa w3 b4 ;
rs. w3 j14. ; save process description address
; end;
jl. i2. ; goto caculate_low_and_high_addr;
z.
d1=k ; first chain head
t.m. init catalog definition of bs included
d2=k ; chain head end
; action table:
; each command is described by its name, the address of
; the command action, and the number of command bytes.
w.h0=k
<:cre:>, g20,32 ; <:create:><name><tail>
<:cha:>, g21,32 ; <:change:><name><tail>
<:ren:>, g22,20 ; <:rename:><name><new name>
<:rem:>, g23,12 ; <:remove:><name>
<:per:>, g24,14 ; <:perman:><name><cat key>
<:loa:>, g30,14 ; <:load:><name><segments>
<:new:>, g9 ,4 ; <:newcat:>
<:old:>, g9 ,4 ; <:oldcat:>
h1: <:end:>, g54,2 ; <:end:>
h3 = -k ; start of initcat command-table:
<:binin:> , 1<20 + g76-b110
<:clearc:> , 1<18 + g70-b110
<:kit<0>:> , 1<18 + g73-b110
<:kitlab:> , 1<18 + g74-b110
<:kitoff:> , 1<18 + g71-b110
<:kiton:> , 1<18 + g73-b110
<:mainca:> , 1<21 + g72-b110
<:nokit:> , 1<18 + g71-b110
<:oldcat:> , 1<18 + g78-b110
<:repair:> , 1<18 + g75-b110
<:auxcle:> , 1<18 + g79-b110
0
h4=k ; command buf:
h5=h4+510 ; command end:
h6=h5+2 ; load buf:
h7=h6+510 ; load end:
h8=h7+2 ; chain buf
h11 = a116 ; (minimum size of chaintable buffer)
c. a114-a116, h11 = a114 z.;
h9 = h8+(:h11+511:)>9<9-2; last of chainbuffer
h10=h9+2 ; start of 1. input buffer
h12=h10 + 2 * 512 ; top of input buffer (top of initcat code
\f
; initial start up of external processes and creation of
; local links to front ends. before linkup the external
; process description is released.
b.i30,j10,p15 w.
p6=0 ; start of message
p7=16 ; start of data
p11=22 ; device name or main process name
p8=30 ; jh.linkno
p9=38 ; process name
p10=46 ; length of item
i2=k ; start of linkup list
t.m. init linkup list included
i3=k ; top of linkup list
i6: i2-p10 ; start of linkup list
i7: i3 ; top of linkup list
i8: 0,r.4,0 ; name of fpa, name table entry
i9: 8<12+0 ; master clear message
i10: 0, r.8 ; answer area
i11: 0 ; link
i12: 0 ; saved pointer
i13: <:host:>,0,0,0 ; host-name and name table entry
i21: <:clock:>,0,0,0 ; clock-name and name table entry
i22: 0<12 ; delay message
5 ; time (in seconds)
f20: rs. w3 i11. ; init externals: save link;
rl w3 b4 ;
j0: rl w0 (x3) ; for devno:=0 step 1 until maxdevno do
se w0 80 ; proc:=proc(devno);
jl. j1. ; if kind(proc)=mainproc kind then
rs. w3 i12. ; name:=name(proc);
rl w3 x3 ;
al w0 0 ; if start flag(proc)<>0 then
rx w0 x3+a56 ; start flag(proc):=0;
rs w0 x3+44 ; main.ready flag := startflag;
se w0 0 ; goto cont;
jl. j3. ;
dl w2 x3+a11+2 ;
ds. w2 i8.+2 ;
dl w2 x3+a11+6 ;
ds. w2 i8.+6 ;
al. w3 i8. ;
jd 1<11+8 ; reserve process(name);
al. w1 i9. ; message:=master clear;
jd 1<11+16 ; send message(name,message);
al. w1 i10. ;
jd 1<11+18 ; wait answer(answer area);
jd 1<11+10 ; release process(name);
j3: rl. w3 i12. ;
j1: al w3 x3+2 ;
se w3 (b5) ;
jl. j0. ;
al. w3 i21. ; wait:
al. w1 i22. ;
jd 1<11+16 ; send message(clock,wait);
al. w1 i10. ;
jd 1<11+18 ; wait answer(answer area);
rl. w1 i6. ; insert links:
rs. w1 i12. ;
j2: rl. w1 i12. ; for dev:=first item in linkup list until last do
al w1 x1+p10 ; begin
rs. w1 i12. ;
sl. w1 (i7.) ;
jl. j8. ;
al. w3 i13. ;
al. w3 i13. ; receiver:= host;
rl w2 x1+p8 ;
ls w2 1 ;
am (b4) ; if linkup list.jh-linkno.kind =
rl w0 (x2+0) ; free itc_subprocess then
se w0 68 ; then
jl. j4. ; receiver:= linkup list.main proc name;
dl w0 x1+p11+2 ;
ds. w0 i8.+2 ;
dl w0 x1+p11+6 ;
ds. w0 i8.+6 ;
al. w3 i8. ;
j4: ;
jd 1<11+16 ; send message(receiver,operation);
al. w1 i10. ;
jd 1<11+18 ; wait answer(answer area);
bz. w3 i10.+1 ;
sn w0 1 ; if result=ok
se w3 0 ; and function result=ok then
jl. j2. ;
rl. w3 i12. ;
rl w1 x3+p8 ;
al w3 x3+p9 ;
jd 1<11+54 ; create peripheral process;
jl. j2. ; end;
j8:
jl. (i11.) ; exit: return to link;
e.
\f
; program used for autoload of local device controllers.
; jr - 07.10.76
;
; the communication takes place via the transmitter part of a fpa 801.
; after autoload this program reads commands from the device controller
; simulating a magtape station locally connected to the device controller.
; the load file must be placed on backing storage in consecutive segments.
; the load file consists of a number of records with the format:
; <ident> <data>
; where ident > 0 : size of data block (in characters)
; = 0 : tapemark (datablock empty)
; =-3 : end of tape (datablock empty)
;
; information about load device and load file is part of monitor options,
; and shall be packed in this way:
; <name of load device(fpa transmitter)>
; <device number of bs device holding the load file>
; <first segment (load file)>
;
; the device controllers are loaded one by one according to the options.
b.m10,n10,p10,q10,r10,s40 w.
; format of options:
p0=0 ; load device
p1=p0+8 ; device number of bs device
p2=p1+2 ; first segment
p3=p2+2 ; length of load command
; counters.
p4=10 ; maxnumber of autoloads
p5=1 ; max number of errors
s30:
; start of options
t.m. device autoload list included
s31=k
; reset process.
s0: 4<12+0 ; operation:=reset all subprocesses
; transmit status message.
s1: 5<12+2.11 ; operation:=transmit, mode:=reset, receive
s6 ; first:=first of sense area
s7 ; last:=last of sense area
8 ; charcount:=8
249 ; startchar:=sense block
; transmit status message.
s2: 5<12+2.01 ; operation:=transmit, mode:=receive
s6 ; first:=first of sense area
s7 ; last:=last of sense area
8 ; charcount:=8
249 ; startchar:=sense block
; transmit data block.
s3: 5<12+2.01 ; operation:=transmit, mode:=receive
0 ; first
s24 ; last (max upper limit)
0 ; charcount
251 ; strtchar:=data block
; autoload.
s4: 6<12+2.11 ; operation:=autoload, mode:=reset, receive
; dummy
; answer area.
s5: 0 ; status
0 ; bytes transferred
0 ; chars transferred
0 ; command character (status character)
0, r.4 ; dummy
; sense information area.
s6: 0 ; char0,1:=status(0:15), char2:=size(0:7),
0 ; char3:=size(8:15),char4,5:=filenumber(0:15),
s7: 0 ; char6,7:=blocknumber(0:15)
; name of destination
s8: 0, r.4, 0 ;
s28: 0 ; link params:
0 ;
0 ; device number
0 ; kind,type
5 ; max outstanding operations
s9: s31 ; last command (changed by f18)
s10: 0 ; status
s11: 0 ; size(data)
s12: 0 ; filenumber
s13: 0 ; blocknumber
s14: 0 ; first(record)
s15: 0 ; link
s16: 0 ; current load command
s17: 0 ; errorcount
s18: 8<12+0 ; position
6 ;
s19: 0 ; file number ( or segment number )
0 ; (segment no if position to disc)
; input message.
s20: 3<12+0 ; operation:=read
s27 ; first:=first of record buffer
s24 ; last:=last of record buffer
0 ; first segment number
; name of source.
s21: 0, r.4 ; (work) name of source
0 ; (s21+8) name table entry of bs device
; delay message. and sense message
s25: 0<12+2 ; operation:=wait, mode:=msec
0,15000 ; time:=1,5 sec
; name of clock.
s26: <:clock:>,0,0 ; name of clock device
0 ; name table entry
s29: 4 ; result from input message
s32: 0 ; return address (used by f18)
s33: -1-15<15 ; status mask: all bits except eof,load point,tape mark and write enable
f18: ; load ida-ifp controllers;
rs. w3 s32. ;
al. w3 s30. ; process descriptions(cur-command.load device)
m3: jd 1<11+4 ;
se w0 0 ; if proc known then
rl w0 (0) ; prockind := proc.kind;
; <* set command pointers *>
al w3 x3-p3 ;
rs. w3 s16. ; cur command := command.prev;
al w3 x3+p3+p3 ;
rs. w3 s9. ; last command := command.suc;
al. w3 m4. ; return from next load := next in list;
rs. w3 s15. ;
se w0 20 ; if prockind = idamain or
sn w0 26 ; prockind = ifpmain then
sz ;
jl. m4. ;
al w0 0 ; wait for source device ready
rs. w0 s21. ;
m1: rl. w1 s30.+p1; repeat
al. w3 s21. ; source.name := wrkname
jd 1<11+54 ;
jd 1<11+8 ; reserve source device
al. w1 s25. ; sense source device
jd 1<11+16 ;
al. w1 s5. ;
jd 1<11+18 ;
se w0 1 ; until ready
jl. m1. ;
jl. m0. ; autoload controller;
; <* if process unknown w0=0 autoload is skipped*>
m4: ; next in list:
sl. w3 s31. ; if list exchausted then
jl. (s32.) ; return
jl. m3. ; else check and autoload;
;
; end ** load of ida-ifp controllers **;
f19: rs. w3 s15. ; start: save link;
al. w3 s30.-p3 ;
rs. w3 s16. ;
al. w1 s25. ; message:=wait;
al. w3 s26. ; name:=clock;
jl. w2 n1. ; send and wait;
am 0 ; ok:
m0: rl. w3 s16. ; next load:
al w3 x3+p3 ; current command:=current command+length of command;
rs. w3 s16. ;
sl. w3 (s9. ) ; if no more commands then
jl. (s15.) ; return to link;
jd 1<11+8 ; reserve destination;
jl. w3 n2. ; transfer command;
jl. r4. ; goto autoload;
m2: rl. w0 s5.+6 ; execute:
sn w0 0 ; if command char=0 then
jl. q0. ; goto transmit next block;
sn w0 1 ; if command char=1 then
jl. q1. ; goto retransmit block;
sn w0 2 ; if command char=2 then
jl. q2. ; goto rewind;
sn w0 4 ; if command char=4 then
jl. q3. ; goto upspace block;
sn w0 8 ; if command char=8 then
jl. q4. ; goto upspace file;
sn w0 12 ; if command char=12 then
jl. q5. ; goto end;
sn w0 128 ; if command char=128 then
jl. q6. ; goto sense;
sn w0 255 ; if command char=255 then
jl. q7. ; goto wait;
jl. q8. ; goto error;
b.j10 w.
; after error, reset and transmit status, receive command.
r1: al w0 0 ; reset,trm status:
rs. w0 s17. ; errorcount:=0;
jl. w3 n3. ; set up status area;
j0: al. w1 s1. ; repeat0: message:=reset,transmit status,receive;
al. w3 s8. ; name:=name(load device);
jl. w2 n1. ; send and wait;
jl. m2. ; ok: goto execute;
al w3 1 ; error:
wa. w3 s17. ; errorcount:=errorcount+1;
rs. w3 s17. ;
sh w3 p5 ; if errorcount=<maxerrorcount then
jl. j0. ; goto repeat0;
jl. q5. ; goto load next;
; transmit status.
r2: jl. w3 n3. ; transmit status: setup status area;
al. w1 s2. ; message:=transmit status;
al. w3 s8. ; name:=name(load device);
jl. w2 n1. ; send and wait;
jl. m2. ; ok: goto execute;
jl. r1. ; error: goto restart;
; transmit data.
r3: rl. w2 s14. ; transmit data:
al w2 x2+2 ; first(data):=first(record)+2;
rs. w2 s3.+2 ; size:=size(data);
rl. w2 s11. ; if size=0 then
sn w2 0 ; size:=1;
al w2 1 ;
rs. w2 s3.+6 ; char count:=size;
al. w1 s3. ; message:=transmit block;
al. w3 s8. ; name:=name(load device);
jl. w2 n1. ; send and wait;
jl. m2. ; ok: goto execute;
jl. r1. ; error: goto restart;
; autoload.
r4: al w0 0 ; autoload:
rs. w0 s17. ; errorcount:=0;
al. w1 s0. ; message:=reset;
al. w3 s8. ; name:=namee(load device);
jl. w2 n1. ; send and wait;
jl. j1. ; ok: goto start load;
jl. q5. ; error: goto load next;
j1: rl. w1 (s8.+8) ; if destination.kind <> fpa then
rl w0 x1 ;
se w0 80 ; goto simple load
jl. r5. ; else
al. w1 s4. ; start load: message:=autoload;
al. w3 s8. ; name:=name(load device);
jl. w2 n1. ; send and wait;
jl. m2. ; ok: goto execute;
al w3 1 ;
wa. w3 s17. ;
rs. w3 s17. ; errorcount:=errorcount+1;
sh w3 p5 ; if errorcount=<maxerrorcount then
jl. j1. ; goto repeat;
jl. q5. ; goto load next;
; simple load ;
r5: al w1 1 ;
rs. w1 s29. ; result:= ok (initialize);
rl. w1 s20.+2 ; setup output addresses
rs. w1 s3.+2 ;
j2: al. w3 s8. ;
al. w1 s3. ;
jl. w2 n1. ; send output
jl. j3. ; ok: get next segment
jl. q5. ; error or finished: load next device
j3: rl. w1 s20.+6 ; update filecount in input mess
al w1 x1+1 ;
rs. w1 s20.+6 ;
al. w3 s21. ; setup input
al. w1 s20. ;
jl. w2 n1. ; send input
jl. j2. ; ok : goto next block
sz. w1 (s33.) ; if not end of file then
rs. w1 s29. ; result:=not ok;
jl. q5. ; error or eof: goto load next device
e.
; transmit next block.
q0: jl. w3 n0. ; transmit next block: next block;
jl. r3. ; goto transmit block;
; retransmit block.
q1=r3 ; retransmit block: goto transmit block;
; rewind.
q2: jl. w3 n2. ; rewind: transfer command;
jl. r2. ; goto transmit status;
; upspace block.
q3: jl. w3 n0. ; upspace block: next block;
al w3 1<2 ;
sz w0 1<8+1<4 ; if status=end of tape or end of file then
rs. w3 s10. ; status:=position error;
al w3 0 ; size(data):=0;
rs. w3 s11. ;
jl. r2. ; goto transmit status;
; upspace file.
q4: jl. w3 n0. ; upspace file:
sn w0 0 ; while status=0 do
jl. q4. ; next block;
al w3 0 ;
sz w0 1<8 ; if status=end of file then
rs. w3 s10. ; status:=ok;
rs. w3 s11. ; size(data):=0;
jl. r2. ; goto transmit status;
; end.
q5: ; end;
al. w3 s21. ;
jd 1<11+10 ; release input device;
al w0 0 ;
rs. w0 s21. ;
rl. w3 s16. ;
jd 1<11+10 ; release process(name);
rl. w1 s29. ;
se w1 1 ; if result = ok then
jl. m0. ; begin
al. w1 s25. ;
al. w3 s26. ;
jl. w2 n1. ; send and wait(clock)
am 0 ;
rl. w1 (s8.+8) ;
rl w0 x1 ;
se w0 q20 ; if kind = idamain or
sn w0 q26 ; kind = ifpmain then
sz ;
jl. m0. ; begin
al. w1 s8. ;
; al. w2 s28. ;
; rl w3 x1+8 ;
; ws w3 b4 ;
; ls w3 -1 ;
;rs w3 x2+4 ; insert device number
al w2 5 ;
jl. w3 f60. ; link device(name,link_params)
am 0 ; error
; end;
; end;
jl. m0. ; goto load next;
; sense.
q6=r2 ; sense: goto transmit status;
; wait.
q7: al. w1 s25. ; wait:
al. w3 s26. ;
jl. w2 n1. ; send and wait(clock);
am 0 ;
jl. r1. ;
; error.
q8=r2 ; error: goto transmit status;
; procedure next block.
; this procedure finds the start of the next record.
;
; status: 0 ok
; 1<4 end of tape
; 1<8 end of file
; 1<14 disc error
;
; call: return:
; w0 status
; w1 size(data)
; w2 destroyed
; w3 link destroyed
b.i4,j5 w.
i0: 0 ; saved link
i1: 3 ; constant
i2: 1<14 ; disc error
i3: 1<18 ; end of medium
n0: rs. w3 i0. ; next block:
rl. w1 (s14.) ;
al w1 x1+2+3 ; first(next record):=
al w0 0 ; (size(data)+3)+2)//3*2+first(record);
wd. w1 i1. ;
ls w1 1 ;
wa. w1 s14. ;
rs. w1 s14. ; first(record):=first(next record);
sh. w1 s23. ; if first(record)>first(buf)+510 then
jl. j0. ; first(record):=first(record)-512;
al w1 x1-512 ; first segmentno:=first segmentno+1;
rs. w1 s14. ;
al w2 0 ; move last segment to low part of buffer
j5: dl. w1 x2+s24. ;
ds. w1 x2+s23. ;
al w2 x2-4 ;
se w2 -512 ;
jl. j5. ;
al w0 1 ;
wa. w0 s20.+6 ;
rs. w0 s20.+6 ;
al. w1 s20. ; message:=input;
al. w3 s21. ; name:=name(load file device);
jl. w2 n1. ; send and wait;
jl. j0. ; ok: goto cont;
rl. w3 s5.+2 ; error:
sz. w1 (i3.) ; if status=end of medium
se w3 512 ; and bytes transferred=1 segment then
jl. j4. ; goto cont;
jl. j0. ;
j4: rl. w0 i2. ; status:=disc error;
al w1 0 ; size:=0;
dl. w3 s13. ; fileno:=fileno, blockno:=blockno;
jl. j3. ; goto exit;
j0: rl. w1 (s14.) ; cont:
sh w1 0 ; if ident(record)>0 then
jl. j1. ; size(data):=ident(record);
al w0 0 ; status:=0;
dl. w3 s13. ; filenumber:=filenumber;
al w3 x3+1 ; blocknumber:=blocknumber+1;
jl. j3. ; else
j1: se w1 0 ; if size(record)<>0 then
am 1<4-1<8 ; status:=1end of tape
al w0 1<8 ; else status:=end of file;
j2: al w1 0 ; size(data):=0;
al w2 1 ; filenumber:=filenumber+1;
wa. w2 s12. ; blocknumber:=1;
al w3 1 ;
j3: ds. w1 s11. ; exit:
ds. w3 s13. ;
jl. (i0.) ; return;
e.
; procedure send and wait.
; the procedure returns to link in case of result ok (which is
; status=0 and result=1), else to link+2.
; call: return:
; w0 result
; w1 message status-writing enable
; w2 link destroyed
; w3 name destroyed
b.i1 w.
n1: rs. w2 i0. ; send and wait:
jd 1<11+16 ; send message;
al. w1 s5. ; answer area:=std answer area;
jd 1<11+18 ; wait answer;
rl. w1 s5.+0 ; if result<>1
la. w1 i1. ; remove writing enable
rl. w2 i0. ;
sn w0 1 ; or status<>0 then
se w1 0 ; return to link+2
jl x2+2 ; else return to link;
jl x2+0 ;
i0: 0 ; saved link
i1: -1 -1<15 ; status mask
e.
; procedure transfer command.
; call return:
; w0 destroyed
; w1 destroyed
; w2 destrlyed
; w3 link destroyed
b.i1, j1w.
n2: rs. w3 i0. ; transfer command:
rl. w2 s16. ;
dl w1 x2+p0+2 ;
ds. w1 s8.+2 ;
dl w1 x2+p0+6 ; transfer name(load device);
ds. w1 s8.+6 ;
rl w3 x2+p1 ;
ls w3 1 ;
wa w3 b4 ; name table entry(bs device):=deviceno*2+start(name table);
rs. w3 s21.+8 ;
rl w3 x3 ; proc(bs device):=word(name table entry);
dl w1 x3+4 ; move name to work
se w0 0 ; if name(0) = 0 then
jl. j0. ; create peripheral process(wrkname);
rl w1 x2+p1 ;
al. w3 s21. ;
jd 1<11+54 ;
jl. j1. ;
j0: ds. w1 s21.+2 ;
dl w1 x3+8 ;
ds. w1 s21.+6 ;
al. w3 s21. ; reserve source device(mandatory if source is ida801)
j1: jd 1<11+8 ;
ld w1 -100 ;
ds. w1 s11. ; ident,size:=0,0;
al w0 1 ;
rs. w0 s12. ; filenumber:=1;
rs. w0 s13. ; blocknumber:=1;
rl w1 x2+p2 ; first segment:=first segment number(load file);
rs. w1 s19. ; save position
rs. w1 s20.+6 ;
al. w1 s18. ; send positon message (mandatory if ida801)
jl. w2 n1. ;
am 0 ; skip the answer
al w0 768-3 ; assure that first and second segment are
rs. w0 s22. ; transferred to core first time the
al. w0 s22. ; record buffer are used;
rs. w0 s14. ;
al. w1 s20. ; input first segment
al. w3 s21. ;
jl. w2 n1. ; send and wait
am 0 ; skip the answer
jl. (i0.) ; exit: return;
i0: 0 ; save link
e.
; procedure setup status area.
; call: return:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed
b.w.
n3: rl. w0 s10. ; setup status area:
rl. w1 s11. ;
se w0 0 ; if status<>ok then
al w1 0 ; size(data):=0;
ls w1 8 ;
ld w1 8 ;
lo. w1 s12. ; sense status area:=
rl. w2 s13. ; status(0:15)<8+size(0:7),
ls w2 8 ; size(8:15)<16+filenumber(0:15),
ds. w1 s6.+2 ; blocknumber(0:15)<8;
rs. w2 s6.+4 ;
jl x3 ; exit: return;
e.
s22=k ; start of record buffer
s23=s22+510 ; last of first segment in record buffer
s24=s22+512*2-2 ; last of record buffer
s27=s23+2 ; first of second segment in record buffer
e.
b.i24 ; begin
w.
i0: ; initialize segment:
rl. w0 i3. ; initialize (top of initcat code);
rs. w0 (i4.) ;
rl w1 b12 ; if coresize >= 1 000 000 hw then
sl. w1 (i8.) ; first logical address := top of init cat;
rs. w0 (i9.) ; (automatic relocation)
c. (:a80>16a.1:)-1
rl. w0 i6. ; initialize forward reference in segment 8
rs. w0 (i7.) ; from linkall to kiton!
z.
rl. w2 i5. ;
dl w1 x3-2 ; move initcat switches;
ds w1 x2+d37-d36;
dl w1 x3-10 ; move startup area name;
ds w1 x2+d49+2-d36;
dl w1 x3-6 ;
ds w1 x2+d49+6-d36;
jl (10) ; goto system start;
i3: h12 ; top of initcat code
i4: b120 ; pointer to ...
i5: d36 ; pointer to initcat switches
c.(:a80>16a.1:)-1
i6: g47 ; entrypoint to kiton
i7: b135 ; address of reference to kiton
z.
i8: 1000000 ; coresize limit for automatic relocation
i9: b141 ; pointer to: first logical address
jl. i0. ; goto initialize segment;
c25=k - b127 + 2
e. ; end
i.
e. ; end of initialize catalog on backing store
\f
; segment 10
; rc 05.08.70 bjørn ø-thomsen
;
; this segment moves segment 2 - 9 in this way:
;
; segment 2 is moved to cell 8 and on, after which
; control is transferred to the last moved word with the
; following parameters:
; w2 = top load address (= new address of last moved
; word + 2)
; w3 = link
;
; after initializing itself, the program segment returns
; to this segment with:
; w2 = load address of next segment
;
; the next segment will then be moved to cell(w2) and on,
; after which it is entered as described above.
;
; when initialize catalog (segment 9) is entered, the values
; of the two switches (writetext, medium) may be found in
; the words x3-4 and x3-2.
;
; segment 10 is entered from segment 1 in its last word
; entry conditions:
; w0,w1 = init catalog switches
; w2 = start address of segment 2
s. i10, j10
w.
j3. ; length of segment 10
j9: 0, r.4 ;x3-12: init cat switch: startup area name
j0: 0 ;x3-4: init cat switch: writetext
j1: 0 ;x3-2: init cat switch: medium
; return point from initializing of some segment
i0: rl. w1 j2. ; get load address;
i1: wa w1 x1+0 ; calculate top address:
rx. w1 j2. ; change(old load address, top address);
al w1 x1+2 ; skip segment length;
; now w1, w2 = old, new load address
; move segment:
sh w2 x1 ; if new addr > old addr then
jl. i2. ; begin
ds. w2 j5. ; save (old, new);
ws w2 2 ; diff := new - old;
sh w2 i5 ; (at least size of move loop);
al w2 i5 ;
al. w1 j2. ; from := last of segment;
; move to higher:
i4: rl w0 x1 ; move word(from)
am x2 ; to word(from + diff);
rs w0 x1 ;
al w1 x1-2 ;
sn. w1 j0. ; if exactly all moveloop moved then
jl. x2+i4. ; goto the moved moveloop...
sl. w1 (j4.) ; if not all moved then
jl. i4. ; goto move to higher;
rl. w1 j4. ; old := old + diff;
wa w1 4 ;
wa. w2 j2. ; top address := top address + diff;
rs. w2 j2. ;
rl. w2 j5. ; restore(new);
; end;
i2: rl w0 x1+0 ; move word from old
rs w0 x2+0 ; to new address;
al w1 x1+2 ; update old addr;
al w2 x2+2 ; update new addr;
se. w1 (j2.) ; if old addr <> top addr
jl. i2. ; then goto move segment;
; now the segment has been moved
; jump to the last moved word
al. w3 i0. ; insert return;
jl x2-2 ; goto word(top addr - 2);
; comment: jump to last loaded word with
; w2 = top load address
; w3 = link
; word(x3-4) = init cat switch, writetext
; word(x3-2) = init cat switch, medium
; initialize segment 10
i3: ds. w1 j1. ; save init cat switches
rs. w2 j2. ;
; ************* note: uses special knowledge to format of autoboot-program
dl w1 30 ; get startup area name from fixed part of autoboot!!!
ds. w1 j9.+2 ;
dl w1 34 ;
ds. w1 j9.+6 ;
; get monitor mode and clear all interrupts
gg w3 b91 ; w3 := inf;
rl. w0 j6. ; w0 := monitor mode;
al. w1 i6. ; w1 := new entry;
al. w2 j7. ; w2 := regdump;
rs w2 x3+a326 ; user regdump := regdump;
rs w0 x3-a325+a328+6; monitor status := monitor mode;
rs w1 x3-a325+a328+2; monitor call entry := new entry;
jd 1<11+0 ; call monitor; i.e. enter below, in monitor mode;
i6: al w0 1 ; after monitor mode got:
gp w0 b91 ; inf := 1; i.e. prevent any response;
al w1 1<3 ; device := 1;
i7: am. (j8.) ; next device:
do x1+2 ; reset device (device);
al w1 x1+1<3 ; increase (device);
sh w1 255<3 ; if device <= 255 then
jl. i7. ; goto next device;
al w2 8 ; new load address := 8;
jd. i0. ; goto get load address;
j6: 1 < 23 ; monitor mode;
j7: 0, r. a180>1 ; regdump
j8: 1 < 23 ; device address bit
j4: 0 ; saved old
j5: 0 ; saved new
i5 = k - j0 ; aproximate size of moveloop
j2: 0 ; top address
jl. i3. ; goto initialize segment 10
j3: ; top address of segment 10:
e. ; end segment 10
i.
; last segment
s.w.
0 ; last segment empty
e. ; end of last segment
m. end of monitor
e. ; end of global block
i.
e.
▶EOF◀