From 98cab31fc3659e33aef260efca55bf9f1753164c Mon Sep 17 00:00:00 2001
From: Lars-Dominik Braun <lars@6xq.net>
Date: Mon, 11 Feb 2019 11:49:19 +0100
Subject: Add source files from Michael

---
 system/std.zusatz/1.7.3/src/EMU16M.ELA | 162 +++++++++++++++++++++++++++++++++
 1 file changed, 162 insertions(+)
 create mode 100644 system/std.zusatz/1.7.3/src/EMU16M.ELA

(limited to 'system/std.zusatz/1.7.3/src/EMU16M.ELA')

diff --git a/system/std.zusatz/1.7.3/src/EMU16M.ELA b/system/std.zusatz/1.7.3/src/EMU16M.ELA
new file mode 100644
index 0000000..ed8cff4
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/EMU16M.ELA
@@ -0,0 +1,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 ;
-- 
cgit v1.2.3