|
|
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: 4608 (0x1200)
Types: TextFile
Names: »ltclist «
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦39138f30b⟧
└─⟦this⟧ »ltclist «
*listtascat=algol ltctxt connect.no list.yes
ltctxt d.861121.1149
1 begin
2 <********************************************************************>
3 <* Utility LISTTASCAT til udskrift af tas katalog indgange. *>
4 <* *>
5 <* Kald: <out-file> = listtascat <out-spec.> *>
6 <* *>
7 <* user.<name> *>
8 <* terminal.<name> *>
9 <* <out-spec.> ::= type.<number> *>
10 <* size *>
11 <* all *>
12 <* *>
13 <* Compiler call: listtascat=algol ltctxt connect.no *>
14 <********************************************************************>
15
15 <**************************************************************>
16 <* Revision history *>
17 <* *>
18 <* 86.12.01 listtascat release 1.0 *>
19 <**************************************************************>
20
20
20 <* Globale variable *>
21
21 zone buf(128,1,std_error); <* Zone til message m.m. *>
22 integer array user_id(1:4); <* Bruger id fra terminal *>
23 long password; <* Password fra terminal *>
24 boolean file_out; <* True= connect to file *>
25 boolean no_found; <* Entry ikke fundet *>
26 integer array out_stack(1:4); <* out zone stack *>
27 integer array prog_name(1:4); <* Program navn *>
28 integer array conv(0:255); <* Tegn konverterings tabel *>
29 integer param; <* fp parameter tæller *>
30 integer user_size; <* Antal seg i user cat *>
31 integer term_size; <* Antal seg i term cat *>
32 integer type_size; <* Antal seg i type cat *>
33 integer user_hw; <* Antal hw i user entry *>
34 integer term_hw; <* Antal hw i term entry *>
35 integer type_hw; <* Antal hw i type entry *>
36
36 integer array field iaf; <* Work *>
37 real array field raf; <* Work *>
38 boolean array field baf; <* Work *>
39 long array field laf; <* Work *>
40 integer i; <* Work *>
41
41 <* Globale procedure *>
42
42 procedure get_userid;
43 <*-------------------------------------------------------------------*>
44 <* Set user id og password i de globale variable user_id og password *>
45 <* Id og password hentes fra terminalen tilknyttet prim. output *>
46 <*-------------------------------------------------------------------*>
47 begin
48 long array term_name(1:2);
49 integer i;
50 integer array ia(1:20);
51
51 system(7,0,term_name);
52 open(buf,0,term_name,0);
53 close(buf,false);
54 getzone6(buf,ia);
55 i:=ia(19);
56 getshare6(buf,ia,1);
57 ia(4):=131 shift 12;
58 ia(5):=i+1;
59 ia(6):=i+11;
60 ia(7):=0;
61 setshare6(buf,ia,1);
62 if monitor(16,buf,1,ia)=0 then
63 error(2);
64 if monitor
1. line 64 program too big
***algol sorry 1
*o c
▶EOF◀