PACKET file DEFINES (* Autor: J.Liedtke *)
(* Stand: 30.04.82 *)
FILE ,
:= ,
input ,
output ,
modify ,
sequential file ,
getline ,
putline ,
line ,
reset ,
eof ,
put ,
get ,
page ,
out ,
eop ,
close ,
max line length ,
max page length ,
read record ,
write record ,
forward ,
backward ,
delete record ,
insert record ,
to first record ,
to eof ,
is first record ,
headline ,
copy attributes ,
reorganize ,
feldeditor ,
feldout ,
feldeinruecken ,
pos ,
change ,
subtext ,
sort :
TYPE FILE = STRUCT ( BOUND DATEI f ,
INT index, pointer, line counter,
mode, max line length, max page length,
BOOL edit status unchanged) ;
TYPE TRANSPUTDIRECTION = INT ;
LET closed = 1 ,
in = 2 ,
outp = 3 ,
mod = 4 ,
end = 5 ,
escape = ""27"" ,
nullzustand = " 0 1 1" ,
max length = 15 000 ; (* < maxint/2 because 2 * maxlength possible*)
TRANSPUTDIRECTION PROC input :
TRANSPUTDIRECTION : ( in )
ENDPROC input ;
TRANSPUTDIRECTION PROC output :
TRANSPUTDIRECTION : ( outp )
ENDPROC output ;
TRANSPUTDIRECTION PROC modify :
TRANSPUTDIRECTION : ( mod )
ENDPROC modify ;
LET DATEI = ROW 4075 STRUCT (
INT nachfolger, vorgaenger, index, fortsetzung,
TEXT inhalt ) ;
LET anker = 2 ,
freianker = 1 ;
TEXT VAR number word ;
FILE VAR result file ;
DATASPACE VAR scratch space ;
close ;
FILE PROC sequential file (TRANSPUTDIRECTION CONST mode) :
IF CONCR (mode) = outp
THEN close
FI ;
sequential file (mode, scratch space)
ENDPROC sequential file ;
FILE PROC sequential file (TRANSPUTDIRECTION CONST mode,
DATASPACE VAR ds) :
IF type (ds) = 1002
THEN result file.f := ds
ELIF type (ds) < 0
THEN result file.f := ds ;
type (ds, 1002) ;
datei initialisieren (CONCR (result file.f))
ELSE errorstop ("dataspace has wrong type") ;
result file.f := scratch space
FI ;
result file.mode := CONCR (mode) ;
reset (result file) ;
result file.max line length := max line length (result file) ;
result file.max page length := 0 ;
result file .
ENDPROC sequential file ;
FILE PROC sequential file (TRANSPUTDIRECTION CONST mode,
TEXT CONST name ) :
IF exists (name)
THEN get dataspace if file
ELIF CONCR (mode) <> in
THEN get new file space
ELSE errorstop ("input file not existing") ;
result file.f := scratch space
FI ;
IF CONCR (mode) <> in
THEN status (name, "") ;
headline (result file, name)
FI ;
result file.mode := CONCR (mode) ;
reset (result file) ;
result file.max line length := max line length (result file) ;
result file.max page length := 0 ;
result file .
get new file space :
result file.f := new (name) ;
IF NOT is error
THEN type (old (name), 1002) ;
datei initialisieren ( CONCR (result file.f) )
FI .
get dataspace if file :
result file.f := old (name, 1002) .
ENDPROC sequential file ;
INT PROC max line length (FILE CONST file) :
int (subtext (zustand, 16, 20)) .
zustand :
CONCR (file.f) (freianker).inhalt .
ENDPROC max line length ;
PROC max line length (FILE VAR file, INT CONST length) :
replace (zustand, 16, text (length,5)) .
zustand :
CONCR (file.f) (freianker).inhalt .
ENDPROC max line length ;
PROC headline (FILE VAR file, TEXT CONST head) :
CONCR (file.f)(anker).inhalt := head
ENDPROC headline ;
TEXT PROC headline (FILE VAR file) :
CONCR (file.f)(anker).inhalt
ENDPROC headline ;
PROC copy attributes (FILE CONST source, FILE VAR dest) :
dest attributes := source attributes ;
reset edit status (dest) ;
dest headline := source headline .
dest attributes : CONCR (dest.f) (freianker).inhalt .
source attributes : CONCR (source.f) (freianker).inhalt .
dest headline : CONCR (dest.f) (anker).inhalt .
source headline : CONCR (source.f) (anker).inhalt .
ENDPROC copy attributes ;
PROC input (FILE VAR file) :
file.mode := in ;
reset (file)
ENDPROC input ;
PROC output (FILE VAR file) :
file.mode := outp ;
reset (file)
ENDPROC output ;
PROC modify (FILE VAR file) :
file.mode := mod ;
reset (file)
ENDPROC modify ;
PROC putline (FILE VAR file, TEXT CONST record) :
check mode (file, outp) ;
line (file) ;
CONCR (file.f)(file.index).inhalt := record ;
file.pointer := max length
ENDPROC putline ;
PROC getline (FILE VAR file, TEXT VAR record) :
check mode (file, in) ;
line (file) ;
record := CONCR (file.f)(file.index).inhalt ;
file.pointer := max length
ENDPROC getline ;
PROC line (FILE VAR file) :
file.index := CONCR (file.f) (file.index).nachfolger ;
file.pointer := 0 ;
IF file.mode = in
THEN check eof
ELIF file.mode = outp
THEN satz erzeugen (CONCR (file.f), file.index) ;
CONCR (file.f)(file.index).inhalt := "" ;
perhaps implicit page feed
FI .
check eof :
IF eof
THEN file.mode := end
FI .
eof : CONCR (file.f)(file.index).nachfolger = anker .
perhaps implicit page feed :
file.line counter INCR 1 ;
IF file.line counter = file.max page length
THEN page (file)
FI .
ENDPROC line ;
PROC check mode (FILE CONST file, INT CONST mode) :
IF file.mode = mode
THEN LEAVE check mode
ELIF file.mode = closed
THEN errorstop ("file not open")
ELIF file.mode = mod
THEN errorstop ("operation not in transputdirection 'modify'")
ELIF mode = mod
THEN errorstop ("operation only in transputdirection 'modify'")
ELIF file.mode = end
THEN IF eof (file) THEN errorstop ("input after end of file") FI
ELIF mode = in
THEN errorstop ("input access to output file")
ELIF mode = outp
THEN errorstop ("output access to input file")
FI
ENDPROC check mode ;
PROC reset (FILE VAR file) :
file.pointer := max length ;
file.line counter := 0 ;
file.edit status unchanged := TRUE ;
initialize file index ;
set correct file mode .
initialize file index :
IF file.mode = outp
THEN file.index := last record
ELSE file.index := anker
FI .
set correct file mode :
IF file.mode = end
THEN file.mode := in
FI ;
IF file.mode = in AND empty file
THEN file.mode := end
FI .
last record : CONCR (file.f) (anker).vorgaenger .
empty file : CONCR (file.f) (anker).nachfolger = anker .
ENDPROC reset ;
BOOL PROC eof (FILE CONST file) :
IF file.mode = end
THEN end of record
ELIF file.mode = mod
THEN file.index = anker
ELSE FALSE
FI .
end of record :
file.pointer >= length (CONCR (file.f)(file.index).inhalt) .
ENDPROC eof ;
PROC line (FILE VAR file, INT CONST lines) :
check mode (file, outp) ;
INT VAR i ;
FOR i FROM 1 UPTO lines REP
line (file)
PER
ENDPROC line ;
PROC page (FILE VAR file) :
file.line counter := 0 ;
putline (file, "#page")
ENDPROC page ;
BOOL PROC eop (FILE CONST file) :
CONCR (file.f)(file.index).inhalt = "#page"
ENDPROC eop ;
PROC put (FILE VAR file, TEXT CONST word) :
check mode (file, outp) ;
IF file.pointer + LENGTH word >= file.max line length
THEN line (file)
FI ;
put word (CONCR (file.f)(file.index).inhalt, word, file.pointer)
ENDPROC put ;
PROC put word (TEXT VAR record, TEXT CONST word, INT VAR pointer) :
IF pointer > 0
THEN record CAT " " ;
FI ;
record CAT word ;
pointer := LENGTH record
ENDPROC put word ;
PROC put (FILE VAR f, INT CONST value) :
put (f, text (value) )
ENDPROC put ;
PROC put (FILE VAR f, REAL CONST real) :
put (f, text (real) )
ENDPROC put ;
PROC out (FILE VAR file, TEXT CONST word) :
check mode (file, outp) ;
IF file.pointer + LENGTH word >= file.max line length
THEN line (file)
FI ;
record CAT word ;
file.pointer INCR LENGTH word .
record : CONCR (file.f)(file.index).inhalt .
ENDPROC out ;
PROC get (FILE VAR file, TEXT VAR word, TEXT CONST separator) :
check mode (file, in) ;
get word (CONCR (file.f)(file.index).inhalt, word,
file.pointer, max length, separator)
ENDPROC get ;
PROC get (FILE VAR file, TEXT VAR word, INT CONST max length) :
check mode (file, in) ;
get word (CONCR (file.f)(file.index).inhalt, word,
file.pointer, max length, "")
ENDPROC get ;
PROC get (FILE VAR file, TEXT VAR word) :
check mode (file, in) ;
next word (file, CONCR (file.f)(file.index).inhalt, word)
ENDPROC get ;
PROC next word (FILE VAR file, TEXT CONST record, TEXT VAR word) :
get next non blank char ;
IF char found
THEN get word (record, word, file.pointer, max length, " ")
ELIF last line of file
THEN word := "" ;
file.pointer := max length
ELSE line (file) ;
get (file, word)
FI .
get next non blank char :
TEXT VAR char ;
REP
file.pointer INCR 1 ;
char := record SUB file.pointer
UNTIL char <> " " PER ;
file.pointer DECR 1 .
char found : char <> "" .
last line of file :
CONCR (file.f) (anker).nachfolger = anker .
ENDPROC next word ;
PROC get (FILE VAR f, INT VAR number) :
get (f, number word) ;
number := int (number word)
ENDPROC get ;
PROC get (FILE VAR f, REAL VAR number) :
get (f, number word) ;
number := real (number word)
ENDPROC get ;
PROC get word (TEXT CONST record, TEXT VAR word, INT VAR pointer,
INT CONST max length, TEXT CONST separator) :
INT VAR end of word := pos (record, separator, pointer+1) - 1 ;
IF end of word < 0
THEN end of word := pointer + max length
FI ;
word := subtext (record, pointer+1, end of word) ;
pointer := end of word + 1
ENDPROC get word ;
PROC close (FILE VAR file) :
file.mode := closed
ENDPROC close ;
PROC close :
disable stop ;
forget (scratch space) ;
scratch space := nilspace
ENDPROC close ;
INT PROC max page length (FILE CONST file) :
file.max page length
ENDPROC max page length ;
PROC max page length (FILE VAR file, INT CONST length) :
file.max page length := length
ENDPROC max page length
PROC read record (FILE CONST file, TEXT VAR record) :
check mode (file, mod) ;
record := CONCR (file.f) (file.index).inhalt
ENDPROC read record ;
PROC write record (FILE VAR file, TEXT CONST record) :
check mode (file, mod) ;
CONCR (file.f) (file.index).inhalt := record
ENDPROC write record ;
PROC forward (FILE VAR file) :
check mode (file, mod) ;
IF file.index <> anker
THEN file.index := CONCR (file.f) (file.index).nachfolger
ELSE errorstop ("forward at eof")
FI
ENDPROC forward ;
PROC backward (FILE VAR file) :
check mode (file, mod) ;
file.index := CONCR (file.f) (file.index).vorgaenger ;
IF file.index = anker
THEN to first record (file) ;
errorstop ("backward at first record")
FI
ENDPROC backward ;
PROC delete record (FILE VAR file) :
check mode (file, mod) ;
IF file.edit status unchanged
THEN reset edit status (file)
FI ;
satz loeschen (CONCR (file.f), file.index)
ENDPROC delete record ;
PROC insert record (FILE VAR file) :
check mode (file, mod) ;
IF file.edit status unchanged
THEN reset edit status (file)
FI ;
satz erzeugen (CONCR (file.f), file.index)
ENDPROC insert record ;
PROC to first record (FILE VAR file) :
check mode (file, mod) ;
file.index := CONCR (file.f) (anker).nachfolger
ENDPROC to first record ;
PROC to eof (FILE VAR file) :
check mode (file, mod) ;
file.index := anker
ENDPROC to eof ;
BOOL PROC is first record (FILE CONST file) :
file.index = CONCR (file.f) (anker).nachfolger
ENDPROC is first record ;
PROC reset edit status (FILE VAR file) :
replace (zustand, 1, nullzustand) ;
file.edit status unchanged := FALSE .
zustand : CONCR (file.f)(freianker).inhalt .
ENDPROC reset edit status ;
FILE VAR scratch , file ;
TEXT VAR record ;
LET esc = ""27"" ;
PROC reorganize (TEXT CONST file name) :
IF exists (file name)
THEN last param (file name) ;
reorganize file
ELSE errorstop ("file does not exist")
FI .
reorganize file :
scratch := sequential file (output) ;
headline (scratch, file name) ;
IF format 15
THEN set to 16 file type ;
file := sequential file (input, file name)
ELSE file := sequential file (input, file name) ;
copy attributes (file, scratch)
FI ;
disable stop ;
INT VAR counter := 0 ;
WHILE NOT eof (file) REP
getline (file, record) ;
putline (scratch, record) ;
counter INCR 1 ;
cout (counter) ;
IF is incharety (escape) OR is error
THEN close ;
LEAVE reorganize
FI
PER ;
forget file ;
copy (scratch space, file name) ;
close .
forget file :
BOOL CONST old status := command dialogue ;
command dialogue (FALSE) ;
forget (file name) ;
command dialogue (old status) .
format 15 : type (old (file name)) = 1001 .
set to 16 file type :
type (old (file name), 1002) .
ENDPROC reorganize ;
PROC reorganize :
reorganize (last param)
ENDPROC reorganize ;
PROC feldout (FILE CONST file, TEXT CONST satz) :
feldout ( CONCR (file.f) (file.index).inhalt )
ENDPROC feldout ;
PROC feldeinruecken (FILE CONST file, TEXT CONST satz) :
feldeinruecken ( CONCR (file.f) (file.index).inhalt )
ENDPROC feldeinruecken ;
PROC feldeditor (FILE VAR file, TEXT CONST satz) :
feldeditor ( CONCR (file.f) (file.index).inhalt )
ENDPROC feldeditor ;
INT PROC pos (FILE CONST file, TEXT CONST pattern, INT CONST from) :
pos ( CONCR (file.f) (file.index).inhalt, pattern, from )
ENDPROC pos ;
PROC change (FILE VAR file, INT CONST from, to, TEXT CONST new) :
change ( CONCR (file.f) (file.index).inhalt, from, to, new )
ENDPROC change ;
TEXT PROC subtext (FILE CONST file, INT CONST from) :
record := subtext ( CONCR (file.f) (file.index).inhalt, from ) ;
record
ENDPROC subtext ;
TEXT PROC subtext (FILE CONST file, INT CONST from, to) :
record := subtext ( CONCR (file.f) (file.index).inhalt, from, to ) ;
record
ENDPROC subtext ;
(* sortieren sequentieller Dateien Autor: P.Heyderhoff *)
(* Stand: 14.11.80 *)
BOUND DATEI VAR datei;
INT VAR sortierstelle, sortanker, byte;
TEXT VAR median, tausch ;
PROC sort (TEXT CONST dateiname) :
sortierstelle := feldanfang; sort (dateiname, "")
END PROC sort;
PROC sort (TEXT CONST dateiname, INT CONST sortieranfang) :
sortierstelle := sortieranfang; sort (dateiname, "")
END PROC sort;
PROC sort (TEXT CONST dateiname, feldname) :
IF exists (dateiname)
THEN datei := old (dateiname);
IF CONCR(datei) (freianker).nachfolger <> freianker
THEN reorganize (dateiname)
FI ;
sortanker := 3;
IF feldname = ""
THEN byte := 0
ELSE feldname in feldnummer uebersetzen
FI;
quicksort(sortanker, CONCR(datei)(freianker).fortsetzung-1)
FI .
feldname in feldnummer uebersetzen :
byte := pos (CONCR(datei) (sortanker).inhalt, feldname);
IF byte > 0
THEN byte := pos (CONCR(datei) (sortanker).inhalt, code(255-byte))
FI;
IF byte = 0
THEN errorstop ("sort: feldname"); LEAVE sort
FI ; sortanker INCR 1 .
END PROC sort;
PROC quicksort ( INT CONST anfang, ende ) :
IF anfang < ende
THEN INT VAR p,q;
spalte (anfang, ende, p, q);
quicksort (anfang, q);
quicksort (p, ende) FI
END PROC quicksort;
PROC spalte (INT CONST anfang, ende, INT VAR p, q):
fange an der seite an und waehle den median;
ruecke p und q so dicht wie moeglich zusammen;
hole ggf median in die mitte .
fange an der seite an und waehle den median :
p := anfang; q := ende ;
INT CONST m :: (p + q) DIV 2 ;
median := subtext(datei m, merkmal m) .
ruecke p und q so dicht wie moeglich zusammen :
REP schiebe p und q so weit wie moeglich auf bzw ab;
IF p < q THEN vertausche die beiden FI
UNTIL p > q END REP .
vertausche die beiden :
tausch := datei p; datei p := datei q; datei q := tausch;
p INCR 1; q DECR 1 .
schiebe p und q so weit wie moeglich auf bzw ab :
WHILE p kann groesser werden REP p INCR 1 END REP;
WHILE q kann kleiner werden REP q DECR 1 END REP .
p kann groesser werden :
IF p <= ende THEN subtext (datei p, merkmal p) <= median ELSE FALSE FI .
q kann kleiner werden :
IF q >= anfang THEN subtext(datei q,merkmal q) >= median ELSE FALSE FI .
hole ggf median in die mitte :
IF m < q THEN vertausche m und q
ELIF m > p THEN vertausche m und p FI .
vertausche m und q :
tausch := datei m; datei m := datei q; datei q := tausch; q DECR 1 .
vertausche m und p :
tausch := datei m; datei m := datei p; datei p := tausch; p INCR 1 .
merkmal m :
IF byte = 0 THEN sortierstelle ELSE 255 - code (datei m SUB byte) FI .
merkmal p :
IF byte = 0 THEN sortierstelle ELSE 255 - code (datei p SUB byte) FI .
merkmal q :
IF byte = 0 THEN sortierstelle ELSE 255 - code (datei q SUB byte) FI .
datei m : CONCR(datei)(m).inhalt .
datei p : CONCR(datei)(p).inhalt .
datei q : CONCR(datei)(q).inhalt .
END PROC spalte;
(*********** schrott ************)
OP := (FILE VAR a, FILE CONST b) :
EXTERNAL 294
ENDOP := ;
PROC becomes (ROW 8 INT VAR a, b) :
INTERNAL 294 ;
a := b
ENDPROC becomes ;
PROC datei initialisieren (DATEI VAR datei) :
EXTERNAL 290 ;
END PROC datei initialisieren;
PROC satz erzeugen (DATEI VAR datei, INT VAR satz):
EXTERNAL 291;
END PROC satz erzeugen;
PROC satz loeschen (DATEI VAR datei, INT VAR satz):
EXTERNAL 292 ;
END PROC satz loeschen;
ENDPACKET file ;