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/TO16.ELA | 102 +++++++++++++++++++++++++++++++++++
 1 file changed, 102 insertions(+)
 create mode 100644 system/std.zusatz/1.7.3/src/TO16.ELA

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

diff --git a/system/std.zusatz/1.7.3/src/TO16.ELA b/system/std.zusatz/1.7.3/src/TO16.ELA
new file mode 100644
index 0000000..94cfc73
--- /dev/null
+++ b/system/std.zusatz/1.7.3/src/TO16.ELA
@@ -0,0 +1,102 @@
+PACKET to 16 DEFINES to 16 :
+
+
+LET OLDRECORD = STRUCT (INT succ, pred, x, y, TEXT line) ,
+    OLDFILE   = BOUND ROW 4075 OLDRECORD ;
+
+LET free root = 1 ,
+    used root = 2 ;
+
+LET file type 16 = 1002 ;
+
+
+FILE VAR file 17 ;
+OLDFILE VAR file 16 ;
+DATASPACE VAR file space ;
+
+
+PROC to 16 :
+  to 16 (last param)
+ENDPROC to 16 ;
+
+PROC to 16 (TEXT CONST file name) :
+
+  last param (file name) ;
+  file 17 := sequential file (input, file name) ;
+  disable stop ;
+  file space := nilspace ;
+  file 16 := file space ;
+  type (file space, file type 16) ;
+  copy 17 to 16 ;
+  IF NOT is error
+    THEN replace 17 by 16 file
+  FI ;
+  forget (file space) .
+
+replace 17 by 16 file :
+  forget (file name, quiet) ;
+  copy (file space, file name) .
+
+ENDPROC to 16 ;
+
+PROC copy 17 to 16 :
+
+  enable stop ;
+  build used record chain ;
+  build free record chain .
+
+build used record chain :
+  copy all records ;
+  construct used chains head and circular links .
+
+copy all records :
+  INT VAR line ;
+  FOR line FROM 1 UPTO lines (file 17) REP
+    copy one record ;
+    cout (line)
+  PER .
+
+copy one record :
+  INT VAR index := line + 2 ;
+  TEXT VAR line 17;
+  record.pred := index - 1 ;
+  record.succ := index + 1 ;
+  getline (file 17, line 17) ;
+  change special 17 chars;
+  record.line := line 17.
+
+change special 17 chars: 
+  change all (line 17, ""217"", ""225"");
+  change all (line 17, ""218"", ""239"");
+  change all (line 17, ""219"", ""245"");
+  change all (line 17, ""214"", ""193"");
+  change all (line 17, ""215"", ""207"");
+  change all (line 17, ""216"", ""213"");
+  change all (line 17, ""220"", ""235"");
+  change all (line 17, ""221"", ""173"");
+  change all (line 17, ""222"", ""163"");
+  change all (line 17, ""223"", ""160"");
+  change all (line 17, ""251"", ""194"").
+
+construct used chains head and circular links :
+  record.succ := used root ;
+  used root record.pred := index ;
+  used root record.succ := used root + 1 ;
+  used root record.line := headline (file 17) .
+
+build free record chain :
+  free root record.pred := free root ;
+  free root record.succ := free root ;
+  free root record.y    := index + 1 ;
+  free root record.line := "    0    1    1" ;
+  free root record.line CAT text (maxlinelength (file 17), 5) .
+
+record : CONCR (file 16) (index) .
+
+used root record : CONCR (file 16) (used root) .
+
+free root record : CONCR (file 16) (free root) .
+
+ENDPROC copy 17 to 16 ;
+
+ENDPACKET to 16 ;
-- 
cgit v1.2.3