summaryrefslogtreecommitdiff
path: root/system/std.zusatz/1.7.3/src/EMU16M.ELA
blob: ed8cff4e962ea89e572d2e3e18320bf66f219cb0 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
PACKET emulator 16 multi DEFINES               (* Autor:  J.Liedtke *)
                                               (* Stand:  11.10.83  *)
  killer ,                                     (* F. Klapper, 16.05.84 *)
  file names ,
  out ,
  command handler ,
  set command ,
  call ,
  read , 
  to archive, 
  from archive, 
  load archive, 
  save archive, 
  list archive, 
  release archive, 
  forward, 
  backward, 
  to eof,
  to first record, 
  is first record: 
 
PROC list archive: 
  list (archive) 
END PROC list archive; 
 
PROC release archive: 
  release (archive) 
END PROC release archive; 
 
PROC to archive: 
  save (last param, archive) 
END PROC to archive; 
 
PROC to archive (TEXT CONST t): 
  save (t, archive) 
END PROC to archive; 
 
PROC from archive (TEXT CONST t): 
  fetch (t, archive) 
END PROC from archive; 
 
PROC load archive: 
  fetch all (archive) 
END PROC load archive; 
 
PROC save to archive (THESAURUS CONST thes): 
  disable stop; 
  all to archive (thes); 
  IF is error 
  THEN put error; 
       line; 
       clear error; 
       IF yes ("naechste Archivfloppy eingelegt") 
       THEN save to archive (remainder) 
       FI 
   FI; 
   enable stop 
END PROC save to archive; 
 
PROC all to archive (THESAURUS CONST thes): 
  enable stop; 
  save (thes, archive) 
END PROC all to archive; 
 
PROC save archive: 
  save to archive (ALL myself) 
END PROC save archive; 
 
PROC save archive (TEXT CONST liste): 
  save to archive (ALL liste) 
END PROC save archive; 

PROC killer :
  forget (ALL myself)
ENDPROC killer ;

THESAURUS VAR cat ;
TEXT VAR file name ;

PROC file names (FILE VAR f) :
  file names (f, name (myself))
ENDPROC file names ;

PROC file names (FILE VAR f, TEXT CONST manager name) :
  INT VAR index := 0 ;
  cat := ALL task (manager name) ;
  REP
    get (cat, file name, index) ;
    IF file name = ""
      THEN LEAVE file names
    FI ;
    putline (f, file name)
  PER
ENDPROC file names ;

PROC out (FILE VAR f, TEXT CONST t) :
  write (f,t)
ENDPROC out ;

TEXT VAR command line;
INT VAR permitted type := 0 ;

PROC set command (TEXT CONST command text, INT CONST type) :
  command line := command text;
  permitted type := type
ENDPROC set command ;

PROC command handler (TEXT CONST command list, 
                      INT VAR command index , number of params ,
                      TEXT VAR param 1, param 2) :
 
  analyze command (command list, command line, permitted type, command index,
                   number of params, param 1, param 2) 
 
ENDPROC command handler ;
 
PROC command handler (TEXT CONST command list, 
                      INT VAR command index , number of params ,
                      TEXT VAR param 1, param 2,
                      TEXT CONST command text) :
 
  get command (command text, command line) ;
  analyze command (command list, command line, 0,
                   command index, number of params, param 1, param 2) 

ENDPROC command handler ;

PROC call (TEXT CONST dest name, INT CONST order code, 
           DATASPACE VAR ds, INT VAR reply code) :

  call (task (dest name), order code, ds, reply code)

ENDPROC call ;

PROC read (TEXT CONST file name) :
  fetch (file name)
ENDPROC read ;

PROC read (TEXT CONST file name, manager name) :
  fetch (file name, task(manager name))
ENDPROC read ;

PROC forward (FILE VAR f): 
  down (f) 
END PROC forward; 
 
PROC backward (FILE VAR f): 
  up (f) 
END PROC backward; 
 
PROC to first record (FILE VAR f): 
  to line (f, 1) 
END PROC to first record; 
 
BOOL PROC is first record (FILE VAR f): 
  line no (f) = 1 
END PROC is first record; 
 
PROC to eof (FILE VAR f): 
  to line (f, lines (f)) 
END PROC to eof;
ENDPACKET emulator 16 multi ;