diff options
Diffstat (limited to 'system/std.zusatz/1.7.3/src/elan lister')
| -rw-r--r-- | system/std.zusatz/1.7.3/src/elan lister | 263 |
1 files changed, 263 insertions, 0 deletions
diff --git a/system/std.zusatz/1.7.3/src/elan lister b/system/std.zusatz/1.7.3/src/elan lister new file mode 100644 index 0000000..dc34176 --- /dev/null +++ b/system/std.zusatz/1.7.3/src/elan lister @@ -0,0 +1,263 @@ +PACKET elan lister DEFINES (* Autor: J.Liedtke *)
+ (* Stand: 22.03.84 *)
+ is elan source ,
+ elan list :
+
+
+LET source lines per page = 64 ,
+ x start = 1 ,
+ y start = 2 ,
+
+ tag = 1 ,
+ bold = 2 ,
+
+ linelength = 120 ,
+ struct comment length = 32 ,
+ max name length = 25 ,
+ struct comment blanks = " " ,
+ refinement layout line = " |" ,
+ headline pre =
+ " Zeile ***** E L A N EUMEL 1.7 ***** " ;
+
+INT VAR symbol type ,
+ line nr ,
+ page nr ,
+ line at page ;
+
+BOOL VAR within defines list ;
+
+TEXT VAR record,
+ list pre ,
+ source name ,
+ source prefix ,
+ symbol,
+ ahead symbol ,
+ bottom blanks := (linelength) * " " ;
+
+
+PROC elan list (FILE VAR source) :
+
+ initialize listing ;
+ within defines list := FALSE ;
+ WHILE NOT eof (source) REP
+ list one source line ;
+ line nr INCR 1
+ PER ;
+ page bottom ;
+ start (0.0,0.0) ;
+ new page .
+
+initialize listing :
+ reset printer ;
+ construct source name and prefix ;
+ print first page head ;
+ line nr := 1 .
+
+construct source name and prefix :
+ source name := headline (source) ;
+ INT CONST slash pos := pos (source name, "/") ;
+ IF slash pos = 0
+ THEN source prefix := ""
+ ELSE source prefix := subtext (source name, slash pos+1) + "/" ;
+ source name := subtext (source name, 1, slash pos-1)
+ FI .
+
+list one source line :
+ getline (source, record) ;
+ print list pre ;
+ printline (record) ;
+ page if necessary .
+
+print list pre :
+ list pre := text (line nr, 5) ;
+ IF pos (record, "P") = 0 AND pos (record, ":") = 0
+ THEN empty layout
+ ELSE analyze source line
+ FI ;
+ list pre CAT ("|") ;
+ print text (list pre, 0) .
+
+empty layout :
+ list pre CAT struct comment blanks .
+
+analyze source line :
+ scan (record) ;
+ next symbol (symbol, symbol type) ;
+ next symbol (ahead symbol) ;
+ IF begin of packet THEN packet layout
+ ELIF within defines list THEN check end of defines part
+ ELIF begin of proc op THEN proc op layout
+ ELIF begin of refinement THEN refinement layout
+ ELSE empty layout
+ FI .
+
+begin of packet :
+ symbol = "PACKET" .
+
+begin of proc op :
+ IF is proc or op (symbol)
+ THEN TRUE
+ ELIF (symbol <> "END") AND is proc or op (ahead symbol)
+ THEN symbol := ahead symbol ;
+ next symbol (ahead symbol) ; TRUE
+ ELSE FALSE
+ FI .
+
+begin of refinement :
+ symbol type = tag AND ahead symbol = ":" AND NOT within defines list .
+
+packet layout :
+ IF not at page head
+ THEN page bottom ;
+ page head
+ FI ;
+ layout (" ", ahead symbol, "*") ;
+ within defines list := TRUE .
+
+check end of defines part :
+ empty layout ;
+ scan (record) ;
+ REP
+ nextsymbol (symbol) ;
+ IF symbol = ":"
+ THEN within defines list := FALSE
+ FI
+ UNTIL symbol = "" PER .
+
+proc op layout :
+(*printline ("") ;*)
+ printline ("") ;
+ printline ("") ;
+ IF not two free lines
+ THEN page bottom ;
+ page head
+ FI ;
+ layout (" ", ahead symbol, ".") .
+
+refinement layout :
+(*print line (refinement layout line) ;*)
+ print line (refinement layout line) ;
+ IF not two free lines THEN page bottom; page head FI;
+ layout (" ", symbol, " ") .
+
+
+print first page head :
+ page nr := 1 ;
+ page head .
+
+page if necessary :
+ IF line at page > source lines per page
+ THEN page bottom ;
+ page head
+ FI .
+
+not two free lines :
+ line at page >= source lines per page - 2 .
+
+not at page head :
+ line at page > 5 .
+
+ENDPROC elan list ;
+
+BOOL PROC is proc or op (TEXT CONST symbol) :
+
+ symbol = "PROC" OR symbol = "PROCEDURE"
+ OR symbol = "OP" OR symbol = "OPERATOR"
+
+ENDPROC is proc or op ;
+
+PROC layout (TEXT CONST pre, TEXT VAR name, TEXT CONST post) :
+
+ list pre CAT pre ;
+ name := subtext (name, 1, max name length) ;
+ list pre CAT name ;
+ list pre CAT " " ;
+ generate remaining struct comment .
+
+generate remaining struct comment :
+ INT VAR i ;
+ FOR i FROM 1 UPTO remaining struct comment length REP
+ list pre CAT post
+ PER .
+
+remaining struct comment length :
+ struct comment length - LENGTH pre - min(LENGTH name,max name length) - 1.
+
+ENDPROC layout ;
+
+PROC print line (TEXT CONST line text) :
+
+ print text (line text, 0) ;
+ line (1.0) ;
+ line at page INCR 1
+
+ENDPROC print line ;
+
+PROC printtext (TEXT CONST t, BOOL CONST b) :
+ out (t)
+ENDPROC printtext ; (*** sonst im Hardwaretreiber *********)
+
+PROC page head :
+
+ new page ;
+ print text (headline pre, 0) ;
+ print text (date, 0); (* R. Nolting 27.10.83 *)
+ print text (" ***** ",0);
+ print text (source name, 0) ;
+ line (4.0) ;
+ line at page := 1
+
+ENDPROC page head ;
+
+PROC page bottom :
+
+ WHILE line at page < source lines per page REP
+ line (1.0) ;
+ line at page INCR 1
+ PER ;
+ line (1.0) ;
+ printtext (text (source prefix + text (page nr), 8), FALSE) ;
+ printtext (bottom blanks, FALSE) ;
+ printtext (source prefix + text (page nr), FALSE) ;
+ line (1.0) ;
+ page nr INCR 1 .
+
+ENDPROC page bottom ;
+
+BOOL PROC is elan source (FILE VAR source) :
+
+ input (source) ;
+ get first symbol ;
+ symbol type = tag COR is bold begin of program COR is comment .
+
+is bold begin of program :
+ symbol type = bold CAND is elan bold .
+
+is elan bold :
+ symbol = "PACKET" COR is proc or op (symbol) COR is data declaration .
+
+is data declaration :
+ next symbol (symbol) ;
+ symbol = "VAR" OR symbol = "CONST" .
+
+is comment :
+ pos (record, "(*") > 0 OR pos (record, "{") > 0 .
+
+
+get first symbol :
+ get first non blank record ;
+ scan (record) ;
+ next symbol (symbol, symbol type) ;
+ reset (source) .
+
+get first non blank record :
+ REP
+ getline (source, record)
+ UNTIL record contains non blank OR eof (source) PER .
+
+record contains non blank :
+ pos (record, ""33"",""254"", 1) > 0 .
+
+ENDPROC is elan source ;
+
+ENDPACKET elan lister ;
|