From 98cab31fc3659e33aef260efca55bf9f1753164c Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 11 Feb 2019 11:49:19 +0100 Subject: Add source files from Michael --- system/base/unknown/src/file | 810 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 810 insertions(+) create mode 100644 system/base/unknown/src/file (limited to 'system/base/unknown/src/file') diff --git a/system/base/unknown/src/file b/system/base/unknown/src/file new file mode 100644 index 0000000..e556bec --- /dev/null +++ b/system/base/unknown/src/file @@ -0,0 +1,810 @@ + +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 ; -- cgit v1.2.3