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

---
 devel/misc/unknown/src/TABINFO.ELA | 117 +++++++++++++++++++++++++++++++++++++
 1 file changed, 117 insertions(+)
 create mode 100644 devel/misc/unknown/src/TABINFO.ELA

(limited to 'devel/misc/unknown/src/TABINFO.ELA')

diff --git a/devel/misc/unknown/src/TABINFO.ELA b/devel/misc/unknown/src/TABINFO.ELA
new file mode 100644
index 0000000..af419bb
--- /dev/null
+++ b/devel/misc/unknown/src/TABINFO.ELA
@@ -0,0 +1,117 @@
+PACKET table info DEFINES table info :       (* Michael Staubermann *) 
+                                             (* 02.12.86            *) 
+LET insert flag addr            = 4654 ,
+
+(*  prev modnr addr             = 4662 , *)
+    cur modnr addr              = 4806 , 
+
+    prev code end addr          = 4775 , 
+    cur code end addr           = 4807 , 
+
+    prev name tab end addr      = 4688 , 
+    cur name tab end addr       = 4693 , 
+
+    prev permanent tab end addr = 4704 ,
+    cur permanent tab end addr  = 4707 , 
+
+    prev denoter end addr       = 4815 , 
+    cur denoter end addr        = 4809 ,
+
+    prev static data end addr   = 4816 , 
+    cur static data end addr    = 4810 , 
+    prev static data begin addr = 4817 , 
+    cur static data begin addr  = 4811 , 
+(*
+    begin of hash table         = 0 , 
+    end of hash table           = 1023 , 
+
+    begin of string table       = 1024 , 
+    end of string table         = 4093 ,
+*)
+    begin of name table         = 4096 , 
+    end of name table           = 22783 , 
+
+    begin of permanent table    = 22784 , 
+    end of permanent table      = 32767 , 
+    
+    begin of code               = 4096 , 
+ 
+    begin of data               = 4096 ; 
+ 
+INT CONST end of code :: -1 , 
+          end of data :: -1 ;
+ 
+BOOL VAR was insert ; 
+ 
+INT PROC getword (INT CONST segment, address) : 
+ EXTERNAL 120 
+ENDPROC getword ; 
+ 
+PROC arith16 : 
+ EXTERNAL 92 
+ENDPROC arith16 ; 
+ 
+INT OP SUB (INT CONST left, right) : 
+ arith 16 ;
+ left - right 
+ENDOP SUB ; 
+ 
+PROC entry (TEXT CONST name, BOOL CONST size, 
+            INT CONST begin, cur, prev, end) : 
+ put (subtext (name + " ....................", 1, 20) + ":") ; 
+ IF size 
+    THEN put (card (end SUB begin)) ; 
+         put (card (end SUB cur)) ; 
+         put (card (cur SUB begin)) ; 
+         put (card (int (positiv (cur SUB begin) / 
+                         positiv (end SUB begin) * 100.0))) ;
+    ELSE put ("                       ") 
+ FI ;
+ IF NOT was insert
+    THEN put (card (prev - cur)) 
+ FI ; 
+ line
+ENDPROC entry ; 
+ 
+PROC table info : 
+ was insert := getword (0, insert flag addr) = 0 ; 
+ line ; 
+ put ("N„chste Modulenr.:") ; 
+ put (getword (0, cur modnr addr)) ; line (2) ; 
+ put ("Name                   Size  Free  Used  Used%") ;
+ IF NOT was insert 
+    THEN put ("LastRun") 
+ FI ; 
+ line ; 
+ entry ("Permanenttable", TRUE, begin of permanent table, 
+        getword (0, cur permanent tab end addr), 
+        getword (0, prev permanent tab end addr), end of permanent table) ; 
+ entry ("Nametable", TRUE, begin of name table, 
+        getword (0, cur name tab end addr), 
+        getword (0, prev name tab end addr), end of name table) ; 
+ entry ("Code", TRUE, begin of code, 
+        getword (0, cur code end addr), 
+        getword (0, prev code end addr), end of code) ; 
+ entry ("Data", TRUE, begin of data, 
+        getword (0, cur static data end addr), 
+        getword (0, prev static data end addr), end of data) ; 
+ line ;
+ENDPROC table info ; 
+ 
+REAL PROC positiv (INT CONST value) : 
+ IF value < 0 
+    THEN real (value) + 65536.0 
+    ELSE real (value) 
+ FI
+ENDPROC positiv ; 
+ 
+TEXT PROC card (INT CONST i) : 
+ IF i = minint 
+    THEN "32768" 
+ ELIF i < 0 
+    THEN subtext (text (real (i) + 65536.0), 1, 5)
+    ELSE text (i, 5)
+ FI 
+ENDPROC card
+ 
+ENDPACKET table info ; 
-- 
cgit v1.2.3