|
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: 334848 (0x51c00)
Types: TextFile
Names: »mon8part5«
└─⟦a8311e020⟧ Bits:30003039 RC 8000 Monitor Kildetekst
└─⟦9ab0fc1ed⟧
└─⟦this⟧ »mon8part5«
23920 48624 \f 23920 48624 23920 48624 m. 23920 48624 mons1 - operating system s, part 1 23921 48624 23921 48624 b.i30 w. 23922 48624 i0=82 02 24, i1=12 00 00 23923 48624 23923 48624 ; if newtime (i0,i1) > oldtime (a133,a134) then oldtime:=newtime; 23924 48624 c.i0-a133 23925 48624 c.i0-a133-1, a133=i0, a134=i1, z. 23926 48624 c.i1-a134-1, a134=i1, z. 23927 48624 z. 23928 48624 23928 48624 i10=i0, i20=i1 23929 48624 23929 48624 i15=i10/100000 , i10=i10-i15*100000 , i25=i20/100000 , i20=i20-i25*100000 23930 48624 i14=i10/10000 , i10=i10-i14*10000 , i24=i20/10000 , i20=i20-i24*10000 23931 48624 i13=i10/1000 , i10=i10-i13*1000 , i23=i20/1000 , i20=i20-i23*1000 23932 48624 i12=i10/100 , i10=i10-i12*100 , i22=i20/100 , i20=i20-i22*100 23933 48624 i11=i10/10 , i10=i10-i11*10 , i21=i20/10 , i20=i20-i21*10 23934 48624 23934 48624 i2:<: date :> 23935 48648 (:i15+48:)<16+(:i14+48:)<8+46 23936 48650 (:i13+48:)<16+(:i12+48:)<8+46 23937 48652 (:i11+48:)<16+(:i10+48:)<8+32 23938 48654 23938 48654 (:i25+48:)<16+(:i24+48:)<8+46 23939 48656 (:i23+48:)<16+(:i22+48:)<8+46 23940 48658 (:i21+48:)<16+(:i20+48:)<8+ 0 23941 48660 23941 48660 i3: al. w0 i2. ; write date: 23942 48662 rs w0 x2 +0 ; first free:=start(text); 23943 48664 al w2 0 ; 23944 48666 jl x3 ; return to slang(status ok); 23945 48668 23945 48668 jl. i3. ; 23946 48670 e. 23947 48670 j. 23947 48624 date 82.02.24 12.00.00 23948 48624 23948 48624 ; rc date 23949 48624 23949 48624 ; segment 8: operating system s 23950 48624 23950 48624 s. k=k, h50,g110,f29,e90,d90,c100,v100 23951 48624 w.b127=k, c70, k = k-2 23952 48624 23952 48624 ; segment structure: 23953 48624 ; definitions (c names) 23954 48624 ; utility procedures (d names) 23955 48624 ; variables (e names) 23956 48624 ; command actions (g names) 23957 48624 ; tables (h names) 23958 48624 ; 23959 48624 ; (i and j names are used locally) 23960 48624 23960 48624 ; size options: 23961 48624 c0=k ; first addr of s 23962 48624 ; c1=def below; size of console description 23963 48624 ; c2=def below; size of work area 23964 48624 c3=4 ; no of own work areas 23965 48624 c16= 2 ; stack depth ( of nested 'reads' ) 23966 48624 c4=c3+1 ; no of own buffers 23967 48624 c5=2 ; no of own area processes 23968 48624 c7=7 ; - buf 23969 48624 c8=6 ; - area 23970 48624 c9=0 ; - internal 23971 48624 c10=8.7440 ; - function 23972 48624 ;c11=def below; size of core table entry 23973 48624 c12=12800 ; standard size 23974 48624 c13=20 ; - entries,perm,work device 23975 48624 c14=800 ; - segments,perm,work device 23976 48624 c81=a117/2 ; number of console desriptions (arbitrary choosen value) 23977 48624 c82=8.0760 ; standard mask 23978 48624 c89=8+12*a112 ; standard length of susercatentry 23979 48624 c100=1 ; number of privileged conseles 23980 48624 c15=k, <:disc:>,0,0 ; standard work device name 23981 48632 ; definition of chain head. chain heads may be 23982 48632 ; placed any where in the elements, but the location 23983 48632 ; must be the same in all sorts of chains 23984 48632 ;c69 ; susercatname 23985 48632 23985 48632 c20=0 ; next chain element 23986 48632 c21=c20+2 ; last chain element 23987 48632 c23= 8.77740000 ; systemoptions: all commands, 23988 48632 ; terminals unblocked after start up. 23989 48632 23989 48632 t. 23989 48632* type 23990 48632 23990 48632 ; options - operating system s. 23991 48632 23991 48632 m. 23991 48632 s size options 23992 48632 c81=5 ; number of standard console descriptions 23993 48632 c82= 8.1760 ; commandmask: standart +bit 2 23994 48632 n.m. 23994 48632 s size options included 23995 48632 23995 48632 c4=c3+1; no of own buffers 23996 48632 c5=2 ; no of own area processes 23997 48632 23997 48632 ; systemoptions: 23998 48632 ; systemoptions determine whether code is included for certain 23999 48632 ; commands. they are defined by bits in the identifier c23 24000 48632 ; as follows: 24001 48632 ; 24002 48632 ; break: c23=c23 o. 1<22 24003 48632 ; include/exclude: c23=c23 o. 1<21 24004 48632 ; call: c23=c23 o. 1<20 24005 48632 ; list: c23=c23 o. 1<19 24006 48632 ; max: c23=c23 o. 1<18 24007 48632 ; replace: c23=c23 o. 1<17 24008 48632 ; all: c23=c23 o. 1<16 24009 48632 ; print: c23=c23 o. 1<15 24010 48632 ; job: c23=c23o.1<14 24011 48632 ; terminals blocked after start up c23=c23 o. 1<13 24012 48632 24012 48632 ; testoptions: 24013 48632 ; testoptions are used during debugging of the system. they 24014 48632 ; are defined by bits in the identifier c24 as follows: 24015 48632 ; 24016 48632 ; internal interrupt: c24=c24 o. 1<23 24017 48632 ; character testoutput: c24=c24 o. 1<22 24018 48632 ; parameter testoutput: c24=c24 o. 1<21 24019 48632 ; event testoutput: c24=c24 o. 1<20 24020 48632 ; work testoutput: c24=c24 o. 1<19 24021 48632 ; console testoutput: c24=c24 o. 1<18 24022 48632 24022 48632 c24 = a93 24023 48632 24023 48632 ; definition of core table entry format: 24024 48632 24024 48632 ;c20=def above; next entry 24025 48632 ;c21=def above; last entry 24026 48632 c17=c21+2 ; child 24027 48632 c18=c17+2 ; child console 24028 48632 c22=c18+2 ; segment no in susercat or -1 24029 48632 c19=c22+2 ; kind , name of alternative primary input 24030 48632 c93=c19+10 ; kind , name of alternative primary output 24031 48632 c11=c93+10+2 ; size of coretable entry 24032 48632 24032 48632 ; definition of a console description format 24033 48632 ;c20=def above; next console 24034 48632 ;c21=def above; last console 24035 48632 c28=c21+2 ; access count word 24036 48632 c25=c28+2 ; process description word 24037 48632 c26=c25+2 ; priority halfword 24038 48632 c27=c26+1 ; command mask halfword 24039 48632 c29=c27+1 ; process name quadrouple 24040 48632 c30=c29+8 ; first address word 24041 48632 c31=c30+2 ; top address word 24042 48632 c32=c31+2 ; buf claim halfword 24043 48632 c33=c32+1 ; area claim; halfword 24044 48632 c34=c33+1 ; internal claim; halfword 24045 48632 c35=c34+1 ; function mask; halfword 24046 48632 c37=c35+1 ; protection register;halfword 24047 48632 c38=c37+1 ; protection key; halfword 24048 48632 c41=c38+1 ; max interval; double 24049 48632 c42=c41+4 ; standard interval; double 24050 48632 c39=c42+4 ; size; word 24051 48632 c40=c39+2 ; program name; quadrouble 24052 48632 c43=c40+8 ; user interval; double 24053 48632 c95=c43+4 ; primin : kind , name 24054 48632 c96=c95+10 ; primout: kind , name 24055 48632 c97=c96+10 ; first logic address 24056 48632 c98=c97+2 ; cpa limit 24057 48632 c44=c98+2 ; entries temp oth device 24058 48632 c45=c44+2 ; segments temp oth device 24059 48632 c46=c45+2 ; entries perm oth device 24060 48632 c47=c46+2; segments perm on 0th device 24061 48632 ; --- 24062 48632 ;c44+n<3 ; entries temp nth device 24063 48632 ;c45+n<3 ; segments temp nth device 24064 48632 ;c46+n<3 ; entries perm nth device 24065 48632 ;c47+n<3 ; segments perm mth device 24066 48632 c48=c44+a112<3-2; last of console description 24067 48632 c1=c48+2 ; size of console description 24068 48632 24068 48632 ;last part of console buffer will be cleared at each call of 24069 48632 ; new , all , get or job. 24070 48632 c49=c95 ; first parameter to be cleared 24071 48632 24071 48632 ; meaning of command mask: 24072 48632 ; bit 0:(not used) 24073 48632 ; bit 1:all bs resources 24074 48632 ; bit 2:mode,modify,print,date 24075 48632 ; bit 3:job,start,stop,break,dump,list,max,remove,proc,prog,load,read,unstack,i,o 24076 48632 ; bit 4:include,exclude 24077 48632 ; bit 5:size,pr,pk,login,user,project,,prio,base 24078 48632 ; bit 6:addr,function,buf,area,internal,key,bs,temp,perm,all,call 24079 48632 ; bit 7:new,create,run,init, 24080 48632 ; bit 8:privileged 24081 48632 ; bit 9:absolute protection 24082 48632 ; bit 10:absolute address 24083 48632 ; bit 11:not used 24084 48632 24084 48632 ; definition of work area format: 24085 48632 24085 48632 c50=0 ; state (=0=> available: <> 0 => buff addr) 24086 48632 c51=c50+2 ; restart addr 24087 48632 ; *** start of part to be saved-restored 24088 48632 c90=c51+2 ; name area 24089 48632 c78=c90+10 24090 48632 c80=c78+2 24091 48632 c91=c80+2 ; remove indicator 24092 48632 c52=c91+2 ; console 24093 48632 c53=c52+2 ; last addr 24094 48632 c54=c53+2 ; char shift 24095 48632 c55=c54+2 ; char addr 24096 48632 c56=c55+2 ; chilel 24097 48632 c57=c56+2 ; core table entry 24098 48632 ; *** end of part to be saved-restored 24099 48632 c58=c57+2 ; input stack pointer 24100 48632 c59=c58+2 ; first stack element 24101 48632 ; subformat of stack entry: 24102 48632 ; name + nta of area 24103 48632 c60=10 ; segment no 24104 48632 c61=c60+2 ; saved last addr 24105 48632 c62=c61+2 ; saved char shift 24106 48632 c63=c62+2 ; saved char addr 24107 48632 c64=c63+2 ; (size of entry) 24108 48632 c71=c16*c64+c59; (top of stack) 24109 48632 c72=c71-c64 ; last stack entry start 24110 48632 c73=c59-c64 ; base of stack 24111 48632 c65=c71+2 ; output buffer start 24112 48632 c66=c65+36 ; input buffer start; often output buffer top 24113 48632 c67=c66+52 ; last addr of buffer 24114 48632 c2=c67+2 ; size of a work area 24115 48632 ; the input buffer may be overwritten by output in certain cases 24116 48632 24116 48632 ; meaning of work area state: 24117 48632 ; state=0 available 24118 48632 ; state=buf addr waiting for answer 24119 48632 24119 48632 ; procedure type internal 24120 48632 ; comment: internal interrupt procedure used during debugging 24121 48632 ; of s. 24122 48632 d0: 24123 48632 c.(:c24>23a.1:)-1 ; if internal interrupt then 24124 48632 w. 0,r.a180>1 ; begin 24125 48648 b.i24 w. 24126 48648 am (b4) ; 24127 48650 rl w0 a199<1 ; 24128 48652 jl. w3 d24. ; find console(mainconsole); 24129 48654 jl. 0 ;+2: not found: wait forever; 24130 48656 rs. w1 (i2.) ; console:=main console; 24131 48658 jl. w3 d19. ; init write; 24132 48660 al. w1 i0. ; 24133 48662 jl. w3 d21. ; write text(<:s-break:>); 24134 48664 al. w2 d0. ; 24135 48666 24135 48666 i1: al w0 32 ; next: 24136 48668 jl. w3 d20. ; write char(sp); 24137 48670 rl w1 x2 ; 24138 48672 jl. w3 d22. ; write integer(param); 24139 48674 al w2 x2 +2 ; 24140 48676 se. w2 d0.+a180; if not all printed then 24141 48678 jl. i1. ; goto next; 24142 48680 24142 48680 al w0 10 ; 24143 48682 jl. w3 d20. ; writechar(nl); 24144 48684 jl. w3 d23. ; type line(buf); 24145 48686 al. w1 (i3.) ; 24146 48688 jd 1<11+18 ; wait answer(buf); 24147 48690 jl. (i4.) ; goto end line; 24148 48692 24148 48692 i0:<:<10>s-break:<0>:> ; 24149 48700 i2: e25 24150 48702 i3: e32 24151 48704 i4: g30 ; 24152 48706 e. 24153 48706 z. ; end 24154 48706 24154 48706 b. i20, j20 w. 24155 48706 24155 48706 i0: 0 ; saved link 24156 48708 i1: 0 ; saved w3 24157 48710 i2: 0 ; saved w1 24158 48712 24158 48712 i5: h20 ; first of buffer 24159 48714 24159 48714 j0: g3 ; end line: not allowed 24160 48716 j1: g12 ; end line: area unknown 24161 48718 j2: g15 ; end line: area error 24162 48720 24162 48720 j5: e24 ; pointer to: work 24163 48722 j6: e26 ; pointer to: last addr 24164 48724 j7: e28 ; pointer to: char addr 24165 48726 j8: e27 ; pointer to: char shift 24166 48728 24166 48728 j10: e47 ; pointer to: area input mess 24167 48730 j11: e49 ; pointer to: last of buffer 24168 48732 j12: e50 ; pointer to: segment number 24169 48734 j13: e32 ; pointer to: answer 24170 48736 ; procedure stack input 24171 48736 ; stacks the input pointers and selects the given area for input 24172 48736 ; 24173 48736 ; call: w2=name, w3=link 24174 48736 ; exit: all regs undef 24175 48736 24175 48736 d79: ; stack input: 24176 48736 rs. w3 i0. ; save return; 24177 48738 rl. w1 (j5.) ; w1 := work; 24178 48740 rl w3 x1+c58 ; w3 := stack pointer; 24179 48742 sn w3 x1+c72 ; if stack pointer = last stack entry then 24180 48744 jl. (j0.) ; goto not allowed; (* i.e. stack overflow *) 24181 48746 24181 48746 al w3 x3+c64 ; increase (stack pointer); 24182 48748 rs w3 x1+c58 ; 24183 48750 24183 48750 rl. w1 (j6.) ; 24184 48752 rs w1 x3+c61 ; save last addr in stack entry; 24185 48754 dl. w1 (j7.) ; 24186 48756 ds w1 x3+c63 ; save char shift and char addr in stack entry; 24187 48758 24187 48758 dl w1 x2+2 ; move name to stack entry; 24188 48760 ds w1 x3+2 ; 24189 48762 dl w1 x2+6 ; 24190 48764 ds w1 x3+6 ; 24191 48766 24191 48766 ; prepare variables for immediately buffer change 24192 48766 al w0 -1 ; 24193 48768 rs w0 x3+c60 ; segment.stack entry := -1; 24194 48770 24194 48770 rl. w2 i0. ; w2 := return; 24195 48772 jl. d82. ; goto next segment; 24196 48774 24196 48774 24196 48774 24196 48774 ; procedure unstack input 24197 48774 ; restores the char pointers from the stack, and maybe also the buffer 24198 48774 ; 24199 48774 ; call: w2=link 24200 48774 ; exit: all regs undef 24201 48774 24201 48774 d80: ; unstack input: 24202 48774 rl. w1 (j5.) ; w1 := work; 24203 48776 rl w3 x1+c58 ; w3 := stack pointer; 24204 48778 sn w3 x1+c73 ; if stack pointer = stack base then 24205 48780 jl x2 ; return; 24206 48782 24206 48782 al w0 x3-c64 ; 24207 48784 rs w0 x1+c58 ; decrease (stack pointer); 24208 48786 24208 48786 dl w1 x3+c63 ; 24209 48788 ds. w1 (j7.) ; restore char shift and char addr from stack entry; 24210 48790 rl w1 x3+c61 ; 24211 48792 rs. w1 (j6.) ; restore last addr from stack entry; 24212 48794 24212 48794 jl. d81. ; goto get segment; 24213 48796 24213 48796 24213 48796 24213 48796 ; procedure get segment 24214 48796 ; 24215 48796 ; call: w2 = link 24216 48796 ; exit: w1,w2,w3=unch, w0=undef 24217 48796 24217 48796 d81: ; get segment: 24218 48796 am 0-1 ; increment := 0; 24219 48798 24219 48798 ; procedure get next segment 24220 48798 ; 24221 48798 ; call: w2 = link 24222 48798 ; exit: w1,w2,w3=unch, w0=undef 24223 48798 24223 48798 d82: ; next segment: 24224 48798 al w0 1 ; increment := 1; 24225 48800 24225 48800 ; procedure read segment 24226 48800 ; 24227 48800 ; call: w0 = increment, w2 = link 24228 48800 ; exit: w1,w2,w3=unch, w0=undef 24229 48800 24229 48800 d83: ; read segment: 24230 48800 ds. w3 i1. ; save return, w3; 24231 48802 rs. w1 i2. ; save w1; 24232 48804 24232 48804 rl. w1 (j5.) ; w1 := work; 24233 48806 rl w3 x1+c58 ; w3 := stack pointer; 24234 48808 sn w3 x1+c73 ; if stack pointer = stack base then 24235 48810 jl. i10. ; goto return; 24236 48812 24236 48812 rl. w1 i5. ; w1 := first of buffer; 24237 48814 al w2 x1+510 ; w2 := last of buffer; 24238 48816 ds. w2 (j11.) ; 24239 48818 24239 48818 sn w0 0 ; if increment <> 0 then 24240 48820 jl. i8. ; begin 24241 48822 rs. w2 (j6.) ; last addr := last of buffer; 24242 48824 rs. w1 (j7.) ; char addr := first of buffer; 24243 48826 al w1 -16 ; 24244 48828 rs. w1 (j8.) ; char shift := -16; 24245 48830 i8: ; end; 24246 48830 24246 48830 wa w0 x3+c60 ; segment := segment + increment; 24247 48832 rs w0 x3+c60 ; 24248 48834 rs. w0 (j12.) ; 24249 48836 jd 1<11+92; create entry lock process(area name); 24250 48838 se w0 0 ; if result <> ok then 24251 48840 jl. (j1.) ; goto area unknown; 24252 48842 24252 48842 al. w1 (j10.) ; 24253 48844 jd 1<11+16; send message (area input, area name); 24254 48846 al. w1 (j13.) ; 24255 48848 jd 1<11+18; wait answer(answer area); 24256 48850 rl w1 x1 ; 24257 48852 lo w1 0 ; w1 := status 'or' result; 24258 48854 jd 1<11+64; remove process (area name); 24259 48856 se w1 1 ; if any arror then 24260 48858 jl. (j2.) ; goto area error; 24261 48860 24261 48860 i10: ; return: 24262 48860 rl. w1 i2. ; restore regs; 24263 48862 dl. w3 i1. ; 24264 48864 jl x2 ; return; 24265 48866 24265 48866 e. ; 24266 48866 24266 48866 ; procedure next char(char,type) 24267 48866 ; comment: unpacks and classifies the next character from 24268 48866 ; the console buffer: 24269 48866 ; character type: 24270 48866 ; 0 <small letter> 24271 48866 ; 1 <digit> 24272 48866 ; 2 <radix point or minus sign> 24273 48866 ; 3 <space> 24274 48866 ; 4 <separator> 24275 48866 ; 5 <end line> 24276 48866 ; 6 <other graphic> 24277 48866 ; 7 <blind> 24278 48866 ; call: return: 24279 48866 ; w0 char 24280 48866 ; w1 type 24281 48866 ; w2 destroyed 24282 48866 ; w3 link link 24283 48866 24283 48866 b.i24 ; begin 24284 48866 w.d1: dl. w2 e28. ; 24285 48868 sh w1 0 ; if charshift>0 then 24286 48870 jl. i0. ; begin 24287 48872 al w1 -16 ; char shift := -16; 24288 48874 al w2 x2+2 ; char addr := char addr + 2; 24289 48876 sh. w2 (e26.) ; if char addr > last addr then 24290 48878 jl. i0. ; begin 24291 48880 al w0 10 ; char := newline; 24292 48882 rl. w1 e24. ; 24293 48884 rl w2 x1+c58 ; 24294 48886 sn w2 x1+c73 ; if stack pointer = stack base then 24295 48888 jl. i1. ; goto classify char; (* i.e. not end of area-read-buffer *) 24296 48890 jl. w2 d82. ; get next segm; 24297 48892 jl. d1. ; goto next char; 24298 48894 ; end; 24299 48894 i0: rl w0 x2 +0 ; 24300 48896 ls w0 x1 +0 ; char:=word(charaddr) shift charshift; 24301 48898 la. w0 i3. ; char:=char(17:23); 24302 48900 al w1 x1 +8 ; charshift:=charshift+8; 24303 48902 ds. w2 e28. ; 24304 48904 i1: ; classify char: 24305 48904 rl w1 0 ; 24306 48906 ls w1 -2 ; 24307 48908 wa. w1 e5. ; 24308 48910 bz w1 x1 +0 ; entry:=byte(chartable+char/4); 24309 48912 so w0 2.10 ; type:= 24310 48914 ls w1 -6 ; if char mod 4=0 then entry(0:2) else 24311 48916 so w0 2.01 ; if char mod 4=1 then entry(3:5) else 24312 48918 ls w1 -3 ; if char mod 4=2 then entry(6:8) else 24313 48920 la. w1 i4. ; entry(9:11); 24314 48922 jl x3 ; end; 24315 48924 i3:8.177 ; 24316 48926 i4:8.7 ; 24317 48928 e. ; end 24318 48928 24318 48928 ; procedure next param(type) 24319 48928 ; comment: converts and classifies the next parameter from 24320 48928 ; the console buffer. 24321 48928 ; parameter type: 24322 48928 ; 0 <empty> 24323 48928 ; 1 <name> 24324 48928 ; 2 <integer> 24325 48928 ; 3 <unknown> 24326 48928 ; call: return: 24327 48928 ; w0 type 24328 48928 ; w1 unchanged 24329 48928 ; w2 unchanged 24330 48928 ; w3 link link 24331 48928 24331 48928 b.i24 ; begin 24332 48928 w.d2: rs. w3 e60. ; 24333 48930 ds. w2 e59. ; 24334 48932 al w1 0 ; 24335 48934 se. w1 (e87.) ; if areabuf undef then 24336 48936 jl. w2 d81. ; get segment; 24337 48938 rs. w1 e87. ; areabuf := defined; 24338 48940 24338 48940 al w0 0 ; param type := 0; 24339 48942 ds. w1 e19. ; integer:=0; 24340 48944 ds. w1 e21. ; 24341 48946 ds. w1 e23. ; name:=0 24342 48948 al w0 10 ; 24343 48950 rl. w1 e6. ; radix:=10; 24344 48952 ds. w1 e57. ; state:=param table; 24345 48954 24345 48954 d3: jl. w3 d1. ; continue: 24346 48956 wa. w1 e57. ; next char(char,type); 24347 48958 bz w1 x1 +0 ; entry:=byte(state+type); 24348 48960 al w2 0 ; 24349 48962 ld w2 -2 ; action:=entry(0:9); 24350 48964 ls w2 -19 ; 24351 48966 wa. w2 e6. ; state:= 24352 48968 rs. w2 e57. ; param table+8*entry(10:11); 24353 48970 jl. x1 +d2. ; goto action; 24354 48972 24354 48972 d4: rl. w3 e19. ; letter: 24355 48974 sl w3 11 ; if integer>=10 24356 48976 jl. d7. ; then goto unknown; 24357 48978 al w2 0 ; 24358 48980 wd. w3 i0. ; 24359 48982 ls w2 3 ; char:=char shift 24360 48984 ac w2 x2 -16 ; (16-integer mod 3 * 8); 24361 48986 ls w0 x2 +0 ; 24362 48988 ls w3 1 ; addr:=name+integer/3*2; 24363 48990 lo. w0 x3+e20. ; 24364 48992 rs. w0 x3+e20. ; word(addr):=word(addr) or char; 24365 48994 rl. w3 e19. ; 24366 48996 al w3 x3 +1 ; 24367 48998 al w2 1 ; integer:=integer+1; 24368 49000 ds. w3 e19. ; param type:=1; 24369 49002 jl. d3. ; goto continue; 24370 49004 d5: se w0 45 ; radix or minus 24371 49006 jl. i1. ; if minus thrn 24372 49008 al w3 -1 ; 24373 49010 rs. w3 i4. ; 24374 49012 jl. d3. ; 24375 49014 24375 49014 i1: al w3 0 ; 24376 49016 rx. w3 e19. ; radix:=integer; 24377 49018 rs. w3 e56. ; integer:=0; 24378 49020 jl. d3. ; goto continue; 24379 49022 24379 49022 d6: rl. w3 e19. ; digit: 24380 49024 wm. w3 e56. ; 24381 49026 al w3 x3 -48 ; integer:= 24382 49028 wa w3 0 ; integer*radix-48+char; 24383 49030 al w2 2 ; param type:=2; 24384 49032 ds. w3 e19. ; 24385 49034 jl. d3. ; goto continue; 24386 49036 24386 49036 d11: ; newline or semicolon: 24387 49036 sn w0 10 ; 24388 49038 jl. d8. ; while char <> newline do 24389 49040 jl. w3 d1. ; next char; 24390 49042 jl. d11. ; goto delimiter; 24391 49044 24391 49044 d7: ; unknown: 24392 49044 sn w0 25 ; if char = em then 24393 49046 jl. w2 d80. ; unstack input; 24394 49048 al w2 3 ; 24395 49050 rs. w2 e18. ; param type:=3; 24396 49052 d8: rl. w0 e18. ; delimiter: 24397 49054 rl. w2 e18. ; 24398 49056 se w2 2 ; 24399 49058 jl. i2. ; 24400 49060 rl. w3 i4. ; 24401 49062 sh w3 -1 ; 24402 49064 ac. w3 (e19.) ; 24403 49066 sh w3 -1 ; 24404 49068 rs. w3 e19. ; 24405 49070 rs. w2 i4. ; 24406 49072 i2: dl. w2 e59. ; 24407 49074 c.(:c24>21a.1:)-1 ; if param testoutput then 24408 49074 jd 1<11+28 ; type w0(param type); 24409 49074 z. jl. (e60.) ; 24410 49076 i0:3 ; 24411 49078 i4:0 ;sign 24412 49080 e. ; end 24413 49080 24413 49080 ; procedure next name 24414 49080 ; comment: checks that the next parameter from the console 24415 49080 ; buffer is a name: 24416 49080 ; call: return: 24417 49080 ; w0 type 24418 49080 ; w1 unchanged 24419 49080 ; w2 unchanged 24420 49080 ; w3 link link 24421 49080 24421 49080 b.i24 ; begin 24422 49080 w.d15:rs. w3 i0. ; 24423 49082 jl. w3 d2. ; next param(type); 24424 49084 se w0 1 ; if type<>1 24425 49086 jl. g2. ; then goto end line; 24426 49088 jl. (i0.) ; 24427 49090 i0:0 ; end 24428 49092 24428 49092 24428 49092 ; procedure next integer(integer) 24429 49092 ; comment: checks that the next parameter from the console 24430 49092 ; buffer is an integer. 24431 49092 ; call: return: 24432 49092 ; w0 integer 24433 49092 ; w1 unchanged 24434 49092 ; w2 unchanged 24435 49092 ; w3 link link 24436 49092 24436 49092 w.d16:rs. w3 i0. ; begin 24437 49094 jl. w3 d2. ; next param(type); 24438 49096 se w0 2 ; if type<>2 24439 49098 jl. g2. ; then goto end line; 24440 49100 rl. w0 e19. ; 24441 49102 jl. (i0.) ; 24442 49104 e. ; end 24443 49104 24443 49104 ; procedure increase access(console) 24444 49104 ; comment: increases the access counter of a given console, 24445 49104 ; and if the console was in the free pool, it is hooked 24446 49104 ; onto the used chain. 24447 49104 ; call: return: 24448 49104 ; w0 destroyed 24449 49104 ; w1 console console 24450 49104 ; w2 unchanged 24451 49104 ; w3 link unchanged 24452 49104 24452 49104 b. i24 w. 24453 49104 d9: ds. w3 i1. ; 24454 49106 al w0 1 ; begin 24455 49108 wa w0 x1+c28 ; 24456 49110 sh w0 1 ; 24457 49112 al w0 2 ; 24458 49114 rx w0 x1+c28 ; access count:= access count + 1; 24459 49116 i4:; if access count was <> 0 24460 49116 sl. w1 (e31.) ; or console belongs to the predefined 24461 49118 jl. 4 ; then return; 24462 49120 jl. w3 d17. ; remove element(console); 24463 49122 dl. w3 i1. ; return 24464 49124 jl x3 ; end; 24465 49126 24465 49126 ; procedure decrease access(console); 24466 49126 ; comment: decreases the access counter of a given console, 24467 49126 ; and if the access counter becomes null, and the console 24468 49126 ; description belongs to the potentially free consoles, it 24469 49126 ; is removed from the used chain and hooked onto the 24470 49126 ; rear of the free chain. 24471 49126 ; call: return: 24472 49126 ; w0 unchanged 24473 49126 ; w1 console console 24474 49126 ; w2 unchanged 24475 49126 ; w3 link destroyed 24476 49126 24476 49126 d10: ds. w3 i1. ; begin 24477 49128 rl w3 x1+c28 ; 24478 49130 se w3 2 ; 24479 49132 jl. +8 ; 24480 49134 rl. w2 e81. ; 24481 49136 sn w2 0 ; 24482 49138 al w3 x3 -1 ; 24483 49140 al w3 x3 -1 ; access count:= access - 1; 24484 49142 sh w3 0 24485 49144 al w3 0 24486 49146 rs w3 x1+c28 ; 24487 49148 sn w3 0 ; if access count <> 0 24488 49150 sl. w1 (e31.) ; or console is predefined 24489 49152 jl. i10. ; then return; 24490 49154 al. w2 e35. ; 24491 49156 jl. w3 d18. ; link element(console,free chain); 24492 49158 i10: dl. w3 i1. ; return 24493 49160 jl x3 ; 24494 49162 ; end; 24495 49162 24495 49162 i0:0 ; common room for register save 24496 49164 i1:0 ; in increase and decrease access. 24497 49166 i3:c82 ; standard console mask 24498 49168 24498 49168 ; procedure remove element(element) 24499 49168 ; comment: removes an element from its chain and makes 24500 49168 ; it point at itself. 24501 49168 ; call: return: 24502 49168 ; w0 unchanged 24503 49168 ; w1 element element 24504 49168 ; w2 old next 24505 49168 ; w3 link old last 24506 49168 24506 49168 d17: rs. w3 i2. ; begin 24507 49170 dl w3 x1+c21 ; next(last):= next(element) 24508 49172 rs w2 x3+c20 ; last(next):= last(element) 24509 49174 rs w3 x2+c21 ; next(element):= element; 24510 49176 rs w1 x1+c21 ; last(element):= element; 24511 49178 rs w1 x1+c20 ; return; 24512 49180 jl. (i2.) ; end; 24513 49182 24513 49182 ; procedure link element(element,head); 24514 49182 ; comment: links a console to the rear of the chain 24515 49182 ; defined by head. this is equivalent to linking 24516 49182 ; into a chain immediately before the element named 24517 49182 ; head. 24518 49182 ; call: return: 24519 49182 ; w0 unchanged 24520 49182 ; w1 element element 24521 49182 ; w2 head head 24522 49182 ; w3 link old last 24523 49182 24523 49182 d18: rs. w3 i2. ; begin 24524 49184 rl w3 x2+c21 ; rear:= last(head); 24525 49186 rs w1 x2+c21 ; last(element):= last(head) 24526 49188 rs w1 x3+c20 ; next(rear):= element; 24527 49190 rs w2 x1+c20 ; next(element):= head; 24528 49192 rs w3 x1+c21 ; last(element):= rear; 24529 49194 jl. (i2.) ; return; 24530 49196 ; end; 24531 49196 i2:0 ; general return for remove and link; 24532 49198 e. ; end 24533 49198 24533 49198 ; procedure init write 24534 49198 ; comment: prepares the writing of characters in the line buffer 24535 49198 ; within the current work area. 24536 49198 ; call: return: 24537 49198 ; w0 unchanged 24538 49198 ; w1 unchanged 24539 49198 ; w2 unchanged 24540 49198 ; w3 link link 24541 49198 24541 49198 b.i24 ; begin 24542 49198 w.d19:rs. w3 e55. ; 24543 49200 rl. w3 e24. ; 24544 49202 al w3 x3+c65 ; 24545 49204 rs. w3 e45. ; line addr:=work+linebuf; 24546 49206 rs. w3 e46. ; writeaddr:=lineaddr; 24547 49208 al w3 16 ; writeshift:=16; 24548 49210 rx. w3 e55. ; 24549 49212 jl x3 +0 ; 24550 49214 e. ; end 24551 49214 24551 49214 24551 49214 ; procedure writechar(char) 24552 49214 ; comment: packs the next character in the storage address 24553 49214 ; initialized by initwrite. 24554 49214 ; call: return: 24555 49214 ; w0 char destroyed 24556 49214 ; w1 unchanged 24557 49214 ; w2 unchanged 24558 49214 ; w3 link link 24559 49214 24559 49214 b.i24 ; begin 24560 49214 w.d20:rx. w1 e55. ; if writeshift<0 24561 49216 rx. w2 e46. ; then 24562 49218 sl w1 0 ; begin 24563 49220 jl. i0. ; writeshift:=16; 24564 49222 al w1 16 ; writeaddr:=writeaddr+2; 24565 49224 al w2 x2 +2 ; end; 24566 49226 i0: ls w0 x1 +0 ; char:=char shift writeshift; 24567 49228 se w1 16 ; if writeshift<>16 then 24568 49230 lo w0 x2 +0 ; char:=char or word(writeaddr); 24569 49232 rs w0 x2 +0 ; word(writeaddr):=char; 24570 49234 al w1 x1 -8 ; writeshift:=writeshift-8; 24571 49236 rx. w1 e55. ; 24572 49238 rx. w2 e46. ; 24573 49240 jl x3 +0 ; 24574 49242 e. ; end 24575 49242 24575 49242 ; procedure writetext(addr) 24576 49242 ; comment: moves a textstring terminated by a null to the 24577 49242 ; storage address initialized by initwrite. 24578 49242 ; call: return: 24579 49242 ; w0 no of chars 24580 49242 ; w1 addr destroyed 24581 49242 ; w2 unchanged 24582 49242 ; w3 link link 24583 49242 24583 49242 b.i24 ; begin 24584 49242 w.d21:ds. w3 e60. ; 24585 49244 al w3 0 ; 24586 49246 24586 49246 al w2 x1 ; 24587 49248 i0: rl w1 x2 ; next word: portion:= word(addr); 24588 49250 al w2 x2 +2 ; addr:= addr + 2; 24589 49252 i1: al w3 x3 +1 ; 24590 49254 al w0 0 ; repeat 24591 49256 ld w1 8 ; ch:= portion shift (-16); 24592 49258 sn w0 0 ; if ch = 0 then 24593 49260 jl. i2. ; goto endtext; 24594 49262 rs. w3 e58. ; 24595 49264 jl. w3 d20. ; write char(ch); 24596 49266 rl. w3 e58. ; 24597 49268 al w1 x1 +8.377 ; portion:= portion shift 8 + 255; 24598 49270 sn w1 -1 ; until portion = 1; 24599 49272 am i0-i1 ; 24600 49274 jl. i1. ; goto next word; 24601 49276 i2: al w0 32 ; end text: 24602 49278 al w1 x3 ; 24603 49280 jl. w3 d20. ; writechar(32); 24604 49282 i6: rl. w1 e58. ; 24605 49284 i7: dl. w3 e60. ; 24606 49286 jl x3 +0 ; end 24607 49288 24607 49288 ; procedure writeinteger(integer) 24608 49288 ; comment converts a positive integer to a textstring which 24609 49288 ; is moved to the storage address initialized by initwrite. 24610 49288 ; call: return: 24611 49288 ; w0 destroyed 24612 49288 ; w1 integer number of digits 24613 49288 ; w2 unchanged 24614 49288 ; w3 link link 24615 49288 i4:1 000 000 ; powers of ten: 24616 49290 100 000 ; 24617 49292 10 000 ; 24618 49294 1 000 ; 24619 49296 100 ; 24620 49298 10 ; 24621 49300 1 ; 24622 49302 24622 49302 d22: ds. w3 e60. ; begin 24623 49304 sl w1 0 ; if number < 0 then 24624 49306 jl. i10. ; begin 24625 49308 ac w1 x1 ; number:= -number; 24626 49310 am 45-32 ; sign:= <minus>; 24627 49312 i10: al w0 32 ; end 24628 49314 al w3 7 ; 24629 49316 rs. w3 i15. ; 24630 49318 sl w1 0 ; else sign:= <sp>; 24631 49320 sl. w1 (i4.) ; if number = 1 < 23 24632 49322 jl. i12. ; or number > 10 ** 6 then 24633 49324 al w2 12 ; divisor:= 10 ** 6; 24634 49326 al w3 1 ; 24635 49328 i11: sl. w1 (x2 +i4.-2) ; else 24636 49330 jl. +4 ; 24637 49332 jl. i13. ; begin 24638 49334 al w2 x2 -2 ; divisor:= 1; 24639 49336 al w3 x3 +1 ; 24640 49338 jl. i11. ; while number > divisor * 10 do 24641 49340 i12: al w2 0 ; divisor:= divisor * 10; 24642 49342 i13: rs. w3 i15. ; 24643 49344 jl. w3 d20. ; end; 24644 49346 i14: al w0 0 ; writechar(sign); 24645 49348 wd. w1 x2 +i4. ; repeat 24646 49350 al w1 x1 +48 ; digit:= 48 + number // divisor; 24647 49352 rx w1 0 ; number:= number mod divisor; 24648 49354 jl. w3 d20. ; writechar(digit); 24649 49356 al w2 x2 +2 ; divisor:= divisor // 10; 24650 49358 sh w2 12 ; until divisor = 0; 24651 49360 jl. i14. ; comment return via 24652 49362 rl. w1 i15. ; 24653 49364 jl. i7. ; end in writetext 24654 49366 i15: 0 ; number of digits 24655 49368 e. ; end 24656 49368 24656 49368 ; procedure typeline(buf) 24657 49368 ; comment: starts the output on the current console of the line buffer 24658 49368 ; within the current work area. 24659 49368 ; call: return: 24660 49368 ; w0 destroyed 24661 49368 ; w1 destroyed 24662 49368 ; w2 buf 24663 49368 ; w3 link destroyed 24664 49368 24664 49368 ; procedure send buf (mess, buf) 24665 49368 ; (as typeline, but at call: w1=mess) 24666 49368 24666 49368 b.i24 ; begin 24667 49368 w. 24668 49368 d23: ; type line: 24669 49368 al. w1 e44. ; mess := output message; 24670 49370 d26: ; send buf: 24671 49370 rs. w3 e60. ; 24672 49372 rl. w2 e25. ; 24673 49374 rl w2 x2+c25 ; 24674 49376 dl w0 x2+a11+2 ; 24675 49378 ds. w0 e41. ; 24676 49380 dl w0 x2+a11+6 ; 24677 49382 ds. w0 e43. ; receiver:=name(proc); 24678 49384 al. w3 e40. ; 24679 49386 jd 1<11+16 ; send mess(receiver,typemess,buf); 24680 49388 jl. (e60.) ; 24681 49390 e. ; end 24682 49390 24682 49390 ; procedure find console(device no, console, sorry) 24683 49390 ; comment: searches a console with a given process descr. addr. 24684 49390 ; call: return: 24685 49390 ; w0 cons addr cons addr 24686 49390 ; w1 console 24687 49390 ; w2 unchanged 24688 49390 ; w3 link link 24689 49390 24689 49390 b.i24 ; begin 24690 49390 w.d24:rl. w1 e9. ; for console:=first console 24691 49392 i0: sn w0 (x1+c25) ; step console size 24692 49394 jl x3 +2 ; until last console do 24693 49396 sn. w1 (e10.) ; if device(console)=device no 24694 49398 jl. +6 ; then goto found; 24695 49400 al w1 x1 +c1 ; goto sorry; 24696 49402 jl. i0. ; found: 24697 49404 al. w1 e35. ; if not found then get 24698 49406 rl w1 x1+c20 ; free consolebuffer 24699 49408 sn. w1 e35. ; 24700 49410 jl x3 +0 ; 24701 49412 rs w0 x1+c25 ; 24702 49414 jl x3 +2 ; 24703 49416 e. ; end 24704 49416 24704 49416 ; common block for the procedures find parent, find size, 24705 49416 ; find addr, and max size. the procedures use the 24706 49416 ; variable core table element (e30) as work variable, and 24707 49416 ; the three first mentioned procedures leave it pointing 24708 49416 ; at a suitable element. i.e. for find parent, e30 points 24709 49416 ; at the core table element for the chilet, and for 24710 49416 ; find size and find addr, e30 points at an element 24711 49416 ; before which a suitable hole may be found. 24712 49416 24712 49416 b. i24, j24 24713 49416 w. 24714 49416 24714 49416 ; local sub procedures first hole and next hole(addr, size, sorry); 24715 49416 ; comment: this set of procedures perform the actual up 24716 49416 ; dating of the variable core table element. 24717 49416 ; call: return 24718 49416 ; w0: hole addr 24719 49416 ; w1: hole size 24720 49416 ; w2: unchanged 24721 49416 ; w3: link link 24722 49416 24722 49416 j0: rs. w3 e30. ; entry first hole: 24723 49418 rl. w0 e16. ; hole addr:= first core; 24724 49420 al. w3 e15. ; element:= core table head; 24725 49422 jl. j2. ; goto advance; 24726 49424 24726 49424 j1: rx. w3 e30. ; entry next hole: 24727 49426 sn. w3 e15. ; element:= core table element 24728 49428 jl. (e30.) ; if element = core table head then 24729 49430 am (x3+c17) ; return sorry; 24730 49432 rl w0 a18 ; hole addr:= top addr(child(element)); 24731 49434 am (x3+c17) 24732 49436 wa w0 a182 ; add base 24733 49438 j2: rl w3 x3+c20 ; advance: 24734 49440 rl w1 x3+c17 ; element:= next(element); 24735 49442 sn. w3 e15. ; if element = core table head 24736 49444 al. w1 e1. ; el then tophole=topcore 24737 49446 rs. w2 i5. 24738 49448 rl w2 x1+a182 24739 49450 rl w1 x1+a17 ; else tophole:= first addr(child(element)); 24740 49452 se. w3 e15. ; 24741 49454 wa w1 4 ; add base 24742 49456 ws w1 0 ; hole size:= top hole - hole addr; 24743 49458 rx. w3 e30. ; core table element:= element; 24744 49460 rl. w2 i5. ; 24745 49462 jl x3 +2 ; return happy; 24746 49464 24746 49464 i5: 0 24747 49466 24747 49466 ; procedure find parent(child,console,coretableelement,sorry); 24748 49466 ; comment: searches the parent console of a given child and 24749 49466 ; sets the variable core table element. 24750 49466 ; call: return: 24751 49466 ; w0: destroyed 24752 49466 ; w1: console 24753 49466 ; w2: child child 24754 49466 ; w3: link core table element 24755 49466 24755 49466 d25: rs. w3 e60. ; begin 24756 49468 am j0-j1 ; for i:= first hole, 24757 49470 i0: jl. w3 j1. ; next hole while happy do 24758 49472 jl. (e60.) ; begin 24759 49474 rl. w3 e30. ; if child = child(element) then 24760 49476 se w2 (x3+c17) ; begin console:= console(element); 24761 49478 jl. i0. ; return happy 24762 49480 rl w1 x3+c18 ; end; 24763 49482 am. (e60.) ; end; 24764 49484 jl +2 ; return sorry; 24765 49486 ; end; 24766 49486 24766 49486 ; procedure find size(start,size,sorry); 24767 49486 ; comment: the core table is searched for the first 24768 49486 ; hole not less than the size given. the start address 24769 49486 ; is returned and the variable core table entry is set 24770 49486 ; to point at the element before which a hole is 24771 49486 ; found. 24772 49486 ; call: return: 24773 49486 ; w0: first addr 24774 49486 ; w1: size size (i.e. unchanged) 24775 49486 ; w2: destroyed 24776 49486 ; w3: link destroyed 24777 49486 24777 49486 d27: rs. w1 e37. ; begin 24778 49488 rs. w3 e38. ; wanted size:= size; 24779 49490 am j0-j1 ; for size:= first hole, next hole while happy do 24780 49492 i1: jl. w3 j1. ; if size >= wanted size then 24781 49494 jl. (e38.) ; goto found; 24782 49496 sl. w1 (e37.) ; return sorry; 24783 49498 jl. 4 ; found: size:= wanted size; 24784 49500 jl. i1. ; first addr:= hole addr; 24785 49502 dl. w2 e38. ; return happy; 24786 49504 jl x2 +2 ; end; 24787 49506 24787 49506 ; procedure find addr (start,size,sorry); 24788 49506 ; comment: the core table is searched for a hole with 24789 49506 ; a given start address and a size not less than given. 24790 49506 ; call: return: 24791 49506 ; w0: start start (i.e. unchanged) 24792 49506 ; w1: size size (i.e. unchanged) 24793 49506 ; w2: destroyed 24794 49506 ; w3: link destroyed 24795 49506 24795 49506 d28: rs. w1 e57. ; begin 24796 49508 rs. w3 e58. ; 24797 49510 rl w2 0 ; 24798 49512 am j0-j1 ; for size:= first hole, next hole while happy do 24799 49514 i2: jl. w3 j1. ; begin 24800 49516 jl. (e58.) ; if holeaddr > start addr then 24801 49518 sl w0 x2 +2 ; return sorry; 24802 49520 jl. (e58.) ; add := hole addr + hole size 24803 49522 wa w1 0 ; - wanted size; 24804 49524 ws. w1 e57. ; if add >= start then goto found; 24805 49526 sh w1 x2 -2 ; end; 24806 49528 jl. i2. ; return sorry; 24807 49530 al w0 x2 ; found: 24808 49532 dl. w2 e58. ; return happy; 24809 49534 jl x2 +2 ; end; 24810 49536 24810 49536 ; procedure find max(size) 24811 49536 ; comment: the core table is searched for the size of the largest 24812 49536 ; hole, and the size is delivered; 24813 49536 ; call: return: 24814 49536 ; w0: destroyed 24815 49536 ; w1: size 24816 49536 ; w2: destroyed 24817 49536 ;w3: link destroyed 24818 49536 24818 49536 d29: rs. w3 e58. ; begin 24819 49538 al w2 0 ; 24820 49540 am j0-j1 ; max:= 0; 24821 49542 i3: jl. w3 j1. ; for size:= firsthole,nexthole while happy do 24822 49544 jl. i4. ; if size >= max then 24823 49546 sl w1 x2 ; max:= size; 24824 49548 al w2 x1 ; 24825 49550 jl. i3. ; size:= max; 24826 49552 i4: al w1 x2 ; return 24827 49554 jl. (e58.) ; end; 24828 49556 24828 49556 e. 24829 49556 24829 49556 ; procedure reserve core(child) 24830 49556 ; comment: inserts a child in the core table just before 24831 49556 ; the element pointed at by core table entry. the variable 24832 49556 ; core table entry is updated to point at the new element; 24833 49556 ; call: return: 24834 49556 ; w0 child child 24835 49556 ; w1 console 24836 49556 ; w2 console core table element 24837 49556 ; w3 link destroyed 24838 49556 24838 49556 b.i24 w. ; begin 24839 49556 d30: rs. w3 e60. ; i:= base core table; 24840 49558 rl. w1 e33. ; repeat 24841 49560 i0: al w1 x1+c11 ; i:= i + core table entry size; 24842 49562 se w1 (x1+c21) ; until 24843 49564 jl. i0. ; core table entry(i) is free; 24844 49566 rx. w2 e30. ; link element(core table entry(i), 24845 49568 jl. w3 d18. ; core table element); 24846 49570 al w2 x1 ; core table element:= core table entry(i); 24847 49572 rx. w1 e30. ; core table element. child:= child; 24848 49574 ds w1 x2+c18 ; core table element. console:= console; 24849 49576 rl. w3 e79. ; 24850 49578 rs w3 x2+c22 ; coretable element. segm:=segmentno 24851 49580 al w3 -1 ; 24852 49582 rs. w3 e79. ; 24853 49584 rl w0 x2+c17 ; 24854 49586 jl. (e60.) ; return; 24855 49588 e. ; end; 24856 49588 24856 49588 ; procedure release core(child) 24857 49588 ; comment: removes a child from the core table; 24858 49588 ; call: return: 24859 49588 ; w0 destroyed 24860 49588 ; w1 destroyed 24861 49588 ; w2 destroyed 24862 49588 ; w3 link destroyed 24863 49588 24863 49588 b.i24 w. ; begin 24864 49588 d31: rs. w3 i1. ; 24865 49590 rl. w1 e30. ; 24866 49592 al w2 -1 ; 24867 49594 rs w2 x1 c22 ; 24868 49596 rl w1 x1+c18 ; console:= core table element.console; 24869 49598 jl. w3 d10. ; decrease access(console); 24870 49600 rl. w1 e30. ; 24871 49602 jl. w3 d17. ; release element (core table element); 24872 49604 jl. (i1.) ; return 24873 49606 i1:0 24874 49608 e. ; end 24875 49608 c.-4000 ; only in rc4000 24876 49608 24876 49608 ; procedure find keys(keys,pr,pk,sorry) 24877 49608 ; comment: examines all children and creates a possible 24878 49608 ; protection register with zeroes in all available protection 24879 49608 ; bits. from this possible register, a protection register pr 24880 49608 ; with a given number of keys is selected from left to right. 24881 49608 ; the protection key pk is set equal to the right-most assigned 24882 49608 ; key. upon return, keys is diminished by the number of assigned 24883 49608 ; keys. 24884 49608 ; call: return: 24885 49608 ; w0 pr 24886 49608 ; w1 pk 24887 49608 ; w2 keys keys 24888 49608 ; w3 link link 24889 49608 24889 49608 b.i24 ; begin 24890 49608 w.d32:ds. w3 e60. ; 24891 49608 rl w1 b1 ; 24892 49608 bz w0 x1+a24 ; possible:=pr(s); 24893 49608 al. w2 e15. ; addr:=core table; 24894 49608 i0: rl w2 x2+c20 ; while word(addr)<>0 do 24895 49608 sn. w2 e15. ; begin 24896 49608 jl. i2. ; child:=word(addr); 24897 49608 rl w3 x2+c17 ; 24898 49608 bz w3 x3+a24 ; possible:=possible or 24899 49608 lx. w3 i1. ; (pr(child) exor last 7); 24900 49608 lo w0 6 ; addr:=addr+2; 24901 49608 jl. i0. ; 24902 49608 i1:8.177 ;end; 24903 49608 i2: rl. w2 e59. ; pr:=possible; 24904 49608 al w3 0 ; 24905 49608 i3: ls w0 1 ; bit:=16; 24906 49608 al w3 x3 -1 ; repeat 24907 49608 sz w0 1<7 ; bit:=bit+1; 24908 49608 jl. i4. ; if pr(bit)=0 then 24909 49608 al w2 x2 -1 ; begin 24910 49608 sn w2 0 ; keys:=keys-1; 24911 49608 jl. i5. ; if keys=0 then goto found; 24912 49608 i4: se w3 -7 ; end; 24913 49608 jl. i3. ; until bit=24; 24914 49608 jl. (e60.) ; goto sorry; 24915 49608 i5: lo. w0 i1. ; found: pk:=bit; 24916 49608 ls w0 x3 +0 ; while bit<>24 do 24917 49608 ac w1 x3 +0 ; begin 24918 49608 rl. w3 e60. ; pr(bit):=1; bit:=bit+1; 24919 49608 jl x3 +2 ; end; 24920 49608 e. ; end 24921 49608 z. 24922 49608 24922 49608 ; procedure child name 24923 49608 ; comment: moves child name to receiver name. 24924 49608 ; call: return: 24925 49608 ; w0 destroyed 24926 49608 ; w1 destroyed 24927 49608 ; w2 child 24928 49608 ; w3 link link 24929 49608 24929 49608 b.i24 ; begin 24930 49608 w.d33:rl. w2 e29. ; 24931 49610 dl w1 x2+a11+2 ; 24932 49612 ds. w1 e41. ; 24933 49614 dl w1 x2+a11+6 ; receiver:=name(child); 24934 49616 ds. w1 e43. ; 24935 49618 jl x3 +0 ; 24936 49620 e. ; end 24937 49620 24937 49620 ; procedure check child 24938 49620 ; comment: checks that the process name in the console 24939 49620 ; description refers to a child of s. the console must 24940 49620 ; either be a privileged console or the parent of the 24941 49620 ; child. 24942 49620 ; call: return: 24943 49620 ; w0 destroyed 24944 49620 ; w1 console 24945 49620 ; w2 child 24946 49620 ; w3 link destroyed 24947 49620 24947 49620 b.i24 ; begin 24948 49620 w.d34:rs. w3 i0. ; 24949 49622 rl. w1 e25. ; 24950 49624 al w3 x1+c29 ; process description( 24951 49626 jd 1<11+4 ; process name(console),result); 24952 49628 rs. w0 e29. ; child:=result; 24953 49630 rl w2 0 ; 24954 49632 rl w1 x2 +0 ; 24955 49634 se w2 0 ; if child=0 24956 49636 se w1 0 ; or kind(child)<>0 24957 49638 jl. g9. ; then goto end line; 24958 49640 jl. w3 d25. ; 24959 49642 jl. g3. ; find parent(child,parent,end line); 24960 49644 sn. w1 (e25.) ; 24961 49646 jl. (i0.) ; if console<>parent 24962 49648 rl. w1 e25. ; 24963 49650 bz w0 x1+c27 ; and not privileged(console) 24964 49652 so w0 1<3 ; 24965 49654 jl. g3. ; then goto end line; 24966 49656 jl. (i0.) ; 24967 49658 i0:0 ; 24968 49660 e. ; end 24969 49660 24969 49660 ; stepping stone 24970 49660 24970 49660 jl. d79., d79=k-2 24971 49662 24971 49662 24971 49662 ; procedure create child 24972 49662 ; comment: allocates resources and creates a child process in 24973 49662 ; accordance with the console parameters. the child is included as 24974 49662 ; user of all devices in the device table. finally, the identification 24975 49662 ; bit of the child is set in the description of the console. 24976 49662 ; call: return: 24977 49662 ; w0 destroyed 24978 49662 ; w1 destroyed 24979 49662 ; w2 destroyed 24980 49662 ; w3 link destroyed 24981 49662 24981 49662 b.i25, j10 w. ; begin 24982 49662 24982 49662 d35:rs. w3 i2. ; find core: 24983 49664 el. w2 e81. ; 24984 49666 se w2 1 ; 24985 49668 jl. w3 d9. ; 24986 49670 rl. w2 e25. ; 24987 49672 rl w0 x2+c30 ; start:=first addr(console); 24988 49674 rl w1 x2+c39 ; size:=size(console); 24989 49676 bz w3 x2+c27 ; 24990 49678 sz w3 1<1 ; if abs addr(console) 24991 49680 am d28-d27 ; then find addr(start,size,end line) 24992 49682 jl. w3 d27. ; else find size(start,size,end line); 24993 49684 jl. g4. ; 24994 49686 rl. w2 e25. ; 24995 49688 rs w0 x2+c30 ; first addr(console):=start; 24996 49690 wa w0 x2+c39 ; top addr(console):= 24997 49692 rs w0 x2+c31 ; start+size(console); 24998 49694 bz w3 x2+c27 ; find protection: 24999 49696 c.-4000 ; in rc4000: 25000 49696 sz w3 1<2 ; if not abs protection(console) then 25001 49696 jl. i0. ; begin 25002 49696 bz w2 x2+c26 ; 25003 49696 25003 49696 jl. w3 d32. ; find keys(keys(console), 25004 49696 jl. g8. ; new pr,new pk, end line); 25005 49696 rl. w2 e25. ; pr(console):=new pr; 25006 49696 hs w0 x2+c37 ; pk(console):=new pk; 25007 49696 hs w1 x2+c38 ; end; 25008 49696 i0: bl w0 x2+c37 ; 25009 49696 sz w0 -1<8 ; if pr(console)(0:3)<>0 then 25010 49696 jl. g8. ; goto end line; 25011 49696 z. 25012 49696 25012 49696 c.8000 ; in rc8000: 25013 49696 rl. w0 i21. ; 25014 49698 so w3 1<2 ; if abs protection 25015 49700 jl. j1. ; 25016 49702 so w3 1<9 ; and allowed(console) 25017 49704 jl. g3. ; 25018 49706 al w1 -1 ; then no relocation and 25019 49708 rs w1 x2+c97 ; 25020 49710 al w0 0 ; pr,pk=0,0 else 25021 49712 j1: rs w0 x2+c37 ; pr,pk=240<12+7 , usermode 25022 49714 z. 25023 49714 rl w3 b1 ; check claims: 25024 49716 bz w0 x2+c32 ; 25025 49718 bz w1 x3+a19 ; 25026 49720 ws. w1 e2. ; if buf claim(console)> 25027 49722 sl w0 x1 +1 ; buf claim(s)-own buf 25028 49724 jl. g5. ; then goto end line; 25029 49726 bz w0 x2+c33 ; 25030 49728 bz w1 x3+a20 ; if area claim(console)> 25031 49730 ws. w1 e3. ; 25032 49732 sl w0 x1 +1 ; area claim(s)-own area 25033 49734 jl. g6. ; then goto end line; 25034 49736 bz w0 x2+c34 ; 25035 49738 bz w1 x3+a21 ; if internal claim(console)> 25036 49740 sl w0 x1 +0 ; internal claim(s)-1 25037 49742 jl. g7. ; then goto end line; 25038 49744 ; test intervals: 25039 49744 ; comment: the testing that the interval limits are contained 25040 49744 ; in each other is performed as schetched below 25041 49744 ; standard: !2! 25042 49744 ; 4 1 25043 49744 dl w1 x2+c42+2 ; the numbers refer to the numbers about 25044 49746 sh w1 (x2+c43+2) ; 1; if cons.std.hi >= cons.user.hi 25045 49748 sl w0 x1 +1 ; 25046 49750 jl. g19. ; then goto base alarm; 25047 49752 rl w1 x2+c43 ; 25048 49754 sl w1 (x2+c41) ; 3; if cons.user.lo < cons.max.lo 25049 49756 jl. 4 ; 25050 49758 jl. g19. ; 25051 49760 ws w1 0 ; 25052 49762 sl w1 1 ; 25053 49764 jl. g19. ; then goto base alarm; 25054 49766 dl w1 x2+c41+2 ; 25055 49768 al w1 x1 +1 ; 25056 49770 sl w0 (x3+a45-2) ; 6; or cons.max.hi < cons.user.hi 25057 49772 sh w1 (x2+c43+2) ; then goto base alarm; 25058 49774 jl. g19. ; 25059 49776 al w1 x1 -2 ; 25060 49778 sl w1 (x3+a45-0) ; 7; if cons.max.hi > s.std.hi 25061 49780 jl. g19. ; then goto base alarm 25062 49782 i25: al w1 x2+c30 ; create internal process( 25063 49784 al w3 x2+c29 ; process name(console), 25064 49786 jd 1<11+56 ; first addr(console),result); 25065 49788 sn w0 1 ; 25066 49790 jl. g4. ; 25067 49792 sn w0 2 ; 25068 49794 jl. g11. ; 25069 49796 se w0 0 ; if result<>0 25070 49798 jl. g10. ; then goto end line; 25071 49800 jd 1<11+4 ; process description( 25072 49802 rs. w0 e29. ; process name(console),result); 25073 49804 jl. w3 d30. ; reserve core 25074 49806 al w3 x1+c95 ; move kind,name of primin 25075 49808 al w2 x2+c19 ; and primout to coretable 25076 49810 j0 : rl w0 x3 ; (set by i and o commands ) 25077 49812 rs w0 x2 ; 25078 49814 al w3 x3+2 ; 25079 49816 al w2 x2+2 ; 25080 49818 se w3 x1+c97 ; 25081 49820 jl. j0. ; 25082 49822 al w3 x1+c29 ; 25083 49824 al w2 x1 ; 25084 49826 rl w1 x1+c97 ; if first logic address defined then 25085 49828 sn w1 -1 ; 25086 49830 jl. j2. ; begin 25087 49832 rl w1 x2+c30 ; displacement := first address ( "physical") 25088 49834 ws w1 x2+c97 ; - first logic address 25089 49836 jd 1<11+98 ; change address base 25090 49838 sn w0 0 ; if not ok 25091 49840 jl. j2. ; then begin 25092 49842 jl. w3 d40. ; remove process 25093 49844 jl. g101. ; write illegal relocation ; end 25094 49846 25094 49846 25094 49846 ; set the cpa register(child) 25095 49846 25095 49846 j2 : rl w1 x2+c98 ; if cpa < > initial cpa then 25096 49848 sn w1 1 ; begin 25097 49850 jl. j3. ; 25098 49852 sn w1 -1 ; if cpa(console) = -1 (default) 25099 49854 rl w1 x2+c31 ; then cpa(child):= top core(child) 25100 49856 jd 1<11+126 ; set cpa 25101 49858 sn w0 0 ; if not ok then 25102 49860 jl. j3. ; begin 25103 49862 jl. w3 d40. ; remove process 25104 49864 jl. g8. ; write illegal cpa 25105 49866 ; set the priority of the process 25106 49866 ; if the priority differs from default. (0) 25107 49866 j3: zl w1 x2+c26 ; prio=prio.console 25108 49868 sn w1 0 ; if prio<> 0 then 25109 49870 jl. i19. ; 25110 49872 jd 1<11+94 ; set priority 25111 49874 sn w0 0 ; if result <> 0 then 25112 49876 jl. i19. ; 25113 49878 jl. w3 d40. ; remove process 25114 49880 jl. g27. ; goto end line 25115 49882 ; include process as user of all peripheral devices except those listed 25116 49882 ; in the s device exception tablr. 25117 49882 i19: rl. w2 e11. ; addr:=start(exception table); 25118 49884 al w1 0 ; devno:=0; 25119 49886 i1: bz w0 x2 ; include: 25120 49888 se w0 x1 ; if devno:=devno(addr) then 25121 49890 jl. i3. ; addr:=addr+1; 25122 49892 al w2 x2+1 ; else 25123 49894 jl. i4. ; 25124 49896 i3: jd 1<11+12 ; include user(name addr, devno); 25125 49898 i4: al w1 x1+1 ; devno:=devno+1; 25126 49900 se w1 a127 ; if devno<>number of peripheral processes then 25127 49902 jl. i1. ; goto include; 25128 49904 25128 49904 ; give the child the required backing storage claims 25129 49904 ; if claims cannot be granted, the process is 25130 49904 ; removed and an alarm message is issued 25131 49904 rl. w2 e25. ; 25132 49906 al w3 -1 ; 25133 49908 rs. w3 e79. ; 25134 49910 bz w0 x2+c27 ; 25135 49912 so w0 1<10 ; if all bs (console) 25136 49914 jl. i8. ; then begin 25137 49916 c.(:c23>16 a.1:)-1 25138 49916 rl w3 b22 ; 25139 49918 i5: rs. w3 i11. ; next device: 25140 49920 rl w3 x3 ; w3:= chaintable 25141 49922 rl w0 x3-a88+16 ; 25142 49924 sn w0 0 ; if chaintable <> free 25143 49926 jl. i7. ; then begin 25144 49928 dl w1 x3-a88+18 ; 25145 49930 ds. w1 e21. ; 25146 49932 25146 49932 dl w1 x3-a88+22 ; 25147 49934 ds. w1 e23. ; work device:= docname(chaintab) 25148 49936 rl w1 x3-a88+26 ; slicelength(chaintab) 25149 49938 rs. w1 i12. ; =: slicelength 25150 49940 rl w3 x3-a88-2 ; claims rel(chaintab) 25151 49942 wa w3 b1 ; + cur proc 25152 49944 rs. w3 i9. ; =: claims 25153 49946 al. w2 e51. ; 25154 49948 i6: bz w1 x3 ; move claims 25155 49950 rs w1 x2 ; 25156 49952 bz w1 x3 +1 ; 25157 49954 wm. w1 i12. ; 25158 49956 rs w1 x2 +2 ; 25159 49958 al w2 x2 +4 ; 25160 49960 al w3 x3 +2 ; 25161 49962 am. (i9.) ; 25162 49964 sh w3 a110*2 ; 25163 49966 jl. i6. ; 25164 49968 rl. w2 e25. ; 25165 49970 al w3 x2+c29 ; 25166 49972 al. w2 e20. ; 25167 49974 al. w1 e51. ; 25168 49976 jd 1<11+78 ; 25169 49978 se w0 0 ; if result<>0 25170 49980 jl. g20. ; 25171 49982 25171 49982 i7: rl. w3 i11. ; 25172 49984 al w3 x3 +2 ; chaintab:= chaintab + 2 25173 49986 se w3 (b24) ; if chain <> chain end 25174 49988 jl. i5. ; then goto next device 25175 49990 jl. (i2.) ; return 25176 49992 i9:0 25177 49994 i12:0 ; 25178 49996 i11:0 ; end 25179 49998 z. ; 25180 49998 jl. g18. ; 25181 50000 i21: 240<12 + 7 ; pr,pk usermode 25182 50002 25182 50002 ; transfer claims to child, 25183 50002 ; the claimlist in the console-description 25184 50002 25184 50002 i8: ; not 'all' bs (console): 25185 50002 rl. w3 e25. ; w3 := claimbase := console; 25186 50004 i13: ; next chaintable: 25187 50004 rs. w3 i22. ; save claimbase; 25188 50006 25188 50006 dl w1 x3+c44+6 ; perm claim := claimlist(claimbase); 25189 50008 ds. w1 i24. ; 25190 50010 wa w0 x3+c44+0 ; temp entries := temp+perm entry claim; 25191 50012 wa w1 x3+c44+2 ; temp segms := temp+perm segm claim; 25192 50014 rs. w0 i23. ; main entries := temp entries; 25193 50016 al w0 0 ; temp entries := 0; 25194 50018 25194 50018 ws. w3 e25. ; w3 := index in claimlist; 25195 50020 ls w3 -2 ; 25196 50022 wa w3 b22 ; w3 := chain table number; 25197 50024 sl w3 (b24) ; if all chains handled then 25198 50026 jl. (i2.) ; return; 25199 50028 rl w3 x3 ; w3 := chain table addr; 25200 50030 25200 50030 al. w2 g20. ; error addr := claims exceeded; 25201 50032 25201 50032 i14: ; transfer claim: 25202 50032 ; w0=temp entries, w1=temp segments 25203 50032 ; w2=error address 25204 50032 ; w3=chaintable address 25205 50032 rs. w2 i20. ; save(error addr); 25206 50034 al w2 0 ; key := 0; 25207 50036 i15: ; next key: 25208 50036 ds. w1 x2+e52. ; claim(key) := entries,segments; 25209 50038 al w2 x2+4 ; increase(key); 25210 50040 sn w2 a109*4 ; if key = min aux key then 25211 50042 dl. w1 i24. ; entries,segments := perm claim; 25212 50044 sh w2 a110*4 ; if key <= max cat key then 25213 50046 jl. i15. ; goto next key; 25214 50048 25214 50048 dl w1 x3-a88+18 ; name := docname.chaintable; 25215 50050 ds. w1 e21. ; 25216 50052 dl w1 x3-a88+22 ; 25217 50054 ds. w1 e23. ; 25218 50056 25218 50056 rl. w3 e25. ; w3 := proc name; 25219 50058 al w3 x3+c29 ; 25220 50060 al. w2 e20. ; w2 := docname; 25221 50062 al. w1 e51. ; w1 := claim; 25222 50064 jd 1<11+78; set bs claim; 25223 50066 sn w0 0 ; if result = ok then 25224 50068 jl. i16. ; goto maincat entries; 25225 50070 se w0 1 ; if result <> claims exceeded then 25226 50072 jl. i17. ; goto next entry; 25227 50074 al w0 1 ; 25228 50076 hs. w0 e81. ; fiddle with remove indicator... 25229 50078 jl. w3 d40. ; remove child; 25230 50080 jl. (i20.) ; goto error; 25231 50082 25231 50082 i16: ; maincat entries: 25232 50082 ld w1 -100 ; perm claim := 0,0; 25233 50084 ds. w1 i24. ; 25234 50086 rx. w0 i23. ; w0 := main entries; main entries := 0; 25235 50088 rl w3 b25 ; w3 := main catalog chain table; 25236 50090 al. w2 g25. ; w2 := error addr := no maincat entries; 25237 50092 se w0 0 ; if main entries <> 0 then 25238 50094 jl. i14. ; goto transfer claim; 25239 50096 25239 50096 i17: ; next entry: 25240 50096 rl. w3 i22. ; increase (claimbase); 25241 50098 al w3 x3+8 ; 25242 50100 jl. i13. ; goto next chaintable; 25243 50102 25243 50102 i20: 0 ; error addr 25244 50104 i22: 0 ; claimbase 25245 50106 i23: 0 ; main entries; 25246 50108 i24=k+2, 0,0 ; perm claim (entries, segments) 25247 50112 25247 50112 i2:0 ; end 25248 50114 e. ; end 25249 50114 25249 50114 ; procedure modify child(addr) 25250 50114 ; comment: modifies the registers of the current child as follows: 25251 50114 ; child w0 = 0 or process description of parent console 25252 50114 ; child w1 = process description of s 25253 50114 ; child w2 = process description of parent console 25254 50114 ; child w3 = process description of child 25255 50114 ; child ex = 0 25256 50114 ; child ic = addr 25257 50114 ; call: return: 25258 50114 ; w0 addr destroyed 25259 50114 ; w1 destroyed 25260 50114 ; w2 destroyed 25261 50114 ; w3 link destroyed 25262 50114 25262 50114 b.i24 ; begin 25263 50114 w.d36:rs. w3 i0. ; 25264 50116 rs. w0 e66. ; child ic:=addr; 25265 50118 rl w0 b1 ; 25266 50120 rs. w0 e62. ; child w1:=s; 25267 50122 jl. w3 d33. ; child name; 25268 50124 jl. w3 d25. ; find parent(child,console,coretableelement, 25269 50126 am 0 ; irrelevant); 25270 50128 rl w1 x1+c25 ; 25271 50130 rs. w1 e61. ; child w0:= child w2; 25272 50132 ds. w2 e64. ; child w3:=child; 25273 50134 ; override these default w0 and w2 assignments, 25274 50134 ; in case of user-defined primary input (or -output) names 25275 50134 al w1 x3+c19 ; w1 := addr of primary input descr; 25276 50136 rl w0 x1+2 ; 25277 50138 se w0 0 ; if name defined then 25278 50140 rs. w1 e61. ; child w0 := primary input descr; 25279 50142 al w1 x3+c93 ; w1 := addr of primary output descr; 25280 50144 rl w0 x1+2 ; 25281 50146 se w0 0 ; if name defined then 25282 50148 rs. w1 e63. ; child w2 := primary output descr; 25283 50150 25283 50150 al. w1 e61. ; 25284 50152 al. w3 e40. ; modify internal process( 25285 50154 jd 1<11+62 ; receiver, child w0); 25286 50156 jl. (i0.) ; 25287 50158 i0:0 ; 25288 50160 e. ; end 25289 50160 25289 50160 ; procedure load child 25290 50160 ; comment: loads a program from backing store into 25291 50160 ; a child process in accordance with the console parameters. 25292 50160 ; the program must be described as follows in the catalog: 25293 50160 ; <size of area> 25294 50160 ; <6 irrelevant words> 25295 50160 ; <first segment to load> 25296 50160 ; <content=3><instruction counter> 25297 50160 ; <bytes to load> 25298 50160 ; call: return: 25299 50160 ; w0 destroyed 25300 50160 ; w1 destroyed 25301 50160 ; w2 destroyed 25302 50160 ; w3 link destroyed 25303 50160 25303 50160 b.i24 ; begin 25304 50160 w.d37: ; create and look up: 25305 50160 rl. w1 e29. ; if state.process <> wait start 25306 50162 zl w1 x1+a13 ; then goto error 25307 50164 so w1 2.100000 ; 25308 50166 jl. g3. ; 25309 50168 rl. w2 e25. ; 25310 50170 dl w1 x2+c40+2 ; 25311 50172 ds. w1 e41. ; 25312 50174 dl w1 x2+c40+6 ; 25313 50176 ds. w1 e43. ; receiver:=prog(console); 25314 50178 rs. w3 i20. ; 25315 50180 dl w1 x2+c43+2 ; get catbase of console.(child) 25316 50182 al. w3 i1. ; name=0 25317 50184 jd 1<11+72 ; catbase(s)=catbase(child) 25318 50186 se w0 0 ; if not ok then 25319 50188 jl. g19. ; goto end line base illegal 25320 50190 al. w3 e40. ; 25321 50192 jd 1<11+52 ; create area process(prog) 25322 50194 al. w3 i1. ; prevent remove of process 25323 50196 sn w0 2 ; if result=2 or 25324 50198 jl. i10. ; 25325 50200 sn w0 3 ; result=3 or 25326 50202 jl. i9. 25327 50204 se w0 0 ; result<>0 then 25328 50206 jl. i11. ; goto give up 25329 50208 al. w3 e40. ; 25330 50210 al. w1 e51. ; look up entry( 25331 50212 jd 1<11+42 ; receiver,tail,result); 25332 50214 sn w0 2 ; if result=2 25333 50216 jl. i10. ; then goto give up 0; 25334 50218 rl. w2 e29. ; check description: 25335 50220 bz. w0 e59. ; 25336 50222 se w0 3 ; if content(tail)<>3 25337 50224 sn w0 8 ; and content(tail)<>8 25338 50226 sz ; 25339 50228 jl. i11. ; then goto give up 0; 25340 50230 rl w0 x2+a17 ; first addr(area mess):= 25341 50232 wa w0 x2+a182 25342 50234 zl. w1 e67. ; child ic:= first addr(child) (logical) + 25343 50236 wa w1 x2+a17 ; ic(tail) 25344 50238 rs. w1 e66. ; 25345 50240 sl w1 (x2+a18) ; if ic > top addr(child) then 25346 50242 jl. i13. ; give up 25347 50244 rl w1 x2+a18 ; save physical top(child) 25348 50246 wa w1 x2+a182 ; 25349 50248 al w2 x1 ; 25350 50250 rl. w1 e60. ; first addr(child); 25351 50252 al w1 x1+511 ; 25352 50254 as w1 -9 ; load size:= 25353 50256 as w1 9 ; (bytes(tail)+511)/512*512; 25354 50258 wa w1 0 ; last addr(area mess):= 25355 50260 al w1 x1 -2 ; first addr(child)+load size-2; 25356 50262 sl w1 x2 ; if last addr(area mess)>= 25357 50264 jl. i13. ; top addr(child) 25358 50266 ds. w1 e49. ; then goto give up 0; 25359 50268 rl. w1 e58. ; segment(area mess):= 25360 50270 rs. w1 e50. ; segment(tail); 25361 50272 al. w1 e47. ; load program: 25362 50274 jd 1<11+16 ; send mess(receiver,area mess,buf); 25363 50276 al w1 0 ; (prepare for clearing last of command table) 25364 50278 sh. w0 (e8.) ; if first addr of child <= last of initcat code then 25365 50280 rs. w1 (e12.) ; terminate command-table with a zero; 25366 50282 ; (i.e. prohibit further use of initcat-commands) 25367 50282 al. w1 e51. ; 25368 50284 jd 1<11+18 ; wait answer(buf,answer,result); 25369 50286 25369 50286 rl. w1 e51. ; 25370 50288 sn w0 1 ; if result<>1 25371 50290 se w1 0 ; or status(answer)<>0 25372 50292 jl. i14. ; then goto give up 0; 25373 50294 al. w3 e40. ; 25374 50296 jd 1<11+64 ; remove process(receiver,result); 25375 50298 rl. w0 e66. ; 25376 50300 jl. w3 d36. ; modify child(child ic); 25377 50302 rl. w2 e25. ; 25378 50304 dl w1 x2+c43+2 ; set catalog base 25379 50306 al. w3 e40. ; set catalog base(version,result) 25380 50308 jd 1<11+72 ; 25381 50310 al. w3 i1. ; (prevent remove process(proc) 25382 50312 sn w0 0 ; if not ok then 25383 50314 jl. i15. ; goto restore base(s) 25384 50316 am 2 ; base illegal 25385 50318 i9: am 2 ; 25386 50320 i10: am 2 ; 25387 50322 i11: am 2 ; 25388 50324 i12: am 2 ; area reserved 25389 50326 i13: am 2 ; program too big 25390 50328 i14: rl. w2 i16. ; area error 25391 50330 rs. w2 i20. ; store exit 25392 50332 jd 1<11+64 ; remove process(prog) 25393 50334 i15: dl. w1 i2. ; restore base(s) 25394 50336 al. w3 i1. ; 25395 50338 jd 1<11+72 ; 25396 50340 jl. (i20.) ; exit 25397 50342 i1: 0 25398 50344 a107 25399 50346 i2: a108-1 25400 50348 i3 : 2.100000 ; state bit : wait for stop or start 25401 50350 i20: 0 25402 50352 i16: g15 ; 0 25403 50354 g14 ; +2 25404 50356 g13 ; +4 25405 50358 g12 ; +6 25406 50360 g11 ; +8 25407 50362 g29 ; +10 25408 50364 g19 ; +12 25409 50366 e. 25410 50366 25410 50366 ; procedure start child 25411 50366 ; comment: starts a child process. 25412 50366 ; call: return: 25413 50366 ; w0 destroyed 25414 50366 ; w1 destroyed 25415 50366 ; w2 destroyed 25416 50366 ; w3 link destroyed 25417 50366 25417 50366 b.i24 ; begin 25418 50366 w.d38:rs. w3 i0. ; 25419 50368 jl. w3 d33. ; child name; 25420 50370 al. w3 e40. ; 25421 50372 jd 1<11+58 ; start internal process(receiver,result); 25422 50374 jl. (i0.) ; 25423 50376 i0:0 ; 25424 50378 e. ; end 25425 50378 25425 50378 25425 50378 ; procedure stop child 25426 50378 ; comment: stops a child process. 25427 50378 ; call: return: 25428 50378 ; w0 destroyed 25429 50378 ; w1 destroyed 25430 50378 ; w2 destroyed 25431 50378 ; w3 link destroyed 25432 50378 25432 50378 b.i24 ; begin 25433 50378 w.d39:rs. w3 i0. ; 25434 50380 jl. w3 d33. ; child name; 25435 50382 al. w3 e40. ; 25436 50384 jd 1<11+60 ; stop internal process(receiver,buf,result); 25437 50386 al. w1 e51. ; 25438 50388 jd 1<11+18 ; wait answer(buf,answer,result); 25439 50390 jl. (i0.) ; 25440 50392 i0:0 ; 25441 50394 e. ; end 25442 50394 25442 50394 ; procedure remove child 25443 50394 ; comment: excludes a child as a user of all devices and 25444 50394 ; removes it. 25445 50394 ; call: return: 25446 50394 ; w0 destroyed 25447 50394 ; w1 destroyed 25448 50394 ; w2 destroyed 25449 50394 ; w3 link destroyed 25450 50394 25450 50394 b.i24 ; begin 25451 50394 w.d40:rs. w3 i1. ; 25452 50396 jl. w3 d33. ; child name; 25453 50398 jl. w3 d25. ; find parent(child,console, 25454 50400 am 0 ; irrelevant); 25455 50402 al. w3 e40. ; 25456 50404 jd 1<11+64 ; 25457 50406 se w0 0 ; if result not ok then 25458 50408 jl. g11. ; write out catalog error 25459 50410 jl. w3 d31. ; release core 25460 50412 jl. (i1.) ; 25461 50414 i1:0 ; 25462 50416 e. ; end 25463 50416 25463 50416 ; procedure find work(state,work) 25464 50416 ; comment: searches a work area in a given state. 25465 50416 ; call: return: 25466 50416 ; w0 unchanged 25467 50416 ; w1 work 25468 50416 ; w2 state state 25469 50416 ; w3 link link 25470 50416 25470 50416 b.i24 ; begin 25471 50416 w. 25472 50416 d41: ; find work: 25473 50416 rl. w1 e13. ; work := first work; 25474 50418 i0: ; loop: 25475 50418 rs. w1 e24. ; 25476 50420 sn w2 (x1+c50) ; if state(work) = state then 25477 50422 jl x3 ; return; 25478 50424 al w1 x1+c2 ; increase(work); 25479 50426 sh. w1 (e14.) ; if work <= last work then 25480 50428 jl. i0. ; goto loop; 25481 50430 jl. g31. ; goto exam next; <* not expecting this answer *> 25482 50432 e. ; found: 25483 50432 ; end; 25484 50432 25484 50432 25484 50432 ; procedure save work(state) 25485 50432 ; comment: saves a state and a number of variables in the 25486 50432 ; current work area and proceeds to examine the event queue. 25487 50432 ; call: return: 25488 50432 ; w0 destroyed 25489 50432 ; w1 work 25490 50432 ; w2 state destroyed 25491 50432 ; w3 link link 25492 50432 25492 50432 b.i24 ; begin 25493 50432 w.d42:rl. w1 e24. ; state(work):=state; 25494 50434 ds w3 x1+c51 ; interrupt addr(work):=link; 25495 50436 rs. w2 e88. ; expected answer := state; 25496 50438 c.(:c24>19a.1:)-1 ; if work testoutput 25497 50438 jd 1<11+32 ; then type w2(state); 25498 50438 z. al. w2 e20. ; 25499 50440 i0: rl w0 x2 +0 ; 25500 50442 rs w0 x1+c90 ; save(console) 25501 50444 al w1 x1 +2 ; to(core addr) 25502 50446 al w2 x2 +2 ; in(work); 25503 50448 sh. w2 e30. ; 25504 50450 jl. i0. ; 25505 50452 rl. w3 e2. ; 25506 50454 al w3 x3 -1 ; own buf:= own buf-1 25507 50456 rs. w3 e2. ; 25508 50458 jl. g30. ; goto exam first; 25509 50460 e. ; end 25510 50460 25510 50460 ; procedure restore work(work, state) 25511 50460 ; comment: restores a number of variables from a work area 25512 50460 ; and jumps to the interrupt address. 25513 50460 ; call: return: 25514 50460 ; w0 logical status 25515 50460 ; w1 work 25516 50460 ; w2 state 25517 50460 ; w3 link 25518 50460 ; 25519 50460 ; return address: link + 0 : status <> 0 25520 50460 ; link + 2 : status = 0 25521 50460 25521 50460 b.i24 ; begin 25522 50460 w.d43:rl. w1 e24. ; 25523 50462 al. w2 e20. ; 25524 50464 rs. w2 e87. ; areabuf := undef; 25525 50466 i0: rl w0 x1+c90 ; 25526 50468 rs w0 x2 +0 ; restore(console) 25527 50470 al w1 x1 +2 ; to(core addr) 25528 50472 al w2 x2 +2 ; from(work); 25529 50474 sh. w2 e30. ; 25530 50476 jl. i0. ; 25531 50478 rl. w1 e24. ; state:=state(work); 25532 50480 al w2 0 ; state(work):=0; 25533 50482 rx w2 x1+c50 ; 25534 50484 rl. w3 e2. ; 25535 50486 al w3 x3 +1 ; own buf:= own buf+1 25536 50488 rs. w3 e2. ; 25537 50490 rl. w0 e59. ; w0 := logical status; 25538 50492 se w0 1<1 ; if status <> 0 then 25539 50494 jl (x1+c51) ; goto interrupt addr(work); 25540 50496 am (x1+c51) ; goto 2 + interrupt addr(work); 25541 50498 jl +2 ; 25542 50500 e. ; end 25543 50500 25543 50500 ; procedure type description 25544 50500 ; comment: testoutput of a console description 25545 50500 ; call: return: 25546 50500 ; w0 unchanged 25547 50500 ; w1 destroyed 25548 50500 ; w2 destroyed 25549 50500 ; w3 link destroyed 25550 50500 25550 50500 c.(:c24>18a.1:)-1 ; if console testoutput then 25551 50500 b.i24 ; begin 25552 50500 w.d44:rs. w3 i1. ; 25553 50500 rl. w1 e25. ; 25554 50500 al w2 x1 +0 ; addr:=console; 25555 50500 i0: bz w3 x2 +0 ; repeat 25556 50500 jd 1<11+34 ; type w3(byte(addr)); 25557 50500 al w2 x2 +1 ; addr:=addr+1 25558 50500 se w2 x1 +c1 ; until addr=console+console size; 25559 50500 jl. i0. ; 25560 50500 jl. (i1.) ; 25561 50500 i1:0 ; 25562 50500 e. ; 25563 50500 z. ; end 25564 50500 25564 50500 ; procedure next bitnumbers(bits, type) 25565 50500 ; comment: converts a sequence of integers from the console buffer 25566 50500 ; and sets the corresponding bits in a word equal to one. 25567 50500 ; call: return: 25568 50500 ; w0 type 25569 50500 ; w1 unchanged 25570 50500 ; w2 bits 25571 50500 ; w3 link link 25572 50500 25572 50500 b.i24 ; begin 25573 50500 w.d45:rs. w3 i1. ; 25574 50502 al w2 0 ; bits:=0; 25575 50504 i0: jl. w3 d2. ; next bit: 25576 50506 se w0 2 ; next param(type); 25577 50508 jl. (i1.) ; if type=2 then 25578 50510 ac. w3 (e19.) ; begin 25579 50512 al w0 1 ; 25580 50514 ls w0 x3 +23 ; bits(23-integer):=1; 25581 50516 lo w2 0 ; goto next bit; 25582 50518 jl. i0. ; end; 25583 50520 i1:0 ; 25584 50522 e. ; end 25585 50522 25585 50522 ; procedure reset last part of console 25586 50522 ; comment sets zeroes in whole claimlist of console descr 25587 50522 ; and in primin and primout. 25588 50522 ; initialize first logic address to standart value. 25589 50522 ; 25590 50522 ; call: w3 = link 25591 50522 ; exit: all regs undef 25592 50522 25592 50522 b. i10 w. 25593 50522 d46: ; clear claimlist: 25594 50522 rl. w1 e25. ; w1 := console; 25595 50524 al w2 x1+c48-c49+2; w2 := rel top of area to be cleared; 25596 50526 al w0 0 ; 25597 50528 i0: ; rep: 25598 50528 sl w1 x2 ; if pointer <= start of console then 25599 50530 jl. i1. 25600 50532 al w2 x2-2 ; decrease pointer 25601 50534 rs w0 x2+c49 ; claimlist(pointer) := 0; 25602 50536 jl. i0. ; goto rep; 25603 50538 i1: rl. w0 e72. ; set first logic address 25604 50540 rs w0 x1+c97 ; and cpa 25605 50542 al w0 -1 ; return 25606 50544 rs w0 x1+c98 ; 25607 50546 jl x3 ; 25608 50548 25608 50548 e. 25609 50548 ; procedure devno(name adr. , devno*8, sorry) 25610 50548 ; comment: search the chaintable for a given name and 25611 50548 ; returns deviceno.*8 (relative adr. for claim list in console table ) 25612 50548 ; and chaintable address , 25613 50548 ; or returns sorry if name not found. 25614 50548 ; call: return: 25615 50548 ; w0 destroyed 25616 50548 ; w1 destroyed 25617 50548 ; w2 name adr. deviceno.*8 25618 50548 ; w3 link chaintable adr. 25619 50548 ; 25620 50548 b. i10, j10 25621 50548 w. 25622 50548 d61: rs. w3 i0. ; 25623 50550 al w1 -2 ; 25624 50552 rs. w1 i1. ; 25625 50554 j1: rl. w3 i1. ; next chaintable 25626 50556 al w3 x3+2 ; 25627 50558 rs. w3 i1. ; 25628 50560 wa w3 b22 ; get adr of next chaintable 25629 50562 ; if adr. of next chaintable 25630 50562 sl w3 (b24) ; >= top of chaintable then 25631 50564 jl. (i0.) ; return sorry 25632 50566 rl w3 x3 ; begin compare names 25633 50568 dl w1 x3-a88+18 ; if name(chaintable) 25634 50570 sn w0 (x2) ; = name(adr.) 25635 50572 se w1 (x2+2) ; then return happy 25636 50574 jl. j1. ; else get next chaintable 25637 50576 dl w1 x3-a88+22 ; 25638 50578 sn w0 (x2+4) ; 25639 50580 se w1 (x2+6) ; 25640 50582 jl. j1. ; 25641 50584 rl. w2 i1. ; 25642 50586 ls w2 2 ; 25643 50588 rl. w1 i0. 25644 50590 jl x1+2 25645 50592 i0: 0 25646 50594 i1: 0 25647 50596 e. 25648 50596 c.(: c23>19 a.1:) -1 ; if list option then 25649 50596 b.i24 ; begin 25650 50596 ; block for the list option 25651 50596 ; 25652 50596 ; procedure writespace(no of spaces) 25653 50596 ; comment this procedure writes out a number of spaces <32> 25654 50596 ; call return 25655 50596 ; w0 destroyed 25656 50596 ; w1 c no of spaces 25657 50596 ; w2 unchanged 25658 50596 ; w3 link link 25659 50596 ; 25660 50596 w. d70: rs. w3 i1. ; 25661 50598 i10: al w0 32 ; while no of spaces>=0 25662 50600 jl. w3 d20. ; do 25663 50602 al w1 x1 -1 ; 25664 50604 se w1 0 ; writechar space 25665 50606 jl. i10. ; 25666 50608 jl. (i1.) ; 25667 50610 ; 25668 50610 ; 25669 50610 ; procedure writeint(integer,type) 25670 50610 ; comment this procedure left justify an integer in 25671 50610 ; a 8 or 4 chars space filled field, according to type 25672 50610 ; call return 25673 50610 ;w0 type destroyed 25674 50610 ;w1 integer no of positions 25675 50610 ;w2 unchanged 25676 50610 ;w3 link link 25677 50610 ; 25678 50610 d71: ds. w0 i0. ; save registers 25679 50612 jl. w3 d22. ; writeinteger(integer) 25680 50614 ws. w1 i0. ; 25681 50616 sl w1 0 ; fill with spaces 25682 50618 jl. (i1.) ; according to type 25683 50620 ac w1 x1 ; 25684 50622 jl. i10. ; return through writespace 25685 50624 i1:0 25686 50626 i0:0 25687 50628 e.z. 25688 50628 c.(:c23>14a.1:)-1 25689 50628 25689 50628 b. i24 25690 50628 ; 25691 50628 ; procedure get_segment(segno) 25692 50628 ; comment: performs the transport of the stated segment 25693 50628 ; from <:susercat:> 25694 50628 ; call: return 25695 50628 ; w0 destroyed 25696 50628 ; w1 segno destroyed 25697 50628 ; w2 address destroyed 25698 50628 ; w3 link destroyed 25699 50628 w.d77: ; get_segment: 25700 50628 rs. w3 i10. ; 25701 50630 al. w3 c69. ; 25702 50632 jd 1<11+52 ; create areaprocess(susercat) 25703 50634 sl w0 2 ; if result <> 0 25704 50636 jl. g12. ; then goto end line 25705 50638 se w0 0 ; 25706 50640 jl. g6. ; 25707 50642 i22: rs. w1 e50. ; 25708 50644 al. w1 e47. ; 25709 50646 rs. w2 e48. ; 25710 50648 al w2 x2+512 ; prepare inputmessage 25711 50650 rs. w2 e49. ; 25712 50652 jd 1<11+16 ; send message 25713 50654 al. w1 e51. ; 25714 50656 jd 1<11+18 ; 25715 50658 lo. w0 e51. ; 'or' status and result 25716 50660 rl w1 0 ; save result 25717 50662 jd 1<11+64 ; remove area.susercat 25718 50664 se w1 1 ; if <>1 then 25719 50666 jl. g11. ; error goto end line 25720 50668 jl. (i10.) ; 25721 50670 i10:0 25722 50672 25722 50672 ; procedure find_entry(name) 25723 50672 ; comment: finds the entry identified by the given name 25724 50672 ; returns with the value -10 if entry not found in this segment or -1 if entry not exist 25725 50672 ; call: return: 25726 50672 ; w0 destroyed 25727 50672 ; w1 destroyed 25728 50672 ; w2 entry address or -10 or -1 25729 50672 ; w3 link destroyed 25730 50672 w. d78: ; find_entry: 25731 50672 rs. w3 i10. ; 25732 50674 rl. w1 e71. ; 25733 50676 i0: rl w2 x1 ; if entry not exsist 25734 50678 sn w2 -1 ; 25735 50680 jl. (i10.) ; then return 25736 50682 sn w2 -2 ; if entry deleted then 25737 50684 jl. i1. ; try next entry 25738 50686 al w2 x1 ; 25739 50688 dl w0 x1 +6 ; 25740 50690 sn. w3 (e20.) ; compare names 25741 50692 se. w0 (e21.) ; 25742 50694 jl. i1. ; if names unequal then 25743 50696 dl w0 x1+10 ; try next entry 25744 50698 sn. w3 (e22.) ; else return 25745 50700 se. w0 (e23.) ; 25746 50702 jl. i1. 25747 50704 jl. (i10.) ; entry found 25748 50706 i1: rl. w2 e70. ; 25749 50708 al w2 x2 +2 ; 25750 50710 rl. w3 e71. ; 25751 50712 wa w1 x2 ; 25752 50714 am. (e85. ; 25753 50716 sl w3 x1 ; 25754 50718 jl. i0. ; 25755 50720 al w2 -10 ; entry not found 25756 50722 jl. (i10.) ; 25757 50724 e.z. 25758 50724 25758 50724 ; parameter table: 25759 50724 ; contains a byte for each character type in the follwoing states: 25760 50724 ; 0 initial state 25761 50724 ; 1 after letter 25762 50724 ; 2 after digit 25763 50724 ; each entry defines the address of an action (relative to the 25764 50724 ; procedure next param) and a new state: 25765 50724 ; entry=action<2 + new state 25766 50724 25766 50724 b.i24 25767 50724 i0=(:d3-d2:)<2+0, i1=i0+1, i2=i0+2 25768 50724 i3=(:d4-d2:)<2+1, i4=(:d5-d2:)<2+2, i5=(:d6-d2:)<2+2 25769 50724 i6=(:d7-d2:)<2+0, i7=(:d8-d2:)<2+0 25770 50724 i9=(:d11-d2:)<2+0 25771 50724 25771 50724 ; initial state: 25772 50724 h.h1: i3, i5, i4, i0 ; letter 1, digit 2, unknown 0, continue 0 25773 50728 i6, i9, i6, i0 ; unknown 0, endline, unknown 0, continue 0 25774 50732 ; after letter: 25775 50732 i3, i3, i6, i7 ; letter 1, letter 1, radix 0, delimit 0 25776 50736 i7, i9, i6, i1 ; delimit 0, endline, unknown 0, continue 1 25777 50740 ; after digit: 25778 50740 i6, i5, i4, i7 ; unknown 0, digit 2, radix 2, delimit 0 25779 50744 i7, i9, i6, i2 ; delimit 0, endline, unknown 0, continue 2 25780 50748 e. 25781 50748 jl. d2. ; 25782 50750 d2=k-2 25783 50750 jl. d9. ; 25784 50752 d9=k-2 25785 50752 jl. d10. ; 25786 50754 d10=k-2 25787 50754 jl. d15. ; 25788 50756 d15=k-2 25789 50756 jl. d16. ; 25790 50758 d16=k-2 25791 50758 jl. d19. ; 25792 50760 d19=k-2 25793 50760 jl. d20. ; 25794 50762 d20=k-2 25795 50762 jl. d21. ; 25796 50764 d21=k-2 25797 50764 jl. d22. ; 25798 50766 d22=k-2 25799 50766 jl. d23. ; 25800 50768 d23=k-2 25801 50768 jl. d24. ; 25802 50770 d24=k-2 25803 50770 jl. d25. ; 25804 50772 d25=k-2 25805 50772 jl. d26. ; 25806 50774 d26=k-2 25807 50774 jl. d27. ; 25808 50776 d27=k-2 25809 50776 jl. d29. ; 25810 50778 d29=k-2 25811 50778 jl. d32. ; 25812 50780 d32=k-2 25813 50780 jl. d34. ; 25814 50782 d34=k-2 25815 50782 jl. d35. ; 25816 50784 d35=k-2 25817 50784 jl. d36. 25818 50786 d36=k-2 25819 50786 jl. d38. 25820 50788 d38=k-2 25821 50788 jl. d39. ; 25822 50790 d39=k-2 25823 50790 jl. d42. ; 25824 50792 d42=k-2 25825 50792 jl. d46. ; 25826 50794 d46=k-2 25827 50794 jl. d61. ; 25828 50796 d61=k-2 25829 50796 jl. d77. ; 25830 50798 d77=k-2 25831 50798 jl. d78. ; 25832 50800 d78=k-2 25833 50800 jl. d79. ; 25834 50802 d79=k-2 25835 50802 25835 50802 25835 50802 25835 50802 c69:<:susercat:>, 0, 0 ; name of s-usercat, incl. name table table entry 25836 50812 \f 25836 50812 25836 50812 m. 25836 50812 mons2 - monitor operatins system s, part 2 25837 50812 25837 50812 b.i30 w. 25838 50812 i0=82 03 30 , i1=13 00 00 25839 50812 25839 50812 ; if newtime (i0,i1) > oldtime (a133,a134) then oldtime:=newtime; 25840 50812 c.i0-a133 25841 50812 c.i0-a133-1, a133=i0, a134=i1, z. 25842 50812 c.i1-a134-1, a134=i1, z. 25843 50812 z. 25844 50812 25844 50812 i10=i0, i20=i1 25845 50812 25845 50812 i15=i10/100000 , i10=i10-i15*100000 , i25=i20/100000 , i20=i20-i25*100000 25846 50812 i14=i10/10000 , i10=i10-i14*10000 , i24=i20/10000 , i20=i20-i24*10000 25847 50812 i13=i10/1000 , i10=i10-i13*1000 , i23=i20/1000 , i20=i20-i23*1000 25848 50812 i12=i10/100 , i10=i10-i12*100 , i22=i20/100 , i20=i20-i22*100 25849 50812 i11=i10/10 , i10=i10-i11*10 , i21=i20/10 , i20=i20-i21*10 25850 50812 25850 50812 i2:<: date :> 25851 50836 (:i15+48:)<16+(:i14+48:)<8+46 25852 50838 (:i13+48:)<16+(:i12+48:)<8+46 25853 50840 (:i11+48:)<16+(:i10+48:)<8+32 25854 50842 25854 50842 (:i25+48:)<16+(:i24+48:)<8+46 25855 50844 (:i23+48:)<16+(:i22+48:)<8+46 25856 50846 (:i21+48:)<16+(:i20+48:)<8+ 0 25857 50848 25857 50848 i3: al. w0 i2. ; write date: 25858 50850 rs w0 x2 +0 ; first free:=start(text); 25859 50852 al w2 0 ; 25860 50854 jl x3 ; return to slang(status ok); 25861 50856 25861 50856 jl. i3. ; 25862 50858 e. 25863 50858 j. 25863 50812 date 82.03.30 13.00.00 25864 50812 25864 50812 25864 50812 w.e0: c0 ; <first addr> 25865 50814 ;e1 ; defined below 25866 50814 25866 50814 e2:c4 ; <own buf> 25867 50816 e3:c5 ; <own area> 25868 50818 e4:0 ; <max device> 25869 50820 e5:h0 ; <char table> 25870 50822 e6:h1 ; <param table> 25871 50824 e7:h2 ; <first command> 25872 50826 e12:h3 ; <top command table> 25873 50828 e8:0-0-0 ; <last of initcat code> 25874 50830 e9:h4 ; <first console> 25875 50832 e10:h5 ; <last console> 25876 50834 e11:h6 ; <first device> 25877 50836 e13:h8 ; <first work> 25878 50838 e14:h9 ; <last work> 25879 50840 e33:h10 ; fictive element before first core table 25880 50842 e15=k-c20 25881 50842 e15,e15 25882 50846 e16:h11 ; <first core> 25883 50848 e17:0 ; <top core> 25884 50850 e18:0 ; <param type> 25885 50852 e19:0 ; <integer> 25886 50854 e24:h8 ; <work> ( initially: first work ) 25887 50856 ; *** the following variables must match part of work-area 25888 50856 e20:0 ; <name> 25889 50858 e21:0 ; 25890 50860 e22:0 ; 25891 50862 e23:0 ; 25892 50864 0 25893 50866 e78:0 ; used in list 25894 50868 e79:-1 ; segment in susercat or -1 25895 50870 e81:0 ;remove,1<21 indicator 25896 50872 e25:h21 ; <console> ( initially: first console ) 25897 50874 e26:0 ; <console buf> or <last addr> 25898 50876 e27:8 ; <char shift> (initially: prepared for empty char buf) 25899 50878 e28:0 ; <char addr> 25900 50880 e29:0 ; <child> 25901 50882 e30:0 ; <core addr> 25902 50884 ; *** end of work-area match 25903 50884 e31:h21 25904 50886 25904 50886 e34:0 25905 50888 e35=k-c20 25906 50888 h4,h22 25907 50892 e36: 25908 50892 e37:0 25909 50894 e38:0 25910 50896 e32:0,r.8 ; <message> 25911 50912 25911 50912 e88:0 ; expected answer 25912 50914 e89:0 ; executing reentrant code: 0=false, -1=true (initially = false) 25913 50916 25913 50916 e39:0 ; <event> 25914 50918 e40:0 ; <receiver> 25915 50920 e41:0 ; 25916 50922 e42:0 ; 25917 50924 e43:0,0 ; 25918 50928 e55:0 ; <write shift> 25919 50930 e44:5<12 ; <type mess> 25920 50932 e45:0 ; <line addr> 25921 50934 e46:0 ; <write addr> 25922 50936 0 25923 50938 e47:3<12 ; <area mess> or <input mess> 25924 50940 e48:0 ; <first addr> 25925 50942 e49:0 ; <last addr> 25926 50944 e50:0 ; <segment> 25927 50946 e87: 0 ; areabuf state: 0=defined, else undef (initially defined) 25928 50948 e51:0 ; <entry tail> or <answer> or <message> 25929 50950 e52:0 ; 25930 50952 e53:0 ; 25931 50954 e54:0 ; <convert area> 25932 50956 0 25933 50958 e56:0 ; <read shift> or <radix> or <start> 25934 50960 e57:0 ; <read addr> or <state> or <size> 25935 50962 e58:0 ; <save w1> or <first segment> 25936 50964 e59:0 ; <save w2> or <content> or <keys> or <result> 25937 50966 e60:0 ; <link> or <bytes to load> 25938 50968 e61:0 ; <child w0> 25939 50970 e62:0 ; <child w1> 25940 50972 e63:0 ; <child w2> 25941 50974 e64:0 ; <child w3> 25942 50976 e65:0 ; <child ex> 25943 50978 e66:0 ; <child ic> 25944 50980 e67=e59+1 ; <ic in entry> 25945 50980 e68=e66+2 25946 50980 0,0 25947 50984 e69:0 ;jobcount 25948 50986 c.(:c23>14 a.1:)-1 25949 50986 e70:h19 25950 50988 e71:h20 25951 50990 z. 25952 50990 e72: -1 ; first logic address (default value) 25953 50992 m. 25953 50992 s lock indicator. 25954 50992 c.(:c23>13 a.1:)-1 ; if teminals shal be blocked after start up 25955 50992 e80: -1 ; then e80=-1, else 25956 50992 z. 25957 50992 c.-(:c23>13 a.1:) ; 25958 50992 e80: 0 ; e80=0 25959 50994 z. 25960 50994 e85:0 ; used in job command 25961 50996 25961 50996 ; end line: 25962 50996 e1=e17-a17;******************** 25963 50996 g1: jl. w1 g28. ; 25964 50998 g48=k+4 25965 50998 <:ready **date not initialized <0>:> ; text until date initialized 25966 51020 g2: jl. w1 g28. ; 25967 51022 <:syntax error:<0>:> 25968 51032 g3: jl. w1 g28. ; 25969 51034 <:not allowed<0>:> 25970 51042 g4: jl. w1 g28. ; 25971 51044 <:no core<0>:> 25972 51050 g5: jl. w1 g28. ; 25973 51052 <:no buffers<0>:> 25974 51060 g6: jl. w1 g28. ; 25975 51062 <:no areas<0>:> 25976 51068 g7: jl. w1 g28. ; 25977 51070 <:no internals<0>:> 25978 51080 g8: jl. w1 g28. ; 25979 51082 <:illegal cpa<0>:> 25980 51090 g9: jl. w1 g28. ; 25981 51092 <:process unknown<0>:> 25982 51104 g10: jl. w1 g28. ; 25983 51106 <:process exists<0>:> 25984 51116 g11: jl. w1 g28. ; 25985 51118 <:catalog error<0>:> 25986 51128 g12: jl. w1 g28. ; 25987 51130 <:area unknown<0>:> 25988 51140 g13: jl. w1 g28. ; 25989 51142 <:area reserved<0>:> 25990 51152 g14: jl. w1 g28. ; 25991 51154 <:program too big<0>:> 25992 51166 g15: jl. w1 g28. ; 25993 51168 <:area error<0>:> 25994 51176 g16: jl. w1 g28. ; 25995 51178 <:device unknown<0>:> 25996 51188 g17: jl. w1 g28. ; 25997 51190 <:device reserved<0>:> 25998 51202 g18: jl. w1 g28. ; 25999 51204 <:not implemented<0>:> 26000 51216 g19: jl. w1 g28. ; 26001 51218 <:base illegal<0>:> 26002 51228 g20: jl. w1 g28. ; 26003 51230 <:bs claims exceeded<0>:> 26004 51244 g21: jl. w1 g28. ; 26005 51246 <:bs device unknown<0>:> 26006 51258 g22: jl. w1 g28. ; 26007 51260 <:name unknown<0>:> 26008 51270 g23:<:message<0>:> 26009 51276 g24:<:pause<0>:> 26010 51280 g25: jl. w1 g28. ; 26011 51282 <:no entries in maincat<0>:> 26012 51298 g26:<:max<0>:> 26013 51302 g27: jl. w1 g28. ; 26014 51304 <:illegal priority<0> :> 26015 51316 g29: jl. w1 g28. ; 26016 51318 <:prog name unknown<0>:> 26017 51330 g47: jl. w1 g28. ; 26018 51332 <:input aborted<0>:> 26019 51342 g101: jl. w1 g28. 26020 51344 <:illegal relocation<0>:> 26021 51358 26021 51358 g28: 26022 51358 ld w3 -100 ; w2=w3=0 26023 51360 se w3 (b13) ; if clock initialized then 26024 51362 rs. w3 g48. ; remove warning 26025 51364 sn. w1 g2.+2 ; if 'syntax' then 26026 51366 al w2 10 ; set w2=10 26027 51368 se. w1 g1.+2 ; else 26028 51370 hs. w3 e81. ; reset remove indicator 26029 51372 al w3 -1 ; 26030 51374 rs. w3 e89. ; executing reentrant code := true; 26031 51376 rs. w3 e79. ; reset segment no in susercat 26032 51378 jl. w3 d19. ; init write 26033 51380 jl. w3 d21. ; write text 26034 51382 se w2 10 ; if syntax error then 26035 51384 jl. g46. ; 26036 51386 al. w1 e20. ; write last read parameter 26037 51388 jl. w3 d21. ; 26038 51390 rl. w1 e19. ; 26039 51392 rl. w0 e20. ; 26040 51394 sn w0 0 26041 51396 jl. w3 d22. ; 26042 51398 g46: al w0 10 ; 26043 51400 jl. w3 d20. ; write <nl> 26044 51402 jl. w3 d23. ; type line 26045 51404 jl. w3 d42. ; save work(buf); 26046 51406 jl. 2 ;+2: error 26047 51408 rl. w1 e25. ; 26048 51410 jl. w3 d10. ; decrease access 26049 51412 26049 51412 g30: al w2 0 ; exam first: 26050 51414 rs. w2 e81. ; reset remove list indicator 26051 51416 jl. g32. ; event:=0; 26052 51418 g31: rl. w2 e39. ; exam next: 26053 51420 g32: jd 1<11+24 ; wait event(event,next,result); 26054 51422 rs. w2 e39. ; event:=next; 26055 51424 rl w1 x2 +6 ; sender:=word(event+6); 26056 51426 c.(:c24>20a.1:)-1 ; if event testoutput then 26057 51426 jd 1<11+30 ; begin type w1(sender); 26058 51426 jd 1<11+32 ; type w2(event); 26059 51426 z. ; end; 26060 51426 sz. w2 (e89.) ; if executing non-reentrant code 26061 51428 jl. g41. ; and 26062 51430 se. w2 (e88.) ; event <> expected answer then 26063 51432 jl. g32. ; goto exam next; 26064 51434 g41: ; 26065 51434 sn w0 0 ; if result=0 then 26066 51436 jl. g34. ; goto message received; 26067 51438 jl. w3 d41. ; find work(event,old work); 26068 51440 al. w1 e51. ; answer received: 26069 51442 jd 1<11+18 ; wait answer(event,answer,result) 26070 51444 al w3 1 ; w1 := logical status 26071 51446 ls w3 (0) ; := 1 shift result 26072 51448 sn w3 1<1 ; + maybe status.answer; 26073 51450 lo w3 x1 ; 26074 51452 rs. w3 e59. ; 26075 51454 jl. w3 d43. ; restore work(work,event); 26076 51456 26076 51456 g33: rl. w2 e39. ; reject message: 26077 51458 jd 1<11+26 ; get event(event); 26078 51460 al w0 2 ; 26079 51462 al. w1 e51. ; 26080 51464 jd 1<11+22 ; send answer(event,answer,2); 26081 51466 jl. g30. ; goto exam first; 26082 51468 26082 51468 g34: rl. w3 e2. ; message received: 26083 51470 sh w3 1 ; if own buf<=1 26084 51472 jl. g31. ; then goto exam next; 26085 51474 sh w1 -1 ; if sender<0 26086 51476 jl. g33. ; then goto reject message; 26087 51478 sn w0 (x1 +0) ; if kind(sender)=0 26088 51480 jl. g50. ; then goto internal message; 26089 51482 al w0 x1 ; 26090 51484 jl. w3 d24. ; find console(device,console, 26091 51486 jl. g33. ; reject message); 26092 51488 rs. w1 e25. ; console:= new console 26093 51490 jl. w3 d9. ; increase access 26094 51492 26094 51492 26094 51492 jd 1<11+26 ; get event(console buf); 26095 51494 al w0 1 ; 26096 51496 al. w1 e51. ; 26097 51498 jd 1<11+22 ; send answer(console) 26098 51500 al w2 0 ; 26099 51502 jl. w3 d41. ; find work(0,new work); 26100 51504 al w0 x1+c73 ; input stack pointer := stack base; 26101 51506 rs w0 x1+c58 ; 26102 51508 g39: ; end; 26103 51508 al w2 x1+c66 ; first addr:= work+linebuf; 26104 51510 al w3 x1+c67 ; last addr:= work+outputlinebuf-2; 26105 51512 ds. w3 e49. ; 26106 51514 al. w1 e47. ; 26107 51516 jl. w3 d26. ; send buf (input mess, buf); 26108 51518 jl. w3 d42. ; save work(buf); 26109 51520 jl. g47. ;+2: error: goto end line; 26110 51522 al w2 x1+c66-2 ; char shift := > 0; (* i.e. change word *) 26111 51524 ds. w2 e28. ; char addr := work + linebuf - 2; 26112 51526 wa. w2 e52. ; 26113 51528 rs. w2 e26. ; last addr := char addr + bytes; 26114 51530 ; next command: 26115 51530 g35: jl. w3 d2. ; next param(type); 26116 51532 g36: sn w0 0 ; exam command: 26117 51534 jl. g98. ; if type=0 26118 51536 se w0 1 ; or type<>1 26119 51538 jl. g2. ; then goto end line; 26120 51540 26120 51540 jl. w3 d19. ; init write; 26121 51542 al w3 -1 ; 26122 51544 rs. w3 e89. ; executing reentrant code := true; 26123 51546 26123 51546 rl. w3 e7. ; w3 := base of command table; 26124 51548 g37:; next command: 26125 51548 al w3 x3 +6 ; increase (command pointer); 26126 51550 dl w2 x3 +2 ; w1w2 := command name; 26127 51552 sh w1 0 ; if first of command <= 0 then 26128 51554 jl. g38. ; goto test end; 26129 51556 sn. w1 (e20.) ; if command.table <> name then 26130 51558 se. w2 (e21.) ; 26131 51560 jl. g37. ; goto next command; 26132 51562 ; notice: only 6 first characters tested 26133 51562 26133 51562 ; command found in table: 26134 51562 ; test that it is allowed to call this command from this console 26135 51562 26135 51562 al w2 0 ; 26136 51564 rl w3 x3 +4 ; 26137 51566 26137 51566 ld w3 10 ; w0:= command mask.console 26138 51568 ls w3 -10 ; w1:= console 26139 51570 rl. w1 e25. ; w2:= command bits.command table 26140 51572 bz w0 x1+c27 ; w3:= relative command address 26141 51574 so w2 1 ; if command not list max print or modify then 26142 51576 hs. w2 e81.+1 ; remove console=false 26143 51578 ls w2 -1 ; 26144 51580 ls w2 3 ; 26145 51582 sz w0 1<3 ; if console privileged then 26146 51584 jl. g40. ; goto command base 26147 51586 so w0 x2 ; if command not allowed(console) then 26148 51588 jl. g3. ; goto end line 26149 51590 so. w2 (e80.) ; if locked and not a bit 3 command then 26150 51592 jl. g3. ; goto end line 26151 51594 26151 51594 g40: jl. x3+g45. ; goto command-action; 26152 51596 ; init write has been called 26153 51596 ; w0 = command mask(console) 26154 51596 ; w1 = console 26155 51596 26155 51596 g38:; test found: 26156 51596 sn w1 0 ; if continuation = 0 then 26157 51598 jl. g2. ; goto end line; i.e. all commands tested 26158 51600 26158 51600 ; all commands, not contained in primary part of command table, are 26159 51600 ; considered non-reentrant 26160 51600 26160 51600 al w3 0 ; 26161 51602 rs. w3 e89. ; executing reentrant code := false; 26162 51604 26162 51604 26162 51604 ac w3 x1 +6 ; w3 := continuation address for more commands; 26163 51606 ; (notice w3 = base of commands) 26164 51606 jl. g37. ; goto next command; 26165 51608 26165 51608 g98: rl. w1 e24. ; if stack=stackbase then 26166 51610 rl w2 x1+c58 ; goto endline else 26167 51612 sn w2 x1+c73 ; goto next command 26168 51614 jl. g1. ; 26169 51616 jl. g35. ; 26170 51618 26170 51618 26170 51618 26170 51618 g50:; message: 26171 51618 dl w0 x2 +10 ; 26172 51620 ds. w0 e32.+2 ; move message from buffer to <message>; 26173 51622 dl w0 x2 +14 ; 26174 51624 ds. w0 e32.+6 ; 26175 51626 dl w0 x2 +18 ; 26176 51628 ds. w0 e32.+10 ; 26177 51630 dl w0 x2 +22 ; 26178 51632 ds. w0 e32.+14 ; 26179 51634 al w2 x1 +0 ; 26180 51636 jl. w3 d25. ; find parent(sender,parent, 26181 51638 jl. g33. ; reject message); 26182 51640 rs. w1 e25. ; console:= parent; 26183 51642 rs. w2 e29. ; child:= sender; 26184 51644 al w2 0 ; 26185 51646 jl. w3 d41. ; find work(0,new work); 26186 51648 jl. w3 d19. ; init write; 26187 51650 rl. w3 e32. ; if message(0)(23)=1 then 26188 51652 so w3 2.1 ; begin stop child; 26189 51654 am d33-d39 ; writetext(<:pause:>) 26190 51656 jl. w3 d39. ; end 26191 51658 se. w3 0 ; else 26192 51660 am g24-g23 ; begin child name; 26193 51662 al. w1 g23. ; writetext(<:message:>) 26194 51664 jl. w3 d21. ; end; 26195 51666 rl. w2 e39. ; 26196 51668 jd 1<11+26 ; get event(event); 26197 51670 al w0 1 ; 26198 51672 al. w1 e32. ; 26199 51674 jd 1<11+22 ; send answer(event,message,1); 26200 51676 al. w1 e40. ; 26201 51678 jl. w3 d21. ; writetext(receiver); 26202 51680 al. w2 e32.+2 ; index:= 2; 26203 51682 g43: rl w1 x2 +0 ; next word: 26204 51684 bl. w3 e32.+1 ; word:= message(index); 26205 51686 ls w3 1 ; bits:= message(1); 26206 51688 hs. w3 e32.+1 ; message(1):= bits shift 1; 26207 51690 sh w3 -1 ; if bits(0)=1 then 26208 51692 jl. g44. ; goto number; 26209 51694 sn w1 0 ; if word=0 then 26210 51696 jl. g42. ; goto test more; 26211 51698 al w0 0 ; char:= word(0:7); 26212 51700 ld w1 8 ; word:= word shift 8; 26213 51702 jl. w3 d20. ; writechar(char); 26214 51704 al w0 0 ; char:= word(0:7); 26215 51706 ld w1 8 ; word:= word shift 8; 26216 51708 jl. w3 d20. ; writechar(char); 26217 51710 al w0 0 ; char:= word(0:7); 26218 51712 ld w1 8 ; word:= word shift 8; 26219 51714 am d20-d22 ; writechar(char); 26220 51716 ; goto test more; 26221 51716 ; number: 26222 51716 ; writeinteger(word); 26223 51716 g44: jl. w3 d22. ; test more: 26224 51718 g42: al w2 x2 +2 ; index:= index+2; 26225 51720 sh. w2 e32.+14 ; if index<=14 then 26226 51722 jl. g43. ; goto next word; 26227 51724 al w0 10 ; 26228 51726 jl. w3 d20. ; writechar(10); 26229 51728 jl. w3 d23. ; typeline(buf); 26230 51730 rs. w2 e23.+2 ; clear function 26231 51732 zl. w1 e32.+1 ; if stop bit on then 26232 51734 so w1 8.200 ; begin 26233 51736 jl. g97. ; 26234 51738 zl. w1 e32. ; save function 26235 51740 rs. w1 e23.+2 ; 26236 51742 se w1 10 ; if function = replace then 26237 51744 jl. g97. ; save areaname 26238 51746 rl. w3 e24. ; save name in input buffer 26239 51748 al w3 x3+c66 ; 26240 51750 dl. w1 e32.+10 ; 26241 51752 ds w1 x3+2 ; 26242 51754 dl. w1 e32.+14 ; 26243 51756 ds w1 x3+6 ; end 26244 51758 dl. w1 e26. ; simulate empty input string 26245 51760 ds. w1 e28. ; ( after unstack command) 26246 51762 g97: jl. w3 d42. ; save work 26247 51764 am 0 ; +2 error (dont care) 26248 51766 rl. w3 e23.+2 ; if function =finis or replace then 26249 51768 se w3 10 ; 26250 51770 sn w3 2 ; 26251 51772 sz ; 26252 51774 jl. g30. ; 26253 51776 jl. w3 d76. ; adjust bs claim 26254 51778 jl. w3 d40. ; remove process 26255 51780 rl. w3 e23.+2 ; if function =replace then 26256 51782 se w3 10 ; 26257 51784 jl. g30. ; 26258 51786 rl. w2 e24. ; stack input and 26259 51788 al w2 x2+c66 ; 26260 51790 jl. w3 d79. ; goto next command 26261 51792 jl. g35. ; 26262 51794 26262 51794 g45: ; base for command-relatives 26263 51794 26263 51794 ; define pseudo-entries for conditinally-assembled commands 26264 51794 g70: ; break 26265 51794 g72: ; include 26266 51794 g73: ; exclude 26267 51794 g74: ; call 26268 51794 g75: ; list 26269 51794 g76: ; max 26270 51794 g77: ; replace 26271 51794 g83: ; all 26272 51794 g89: ; job 26273 51794 g90: ; print 26274 51794 g91: ; modify 26275 51794 jl. g18. ; goto not implemented; 26276 51796 26276 51796 26276 51796 26276 51796 ; command syntax: read <area name> 26277 51796 g57: ; read: 26278 51796 jl. w3 d15. ; next name; 26279 51798 al. w2 e20. ; 26280 51800 am -2048 ; 26281 51802 jl. w3 d79.+2048; stack input (name); 26282 51804 jl. g35. ; goto next command; 26283 51806 26283 51806 26283 51806 ; command syntax: unstack 26284 51806 g58: ; unstack: 26285 51806 am -2048 ; 26286 51808 jl. w2 d80.+2048; unstack input; 26287 51810 jl. g35. ; goto next command; 26288 51812 26288 51812 26288 51812 ; command syntax: date <year> <month> <date> <hour> <min> <sec> 26289 51812 26289 51812 b. i20, j30 w. ; 26290 51812 j0: ; minimum values: 26291 51812 82 , 1 , 1 , 0 , 0 , 0 26292 51824 j1: ; top values: 26293 51824 99+1, 12+1, 31+1, 23+1, 59+1, 59+1 26294 51836 j2: ; year,month,day,hour,min,sec 26295 51836 0 , 0 , 0 , 0 , 0 , 0 26296 51848 j5: ; month table: jan, ..., dec 26297 51848 h. 365, 396, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334 26298 51860 w. 26299 51860 j11: 4 ; minutes per four minutes 26300 51862 j13: 24 ; hours per day 26301 51864 j14: 60 ; minutes per hour 26302 51866 j17: 365*3+366 ; days per four years (inclusive leap year) 26303 51868 j18: 10000 ; units per second 26304 51870 j20: 60*4 * 10000 ; units per four minutes 26305 51872 26305 51872 j30: <:oldcat:> ; name of successor-command 26306 51876 26306 51876 g49: ; date: 26307 51876 al w1 0 ; for i := 0 step 2 until 10 do 26308 51878 i0: ; begin 26309 51878 jl. w3 d16. ; next integer; 26310 51880 sl. w0 (x1+j0.) ; if number < min value 26311 51882 sl. w0 (x1+j1.) ; or number >= top value then 26312 51884 jl. g2. ; goto syntax error; (* i.e. illegal date *) 26313 51886 rs. w0 x1+j2. ; save number; 26314 51888 al w1 x1+2 ; 26315 51890 se w1 12 ; 26316 51892 jl. i0. ; end; 26317 51894 26317 51894 dl. w2 j2.+2 ; w1 := year; w2 := month; 26318 51896 sh w2 2 ; if month > february then 26319 51898 al w1 x1-1 ; year := year - 1; 26320 51900 26320 51900 al w1 x1-68 ; days := (year - 68) 26321 51902 wm. w1 j17. ; * days in four years 26322 51904 as w1 -2 ; / 4 26323 51906 ba. w1 x2+j5.-1 ; + month table (month) 26324 51908 wa. w1 j2.+4 ; + day; 26325 51910 26325 51910 wm. w1 j13. ; w1 := hours := days * 24 26326 51912 wa. w1 j2.+6 ; + hour; 26327 51914 26327 51914 al w2 0 ; w2w3 := min; 26328 51916 rl. w3 j2.+8 ; 26329 51918 26329 51918 wm. w1 j14. ; w0w1 := minutes := hours * 60 26330 51920 aa w1 6 ; + min; 26331 51922 26331 51922 wd. w1 j11. ; w1 := fourmin := minutes / 4; 26332 51924 wm. w0 j14. ; seconds := minutes mod 4 * 60 26333 51926 wa. w0 j2.+10 ; + sec; 26334 51928 26334 51928 wm. w0 j18. ; msec := seconds * 10000; 26335 51930 rl w3 0 ; (w2=0) w3 := msec; 26336 51932 26336 51932 wm. w1 j20. ; clock := fourmin * 2400000 26337 51934 aa w1 6 ; + msec; 26338 51936 jd 1<11+38; set clock (clock); 26339 51938 26339 51938 dl. w1 j30.+2 ; name := successor command name; 26340 51940 ds. w1 e21. ; 26341 51942 al w0 1 ; type := 1; <* i.e. pretend that 'oldcat' has been read *> 26342 51944 sl w0 (b25) ; if maincat not defined yet then 26343 51946 jl. g36. ; goto next command; <* i.e. interpret 'oldcat' *> 26344 51948 26344 51948 jl. g35. ; goto next command; 26345 51950 26345 51950 e. ; 26346 51950 26346 51950 26346 51950 b.i30 w. ; new: 26347 51950 g51: 26348 51950 la. w0 i0. ; abs addr(console):= all bs(console):= 26349 51952 ; abs protection(console):=false; 26350 51952 rs w0 x1+c26 ; prio(console):= 0; 26351 51954 hs w0 x1+c37 ; pr(console):=illegal pr; 26352 51956 dl. w3 i2. ; buf claim(console):=standard buf; 26353 51958 ds w3 x1+c34 ; area claim(console):=standard area; 26354 51960 rl. w3 i3. ; internal claim(console):=standard int; 26355 51962 rs w3 x1+c39 ; cat mask(console):=standard cat; 26356 51964 rl. w0 i9. ; 26357 51966 rl. w3 i9. ; 26358 51968 ds w0 x1+c41+2 ; max interval(console):=max interval(s) 26359 51970 ds w0 x1+c42+2 ; standard interval(s) 26360 51972 ds w0 x1+c43+2 ; 26361 51974 jl. w3 d46. ; reset last of console; 26362 51976 rl. w2 i25. ; get work device name 26363 51978 jl. w3 d61. ; get devno*8 26364 51980 jl. g16. ; sorry goto end line 26365 51982 wa. w2 e25. ; 26366 51984 dl. w0 i6. ; perm claim(work device) := 26367 51986 ds w0 x2+c44+6 ; standard segment,entries; 26368 51988 i10: dl. w3 i4. ; size(console):=standard size; 26369 51990 rl. w1 e25. ; 26370 51992 ds w3 x1+c40+2 ; 26371 51994 dl. w3 i5. ; 26372 51996 ds w3 x1+c40+6 ; prog(console):=standard prog; 26373 51998 jl. g52. ; goto process; 26374 52000 i0:8.1771 ; 26375 52002 c7<12+c8 ; standard buf and area: 26376 52004 i2:c9<12+c10 ; standard int and func: 26377 52006 i3:c12 ; standard size: 26378 52008 i4=k+2, i5=k+6 ; standard prog: 26379 52008 <:fp:>,0,0,0 ; 26380 52016 c13 ; standard segment claim 26381 52018 i6:c14 ; standard entry claim 26382 52020 i8:8.2000 ; all bs resources bit 26383 52022 i9:8388605 26384 52024 i25: c15 ; work device name 26385 52026 c. (:c23>16a.1:)-1 ; 26386 52026 26386 52026 g83 = k ; all: 26387 52026 la. w0 i0. ; abs addr(console):= 26388 52028 lo. w0 i8. ; abs prot(console):= false 26389 52030 rs w0 x1+c26 ; all bs(console):= true 26390 52032 rl w2 b1 ; 26391 52034 dl w0 x2+a45 ; 26392 52036 ds w0 x1+c41+2 ; maxbase:=standardbase(s) 26393 52038 ds w0 x1+c42+2 ; standardbase:= ------ 26394 52040 ds w0 x1+c43+2 ; userbase:= ------- 26395 52042 bz w0 x2+a19 ; bufclaims(s) 26396 52044 ws. w0 e2. ; - ownbuf 26397 52046 hs w0 x1+c32 ; =: bufclaims(console) 26398 52048 bz w0 x2+a20 ; areaclaims(s) 26399 52050 ws. w0 e3. ; - own area 26400 52052 hs w0 x1+c33 ; =: areaclaims(console) 26401 52054 bz w0 x2+a21 ; internalclaims(s) 26402 52056 bs. w0 1 ; -1 26403 52058 hs w0 x1+c34 ; =:internalclaims(console) 26404 52060 bz w0 x2+a22 ; functionmask(s) 26405 52062 hs w0 x1+c35 ; =: functionmask(console) 26406 52064 jl. w3 d29. ; find max(size) 26407 52066 sn w1 0 ; if max size =0 then 26408 52068 jl. g4. ; return "no core " 26409 52070 rl. w2 e25. ; 26410 52072 rs w1 x2+c39 ; size(console):= size 26411 52074 c.-4000 ; only in rc4000: 26412 52074 al w2 8 ; keys:= 8 26413 52074 jl. w3 d32. ; find keys(keys,pr,pk,notused) 26414 52074 am 0 ; 26415 52074 ac w0 x2 -8 ; 26416 52074 rl. w1 e25. ; 26417 52074 hs w0 x1+c26 ; keys(console):= 8-keys 26418 52074 z. ; 26419 52074 ; 26420 52074 ; 26421 52074 jl. w3 d46. ; clear claimlist; 26422 52076 jl. i10. ; 26423 52078 z. ; 26424 52078 e. 26425 52078 b. j5 w. 26426 52078 g94: am c95-c96 ; i: 26427 52080 g95: al w1 x1+c96+2 ; o: 26428 52082 jl. w3 d16. ; get kind 26429 52084 rs w0 x1-2 ; 26430 52086 jl. j1. ; continue with get name 26431 52088 26431 52088 g52: am c29-c40 ; process: 26432 52090 g53: al w1 x1+c40 ; program: 26433 52092 j1: jl. w3 d15. ; next name; 26434 52094 rl. w3 j2. ; test name 26435 52096 sn. w3 ( e20.) ; if name="s" 26436 52098 jl. g3. ; then goto error : not allowed 26437 52100 dl. w3 e21. ; 26438 52102 ds w3 x1 +2 ; 26439 52104 dl. w3 e23. ; 26440 52106 ds w3 x1 +6 ; name(console):=name; 26441 52108 c.(:c24>18a.1:)-1 ; if console testoutput 26442 52108 jl. w3 d44. ; then type description; 26443 52108 z. jl. g35. ; goto next command; 26444 52110 j2: <:s<0>:> ; (prevent blocking communication with s) 26445 52112 e. 26446 52112 26446 52112 b.i24 26447 52112 w.g54:lo. w0 i0. ; address: 26448 52114 hs w0 x1+c27 ; abs addr(console):=true; 26449 52116 am c30-c39 ; 26450 52118 g56: al w2 x1+c39 ; size: 26451 52120 jl. w3 d16. ; next integer(integer); 26452 52122 sz w0 2.1 ; 26453 52124 bs. w0 1 ; integer(23):= 0; 26454 52126 rs w0 x2 +0 ; word param(console):=integer; 26455 52128 c.(:c24>18a.1:)-1 ; if console testoutput 26456 52128 jl. w3 d44. ; then type description; 26457 52128 z. jl. g35. ; goto next command; 26458 52130 i0:1<1 26459 52132 e. 26460 52132 c.8000 ; in rc8000: 26461 52132 b.i10 26462 52132 w. 26463 52132 ; mode : 26464 52132 ; syntax mode <short integer> 26465 52132 26465 52132 g55: la. w0 i2. ; abs protection=false 26466 52134 rs w0 4 ; w2=command mask 26467 52136 jl. w3 d16. ; next integer 26468 52138 sn w0 0 ; if mode=0 then 26469 52140 lo. w2 i3. ; abs protection=true 26470 52142 rs w2 x1+c26 ; 26471 52144 jl. g35. ; next command 26472 52146 26472 52146 z. 26473 52146 c.-4000 ; only in rc4000 26474 52146 26474 52146 g57:al w2 x1+c26 ; key claim: 26475 52146 la. w0 i2. ; abs protection(console):=false; 26476 52146 jl. i0. ; goto set param; 26477 52146 g59: al w2 x1+c38 ; pk: 26478 52146 lo. w0 i3. ; abs protection(console):=true; 26479 52146 i0: hs w0 x1+c27 ; set param: 26480 52146 jl. i1. ; 26481 52146 z. 26482 52146 26482 52146 g60: am c32-c33 ; buffer claim: 26483 52148 g61: am c33-c34 ; area claim: 26484 52150 g62: al w2 x1+c34 ; internal claim: 26485 52152 i1: jl. w3 d16. ; next integer(integer); 26486 52154 hs w0 x2 +0 ; byte param(console):=integer; 26487 52156 c.(:c24>18a.1:)-1 ; if console testoutput 26488 52156 jl. w3 d44. ; then type description; 26489 52156 z. jl. g35. ; goto next command; 26490 52158 i2:8.7773 26491 52160 i3:1<2 26492 52162 e. 26493 52162 c.-4000 26494 52162 26494 52162 b.i24 ; pr: 26495 52162 w.g58:jl. w3 d45. ; next bitnumbers(bits, type); 26496 52162 ls w2 -16 ; bits:=bits shift -16; 26497 52162 lx. w2 i0. ; bits:=bits exor 8.377; 26498 52162 lo. w2 i1. ; bits(16):=1; 26499 52162 hs w2 x1+c37 ; pr(console):=bits(12:23); 26500 52162 c.(:c24>18a.1:)-1 ; if console testoutput 26501 52162 jl. w3 d44. ; then type description; 26502 52162 z. jl. g36. ; goto exam command; 26503 52162 i0:8.377 26504 52162 i1:1<7 26505 52162 e. 26506 52162 z. 26507 52162 26507 52162 26507 52162 ; cpa <cpavalue> or 0 or 1 : 26508 52162 26508 52162 g59: jl. w3 d16. ; next integer 26509 52164 sh w0 -1 ; if < 0 then 26510 52166 jl. g8. ; write : illegal cpa 26511 52168 rs w0 x1+c98 ; 26512 52170 jl. g35. ; goto next command 26513 52172 26513 52172 26513 52172 ; function mask: 26514 52172 g63: jl. w3 d45. ; next bitnumbers(bits, type); 26515 52174 ls w2 -12 ; 26516 52176 hs w2 x1+c35 ; function mask(console):=bits(0:11); 26517 52178 c.(:c24>18a.1:)-1 ; if console testoutput 26518 52178 jl. w3 d44. ; then type description; 26519 52178 z. jl. g36. ; goto exam command; 26520 52180 26520 52180 g64:; create: 26521 52180 jl. w3 d35. ; 26522 52182 rl. w2 e29. ; create child; 26523 52184 rl w0 x2+a17 ; 26524 52186 wa w0 x2+a182 26525 52188 jl. w3 d36. ; modify child(first addr(child)); 26526 52190 c.(:c24>18a.1:)-1 ; if console testoutput 26527 52190 jl. w3 d44. ; then type description; 26528 52190 z. jl. g35. ; goto next command; 26529 52192 26529 52192 ; init: 26530 52192 g65: jl. w3 d35. ; create child; 26531 52194 jl. w3 d37. ; load child; 26532 52196 jl. g35. ; goto next command; 26533 52198 26533 52198 ; run: 26534 52198 g66: jl. w3 d35. ; create child; 26535 52200 jl. w3 d37. ; load child; 26536 52202 jl. w3 d38. ; start child; 26537 52204 jl. g35. ; goto next command; 26538 52206 26538 52206 ; load: 26539 52206 g67: jl. w3 d34. ; check child; 26540 52208 jl. w3 d37. ; load child; 26541 52210 jl. g35. ; goto next command; 26542 52212 26542 52212 ; start: 26543 52212 g68: jl. w3 d34. ; check child; 26544 52214 jl. w3 d38. ; start child; 26545 52216 jl. g35. ; goto next command; 26546 52218 26546 52218 ; stop: 26547 52218 g69: jl. w3 d34. ; check child; 26548 52220 jl. w3 d39. ; stop child; 26549 52222 jl. g35. ; goto next command; 26550 52224 c.(:c23>22a.1:)-1 ; if break option then 26551 52224 g70 = k ; break: 26552 52224 jl. w3 d34. ; begin check child; 26553 52226 jl. w3 d39. ; stop child; 26554 52228 rl. w2 e29. ; 26555 52230 rl w3 x2+a27 ; addr:=interrupt addr(child); 26556 52232 sn w3 0 ; if addr<>0 then 26557 52234 jl. g35. ; begin 26558 52236 dl w1 x2+a29 ; word(addr):=save w0(child); 26559 52238 ds w1 x3 +2 ; word(addr+2):=save w1(child); 26560 52240 dl w1 x2+a31 ; word(addr+4):=save w2(child); 26561 52242 ds w1 x3 +6 ; word(addr+6):=save w3(child); 26562 52244 dl w1 x2+a33 ; word(addr+8):=save ex(child); 26563 52246 ds w1 x3 +10 ; word(addr+10):=save ic(child); 26564 52248 al w1 8 ; word(addr+12):=8; 26565 52250 rs w1 x3 +12 ; 26566 52252 al w0 x3+a180 ; modify child(addr+a180); 26567 52254 jl. w3 d36. ; start child; 26568 52256 jl. w3 d38. ; end; 26569 52258 jl. g35. ; goto next command; 26570 52260 z. 26571 52260 26571 52260 ; remove: 26572 52260 b. i24 26573 52260 w. g71: ; 26574 52260 jl. w3 d34. ; check child; 26575 52262 al w0 1 ; 26576 52264 hs. w0 e81. ; 26577 52266 jl. w3 d39. ; stop child; 26578 52268 jl. w3 d76. ; adjust bs-claims 26579 52270 jl. w3 d40. ; remove child; 26580 52272 jl. g35. ; goto next command; 26581 52274 i1:0 ; 26582 52276 e. 26583 52276 c.(:c23>21a.1:)-1 ; if include/exclude option then 26584 52276 g72 = k ; include: 26585 52276 am 2 ; 26586 52278 g73 = k ; exclude: 26587 52278 b.i24 ; begin 26588 52278 w. rl. w3 i2. ; 26589 52280 rs. w3 i1. ; 26590 52282 jl. w3 d34. ; check child; 26591 52284 i0: jl. w3 d2. ; more: 26592 52286 se w0 2 ; next param(type); 26593 52288 jl. g36. ; if type<>2 26594 52290 rl. w1 e25. ; then goto exam command; 26595 52292 al w3 x1+c29 ; 26596 52294 rl. w1 e19. ; include/exclude(name(console), 26597 52296 i1: am 0 ; integer,result); 26598 52298 se w0 0 ; if result=0 26599 52300 jl. g16. ; then goto more 26600 52302 jl. i0. ; else goto end line; 26601 52304 i2: jd 1<11+14 ; 26602 52306 jd 1<11+12 ; 26603 52308 e.z. 26604 52308 c.(:c23>20a.1:)-1 ; if call option then 26605 52308 g74 = k ; call: 26606 52308 b.i24 ; begin 26607 52308 w.i0: jl. w3 d2. ; more: next param(type); 26608 52310 se w0 2 ; if type<>2 26609 52312 jl. g36. ; then goto exam command; 26610 52314 rl. w1 e19. ; device:=integer; 26611 52316 jl. w3 d15. ; next name; 26612 52318 al. w3 e20. ; create peripheral process( 26613 52320 jd 1<11+54 ; name,device,result); 26614 52322 sn w0 3 ; if result=3 26615 52324 jl. g10. ; 26616 52326 sn w0 4 ; or result=4 26617 52328 jl. g16. ; 26618 52330 sn w0 5 ; or result=5 26619 52332 jl. g17. ; then goto end line 26620 52334 jl. i0. ; else goto more; 26621 52336 e. 26622 52336 z. 26623 52336 c.(:c23>19a.1:)-1 ; if list option then 26624 52336 b.i24 w. ; begin 26625 52336 i7: <: error <0>:> 26626 52342 i8: <: stop <0>:> 26627 52348 i9: <: run <0>:> 26628 52354 i10: <: wait <0>:> 26629 52360 g75 = k ; list: 26630 52360 rl w2 b6 ; : 26631 52362 i1: sl w2 (b7) ; for i:=first internal step 1 26632 52364 jl. g35. ; until last internal do 26633 52366 rl w1 x2 ; 26634 52368 rl w0 x1+a11 ; if name=0 26635 52370 rl w3 x1+a34 ; or 26636 52372 al w2 x2 +2 ; parent=0 26637 52374 rs. w2 e78. ; 26638 52376 se w0 0 ; 26639 52378 sn w3 0 ; else 26640 52380 jl. i1. ; begin 26641 52382 jl. w3 d19. ; initwrite 26642 52384 rl w2 x2 -2 ; 26643 52386 al w1 x2+a11 ; 26644 52388 jl. w3 d21. ; writetext(processname) 26645 52390 ac w1 x1 -12 ; 26646 52392 jl. w3 d70. ; writespace(no af spaces) 26647 52394 rl w1 x2+a17 ; 26648 52396 wa w1 x2+a182 26649 52398 al w0 8 ; 26650 52400 jl. w3 d71. ; writeint(first core,8) 26651 52402 rl w1 x2+a18 ; 26652 52404 ws w1 x2+a17 ; 26653 52406 al w0 8 ; 26654 52408 jl. w3 d71. ; writeint(coresize,8) 26655 52410 zl w1 x2+a25 ; 26656 52412 al w0 3 ; 26657 52414 jl. w3 d71. ; writeint(key,4) 26658 52416 zl w1 x2+a12 ; 26659 52418 al w0 4 ; 26660 52420 jl. w3 d71. ; writeint(stopcount,4) 26661 52422 bl w0 x2+a13 ; w0 := process state; 26662 52424 al. w1 i7. ; 26663 52426 sz w0 2.10000000; 26664 52428 al. w1 i10. ; 26665 52430 sz w0 2.00100000; 26666 52432 al. w1 i8. ; 26667 52434 sz w0 2.01000000; 26668 52436 al. w1 i9. ; 26669 52438 jl. w3 d21. ; writetext(process state); 26670 52440 rl w1 x2+a34 ; 26671 52442 al w1 x1+a11 ; 26672 52444 jl. w3 d21. ; writetext(parent) 26673 52446 al w0 10 ; 26674 52448 jl. w3 d20. ; writechar(nl) 26675 52450 jl. w3 d23. ; typeline(buf) 26676 52452 jl. w3 d42. ; save work(buf) 26677 52454 jl. g47. ; +2 error goto end line 26678 52456 rl. w2 e78. ; 26679 52458 jl. i1. ; 26680 52460 e. 26681 52460 z. 26682 52460 c.(:c23>18a.1:)-1 ; if max option then 26683 52460 g76 = k ; max: 26684 52460 b.i24 ; begin 26685 52460 w. 26686 52460 al. w1 g26. ; 26687 52462 jl. w3 d21. ; writetext(<:max:>); 26688 52464 am -2048 ; 26689 52466 jl. w3 d29.+2048; find max(size); 26690 52468 jl. w3 d22. ; writeinteger(size); 26691 52470 al w0 32 ; 26692 52472 jl. w3 d20. ; writechar(32); 26693 52474 rl w2 b1 ; 26694 52476 bz w1 x2+a19 ; 26695 52478 ws. w1 e2. ; writeinteger(buf claim(s) 26696 52480 jl. w3 d22. ; -own buf); 26697 52482 al w0 32 ; 26698 52484 jl. w3 d20. ; writechar(32); 26699 52486 bz w1 x2+a20 ; 26700 52488 ws. w1 e3. ; writeinteger(area claim(s) 26701 52490 jl. w3 d22. ; -own area); 26702 52492 al w0 32 ; 26703 52494 jl. w3 d20. ; writechar(32); 26704 52496 bz w1 x2+a21 ; 26705 52498 jl. w3 d22. ; writeinteger(internal claim(s)); 26706 52500 al w0 32 ; 26707 52502 jl. w3 d20. ; writechar(32); 26708 52504 c.-4000 26709 52504 al w2 8 ; keys:=8; 26710 52504 jl. w3 d32. ; find keys(keys,pr,pk, 26711 52504 jl. i0. ; typekeys); 26712 52504 am 0 ; 26713 52504 i0: ac w1 x2 -8 ; typekeys: 26714 52504 jl. w3 d22. ; writeinteger(8-keys); 26715 52504 z. 26716 52504 al w0 10 ; 26717 52506 jl. w3 d20. ; writechar(10); 26718 52508 jl. w3 d23. ; typeline(buf); 26719 52510 jl. w3 d42. ; save work(buf); 26720 52512 jl. g47. ;+2: error: goto end line; 26721 52514 jl. g35. ; goto next command; 26722 52516 e. 26723 52516 z. 26724 52516 26724 52516 26724 52516 26724 52516 c.(:c23>17a.1:)-1 ; if replace option then 26725 52516 g77 = k ; replace: 26726 52516 b.i24 ; begin 26727 52516 w. am d15-e0 ; 26728 52518 jl. w3 e0. ; next name; 26729 52520 al. w3 e20. ; 26730 52522 jd 1<11+52 ; create area process(name,result); 26731 52524 sn w0 2 ; 26732 52526 jl. g11. ; if result=2 26733 52528 se w0 3 ; or result=3 26734 52530 sn w0 4 ; or result=4 then 26735 52532 jl. g12. ; goto end line; 26736 52534 al. w1 e51. ; 26737 52536 rl w3 b1 ; next buffer: 26738 52538 i0: al w2 0 ; buf:=0; 26739 52540 jd 1<11+24 ; wait event(buf); 26740 52542 jd 1<11+26 ; get event(buf); 26741 52544 ba. w0 1 ; result:=result+1; 26742 52546 sn w0 1 ; if result=1 then 26743 52548 jd 1<11+22 ; send answer(buf,answer,result); 26744 52550 rl w0 x3+a15 ; next:=word(event q(proc)); 26745 52552 se w0 x3+a15 ; if next<>event q(proc) then 26746 52554 jl. i0. ; goto next buffer; 26747 52556 al. w3 e20. ; 26748 52558 jd 1<11+8 ; reserve process(name,result); 26749 52560 sn w0 1 ; if result=1 then 26750 52562 jl. i2. ; goto give up; 26751 52564 al. w1 e51. ; 26752 52566 jd 1<11+42 ; lookup entry(name,tail,result); 26753 52568 sn w0 2 ; if result=2 then 26754 52570 jl. i3. ; goto give up; 26755 52572 bz. w0 e59. ; 26756 52574 se w0 8 ; if content<>8 then 26757 52576 jl. i4. ; goto give up; 26758 52578 rl. w1 e60. ; 26759 52580 al w1 x1+511 ; 26760 52582 ls w1 -9 ; load size:= 26761 52584 ls w1 9 ; (bytes(tail)+511)/512*512; 26762 52586 jl. w3 d27. ; find size(start,size,give up); 26763 52588 jl. i6. ; 26764 52590 wa w1 0 ; last addr(area mess):= 26765 52592 al w1 x1 -2 ; first addr+load size-2; 26766 52594 ds. w1 e49. ; first addr(area mess):= first addr; 26767 52596 rl. w1 e58. ; segment(area mess):= 26768 52598 rs. w1 e50. ; segment(tail); 26769 52600 bz. w1 e67. ; 26770 52602 wa w1 0 ; 26771 52604 rs. w1 i20. ; entry:= first addr+entry(tail); 26772 52606 sh. w1 (e49.) ; if entry>last addr(area mess) then 26773 52608 jl. 4 ; 26774 52610 jl. i5. ; goto give up; 26775 52612 al. w1 e47. ; 26776 52614 al. w3 e20. ; 26777 52616 jd 1<11+16 ; send mess(name,area mess,buf); 26778 52618 al. w1 e51. ; 26779 52620 jd 1<11+18 ; wait answer(buf,answer,result); 26780 52622 rl. w1 e51. ; 26781 52624 lo w1 0 ; res:= status or result; 26782 52626 jd 1<11+64 ; remove process(name,result); 26783 52628 se w1 1 ; if res <> 1 then 26784 52630 jl. g15. ; goto sorry; 26785 52632 rl. w0 i22. ; 26786 52634 rs. w0 g30. ; 26787 52636 jl. g1. ; 26788 52638 i12: rl. w1 e24. ; ok: 26789 52640 rl w2 x1+c50 ; buf:= state(work); 26790 52642 jd 1<11+18 ; wait answer(buf,work,result); 26791 52644 ld w1 -100 ; w0:= w1:= 0; 26792 52646 rl. w2 e25. ; 26793 52648 rl w2 x2+c25 ; w2:=process descr.(console) 26794 52650 xl. 0 ; ex:= 0; 26795 52652 jl. (i20.) ; goto entry; 26796 52654 26796 52654 i2: am g13-g11; 26797 52656 i3: am g11-g12; 26798 52658 i4: am g12-g14; 26799 52660 i5: 26800 52660 i6: al. w2 g14. ; give up: 26801 52662 al. w3 e20. ; 26802 52664 jd 1<11+64 ; remove process(name,result); 26803 52666 jl x2 +0 ; goto end line; 26804 52668 i20:0 ; entry 26805 52670 i22: jl. i12-g30 ; return to ok 26806 52672 e. 26807 52672 z. 26808 52672 26808 52672 26808 52672 ; 26809 52672 ; stepping stone 26810 52672 ; 26811 52672 jl. d2., d2=k-2 26812 52674 jl. g2., g2=k-2 26813 52676 jl. d15., d15=k-2 26814 52678 jl. d16. 26815 52680 d16=k-2 26816 52680 jl. g27., g27=k-2 26817 52682 jl. d34. 26818 52684 d34=k-2 26819 52684 jl. g35., g35=k-2 26820 52686 jl. d42. 26821 52688 d42=k-2 26822 52688 jl. d46., d46=k-2 26823 52690 jl. d61. 26824 52692 d61=k-2 26825 52692 jl. d77. ; 26826 52694 d77=k-2 26827 52694 jl. d78. ; 26828 52696 d78=k-2 26829 52696 26829 52696 ; 26830 52696 ; v. block 26831 52696 ; indirect adressing of all e-names 26832 52696 ; 26833 52696 v16: e16 26834 52698 26834 52698 v19: e19 26835 52700 v20: e20 26836 52702 v21: e21 26837 52704 v23: e23 26838 52706 v25: e25 26839 52708 v30: e30 26840 52710 v46: e46 26841 52712 v70: e70 26842 52714 v72: e72 26843 52716 v79: e79 26844 52718 v87: e87 26845 52720 26845 52720 b.i24 ; dump: 26846 52720 w.g79:am d15-e0 26847 52722 jl. w3 e0. ; next name; 26848 52724 jl. w3 d34. ; check child; 26849 52726 dl w1 x2+a43 ; get catbase of pr descr(child) 26850 52728 al. w3 i1. ; name=0 26851 52730 jd 1<11+72 ; catbase(s)=catbase(child) 26852 52732 se w0 0 ; if not ok then 26853 52734 jl. g19. ; goto end line: base illegal 26854 52736 al. w3 e20. ; name adr 26855 52738 jd 1<11+52 ; create area process(name) 26856 52740 al. w3 i1. ; (prevent remove process(name)) 26857 52742 sn w0 2 ; if result=2 or 26858 52744 jl. i10. ; 26859 52746 sl w0 2 ; result>2 then 26860 52748 jl. i11. ; goto give up 26861 52750 al. w3 e20. ; 26862 52752 jd 1<11+8 ; reserve process(name,result); 26863 52754 se w0 0 ; if result<>0 then 26864 52756 jl. i12. ; goto give up; 26865 52758 jl. w3 d39. ; stop child; 26866 52760 rl. w2 e29. ; 26867 52762 al w1 0 ; 26868 52764 rs. w1 e46.+2 ; segmentno(mess)=0 26869 52766 rl w1 x2+a182 ; load base (child) 26870 52768 dl w3 x2+a18 ; 26871 52770 wa w2 2 ; add base 26872 52772 wa w3 2 ; 26873 52774 al w3 x3 -2 ; line addr:= first addr(child); 26874 52776 ds. w3 e46. ; write addr:= top addr(child)-2; 26875 52778 al. w3 e20. ; 26876 52780 al. w1 e44. ; 26877 52782 jd 1<11+16 ; send mess(name,output,buf); 26878 52784 al. w1 e51. ; 26879 52786 jd 1<11+18 ; wait answer(buf,answer,result); 26880 52788 rl. w2 e51. ; 26881 52790 sn w0 1 ; if result<>1 26882 52792 se w2 0 ; or status(answer)<>0 then 26883 52794 jl. i9. ; give up: area error 26884 52796 jd 1<11+42 ; lookup entry (area) 26885 52798 se w0 0 ; if not ok then 26886 52800 jl. i9. ; goto area error 26887 52802 al w0 7 ; else 26888 52804 hs. w0 e59. ; contents key(area):= core dump 26889 52806 jd 1<11+36 ; get clock 26890 52808 ld w1 5 ; 26891 52810 rs. w0 e56. ; set shortclock(area) 26892 52812 al. w1 e51. ; 26893 52814 jd 1<11+44 ; change entry 26894 52816 se w0 0 ; if not ok then 26895 52818 i9: am g15-g35 ; give up: area error 26896 52820 am g35-g11 ; goto next command 26897 52822 i10: am g11-g12 ; give up: catalog error 26898 52824 i11: am g12-g13 ; - - - : area unknown 26899 52826 i12: al. w2 g13. ; - - - : area reserved 26900 52828 jd 1<11+64 ; remove area process 26901 52830 al. w3 i1. ; 26902 52832 dl. w1 i2. ; 26903 52834 jd 1<11+72 ; reset catalogbase(s) 26904 52836 jl x2+ 0 ; exit , 26905 52838 26905 52838 i1: 0 26906 52840 a107 26907 52842 i2: a108-1 26908 52844 e. 26909 52844 26909 52844 b. i4 26910 52844 w. ; 26911 52844 ; command syntax: user <lower> <upper> 26912 52844 ; command syntax: login <lower> <upper> 26913 52844 ; command syntax: project <lower> <upper> 26914 52844 g86: am c43-c42; user: update userbase; 26915 52846 g82: am c42-c41; login: update loginbase; 26916 52848 g80: al w2 x1+c41 ; project: update projectbase; 26917 52850 jl. w3 d16. ; next integer 26918 52852 rs w0 x2+0 ; lower := integer; 26919 52854 jl. w3 d16. ; next integer 26920 52856 rs w0 x2+2 ; upper := integer; 26921 52858 jl. g35. ; next command 26922 52860 e. 26923 52860 26923 52860 26923 52860 b.i12 ; bs: 26924 52860 w. ; 26925 52860 i2: dl. w2 e21. ; 26926 52862 ds. w2 i4. ; 26927 52864 dl. w2 e23. ; 26928 52866 ds. w2 i5. ; 26929 52868 jl x3 ; 26930 52870 g81: jl. w3 d34. ; check child 26931 52872 jl. w3 d15. ; 26932 52874 jl. w3 i2. ; 26933 52876 jl. w3 d16. ; next integer 26934 52878 i0: rs. w0 e52. ; more: 26935 52880 jl. w3 d16. ; next integer 26936 52882 rs. w0 e51. ; 26937 52884 dl. w0 e52. ; 26938 52886 al. w1 e51.+a110*4; index:= claim list end 26939 52888 i1: ds w0 x1 +2 ; repeat begin 26940 52890 al w1 x1 -4 ; claimlist(index):=claimchange 26941 52892 se. w1 e51. ; index:= index-4 26942 52894 jl. i1. ; until index = claim list start 26943 52896 al. w2 i3. ; 26944 52898 rl. w3 e25. ; 26945 52900 al w3 x3+c29 ; w3 = process name(console) 26946 52902 jd 1<11+78 ; set bs claims 26947 52904 sn w0 1 ; if result = 1 26948 52906 jl. g20. ; then goto end line 26949 52908 se w0 0 ; if result <> 0 26950 52910 jl. g21. ; then goto end line 26951 52912 jl. g35. ; then goto exam command 26952 52914 26952 52914 ; command syntax: temp <docname> <segments> <entries> 26953 52914 g84: ; temp: 26954 52914 am c45-c47; (update temp claims) 26955 52916 26955 52916 ; command syntax: perm <docname> <segments> <entries> 26956 52916 g85: ; perm: 26957 52916 al w3 c47 ; (update perm claims) 26958 52918 wa. w3 e25. ; 26959 52920 rs. w3 i6. ; save abs addr of claim; 26960 52922 26960 52922 jl. w3 d15. ; 26961 52924 jl. w3 i2. ; 26962 52926 jl. w3 d16. ; get segments 26963 52928 rs. w0 e52. ; 26964 52930 jl. w3 d16. ; get entries 26965 52932 rs. w0 e51. ; 26966 52934 al. w2 i3. ; name adr. 26967 52936 jl. w3 d61. ; get devno*8 26968 52938 jl. g16. ; sorry goto end line 26969 52940 dl. w1 e52. ; 26970 52942 am. (i6.) ; update segments and entries; 26971 52944 ds w1 x2 ; 26972 52946 jl. g35. ; next command 26973 52948 i3:0 26974 52950 i4:0 26975 52952 0 26976 52954 i5:0 26977 52956 i6: 0 ; abs addr of claim (in console descr) 26978 52958 e. 26979 52958 b.i40,j10 26980 52958 w. 26981 52958 c.(:c23>14a.1:)-1 26982 52958 g96 = k ; get: 26983 52958 am -1 ; 26984 52960 g89 = k ; job: 26985 52960 al w0 0 ; set startflag 26986 52962 rs. w0 i16. ; 26987 52964 al w3 0 ; 26988 52966 rs w3 x1+c95+2 ; clear primin and primout 26989 52968 rs w3 x1+c96+2 ; 26990 52970 jl. w3 d46. ; clear claimlist; 26991 52972 jl. w3 d15. ; get jobname 26992 52974 al w1 0 ; then get segment(0) 26993 52976 rl. w2 e70. ; 26994 52978 jl. w3 d77. ; 26995 52980 rl. w1 e70. ; 26996 52982 rl w3 x1+6 ; get no. of segments 26997 52984 rs. w3 i14. ; 26998 52986 rl w1 x1 +2 ; 26999 52988 rs. w1 i12. ; 27000 52990 al w2 0 ; find number of 27001 52992 al w3 512 ; entries in one 27002 52994 wd w3 2 ; susercatentry 27003 52996 al w3 x2-510 ; w3 := last used in segment; 27004 52998 rs. w3 e85. ; 27005 53000 j8: dl. w2 (v21.) ; 27006 53002 aa. w2 (v23.) ; compute hashvalue 27007 53004 wa w2 2 ; 27008 53006 al w1 0 ; 27009 53008 sh w2 -1 ; 27010 53010 ac w2 x2 ; 27011 53012 wd. w2 i14. 27012 53014 rs. w1 i13. ; 27013 53016 j3: rl. w2 e71. ; 27014 53018 rs. w1 (v79.) ; 27015 53020 jl. w3 d77. ; get segment 27016 53022 jl. w3 d78. ; find entry 27017 53024 sl w2 0 ; if entry address then 27018 53026 jl. j4. ; copy information 27019 53028 se w2 -10 ; if entry ndon' excist then 27020 53030 jl. g22. ; goto end line 27021 53032 rl. w1 (v79.) ; if entry not found on this segment 27022 53034 al w1 x1+1 ; then increase segment no. 27023 53036 sn. w1 (i14.) ; search cyclical through 27024 53038 al w1 0 ; 27025 53040 se. w1 (i13.) ; 27026 53042 jl. j3. 27027 53044 jl. g22. 27028 53046 j4: rl w1 4 ; 27029 53048 wa. w1 i12. ; last adr. +2 in userentry 27030 53050 rs. w1 i15. 27031 53052 rl. w1 (v25.) ; 27032 53054 rl w3 x2+2 ; command mask(job) : 27033 53056 rl w0 x1+c26 ; if abs.protection, abs.addr or 27034 53058 la. w0 i17. ; 27035 53060 la. w3 i10. ; all bs= true then 27036 53062 lo w0 6 ; 'or' these bits to 27037 53064 rs w0 x1+c26 ; command mask(console) 27038 53066 al w3 x1+c29 ; copy job to console buffer 27039 53068 al w2 x2+4 ; from process name 27040 53070 j5: rl w0 x2 ; to claim list 27041 53072 rs w0 x3 ; 27042 53074 al w2 x2+2 ; 27043 53076 al w3 x3+2 ; 27044 53078 se w3 x1+c95 ; (until i and o are defined in susercat) end 27045 53080 jl. j5. ; 27046 53082 ; 27047 53082 ; create claim list(console) 27048 53082 ; 27049 53082 rs. w2 i1. ; 27050 53084 rl. w2(v70.) ; 27051 53086 al w2 x2+8 ; name adr. first dev(entry0) 27052 53088 rs. w2 i2. ; 27053 53090 al w2 x1+c44 ; start of claim list(console) 27054 53092 rs. w2 i0. ; 27055 53094 j0: rl. w2 i2. ; 27056 53096 sl. w2 (i15.) ; kan fjernes nar newcat er rettet !!!!!!!!!!!!! 27057 53098 jl. j2. ; ---------""---------""-------""!!!!!!!!!!! 27058 53100 jl. w3 d61. ; get devno*8(next dev) 27059 53102 jl. j1. ; not found: goto next dev. 27060 53104 rl. w3 i1. ; found: copy claim list: 27061 53106 dl w1 x3+2 ; begin 27062 53108 wa. w2 i0. ; 27063 53110 ds w1 x2+2 ; 27064 53112 dl w1 x3+6 ; 27065 53114 ds w1 x2+6 ; end 27066 53116 j1: dl. w3 i2. ; next device: get claim list adr.(userentry) 27067 53118 al w3 x3+12 ; and dev. name adr.(entry0) 27068 53120 al w2 x2+8 ; 27069 53122 ds. w3 i2. ; 27070 53124 se. w2 (i15.) ; 27071 53126 jl. j0. ; then find next dev. 27072 53128 j2: ; 27073 53128 rl. w1 (v25.) ; restore console 27074 53130 al w2 -1 ; areabuf := undef; 27075 53132 rs. w2 (v87.) ; 27076 53134 sn. w2 (i16.) ; if only load then 27077 53136 jl. g35. ; goto next command; 27078 53138 jl. g66. ; else goto run 27079 53140 ; 27080 53140 i0: 0 ; claim list start(console) 27081 53142 i1: 0 ; -2 claim list adr(userentry) 27082 53144 i2: 0 ; +0 dev. name adr.(entry0) 27083 53146 i10: 8.77772006 ; prio+all bs, abs. protc., abs. addr. 27084 53148 i12: 0 ; entry lenght 27085 53150 i13: 0 ; name key 27086 53152 i14: 0 ; catalog lenght 27087 53154 i15: 0 ; last adr.+2(userentry) 27088 53156 i16: 0 ; job indicator : 0=job command 27089 53158 i17: 8.1770 27090 53160 z.e. 27091 53160 b.i24 27092 53160 w. 27093 53160 g87: am 1<8 ; lock: lock := true; 27094 53162 g88: al w0 0 ; unlock:lock := false; 27095 53164 rs. w0 (i0.) ; 27096 53166 jl. g35. ; goto next command; 27097 53168 i0: e80 ; lock indicator 27098 53170 e. 27099 53170 27099 53170 27099 53170 27099 53170 c. (:c23>15a.1:)-1 27100 53170 27100 53170 27100 53170 27100 53170 b. i30, j10 ; 27101 53170 w. ; 27102 53170 27102 53170 ; command syntax: modify <addr> <old contents> <new contents> 27103 53170 27103 53170 g91 = k ; modify: 27104 53170 jl. w3 (i22.) ; addr := next integer; 27105 53172 sl w0 0 ; if illegal core-address then 27106 53174 sl w0 (116) ; 27107 53176 jl. g15. ; goto end line; 27108 53178 rl w2 0 ; 27109 53180 27109 53180 jl. w3 (i22.) ; 27110 53182 se w0 (x2) ; if next integer <> core(addr) then 27111 53184 jl. g15. ; goto end line; 27112 53186 27112 53186 jl. w3 (i22.) ; 27113 53188 rs w0 x2 ; core(addr) := next integer; 27114 53190 27114 53190 jl. g35. ; goto next command; 27115 53192 27115 53192 g90 = k ; print: 27116 53192 jl. w3 (i22.) ; next integer 27117 53194 am -500 ; 27118 53196 rs. w0 e37.+500 ; 27119 53198 jl. w3 (i22.) ; next integer 27120 53200 am -500 ; 27121 53202 rs. w0 e38.+500 ; 27122 53204 al. w3 i11. ; 27123 53206 jd 1<11+8 ; reserve printer 27124 53208 se w0 0 ; if result <> 0 27125 53210 jl. (i23.) ; then goto end line 27126 53212 j0: dl. w1 i12. ; next: init output area 27127 53214 ds. w1 i1. ; 27128 53216 ds. w1 i3. ; 27129 53218 ds. w1 i7. ; 27130 53220 dl. w1 i13. ; 27131 53222 ds. w1 i4. ; 27132 53224 ds. w1 i5. ; 27133 53226 rl. w1 i14. ; 27134 53228 rs. w1 i2. ; 27135 53230 rs. w1 i6. ; 27136 53232 am -500 ; 27137 53234 rl. w1 e37.+500 ; print address(decimal) 27138 53236 al w0 10 ; 27139 53238 al. w2 i1. ; 27140 53240 jl. w3 j3. ; 27141 53242 am -500 ; 27142 53244 rl. w2 e37.+500 ; print word(octal) 27143 53246 rl w1 x2 ; 27144 53248 al w0 8 ; 27145 53250 al. w2 i3. ; 27146 53252 jl. w3 j3. ; 27147 53254 al w1 -2 ; 27148 53256 am -500 ; 27149 53258 la. w1 e37.+500 ; 27150 53260 bz w1 x1 ; print byte 1(decimal) 27151 53262 al w0 10 ; 27152 53264 al. w2 i4. ; 27153 53266 jl. w3 j3. ; 27154 53268 al w1 -2 ; 27155 53270 am -500 ; 27156 53272 la. w1 e37.+500 ; 27157 53274 bz w1 x1 +1 ; print byte 2(decimal) 27158 53276 al w0 10 ; 27159 53278 al. w2 i5. ; 27160 53280 jl. w3 j3. ; 27161 53282 am -500 ; 27162 53284 rl. w2 e37.+500 ; 27163 53286 rl w1 x2 ; print word(decimal) 27164 53288 sl w1 0 ; if word < 0 27165 53290 jl. j2. ; then begin 27166 53292 ac w1 x1 ; change sign 27167 53294 rl. w0 i15. ; 27168 53296 rs. w0 i6. ; set minus 27169 53298 j2: al w0 10 ; end 27170 53300 al. w2 i7. ; 27171 53302 jl. w3 j3. ; 27172 53304 am -500 ; 27173 53306 rl. w1 e37.+500 ; 27174 53308 rl w2 x1 ; print word(text) 27175 53310 rl. w1 i26. ; 27176 53312 j1: ld w2 8 ; 27177 53314 sz w1 8.340 ; 27178 53316 sz w1 8.200 ; 27179 53318 la. w1 i25. ; 27180 53320 sz w1 8.177 ; 27181 53322 sz ; 27182 53324 al w1 x1 +32 ; 27183 53326 sh w1 0 ; 27184 53328 jl. j1. ; 27185 53330 rs. w1 i8. ; 27186 53332 al. w1 i10. ; 27187 53334 al. w3 i11. ; 27188 53336 jd 1<11+16 ; send message 27189 53338 jl. w3 d42. ; save work(buf); 27190 53340 jl. j6. ;+2: error: goto end print; 27191 53342 am -500 ; 27192 53344 rl. w1 e37.+500 ; first addr 27193 53346 al w1 x1 +2 ; +2 27194 53348 am -500 ; 27195 53350 rs. w1 e37.+500 ; =: first addr 27196 53352 am -500 ; 27197 53354 rl. w2 e38.+500 ; 27198 53356 sh w1 x2 ; if first addr<=last addr 27199 53358 jl. j0. ; then goto next 27200 53360 j6:; end print: 27201 53360 al. w3 i11. ; 27202 53362 jd 1<11+10 ; release printer 27203 53364 jl. (i24.) ; goto next command 27204 53366 j3: ds. w0 i19. ; save return and radix 27205 53368 j4: al w3 0 ; next word: s:= 0 27206 53370 j5: al w0 0 ; next char: 27207 53372 wd. w1 i19. ; 27208 53374 wa. w0 i16. ; 27209 53376 as w0 x3 ; remainder shift s 27210 53378 wa w0 x2 ; + word(i) 27211 53380 rs w0 x2 ; =: word(i) 27212 53382 sn w1 0 ; if quotient = 0 27213 53384 jl. (i18.) ; then return 27214 53386 al w3 x3 +8 ; s:= s+8 27215 53388 se w3 24 ; if s<>24 27216 53390 jl. j5. ; then goto next char 27217 53392 al w2 x2 -2 ; i:=i-2 27218 53394 jl. j4. ; goto next word 27219 53396 i0:0 ; 27220 53398 i1:0 ; addr 27221 53400 <: :> ; 27222 53402 i6:0 ; 27223 53404 0 ; 27224 53406 i7:0 ; decimal 27225 53408 0 ; 27226 53410 i4:0 ; byte 1 27227 53412 0 ; 27228 53414 i5:0 ; byte 2 27229 53416 <: :> ; 27230 53418 i2:0 ; 27231 53420 0 ; 27232 53422 i3:0 ; octal 27233 53424 <: :> ; 27234 53426 i8:0 ; text 27235 53428 i9:<:<10>:> ; 27236 53430 i10:5<12 ; message 27237 53432 i0 ; 27238 53434 i9 ; 27239 53436 0 ; 27240 53438 i11:<:printer:>,0,0 ; name 27241 53448 <: :> , i12=k-2 27242 53452 <: :> , i13=k-2 27243 53456 <: :> , i14=k-2 27244 53458 <:- :> , i15=k-2 27245 53460 <:<0><0><16>:> , i16=k-2 27246 53462 i18:0 ; link 27247 53464 i19:0 ; radix 27248 53466 i22:d16 ; next integer 27249 53468 i23:g1 ; error 27250 53470 i24:g35 ; next command 27251 53472 i25:8.7777 7400 ; 27252 53474 i26:128<16+128<8+128 ; 27253 53476 z. 27254 53476 e. 27255 53476 27255 53476 27255 53476 b. i24 27256 53476 w. g93: ; prio: 27257 53476 jl. w3 d16. ; read priority 27258 53478 sz. w0 (i1.) ; if prio < 0 or prio >= 4096 then 27259 53480 jl. g27. ; goto end line: illegal priority 27260 53482 hs w0 x1+c26 ; 27261 53484 jl. g35. ; else goto next command 27262 53486 i1: -1<12 27263 53488 e. 27264 53488 27264 53488 27264 53488 b.i10 27265 53488 w.g99: ; jobremove 27266 53488 am -2046 ; 27267 53490 jl. w3 d34.+2046 ; check child 27268 53492 al w2 -1 ; 27269 53494 rs w2 x3+c22 ; coretableelement:=not job 27270 53496 jl. g71. ; goto remove 27271 53498 e. 27272 53498 27272 53498 27272 53498 b.i3 27273 53498 w.g100: ; base 27274 53498 jl. w3 d16. ; next integer 27275 53500 rs. w0 i3. ; 27276 53502 jl. w3 d16. ; next integer 27277 53504 rl. w3 i3. ; 27278 53506 ds w0 x1+c42+2 ; set bases 27279 53508 ds w0 x1+c41+2 ; 27280 53510 ds w0 x1+c43+2 ; 27281 53512 jl. g35. ; 27282 53514 i3:0 27283 53516 e. 27284 53516 ; autorel and relocate 27285 53516 ; 27286 53516 ; yes 27287 53516 ; syntax: command <first logic address> 27288 53516 ; no 27289 53516 ; 27290 53516 b. i10, j10 w. 27291 53516 27291 53516 g92: rl. w3 v72. ; autorel 27292 53518 jl. j0. ; set destination address 27293 53520 g102:al w3 x1+c97 ; relocate : 27294 53522 j0: rs. w3 i1. ; 27295 53524 jl. w3 d2. ; examine next param 27296 53526 se w0 1 ; if name then 27297 53528 jl. j1. ; begin 27298 53530 rl. w2 (v20.) ; if name:= <:no :> then 27299 53532 al w3 -1 ; first logic address := 27300 53534 se. w2 (i0.) ; -1 (no relocation) 27301 53536 jl. j2. ; else 27302 53538 rl. w3 (v16.) ; set first logic address 27303 53540 jl. j2. ; top of s own code 27304 53542 j1: se w0 2 ; if not integer then 27305 53544 jl. g2. ; syntax 27306 53546 rl. w3 (v19.) ; integer: 27307 53548 sh w3 -1 ; if <0 then write 27308 53550 jl. g2. ; syntax 27309 53552 j2: rs. w3 (i1.) ; 27310 53554 jl. g35. ; goto next command 27311 53556 27311 53556 i0: <:yes:> ; 27312 53558 i1: 0 ; 27313 53560 27313 53560 e. 27314 53560 27314 53560 ; adjust rest claims in usercat. 27315 53560 ; comment: change the perm rest claims in susercat 27316 53560 ; to the value given by the internal process descr. for key=3. 27317 53560 ; temp claims are unchanged. 27318 53560 ; 27319 53560 ; call return 27320 53560 ; w0 destroyed 27321 53560 ; w1 destroyed 27322 53560 ; w2 destroyed 27323 53560 ; w3 link destroyed 27324 53560 ; 27325 53560 b.i20, j10 27326 53560 w. 27327 53560 27327 53560 d76: rs. w3 i10. ; store return in save area 27328 53562 am -2046 ; 27329 53564 rl. w3 e30.+2046 ; 27330 53566 rl w1 x3+c22 ; if segmentno= -1 then 27331 53568 sh w1 -1 ; return: no susercatjob 27332 53570 jl. (i10.) ; 27333 53572 c.(:c23>14 a.1 :)-1 27334 53572 rl. w2 i2. ; 27335 53574 jl. w3 d77. ; get segment 27336 53576 am -2046 27337 53578 rl. w1 e30.+2046 ; 27338 53580 rl w1 x1+c22 ; 27339 53582 am -2046 ; 27340 53584 rs. w1 e46.+2+2046 ; store segmentno in output mess 27341 53586 am -2046 ; 27342 53588 rl. w1 e29.+2046 ; get procname(child) 27343 53590 al w2 x1+a11 ; and store in name area 27344 53592 am -2046 ; 27345 53594 al. w3 e20.+2046 ; 27346 53596 dl w1 x2+2 ; 27347 53598 ds w1 x3+2 ; 27348 53600 dl w1 x2+6 ; 27349 53602 ds w1 x3+6 ; 27350 53604 jd 1<11+4 ; get pr descr.(proc name) 27351 53606 rs. w0 i0. ; 27352 53608 se w0 0 ; 27353 53610 jl. j0. ; 27354 53612 am -2046 ; if error then 27355 53614 jl. g9.+2046 ; goto end line: process unknown 27356 53616 j0: jl. w3 d78. ; find entry 27357 53618 sh w2 -1 ; if entry not found then 27358 53620 jl. j4. ; goto end line: catalog error 27359 53622 al w2 x2+48 ; 27360 53624 rs. w2 i3. ; perm claim adr(userentry) 27361 53626 rl. w2 i1. ; 27362 53628 al w2 x2+8 ; 27363 53630 rs. w2 i4. ; 27364 53632 j1: rl. w2 i4. ; adjust rest claims 27365 53634 jl. w3 d61. ; for i=0 step 1 27366 53636 jl. j2. ; until last dev.(entry0) 27367 53638 rl w2 x3-a88-2 ; begin 27368 53640 wa. w2 i0. ; find chaintable(dev.) 27369 53642 al w2 x2+6 ; if not found goto next device 27370 53644 zl w0 x2 ; perm entries(suserentry) 27371 53646 rl. w1 i3. ; = entry claim(pr.descr.) , key=3 27372 53648 rs w0 x1 ; 27373 53650 zl w0 x2+1 ; perm segments 27374 53652 wm w0 x3-a88+26 ; = slicelenght(dev)*slice claim(pr.descr.) 27375 53654 rs w0 x1+2 ; end 27376 53656 j2: dl. w2 i4. ; next device: 27377 53658 al w2 x2+12 ; 27378 53660 al w1 x1+8 ; 27379 53662 ds. w2 i4. ; 27380 53664 rl. w1 i1. ; 27381 53666 rl w1 x1+4 27382 53668 am. ( i1.) ; if dev.name.adr. < 27383 53670 sh w2 x1 ; last used of entry0 then 27384 53672 jl. j1. ; goto next , else 27385 53674 rl. w2 i2. ; store segment: 27386 53676 al w3 x2+510 ; create output mess. 27387 53678 am -2046 ; first adr. h20 27388 53680 ds. w3 e46.+2046 ; last adr. h20+510 27389 53682 rl. w3 i5. ; segment no:stored above 27390 53684 jd 1<11+52 ; create area.susercat 27391 53686 jd 1<11+8 ; reserve(susercat) 27392 53688 sn w0 0 ; 27393 53690 jl. j5. ; 27394 53692 am -2046 ; if error then 27395 53694 jl. g15.+2046 ; write: area error 27396 53696 j5: am -2046 ; 27397 53698 al. w1 e44.+2046 ; 27398 53700 jd 1<11+16 ; send mess. 27399 53702 rl. w1 i11. ; 27400 53704 jd 1<11+18 ; wait answer 27401 53706 lo. w0 (i11.) ; 'or' status and result 27402 53708 sn w0 1 ; if <> 1 then goto error 27403 53710 jl. j6. ; 27404 53712 j4: am -2046 ; error 27405 53714 al. w1 g11.+2046 ; write catalog error 27406 53716 rs. w1 i10. ; 27407 53718 j6: rl. w3 i5. ; 27408 53720 jd 1<11+64 ; remove area susercat 27409 53722 am -2048 ; 27410 53724 rs. w3 e87.+2048; areabuf := undef; 27411 53726 jl. (i10.) ; return 27412 53728 ; 27413 53728 i0: 0 ; pr.descr.adr(procname) 27414 53730 i1: h19 ; entry0 adr. 27415 53732 i2: h20 ; user segment adr. 27416 53734 z. 27417 53734 am -2046 27418 53736 jl. g18.+2046 27419 53738 27419 53738 i3: 0 ; -2, perm claim list adr(userentry) 27420 53740 i4: 0 ; +0, dev.name adr(entry0) 27421 53742 i5: c69 ; susercat name adr. 27422 53744 i6: 0 ; segmentno in susercat 27423 53746 i10: 0 ; return adr. 27424 53748 i11: e51 ; answer status adr. 27425 53750 e. 27426 53750 27426 53750 27426 53750 ; character table: 27427 53750 ; contains an entry of 3 bits defining the type of each 27428 53750 ; character in the iso 7 bit character set. 27429 53750 27429 53750 w.h0: 8.7777 7777 ; nul soh stx etx eot enq ack bel 27430 53752 8.7757 7777 ; bs ht nl vt ff cr so si 27431 53754 8.7777 7777 ; dle dc1 dc2 dc3 dc4 nak syn etb 27432 53756 8.7667 7777 ; can em sub esc fs gs rs us 27433 53758 8.3666 6666 ; sp 27434 53760 8.6636 4244 ; ( ) * + , - . / 27435 53762 8.1111 1111 ; 0 1 2 3 4 5 6 7 27436 53764 8.1125 6466 ; 8 9 : ; < = > 27437 53766 8.6666 6666 ; a b c d e f g 27438 53768 8.6666 6666 ; h i j k l m n o 27439 53770 8.6666 6666 ; p q r s t u v w 27440 53772 8.6666 6666 ; x y z æ ø _ 27441 53774 8.6000 0000 ; a b c d e f g 27442 53776 8.0000 0000 ; h i j k l m n o 27443 53778 8.0000 0000 ; p q r s t u v w 27444 53780 8.0000 0067 ; x y z æ ø del 27445 53782 27445 53782 ; command table: 27446 53782 ; each entry consists of two words defining the name of the 27447 53782 ; command, a eigth bits defining a bit to test in the console mask, 27448 53782 ; and a sixteen bits defining the address of the command action 27449 53782 ; relative to g45. 27450 53782 27450 53782 w.h2 = k-6 ; base of command: 27451 53782 <:all<0>:> , 1<17+g83-g45 27452 53788 <:addr:> , 1<17+g54-g45 27453 53794 <:area:> , 1<17+g61-g45 27454 53800 <:autore:> , 1<15+g92-g45 27455 53806 <:base:>,1<18+g100-g45 27456 53812 <:break:> , 1<20+g70-g45 27457 53818 <:bs<0><0>:>, 1<17+g81-g45 27458 53824 <:buf<0>:> , 1<17+g60-g45 27459 53830 <:call:> , 1<17+g74-g45 27460 53836 <:cpa<0>:> , 1<17+g59-g45 27461 53842 <:create:> , 1<16+g64-g45 27462 53848 <:date:> , 1<21+1<14+g49-g45 27463 53854 <:dump:> , 1<20+g79-g45 27464 53860 <:exclud:> , 1<19+g73-g45 27465 53866 <:i:>,0 , 1<20+g94-g45 27466 53872 <:functi:> , 1<17+g63-g45 27467 53878 <:includ:> , 1<19+g72-g45 27468 53884 <:init:> , 1<16+g65-g45 27469 53890 <:intern:> , 1<17+g62-g45 27470 53896 <:job<0>:>,1<20+g89-g45 27471 53902 <:get<0>:> , 1<20+g96-g45 27472 53908 <:list:> , 1<20+1<14+g75-g45 27473 53914 <:load:> , 1<20+g67-g45 27474 53920 <:lock:>, 1<15+g87-g45 27475 53926 <:login:>, 1<18+g82-g45 27476 53932 <:max<0>:> , 1<20+1<14+g76-g45 27477 53938 <:modify:> , 1<21+1<14+g91-g45 27478 53944 <:new<0>:> , 1<16+g51-g45 27479 53950 <:jobrem:>, 1<15+g99-g45 27480 53956 <:o:>,0 , 1<20+g95-g45 27481 53962 <:perm:>,1<17+g85-g45 27482 53968 <:prio:>,1<18+g93-g45 27483 53974 <:proc:> , 1<20+g52-g45 27484 53980 <:prog:> , 1<20+g53-g45 27485 53986 <:projec:>,1<18+g80-g45 27486 53992 <:read:> , 1<20+1<14+g57-g45 27487 53998 <:reloca:> , 1<18+g102-g45 ; 27488 54004 <:remove:> , 1<20+g71-g45 27489 54010 c.(:c23>17a.1:)-1 27490 54010 <:replac:> , 1<15+g77-g45 27491 54016 z. 27492 54016 <:run<0>:> , 1<16+g66-g45 27493 54022 <:size:> , 1<18+g56-g45 27494 54028 <:start:> , 1<20+g68-g45 27495 54034 <:stop:> , 1<20+g69-g45 27496 54040 <:temp:>,1<17+g84-g45 27497 54046 <:unlock:>,1<15+g88-g45 27498 54052 <:unstac:> , 1<20+1<14+g58-g45 27499 54058 <:user:>,1<18+g86-g45 27500 54064 <:mode:> , 1<21+g55-g45 27501 54070 c.-4000 27502 54070 <:key<0>:> , 1<17+g57-g45 27503 54070 <:pk<0><0>:> , 1<18+g59-g45 27504 54070 <:pr<0><0>:> , 1<18+g58-g45 27505 54070 z. 27506 54070 <:print:> , 1<21+1<14+g90-g45 27507 54076 h3:h13 ; continue command list 27508 54078 27508 54078 ; define b-names for transferring variables to mons2-text 27509 54078 27509 54078 b110 = g45 ; command base 27510 54078 b112 = d2 ; call next param 27511 54078 b113 = d15 ; call next name 27512 54078 b114 = d16 ; call next integer 27513 54078 b115 = g2 ; goto syntax error 27514 54078 b116 = g35 ; goto next command 27515 54078 b117 = g36 ; goto exam command 27516 54078 b118 = e19 ; integer just read 27517 54078 b119 = e20 ; name just read 27518 54078 b120 = e8 ; pointer to: last of init code 27519 54078 b121 = d19 ; call init write 27520 54078 b122 = d20 ; call write char 27521 54078 b123 = d21 ; call write text 27522 54078 b124 = d23 ; call type line 27523 54078 b125 = d42 ; call save work 27524 54078 b126 = g47 ; goto input aborted 27525 54078 b129 = g11 ; goto catalog error 27526 54078 b130 = d79 ; call stack input 27527 54078 27527 54078 ; console table: 27528 54078 27528 54078 h4:0, r.c81*c1>1 ; lay out standard console descriptions 27529 54608 h22=k-c1 ; last description 27530 54608 27530 54608 ; initialize standard console descriptions. 27531 54608 ; c20, c21 queue element (queued up on the queue head) 27532 54608 ; c27 command mask (standard mask) 27533 54608 b.i4,j2 w. 27534 54608 27534 54608 i0:0 ; saved link 27535 54610 h4+c1 ; next element 27536 54612 i1:h4-c1 ; last element 27537 54614 i2:e35 ; queue head 27538 54616 27538 54616 j0: rs. w3 i0. ; start: 27539 54618 al. w1 i0. ; 27540 54620 rs w1 x2 +0 ; first free:=start of init code; 27541 54622 al w0 c82 ; 27542 54624 dl. w2 i1. ; 27543 54626 am -2046 ; 27544 54628 al. w3 h4.+2046 ; 27545 54630 j1: rs w0 x3+c27 ; for console desc:=first stop 1 until last do 27546 54632 ds w2 x3+c21 ; mask(console desc):=standard mask; 27547 54634 al w1 x1 +c1 ; next,last queue element:=next, last console desc; 27548 54636 al w2 x2 +c1 ; 27549 54638 al w3 x3 +c1 ; 27550 54640 sh. w3 h22. ; 27551 54642 jl. j1. ; 27552 54644 rl. w2 i2. ; insert queue head in first and last console des; 27553 54646 am -2046 27554 54648 rs. w2 h4.+c21+2046 ; 27555 54650 rs. w2 h22.+c20 ; 27556 54652 al w0 0 ; 27557 54654 al w2 0 ; 27558 54656 jl. (i0.) ; return to slang; 27559 54658 27559 54658 jl. j0. ; goto start; 27560 54660 e.j. 27561 54608 27561 54608 h21=k ; start of special console descriptions 27562 54608 27562 54608 t. 27562 54608* type 27563 54608 27563 54608 m. 27563 54608 s console table 27564 54608 k, k-2, 0, 2, 8.1770, 0, r.c1>1-5 27565 54714 n.m. 27565 54714 s console table included 27566 54714 27566 54714 h. h5=k-c1 ; last console 27567 54714 27567 54714 ; device exception table (devices not automatically included with users ) 27568 54714 ; the numbers in order of increasing value: 27569 54714 h6: ; start(table) 27570 54714 t. 27570 54714* type 27571 54714 27571 54714 m. 27571 54714 s device exception table 27572 54714 n.m. 27572 54714 s device exclusion table included 27573 54714 2047 ; last(table) 27574 54715 w. 27575 54716 w. 27576 54716 27576 54716 ; work table: 27577 54716 27577 54716 h. h8: ; first work: 27578 54716 0,r.c2*c3 27579 55364 h9=k-c2 ; last work: 27580 55364 c.(:c23>14a.1:)-1 27581 55364 h. h19: -1,r.c89 27582 55420 h20:-1,r.512 27583 55932 z. 27584 55932 27584 55932 ; core table: 27585 55932 ; contains an entry for each storage area allocated to a child. 27586 55932 ; an entry defines the address of a child description within the 27587 55932 ; monitor. the entries are arranged in the same order as the 27588 55932 ; storage areas from low towards high addresses. the table is 27589 55932 ; terminated by a zero. 27590 55932 27590 55932 w. 27591 55932 h10 = k - c11 ; base of core table: 27592 55932 -1, r.(:a3-2:)*c11>1 ; lay out core table 27593 56220 h11=k ; top of coretable 27594 56220 27594 56220 m. 27594 56220 first free addr 27595 56220 27595 56220 ; initialize core table. 27596 56220 ; all entries in the core table is initialised to this values- 27597 56220 ; k, k-2, -1, r.5 27598 56220 b.i1,j1 w. 27599 56220 i0:h10+c11 ; absolute addr of core table 27600 56222 i1:h10.+c11 ; relative addr of core table 27601 56224 27601 56224 j0: al. w1 i0. ; start: 27602 56226 rs w1 x2 +0 ; first free:=start of init code; 27603 56228 rl. w1 i0. ; 27604 56230 al. w2 i1. ; 27605 56232 wa. w2 i1. ; 27606 56234 j1: rs w1 x2 +0 ; for entry:=first stop 1 until last do 27607 56236 rs w1 x2 +2 ; word(entry+0,+2):=k, k-2; 27608 56238 al w1 x1+c11 ; 27609 56240 al w2 x2+c11 ; 27610 56242 se. w2 h11. ; 27611 56244 jl. j1. ; 27612 56246 al w0 0 ; 27613 56248 al w2 0 ; status:=ok; 27614 56250 jl x3 ; return to slang; 27615 56252 27615 56252 jl. j0. ; goto start; 27616 56254 e.j. 27617 56220 27617 56220 27617 56220 h12: 27618 56220 h13 = - (:h12 + 2:) ; command table continues in second word of next text 27619 56220 27619 56220 b. i24 w. 27620 56220 27620 56220 ; table of preoccupied claims: 27621 56220 ; mess buf area internal 27622 56220 i0=1 , i1=a112+1 , i2=1 ; proc func 27623 56220 i3=1+a117 , i4=0 , i5=1 ; std driver 27624 56220 i6=a5-i0-i3 , i7=a1-i1-i4 , i8=a3-i2-i5 ; s 27625 56220 27625 56220 i10: rs. w3 i12. ; save return to autoloader; 27626 56222 27626 56222 ; initialize work table 27627 56222 b. j1 w. 27628 56222 al. w3 h8. ; 27629 56224 j0: ; rep: 27630 56224 al w1 x3+c73 ; for all work table entries do 27631 56226 rs w1 x3+c58 ; stack pointer := stack base; 27632 56228 al w3 x3+c2 ; 27633 56230 sh. w3 h9. ; 27634 56232 jl. j0. ; 27635 56234 e. ; 27636 56234 27636 56234 ; initialize special console descriptions. 27637 56234 b.j10 w. 27638 56234 al. w3 (j2.) ; 27639 56236 jl. j1. ; 27640 56238 j0: rl w1 x3+c25 ; for console desc:=first step 1 until last do 27641 56240 ls w1 1 ; proc desc addr(console):= 27642 56242 wa w1 b4 ; word(base name table(dev)+2*devno); 27643 56244 rl w1 x1 ; 27644 56246 rs w1 x3+c25 ; 27645 56248 al w3 x3 +c1 ; 27646 56250 j1: sh. w3 (j3.) ; 27647 56252 jl. j0. ; 27648 56254 rl w1 b12 ; if coresize > 27649 56256 sh. w1 (j4.) ; 1.000.000 hw then 27650 56258 jl. i9. ; 27651 56260 27651 56260 rl. w1 (j6.) ; 27652 56262 rs. w1 (j5.) ; 27653 56264 jl. i9. ; 27654 56266 jl. i9. 27655 56268 27655 56268 j2: h21 27656 56270 j3: h5 27657 56272 j4: 1000000 ; min coresize for automatic relocation ( hw) 27658 56274 j5: e72 27659 56276 j6: e16 ; first free address 27660 56278 e. 27661 56278 27661 56278 ; process description for process functions: 27662 56278 ; 27663 56278 ; rel address contents 27664 56278 27664 56278 i9: rl w1 (b6) ; proc := first internal; 27665 56280 jl. w2 i18. ; init description; 27666 56282 27666 56282 a48 , a107 ; interval low 27667 56286 a49 , a108 ; - high 27668 56290 a11 , 0 ; name 0 : zero 27669 56294 a11+2 , <:pro:> ; name 2-6: <:procfunc> 27670 56298 a11+4 , <:cfu:> ; 27671 56302 a11+6 , <:nc:> ; 27672 56306 a17 , b60-b60+8 ; first address 27673 56310 a18 , b61 ; top address 27674 56314 a301 , 0 ; priority 27675 56318 a26 , a89 ; interrupt mask 27676 56322 a27 , b62 ; user exception address 27677 56326 a170 , 0 ; user escape address 27678 56330 a32 , 0 ; status = not monitor mode 27679 56334 a33 , b63 ; ic = waiting point 27680 56338 a182 , 0 ; base = no relocation 27681 56342 a183 , 8 ; lower write limit = first core 27682 56346 ;*** a184 , core size ; top write limit: special 27683 56346 a185 , 6<12+b54 ; interrupt levels 27684 56350 a42 , a107 ; catalog base low 27685 56354 a43 , a108 ; - - high 27686 56358 a44-2 , a107 ; max interval low 27687 56362 a44 , a108 ; - - high 27688 56366 a45-2 , a107 ; std - low 27689 56370 a45 , a108 ; - - high 27690 56374 a302 , 0 ; save area address 27691 56378 27691 56378 a10 , 0;(end of words) ; kind = 0 27692 56382 27692 56382 a12 , 0 ; stop count 27693 56386 a13 , a102 ; state = waiting for message 27694 56390 a19 , i0 ; buf claim 27695 56394 a20 , i1 ; area claim 27696 56398 a22 , 8.7777 ; function mask 27697 56402 27697 56402 a10 , 0;(end of bytes) ; (kind = 0) 27698 56406 27698 56406 rs w0 x1+a184 ; top write limit(proc func) := core size; 27699 56408 27699 56408 ; process description for initial operating system, s 27700 56408 27700 56408 al w1 x1 +a4 ; proc := second internal; 27701 56410 jl. w2 i18. ; init description; 27702 56412 27702 56412 a48 , a107 ; interval low 27703 56416 a49 , a108 ; - high 27704 56420 a11 , <:s:> ; name = <:s:> 27705 56424 a11+2 , 0 ; 27706 56428 a11+4 , 0 ; 27707 56432 a11+6 , 0 ; 27708 56436 a17 , c0 ; first address 27709 56440 ;*** a18 , core size ; top address 27710 56440 a301 , 0 ; priority 27711 56444 a26 , a89 ; interrupt mask 27712 56448 a27 , d0 ; user exception address 27713 56452 a170 , 0 ; user escape address 27714 56456 ;*** a171 , core size ; initial cpa 27715 56456 a172 , 0 ; - base 27716 56460 a173 , 8 ; - lower write limit 27717 56464 ;*** a174 , core size ; - upper - - 27718 56464 a175 , b54<12+b54 ; - interrupt levels 27719 56468 a32 , 0 ; status = not monitor mode 27720 56472 a33 , h12 ; ic = start init 27721 56476 a34 , 0 ; parent = undef 27722 56480 ;*** a181 , core size ; current cpa 27723 56480 a182 , 0 ; - base 27724 56484 a183 , 8 ; - lower write limit 27725 56488 ;*** a184 , core size ; - upper - - 27726 56488 a185 , b54<12+b54 ; - interrupt levels 27727 56492 a42 , a107 ; catalog base low 27728 56496 a43 , a108-1 ; - - high 27729 56500 a44-2 , a107 ; max interval low 27730 56504 a44 , a108-1 ; - - high 27731 56508 a45-2 , a107 ; std interval low 27732 56512 a45 , a108-1 ; - - high 27733 56516 a302 , 0 ; save area address 27734 56520 27734 56520 a10 , 0;(end of words) ; kind = 0 27735 56524 27735 56524 a12 , 0 ; stopcount 27736 56528 a13 , a95 ; state = running 27737 56532 a19 , i6 ; buf claim 27738 56536 a20 , i7 ; area claim 27739 56540 a21 , i8-1 ; internal claim 27740 56544 a24 , 1<7 ; (protection register, for compatibility reasons) 27741 56548 a25 , 0 ; (protection key, for compatibility reasons) 27742 56552 a22 , 8.7777 ; function mask 27743 56556 27743 56556 a10 , 0;(end of bytes) ; (kind = 0) 27744 56560 27744 56560 rs. w0 (4) ; top core := 27745 56562 jl. 4 ; 27746 56564 e17 ; 27747 56566 rs w0 x1+a18 ; top address(s) := 27748 56568 rs w0 x1+a171 ; initial cpa(s) := 27749 56570 rs w0 x1+a174 ; initial upper write limit(s) := 27750 56572 rs w0 x1+a181 ; current cpa(s) := 27751 56574 rs w0 x1+a184 ; current upper write limit(s) := core size; 27752 56576 27752 56576 ; process description for std driver 27753 56576 27753 56576 al w1 x1 +a4 ; proc := next internal; 27754 56578 jl. w2 i18. ; init description; 27755 56580 27755 56580 a48 , a107 ; interval low 27756 56584 a49 , a108-1 ; - high 27757 56588 a11 , <:dri:> ; name = <:driver proc:> 27758 56592 a11+2 , <:ver:> ; 27759 56596 a11+4 , <:pro:> ; 27760 56600 a11+6 , <:c:> ; 27761 56604 a17 , 8 ; first address 27762 56608 a18 , b60 ; top address 27763 56612 a301 , -1 ; priority 27764 56616 a26 , a89 ; interrupt mask 27765 56620 a27 , b87 ; user exception address 27766 56624 a170 , 0 ; user escape address 27767 56628 a171 , b60 ; initial cpa 27768 56632 a172 , 0 ; - base 27769 56636 a173 , 8 ; - lower write limit 27770 56640 a174 , b60 ; - upper - - 27771 56644 a175 , 6<12+b54 ; - interrupt levels 27772 56648 a32 , 0 ; status = not monitor mode 27773 56652 a33 , b85 ; ic = central waiting point 27774 56656 a34 , 0 ; parent = undef 27775 56660 a181 , b60 ; current cpa 27776 56664 a182 , 0 ; - base 27777 56668 a183 , 8 ; - lower write limit 27778 56672 a184 , b60 ; - upper - - 27779 56676 a185 , 6<12+b54 ; - interrupt levels 27780 56680 a42 , a107 ; catalog base low 27781 56684 a43 , a108-1 ; - - high 27782 56688 a44-2 , a107 ; max interval low 27783 56692 a44 , a108-1 ; - - high 27784 56696 a45-2 , a107 ; std interval low 27785 56700 a45 , a108-1 ; - - high 27786 56704 a302 , b86 ; save area address 27787 56708 27787 56708 a10 , 0 ;(end of words) ; kind = 0 27788 56712 27788 56712 a12 , 0 ; stopcount 27789 56716 a13 , a95 ; state = running 27790 56720 a19 , i3 ; buf claim 27791 56724 a20 , i4 ; area claim 27792 56728 a21 , i5-1 ; internal claim 27793 56732 a24 , 1<7 ; (protection register) 27794 56736 a25 , 0 ; (protection key) 27795 56740 a22 , 8.7777 ; function mask 27796 56744 27796 56744 a10 , 0 ;(end of bytes) ; (kind = 0) 27797 56748 \f 27797 56748 27797 56748 al w2 x1+a16 ; 27798 56750 rl w1 b2 ; link(timer q, internal); 27799 56752 jl w3 b36 ; 27800 56754 al w2 x2 -a4 ; link(timer q, previous internal); 27801 56756 jl w3 b36 ; 27802 56758 27802 56758 27802 56758 jl. w3 i14. ; take control 27803 56760 b3 ; (first name table entry, 27804 56762 b6 ; first internal, 27805 56764 b29+2*a4 ; driver proc); 27806 56766 27806 56766 jl. w3 i14. ; take control 27807 56768 b76 ; (first secondary interrupt, 27808 56770 k ; irrellevant, 27809 56772 b29+2*a4 ; driver proc); 27810 56774 27810 56774 al. w2 i10. ; 27811 56776 jl. (i12.) ; autoloader(first core); 27812 56778 i13:e4 ; 27813 56780 27813 56780 ; take control 27814 56780 ; comment: searches through the specified part of name table and initializes driver 27815 56780 ; proc address. 27816 56780 27816 56780 i14: rl w1 (x3) ; entry := param 1; 27817 56782 27817 56782 i15: am (x3 +2) ; next: 27818 56784 sn w1 (0) ; if entry = top entry (i.e. param 2) 27819 56786 jl x3 +6 ; then return; 27820 56788 27820 56788 rl w2 x1 +0 ; proc := nametable(entry); 27821 56790 sn w2 0 ; if end of table then 27822 56792 jl x3 +6 ; then return; 27823 56794 27823 56794 rl w0 x3 +4 ; if driverproc(proc) = 0 then 27824 56796 rx w0 x2+a250 ; driverproc(proc) := param 3; 27825 56798 se w0 0 ; 27826 56800 rs w0 x2+a250 ; 27827 56802 27827 56802 al w1 x1 +2 ; entry := entry + 2; 27828 56804 jl. i15. ; goto next; 27829 56806 27829 56806 ; procedure init description 27830 56806 ; call: w1 = process description address, w2 = init table 27831 56806 ; exit: w0 = core size, w1 = unchanged 27832 56806 i18: dl w0 x2 +2 ; move words: 27833 56808 al w2 x2 +4 ; move contents to outpointed 27834 56810 am x1 ; relatives in process description 27835 56812 rs w0 x3 ; 27836 56814 se w3 a10 ; until kind is moved; 27837 56816 jl. i18. ; 27838 56818 27838 56818 i19: dl w0 x2 +2 ; move bytes: 27839 56820 al w2 x2 +4 ; move contents to outpointed 27840 56822 am x1 ; relatives in process description 27841 56824 hs w0 x3 ; 27842 56826 se w3 a10 ; until kind is moved; 27843 56828 jl. i19. ; 27844 56830 rl w0 b12 ; 27845 56832 jl x2 ; 27846 56834 27846 56834 27846 56834 i12:0 ; after loading: 27847 56836 jl. i10. ; goto initialize segment; 27848 56838 c70= k-b127 + 2 27849 56838 k=i10 ; 27850 56220 e. ; 27851 56220 i. 27852 56220 27852 56220 e. ; end of operating system s 27853 56220 \f 27853 56220 27853 56220 m. 27853 56220 moncatinit - initialisation of catalog, links ... 27854 56220 27854 56220 b.i30 w. 27855 56220 i0=81 12 15, i1=12 00 00 27856 56220 27856 56220 ; if newtime (i0,i1) > oldtime (a133,a134) then oldtime:=newtime; 27857 56220 c.i0-a133 27858 56220 c.i0-a133-1, a133=i0, a134=i1, z. 27859 56220 c.i1-a134-1, a134=i1, z. 27860 56220 z. 27861 56220 27861 56220 i10=i0, i20=i1 27862 56220 27862 56220 i15=i10/100000 , i10=i10-i15*100000 , i25=i20/100000 , i20=i20-i25*100000 27863 56220 i14=i10/10000 , i10=i10-i14*10000 , i24=i20/10000 , i20=i20-i24*10000 27864 56220 i13=i10/1000 , i10=i10-i13*1000 , i23=i20/1000 , i20=i20-i23*1000 27865 56220 i12=i10/100 , i10=i10-i12*100 , i22=i20/100 , i20=i20-i22*100 27866 56220 i11=i10/10 , i10=i10-i11*10 , i21=i20/10 , i20=i20-i21*10 27867 56220 27867 56220 i2: <: date :> 27868 56244 (:i15+48:)<16+(:i14+48:)<8+46 27869 56246 (:i13+48:)<16+(:i12+48:)<8+46 27870 56248 (:i11+48:)<16+(:i10+48:)<8+32 27871 56250 27871 56250 (:i25+48:)<16+(:i24+48:)<8+46 27872 56252 (:i23+48:)<16+(:i22+48:)<8+46 27873 56254 (:i21+48:)<16+(:i20+48:)<8+ 0 27874 56256 27874 56256 i3: al. w0 i2. ; write date: 27875 56258 rs w0 x2+0 ; first free:=start(text); 27876 56260 al w2 0 ; 27877 56262 jl x3 ; return to slang(status ok); 27878 56264 27878 56264 jl. i3. ; 27879 56266 e. 27880 56266 j. 27880 56220 date 81.12.15 12.00.00 27881 56220 27881 56220 27881 56220 ; segment 9: initialize catalog on backing store 27882 56220 s.k=k, m2, h13,g54,f50,e27,d80,c25 27883 56220 w.b127=k, c25, k=k-2 27884 56220 27884 56220 ; segment structure: 27885 56220 ; definitions (c names) 27886 56220 ; variables (d names) 27887 56220 ; textstrings (e names) 27888 56220 ; utility procedures (f names) 27889 56220 ; command actions (g names) 27890 56220 ; tables and buffers (h names) 27891 56220 ; 27892 56220 ; (i and j names are used locally) 27893 56220 27893 56220 d0=k-2 ; start s: 27894 56220 27894 56220 w. jl. (d40.) ; first instruction: goto init catalog; 27895 56222 27895 56222 h2: h3 ; link for initcat command-table 27896 56224 27896 56224 d54=0 , d53=1 ; first slice.cat, keys 27897 56224 d52=4 ; interval 27898 56224 d55=6 ; name 27899 56224 d56=14 ; tail 27900 56224 d57=d56+0 ; size 27901 56224 d61=d56+2 ; doc name 27902 56224 d64=d56+12 ; slicelength 27903 56224 d66=d56+14, d67=d56+15 ; last slice, first reserved slice 27904 56224 27904 56224 e5: <:result<0>:>, e6=k-2 27905 56230 e7: <:status<0>:>, e8=k-2 27906 56236 27906 56236 ; generate start up header. 27907 56236 ; the text generated below is printed during start up of the monitor. 27908 56236 27908 56236 e19: 27909 56236 <:<10> monitor release : :> 27910 56250 27910 56250 b.i1,j1 w. 27911 56250 27911 56250 i0=a135/10, j0=a136/10 27912 56250 i1=a135/1 , j1=a136/1 27913 56250 27913 56250 (:i0+48:)<16+(:i1-i0*10+48:)<8+46 27914 56252 (:j0+48:)<16+(:j1-j0*10+48:)<8+32 27915 56254 27915 56254 e. 27916 56254 27916 56254 <:<10> monitor version : :> 27917 56268 27917 56268 b.i10,j5 w. 27918 56268 27918 56268 i0=a133/100000, j0=a134/100000 27919 56268 i1=a133/10000 , j1=a134/10000 27920 56268 i2=a133/1000 , j2=a134/1000 27921 56268 i3=a133/100 , j3=a134/100 27922 56268 i4=a133/10 , j4=a134/10 27923 56268 i5=a133/1 , j5=a134/1 27924 56268 27924 56268 (:i0 +48:)<16+(:i1-i0*10+48:)<8+46 27925 56270 (:i2-i1*10+48:)<16+(:i3-i2*10+48:)<8+46 27926 56272 (:i4-i3*10+48:)<16+(:i5-i4*10+48:)<8+32 27927 56274 32<16+(:j0 +48:)<8+(:j1-j0*10+48:) 27928 56276 46<16+(:j2-j1*10+48:)<8+(:j3-j2*10+48:) 27929 56278 46<16+(:j4-j3*10+48:)<8+(:j5-j4*10+48:) 27930 56280 e. 27931 56280 27931 56280 27931 56280 c.a130-1 27932 56280 b.i5,j5 w. 27933 56280 i0=a130/100000, j0=a131/100000 27934 56280 i1=a130/10000 , j1=a131/10000 27935 56280 i2=a130/1000 , j2=a131/1000 27936 56280 i3=a130/100 , j3=a131/100 27937 56280 i4=a130/10 , j4=a131/10 27938 56280 i5=a130/1 , j5=a131/1 27939 56280 27939 56280 <:<10> date of options : :> 27940 56294 (:i0 +48:)<16+(:i1-i0*10+48:)<8+46 27941 56296 (:i2-i1*10+48:)<16+(:i3-i2*10+48:)<8+46 27942 56298 (:i4-i3*10+48:)<16+(:i5-i4*10+48:)<8+32 27943 56300 32<16+(:j0 +48:)<8+(:j1-j0*10+48:) 27944 56302 46<16+(:j2-j1*10+48:)<8+(:j3-j2*10+48:) 27945 56304 46<16+(:j4-j3*10+48:)<8+(:j5-j4*10+48:) 27946 56306 e.z. 27947 56306 27947 56306 <:<10><0> initialize date using the date command <10> :>, e20=k-2 27948 56336 27948 56336 ; print out start-up head under assembly. 27949 56336 ; note: the text (e19 until ..initialize date.. must not contain 27950 56336 ; zero characters, because these will terminate the listing. 27951 56336 b.j0 w. 27952 56336 j0: al. w0 e19. ; text:=start-up header; 27953 56338 al w2 0 ; status:=ok; 27954 56340 jl x3 ; return to slang; 27955 56342 27955 56342 jl. j0. ; entry: goto start; 27956 56344 e. 27957 56344 j. 27957 56344 monitor release : 08.00 monitor version : 82.06.15 12.00.00 date of options : 79.03.27 19.00.00 27958 56344 27958 56344 27958 56344 ; description of main catalog: 27959 56344 ; (format resembles a normal catalog-entry) 27960 56344 d8: ; start of entry 27961 56344 a110 ; (key) 27962 56346 a107,a108 ; (interval) 27963 56350 d9: <:catalog:>, 0 ; name of main catalog 27964 56358 d10: -1 ; size of main catalog (initially not defined) 27965 56360 0, r.4 ; (document name) 27966 56368 d11: 0 ; maincat shortclock 27967 56370 0, 0 ; (file and block) 27968 56374 -1 ; (contents and en68 56374 -1 ; (contents and entry) 27969 56376 0, r.(:a88+d8.+2:)>1; (rest of tail) 27970 56378 27970 56378 27970 56378 ; procedure type newline 27971 56378 ; outputs a newline char on the console 27972 56378 ; 27973 56378 ; call: w3 = link 27974 56378 ; exit: w0 = undef, w1,w2,w3 = unch 27975 56378 27975 56378 f3: ; type newline: 27976 56378 al w0 10 ; char := newline; 27977 56380 ; continue with type char; 27978 56380 27978 56380 27978 56380 ; procedure type char 27979 56380 ; outputs the given char on the console 27980 56380 ; (if the char is <newline>, the buffer is sent) 27981 56380 ; ***** note: return inf etc are not saved for reentrant use of this code!!! 27982 56380 ; 27983 56380 ; call: w0 = char, w3 = link; 27984 56380 ; exit: all regs unch 27985 56380 27985 56380 f0: ; type char: 27986 56380 b. i24 w. 27987 56380 ds. w2 i0. ; save regs; 27988 56382 ds. w0 i1. ; 27989 56384 rl w2 0 ; 27990 56386 i10: ; put char: (w0 = w2 = char) 27991 56386 jl. w3 f42. ; write char (char); 27992 56388 se w2 10 ; if char = newline then 27993 56390 jl. i15. ; begin 27994 56392 jl. w3 f44. ; type line (buf); 27995 56394 jl. w3 f45. ; save work (buf); 27996 56396 am ;+2: error: (continue) 27997 56398 ; (maybe status-errors ougth to repeat a couple of times ???) 27998 56398 jl. w3 f41. ; init write; 27999 56400 i15: ; end; 28000 56400 dl. w2 i0. ; restore regs; 28001 56402 dl. w0 i1. ; 28002 56404 jl x3 ; return; 28003 56406 28003 56406 28003 56406 ; procedure typetextline (text); 28004 56406 ; outputs the text on the console, terminated by a newline char 28005 56406 ; call: w1=text addr, w3=link 28006 56406 ; exit: w0,w1,w3=unch, w2 = undef 28007 56406 28007 56406 f2: ; typetextline: 28008 56406 am 10-32 ; char := newline; 28009 56408 ; continue with typeout; 28010 56408 28010 56408 ; procedure typetext (text); 28011 56408 ; outputs the text on the console, terminated by a space 28012 56408 ; call: w1=text addr, w3=link 28013 56408 ; exit: w0,w1,w3=unch, w2=undef 28014 56408 28014 56408 f1: ; typetext: 28015 56408 al w2 32 ; char := space; 28016 56410 ds. w2 i0. ; save regs; 28017 56412 ds. w0 i1. ; 28018 56414 jl. w3 f43. ; writetext (text); 28019 56416 al w0 x2 ; 28020 56418 jl. i10. ; goto put char 28021 56420 28021 56420 i0=k+2, 0, 0 ; saved w1,w2 28022 56424 i1=k+2, 0, 0 ; saved w3,w0 28023 56428 e. ; 28024 56428 28024 56428 ; procedure typeresult(name,result) 28025 56428 ; comment: outputs a name and result on the console. 28026 56428 ; call: return: 28027 56428 ; w0 result result 28028 56428 ; w1 unchanged 28029 56428 ; w2 link link 28030 56428 ; w3 name name 28031 56428 28031 56428 b.i24 ; begin 28032 56428 w.f5: ds. w1 i2. ; 28033 56430 ds. w3 i3. ; 28034 56432 al w1 x3+0 ; 28035 56434 jl. w3 f1. ; typeout(name); 28036 56436 al. w1 e5. ; 28037 56438 jl. w3 f1. ; typeout(<:result:>); 28038 56440 wa. w0 i1. ; 28039 56442 jl. w3 f0. ; typechar(result+48); 28040 56444 i0: ; end with newline: 28041 56444 jl. w3 f3. ; type newline; 28042 56446 dl. w1 i2. ; 28043 56448 dl. w3 i3. ; 28044 56450 jl x2+0 ; 28045 56452 i1: 48 ; 28046 56454 0, i2: 0 ; 28047 56458 0, i3: 0 ; end 28048 56462 28048 56462 ; procedure typestatus(name,status) 28049 56462 ; comment: outputs a name and the number of the 28050 56462 ; leftmost status bit. 28051 56462 ; call: return: 28052 56462 ; w0 status status 28053 56462 ; w1 unchanged 28054 56462 ; w2 link link 28055 56462 ; w3 name name 28056 56462 28056 56462 ; begin 28057 56462 w.f6: ds. w1 i2. ; 28058 56464 ds. w3 i3. ; 28059 56466 al w1 x3+0 ; 28060 56468 jl. w3 f1. ; typeout(name); 28061 56470 al. w1 e7. ; 28062 56472 jl. w3 f1. ; typeout(<:status:>); 28063 56474 rl w1 0 ; w1 := status; 28064 56476 al w2 -1 ; 28065 56478 i4: sl w1 0 ; rep: 28066 56480 am 46-49 ; if leftmost bit(w1) = 0 then 28067 56482 al w0 49 ; outchar(point) else 28068 56484 jl. w3 f0. ; outchar(one); 28069 56486 ld w2 1 ; w1 := w1 shift 1; 28070 56488 se w2 0 ; if not all status is printed then 28071 56490 jl. i4. ; goto rep; 28072 56492 jl. i0. ; goto end with newline; 28073 56494 e. ; end 28074 56494 28074 56494 ; procedure inchar(char, trouble) 28075 56494 ; comment: inputs the next character from the <input> 28076 56494 ; call: return: 28077 56494 ; w0 char 28078 56494 ; w1 unchanged 28079 56494 ; w2 unchanged 28080 56494 ; w3 link link 28081 56494 28081 56494 b.i24 ; begin 28082 56494 w.f7: ds. w2 i8. ; 28083 56496 rs. w3 i9. ; 28084 56498 rl. w2 d18. ; 28085 56500 al w2 x2+1 ; cur char:=cur char+1; 28086 56502 i0: rs. w2 d18. ; while cur char=characters do 28087 56504 se. w2 (d17.) ; begin 28088 56506 jl. i3. ; 28089 56508 jl. w3 f9. ; inblock 28090 56510 jl. (i9.) ;+2: trouble: goto trouble; 28091 56512 jl. i4. ;+4: end area: goto simulated end-character; 28092 56514 ;+6: ok: 28093 56514 al w2 0 ; end; 28094 56516 jl. i0. ; cur char:=0; 28095 56518 i3: al w1 0 ; end; 28096 56520 wd. w2 i6. ; 28097 56522 ls w1 3 ; pos:=(cur char mod 3)*8-16; 28098 56524 ls w2 1 ; 28099 56526 wa. w2 d22. ; addr:=input buf+cur char/3*2; 28100 56528 rl w0 x2+0 ; 28101 56530 ls w0 x1-16 ; char:=word(addr) shift pos; 28102 56532 sz w0 255 ; if char = null-char then 28103 56534 jl. i5. ; begin 28104 56536 rl. w1 d40. ; if modekind <> tro then 28105 56538 sn w1 m2 ; 28106 56540 jl. i5. ; 28107 56542 i4: ; simulated end-char: 28108 56542 al w0 255 ; char := 255; 28109 56544 jl. i10. ; end 28110 56546 i5: ; else 28111 56546 la. w0 i7. ; char := char extract 7; 28112 56548 i10: ; 28113 56548 dl. w2 i8. ; 28114 56550 rl. w3 i9. ; 28115 56552 jl x3+2 ; 28116 56554 i6: 3 ; 28117 56556 i7: 8.177 ; 28118 56558 0, i8: 0 ; 28119 56562 i9: 0 ; 28120 56564 e. ; end 28121 56564 28121 56564 ; procedure inword(word, trouble, endseg) 28122 56564 ; comment: inputs a binary word from the <input>. at the 28123 56564 ; end of an input segment the checksum is checked. 28124 56564 ; call: return: 28125 56564 ; w0 word 28126 56564 ; w1 unchanged 28127 56564 ; w2 unchanged 28128 56564 ; w3 link link 28129 56564 28129 56564 b.i24 ; begin 28130 56564 w.f8: ds. w2 i7. ; 28131 56566 rs. w3 i8. ; 28132 56568 al w0 0 ; word:=0; 28133 56570 al w1 18 ; pos:=18; 28134 56572 rl. w2 d35. ; 28135 56574 i0: rs. w0 i6. ; repeat 28136 56576 jl. w3 f7. ; inchar(char, trouble); 28137 56578 jl. (i8.) ; 28138 56580 sl w0 64 ; if char>63 28139 56582 jl. i1. ; then goto checksum; 28140 56584 wa w2 0 ; sum:=sum+char; 28141 56586 ls w0 x1+0 ; 28142 56588 lo. w0 i6. ; word:=word or char shift pos; 28143 56590 al w1 x1-6 ; pos:=pos-6; 28144 56592 sl w1 0 ; until pos<0; 28145 56594 jl. i0. ; 28146 56596 rs. w2 d35. ; 28147 56598 dl. w2 i7. ; 28148 56600 rl. w3 i8. ; 28149 56602 jl x3+4 ; goto exit; 28150 56604 i1: se w1 18 ; checksum: 28151 56606 jl. i2. ; if pos<>18 28152 56608 sn w0 255 ; (if null-char read 28153 56610 se w2 0 ; and sum=0 then 28154 56612 jl. i9. ; begin 28155 56614 dl. w2 i7. ; restore (w1, w2); 28156 56616 sn w1 x2 ; if null-char allowed then 28157 56618 jl. (i10.) ; goto end-action; 28158 56620 jl. i2. ; goto sumerror; 28159 56622 i9: ; end) 28160 56622 la. w0 i4. ; 28161 56624 la. w2 i4. ; or char(18:23)<>sum(18:23) 28162 56626 sn w0 x2+0 ; 28163 56628 jl. i3. ; then 28164 56630 i2: al. w1 e9. ; begin 28165 56632 jl. w3 f2. ; type textline (<:input sumerror:>); 28166 56634 jl. (i8.) ; end; 28167 56636 i3: al w0 0 ; 28168 56638 rs. w0 d35. ; sum:=0; 28169 56640 dl. w2 i7. ; 28170 56642 rl. w3 i8. ; 28171 56644 jl x3+2 ; goto endseg; 28172 56646 i4: 8.77 ; 28173 56648 i5: 0, i6: 0 ; 28174 56652 0, i7: 0 ; 28175 56656 i8: 0 ; exit: 28176 56658 i10:g54 ; end-action address 28177 56660 e. ; end 28178 56660 28178 56660 ; procedure inoutseg(name, mess, trouble) 28179 56660 ; comment: inputs or outputs the load buffer from or to the backing store 28180 56660 ; call: return: 28181 56660 ; w0 logical status 28182 56660 ; w1 mess mess 28183 56660 ; w2 link link 28184 56660 ; w3 name name 28185 56660 28185 56660 b.i24 ; begin 28186 56660 w.f10:am 3-5 ; input: 28187 56662 f12:al w0 5 ; output: 28188 56664 hs w0 x1 ; set operation in message; 28189 56666 ds. w3 i5. ; 28190 56668 rs. w1 i6. ; 28191 56670 jd 1<11+16 ; send mess(name,area mess,buf); 28192 56672 al. w1 d15. ; wait answer(buf,answer,result); 28193 56674 jd 1<11+18 ; 28194 56676 al w2 1 ; logical status := 28195 56678 ls w2 (0) ; 1 shift result 28196 56680 sn w2 1<1 ; 28197 56682 lo w2 x1 ; + if ok then status; 28198 56684 al w0 x2 ; w0 := logical status; 28199 56686 dl. w2 i4. ; restore(w1,w2); 28200 56688 se w0 1<1 ; if any errors then 28201 56690 jl. f6. ; type status (logical status) and trouble return; 28202 56692 rl w3 x1+6 ; 28203 56694 al w3 x3+1 ; 28204 56696 rs w3 x1+6 ; cur seg:=cur seg+1; 28205 56698 rl. w3 i5. ; 28206 56700 jl x2+2 ; 28207 56702 i3: 1<18 ; 28208 56704 i6: 0 ; saved message address 28209 56706 i4: 0, i5: 0 ; 28210 56710 e. ; end 28211 56710 28211 56710 ; procedure clear(first,last) 28212 56710 ; comment: initializes a storage area with -1. 28213 56710 ; call: return: 28214 56710 ; w0 -1 28215 56710 ; w1 last last 28216 56710 ; w2 first last+2 28217 56710 ; w3 link link 28218 56710 28218 56710 b.i24 ; begin 28219 56710 w.f11:al w0 -1 ; 28220 56712 i0: rs w0 x2+0 ; repeat 28221 56714 al w2 x2+2 ; word(first):=-1; 28222 56716 sh w2 x1+0 ; first:=first+2; 28223 56718 jl. i0. ; until first=last+2; 28224 56720 jl x3+0 ; 28225 56722 e. ; end 28226 56722 28226 56722 ; read block 28227 56722 ; 28228 56722 ; return address: link+0: trouble 28229 56722 ; +2: end area 28230 56722 ; +4: ok (w2 = start of buffer) 28231 56722 ; 28232 56722 ; comment delivers one block from input; 28233 56722 ; call return 28234 56722 ; w0 - destroyed 28235 56722 ; w1 - destroyed 28236 56722 ; w2 - start of buffer 28237 56722 ; w3 link destroyed 28238 56722 ; on return d17 is initialized 28239 56722 28239 56722 b. i20, j10 28240 56722 w. 28241 56722 28241 56722 f9: am 3-5 ; read double buffered: 28242 56724 f13: al w0 5 ; write double buffered: 28243 56726 rx. w3 j3. ; save (return); get mess addr; 28244 56728 hs w0 (x3+8) ; save (operation) in opposite message; 28245 56730 rl w2 x3+10 ; get buffer address; 28246 56732 i0: al. w1 d15. ; wait: get answer address; 28247 56734 rs. w3 d42. ; save current message address; 28248 56736 jd 1<11+18 ; wait transfer; 28249 56738 se w0 1 ; if result <> 1 then 28250 56740 jl. i1. ; goto result error; 28251 56742 rl w0 x1+0 ; test status; 28252 56744 sz. w0 (j0.) ; if any error then 28253 56746 jl. i2. ; goto read error; 28254 56748 i6: rl w0 x3+2 ; continue: 28255 56750 rs. w0 d22. ; save buffer start; 28256 56752 rl w2 x1+2 ; no of characters := 28257 56754 ls w2 -1 ; no of bytes + 28258 56756 wa w2 x1+2 ; no of no of bytes//2; 28259 56758 rs. w2 d17. ; 28260 56760 rl w2 x1+2 ; w2 := bytes transferred; 28261 56762 ls w2 -9 ; 28262 56764 wa w2 x3+6 ; w2 := segm := segms transferred + last segm; 28263 56766 rl w1 x3+8 ; get new message address; 28264 56768 i5: ; start transfer: 28265 56768 rs w2 x1+6 ; save segmno in message; 28266 56770 28266 56770 ; prepare an empty catalog buffer, in case of kitlabel 28267 56770 dl w3 x1+4 ; w2 := first of buffer; w3 := last of buffer; 28268 56772 al w0 -1 ; 28269 56774 i10: rs w0 x2 ; clear all buffer; 28270 56776 al w2 x2+2 ; 28271 56778 se w2 x3 ; 28272 56780 jl. i10. ; 28273 56782 al w0 0 ; last word of buffer := 0; 28274 56784 rs w0 x2 ; 28275 56786 rs. w0 j4. ; error count := 0; 28276 56788 28276 56788 al. w3 e1. ; w3 := name; 28277 56790 jd 1<11+16 ; start transfer; 28278 56792 rs w2 x1+10 ; save buffer address; 28279 56794 rl. w2 d22. ; w2 := start of buffer; 28280 56796 rx. w1 j3. ; save message address; 28281 56798 jl x1+4 ; return; 28282 56800 28282 56800 ; result error 28283 56800 i1: al. w1 f6. ; 28284 56802 al w2 1 ; 28285 56804 ls w2 (0) ; logical status := 1 shift result; 28286 56806 al w0 x2 ; 28287 56808 jl. i4. ; out error(type result); 28288 56810 28288 56810 ; read error 28289 56810 i2: rl. w2 d40. ; w2 := modekind; 28290 56812 sn w2 m2 ; if kind = <tr> then goto 28291 56814 jl. i7. ; goto test end of tape; 28292 56816 rs. w3 j2. ; save message address; 28293 56818 sn w2 m0 ; if kind = <bs> then 28294 56820 jl. i11. ; goto test end area; 28295 56822 so. w0 (j1.) ; if not parity error then 28296 56824 jl. i3. ; goto hard error; 28297 56826 al. w1 j5. ; insert move message address; 28298 56828 al. w3 e1. ; insert name address; 28299 56830 jd 1<11+16 ; 28300 56832 al. w1 d15. ; insert answer address; 28301 56834 jd 1<11+18 ; wait move; 28302 56836 rl. w0 j1. ; (status := parity error); 28303 56838 i9: ; repeat: 28304 56838 rl. w1 j4. ; 28305 56840 al w1 x1+1 ; increase (error count); 28306 56842 rs. w1 j4. ; 28307 56844 sl w1 5 ; if error count >= max then 28308 56846 jl. i3. ; goto hard error; 28309 56848 al. w3 e1. ; w3 := name; 28310 56850 rl. w1 j2. ; restore message address; 28311 56852 jd 1<11+16 ; start new input; 28312 56854 rl w3 2 ; w3 := message address; 28313 56856 jl. i0. ; goto wait; 28314 56858 28314 56858 i11: ; test end area: 28315 56858 so. w0 (j10.) ; if not end document then 28316 56860 jl. i9. ; goto repeat; 28317 56862 i13: ; end document: 28318 56862 al w2 0 ; pending answer := false; 28319 56864 rx. w2 j3. ; 28320 56866 jl x2+2 ; goto end-area return; 28321 56868 28321 56868 ; hard error: 28322 56868 i3: al. w1 f6. ; out error( type status); 28323 56870 al w2 1<1 ; logical status := status + (result ok) shift 1; 28324 56872 lo w0 4 ; 28325 56874 28325 56874 ; out error: 28326 56874 i4: al. w3 e1. ; get name address; 28327 56876 jl w2 x1+0 ; type error; 28328 56878 al w2 0 ; pending answer := false; 28329 56880 rx. w2 j3. ; 28330 56882 jl x2 ; goto error return; 28331 56884 28331 56884 ; test end of tape 28332 56884 i7: sz. w0 (j6.) ; if end of tape then 28333 56886 jl. i12. ; goto test empty; 28334 56888 jl. i3. ; goto hard error; 28335 56890 28335 56890 ; test empty: if nothing was read from the paper tape reader then 28336 56890 ; return via end-document-return; 28337 56890 i12: rl w2 x1+2 ; if bytes transferred <> 0 then 28338 56892 se w2 0 ; goto continue; 28339 56894 jl. i6. ; 28340 56896 jl. i13. ; goto end document; 28341 56898 28341 56898 28341 56898 ; procedure start transfer 28342 56898 ; comment initializes reading from input 28343 56898 ; call return 28344 56898 ; w0 - destroyed 28345 56898 ; w1 - destroyed 28346 56898 ; w2 - destroyed 28347 56898 ; w3 link destroyed 28348 56898 28348 56898 f15: am 3-5 ; start transfer input: 28349 56900 f16: al w0 5 ; start transfer output: 28350 56902 ls w0 12 ; 28351 56904 hl. w0 d40. ; w0 := operation shift 12 + mode; 28352 56906 28352 56906 al w3 x3-4 ; (prepare ok return via start-transfer-action) 28353 56908 28353 56908 rs. w3 j3. ; save return; 28354 56910 al. w1 d38. ; 28355 56912 al. w2 d39. ; get message addresses; 28356 56914 rs w0 x1 ; save operation and mode in messages; 28357 56916 rs w0 x2 ; 28358 56918 rs w1 x2+8 ; establish chain; 28359 56920 rs w2 x1+8 ; 28360 56922 al w0 512-2 ; block length := 512 bytes; 28361 56924 rl. w3 j7. ; 28362 56926 ; insert buffer addresses; 28363 56926 rs w3 x1+2 ; 28364 56928 wa w3 0 ; 28365 56930 rs w3 x1+4 ; 28366 56932 al w3 x3+2 ; 28367 56934 rs w3 x2+2 ; 28368 56936 wa w3 0 ; 28369 56938 rs w3 x2+4 ; 28370 56940 28370 56940 al. w3 e1. ; w3 := name; 28371 56942 jd 1<11+8 ; reserve process; 28372 56944 28372 56944 rl. w2 d41. ; w2 := first segment; 28373 56946 rl. w0 d40. ; w0 := kind; 28374 56948 bz w0 1 ; 28375 56950 se w0 m1 ; if kind <> <mt> then 28376 56952 jl. i5. ; goto start transfer; 28377 56954 28377 56954 rs. w2 j9. ; save position in setposition-message; 28378 56956 al. w1 j8. ; 28379 56958 bz. w0 d40. ; mode.message := mode; 28380 56960 hs w0 x1+1 ; 28381 56962 jd 1<11+16 ; send message (setposition); 28382 56964 al. w1 d15. ; 28383 56966 jd 1<11+18 ; wait answer; (no status check) 28384 56968 28384 56968 al. w1 d38. ; w1 := first message; 28385 56970 jl. i5. ; goto start transfer; 28386 56972 28386 56972 28386 56972 ; procedure end transfer 28387 56972 ; comment the last answer is checked. 28388 56972 ; 28389 56972 ; registers call return 28390 56972 ; w0 - destroyed 28391 56972 ; w1 - destroyed 28392 56972 ; w2 - destroyed 28393 56972 ; w3 link name 28394 56972 28394 56972 f17: rx. w3 j3. ; save return; 28395 56974 sn w3 0 ; if no pending answer then 28396 56976 jl. i8. ; goto exit; 28397 56978 rl w2 x3+10 ; get buffer address 28398 56980 al. w1 d15. ; insert answer address; 28399 56982 jd 1<11+18 ; wait answer; 28400 56984 i8: al w2 0 ; exit: 28401 56986 rx. w2 j3. ; change(0, return); 28402 56988 al. w3 e1. ; w3 := name; 28403 56990 jd 1<11+10 ; release process(name); 28404 56992 jl x2+0 ; return; 28405 56994 28405 56994 j0: 8.77 20 00 00 ; error bits 28406 56996 j1: 8.20 00 00 00 ; parity error bit 28407 56998 j2: 0 ; saved message address 28408 57000 j3: 0 ; saved return or message address 28409 57002 j4: 5 ; error count 28410 57004 j5: 8<12, 3 ; backspace message 28411 57008 j6: 8.01 20 00 00 ; end of tape bit 28412 57010 j7: h10 ; 1. input buffer 28413 57012 j8: 8 < 12 ; move operation: 28414 57014 6 ; setposition 28415 57016 j9: 0 ; file number 28416 57018 0 ; (block = 0) 28417 57020 j10: 1<18 ; end document status 28418 57022 28418 57022 e. 28419 57022 28419 57022 28419 57022 28419 57022 ; procedure read chain and prepare bs 28420 57022 ; procedure write chain and prepare bs 28421 57022 ; 28422 57022 ; the chainbuffer is either read from the device or written onto the device 28423 57022 ; given by ..device number.. 28424 57022 ; 28425 57022 ; call: w3 = link 28426 57022 ; exit: link+0: error (all regs undef) 28427 57022 ; +2: ok (w3 = chainhead address, other regs undef) 28428 57022 28428 57022 b. i30, j10 w. 28429 57022 28429 57022 28429 57022 f21: am 3-5 ; read chain: 28430 57024 f22: al w0 5 ; write chain: 28431 57026 hs. w0 j1. ; set operation in message; 28432 57028 28432 57028 rs. w3 j0. ; save (return); 28433 57030 28433 57030 jl. w3 f39. ; move catname,docname to chainhead; 28434 57032 ; (in case of write chain) 28435 57032 28435 57032 ; give the device a wrk-name and reserve it 28436 57032 al. w3 j5. ; w3 := wrk-name address; 28437 57034 al w0 0 ; 28438 57036 rs. w0 j6. ; (repeat count := 0;) 28439 57038 rs w0 x3 ; (clear first of name to get a new wrk-name) 28440 57040 rs w0 x3+8 ; (clear name table address) 28441 57042 28441 57042 ; convert device number to text 28442 57042 rl. w1 d43. ; w0w1 := devno; 28443 57044 wd. w1 j8. ; 28444 57046 rl w2 0 ; w2 := last digit; 28445 57048 al w0 0 ; 28446 57050 wd. w1 j8. ; 28447 57052 ld w1 8 ; 28448 57054 ls w1 8 ; 28449 57056 wa w2 0 ; w2 := two rigthmost digits; 28450 57058 wa w2 2 ; w2 := three digits; 28451 57060 lo. w2 j7. ; convert digits to letters; 28452 57062 rs. w2 d48. ; save in text; 28453 57064 28453 57064 i0: ; create process: 28454 57064 rl. w1 d43. ; w1 := devno; 28455 57066 jd 1<11+54; create peripheral process (wrkname, devno); 28456 57068 se w0 0 ; if result not ok then 28457 57070 jl. i10. ; goto alarm; 28458 57072 28458 57072 jd 1<11+8 ; reserve process; 28459 57074 se w0 0 ; if result not ok then 28460 57076 jl. i11. ; goto alarm; 28461 57078 28461 57078 ; start reading/writing one segment, and later read/write the rest 28462 57078 28462 57078 rl. w1 j2. ; addr := first address of chainhead buffer; 28463 57080 28463 57080 i1: ; try greater size of transfer: 28464 57080 al w1 x1+510+1 ; last.mess := 28465 57082 rs. w1 j3. ; addr + 510 + round up; 28466 57084 28466 57084 al. w1 j1. ; 28467 57086 jd 1<11+16; send message; 28468 57088 al. w1 d15. ; 28469 57090 jd 1<11+18; wait answer; 28470 57092 al w2 1 ; 28471 57094 ls w2 (0) ; w2 := logical status.answer; 28472 57096 sn w0 1 ; 28473 57098 lo w2 x1 ; 28474 57100 sn w2 1<1 ; if no errors then 28475 57102 jl. i5. ; goto test transferred; 28476 57104 28476 57104 ; the only allowed error is disconnected (or intervention) 28477 57104 se w2 1<5 ; if not after intervention then 28478 57106 jl. i12. ; goto alarm; 28479 57108 28479 57108 ; intervention is only allowed a limited number of times 28480 57108 rl. w1 j6. ; 28481 57110 al w1 x1+1 ; increase (repeat count); 28482 57112 rs. w1 j6. ; 28483 57114 se w1 2 ; if first time then 28484 57116 jl. i0. ; goto create process; 28485 57118 28485 57118 bz. w0 j1. ; 28486 57120 sn w0 3 ; if operation = input then 28487 57122 jl. (j0.) ; return (no chain); 28488 57124 jl. i13. ; goto alarm; 28489 57126 28489 57126 28489 57126 i5: ; test transferred: 28490 57126 rl. w1 j2. ; w1 := first of chainhead buffer; 28491 57128 bz w2 x1+d66 ; w2 := last slice number.chainhead 28492 57130 al w2 x2+a88+1-1; + size of chainhead + 1; 28493 57132 wa w1 4 ; addr := first + bytes in chain; 28494 57134 sl. w2 (d14.) ; if bytes in chain > bytes transferred then 28495 57136 jl. i1. ; goto try greater size of transfer; 28496 57138 28496 57138 ; the chainhead has been transferred succesfully: 28497 57138 28497 57138 jl. w3 f39. ; move catname,docname to chainhead; 28498 57140 ; (in case of read chain, i.e. after kit <name> ) 28499 57140 28499 57140 ; the chainbuffer now contains a chainhead 28500 57140 28500 57140 al. w3 j5. ; 28501 57142 jd 1<11+64; remove process(wrk-name); 28502 57144 28502 57144 jl. w3 f38. ; move catname,docname from chainhead; 28503 57146 ; (in case of read chain, i.e. after kit <devno> ) 28504 57146 28504 57146 rl. w1 d43. ; w1 := device number; 28505 57148 al. w3 e2. ; w3 := docname; 28506 57150 jd 1<11+54; create peripheral process (docname, devno); 28507 57152 se w0 0 ; if result not ok then 28508 57154 jl. i14. ; goto alarm; 28509 57156 jd 1<11+8 ; reserve process (docname); 28510 57158 28510 57158 rl. w3 j2. ; w3 := chainhead buffer; 28511 57160 jd 1<11+102; prepare bs (chainhead); 28512 57162 se w0 0 ; if result not ok then 28513 57164 jl. i15. ; goto alarm; 28514 57166 28514 57166 am. (j0.) ; 28515 57168 jl +2 ; return ok; 28516 57170 28516 57170 28516 57170 i10: ; error at create wrk-name: 28517 57170 jl. w1 i20. ; 28518 57172 <:create peripheral process wrkname<0>:> 28519 57196 28519 57196 i11: ; error at reserve process wrk-name: 28520 57196 jl. w1 i20. ; 28521 57198 <:reserve process wrkname<0>:> 28522 57214 28522 57214 i12: ; error at transfer: 28523 57214 jd 1<11+64; remove process (wrk name); 28524 57216 al w0 x2 ; w0 := logical status; 28525 57218 al. w3 d47. ; w3 := <:on <devno>:>; 28526 57220 jl. w2 f6. ; typestatus (text, status); 28527 57222 jl. (j0.) ; return (no chain); 28528 57224 28528 57224 i13: ; intervention: 28529 57224 jd 1<11+64; remove process (wrk name); 28530 57226 jl. w1 i20. ; 28531 57228 <:intervention<0>:> 28532 57238 28532 57238 i14: ; error at create peripheral process: 28533 57238 jl. w1 i20. ; 28534 57240 <:create peripheral process documentname<0>:> 28535 57266 28535 57266 i15: ; error at prepare bs: 28536 57266 rl w2 0 ; save (result); 28537 57268 al w3 x3+d61 ; 28538 57270 jd 1<11+64; remove process (doc name.chain buffer); 28539 57272 al w0 x2 ; restore (result); 28540 57274 jl. w1 i20. ; 28541 57276 <:prepare bs<0>:> 28542 57284 28542 57284 i20: ; outerror: 28543 57284 28543 57284 jl. w3 f1. ; typeout (text); 28544 57286 28544 57286 al. w3 d47. ; w3 := <:on <devno>:>; 28545 57288 jl. w2 f5. ; typeresult (text, result); 28546 57290 28546 57290 jl. (j0.) ; return (no chain); 28547 57292 28547 57292 28547 57292 28547 57292 j0: 0 ; return 28548 57294 j1: 5<12+0 ; message: operation 28549 57296 j2: h8 ; first address 28550 57298 j3: 0 ; last address 28551 57300 0 ; always ; segment number 28552 57302 j5: 0, r.5 ; wrkname (+ name table address) 28553 57312 j6: 0 ; repeat count 28554 57314 j7: <:000:> ; mask for converting to letters 28555 57316 j8: 10 ; constant for converting ti digits 28556 57318 28556 57318 e. ; 28557 57318 28557 57318 28557 57318 28557 57318 ; procedure insert all entries 28558 57318 ; 28559 57318 ; call: w3 = link 28560 57318 ; exit: link+0: trouble 28561 57318 ; link+2: ok (w3 = chainhead, other regs undef) 28562 57318 28562 57318 b. i30, j20 w. 28563 57318 28563 57318 j0: 0 ; return 28564 57320 j1: 0 ; writeback (0==false, else true) 28565 57322 j2 = j1 ; entry count change 28566 57322 j3: h8 ; start of chainhead 28567 57324 j4: h12 ; start of entry count table 28568 57326 j5: 0 ; addr of cur entry in entry count table 28569 57328 28569 57328 j6: <:repair not possible<0>:> 28570 57342 j8: <:update of entry count not possible<0>:> 28571 57366 j10: <:insert entry<0>:> 28572 57376 28572 57376 j12=k+2, 0,0 ; saved w1,w2 28573 57380 28573 57380 28573 57380 f23: ; insert all entries: 28574 57380 rs. w3 j0. ; save (return); 28575 57382 28575 57382 al w0 m0 ; 28576 57384 rs. w0 d40. ; modekind := bs; 28577 57386 al w0 0 ; 28578 57388 rs. w0 d41. ; first segment := 0; 28579 57390 rs. w0 j1. ; writeback := false; 28580 57392 28580 57392 rl. w3 j3. ; 28581 57394 rl w1 x3+d57 ; w1 := auxcat size.chainhead 28582 57396 ls w1 1 ; * 2 ; 28583 57398 28583 57398 ; clear all relevant part of entry-count table: 28584 57398 i1: ; clear next: 28585 57398 al w1 x1-2 ; 28586 57400 am. (j4.) ; 28587 57402 rs w0 x1 ; (each field in the table occupies a word) 28588 57404 se w1 0 ; 28589 57406 jl. i1. ; 28590 57408 28590 57408 jl. w3 f15. ; start transfer input; 28591 57410 28591 57410 i2: ; next auxcat segment: 28592 57410 al w0 0 ; 28593 57412 rx. w0 j1. ; writeback := false; 28594 57414 sn w0 0 ; if writeback was false already then 28595 57416 jl. i5. ; goto read; 28596 57418 28596 57418 ; the catalog segment was inconsistent in some way 28597 57418 jl. w3 f40. ; test repair allowed; 28598 57420 jl. i5. ;+2: not allowed: goto read; 28599 57422 28599 57422 ; the segment must be written back: 28600 57422 rl. w1 d42. ; w1 := current message address; 28601 57424 al. w3 e1. ; w3 := catname; 28602 57426 jl. w2 f12. ; outsegment (name, buffer); 28603 57428 jl. i20. ;+2: trouble: goto alarm; 28604 57430 28604 57430 i5: ; read: 28605 57430 jl. w3 f9. ; input block: 28606 57432 jl. i18. ;+2: trouble: goto error return; 28607 57434 jl. i10. ;+4: end area: goto test entry count table; 28608 57436 28608 57436 ; w2 = start of buffer 28609 57436 al w1 x2-a88 ; entry := base of buffer; 28610 57438 al w2 x2+510 ; top := top of last entry; 28611 57440 28611 57440 rl. w3 d42. ; 28612 57442 rl w3 x3+6 ; index := segment.current buffer 28613 57444 ls w3 1 ; * 2 ; 28614 57446 wa. w3 j4. ; 28615 57448 rl w0 x2 ; increase (entry count table (index) ) 28616 57450 wa w0 x3 ; by entry count.buffer; 28617 57452 rs w0 x3 ; 28618 57454 28618 57454 i8: ; next entry: 28619 57454 ; w1 = old entry addr 28620 57454 ; w2 = top entry 28621 57454 28621 57454 al w1 x1+a88 ; increase (entry); 28622 57456 sl w1 x2 ; if all entries processed then 28623 57458 jl. i2. ; goto next auxcat segment; 28624 57460 28624 57460 rl w0 x1 ; if empty entry then 28625 57462 sn w0 -1 ; 28626 57464 jl. i8. ; goto next entry; 28627 57466 28627 57466 ; compute the namekey of the entry, and if it was not like the old 28628 57466 ; namekey.entry then modify entry 28629 57466 28629 57466 dl w0 x1+d55+2 ; 28630 57468 aa w0 x1+d55+6 ; w0 := namekey function(name.entry); 28631 57470 wa w0 6 ; 28632 57472 ba w0 0 ; 28633 57474 al w3 0 ; (see procfunc); 28634 57476 am. (j3.) ; 28635 57478 wd w0 +d57 ; 28636 57480 28636 57480 ls w3 3 ; w3 := namekey * 8; 28637 57482 28637 57482 al w0 2.111 ; 28638 57484 la w0 x1+d53 ; w0 := permanens key.entry; 28639 57486 28639 57486 wa w0 6 ; w0 := namekey * 8 + permkey; 28640 57488 28640 57488 bz w3 x1+d53 ; store new namekey in entry; 28641 57490 hs w0 x1+d53 ; 28642 57492 se w0 x3 ; if new namekey <> old namekey then 28643 57494 rs. w1 j1. ; writeback := true; 28644 57496 28644 57496 ls w0 -2 ; 28645 57498 wa. w0 j4. ; addr := namekey / 4 + start of entry count table; 28646 57500 rs. w0 j5. ; 28647 57502 al w3 -1 ; 28648 57504 wa w3 (0) ; decrease (entry count table (namekey) ); 28649 57506 rs w3 (0) ; 28650 57508 28650 57508 rl. w3 j3. ; w3 := start of chainhead buffer; 28651 57510 jd 1<11+104; insert entry (entry, chainhead); 28652 57512 se w0 0 ; 28653 57514 sn w0 7 ; if result ok then 28654 57516 jl. i8. ; goto next entry; 28655 57518 28655 57518 jl. i25. ; goto alarm; 28656 57520 28656 57520 i10: ; test entry count table: 28657 57520 28657 57520 ; all table-entries must be zero: 28658 57520 rl. w3 j3. ; 28659 57522 rl w3 x3+d57 ; index := auxcatsize.chainhead 28660 57524 ls w3 1 ; * 2 ; 28661 57526 al w0 0 ; 28662 57528 28662 57528 i12: ; test next: 28663 57528 ; w0 = 0 28664 57528 ; w3 = index 28665 57528 al w3 x3-2 ; decrease(index); 28666 57530 sh w3 -1 ; if index < 0 then 28667 57532 jl. i15. ; goto terminate; 28668 57534 28668 57534 am. (j4.) ; entry count table (index) := 0; 28669 57536 rx w0 x3 ; 28670 57538 sn w0 0 ; if old contents = 0 then 28671 57540 jl. i12. ; goto test next; 28672 57542 28672 57542 ; an entry was found <> 0, i.e. a segment had an incorrect information 28673 57542 ; of the number of entries with the corresponding namekey 28674 57542 28674 57542 ls w3 -1 ; segment number := index / 2; 28675 57544 rs. w0 j2. ; save (entry count change); 28676 57546 al. w1 d30. ; w1 := load buffer message; 28677 57548 rs w3 x1+6 ; segm.message := segment number; 28678 57550 28678 57550 jl. w3 f40. ; test repair allowed; 28679 57552 jl. i21. ;+2: not allowed: goto error at update entry count; 28680 57554 28680 57554 al. w3 e1. ; w3 := auxcat name; 28681 57556 jl. w2 f10. ; insegment (auxcat, loadbuffer); 28682 57558 jl. i21. ;+2: trouble: goto alarm; 28683 57560 28683 57560 rl w0 (x1+4) ; entrycount.buffer := 28684 57562 ws. w0 j2. ; entrycount.buffer 28685 57564 rs w0 (x1+4) ; - change; 28686 57566 28686 57566 al w0 -1 ; 28687 57568 wa w0 x1+6 ; decrease (segm.message); 28688 57570 rs w0 x1+6 ; (i.e. still same segment number); 28689 57572 jl. w2 f12. ; outsegment(auxcat, loadbuffer); 28690 57574 jl. i21. ;+2: trouble: goto alarm; 28691 57576 28691 57576 jl. i10. ; goto test entry count table; 28692 57578 ; (notice: i.e. scan the whole table again) 28693 57578 28693 57578 28693 57578 i15: ; terminate: 28694 57578 jl. w3 f17. ; end transfer; 28695 57580 jd 1<11+64; remove process (auxcat); 28696 57582 rl. w3 j3. ; w3 := chainhead start; 28697 57584 am. (j0.) ; 28698 57586 jl +2 ; return ok; 28699 57588 28699 57588 i18: ; error return; 28700 57588 jl. w3 f17. ; end transfer; 28701 57590 jd 1<11+64; remove process (auxcat); 28702 57592 jl. (j0.) ; error return; 28703 57594 28703 57594 28703 57594 28703 57594 i20: ; error at output catsegment: 28704 57594 al. w1 j6. ; 28705 57596 jl. w3 f2. ; type textline (<:repair not possible:>); 28706 57598 jl. i5. ; goto read; 28707 57600 28707 57600 i21: ; error at update entry count: 28708 57600 al. w1 j8. ; 28709 57602 jl. w3 f2. ; type textline (<:update of entry count not possible:>); 28710 57604 jl. i10. ; goto test entry count table; 28711 57606 28711 57606 i25: ; error at insert entry: 28712 57606 ds. w2 j12. ; save (w1, w2); 28713 57608 al. w1 j10. ; 28714 57610 jl. w3 f1. ; typetext (<:insert entry:>); 28715 57612 28715 57612 dl. w2 j12. ; 28716 57614 al w3 x1+d55 ; w3 := name.entry; 28717 57616 jl. w2 f5. ; typeresult (name, result); 28718 57618 28718 57618 dl. w2 j12. ; restore (w1, w2); 28719 57620 se w0 5 ; if result <> 5 then 28720 57622 jl. i8. ; goto next entry; 28721 57624 28721 57624 ; the current entry was inconsistent 28722 57624 ; maybe delete the entry manually 28723 57624 28723 57624 jl. w3 f40. ; test repair allowed; 28724 57626 jl. i8. ;+2: not allowed: goto next entry; 28725 57628 28725 57628 al w0 1 ; 28726 57630 wa. w0 (j5.) ; increase (entry count table (addr) ); 28727 57632 rs. w0 (j5.) ; 28728 57634 28728 57634 al w0 -1 ; 28729 57636 rs w0 x1+d53 ; clear entry; 28730 57638 28730 57638 rs. w0 j1. ; writeback := true; 28731 57640 28731 57640 jl. i8. ; goto next entry; 28732 57642 28732 57642 e. ; 28733 57642 28733 57642 28733 57642 ; description of auxcat: 28734 57642 d3: 0 ; bs kind 28735 57644 d4: 0 ; catsize 28736 57646 d5: 0 ; slice length 28737 57648 d6: 0 ; number of slices 28738 57650 28738 57650 28738 57650 d15: 0, r.8 ; answer 28739 57666 d14 = d15 + 2 ; bytes transferred 28740 57666 d17: 0 ; characters 28741 57668 d18: -1 ; cur char 28742 57670 28742 57670 d19: h0 ; start of action table 28743 57672 d20: h1 ; end of action table 28744 57674 d21: 0 ; cur action 28745 57676 d22: 0 ; input buf 28746 57678 d24: h4 ; start of command buf 28747 57680 d25: h5 ; last of command buf 28748 57682 d26: 0 ; cur command 28749 57684 d27: 0 ; top command 28750 57686 d28: h6 ; start of load buf 28751 57688 d29: h7 ; last of load buf 28752 57690 d30: 5<12, h6, h7, 0 ; load buf message 28753 57698 d33: 0 ; input segment 28754 57700 d34: 0 ; max segment 28755 57702 d35: 0 ; checksum 28756 57704 d36: 0 ; initcat switches: writetext (by entry byte0 holds load flag) 28757 57706 d37: 0 ; initcat switches: medium 28758 57708 d49: 0, r.4 ; initcat switches: automatic startup area name 28759 57716 d38: 3<12,0,0,0,0,0 ; message 1 28760 57728 d39: 3<12,0,0,0,0,0 ; message 2 28761 57740 d40: g0 ; modekind (initially: start of initcat) 28762 57742 d41: 0 ; first segment or position 28763 57744 d42: 0 ; current message address 28764 57746 d43: 0 ; device number 28765 57748 d44: 0 ; repair allowed ( 0==false, else true) 28766 57750 d45: b118 ; address of integer just read 28767 57752 d46: b119 ; address of name just read 28768 57754 28768 57754 28768 57754 e1: 0, r.5 ; auxcatname or devicename 28769 57764 e2: 0, r.5 ; document name 28770 57774 e9: <:input sumerror<0>:> 28771 57784 e11: <:input sizeerror<0>:> 28772 57796 e13: <:syntax error<0>:> 28773 57806 28773 57806 28773 57806 ; stepping stones: 28774 57806 28774 57806 jl. d0. , d0 = k-2 28775 57808 28775 57808 jl. f0. , f0 = k-2 28776 57810 jl. f1. , f1 = k-2 28777 57812 jl. f2. , f2 = k-2 28778 57814 jl. f5. , f5 = k-2 28779 57816 jl. f6. , f6 = k-2 28780 57818 jl. f8. , f8 = k-2 28781 57820 jl. f12. , f12 = k-2 28782 57822 jl. f15. , f15 = k-2 28783 57824 28783 57824 28783 57824 28783 57824 ; procedure dismount kit 28784 57824 ; 28785 57824 ; search through the chaintables to find a possible chaintable connected to 28786 57824 ; the current device. 28787 57824 ; if found then remove chaintable etc 28788 57824 ; 28789 57824 ; call: w3 = link 28790 57824 ; exit: link+0: error, all regs undef 28791 57824 ; link+2: ok , all regs undef 28792 57824 28792 57824 b. i20, j10 w. 28793 57824 28793 57824 j0: 0 ; return 28794 57826 j1: 0, r.4 ; docname to be removed 28795 57834 28795 57834 j5: <:delete bs<0>:> 28796 57842 j7: <:delete entries<0>:> 28797 57852 28797 57852 f24: ; dismount kit: 28798 57852 rl. w0 d43. ; w0 := device number; 28799 57854 ls w0 1 ; 28800 57856 wa w0 b4 ; w0 := name table address of device; 28801 57858 28801 57858 rl w1 b22 ; entry := first chain in nametable; 28802 57860 al w1 x1-2 ; 28803 57862 28803 57862 i1: ; next chain: 28804 57862 al w1 x1+2 ; increase (entry); 28805 57864 sn w1 (b24) ; if all chaintables tested then 28806 57866 jl x3+2 ; return ok; (i.e. not found) 28807 57868 28807 57868 rl w2 x1 ; chain := nametable (entry); 28808 57870 se w0 (x2+d61+8-a88); if document name table address.chain <> w0 then 28809 57872 jl. i1. ; goto next chain; 28810 57874 28810 57874 dl w1 x2+d61+2-a88; 28811 57876 ds. w1 j1.+2 ; move docname.chain; 28812 57878 dl w1 x2+d61+6-a88; 28813 57880 ds. w1 j1.+6 ; 28814 57882 28814 57882 rs. w3 j0. ; save (return); 28815 57884 28815 57884 sn w2 (b25) ; if maincat on document then 28816 57886 jd 1<11+114; remove main catalog; 28817 57888 28817 57888 al. w2 j1. ; 28818 57890 jd 1<11+108; delete backing storage (docname); 28819 57892 se w0 0 ; if result not ok then 28820 57894 jl. i10. ; goto alarm; 28821 57896 28821 57896 i5: ; rep: 28822 57896 jd 1<11+110; delete entries (docname); 28823 57898 sn w0 3 ; if not all entries deleted then 28824 57900 jl. i5. ; goto rep; 28825 57902 28825 57902 se w0 0 ; if result not ok then 28826 57904 jl. i11. ; goto alarm; 28827 57906 28827 57906 jl x3+2 ; return ok; 28828 57908 28828 57908 28828 57908 i10: ; error at delete bs: 28829 57908 sn w0 2 ; if result = catalog io-error then 28830 57910 jl. i5. ; goto rep; 28831 57912 am j5-j7 ; text := <:delete bs:> 28832 57914 28832 57914 i11: ; error at delete entries: 28833 57914 al. w1 j7. ; text := <:delete entries:>; 28834 57916 28834 57916 i15: ; typeout: 28835 57916 jl. w3 f1. ; typeout (text); 28836 57918 al. w3 j1. ; 28837 57920 jl. w2 f5. ; typeresult (docname, result); 28838 57922 jl. (j0.) ; error return; 28839 57924 28839 57924 e. ; 28840 57924 28840 57924 28840 57924 28840 57924 ; procedure mount main catalog 28841 57924 ; 28842 57924 ; call: w3 = link 28843 57924 ; exit: link+0: error , all regs undef 28844 57924 ; +2: ok , all regs undef 28845 57924 28845 57924 b. i30, j20 w. 28846 57924 28846 57924 j0: 0 ; return 28847 57926 j1: h8 ; start of chainhead buffer 28848 57928 j2: 0, r.4 ; wrk-name 28849 57936 28849 57936 j3: <:remove aux entry<0>:> 28850 57948 j5: <:connect main catalog<0>:> 28851 57962 j7: <:main catalog not defined<0>:> 28852 57980 j9: <:create aux entry<0>:> 28853 57992 j11: <:no main catalog connected<0>:> 28854 58010 28854 58010 f25: ; mount maincat: 28855 58010 rs. w3 j0. ; save (return); 28856 58012 i0: ; try again: 28857 58012 al. w3 e1. ; 28858 58014 jd 1<11+10; release process (aux catalog); 28859 58016 rl. w2 d10. ; w2 := preferred size of maincat; 28860 58018 28860 58018 rl. w3 j1. ; w3 := chainhead; 28861 58020 al. w1 d9. ; w1 := maincat name; 28862 58022 jd 1<11+112; connect main catalog (chainhead, maincat name); 28863 58024 al w3 x1 ; w3 := maincat name; 28864 58026 se w0 0 ; if result not ok then 28865 58028 jl. i10. ; goto test create; 28866 58030 28866 58030 ; maincat was connected, but has it the rigth size 28867 58030 sh w2 0 ; if preferred size undefined then 28868 58032 jl. i30. ; goto return ok; (i.e. accept any size) 28869 58034 28869 58034 ; maincat exists, but a specific size was wanted 28870 58034 28870 58034 jd 1<11+4 ; w0 := proc descr (maincat area process); 28871 58036 am (0) ; 28872 58038 sn w2 (+a61) ; if size.areaproc = wanted size then 28873 58040 jl. i30. ; goto return ok; 28874 58042 28874 58042 ; another size was wanted 28875 58042 28875 58042 jd 1<11+114; remove main catalog; 28876 58044 al. w3 e1. ; remove process (aux catalog); 28877 58046 jd 1<11+64; 28878 58048 28878 58048 rl. w2 j1. ; 28879 58050 al w2 x2+d61 ; w2 := docname.chainhead; 28880 58052 al. w1 d8. ; w1 := maincat entry; 28881 58054 jd 1<11+122; remove aux entry (docname, entry); 28882 58056 se w0 0 ; if result not ok then 28883 58058 jl. i15. ; goto alarm; 28884 58060 28884 58060 i5: ; clean up: 28885 58060 jl. w3 f24. ; dismount kit; (i.e. release all chains) 28886 58062 jl. i20. ;+2: error: goto error exit; 28887 58064 28887 58064 jl. w3 f21. ; read chain; 28888 58066 jl. i20. ;+2: error: goto error exit; 28889 58068 28889 58068 jl. i0. ; goto try again; 28890 58070 28890 58070 28890 58070 i10: ; test create: 28891 58070 se w0 3 ; if neither unknown nor already exist then 28892 58072 jl. i17. ; goto alarm; 28893 58074 28893 58074 ; it will be assumed that the entry did'nt exist in auxcat 28894 58074 28894 58074 sh w2 0 ; if preferred size not defined then 28895 58076 jl. i18. ; goto alarm; 28896 58078 28896 58078 ; before a maincat can be created, all chains on the document must 28897 58078 ; be transferred 28898 58078 28898 58078 ; the auxcat areaprocess has been released. 28899 58078 ; in order to be able to repair the auxcat during the 28900 58078 ; following cat-scan, the auxcat must be reserved again. 28901 58078 ; this may be done by means of a call of ..prepare bs.. 28902 58078 al. w3 e1. ; 28903 58080 jd 1<11+64; remove process (auxcat); 28904 58082 jl. w3 f24. ; dismount kit; 28905 58084 jl. i20. ;+2: error: goto error exit; 28906 58086 jl. w3 f21. ; read chain; 28907 58088 jl. i20. ;+2: error: goto error exit; 28908 58090 28908 58090 jl. w3 f23. ; insert all entries; (i.e. all chains) 28909 58092 jl. i20. ;+2: error: goto error exit; 28910 58094 28910 58094 jd 1<11+36; w0w1 := get clock; 28911 58096 ld w1 5 ; w0 := shortclock; 28912 58098 28912 58098 al. w1 d8. ; w1 := maincat entry; 28913 58100 rs w0 x1+d11-d8 ; save shortclock in tail; 28914 58102 28914 58102 rl. w2 j1. ; 28915 58104 al w2 x2+d61 ; w2 := docname.chainhead; 28916 58106 28916 58106 al w0 0 ; 28917 58108 al. w3 j2. ; w3 := wrkname area; 28918 58110 rs w0 x3 ; (clear first word of name); 28919 58112 28919 58112 jd 1<11+120; create aux entry and area process; 28920 58114 se w0 0 ; if result not ok then 28921 58116 jl. i19. ; goto alarm; 28922 58118 28922 58118 jd 1<11+64; remove process (aux area process); 28923 58120 28923 58120 jl. i5. ; goto clean up; 28924 58122 28924 58122 28924 58122 i15: ; error at remove aux entry: 28925 58122 am j3-j5 ; text := <:remove aux entry:>; 28926 58124 i17: ; error at connect main catalog: 28927 58124 am j5-j9 ; text := <:connect main catalog:>; 28928 58126 i19: ; error at create main catalog: 28929 58126 al. w1 j9. ; text := <:create aux entry:>; 28930 58128 28930 58128 i16: ; typeout: 28931 58128 jl. w3 f1. ; typeout (text); 28932 58130 28932 58130 al. w3 d9. ; w3 := main cat name; 28933 58132 jl. w2 f5. ; typeresult (maincat name, result); 28934 58134 28934 58134 jl. i20. ; goto error exit; 28935 58136 28935 58136 i18: ; size of main cat not defined: 28936 58136 al. w1 j7. ; type textline (<:maincatalog not defined:>); 28937 58138 jl. w3 f2. ; 28938 58140 28938 58140 i20: ; error exit: 28939 58140 al. w1 j11. ; type textline (<:no maincat connected:>); 28940 58142 jl. w3 f2. ; 28941 58144 al. w3 e1. ; 28942 58146 jd 1<11+64; remove process (aux catalog); 28943 58148 28943 58148 jl. (j0.) ; error return; 28944 58150 28944 58150 i30: ; return ok: 28945 58150 am. (j0.) ; 28946 58152 jl +2 ; return ok; 28947 58154 28947 58154 e. ; 28948 58154 28948 58154 28948 58154 28948 58154 ; procedure get bskind 28949 58154 ; 28950 58154 ; call: w3 = link 28951 58154 ; exit: all regs undef 28952 58154 ; error exit: syntax alarm 28953 58154 28953 58154 b. i10, j10 w. 28954 58154 28954 58154 j0: ; start of table 28955 58154 <:fast:>, 0 ; 28956 58160 <:slow:>, 1 ; 28957 58166 j1: ; top of table 28958 58166 j2 = 6 ; size of entry 28959 58166 28959 58166 f29: ; get bskind: 28960 58166 am. (d46.) ; 28961 58168 dl w1 +2 ; w0w1 := two first word of name; 28962 58170 al. w2 j0.-j2 ; entry := base of kind-table; 28963 58172 i0: ; next kind: 28964 58172 al w2 x2+j2 ; increase (entry); 28965 58174 sn. w2 j1. ; if all kinds tested then 28966 58176 jl. f30. ; goto syntax alarm; 28967 58178 sn w0 (x2+0) ; 28968 58180 se w1 (x2+2) ; if name <> kindname.entry then 28969 58182 jl. i0. ; goto next kind; 28970 58184 28970 58184 rl w0 x2+4 ; bskind := kind.entry; 28971 58186 rs. w0 d3. ; 28972 58188 28972 58188 jl x3 ; return; 28973 58190 28973 58190 e. ; 28974 58190 28974 58190 28974 58190 28974 58190 28974 58190 f30: jl. (2),b115; goto syntax error; 28975 58194 f31: jl. (2),b116; goto next command; 28976 58198 f32: jl. (2),b117; goto exam command; 28977 58202 f33: jl. (2),b112; call next param; 28978 58206 f34: jl. (2),b113; call next name; 28979 58210 f35: jl. (2),b114; call next integer; 28980 58214 f41: jl. (2),b121; call init write; 28981 58218 f42: jl. (2),b122; call write char; 28982 58222 f43: jl. (2),b123; call write text; 28983 58226 f44: jl. (2),b124; call type line; 28984 58230 f45: jl. (2),b125; call save work; 28985 58234 f46: jl. (2),b126; goto command aborted; 28986 58238 f47: jl. (2),b129; goto catalog error; 28987 58242 f48: jl. (2),b130; call stack input; 28988 58246 28988 58246 ; procedure read name 28989 58246 ; 28990 58246 ; call: w2 = name address, w3 = link 28991 58246 ; exit: all regs undef 28992 58246 28992 58246 f36: ; read name: 28993 58246 al w1 x3 ; 28994 58248 jl. w3 f34. ; next name; 28995 58250 al w3 x1 ; 28996 58252 28996 58252 ; procedure move name 28997 58252 ; 28998 58252 ; call: w2 = name address, w3 = link 28999 58252 ; exit: w0w1 = undef, w2w3 = unchanged 29000 58252 29000 58252 f37: ; move name: 29001 58252 am. (d46.) ; 29002 58254 dl w1 +2 ; move name just read to name-area; 29003 58256 ds w1 x2+2 ; 29004 58258 am. (d46.) ; 29005 58260 dl w1 +6 ; 29006 58262 ds w1 x2+6 ; 29007 58264 jl x3 ; return; 29008 58266 29008 58266 29008 58266 ; procedure move catname,docname from chainbuffer 29009 58266 ; 29010 58266 ; call: w3 = link 29011 58266 ; exit: all regs undef 29012 58266 29012 58266 b. j10 w. 29013 58266 29013 58266 f38: ; move catname,docname from chainbuffer: 29014 58266 rl. w2 j2. ; w2 := first of chainbuffer; 29015 58268 dl w1 x2+d61+2 ; 29016 58270 ds. w1 e2.+2 ; move docname from chainbuffer; 29017 58272 dl w1 x2+d61+6 ; 29018 58274 ds. w1 e2.+6 ; 29019 58276 29019 58276 dl w1 x2+d55+2 ; 29020 58278 ds. w1 e1.+2 ; move catname from chainbuffer; 29021 58280 dl w1 x2+d55+6 ; 29022 58282 ds. w1 e1.+6 ; 29023 58284 29023 58284 jl x3 ; return; 29024 58286 29024 58286 29024 58286 ; procedure move catname,docname to chainbuffer 29025 58286 ; 29026 58286 ; call: w3 = link 29027 58286 ; exit: all regs undef 29028 58286 29028 58286 f39: ; move catname etc to chainbuffer: 29029 58286 rl. w2 j2. ; w2 := first of chainbuffer; 29030 58288 dl. w1 e2.+2 ; if docname(0) not defined then 29031 58290 sn w0 -1 ; 29032 58292 jl x3 ; return; 29033 58294 29033 58294 ds w1 x2+d61+2 ; move docname to chainhead; 29034 58296 dl. w1 e2.+6 ; 29035 58298 ds w1 x2+d61+6 ; 29036 58300 29036 58300 dl. w1 e1.+2 ; move catname to chainhead; 29037 58302 ds w1 x2+d55+2 ; 29038 58304 dl. w1 e1.+6 ; 29039 58306 ds w1 x2+d55+6 ; 29040 58308 29040 58308 rl. w1 d3. ; 29041 58310 ls w1 3 ; if bskind defined then 29042 58312 al w1 x1+a110 ; kind.chainhead := bskind; 29043 58314 sl w1 0 ; permkey.chainhead := max cat key; 29044 58316 hs w1 x2+d53 ; 29045 58318 29045 58318 jl x3 ; return; 29046 58320 29046 58320 j2: h8 ; first of chainbuffer 29047 58322 29047 58322 e. ; 29048 58322 29048 58322 29048 58322 29048 58322 ; procedure test repair allowed 29049 58322 ; 29050 58322 ; call: w3 = link 29051 58322 ; exit: link+0: not allowed, all regs undef 29052 58322 ; +2: allowed , w0 = undef, other regs unchanged 29053 58322 29053 58322 b. j10 w. 29054 58322 29054 58322 f40: ; test repair allowed: 29055 58322 al w0 0 ; repair allowed := false; 29056 58324 rx. w0 d44. ; 29057 58326 se w0 0 ; if repair was allowed then 29058 58328 jl x3+2 ; return ok; 29059 58330 29059 58330 jl. w1 f2. ; type textline... and return; 29060 58332 <:auxcat to be repaired<0>:> 29061 58348 29061 58348 e. ; 29062 58348 \f 29062 58348 29062 58348 29062 58348 ; ********************************************* 29063 58348 ; ********************************************* 29064 58348 ; ** ** 29065 58348 ; ** main control of monitor initialization ** 29066 58348 ; ** ** 29067 58348 ; ********************************************* 29068 58348 ; ********************************************* 29069 58348 29069 58348 b. i10 w. 29070 58348 i0: f19 ; autoload device controllers 29071 58350 i1: f20 ; start up device controllers 29072 58352 29072 58352 g0: ; init catalog: 29073 58352 jl. w3 f41. ; init write; 29074 58354 29074 58354 rl. w0 d36. ; 29075 58356 se w0 0 ; if discload then 29076 58358 jl. w3 (i0.) ; autoload device controllers; 29077 58360 29077 58360 jl. w3 (i1.) ; start up device controller; 29078 58362 29078 58362 rl. w0 d36. ; w0 := discload flag; 29079 58364 rl. w1 d49. ; w1 := first word of startup area name; 29080 58366 se w0 0 ; if not discload 29081 58368 sn w1 0 ; or area name <> 0 then 29082 58370 jl. i2. ; goto write start header; 29083 58372 29083 58372 ; automatic startup is demanded 29084 58372 jl. w3 g11. ; call (automatic oldcat); 29085 58374 29085 58374 al. w2 d49. ; name := startup area name; 29086 58376 jl. w3 f48. ; stack input (name); 29087 58378 29087 58378 jl. f31. ; goto next command; 29088 58380 i2: am (b4) ; get name of console 2 29089 58382 rl w2 +a199<1 ; 29090 58384 dl w1 x2+4 ; 29091 58386 ds. w1 e1.+2 ; 29092 58388 dl w1 x2+8 ; 29093 58390 ds. w1 e1.+6 ; 29094 58392 al. w3 e1. ; send output message 29095 58394 al. w1 i3. ; 29096 58396 jd 1<11+16 ; 29097 58398 jd 1<11+18 ; wait answer dont care about the answer and dont check 29098 58400 jl. f31. ; 29099 58402 29099 58402 i3: 5<12, e19 , e20 29100 58408 0, r.5 ; eight words for answer 29101 58418 29101 58418 e. ; 29102 58418 29102 58418 ; ************************************************ 29103 58418 ; ************************************************ 29104 58418 \f 29104 58418 29104 58418 29104 58418 29104 58418 29104 58418 29104 58418 ; command syntax: clearcat 29105 58418 29105 58418 b. i10, j10 w. 29106 58418 29106 58418 g40: ; clearcat: 29107 58418 rl w2 b22 ; entry := first chain in name table; 29108 58420 jl. i3. ; (skip) 29109 58422 i1: ; next chain: 29110 58422 rl. w2 j1. ; restore (entry); 29111 58424 i2: al w2 x2+2 ; increase (entry); 29112 58426 i3: sn w2 (b24) ; if all chains tested then 29113 58428 jl. f31. ; goto next command; 29114 58430 29114 58430 rl w3 x2+0 ; chain := name table (entry); 29115 58432 rl w0 x3+d61-a88; 29116 58434 sn w0 0 ; if docname(0) = 0 then 29117 58436 jl. i2. ; goto next chain; 29118 58438 29118 58438 rs. w2 j1. ; save (entry); 29119 58440 29119 58440 rl w1 x3+d61+8-a88; devno := (document name table address.chain 29120 58442 ws w1 b4 ; - first device in name table ) 29121 58444 ls w1 -1 ; / 2 ; 29122 58446 rs. w1 d43. ; 29123 58448 29123 58448 jl. w3 f24. ; dismount kit; 29124 58450 jl. i1. ;+2: error: goto next chain; 29125 58452 29125 58452 jl. i1. ; goto next chain; 29126 58454 29126 58454 j1: 0 ; cur entry for chain 29127 58456 29127 58456 e. ; 29128 58456 29128 58456 29128 58456 29128 58456 ; command syntax: nokit <device number> 29129 58456 29129 58456 g41: ; nokit: 29130 58456 jl. w3 f35. ; devno := 29131 58458 rs. w0 d43. ; next integer; 29132 58460 29132 58460 jl. w3 f24. ; dismount kit; 29133 58462 jl. f31. ;+2: error: goto next command; 29134 58464 29134 58464 jl. f31. ; goto next command; 29135 58466 29135 58466 29135 58466 29135 58466 ; command syntax: maincat <maincat name> <maincat size> 29136 58466 29136 58466 b. j10 w. 29137 58466 29137 58466 g42: ; maincat: 29138 58466 rl. w2 j1. ; maincatname := 29139 58468 jl. w3 f36. ; readname; 29140 58470 29140 58470 jl. w3 f35. ; maincatsize := 29141 58472 rs w0 x2+d10-d9 ; next integer; 29142 58474 29142 58474 jl. f31. ; goto next command; 29143 58476 29143 58476 j1: d9 ; maincat name address 29144 58478 e. ; 29145 58478 29145 58478 29145 58478 29145 58478 ; command syntax: oldcat 29146 58478 29146 58478 b. i10, j10 w. 29147 58478 29147 58478 ; oldcat action: 29148 58478 g48: ; oldcat-command: 29149 58478 al. w3 f31. ; return := next command; 29150 58480 g11: ; automatic oldcat: 29151 58480 rs. w3 j6. ; save (return); 29152 58482 rl. w0 j7. ; 29153 58484 rs. w0 j9. ; number index := first bs device; 29154 58486 al. w0 i0. ; 29155 58488 rs. w0 j10. ; read action := get next from list; 29156 58490 jl. i1. ; goto next kitnumber; 29157 58492 29157 58492 i0: ; get next from list: 29158 58492 rl. w1 j9. ; if number index = top of list then 29159 58494 sn. w1 (j8.) ; 29160 58496 jl. (j6.) ; return; 29161 58498 rl w0 x1 ; 29162 58500 rs. w0 (d45.) ; param := device number (number index); 29163 58502 al w1 x1+2 ; increase (number index); 29164 58504 rs. w1 j9. ; 29165 58506 al w0 2 ; param kind := integer; 29166 58508 jl x3 ; return; 29167 58510 29167 58510 29167 58510 29167 58510 ; command syntax: kit <docname> (<auxcatname> (<kind>)) <device number> 29168 58510 ; or: kit (<device number>)* 29169 58510 29169 58510 g43: ; kit: 29170 58510 al. w3 f33. ; read action := next param; 29171 58512 rs. w3 j10. ; 29172 58514 29172 58514 al w0 -1 ; 29173 58516 rs. w0 e2. ; docname := unchanged; 29174 58518 rs. w0 d3. ; bskind := unchanged; 29175 58520 29175 58520 jl. w3 f33. ; next param; 29176 58522 se w0 1 ; if kind <> name then 29177 58524 jl. i5. ; goto test; 29178 58526 29178 58526 al. w2 e2. ; docname := name; 29179 58528 jl. w3 f37. ; 29180 58530 29180 58530 rl. w0 j0. ; (prepare no auxcatname parameter) 29181 58532 rs. w0 e1. ; 29182 58534 29182 58534 al. w2 e1.+2 ; auxcatname := <:cat:> + docname; 29183 58536 jl. w3 f37. ; 29184 58538 29184 58538 jl. w3 f33. ; next param; 29185 58540 se w0 1 ; if kind <> name then 29186 58542 jl. i5. ; goto test; 29187 58544 al. w2 e1. ; auxcatname := name; 29188 58546 jl. w3 f37. ; 29189 58548 29189 58548 jl. w3 f33. ; next param; 29190 58550 se w0 1 ; if kind <> name then 29191 58552 jl. i5. ; goto test; 29192 58554 jl. w3 f29. ; get bskind; 29193 58556 jl. i2. ; goto get devno; 29194 58558 29194 58558 i1: ; next kitnumber: 29195 58558 al w0 -1 ; 29196 58560 rs. w0 e2. ; docname := unchanged; 29197 58562 rs. w0 d3. ; bskind := unchanged; 29198 58564 i2: ; get devno: 29199 58564 jl. w3 (j10.) ; next param; 29200 58566 i5: ; test: 29201 58566 se w0 2 ; if kind <> integer then 29202 58568 jl. f32. ; goto exam command; 29203 58570 29203 58570 rl. w0 (d45.) ; devno := 29204 58572 rs. w0 d43. ; param; 29205 58574 29205 58574 jl. w3 f21. ; read chain; 29206 58576 jl. i1. ;+2: error: goto next kitnumber; 29207 58578 29207 58578 ; w3 = chainhead address 29208 58578 29208 58578 dl w1 x3+d61+2 ; outtextline ( <docname> mounted on <devno>); 29209 58580 lo. w0 j1. ; 29210 58582 lo. w1 j1. ; 29211 58584 ds. w1 j3. ; 29212 58586 dl w1 x3+d61+6 ; 29213 58588 lo. w0 j1. ; 29214 58590 lo. w1 j1. ; 29215 58592 ds. w1 j4. ; 29216 58594 29216 58594 al. w1 j2. ; 29217 58596 jl. w3 f2. ; 29218 58598 29218 58598 rl w0 b25 ; if no maincat yet then 29219 58600 se w0 0 ; 29220 58602 jl. i8. ; begin 29221 58604 jl. w3 f25. ; mount maincat; 29222 58606 jl. f47. ;+2: error: goto catalog error; 29223 58608 i8: ; end; 29224 58608 29224 58608 jl. w3 f23. ; insert all entries; 29225 58610 jl. i1. ;+2: error: goto next kitnumber; 29226 58612 29226 58612 ; w3 = chainhead address 29227 58612 29227 58612 al w2 x3+d61 ; 29228 58614 jd 1<11+106; insert bs (docname.chainhead); 29229 58616 sn w0 0 ; if result ok then 29230 58618 jl. i1. ; goto next kitnumber; 29231 58620 29231 58620 al. w2 i1. ; typeresult ( <:insert bs:>, result); 29232 58622 jl. w3 f5. ; goto next kitnumber; 29233 58624 <:insert bs <0>:> ; 29234 58634 29234 58634 j0: <:cat:> ; standard start of cat-name 29235 58636 j1: <: :> ; spaces for converting text to fixed length 29236 58638 j2: 0, r.4 ; text: <docname> 29237 58646 j3=j2+2 ; 29238 58646 j4=j2+6 ; 29239 58646 <: mounted :> ; 29240 58652 d47: <:on :> ; 29241 58654 d48: 0, r.3 ; <device number as text> 29242 58660 0 ; (end of text) 29243 58662 29243 58662 j6: 0 ; return from oldcat 29244 58664 29244 58664 j7: d1 ; start of device number list for oldcat 29245 58666 j8: d2 ; top of device number list 29246 58668 j9: 0 ; number index 29247 58670 j10: 0 ; address of read action 29248 58672 e. ; 29249 58672 29249 58672 29249 58672 29249 58672 ; command syntax: kitlabel ( <devno> <docname> <auxcatname> <bskind> , 29250 58672 ; <catsize> <slicelength> <number of slices> ) * 29251 58672 29251 58672 b. i10, j10 w. 29252 58672 29252 58672 g44: ; kitlabel: 29253 58672 i0: ; next label: 29254 58672 jl. w3 f33. ; next param; 29255 58674 se w0 2 ; if kind <> integer then 29256 58676 jl. f32. ; goto exam command; 29257 58678 29257 58678 rl. w0 (d45.) ; 29258 58680 rs. w0 d43. ; device number := param; 29259 58682 29259 58682 al. w2 e2. ; docname := read name; 29260 58684 jl. w3 f36. ; 29261 58686 29261 58686 al. w2 e1. ; auxcatname := read name; 29262 58688 jl. w3 f36. ; 29263 58690 29263 58690 jl. w3 f34. ; next name; 29264 58692 jl. w3 f29. ; get bskind; 29265 58694 29265 58694 jl. w3 f35. ; catsize := next integer; 29266 58696 rs. w0 d4. ; 29267 58698 29267 58698 jl. w3 f35. ; slicelength := next integer; 29268 58700 rs. w0 d5. ; 29269 58702 29269 58702 jl. w3 f35. ; number of slices := next integer; 29270 58704 rs. w0 d6. ; 29271 58706 29271 58706 ; notice: if the device is already included in the bs-system, it will 29272 58706 ; not automaticly be dismounted 29273 58706 29273 58706 rl. w3 j0. ; w3 := start of chainhead buffer; 29274 58708 29274 58708 ; move: 29275 58708 29275 58708 rl. w1 d4. ; auxcat size 29276 58710 rs w1 x3+d57 ; 29277 58712 29277 58712 rl. w1 d5. ; slice length 29278 58714 rs w1 x3+d64 ; 29279 58716 29279 58716 rl. w1 d6. ; last slice 29280 58718 al w1 x1-1 ; (= number of slices - 1) 29281 58720 hs w1 x3+d66 ; 29282 58722 29282 58722 al w1 x1+a88+1+511; first slice of aux catalog 29283 58724 ls w1 -9 ; 29284 58726 al w0 0 ; ( = (size of chainhead + number of slices) 29285 58728 wd w1 x3+d64 ; / slice length ) 29286 58730 se w0 0 ; 29287 58732 al w1 x1+1 ; (rounded up to an integral number of slices)) 29288 58734 hs w1 x3+d54 ; 29289 58736 29289 58736 al w1 0 ; first slice in chaintable 29290 58738 hs w1 x3+d67 ; (= 0) 29291 58740 29291 58740 ; setup chains for the whole chaintable etc 29292 58740 29292 58740 al w0 1 ; 29293 58742 bz w1 x3+d66 ; w1 := last slice number; 29294 58744 29294 58744 i5: ; next slice: 29295 58744 am x3+a88 ; 29296 58746 hs w0 x1 ; slice (w1) := 1; 29297 58748 al w1 x1-1 ; decrease (w1); 29298 58750 sl w1 0 ; if not all slices initialized then 29299 58752 jl. i5. ; goto next slice; 29300 58754 29300 58754 jl. w3 f22. ; write chain; 29301 58756 jl. i0. ;+2: error: goto next label; 29302 58758 29302 58758 ; clear auxcat 29303 58758 29303 58758 rl. w1 d29. ; w1 := last of load buffer; 29304 58760 rl. w2 d28. ; w2 := first of load buffer; 29305 58762 am -2048 ; 29306 58764 jl. w3 f11.+2048; clear (from, to); 29307 58766 29307 58766 al w0 0 ; last word of buffer := 0; 29308 58768 rs w0 x1 ; 29309 58770 29309 58770 al. w1 d30. ; w1 := load buffer message; 29310 58772 rs w0 x1+6 ; segment.message := 0; 29311 58774 29311 58774 al. w3 e1. ; name := auxcat name; 29312 58776 29312 58776 i8: ; next segment: 29313 58776 jl. w2 f12. ; outsegment (auxcat, buffer); 29314 58778 jl. i10. ;+2: trouble: goto dismount; 29315 58780 29315 58780 rl w0 x1+6 ; w0 := segment number of message; 29316 58782 se. w0 (d4.) ; if segment.message <> auxcat size then 29317 58784 jl. i8. ; goto next segment; 29318 58786 29318 58786 jd 1<11+64; remove process (aux catalog); 29319 58788 29319 58788 jl. i0. ; goto next label; 29320 58790 29320 58790 29320 58790 i10: ; dismount: 29321 58790 jd 1<11+64; remove process (aux catalog); 29322 58792 jl. w3 f24. ; dismount kit; 29323 58794 jl. i0. ;+2: error: goto next label; 29324 58796 29324 58796 jl. i0. ; goto next label; 29325 58798 29325 58798 j0: h8 ; start of chainhead 29326 58800 29326 58800 e. ; 29327 58800 29327 58800 29327 58800 29327 58800 ; command syntax: repair 29328 58800 29328 58800 g45: ; repair: 29329 58800 al w0 -1 ; repair allowed := true; 29330 58802 rs. w0 d44. ; 29331 58804 jl. f31. ; goto next command; 29332 58806 29332 58806 29332 58806 29332 58806 ; command syntax: auxclear (<bskind>) <device number> (<lower> <upper> <name>)* 29333 58806 29333 58806 b. i10, j10 w. 29334 58806 29334 58806 g49: ; auxclear: 29335 58806 al. w3 e1. ; 29336 58808 jd 1<11+68; get wrk-name (auxcat name); 29337 58810 al. w3 e2. ; 29338 58812 jd 1<11+68; get wrk-name (docname); 29339 58814 29339 58814 al w0 -1 ; 29340 58816 rs. w0 d3. ; bskind := unchanged; 29341 58818 29341 58818 jl. w3 f33. ; next param; 29342 58820 se w0 1 ; if kind = name then 29343 58822 jl. i1. ; begin 29344 58824 jl. w3 f29. ; get bskind; 29345 58826 jl. w3 f33. ; next param; 29346 58828 i1: ; end; 29347 58828 29347 58828 se w0 2 ; if kind <> integer then 29348 58830 jl. f30. ; goto syntax error; 29349 58832 29349 58832 rl. w0 (d45.) ; 29350 58834 rs. w0 d43. ; devno := integer; 29351 58836 29351 58836 jl. w3 f21. ; read chain; 29352 58838 jl. f30. ;+2: error: goto syntax (or better: goto ready); 29353 58840 29353 58840 al w3 x3+d55 ; 29354 58842 jd 1<11+64; remove process (aux cat); 29355 58844 29355 58844 i3: ; next entry: 29356 58844 jl. w3 f33. ; next param; 29357 58846 se w0 2 ; if kind <> integer then 29358 58848 jl. i9. ; goto dismount; 29359 58850 29359 58850 rl. w0 (d45.) ; 29360 58852 rs. w0 j1. ; lower interval := param; 29361 58854 jl. w3 f35. ; 29362 58856 rs. w0 j2. ; upper interval := next integer; 29363 58858 29363 58858 al. w2 j3. ; entry name := 29364 58860 jl. w3 f36. ; read name; 29365 58862 29365 58862 al. w1 j0. ; w1 := entry; 29366 58864 al. w2 e2. ; w2 := docname; 29367 58866 jd 1<11+122; remove aux entry (entry, docname); 29368 58868 sn w0 0 ; if result ok then 29369 58870 jl. i3. ; goto next entry; 29370 58872 29370 58872 al. w1 j5. ; 29371 58874 jl. w3 f1. ; typeout (<:remove aux entry:>); 29372 58876 29372 58876 al. w3 j2. ; w3 := entry name; 29373 58878 jl. w2 f5. ; typeresult (result, entry name); 29374 58880 29374 58880 jl. i3. ; goto next entry; 29375 58882 29375 58882 i9: ; dismount: 29376 58882 jl. w3 f24. ; dismount kit; 29377 58884 jl. f32. ;+2: error: goto exam command; 29378 58886 jl. f32. ; goto exam command; 29379 58888 29379 58888 j0 = k-2 ; entry: 29380 58888 j1: 0 ; lower interval 29381 58890 j2: 0 ; upper interval 29382 58892 j3: 0, r.4 ; entry name 29383 58900 29383 58900 j5: <:remove aux entry<0>:> 29384 58912 29384 58912 e. ; 29385 58912 29385 58912 29385 58912 29385 58912 ; command syntax: binin <modekind> <docname> (<position>)* 29386 58912 29386 58912 b. i10, j10 w. 29387 58912 29387 58912 m0 = 0 ; bs-kind 29388 58912 m1 = 2 ; mt-kind 29389 58912 m2 = 4 ; tr-kind 29390 58912 29390 58912 ; name , modekind, tabelentry size 29391 58912 j3=0 , j4=2 , j1=j4+2 29392 58912 j0: ; start of table: 29393 58912 <:bs:> , m0 ; 29394 58916 <:mto:> , 0+m1 ; 29395 58920 <:nrz:> , 4<12+m1 ; 29396 58924 <:tro:> , m2 ; 29397 58928 <:flx:> , m1 ; 29398 58932 j2: ; top of table 29399 58932 29399 58932 j8: <:modekind illegal<0>:> 29400 58944 j10: 0,0 ; current command name 29401 58948 0 ; (end of name) 29402 58950 j6: 0, 0 ; saved w3,w0 29403 58954 29403 58954 g46: ; binin: 29404 58954 jl. w3 f34. ; next name; 29405 58956 rl. w3 d46. ; 29406 58958 dl w0 x3+2 ; w3w0 := parameter; 29407 58960 29407 58960 al. w2 j0.-j1 ; 29408 58962 29408 58962 i1: ; 29409 58962 al w2 x2+j1 ; if modekind unknown then 29410 58964 sn w0 0 ; 29411 58966 sn. w2 j2. ; 29412 58968 jl. i5. ; goto alarm; 29413 58970 se w3 (x2+j3) ; 29414 58972 jl. i1. ; 29415 58974 29415 58974 ; w2 = entry in mode-table 29416 58974 29416 58974 rl w3 x2+j4 ; modekind := table-contents; 29417 58976 rs. w3 d40. ; 29418 58978 29418 58978 al. w2 e1. ; device name := read name; 29419 58980 jl. w3 f36. ; 29420 58982 29420 58982 jl. w3 f35. ; position := next integer; 29421 58984 29421 58984 jl. g13. ; goto initialize input; 29422 58986 29422 58986 i5: ; modekind illegal: 29423 58986 al. w1 j8. ; type textline (<:modekind illegal:>); 29424 58988 jl. w3 f2. ; 29425 58990 29425 58990 jl. f31. ; goto next command; 29426 58992 29426 58992 g54: ; end: 29427 58992 jl. w3 f17. ; end transfer; 29428 58994 jl. w3 f33. ; next param; 29429 58996 se w0 2 ; if kind <> integer then 29430 58998 jl. f32. ; goto exam command; 29431 59000 rl. w0 (d45.) ; position := param; 29432 59002 29432 59002 g13: ; 29433 59002 rs. w0 d41. ; save (position); 29434 59004 29434 59004 ; initialize input 29435 59004 al w0 0 ; 29436 59006 al w1 -1 ; characters := 0; 29437 59008 ds. w1 d18. ; cur char := -1; 29438 59010 rs. w0 d35. ; sum := 0; 29439 59012 jl. w3 f15. ; start transfer input; 29440 59014 29440 59014 g1: rl. w1 d24. ; input commands: 29441 59016 rs. w1 d26. ; cur command:= 29442 59018 al w2 x1 ; null-char allowed at start of buffer; 29443 59020 g2: jl. w3 f8. ; top command:=command buf; 29444 59022 jl. g54. ; 29445 59024 jl. g4. ; repeat 29446 59026 sh. w1 (d25.) ; input word(input, end-action,next command); 29447 59028 jl. g3. ; if top command>command end then 29448 59030 al. w1 e11. ; begin 29449 59032 ; type textline (<:input sizeerror:>); 29450 59032 jl. w3 f2. ; goto end-action; 29451 59034 jl. g54. ; end; 29452 59036 g3: rs w0 x1+0 ; word(command top):=input; 29453 59038 al w1 x1+2 ; command top:=command top+2; 29454 59040 jl. g2. ; until no limit; 29455 59042 g4: rs. w1 d27. ; 29456 59044 g5: rl. w1 d26. ; next command: 29457 59046 sl. w1 (d27.) ; if cur command>=command end 29458 59048 jl. g1. ; then goto input commands; 29459 59050 dl w1 x1+2 ; w0 := first word of command; 29460 59052 ds. w1 j10.+2 ; save command; 29461 59054 ; cur action := action table; 29462 59054 g6: rl. w2 d19. ; repeat 29463 59056 g7: sn w0 (x2+0) ; if word(cur action)=word(cur command) 29464 59058 jl. g8. ; then goto before command; 29465 59060 al w2 x2+6 ; cur action:=cur action+6; 29466 59062 sh. w2 (d20.) ; 29467 59064 jl. g7. ; until cur action>action end; 29468 59066 jl. w2 f4. ; typecommand; 29469 59068 al. w1 e13. ; 29470 59070 jl. w3 f2. ; type textline(<:syntaxerror:>); 29471 59072 jl. g54. ; goto end-action; 29472 59074 g8: rs. w2 d21. ; before command: 29473 59076 rl. w3 d26. ; 29474 59078 al w3 x3+4 ; 29475 59080 al w1 x3+8 ; 29476 59082 jl (x2+2) ; goto word(cur action+2); 29477 59084 ; w1=cur command+12 w3=cur command+4 29478 59084 29478 59084 g9: rl. w2 d21. ; after command: 29479 59086 rl. w1 d26. ; 29480 59088 wa w1 x2+4 ; cur command:= 29481 59090 rs. w1 d26. ; cur command+word(cur action+4); 29482 59092 jl. g5. ; goto next command; 29483 59094 29483 59094 ; local procedure type command; 29484 59094 ; 29485 59094 ; call: w2=link 29486 59094 ; exit: w0,w2,w3=unch, w1=undef 29487 59094 f4: ; type command: 29488 59094 ds. w0 j6.+2 ; save regs; 29489 59096 al. w1 j10. ; 29490 59098 jl. w3 f1. ; typetext (command name); 29491 59100 dl. w0 j6.+2 ; restore regs; 29492 59102 jl x2 ; return; 29493 59104 29493 59104 29493 59104 ; create: 29494 59104 g20:jd 1<11+48 ; (remove maybe an old entry) 29495 59106 jd 1<11+40 ; create entry(name,tail,result); 29496 59108 jl. g25. ; goto test result; 29497 59110 29497 59110 ; change: 29498 59110 g21:jd 1<11+44 ; change entry(name,tail,result); 29499 59112 jl. g25. ; goto test result; 29500 59114 29500 59114 ; rename: 29501 59114 g22:jd 1<11+46 ; rename entry(name,result); 29502 59116 jl. g25. ; goto test result; 29503 59118 29503 59118 ; remove: 29504 59118 g23:jd 1<11+48 ; remove entry(name,tail,result); 29505 59120 jl. g25. ; goto test result; 29506 59122 29506 59122 g24:rl w1 x1+0 ; perman: 29507 59124 jd 1<11+50 ; permanent entry(name,key,result); 29508 59126 29508 59126 ; test result: 29509 59126 g25:sn w0 0 ; if result<>0 then 29510 59128 jl. g9. ; begin 29511 59130 jl. w2 f4. ; typecommand; 29512 59132 jl. w2 f5. ; typeresult(result, name); 29513 59134 jl. g54. ; goto end-action; 29514 59136 ; end; 29515 59136 ; goto after command; 29516 59136 29516 59136 g30:al w0 0 ; load: 29517 59138 rl w1 x1+0 ; input seg:=0; 29518 59140 ds. w1 d34. ; max seg:mand param; 29519 59142 sh w1 0 ; if max seg<=0 29520 59144 jl. g9. ; then goto after command; 29521 59146 rs. w0 d30.+6 ; cur seg:=0; 29522 59148 jd 1<11+52 ; create area process(name,result); 29523 59150 se w0 0 ; if result<>0 29524 59152 jl. g25. ; then goto test result; 29525 59154 jd 1<11+8 ; reserve process(name,result); 29526 59156 g31:rl. w1 d28. ; next buf: addr:=load buf; 29527 59158 al w2 0 ; null-char := not allowed; 29528 59160 g32:jl. w3 f8. ; next word: 29529 59162 jl. g35. ; 29530 59164 jl. g33. ; inword(binword,after trouble,next segment; 29531 59166 rs w0 x1+0 ; word(addr):=bin word; 29532 59168 al w1 x1+2 ; addr:=addr+2; 29533 59170 sh. w1 (d29.) ; if addr<=load end 29534 59172 jl. g32. ; then goto next word; 29535 59174 al. w1 d30. ; 29536 59176 rl. w3 d26. ; 29537 59178 al w3 x3+4 ; 29538 59180 jl. w2 f12. ; outseg(name, area output, 29539 59182 jl. g35. ; after trouble); 29540 59184 jl. g31. ; goto next buf; 29541 59186 g33:rl. w3 d33. ; next segment: 29542 59188 al w3 x3+1 ; 29543 59190 rs. w3 d33. ; input seg:=input seg+1; 29544 59192 se. w3 (d34.) ; if input seg<>max seg 29545 59194 jl. g32. ; then goto next word; 29546 59196 sn. w1 (d28.) ; 29547 59198 jl. g34. ; if addr<>load buf then 29548 59200 al. w1 d30. ; 29549 59202 rl. w3 d26. ; 29550 59204 al w3 x3+4 ; 29551 59206 jl. w2 f12. ; outseg(name, area output, 29552 59208 jl. g35. ; after trouble); 29553 59210 g34:rl. w3 d26. ; after load: 29554 59212 al w3 x3+4 ; 29555 59214 jd 1<11+64 ; remove process(name,result); 29556 59216 jl. g9. ; goto after command; 29557 59218 29557 59218 g35:rl. w3 d26. ; after trouble: 29558 59220 al w3 x3+4 ; 29559 59222 jd 1<11+64 ; remove process(name,result); 29560 59224 jl. g54. ; goto end-action; 29561 59226 29561 59226 e. ; end binin-command 29562 59226 \f 29562 59226 29562 59226 29562 59226 29562 59226 29562 59226 d1=k ; first chain head 29563 59226 t. 29563 59226* type 29564 59226 29564 59226 29564 59226 ; initiation information. 29565 59226 29565 59226 29565 59226 m. 29565 59226 init catalog definition 29566 59226 24, 25, 26 , 3 29567 59234 n.m. 29567 59234 init catalog definition of bs included 29568 59234 d2=k ; chain head end 29569 59234 29569 59234 29569 59234 ; action table: 29570 59234 ; each command is described by its name, the address of 29571 59234 ; the command action, and the number of command bytes. 29572 59234 29572 59234 w.h0=k 29573 59234 <:cre:>, g20,32 ; <:create:><name><tail> 29574 59240 <:cha:>, g21,32 ; <:change:><name><tail> 29575 59246 <:ren:>, g22,20 ; <:rename:><name><new name> 29576 59252 <:rem:>, g23,12 ; <:remove:><name> 29577 59258 <:per:>, g24,14 ; <:perman:><name><cat key> 29578 59264 <:loa:>, g30,14 ; <:load:><name><segments> 29579 59270 <:new:>, g9 ,4 ; <:newcat:> 29580 59276 <:old:>, g9 ,4 ; <:oldcat:> 29581 59282 h1: <:end:>, g54,2 ; <:end:> 29582 59288 29582 59288 h3 = -k ; start of initcat command-table: 29583 59288 <:binin:> , 1<20 + g46-b110 29584 59294 <:clearc:> , 1<18 + g40-b110 29585 59300 <:kit<0>:> , 1<18 + g43-b110 29586 59306 <:kitlab:> , 1<18 + g44-b110 29587 59312 <:mainca:> , 1<21 + g42-b110 29588 59318 <:nokit:> , 1<18 + g41-b110 29589 59324 <:oldcat:> , 1<18 + g48-b110 29590 59330 <:repair:> , 1<18 + g45-b110 29591 59336 <:auxcle:> , 1<18 + g49-b110 29592 59342 0 29593 59344 29593 59344 29593 59344 h4=k ; command buf: 29594 59344 h5=h4+510 ; command end: 29595 59344 29595 59344 h6=h5+2 ; load buf: 29596 59344 h7=h6+510 ; load end: 29597 59344 h8=h7+2 ; chain buf 29598 59344 h11 = a116 ; (minimum size of chaintable buffer) 29599 59344 c. a114-a116, h11 = a114 z.; 29600 59344 h9 = h8+(:h11+511:)>9<9-2; last of chainbuffer 29601 59344 h10=h9+2 ; start of 1. input buffer 29602 59344 h12=h10 + 2 * 512 ; start of entry count table 29603 59344 h13=h12 + 2 * 500 ; top of entry count table (prepared for 500 segments 29604 59344 \f 29604 59344 29604 59344 29604 59344 ; initial start up of external processes and creation of 29605 59344 ; local links to front ends. before linkup the external 29606 59344 ; process description is released. 29607 59344 29607 59344 b.i30,j10,p15 w. 29608 59344 29608 59344 p6=0 ; start of message 29609 59344 p7=16 ; start of data 29610 59344 p8=30 ; jh.linkno 29611 59344 p9=38 ; process name 29612 59344 p10=46 ; length of item 29613 59344 29613 59344 i2=k ; start of linkup list 29614 59344 t. 29614 59344* type 29615 59344 29615 59344 m. 29615 59344 init linkup list 29616 59344 p.<:deviceinit:> 29617 59344 29617 59344 1<12+7<1,k+14,k+34, 17,5033, 0<12+ 0,0,0 29618 59360 8202, 1,192,<:reader<0>:>,0, 0,0,0,0,<:reader<0>:>,0 29619 59390 1<12+7<1,k+14,k+34, 17,5033, 0<12+ 0,0,0 29620 59406 8204, 1,258,<:punch<0>:>,0,0, 1,0,0,0,<:punch<0>:>,0,0 29621 59436 1<12+7<1,k+14,k+34, 17,5033, 0<12+ 0,0,0 29622 59452 8, 1,192,<:terminal1<0>:>, 2,0,0,0,<:console1<0>:>,0 29623 59482 1<12+7<1,k+14,k+34, 17,5033, 0<12+ 0,0,0 29624 59498 6, 1,768,<:disc0<0>:>,0,0, 3,0,0,0,<:disc3<0>:>,0,0 29625 59528 1<12+7<1,k+14,k+34, 17,5033, 0<12+ 0,0,0 29626 59544 14, 1,258,<:printer<0>:>,0, 5,0,0,0,<:printer<0>:>,0 29627 59574 1<12+7<1,k+14,k+34, 17,5033, 0<12+ 0,0,0 29628 59590 14, 1,258,<:printer1<0>:>,0, 4,0,0,0,<:printer1<0>:>,0 29629 59620 1<12+7<1,k+14,k+34, 17,5033, 0<12+ 0,0,0 29630 59636 22, 2,513,<:fd0<0>:>,0,0, 6,0,0,0,<:fd0<0>:>,0,0 29631 59666 1<12+7<1,k+14,k+34, 17,5033, 0<12+ 0,0,0 29632 59682 18, 2,3090,<:mt0<0>:>,0,0, 10,0,0,0,<:mt0<0>:>,0,0 29633 59712 u.n.m. 29633 59712 init linkup list included 29634 59712 i3=k ; top of linkup list 29635 59712 i6: i2-p10 ; start of linkup list 29636 59714 i7: i3 ; top of linkup list 29637 59716 29637 59716 i8: 0,r.4,0 ; name of fpa, name table entry 29638 59726 29638 59726 i9: 8<12+0 ; master clear message 29639 59728 29639 59728 i10: 0, r.8 ; answer area 29640 59744 i11: 0 ; link 29641 59746 i12: 0 ; saved pointer 29642 59748 29642 59748 i13: <:host:>,0,0,0 ; host-name and name table entry 29643 59758 29643 59758 i21: <:clock:>,0,0,0 ; clock-name and name table entry 29644 59768 29644 59768 i22: 0<12 ; delay message 29645 59770 5 ; time (in seconds) 29646 59772 29646 59772 f20: rs. w3 i11. ; init externals: save link; 29647 59774 rl w3 b4 ; 29648 59776 j0: rl w0 (x3) ; for devno:=0 step 1 until maxdevno do 29649 59778 se w0 80 ; proc:=proc(devno); 29650 59780 jl. j1. ; if kind(proc)=mainproc kind then 29651 59782 rs. w3 i12. ; name:=name(proc); 29652 59784 rl w3 x3 ; 29653 59786 al w0 0 ; if start flag(proc)<>0 then 29654 59788 rx w0 x3+a56 ; start flag(proc):=0; 29655 59790 se w0 0 ; goto cont; 29656 59792 jl. j3. ; 29657 59794 dl w2 x3+a11+2 ; 29658 59796 ds. w2 i8.+2 ; 29659 59798 dl w2 x3+a11+6 ; 29660 59800 ds. w2 i8.+6 ; 29661 59802 al. w3 i8. ; 29662 59804 jd 1<11+8 ; reserve process(name); 29663 59806 al. w1 i9. ; message:=master clear; 29664 59808 jd 1<11+16 ; send message(name,message); 29665 59810 al. w1 i10. ; 29666 59812 jd 1<11+18 ; wait answer(answer area); 29667 59814 jd 1<11+10 ; release process(name); 29668 59816 j3: rl. w3 i12. ; 29669 59818 j1: al w3 x3+2 ; 29670 59820 se w3 (b5) ; 29671 59822 jl. j0. ; 29672 59824 al. w3 i21. ; wait: 29673 59826 al. w1 i22. ; 29674 59828 jd 1<11+16 ; send message(clock,wait); 29675 59830 al. w1 i10. ; 29676 59832 jd 1<11+18 ; wait answer(answer area); 29677 59834 29677 59834 rl. w1 i6. ; insert links: 29678 59836 rs. w1 i12. ; 29679 59838 j2: rl. w1 i12. ; for dev:=first item in linkup list until last do 29680 59840 al w1 x1+p10 ; begin 29681 59842 rs. w1 i12. ; 29682 59844 sl. w1 (i7.) ; 29683 59846 jl. j8. ; 29684 59848 al. w3 i13. ; 29685 59850 jd 1<11+16 ; send message(host,linkup); 29686 59852 al. w1 i10. ; 29687 59854 jd 1<11+18 ; wait answer(answer area); 29688 59856 bz. w3 i10.+1 ; 29689 59858 sn w0 1 ; if result=ok 29690 59860 se w3 0 ; and function result=ok then 29691 59862 jl. j2. ; 29692 59864 rl. w3 i12. ; 29693 59866 rl w1 x3+p8 ; 29694 59868 al w3 x3+p9 ; 29695 59870 jd 1<11+54 ; create peripheral process; 29696 59872 jl. j2. ; end; 29697 59874 j8: 29698 59874 jl. (i11.) ; exit: return to link; 29699 59876 e. 29700 59876 \f 29700 59876 29700 59876 29700 59876 29700 59876 29700 59876 ; program used for autoload of local device controllers. 29701 59876 ; jr - 07.10.76 29702 59876 ; 29703 59876 ; the communication takes place via the transmitter part of a fpa 801. 29704 59876 ; after autoload this program reads commands from the device controller 29705 59876 ; simulating a magtape station locally connected to the device controller. 29706 59876 ; the load file must be placed on backing storage in consecutive segments. 29707 59876 ; the load file consists of a number of records with the format: 29708 59876 ; <ident> <data> 29709 59876 ; where ident > 0 : size of data block (in characters) 29710 59876 ; = 0 : tapemark (datablock empty) 29711 59876 ; =-3 : end of tape (datablock empty) 29712 59876 ; 29713 59876 ; information about load device and load file is part of monitor options, 29714 59876 ; and shall be packed in this way: 29715 59876 ; <name of load device(fpa transmitter)> 29716 59876 ; <device number of bs device holding the load file> 29717 59876 ; <first segment (load file)> 29718 59876 ; 29719 59876 ; the device controllers are loaded one by one according to the options. 29720 59876 29720 59876 b.m10,n10,p10,q10,r10,s40 w. 29721 59876 29721 59876 ; format of options: 29722 59876 p0=0 ; load device 29723 59876 p1=p0+8 ; device number of bs device 29724 59876 p2=p1+2 ; first segment 29725 59876 p3=p2+2 ; length of load command 29726 59876 29726 59876 ; counters. 29727 59876 p4=10 ; maxnumber of autoloads 29728 59876 p5=1 ; max number of errors 29729 59876 29729 59876 s30: 29730 59876 29730 59876 ; start of options 29731 59876 t. 29731 59876* type 29732 59876 29732 59876 m. 29732 59876 device autoload list 29733 59876 <:main1:> , 0, 0, 28, 168 29734 59888 n.m. 29734 59888 device autoload list included 29735 59888 29735 59888 s31=k 29736 59888 29736 59888 ; reset process. 29737 59888 s0: 4<12+0 ; operation:=reset all subprocesses 29738 59890 29738 59890 ; transmit status message. 29739 59890 s1: 5<12+2.11 ; operation:=transmit, mode:=reset, receive 29740 59892 s6 ; first:=first of sense area 29741 59894 s7 ; last:=last of sense area 29742 59896 8 ; charcount:=8 29743 59898 249 ; startchar:=sense block 29744 59900 29744 59900 ; transmit status message. 29745 59900 s2: 5<12+2.01 ; operation:=transmit, mode:=receive 29746 59902 s6 ; first:=first of sense area 29747 59904 s7 ; last:=last of sense area 29748 59906 8 ; charcount:=8 29749 59908 249 ; startchar:=sense block 29750 59910 29750 59910 ; transmit data block. 29751 59910 s3: 5<12+2.01 ; operation:=transmit, mode:=receive 29752 59912 0 ; first 29753 59914 s24 ; last (max upper limit) 29754 59916 0 ; charcount 29755 59918 251 ; strtchar:=data block 29756 59920 29756 59920 ; autoload. 29757 59920 s4: 6<12+2.11 ; operation:=autoload, mode:=reset, receive 29758 59922 ; dummy 29759 59922 29759 59922 ; answer area. 29760 59922 s5: 0 ; status 29761 59924 0 ; bytes transferred 29762 59926 0 ; chars transferred 29763 59928 0 ; command character (status character) 29764 59930 0, r.4 ; dummy 29765 59938 29765 59938 ; sense information area. 29766 59938 s6: 0 ; char0,1:=status(0:15), char2:=size(0:7), 29767 59940 0 ; char3:=size(8:15),char4,5:=filenumber(0:15), 29768 59942 s7: 0 ; char6,7:=blocknumber(0:15) 29769 59944 29769 59944 ; name of load device 29770 59944 s8: 0, r.4, 0 ; 29771 59954 29771 59954 s10: 0 ; status 29772 59956 s11: 0 ; size(data) 29773 59958 s12: 0 ; filenumber 29774 59960 s13: 0 ; blocknumber 29775 59962 29775 59962 s14: 0 ; first(record) 29776 59964 s15: 0 ; link 29777 59966 s16: 0 ; current load command 29778 59968 s17: 0 ; errorcount 29779 59970 29779 59970 ; input message. 29780 59970 s20: 3<12+0 ; operation:=read 29781 59972 s22 ; first:=first of record buffer 29782 59974 s24 ; last:=last of record buffer 29783 59976 0 ; first segment number 29784 59978 29784 59978 ; name of bs device. 29785 59978 s21: <:loaddevice:> ; ork name of bs device 29786 59986 0 ; (s21+8) name table entry of bs device 29787 59988 29787 59988 ; delay message. 29788 59988 s25: 0<12+2 ; operation:=wait, mode:=msec 29789 59990 0,15000 ; time:=1,5 sec 29790 59994 29790 59994 ; name of clock. 29791 59994 s26: <:clock:>,0,0 ; name of clock device 29792 60002 0 ; name table entry 29793 60004 29793 60004 29793 60004 f19: rs. w3 s15. ; start: save link; 29794 60006 al. w3 s30.-p3 ; 29795 60008 rs. w3 s16. ; 29796 60010 al. w1 s25. ; message:=wait; 29797 60012 al. w3 s26. ; name:=clock; 29798 60014 jl. w2 n1. ; send and wait; 29799 60016 am 0 ; ok: 29800 60018 m0: rl. w3 s16. ; next load: 29801 60020 al w3 x3+p3 ; current command:=current command+length of command; 29802 60022 rs. w3 s16. ; 29803 60024 sl. w3 s31. ; if no more commands then 29804 60026 jl. (s15.) ; return to link; 29805 60028 jd 1<11+8 ; reserve process(name); 29806 60030 jl. w3 n2. ; transfer command; 29807 60032 jl. r4. ; goto autoload; 29808 60034 29808 60034 m2: rl. w0 s5.+6 ; execute: 29809 60036 sn w0 0 ; if command char=0 then 29810 60038 jl. q0. ; goto transmit next block; 29811 60040 sn w0 1 ; if command char=1 then 29812 60042 jl. q1. ; goto retransmit block; 29813 60044 sn w0 2 ; if command char=2 then 29814 60046 jl. q2. ; goto rewind; 29815 60048 sn w0 4 ; if command char=4 then 29816 60050 jl. q3. ; goto upspace block; 29817 60052 sn w0 8 ; if command char=8 then 29818 60054 jl. q4. ; goto upspace file; 29819 60056 sn w0 12 ; if command char=12 then 29820 60058 jl. q5. ; goto end; 29821 60060 sn w0 128 ; if command char=128 then 29822 60062 jl. q6. ; goto sense; 29823 60064 sn w0 255 ; if command char=255 then 29824 60066 jl. q7. ; goto wait; 29825 60068 jl. q8. ; goto error; 29826 60070 29826 60070 b.j10 w. 29827 60070 29827 60070 ; after error, reset and transmit status, receive command. 29828 60070 r1: al w0 0 ; reset,trm status: 29829 60072 rs. w0 s17. ; errorcount:=0; 29830 60074 jl. w3 n3. ; set up status area; 29831 60076 j0: al. w1 s1. ; repeat0: message:=reset,transmit status,receive; 29832 60078 al. w3 s8. ; name:=name(load device); 29833 60080 jl. w2 n1. ; send and wait; 29834 60082 jl. m2. ; ok: goto execute; 29835 60084 al w3 1 ; error: 29836 60086 wa. w3 s17. ; errorcount:=errorcount+1; 29837 60088 rs. w3 s17. ; 29838 60090 sh w3 p5 ; if errorcount=<maxerrorcount then 29839 60092 jl. j0. ; goto repeat0; 29840 60094 jl. m0. ; goto load next; 29841 60096 29841 60096 ; transmit status. 29842 60096 r2: jl. w3 n3. ; transmit status: setup status area; 29843 60098 al. w1 s2. ; message:=transmit status; 29844 60100 al. w3 s8. ; name:=name(load device); 29845 60102 jl. w2 n1. ; send and wait; 29846 60104 jl. m2. ; ok: goto execute; 29847 60106 jl. r1. ; error: goto restart; 29848 60108 29848 60108 ; transmit data. 29849 60108 r3: rl. w2 s14. ; transmit data: 29850 60110 al w2 x2+2 ; first(data):=first(record)+2; 29851 60112 rs. w2 s3.+2 ; size:=size(data); 29852 60114 rl. w2 s11. ; if size=0 then 29853 60116 sn w2 0 ; size:=1; 29854 60118 al w2 1 ; 29855 60120 rs. w2 s3.+6 ; char count:=size; 29856 60122 al. w1 s3. ; message:=transmit block; 29857 60124 al. w3 s8. ; name:=name(load device); 29858 60126 jl. w2 n1. ; send and wait; 29859 60128 jl. m2. ; ok: goto execute; 29860 60130 jl. r1. ; error: goto restart; 29861 60132 29861 60132 ; autoload. 29862 60132 r4: al w0 0 ; autoload: 29863 60134 rs. w0 s17. ; errorcount:=0; 29864 60136 al. w1 s0. ; message:=reset; 29865 60138 al. w3 s8. ; name:=namee(load device); 29866 60140 jl. w2 n1. ; send and wait; 29867 60142 jl. j1. ; ok: goto start load; 29868 60144 jl. m0. ; error: goto load next; 29869 60146 j1: al. w1 s4. ; start load: message:=autoload; 29870 60148 al. w3 s8. ; name:=name(load device); 29871 60150 jl. w2 n1. ; send and wait; 29872 60152 jl. m2. ; ok: goto execute; 29873 60154 al w3 1 ; 29874 60156 wa. w3 s17. ; 29875 60158 rs. w3 s17. ; errorcount:=errorcount+1; 29876 60160 sh w3 p5 ; if errorcount=<maxerrorcount then 29877 60162 jl. j1. ; goto repeat; 29878 60164 jl. m0. ; goto load next; 29879 60166 e. 29880 60166 29880 60166 ; transmit next block. 29881 60166 q0: jl. w3 n0. ; transmit next block: next block; 29882 60168 jl. r3. ; goto transmit block; 29883 60170 29883 60170 ; retransmit block. 29884 60170 q1=r3 ; retransmit block: goto transmit block; 29885 60170 29885 60170 ; rewind. 29886 60170 q2: jl. w3 n2. ; rewind: transfer command; 29887 60172 jl. r2. ; goto transmit status; 29888 60174 29888 60174 ; upspace block. 29889 60174 q3: jl. w3 n0. ; upspace block: next block; 29890 60176 al w3 1<2 ; 29891 60178 sz w0 1<8+1<4 ; if status=end of tape or end of file then 29892 60180 rs. w3 s10. ; status:=position error; 29893 60182 al w3 0 ; size(data):=0; 29894 60184 rs. w3 s11. ; 29895 60186 jl. r2. ; goto transmit status; 29896 60188 29896 60188 ; upspace file. 29897 60188 q4: jl. w3 n0. ; upspace file: 29898 60190 sn w0 0 ; while status=0 do 29899 60192 jl. q4. ; next block; 29900 60194 al w3 0 ; 29901 60196 sz w0 1<8 ; if status=end of file then 29902 60198 rs. w3 s10. ; status:=ok; 29903 60200 rs. w3 s11. ; size(data):=0; 29904 60202 jl. r2. ; goto transmit status; 29905 60204 29905 60204 ; end. 29906 60204 q5: rl. w3 (s21.+8) ; end: 29907 60206 ld w1 -100 ; remove work name of bs device; 29908 60208 ds w1 x3+4 ; 29909 60210 ds w1 x3+8 ; 29910 60212 rl. w3 s16. ; 29911 60214 jd 1<11+10 ; release process(name); 29912 60216 al. w1 s25. ; 29913 60218 al. w3 s26. ; 29914 60220 jl. w2 n1. ; send and wait(clock) 29915 60222 am 0 ; 29916 60224 jl. m0. ; goto load next; 29917 60226 29917 60226 ; sense. 29918 60226 q6=r2 ; sense: goto transmit status; 29919 60226 29919 60226 ; wait. 29920 60226 q7: al. w1 s25. ; wait: 29921 60228 al. w3 s26. ; 29922 60230 jl. w2 n1. ; send and wait(clock); 29923 60232 am 0 ; 29924 60234 jl. r1. ; 29925 60236 29925 60236 ; error. 29926 60236 q8=r2 ; error: goto transmit status; 29927 60236 29927 60236 29927 60236 ; procedure next block. 29928 60236 ; this procedure finds the start of the next record. 29929 60236 ; 29930 60236 ; status: 0 ok 29931 60236 ; 1<4 end of tape 29932 60236 ; 1<8 end of file 29933 60236 ; 1<14 disc error 29934 60236 ; 29935 60236 ; call: return: 29936 60236 ; w0 status 29937 60236 ; w1 size(data) 29938 60236 ; w2 destroyed 29939 60236 ; w3 link destroyed 29940 60236 b.i4,j4 w. 29941 60236 i0: 0 ; saved link 29942 60238 i1: 3 ; constant 29943 60240 i2: 1<14 ; disc error 29944 60242 i3: 1<18 ; end of medium 29945 60244 29945 60244 n0: rs. w3 i0. ; next block: 29946 60246 rl. w1 (s14.) ; 29947 60248 al w1 x1+2+3 ; first(next record):= 29948 60250 al w0 0 ; (size(data)+3)+2)//3*2+first(record); 29949 60252 wd. w1 i1. ; 29950 60254 ls w1 1 ; 29951 60256 wa. w1 s14. ; 29952 60258 rs. w1 s14. ; first(record):=first(next record); 29953 60260 sh. w1 s23. ; if first(record)>first(buf)+510 then 29954 60262 jl. j0. ; first(record):=first(record)-512; 29955 60264 al w1 x1-512 ; first segmentno:=first segmentno+1; 29956 60266 rs. w1 s14. ; 29957 60268 al w0 1 ; 29958 60270 wa. w0 s20.+6 ; 29959 60272 rs. w0 s20.+6 ; 29960 60274 al. w1 s20. ; message:=input; 29961 60276 al. w3 s21. ; name:=name(load file device); 29962 60278 jl. w2 n1. ; send and wait; 29963 60280 jl. j0. ; ok: goto cont; 29964 60282 rl. w3 s6.+2 ; error: 29965 60284 sn. w1 (i3.) ; if status=end of medium 29966 60286 se w3 512 ; and bytes transferred=1 segment then 29967 60288 jl. j4. ; goto cont; 29968 60290 jl. j0. ; 29969 60292 j4: rl. w0 i2. ; status:=disc error; 29970 60294 al w1 0 ; size:=0; 29971 60296 dl. w3 s13. ; fileno:=fileno, blockno:=blockno; 29972 60298 jl. j3. ; goto exit; 29973 60300 j0: rl. w1 (s14.) ; cont: 29974 60302 sh w1 0 ; if ident(record)>0 then 29975 60304 jl. j1. ; size(data):=ident(record); 29976 60306 al w0 0 ; status:=0; 29977 60308 dl. w3 s13. ; filenumber:=filenumber; 29978 60310 al w3 x3+1 ; blocknumber:=blocknumber+1; 29979 60312 jl. j3. ; else 29980 60314 j1: se w1 0 ; if size(record)<>0 then 29981 60316 am 1<4-1<8 ; status:=1end of tape 29982 60318 al w0 1<8 ; else status:=end of file; 29983 60320 j2: al w1 0 ; size(data):=0; 29984 60322 al w2 1 ; filenumber:=filenumber+1; 29985 60324 wa. w2 s12. ; blocknumber:=1; 29986 60326 al w3 1 ; 29987 60328 j3: ds. w1 s11. ; exit: 29988 60330 ds. w3 s13. ; 29989 60332 jl. (i0.) ; return; 29990 60334 e. 29991 60334 29991 60334 ; procedure send and wait. 29992 60334 ; the procedure returns to link in case of result ok (which is 29993 60334 ; status=0 and result=1), else to link+2. 29994 60334 ; call: return: 29995 60334 ; w0 destroyed 29996 60334 ; w1 message result(0: ok, 1: error) 29997 60334 ; w2 link destroyed 29998 60334 ; w3 name destroyed 29999 60334 b.i0 w. 30000 60334 n1: rs. w2 i0. ; send and wait: 30001 60336 jd 1<11+16 ; send message; 30002 60338 al. w1 s5. ; answer area:=std answer area; 30003 60340 jd 1<11+18 ; wait answer; 30004 60342 rl. w1 s5.+0 ; if result<>1 30005 60344 rl. w2 i0. ; 30006 60346 sn w0 1 ; or status<>0 then 30007 60348 se w1 0 ; return to link+2 30008 60350 jl x2+2 ; else return to link; 30009 60352 jl x2+0 ; 30010 60354 i0: 0 ; saved link 30011 60356 e. 30012 60356 30012 60356 ; procedure transfer command. 30013 60356 ; call return: 30014 60356 ; w0 destroyed 30015 60356 ; w1 destroyed 30016 60356 ; w2 destrlyed 30017 60356 ; w3 link destroyed 30018 60356 b.i1w. 30019 60356 n2: rs. w3 i0. ; transfer command: 30020 60358 rl. w2 s16. ; 30021 60360 dl w1 x2+p0+2 ; 30022 60362 ds. w1 s8.+2 ; 30023 60364 dl w1 x2+p0+6 ; transfer name(load device); 30024 60366 ds. w1 s8.+6 ; 30025 60368 rl w3 x2+p1 ; 30026 60370 ls w3 1 ; 30027 60372 wa w3 b4 ; name table entry(bs device):=deviceno*2+start(name table); 30028 60374 rs. w3 s21.+8 ; 30029 60376 rl w3 x3 ; proc(bs device):=word(name table entry); 30030 60378 dl. w1 s21.+2 ; 30031 60380 ds w1 x3+4 ; transfer work name to proc; 30032 60382 dl. w1 s21.+6 ; 30033 60384 ds w1 x3+8 ; 30034 60386 ld w1 -100 ; 30035 60388 ds. w1 s11. ; ident,size:=0,0; 30036 60390 al w0 1 ; 30037 60392 rs. w0 s12. ; filenumber:=1; 30038 60394 rs. w0 s13. ; blocknumber:=1; 30039 60396 rl w1 x2+p2 ; first segment:=first segment number(load file) - 1; 30040 60398 al w1 x1-1 ; 30041 60400 rs. w1 s20.+6 ; 30042 60402 al w0 768-3 ; assure that first and second segment are 30043 60404 rs. w0 s22. ; transferred to core first time the 30044 60406 al. w0 s22. ; record buffer are used; 30045 60408 rs. w0 s14. ; 30046 60410 jl. (i0.) ; exit: return; 30047 60412 i0: 0 ; save link 30048 60414 e. 30049 60414 30049 60414 ; procedure setup status area. 30050 60414 ; call: return: 30051 60414 ; w0 destroyed 30052 60414 ; w1 destroyed 30053 60414 ; w2 destroyed 30054 60414 ; w3 link destroyed 30055 60414 b.w. 30056 60414 n3: rl. w0 s10. ; setup status area: 30057 60416 rl. w1 s11. ; 30058 60418 se w0 0 ; if status<>ok then 30059 60420 al w1 0 ; size(data):=0; 30060 60422 ls w1 8 ; 30061 60424 ld w1 8 ; 30062 60426 lo. w1 s12. ; sense status area:= 30063 60428 rl. w2 s13. ; status(0:15)<8+size(0:7), 30064 60430 ls w2 8 ; size(8:15)<16+filenumber(0:15), 30065 60432 ds. w1 s6.+2 ; blocknumber(0:15)<8; 30066 60434 rs. w2 s6.+4 ; 30067 60436 jl x3 ; exit: return; 30068 60438 e. 30069 60438 30069 60438 s22=k ; start of record buffer 30070 60438 s23=s22+510 ; last of first segment in record buffer 30071 60438 s24=s22+512*2-2 ; last of record buffer 30072 60438 30072 60438 e. 30073 60438 30073 60438 30073 60438 b.i24 ; begin 30074 60438 w. 30075 60438 i0: ; initialize segment: 30076 60438 rl. w0 i3. ; initialize (top of initcat code); 30077 60440 rs. w0 (i4.) ; 30078 60442 30078 60442 rl. w2 i5. ; 30079 60444 30079 60444 dl w1 x3-2 ; move initcat switches; 30080 60446 ds w1 x2+d37-d36; 30081 60448 30081 60448 dl w1 x3-10 ; move startup area name; 30082 60450 ds w1 x2+d49+2-d36; 30083 60452 dl w1 x3-6 ; 30084 60454 ds w1 x2+d49+6-d36; 30085 60456 30085 60456 jl (10) ; goto system start; 30086 60458 30086 60458 i3: h13 ; top of initcat code 30087 60460 i4: b120 ; pointer to ... 30088 60462 i5: d36 ; pointer to initcat switches 30089 60464 30089 60464 jl. i0. ; goto initialize segment; 30090 60466 c25=k - b127 + 2 30091 60466 e. ; end 30092 60466 i. 30093 60466 e. ; end of initialize catalog on backing store 30094 60466 \f 30094 60466 30094 60466 30094 60466 ; segment 10 30095 60466 ; rc 05.08.70 bjørn ø-thomsen 30096 60466 ; 30097 60466 ; this segment moves segment 2 - 9 in this way: 30098 60466 ; 30099 60466 ; segment 2 is moved to cell 8 and on, after which 30100 60466 ; control is transferred to the last moved word with the 30101 60466 ; following parameters: 30102 60466 ; w2 = top load address (= new address of last moved 30103 60466 ; word + 2) 30104 60466 ; w3 = link 30105 60466 ; 30106 60466 ; after initializing itself, the program segment returns 30107 60466 ; to this segment with: 30108 60466 ; w2 = load address of next segment 30109 60466 ; 30110 60466 ; the next segment will then be moved to cell(w2) and on, 30111 60466 ; after which it is entered as described above. 30112 60466 ; 30113 60466 ; when initialize catalog (segment 9) is entered, the values 30114 60466 ; of the two switches (writetext, medium) may be found in 30115 60466 ; the words x3-4 and x3-2. 30116 60466 ; 30117 60466 ; segment 10 is entered from segment 1 in its last word 30118 60466 ; entry conditions: 30119 60466 ; w0,w1 = init catalog switches 30120 60466 ; w2 = start address of segment 2 30121 60466 30121 60466 30121 60466 30121 60466 30121 60466 s. i10, j10 30122 60466 w. 30123 60466 j3. ; length of segment 10 30124 60468 j9: 0, r.4 ;x3-12: init cat switch: startup area name 30125 60476 j0: 0 ;x3-4: init cat switch: writetext 30126 60478 j1: 0 ;x3-2: init cat switch: medium 30127 60480 30127 60480 30127 60480 ; return point from initializing of some segment 30128 60480 30128 60480 i0: rl. w1 j2. ; get load address; 30129 60482 i1: wa w1 x1+0 ; calculate top address: 30130 60484 rx. w1 j2. ; change(old load address, top address); 30131 60486 al w1 x1+2 ; skip segment length; 30132 60488 30132 60488 ; now w1, w2 = old, new load address 30133 60488 30133 60488 ; move segment: 30134 60488 30134 60488 sh w2 x1 ; if new addr > old addr then 30135 60490 jl. i2. ; begin 30136 60492 30136 60492 ds. w2 j5. ; save (old, new); 30137 60494 ws w2 2 ; diff := new - old; 30138 60496 sh w2 i5 ; (at least size of move loop); 30139 60498 al w2 i5 ; 30140 60500 30140 60500 al. w1 j2. ; from := last of segment; 30141 60502 ; move to higher: 30142 60502 i4: rl w0 x1 ; move word(from) 30143 60504 am x2 ; to word(from + diff); 30144 60506 rs w0 x1 ; 30145 60508 al w1 x1-2 ; 30146 60510 sn. w1 j0. ; if exactly all moveloop moved then 30147 60512 jl. x2+i4. ; goto the moved moveloop... 30148 60514 30148 60514 sl. w1 (j4.) ; if not all moved then 30149 60516 jl. i4. ; goto move to higher; 30150 60518 30150 60518 rl. w1 j4. ; old := old + diff; 30151 60520 wa w1 4 ; 30152 60522 wa. w2 j2. ; top address := top address + diff; 30153 60524 rs. w2 j2. ; 30154 60526 rl. w2 j5. ; restore(new); 30155 60528 ; end; 30156 60528 30156 60528 i2: rl w0 x1+0 ; move word from old 30157 60530 rs w0 x2+0 ; to new address; 30158 60532 al w1 x1+2 ; update old addr; 30159 60534 al w2 x2+2 ; update new addr; 30160 60536 se. w1 (j2.) ; if old addr <> top addr 30161 60538 jl. i2. ; then goto move segment; 30162 60540 30162 60540 ; now the segment has been moved 30163 60540 ; jump to the last moved word 30164 60540 30164 60540 al. w3 i0. ; insert return; 30165 60542 jl x2-2 ; goto word(top addr - 2); 30166 60544 30166 60544 ; comment: jump to last loaded word with 30167 60544 ; w2 = top load address 30168 60544 ; w3 = link 30169 60544 ; word(x3-4) = init cat switch, writetext 30170 60544 ; word(x3-2) = init cat switch, medium 30171 60544 30171 60544 30171 60544 ; initialize segment 10 30172 60544 30172 60544 i3: ds. w1 j1. ; save init cat switches 30173 60546 rs. w2 j2. ; 30174 60548 30174 60548 ; ************* note: uses special knowledge to format of autoboot-program 30175 60548 dl w1 30 ; get startup area name from fixed part of autoboot!!! 30176 60550 ds. w1 j9.+2 ; 30177 60552 dl w1 34 ; 30178 60554 ds. w1 j9.+6 ; 30179 60556 30179 60556 ; get monitor mode and clear all interrupts 30180 60556 30180 60556 gg w3 b91 ; w3 := inf; 30181 60558 30181 60558 rl. w0 j6. ; w0 := monitor mode; 30182 60560 al. w1 i6. ; w1 := new entry; 30183 60562 al. w2 j7. ; w2 := regdump; 30184 60564 30184 60564 rs w2 x3+a326 ; user regdump := regdump; 30185 60566 rs w0 x3-a325+a328+6; monitor status := monitor mode; 30186 60568 rs w1 x3-a325+a328+2; monitor call entry := new entry; 30187 60570 jd 1<11+0 ; call monitor; i.e. enter below, in monitor mode; 30188 60572 30188 60572 i6: al w0 1 ; after monitor mode got: 30189 60574 gp w0 b91 ; inf := 1; i.e. prevent any response; 30190 60576 30190 60576 al w1 1<3 ; device := 1; 30191 60578 30191 60578 i7: am. (j8.) ; next device: 30192 60580 do x1+2 ; reset device (device); 30193 60582 al w1 x1+1<3 ; increase (device); 30194 60584 sh w1 255<3 ; if device <= 255 then 30195 60586 jl. i7. ; goto next device; 30196 60588 30196 60588 al w2 8 ; new load address := 8; 30197 60590 jd. i0. ; goto get load address; 30198 60592 30198 60592 j6: 1 < 23 ; monitor mode; 30199 60594 j7: 0, r. a180>1 ; regdump 30200 60610 j8: 1 < 23 ; device address bit 30201 60612 j4: 0 ; saved old 30202 60614 j5: 0 ; saved new 30203 60616 i5 = k - j0 ; aproximate size of moveloop 30204 60616 30204 60616 j2: 0 ; top address 30205 60618 jl. i3. ; goto initialize segment 10 30206 60620 j3: ; top address of segment 10: 30207 60620 30207 60620 e. ; end segment 10 30208 60620 i. 30209 60620 30209 60620 ; last segment 30210 60620 30210 60620 s.w. 30211 60620 0 ; last segment empty 30212 60622 30212 60622 e. ; end of last segment 30213 60622 m. 30213 60622 end of monitor 30214 60622 e. slang ok 11/42354/83 ▶EOF◀