|
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: 32256 (0x7e00)
Types: TextFile
Names: »ud«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »ud«
***clear temp raman unknown
c
1 \f
1
1
1 begin
2 integer i,j,res,num,ver,int,tmin,fmin,fmax,nr,n1,n2,m,df,dt,pl,del,
3 s,s1,s2,I,norm,N,b,nr1,nr2,ramme,t,type,sel,fint,key,savep,ram3;
4 real T,fak,max,umax,min,umin,skax,skay,ymax,format,x,y,g;
5 long array lis,com,navn,navn1,navn2(1:2);
6 long l;
7 integer array a(1:8),tail,hale(1:10);
8 array mic,prg(1:3),text(1:12);
9 boolean setup,pr,nl;
10 zone z(128,1,stderror);
11
11 procedure ffil(nr,navn,type);
12 long array navn; integer nr,type;
13 begin
14 integer s,i; boolean p,r; long array exn(1:2);
15
15 navn(1):= navn(2):= 0;
16 D: repeatchar(in);
17 A: readchar(in,s); if s=32 then goto A;
18 repeatchar(in);
19 readchar(in,s);
20 if s=10 then write(out,<:navn= :>)
21 else repeatchar(in); outendcur(0);
22 readstring(in,navn,1);
23 if navn(1)=0 then goto D;
24 ramnc(nr,navn,type);
25 if type=6 or type=7 then goto slut;
26 if lookupentry(navn)=0 then goto slut;
27 if type=1 then
28 begin ramng(nr,exn,2);
29 if lookupentry(exn)<>0 then goto L;
30 ramng(nr,navn,2); type:=2; goto slut;
31 end;
32 if type=2 then
33 begin ramng(nr,exn,1);
34 if lookupentry(exn)=0 then goto slut;
35 ramng(nr,navn,1); goto L;
36 end;
37 if type=9 then
38 begin ramng(nr,navn,2);
39 if lookupentry(navn)=0 then
40 begin type:=2; goto slut; end;
41 ramng(nr,navn,1);
42 if lookupentry(navn)=0 then
43 begin type:=1; goto slut; end
44 else
45 goto L;
46 end;
47 L: write(out,navn,<: *findes ikke:>);
48 navn(1):=navn(2):=0;
49 repeatchar(in);
50 C: readchar(in,s); if s<>10 then goto C;
51 goto nextcom;
52 slut:
53 end ffil;
54
54 procedure gfil(navn,op);
55 long array navn; integer op;
56 begin integer s,t;
57 if op=0 then goto C;
58 navn(1):=navn(2):=0;
59 D: repeatchar(in);
60 A: readchar(in,s); if s=32 then goto A;
61 repeatchar(in);
62 readchar(in,s);
63 if s=10 then write(out,case op of(
64 <:navn= :>,<:mnavn= :>,<:snavn= :>,<:knavn= :>,
65 <:lnavn= :>,<:enavn= :>))
66 else repeatchar(in); setposition(out,0,0);
67 readstring(in,navn,1);
68 ramnc(nr,navn,t);
69 if t=7 then
70 begin ramnc(nr,navn1,t);
71 t:=case op of(0,3,4,0,0);
72 ramng(nr,navn,t);
73 end;
74 C: if lookupentry(navn)=0 then removeentry(navn);
75 reservesegm(navn,400); permentry(navn,15);
76 end gfil;
77
77 procedure indl(navn);
78 long array navn;
79 begin integer array t(1:10);
80 if type=1 or type=2 then
81 begin if type=1 then ramng(nr,navn,2);
82 if lookupentry(navn) <> 0 then ramind(nr);
83 end;
84 end indl;
85
85
85
85 boolean procedure fejl;
86 begin
87 if res<>1 or netiosw extract 7 <> 0 then
88 begin
89 fejl:=true;
90 fejlinet(out,mic,res,netiosw);
91 end
92 else
93 fejl:=false;
94 end fejl;
95
95 procedure status;
96 begin
97 integer array data(1:256);
98 integer pos,segm,state;
99 res:=netoperat(string inc(mic),opsense,0);
100 if fejl then goto sslut;
101 state:=netprogsw;
102 state:=
103 if state=0 then 1 else
104 if state=1 then 2 else
105 if state=2 then 3 else
106 if state=4 then 4 else
107 if state=8 then 5 else 6;
108
108 res:=netabsio(string inc(mic),opinput,data,0);
109 if fejl then goto sslut;
110 pos:=(data(35) shift (-8))-771;
111 segm:=pos//768;
112 pos:=pos/3-segm-1;
113
113 write(out,<:Status::>,sp,17,case state of (
114 <:ingen bruger process eller stoppet.:>,
115 <:aktiv.:>,
116 <:venter på meddelelse.:>,
117 <:venter på svar.:>,
118 <:venter på begivenhed (meddelelse eller svar).:>,
119 <:ukendt status.:>),nl,1,<< ddddd>,
120 <:Antal punkter opsamlet::>,pos,nl,1,
121 <:Antal cm-1 scannet::>,sp,4,pos/8.4);
122 sslut:
123 end status;
124
124
124
124 mic(1):=real (long <:miclo:> + (long <:c:> shift (-40)));
125 mic(2):=real <:al6:>;
126 prg(1):=real (long <:raman:> + (long <:p:> shift (-40)));
127 prg(2):=real <::>;
128 mic(3):=prg(3):=real <::>;
129 nl:=false add 10;
130 ram3:=0; pr:=true; sel:=0; savep:=0;
131 \f
131 nextcom:
132 setup:=false; com(1):=com(2):=0; write(out,nl,2,<:com=:>);
133 setposition(out,0,0); readstring(in,com,1); l:=com(1);
134 if l=long <:cdraw:> or l= long <:cdr:> then goto cdraw;
135 if l=long <:cdump:> or l= long <:cdu:> then goto cdump;
136 if l=long <:cd1:> or l= long <:cd2:> then goto cdump;
137 if l= long <:con:> then goto conv;
138 if l=long <:draw:> or l= long <:dra:> then goto draw;
139 if l=long <:dump:> or l= long <:dum:> then goto dump;
140 if l=long <:hent:> or l= long <:hen:> then goto hent;
141 if l=long <:load:> or l= long <:loa:> then goto load;
142 if l=long <:mikro:> or l= long <:mik:> then goto mikro;
143 if l=long <:progr:> or l= long <:pro:> then goto progr;
144 if l=long <:setup:> or l= long <:set:> then goto set;
145 if l=long <:start:> or l= long <:sta:> then goto start;
146 if l=long <:status:> or l=long <:sts:> then goto stat;
147 if l=long <:stop:> or l= long <:sto:> then goto stop;
148 if l=long <:clear:> or l= long <:cle:> then goto clear;
149 if l=long <:kat:> then goto kat;
150 if l=long <:katr:> or l= long <:ktr:> then goto katr;
151 if l=long <:kats:> or l= long <:kts:> then goto kats;
152 if l=long <:look:> or l= long <:loo:> then goto look;
153 if l=long <:nr:> or l= long <:rnr:> then goto ranr;
154 if l=long <:adder:> or l= long <:add:> then goto adder;
155 if l=long <:b:> or l= long <:bag:> then goto bagr;
156 if l=long <:z:> or l= long <:fsm:> then goto fsmo;
157 if l= long <:get:> then goto getl;
158 if l=long <:g:> or l= long <:gsn:> then goto gsnit;
159 if l=long <:i:> or l= long <:ind:> then goto ind;
160 if l=long <:kopi:> or l= long <:kop:> then goto kopi;
161 if l= long <:kvo:> then goto kvot;
162 if l=long <:log:> then goto log;
163 if l=long <:max:> then goto maks;
164 if l=long <:min:> then goto minl;
165 if l=long <:mul:> then goto mult;
166 if l=long <:n:> or l= long <:nor:> then goto nor;
167 if l=long <:jus:> or l= long <:npf:> then goto npf;
168 if l= long <:ny4:> then goto ny4;
169 if l=long <:opl:> then goto opl;
170 if l=long <:pli:> then goto pli;
171 if l=long <:p:> or l= long <:plo:> then goto plot;
172 if l=long <:plrny:> or l= long <:plr:> then goto plrny;
173 if l=long <:pot:> then goto pot;
174 if l= long <:put:> then goto putl;
175 if l=long <:r:> or l= long <:ret:> then goto putl;
176 if l=long <:m:> or l= long <:rn1:> then goto rn1;
177 if l=long <:rny:> or l= long <:rn2:> then goto rn2;
178 if l= long <:sap:> then goto sap;
179 if l= long <:smo:> then goto smo;
180 if l= long <:sms:> then goto sms;
181 if l=long <:c:> or l= long <:sub:> then goto sub;
182 if l=long <:u:> or l= long <:udl:> then goto getl;
183 if l=long <:sky:> or l= long <:ysk:> then goto yska;
184 if l=long <:skx:> or l= long <:xsk:> then goto xska;
185 if l=long <:list:> or l= long <:lis:> then goto list;
186 if l=long <:perm:> or l= long <:per:> then goto perm;
187 if l=long <:vent:> or l= long <:ven:> then goto vent;
188 if l= long <:tes:> then goto test;
189 if l=long <:slut:> or l= long <:end:> then goto slut
190 else
191 begin write(out,<:kommando :>,com,<: findes ikke:>,nl,1,
192 <:ved kommando list skrives kommandoliste:>);
193 repeatchar(in);
194 B: readchar(in,s); if s<>10 then goto B; goto nextcom;
195 end;
196 \f
196
196
196
196 load:
197 res:=netprogload(string inc(mic),string inc(prg));
198 fejl;
199 if setup then goto start;
200 goto nextcom;
201
201
201 start:
202 res:=netoperat(string inc(mic),opstart,0);
203 fejl;
204 if setup then
205 begin write(out,<:*START MICRO:>,nl,2); setposition(out,0,0);
206 wait(2);
207 write(out,<:*START RS100:>,nl,1); setposition(out,0,0);
208 wait(5);
209 goto cdump;
210 end;
211 goto nextcom;
212
212
212 stop:
213 if setup then
214 begin write(out,nl,1,<:*STOP RS100:>,nl,1);
215 setposition(out,0,0);
216 end;
217 res:=netoperat(string inc(mic),opstop,0);
218 fejl;
219 goto nextcom;
220
220
220 cdraw:
221 if -,htal(fmin) and -,htal(int) or htal(i) then
222 begin write(out,<:tmin int (cm-1)= :>); setp;
223 read(in,tmin,int);
224 end;
225 ramcdr(mic,tmin,int);
226 goto nextcom;
227
227
227 cdump:
228 if -,htal(tmin) and -,htal(int) or htal(i) then
229 begin write(out,<:tmin int (cm-1)=:>);
230 setposition(out,0,0); read(in,tmin,int);
231 end;
232 if pr then
233 begin write(out,nl,1,<:n:>,nl,2); setposition(out,0,0);
234 ramcdu(mic,tmin,int);
235 end
236 else
237 begin write(out,nl,1,<:g:>,nl,2); setposition(out,0,0);
238 ramcdg(mic,tmin,int);
239 end;
240 if setup then goto stop;
241 goto nextcom;
242
242
242 conv:
243 if -,htal(s1) and -,htal(s2) or htal(i) then
244 begin write(out,<:nr1 nr2= :>); setposition(out,0,0);
245 read(in,s1,s2);
246 end;
247 ramcon(s1,s2,1);
248 goto nextcom;
249
249
249 draw:
250 if -,htal(tmin) and -,htal(int) or htal(i) then
251 begin write(out,<:tmin int (cm-1)= :>); setp;
252 read(in,tmin,int);
253 end;
254 goto nextcom;
255
255
255 dump:
256 goto nextcom;
257
257
257 hent:
258 goto nextcom;
259
259
259 mikro:
260 write(out,<:mikro= :>,string inc(mic));
261 write(out,nl,1,<:mikro= :>); setposition(out,0,0);
262 readchar(in,res); if res<>10 then
263 begin mic(1):=mic(2):=mic(3):=long <::>;
264 repeatchar(in); readstring(in,mic,1);
265 end;
266 goto nextcom;
267
267
267 progr:
268 write(out,<:program= :>,string inc(prg)); setposition(out,0,0);
269 write(out,nl,1,<:program= :>); setposition(out,0,0);
270 readchar(in,res); if res<>10 then
271 begin prg(1):=prg(2):=prg(3):=real <::>;
272 repeatchar(in); readstring(in,prg,1);
273 pr:=-,pr;
274 end;
275 goto nextcom;
276
276
276 set:
277 setup:=true; goto load;
278
278
278 stat:
279 status;
280 goto nextcom;
281 \f
281
281
281
281 clear:
282 write(out,<:nr1 nr2 type=:>); setposition(out,0,0);
283 read(in,nr1,nr2,type);
284 ramcle(nr1,nr2,type);
285 goto nextcom;
286
286
286 look:
287 if -,htal(nr1) and -,htal(nr2)
288 and -,htal(type) or htal(i) then
289 begin write(out,<:nr1 nr2 type=:>); setposition(out,0,0);
290 read(in,nr1,nr2,type);
291 end;
292 ramloo(nr1,nr2,type);
293 goto nextcom;
294
294
294 kat:
295 if -,htal(nr1) and -,htal(nr2) or htal(i) then
296 begin write(out,<:nr1 nr2=:>); setposition(out,0,0);
297 read(in,nr1,nr2);
298 end;
299
299 lookuptail(<:ramkatn:>,hale);
300 hale(8):=1; hale(9):=nr1; hale(10):=nr2;
301 changetail(<:ramkatn:>,hale);
302 ramkat;
303 goto nextcom;
304
304
304 katr:
305 if -,htal(nr) or htal(i) then
306 begin write(out,<:nr=:>); setposition(out,0,0);
307 read(in,nr);
308 end;
309 ramkatr(nr);
310 goto nextcom;
311
311
311 kats:
312 if -,htal(nr1) and -,htal(nr2) or htal(i) then
313 begin write(out,<:nr1 nr2=:>); setposition(out,0,0);
314 read(in,nr1,nr2);
315 end;
316 lookuptail(<:ramkatn:>,hale);
317 hale(8):=0; hale(9):=nr1; hale(10):=nr2;
318 changetail(<:ramkatn:>,hale);
319 psubmit(<:ramks:>,0);
320 goto nextcom;
321
321
321 ranr:
322 ramrnr;
323 goto nextcom;
324 \f
324
324
324
324 adder:
325 ffil(nr,navn,type);
326 if -,htal(b) or htal(i) then
327 begin write(out,<:med konstant=:>); setposition(out,0,0);
328 read(in,b);
329 end;
330 indl(navn); rambag(navn,1,b,1.0);
331 goto nextcom;
332
332
332 bagr:
333 ffil(nr,navn,type);
334 if -,htal(b) or htal(i) then
335 begin write(out,<:med konstant=:>); setposition(out,0,0);
336 read(in,b);
337 end;
338 indl(navn); rambag(navn,1,-b,1.0);
339 goto nextcom;
340
340
340 getl:
341 ffil(nr,navn,type);
342 if -,htal(nr1) and -,htal(nr2) or htal(i) then
343 begin write(out,<:nr1 nr2= :>);
344 setposition(out,0,0); read(in,nr1,nr2);
345 end;
346 begin array S(1:nr2-nr1+1);
347 indl(navn); get(navn,nr1,nr2,S);
348 for i:=1 step 1 until nr2-nr1+1 do
349 write(out,nl,1,<<ddd>,i+nr1-1,<< ddddd>,S(i));
350 setposition(out,0,0);
351 end;
352 goto nextcom;
353
353
353 gsnit:
354 ffil(nr,navn,type); if -,htal(ver) or htal(i) then
355 begin write(out,<:ver=:>); setposition(out,0,0);
356 read(in,ver);
357 end;
358 indl(navn); ramgsn(navn,ver,g);
359 goto nextcom;
360
360
360 ind:
361 if -,htal(nr) or htal(i) then
362 begin write(out,<:nr= :>); setposition(out,0,0);
363 read(in,nr);
364 end;
365 ramind(nr);
366 goto nextcom;
367
367
367 kopi:
368 ffil(nr,navn1,type); gfil(navn2,4);
369 indl(navn1); rammul(navn1,navn2,2,1.0,1,max);
370 goto nextcom;
371
371
371 kvot:
372 ramsub(2);
373 goto nextcom;
374
374
374 log:
375 ffil(nr,navn1,type); gfil(navn2,5);
376 indl(navn1); rammul(navn1,navn2,3,1.0,1,max);
377 goto nextcom;
378
378
378 maks:
379 ffil(nr,navn,type);
380 if -,htal(s1) and -,htal(s2) or htal(i) then
381 begin write(out,<:s1 s2 (cm-1)= :>);
382 setposition(out,0,0); read(in,s1,s2);
383 end;
384 indl(navn); rammax(navn,s1,s2,max,umax);
385 goto nextcom;
386
386
386 minl:
387 ffil(nr,navn,type);
388 if -,htal(s1) and -,htal(s2) or htal(i) then
389 begin write(out,<:s1 s2 (cm-1)= :>);
390 setposition(out,0,0); read(in,s1,s2);
391 end;
392 indl(navn); rammin(navn,s1,s2,min,umin);
393 goto nextcom;
394
394
394 mult:
395 ffil(nr,navn,type);
396 if -,retal(fak) or htal(i) then
397 begin write(out,<:med faktor=:>); setposition(out,0,0);
398 read(in,fak);
399 end;
400 indl(navn); rambag(navn,2,1,fak);
401 goto nextcom;
402
402
402 nor:
403 ffil(nr,navn,type);
404 if -,htal(s1) and -,htal(s2) or htal(i) then
405 begin write(out,<:s1 s2 (cm-)= :>);
406 setposition(out,0,0); read(in,s1,s2);
407 end;
408 indl(navn); rammax(navn,s1,s2,max,umax);
409 rambag(navn,5,1,max);
410 goto nextcom;
411
411
411 npf:
412 begin integer array t(1:10);
413 lookuptail(<:ramnpf:>,t);
414 write(out,nl,1,<:alfa= :>,<< d.ddd>,t(9)/1000);
415 setposition(out,0,0);
416 write(out,nl,1,<:alfa= :>); setposition(out,0,0);
417 readchar(in,i); if i<>10 then
418 begin repeatchar(in); read(in,t(9));
419 t(9):=t(9)*1000;
420 end;
421 write(out,nl,1,<:npf = :>,<< d.ddd>,t(10)/10);
422 setposition(out,0,0);
423 write(out,nl,1,<:npf = :>); setposition(out,0,0);
424 readchar(in,i); if i<>10 then
425 begin repeatchar(in); read(in,t(10));
426 t(10):=t(10)*10;
427 end;
428 end;
429 goto nextcom;
430
430
430 ny4:
431 ffil(nr,navn,type);
432 indl(navn); rambag(navn,6,1,1.0); rammax(navn,0,0,max,umax);
433 goto nextcom;
434
434
434 opl:
435 ffil(nr,navn,type); indl(navn);
436 open(z,4,navn,0); inrec(z,128);
437 for i:=1 step 1 until 12 do text(i):=z(99+i);
438 write(out,nl,2,string inc(text),nl,1);
439 write(out,
440 nl,1,<:antal segmenter=:>,<< ddd ddd ddd>,z(1),
441 nl,1,<:antal punkter =:>,<< ddd ddd ddd>,z(2),<: (:>,
442 << ddd ddd>,z(3),<:):>,
443 nl,1,<:minimum =:>,<< ddd ddd ddd>,z(4),
444 nl,1,<:minimum freq. =:>,<< ddd ddd ddd>,z(5)/10+z(11),<: cm-1:>,
445 nl,1,<:maximum =:>,<< ddd ddd ddd>,z(6),
446 nl,1,<:maximum freq. =:>,<< ddd ddd ddd>,z(7)/10+z(11),<: cm-1:>,
447 nl,1,<:min. tælletal =:>,<< ddd ddd ddd>,z(8),
448 nl,1,<:max. tælletal =:>,<< ddd ddd ddd>,z(9),
449 nl,1,<:minimal freq. =:>,<< ddd ddd ddd>,z(11),<: cm-1:>,
450 nl,1,<:maximal freq. =:>,<< ddd ddd ddd>,z(12),<: cm-1:>,nl,1);
451 setposition(out,0,0); close(z,true);
452 goto nextcom;
453
453
453 rn1:
454 ffil(nr,navn1,type); gfil(navn2,2);
455 if -,htal(norm) and -,retal(T) or htal(i) then
456 begin write(out,<:norm T(K)=:>); setposition(out,0,0);
457 read(in,norm,T);
458 end;
459 indl(navn1); rammul(navn1,navn2,1,T,1,max);
460 if norm>0 then rambag(navn2,5,1,max);
461 goto nextcom;
462
462
462 rn2:
463 ffil(nr,navn,type); indl(navn);
464 ramng(nr,navn1,3); ramng(nr,navn2,4);
465 gfil(navn1,0); gfil(navn2,0);
466 ramgsn(navn,3,g);
467 rammul(navn,navn1,1,298.0,1,max);
468 rambag(navn1,5,1,max);
469 ramfsm(navn1,navn2,10,1000);
470 rammax(navn2,20,220,max,umax);
471 rambag(navn2,5,1,max);
472 goto nextcom;
473
473
473 fsmo:
474 ffil(nr,navn1,type); gfil(navn2,3);
475 if -,htal(I) or htal(i) then
476 begin write(out,<:I (cm-1)=:>);
477 setposition(out,0,0); read(in,I);
478 end;
479 indl(navn1); ramfsm(navn1,navn2,I,500);
480 rammax(navn2,0,0,max,umax);
481 goto nextcom;
482
482
482 pli:
483 ffil(nr,navn,type);
484 write(out,<:plotter=:>); setposition(out,0,0);
485 Y: if readchar(in,m) <> 6 then goto Y;
486 m:=m-96;
487 open(z,4,navn,0); inrec(z,128);
488 write(out,nl,1,<:fre. int.= :>,<< dddd>,z(11),z(12),nl,1);
489 close(z,true);
490 write(out,<:fmin fmax df dt (cm-1) del= :>);
491 setposition(out,0,0); read(in,fmin,fmax,df,dt,del);
492 pl:=m*10+3;
493 indl(navn); rampli(navn,pl,fmin,fmax,df,dt,del);
494 goto nextcom;
495
495
495 plot:
496 ffil(nr,navn,type);
497 if -,htal(ramme) or htal(i) then
498 begin write(out,<:ramme=:>); setposition(out,0,0);
499 read(in,ramme);
500 end;
501
501 if ramme=0 then
502 begin if sel=0 then ramme:=1;
503 end;
504
504 if ramme > 0 then
505 begin if sel<>0 then plotclose;
506 write(out,<:plotter= :>); setposition(out,0,0);
507 X: if readchar(in,sel)<>6 then goto X; sel:=sel-96;
508 setplotname(case sel of(
509 <:tek4006a:>,<:houstona:>,<:tek4006c:>,<:tek4006d:>),
510 if sel=4 then 3 else 0);
511 if savep=1 then
512 begin ramng(nr,navn1,5);
513 if lookupentry(navn1)=0 then removeentry(navn1);
514 cleararray(tail); tail(1):=50;
515 reservesegm(navn1,50); permentry(navn1,15);
516 j:=1; saveplot(0,string navn1(increase(j)),0);
517 end;
518
518 indl(navn);
519
519 if type<6 then
520 begin open(z,4,navn,0); inrec(z,128); ymax:=z(6);
521 close(z,true);
522 end
523 else
524 ymax:=100;
525
525 write(out,nl,1);
526 write(out,<:ord: ymax= :>,<< ddd ddd ddd>,ymax,nl,1);
527 write(out,<: ymax= :>); setposition(out,0,0);
528 readchar(in,i); readchar(in,i);
529 setposition(out,0,0);
530 if i<>10 then
531 begin repeatchar(in); read(in,ymax);
532 end;
533 end;
534 ramplo(navn,ramme,fmin,fmax,format,ymax);
535 plotend;
536 goto nextcom;
537
537
537 plrny:
538 ffil(nr,navn,type); indl(navn);
539 ramng(nr,navn1,3); ramng(nr,navn2,4);
540 gfil(navn1,0); gfil(navn2,0);
541 ramgsn(navn,3,g);
542 rammul(navn,navn1,1,298.0,1,max);
543 rambag(navn1,5,1,max);
544 ramfsm(navn1,navn2,10,1000);
545 rammax(navn2,20,220,max,umax);
546 rambag(navn2,5,1,max);
547 rampli(navn2,43,0,400,10,100,5);
548 goto nextcom;
549
549
549 pot:
550 ffil(nr,navn1,type); gfil(navn2,6);
551 if -,htal(norm) and -,htal(m) or htal(i) then
552 begin write(out,<:exponent= :>); setposition(out,0,0);
553 read(in,m);
554 end;
555 indl(navn1); rammul(navn1,navn2,5,1.0,m,max);
556 if norm>0 then rambag(navn2,5,1,max);
557 goto nextcom;
558
558
558 putl:
559 ffil(nr,navn,type);
560 if -,htal(nr1) and -,htal(nr2) or htal(i) then
561 begin write(out,<:nr1 nr2= :>);
562 setposition(out,0,0); read(in,nr1,nr2);
563 end;
564 begin array S(1:nr2-nr1+1);
565 indl(navn); get(navn,nr1,nr2,S);
566 for i:=1 step 1 until nr2-nr1+1 do
567 begin write(out,<<ddd>,i+nr1-1,<:=:>,<< ddd ddd>,S(i));
568 write(out,nl,1,<<ddd>,i+nr1-1,<:=:>);
569 setposition(out,0,0); read(in,S(i));
570 end;
571 put(navn,nr1,nr2,S);
572 end;
573 goto nextcom;
574
574
574 sap:
575 savep:=1;
576 goto nextcom;
577
577
577 smo:
578 goto nextcom;
579
579
579 sms:
580 ffil(nr,navn1,type); gfil(navn2,3);
581 if -,htal(I) and -,htal(N) or htal(i) then
582 begin write(out,<:I (cm-1) N (antal) = :>); setp;
583 read(in,I,N);
584 end;
585 indl(navn1); ramfsm(navn1,navn2,I,N);
586 rammax(navn2,0,0,max,umax);
587 goto nextcom;
588
588
588 sub:
589 ramsub(1);
590 goto nextcom;
591
591
591 xska:
592 write(out,<:fmin fmax=:>,<< dddd>,fmin,fmax,<: cm-1:>);
593 setposition(out,0,0);
594 goto nextcom;
595
595
595 yska:
596 write(out,<:ymax: :>,<< ddd ddd ddd>,ymax);
597 write(out,nl,1,<:ymax: :>); setposition(out,0,0);
598 readchar(in,i); if i<>10 then
599 begin repeatchar(in); read(in,ymax);
600 end;
601 setposition(out,0,0);
602 goto nextcom;
603
603
603 list:
604 lis(1):=lis(2):=0;
605 repeatchar(in); A:readchar(in,i); if i=32 then goto A;
606 repeatchar(in);
607 readchar(in,i);
608 if i=10 then
609 L:begin write(out,nl,1,<:
610 list ana lister analyse kommandoer
611 list div lister diverse kommandoer
612 list kat lister katalog kommandoer
613 list mik lister mikro kommandoer:>);
614 goto nextcom;
615 end
616 else repeatchar(in); setposition(out,0,0);
617 readstring(in,lis,1); l:=lis(1);
618 if l=long <:ana:> then goto L1;
619 if l=long <:div:> then goto L2;
620 if l=long <:kat:> then goto L3;
621 if l=long <:mik:> then goto L4
622 else
623 goto L;
624 L1:
625 write(out,<:
626 RAMAN ANALYSE
627 com parametre betydning
628
628 add navn addend navn+addend
629 bag navn konstant navn-konstant
630 div navn divisor navn:divisor
631 fsm navn1 navn2 I navn2=glat navn1; I: glatteint i cm-1
632 get navn nr1 nr2 udlæser navn i tælletal int. nr1 til nr2
633 gsn navn ver gennemsnitsbregning
634 ind nr konverterer ra<nr> til p<nr>
635 kvo navn=navn1/navn2
636 kop navn1 navn2 navn2=navn1
637 log navn1 navn2 navn2=log(navn1)
638 max navn s1 s2 finder maximum mellem s1 og s2 cm-1
639 min navn s1 s2 finder minimum mellem s1 og s2 cm-1
640 mul navn fak navn*fak
641 nor navn s1 s2 normerer navn fra s1 til s2 (cm-1)
642 npf udlæser (ændre) npf og alfa
643 ny4 navn korrigerer for v**4
644 opl navn udskriver oplysninger om navn
645 pli navn plotter navn
646 plo navn ramme plotter navn med rammespecifikation
647 plr navn plotter smo rny(navn)
648 pot navn1 navn2 norm n navn1=(navn2)**n
649 put navn nr1 nr2 ændre navn i tælletalint. nr1 til nr2
650 rn1 navn1 navn2 n T navn2=rny(navn1) n=norm T=grad K
651 rny navn=p<nr> s<nr>=smo rny(navn)
652 sub navn=navn1-fak*navn2
653 xks udskriver frekvensint. på sidste plot
654 ysk udskriver (ændre) y-skala på sidste plot
655 :>);
656 goto nextcom;
657 L2:
658 write(out,<:
659
659 RAMAN DIVERSE kommandoliste
660
660 com betydning
661
661 end (slut) afslutter raman-programmet
662 list udskriver kommandoliste
663 loo nr1 nr2 type finder x<nr1> til x<nr2>
664 perm nr1 nr2 type permanenter fra x<nr1> til x<nr2>
665 vent venter på att:>,nl,1);
666 goto nextcom;
667 L3:
668 write(out,<:
669
669 RAMAN KATALOG
670 com parametre betydning
671 cle sletter indgange
672 kat nr1 nr2 udskriver liste over kataloget
673 katr nr retter i kataloget
674 kats nr1 nr2 udskriver liste over kataloget på printer
675 loo nr1 nr2 type finder indgange x<nr1> til x<nr2>
676 rnr udskriver og retter ramnr og snr
677 :>);
678 goto nextcom;
679 L4:
680 write(out,<:
681 RAMAN MIKRO
682 com parametre betydning
683
683 cdraw
684 cdump fmin int dumper under optagelsen
685 draw
686 dump
687 hent
688 load overfører program til mikro
689 mikro udskriver (evt. ændre) navnet på mikro
690 progr udskriver (evt. ændre) navnet på mikroprg.
691 :>);
692 goto nextcom;
693
693
693 perm:
694 if -,htal(n1) and -,htal(n2) and
695 -,htal(type) and -,htal(key) or htal(i) then
696 begin write(out,<:nr1 nr2 type key= :>); setp;
697 read(in,n1,n2,type,key);
698 end;
699 for j:=n1 step 1 until n2 do
700 begin ramng(j,navn,type);
701 if permentry(navn,key)=0 then
702 write(out,nl,1,navn,<: perm.:>,<<dd>,key);
703 end;
704 goto nextcom;
705
705
705 test:
706 ffil(nr,navn1,type);
707 write(out,nl,1,<:navn1 nr type=:>,navn1,<< ddd>,nr,type,nl,1);
708 setp;
709 gfil(navn2,2);
710 write(out,nl,1,<:navn2 nr type=:>,navn2,<< ddd>,nr,type);
711 setp;
712 ramnc(nr,navn1,type);
713 write(out,nl,1,<:navn1 nr type=:>,navn1,nr,type);
714 indl(navn1);
715 goto nextcom;
716
716
716 vent:
717 waitanswer(att,a);
718 goto nextcom;
719
719 slut: if sel<>0 then plotclose; end
6. line 82 . 4 undeclared
line 87 . 3 undeclared
line 90 . 1 undeclared
line 99 . 2 undeclared
line 99 . 5 undeclared
line 101 . 2 undeclared
line 108 . 2 undeclared
line 108 . 5 undeclared
line 113 . 4 undeclared
line 197 . 2 undeclared
line 202 . 2 undeclared
line 202 . 5 undeclared
line 217 . 5 undeclared
line 222 . 4 undeclared
line 225 . 1 undeclared
line 234 . 1 undeclared
line 238 . 1 undeclared
line 247 . 1 undeclared
line 284 . 1 undeclared
line 292 . 1 undeclared
line 309 . 1 undeclared
line 319 . 1 undeclared
line 322 . 1 undeclared
line 330 . 3 undeclared
line 358 . 3 undeclared
line 365 . 1 undeclared
line 384 . 3 undeclared
line 392 . 3 undeclared
line 396 . 1 undeclared
line 469 . 1 undeclared
line 717 . 2 undeclared
9. pi catalog 8388626
***algol sorry 212
ud transport 312
end 43
▶EOF◀