|
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: 127488 (0x1f200)
Types: TextFile
Names: »ms2 «
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦2ba378e4a⟧
└─⟦this⟧ »ms2 «
\f
m. mons2 - monitor operatins system s, part 2 17.0 beta
;
;88.05.11 15.45 kak connect ida changed
;88.05.20 15.11 kak new text output in connect (g112);
;88.05.24 09.30 kak change of cpa and address base included
;88.06.07 10.20 kak prepare dump and dump commands included
;88.08.16 11.38 kak connect/disconnect changed to createlink/removelink
; including a new param format
;88 09 19 17.39 hsi error in createlink spec for floppy (h15:)
;88 10 12 09.55 kak two new commands: privileged and unprivileged introducted
; and including privileged consoles from options is removed
;88 11 09 08.02 kak error in linkall corrected
;88 11 25 11.27 kak protection against unprivileged mainconsole
;89 01 27 13.00 kak removelink corrected
;89 02 22 12.52 kak accepting of capitol letters included
;89 03 14 08.50 kak the last char read is saved, and may be used to detect end of line
; in commands with a variable number of paramters
; the last name read in createlink is saved in work, to prevent overwrite
;89 03 15 16.22 kak driverproc is started locked
; and inserted in running queue
;89 03 30 12.00 kak stepping stone (step 2) out of conditional block
;--------------------------------------------------------------------------
; START OF RELEASE 16.0
;89 04 11 14.12 hsi unlink: reset output buffer after each parameter
;89 05 25 15.06 kak the last free consolebuffer cannot be privileged
;--------------------------------------------------------------------------
; START OF RELEASE 17.0
;90 10 23 12.34 kak a new s-command: setprio introducted
; who did it possible to changed the priority of a running child
;91 01 15 14.00 kak ths s-command create child is changed: in the monitor call
; modify child the first logical addr is used as IC (before it was the physical addr)
;91 01 30 13.51 kak message received from internal process changed:
; the device address is replaced with the core table address at the call of find console.
b.i30 w.
i0=91 01 30 , i1=13 51 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.
w.
e0: c0 ; <first addr>
;e1 ; defined below
e2:c4 ; <own buf>
e3:c5 ; <own area>
e4:0 ; <max device>
e5:h0 ; <char table>
e6:h1 ; <param table>
e7:h2 ; <first command>
e12:h3 ; <top command table>
e9:h4 ; <first console>
e10:h5 ; <last console>
e11:h6 ; <first device>
e13:h8 ; <first work>
e14:h9 ; <last work>
e33:h10 ; fictive element before first core table
e15=k-c20
e15,e15
e16:0-0-0 ; <first core - last of init cat code>
e17:0 ; <top core>
e18:0 ; <param type>
e19:0 ; <integer>
e24:h8 ; <work> ( initially: first work )
; *** the following variables must match part of work-area
e20:0 ; <name>
e21:0 ;
e22:0 ;
e23:0 ;
0
e78:0 ; used in list and link and removelink and initkit
e79:-1 ; segment in susercat or -1
e81:0 ;continue indicator
; text addr: odd = continue, even = no continue
e83:0 ; <subroutine return address>
0 ; <cur catalog base, lower limit >
e75:0 ; < upper limit >
e25:h21 ; <console> ( initially: first console )
e26:0 ; <console buf> or <last addr>
e27:8 ; <char shift> (initially: prepared for empty char buf)
e28:0 ; <char addr>
e29:0 ; <child>
e90:0 ; <terminal address>
e101:0 ; <device no of disc containing description>
e102:0 ; <device no of physical disc>
e103:0 ; <pointer in disc description>
e105:0 ; <size of logical disc description>
e30:0 ; <core addr>
; *** end of work-area match
e104:0 ; <user of disc description buffer identified by work>
e31:h21
e34:0
e35=k-c20
h4,h22
e36:
e37:0
e38:0
e32:0,r.8 ; <message>
e88:0 ; expected answer
e89:0 ; executing reentrant code: 0=false, -1=true (initially = false)
c.(:a399>21a.1:)-1
e106:0 ; pp_buff: buffer addres from prepare dump
z.
e109: ; last char read;
e39:0 ; <event>
e40:0 ; <receiver>
e41:0 ;
0 ;
e43:0,0 ;
e55:0 ; <write shift>
e44:5<12 ; <type mess>
e45:0 ; <line addr>
e46:0 ; <write addr>
0 ; <segment or unused>
e42:0 ; <top of writebuffer>
e53:0 ; <write mode: 0=terminal, 1=memory>
e47:3<12 ; <area mess> or <input mess>
e48:0 ; <first addr>
e49:0 ; <last addr>
e50:0 ; <segment>
e87: 0 ; areabuf state: 0=defined, else undef (initially defined)
e51:0 ; <entry tail> or <answer> or <message>
e52:0 ;
0 ;
e54:0 ; <convert area>
0
e56:0 ; <read shift> or <radix> or <start>
e57:0 ; <read addr> or <state> or <size>
e58:0 ; <save w1> or <first segment>
e59:0 ; <save w2> or <content> or <keys> or <result>
e60:0 ; <link> or <bytes to load>
e61:0 ; <child w0>
e62:0 ; <child w1>
e63:0 ; <child w2>
e64:0 ; <child w3>
e65:0 ; <child ex>
e66:0 ; <child ic>
e67=e59+1 ; <ic in entry>
e68=e66+2
0,0
e69:0 ;jobcount
a107 ;<max catalog base, lower limit>
e76:a108-1 ;< upper limit>
e77: 0 ; increase access indicator
e70:h19
e71:h20
e72: -1 ; first logic address (default value)
m. s lock indicator.
c.(:c23>13 a.1:)-1 ; if teminals shal be blocked after start up
e80: -1 ; then e80=-1, else
z.
c.-(:c23>13 a.1:) ;
e80: 0 ; e80=0
z.
c.(:a399>22a.1:)-1
e82: 0 ; max r.size : max space between monitor table and start of process description
z.
e85:0 ; used in job command
b1: b29+1*a4 ; own process description (second internal)
; end line:
e1=e17-a17;********************
g1: jl. w1 g28. ;
g48=k+4
<:ready **date not initialized <0>:> ; text until date initialized
g2: jl. w1 g28. , <:syntax error:<0>:>
g3: jl. w1 g28. , <:not allowed<0>:>
g4: jl. w1 g103. , <:no core<0>:>
g5: jl. w1 g103. , <:no buffers<0>:>
g6: jl. w1 g103. , <:no areas<0>:>
g7: jl. w1 g103. , <:no internals<0>:>
g8: jl. w1 g28. , <:illegal cpa<0>:>
g9: jl. w1 g103. , <:process unknown<0>:>
g10: jl. w1 g103. , <:process exists<0>:>
g11: jl. w1 g28. , <:catalog error<0>:>
g12: jl. w1 g28. , <:area unknown<0>:>
g13: jl. w1 g28. , <:area reserved<0>:>
g14: jl. w1 g103. , <:program too big<0>:>
g15: jl. w1 g28. , <:area error<0>:>
g16: jl. w1 g103. , <:device unknown<0>:>
g17: jl. w1 g103. , <:device reserved<0>:>
g18: jl. w1 g28. , <:not implemented<0>:>
g19: jl. w1 g103. , <:base illegal<0>:>
g20: jl. w1 g103. , <:bs claims exceeded<0>:>
g21: jl. w1 g103. , <:bs device unknown<0>:>
g22: jl. w1 g103. , <:unknown<0>:>
g23: <:message<0>:>
g24: <:pause<0>:>
g25: jl. w1 g103. , <:no entries in maincat<0>:>
g26: <:max<0>:>
g27: jl. w1 g103. , <:illegal priority<0>:>
g29: jl. w1 g103. , <:prog name unknown<0>:>
g47: jl. w1 g28. , <:input aborted<0>:>
g101:jl. w1 g103. , <:illegal relocation<0>:>
g111:jl. w1 g103. , <:illegal old contents<0>:>
g126:jl. w1 g103. , <:no consol buffers<0>:>
g120: <:warning: susercat not updated<0>:>
g105: ; write message: (w1 text addr, w3 link)
b. i10 w. ; local write routine used after endline or error.
rs. w3 i1. ;
al w2 x1 ; save textaddr;
jl. w3 d19. ; init write;
jl. w3 d21. ; write text;
se. w2 g2.+2 ; if syntax error then
jl. i5. ;
al. w1 e20. ; write last read parameter;
jl. w3 d21. ;
rl. w1 e19. ;
rl. w0 e20. ;
sn w0 0 ;
jl. w3 d22. ;
;
i5: al w0 10 ; write newline;
jl. w3 d20. ;
jl. w3 d23. ; type line;
jl. (i1.) ; return;
;
i1: 0 ;save return addr
e.
;
;
g110: ;test area and continue indicator;
b. i10 w. ; local procedure used to test if continuation
; can take place (only after error and when
; reading from an area).
; return:
; link : continue and reading from area
; link+2 : no continue and reading from area
; link+4 : not reading from area
; w0, w1, w2: unchanged
ds. w1 i5. ;
rs. w2 i6. ;
rl. w2 e81. ;
rl. w1 e24. ;
rl w0 x1+c58 ; if inputstack = stack base then
sn w0 x1+c73 ;
jl. i4. ; goto not reading from area;
;
so w2 1 ; if continue = false then
jl. i2. ; goto no continue and reading from area
jl. i0. ; else goto continue and reading from area;
;
i4: am 4-2 ;not reading from area:
i2: am 2-0 ;no continue but reading from area:
i0: al w3 x3+0 ;continue and reading from area:
dl. w1 i5. ;
rl. w2 i6. ;
jl x3 ; return;
0 ;
i5: 0 ;
i6: 0 ;
e.
g103: ; continue command interpretation:
am 1 ; continue:= true;
g28: ; terminate command interpretation:
al w2 x1 ; continue:= false; (w2 := text address, even or odd)
rs. w2 e81. ;
al w3 0 ;
rs. w3 e77. ; increase access indicator := false;
; <* true after error in all, get or new commands *>;
se w3 (b13) ; if high part of clock <> 0 then
rs. w3 g48. ; remove warning;
al w3 -1 ;
rs. w3 e89. ; executing reentrant code := true;
rs. w3 e79. ; reset segment no in susercat
rl. w3 e25. ;
rl w3 x3+c28 ; if access count = 0 then
se w3 0 ;
jl. g106. ;
; begin
jl. w3 g105. ; write message(message);
jl. w3 d42. ; save work;
jl. g108. ;+0: error: goto release link
;+2: ok:
jl. w3 g110. ; test area and continue indicator;
jl. g35. ;+0: area and continue: goto next command;
jl. 2 ;+2: area and no continue:
jl. g108. ;+4: no area: goto release link;
; end
g106: ; else begin <* access count = 1 *>
sn. w1 g1.+2 ; if text = 'ready' then
jl. g46. ; goto send input;
;
jl. w3 g105. ; write message;
jl. w3 d42. ; save work;
jl. g107. ;+0: error: goto decrease access, release link;
;+2: ok:
jl. w3 g110. ; test area and continue indicator;
jl. g35. ;+0: area and continue: goto next command;
jl. g107. ;+2: area and no continue: goto decrease acces, release
jl. g46. ;+4: no area: send input;
; end;
;
;
g107: ; decrease access:
rl. w1 e25. ;
jl. w3 d10. ; decrease access(console);
;
;
g108: ; release link:
rl. w2 e25. ;
rl w2 x2+c25 ;
jl. w3 d48. ; release temp link(console);
am 0 ;+0: error: ignore (usually privileged consoles);
;+2: ok:
;
g109: ; link console buffer:
rl. w1 e25. ; if console buffer<>privileged then
al. w2 e35. ; link element(console, free chain);
zl w0 x1+c27 ;
so w0 1<3 ;
jl. w3 d18. ;
;
;
g30: al w2 0 ; exam first:
jl. g32. ; event:=0;
g31: rl. w2 e39. ; exam next:
g32: jd 1<11+24 ; wait event(event,next,result);
rs. w2 e39. ; event:=next;
rl w1 x2 +6 ; sender:=word(event+6);
sz. w2 (e89.) ; if executing non-reentrant code
jl. g41. ; and
se. w2 (e88.) ; event <> expected answer then
jl. g32. ; goto exam next;
g41: ;
sn w0 0 ; if result=0 then
jl. g34. ; goto message received;
jl. w3 d41. ; find work(event,old work);
jl. g31. ;+0: not found: let the answer be - should not happened
;+2: found:
al. w1 e51. ; answer received:
jd 1<11+18 ; wait answer(event,answer,result)
al w3 1 ; w1 := logical status
ls w3 (0) ; := 1 shift result
sn w3 1<1 ; + maybe status.answer;
lo w3 x1 ;
rs. w3 e59. ;
jl. w3 d43. ; restore work(work,event);
g33: rl. w2 e39. ; reject message:
jd 1<11+26 ; get event(event);
al w0 2 ;
al. w1 e51. ;
jd 1<11+22 ; send answer(event,answer,2);
jl. g30. ; goto exam first;
g34: rl. w3 e2. ; message received:
sh w3 1 ; if own buf<=1
jl. g31. ; then goto exam next;
sh w1 -1 ; if sender<0
jl. g33. ; then goto reject message;
sn w0 (x1 +0) ; if kind(sender)=0
jl. g50. ; then goto internal message;
rs. w1 e90. ; terminal:= sender;
al w0 x1 ;
jl. w3 d24. ; find_and_select_console_1(device,console,
jl. g33. ; reject message);
rs. w1 e25. ; console:= new console
al w0 x2 ; save w2 (buffer address);
jl. w3 d17. ; remove element(console);
; <* maybe the console was in the free chain *>
al w2 (0) ; restore w2
jd 1<11+26 ; get event(console buf);
al w0 1 ;
al. w1 e51. ;
jd 1<11+22 ; send answer(console)
g46: al w2 0 ;
jl. w3 d41. ; find work(0,new work);
jl. g108. ;+0: not found: goto release link, link console;
;+2: found:
al w0 x1+c73 ; input stack pointer := stack base;
rs w0 x1+c58 ;
g39: ; end;
al w2 x1+c66 ; first addr:= work+linebuf;
al w3 x1+c67 ; last addr:= work+outputlinebuf-2;
ds. w3 e49. ;
al. w1 e47. ;
jl. w3 d26. ; send buf (input mess, buf);
jl. w3 d42. ; save work(buf);
jl. g107. ;+2: error: goto decrease access and release link;
al w2 x1+c66-2 ; char shift := > 0; (* i.e. change word *)
ds. w2 e28. ; char addr := work + linebuf - 2;
wa. w2 e52. ;
rs. w2 e26. ; last addr := char addr + bytes;
; next command:
g35: jl. w3 d2. ; next param(type);
g36: ; exam command:
rl. w1 e25. ; if increase access indicator then
rl. w3 e77. ; <* after a call of new, all or get *>
sn w3 1 ;
jl. w3 d9. ; increase access(console);
;
al w3 0 ;
rs. w3 e77. ; increase access indicator := false;
;
sn w0 0 ; <* w0: type of next item *>
jl. g98. ; if type=0
se w0 1 ; or type<>1
jl. g2. ; then goto end line;
jl. w3 d19. ; init write;
al w3 -1 ;
rs. w3 e89. ; executing reentrant code := true;
rl. w3 e7. ; w3 := base of command table;
g37:; next command:
al w3 x3 +6 ; increase (command pointer);
dl w2 x3 +2 ; w1w2 := command name;
sh w1 0 ; if first of command <= 0 then
jl. g38. ; goto test end;
sn. w1 (e20.) ; if command.table <> name then
se. w2 (e21.) ;
jl. g37. ; goto next command;
; notice: only 6 first characters tested
; command found in table:
; test that it is allowed to call this command from this console
al w2 0 ;
rl w3 x3 +4 ;
ld w3 10 ; w0:= command mask.console
ls w3 -10 ; w1:= console
rl. w1 e25. ; w2:= command bits.command table
bz w0 x1+c27 ; w3:= relative command address
ls w2 -1 ;
ls w2 3 ;
sz w0 1<3 ; if console privileged then
jl. g40. ; goto command base
so w0 x2 ; if command not allowed(console) then
jl. g3. ; goto end line
so. w2 (e80.) ; if locked and not a bit 3 command then
jl. g3. ; goto end line
g40: jl. x3+g45. ; goto command-action;
; init write has been called
; w0 = command mask(console)
; w1 = console
g38: ; test found:
sn w1 0 ; if continuation = 0 then
jl. g2. ; goto end line; i.e. all commands tested
; all commands, not contained in primary part of command table, are
; considered non-reentrant
al w3 0 ;
rs. w3 e89. ; executing reentrant code := false;
ac w3 x1 +6 ; w3 := continuation address for more commands;
; (notice w3 = base of commands)
jl. g37. ; goto next command;
g98: rl. w1 e24. ; if stack=stackbase then
rl w2 x1+c58 ; goto endline else
sn w2 x1+c73 ; goto next command
jl. g1. ;
jl. g35. ;
;
b. i5 w.
g50: ; message:
; ---------
dl w0 x2 +10 ;
ds. w0 e32.+2 ; move message from buffer to <message>;
dl w0 x2 +14 ;
ds. w0 e32.+6 ;
dl w0 x2 +18 ;
ds. w0 e32.+10 ;
dl w0 x2 +22 ;
ds. w0 e32.+14 ;
al w2 x1 +0 ;
jl. w3 d25. ; find parent(sender,parent,
jl. g33. ; reject message);
rs. w1 e90. ; terminal:=child.terminal;
al w0 x3+c18 ;
jl. w3 d24. ; find_and_select_console_1(terminal_name.core_table, console);
jl. g33. ;+0: error: reject message;
rs. w1 e25. ;+2: ok: console:=new or old console;
rs. w2 e29. ; child:= sender;
dl w0 x2+a43 ; cur catalogbase:=child.catalogbase;
ds. w0 e75. ; <* save in case of newjob or replace *>;
jl. w3 d17. ; remove element(console);
al w2 0 ;
jl. w3 d41. ; find work(0,new work);
jl. g31. ;+0: not found:
; <* let the message be - try to find an answer which
; will release a workarea *>
;+2: found:
jl. w3 d19. ; init write;
rl. w3 e32. ; if message(0)(23)=1 then
so w3 2.1 ; begin stop child;
am d33-d39 ; writetext(<:pause:>)
jl. w3 d39. ; end
se. w3 0 ; else
am g24-g23 ; begin child name;
al. w1 g23. ; writetext(<:message:>)
jl. w3 d21. ; end;
rl. w2 e39. ;
jd 1<11+26 ; get event(event);
al w0 1 ;
al. w1 e32. ;
jd 1<11+22 ; send answer(event,message,1);
al. w1 e40. ;
jl. w3 d21. ; writetext(receiver);
al. w2 e32.+2 ; index:= 2;
g43: rl w1 x2 +0 ; next word:
bl. w3 e32.+1 ; word:= message(index);
ls w3 1 ; bits:= message(1);
hs. w3 e32.+1 ; message(1):= bits shift 1;
sh w3 -1 ; if bits(0)=1 then
jl. g44. ; goto number;
sn w1 0 ; if word=0 then
jl. g42. ; goto test more;
al w0 0 ; char:= word(0:7);
ld w1 8 ; word:= word shift 8;
jl. w3 d20. ; writechar(char);
al w0 0 ; char:= word(0:7);
ld w1 8 ; word:= word shift 8;
jl. w3 d20. ; writechar(char);
al w0 0 ; char:= word(0:7);
ld w1 8 ; word:= word shift 8;
am d20-d22 ; writechar(char);
; goto test more;
; number:
; writeinteger(word);
g44: jl. w3 d22. ; test more:
g42: al w2 x2 +2 ; index:= index+2;
sh. w2 e32.+14 ; if index<=14 then
jl. g43. ; goto next word;
al w0 10 ;
jl. w3 d20. ; writechar(10);
jl. w3 d23. ; typeline(buf);
zl. w1 e32. ; save function
rs. w1 e23.+2 ;
rl. w3 e24. ; save name in input buffer
al w3 x3+c66 ;
dl. w1 e32.+10 ;
ds w1 x3+2 ;
dl. w1 e32.+14 ;
ds w1 x3+6 ; end
dl. w1 e26. ; simulate empty input string
ds. w1 e28. ; ( after unstack command)
jl. w3 d42. ; save work
am 0 ; +2 error (dont care)
rl. w3 e23.+2 ; if function = newjob then
sn w3 12 ; goto stack-input
jl. g97. ; else
se w3 10 ; if function = finis or replace then
sn w3 2 ;
sz ;
jl. g108. ;
jl. w3 d39. ; stop process(child); c. if stopbit was off;
jl. w3 (i0.) ; adjust bs claim
jl. w3 d40. ; remove process
rl. w3 e23.+2 ; if function =replace then
se w3 10 ;
jl. g108. ;
g97: rl. w2 e24. ;
al w2 x2+c66 ;
dl. w1 e75. ; stack input(child.catalogbase, areaname);
jl. w3 d79. ; goto next command
jl. g35. ;
;
i0: d76 ; adjust bs-claims
e. ; end message;
g45: ; base for command-relatives
; define pseudo-entries for conditinally-assembled commands
g70: ; break
g72: ; include
g73: ; exclude
g74: ; call
g75: ; list
g76: ; max
g77: ; replace
g83: ; all
g89: ; job
g90: ; print
g91: ; modify
jl. g18. ; goto not implemented;
; command syntax: read <area name>
; ---------------------------------
g57: ; read:
jl. w3 d15. ; next name;
al. w2 e20. ;
dl. w1 e76. ; catalogbase := max catalogbase;
jl. w3 d79. ; stack input (name);
jl. g35. ; goto next command;
; command syntax: unstack
; ------------------------
g58: ; unstack:
jl. w2 d80. ; unstack input;
jl. g35. ; goto next command;
; command syntax: date <year> <month> <date> <hour> <min> <sec>
; --------------------------------------------------------------
b. i20, j30 w. ;
j0: ; minimum values:
82 , 1 , 1 , 0 , 0 , 0
j1: ; top values:
99+1, 12+1, 31+1, 23+1, 59+1, 59+1
j2: ; year,month,day,hour,min,sec
0 , 0 , 0 , 0 , 0 , 0
j5: ; month table: jan, ..., dec
h. 365, 396, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334
w.
j11: 4 ; minutes per four minutes
j13: 24 ; hours per day
j14: 60 ; minutes per hour
j17: 365*3+366 ; days per four years (inclusive leap year)
j18: 10000 ; units per second
j20: 60*4 * 10000 ; units per four minutes
j30: <:oldcat:> ; name of successor-command
g49: ; date:
al w1 0 ; for i := 0 step 2 until 10 do
i0: ; begin
jl. w3 d16. ; next integer;
sl. w0 (x1+j0.) ; if number < min value
sl. w0 (x1+j1.) ; or number >= top value then
jl. g2. ; goto syntax error; (* i.e. illegal date *)
rs. w0 x1+j2. ; save number;
al w1 x1+2 ;
se w1 12 ;
jl. i0. ; end;
dl. w2 j2.+2 ; w1 := year; w2 := month;
sh w2 2 ; if month > february then
al w1 x1-1 ; year := year - 1;
al w1 x1-68 ; days := (year - 68)
wm. w1 j17. ; * days in four years
as w1 -2 ; / 4
ba. w1 x2+j5.-1 ; + month table (month)
wa. w1 j2.+4 ; + day;
wm. w1 j13. ; w1 := hours := days * 24
wa. w1 j2.+6 ; + hour;
al w2 0 ; w2w3 := min;
rl. w3 j2.+8 ;
wm. w1 j14. ; w0w1 := minutes := hours * 60
aa w1 6 ; + min;
wd. w1 j11. ; w1 := fourmin := minutes / 4;
wm. w0 j14. ; seconds := minutes mod 4 * 60
wa. w0 j2.+10 ; + sec;
wm. w0 j18. ; msec := seconds * 10000;
rl w3 0 ; (w2=0) w3 := msec;
wm. w1 j20. ; clock := fourmin * 2400000
aa w1 6 ; + msec;
jd 1<11+38; set clock (clock);
dl. w1 j30.+2 ; name := successor command name;
ds. w1 e21. ;
al w0 1 ; type := 1; <* i.e. pretend that 'oldcat' has been read *>
sl w0 (b25) ; if maincat not defined yet then
jl. g36. ; goto next command; <* i.e. interpret 'oldcat' *>
jl. g35. ; goto next command;
e. ;
b.i30 w. ; new:
; --------
g51:
la. w0 i0. ; abs addr(console):= all bs(console):=
; abs protection(console):=false;
rs w0 x1+c26 ; prio(console):= 0;
hs w0 x1+c37 ; pr(console):=illegal pr;
dl. w3 i2. ; buf claim(console):=standard buf;
ds w3 x1+c34 ; area claim(console):=standard area;
rl. w3 i3. ; internal claim(console):=standard int;
rs w3 x1+c39 ; cat mask(console):=standard cat;
rl. w0 i9. ;
rl. w3 i9. ;
ds w0 x1+c41+2 ; max interval(console):=max interval(s)
ds w0 x1+c42+2 ; standard interval(s)
ds w0 x1+c43+2 ;
jl. w3 d46. ; reset last of console;
rl. w2 i25. ; get work device name
jl. w3 d61. ; get devno*8
jl. g16. ; sorry goto end line
wa. w2 e25. ;
dl. w0 i6. ; perm claim(work device) :=
ds w0 x2+c44+6 ; standard segment,entries;
i10: dl. w3 i4. ; size(console):=standard size;
rl. w1 e25. ;
ds w3 x1+c40+2 ;
dl. w3 i5. ;
ds w3 x1+c40+6 ; prog(console):=standard prog;
al w3 1 ; <* for both 'new' and 'all' *>
rs. w3 e77. ; increase access indicator := true;
jl. g52. ; goto process;
i0:8.1771 ;
c7<12+c8 ; standard buf and area:
i2:c9<12+c10 ; standard int and func:
i3:c12 ; standard size:
i4=k+2, i5=k+6 ; standard prog:
<:fp:>,0,0,0 ;
c13 ; standard segment claim
i6:c14 ; standard entry claim
i8:8.2000 ; all bs resources bit
i9:8388605
i25: c15 ; work device name
c. (:c23>16a.1:)-1 ;
g83 = k ; all:
; ---------
la. w0 i0. ; abs addr(console):=
lo. w0 i8. ; abs prot(console):= false
rs w0 x1+c26 ; all bs(console):= true
rl. w2 b1. ;
dl w0 x2+a45 ;
ds w0 x1+c41+2 ; maxbase:=standardbase(s)
ds w0 x1+c42+2 ; standardbase:= ------
ds w0 x1+c43+2 ; userbase:= -------
bz w0 x2+a19 ; bufclaims(s)
ws. w0 e2. ; - ownbuf
hs w0 x1+c32 ; =: bufclaims(console)
bz w0 x2+a20 ; areaclaims(s)
ws. w0 e3. ; - own area
hs w0 x1+c33 ; =: areaclaims(console)
bz w0 x2+a21 ; internalclaims(s)
bs. w0 1 ; -1
hs w0 x1+c34 ; =:internalclaims(console)
bz w0 x2+a22 ; functionmask(s)
hs w0 x1+c35 ; =: functionmask(console)
al w0 0 ; size(console) := 0; <* i.e. max, see create child *>
rs w0 x1+c39 ;
jl. w3 d46. ; clear claimlist;
jl. i10. ;
z. ;
e.
b. j5 w.
g94: am c95-c96 ; i:
; -------
g95: al w1 x1+c96+2 ; o:
; -------
jl. w3 d16. ; get kind
rs w0 x1-2 ;
jl. j1. ; continue with get name
g52: am c29-c40 ; process:
; ---------
g53: al w1 x1+c40 ; program:
; ---------
j1: jl. w3 d15. ; next name;
rl. w3 j2. ; test name
sn. w3 ( e20.) ; if name="s"
jl. g3. ; then goto error : not allowed
dl. w3 e21. ;
ds w3 x1 +2 ;
dl. w3 e23. ;
ds w3 x1 +6 ; name(console):=name;
jl. g35. ; goto next command;
j2: <:s<0>:> ; (prevent blocking communication with s)
e.
;
m. step 1
;
; stepping stones
; ---------------
;
jl. (2) , l2 , d2 = k-4
jl. (2) , l15 , d15 = k-4
jl. (2) , l14 , d14 = k-4
jl. (2) , l16 , d16 = k-4
jl. (2) , l17 , d17 = k-4
jl. (2) , l18 , d18 = k-4
jl. (2) , l19 , d19 = k-4
jl. (2) , l20 , d20 = k-4
jl. (2) , l21 , d21 = k-4
jl. (2) , l22 , d22 = k-4
jl. (2) , l23 , d23 = k-4
jl. (2) , l24 , d24 = k-4
jl. (2) , l27 , d27 = k-4
jl. (2) , l34 , d34 = k-4
jl. (2) , l39 , d39 = k-4
jl. (2) , l41 , d41 = k-4
jl. (2) , l42 , d42 = k-4
jl. (2) , l44 , d44 = k-4
jl. (2) , l46 , d46 = k-4
jl. (2) , l51 , d51 = k-4
jl. (2) , l52 , d52 = k-4
jl. (2) , l53 , d53 = k-4
jl. (2) , l54 , d54 = k-4
jl. (2) , l55 , d55 = k-4
jl. (2) , l56 , d56 = k-4
jl. (2) , l57 , d57 = k-4
jl. (2) , l58 , d58 = k-4
jl. (2) , l61 , d61 = k-4
jl. (2) , l64 , d64 = k-4
jl. (2) , l74 , d74 = k-4
jl. (2) , l77 , d77 = k-4
jl. (2) , l78 , d78 = k-4
jl. (2) , g1 , g1 = k-4
jl. (2) , g3 , g3 = k-4
b.i24
w.g54:lo. w0 i0. ; address:
; ---------
hs w0 x1+c27 ; abs addr(console):=true;
am c30-c39 ;
g56: al w2 x1+c39 ; size:
; ---------
jl. w3 d16. ; next integer(integer);
sz w0 2.1 ;
bs. w0 1 ; integer(23):= 0;
c.(:a399>23a.1:)-1
al w1 0 ;
ld w0 -11 ;
se w1 0 ; if integer mod 2k <>0 then
ea. w0 1 ; round up
ls w0 11 ;
z.
rs w0 x2 +0 ; word param(console):=integer;
jl. g35. ; goto next command;
i0:1<1
e.
b.i10
w.
; mode :
; ----------
; syntax mode <short integer>
g55: la. w0 i2. ; abs protection=false
rs w0 4 ; w2=command mask
jl. w3 d16. ; next integer
sn w0 0 ; if mode=0 then
lo. w2 i3. ; abs protection=true
rs w2 x1+c26 ;
jl. g35. ; next command
g60: am c32-c33 ; buffer claim:
; -------------
g61: am c33-c34 ; area claim:
; -------------
g62: al w2 x1+c34 ; internal claim:
; ---------------
i1: jl. w3 d16. ; next integer(integer);
hs w0 x2 +0 ; byte param(console):=integer;
jl. g35. ; goto next command;
i2:8.7773
i3:1<2
e.
; cpa <cpavalue> or 0 or 1 :
; --------------------------
g59: jl. w3 d16. ; next integer
sh w0 -1 ; if < 0 then
jl. g8. ; write : illegal cpa
c.(:a399>23a.1:)-1
sz w0 (b216) ; if new cpa mod 2k<>0 then
jl. g8. ; write: illegal cpa
z.
rs w0 x1+c98 ;
jl. g35. ; goto next command
; function mask:
; --------------
g63: jl. w3 d45. ; next bitnumbers(bits, type);
ls w2 -12 ;
hs w2 x1+c35 ; function mask(console):=bits(0:11);
jl. g36. ; goto exam command;
; create:
; --------
b. i5 w.
i0: <:link<0>:>
g64: rl. w3 e22. ;
sn. w3 (i0.) ; if command=createlink then
jl. g112. ; goto createlink
jl. w3 d35. ;
rl. w2 e29. ; create child;
rl w0 x2+a17 ;
; wa w0 x2+a182
jl. w3 d36. ; modify child(first addr(child));
jl. g35. ; goto next command;
e.
; init:
; -------
g65: jl. w3 d35. ; create child;
jl. w3 d37. ; load child;
jl. g35. ; goto next command;
; run:
; -------
g66: rl. w1 e25. ;
jl. w3 d10. ; decrease access(console);
jl. w3 d35. ; create child;
jl. w3 d37. ; load child;
jl. w3 d38. ; start child;
jl. g35. ; goto next command;
; load:
; --------
g67: jl. w3 d34. ; check child;
jl. w3 d37. ; load child;
jl. g35. ; goto next command;
; start:
; ---------
g68: rl. w1 e25. ;
jl. w3 d10. ; decrease access(console);
jl. w3 d34. ; check child;
jl. w3 d38. ; start child;
jl. g35. ; goto next command;
; stop:
; --------
g69: jl. w3 d34. ; check child;
jl. w3 d39. ; stop child;
jl. g35. ; goto next command;
c.(:c23>22a.1:)-1 ; if break option then
g70 = k ; break:
; ---------
jl. w3 d34. ; begin check child;
jl. w3 d39. ; stop child;
rl. w2 e29. ;
rl w3 x2+a27 ; addr:=interrupt addr(child);
sn w3 0 ; if addr<>0 then
jl. g35. ; begin
wa w3 x2+a182 ; addr:=addr + base (physical)
dl w1 x2+a29 ; word(addr):=save w0(child);
ds w1 x3 +2 ; word(addr+2):=save w1(child);
dl w1 x2+a31 ; word(addr+4):=save w2(child);
ds w1 x3 +6 ; word(addr+6):=save w3(child);
dl w1 x2+a33 ; word(addr+8):=save ex(child);
ds w1 x3 +10 ; word(addr+10):=save ic(child);
al w1 8 ; word(addr+12):=8;
rs w1 x3 +12 ;
ws w3 x2+a182 ; addr:=addr - base (logical)
al w0 x3+a180 ; modify child(addr+a180);
jl. w3 d36. ; start child;
jl. w3 d38. ; end;
jl. g35. ; goto next command;
z.
; remove:
; ---------
b. i24 w.
i0: <:link<0>:>
g71: rl. w3 e22. ;
sn. w3 (i0.) ; if command=removelink then
jl. g113. ; goto removelink
jl. w3 d34. ; check child;
jl. w3 d39. ; stop child;
jl. w3 (i1.) ; adjust bs-claims
jl. w3 d40. ; remove child;
jl. g35. ; goto next command;
; cleanup:
g104: ; cleanup:
; ----------
rl. w3 e15.+c20 ; while first of core table <> core table head do
sn. w3 e15. ; begin
jl. g35. ; done: goto next command;
rs. w3 e30. ; coretable element:=first of coretable;
rl w0 x3+c17 ; child:= child(first of core table);
rs. w0 e29. ;
jl. w3 d39. ; stop process;
jl. w3 (i1.) ; adjust bs-claims;
jl. w3 d40. ; remove child;
jl. g104. ; end;
i1: d76
e.
c.(:c23>21a.1:)-1 ; if include/exclude option then
g72 = k ; include:
; ------------
am 2 ;
g73 = k ; exclude:
; ------------
b.i24 w. ; begin
rl. w3 i2. ;
rs. w3 i1. ;
jl. w3 d34. ; check child;
i0: jl. w3 d2. ; more:
se w0 2 ; next param(type);
jl. g36. ; if type<>2
rl. w1 e25. ; then goto exam command;
al w3 x1+c29 ;
rl. w1 e19. ; include/exclude(name(console),
i1: am 0 ; integer,result);
se w0 0 ; if result=0
jl. g16. ; then goto more
jl. i0. ; else goto end line;
i2: jd 1<11+14 ;
jd 1<11+12 ;
e.z.
c.(:c23>20a.1:)-1 ; if call option then
g74 = k ; call:
; --------
b.i24 w. ; begin
i0: jl. w3 d2. ; more: next param(type);
se w0 2 ; if type<>2
jl. g36. ; then goto exam command;
rl. w1 e19. ; device:=integer;
jl. w3 d15. ; next name;
al. w3 e20. ; create peripheral process(
jd 1<11+54 ; name,device,result);
sn w0 3 ; if result=3
jl. g10. ;
sn w0 4 ; or result=4
jl. g16. ;
sn w0 5 ; or result=5
jl. g17. ; then goto end line
jl. i0. ; else goto more;
e.
z.
c.(:c23>19a.1:)-1 ; if list option then
b.i24 w. ; begin
g75 = k ; list:
; ---------
rl w2 b6 ;
i1: sl w2 (b7) ; for i:=first internal step 1
jl. g35. ; until last internal do
rl w1 x2 ;
rl w0 x1+a11 ; if name=0
rl w3 x1+a34 ; or
al w2 x2 +2 ; parent=0
rs. w2 e78. ;
se w0 0 ;
sn w3 0 ; else
jl. i1. ; begin
jl. w3 d19. ; initwrite
rl w2 x2 -2 ;
al w1 x2+a11 ;
jl. w3 d21. ; writetext(processname)
ac w1 x1 -12 ;
jl. w3 d70. ; writespace(no af spaces)
rl w1 x2+a17 ;
wa w1 x2+a182
al w0 8 ;
jl. w3 d71. ; writeint(first core,8)
rl w1 x2+a18 ;
ws w1 x2+a17 ;
al w0 8 ;
jl. w3 d71. ; writeint(coresize,8)
rl w1 x2+a301 ;
al w0 4 ;
jl. w3 d71. ; writeint(priority,8)
zl w1 x2+a12 ;
al w0 4 ;
jl. w3 d71. ; writeint(stopcount,4)
bl w0 x2+a13 ; w0 := process state;
;
al. w3 i9. ; write process state:
sz w0 2.10000000 ; if not waiting then
jl. i3. ; begin
sz w0 2.00000011 ; if not running then
jl. i2. ;
jl. w1 d21. ; writetext(<:error :>)
<: error :> ;
i2: jl. w1 d21. ; else
<: running :> ; writetext(<:running :>;
i3: ; end else
so w0 2.10100000 ; if waiting for stop or start then
jl. i4. ; writetext(<:stop :>)
jl. w1 d21. ;
<: stopped :> ; else
i4: sz w0 2.00000111 ; if waiting for cpu then
jl. i5. ; writetext(<:waiting cpu :>)
jl. w1 d21. ;
<: wait cpu :> ; else
i5: so w0 2.00000011 ; if waiting for event then
jl. i6. ; writetext(<:waiting event :>)
jl. w1 d21. ;
<: wait evnt :> ; else
i6: sz w0 2.00000011 ; if waiting for procfunc then
jl. i7. ; writetext(<:waiting proc :>)
jl. w1 d21. ;
<: wait proc :> ; else
i7: so w0 2.00000001 ; if waiting for message then
jl. i8. ; writetext(<:waiting mess :>)
jl. w1 d21. ;
<: wait mess :> ; else
i8: jl. w1 d21. ; writetext(<:waiting answ :>);
<: wait answ :> ;
i9: ; comment: return from writetext;
rl w1 x2+a34 ;
al w1 x1+a11 ;
jl. w3 d21. ; writetext(parent)
al w0 10 ;
jl. w3 d20. ; writechar(nl)
jl. w3 d23. ; typeline(buf)
jl. w3 d42. ; save work(buf)
jl. g47. ; +2 error goto end line
rl. w2 e78. ;
jl. i1. ;
e.
z.
c.(:c23>18a.1:)-1 ; if max option then
g76 = k ; max:
b.i24 w. ; begin
al. w1 g26. ;
jl. w3 d21. ; writetext(<:max:>);
am -2048 ;
jl. w3 d29.+2048; find max(size);
jl. w3 d22. ; writeinteger(size);
al w0 32 ;
jl. w3 d20. ; writechar(32);
rl. w2 b1. ;
bz w1 x2+a19 ;
ws. w1 (v2.) ; writeinteger(buf claim(s)
jl. w3 d22. ; -own buf);
al w0 32 ;
jl. w3 d20. ; writechar(32);
bz w1 x2+a20 ;
ws. w1 (v3.) ; writeinteger(area claim(s)
jl. w3 d22. ; -own area);
al w0 32 ;
jl. w3 d20. ; writechar(32);
bz w1 x2+a21 ;
jl. w3 d22. ; writeinteger(internal claim(s));
al w0 32 ;
jl. w3 d20. ; writechar(32);
c.-4000
al w2 8 ; keys:=8;
jl. w3 d32. ; find keys(keys,pr,pk,
jl. i0. ; typekeys);
am 0 ;
i0: ac w1 x2 -8 ; typekeys:
jl. w3 d22. ; writeinteger(8-keys);
z.
al w0 10 ;
jl. w3 d20. ; writechar(10);
jl. w3 d23. ; typeline(buf);
jl. w3 d42. ; save work(buf);
jl. g47. ;+2: error: goto end line;
jl. g35. ; goto next command;
e.
z.
c.(:c23>17a.1:)-1 ; if replace option then
g77 = k ; replace:
; ----------
b.i24 w. ; begin
jl. w3 d15. ; next name;
rl. w3 v20. ;
jd 1<11+52 ; create area process(name,result);
sn w0 2 ;
jl. g11. ; if result=2
se w0 3 ; or result=3
sn w0 4 ; or result=4 then
jl. g12. ; goto end line;
al. w1 e51. ;
rl. w3 b1. ; next buffer:
i0: al w2 0 ; buf:=0;
jd 1<11+24 ; wait event(buf);
jd 1<11+26 ; get event(buf);
ba. w0 1 ; result:=result+1;
sn w0 1 ; if result=1 then
jd 1<11+22 ; send answer(buf,answer,result);
rl w0 x3+a15 ; next:=word(event q(proc));
se w0 x3+a15 ; if next<>event q(proc) then
jl. i0. ; goto next buffer;
al. w3 (v20.) ;
jd 1<11+8 ; reserve process(name,result);
sn w0 1 ; if result=1 then
jl. i2. ; goto give up;
al. w1 e51. ;
jd 1<11+42 ; lookup entry(name,tail,result);
sn w0 2 ; if result=2 then
jl. i3. ; goto give up;
bz. w0 e59. ;
se w0 8 ; if content<>8 then
jl. i4. ; goto give up;
rl. w1 e60. ;
al w1 x1+511 ;
ls w1 -9 ; load size:=
ls w1 9 ; (bytes(tail)+511)/512*512;
jl. w3 d27. ; find size(start,size,give up);
jl. i6. ;
wa w1 0 ; last addr(area mess):=
al w1 x1 -2 ; first addr+load size-2;
ds. w1 (v49.) ; first addr(area mess):= first addr;
rl. w1 (v58.) ; segment(area mess):=
rs. w1 (v50.) ; segment(tail);
bz. w1 (v67.) ;
wa w1 0 ;
rs. w1 i20. ; entry:= first addr+entry(tail);
rl. w3 (v49.) ;
sh w1 x3 ; if entry>last addr(area mess) then
jl. 4 ;
jl. i5. ; goto give up;
al. w1 (v47.) ;
rl. w3 v20. ;
jd 1<11+16 ; send mess(name,area mess,buf);
al. w1 (v51.) ;
jd 1<11+18 ; wait answer(buf,answer,result);
rl. w1 (v51.) ;
lo w1 0 ; res:= status or result;
jd 1<11+64 ; remove process(name,result);
se w1 1 ; if res <> 1 then
jl. g15. ; goto sorry;
rl. w0 i22. ;
rs. w0 g30. ;
jl. g1. ;
i12: rl. w1 (v24.) ; ok:
rl w2 x1+c50 ; buf:= state(work);
jd 1<11+18 ; wait answer(buf,work,result);
ld w1 -100 ; w0:= w1:= 0;
rl. w2 (v25.) ;
rl w2 x2+c25 ; w2:=process descr.(console)
xl. 0 ; ex:= 0;
jl. (i20.) ; goto entry;
i2: am g13-g11;
i3: am g11-g12;
i4: am g12-g14;
i5:
i6: al. w2 g14. ; give up:
rl. w3 v20. ;
jd 1<11+64 ; remove process(name,result);
jl x2 +0 ; goto end line;
i20: 0 ; entry
i22: jl. i12-g30 ; return to ok
e.
z.
; closecatopr
; -----------
;
; closecatopr
;
b. i5, j5 w.
g119: ; closecatopr
; begin
rl. w1 i0. ; first core := first free core;
rs. w1 (v16.) ;
al w1 0 ;
rl. w3 (v12.) ; command table end := 0;
rs w1 x3 ;
jl. g35. ; goto next command;
i0: h11 ; top of resident commands;
e. ; end;
; priviliged
; -----------
;
; priviliged
;
b. i5, j5 w.
g124: ; priviliged
; begin
jl. w3 d15. ; next_name;
rl. w1 v20. ; begin
rl. w3 (v35.) ;
rl w2 x3+c20 ;
sn w2 (x3+c21) ; if number of free consolbuffs < 2 then
jl. g126. ; write 'no free';<* dont use the last one *>
al w0 x1-2 ; pseudo_pd:=name area address -2
jl. w3 d64. ; find_and_select_console_2(pseudo_pd_addr,consol_buf);
jl. g126. ; not_found: goto no consolbuffers;
al w3 2.1000 ;
lo w3 x1+c27 ;
hs w3 x1+c27 ; set(privileged);
jl. w3 d17. ; remove_element(console);
jl. g35. ; else goto next command;
; end;
; unprivileged
; -----------
;
; unprivileged
;
g125: ; unprivileged
; begin
jl. w3 d15. ; next_name;
rl. w1 v20. ; begin
al w0 x1-2 ; pseudo_pd:=name area address -2
jl. w3 d44. ; find_console(pseudo_pd_addr,console_buf);
jl. g22. ;not_found: goto unknown;
am (b4) ;found:
rl w3 a199<1 ;
se w3 (x1+c25) ; if console = mainconsole or
se w1 (x1+2) ; not unlinked then
jl. g3. ; goto not allowed;
zl w3 x1+c27 ;
al w3 x3-2.1000 ; remove privileged;
hs w3 x1+c27 ;
rl. w2 v35. ;
jl. w3 d18. ; insert_in_free(console);
jl. g35. ; else goto next command;
e. ; end;
;
m. step 2 g-names
;
; stepping stone
;
jl. (2), g2, g2=k-4
jl. (2), g9, g9=k-4
jl. (2), g11, g11=k-4
jl. (2), g15, g15=k-4
jl. (2), g16, g16=k-4
jl. (2), g19, g19=k-4
jl. (2), g20, g20=k-4
jl. (2), g21, g21=k-4
jl. (2), g22, g22=k-4
jl. (2), g27, g27=k-4
jl. (2), g31, g31=k-4
jl. (2), g35, g35=k-4
jl. (2), g36, g36=k-4
jl. (2), g47, g47=k-4
jl. (2), g66, g66=k-4
c.(:a80>16a.1:)-1 ; <* include connect, disconnect, link, unlink, linkall
; and initkit if itc device drivers are included *>
b. p21 w. ; itc controller command block
p0 = 6 ; size of logical disc description
c. -1
p1: <:connect error <0>:>
p2: <: connected to<0>:>
p3: <:disconnect error <0>:>
p4: <:link error <0>:>
p5: <:logical disc linked on<0>:>
p6: <:unlink error <0>:>
p7: <:disc error <0>:>
p8: <:illegal devno<0>:>
p9: 0,0,0,0 ; name save area
p10: 0 ; param area: cm / log devno
0 ; unit / phys devno
0 ; devno or -1 / first segment
0 ; kind, type / no of segments
5 ; max outstanding operations
p11: h23 ; first of disc buffer
p12: h24 ; last of disc buffer
p13: <:unknown <0>:> ; device name table
p14: <:disc <0>:>
p15: <:terminal<0>:>
p16: <:printer <0>:>
p17: <:tape <10>:>
p18: <:idamain <0>:>
p19: <:ifpmain <0>:>
p20: <:gsd<0>:>
; connect:
; --------
;
; connect <name of itcmain> <device kind> <device type> <cm> <unit> (<device no>)
;
b. i5, j5 w.
g112: ; connect
; begin
jl. w3 d15. ; next name; <* itc main process name *>
dl. w0 (v21.) ; <* move name to local save area *>
ds. w0 p9.+2 ;
dl. w0 (v23.) ;
ds. w0 p9.+6 ;
al. w1 p10. ;
jl. w3 d16. ; param.device type := next integer;
hs w0 x1+6+0 ;
jl. w3 d16. ; param.device kind := next integer
hs w0 x1+6+1 ;
;
jl. w3 d16. ; param.cm := next integer;
rs w0 x1+0 ;
jl. w3 d16. ; param.unit := next integer;
rs w0 x1+2 ;
;
jl. w3 d2. ; param.devno :=
rs. w0 (v78.) ; if next param = integer then param
al w1 -1 ; else -1;
sn w0 2 ;
rl. w1 (v19.) ; <* type of param is saved for later use
al. w2 p10. ; to determine whether the next command
rs w1 x2+4 ; has been read or not *>
al. w1 p9. ;
jl. w3 d51. ; connect(itcmain, param);
jl. j1. ; +0:
; +2: if not error then
jl. w3 d19. ; begin initwrite;
rl. w2 v51. ;
rl w1 x2+2 ;
ls w1 +1 ; connection :=
wa w1 b4 ; name table(answer.devno);
rl w2 x1 ;
al. w1 p13. ;
rl w0 x2 ; text:=
; device name table(answer.device kind);
sn w0 q6 ;
al. w1 p14. ;
sn w0 q8 ;
al. w1 p15. ;
sn w0 q14 ;
al. w1 p16. ;
sn w0 q18 ;
al. w1 p17. ;
sn w0 q20 ;
al. w1 p18. ;
sn w0 q26 ;
al. w1 p19. ;
sn w0 q28 ;
al. w1 p20. ;
jl. w3 d21. ; write(text);
rl w1 x2+a67 ;
jl. w3 d22. ; writeinteger(connection.cm);
rl w1 x2+a68 ;
jl. w3 d22. ; writeinteger(connection.unit);
al. w1 p2. ;
jl. w3 d21. ; write(<:connected to:>);
am. (v51.) ;
rl w1 +2 ;
jl. w3 d22. ; writeinteger(answer.devno);
jl. j2. ; end
j1: ; else begin
rl w2 0 ; <*save logical status*>
jl. w3 d19. ; initwrite;
al. w1 p1. ;
jl. w3 d21. ; write(<:connect error:>);
al w1 x2 ;
jl. w3 d14. ; writebits(logical status);
; end;
j2: ;
al w0 10 ;
jl. w3 d20. ; writechar(nl);
jl. w3 d23. ; type line(buf);
jl. w3 d42. ; save work(buf);
am 0 ; +0 ignore output error
rl. w0 (v78.) ; +2: else <get type of last read param >;
sn w0 2 ; if last read param = integer then
jl. g35. ; goto next command
jl. g36. ; else goto exam command;
;
i1: 0 ;
e. ; end;
; disconnect:
; -----------
; *
; disconnect (<device number>)
; 0
b. i5, j5 w.
g113: ; disconnect
jl. w3 d2. ; if next param <> integer then
se w0 2 ; goto exam command
jl. g36. ; else begin
rl. w0 (v19.) ; deviceno := read integer;
jl. w3 d52. ; disconnect(deviceno, logical status);
sz ; +0: if error then goto error
jl. g113. ; +2: else goto disconnect;
;
rl w2 0 ; error:
al. w1 p3. ; save error cause;
jl. w3 d21. ; writetext(<:disconnect error:>;
al w1 x2 ;
jl. w3 d14. ; writebits(logical status);
al w0 10 ;
jl. w3 d20. ; writechar(nl);
jl. w3 d23. ; type line(buf);
jl. w3 d42. ; save work(buf);
jl. g47. ; +0: if error then goto endline
jl. g113. ; +2: else goto disconnect
;
e. ; end;
z.
p1: <:createlink error <0>:>
p2: <: linked to<0>:>
p3: <:removelink error <0>:>
p4: <:link error <0>:>
p5: <:logical disc linked on<0>:>
p6: <:unlink error <0>:>
p7: <:disc error <0>:>
p8: <:illegal devno<0>:>
0,0,0,0 ;
p9: 0,0,0,0 ; name save area
; param area
; create link link logical disk
; disk/tape console/floppy
p10: 0 ; slave no kind log devno
0 ; facility no unused phys devno
0 ; devno or -1 devno or -1 first segment
0 ; kind, type unused no of segments
5 ; max outstanding operations
;
p11: h23 ; first of disc buffer
p12: h24 ; last of disc buffer
p13: <:unknown <0>:> ; device name table
p14: <:disc <0>:>
p15: <:console <0>:>
p16: <:printer <0>:>
p17: <:tape <0>:>
p20: <:gsd<0>:>
; createlink:
; --------
;
; createlink <main> <device type> <devicename>.<device no> (<slave> <facility>)
;
b. i5, j5 w.
i4=10 ; size of one element in create link param list
i5= 8 ; position of kind,modif in create link param list
g112: ; create link
; begin
jl. w3 d15. ; next name; <* main process name *>
dl. w0 (v21.) ; <* move name to local save area *>
ds. w0 p9.+2 ;
dl. w0 (v23.) ;
ds. w0 p9.+6 ;
jl. w3 d15. ; next_name;
dl. w0 (v21.) ;
rl. w1 i2. ;
al w1 x1-i4 ;
j0: al w1 x1+i4 ; pointer:=next_from_list;
sl. w1 (i3.) ; if not end of list then
jl. g2. ; begin
sn w3 (x1) ; if param.name<>name.list then
se w0 (x1+2) ;
jl. j0. ; goto next;
al. w2 p10. ;
rl w1 x1+i5 ; else c_param.device_kind:=kind;
rs w1 x2+6 ; c_param.type:=type;
; end else goto syntax error;
jl. w3 d15. ; next_name;
dl. w0 (v21.) ; <* move name to local save area *>
ds. w0 p9.-6 ;
dl. w0 (v23.) ;
ds. w0 p9.-2 ;
jl. w3 d16. ; next_integer;
rs w0 x2+4 ; c_param.device_no:=param.device_no;
zl w0 x2+6+0 ;
se w0 18 ; if tape or
sn w0 6 ; disc then
sz ;
jl. j3. ; begin
;
jl. w3 d16. ; c_param.slave:= param.slave;
rs w0 x2+0 ;
jl. w3 d16. ; c_param.unit := param.slave;
am 2 ; end else
j3: rs w0 x2+0 ; c_param.kind:=param:=kind;
dl. w0 p9.-6 ; move name to work
ds. w0 (v21.) ;
dl. w0 p9.-2 ;
ds. w0 (v23.) ;
al. w1 p9. ;
jl. w3 d51. ; create_link(main, c_param);
jl. j1. ; +0:
; +2: if not error then
al. w3 (v20.) ;
;
al w1 x2 ;
jd 1<11+54; create_peripheral_process(name,dev_no);
se w0 0 ; if result<>ok then
jl. 2 ; no action
jl. w3 d19. ; begin initwrite;
rl. w2 v51. ;
rl w1 x2+2 ;
ls w1 +1 ; link :=
wa w1 b4 ; name table(answer.devno);
rl w2 x1 ;
al. w1 p13. ;
rl w0 x2 ; text:=
; device name table(answer.device kind);
sn w0 q6 ;
al. w1 p14. ;
sn w0 q8 ;
al. w1 p15. ;
sn w0 q14 ;
al. w1 p16. ;
sn w0 q18 ;
al. w1 p17. ;
sn w0 q28 ;
al. w1 p20. ;
jl. w3 d21. ; write(text);
rl w1 x2+a67 ;
jl. w3 d22. ; writeinteger(link.slaveno);
rl w1 x2+a68 ;
jl. w3 d22. ; writeinteger(link.unit);
al. w1 p2. ;
jl. w3 d21. ; write(<:linked to:>);
am. (v51.) ;
rl w1 +2 ;
jl. w3 d22. ; writeinteger(answer.devno);
jl. j2. ; end
j1: ; else begin
rl w2 0 ; <*save logical status*>
jl. w3 d19. ; initwrite;
al. w1 p1. ;
jl. w3 d21. ; write(<:link error:>);
al w1 x2 ;
jl. w3 d14. ; writebits(logical status);
; end;
j2: ;
al w0 10 ;
jl. w3 d20. ; writechar(nl);
jl. w3 d23. ; type line(buf);
jl. w3 d42. ; save work(buf);
am 0 ; +0 ignore output error
jl. g35. ; goto next command
;
i1: 0 ;
i2: h14 ; start of name list
i3: h15 ; end of name list
e. ; end;
; removelink:
; -----------
; * *
; removelink (<device number>) (<device name>)
; 0 0
b. i5, j5 w.
g113: ; removelink
jl. w3 d2. ;
sn w0 0 ; if empty then
jl. g35. ; goto next param;
sn w0 1 ; if next param=name then
jl. j3. ; goto find_devno else
; if next param <> integer then
se w0 2 ; goto exam command
jl. g36. ; else begin
rl. w0 (v19.) ; deviceno := read integer;
j0: rl. w3 (v109. ; save last read char
rs. w3 (v78.) ; in work;
jl. w3 d52. ; removelink(deviceno, logical status);
jl. j4. ; +0: if error then goto error
rl. w3 (v78.) ; +2: else test next;
se w3 10 ; if not end of line then
jl. g113. ; goto get next param;
jl. g35. ; else goto next command;
j4:
rl w2 0 ; error:
al. w1 p3. ; save error cause;
jl. w3 d21. ; writetext(<:removelink error:>;
al w1 x2 ;
jl. w3 d14. ; writebits(logical status);
j2: al w0 10 ;
jl. w3 d20. ; writechar(nl);
jl. w3 d23. ; type line(buf);
jl. w3 d42. ; save work(buf);
jl. g47. ; +0: if error then goto endline
jl. g35. ; +2: else goto next param
; end;
j3: jl. w3 g123. ; find_devno(name);
jl. j2. ; error: goto out line;
jl. j0. ; ok: goto removelink
e. ; end;
; link logical disc
; -----------------
;
; link <devno of phys. disc> <first segment> <no of segm.> (<devno of log. disc>)
;
b. i5, j5 w.
g114: ; link
al. w2 p10. ; begin
jl. w3 d16. ; param.physical disc devno := next integer;
rs w0 x2+2 ;
jl. w3 d16. ; param.first segment := next integer;
rs w0 x2+4 ;
jl. w3 d16. ; param.no of segments:= next integer;
rs w0 x2+6 ;
;
jl. w3 d2. ; param.log-devno :=
rs. w0 (v78.) ; if next param = integer then
al w1 -1 ; integer
sn w0 2 ; else -1;
rl. w1 (v19.) ;
rs w1 x2+0 ;
;
jl. w3 d53. ; link(param, logical status, devno);
am p4.-p5.; +0: text := if error then <:link error:>
al. w1 p5. ; +2: else <:logical disc...:>;
rs. w0 i1. ;
jl. w3 d21. ; writetext(text);
rl. w1 i1. ;
se w1 1<1 ; if logical status = ok then
jl. j1. ; writeinteger(devno)
al w1 x2 ; else writebits(logical status);
jl. w3 d22. ;
sz ;
j1: jl. w3 d14. ;
al w0 10 ;
jl. w3 d20. ; writechar(nl);
jl. w3 d23. ; typeline(buf);
jl. w3 d42. ; save work(buf);
jl. g47. ; +0: if error then goto end line
rl. w0 (v78.) ; +2: else <get type of last read param>;
sn w0 2 ; if last read param = integer then
jl. g35. ; goto next command
jl. g36. ; else goto exam command;
;
i1: 0 ;
e. ; end;
; unlink logical disc
; -------------------
; *
; unlink (<device number>)
; 0
b. i5, j5 w.
j0: jl. w3 d19. ; init write
g115: ; unlink
jl. w3 d2. ; if next param <> integer then
se w0 2 ; goto exam command
jl. g36. ; else begin
rl. w0 (v19.) ; devno := read integer;
jl. w3 d54. ; unlink(devno);
sz ; +0: if error then goto error
jl. g115. ; +2: else goto unlink;
; error:
al w2 x1 ;
al. w1 p6. ;
jl. w3 d21. ; writetext(<:unlink error:>);
al w1 x2 ;
jl. w3 d14. ; writebits(logical status);
al w0 10 ;
jl. w3 d20. ; writechar(nl);
jl. w3 d23. ; typeline(buf);
jl. w3 d42. ; save work(buf);
jl. g47. ; +0: if error then goto endline
jl. j0. ; +2: else goto next unlink;
;
e. ; end;
z.
;
m. step 2
;
; stepping stones
;
jl. (2) , l2 , d2 = k-4
jl. (2) , l15, d15= k-4
jl. (2) , l16, d16= k-4
jl. (2) , l34, d34= k-4
jl. (2) , l39, d39= k-4
jl. (2) , l42, d42= k-4
jl. (2) , l46, d46= k-4
jl. (2) , l61, d61= k-4
jl. (2) , l74, d74= k-4
jl. (2) , l77, d77= k-4
jl. (2) , l78, d78= k-4
jl. (2) , g2, g2 = k-4
jl. (2) , g11, g11= k-4
jl. (2) , g12, g12= k-4
jl. (2) , g13, g13= k-4
jl. (2) , g15, g15= k-4
jl. (2) , g35, g35= k-4
jl. (2), g111, g111= k-4
c.(:a80>16a.1:)-1
; linkall
; -------
;
; linkall <devno of phys. disc> / <name of phys. disc>
;
b. i5, j15 w.
g116: ; linkall <main entrypoint>
jl. w3 d2. ;
sn w0 1 ; if next param=name then
jl. j11. ; goto find_devno else
; if next param <> integer then
se w0 2 ; goto exam command
jl. g36. ; else begin
rl. w0 (v19.) ; deviceno := read integer;
j0: al w3 0 ; execute reentrant code := false;
rs. w3 (v89.) ; <nessesary as kiton is called>
al. w3 g35. ; <return address := next command>
;
g118: ; linkall <2nd entrypoint>
rs. w3 (v83.) ; begin
rs. w0 (v101.) ; w0: devno of link
rs. w0 (v102.) ; w3: link
rl w1 0 ;
jl. w3 d56. ; check device(devno);
jl. j9. ; +0: if error or
sn w0 6 ; +2: not (kind of device = idadisc and
se w3 0 ; type of device = physical disc) then
jl. j9. ; goto <illegal devno>;
;
rl. w1 (v24.) ;
rs. w1 (v104.) ; user of buffer := current work;
rl. w1 (v101.) ;
al w0 0 ;
jl. w3 d55. ; read segment(0,devno of readdevice);
jl. j10. ; +0: if error then goto disc error;
; +2:
rl. w1 p11. ; pointer :=
rl w2 x1+0 ; (buffer.no of files * 2 + 1) * 2;
ls w2 +1 ;
al w2 x2+1 ;
ls w2 +1 ;
am x1 ; pointer :=
al w2 x2+2 ; pointer + buffer.start + 2; <skip 'no of log discs'>
rs. w2 (v103.) ;
sl. w2 (p11.) ; if not pointer within buffer then goto finis;
sl. w2 (p12.) ; <*uninitialized description*>
jl. j7. ;
zl w0 x2-2 ; size of log disc description :=
sn w0 0 ; if buffer(pointer - 2)=0 then default size
al w0 p0 ; else
rs. w0 (v105.) ; buffer(pointer - 2);
;
j3: jl. w3 d19. ; while true do
rl. w0 (v24.) ; begin
sn. w0 (v104.) ; init write;
jl. j4. ;
rs. w0 (v104.) ; if user of buffer <> current work then
al w0 0 ; begin user of buffer := current work;
rl. w1 (v101.) ;
jl. w3 d55. ; read segment(0, devno of read device);
jl. j10. ; +0: if error then goto disc error;
rl. w2 (v103.) ; +2:
; end;
j4: ;
dl w0 x2+2 ; if buffer(pointer).first segment = -1 then
sn w3 -1 ; goto finis;
jl. j7. ;
ds. w0 p10.+6 ; param.first segment := buffer(pointer+0);
; param.no of segments:= buffer(pointer+2);
el w3 x2+5 ; param.log devno := buffer(pointer+5);
rl. w0 (v102.) ; param.phys devno:= devno;
ds. w0 p10.+2 ;
al. w2 p10. ;
jl. w3 d53. ; link(param, devno);
jl. j1. ; +0: if error then goto linkerror;
rl. w1 (v103.) ; +2:
zl w1 x1+4 ;
ls w1 -1 ; if buffer (pointer).type = rc8000 catalog and
rl. w3 (v12.) ; kiton-command still valid then
rl w3 x3 ;
sn w1 1 ; kiton(devno)
sn w3 0 ;
jl. j2. ;
jl. w3 (i2.) ;
jl. j6. ; else
j1: am p4-p5 ; begin
j2: al. w1 p5. ; text := if linkerror then <:link error:>
rs. w0 i1. ; else <:logical disc..:>;
jl. w3 d21. ; write(text);
rl. w1 i1. ;
se w1 1<1 ; if logical status = ok then
jl. j5. ; begin
rl. w1 (v54.) ; if answer.first segment = 0 then
sn w1 0 ; devno of read device := devno;
rs. w2 (v101.) ;
al w1 x2 ;
jl. w3 d22. ; writeinteger(devno);
sz ; end
j5: jl. w3 d14. ; else writebits(logical status);
al w0 10 ;
jl. w3 d20. ; writechar(nl);
jl. w3 d23. ; typeline(buf);
jl. w3 d42. ; save work(buf);
am 0 ; +0: error:
; +2:
j6: ; end;
rl. w2 (v103.) ;
wa. w2 (v105.) ; pointer := pointer + size of log disc descrp;
rs. w2 (v103.) ;
jl. j3. ; end ***while true do***;
;
j7: ; finis:
rl. w3 (v83.) ; return;
jl x3 ;
;
j9: ; illegal devno:
al. w1 p8. ; writetext(<illegal devno>);
jl. w3 d21. ;
jl. j8. ; goto writebuf;
;
j10: ; disc error:
al w2 x1 ;
al. w1 p7. ;
jl. w3 d21. ; write(<:disc error:>);
al w1 x2 ;
jl. w3 d14. ; writebits(logical status);
j8: al w0 10 ; writebuf:
jl. w3 d20. ; writechar(nl);
jl. w3 d23. ; typeline(buf);
jl. w3 d42. ; save work(buf);
am 0 ; +0:
jl. j7. ; +2: goto finis;
; end;
j11:
al. w3 g35. ; <return address := next command>
rs. w3 (v83.) ; used at error return
jl. w3 g127. ; find_devno;
jl. j8. ; error: goto out line;
jl. j0. ; ok: goto linkall
;
i1: 0 ;
i2: 0 ; kiton entry point
b135 = i2 ; <initialized in init part of the next slang segm.>
;
e. ;
;
; initkit
; -------
;
; *
; initkit <devno of physical device> (<size> <devno of logical disc>)
; 0
b. i5, j10 w.
g117: ; initkit
jl. w3 d16. ; begin
rs. w0 (v102.) ; physical disc := next integer;
rl w1 0 ;
jl. w3 d56. ; check device(physical disc);
jl. g16. ; +0: if error or
sn w0 6 ; +2: not (kind of device = idadisc and
se w3 0 ; type of device = physical disc) then
jl. g16. ; goto <device unknown>;
;
rl. w0 (v24.) ; user of buffer := current work;
rs. w0 (v104.) ;
;
al w0 -1 ; clear the buffer:
rl. w1 p11. ; for i := buffer.first step 2 until buffer.top do
j1: rs w0 x1+0 ; buffer(i) := -1;
al w1 x1+2 ;
sh. w1 (p12.) ;
jl. j1. ;
;
rl. w1 p11. ; init buffer:
rl. w2 i3. ; displace := 0;
j2: rl w0 x2+0 ; while more in default desc do
rs w0 x1+0 ; begin
al w1 x1+2 ; buffer(buffer.first+displace) :=
al w2 x2+2 ; default(default.start+displace);
se. w2 (i4.) ; displace := displace + 2;
jl. j2. ; end;
;
rl. w1 p11. ; displace :=
rl w2 x1+0 ; (buffer.no of files * 2 + 1) * 2;
ls w2 +1 ;
al w2 x2+1 ;
ls w2 +1 ;
am x1 ; pointer := buffer.start + displace;
al w2 x2 ;
rs. w2 (v103.) ; <save pointer to 'no of log discs'>
zl w1 x2+1 ; no of log disc := buffer.no of log discs;
al w2 x2+2 ; pointer :=
al w0 p0 ; pointer + 2 + (no of log discs * size of descrip);
wm w0 2 ;
wa w2 0 ;
;
j3: jl. w3 d2. ;
se w0 2 ; while next param = integer do
jl. j4. ; begin
rl. w0 (v19.) ; cur desc := buffer(pointer);
rs w0 x2+2 ; cur desc.no of segments := integer;
al w0 0 ; cur desc.first segment :=
se w1 0 ; if no of log discs = 0 then 0
rl w0 x2-p0 ; else
se w1 0 ; prev desc.first segment +
wa w0 x2-p0+2 ; prev desc.no of segments;
rs w0 x2+0 ;
jl. w3 d16. ; cur desc.type := data_disc,
ls w0 +12 ; include sender as user;
ls w0 -12 ; cur desc.rc8000devno := next integer;
rs w0 x2+4 ;
al w1 x1+1 ; no of log discs := no of log discs + 1;
al w2 x2+p0 ; pointer := pointer + size of descrip;
jl. j3. ; end <*.while *>;
;
j4: ;
rl. w2 (v103.) ; buffer.no of log disc := no of log discs;
hs w1 x2+1 ;
al w1 p0 ; buffer.size of log disc descrp := size of disc descr;
hs w1 x2+0 ;
rs. w0 (v78.) ; <save kind of param>
al w0 0 ;
rl. w1 (v102.) ;
jl. w3 d57. ; write segment(0, device no);
jl. j5. ; +0: if error then goto disc error
rl. w0 (v78.) ; +2: else goto exam command
jl. g36. ; <with restored param type>
;
j5: ; disc error:
rl w2 0 ;
al. w1 p7. ;
jl. w3 d21. ; write text(:disc error:);
al w1 x2 ;
jl. w3 d14. ; writebits(logical status);
al w0 10 ;
jl. w3 d20. ; writechar(nl);
jl. w3 d23. ; type line(buf);
jl. w3 d42. ; save work(buf);
jl. g47. ; +0: if error then goto endline
rl. w0 (v78.) ; +2: else goto exam command;
jl. g36. ; <with restored param type>
;
i3: h25 ;
i4: h26 ;
e. ; end;
;
; find devno
;
; reg call return ok return not ok
; w0 devno undef
; w1 unchanged -
; w2 unchanged -
; w3 link unchanged -
;
; return:
; link+2 ok: device with kind 6,8,14,18 or 28 found
; link+0 not ok: an error text is written in the output buffer
; if the device is not found
b. j5,i5 w.
i0:<: unknown<0>:>
i1:<: illegal kind<0>:>
i4=k+4
i2:<:removelink error <0>:>
i3: 0 ; return
i5: 0 ; text address
g123:am i2-i4 ;
g127:al. w0 i4. ;
ds. w0 i5. ;
rl. w3 v20. ;
jd 1<11+4 ; process_description(name,pda);
sn w0 0 ;
jl. j2. ; goto unknown;
rl w3 (0) ;
se w3 q6 ; if proc<>disc and
sn w3 q8 ; proc<>console and
jl. j0. ;
se w3 q14 ; proc<>printer and
sn w3 q18 ; proc<>tape and
jl. j0. ;
se w3 q28 ; proc<>gsd then
jl. j1. ; goto illegal kind else
j0: am (0) ; devno:=devno.proc;
rl w0 +a59 ;
rl. w3 i3. ;
jl x3+2 ; return;
j2: am i0-i1 ;
j1: al. w2 i1. ;
rl. w1 i5. ;
jl. w3 d21. ; write(remove link error);
rl. w1 v20. ;
jl. w3 d21. ; write_text(name);
al w1 x2 ;
jl. w3 d21. ; write(unknown/illegal devno);
jl. w3 (i3.) ; return sorry;
e.
;
c.(:a399>21a.1:)-1
; prepare dump <name> <low.first> <low.last> <high.first> <high.last>
b. i0,j0 w.
i0:<:prepare dump error<0>:>;
g121: jl. w3 d15. ; next name
dl. w0 (v21.) ;
ds. w0 p9.+2 ; move_name(param_list,name area);
dl. w0 (v23.) ;
ds. w0 p9.+6 ;
al. w1 p10. ;
jl. w3 d16. ; next integer;
rs w0 x1+0 ; low.first:=next integer
jl. w0 d16. ;
rs w0 x1+2 ; low.last:=next integer
ea w0 1 ;
sh w0 (x1+0) ; if low.first>low.last then
jl. g47. ; goto endline;
jl. w3 d16. ; next integer;
rs w0 x1+4 ; high.first:=next integetr
jl. w0 d16. ;
rs w0 x1+6 ; high.last:=next integer
ea w0 1 ;
sh w0 (x1+4) ; if high.first>high.last then
jl. g47. ; goto endline;
al. w3 p9. ;
jd 1<11+52; create area process;
jd 1<11+4 ; process description;
sh w0 0 ; if no process then
jl. g47. ; goto end line
rl w1 0 ;
al. w2 p10. ;
jl. w3 d58. ; prepare_dump(pda_ext/area_proc,address_buff);
jl. j0. ; error: goto write text;
jl. g35. ; goto next command
j0: al. w1 i0. ;
jl. w3 d21. ; write_text;
al w0 10 ;
jl. w3 d20. ; write(nl);
jl. w3 d23. ; type_line;
jl. w3 d42. ; save_buffer;
jl. g47. ; error: goto end line
jl. g35. ; goto next command
e.
;
; memory dump
;
b. j2 ,i5 w.
i3:<:prepare dump not performed <0>:>
i4:<:dump memory status <0>:>
i5:<:prepare dump status <0>:>
g122: rl. w2 (v106.) ;
sn w0 0 ;
jl. j0. ; goto prepare dump not performed
rl w2 x2+a141 ;
sh w2 0 ;
ac w2 x2 ;
al. w3 p9. ;
dl w1 x2+a11+2 ;
ds w1 x3+2 ; move_name(receiver_name,name area);
dl w1 x2+a11+6 ;
ds w1 x3+6 ;
rl. w1 v32. ;
al w0 0 ;
hs w0 x1+0 ; mess.op:=0;
jd 1<11+16;
rl. w1 v51. ;
jd 1<11+18;
rl. w2 (v51.) ;
sn w0 1 ; if result<>1
se w2 0 ; or status(answer)<>0 then
jl. j1. ; give up: dump error
al w2 0 ;
rx. w2 (v106.) ;
jd 1<11+18 ; wait answer(buf,answer,result);
rl. w2 (v51.) ;
sn w0 1 ; if result<>1
se w2 0 ; or status(answer)<>0 then
jl. j2. ; give up: prepare dump error
jl. g35. ; goto next command;
j0: am i3-i4 ;
j1: am i4-i5 ; prepare dump error:
j2: al. w1 i5. ; dump error:
al w2 1 ;
ls w2 (0) ;
sn w2 1<1 ; if result<>1 then
lo. w2 (v51.) ; status:=answer.status + 1 shift result;
jl. w3 d21. ; write_text;
al w1 x2 ;
sz w1 2.111111;if answer result then
jl. w3 d14. ; write status;
al w0 10 ;
jl. w3 d20. ; write(nl);
jl. w3 d23. ; type_line;
jl. w3 d42. ; save_buffer;
jl. g47. ; error: goto end line
jl. g35. ; goto next command;
e. ;
z.
c.-(:a399>21a.1:)
g121:
g122: jl. g2. ;
z.
e. ; end of itc controller command block
z.
c.-(:a80>16a.1:) ; if not itc devices included then
g112: ;
g113: ;
g114: ;
g115: ;
g116: ;
g117: ;
g118: ;
g121: ;
g122: ;
jl. g2. ; goto endline;
z. ;
;
m. v block
; indirect adressing of all e-names
;
v2: e2
v3: e3
v12: e12
v16: e16
v19: e19
v20: e20
v21: e21
v23: e23
v24: e24
v25: e25
v29: e29
v30: e30
v32: e32
v35: e35
v37: e37
v38: e38
v44: e44
v46: e46
v47: e47
v49: e49
v50: e50
v51: e51
v52: e52
v54: e54
v56: e56
v58: e58
v59: e59
v67: e67
v70: e70
v71: e71
v72: e72
v77: e77
v78: e78
v79: e79
v83: e83
v85: e85
v87: e87
v89: e89
v101: e101
v102: e102
v103: e103
v104: e104
v105: e105
c.(:a399>21a.1:)-1
v106: e106
z.
v109: e109
b.i24 w. ; dump:
; ---------
g79: ;
jl. w3 d15. ; next name;
jl. w3 d34. ; check child;
dl w1 x2+a43 ; get catbase of pr descr(child)
al. w3 i1. ; name=0
jd 1<11+72 ; catbase(s)=catbase(child)
se w0 0 ; if not ok then
jl. g19. ; goto end line: base illegal
rl. w3 v20. ; name adr
jd 1<11+52 ; create area process(name)
al. w3 i1. ; (prevent remove process(name))
sn w0 2 ; if result=2 or
jl. i10. ;
sl w0 2 ; result>2 then
jl. i11. ; goto give up
rl. w3 v20. ;
jd 1<11+8 ; reserve process(name,result);
se w0 0 ; if result<>0 then
jl. i12. ; goto give up;
jl. w3 d39. ; stop child;
rl. w2 (v29.) ;
al w1 0 ;
am. e46.+2000;
rs w1 +2-2000; segmentno(mess)=0
rl w1 x2+a182 ; load base (child)
dl w3 x2+a18 ;
wa w2 2 ; add base
wa w3 2 ;
al w3 x3 -2 ; line addr:= first addr(child);
ds. w3 (v46.) ; write addr:= top addr(child)-2;
rl. w3 v20. ;
rl. w1 v44. ;
jd 1<11+16 ; send mess(name,output,buf);
rl. w1 v51. ;
jd 1<11+18 ; wait answer(buf,answer,result);
rl. w2 (v51.) ;
sn w0 1 ; if result<>1
se w2 0 ; or status(answer)<>0 then
jl. i9. ; give up: area error
jd 1<11+42 ; lookup entry (area)
se w0 0 ; if not ok then
jl. i9. ; goto area error
al w0 7 ; else
hs. w0 (v59.) ; contents key(area):= core dump
jd 1<11+36 ; get clock
ld w1 5 ;
rs. w0 (v56.) ; set shortclock(area)
rl. w1 v51. ;
jd 1<11+44 ; change entry
se w0 0 ; if not ok then
i9: am g15-g35 ; give up: area error
am g35-g11 ; goto next command
i10: am g11-g12 ; give up: catalog error
i11: am g12-g13 ; - - - : area unknown
i12: am -2000 ; - - - : area reserved
al. w2 g13.+2000 ;
jd 1<11+64 ; remove area process
al. w3 i1. ;
dl. w1 i2. ;
jd 1<11+72 ; reset catalogbase(s)
jl x2+ 0 ; exit ,
i1: 0
a107
i2: a108-1
e.
b. i4
w. ;
; command syntax: user <lower> <upper>
; --------------------
; command syntax: login <lower> <upper>
; --------------------
; command syntax: project <lower> <upper>
; ----------------------
g86: am c43-c42; user: update userbase;
g82: am c42-c41; login: update loginbase;
g80: al w2 x1+c41 ; project: update projectbase;
jl. w3 d16. ; next integer
rs w0 x2+0 ; lower := integer;
jl. w3 d16. ; next integer
rs w0 x2+2 ; upper := integer;
jl. g35. ; next command
e.
b.i12 w. ; bs:
; --------
i2: dl. w2 (v21.) ;
ds. w2 i4. ;
dl. w2 (v23.) ;
ds. w2 i5. ;
jl x3 ;
g81: jl. w3 d34. ; check child
jl. w3 d15. ;
jl. w3 i2. ;
jl. w3 d16. ; next integer
i0: rs. w0 (v52.) ; more:
jl. w3 d16. ; next integer
rs. w0 (v51.) ;
dl. w0 (v52.) ;
am. (v51.) ;
al w1 +a110*4; index:= claim list end
i1: ds w0 x1 +2 ; repeat begin
al w1 x1 -4 ; claimlist(index):=claimchange
se. w1 (v51.) ; index:= index-4
jl. i1. ; until index = claim list start
al. w2 i3. ;
rl. w3 (v25.) ;
al w3 x3+c29 ; w3 = process name(console)
jd 1<11+78 ; set bs claims
sn w0 1 ; if result = 1
jl. g20. ; then goto end line
se w0 0 ; if result <> 0
jl. g21. ; then goto end line
jl. g35. ; then goto exam command
; command syntax: temp <docname> <segments> <entries>
; ------------------------------------
g84: ; temp:
am c45-c47; (update temp claims)
; command syntax: perm <docname> <segments> <entries>
; -------------------------------------
g85: ; perm:
al w3 c47 ; (update perm claims)
wa. w3 (v25.) ;
rs. w3 i6. ; save abs addr of claim;
jl. w3 d15. ;
jl. w3 i2. ;
jl. w3 d16. ; get segments
rs. w0 (v52.) ;
jl. w3 d16. ; get entries
rs. w0 (v51.) ;
al. w2 i3. ; name adr.
jl. w3 d61. ; get devno*8
jl. g16. ; sorry goto end line
dl. w1 (v52.) ;
am. (i6.) ; update segments and entries;
ds w1 x2 ;
jl. g35. ; next command
i3:0
i4:0
0
i5:0
i6:0 ; abs addr of claim (in console descr)
e.
b.i40,j10
w.
c.(:c23>14a.1:)-1
g96 = k ; get:
; --------------
al w0 1 ; increase access indicator := true;
rs. w0 (v77.) ;
am -1 ;
g89 = k ; job:
; --------------
al w0 0 ; set startflag
rs. w0 i16. ;
al w3 0 ;
rs w3 x1+c95+2 ; clear primin and primout
rs w3 x1+c96+2 ;
jl. w3 d46. ; clear claimlist;
jl. w3 d15. ; get jobname
al w1 0 ; then get segment(0)
rl. w2 (v70.) ;
jl. w3 d77. ;
rl. w1 (v70.) ;
rl w3 x1+6 ; get no. of segments
rs. w3 i14. ;
rl w1 x1 +2 ;
rs. w1 i12. ;
al w2 0 ; find number of
al w3 512 ; entries in one
wd w3 2 ; susercatentry
al w3 x2-510 ; w3 := last used in segment;
rs. w3 (v85.) ;
j8: dl. w2 (v21.) ;
aa. w2 (v23.) ; compute hashvalue
wa w2 2 ;
al w1 0 ;
sh w2 -1 ;
ac w2 x2 ;
wd. w2 i14.
rs. w1 i13. ;
j3: rl. w2 (v71.) ;
rs. w1 (v79.) ;
jl. w3 d77. ; get segment
jl. w3 d78. ; find entry
sl w2 0 ; if entry address then
jl. j4. ; copy information
se w2 -10 ; if entry ndon' excist then
jl. g22. ; goto end line
rl. w1 (v79.) ; if entry not found on this segment
al w1 x1+1 ; then increase segment no.
sn. w1 (i14.) ; search cyclical through
al w1 0 ;
se. w1 (i13.) ;
jl. j3.
jl. g22.
j4: rl w1 4 ;
wa. w1 i12. ; last adr. +2 in userentry
rs. w1 i15.
rl. w1 (v25.) ;
rl w3 x2+2 ; command mask(job) :
rl w0 x1+c26 ; if abs.protection, abs.addr or
la. w0 i17. ;
la. w3 i10. ; all bs= true then
lo w0 6 ; 'or' these bits to
rs w0 x1+c26 ; command mask(console)
al w3 x1+c29 ; copy job to console buffer
al w2 x2+4 ; from process name
j5: rl w0 x2 ; to claim list
rs w0 x3 ;
al w2 x2+2 ;
al w3 x3+2 ;
se w3 x1+c95 ; (until i and o are defined in susercat) end
jl. j5. ;
;
; create claim list(console)
;
rs. w2 i1. ;
rl. w2(v70.) ;
al w2 x2+8 ; name adr. first dev(entry0)
rs. w2 i2. ;
al w2 x1+c44 ; start of claim list(console)
rs. w2 i0. ;
j0: rl. w2 i2. ;
sl. w2 (i15.) ; kan fjernes nar newcat er rettet !!!!!!!!!!!!!
jl. j2. ; ---------""---------""-------""!!!!!!!!!!!
jl. w3 d61. ; get devno*8(next dev)
jl. j1. ; not found: goto next dev.
rl. w3 i1. ; found: copy claim list:
dl w1 x3+2 ; begin
wa. w2 i0. ;
ds w1 x2+2 ;
dl w1 x3+6 ;
ds w1 x2+6 ; end
j1: dl. w3 i2. ; next device: get claim list adr.(userentry)
al w3 x3+12 ; and dev. name adr.(entry0)
al w2 x2+8 ;
ds. w3 i2. ;
se. w2 (i15.) ;
jl. j0. ; then find next dev.
j2: ;
rl. w1 (v25.) ; restore console
al w2 -1 ; areabuf := undef;
rs. w2 (v87.) ;
se. w2 (i16.) ; if job command then
jl. g66. ; goto run
jl. g35. ; else goto next command;
; end;
;
i0: 0 ; claim list start(console)
i1: 0 ; -2 claim list adr(userentry)
i2: 0 ; +0 dev. name adr.(entry0)
i10: 8.77772006 ; prio+all bs, abs. protc., abs. addr.
i12: 0 ; entry lenght
i13: 0 ; name key
i14: 0 ; catalog lenght
i15: 0 ; last adr.+2(userentry)
i16: 0 ; job indicator : 0=job command
i17: 8.1770
z.e.
b.i24
w.
g87: am 1<8 ; lock: lock := true;
; -------------------
g88: al w0 0 ; unlock:lock := false;
; ---------------------
rs. w0 (i0.) ;
jl. g35. ; goto next command;
i0: e80 ; lock indicator
e.
c. (:c23>15a.1:)-1
b. i30, j10 ;
w. ;
; command syntax: modify <addr> <old contents> <new contents>
; -------------------------------------------
g91 = k ; modify:
jl. w3 (i22.) ; addr := next integer;
sl w0 0 ; if illegal core-address then
sl w0 (116) ;
jl. g111. ; goto end line;
rl w2 0 ;
jl. w3 (i22.) ;
se w0 (x2) ; if next integer <> core(addr) then
jl. g111. ; goto end line;
jl. w3 (i22.) ;
rs w0 x2 ; core(addr) := next integer;
jl. g35. ; goto next command;
g90 = k ; print:
; --------------
jl. w3 (i22.) ; next integer
rs. w0 (v37.) ;
jl. w3 (i22.) ; next integer
rs. w0 (v38.) ;
al. w3 i11. ;
jd 1<11+8 ; reserve printer
se w0 0 ; if result <> 0
jl. (i23.) ; then goto end line
j0: dl. w1 i12. ; next: init output area
ds. w1 i1. ;
ds. w1 i3. ;
ds. w1 i7. ;
dl. w1 i13. ;
ds. w1 i4. ;
ds. w1 i5. ;
rl. w1 i14. ;
rs. w1 i2. ;
rs. w1 i6. ;
rl. w1 (v37.) ; print address(decimal)
al w0 10 ;
al. w2 i1. ;
jl. w3 j3. ;
rl. w2 (v37.) ; print word(octal)
rl w1 x2 ;
al w0 8 ;
al. w2 i3. ;
jl. w3 j3. ;
al w1 -2 ;
la. w1 (v37.) ;
bz w1 x1 ; print byte 1(decimal)
al w0 10 ;
al. w2 i4. ;
jl. w3 j3. ;
al w1 -2 ;
la. w1 (v37.) ;
bz w1 x1 +1 ; print byte 2(decimal)
al w0 10 ;
al. w2 i5. ;
jl. w3 j3. ;
rl. w2 (v37.) ;
rl w1 x2 ; print word(decimal)
sl w1 0 ; if word < 0
jl. j2. ; then begin
ac w1 x1 ; change sign
rl. w0 i15. ;
rs. w0 i6. ; set minus
j2: al w0 10 ; end
al. w2 i7. ;
jl. w3 j3. ;
rl. w1 (v37.) ;
rl w2 x1 ; print word(text)
rl. w1 i26. ;
j1: ld w2 8 ;
sz w1 8.340 ;
sz w1 8.200 ;
la. w1 i25. ;
sz w1 8.177 ;
sz ;
al w1 x1 +32 ;
sh w1 0 ;
jl. j1. ;
rs. w1 i8. ;
al. w1 i10. ;
al. w3 i11. ;
jd 1<11+16 ; send message
jl. w3 d42. ; save work(buf);
jl. j6. ;+2: error: goto end print;
rl. w1 (v37.) ; first addr
al w1 x1 +2 ; +2
rs. w1 (v37.) ; =: first addr
rl. w2 (v38.) ;
sh w1 x2 ; if first addr<=last addr
jl. j0. ; then goto next
j6: ; end print:
al. w3 i11. ;
jd 1<11+10 ; release printer
jl. (i24.) ; goto next command
j3: ds. w0 i19. ; save return and radix
j4: al w3 0 ; next word: s:= 0
j5: al w0 0 ; next char:
wd. w1 i19. ;
wa. w0 i16. ;
as w0 x3 ; remainder shift s
wa w0 x2 ; + word(i)
rs w0 x2 ; =: word(i)
sn w1 0 ; if quotient = 0
jl. (i18.) ; then return
al w3 x3 +8 ; s:= s+8
se w3 24 ; if s<>24
jl. j5. ; then goto next char
al w2 x2 -2 ; i:=i-2
jl. j4. ; goto next word
i0:0 ;
i1:0 ; addr
<: :> ;
i6:0 ;
0 ;
i7:0 ; decimal
0 ;
i4:0 ; byte 1
0 ;
i5:0 ; byte 2
<: :> ;
i2:0 ;
0 ;
i3:0 ; octal
<: :> ;
i8:0 ; text
i9:<:<10>:> ;
i10:5<12 ; message
i0 ;
i9 ;
0 ;
i11:<:printer:>,0,0 ; name
<: :> , i12=k-2
<: :> , i13=k-2
<: :> , i14=k-2
<:- :> , i15=k-2
<:<0><0><16>:> , i16=k-2
i18:0 ; link
i19:0 ; radix
i22:d16 ; next integer
i23:g1 ; error
i24:g35 ; next command
i25:8.7777 7400 ;
i26:128<16+128<8+128 ;
z.
e.
b. i24,j4 w.
g128:am 1 ; set priority
g93: al w2 0 ; prio:
;--------------
jl. w3 d16. ; read priority
sz. w0 (i1.) ; if prio < 0 or prio >= 4096 then
jl. g27. ; goto end line: illegal priority
se w2 0 ; if prio then
jl. j0. ; begin
hs w0 x1+c26 ; insert prio in console buffer and
jl. g35. ; goto next command
j0: ; end else
al w3 x1+c29 ; begin <* set priority *>
al w2 x1 ; save address of console buffer
rl w1 0 ;
jd 1<11+94 ; set_priority(prio,child,res);
se w0 0 ; if error result then
jl. g27. ; goto end line: illegal priority
hs w1 x2+c26 ; insert priority in console buffer and
jl. g35. ; goto next command
; end;
i1: -1<12
e.
b.i10 w.
g99: ; jobremove
; --------------
jl. w3 (i1.) ; check child
al w2 -1 ;
rs w2 x3+c22 ; coretableelement:=not job
jl. (i2.) ; goto remove
i1: d34
i2: g71
e.
b.i3 w.
g100: ; base
; -------------
jl. w3 d16. ; next integer
rs. w0 i3. ;
jl. w3 d16. ; next integer
rl. w3 i3. ;
ds w0 x1+c42+2 ; set bases
ds w0 x1+c41+2 ;
ds w0 x1+c43+2 ;
jl. g35. ;
i3:0
e.
; autorel and relocate
; ---------------------
; yes
; syntax: command <first logic address>
; no
; --------------------------------------
b. i10, j10 w.
g92: rl. w3 v72. ; autorel
jl. j0. ; set destination address
g102:al w3 x1+c97 ; relocate :
j0: rs. w3 i1. ;
jl. w3 d2. ; examine next param
se w0 1 ; if name then
jl. j1. ; begin
rl. w2 (v20.) ; if name:= <:no :> then
al w3 -1 ; first logic address :=
se. w2 (i0.) ; -1 (no relocation)
jl. j2. ; else
rl. w3 (v16.) ; set first logic address
jl. j2. ; top of s own code
j1: se w0 2 ; if not integer then
jl. g2. ; syntax
rl. w3 (v19.) ; integer:
sh w3 -1 ; if <0 then write
jl. g2. ; syntax
c.(:a399>23a.1:)-1
sz w0 (b214) ; if integer mod 8k <>0 then
jl. g2. ; syntax
z.
j2: rs. w3 (i1.) ;
jl. g35. ; goto next command
i0: <:yes:> ;
i1: 0 ;
e.
; adjust rest claims in usercat.
; comment: change the perm rest claims in susercat
; to the value given by the internal process descr. for key=3.
; temp claims are unchanged.
;
; call return
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed
;
b.i20, j10
w.
d76: rs. w3 i10. ; store return in save area
rl. w3 (v30.) ;
rl w1 x3+c22 ; if segmentno= -1 then
sh w1 -1 ; return: no susercatjob
jl. (i10.) ;
c.(:c23>14 a.1 :)-1
rl. w2 i2. ;
jl. w3 d77. ; get segment
rl. w1 (v30.) ;
rl w1 x1+c22 ;
am. (v46.) ;
rs w1 +2 ; store segmentno in output mess
rl. w1 (v29.) ; get procname(child)
al w2 x1+a11 ; and store in name area
rl. w3 v20. ;
dl w1 x2+2 ;
ds w1 x3+2 ;
dl w1 x2+6 ;
ds w1 x3+6 ;
j0: jl. w3 d78. ; find entry
sh w2 -1 ; if entry not found then
jl. j7. ; goto write warning
al w2 x2+50 ;
rs. w2 i3. ; perm claim adr(userentry)+2
rl. w2 i1. ;
al w2 x2+8 ;
rs. w2 i4. ;
j1: rl. w2 i4. ; adjust rest claims
rl. w3 v20. ; for i=0 step 1 until last dev.(entry0) do
jl. w1 d74. ; begin
se w0 0 ; lookup bs claims(dev,process)
jl. j2. ; if not-ok goto next device
dl w3 x1+4*a110+2 ; perm(entryes, segments) := entryes ,segments(key=max-key
ds. w3 (i3.) ;
j2: dl. w2 i4. ; next device:
al w2 x2+12 ;
al w1 x1+8 ;
ds. w2 i4. ;
rl. w1 i1. ;
rl w1 x1+4
am. ( i1.) ; if dev.name.adr. <
sh w2 x1 ; last used of entry0 then
jl. j1. ; goto next , else
rl. w2 i2. ; store segment:
al w3 x2+510 ; create output mess.
; first adr. h20
ds. w3 (v46.) ; last adr. h20+510
rl. w3 i5. ; segment no:stored above
jd 1<11+52 ; create area.susercat
jd 1<11+8 ; reserve(susercat)
sn w0 0 ;
jl. j5. ;
; if error then
jl. g15. ; write: area error
j5: ;
rl. w1 v44. ;
jd 1<11+16 ; send mess.
rl. w1 i11. ;
jd 1<11+18 ; wait answer
lo. w0 (i11.) ; 'or' status and result
sn w0 1 ; if <> 1 then goto error
jl. j6. ;
j4: ; error
al. w1 g11. ; write catalog error
rs. w1 i10. ;
j6: rl. w3 i5. ;
jd 1<11+64 ; remove area susercat
rs. w3 (v87.) ; areabuf := undef;
jl. (i10.) ; return
;
j7: rl. w1 i7. ; entry not found error:
jl. w3 (i8.) ; write warning;
jl. w3 d42. ; save work;
jl. +2 ; +0: error: ignore;
jl. j6. ; +2: goto remove susercat area
i0: 0 ; pr.descr.adr(procname)
i1: h19 ; entry0 adr.
i2: h20 ; user segment adr.
i7: g120 ; address of warning text
i8: g105 ;
z.
c.-(:c23>14 a.1 :)
jl. (2), g18
z.
i3: 0 ; -2, perm claim list adr(userentry)
i4: 0 ; +0, dev.name adr(entry0)
i5: c69 ; susercat name adr.
i6: 0 ; segmentno in susercat
i10: 0 ; return adr.
i11: e51 ; answer status adr.
e.
; character table:
; contains an entry of 3 bits defining the type of each
; character in the iso 7 bit character set.
w.h0: 8.7777 7777 ; nul soh stx etx eot enq ack bel
8.7757 7777 ; bs ht nl vt ff cr so si
8.7777 7777 ; dle dc1 dc2 dc3 dc4 nak syn etb
8.7667 7777 ; can em sub esc fs gs rs us
8.3666 6666 ; sp
8.6636 4244 ; ( ) * + , - . /
8.1111 1111 ; 0 1 2 3 4 5 6 7
8.1125 6466 ; 8 9 : ; < = >
8.6000 0000 ; A B C D E F G
8.0000 0000 ; H I J K L M N O
8.0000 0000 ; P Q R S T U V W
8.0000 0066 ; X Y Z Æ Ø Å _
8.6000 0000 ; a b c d e f g
8.0000 0000 ; h i j k l m n o
8.0000 0000 ; p q r s t u v w
8.0000 0067 ; x y z æ ø å del
; command table:
; each entry consists of two words defining the name of the
; command, a eigth bits defining a bit to test in the console mask,
; and a sixteen bits defining the address of the command action
; relative to g45.
w.h2 = k-6 ; base of command:
<:all<0>:> , 1<17+g83-g45
<:addr:> , 1<17+g54-g45
<:area:> , 1<17+g61-g45
<:autore:> , 1<15+g92-g45
<:base:> , 1<18+g100-g45
<:break:> , 1<20+g70-g45
<:bs<0><0>:>, 1<17+g81-g45
<:buf<0>:> , 1<17+g60-g45
<:call:> , 1<17+g74-g45
<:closec:> , 1<15+g119-g45
<:connec:> , 1<17+g112-g45
<:cpa<0>:> , 1<17+g59-g45
<:create:> , 1<16+g64-g45 ; <:createlink:> --> g64 --> g112
<:date:> , 1<21+1<14+g49-g45
<:discon:> , 1<17+g113-g45
<:dump:> , 1<20+g79-g45
<:exclud:> , 1<19+g73-g45
<:i:>,0 , 1<20+g94-g45
<:functi:> , 1<17+g63-g45
<:includ:> , 1<19+g72-g45
<:init:> , 1<16+g65-g45
<:initki:> , 1<17+g117-g45
<:intern:> , 1<17+g62-g45
<:job<0>:> , 1<20+g89-g45
<:get<0>:> , 1<20+g96-g45
<:link:> , 1<17+g114-g45
<:linkal:> , 1<17+g116-g45
<:list:> , 1<20+1<14+g75-g45
<:load:> , 1<20+g67-g45
<:lock:> , 1<15+g87-g45
<:login:> , 1<18+g82-g45
<:max<0>:> , 1<20+1<14+g76-g45
<:modify:> , 1<21+1<14+g91-g45
<:memdum:> , 1<17+g122-g45
<:new<0>:> , 1<16+g51-g45
<:jobrem:> , 1<15+g99-g45
<:o:>,0 , 1<20+g95-g45
<:perm:> , 1<17+g85-g45
<:prepar:> , 1<17+g121-g45
<:prio:> , 1<18+g93-g45
<:privil:> , 1<15+g124-g45
<:proc:> , 1<20+g52-g45
<:prog:> , 1<20+g53-g45
<:projec:> , 1<18+g80-g45
<:read:> , 1<20+1<14+g57-g45
<:reloca:> , 1<18+g102-g45 ;
<:remove:> , 1<20+g71-g45 ; <:removelink:> -->g71 --> g113
<:setpri:> , 1<15+g128-g45
<:unpriv:> , 1<15+g125-g45
<:cleanu:> , 1<15+g104-g45
c.(:c23>17a.1:)-1
<:replac:> , 1<15+g77-g45
z.
<:run<0>:> , 1<16+g66-g45
<:size:> , 1<18+g56-g45
<:start:> , 1<20+g68-g45
<:stop:> , 1<20+g69-g45
<:temp:> , 1<17+g84-g45
<:unlink:> , 1<17+g115-g45
<:unlock:> , 1<15+g88-g45
<:unstac:> , 1<20+1<14+g58-g45
<:user:> , 1<18+g86-g45
<:mode:> , 1<21+g55-g45
c.-4000
<:key<0>:> , 1<17+g57-g45
<:pk<0><0>:> , 1<18+g59-g45
<:pr<0><0>:> , 1<18+g58-g45
z.
<:print:> , 1<21+1<14+g90-g45
h3:h13 ; continue command list
; create link param list
h14: ; type kind<12+modifier
<:disc<0>:>,0,0, 6 < 12 + 0 ; reserved
<:disk<0>:>,0,0, 6 < 12 + 0 ; reserved
<:discneutral<0>:>, 6 < 12 + 4 ; neutral
<:diskneutral<0>:>, 6 < 12 + 4 ; neutral
<:discforce<0>:>, 6 < 12 + 8 ; override
<:diskforce<0>:>, 6 < 12 + 8 ; override
<:tape<0>:>,0,0, 18 < 12 + 0 ; reserved
<:tapeneutral<0>:>, 18 < 12 + 4 ; neutral
<:tapeforce<0>:>, 18 < 12 + 8 ; override
<:tapek2<0>:>,0, 18 < 12 + 2 ; keystone 2
<:tapek3<0>:>,0, 18 < 12 + 3 ; keystone 3
<:tapeperte<0>:>, 18 < 12 + 1 ; 3715
<:console:>,0, 1 < 12 + 0 ;
<:floppy:>,0,0, 7 < 12 + 0 ;
h15:
; define b-name for transferring variables to mons2-text
b110 = g45 ; command base
b112 = d2 ; call next param
b113 = d15 ; call next name
b114 = d16 ; call next integer
b115 = g2 ; goto syntax error
b116 = g35 ; goto next command
b117 = g36 ; goto exam command
b118 = e19 ; integer just read
b119 = e20 ; name just read
b120 = e16 ; pointer to: first addr
b121 = d19 ; call init write
b122 = d20 ; call write char
b123 = d21 ; call write text
b124 = d23 ; call type line
b125 = d42 ; call save work
b126 = g47 ; goto input aborted
b129 = g11 ; goto catalog error
b130 = d79 ; call stack input
b131 = d22 ; call write integer;
b132 = e90 ; pointer to: terminal
b133 = d51 ; call connect;
b134 = g118 ; call linkall;
b136 = c84 ; devno of 1st connection;
b137 = d55 ; call read segment;
b138 = d57 ; call write segment;
b139 = 0 ; default definition. redefined below if itc included (dirty)
b140 = d14 ; call writebits;
b141 = e72 ; pointer to: first logical address
b142 = e17 ; memory buffer (first free and top of core e16+e17)
b143 = d12 ; change write mode
b144 = e53 ; write mode
b145 = e44 ; output message
b146 = e40 ; name (receiver)
b147 = e32 ; answer area
b148 = c36 ; s log area name
b149 = e42 ; top of write buffer
b150 = d58 ; prepare dump
c.(:a399>21a.1:)-1
b151 = c107 ; default dump area size
z.
b152 = e102 ; device number for 1. physical disc
b153 = d59 ; initialize main
e86: 0,r.(:a110+1:)*2 ; bs claim store;
; console table:
h4:0, r.c81*c1>1 ; lay out standard console descriptions
h22=k-c1 ; last description
; initialize standard console descriptions.
; c20, c21 queue element (queued up on the queue head)
; c27 command mask (standard mask)
b.i4,j2 w.
i0:0 ; saved link
h4+c1 ; next element
i1:h4-c1 ; last element
i2:e35 ; queue head
i3: h4. ;
j0: rs. w3 i0. ; start:
al. w1 i0. ;
rs w1 x2 +0 ; first free:=start of init code;
al w0 c82 ;
dl. w2 i1. ;
al. w3 i3. ;
wa. w3 i3. ; al. w3 h4.
j1: rs w0 x3+c27 ; for console desc:=first stop 1 until last do
ds w2 x3+c21 ; mask(console desc):=standard mask;
al w1 x1 +c1 ; next,last queue element:=next, last console desc;
al w2 x2 +c1 ;
al w3 x3 +c1 ;
sh. w3 h22. ;
jl. j1. ;
rl. w2 i2. ; insert queue head in first and last console des;
al. w3 i3. ;
wa. w3 i3. ; al. w3 h4.
rs w2 x3+c21 ;
rs. w2 h22.+c20 ;
al w0 0 ;
al w2 0 ;
jl. (i0.) ; return to slang;
jl. j0. ; goto start;
e.j.
h21=k ; main console
m. s main console included
k, k-2, 0, 2, 8.1770, <:console1:>,0, 0, r.c1>1-9
h. h5=k-c1 ; last console
; device exception table (devices not automatically included with users )
; the numbers in order of increasing value:
h6: ; start(table)
t.m. s device exclusion table included
2047 ; last(table)
w.
w.
; work table:
h. h8: ; first work:
0,r.c2*c3
h9=k-c2 ; last work:
h. h19: -1,r.c89
h20:-1,r.512
c.(:a80>16a.1:)-1 ; if ida device drivers included then
w. ;
h23=k ; first of disc desc buffer
-1, r.256 ; disc buffer = one segment
h24=k-2 ; last of disc desc buffer
;
b139 = h23 ;
;
h25: ; initkit disc description:
6 ; + 0: no of files
866 ; + 2: first segment of rc8000 coredump
500 ; + 4: no of segments in coredump
5 ; + 6: first segment of ida801 fw
60 ; + 8: no of segments in ida801 fw
65 ; +10: first segment of bootloader
1 ; +12: no of segments in bootloader
66 ; +14: first segment of rc8000 monitor
500 ; +16: no of segments in monitor
566 ; +18: first segment of 1st fe program
300 ; +20: no of segments in 1st fe program
1366 ; +22: first segment of dummy file
0 ; +24: no of segments in dummy file
;
0, 0 ; +26,+27: size of log disc descrp, no of log disc descrp
h26=k ; top of default kit description
; format of log disc description:
; +28: first segment of 1st disc
; +30: no of segments in 1st disc
; +32: type: include sender, data disc
; +33: devno: select a free
;
z. ;
; core table:
; contains an entry for each storage area allocated to a child.
; an entry defines the address of a child description within the
; monitor. the entries are arranged in the same order as the
; storage areas from low towards high addresses. the table is
; terminated by a zero.
w.
h10 = k - c11 ; base of core table:
-1, r.(:a3-2:)*c11>1 ; lay out core table
h11=k ; top of coretable
m. first free addr
; initialize core table.
; all entries in the core table is initialised to this values-
; k, k-2, -1, r.5
b.i1,j1 w.
i0:h10+c11 ; absolute addr of core table
i1:h10.+c11 ; relative addr of core table
j0: al. w1 i0. ; start:
rs w1 x2 +0 ; first free:=start of init code;
rl. w1 i0. ;
al. w2 i1. ;
wa. w2 i1. ;
j1: rs w1 x2 +0 ; for entry:=first stop 1 until last do
rs w1 x2 +2 ; word(entry+0,+2):=k, k-2;
al w1 x1+c11 ;
al w2 x2+c11 ;
se. w2 h11. ;
jl. j1. ;
al w0 0 ;
al w2 0 ; status:=ok;
jl x3 ; return to slang;
jl. j0. ; goto start;
e.j.
; * * * obs do not place any data between h12 and i10 !
c.(:a399>23a.1:)-1
h.
0,r.(:(:(:(:k+2047:)/2048:)*2048:) - k:); (first address:=(first address+2047)//2048)*2048;
w.
m. first free mod 2k
z.
h12:
h13 = - (:h12 + 2:) ; command table continues in second word of next text
b. i29 w.
; table of preoccupied claims:
; mess buf area internal
i0=1 , i1=a112+1 , i2=1 ; proc func
i3=1+a117 , i4=0 , i5=1 ; std driver
i6=a5-i0-i3 , i7=a1-i1-i4 , i8=a3-i2-i5 ; s
c.(:a399>22a.1:)-1
i25=2 , i26=0 , i27=1 ; monitor
i6=i6-i25 , i7=i7-i26 , i8=i8-i27 ; s
z.
i10: rs. w3 i12. ; save return to autoloader;
; initialize work table
b. j1 w.
rl. w3 i20. ;
j0: ; rep:
al w1 x3+c73 ; for all work table entries do
rs w1 x3+c58 ; stack pointer := stack base;
al w3 x3+c2 ;
sh. w3 (i21.) ;
jl. j0. ;
e. ;
; initialize special console descriptions.
b.j10 w.
al. w3 (j2.) ;
jl. j1. ;
j0: rl w1 x3+c25 ; for console desc:=first step 1 until last do
ls w1 1 ; proc desc addr(console):=
wa w1 b4 ; word(base name table(dev)+2*devno);
rl w1 x1 ;
rs w1 x3+c25 ;
al w3 x3 +c1 ;
j1: sh. w3 (j3.) ;
jl. j0. ;
c.(:a399>22a.1:)-1
dl w1 b27+2 ;
ws w1 0 ; max r.size:=max space allowing visibilty monitor tables and area for process dscriptions
ls w1 -11 ; max r.size mod 2k :=0;
ls w1 11 ;
rs. w1 (i29.) ;
z.
jl. i9.
j2: h21
j3: h5
i20: h8
i21: h9
c.(:a399>22a.1:)-1
i28: d30
i29: e82
z.
e.
; process description for process functions:
;
; rel address contents
i9: rl w1 (b6) ; proc := first internal;
jl. w2 i18. ; init description;
a48 , a107 ; interval low
a49 , a108 ; - high
a11 , 0 ; name 0 : zero
a11+2 , <:pro:> ; name 2-6: <:procfunc>
a11+4 , <:cfu:> ;
a11+6 , <:nc:> ;
a17 , b60-b60+a398 ; first address
a18 , b61 ; top address
a301 , 0 ; priority
a26 , a89 ; interrupt mask
a27 , b62 ; user exception address
a170 , 0 ; user escape address
a32 , 1<23 ; status = monitor mode
a33 , b63 ; ic = waiting point
a182 , 0 ; base = no relocation
a183 , a398 ; lower write limit = first core
;*** a184 , core size ; top write limit: special
a185 , 6<12+b54 ; interrupt levels
a42 , a107 ; catalog base low
a43 , a108 ; - - high
a44-2 , a107 ; max interval low
a44 , a108 ; - - high
a45-2 , a107 ; std - low
a45 , a108 ; - - high
a302 , 0 ; save area address
a10 , 0;(end of words) ; kind = 0
a12 , 0 ; stop count
a13 , a102 ; state = waiting for message
a19 , i0 ; buf claim
a20 , i1 ; area claim
a22 , 8.7777 ; function mask
a10 , 0;(end of bytes) ; (kind = 0)
rs w0 x1+a184 ; top write limit(proc func) := core size;
c.(:a399>22a.1:)-1
; process description for monitor
al w1 x1 +a4 ; proc := second internal;
jl. w2 i18. ; init description;
a48 , a107 ; interval low
a49 , a108 ; - high
a11 , <:mon:> ; name = <:monitor:>
a11+2 , <:ito:> ;
a11+4 , <:r:> ;
a11+6 , 0 ;
a17 , b160 ; first address
a18 , 8.3777 7777 ; top address
a301 , 0 ; priority
a26 , a89 ; interrupt mask
a27 , 0 ; user exception address
a170 , 0 ; user escape address
;*** a171 , core size ; initial cpa
a172 , 0 ; - base
a173 , a398 ; - lower write limit
;*** a174 , core size ; - upper - -
a175 , b54<12+b54 ; - interrupt levels
a32 , 0 ; status = not monitor mode
a33 , b160 ; ic = start init
a34 , 0 ; parent = undef
;*** a181 , core size ; current cpa
a182 , 0 ; - base
a183 , a398 ; - lower write limit
;*** a184 , core size ; - upper - -
a185 , b54<12+b54 ; - interrupt levels
a42 , a107 ; catalog base low
a43 , a108-1 ; - - high
a44-2 , a107 ; max interval low
a44 , a108-1 ; - - high
a45-2 , a107 ; std interval low
a45 , a108-1 ; - - high
a302 , 0 ; save area address
a10 , 0;(end of words) ; kind = 0
a12 , 0 ; stopcount
a13 , a104 ; state = wait for event
a19 , i25 ; buf claim
a20 , i26 ; area claim
a21 , i27-1 ; internal claim
a24 , 1<7 ; (protection register, for compatibility reasons)
a25 , 0 ; (protection key, for compatibility reasons)
a22 , 8.7777 ; function mask
a10 , 0;(end of bytes) ; (kind = 0)
sl w0 0 ; if montop<8MHW then
rs w0 x1+a18 ; top address(s) :=montop
rs w0 x1+a171 ; initial cpa(s) :=
rs w0 x1+a174 ; initial upper write limit(s) :=
rs w0 x1+a181 ; current cpa(s) :=
rs w0 x1+a184 ; current upper write limit(s) := core size;
al w0 x1 ;
al w2 0 ;
jl. w3 (i28.) ; reserve core
rl w1 0 ;
z.
; process description for initial operating system, s
al w1 x1 +a4 ; proc := second internal;
jl. w2 i18. ; init description;
a48 , a107 ; interval low
a49 , a108 ; - high
a11 , <:s:> ; name = <:s:>
a11+2 , 0 ;
a11+4 , 0 ;
a11+6 , 0 ;
a17 , c0 ; first address
;*** a18 , core size ; top address
a301 , 0 ; priority
a26 , a89 ; interrupt mask
a27 , d0 ; user exception address
a170 , 0 ; user escape address
;*** a171 , core size ; initial cpa
a172 , 0 ; - base
a173 , a398 ; - lower write limit
;*** a174 , core size ; - upper - -
a175 , b54<12+b54 ; - interrupt levels
a32 , 0 ; status = not monitor mode
a33 , h12 ; ic = start init
a34 , 0 ; parent = undef
;*** a181 , core size ; current cpa
a182 , 0 ; - base
a183 , a398 ; - lower write limit
;*** a184 , core size ; - upper - -
a185 , b54<12+b54 ; - interrupt levels
a42 , a107 ; catalog base low
a43 , a108-1 ; - - high
a44-2 , a107 ; max interval low
a44 , a108-1 ; - - high
a45-2 , a107 ; std interval low
a45 , a108-1 ; - - high
a302 , 0 ; save area address
a10 , 0;(end of words) ; kind = 0
a12 , 0 ; stopcount
a13 , a95 ; state = running
a19 , i6 ; buf claim
a20 , i7 ; area claim
a21 , i8-1 ; internal claim
a24 , 1<7 ; (protection register, for compatibility reasons)
a25 , 0 ; (protection key, for compatibility reasons)
a22 , 8.7777 ; function mask
a10 , 0;(end of bytes) ; (kind = 0)
rs. w0 (4) ; top core :=
jl. 4 ;
e17 ;
rs w0 x1+a18 ; top address(s) :=
rs w0 x1+a171 ; initial cpa(s) :=
rs w0 x1+a174 ; initial upper write limit(s) :=
rs w0 x1+a181 ; current cpa(s) :=
rs w0 x1+a184 ; current upper write limit(s) := core size;
; process description for std driver
al w1 x1 +a4 ; proc := next internal;
jl. w2 i18. ; init description;
a48 , a107 ; interval low
a49 , a108-1 ; - high
a11 , <:dri:> ; name = <:driver proc:>
a11+2 , <:ver:> ;
a11+4 , <:pro:> ;
a11+6 , <:c:> ;
a17 , a398 ; first address
a18 , b60 ; top address
a301 , -1 ; priority
a26 , a89 ; interrupt mask
a27 , b87 ; user exception address
a170 , 0 ; user escape address
a171 , b60 ; initial cpa
a172 , 0 ; - base
a173 , a398 ; - lower write limit
a174 , b60 ; - upper - -
a175 , 6<12+8 ; - interrupt levels
a32 , 1<23+1<6 ; status = monitor mode,locked
a33 , b77 ; ic = before central waiting point one call of lock
a34 , 0 ; parent = undef
a181 , b60 ; current cpa
a182 , 0 ; - base
a183 , a398 ; - lower write limit
a184 , b60 ; - upper - -
a185 , 6<12+8 ; - interrupt levels
a42 , a107 ; catalog base low
a43 , a108-1 ; - - high
a44-2 , a107 ; max interval low
a44 , a108-1 ; - - high
a45-2 , a107 ; std interval low
a45 , a108-1 ; - - high
a302 , b86 ; save area address
a10 , 0 ;(end of words) ; kind = 0
a12 , 0 ; stopcount
a13 , a95 ; state = running
a19 , i3 ; buf claim
a20 , i4 ; area claim
a21 , i5-1 ; internal claim
a24 , 1<7 ; (protection register)
a25 , 0 ; (protection key)
a22 , 8.7777 ; function mask
a10 , 0 ;(end of bytes) ; (kind = 0)
al w0 0 ;
rs w0 x1+a30 ; driverproc.save w2 := 0;
al w2 x1+a16 ;
rl w1 b2 ;
jl w3 b36 ; link(timer q,driverproc)
al w2 x2-a4 ;
jl w3 b36 ; link(timer q, s);
jl. w3 i14. ; take control
b3 ; (first name table entry,
b6 ; first internal,
b29+2*a4 ; driver proc);
jl. w3 i14. ; take control
b76 ; (first secondary interrupt,
k ; irrellevant,
b29+2*a4 ; driver proc);
al. w2 i10. ;
jl. (i12.) ; autoloader(first core);
i13:e4 ;
; take control
; comment: searches through the specified part of name table and initializes driver
; proc address.
i14: rl w1 (x3) ; entry := param 1;
i15: am (x3 +2) ; next:
sn w1 (0) ; if entry = top entry (i.e. param 2)
jl x3 +6 ; then return;
rl w2 x1 +0 ; proc := nametable(entry);
sn w2 0 ; if end of table then
jl x3 +6 ; then return;
rl w0 x3 +4 ; if driverproc(proc) = 0 then
rx w0 x2+a250 ; driverproc(proc) := param 3;
se w0 0 ;
rs w0 x2+a250 ;
al w1 x1 +2 ; entry := entry + 2;
jl. i15. ; goto next;
; procedure init description
; call: w1 = process description address, w2 = init table
; exit: w0 = core size, w1 = unchanged
i18: dl w0 x2 +2 ; move words:
al w2 x2 +4 ; move contents to outpointed
am x1 ; relatives in process description
rs w0 x3 ;
se w3 a10 ; until kind is moved;
jl. i18. ;
i19: dl w0 x2 +2 ; move bytes:
al w2 x2 +4 ; move contents to outpointed
am x1 ; relatives in process description
hs w0 x3 ;
se w3 a10 ; until kind is moved;
jl. i19. ;
rl w0 b12 ;
jl x2 ;
i12:0 ; after loading:
jl. i10. ; goto initialize segment;
c70= k-b127 + 2
k=i10 ;
e. ;
i.
e. ; end of operating system s
▶EOF◀