Quellcode V1.8.0 Single User 10 11 86
Quellcode-V1.8.0-SingleUser-10-11-86 Quellcode-V1.8.0-SingleUser-10-11-86
User Manual: Quellcode-V1.8.0-SingleUser-10-11-86
Open the PDF directly: View PDF 
.
Page Count: 356
| Download | |
| Open PDF In Browser | View PDF |
Quellcode
der insertierten ELAN - Pakete
Version:
Teil:
Stand:
1.8.0
Single - User
10.11.86
©1986
Selbstverlag GMD
Aile Rechte vorbehalten.
Insbesondere ist die UberfOhrung in maschinenlesbare
Form, sowie das Speichern in Informationssystemen, auch
auszugsweise, nur mit schriftlicher Genehmigung dar
GMD gestattet.
Herausgeber:
Gesellschaft fOr Mathematik und Datenverarbeitung mbH
Postfach 1240, Schl08 Birlinghoven
0- 5205 Sankt Augustin 1
Telefon(02241) 14-1, Telex 8 89 469 gmd d
Telefax(02241) 142889, BTX *43900#
Teletex 2627 - 224135 = GMDW
Texterstellung:
Dieser Text wurda mit dar EUMEL - Textverarbeitung erstellt und aufbereitet und
mit dem Agfa Laserdrucksystem P400 gedruckt.
Umschlaggestaltung:
Hannelotte Weeken
Hinweis:
Diese Dokumentation wurde mit gr6Btm6glicher Sorgfalt erstellt. Dennoch wird
fUr die Korrektheit und Vo/lstllndigkeit der gemachten Angaben keine GewiJhr
Obernommen. Bei vermuteten Fehlern der Software oder der Dokumentation
bitten wir um beldige Meldung, damit eine Korrektur m6glichst Tasch erfolgen
kann. Anregungen und Kritik sind jederzeit willkommen.
Inhaltsverzeichnis
1.
2.
3.
4.
Ubersicht Dber die insertierten Pakete
Ubersicht Door die exportierten Objekte nach Paketen geordnet
Ubersicht Dber die exportierten Objekte alphabetisch geordnet
Quellcode der insertierten Pakete
1. Obersicht Ober die insertierten Pakete
'(M)'
'(S)'
'(T)'
vor der Paketnummer heiBt, daB dies Objekt nur im Multi - User vorhanden ist.
vor der Paketnummer heiBt, daB dies Objekt nur im Single - User vorhanden ist.
vor der Paketnummer heiBt, daB dies Objekt nur in einem System mit Textverarbeitung vorhanden ist.
Die Paketnummer ergibt sich aus der Reihenfolge, in der die Pakete im Multi - User mit
Textverarbeitung insertiert wurden. Bitte beachten Sie, daB diese Reihenfolge nicht dar
Insertierungsreihenfolge im Single - User entspricht. Dar Quellcode dar insertierten Pakete
ist in Teil 4 nach Paketnummern sortiert.
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
S29.
S30.
S31.
48.
849.
39.
a
bits
tex1
pcb and init control
dataspace
basic transput
bool
integer
error handling
real
date handling
command dialogue
thesaurus handling
local manager
pattern match
file handling
elan do interface
scanner
screen description
tasten verwaltung
editor paket
editor functions
std transput
local manager part 2
eurnel coder part 1
mathlib
command handler
advertising
tasks single
font store
basic archive
archive single
narneset
840.
52.
S53.
543.
system info
konfigurieren
configurator single
single user monitor
44. sysgen off
545. ur startlS
2, Obersicht aber die exportierten Objekte nach Paketen geordnet:
'(M)'
'(S)'
'(T)'
vor der Paketnummer heiBt, daB dies Objekt nur im Multi - User vorhanden is!.
vor der Paketnummer heiBt, daB dies Objekt nur im Single - User vorhanden is!.
vor dar Paketnummer heiBt, daB dies Objekt nur in einem System mit Textverarbeitung vorhanden is!.
Die Paketnummer ergibt sich aus der Reihenfolge, in der die Pakete im Multi - User mit
Textv9rarbeitung insertiert wurden. Bitte beachten Sie, daB diese Reihentolge nicht der
Insertierungsreihenfolge im Single - Usar antspricht. Dar Quallcoda dar insertiertan Pakata
ist in Teil 4 nach Paketnummern sortiert.
PACKET a:
PACKET bits:
PROC rotate <: INT VAR bits, INT CONST number of bi t8 J
INT OP AND (INT CONST left, right)
INT OP OR I. INT CONST left, right)
INT OP XOR (INT CONST left, rlght)
oool PROC bi t (INT CONST bi ts, bi t no)
PROC set bit (INT VAR bits, INT CONS: blt nol
PROC reset blt (INT VAR bits, INT CONST bit no)
INT PROC 10lolest set (INT CONST bits)
INT PROC 10lolest reset (INT CONST bits)
2-19
2-23
2-27
2-31
2-35
2-41
2-47
2-53
2-65
PACKET text:
INT CONST max text length
TEXT OP SUB (TEXT CONST text, INT CONST pas 1
TEXT PROC subtext (TEXT CONST source, INT CONST from, to)
TEXT PROC subtext (TEXT CONST source, IN! CONST from)
INT PROC code (TEXT CONST text)
TEXT PROC code (IN! CONST code)
INT OP ISUB (TEXT CONST text, IN! CONST index)
PROC replace (TEXT VAR text, INT CONST index, value)
REAl OP RSUB (TEXT CONST text, IN! CONST index)
PROC replace (TEXT VAR text, IN! CONST index, REAL CONST code)
PROC replace (TEXT VAR dest, IN! CONST pas, ~XT CONST source)
TEXT PROC text (TEXT CONST source, INT CONST length)
TEXT PROC text (TEXT CONST source, HIT CONST length, from)
OP CAT (TEXT VAR right, TEXT CONST left)
TEXT OP + (TEXT CONST left, right)
TEXT OP • (INT CONST times, TEXT CONST source)
INT PROC length (TEXT CONST text)
IN! OP lENGTH (TEXT CONST text)
IN! PROC pas (TEXT CONST source, pattern)
IN! PROC pas (TEXT CONST source, pattern, IN! CONST from)
IN! PROC pes (TEXT CONST source, pattern, IN! CONST from, to)
IN! PROC pos (TEXT CONST source, 10101, high, INT CONST from)
3-35
3-37
3-41
3-45
3-49
3-53
3-57
3-61
3-65
3-69
3-74
3-78
3-95
3-99
3-103
3-109
3-120
3-124
3-128
3-1:12
3-136
3-140
TEXT PROC compress (TEXT CONST text)
PROC change ITEZT VAR destination, INT CONST from, to, TEXT CONST ne.,,)
FROC change (TEXT VAR destination, TEXT eONST old, ne.,,)
PRoe delete char \ TEXT VAR string, HIT CONST delete pas)
PROC insert char (TEXT VAR strir.g, TEXT eONST char, INT CONST lnsert pas)
INT PROC heap size
PROe collect heap garbage
PROC stranalyze (ROW 256 INT CONST table, INT VAR sum, INT CONST max sum,
TEXT CONST string, INT VAR index, INT eONST to,
INT VAR exi t code)
BOO1 OP 1EXEQUAL (TEXT CONST left, right)
BOO1 OP 1EXGREATER (TEXT CONST left, right)
BOO1 OP 1EXGREATEREQUA1 (TEXT CONST left, right)
OP CAT (TEXT VAR result, INT CONST number i
PROC insert int (TEXT VAR result, IN! CONST insert pas, number)
PROC delete int (TEXT VAR result, INT CONST delete pas)
3-144
3-167
3-183
3-214
3-224
3-236
3-240
3-244
3-262
3-269
3-276
3-374
3-379
3-385
PACKET pcb and init control:
TYFE INITrLAG
INT FROC session·
IN! PROC pcb (INT CONST field)
FROC set line nr (INT CONST value)
OP : = (INITrLAG VAR t'l~, BOOL CONST n~true)
B001 PROC initialized \ INITrLAG VAR flae;)
REAL PROC clock (INT CONST nr)
PROC stor~e (INT VAR size, used)
INT pROC id \ INT CONST no)
FROC ke
4-19
4-22
4-26
4-34
4-39
4-50
4-62
4-66
4-70
4-74
PACKET dataspace :
TYPE ALIGN
OP :. (DATASPACE VAR dest, DATASPACE CONST source)
DATASPACE PROC ni1space
PROC forget (DATASPACE CONST da taspace )
PROC type \ DATASPACE CONST ds, IN! CONST type)
INT PROC type (DATASPACE CONST ds)
INT FROC heap size (DATASPACE CONST ds)
IN! PROC stor~e (DATASPACE CONST is)
IN! PROC ds pages !. DATASPACE CONST ds)
IlIT FROC next ds page (DATASPACE CONST ds, IN! CONST page nr)
PROC blackout (DATASPACE CONST ds, IN! CONST page nr, codel, code2,
IN! VAR return code)
PROC b10ckin (DATASPACE VAR ds, IN! CONST page nr, codel, code2,
IN! VAR return code)
5-21
5-23
5-27
5-31
5-35
5-39
5-43
5-47
5-51
5-59
5-63
5-68
PACKET basic transput :
PROC out (TEXT CONST te>:t I
PROC outsubtext (TEXT CONST source, IN! CONST from)
PROC outsubtext (TEXT CONST source, IN! CONST from, to)
PROC outtext (TEXT CONST source, INT CONST from, to)
OP TIMESOUT (IN! CONST times, TEXT CONST text)
PROC display (TEXT CONST text)
FROC inchar (TEXT VAR character)
TEXT PROC incharety
exportlerte Ob,jekte nach Paketen geordnet
6-35
6-39
6-43
6-47
6-59
6-81
6-87
6-91
TEXT PROC incharety (INT CONST time limi t)
PROe pause r INT CONST time lilt1 t)
PROC pause
PROe cat input rTEXT VAR t, esc char)
PROe cursor (INT eONST '" y)
PROe set cursor lINT VAR x, y)
PROe cout (INT CONST nun:ber)
INT PROC channe 1
BOOL PROC online
PROe control (INT CONST codel, code2, code3, INT VAR return codel
PRoe blockout (ROW 256 INT CONST block, INT CONST codel, code2,
INT VAR return code)
PROC blockin (ROW 256 INT VAR block, INT eONST codel, code2,
INT VAR return codel
6-95
6-100
6-105
6-113
6-118
6-124
6-128
6-133
6-137
6-142
6-146
6-161
PACKET bool :
BOOL CONST "true
BOOL CONST false
BOOr. OP XOR (BOOL CONST left, risht)
7-4
7-4
7-7
PACKET integer :
INT PROC minint
INT PROC maxi nt
TEXT PROC text (INT CONST number)
TEXT PROC text (INT CONST number, lensth)
INT PROe int (TEXT CONST number)
INT OP MOIl (INT CONST left, r1ght)
INT PROC slgn (INT CaNST argument I
INT OP SIGN (INT CaNST argument)
INT PROC abs (INT CONST argument)
HIT OP ABS (INT CONST argument)
INT OP ... (INT CONST arg, exp I
INT PRce m1n (nn CaNST first, second)
INT PROC max (INT CaNST first, second)
BOOL PROC last conversion ok
PROC set conversion (BOOL CONST success)
PROC initialize random (INT CONST start)
INT PROC random (INT CONST lower bound, upper bound)
8-7
8-9
8-12
8-25
8-38
8-95
8-101
8-110
8-114
8-122
8-126
8-154
8-160
8-170
8-174
8-197
8-208
PACKET error handling:
PROC enable stop
PROC disable stop
BOOL PROC is error
PROC clear error
:SXT PROC error message
INT PROC error code
INT PROC error l i ns
PROC errors top (TEXT CONST message)
PROe errors top (INT CONST code, TEXT CONST message)
PROC put error
PROC stop
9-28
9-32
9-40
9-44
9-72
9-79
9-<30
9-101
9-107
9-116
9-135
PACKET real :
REAL FROC max real
REAL FROC small real
INT FROC decimal exponent (REAL CONST mantissal
FROC set exp (INT CONST exponent, REAL VAR number)
REAL FROC floor (REAL CONST real)
REAL FROC round (REAL CONST real, INT CONST digi ts )
TEXT FROC text (REAL CONST real)
TEXT FROC text (REAL CONST real, INT CONST length)
T~XT PROC text (REAL CONST real, INT CONST length, fracs)
REAL FROC real (TEXT CONST text)
REAL FROC abs (REAL CONST value)
REAL OF ABS (REAL CONST value I
INT FROC Slgn (REAL CONST yalue)
INT OF SIGN : REAL CONST value)
REAL OF I«lD (REAL CONST left, right)
REAL PROC frac (REAL CONST value)
REAL FROC max (REAL CONST a, b)
REAL FROC min (REAL CONST a, b)
OF INCR (REAL VAR dest, REAL CONST increment I
OF DECR (REAL VAR dest, REAL CONST decrement I
INT FROC int (REAL CONST valuel
REAL FROC real (INT CONST value I
10-40
10-42
10-48
10-~2
10-62
10-66
10-88
10-1~5
10-199
10-24:3
10-:329
10-:3:38
10-:344
10-~:3
10-:359
10-:369
10-:375
10-:381
10-:387
10-:39:3
10-:399
10-424
PACKET date handling :
REAL
REAL
REAL
REAL
TEXT
TEXT
TEXT
TEXT
TEXT
TEXT
TEXT
TEXT
TEXT
REAL
REAL
REAL
PROC day
PROC hour
PROC mi nu te
PROC second
PROC date
PROC date (REAL CONST datum)
PROC day (REAL CONST datum)
PROC month (REAL CONST datuml
PROC year (REAL CONST datum)
PROC time of day
PROC time of day (REAL CONST value I
PROC time (REAL CONST value)
PROC time (REAL CONST value, INT CONST length)
PROC date (TEXT CONST datum)
PROC time (TEXT CONST time)
CONST hour
11-28
11-29
11-:30
11-:31
11-:3:3
11-44
11-128
11-1:39
11-156
11-166
11-170
11-174
11-178
11-201
11-260
11-265
PACKET command dialogue :
TYPE QUIET
QUIET PROC quiet
BOOL
PROC
BOOL
BOOL
PROC
PROC
TEXT
PROC
TEXT
PROC command dialogue
cOlllll&lld dialogue (BOOL CONST status)
PROC yes (TEXT CONST question)
PROC no (TEXT CONST question)
say (TEXT CONST message)
param position (INT CONST x)
PROC last param
last param (TEXT CONST new)
PROC std
12-29
12-:31
12-:38
12-40
12-45
12-81
12-87
12-95
12-181
12-114
12-118
PACKET thesaurus handling:
TYPE THESAURUS
YdESAURUS PROC empty thesaurus
OP :. (THESAURUS VAH dest, THESAURUS CONST source)
PROC insert (TIlESAURUS VAH thesaurus, TEXT CONST name, INT VAH indeK)
PROC insert (THESAURUS VAH thesaurus, TEXT CONST name)
PROC delete (THESAURUS VAH thesaurus, TEXT CONST name, INT VAH indeK)
PROC delete (TIlESAURUS VAH thesaurus, INT CONST indeK)
BOOL OP CONTAINS (THESAURUS CONST thesaurus, TEXT CONST name)
PROC rename (THESAURUS VAH thesaurus, TEXT CONST old, new)
PROC rename (THESAURUS VAH thesaurus, INT CONST index, TEXT CONST new)
INT PROC link (THESAURUS CONST thesaurus, TEXT CONST name)
TEXT PROC name (THESAURUS CONST thesaurus, INT CONST index)
PROC get (THESAURUS CONST thesaurus, TEXT VAH name, INT VAH index)
INT PROC highest entry (THESAURUS CONST thesaurus)
13-17
13-96
13-103
13-111
13-170
13-180
13-188
13-231
13-242
13-248
13-267
13-274
13-281
13-323
PACKET local manager:
PROC create (TEXT CONST name)
DATASPACE PROC new (TEXT CONST name)
DATASl'ACE PROC old (TEXT CONST name)
DATASPACE PROC old (TEXT CONST name, INT CONST expected type)
BOOL PROC exists (TEXT CONST name)
PROC forget (TEXT CONST name)
PROC forget (TEXT CONST name, QUIET CONST q)
PROC forget
PROC status (TEXT CONST name, status teKt)
TEXT PROC status (TEXT CONST name)
PROC stetus (INT CONST pas, TEXT CONST status pattern)
PROC copy (DATASPACE CONST source, TEXT CONST dest name)
PROC copy (TEXT CONST source name, dest name)
PROC rename (TEXT CONST old name, new name)
PROC begin list
PROC get list entry (TEXT VAH entry, status text)
TEXT PROC write password
TEXT PROC read password
PROC enter password (TEXT CONST password)
PROC enter password (TEXT CONST fUe name, write pass, read pass)
BOOL PROC read permisslon (TEXT CONST name, supply password)
BOOL PROC write permission (TEXT CONST name, supply password)
THESAURUS PROC all
14-61
14-86
14-96
14-110
14-127
14-13414-145
14-157
14-166
14-176
14-187
14-200
14-218
14-224
14-237
14-24414-257
14-263
14-270
14-28414-312
14-335
14-358
PACKET pattern match:
TEXT OP - (TEXT CONST alphabet)
TEXT OP OR (TEXT CONST a, b)
TEXT OP - (TEXT CONST p, INT CONST x)
TEXT CONST any
TEXT PROC any (INT CONST n)
TEXT PROC any (TEXT CONST a)
TEXT PROC any (INT CONST n, TEXT CONST a)
TEXT PROC notion (TEXT CONST t)
TEXT CONST bound
TEXT PROC match (INT CONST xl
INT PROC matchpo s (INT CONST x)
INT PROC matchend (INT CONST x)
15-43
15-54
15-58
15-62
15-54
15-78
15-72
15-78
15-87
15-91
15-95
15-97
TEXT
8001
8001
TEXT
PROC somefix (TEXT GONST pattern)
OP UNLIKE (TEXT CONST t, p)
OP lIKE (TEXT CONST t, pattern I
PROG notion (TEXT CONST t, INT CONST rl
15-123
15-191
15-193
15-765
PACKET file handling:
TYPE FILE
TYPE l'RANGE
OP :. (rILE VAH left, rILE CONST right)
TEXT PROG prefix (TEXT CONST pattern)
8001 PROG pattern found
TRANSPL~IRECTION PROG input
TRANSPUTDIRECTION PROG output
TRANSPUTDIRECTION PROG modify
FILE PROC sequential file (TRANSPUTDIRECTION CONST mode,
DATASPAGE GONST ds)
rILE PROG sequential file (TRANSPUTDIRECTION GONST mode, TEXT CONST name)
PROG reset (FILE VAH f)
PROG reset (FILE VAH f, TRANSPUTDIRECTION CONST mode)
PROG input (FILE VAH fl
PROG output (rILE VAH fl
PROG modify (rILE VAH f)
PROG close (FILE VAH fl
PROG to line (FILE VAH f, INT CONST destination line I
PROG to first record (FILE VAH f)
PROG to eof (FILE VAH fl
PROG putline (FILE VAH f, TEXT CONST word)
PROG delete record (rILE VAH f I
PROC insert record (rILE VAH f)
PROG down (FILE VAH fl
PROC up (FILE VAH f)
PROC down (rILE VAH f, INT CONST n I
PROG up (rILE VAH f, INT CONST n)
PROC write record (rILE VAH f, TEXT CONST record)
PROC read record (rILE CONST f, TEXT VAH record)
PROG line (rILE VAH f)
PROC line (rILE VAH f, INT CONST lines)
PROG getHne (FILE VAH f, TEXT VAH textl
8001 moe is first record (FILE CONST fl
8001 PROC eof (rILE CONST f)
INT moe line no (FILE CONST fl
PROC line type (FILE VAH f, INT CONST t)
INT moe line type (FILE CONST f)
PROC put (rILE VAH f, TEXT CONST word)
PROC put (rILE VAH f, INT CONST value)
PROC put (FILE VAH f, REAL CONST real)
PROC write (rILE VAH f, TEXT CONST word)
PROC get (FILE VAH f, TEXT VAH word, TEXT CONST separator)
moe get (FILE VAH r, TEXT VAH word, INT CONST max lel18th)
PROC get (rILE VAH r, TEXT VAH word)
moe get (FILE VAH r, INT VAH number)
PROC get (rILE VAH r, REAL VAH number)
PROC split line (rILE VAH r, INT CONST split col)
PROC split line (rILE VIJI r, INT CONST spli t col,
8001 CONST note indentation I
PROC concatenate line (FILE VAH r, 8001 CONST delete blanks)
moe set ral18e (FILE VAH r, INT CONST start. line, start col,
mANGE VAH old ral18e)
16-150
16-152
16-160
16-546
16-574
16-851
16-856
16-861
16-869
16-B85
:6-926
16-935
16-962
16-969
16-976
16-983
16-1023
16-1031
16-1038
16-1045
16-1055
16-1063
16-1071
16-1078
16-1085
16-1091
16-1098
16-1111
16-1119
16-1145
16-1152
16-1174
16-1182
16-1197
16-1204
16-1210
16-1217
16-1236
16-1243
16-1250
16-1268
16-1312
16-1336
16-1346
16-13M
16-1365
16-1371
16-1407
16-1550
FROG set range (FILE VAR f, mANGE VAR nell range)
FROC reset range (rILE VAR f)
FROC remove (rILE VAR f, INT CONST size)
FROC clear removed (rILE VAR f)
FROG reinsert (rILE VAR f)
FROC copy attributes (rILE CONST source file, FILE VAR dest file)
INT FROC max line length (FILE CONST f)
FROC max line length (FILE VAR f, INT CONST nell limit)
TEXT FROC headline (FILE CONST t)
FROC headline (rILE VAR f, TEXT CONST head)
FROC get tabs (FILE CONST f, TEXT VAR tabs)
FROC put tabs (FILE VAR f, TEXT CONST tabs)
INT FROC edit info (FILE CONST f)
FROC edi t info (FILE VAR f, INT CONST info)
INT FROC lines (rILE CONST f)
INT FROC removed lines (rILE CONST f)
INT FROC segments (FILE CONST f)
INT FROC col (FILE CONST f)
FROC col (FILE VAR f, INT CONST nell column)
TEXT FROC word (FILE CONST f)
TEXT PROC liard (rILE CONST f, TEXT CONST delimiter)
TEXT FROC liard (rILE CONST f, INT CONST max length)
BOOL PROC at (FILE CONST f, TEXT CONST word I
PROe exec (PROC (TEXT VAR, TEXT CONST) proc, FILE VAR f, TEXT CONST t)
FROe exec (PROC (TEXT VAR, INT CONST) proc, FILE VAR f, INT CONST i)
INT FROC pos (rILE CONST f, TEXT CONST pattern, INT CONST 1)
PROC dOlln (FILE VAR f, TEXT CONST pattern)
FROC dOlln (FILE VAR f, TEXT CONST pattern, INT CONST max line I
PROC dOllnety (FILE VAR f, TEXT CONST pattern)
PROC dOllnety (FILE VAR f, TEXT CONST pattern, INT CONST max linel
PROC up (rILE VAR f, TEA"! CONST pattern)
PROC up (FILE VAR f, TEXT CONST pattern, HIT CONST max line)
FROC uppety (FILE VAR f, TEXT CONST pattern)
FROC uppety (FILE VAR f, TEXT CONST pattern, INT CONST max line)
INT FROC len (rILE CONST f)
TEXT PROC subtext (FILE CONST f, INT CONST from, to)
FROC change (FILE VAR f, INT CONST from, to, TEXT CONST new I
BOOL FROC mark (FILE CONST f)
FROC mark (FILE VAR f, INT CONST line no, col)
INT FROC mark line no (FILE CONST f)
INT FROC mark col (FILE CONST f)
FROC set marked range (rILE VAR f, l'RANGE VAR old range)
FROC sort (TEXT CONST dateinamel
FROC sort (TEXT CONST dateiname, INT CONST sortier&nfang)
FROC lex sort (TEXT CONST date1name)
FROC lex sort (TEXT CONST dateiname, INT CONST sortieranfang)
16-1620
16-1668
16-1679
16-1687
16-1695
16-1703
16-1716
16-1723
16-1732
16-1739
16-1746
16-1753
16-1760
16-1767
16-1774
16-1781
16-1788
16-1795
16-1801
16-1809
16-1815
16-1825
16-1831
16-1844
16-1853
16-1861
16-1869
16-1875
16-1884
16-1890
16-1899
16-1905
16-1914
16-1920
16-19~
16-1938
16-1946
16-1956
16-1962
16-1973
16-1982
16-1993
16-2016
16-2020
16-2025
16-2029
PACKET elan do interface :
PROC do (TEXT CONST COlIIIII&nd)
FROC no do again
17-23
17-44
PACKET scanner:
PROC
PROC
FROC
PROC
scan (TEXT CONST sCan text)
continue scan (TEXT CONST scan text)
next symbol (TEXT VAR symbol)
next symbol (TEXT VAR symbol, INT VAR type)
18-36
18-44
18-52
18-59
FROC scan (FILE VAR fl
FROC next symbol (FILE VAR f, TEXT VAR symbol)
FROC next symbol (FILE VAR f, TEXT VAR symbol, INT VAR type)
18-296
18-303
18-312
PACKET screen description :
INT FROC xsize
INT FROC ysize
INT FROG marksize
FROC xsize (INT CONST i I
FROG ysize (INT CONST i I
FROG markslze (INT CONST 1)
BOOL FROC mark refresh line mode
FROG mark refresh line mode (BOOL CONST bl
19-9
19-11
19-13
19-15
19-17
19-19
19-24
19-28
PACKET tasten verwaltung :
FROG
TEXT
FROC
TEXT
BOOL
FROC
lernsequenz auf taste legen (TEXT CONST taste, lernsequenz)
FROC lernsequenz auf taste (TEXT CONST taste I
kommando auf taste legen (TEXT CONST taste, kommando I
FROC kommando auf taste (TEXT CONST taste)
FROC taste enthaelt kommando (TEXT CONST taste)
std tastenbelegung
20-27
20-63
20-71
20-79
20--87
20-92
PACKET editor peket :
FROC edi tget command (BOOL CONST schal ter I
FROC editget {TEXT VAR editsatz, INT CONST editlimit, editlaenge,
TEXT CONST sep, res, TEXT VAR exit chari
FROC editget (TEXT VAR ed1tsatz, INT CONST ed1tlimit, TEXT VAR ex1t char)
FROC ed1tget (TEXT VAR ed1tsatz, TEXT CONST sep, res, TEXT VAR exit char)
PROC editget (TEXT VAR ed1tsatz)
PROC edltget (TEXT VAR editsatz, INT CONST edltl1mit, editlaenge)
BOOL PROC is edi tget
PROC get editllne (TEXT VAR editllne, INT VAR ed1tpos, edltmarke)
FROG put editline (TEXT CONST editline, INT CONST editpos, editmarke)
BOOL PROC lIithin kanji (TEXT CONST satz, INT CONST stellel
BOOL PROC is kanji esc (TEXT CONST char)
BOOL PROC tllO bytes
PROC tllO bytes (BOOL CONST nell mode)
BOOL PROC \/rite permission
PROC push (TEXT OONST austuehrkollllll&lldo)
PROC type (TEXT OONST austuehrkollllll&!ldo)
PROC getchar (TEXT VAR zeichenl
BOOL PROC is incharety (TEXT CONST muster)
TEXT PROC getcharety
PROC get editcursor (INT VAR x, y)
INT PROC aktueller editor
INT PROC groesster editor
PROC quit last
PROC quit
INT CONST aktueller editor
PROC n1chts neu
PROC satznr neu
PROC ueberschrift neu
PROC ze1le neu
PROC abschnltt nau (INT OONST von satznr, bis satznr)
exportlerte ObJekf,e na.ch Paketen geordnet
21--81
21-87
21-192
21-196
21-200
21-205
21-913
21-917
21-925
21-933
21-947
21-952
21-954
21-989
21-991
21-1ee9
21-1173
21-1194
21-1208
21-1219
21-1279
21-1281
21-2144
21-2153
21-2158
21-2217
21-2219
21-2221
21-2223
21-2228
PROC bildabschni tt neu (INT CONST von zeile, bis zeUe)
PROC bUd neu
PROC bUd neu (FILE VAR f)
PROC alles neu
FROC satznr zelgen
PROC ueberschrift zeigen
PROe bUd zeigen
PROC set busy indica tor
PROe word wrap (BOOL CONST br
BOOL PROC word wrap
INT PROC margin
PROC marg1n (INT CONST 1)
BOOL FROC rubin mode
BOOL FROC rubin mode (INT CONST editor nr)
FROC edit (INT CONST i, TEXT CONST res, PROe
(TEXT CONST) kommando interpreter)
PROC edit (INT CONST von, bis, start, TEXT CONST res, PROC
(TEXT CONST) kommando interpreter)
PROe open editor (FILE CONST new file, BOOL CONST access)
PROC open editor (INT CONST editor nr, FILE CONST new file,
BOOL CONST access, INT CONST x start, y, x len start,
y len)
PROC open edi tor (IlIT CONST i)
FILE PROC ed1tf11e
FROC get window (INT VAR x, y, x size, y size)
21-2237
21-2249
21-2251
21-2261
21-2270
21-2274
21-2417
21-2508
21-2607
21-2623
21-2630
21-2632
21-2653
21-2655
21-2665
21-2670
21-2753
21-2792
21-2881
21-2929
21-2935
PACKET editor functions :
PROC std kommando 1nterpreter (TEXT CONST taste)
PROC edit (FILE VAR f)
FROC ed1t (FILE VAR f, INT CONST x, y, x size, y size)
PROC ed1t (FILE VAR f, TEXT CONST res, PROC (TEXT CONST) kdo interpreter)
FROC ed1t
PROC ed1 t (TEXT CONST filename)
PROC edit (TEXT CONST filename, INT CONST x, y, x s1ze, y s1ze)
PROC edt t (INT CONST i)
PROC show (FILE VAR f)
PROC show (TEXT CONST filename)
FROC show
OP PUT (TEXT CONST filename)
OP P (TEXT CONST f11ename)
OP GET (TEXT CONST filename)
OP G (TEXT CONST filename)
INT PROC len
PROC col (INT CONST stelle)
INT PROC col
PROC 11mi t (INT CONST 11mi t )
INT PROC limi t
INT PROC lines
INT PROC line no
PROC to 11ne (INT CONST satz nr)
OP T (INT CONST satz nr)
PROC down (INT CONST &/lZ)
OP D (INT CONST anz)
PROC up (INT CONST &/lZ)
OP U (INT CONST anz)
PROC down (TEXT CONST muster)
OP D (TEXT CONST muster)
PROC down (TEXT CONST muster, INT CONST &/lZ)
22-58
22-176
22-186
22-193
22-200
22-233
22-2561
22-261
22-266
22-273
22-283
22-293
22-362
22-367
22-438
22-443
22-448
22-453
22-458
22-463
22-468
22-473
22-478
22-488
22-493
22-498
22-583
22-5$8
22-513
22-525
22-530
FROC up (TEXT CONST muster)
OP U (TEXT CONST muster I
FROC up (TEXT CONST muster, HIT CONST anz)
FROC downety (TEXT CONST muster)
FROC downety (TEXT CONST muster, INT CONST anz I
PROG uppety (TEXT CONST muster)
FROC uppety (TEXT CONST muster, INT CONST anz I
OP C (TEXT CONST old, new)
OP C (TEXT CONST replacement I
FROC change to (TEXT CONST old, newl
OP CA (TEXT CONST old, new)
FROC change all (TEXT CONST old, new)
B001 PROC eof
B001 PROC mark
FROC mark (BOO1 CONST mark on)
B001 PROC at (TEXT CONST pattern)
TEXT PROC word
TEXT PROC word (TEXT CONST sep)
TEXT PROC word (INT CONST len)
FROC no te (TEXT CONST text)
PROC note (INT CONST number)
PROC note line
B001 PROC anything noted
rILE PROC note file
FROC note edit (rILE VAR context)
PROC note edit
22-535
22-547
22-552
22-557
22-565
22-570
22-578
22-58:3
22-587
22-596
22-613
22-618
22-623
22-628
22-633
22-642
22-646
22-651
22-656
22-671
22-677
22-683
22-689
22-695
22-701
22-731
PACKET std transput :
FROC
TEXT
FROC
TEXT
PROC
FROC
FROC
PROC
sysout (TEXT CONST file name)
PROC sysout
sys1n (TEXT CONST file name)
PROC sys1n
put (TEXT CONST word)
put (INT CONST number)
put (REAL CONST number)
putl1ne (TEXT CONST textl1ne)
PROC line
FROC line (INT CONST times I
FROC page
PROC write (TEXT CONST word)
FROC get (TEXT VAR word)
PROC get (TEXT VAR word, TEXT CONST separator)
FROC get (INT VAR number)
PROC get (REAL VAR number)
PROC get (TEXT VAR word, INT CONST length I
PROC getl1ne (TEXT VAR textl1ne)
PROC get secret line (TEXT VAR textl1ne)
23-33
23-44
23-48
23-59
23-64
23-73
23-79
23-85
23-94
23-103
23-112
23-126
23-1:3e
23-152
23-175
23-182
23-189
23-293
23-217
PACKET local manager part 2 :
FROC list
PROC list (rILE VAR
f)
24-18
24-22
PACKET eumel coder part 1 :
FROC
FROC
PROC
PROC
PROC
PROC
PROC
PROC
FROC
PROC
PROC
BOOL
PROC
PROC
BOOL
PROC
PROC
BOOL
help (TEXT CONST proc name)
bulletin (TEXT CaNST packet name I
bulletin
packe ts
run (TEXT CONST file name)
run
run agai n
insert (TEXT CONST file name I
insert
prot (TEXT CONST file name)
prot off
PROC prot
check on
check off
PROC check
warnings on
warnings off
PROC warnings
25-328
25-559
25-679
25-701
25-735
25-744
25-748
25-756
25-765
25-826
25-832
25-837
25-841
25-845
25-849
25-853
25-857
25-861
PACKET math lib :
REAL
REAL
REAL
REAL
REAL
REAL
REAL
PROC pi
PROC e
PROC In (REAL CONST x I
PROC log10 (REAL CaNST xl
FROC log2 (REAL CONST z I
FROC sqrt (REAL CaNST z)
FROC exp (REAL CaNST z)
PROC tan (REAL CONST x I
PROC tand (REAL CaNST x)
PROC sin (REAL CaNST x)
PROC sind (REAL CaNST xl
FROC cos (REAL CONST x)
PROC cosd (REAL CaNST x)
PROC arctan (REAL CONST y)
PROC arctand (REAL CONST x I
OP ** (REAL CONST b, e I
OP - (REAL CONST a, INT CONST b)
REAL
REAL
REAL
REAL
REAL
REAL
REAL
REAL
REAL
REAL
REAL PROC random
FROC initializerandom (REAL CONST z)
26-25
26-26
26-28
26-32
26-36
26-64
26-83
26-111
26-116
26-146
26-154
26-162
26-170
26-204
26-218
26-222
26-231
26-259
26-263
PACKET command handler:
PROC get command (TEXT CONST command text)
PROC get command (TEXT CONST command text, TEXT VAR command 11ne)
PROC all&lyze COlIIIII&nd (TEXT CONST command list, INT CONST permitted type,
PROC
PROC
PROC
PROC
PROC
INT VAR command index, number of params,
TEXT VAR param 1, param 2)
all&lyze command (TEXT CONST cOlllllll1nd list, command line,
INT CONST permitted type, INT VAR command index,
number of params, TEXT VAR param 1, param 2)
do command
command error
cover tracks
cover tracks (TEXT VAR secret)
export.lerie ObJelrte nacb Pabten pord.net
27-33
27-39
27-106
27-117
27-233
27-247
27-266
27-277
PACKET advertising :
SOME PROe eumel must advertise
S29-4
PACKET tasks single :
TYPE TASK
TASK PROC myself
OP :. (TASK VAH dest. TASK GONST source)
BOOL OP • (TASK CONST left. right)
BOOL PROG is n11 task (TASK CONST t)
INT PROG pcb (TASK CONST id. INT CONST field)
INT PROC status (TASK CONST id)
INT PROC channel (TASK CONST id)
REAL PROC clock (TASK CaNST id)
INT PROC storage (TASK CONST id)
PROC continue (INT CONST channel no)
INT PROG da taspaces
S30-38
S30-44
S30-51
S30-57
S30-63
S30-69
S30-75
S30-81
S30-87
S30-93
S30-112
S30-121
PACKET font store :
PROG font table (TEXT CONST new font table I
TEXT FROC font tab:i.e
PROC list font tables
FROC list fonts (TEXT CONST name)
PROC list fonts
INT PROC x step conversion (REAL CONST em)
REAL PROC x step conversion (INT CONST steps)
INT FROC y step conversion (REAL CONST cm)
REAL PROC y step conversion (INT CONST steps)
TEXT PROC on string (INT CONST modification)
TEXT FROC off string (INT CONST modification)
INT PROC font (TEXT CONST font name)
TEXT FROC font (INT CONST font number)
BOOL PROC font exists (TEXT CONST font name)
BOOL PROC next larger font exists (INT CONST font number.
INT VAH next larger font)
BOOL PROC next smaller font exists (INT CONST font number,
INT VAH next smaller font)
INT PROC font lead (INT CONST font number)
INT PROC font he ight (INT CONST font number)
INT PROC font depth (INT CONST font number)
INT FROC indentation pitch (INT CONST font number)
INT PROC char pitch (INT CONST font number. TEXT CONST char)
INT PROC extended char pitch (INT CONST font number. TEXT CONST esc char,
char)
TEXT PROC replacement (INT CONST font number. TEXT CONST char)
TEXT PROC extended replacement (INT CONST font number.
TEXT CONST esc char. char)
TEXT PROC font string (INT CONST font number)
TEXT PROC y offsets (INT CONST font number)
INT PROC bold offset (INT CONST font number)
PROC get font (INT CONST font number. INT VAH indentation pitch,
S31-88
S31-128
S31-135
S31-164
S31-176
S31-218
S31-229
S31-237
S31-248
S31-206
S31-270
S31-284
S31-298
S31-311
S31-318
S31-;338
S31-358
S31-371
S31-384
S31-397
S31-410
S31-430
S31-452
S31-480
S31-537
S31-550
S31-563
font lead. font height, font depth.
ROW 256 INT VAH pitch table)
PROC get replacements (INT CONST font number, TEXT VAH replacements,
ROW 256 INT VAH replacements table)
export.1erte ObJel TEXT
I INT CONST arg, exp) -- > INT
1REAL CONST a, INT CONST b) --> REAL
lREAL CONST b, el --> REAL
i TEXT CONST p, INT CONST x) --> TEXT
I TEXT CONST left, right) -- > TEXT
I THESAURUS CONST left, TEXT CONST right)
THESAURUS
(THESAURUS CONST left, right) -- > THESAURUS
(TEXT CONST alphabet) --> TEXT
(THESAURUS CONST left, TEXT CONST right) -- > THESAURUS
I THESAURUS CONST left, right) -- > THESAURUS
I. THESAURUS CONST left,
right) -- > THESAURUS
(DATASPACE VAH dest, DATASPACE CONST source)
I FILE VAH left, rILE CONST right)
(INITFLAG VAR n..."
oooL CONST flag true )
(TASK VAH de.t, TASK CONST source)
(THESAURUS VAH de.t, THESAURUS CONST source)
\ TASK CONST left, right) --> BOOL
3-109
8-126
26-231
26-222
15-58
3-103
39-47
39-32
15-43
39-72
39-57
39-81
5-23
16-160
4-39
S30-51
13-103
S30-57
A
abschni tt neu (INT CONST von satznr,
ABS (INT CONST argument) -- > INT
abo (INT CONST argument) --> INT
abs (REAL CONST value) --> REAL
ABS (REAL CONST va.lue) --) REAL
aktueller editor --) INT
aktueller editor --) INT
bis satznr)
ALIGN
aHes
neU
CONST from) --) THESAURUS
CONST file name) --) THESAURUS
all
--)
THESAURUS
analyze command (TEXT CONST command list, command line,
INT CONST permitted type, INT VAH command index,
number of pa.rams, TEXT VAH pa.ram 1, pa.ram 2)
analyze command (TEXT CONST command list, INT CONST permitted type,
INT VAH command index, number of pa.rams,
TEXT ViJl pa.ram 1, pa.ram 2)
AND (INT CONST left, right) --) INT
ansi cursor (TEXT CONST pre, mid, post I
any (INT CONST n) --) TEXT
ALL
ALL
(TASK
(TEXT
exporlierte ObJekte &lpb&betiach geordnet
21-2228
8-122
8-114
10-329
10-338
21-1279
21-2158
5-21
21-2261
549-649
39-96
14-358
27-117
27-106
2-23
52-231
15-64
any (INT CONST n, TEXT CONST a) --) TEXT
any
--)
TEXT
any ( TEXT CONST a)
TEXT
an,'thing noted
BOOL
archi ve blocks --) INT
archi ve (TEXT CONST name)
arctand (REAL CONST x) --) REAL
arctan (REAL CONST r) --) REAL
at (FILE CONST f, TEXT CONST word) - - ) BOOL
at ( TEXT CONST pattern) - -) BOOL
15-72
15-62
15-70
22-689
48-329
549-72
26-218
26-204
16-1831
22-642
B
baudra te ( INT CONST nr, rate)
begin
list
blldabschnltt neu (INT CONST von zene, bis zeile)
bild
neu
bild neu (TILE VAR f)
bild
zeigen
bi t (INT CONST bits, bit no) --) BOOL
bits (INT CONST channel, key)
bi ts (INT CONST channel, number, parity)
blockin (DATASPACE VAH ds, INT CONST page nr, codel, code2,
INT VAH return code)
blockin (ROW 256 INT VAH block, INT CONST codel, code2,
INT VAH return code)
block number --) INT
blackout (DATASPACE CONST ds, INT CONST page nr, codel, code2,
INT VAR return codel
blackout (ROW 2~6 INT CONST block, INT CONST codel, code2,
INT VAH return code)
bold offset ( INT CONST font number) --) INT
bound
TEXT
bulletin
bulletin (TEXT CONST packet name)
52-81
14-237
21-2237
21-2249
21-2251
21-2417
2-~
52-89
52-85
5-68
6-161
48-4:3
5-6:3
6-146
S31-~63
15-87
25-679
25-559
c
CA (TEXT CONST old, new)
cat input (TEXT VAH t, esc char)
CAT (TEXT VAH result, INT CONST number)
CAT (TEXT VAH r1ght, TEXT CONST left)
change all ( TEXT CONST old, new)
change (FILE VAH f, INT CONST from, to, TEXT CONST new)
change (TEXT VAH destinat10n, INT CONST from, to, TEXT CONST new)
change (TEXT VAH destination, TEXT CONST old, new)
change to (TEXT CONST old, new)
channel --)
INT
channel (TASK CONST id) --) INT
char pitch (INT CONST font number, TEXT CONST char) --) INT
check --)
BOOL
check
off
check
on
check
read
check (TEXT CONST _ , TASK CONST from)
clear
error
clear removed (FILE VAH f)
clear (TASK CONST dest)
22-61:3
6-11:3
:3-:374
3-99
22-618
16-1946
3-167
:3-183
22-596
6-133
S30-81
S31-410
25-849
25-84~
25-841
48-118
549-5:34
9-44
16-1687
549-678
cloci( (INT CONS~ nrl - - ) REAL
clock (TASK CONST ldl
REAL
close (FILE VAR fi
code (INT CONST code I
TEXT
code (TEXT CONST text I - - ) INT
col (FILE CONST fi
IlIT
col (FILE VAR f, IN'! ::aNST new co1umnl
)
col
INT
col (INT CONST stelle)
collect gar~e blocks
collect heap ga.r~e
command dialogue
BOOL
command dialogue (BaOL CONST status I
command
error
compress ( TEXT CONST text) --) TEXT
concatenate line (FILE VAR f, BOOL CONST delete blanks)
configurate
CONTAINS (THESAURUS CONST thesaurus, TEXT CONST name I --) BOOL
continue (INT CONST channel nol
continue scan (TLXT CONST scan textl
contro: (INT CONST codel, code2, code:5, INT VAR rett:rn code I
copy attributes (FILE CONST source file, FILE VAR dest file)
copy (DATASPACE CONST source, TEXT CONST dest name I
copy (TEXT CONST source name, dest name)
cosd (REAL CONST x) --) REAL
cos (REAL CONST x) --) REAL
cout ( INT CONST number)
cover
tracks
cover tracks (TEXT VAR secret I
create ( TEXT CONST name)
C (TEXT CONST old, new)
C (TEXT CONST replacement)
cursor ( INT CONST x, y)
cursor log1c (INT CONST dist, modus, TEXT CONST pre, mid, post)
cursor 10g1c (INT CONST dist, TEXT CONST pre, mid, post)
--)
4-62
S:30-87
16-98:5
3-~:5
3-49
16-1795
16-1801
22-453
22-448
54:5-202
:5-240
12-:56
12-40
27-247
3-144
16-1407
S53-220
13-231
S:30-112
18-44
6-142
16-1703
14-200
14-218
26-170
26-162
6-128
27-266
27-277
14-61
22-~8:5
22-~87
6-118
52-237
52-2~
o
da taspaces
I NT
date (REAL CONST datum)
TEXT
date
--)
TEXT
date (TEXT CONST datum) --) REAL
day
--)
REAL
day (REAL CONST datum) --) TEXT
decimal exponent (REAL CONST mantissa) --) INT
DECR (REAL VAR dest, REAL CONST decrement)
delete char (TEXT VAR string, INT CONST delete pos)
delete int (TEXT VAR result, INT CONST delete pos)
delete record (FILE VAR f)
delete (THESAURUS VAR thesaurus, INT CONST index)
delete (THESAURUS VAR thesaurus, TEXT CONST name, INT VAR index)
D ( INT CONST anz)
disable
stop
display (TEXT CONST text)
do
conmand
do (PROC (TEXT CONST) operate, THESAURUS CONST thesaurus)
do (PROC (TEXT CONST, TASK CONST) operate, THESAURUS CONST thesaurus,
TASK CONST task)
do (TEXT CONST command)
exportJ.erte ObJeIrte &l.pbabetisch geordnet
S:30-121
11-44
11-:5:5
11-201
11-28
11-128
10--48
10-393
3-214
3-385
16-10~~
1:5-188
13-180
22-498
9-:52
6-81
27-2:5:5
39-16:5
39-199
17-23
dOIJnety (FILE VAR f, TE.xT CaNST pattern i
. dOIJnet:i (FILE VAR f, TEXT COllST pattern, INT CaNST max line)
dOIJnety (TEXT CaNST muster)
dOIJnety (TEXT CaNST muster, INT CaNST anz)
dOIJn (FILE VAR f)
dOIJn (FILE VAR f, INT CaNST n)
dOIJn (FILE VAR 1', n::n CaNST pattern)
dOIJn (FILE VAR f, TEXT CaNST pattern, INT CaNST max line)
dOIJn ( INT CaNST anz )
dOIJn ( TEXT CONST mus ter)
dOIJn (TEXT CaNST muster, INT CaNST anz)
ds pages (DATASPACE CaNST ds) --) INT
D (TEXT CONST muster)
16-1884
1€-1890
22-~57
22-565
16-1071
16-1085
16-1869
16-1875
22-49;3
22-51;3
22-5;30
5-51
22-525
E
edit
edi Uile
FILE
edi t (FILE VAR f)
edit (FILE VAR 1', INT CaNST x, y, x size, y size.1
edit (rILE VAR 1', TEXT CaNST res, PROe :TEXT CaNST) kdo interpreter)
edi tget cOJl'.mand (BOOL CaNST schalter)
editget (TEXT VAR editsatz)
edi tget (TEXT VAR editsatz, INT CaNST edl tlim t, ed:' tlaenge)
editget (TEXT VAR editsatz, INT CaNST edit~imit, editlaenge,
TEXT CONST sep, res, TEXT VAR e>:i t char)
editget (TEXT VAR editsatz, INT CaNST editlirnit, TEXT VAR exit char)
editget (TEXT VAR editsatz, TEXT CaNST sep, res, TEXT VAR exi1: char)
ed1t info (FILE CONST r) --) INT
edi t info (FILE VAR 1', INT CONST info)
edi t
( INT CONST i)
edi t (INT CONST i, TEXT eONST res, PROC (TEXT CaNST) kornrnando interpreter)
edit (INT CONST von, bis, start, TEXT CaNST res, PROe
(TEXT CONST) kornrnando interpreter)
edi t (TEXT CONST filename)
edi t (TEXT CaNST filename, INT CONST x, y, x size, y size)
edit (THESAURUS CONST nameset)
elbit
cursor
empty thesaurus --) THESAURUS
enable
step
enter incode (INT CONST elan code, TEXT CONST sequenz)
enter outcode (INT CONST eurnelcede, TEXT CaNST IJart)
enter outcode (INT CONST eumel code, IJartezeit, TEXT CONST sequenz)
enter outcode (INT CONST eurnel code, ziel code)
enter paSSIJord (TEXT CONST file name, IJri te pass, read pass)
enter passIJerd ( TEXT CONST paSSIJord I
eof --)
BOOL
eo l' ( FILE CONST l' )
BOOL
erase
erase (TEXT CONST file name I
erase (TEXT CONST file name, TASK CONST desti
erase ( THESAURUS CONST nameset)
erase (THESAURUS CONST nameset, TASK CONST task)
e
--)
REAL
error code
INT
error line --) INT
error message --) TEXT
errorstop (INT CONST code, TEXT CONST message)
errors top ( TEXT CONST message)
22-200
21-2929
22-176
22-186
22-19;3
21-81
21-200
21-205
21-87
21-192
21-196
16-1760
16-1767
22-261
21-2665
21-2670
22-2:3:3
22-250
39-;348
52-247
13-96
9-28
52-211
52-194
52-178
52-156
14-284
14-270
22-623
16-1182
549-:306
549-314
S49-320
39-338
39-336
26-26
9-79
9-8:5
9-72
9-107
9-101
eurne: must advertise
SOME
exec
configuration
exec (PROC (TEXT VAR, INT CONST) proc, TILE VAR f, INT CONST i)
exec (PROC (TEXT VAR, ~XT CONST) proc, TILE VAR f, TEXT CONST t)
e>::sts (TEXT CONST na:ne) --) BOOL
exists (TEXT CONST name, TASK CONST froml --) BOOL
exp (REAL CONST z) --) REAL
extended
char
pi tch
(INT
CO/;ST
font
number,
TEXT
CONST
INT
extended
replacement
(INT
CONST
font
number,
TEXT
CONST
--)
TEXT
esc
esc
S29-4
S53-447
16-1853
16-1844
14-127
S49-563
26-83
char,
char)
S31-430
char,
char)
S31-480
F
false
--)
BOOL
fetch
all
fetch all (TASK CONST manager)
fetch (TEXT CONST file name)
fetch (TEXT CONST file name, TASK CONST from)
fetch (THESAURUS CONST nameset I
fetch (THESAURUS CONST nameset, TASK CONST task)
TILE
TILLBY
TILLBY
TILLBY
(TILE VAR file, THESAURUS CONST thesaurus)
( TEXT CONST file name, THESAURUS CONST thesaurus)
(THESAURUS VAR thesaurus, TILE VAR file)
fixpoint
floor (REAL CONST real) --) REAL
flow (INT CONST nr, INT CONST dtype)
font depth (INT CONST font number) --) INT
font exists (TEXT CONST font name I --) BOOL
font height (INT CONST font number) --) INT
font (INT CONST font number) --) TEXT
font lead (INT CONST font number) --) INT
font string (INT CONST font number) --) TEXT
font table (TEXT CONST new font table)
font table --) TEXT
font (TEXT CONST font name) --) INT
forget
forget (DATASPACE CONST dataspace)
forget (TEXT CONST name)
forget ( TEXT CONST name, QUIET CONST q)
forget (THESAURUS CONST name set )
format archive lINT CONST format code)
format (INT CONST format code, TASK CONST dest)
format (TASK CONST dest)
frac ( REAL CONST value) --) REAL
mANGE
7-4
39-300
39-306
S49-215
S49-221
39-276
39-282
16-150
39-254
39-267
39-237
543-208
10-62
52-68
S31-384
S31-311
S31-371
531-298
S31-358
S31-~37
531--88
S31-128
531-284
14-157
5-31
14-134
14-145
39-324
48-378
S49-722
549-740
10-369
16-152
G
getcharety
TEXT
getchar (TEXT VAR ze1chen)
get command (TEXT CONST command text)
get command (TEXT CONST command text, TEXT VAR command line)
get cursor (INT VAR x, y)
get edltcursor lINT VAR x, y)
get editllne (TEXT VAR editline, INT VAR editpos, editmarke)
get (FILE VAR f, INT VAR number)
exportierte ObJekte alpbabetisch geordnet
21-1208
21-1173
27-33
27-39
6-124
21-1219
21-917
16-1346
get
get
get
get
get
(FILE VAR f, REAL VAR number)
(FILE VAR f, TEXT VAR word)
(FILE VAR f, TEXT VAR word, INT CONST max length)
(rILE VAR f. TEXT VAR word, TEXT CONST separator)
font (INT CONST font number, INT VAR indentation pi tch, font lead,
font height. font depth, ROW 256 INT VAR pitch table)
get (INT VAR number)
getl1ne (FILE VAR f, ~T VAR text)
getl1ne (TEXT VAR textl1ne.l
get list entry (TEXT VAR entry, status text)
get (REAL VAR number)
get replacements (IN! CONST font number. TEXT VAR replacements,
ROW 256 INT VAR replacements table)
get secret line (TEXT VAR textline)
get tabs (FILE CONST f, TEXT VAR tabs)
GET ( TEXT CONST filename)
get (TEXT VAR word)
get (TEXT VAR word, IN! CONST length)
get (TEXT VAR word, TEXT CONST separator)
get (THESAURUS CONST thesaurus. TEXT VAR name, INT VAR index)
get window (INT VAR x, y, x siZe, y siZe I
groesster editor --) INT
G ( TEXT CONST filename)
16-1354
16-1336
16-1312
16-1268
S31-576
23-175
16-1152
23-203
14-244
23-182
531-595
23-217
16-1746
22-367
23-130
23-189
23-152
13-281
21-2935
21-1281
22-438
H
headline (FILE CONST f) --) TEXT
headline (FILE VAR f, TEXT CONST head)
heap size (DATASPACE ::ONST ds) --) INT
heap size --) INT
help (FILE VAR help f11e)
help
help (TEXT CONST proc name)
highest entry (THESAUR;JS CONST thesaurus)
hour
--)
REAL
hour --) REAL
--)
INT
id ( INT CONST no) --) INT
1ncharety (INT CONST t1me limit) --) TEXT
1ncharety
--)
TEXT
inchar (TEXT VAR character)
INCR (REAL VAR dest, REAL CONST increment)
1ndentat10n pitch ( IN! CONST font number) --) INT
16-1732
16-1739
5--43
3-236
540-71
540-61
25-328
13-323
11-29
11-265
4-70
6-95
6-91
INITFLAG
6-a7
10-387
S31-397
4-19
initialized (INITFLAG VAR flag) --) BOOL
ini tialize random (INT CONST start)
initial1zerandom (REAL CONST z)
input buffer size (INT CONST nr, size)
input (FILE VAR f)
input --) TRANSPUTDlRECTION
insert
insert char (TEXT VAR string, TEXT CONST char, INT CONST insert pos)
insert int (TEXT VAR result, INT CONST insert pos, number)
insert record (FILE VAR f)
insert (TEXT CONST file name )
insert (THESAURUS CONST nameset)
8-197
26-263
52-76
16-962
16-a51
25-765
3-224
3-379
16-1063
25-756
39-342
exportlerte ObJekte &lpbabetlsch pordnei;
4-59
insert (THESAURUS VAR thesaurus, TEXT CONST name)
insert. (THESAURUS VAR thesaurus, TEXT CONST name, IN! VAR index)
int (REAl CONST value) --) INT
int (TEXT CONST number) --) IN!
1s edi tget --) BOOL
is error --) BOO1
is first record (rILE CONST fl --) IIOOL
is incharety (TEXT CONST muster) --) BOO1
is kanj i esc (TEXT CONST char I --) IIOOL
is niltask (TASK CONST t) --) IIOOL
ISUB (TEXT CONST text, IN! CONST index) --) IN!
13-170
13-111
10-399
8-38
21-913
9-40
16-1174
21-1194
21-947
5:30-63
3-57
K
ke
kommando auf taste
kommando auf taste
legen (TEXT CONST taste, kommando)
I TEXT CONST taste) --) TEXT
4-74
20-71
20-79
L
last conversion ok --) BOOL
lan parant - -) TEXT
las t param ( TEXT CONST nell )
len (FILE CONST f) --) INT
LENGTH ( TEXT CONST text)
IN!
length (TEXT CONST text) --) IN!
len
INT
lernsequeru: auf taste legen (TEXT CONST· taste, lernsequenz)
lernsequenz auf taste (TEXT CONST taste: --) TEXT
1EXEQUAL (TEXT CONST :eft, right I --) BOOL
1EXGREATEREQUAL (TEXT CONST left, right) --) Il001
LEXGREATER (TEXT CONST left, right I --) BOOL
lex sort (TEXT CONST da te1name)
lex sort (TEXT CONST dateiname, INT CONST sortieranfang)
LIKE (TEXT CONST t, pattern) --) IIOOL
LIKE (THESAURUS CONST thesaurus, TEXT CONST pattern) --) THESAURUS
limit --)
IN!
limit ( IN! CONST limit)
line
line (rILE VAR f)
11ne (rILE VAR f, IN! CONST lines)
line (IN! CONST t1mes)
line no ( rILE CONST f) --) IN!
line no --) IN!
lines (rILE CONST f) --) IN!
lines --)
IN!
line type (rILE CONST f)
IN!
line type (rILE VAR f, IN! CONST t)
link (IN'! CONST nr, TEXT CONST dtype)
link (THESAURUS CONST thesaurus, TEXT CONST name) --) IN!
list
list (rILE VAR f)
list (FILE VAR list file, TASK CONST from)
list
fonts
l1st fonts (TEXT CONST l1&1li8)
list font tables
list (TASK CONST from)
In (REAL CONST x) --) REAL
8-170
12-101
12-114
16-1930
3-124
3-120
22-443
20-27
20-63
3-262
3-276
3-269
16-202:1
16-2029
15-193
39-142
22-463
22-458
23-94
16-1119
16-114:1
23-103
16-1197
22-473
16-1774
22-468
16-1219
16-1264
52-142
13-267
24-10
24-22
549-588
531-176
S31-164
S31-13!l
549-576
26-28
log10 (REAL CONST x) --) REAL
log2 (REAL CONST z) --) REAL
10llest reset (IN! CONST bits) --) IN!
lo .... est set (INT CONST bits) --) INT
25-32
26-36
2-65
2-53
M
margin
INT
margin (INT CONST i)
mark
--)
BOOL
mark (BOOL CONST mark on)
mark col (TILE CONST f) --) IN!
mark (FILE CONST f) --) BOOL
mark (FILE VAR f, INT CONST line no, col)
mark line no (TILE CONST f) --) INT
mark refresh line mode --) BOOL
mark refresh line mode (BOOL CONST b)
marksize
INT
marksize (INT CONST i)
ma tchend (INT CONST >:)
INT
match (INT CONST >:1 --) TEXT
rnatchpos (INT CONST >:) --) IN!
max (INT CONST first., second) --) INT
rnaxint
--)
INT
max line length (TILE CONST f) --) INT
max line length (TILE VAR f, INT CONST nell limit)
max ( REAL CaNST a , b )
REAL
max real
REAL
max text length
INT
min (IN! CaNST first, second) --) INT
minint
INT
min (REAL CONST a, b) --) REAL
minute
--)
REAL
modify (FILE VAR f)
modify
TRANSPUTDIRECTION
MOD ( IN! CaNST left, right) --) INT
MOD (REAL CaNST left, right)
REAL
monitor (PROC ini t
system)
monitor
month (REAL CONST datum) --) TEXT
myself
--)
TASK
21-2630
21-2632
22-628
22-633
16-1982
16-1956
16-1962
16-1973
19-24
19-28
19-13
19-19
15-97
15-91
15-95
8-160
8-9
16-1716
16-1723
10-375
10-40
3-35
8-154
8-7
10-381
11-30
15-976
16-861
8-95
10-359
S43-40
S43-34
11-139
530-44
N
name
ne....
nell
nell
next
next
(TIlESAURUS CONST thesaurus, INT CONST index) --) TEXT
configuration
(TEXT CONST name) --) DATASPACE
type (TEXT CONST d type )
ds page (DATASPACE CaNST ds, INT CONST page nr) --) INT
larger font exists (IN! CONST font number,
IN! VAR
next
oooL
next
srnaller
next symbol
next symbol
next symbol
next symbol
nichts
neu
font
exists
(INT CONST font number, INT
BOOL
(TILE VAR f, TEXT VAR symbol)
(FILE VAR f, TEXT VAR symbol, INT VAR type)
(TEXT VAR symbol)
(TEXT VAR symbol, INT VAR type)
VAR
elCp)rtlerte ObJeltte &lpbabetlsch geordnet
next
13-274
52-39
14-86
52-105
5-59
larger font)
S31-318
smaller font)
S31-338
18-303
18-312
18-52
18-59
21-2217
nilspace
DATASPACE
no
do
again
note
edi t
note edit (TILE VAR contex"tl
no te file
FILE
no"te ( IN! COrlST numl:er I
note
line
no"te (TEXT CaNST text I
no (TEXT CaNST question I --) BOOL
notion (TEXT CaNST t, INT CaNST r I
notion (TEXT CaNST tJ --) TEXT
5-27
17-44
22-7~1
22-701
22-695
22-677
22-68~
TEXT
22-671
12-81
15-765
15-78
o
off string (INT CaNST modification I --) TEXT
old (TEXT CaNST name I --) DATASPACE
old (TEXT CaNST name, INT CaNST expected type I --) JATASPACE
online
BOOL
on string i.INT CaNST modlfication) --) TEXT
open editor (FILE CaNST nell file, BOOL CaNST access'
open editor (INT CONST editor nr, FILE CaNST nell file, BOOL CONST access,
INT CONST x start, y, x len start, y len)
open editor (INT CaNST i I
OR (INT CaNST left, right) --) IN!
OR
(TEXT
CaNST
a,
bJ
--)
TEXT
output (FILE VAR fl
output --)
TRANSPUTDIRE(;I'ION
outsubtext I TEXT CaNST source, IN! CaNST from)
outsubtext (TE-XT CaNST source, IN! CaNST from, to)
out ( TEXT CONST text)
out text (TEXT CaNST source, IN! CaNST from, to)
S~1-270
14-96
14-110
6-137
531-256
21-2753
21-2792
21-2881
2-27
15-54
16-969
16-856
6-39
6-43
6-35
6-47
p
packets
page
param position lINT CONST xl
pattern found
BOOL
pause
pause ( INT CaNST time limit)
pcb (INT CONST fieldl
INT
pcb (TASK CONST id, INT CaNST fieldl --) INT
pi
REAL
pas (FILE CaNST f, TEXT CaNST pattern, INT CONST iJ --) INT
pos (TEXT CaNST source, lOll, high, IN! CaNST from) --) IN!
pas (TEXT CONST source, pattern I --) INT
pas (TEXT CaNST source, pattern, IN! CaNST from)
INT
pos (TEXT CONST source, pattern, IN! CONST from, to) --) INT
prefix (TEXT CONST pattern) --) TEXT
prot --)
BOOL
pro"t
off
prot (TEXT CaNST file name)
P ( TEXT CaNST filename)
push ( TEXT CONST ausfuehrkommando)
put edi tline (TEXT CaNST edi tline, IN! CaNST editpos, edi tmarke)
put
error
puc (FILE V/>Jl f, IN! CaNST value)
put (FILE V/>Jl f, REAL CaNST real)
exp>rtierte Objekte &lpbabetiach seordnet
25-701
23-112
12-95
16-674
6-105
6-100
4-26
530-69
26-25
16-1861
~-140
3-128
3-132
~-136
16-M6
25-8~7
25-8~2
25-826
22-362
21-991
21-925
9-116
16-1236
16-1243
put I. rILE VAR f, TEXT CONST IIOrd)
put (INT CONST number)
putl1ne (rILE VAR f, TEXT CONST IIOrd)
putUne (TEXT CONST text:;'ine)
put (REAl CONST number)
put tabs (rILE VAR f, TEXT CONST tabs)
PUT ( TEXT CONST filename)
put (TEXT CONST lIord)
16-1217
23-73
16-1045
23-85
23-79
16-1753
22-293
23-64
Q
QUIET
quiet
quit
quit
--)
QUIET
last
12-29
12-31
21-2153
21-2144
R
random (INT CONST lOl/er bound, upper bound)
INT
random - -)
REAL
read block (DATASPACE VAR ds, INT CONST ds page no, HIT CONST block no,
INT VAR return code)
read (DATASPACE VAR ds)
read (DATASPACE VAR ds, INT CONST max pae;es, BOOL CONST error accept)
read paSSIiOrd
TEXT
read permission (TEXT CONST name, supply paSSIiOrd) --) BOOl
read record (rILE CONST f, TEXT VAR record)
real (INT CONST value) --) REAL
rea 1 ( TEXT CONST text)
REAl
reinsert (FILE VAR f)
release (TASK CONST t)
remai nder
THESAURUS
removed Unes (rILE CONST f) --) INT
remove (FILE VAR f, INT CONST size)
rename ( TEXT CONST 0 ld name , nell name )
rename (THESAURUS VAR thesaurus, INT CONST index, TEXT CONST nell)
rename (THESAURUS VAR thesaurus, TEXT CONST old, nell)
replacement (INT CONST font number, TEXT CONST char) --) TEXT
replace (TEXT VAR dest, INT CONST pos, TEXT CONST source)
replace (TEXT VAR text, INT CONST index, REAl CONST code)
replace (TEXT VAR text, INT CONST index, value)
reset bit (INT VAR bits, INT CONST bit no)
reset (FILE VAR f)
reset (FILE VAR f, TRANSPUTDIRECTION CONST mode)
reset range (rILE VAR f)
rellind
rotate (INT VAR bits, INT CONST number of bits)
round (REAL CONST real, INT CONST digits) --) REAL
RSUB (TEXT CONST text, INT CONST index) --) REAL
rubin mode --) BOOL
rubin mode (INT CONST editor nr) --) BOOL
run
run
again
run (TEXT CONST file name)
8-208
26-259
48-268
48-70
48-74
14-263
14-312
16-1111
10-424
10-243
16-1695
549-81
39-157
16-1781
16-1679
14-224
13-248
13-242
531-452
3-74
3-69
3-61
2-47
16-926
16-93:1
16-1668
48-51
2-19
10-66
3-85
21-2853
21-2855
25-744
25-748
25-735
s
satznr
neu
satznr zeigen
save
all
save all (TASK
CONST
manager)
save
sa'ie
system
save (TEXT CONST tile name)
save (TEXT CONST tile name, TASK CONST to)
save (THESAURUS CONST name set )
save (THESAURUS CONST nameset, TASK CONST task)
say ( TEXT CONST me s sage)
scan I FILE VAR 1')
scan (TEXT CONST scan text)
search dataspace (INT VAR ds pages)
second
--)
REAL
seek (INT CONST block)
segments (TILE CONST f) --) INT
sequential file (TRANSPUTDIRECTION CONST mode, DATASPACE CONST ds) --) TILE
sequential file (TRANSPUTDIRECTION CONST mode, TEXT CONST name) --) TILE
session
--)
INT
set bit (INT VAR bits, INT CONST bit no)
set buSl' indicator
set clock (REAL CONST time)
set conversion (BOOL CONST success)
set
date
set exp (INT CONST exponent, REAL VAR number)
set line nr (INT CONST value)
set marked range (TILE VAR r, mANGE VAR old range)
set range (FILE VAR f, FRANGE VAR nell range)
set range (TILE VAR t, INT CONST start line, start col,
mANGE VAR old range)
setup
shOll
shOll (FILE VAR t)
shOll ( TEXT CONST filename)
shutup
SIGN (INT CONST argument) --) INT
sign (INT CONST argument) --) IN!
sign (REAL CONST value) --) INT
SIGN (REAL CONST value) --) IN!
sind (REAL CONST x) --) REAL
sin (REAL CONST x) --) REAL
size ( IN! CONST key) --) IN!
skip
da tasp&ce
small real --) REAL
sometix (TEXT CONST pattern) --) TEXT
SOME (TASK CONST task) --) THESAURUS
SOME (TEXT CONST file name) --) THESAURUS
SOME (THESAURUS CONST thesaurus) --) THESAURUS
sort (TEXT CONST date1name)
sort (TEXT CONST dateiname, IN! CONST sortierantang)
spli t line (FILE VAR f, INT CONST split col)
split line (rILE VAR f, IN! CONST split col, BOOL CONST note indentation)
sqrt (REAL CONST z) --) REAL
status (INT CONST pos, TEXT CONST status pattern)
status (TASK CONST id) --) INT
status (TEXT CONST name, status text)
status (TEXT CONST name) --) TEXT
21-2219
21-2270
39-312
39-318
S49-411
S43-192
S49-417
S49-423
39-288
39-294
12-87
18-296
18-36
48-333
11-31
48-47
16-1788
16-869
16-885
4-22
2-41
21-~
S43-235
8-174
S43-121
10-02
4-34
16-1993
16-1620
16-1~oe
~3-403
22-283
22-266
22-273
S43-1B2
8-11e
8-1el
le-344
10-353
26-154
26-146
48-321
48-59
10-42
15-123
39-1:58
39-136
39-1a~
16-2816
16-2828
16-1365
16-1371
26-64
14-187
S:5El-7~
14-166
14-176
std kommando interpreter (TEXT ~ONST taste)
std
tastenbelegung
std --) TEXT
stop
storage (DATASPACE CONST ds)
INT
storage
info
s:o,-age (INT VAR Slze, used)
storage (TASK CaNST id)
INT
stranalyze (ROW 256 INT CONST table, INT VAR sum, INT CONST max sum,
TEXT CONST str1ng, INT VAR index, INT CaNST to,
INT VAR exit code)
SUB (TEXT CaNST text, INT CaNST pos) --) TEXT
subtext (FILE CaNST f, INT CaNST from, to) --) TEXT
subtext (TEXT CONST source, IN! CONST from) --) TEXT
subtext (TEXT CONST source, INT CONST from, to) --) TEXT
sysin
TEXT
sysin (TEXT CONST file name)
sysout
--)
TEXT
sysout (TEXT CONST file name)
22-58
20-92
12-118
9-135
5-47
S40-45
4-66
S:30-93
3-244
3-37
16-1938
3-45
3-41
23-59
23-48
23-44
23-33
T
tand (REAL CONST x) --) REAL
tan (REAL CaNST xl --) REAL
TASK
task
taste
te:= < < ill
I
a
1/4
Zeile
230
E :. AN
****
1. 8
EUMEL
10.11. 86
a
a .*********************** IPACKET a
231
232
233
out ...................... IPROe out (TEXT CONST tJ
2:34
I EXTERNAL 60
I ENDPROG out
235
I
236
237
outtext .................. IPROG
OU"I; text (TEXT CONST t, INT CONST typ)
INTE:.:;,;:' 257 ;
IT typ = typ
238
2:39
THEN out (t)
rr
240
241
242
243
244
245
i ENDPROe out text
I
outline .................. I PROC o.t line (INT eONST typ)
I
THEIl out (""13"·10·")
246
247
248
249
250
251
~2
~3
254
255
256
257
258
259
260
261
262
1/l)
INTERNAL 258 ;
I IF typ • typ
I FI
IENDPROC out line
I
I ENDPACKET a
I
I
I
I
I
I
I
I
I
I
I
I
&
1/5
Zelle
.....
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
+
+
18
19
28
21
22
E LAN
EIlMEL
1.8
18.11.86
-
bits
1
bi ts _
..............- 1 PACKET bits DEFINES
1
1
AND,
1
OR,
1
XOR,
1
bit,
1
lowest reset ,
1
lowest set ,
1
reset bit,
1
rotate,
1
set bit :
1
1LET
bi ts per int • 16
1
IROW bits per int INT YAR bit mask := ROW bits per int INT:
1
1
(1,2,4,8,16,32,64 ,128,256,512,1824 ,2E148 ,4096 ,8192,16384 ,-32'l
67-1) ;
1
1
rotate ................... IPROC rotate (INT YAR bits, INT CONST number of bits)
1 EXTERNAL 83
IENDPROC rotate
1
23
24
25
26
AND .••...••••.••.••..•.•• 1INT OP AND (INT CONST left, right)
27
28
29
38
OR ....................... 1INT OP OR (INT CONST lett, right)
1 ~~AL 125
1ENlXlP OR
31
32
33
34
XOR ...................... 1INT OP XOR (INT CONST left, right)
1 ~~AL 121
1ENlXlP XOR
35
bit ...................... IBOOL PROC bit (INT CONST bits, bit no)
36
1
~~ALl24
1ENlXlP
AND
1
1
1
1
1
37
38
39
(bits AND bit mask (bit no+l» () 0
1
1ENDPROC bit
48
1
41
42
43
44
45
46
2/1
setbi t ................... 1PROC set bit (INT YAR bits, INT CONST bit no)
1
1 bits:= bits OR bit mask (bit no+1)
1
IENDPROC set bit
1
bits
2/1
Zelle
47
E LAN
EUMEL
1.8.....
~
51
!i2
I
49
!i3
!j4
!i5
56
57
58
59
68
61
62
63
64
65
66
67
68
69
78
71
72
73
74
75
76
77
2/2
bits
resetbit ................. IPIIOC reset bit (INT VAR bits,INT CONST bit no) :
I
I
I
48
18.11.86
bi ts :. bits XOR (bits AND bit m&sk (bit no+1»
I ENDPIIOC reset bit
lowestset ................ lINT PIIOC lowest set (INT CONST bits)
I
I
I
I
I
I
I
I
I
INT VAR III&sk index ;
FOR m&sk index FROM 1 UP1'O 16 REP
IF (bits AND bit mask (m&sk index» () 8
'l'Hni LEAVE lowest set WITH m&Sk index - 1
FI
pm;
-1
I ENDPIIOC lowest set
I
lowestroset .............. lINT PIIOC lowest reset (INT CONST bits) :
I
I
I
I
I
I
I
I
INT VAR III&sk index ;
FOR m&sk index FROM 1 UPl'O bits per int REP
IF (bits AND bit III&sk (m&sk index» • 8
THEN LEAVE lowest reset WITH III&Sk index - 1
FI
PER;
-1
I
I ENDPIIOC lowest reset
I
IENDPACKET
bits ;
bits
2/2
Zeile
1
2
3
E LAN
EUMEl
1.8
****
10.11.86
text
1(* ------------------- VERSIOtl 3
06.03.86 ------------------- *)
text ****************---IPACKET text DEFINES
I
4
ma;.: text length •
5
SUB •
6
subtext .
text,
length • LENGTH
7
8
CAT
9
10
11
12
13
+
•
replace
change •
change all •
compress
pos .
code
1~
15
16
17
ISUB •
RSUB •
18
19
delete char
insert char
delete int
insert lnt
heap size .
collect heap garbage
stranalyze
20
21
22
23
24
25
26
27
28
LEXEQUAL •
LEXGREATER
LEXGREATEREQUAL
29
30
31
32
33
3..
35
36
37
38
39
40
41
42
43
44
I TEXT VAR text buffer • tail buffer
I
lINT CONST max text length : = 32000
I
SUB ...................... !TEXT OP SUB (TEXT CONST text, INT CONST pos )
I EXTERNAL 48
IEND OP SUB
I
subtext .................. ITEXT ?ROC subuxt (TEXT CONST source. IlIT CONST from. to I:
I EXTERNAL 49
I ENDPROC subtext
I
45
46
47
48
subtext .................. ITEXT FROC subtext (TEXT CONST source. INT CONST from )
I EXTERNAL ~0
IENDPROC subtext
49
50
51
52
code ..................... lINT PROC code (TEXT CONST text)
I EXTERNAL 46
lEND PROC code
3/1
I
I
text
3/1
Zelle
53
E LAN
EUMEL
1. 8
10.11. 86
****
text
code ..................... ITEXT PROC code (INT CONS':' code)
~4
I EXTERNAL 47
I ENDPROC code
55
55
I
57
58
59
50
ISUB ••••..•.••...••.••..• I IlIT OP ISUB (TEXT CONST text, INT CONST index)
I EXTERNAL 44
I ENDOP ISUB
61
52
63
54
replace .................. IPROC replace (TEXT VAR text, INT CONST index, value)
65
66
67
58
RSUB ••••.•.•••.••...••.•• I REAL OP RSUB I TEXT CONST text, INT CONST index)
I EXTERNAL 100
I ENDOP RSUB
69
70
71
replace .................. IPROC replace ITEXT VAR text, :NT CONST index, REAL CONST code)
I
I EXTERNAL 45
I ENDPROC replace
I
I
I EXTERNAL 101
I ENDPROC replace
I
I
72
73
74
75
76
replace .................. I PROC replace (TEXT VAR dest. INT CONST pes, TEXT CONST source)
I EXTERNAL 51
I EIIDPROC replace
I
77
78
79
text •.................... I TEXT PROC text (TEXT CONST source. INT CONST length)
I
I
I
I
80
81
82
83
84
85
85
87
88
mi tblanksauffuellen
IT length < LENGTH source
THEN text buffer := subtext (source,i.length)
ELSE text buffer : = source
mit blanks auffuellen
I
I rr
I text buffer .
I
I
Imi t blanks auffuellen
I
INT VAR i ;
!'ROM 1 UPTO length - LENGTH source REP
text buffer CAT " "
PER.
89
I !'OR i
90
91
92
I
I
I
93
IENDPROC text
94
I
95
96
97
text .•.••.•...•••••.....• I TEXT PROC text (TEX':' CONST source, INT CONST length. from)
I text ( subtext (source, from) • length )
IENDPROC text
I
98
3/2
-"'.J.":.
text
3/2
Zeile
E LAN
EUME1
1.8
****
text
10.11.86
99
100
101
102
CAT .••••.•••••••••••••••• IOF CAT (TEXT VAR right, !EXT CaNST left)
I EXTERNAL ~2
I ENDOP ::AT
103
111)4
105
106
107
108
+ •••••••.•••••••••.•••••• 1rEXT
109
110
111
112
113
114
115
116
117
118
119
* ........................ ITEXT OP *
120
121
122
123
length ................... IIN! FROC length (TEXT CONST text
I EXTERNAL 03
IENDFROC length
124
125
126
127
LENGTH •••••••••••..•••••• IIN! OP LENGTH (TEXT CONST text
I EXTERNAL 53
IENDOP LENGTH
128
129
130
131
pos ...................... 1IN! PROC pos
I EXTERNAL 54
IENDPROC pos
132
133
134
135
pos ...................... IIN! PROC pos (TEXT CONST source, pattern, IN! CONST from)
I EXTERNAL 05
IENDPROC pos
136
137
138
139
pos ..•................... 1 IN! PROC pos (TEXT CaNST source, pattern, IN! CONST from, to)
140
pos ...................... I IN! PROC pos (TEXT CONST source, low, bigh, IN! CONST from)
I
OP + (TEXT CONST left, right)
text buffer : = left ;
I text buffer CAT right
I te>:t buffer
IENDOP +
I
I
(INT CONST times, TEXT CONST source )
I
I
I
text buffer :. •• ;
IN! VAR i ;
TOR i FROM 1 UPTO times REP
text buffer CAT source
I
I
I PER;
I text buffer
I
IENDOP *
I
I
I
source, pattern)
I
I
I
EXTERNAL 56
IENDPROC pos
I
141
I
142
143
IENDPROC pos
3/3
I TEXT CONST
EXTERNAL 58
I
text
ZeCe
144
E LAN
1. ~
EUMEl
**"*
:0.11. 86
text
compress ................. ITEXT FROC compress (TEXT CeNST text)
145
146
I
147
148
149
150
151
152
I
I
INT VAR begin, end ;
search first non blank
search last non blank ;
text buffer . - subtext (tex", begin, end I
text buffer .
I
1~3
searchfirstnonblank
Isearch first non blank ;
I begin;. 1
I ·.~'EI1E (text SUB begin I • " " REP
I
begin INCR 1
154
156
PER .
157
158
159
160
searchlastnonblank
161
162
I PER.
I
163
164
165
166
167
IENDPRO: compress
I
change ................... IPROC change (TEXT VAR destination, INT COtlST from, to, TEXT CONST
I
newl:
:68
I
I
I IT LENGTH new = to - frorr. ... 1 AlID to <. LENGTH destination
THEN replace (destination, from, new)
I
ELSE change via buffer
I
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
lsearch last non blank:
I end; = LENGTH text ;
I WHILE (text SUB endl • " " REP
I
end DECR 1
changeviabuffer
I TI .
I
I
Ichange
I
I
I
I
I
via bu!'!~,. ;
text buffer :. subtext (destination, 1, from-l1
text buffer CAT new ;
tail buffer ;. subtext (destination, to ... 1 I ;
text buffer CAT tail buffer
destination;. text buffer
I
IENDPROC change
I
change ••......•.••..•.... PROC change (TEXT VAR destination, TEXT CONST old, newl
185
186
187
INT CONST position ;= pos (destination, old) ;
IT position ) 0
THEN change (destination, pOSition, position ... LENGTH old -1,
newl
188
rr
189
190
IENDPROC change
191
I
192
193
194
3/4
changeal::. ................ IPROC change a:l (TEXT 'JAR destination, TEXT CONST old, new I
I
lINT VAR position; = pos 'destination, old) ;
text
3/4
E LAN
EUMEL
1.8........
10.11.86
text
IT LENGTH o:d • LENGTH new
THDI change by replace
195
196
ELSE change by change
rI.
197
198
199
I
200
201
202
203
204
205
changebyreplace
Ichange by rep:ace :
I WHILE position) 0 REP
I
replace (destination, position, new) ;
I
position:. pos (destination, old, position
+
LENGTH new)
I PER.
1
1
206
207
208
209
210
211
212
213
214
215
216
217
218
219
~
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
change by change
1
I
I
I
change by change :
WHILE posi tion ) 0 REP
change (destination, position, position + LENGTH old - 1 , new)
pos:tion:. pos (destination, old, position + LENGTH new)
PER.
1
1
ENDPROC change all
1
I
deletechar ............... IPROC delete char (TEXT VAR string, INT CONST delete pes)
1
I
1
1
I
I
I
1
Ir delete pos ) 0
THEN tail butter :. subtext (string, delete pes + 11
string :. subtext (string, 1, de lete pos - 1) ;
string CAT tail butter
IT
END PROC delete char
1
insertchar •.•............ IPROC insert char (TEXT VAR string, TEXT CONST char,
1
INT CONS! insert pesl :
i
I
I
Ir insert pos ) 0 AND insert pes (. LENGTH string
1
str:ng :. subtext (string, 1, insert pes - 1) ;
string CAT char ;
strir.g CAT tail butter
1
1
I
rI
1
I
1
END PROC insert char
1
236
237
238
239
heapsize ................. lINT PROC heap size :
1
EXTERNAL 93
1ENDPROC heap siZe
240
241
242
243
collectheape;arbage ....... 1PROC collect heap garbage :
1 EXTERNAL 94
1ENDPROC collect heap garbage
3/5
+
THEN tail butter := subtext (string, insert pesl ;
I
I
text
3/5
Zeile
244
245
246
247
248
249
25e
251
252
253
254
255
256
257
258
E LAN
EUMEL
1.8
*-*
10.11.86
text
strana1yze ............... IPROC strana1yze (ROI\' 256 INT CONST table, INT VAR sum, INT CONST IIl8f
I
sum,
I
TEXT CONST string, INT VAR index, INT CONST to,
I
INT VAR exit code) :
I EXTERNAL 57
IENDPROC strana1yze ;
I
!(***.********.....**********................*******••*****....******)
I (* 1exikographische Verg1eiche
*)
1(* Nach DIN 5007, Absclmitt 1 und Abschnitt 3.2 (Bindestrichl
*)
1(* Autor: Rainer Hahn, Jochen Liedtke
*)
1(* Stand: 1.?4 (Jan. 1985)
*1
I (...... MM.MM . . . . . . . . . . . . . . .***•••••************************......... )
ILET first umlaut _ ""214"" ,
I
umlauts
• ""214""215"n216""21?""218""219""251"" ;
I
~9
I
260
261
ITEXT VAR left letter, right letter;
I
262
263
264
265
265
267
268
LEXEQUAL ................. 1000L OP LEXEQUAL (TEXT CONST left, right)
I
I compare (left, right) ;
I left letter. right letter
269
270
271
272
LEXGREATER ..........•.... 1000L OP LEXGREATER (TI:~T CONST left, right)
I
I compare (left, right) ;
I left letter ) right letter
I
1ENDOP LEXEQUAL
1
I
n3
274
IENDOP LEXGREATER
n5
I
276
277
278
279
LEXGREATEREQUAL .....••... 1000L OP LEXGREATEREQUAL (TEXT CONST left, right 1
I
1 compare Cleft, right) ;
1 left letter )- right letter
280
I
281
282
IENDOP LEXGREATEREQUAL
I
283
compare ••••••....••••.•.• IPROC compare (TEXT CONST left, right)
Z84
I
285
286
287
I
I
I
I
I
288
289
290
291
292
293
294
29:1
3/6
tobeglnoflexrelevantte
to begin of lex relevant text ;
REP
get left letter ;
get right letter
UNTIL NOT letter match OR both ended PER
I
I
Ito
begin of lex relevant text :
I INT VAR
I left pes :. pes (left, ""65"",""254"", 11
1 right pas :. pos (right,""65"",""254"", 11
I IF left pes • e
text
3/6
Zeile
E LAN
296
297
298
299
300
301
EUME~
1.8
I
****
text
THEN loft pos :. LENGTH left
~
1
THEN right pos :. LENGTH right
+
I rI;
I IF right
I
10.11.86
pos • 0
1
I rI.
I
I
302
303
304
305
gotleftlettor
306
307
308
309
getright1etter
310
1ettermatch
Iget left letter :
I left letter :. left SUB left pos
I left pos INCR 1 .
I
I
311
312
313
314
315
316
Iget right letter :
I right letter :. right SUB right pos
I right pos INCR 1
I
I
I letter match
I IF left letter = right letter
I
THEN TRUE
I
ELSE dine (left, left letter, lett pas) ;
I
dine (right, right letter, right pos)
I
IT exactly one letter is double letter
I
THEN expand other :etter
317
318
I
TI ;
I
lett letter
319
I rI.
I
I
320
= right
letter
321
322
323
eY.&ct1yone1etterisdoub Iexactly one letter is double :etter :
I LENGTH left letter () LENGTH right letter.
324
325
326
327
328
expandother1etter
I
I
329
330
331
332
333
334
335
336
337
338
339
I
I
bcthended
IENDPROC compare
I
dine ..................... IPROC dine (TEXT CONST string. TEXT VAR char, INT VAR string pos)
I
I skip non letter chars ;
I
I
I
I
I
I
I
341
342
343
344
348
3/7
Iboth ended : left letter • ""
I
Me
345
346
347
Iexpand other letter :
I IT LENGTH left letter = 1
I
THEN left letter CAT (left SUB lett pas)
I
left pas INCR 1
I
ELSE right letter CAT (right SUB right pos)
I
right pos INCR 1
I Fl.
sklpnon1otterchars
IF is capital letter
THEN translate to small letter
ELIT char >. first umlaut
THEN translate umlaut
rI.
Iskip non letter chars
I WHILE NOT (is letter OR end of string) REP
I
char:. string SUB string pos
I
string pos INCR 1
text
3/7
Zeile
E L A II
EUMEL
1.8
.....
10.11.86
text
PER .
349
350
351
352
353
translatetos~~llletter
354
355
356
357
358
359
360
361
transla ~eumlaut
362
363
364
365
iscapi ~lletter
366
367
368
369
isletter
370
371
372
373
endofstring
!translate to small letter:
char :. code <. code (char)
translate umlaut :
SELECT pos (umlauts,
CASE 1,4
char: =
CASE 2,5
char:=
CASE 3,6
char:.
I
CASE 7
char .I ENDSELECT.
chari
"ae"
"oe"
"ue"
"ss"
+
32) .
or
I
I
11S c&Pi~l
I
I
letter:
lIlT VAR char code .' code (char J
65 (= char code AND char code (= 90
I
I
Iis lette::- :
I char code .' code (char I OR 32
I (97 (. char code AND char code (. 1221
OR
char code ) = 128 .
I
I
lend of string: char. "" .
I
IENDPROC dine
I
374
375
376
377
378
CAT ..•...........•....... IOP CAT (TEXT VAR result, IIlT CONST number) :
I
result CAT" ";
I
replace ( result, LENGTH result DIV 2, number);
lEND OP CAT;
379
380
381
382
383
384
insertint ...•...•........ IPROC insert int (TEXT VAR result, lIlT CONST insert pos, number)
I
lIlT VAR pos : = insert pos • 2 - 1;
I
change (result, pos, pos - 1," ");
I
replace (result, insert pos, number);
IEND PROC insert int;
385
386
387
388
389
390
del.teint ................ IPROC delete int (TEXT VAR result, lIlT CONST delete pos)
I
INT VAR pos : = delete pos • 2;
I
change (result, pos - 1, pos, ""I
lEND PROC delete int;
3/8
I
I
I
IENDPACKET text ;
text
3/8
Ze1le
1
2
3
-
ELA N
EtlMEL 1.8 - -
10.11.86
-**
pcb and ini t control
I
pcb&ndinitcontrol *---IPACKET pcb and init control DEFINES
I
4
5
6
7
I
I
I
I
sesslon,
pcb,
set line nr ,
clock,
INITFLAG,
I
I
lnl tlalized ,
stor&«e,
id,
ke:
(* Autor: J.Liedtke .)
(. Stand: 2!i.eB.B4 *)
I
I .",
8
9
10
11
12
13
I
I
I
I
14
15
ILET line number t1eld
I
myself id field
16
17
18
= 1
• 9
I
19
ITYPE INITFLAG • INT
20
21
I
I
22
23
24
25
session .................. lINT PROC session :
I EXTERNAL 126
IENDPROC session
26
pcb ...................... lINT PROC pcb (INT CONST fleld)
I
27
I
2B
IENDPROC pcb
29
I
EXTERNAL B0
30
31
32
33
writepcb ................. IPROC write pcb (INT CONST task nr, fleld, value)
I EXTERNAL 105
IENDPROC write pcb
34
setlinenr ................ IPROC set line nr (INT CONST value)
I write pcb (pcb (myself id t1eld), line number field, value)
IENDPROC set line nr
35
36
37
I
I
I
3B
39
48
.•.•..................... IOP .' (INITFLAG VAR fl&«, BOOL CONST fl&«true)
I
41
42
43
44
45
46
47
4B
49
4/1
I
I
I
I
I
I
myselfno
IF fl&«true
THEN CONCR (fl&«) : = myse If no
EI.'lE CONCR (fl&«) :. 8
FI.
Imyself no
pcb (myself id field) AND 255 •
I
IENDOP :. ;
I
pcb and ini t control
4/1
E LAN
Zeile
50
1.8
*-*
10.11.86
52
53
54
55
56
57
myselfno
I
I IF CONeR (n~) = myself no
I
THEN TRUE
I
ELSE CONCR (fl~) := myself no
I
FALSE
I Fl.
I
I
Imyself no
pcb (myself 1d field)
I
AND 255 .
IENDPROC in1 t1alized
I
51
62
63
64
65
clock .................... IREAL PROC clock (INT CONST nr)
I EXTERNAL 102
IENDPROC clock
66
67
68
69
sto~e
70
71
72
73
1d ....................... I INT PROC 1d (INT CONST no)
I EXTERNAL 129
IENDPROC id
74
75
76
ke ....................... IPROC ke
I EXTERNAL 5
IENDPROC ke ;
I
.......•.......... IPROC stor~e (INT VAR size, used)
I EXTERNAL 89
IENDPROC stor~e
I
I
77
I
78
IENDPACKET pcb and init control
'12
pcb and init control
initialized .............. IBOOL PROC 1nit1alized (INITFLAG VAR flag)
51
58
59
60
EUMEL
pcb and ini t control
4/2
Zolle
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
E LAN
EUMEL
1.8 ••••
10.11.86
ciataspace
1(. ------------------- VERSION 3
cia tasp&Ce ....* ..... _ .... 1PACKET c1&taspace DEFINES
I
I
I
I
I
I
I
22.04.86 -------------------
nilspace •
forget.
type •
heap size,
stor&«e •
I cis pages •
next cis page •
I
blockout •
I
blockin •
I
I ALIGN:
I
I
ILET myself ici fielci = 9 •
I
lowest cis number = 4 •
I
highest cis number = 255
I
ITYPE ALIGN = ROW 252 INT
I
.- ..........••..••.••••.. IOP := (DATASPACE VAR ciest. DATASPACE CONST source)
I EXTERNAL 70
IENDOP : = ;
I
27
28
29
30
nilsp&Ce ..•••••.••..••••• IDATASPACE PROC nllspace
I EXTmIIAL 69
I ENDPROC nilsp&Ce
31
32
33
forget •••.•.••••••....••. I PROC forget (DATASPACE CONST c1&tasp&Ce
I EXTERNAL?1
I ENDPROC forget
M
35
36
37
38
I
I
type .•.......•••••.•••••• I PROC type (DATASPACE CONST cis. INT CONST type)
I EXTmIIAL 72
I ENDPROC type
I
39
40
41
42
type ..................... I INT PROC type (DATASPACE CONST cis)
I EXTERNAL 73
IENDPROC type
43
44
45
46
heapsize •••.•••..•••..•.• lINT PROC heap size (DATASPACE CONST cis)
I EXTERNAL 74
IENDPROC hea.p size
5/1
I
I
ciatasp&Ce
5/1
Zelle
47
46
49
~
:11
52
53
54
E LAN
EUMEL 1.6....
19.11.66
dataspace
storage .................. 1INT PIIOC storage (DATASPACE CONST ds)
1 (ds pages (ds) + 1) DIV 2
1ENDPIIOC storage
1
dspages .................. 1INT PROC ds pages (DATASPACE CONST ds)
1 pages (ds, pcb (myself ld field))
1ENDPIIOC ds pages
1
55
56
57
56
pages •••.....•••••..•••.. IINT PROC pages (DATASPACE CONST ds, INT CONST task nr)
1 EXTERNAL 66
IENDPROC pages
59
nextdspage ••••••........• 1INT PIIOC next ds page (DATASPACE CONST ds, INT CONST page nr)
1 EXTERNAL 67
1ENDPROC next ds page
69
61
62
1
1
63
64
65
66
67
blockout ......••......... IPROC blockout (DATASPACE CONST ds, INT CONST page nr, codel, code2,
1
INT VAH return code)
1 EXTERNAL 85
IENDPROC blockout
66
blockln ....•••••.....•••• IPROC blockln (DATASPACE VAH ds, INT CONST page nr, codet, code2,
1
INT VAH return code)
1 EXTERNAL 66
1ENDPIIOC blockln ;
69
79
71
72
73
5/2
1
1
IENDPACKET dat&space
dat&space
5/2
Zeile
1
2
3
4
5
6
7
8
9
10
11
12
E LAN
1. 8
EUMEL
--.
basic tr&nsput
19.11.86
I
b&sictransput ............ 1PACKET basic transput DEFIIIDl
I
out ,
I
outsubtext ,
outtext ,
TlMESOUT ,
cout t
displ&y ,
inch&r ,
inch&rety ,
C&t input,
plLuse ,
13
cursor ,
14
get cursor,
ch&nnel ,
online,
control,
blockout ,
blockin ;
15
16
17
18
19
2e
21
22
23
24
25
+
26
27
28
29
39
31
32
33
34
35
36
ILET ch&nnel field • 4 ,
I
bl&nk times 64 •
I
I
I
" .,
ILET BLOCKIO = STRUCT (ALIGN p&ge &lign, ROW 256 INT butter) ,
I
butter p&ge • 2
I
IBOUND BLOCKIO VAH block io ;
IDATASPACE VAH block io ds ;
IINITFLAG VAH this packet ;. FALSE
I
I
out ...................... IPROC out (TEXT CONST text
I
EXTDlNAL 69
37
IENDPROC out
38
I
39
49
41
42
43
44
45
46
47
48
49
59
51
52
53
6/1
outsubtext ............... IPROC outsubtext ( TEXT CONST source, INT CONST tram)
I EXTDlNAL 62
lEND PROC outsubtext;
I
outsubtext ...........•... IPROC outsubtext (TEXT CONST source, INT CONST tram, to)
I EXTDINAL 63
lEND PROC outsubtext;
I
outtext ...•.............. IPROC outtext ( TEXT CONST source, INT CONST from, to )
lout subtext (source, tram, to) ;
I INT VAH trailing ;
I IF from <. LENGTH source
I
THEN trailing .' to - LENGTH source
I
ELSE tralli ng ; - to + 1 - from
I FI;
b&sic transput
6/1
:leile
E LAN
~4
1.8 .._.
10.11.86
basic transput
I
I
IF trailing ) 0
THEN trailing TIMESOUT " "
I FI
IENDPROC outtext
~5
56
57
~
~9
EUMEL
I
TIMESOUT •................ IOP TIMESOlrl' (INT CONST times, TEXT CONST text)
I
60
61
62
I
I
I
IF text = "
THEN fast timesout blank
ELSE timesout
I
I
I
FI.
71
72
I
PER;
I
outsubtext (blank times 64, 1, times - i) .
73
I
I
63
64
65
66
67
68
fasttimesoutblank
69
70
74
75
76
77
timesout
Ifast timesout blank
I INT VAR i := 0 ;
I WHILE i + 64 ( times REP
l o u t (blank times 64) ;
I
i INCR 64
Itimesout :
I FOR i FROM 1 UPl'O times REP
I
out( text)
I ENDREP.
78
79
I
80
I
81
82
83
84
85
86
87
88
89
90
91
IENlXlP TIMESOlrl'
display .................. lpROC display (TEXT CONST text)
I IF online
I
THEN out (text)
I FI
IENDPROC display
I
incbar ................... IPROC incbar (TEXT VAR character )
I
I
incb&rety •.••............ ITEXT PROC incb&rety
I
94
I
9~
97
98
99
EXTERNAL 64
IENDPROC incbar
92
93
96
ft
EXTERNAL 65
IEND PROC incb&rety
incbarety .....•••...•.... ITEXT PROC incbarety (INT CONST time limit)
I internal pause (time limit) ;
I lncbarety
IENDPROC incb&rety
I
basic transput
6/2
ZeUe
E LAN
1.8 ****
EUMEL
basIc transput
10.11.86
lee
101
1132
103
194
pause .................... IPROC pause (INT CONST tIme limit)
I Internal pause (tIme lImIt) ;
I TEXT CONST dummy :. Inch&rety
IENDPROC pause
10:!
1136
107
108
pause .......•............ IPROC pause
I TEXT VAH duDIIIIY; Inch&r (dummy)
IENDPROC pause
109
110
111
112
internalpause ............ IPROC Internal pause (INT CONST tIme limIt)
I EXTERNAL 66
IENDPROC internal pause
113
114
115
116
117
catinput ................. IPROC cat Input (TEXT YAH t, esc char)
I EXTERNAL 68
IENDPROC cat input
118
119
129
121
122
123
cursor ................... IPROC cursor (INT CONST
lout (""6"") ;
lout (code(y-1»
I out (code(x-l»
IENDPROC cursor
124
getcursor ................ IPROC get cursor (INT VAH x, y)
I EXTERNAL 67
IENDPROC get cursor
125
126
127
I
I
I
I
I
x, y)
I
I
128
129
138
131
132
cout ..................... IPROC cout (INT CONST number)
I EXTERNAL 61
IENDPROC cout
133
134
13:1
136
ch&nnel ......••.•........ lINT PROC channel
I pcb (channel field)
IENDPROC channe 1
137
138
139
148
141
online ................... IBOOt PROC online
I pcb (channel field) () 0
IENDPROC online
6/3
I
I
I
I
I
basic transput
6/3
ZeUe
E LAN
BIIIEL
1.8 -
18.11.86
bas1c transpJt
142
143
144
145
control .................. IPIIlC control (INT CIOIIST code1, code2, code3, INT VAH return code)
I EXTIRNAL 84
IEIIDRIOC control
146
147
148
149
158
151
152
blackout ................. IPIIlC blockout (1IlW 256 INT CIOIIST block, INT CIOIIST code1, cocle2,
I
INT VAH return code)
153
154
155
156
157
158
159
168
161
162
163
164
165
166
167
168
169
178
171
172
173
174
175
176
177
178
6/4
I
I
I
I
I
accessblock1ods
access block 10 cis ;
block 10. blUer : z block
blockout (block 10 ds, blUer page, code1, code2, return code)
I
I
Iaccess
block 10 cis
I IF NOT 1nitlalized (tbis packet)
I THEIl block 10 ds : ~ nilspace
In;
I block 10 :. block 10 cis
I
IENIlPIIlC
I
blockout
blockin ...•...•.......... IPIIlC block1n (ROW 256 INT VAH block, INT CIOIIST code1, code2,
I
INT VAH return code)
I
I
I
I
I
I
accessblockiods
access block 10 cis ;
block1n (block 10 cis, blUer page, code1, code2. return code)
block:. block 10. bltter
laccess block 10 cis :
IF NOT Inl tialized (tbis packet)
THEIl block 10 ds : = nilspace
FI;
block 10 :. block 10 cis
I
I
I
I
I
IENDPROC
I
blockln ;
IENDPACKET lBslc transpJt
I
I
bas1c transpJt
6/4
Zelle
1
2
3
4
5
6
7
8
9
18
11
12
13
14
15
7/1
ELAN
lDIEL
1.8 -
18.11.86
bool
1
bool ••••••••••••••••••••• IPACKBr 0001 DEFINES XCII, true, false
1
IBOOL caIST true := TRUE ,
1
1
false:. rALSE ;
l{(lI •.••.•.••.•••...•••••• IBOOL OP l{(lI (BOOL COIIST lett, rtsbt)
1
1 IF lett 'llIDI NO'l' rtsbt
1
ELSE r18bt
1 F1
1
IENOOP X(lI
1
IEN1lPACKET bool
bool
7/1
E LAN
Zeile
+
+
4
5
10.11.86
integer
I
minint ..............•.... I INT PROC minint
-32767 - 1 ENDPROC minint
I
8
9
10
11
lI\&Xint ................... lINT PROC lI\&Xint
12
13
14
15
16
17
18
19
text ..................... ITEXT PROC text (INT CONST number) :
20
21
22
2C
I
digi t
I
code ( number MOD 10 + 48 ) .
I
I
I
I
I
I
I
I
I
I
number = minint THEN "-32768"
number ( 0
THEN "-" + text( -number)
number ( = 9
THEN code (number + 48)
EUlE text (number DIV 10) + digit
text
TEXT VAR result := text (number) ;
INT CONST number length :. LENGTH result
IF number length ( length
THEN (length - number length) • " " + result
ELIF number length ) length
THEN length" " .. "
EUlE
result
FI
IENDPROC
text
I
int .•••••..••••..••..•.•• IINT PROC int (TEXT CONST number)
I
I
39
4e
41
I
42
43
&/1
IF
I ELIF
I ELIF
I
I FI.
I
I
Idigit
text •••.................. ITEXT PROC text (INT CONST number, length)
29
3e
31
32
33
M
35
36
37
44
45
46
47
48
I
I
IENDPROC
I
2B
3B
32767 ENDPROC lI\&Xint
I
I
24
25
26
27
23.10.85
integer .................. IPACKET integer DEFINES text, int, MOD,
I
sign, SIGN, &bs I ABS, •• , min, max, minlnt,
I
lI\&Xint,
I
random, initialize random ,
I
last conversion ok, set conversion
6
7
-
1(. ------------------- STAND:
I
--------------------.)
1
2
3
1.8
EllMEL
skipbl&nksancisign
skip blanks and sign
get value
result.
I
I
I
Iskip blanks and sign
I BOOL VAR number is
I
I
I
positive
INT VAR pos :. 1 ;
skip blanks ;
IF (number SUB pos) • " "
integer
8/1
Ze1le
--
ELAN
EUMEL
I
getvalue
61
62
63
64
65
getfirstc1igit
73
74
75
iSd1gi t
76
77
dlgi t
78
79
result
ee
83
setconversionokresult
86
67
~
91
92
93
94
95
96
97
98
99
lee
8/2
I
Iget value
I IN'! VAH value
I get first digi t
I WHILE is digit REP
I
value:. value • 10 + digit
I
pos INCR 1
I PER;
I set conversion ok result
I
I
Iget first digit:
I IF is digit
I
THEN value : = digi t
I
pos INCR 1
I
ELSE set conversion (FALSE)
I
LEAVE int WITH 0
I Fl.
I
I
11S dlgl t : 0 <. dlgi t AND dlgit <. 9
I
I
Idigit : code (number SUB po.) - 48 .
I
I
81
82
88
89
integer
THEN number is posi ti ve : = FALSE
pos INCR 1
ELIF (number SUB pos) • "+"
THEN number is positive : = TRUE
I
pos INCR 1
I ELSE
number is posi ti ve : = TRUE
I Fl.
se
84
85
10.11.86
I
I
I
56
66
67
68
69
70
71
72
._.
I
49
50
51
52
53
54
55
57
58
59
1.8
skipbl&nks
Iresult :
I IF number is positive
I
THEN
value
I
ELSE - value
I FI.
I
I
Iset conversion ok result
I skip blanks ;
I conversion ok :. (pos ) LENGTH number)
I
I
Iskip blanks
I WHILE (number SUB pos) • " " REP
I
I
I
~mCR1
PER.
IENDPROC int
I
I«lD ...................... I IN'! OP I«lD (IN'! CONST left. right)
I
I EXTERNAL
I
IENlXlP I«lD
I
43
integer
8/2
Zeile
181
182
183
....
ELAN
EUMIL 1.8....
s1gn •••••••••••••••••••••
18.11.86
....
integer
lINT PROC sign (INT IXlIST arsu-nt)
I
I IF arsu-nt ( 8 '11II!If -1
I ELII' arsu-nt > 8 '11II!If 1
I ELSE 8
I FI
184
185
186
I
187
188
189
IENllPROC s1gn ;
I
118
111
112
113
SIGN ••...........•....... lINT OP SIGN (INT OONST arsu-nt )
I s1gn (arsu-nt )
IDIlXlP SIGN
114
115
abs ...................... lINT PROC abs (INT CONST arsu-nt )
I
I
I IF argument > 8
I ElSE - arguant
I FI
I
116
117
118
119
128
IENllPROC abs
121
I
122
123
124
125
126
127
128
129
138
131
132
133
134
135
136
137
138
139
148
141
142
ABS .....................• I INT OP ABS (INT CONST argument)
I abs (argument)
IENroP ABS
I
........................
INT OP .. (INT CONST arg, exp)
INT YAH x : = arg , Z : = 1 ,
counter :. exp
IFexp.e
THEN LEAVE .. WITH 1
ELIF exp ( e
THEN LEAVE .. WITH 1 DIY arg
FI ;
WHILE counter >= 2 REP
calculate new x and z
counter :. counter DIY 2
nmu:P ;
z .. x •
143
144
145
146
147
148
calculatenewxandz
149
158
151
152
counter1snoteven
8/3
THEN a.rgu.ent
Icalculate new x and z
I IF counter 1s not even
THEN z :. z • x
I
I FI ;
I X:aX*X.
I
I
Icounter 1s not even
I counter MOD 2 • 1
I
IENroP" ;
integer
8/3
Zene
e
integer
18.11.86
tin ..........•........... 1!NT RtOC ain (INT IXIIST tirst, second) :
158
1
1 IJ' tirst < second
1
IINDl'ROC ain
159
1
156
157
THEIl tirst ELSE second J'I
168
161
162
163
164
165
166
167
168
169
.ax •••••••••••••••••••••• 1INT RtOC .ax (!NT IXIIST tirst, second) :
178
lastcormorsionok ......... IBOOL RtOC last conversion ok
1 conversion ok
IINDl'ROC last conversion ok
171
172
173
e
EUMEL 1.8....
153
154
155
e
ELAN
174
175
176
177
178
179
188
181
182
183
184
185
186
187
188
189
198
191
192
193
194
19!1
196
197
198
199
2eQ
281
282
283
284
8/4
1
1
IJ' tirst > second THEIl tirst ELSE second J'I
1
IINDl'ROC .ax
1
I
1
IBOOL YAH conversion ok :. TRUE
I
I
setcormorsion •••••••••••• 1RtOC set conversion (BOOL IXIIST success)
1 conversion ok : = success
II!2IDPIIOC set conversion
1
1
1
1(··················································· ................ )
III (I (1(I (1(1(1(-
-)
Autor: A. J'laaIIIenkalllp
RANInI GENERATOR
-)
x
.•
4895 - x
n+l
MOD (4895-4896+4893) -)
n
-)
-)
Periods: 2-24-4
16.886
-)
1(-
1(1(·
-)
-)
-)
Beachte:
x = 4896. xl + xe,
8 <= xe,x1 < 4896
.)
.)
1(·································""················ ........•......• )
I
I
lINT YAH high
.=
1, low .-
e
I
ini tial1zerandolD ..•...... IRtOC initialize random (INT CONST start)
I
I
I
I
low:. start MOD 4896 ;
IF start < e
THEN high := 2!l6 + 16 + start DIY 4896
IF low < > e THEN high DECR 1 J'I
EUlE high :. 256 + start DIV 4896
I
I
In
integer
8/4
Zelle
-
ELAN
EUMEL
1.6
113.11.66
••-
integer
I
IENDPROC initialize random
I
2e6
random ................... lINT PROC random (INT CONST lower bound, upper bound)
~9
I
2113
211
212
213
214
I compute new random value
I normalize high ;
I normali ze low ;
I map into interval
215
216
217
216
219
computenewrandomvalue
220
221
222
223
normalizehigh
Icompute new random value
I (. (high,low) :. (low-high, 3-high-low) .)
I high:= low - high ;
I low INCR low - 3 • high ,
I
I
224
225
I
I
normalize low
226
227
Inormalize high :
I IF high < e
I
THEN high INCR 4096
I Fl.
low DECR 3
I
I
I·normalize low
I ( • high INCR low DIY 4096
I
low : = low MOD 4096
226
I .)
229
23e
I IF low ). 4096 THEN low overflow
I ELIF low < 0
THEN low underflow
I Fl.
231
I
I
232
233
lowoverflow
234
235
236
237
236
239
postnormalization
240
241
242
243
244
245
246
247
Ilow overflow
I IF low). 6192
I
THEN low DECR 6192
I
ElSE low DECR 4096
I Fl.
high INCR 2
high INCR 1
post nomalization
I
I
lpost normalization
I (. IF (high,low) ). (4095,4093)
I
THEN (high, low) DECR (4095,4093)
I
FI
I .)
I
I
I
I
I
I
I
246
249
250
251
252
lowunderflow
253
254
255
256
257
mapintointerval
IF high ). 4095
TIIEN IF
low
ELIF high
FI
Fl.
>.
4093 TIIEN high DECR 4095
high : = e
= 4096 TIIEN
low DECR 4093
low INCH 3
Ilow underflow
I low INCR 4096 ; high DECR 1
I
I
lmap into interval
I INT YAH number :. high II)D 16 - 6
I number INCR 4095 • nUliber + low ;
I IF lower bound <. upper bound
I
TIIEN lower bound + nllllber II)D (upper bound - lower bound + 1)
integer
8/5
Zelle
2M
259
260
261
.....
E LAN
EUMEL
1.8 ••••
ELSE
I
I FI .
I
10.11.86
upper bound + number MOD (lower bound - upper bound + 1)
IENDPROC random
263
I
I
264
IENDPACKET integer
262
8/6
integer
integer
8/6
Zaile
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
2B
29
30
31
32
33
34
35
36
37
3B
39
40
41
42
43
44
45
46
47
48
49
50
9/1
E LAN
EUMEL
1.8 ****
error handl1 ng
10.11.86
I
errorhandling *********.**IPACKET error handling DEFINES
I
I
enable stop •
I
dis&ble stop •
I
is error.
I
cle&r error •
I
errormessage.
I
error code •
I
error line •
I
put error •
I
errors top •
I
stop:
I
I
ILET cr It'
I
line nr field
I
error line field
I
error code field
I
syntax error code=
I
I
error pre
I
I
ITEXT VAR errortext .'
I
I
""13""10""
1
2.
3.
100
""7""13""10""5"FEIILER
en&blestop ............... IPROC ena.ble stop :
I EXTERNAL 75
IENDPROC enable
I
stop
dis&blestop .............. IPROC dis&ble stop :
I EXTERNAL 76
IENDPROC dis&ble
I
stop
seterrorstop ............. IPROC set error stop (INT CaNST code)
I EXTERNAL 77
IENDPROC set error
I
stop ;
iserror .................. IBOOL PROC is error
I EXTERNAL
IENDPROC is
I
78
error ;
cle&rerror ............... IPROC cle&r error :
I EXTERNAL 79
IENDPROC cle&r
I
error
selecterrormessage ....... IPROC select error message
I
I
SELECT error code OF
error handling
9/1
Zeile
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
E LAN
1.8
EUMEL
,,
,,
....
CASE 1
CASE 2
CASE 3
CASE 4
CASE 5
CASE 6
CASE 7
CASE 8
CASE 9
CASE 10:
CASE 11:
CASE 12:
CASE 13:
CASE 14:
CASE 15:
CASE 16:
CASE 17:
END SELECT
,'ENDPROC
error handling
113.11.86
·
·
error text error text error text :=
error text : =
error text : =
error text :.
error text :.
error text : =
error text · error text
error text error text :=
error text : =
error text :=
error text : =
error text error text · -
·.
·
·
select error mess'4!!e
78
errormess'4!!e ............. 'TEXT PROC error mess'4!!e :
,
, select error mess'4!!e
, error text
,
'ENDPROC error mess'4!!e
,
79
80
81
82
83
errorcode ................ 'INT PROC error code :
,
, pcb (error code field)
,
'ENDPROC error code
77
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
180
9/2
"'halt' vom Terminal"
"Stack -Ue ber laut"
"Heap-Ueberlauf"
"INT-Ueberlaut"
"DIV durch 0"
"REAL-Ueberlaut"
"TEXT-Ueberlauf"
"zu viele DATASPACEs"
"Ueberlauf bei Subskription"
"Unterlauf bei Subskription"
"falscher DATASPACE-Zugriff"
"INT nicht initialisiert"
"REAL nicht ini tialisiert"
"TEXT nicht initialisiert"
"nicht implementlert"
"Block unlesbar"
"Codefehler"
,
errorl1ne ................ 'INT PROC error line
,
, IF is error
,
THEN pcb (error line field)
,
ELSE 0
, FI
,
'ENDPROC error line
,
syntaxerror ....•......... 'PROC syntax error (TEXT CONST mess'4!!e)
,
, INTERNAL 259 ;
, errors top (syntax error code, mess'4!!e) .
,
'ENDPROC syntax error ;
,
error handl1ng
9/2
ZeUe
101
102
103
104
105
E LAN
1.8
I
I
I
errors top (0, message)
IENDPIIOC errors top
I
errors top ................ IPROC errors top (INT CONST code, TEXT CONST message)
I
108
I IF NOT
I THEN
I
w i n
113
I
109
110
111
I
115
puterror ................. IPROC put error
I
I
I
I
I
I
I
I
117
118
119
120
121
122
123
124
125
126
127
128
129
130
puterrormessage
THEN select error message
IF error text () ~~
THEN put error message
FI
Fl.
lout (error pre)
lout (error text) ;
I IF error line ) 0
I
THEN out (" bei Zeile
I
I
134
I
~);
out (text (error line»
FI;
lout (cr
If)
.
IENDPIIOC put error
stop ..................... IPROC stop :
136
137
I
I
1~
I
139
140
141
I
9/3
IF is error
I
Iput error message
131
132
133
135
1s error
error text :. message
set error stop (code)
IENDPROC errors top
114
116
error handling
10.11.86
-
errors top ................ IPROC errors top (TEXT CONST message)
106
107
EUMEL
errors top ("stop")
IENDPROC stop;
IENDPACKET error h&ndling
error h&ndling
9/3
Zeile
E LAN
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
real
EUMEL
1.8
lABS,
I
I
I
sign,
SIGN,
MOD,
min,
20
21
22
I
23
I
24
25
IlEI'
I
I
I INT
I
27
28
29
30
31
32
33
M
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
10/1
05.05.86 ------------------- *
(* Autor: J . Liedtke •
I
text,
lint,
I
real,
I
round,
I
floor,
I
frac,
I
decimal exponent
I
set exp ,
I
INCR,
I DEeR,
labs,
17
26
VERSION 6
IPACm real DEFINES
I
18
real
10.11.86
----* 1(*I -------------------
16
19
--
I
I
max,
max real ,
small real
mantissa length = 13 ,
digit zero index = 1 ,
digi t nine index = 10 ;
CONST
decimal point index :. -1
I
ITEXT VAR mantissa ;
I
IROW 10 REAL VAR real digit
I
lINT VAR i ; REAL VAR d := 0.0
IFOR i FROM 1 UPl'O 10 REP
I real digit (1) : = d ;
I d:= d + 1.0
Ipm
I
maxreal .................. IREAL PROC max real
9.9999999999990126 ENDPROC max real
I
smallreal ................ IREAL PROC small real
1. 08-12 ENDPROC small real
I
sId ...................... IPROC sId (INT CONST in, REAL VAR real, INT VAR out)
I EXTmNAL 96
IENDPROC sId
I
decimaloxponent .........• lINT PROC decimal exponent (REAL CONST mantissa)
I EXTmNAL 97
IENDPROC decimal exponent
I
real
10/1
Zelle
E LAN
52
setexp ...................
53
54
55
EUMEL
1.8
---
10.11.86
Imoe set exp (INT
I EXTERNAL 98
IENDPROC set exp ;
I
reAl
CONST exponent, REAL VAR number)
56
57
58
59
50
61
tenpower ................. IREAL PROC tenpower (INT CONST exponent)
I REAL VAR result := 1.0 ;
I set exp (exponent, result) ;
I result
IENDPROC tenpower
62
floor ...............•.... IREAL PROC floor (REAL CONST reAl)
I EXTERNAL 99
IENDPROC floor ;
63
64
65
66
67
68
69
I
I
round .................... IREAL PROC round (REAL CONST reAl, INT CONST digits)
I
I
I
I
I
I
I
+
70
71
72
73
74
75
76
77
78
79
8El
81
82
83
84
85
86
87
88
roundresul t
REAL VAR result : = reAl ;
IF (reAl () 0.0) CAND (decim&l exponent (reAl)
length)
THEN round result
FI;
result.
+
digits ( m&ntiss&
I
I
Iround result
I set exp (decim&l exponent (result) + digits, result)
I IF result ). 0.0
I
THEN result: = floor (result + 0.5)
I
ELSE result :. floor (result - 0.5)
I Fl;
I IF result () 0.0
I THEN set exp (decima.l exponent (result) - digits, result)
I FI.
I
IENDPROC round
I
ITEXT VAR result
I
text.. .. .. .. .. .. .. .. .. ... TEXT PROC text (REAL CONST reAl) :
89
ge
91
92
93
94
95
96
97
98
99
100
101
102
103
10/2
REAL VAR VAlue :. rounded to seven digi ts
IF vAlue. 0.0
THEN ~0.0~
ELSE
proces s sign
get m&ntissA (vAlue)
INT CONST exponent : = decim&l exponent (vAlue) ;
get short ma.ntissA ;
IF exponent ) 7 OR exponent ( LENGTH short IIIILntissA - 7
THEN scientific notAtion
ELSE short notAtion
FI
FI .
reAl
10/2
1.8 ••••
EUMEL
Zaile
E LAN
104
105
106
107
rounded tosevendigi ts
108
109
110
111
112
113
114
processsign
115
116
117
118
119
120
121
getshortmantissa
122
123
124
125
126
127
scientificnotation
128
129
130
131
132
133
134
shortnotation
10.11.86
real
Irounded to seven digits :
I round ( real. tenpower( -decimal exponent( real) ) , 6 )
I
• tenpower ( decimal exponent(real) ) .
I
I
Iprocess sign :
I IF value ( 0.0
THEN result := " - " .,
I
value : = - value
I
ELSE result . s
I
I FI .
I
I
Iget short mantissa :
lIlT VAH i : = 7 ;
I WHILE (mantissa SUB 1) • "0" REP
!
iDECRl
I UNTIL i=l END REP ;
I TEXT CONST short mantissa := sUhtext (mantissa, 1, i) .
I
I
I
Iscientific notation :
I result CAT (mantissa
I
I
I
I
I
135
136
137
138
139
140
141
142
SUB 1) ;
result CAT"." ;
result CAT suhtext (mantissa, 2, 7)
result + "e" + text (exponent) .
short notation :
IF exponent ( 0
THEN result + "0." + (-exponent - 1) • "0" + short mantissa
ELSE result CAT suhtext (short mantissa, 1, exponent+l) ;
result CAT (exponent+l - LENGTH short mantissa) • "8" ;
result CAT"." ;
result CAT suhtext (short mantissa, exponent+2)
IF LENGTH short mantissa ( exponent + 2
THEN result + "0"
ELSE result
FI
FI .
IENDPROC
I
text
143
144
145
146
147
148
149
150
151
152
153
154
getmantissa .............. IPROC get mantissa (REAL CONST number)
155
156
157
text ..................... ITEXT PROC text (REAL CONST real, INT OONST length) :
10/3
I
I
I
I
I
I
I
I
I
REAL VAH real mantissa : = number ;
mantissa: = n ;
lIlT VAH i , digit;
FOR i FROM 1 UPl'O mantissa length REP
sld (0, real mantissa, digit) ;
mantissa CAT code (digit + 48)
PER;
IENDPROC get mantissa
I
I
I
lIlT CONST mantissa length := min (length - 7, 13) ;
real
10/3
Ze1le
E LAN
158
159
160
161
162
163
EUMEL
1.8
,
,
,
****
10.11.86
••••
real
IF mantissa length > El
THEN construct scientific notation
ELSE result : = length. "."
'FI;
,
,
result.
,
164
165
166
167
168
169
170
171
172
constructscientificnot 'construct SCientific notation:
, REAL VAR value : = rounded real
, IF value = 0.0
,
THEN result := subtext (" 0.0
,
ELSE process sign ;
' p r o c e s s mantissa
' p r o c e s s exponent
, FI.
,
173
174
+
175
176
roundedreal
177
178
179
180
181
182
processsign
183
184
185
186
187
188
processmantissa
189
190
191
192
193
194
195
196
197
198
processexponent
199
280
201
202
203
204
285
2$6
207
208
209
210
211
1El/4
", 1, length)
,
'rounded real
, round (real • tenpower ( -decimal exponent (real)) , mantissa
,
length - 1)
, • tenpower (decimal exponent (real)) .
,
,
'process sign :
, IF value < 0.8
,
THEN result . - " "
,
ELSE result := "+"
,Fl.
,
,
'process mantissa :
, get mantissa (value)
, result CAT (mantissa SUB 1) ;
, result CAT "." ;
, result CAT subtext (ma.ntissa, 2, ma.ntissa length) .
,
,
'process exponent :
IF decimal exponent (value) >= El
,
THEN result CAT "e+"
,
ELSE result CAT "e-"
, FI;
, result CAT text (ABS decimal exponent (value), 3)
, change all (result, " ", "0") .
,
,ENDPROC text
,
I
text ..................... 'TEXT PROC text (REAL CONST real, INT CONST length, !racs)
,
, REAL VAR value :. round (real, !racs) ;
I INT VAR exponent : = decimal exponent (value)
, I F value = 8.0 THEN exponent :. 0 FI
, INT VAR floors
:. exponent + 1 ,
, f l o o r length :. length - fracs - 1 ;
, I F value < 8.El THEN floor length DECR 1 FI
,
, IF value too big
,
TIIEN length • • ••
,
ELSE transformed value
,
FI.
real
18/4
ZeUe
E LAN
EUMEL
1.8
--
1e.11.86
rea.l
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
transformedva.lue
231
232
233
234
235
236
237
processleadingbla.nksa.n Iprocess leading blanks a.nd sign:
I result:= (floor length - ma.x(floors,e» •
I IF va.lue ( €I.e
I
THEN result CAT "-" ;
I
va.lue : = - va.lue
I FI.
I
238
239
va.luetoobig
tra.nsformed va.lue
process leading bla.nks a.nd sign
get mantissa. (va.lue) ;
result CAT subtext (mantissa., 1, floors)
IF LENGTH mantissa. ( floors
THEN result CAT (floors - LENGTH mantissa.) • "€I"
FI ;
result CAT "." ;
IF exponent ( €I
THEN result CAT (-floors) • "€I" ;
result CAT subtext (mantissa., 1, length - LENGTH result)
ELSE result CAT subtext (mantissa., floors+1, floors + fracs)
FI ;
IF LENGTH result ( length
THEN result CAT (length - LENGTH result) • "€I"
FI ;
re~lt.
I
I
~e
~1
IENDPROC text
I
~2
~3
Iva.lue too big :
I floors) floor length
rea.l ..................... IREAL PROC rea.l (TEXT CONST text)
I
~4
~!j
I
I
I
I
I
~6
24 7
~8
249
250
skip leading bla.nks
sign;
mantissa. part
exponent
result.
I
I
2:51
2:52
253
254
skipleadingbl&nks
255
256
257
258
259
skipblanks
260
261
262
263
sign
Iskip leading bla.nks
I INT VAH pos := 1 ;
I skip bla.nks
I
I
Iskip blanks
I WHILE (text SUB pos) • " " REP
I
pos INCR 1
I PER.
I
I
264
265
1e/5
Isign
BOOL VAH nega.tive
I IF (text SUB pos)
""
I
THEN nega.ti ve :. TRUE
I
pos INCR 1
I ELIF (text SUB pos) • "+"
I
rea.l
18/5
Zeile
E LAN
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
1.8 ****
EUMEL
I
I
I
I
I
I
mantlssapart
284
real
THEN negative:; FALSE
pos INCR 1
ELSE
negative:; FALSE
Fl.
Imantissa part:
I REAL VAH value
I INT VAH exponent pos :; 0 ;
I get first digit;
I WHILE pos <; LENGTH text REP
I
digi t :; code (text SUB pos) - 47 ;
I
IF digit); digit zero index AND digit <; digit nine index
I
THEN value :; value * 10.0 + real digit (digit)
I
pos INCR 1
I
ELIF digit; decimal point index AND exponent pos ; 0
I
THEN pos INCR 1 ;
I
exponent pos :; pos
I
ELSE LEAVE mantissa part
I FI
I
I
285
286
10.11.86
END REP .
I
287
288
289
290
291
292
getfirstdigi t
Iget first digit
INT VAH digit :. code (text SUB pos) - 47
IF digit = decimal point index
THEN pos INCR 1 ;
exponent pos : = pos ;
digit: = code (text SUB pos) - 47
FI;
IF digit) = digit zero index AND digit <. digit nine index
THEN value : = real digit (digi t)
pos INCR 1
ELSE set conversion (FALSE)
LEAVE real WITH 0. 0
FI •
301
302
303
304
305
306
307
308
309
310
Ml
exponent
Iexponent
I INT VAH exp
I IF exponent pos ) 0
I
THEN exp :; exponent pos - pos
I
ELSE exp : = 0
I FI;
I IF (text SUB pos) = "e"
I
THEN exp INCR int (subtext( text,pos+l»
I
ELSE no more nonblank chars permitted
I Fl.
312
313
314
315
316
317
318
nomorenonblankcharsper Ino more nonblank chars permitted
I skip blanks ;
I IF po s ) LENGTH text
I
THEN set conversion (TRUE)
I
ELSE set conversion (FALSE)
I FI.
319
320
321
322
result
~3
294
295
296
297
298
299
300
I
lEl/6
I
I
I
I
Iresult
I value: = value
I IF negative
I
THEN - value
real
* tenpower (exp)
10/6
E LAN
Zeile
:325
:326
327
328
336
:337
33B
:339
340
341
342
343
344
345
346
347
348
~
~0
351
352
~:3
354
~5
356
357
~8
~9
360
361
362
363
364
365
366
367
368
369
370
371
372
10/7
1.8
****
10.11.86
****
real
I
ELSE value
I FI.
I
IENDPROC real
I
I
:323
:324
:329
338
:331
:3:32
3:33
:334
335
EUMEL
abs
...................... IREAL PROC abs (REAL
I
I IF value
0.0
TIIEN value
I
ELSE -value
I
I FI
I
IENDPROC abs
I
CONST value)
)=
ABS ...................... IREAL OP ABS (REAL CONST value)
I
labs (value)
I
IENOOP
I
ABS
sign ..................... lINT PROC sign (REAL CONST value)
I
I
I
I
IF
value ( 0.0 TIIEN -1
ELIF value = 0.0 TIIEN 0
ELSE
1
I IT
I
IENDPROC
I
sign
SIGN ..................... I INT OP SIGN (REAL CONST value)
I
I sign (value)
I
IENOOP SIGN
I
MOD ...................... IREAL OP MOD (REAL CONST left. right) :
I
I
I
I
I
I
REAL VAR result := left - floor (left/right)
* right
IF result ( 0.0
THEN result + abs (right)
ELSE result
FI
I
IENOOP
I
MOD
frac ..................... IREAL PROC frac (REAL CONST value)
I
I
value - floor (value)
I
real
10/7
Zaile
....
ELAN
EUMEL 1.8 ••••
10.11.86
373
IENDPROC frae
374
I
375
376
377
378
379
380
381
382
383
max ...................... IREAL PROC max (REAL CONST a, b)
I
I
I
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
18/8
b)
I
I
I
398
b THEN a ELSE b FI
min ...................... IREAL PROC min (REAL CONST a,
385
386
393
394
395
396
397
>
IENDPROC max
I
391
392
IF a
I
384
387
388
389
3~
real
IF a < b THEN a ELSE b FI
IENDPROC min
INCR ..................... Iop INCR (REAL VAR dest, REAL CONST increment)
I
I dest:= dest
+
increment
I
IENDOP INCR
I
DECR ••.•.••.•••..•••...•• IOP DECR (REAL VAR dest, REAL CONST decrement)
I
I dest:= dest - decrement
I
IENDOP
I
DEeR
int ...................... lINT PROC int (REAL CONST value)
I
I IF value = minint value
THEN minint
I
ELSE compute int result
I
IF value < 0.0
I
THEN - result
I
ELSE
result
I
FI
I
I FI .
I
I
computeintresul t
Icompute int result:
I INT VAR result := 0, digit ,i ;
I REAL VAR mantissa := value;
I
I FOR i FROM 0 UPTO decimal exponent (value) REP
sld (0, mantissa, digit) ;
I
result := result. 10 + digit
I
I PER .
I
I
minintvalue
- 32768.@ .
Iminint value
real
18/8
E LAN
Zeile
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
minint
EUMEL
1.8
10.11.86
Iminint
real
- 32767 - 1 .
I
IENDPROC int
I
real ..................... IREAL PROC real (INT CONST value)
I
I
I
I
I
I
I
I
I
I
IF value < 0
THEN - real (-value)
ELIF value < 10
THEN real digit (value+l)
ELSE split value into head and last digit;
real (head) * 10.0 + real digit (last digit+l)
FI.
spl1 tvalueintoheadandl I spli t value into head and last digit
I INT CONST
I head: = value DIV 10 ,
I last digit .• value - head * 10 .
438
I
439
440
441
I
10/9
*-*
IENDPROC real
IENDPACKET real
real
18/9
Zeile
1
2
3
..
5
6
r LAN
~.8
EUMEL
16
+
17
18
19
20
21
22
23
+
24
+
25
26
+
27
:0.11.86
date handli ng
(. ,:..utor: H.
datehandling **••••••** ••• IP~.CKET date handling DEfINES date, time,
I
Indenbirken·)
time of day.
I. Stand:
i
02.06.1986 (wk)·)
I
month, day , year ,
I
hour,
I
r.linute,
I
second
I
ILET
7
8
9
10
11
12
13
14
15
**..
I
I
I
I
I
I
1(.
I
middle yearlength = 31557380.0,
weeklength
604800.0,
daylength
86400.0,
hours
3600 . 0 ,
minutes
60.0,
seconds
1.0;
T~e
bis zum Jahr 01.01.1900: 693970.25
.)
1(* Dieser
T~
ist ein
Mon~
IREAL VAH begin of today .- 0.0 , end of today .- 0.0
I
ITEXT VAH today, result
I
I
IROW 12 REAL CONST previous days
5097600.0,
ROW 12 REAL : (0.0, 2678400.0,
I
I
I
I
I
I
I
I
7776000.0, 10368000.0,
1:3046400.0,
15638400.0. 18316800.O,
20995200.0,
23587200.0, 26265600.0,
28857600.0);
day ...•.................. IREAL PROC day: day length END PROC day;
29
hour ..•.................. IREAL PROC hour: hours
:30
minute ................... IREAL
31
32
second ................... IREAL PROC second: seconds END PROC second;
33
34
date ..................... ITEXT PROC date
35
37
38
39
moc
END PROC hour;
minute: minutes END PROC minute;
I
I
I
I
I
I
I
I
%
41
42
I
43
I
11/1
Sekunden
I·)
I
28
36
5.995903910
I
IF clock (1) ( begin of today OR end of today ( = clock (1)
THEN begin of today : = clock (1) ;
end of today : = floor (begin of
today/daylength).daylength+daylength;
today := date (begin of today)
FI;
today
IENDPROC date
date handling
11/1
Zeile
44
45
46
****
ELAN
,
,
,
,
,
,I
,
61
62
63
64
65
leapyear
n
M
88
89
~
M
92
93
94
95
96
97
98
~
100
101
11/2
«
,,correct kalendary day;
correctkalendaryday
78
79
00
81
82
83
54
85
86
date handling
10.11. 86
,
57
58
59
60
67
68
69
70
71
72
73
74
75
76
****
date ..................... 'TEXT PROC date (REAL CONST datum):
, INT VAR year:: int (datum/middle yearlength),
,
day :: int
(datum - datum MOD daylength) MOD middle
,
year length) / daylength) + 1;
47
48
49
50
51
52
53
54
55
56
66
1. 8
EUMEL
calculate month and correct day;
result:. day text ;
result CAT monthtext;
result CAT yeartext;
change all (result, "" "€I")
result.
,correct kalendary day:
IF day ) = 60 AND NOT leapye&r
, THEN day INCR 1 FI
,
!
,
'leapyear:
IF year MOD 100 = 0
THEN year MOD 400 •
,
,
ELSE year MOD 4 = 0
, FI.
I
e
,I
calculatemonthandcorre ,calculate month and correct day:
, INT VAR month;
, IF day ) 182
, THEN IF day ) 274
THEN IF day ) 305
THEN IF day ) 335
THEN month : = 12;
day DEX:R 335
ELSE month : = 11;
day DEX:R 305
TI
ELSE month : = 10;
day DEeR 274
TI
ELSE IF day ) 213
THEN IF day ) 244
THEN month : = 9;
day DEX:R 244
ELSE month : = 8;
day DEX:R 213
TI
ELSE month : = 7;
day DEeR 182
TI
TI
ELSE IF day ) 91
THEN IF day ) 121
THEN IF day ) 152
THEN month : = 6;
day DEX:R 152
ELSE month : = 5;
day DEX:R 121
TI
ELSE month := 4;
day DEX:R 91
date handling
11/2
E LAN
ZeUe
EUMEL 1.8 .. **
I
I,
I
I
I
I
102
103
104
105
106
107
108
109
110
111
112
113
I
I
114
115
116
daytext
117
118
119
IIOnthtext
120
121
122
123
124
125
126
127
yeartext
10.11.86
* ••*
date handling
FI
ELSE IF day ) 31
THEN IF day ) 60
THEN month :. 3;
day DECR 60
ELSE month : = 2;
day DECR 31
FI
ELSE month : = 1 FI
I
FI
I
I FI
I
I
Idaytext
I text (day, 2) + "."
I
I
Imonthtext :
I text (month,2) + "."
I
I
Iyeartext:
I IF 1900 (. year AND
I
THEN text (year -
year ( 20EIE)
1900, 2)
ELSE text (year, 4)
I
IF!
I
lEND PROC date;
I
...................... ITEXT PROC day (REAL CONST datum):
I SELECT int (( datum MOD week1ength)/day1ength)
I CASE 1: "Donnerstag"
I CASE 2: "Freitag"
I CASE 3: "Sa.mstag"
I CASE 4: "Sonntag"
I CASE 5: "Montag"
I CASE 6: "Dienstag"
I OTHERWISE "Ml ttwoch" ENDSELECT
lEND PROC day;
I
128
129
130
131
132
133
134
135
136
137
138
day
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
month .................... TEXT PROC month (REAL CONST datum):
SELECT lnt (subtext (date (datum), 4,
CASE 1: "Januar"
CASE 2: "Februar"
CASE 3: "Marz"
CASE 4: "April"
CASE 5: "Mal"
CASE 6: "Jun1"
CASE 7: "Ju11"
CASE 8: "August"
CASE 9: "September"
CASE 10: "Oktober"
CASE 11: "November"
OTHERWISE "!lezember" ENDSELECT
U/3
lEND
I
5»
OF
OF
PROC month;
date handling
11/3
E LAN
Zoile
156
157
158
159
160
161
162
163
164
EUMEL
1.8
****
date handl1ng
10.11.86
year ...•.•............... ITEXT PROC year (REAL CONST datum) :
I
I TEXT VAR buffer := subtext (date (datum), 7)
I IF LENGTR buffer = 2
I
THEN "19" + buffer
I
ELSE buffer
I FI.
I
IENDPROC year
I
~5
166
167
168
169
timeofday ................ ITEXT PROC time of day :
I time of day (clock (1»
IENDPROC time of day ;
170
171
172
173
timeofday ................ ITEXT PROC time of day (REAL CONST value) :
I subtext (time (value MOD daylength), 1, 5)
IENDPROC time of day ;
174
175
176
177
time ..................... ITEXT PROC time (REAL CONST value)
I time (value,10)
IENDPROC time
178
179
time ....................• ITEXT PROC time (REAL CONST value, INT CONST length)
I result:="";
I IF length > 7
I
THEN result CAT hour
result CAT ". "
I
180
181
182
183
I
I
I
198
I FI ;
I result CAT minute
I result CAT ":" ;
I result CAT rest ;
I change all (result, " " ,
I result.
I
I
Ihour
I text (int (value/hours),
I
I
Iminute
I text (int (value/minutes
I
I
Irest
I text (value MOD minutes,
I
199
200
I
184
185
186
187
188
189
190
hour
191
192
193
194
195
minute
196
rest
197
201
202
203
204
11/4
"0")
length-8) .
MOD 60.0), 2)
4, 1) •
IEND PROC time
date ..•.................. IREAL PROC date (TEXT CONST datum) :
I spli t and check datum;
I real (day no )*CIaylength +
I previous days [month noJ + calendary day +
date handling
11/4
Zeile
--
ELAN
EUMEL
1.8
10.11.86
...*
date handling
floor (real (year no)-middleyearlength / daylength)-uylength
295
296
297
-
spli t&ndcheckda tum
208
299
210
211
212
213
214
215
216
217
218
219
spu t and check datum:
INT CONST day no :: first no;
IF NOT last conversion ok
THEN errors top ("inkorrekte Datums&ngabe (Tag)
" . datum) FI;
INT CONST month no :: second no;
IF NOT last conversion ok 011 month no ( 1 011 month no > 12
THEN errors top ("inkorrekte Datumsangabe (Monat) : " • datUIII) FI
INT CONST year no :: third no • century;
IF NOT last conversion ok
THEN errorstop ("inkorrekte Datumsangabe (Jahr) : " • datUIII) FI;
IF day no ( 1 011 day no > size of month
THEN errorstop ("inkorrekte Datumsangabe (Tag)
220
221
"+ datum) FI
222
223
century
224
225
226
sizeofmonth
229
238
231
232
februarysize
235
236
237
Isize of month:
I SELECT month no OF
I CASE 1, 3, 5, 7, 8, 10, 12: 31
I CASE 4, 6, 9, 11: 38
I OTHERWISE february size ENmELECT
I february size:
I IF leapyear
I THEN 29
I ELSE 28 FI
I
I
238
239
Icentury:
I IF (length (datUIII) - second pos) (. 2
I TIIEN 1909
I ELSE 0 FI
I
I
233
234
I
I
I
227
228
calendaryday
240
241
242
243
244
245
246
leapyear
247
tirstno
Icalendary day:
I IF month no > 2 AND leapyear
I THEN daylength
I ELSE 0.0 FI
I
I
Ileapyear:
I year no MOD 4 =
11)
AND year no MOD 40!il <> 0
.
I
I
248
249
lfirst no:
I INT CONST first pos :: pos (datUIII, ".");
lint (subtext (datum, 1, first pos-l»
I
I
250
251
252
253
254
secondno
255
thirdno
Isecond no:
I INT CONST second pos ;: pos (datUID, ".", first pos+l);
lint (subtext (datum, first pos + 1, second pos-1»
I
I
2M
Ithird no:
lint (subtext (datum, second pos + 1»
257
I
11/5
.
date handling
11/5
Zeile
E LAN
264
265
da ,e hand li ng
i0.11.B€
PRO:: date;
:::te ..................... I REAL BOe time i, TEZ: COtiST tine;
I sph t and cteck t~l!le;
I hour ~ min + sec
I
splitandchecktime
I
i spU t and cheok time:
266
267
268
269
270
271
272
273
274
I
I
I
I
I
I
275
276
277
278
279
****
:.8
IE:m
I
258
259
260
261
262
263
r:"MEL
hourno
280
281
282
REAL eONST hour :: hou!" ",0 * hours;
IT NOT last conversion o~
THEN errorstop ("inkarrekte Datumsangabe (Stunde I
" +
REAL :ONST min :: min :10 * r.lir.'Jtes;
IT NO: last conversion ok
THEN errors top I, "ir.korre~te Ja t'lmsar.gabe (Minute I
" + timel FI:
REAL CONST sec :: sec no;
IF NOT last conversion o~
THEN errors top ("inkcrrekte Jat:;msangabe (Sekundel
time) rI;
" + timel FI;
set oonversion (l;cur ok ANI: min ok ANJ sec ok)
Ihour no:
lINT CONST hour pos :: pos (:~:!1e. ":" I ;
I real (subtext (tlme, 1. hour pos-ll1
I
I
283
284
285
minno
286
287
288
289
290
291
292
I
I
secno
293
Isec no:
IF min pos = 0
TIIEll 0.0
I
ELSE real (subtext (time, min pos + 111
I
I
I rr.
I
I
294
295
296
Imin no:
I IN! VAR m1n pos :: pos (time. ":", hour pos+ll;
I IF min pos = 0
I
THEN real (subtext ,tirr:e, ho",," pes + 1, LENGTH time I I
I
ELSE real (subte:·:t (Hr.,e, hou,," pos + 1, min pos-ll1
I FI.
hourok
Ihour ok: 0.0
I
297
298
299
300
301
11/6
mlnok
Im1n ok:
secok
I
Isec
0.0
ok: 0.0
IEND PROC time;
hour All] hcur
<
daylength
m1n
AND min
<
hours
sec
AND sec
<
minutes
I
lEND PACKET datehandling
date handling
11/6
Zeile
1
2
3
4
5
6
7
E LAN
EUMEL
1.8
••••
,
commanddialogue .......... IPACKET
,
,
,
,
,
8
,
9
19
11
12
13
14
,
,
,
,
,
,
15
,LET up
16
17
18
19
29
21
22
23
24
25
26
27
28
29
30
I
,
I
I
19.11.86
command dialogue DEFINES
• ""3"" ,
right
""2"" ,
cr If
""13""19""
param pre
"(""",
param post = """) "13""19""
I
I
ITEXT VAR std para.m . _ "" ;
I
IBOOL VAR dialogue flag : = TRUE
I
lINT VAR para.m x := 9 ;
I
I
ITYPE QUIET = INT
I
qUiet .................... IQUIET PROC quiet
I QUIET: (9)
IENDPROC quiet
36
37
38
commanddialogue .......... 'BOOL moc command dialogue
I dialogue flag
IENDmOC command dialogue
39
I
43
44
45
46
47
48
49
59
51
12/1
(. Autor: J.Liedtke .~
(. Stand: 25.11.83.)
cOJlllll8.nd dialogue ,
say,
yes,
no ,
para.m position ,
last para.m ,
std ,
QUIET ,
quiet
31
32
33
34
35
49
41
42
command dialogue
I
,
commanddialogue .......... IPROC command dialogue (BOOL CONST status)
I dialogue flag : = status
IENDPROC command dialogue
I
,
yes ...................... IBOOL moc yes (TEXT CONST question)
I
I
I
I
I
I
IF dialogue flag
TIIEN ask question
ELSE TRUE
FI.
cOllllll&nd dialogue
12/1
E LAN
Zeile
52
53
54
55
56
57
58
59
60
61
62
63
64
65
askquestion
66
67
getanswer
EUMEL 1.8 ••••
10.11.86
command dialogue
Iask
question :
lout (question)
1 skip previous input chars
lout (" (J/n) ? ")
1 get answer ;
1 IF correct answer
1
THEN out (answer)
1
out (cr if) ;
I
positive answer
1
ELSE out (""7"") ;
1
LENGTH question + 9
1
yes (question)
1 FI.
TIMESOUT ftft8ftft
1
1
68
Iget answer
TEXT VAH answer
1 inchar (answer)
69
1
1
1
70
71
72
correctanswer
73
74
75
positiveanswer
76
77
78
79
skippreviousinputchars
Icorrect answer:
pos (" jnyJNY" , answer) )
1
e.
1
1
lpositive answer:
pos ("jyJY", answer) ) 0 .
1
1
1
1skip
I
previous input chars :
REP UNTIL incharety = "" PER
1
1ENDPROC
8@
yes
1
81
82
83
84
85
86
no ....................... IBOOL PROC no (TEXT CONST question)
1
1 NOT yes (question)
1
1ENDPROC no ;
87
88
89
90
91
92
93
94
say
95
96
97
98
99
paramposition ............ 1PROC param position (INT CONST x)
1
•••••••••••••••••••••• 1PROC
say (TEXT CONST message)
1
1
1
1
IF dialogue flag
THEN out (message)
FI
1
1ENDPROC
say
1
1
1
param x := x
1
100
IENDPROC param position
1
12/2
cODDl1&nd dialogue
12/2
Zaile
E LAN
EUMEL
1.8
***.
10.11.86
••••
101
102
103
104
105
106
107
108
109
110
111
112
113
lastpa.ram ................ ITEXT PROC l&st p&ra.m :
114
115
116
117
l&stpa.ram ................ IPROC last p&ra.m (TEXT CONST new)
I std p&ra.m : = new
IENDPROC las t p&ra.m ;
118
119
128
121
122
std ...•.................. ITEXT PROC std
I std p&ra.m
IENDPROC std ;
12/3
I
I
I
I
I
I
I
I
I
I
command dialogue
IF p&ra.m x ) 0 AND online
THEN out (up) ;
p&ra.m x TIMESOUT right
out (p&ra.m pre) ;
out (std p&ra.m) ;
out (p&ra.m post)
FI;
std p&ram •
IENDPROC last p&ra.m
I
I
I
IENDPACKET command dialogue
COlIIIII&nd
dialogue
12/3
Zeile
1
2
3
4
5
6
7
8
E LAN
EUMEL 1.8 ••••
10.11.86
1(. ------------------- VERSION 2
thesaurushandling ........ PACKET thesaurus handling
DEFINES
TllESAURUS
insert,
delete,
vorhanden· )
rename,
vorhanden· )
CONTAINS,
link ,
+
+
10
11
12
13
name.
get ,
highest entry
I
I
I
14
15
16
17
ITYPE THESAURUS
= TEXT
(. aendert ein Element falls
(.
(.
(.
(.
(.
steUt fest, ob enthalten .)
index in thesaurus
.)
name of entry
.)
get next entry (0. is eof)-)
highest valid index of thes.)
;
ILET thesaurus size = 200
nil = 0 ,
I
niltext =
max name length = 80 ,
I
I
2e
21
22
23
I
I
I
I
I
I
I
I
I
24
25
26
27
28
29
30
31
''''e''''
begin entry char
end entry char
nil entry
nil name
""1 ""
=
''''@''''1'''' ,
quote
ITEXT VAH entry
lINT VAH cache index : = 0 ,
32
33
34
35
36
I
cache pas ;
I
I
access ................... IPROC access (TllESAURUS CONST thesaurus, TEXT CONST name)
I
I
I
I
39
40
41
42
43
44
45
46
I
I
I
I
47
I
I
I
construct entry ;
IF NOT cache identifies entry
THEN search through thesaurus list
FI;
IF entry found
THEN cache index . - code (list SUB (cache pas - 1))
ELSE cache index : = 0
FI.
48
49
50
51
52
53
constructentry
54
55
searchthroughthesaurus Isearch through thesaurus list:
I cache pas := pas (list, entry)
13/1
(* fuegt ein Element ein .)
(. loescht ein Element falls
I
18
19
56
06.93.86 ------------------- .)
(* Autor: J.Liedtke
.)
empty thesaurus ,
9
37
38
thesaurus handling
Iconstruct entry
I entry: = begin entry char
I entry CAT name ;
I decode invalid chars (entry, 2)
I entry CAT end entry char .
I
I
I
thesaurus handling
13/1
EUMEL
Zeile
E LAN
57
58
59
cacheidentifiesentry
+
60
61
62
entryfound
63
64
65
66
list
67
constructentry
84
cacheidentifiesindex
+
87
88
89
entryfound
90
list
96
97
98
99
100
101
102
lentry found
I
I
Ilist
I
IENDPROC
I
I
I
I
I
I
I
I
I
+
91
92
93
94
95
10.11.86
Icache identifies entry :
I cache pos <) 0 AND
I pos (list, entry, cache
I
I
I
I
I
69
70
71
72
73
74
75
76
77
78
79
80
81
85
86
........
thesaurus handling
pos, cache pos + LENGTH entry)
cache pos
cache pos ) 0 .
CONCR (thesaurus)
access
access .••••.•..••••••.••• IPROC access (THESAURUS CONST thesaurus, INT CONST index)
68
82
83
1.8
I
I
I
I
I
IF cache identifies index
THEN cache index : = index
construct entry
ELSE cache pos : = pos (list, code (index) + begin entry char}
IF entry found
THEN cache pos INCR 1
cache index : = index
construct entry
ELSE cache index : = 0
entry : = nil text
FI
FI.
Iconstruct entry :
I entry:= subtext (list, cache pos, pos
I
cache pos)}
I
I
Icache identifies index :
I subtext (list, cache pos-1, cache pos)
I
entry char .
I
I
lentry found
I
I
Ilist
I
IENDPROC
I
I
I
(list, end entry char,
z
code (index)
+
begin
cache pos ) 0 .
CONeR (thesaurus)
access
emptythesaurus ........... ITHESAURUS PROC empty thesaurus
I
I THESAURUS:
I
IENDPROC empty
I
I
(""1 ftft)
thesaurus
thesaurus handling
13/2
Zeile
E LAN
1. 8
EUMEL
****
****
10.11. 86
thesaurus handling
103
104
105
106
107
108
109
110
: = ....................... IOF : = (THESAURUS VAR dest, THESAURUS caNST source )
111
insert ................... I FROC insert (THESAURUS VAR thesaurus, TEXT CONST name, INT VAR
I
index)
+
I
I
IENllOF :=
I
I TEXT VAR insert name
I
I
I
I
I
112
113
114
115
116
117
118
119
120
caNCR (dest) . - caNCR (source) .
I
insert name := name ;
decode invalid chars (insert name, 1) ;
IF insert name = "" OR LENGTH insert name ) max name length
THEN index : = nil ; errors top ("Name ulUlulaessig")
ELSE insert element
FI .
insert element :
search free entry
IF
entry found
THEN insert into directory
ELSE add entry to directory if possible
FI .
insertelement
121
122
123
124
125
126
127
128
129
searchfreeentry
130
131
132
133
insertintodirectory
134
135
136
137
138
139
140
addentrytodirectoryifp
Isearch free entry :
I access (thesaurus, nil name) .
I
I
I insert into directory :
I change (list, cache pos + 1, cache
I index:= cache index.
I
I
Iadd entry to directory if possible :
141
142
143
144
145
146
147
148
addentrytodirectory
I IF next free index <= thesaurus
I
THEN add entry to directory
I ELSE directory overflow
I FI.
I
I
.
Iadd entry to directory
149
150
151
directoryoverflow
152
153
entryfound
I
I
I
I
I
I
I
I
pos, insert name)
INT CONST next free index := code (list SUB LENGTH list)
size
list CAT begin entry char
cache pos : = LENGTH list
cache index : = next free index
list CAT insert name ;
list CAT end entry char + code (next free index + 1)
index: = cache index .
I
13/3
Idirectory overflow
I index: = nil .
I
I
Ientry found
cache
I
index ) 0 .
thesaurus handling
13/3
Zeile
154
155
156
157
158
159
E LAN
list
.*..
1.8
10.11.86
Ilist :
thesaurus handling
CONCR (thesaurus) .
I
IENDPROC insert
I
decodeinvalidchars ....... IPROC decode invalid chars (TEXT VAR name, INT CONST start pas) :
I
I INT VAR invalid char pas : = pas (name, ww(')Wft, ftW31 ftft, start pas)
I WHILE invalid char pas ) iii REP
I
change (na.me, invalid char pas, invalid char pas, decoded char)
I
invalid char pas := pas (name, ftft(')ftW, ftft31ftft, invalid char pas)
I PER.
160
161
162
163
164
165
166
EUMEL
decodedchar
+
I
I
Idecoded char
I
quote.
167
168
I
169
I
quote + text( code (n&me SUB invalid char pas»
IENDPIIOC decode invalid chars
170
171
172
173
174
175
176
177
178
179
insert ................... IPROC insert (THESAURUS VAR thesaurus, TEXT CONST name)
189
delete ................... IPROC delete (THESAURUS VAR thesaurus, TEXT CONST name, INT VAR
I
index)
+
I
I
I
I
I
I
I
IENDPROC insert
I
I
I
I
I
183
184
185
186
187
195
196
197
198
199
20e
13/4
FI .
I
181
182
188
189
199
191
192
193
194
INT VAR index ;
insert (thesaurus, name, index) ;
IF index = nil AND NCYr is error
THEN errors top ( ft THESAURUS-Ueberl&ufft )
access (thesaurus, name) ;
index : = cache index ;
delete (thesaurus, index) .
IENDPROC delete
I
delete ................... IPROC delete (THESAURUS VAR thesaurus, INT CONST index)
I
I
I
I
deleteentry
access (thesaurus, index)
IF entry found
THEN delete entry
I rr.
I
I
Idelete entry
I IF is last
I
THEN cut
I
ELSE set
I
I
:
entry of thesaurus
off as much as passible
to nil entry
FI.
thesaurus handling
13/4
+
Zeile
201
202
E LAN
EUMEL
1.8
settonilentry
****
10.11.86
thes80urus ha.ndling
I set to nil entry :
I cha.nge (list, c80che pos, c80che pos + LENGTH entry - 1, nil entry)
I
I
I
+
203
204
205
206
207
208
209
210
cutoff8osmucha.spossible Icut off 80S much 80S possible:
I WHILE predecessor is 8olso nil entry REP
I
set c80che to this entry
I PER;
I list: = subtext (list, 1, ca.che pos - 1)
I er80se c80che .
211
212
213
predecessorisa.lsonilen Ipredecessor is 8olso nil entry :
I subtext (list, ca.che pos - 3, ca.che pos - 2)
214
215
216
setc8ochetothisentry
I
I
nil entry .
I
I
I set c80che to this entry
I c80che pos DECR 3 .
I
I
217
218
219
era.sec8oche
I er80se c80che :
I c80che pos : = 0 ;
I c80che index : = 0
I
I
220
221
222
223
is18ostentryofthes8ourus lis l80st entry of thes80urus :
I pos (list, end entry cha.r, c80che pos)
224
225
list
226
227
228
229
230
entryfound
231
232
233
I
I
I list
Ientry found:
IENDPROC delete
I
I
CONTAINS ................. IBOOL OP CONTAINS (THESAURUS CONST thes8ourus, TEXT CONST na.me
I
I
235
236
237
I
13/5
c80che index ) nil .
I
I
242
243
244
245
246
247
CONCR (thes8ourus) .
I
I
234
238
239
240
241
LENGTH list - 1 .
I
I
I
entryfound
IF
na.me = nil text OR LENGTH na.me ) ma.x na.me length
THEN FALSE
ELSE 80ccess (thes8ourus, na.me) ; entry found
Fl.
lentry found
c80che index) nil .
I
IENDOP CONTAINS
I
rena.me ................... IPROC rena.me (THESAURUS VAR thes8ourus, TEXT CONST old, new)
I
I
rena.me (thes8ourus, link (thes8ourus, old), new}
I
IENDPROC rena.me
I
thes80urus ha.ndling
13/5
Zeile
248
+
249
250
251
252
253
254
255
256
257
258
259
260
E LAN
****
1.8
10.11.86
thesaurus handling
rena.me ................•.. IPROC ren&me (THESAURUS VAH thesaurus, INT CONST index, TEXT CONST
I
new):
I
I
I
I
I
I
I
I
changetonewna.me
261
262
263
264
265
266
EUMEL
list
I
insert n&me : = new ;
decode invalid chars (insert n&me, 1) ;
IF insert na.me = "" OR LENOnI insert n&me
TIIEN errorstop ("N&me unzulaessig")
ELSE change to new n&me
Fl.
) m&X
na.me length
Ichange
I
I
I
I
to new name :
access (thesaurus, index) ;
IF cache index <) 0 AND entry
TIIEN change (list, cache pos + 1, cache pos + LEIIGnI entry - 2,
insert na.me)
Fl.
I
I
I
Ilist
I
CONCR (thesaurus)
IENDPROC ren&me ;
I
..................... IINT
I
267
268
269
270
271
272
273
link
274
275
276
277
278
279
na.me ...........•......... ITEXT PROC n&me (THESAURUS CONST thesaurus, INT CONST index)
I
I
I
288
IENDPROC link ;
I
I
I
I
IENDPROC na.me ;
get ..............•....... IPROC get (THESAURUS CONST thesaurus, TEXT VAH na.me, INT VAH index)
identifyindex
293
294
13/6
access (thesaurus, index) ;
subtext (entry, 2, LEIIGnI entry - 1) .
I
289
290
291
292
295
296
297
access (thesaurus, n&me) ;
cache index .
I
28E)
281
282
283
284
285
286
287
PROG link (THESAURUS CONST thesaurus, TEXT CONST na.me)
tonextentry
I
I identify index ;
I REP
I
to next entry
I UNTIL end of list COR valid entry found PER .
I
I
I identify index :
I IF index = 0
I
TIIEN cache index . = 0 ;
I
cache pos
:= 1
I
ELSE access (thesa.urus, index)
I Fl.
I
I
Ito next entry :
I cache pos : = pos (list, begin entry char, cache
I IF cache pos ) 0
thesaurus handling
pos + 1)
13/6
Zaile
E LAN
298
299
3@0
301
302
303
getentry
304
305
306
307
308
309
310
EUMEL 1.8 ****
I THEN
ELSE
I
I FI .
I
I
get entry
get nil entry
I
I
getnllentry
Iget n11 entry
I cache index : = 0
I cache pos : = 0 ;
I index:= 0
311
I
I
I
313
314
endentrypos
315
316
endoflist
317
318
validentryfound
319
list
name:::""
Iend entry pos
lend of list
I
I
Ivalid entry found
name <) ,.., .
CONCR (thesaurus)
I list
I
321
IENDPROC get
I
322
highestentry ............. lINT PIloe highest entry (THESAUIIUS CONST thesaurus)
I
(0084081300 )
I
324
325
I
326
I
I
list
code (list SUB LENGTH list) - 1 .
I list
328
I
329
330
331
I
13/7
index = 0 .
I
320
327
pos (list, end entry char, cache pos)
I
I
I
+
thesaurus handling
Iget entry
I cache index INCR 1
I index :. cache index
I name := subtext (list, cache pos + 1, end entry pos - 1)
312
323
10.11.86
CONCR (thesaurus)
IENDPROC highest entry ;
IENDPACKET thesaurus handling
thesaurus handling
13/7
Zeile
1
2
3
4
5
6
**••
ELAN
EUME1
.**.
1.8
1 (* -------------------
1
all :
1
1
1LET
1
size
nil
1
1INT
VAR index ;
*)
*)
200
o;
ITEXT VAR system write password :=
system read password .1
actual password
43
1
44
45
46
1
1
14/1
*)
ftft
,
1
1
59
*)
*)
*)
*)
1
32
33
34
35
36
37
38
39
40
41
42
60
*)
1
22
52
53
54
~
56
57
58
*)
t
1
23
24
25
26
27
28
51
-------------------Al.
(* Autor: J.Liedtke
1
14
47
48
49
50
24.02.86
VERSION 2
create,
(* neue lokale Datei einrichten
new,
(* 'create' und Datei liefern
old,
(. bestehende Datei liefern
forget,
(* lokale Date1 loeschen
exists,
(* existiert Datei (lokal)?
status,
(* setzt und liefert Status
ren8JJIe,
(* Umbenennung
copy,
(* Datenraum in Datei kopieren
enter password,(* Passwort einfuehren
write password ,
read password ,
write permission ,
read permission
begin list,
get list entry ,
15
31
local ma.na.ger
DEFINES
13
29
30
••••
localma.na.ger ************* PACKET local ma.na.ger
7
8
9
10
11
12
16
17
18
19
20
21
10.11.86
1
INITFLAG VAR this packet : = FALSE
1
IDATASPACE VAR password space ;
1
1BOUND
ROW size STRUCT (TEXT write, read) VAR passwords
1
1
1THESAURUS
1
1ROW
VAR dir : = empty thesaurus
size STRUCT (DATASPACE ds,
BOOL protected,
TEXT status) VAR crowd
1
1nit1alizeifnecessary .... 1PROC 1ni tialize if necessary :
1
1
1
1
1
1
1
1
IF NOT in1 tialized (this packet)
THEN system write password : = ftft
system read password := ftft
dir : = empty thesaurus ;
password space : = nils pace
passwords : = password space
IT
1
1ENDPROC
initialize if necessary
1
1
1
local ma.na.ger
14/1
E LAN
Zeile
61
62
63
64
65
66
EUMEL
1.8
****
10.11.86
local manager
create ................... I PROC create (TEXT CONST name)
I
I IF exists (name )
I THEN error (name,
I
I
"existiert bereits")
index : = nil
ELSE insert and initialize entry
~
lIT
68
I
I
I insert a.nd initialize entry
I disable stop ;
I insert (dir, name, index)
I IF index <) nil
I
THEN crowd (index). ds : = nilspace
I
IF is error
I
THEN delete (dir, name, index)
I
LEAVE create
I
FI ;
I
status (name, "") ;
I
crowd (index). protected .' FALSE
I ELIF NOT is error
I THEN errorstop ("zu viele Dateien")
I IT.
I
69
70
71
insertandini tializeent
72
73
74
75
76
77
78
79
80
81
82
83
84
I ENDPROC create
85
I
86
new ...................... I DATASPACE PROC new (TEXT CONST name)
I
I
I
I
I
I
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
14/2
create (name) ;
IF index <) nil
THEN crowd (index). ds
ELSE nils pace
FI
I
I ENDPROC new
I
old ...................... IDATASPACE PROC old (TEXT CONST name)
I
I
I
I
I
space
ini tialize if necessary ;
index : = link (dir, name)
IF index = 0
THEN error (name, "gibt es nicht")
nilspace
ELSE space
FI .
I
I
I
I
I
Ispace
I
crowd (index).ds .
I ENDPROC old ;
I
old ...................... IDATASPACE PROC old (TEXT CONST name, INT CONST expected type)
I
I
I
I
ini tialize i f necessary ;
index:= link (dir, name)
IF index = 0
local manager
14/2
E LAN
Zeile
1.8
I
I
I
I
I
I
I
I
I
115
116
117
118
119
120
121
122
123
124
125
126
EUMEL
space
****
10.11.86
****
local manager
THEN error (name, "gibt es nicht") ;
nilspace
ELIF type (space) <> expected type
THEN errorstop ("Datenraum hat falschen Typ")
nilspace
ElSE space
Fl.
Ispace
: crowd (index). ds .
I
IENDPROC old
I
127
128
129
138
131
132
133
exists ................... IBOOL PROC exists (TEXT CONST name)
134
135
136
137
138
139
148
141
142
143
144
forget ••••••••••••••••••• IPROG forget (TEXT CONST name
145
146
147
148
149
150
151
152
153
154
155
156
forget
157
158
159
160
161
162
163
164
165
forget ••••••••••••••••••• I PROG forget :
14/3
I
I
I
I
in1 tialize i f necessary
dir CONTAINS name
IENDPROC exists
I
I
I
I
I
I
I
I
I
initialize if necessary
say (""'''')
say (name)
THEN say (""" existiert nicht")
IF
NOT exists (name)
ELIF yes (""" loeschen") THEN forget (name, quiet)
FI .
IENDPROC forget
I
................... IPROC forget (TEXT CONST name,
I
I initialize if necessary;
I
I
I
I
I
I
I
QUIET CONST q)
disable stop ;
delete (dir, name, index)
IF index < > nil
THEN forget ( crowd (index). ds
crowd (index).status := ""
Fl.
IENDPROC forget
I
I
I
I
I
I
I
BOOL VAR status . - command dialogue
command dialogue (TRUE) ;
forget (last param) ;
command dialogue (status)
IENDPROC forget
I
local manager
14/3
Zeile
E LAN
EUMEL
1.8
****
10.11.86
10c8ol manager
166
167
168
169
170
171
172
173
174
175
status ..•.•••••••••...•.. IPROC status (TEXT CONST name, status text)
176
177
178
179
180
181
182
183
184
185
186
status •••••.•.....••••••• I TEXT PROC status (TEXT CONST name)
187
status ................... IPROC status (INT CONST pos, TEXT CONST status pattern)
I
I
I
I
I
I
I
I ENDPROC status
I
I
I
I
I
I
I
I
I
ini ti80lize i f necessary ;
INT VAR index := link (dir, name)
IF index ) 0
THEN crowd (index).status
ELSE ftft
FI
I ENDPROC statUD
I
I
188
189
190
191
192
193
194
195
196
initi80lize if necess80ry ;
INT VAR index: = link (dir, name) ;
IF index) 0
THEN crowd (index). status : = date + ft ft + text (status text, 4)
FI
8octu8olst8otus
I
I
I
I
I
I
I
I
initi80lize if necessary ;
INT VAR index := 0 ;
WHILE index ( highest entry (dir) REP
index INCR 1 ;
replace (8octu8ol status, pos , status pattern)
PER.
l8octu8ol status: crowd (index).status .
I
197
198
IENDPROC status ;
199
I
200
copy ••••......••.•••...•• I PROG copy (DATASPACE CONST source, TEXT CONST dest name)
I
I
I
I
I
I
I
201
202
203
204
205
206
207
208
209
210
211
212
213
~
215
copyfile
IF exists (dest name)
THEN error (dest name, ftexistiert bereits ft )
ELSE copy file
FI.
Icopy
I
I
I
I
I
I
I
I
file
dis80ble stop
cre80te ( dest name ) ;
INT VAR index : = link (dir, dest name)
IF index ) nil
THEN forget (crowd (index). ds) ;
crowd (index) .ds : = source
IT
216
I ENDPROC copy
217
I
14/4
10c8ol manager
14/4
E LAN
ZeUe
EUMEL 1.8
*.*.
10.11.86
local manager
218
Z9
220
221
222
223
copy ..................... IPROC copy (TEXT CONST source name, dest name)
224
225
226
227
228
229
230
231
232
rename ................... IPROC rename (TEXT CONST old name, new name) :
I
I
I
copy (old (source name), dest name)
IENDPROC copy
I
2~
I
I
I
I
I
I
I
I
I
2M
235
236
I
I
IF exists (new name)
THEN error (new name, "existiert bereits")
ELIF exists (old name)
THEN rename (dir, old name, new name) ;
las t param (new name)
ELSE
error (old name, "gibt es nicht")
rI.
IENDPROC rename
237
238
239
240
241
242
243
beginlist ................ IPROC begin list :
244
245
246
247
248
249
250
251
getlistentry ............. IPROC get list entry (TEXT VAR entry, status text)
252
253
254
255
256
257
258
259
26e
261
262
263
264
265
266
267
268
14/5
I
I
I
I
initialize if necessary
index:. 0
IENDPROC begin list
I
I
I
I
I
I
I
I
found
I
get (dir, entry, index) ;
IF found
THEN status text : = crowd (index). status
ELSE status text : =
Fl.
Ifound
I
: index ) 0 .
IENDPROC get list entry
I
I
wri tepassword ............ ITEXT PROC write password
I
r
I
system write password
IENDPROC wrl te password
I
readpassword ............. ITEXT PROC read password
I
I
I
system read password
IENDPROC read password
I
local manager
14/5
Zeile
E LAN
EUMEL
1.8
****
10.11.86
local manager
269
270
271
272
273
274
275
276
277
278
enterpa.ssword ............ IPROC enter password (TEXT CONST password)
I
I
I
I
I
I
I
I
I
279
I
I
I
280
~1
~2
~3
284
285
286
ini tialize if necessary ;
say (""3""5"") ;
INT CONST slash pas := pos (password, "/")
IF slash pos = 0
THEN system write password .' password ;
system read password .' password
ELSE system write password := subtext (password, 1, slash pas-1)
system read password
IENDPROC enter password
I
enterpassword ............ IPROC enter password (TEXT CONST file name, write pass, read pass)
I
I
I
~7
INT CONST index : = link (dir, file name)
IF index ) 0
THEN set protect password
288
I
~9
I FI.
I
I
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
~
309
310
311
312
313
314
315
316
317
318
319
320
14/6
.- subtext (password, slash pas+l)
Fl.
setprotectpassword
Iset protect password
I IF write pass = "" AND read pass
I
THEN crowd (index). protected : =
I
ELSE crowd (index). protected : =
I
passwords (index). wri te : =
I
passwords (index).read :=
I Fl.
FALSE
TRUE ;
write pass
read pass
I
IENDPROC enter password
I
passwordindex ............ lINT PROC password index (TEXT CONST file name)
I
I initialize if necessary
I INT CONST index := link (dir, file name) ;
I IF index ) 0 CAND crowd (index). protected
I
THEN index
I
ELSE 0
I FI
I
IENDPROC password index
I
readpermission ........... IBOOL PROC read permission (TEXT CONST name, supply password) :
I
I
I
(******************************** ...................................... )
I
(* for reasons of data security the password check algorithm
.)
(* must not copy parts of the file password into variables
*)
( * loco. ted in the standard da ta.space !
*)
(*****. . . . . .*******.............................................. )
I
I
access file password ;
I
I
local manager
14/6
Zeile
E LAN
+
322
readpasswordmatch
324
325
326
accessfi lepassword
327
filepassword
330
331
332
****
10.11.86
file hes no password COR (supply password
ma.tch)
<)
AND read password
Iread password match
I file password. read = supply password OR file password. read
I
I
laccess file password
I INT CONST pw index : = password index (name) .
filehesnopassword
Ifile password
passwords (pw index) .
I
I
Ifile has no password :
pw index
o.
I
333
IENDPROC read permission
334
I
335
336
337
local ma.nager
I
I
328
329
1. 8
I
I
I
I
321
323
EUMEL
wrl tepermission .......... BOOL PRoo write permission (TEXT CONST name. supply password) :
(************************. . .****** ..........***......**** ••******)
338
(*
(*
(*
for reasons of data. security the password check algorithm
*)
must not copy parts of the file password into variables
*)
located in the s tanda.rd dB. ta.space !
*)
(********.**********. . . . . . . . .***....................************.)
339
340
341
342
343
344
access file password ;
file hes no password COR (supply password <>
password ma.tch).
AND write
345
346
347
348
wri tepasswordma tch
349
350
accessfilepassword
351
352
353
filepassword
354
filehasnopassword
355
356
357
358
359
360
361
+
362
363
Iwrite password ma.tch :
I file password. write = supply password OR file password. write •••
I
I
laccess file password
I INT CONST pw index . - password index (name) .
I
I
Ifile password
Ifile hes no password:
pw index • 0 .
I
IENDPRoo write permission;
I
all ...................... ITHESAURUS PRoo all :
I
I
I
I
I
ini tialize if necessary
THESAURUS VAR result := dir
Compiler *)
result
(*ueberfluessig ab na.echstem
I
364
IENDPROC all
365
I
14/7
passwords (pw index) .
I
I
local manager
14/7
Zeile
366
367
368
369
:370
:371
:372
14/8
E LAN
EUMEL 1.8 ****
10.11.86
100801 ma.nager
error .................... IPROC error (TEXT CONST file name, error text) :
I
I errors top ("""" + file
I
IENDPROC error ;
I
IENDPACKET 100&1 manager
local manager
name + """ " + error text)
14/8
Zeile
1
2
+
3
4
5
6
7
8
9
10
11
12
13
14
15
16
+
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
+
38
39
+
40
+
41
+
42
43
44
45
46
47
48
w
50
M
52
15/1
E LAN
EUMEL
1.8 ._.
10.11.86
pattern
111& tch
(. Author:
patternma.tch ............. IPACKET pattern III&tch DEFINES
I
P.Heyderhoff .)
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
(. Date:
09.06.1986
..OR,
,
any,
notion,
bound,
III&tch,
III&tchpos,
III&tchend,
somefix,
UNLIKE,
LIKE :
I (.------- Operation codes of the internal intermoadiate language:
I
--------.)
I
ILET
z
""e"" ,
I
""1""0"",
stopz
I
""2""9"",
I closez
""2""0'''''3''''0'''' ,
I closor
""3"",
or
I
"'''3''''5"'',
oralpha
I
""4""0""'4"''''0''''',
open2
I
""5"''',
alpha
I
""5"'''0"'',
I alphaz
""6""0"",
lenz
I
any (0)
"'''6''''0''''8''''0''''7''''@'''',
nHz
I
""7""0"",
starz
I
""8""0""2""7""0""1""8"",
star
I
""8""9"",
powerz
I
""8""0""1"",
I powerz9
""9""0"",
I notionz
""10""8"",
fullz
I
I boundz
""11""0"";
I (.---------------------------------------------------------------I
-----.)
I
ILET undefined = 0,
I
value
.)
forcer
= 0,
I
parameter
•)
I
I delimiter = " !""_SU'( )*+,-./: ; ( E ) ?
notion' .)
I
(. fixleft
(. value
... _ ' - " ;
(. for 'PROC
I
- ........................ ITEXT OP - (TEXT CONST alphabet ):
I
I
I
I
p:= "";
INT VAR j;
FOR j FROM 0 UPTO 255
REP
I
I
I
I
I
IF pos(alphabet,code(j»
THEN P CAT coder j)
IT
PER;
P
ENDOP
pattern III&tch
15/1
Ze1le
E LAN
EUMEL
1.8
*...
10.11.86
pattern III&tch
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
OR ....................... ITEXT OP OR (TEXT CONST a., b):
I
I
open2 + notnil (a.) + closor + notnil (b) + closez
ENlXlP OR;
I
....................... I TEXT OP •• (TEXT CONST p, INT CONST x):
I
I
I
powerz + code (l+x) + notnil (p) + stopz
ENlXlP **;
ITEXT CONST a.ny:= sta.rz;
I
a.ny ...................... I TEXT PROC a.ny (INT CONST n):
I
TEXT VAR t:=" ";
I
repla.ce (t, 1, ABSn);
I
lenz + t + sta.rz
I ENDPROC a.ny;
I
70
71
a.ny ...................... I TEXT PROC a.ny (TEXT CONST a.): a.lpha.z + a. +
72
73
74
75
76
77
a.ny ...................... I TEXT PROC a.ny (INT CONST n, TEXT CONST a.):
I
TEXT VAR t:=" ";
I
replace (t, 1, ABSn);
I
lenz + t + a.lpha.z + a. + sta.rz
I ENDPROC a.ny;
78
not1on ................... I TEXT PROC notion (TEXT CONST t): notlonz + notnil(t) + stopz DIIlPROC
I
notion;
79
ae
81
82
83
M
8:i
86
87
88
89
ge
91
92
93
94
15/2
S ta.rz
ENDPROC a.ny;
I
I
I
notn1l ................... I TEXT PROC notn1l (TEXT CONST t):
I
IF
t = ftft
I
TIIDI n1lz
I
EISE t
I
IT
I ENDPROC notnil;
I
I TEXT CONST bound :. boundz;
I
full ..................... I TEXT PROC full (TEXT CONST t): fullz + t + stopz ENDPROC full;
I
III&tch .................... ITEXT PROC III&tch (INT CONST x):
I
subtext (p, ma.tchpos(x), ma.tchend(x))
I ENDPROC ma.tch;
I
pattern ma.tch
15/2
Zaile
95
E LAN
II1II. tchpos
+
EUMEL
1.8
I
IIIII.tchend
••••••••••••••••• 1INT
!'ROC IIIII.tchend (INT CaNST xl: maend (1 + x MOD 256) - 1
I ENDPROC ma tchend;
98
I
99
100
1(*----------------- GLOBAL VARIABLES:
+
101
102
103
+
104
+
105
+
106
+
107
108
I
I
-----------------------------------*)
IROW
256 INT VAR
I
I
I
I
I
I
I
I
I
lINT
(* Table of match registers. Each entry consists of
two *)
(* pointers, which points to the TEXT object 't'
*)
mapos,
(* points to the beginning of the match
maend;
(* points to the position after the end of match
VAR ppos, tpos,
I
*)
109
I
floatpos,
+
I
I
I
I
I
I
I
I
I
I
+
110
+
111
+
112
+
113
+
114
115
I
116
I
I
I
I
I
I
I
+
+
118
+
119
120
+
121
+
122
123
124
125
+
126
127
128
129
130
131
132
+
1~/3
(* workpositions in pattern 'p' and text 't'
(* a.ccumulation of all pending float lengths
*)
failpos,
(* result of ' PROC in alpha'
plen, tlen,
(* length of pattern 'p' and length of text
't'
*)
(. for track forward skipping
skipcount,
*)
multi, v&ri;
(. for handling of nonexclusive a.lternatives
*)
(* the pattern to be find or some result
ITEXT VAR p,
+
117
pattern IIIII.tch
10.11.86
................. I INT PROC II1II.tchpos (INT CaNST x): IIIII.pos (1 + x MOD 256) ENDPROC
I
matchpos;
96
97
****
*)
(. stack of pending aSSignments
stack,
*)
alphabet:=""; ( .. result of 'PROC find alpha', reset to nil
*)
( .. after its usage by , find any'
.. )
IBOOL VAR fix,
( .. text position is fixed and not floating
I
I
I
( .. not variing the order of alternatives
*)
no vari;
I
some fix ........•......... ITEXT PROC some fix (TEXT CONST pattern):
I
I
I
I
I
I
I
I
I
I
I
(* delivers the first text occuring unconditionally in the
pattern *)
p: = pattern;
INT VAR j:= 1, n:= 0, k, len:= LENGTH p;
REP
SELECT text( subtext (p, j, j+1), 2) ISUB 1 OF
CASE 1,3,7,9,10,11: J INCH 2
CASE 2:
j INCH 2; n DECR 1 ( .. condition closed
pattern match
15/3
Zeile
E LAN
1.8 -**
EUMEL
.)
+
CASE 5:
CASE 6:
CASE 8:
OTHERWISE
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
159
160
161
+
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
15/4
INCR 2; n INCR 1 (* condition opened
CASE 4:
133
153
154
155
156
157
158
pa.ttern m&tch
10.11.86
j := pos (p, sta.rz, J+2) + 2
j INCR 4
j INCR 3
k:= pos(p, z, J+l) - 1;
IF k <= 0 THEN k:= 1+1en FI;
IF
star found
THEN change (p, starpos, starpos, sta.r);
len:= LENGTH p;
k:= starpos
FI;
IFn= 0COO(pSUBk) <>orCOOk,
THEN LEAVE somefix WITH suhtext(p,j,k-l)
ELSE j: =k
FI
ENDSELECT
j ) len
UNTIL
PER;
star found:
INT VAR starpos:= pos (p, "-", j);
starpos ) 0 COO sta.rpos <. k .
sta.rfound
ENDPROC somefix;
skip •................•... IPROC skip (TEXT CONST p, BOOL CONST upto or):
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
(. skips 'ppos' upto the end of the opened nest, n • nesting
level *)
INT VAR n:. 0;
REP
SELECT text (subtext (p, ppos, ppos+l), 2) ISUB 1 OF
IF
n. 0
CASE 1,2:
THEN LEAVE skip
FI;
ppos INCR 2;
nDECRl
IF
n. 0 COO upto or
CASE 3:
THEN LEAVE skip
FI;
·ppos INCR 2
CASE 7:
ppos INCR 2
CASE 4,9,10,11: ppos INCR 2;
n INCR 1
ppos:. pos (p, sta.rz, ppos+2)
CASE 5:
ppos INCR 4
CASE 6:
ppos INCR 3;
CASE 8:
n INCR 1
ppos:. pos(p, Z, ppos+l) - 1;
OTHERWISE
IF
ppos < 0
THEN ppos:. plen;
LEAVE skip
FI
ENDSELECT
+
2
PER
ENDPROC skip;
pa.ttern m&tch
15/4
E LAN
Zeile
EUMEL
1.8
••••
10.11.86
pattern match
190
191
UNLIKE ................... IBOOL OP UNLIKE (TEXT CONST t, p): NOT ( t LIKE P ) ENOOP UNLIKE;
I
~2
193
194
195
196
197
LIKE ..................... IBOOL OP LIKE (TEXT CONST t, pattern):
I
init;
I
OOOL CONST found:= find (t,l,l, fixresult, floatresult);
I
save;
I
found.
196
199
200
201
202
203
204
205
206
init
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
+
2~
229
230
+
231
232
233
234
235
236
237
238
239
240
15/5
save
I
I
I init:
no vari:= TRUE;
I
vari:= 0;
I
tlen:= 1 + LENGTH t;
I
p: = full (pattern);
I
IF
pos (p, hound) ) 0
I
THEN
I
IF
subtext (p, 14, 15) = bound
I
THEN p:= subtext (p, 1, 8) + powerz0 + subtext (p,
I
16)
I
FI;
I
plen: = LENGTH p - 7;
I
IF
subtext (p, plen, plen+l) = bound
I
THEN p:= subtext (p, 1, plen - 1) + stopz + stopz
I
FI;
I
FI;
I
plen:= LENGTH p + 1;
I
INT VAR fixresult, floatresult;
I
tpos:= 1;
I
floatpos:= 0;
I
stack:= "";
I
alphabet: = "";
I
fix: = TRUE;
I
skipcount:= 0;
I
multi:: 0.
I
I
I save:
p: = t
I
I ENOOP LIKE;
I
I (.-------- Realisation of the pattern matching a~orithms 'find'
I
--------.)
I
find ..................... IOOOL PROC find
I
(TEXT CONST t, INT CONST unit, from, INT VAR fixleft,
I
floatlen):
I
I
I
I
I
I
I
I
I
I
ini tialize;
BOOL CONST found:= pattern
SELECT next command. unit
CASE 0,1,2:
CASE 3:
OTHERWISE
ENDSELECT .
pattern match
unit;
OF
found
next;
find al terna ti ve
find concatenation
15/5
E LAN
Zeile
EUMEL
1.8
****
pattern match
10.11.86
find alternative:
IF
found
THEN save left posi tion;
backtrack;
IF
find pattern CAND better
THEN note multiplicity
ELSE back to first one
FI
Eo'LSE backtrack multi
241
242
243
244
245
246
247
248
249
250
251
findalternative
252
253
better
better:
permutation XOR more left.
254
255
permutation
permutation:
vari MOD 2
256
257
saveleftposi tion
save left position:
j:: fixleft.
258
259
more left
more left:
j > fixleft.
260
261
262
263
backtrackmulti
backtrack multi:
multi:: 2 * backmulti + 1;
vari:: backvari DIV 2;
find pattern.
264
notemul tiplici ty
note multiplicity:
multi:: 2 * multi + 1;
vari:: vari DIV 2;
TRUE.
backtofirstone
back to first one:
backtrack;
IF
find first subpattern
THEN skip (p, FAUlE);
note multiplicity
ELSE errorstop ("pattern");
FAUlE
FI.
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
1.
Flo
findconca tenation
find conca tenation:
IF
found
THEN IF ppos:plen COR find pattern COR track forward
COR ( multi > backmulti CAND vari • 0 CAND find variation
)
+
280
281
282
THEN TRUE
ELSE backtrack; FAUlE
283
284
ELSE skip (p, TRUE); FAUlE
FI
Flo
285
286
+
287
288
289
290
291
15/6
trackforward
track forward:
variation *)
(* must be performed before
j::0;
last multi:: multi;
last vari:= vari;
WHILE skipcount : 0
REP
IF tlen : tpos
pattern match
15/6
Zeile
E LAN
EUMEL 1.8 ****
10.11.86
pat tern ma.tch
TIIEN LEAVE track forward WITH FALSE
FI;
backtrack;
292
293
294
295
296
297
298
299
J INCR 1;
skipcount: = j
UNTIL find first subpattern CAND find pattern
PER;
j: = skipcount;
skipcount:=0;
j=0.
3@0
301
302
findvariation
find variation:
multi:= last multi;
vari:= last vari;
FOR k FROM 1 UPTO (multi+1) DIV (backmulti+l) - 1
REP backtrack with variation;
IF
find first sUhpattern CAND find pattern
THEN vari: =0;
LEAVE find variation WITH TRUE
FI
PER;
FALSE.
315
316
317
318
backtrackwi thvariation
backtrack wi th variation:
backtrack;
vari:= k.
319
findpattern
find pattern:
find (t, 1, ppos+forcer, fixresult, floatresult) CAND keep
result.
findfirstsubpattern
find first subpattern:
find (t, 0, from, fixresult, floatresult) CAND keep result
initialize
in1 tialize:
INT VAR
303
304
305
306
307
308
309
310
311
312
313
314
320
+
321
322
323
324
325
326
327
j,
k,
fixresult,
floatresult,
last multi,
last vari;
BOOL CONST backfix: = fix;
TEXT CONST backstack:= stack;
floatlen: = 0;
INT CONST back: = tpos,
backfloat:= floatpos,
backskip:. skipcount,
backmulti: = multi,
backvari : = vari;
fixleft: = fixleft0.
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
15/7
fixleft0
fixleft0: IF fix TIIEN back ELSE undefined FI.
pattern match
15/7
E LAN
Zeile
344
345
346
347
348
349
350
backtrack:
fix: = backfix;
tpos:: back;
fixleft:: fixleft0;
floatlen:= 0;
floa tpos :: backfloat;
stack:: backstack;
skipcount:= backskip;
multi:: backmul ti;
vari:: backvari.
keepresult
keep result:
IF fix left = undefined
THEN IF fixresult: undefined
THEN floatlen INCR floatresult
ELSE fixleft : = fixresult - floatlen;
floatpos DECR floatlen;
floatlen: = 0
352
353
354
356
357
358
359
360
361
362
363
364
365
366
367
FI
FI;
TRUE.
pat ternuni t
368
369
370
371
372
373
374
375
376
377
378
379
pattern unit:
init ppos;
SELECT command OF
CASE 1,2:
CASE 3:
CASE 4:
CASE 5:
CASE 6:
CASE 7:
CASE 8:
CASE 9:
CASE 10:
CASE 11:
OTHERWISE
find end
find nil
find choice
find alphabet
find fixlength any
find var length any
find and store match
find notion
find full
next; find nil
find plain text
SELECT.
+
381
pattern match
10.11.86
backtrack
351
355
EUMEL 1.8 ****
initppos
init ppos:
ppos:: from + 2.
COllllll8.nd
command:
text (subtext (p, from, from+l), 2) ISUB 1.
nextcommand
next command: text (subtext (p, ppos, ppos+l), 2) ISUB 1.
next
next:
ppos INCH 2.
findend
find end:
ppos DECR 2;
fixleft:: tpos;
LEAVE find WITH TRUE;
TRUE.
findnil
find nil:
ppos DECR 2;
fixleft: = tpos;
TRUE.
382
385
386
387
388
389
399
391
392
393
394
395
396
15/8
pattern match
15/8
ZeUe
.....
E LAN
EUMEL 1.8 ....
10.11.86
••••
pattern match
397
findchoice
find choice:
403
404
405
406
407
408
f1ndplaintext
find plain text: find text upto next conunand;
THEN allow fix position only
IF
fix
ELIF text found THEN allow variable position
ELSE allow backtrack
Flo
409
findtextuptonextconunan
find text upto next command:
ppos:= pos (p, z, from + 1);
IF
ppos = 0
THEN ppos: = plen
ELSE ppo s DECR 1
FI;
IF
star found
THEN change (p, starpos, starpos, star);
plen:= 1 + LENGTH p;
ppos:= starpos
FI;
tpos:= pos (t, subtext (p, from, ppos - 1), tpos).
422
423
424
425
starfound
star found:
INT VAR starpos:= pos (p, ft.ft, from);
starpos ) 0 CAND starpos < = ppos .
426
textfound
text found:
WHILE skipoount ) 0 CAND tpos ) 0
REP
skipcount DECR 1;
tpos:= pos (t, subtext(p,from,ppos-l), tpos+l)
398
399
400
401
402
410
411
412
413
414
415
416
417
418
419
420
IF
find pattern
THEN next; TRUE
ELSE next; FALSE
Flo
421
427
428
429
430
431
PER;
tpos ) 0 .
432
433
allowfixpos1 tiononly
allow fix pos1t1on only:
IF
tpos = back
THEN tpos INCR (ppos-from); TRUE
ELSE tpos:, back;
from = ppos
Flo
allowvariablepos1tion
allow variable pos1 tion:
IF
alphabet = ftft COR 1n alpha (t, back, tpos)
THEN fix it;
tpos INCR (ppos-from);
TRUE
ELSE tpos:= back;
FALSE
Flo
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
15/9
pattern match
15/9
Zeile
E LAN
449
450
451
452
453
454
455
456
anowba.cktrack
457
findalphabet
EUMEL 1. 8
pattern match
allow ba.cktrack:
tpos:= ba.ck;
IF
from = ppos
THEN fix it;
TRUE
459
460
461
462
find alphabet:
j:= pos (p, starz, ppos);
alphabet:= subtext (p, ppos, j-l);
ppos := j;
TRUE.
findfixlengthany
find fixlength any:
get length value;
find alpha attribut;
IF
alphabet = ""
THEN find any with fix length
ELSE find any in alphabet with fix length
FL
getlengthvalue
get length value:
floatlen:= subtext(p, ppos, ppos+l) ISUB 1;
ppos INCR 4.
findalphaa ttri bu t
find alpha attribut:
IF (p SUB (ppos-2))
THEN next
FL
464
465
466
467
468
469
470
471
472
473
10.11. 86
ELSE FALSE
FI .
458
463
****
474
475
476
477
478
alpha CAND find alphabet
479
480
findanywi thfixlength
481
482
483
484
485
486
487
488
+
find any wi th fix length:
tpos INCR floatlen;
IF
tpoS) tlen
THEN tpos:= ba.ck;
floa tlen: =0;
FALSE
ELSE IF
fix THEN floatlen:= 0
ELIF floatlen = 0
THEN fix it
490
TRUE
491
492
493
495
496
497
498
499
unlike nil text 6. 6 .
ELSE floatpos INCR floa.tlen
FI;
489
494
(*
*)
FL
findanyinalphabetwithf
find any in alphabet with fix length:
IF
first chara.cter in alpha
THEN IF NOT fix THEN fix it FI;
set fix found
ELSE set fix not found
FL
500
15/10
pattern match
15/10
Zeile
****
E LAN
EUMEL 1.8
****
10.11.86
****
pattern ma.tch
501
502
503
firstcharacterinalpha
first cha.ra.cter in alpha:
(fix COR adva.nce) CAND in a.lpha (t, tpos, tpos+floatlen).
504
505
506
507
508
509
510
advance
advance:
FOR tpos FROM back UP1'O tlen
REP IF
pos (alphabet, t SUB tpos) ) 0
THEN LEAVE advance WITH TRUE
FI
PER;
FALSE.
511
512
513
514
515
516
fixit
fix it:
fixleft:= back-floatpos;
make fix (back);
fix left : = tpos.
517
518
519
520
521
522
setfixfound
set fix found:
tpos INCR floatlen;
floa.tlen: = 0;
a.lphabet:= "";
TRUE.
523
setfixnotfound
set fix not found:
tpos:= back;
alphabet:= "";
floatlen: = 0;
FALSE.
528
529
530
531
532
findvarlengthany
find va.rlength any:
IF
alphabet = ""
THEN really any
ELSE find varlength any in alpha.bet
533
reallyany
524
525
526
527
FI.
really any:
537
IF
fix
THEN fix:= FALSE;
fixleft:. tpos
ELIF floa. tpos • 0
THEN fixleft:= tpos
+
538
FI;
534
535
536
TRUE •
539
540
541
542
543
544
findvarlengthanyinalph
545
546
547
find va.rlength a.ny in a.lphabet:
IF fix THEN fixleft . - tpos FI;
IF
fix CAND pos (alphabet, t SUB tpos) ) 0
COR NOT fix CAND adva.nce
THEN IF NOT fix THEN fix it FI;
set var found
ELSE set var not found
FI.
548
549
550
setvarfound
set var found:
551
552
111/11
(. 6.6.
pattern ma.tch
tpos:. end of varlength a.ny;
a.lphabet:= "";
TRUE.
15/11
E LAN
Zeile
EUMEL
1.8 ••••
10.11.86
pat tern match
553
554
555
setvarnotfound
set var not found:
556
557
558
559
560
endofvarlengthany
end of varlength any: IF
NOT in alpha(t,tpos,tlen)
THEN failpos
ELSE tlen
Flo
561
562
563
findandstorematch
find and store match: get register name;
IF find pattern
THEN next;
store;
TRUE
ELSE next;
FALSE
Flo
store
store:
IF
fix
THEN mapos (reg):. fixleft;
maend (reg): = tpos
ELSE stack CAT code(floatlen) +
code(floatpos) +
code( fixleft) + c
Flo
getregistername
get register name:
TEXT CONST c:= p SUB (ppos);
INT VAR reg:. code (c);
564
565
566
567
568
tpos:= back;
alphabet: = "";
FALSE.
569
570
571
572
573
574
+
575
576
577
578
579
ppos
INCR 1.
580
581
582
583
findnotion
find notion:
584
floatnotion
float notion:
float notion;
exhaust notion
j:= back;
REP IF
find pattern
THEN IF
is notion (t, fixleft)
THEN LEAVE find notion WITH TRUE
ELIF baekfix
THEN LEAVE float notion
ELSE go ahead FI
ELIF j=back
THEN next;
LEAVE find notion WITH FALSE
ELSE LEAVE float notion
FI
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
PER.
goahead
go ahead:
simple
simple:
j
INCR 1;
IF simple THEN j: = max (tpos, j) FI;
notion backtrack.
600
601
602
603
604
605
15/12
k:= from;
REP k := pos (p, z, k+2);
IF
k > ppos-3
THEN LEAVE simple WITH TRUE
pattern match
15/12
Zeile
E LAN
EUMEL
1. 8
****
pattern match
10 .11. 86
ELIF pos (oralpha. p SUll k-1) ) 0
mEN LEAVE simple WIn! FALSE
FI
696
697
698
609
610
PER;
FALSE.
611
612
613
614
615
616
617
618
619
notionb&cktrack
notion backtrack: tpos: = j;
fix: = backfix;
fixleft: = fixleft0;
floatlen:= 0;
floatpos:= backfloat + tpos - back;
stack:= b&ckstack;
ppos: = from + 2 .
620
exhaustnotion
exhaust notion: IF
COR
CAND
CAND
621
622
623
624
625
626
627
628
notion expansion
multi) backmulti
no vari
notion variation
THEN TRUE
ELSE backtrack; FALSE
FI.
notionexpansion
notion expansion: j: = 0;
multi:= last multi;
vari:. last vari;
WHILE skipcount = 0
REP skip and try PER;
j: = skipcount;
skipcount:= 0;
j = 0.
skipandtry
skip and try:
629
630
631
632
633
634
635
636
637
638
639
640
641
642
backtrack;
j
INCR 1;
644
645
skipcount: =j;
ppos: = from + 2;
IF
find pattern
mEN IF
is notion (t. fixleft)
mEN LEAVE find notion WIn! TRUE
FI
ELSE next; LEAVE find notion WIn! FALSE
646
FI.
643
647
648
649
550
551
652
553
554
555
655
557
notionvariation
notion variation: no vari: = FALSE;
last multi:. multi;
las t vari: = vari;
FOR k FROM 1 UPI'O (multi+l) DIV (backmulti+l) - 1
REP backtrack IIi th variation;
IF
find first subpattern
mEN no vari:= TRUE;
LEAVE find notion WIn! TRUE
FI
PER;
658
no vari::e TRUE,
659
669
FALSE.
15/13
pattern match
15/13
Zeile
661
E LAN
****
10.11.86
pattern me.tch
find full:
find pattern COO (end of line COR exhaust line).
endofline
end of line:
next;
IF
fix
THEN tpos = tlen
ELSE tpos: = tlen;
make fix (1);
TRUE
669
670
671
672
673
674
1.8
findfull
662
663
664
665
666
667
668
EUMEL
FI.
exhaustline
675
676
677
678
exhaust line:
IF
full expansion COR multi ) 0 CAND no vari CAND full
variation
THEN TRUE ELSE backtrack;
FALSE
FI.
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
fullexpansion
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
full variation
full expansion:
j:=0;
last multi:. multi;
last va.ri: = vari;
WHILE skipcount = 0
REP
IF tlen = tpos
THEN LEAVE full expansion WITH FALSE
FI;
backtrack;
j
INCR 1;
skipcount: = j;
ppos:.from + 2
UNTIL find pattern CAND tpos.tlen
PER;
j: = skipcount;
skipcount:=0;
j=0.
full variation:
no vari:= FALSE;
multi: = last multi;
vari:= last vari;
FOR k FROM 1 UPTO multi
REP backtrack with variation;
IF
find first subpattern
THEN no vari: = TRUE;
LEAVE find WITH TRUE
FI
PER;
no vari: = TRUE;
FALSE.
ENDPROC find;
713
714
715
isnotion ................. IBOOL PROC is notion (TEXT CONST t. INT CONST t'ixleft):
I
ppos INCR 2;
I
(
NOT fix
15/14
pattern me.tch
15/14
Zeile
E LAN
EUMEL 1.8 ****
COR
COR
COR
COR
CAND
CAND (
COR
COR
COR
CAND
716
717
718
719
72G
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
10.11.86
pattern match
tpos = tlen
pas (delimiter, t SUB tpos)
) 0
pos (delimiter, t SUB tpos-f) ) 0
(t SUB tpos) <= "z"
(t SUB tpos-1) ) "Z"
fixleft < = 1
pas (delimiter, t SUB fixleft-1) ) 0
pos (delimiter, t SUB fixleft)
) 0
(t SUB fixleft)
) "Z"
(t SUB fixleft-l) <= "Z"
END PROC is notion;
makefix .................. I PROC make fix (INT CONST back):
WHILE stack not empty
REP INT VAR reg: = code (stack SUB
pos:= code (stack SUB
len: = code (stack SUB
dis:= code (stack SUB
maend(reg):= min (tpos + diS,
+
top),
top-1),
top-3),
top-2) - floatpos;
tlen);
(* 6.6.
*)
736
737
mapas(reg):= pos or fix or float;
stack:= subtext (stack,l,top-4)
7~
PER;
739
740
fix: = TRUE;
floatpos:= 0
741
742
743
744
stacknotempty
stack not empty: INT VAR top:. LENGTH stack;
toP) 0.
745
746
747
748
749
750
751
752
753
754
755
posorfixorfloat
pos or fix or float:
IF
pos = undefined
THEN IF len = 0
THEN min (back + dis, tlen)
ELSE maend(reg) - len
FI
ELSE pos
756
757
758
759
760
761
762
763
764
765
+
766
767
15/15
FI.
ENDPROC make fix;
inalpha .................. IBOOL PROC in alpha (TEXT CONST t, 1NT CONST from, to):
I
FOR failpos FROM from UPl'O to - 1
I
REP IF
pos (alphabet, t SUB failpos) • 0
I
THEN LEAVE in alpha WITH FALSE
I
FI
I
I
I
PER;
TRUE
ENDPROC in alpha;
I
notion ................... I TEXT PROC notion (TEXT CONST t, INT CONST r): notion (t) I
ENDPROC notion;
r
I
IENDPACKET pattern match;
pattern match
15/15
Zeile
1
2
3
4
5
6
7
E LAN
EUMEL
1. 8
---
1(. -------------------
FILE,
:"',
U
c~",
13
14
putline,
getline,
~
~t,
~
gd,
H
~~,
18
19
32
line,
reset,
down,
up,
downety,
uppety,
pattern found,
to first record,
to line,
to eof,
insert record,
delete record,
read record,
wri te record,
is first record,
~
~f,
22
23
24
25
26
27
28
29
30
31
34
line no,
35
mANGE,
36
set range,
reset range ,
remove,
c lear removed,
reinsert,
ma.x line length,
edi t info,
line type ,
copy attributes,
headline,
put tabs,
get tabs,
37
~
39
40
41
42
43
44
45
46
47
~
~l,
49
word,
at,
removed lines,
exec,
~e
51
52
53
54
55
56
pes ,
58
len,
subtext ,
change,
lines,
segments ,
59
m&rk ,
~7
60
oaa.rk line no ,
61
m&rk
62
16/1
02.86.86 ------------------- .)
(. Autoren: J. Liedtke , D.Martinek .)
( ***..* ..... )
8
9
10
11
21
VERSION 3:i
filehandling _•••• _ •••••• PACKET file handling DEFINES
sequential file,
reorganize,
input,
output,
modify,
29
file handling
10.11. 86
col,
set rna.rked range ,
file handling
16/1
Zeile
--
E LAN
EUMEL
1.8
_..
10.11.86
••••
file ha.ndling
split line,
conca.tena te line ,
prefix,
sort ,
lexsort :
63
64
65
66
67
68
69
70
(......**.....***................**.****........................~
-)
71
.)
+
(•
72
.)
+
73
74
75
76
77
78
+
79
+
80
81
82
83
1(·
I
1(*
I
1(.
I
1(·
I
1(·
I
1(·
I
1(·
I
I (I
1(·
I
1(*
89
90
91
92
93
+
94
95
+
96
+
97
16/2
I
Die einzelnen Atome ha.ben zwar eine Position
im Row, a.ber in dieser Betrachtung keine
.)
logische Reihenfolge.
*)
*)
ATOM
-)
Ba.siselement, ka.nn eine Zeile der Da.tei und die
zugehoerige Verwa.ltungsinformation a.ufnehmen
.)
CHAIN
.)
SEXlMENT
I
1(·
I
1(·
I
1(I
1(·
I
1(·
I
1(·
I
I (*
I
.)
I
1(I
1(I
1(I
1(·
I
*)
1(-
Menge a.ller Atome eines FILEs.
.)
*)
I (-
88
ATOMROW
.)
I
85
+
.)
*)
1(*
1(*
87
.)
I
84
86
Terminologie:
Zyklisch geschlossene Kette von Segmenten.
Tellbereich des Atomrows, enthael t 1 oder mehr
zusa.mmenhaengende Atoms.
.)
Jedes Segment ha.t ein Vorga.enger- und ein
.)
Nachfolgersegment.
*)
Jades Segment enthaelt einen logisch zumsammen-
-)
ha.engenden Teile einer Sequence.
*)
.)
S~UENCE
Logische Folge von Lines.
*)
Jede Sequence ist Teil einer Cha.in oder besteht
vollsta.endig dara.us:
*)
*)
SEG1--SEG2--SEG3--SEG4--SEG5
*)
:----sequence----:
*)
file ha.ndling
16/2
Zeile
98
99
100
1(')1
1(')2
103
1(')4
1(,)~
+
1(')6
1(')7
+
1(')8
E LAN
EUME!. 1.8 ••••
1(·
I
1(·
I
1(·
112
113
114
115
116
117
+
118
+
119
Ein Atom als Element ein Sequence betrachtet.
j(.
I
1(·
I
1<··....·······**·······..· ..·**********·................•••......• ...
I
•• )
I{·
I
I (. Eigenschaften:
I
.)
1(*
+
Sequence.
I
1(·
I
1(·
I
I
1(·
I
1(·
I
1(·
I
1(·
I
1(·
I
1(·
I
1(·
I
1(·
I
1(·
I
1(·
111
file handling
Lines ist eine wesentliche Eigenschaft einer
1(·
+
+
_ ••
Die 'Reihenfolge' ebenso wie die 'Anza.hl' der
I
1(')9
11(')
10.11.86
.)
Folgende Mengen bilden eine Zerlegung (im math. Sinn) einer
.)
gesamten Datei:
.)
used segment chain
scratch segment chain
free segment chain
unused tail
.)
Fuer jedes X aus (used, scratch, free) gelten:
.)
'X sequence' ist echte Teilmenge von 'X segment chain'.
.)
120
121
(D&raus folgt, es gibt keine leere
'chain'.) .)
+
122
.)
123
'X segment chain' ist zyklisch gekettet.
.)
+
124
.)
+
125
AHe Atome von 'X segment chain' h&ben definierten Inh<.
+
126
+
127
128
129
16/3
1(·
I
.)
1<·........................•..........••..................................·····1111 •••••••
I
I
I
•• )
file handling
16/3
Zeile
E LAN
130
131
132
133
1M
135
136
137
138
139
140
141
142
143
144
145
1.8 ****
EUMEL
= 4075
ILET file size
nil
I
I
I
I
I
I
I
I
+
148
149
150
151
152
= 0 ,
free root
scratch root
used root
first unused
1
2
3
= 4
ILET SEQUENCE
= STRUCT (INT index, segment begin, segment end,
I
I
I
I
I
ATOM
ATOMROW
INT line no, lines),
STRUCT (INT succ, pred, end),
• STRUCT (SEXlMENT seg, INT type, TEXT line),
= ROW filesize ATOM,
LIST
= STRUCT (SEQUENCE used, INT prefix lines, postfix
I
I
I
I
I
I
I
146
147
file handling
10.11.86
SEXlMENT
lines,
SEQUENCE scratch, free, INT unused tail,
INT mode, col, limit, edit 1nfo, m&rk line,
mark col,
ATOMROW atoms);
ITYPE FILE
= BOUND LIST ;
I
ITYPE FRANGE = STRUCT (INT pre, post, BOOL pre was split, post was
I
split);
I
I
153
154
155
156
157
158
159
.-
160
161
162
163
164
:= ....................... IOP := (FILE VAH left, FILE CONST right):
165
166
167
168
169
170
becomes .................. IPROG becomes (INT VAH a, b)
171
172
173
174
175
176
177
initialize ............... IPROG initialize (FILE VAH f) :
+
178
179
16/4
....................... IOP : = (FRANGE VAH left, FRANGE CONST right):
I CONCR (left) := CONCR (right)
IENlXlP . - ,
I
I
I
EXTERNAL 260
lEND OP .-,
I
I
I INTERNAL
I a: = b
260
;
IEND PROC becomes;
I
I
I
I
l' . used
: = SEQUENCE : (used root, used root, used root, 1, El);
I
f.prefix lines := 0;
I
f.postfix lines := 0;
I f . free
: = SEQUENCE
(free root, free root, free root, 1, e) ~
I f . scratch : = SEQUENCE
( scratch root, seratch root , scratch
I
root, 1, 0);
I f . unused tail : = first unused;
I
file handling
16/4
E LAN
Zeile
EUMEL
1.8
INT VAH i;
FOR i FROM 1 UPI'O 3 REP
root (i). seg := SEGMENT
root (i). line : =
put tabs (f, "") .
root
Iroot : f . atoms .
I
IEND PROC initialize;
I
I
1(*******·******. . . .·******..• ....·**··**********·********···· ........
I
+
I
.)
I
1(·
I
.)
1(.
+
201
+
Segment Handler
I
I
+
203
& CHAINs)
.)
.. )
segs ..................... lINT PROC segs (S~UENCE CONST s, ATOMROW CONST atom)
I
I
I
I
I
I
I
I
I
208
209
210
211
212
213
214
215
216
INT VAH number of segments : = 0 ,
actual segment : = s. segment begin
REP
number of segments INCR 1
actual segment : = a tom (actual segment). seg. succ
UNTIL actual segment • s. segment begin PER ;
number of segments
IENDPROC segs ;
I
I
nextsegment .............. IPROG next segment
(S~UENCE
VAH s, ATOMROW CONST atom)
I
I d1sable stop;
I s . line no INCR (s. segment end - s. index + 1);
I INT CONST ne\l segment index : = actual segment. succ;
I s . segment begin : = ne\l segment index;
I s . segment end
: = ne\l segment. end;
I s . index
. - ne\l segment index •
I
I
actualsegment
nll\lsegment
lactual segment
I
Ine\l segment:
atom (s.segment begin).seg .
atom (ne\l segment index).seg
228
I
229
IEND PROC next segment;
16/5
(SEGMENTs
1(**······..·····****···****···...··........·••·..•..•....•...........
202
227
•• )
1(·
200
226
(i, i, 1);
PER;
199
217
218
219
220
221
222
223
224
225
file handling
f.col := 1 ;
f. mark line : = 0 ;
f.mark col := 0 ;
+
204
205
206
207
10.11.86
f.limit := 77;
t.edit info := 0;
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
_..
file handling
16/0
Zeile
E LAN
EUMEL
1.8
****
rile handling
10.11.86
2:30
231
232
233
234
235
236
237
238
239
240
241
242
M3
244
245
246
247
248
249
250
251
252
253
previoussegment .......... IPROC previous segment (S~UENCE VAR s, ATOMROW CONST atom)
I
I disable stop;
I s . line no DEeR (s. index - s. segment begin + 1);
I INT CONST new segment index :. actual segment.pred;
I s . segment begin . - new segment index;
I s . segment end
. = new segment. end;
I s . index
. - s. segment end .
actu&lsegment
newsegment
I
I
lactual segment
atom (s.segment begin) .seg .
I
Inew segment:
atom (new segment index).seg
I
IEND PROC previous segment;
I
I
splHsegment ............. IPROC split segment
(S~UEIICE
VAR s, ATOMRO'I/ VAR atom)
I
I
I
I
I
disable stop;
IF not at segment top
THEN spH t segment at actual position
FI.
I
I
254
255
256
257
258
259
260
261
262
263
264
265
266
257
268
269
spli tsegmentatactu&lpo Ispli t segment at actual posi t10n :
I INT CONST pred index
. - s. segment begin,
I
actual index := s.index,
I
succ index
:. pred. succ;
270
271
notatsegmenttop
272
pred
I
I
I
I
I
I
pred. succ
pred. end
. - actual index;
:. actual index - 1;
succ. pred
: = actual index;
I
I
I
I
s.segment begin :. actual index
I
I
Inot at segment top
I
I
Ipred
I
I
274
275
actual
275
277
278
279
succ
16/5
:. pred index;
:. succ index;
:. s. segment end;
I
~3
280
actual. pred
actual. succ
actual. end
Iactual
I
I
Isucc
s.index) s.segment begin.
a tom (pred 1 ndex) . seg .
atom (actual index).seg .
: atom (succ index).seg
I
lEND PROC split segment;
I
I
file handling
16/5
Zeile
281
282
283
284
285
286
287
288
289
E LAN
1.8
EUMEL
****
10.11.86
file handli ng
JOinsegJll8nts ............. IPROC join segments (ATOMROW VAR atom,
I
INT CONST first index, INT VAR second index)
I
I
I
I
I
I
I
I
disable stop;
IF first seg. end + 1 = second index
THEN attach second to first segment
ELSE link first to second segment
Fl.
290
291
292
293
294
295
296
297
298
attachsecondtofirstseg lattach second to first segment:
I first seg.end : = second seg.end;
I INT VAR successor of second := second seg.succ;
I IF successor of second = second index
I
THEN first seg. succ : = first index
I
ELSE join segments (atom, first index, successor of second)
I FI;
I second index : = first index
299
300
301
302
linkfirsttosecondsegme llink first to second segment :
I first seg.succ := second index;
I second seg.pred : = first index.
303
firstseg
304
305
306
307
308
309
310
311
312
313
314
315
I
I
I
I
secondseg
Ifirst seg:
atom (first index).seg .
I
Isecond seg : atom (second index). seg .
I
lEND PROC join segments;
I
I
deletesegments ........... IPROC delete segments (SEQUENCE VAR from, ATOMROW VAR atom,
I
INT CONST first index, last index, lines)
I
I
I
I
determine surrounding segments and new atom index;
join surrounding segments;
update sequence descriptor .
I
I
316
317
318
319
320
determinesurroundingse Idetermine surrounding segments and new atom index
I INT VAR pred index
:= first seg.pred,
I
actual index : = last seg. succ;
I from. index : = actual index .
321
322
323
joinsurroundingsegment I join surrounding segments :
I join segments (atom, pred index, actual index) .
324
325
326
327
328
updatesequencedescript
329
actualseg
16/7
I
I
I
I
Iupdate
I
I
I
I
I
sequence descriptor :
from. segment begin : = actual index;
from. segment end := actual seg.end;
from . lines DEeR lines .
lactual seg
atom (actual index) .seg .
file handling
16/7
Zeile
E LAN
f1rstseg
331
lastseg
EUMEL
1.8
Ifirst seg:
I
Ilast seg:
332
I
333
334
335
I
I
336
337
****
10.11.86
file handling
atom (first index).seg .
atom (last index).seg
IEND PROC delete segments;
insertsegments ........... IPROC insert segments (SEQUENCE VAR into, ATOMROY/ VAR atom,
I
INT CONST first index, last index, lines)
I
338
339
340
341
I
I
join into sequence and new segments;
update sequence descriptor .
I
I
342
343
344
345
346
347
348
joinintosequenceandnew I join into sequence and new segments :
I INT VAR actual index :. into.index,
I
pred index
: = actual sag. pred;
I join segments (atom, last index, actual index);
I actual index : = first index;
I join segments (atom, pred index, actual index) .
349
350
351
352
353
updatesequencedescript Iupdate sequence descriptor :
I into. index : = first index;
I into. segment begin :. actual index;
I into.segment end := actual seg.end;
I into . lines INCR lines .
I
I
I
I
~4
~5
~6
actualseg
367
368
369
370
371
372
373
374
375
376
377
378
+
379
16/8
atom (actual index) .seg .
IEND PROC insert segments;
357
358
359
360
361
362
363
364
365
366
lactual seg:
I
I
I
nextatom ................. 1PROG next atom (SEQUENCE VAR s, ATOMROY/ CONST atom)
I
I
I
I
tonexta tom
I
I
I
IF s. line no <= s . lines
THEN to next atom
ELSE errorstop ("'down' nach Datelende")
Fl.
Ito next a tom :
I disable stop;
I IF s.index = s.segment end
I
THEN next segment (s, a tom)
I
ELSE s . index INCR 1;
I
s.line no INCR 1
I FI
I
lEND PROG next atom;
I
I
nextatoms ................ IPROG next atoms (SEQUENCE VAR s, ATOMROW CONST atom, INT CONST
I
I
times):
file handling
16/8
Zeile
E LAN
EUMEL 1.8 ••••
jumpuptodestinationseg
jump upto destination segment:
WIIILE s . line no + length of actual segments tail ( destination
line REP
next segment (s, atom);
386
387
388
PER •
389
390
391
392
393
posi tlonwi thindestinat
394
395
396
397
398
lengthofactualsegments Ilength of actual segments tail
399
I
I
I
I
I
position wi thin destination segment :
disable stop;
s.index INCR (destination line - s.line no);
s.line no : = destination line .
lEND
PROC next atoms;
I
I
previousatom ............. IPROC previous atom (SEQUENCE VAR s, ATOMRCNI CONST atom)
I
401
402
403
I
I
I
~
I IT.
I
I
I to previous a tom
I disable stop;
405
413
414
415
416
417
418
419
429
421
4~
s. segment end - s. index .
I
400
406
407
408
409
410
411
412
file handling
INT CONST destination line := min (s.line no + times, s.lines + 1)
jump upto destination segment;
position within destination segment.
380
381
382
383
384
385
10.11.86
topreviousa tom
I
IF s.line no ) 1
THEN to previous atom
ELSE errors top ("'up' am Dateianfang")
:
IF s.index = s.segment begin
previous segment (s, atom)
s. index DECR 1;
s.line no DECR 1
I
THEN
I
ELSE
I
I FI
I
IEND PROC
I
I
previous a tom;
previousatoms ............ IPROC previous atoms (SEQUENCE VAR s, ATOMRCNI CONST atom, INT CONST
I
times):
I
I
I
I
INT CONST destination line := max (1, s.line no - times);
jump back to destination segment;
position wi thin destination segment .
I
I
423
424
+
425
426
427
16/9
Jumpbacktodestlnatlons IJump back to destination segment:
I WIIILE s . line no - length of actual segments head ) destination
I
line REP
I
previous segment (s, atom);
I
I
PER.
file handling
16/9
Zaile
428
429
430
431
E LAN
EUMEL
1.8
441
442
443
444
10.11.86
file hlLndling
I posi tion wi thin destination segment :
pos1 t1onw1 th1ndest1nat
I
I
I
disable stop;
s.index DECR (s.line no - destination line);
s . line no : = destination line .
I
I
4~
433
434
435
436
437
438
439
440
*-
lengthofactualsegments Ilength of actual segments head
I
lEND
I
I
s.1ndex - s.segment begin.
PROC previous atoms;
ITEXT VAR pre, pat, pattern0;
lINT VAR last search line ;
I
searchdown ............... PROC search down (SEQUENCE VAR s, ATOMROW CONST atom, TEXT CONST
pattern,
INT CONST max 11nes, INT VAR column) :
INT CONST start col : = column ,
start line : = s .lineno ;
last search line := min (s.lines, s.lineno + max lines)
pre:= some fix (pattern) ;
pattern0 : = pattern ** 0 ;
down in atoms (s, atom, pre, column);
IF NOT (last search succeeded CAND like pattern)
THEN try again
FI;
last search succeeded .= TRUE
column := matchpos (0) .
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
tryagain
461
462
463
464
Itry again:
I WHILE s . line no ( last search line
I
REP next atom (s, atom) ;
column := 1 ;
I
down in atoms (s, atom, pre, column);
I
IF last search succeeded CAND like pattern
I
THEN LEAVE try agal n
FI
PER;
column . = 1 + LENGTH record;
las t search succeeded : = FALSE
LEAVE search down.
465
466
467
468
469
470
471
likepattern
like pattern :
correct position
pat := any (column-i)
pat CAT any ;
pat CAT pattern0 ;
pat CAT any;
record LIKE pat .
472
473
474
475
476
477
478
479
480
481
482
16/10
correctposi tion
Icorrect position:
I IF s.lineno = start line
I
THEN column : = start col
I
ELSE column := 1
I FI.
I
file hlLndling
16/18
E LAN
Zeile
483
EUMEL
record
**...
file handling
10.11.86
Irecord : a tom (s. index) . line
I
484
485
486
487
1.8
IENDPROC search down;
I
downinatoms .............. PROC down in atoms
pattern,
(S~UENCE
VAR s, ATOMROW CONST atom, TEXT CONST
INT VAR column)
488
489
490
491
492
493
494
495
496
497
498
499
I
I
1&st search succeeded :. FALSE ;
search forwards in actual line ;
IF Nor found AND s . line no < 1&st search line
THEN search in following lines
FI ;
IF found
'mEN 1&s t search succeeded : = TRUE
ELSE set column behind 1&st char
Fl .
500
501
502
setcolumnbehindlastcha I set column behind last char :
I column:. LENGTH atom (s. index) . line + 1 •
503
504
505
506
507
508
509
searchforwardsinactual Isearch forwards
I IF pattern <)
I
'mEN column
I ELIF column )
I
THEN column
I Fl.
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
searchinfollowinglines
525
526
527
searchforwardsthroughs Isearch forwards through segment:
I INT VAR search index : = s. index
I last index .- min (s.segment end, s.index+(1ast search line-s.line
I
no»;
I
I
in actual line :
:. pos (atom (s.index).line, pattern, column)
LENGTH atom (s . index) . line
:. 0
I
I
search in following lines
next atom (s, atom) ;
IF pattern = ft.
'mEN column :. 1 ;
LEAVE search in following lines
FI ;
REP
search forwards thrcugh segment ;
update file posi tion forwards ;
IF found OR s . line no = last search line
THEN LEAVE search in following lines
ELSE next segment (s, a tom)
Fl
PER •
528
I
529
530
531
532
533
I
I
I
534
535
16/11
I
I
I
I
REP
column:. pos (atom (search index).l1ne, pattern)
IF found OR search index = 1&st index
'mEN LEAVE search forwards through segment
FI;
search index INCH 1
PER.
file handling
16/11
Za1le
E LAN
EUMEL
1.8
**-
10.11.86
536
537
538
539
540
541
updatefilepositionforw lupdate file position forwards :
I disable stop ;
I s.line no INCR (search index
I s . index : = search index ;
I enable stop .
542
M3
544
545
found
I
I
Ifound
I
IENDPROC
I
file handling
s.index)
column > 0 .
down in a toms
546
547
548
M9
550
551
552
553
554
555
556
prefix ................... ITEXT PROC prefix (TEXT CONST pattern) :
557
searchup. . . . . . . . . . . . . . . .. PROC search up (SEQUENCE VAH s, ATOMROW CONST atom, TEXT CONST
pattern,
INT CONST max lines, INT VAH column) :
+
558
559
560
561
562
563
564
565
566
567
568
569
570
571
I
I
I
I
I
I
I
I
IENDPROC
I
tryagain
573
574
575
576
577
578
579
PER;
581
582
583
16/12
try again:
WHILE s.lineno > last search line OR column> 1
REP
previous atom (s, atom);
column := LENGTH record ;
up in atoms (s, atom, pre, column);
IF last search succeeded CAND last pattern in line found
THEN LEAVE try again
FI
column := 1;
last search succeeded : = FALSE
LEAVE search up.
58E>
584
prefix
last search line : = max (1, s .lineno - max lines)
pre:= prefix (pattern);
pattern0 := pattern ** 0;
remember start point ;
up in atoms (s, atom, pre, column);
IF
NOT (last search succeeded CAND last pattern in line found)
THEN try again
FI;
last search succeeded := TRUE
column := matchpos (0) .
572
585
586
INT VAH invalid char pos : = pos (pattern, ""0"", ""31"", 1)
SELECT invalid char pos OF
CASE 0
pat tern
CASE 1
OTHERWISE
subtext (pattern, 1, invalid char pos - 1)
ENDSELECT.
rememberstartpoint
remember start point :
INT VAH c:= column, r:= s.l1neno;.
file handling
16/12
E LAN
ZeUe
1.8
EUMEL
587
588
589
590
591
592
593
594
lastpattern1nlinefound
595
596
597
598
599
600
601
l1kepattern
602
rightofsta.rt
603
604
605
606
record
,,
,I
,
,
,,,
,
,
,I,
,,
....
10.11.88
file handling
last pattern 1n line found :
column :. 2 ;
WHILE like pattern CAND right of sta.rt REP
column :. ma.tchpos (0) +1
PER .
column DEeR 1 ;
like pattern CAND right of sta.rt
like pattern :
pat :. any (column-1)
pat CAT any ;
pat CAT pattern0 ;
pat CAT any;
record LIKE pat .
I
,I r1ght of sta.rt
, record
,
,'ENDPROC search up
(r ) s. lineno COR c
)=
ma.tchpos(0) )
atom (s .1ndex) . line
608
609
610
611
612
613
614
615
616
617
618
M9
up1natoms ................ 'PROC up 1n atoms (SEQUENCE VAR s, ATOMROW CONST atom, TEXT CONST
,
pattern,
, I N T VAR column)
,
, last search succeeded :. FALSE ;
I search backllards in actual line ;
, IF NOT found AND s . line no ) last search line
,
THEN search 1n preceeding lines
, FI;
, IF found
,
THEN last search succeeded : = TRUE
,
ELSE column . - 1
, FI.
,
620
621
622
623
624
625
626
627
628
629
searchbackllards1na.ctua 'search backllards in actual line
I IF pattern = ""
,
THEN LEAVE search backllards 1n actual line
, FI;
, INT VAR last pos , nell pos :. 0 ;
, REP
,
last pos : = nell ·pos ;
,
nell pos := pos (atom (s.index).l1ne, pattern, last pos+1)
, UNTIL nell pos = 0 OR nell pos ) column PER ;
, column: = last pos .
607
630
631
632
633
634
635
636
637
,
,,
·search1npreceed1ngline 'search in preceeding lines
, previous atom (s, atom) ;
, IF pattern = ""
,
THEN column := LENGTH atom (s.index) .11ne + 1
, l a s t search succeeded :. TRUE ;
,
LEAVE search in preceeding lines
, FI;
638
,
639
640
,
,
16/13
REP
search backllards through segment
update file position backllards ;
file handling
16/13
ZeUe
E L A II
EUMEL
1.8 ........
_ ....
file handling
IF found OR s . line no = last search line
THEN LEAVE search in preceeding lines
ELSE previous segment (s, atom)
FI
PER .
641
642
64:3
644
645
646
647
648
649
+
650
651
652
653
654
655
656
657
658
659
10.11.86
searchbackwardsthrough
search backwards through segment :
lIlT VAR search index : = s . index ,
last index := III&X (s.segment begin, s.index-(s.line no-last search
line»;
REP
new pos := 0 ;
REP
column : new pos
new pos := pos (atom (search index).line, pattern, column+l)
UNTIL new pos = 0 PER ;
IF found OR search index = last index
THEN LEAVE search backwards through segment
FI ;
search index DECR 1
0::
660
,
661
,
PER.
,
662
66:3
664
665
666
667
updatefilepositionback ,update file position backwards:
, disable stop ;
I s . line no DECR (s. index search index)
I s.index:= search index
I enable stop .
668
669
670
671
672
67:3
found
I
1
'found
column) 0
,
'ENDPROC up 1n atoms
1
IBOOL
I
VAR last search succeeded
674
675
676
M7
678
679
patternfound ............. IOOOL PRO<: pattern found
1
last search succeeded
1ENDPROC pattern found ;
680
681
682
68:3
684
685
686
687
deleteatom ............... IPROC delete atom (S~UENCE VAR used, free, ATOMROW VAR atom)
,
, disable stop;
I IF used. line no (= used. lines
,
THEN delete actual atom
I
ELSE errors top ("'delete' am Ila.telende")
1 Fl.
I
I
,
1
1
688
689
690
691
692
69:3
16/14
deleteactualatom
,delete actual atom
position behind actual free segment;
1 spli t segment (used, a tom) ;
1 lIlT VAR actual index : = used. index;
1 cut off tail of actual used segment;
I delete segments (used, atom, actual index, actual index, 1);
I
file handling
16/14
Zeile
E LAN
EUMEL
1.8
I
I
I
594
695
.....
10.11.86
file handling
insert segments (free, atom, actual index, actual index, 1) .
696
697
698
699
700
positionbehind&etualfr Iposi tion behind &etual free segment
I IF free. line no ( = free. lines
I
THEN next segment (free, atom)
I FI.
701
702
703
cutofft&ilofactualused Icut off t&il of actual used segment :
I IF actual index (> used. segment end
I
THEN used. index INCR 1;
I
split segment (used, atom);
I
used. index DECR 1
I Fl.
704
705
706
707
I
I
I
IEND PROC delete atom;
708
709
I
I
710
711
insert&tom ............... IPROC insert atom (SEQUENCE VAR used, free,INT VAR unused, ATOMROIY
I
VAR atom) :
712
I
713
714
715
I
I
I
I
I
I
I
716
717
718
719
720
721
722
723
724
725
I
I
I
insertnewatomfromfrees I insert new atom from free sequence :
I get a free segments he&d;
I make this atom to actual segment;
I transfer from free to used chain .
726
727
728
729
7~
731
732
disable stop;
split segment (used, atom);
IF free . lines > 0
THEN insert new atom from free sequence
ELIF unused (. file size
THEN insert new atom from unused t&1l
ELSE
errorstop ("FlLE-Ueberl&uf")
Fl.
get&freesegmentshe&d
I
I
Iget
I
I
I
I
a free segments he&d :
IF actual free segment is root segment
THEN previous segment (free, atom)
FI;
posi ticn to &etual segments he&d .
I
I
733
734
735
736
737
posi tiontoactualsegmen Iposi tion to actual segments he&d :
I INT VAR actual index : = free. segment begin;
I free.line no DEeR (free.index - actual index);
I free. index : = actual index .
738
makethisatomto&etualse lmake this atom to actual segment:
I IF free.segment end> actual index
I THEN free. index INCR 1;
I
split segment (free, atom);
I
free. index DEeR 1
I FI.
739
740
741
742
743
744
16/15
I
I
I
file handling
15/15
Zelle
-
E LAN
EUMEL 1.8 •• **
10.11.86
**.*
flle handling
745
746
747
748
ft9
transferfromfreetoused I transfer from free to used chain :
I delete segments (free, atom, actual index, actual index, 1);
I insert segments (used , atom, actual index, actual index, 1);
I atom (actual index) . line . - ••
750
751
752
753
insertnewatomfromunuse I insert new a tom from unused tail
I actual index : = unused;
I a tom (actual index). seg : =
I
SmMENT: (actual index, actual index, actual
I
index);
I atom (actual index).line := •• ;
I insert segments (used, a tom, actual index, actual index, 1);
I unused INCR 1
+
754
755
756
757
758
+
I
I
I
I
actualfreesegmentisroo lactual free segment is root segment
I
root.
+
764
=
free
I
759
760
761
762
763
free. segment begin
lEND PROC insert atom;
I
I
insertnext ............... IPROC insert next (SEQUENCE VAR used, free, INT VAR unused, ATOMROW
I
VAR atom,
I
TEXT CONST record)
I
765
766
767
768
769
I
I
I
I
I
I
I
770
771
772
773
I
I
IF used.ltre no > used.lines
THEN insert a tom (used, free, unused, a tom)
ELIF actual position before unused nonempty atomrow part
THEN forward and insert atom by simple extension of used atomrow
part
ELSE next atom (used, atom);
insert atom (used, free, unused, atom)
FI;
atom (used.index).line := record.
I
I
774
775
776
777
778
779
780
781
782
forwardandinsertatomby Iforward and insert atom by simple extension of used atomrow part
I used. line no I!'CR 1;
I used. lines INCR 1;
I used, index INCR 1;
I used, segment end INCR 1;
I atom (used.segment begin) ,seg.end INCR 1;
I unused INCR 1 .
783
784
785
actualpositionbeforeun lactual position before unused nonempty atomrow part
I used. index = unused - 1 AND unused part not empty
786
unusedpartnotempty
787
788
789
790
791
792
793
16/16
I
I
I
I
Iunused part not empty
unused <= file size .
I
lEND PROC insert next;
I
I
transfersubsequence ...... IPROC transfer subsequence (SEQUENCE VAR source, dest,
I
ATOMROW VAR atom, INT CONST size)
I
file handling
16/16
Zeile
E LAN
EUME!.
794
795
796
797
798
799
800
801
802
803
804
805
806
807
markbeginofsourcepart
1.8.....
I
I
I
I
I
I
I
I
I
fUe handling
10.11.86
IF size ) 0
THEN INT VAA subsequence size : = min (size, source . line no);
mark begin of source part;
mark end of source part;
split destination sequence;
transrer part
Fl.
lmark begin of source part :
previous atoms (source, atom, subsequence size - 1);
split segment (source, atom);
I INT CONST first : = source. segment begin .
I
I
I
markendofsourcepart
808
809
810
811
&2
I
Imark end or source part :
next atoms (source, atom, subsequence size - 1);
I INT CONST last := source. segment begin;
I next atom (source, atom);
I split segment (source, atom) .
I
I
I
813
814
815
splitdestinationsequen Isplit destination sequence:
I split segment (dest, atom)
816
817
transferpart
818
819
820
821
822
823
824
825
826
827
+
828
829
+
83e
+
831
+
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
16/17
I
I
Itransfer part
disable stop;
delete segments (source, atom, first, last, subsequence size);
I source . line no DEeR subsequence size;
I insert segments (dest, atom, first, last, subsequence size);
I next atoms (dest, atom, subsequence size - 1) .
I
I
I
IEND PROC transfer subsequence;
I
I
I
1(****.*****..****.***...................................***............... 1• • • • • •
I
1( ......
I
***.*)
I(.......
I
* •••• )
FILE handler
1( •••••
I
••• _)
I( •••••*.****************.*•••*****.****..*******••**............. ~
I
)
I
I
I
ILET
I
I
I
I
I
I
I
file type
file type 16
closed
inp
outp
mod
end
1003
1002
&
a
0,
1,
2,
3,
4,
I
I
I
max limit
super limit
16000,
= 16001;
I
file handling
16/17
Zeile
E LAN
EUMEL
1.8
_..
10.11.86
847
I
848
ITYPE TRANSPUTDIRECTION
849
850
I
I
851
852
853
854
855
856
857
858
859
I
I
output ................... ITRANSPUTDIRECTION PROC output
I TRANSPIlTDlRECTION: (outp)
lEND PROC output;
I
I
modify ................... ITRANSPUTDIRECTION PROC modify
I TRANSPUTDIRECTION: (mod)
I END PROC modify;
I
I
IFILE VAR result file;
I
I
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
+
886
887
888
889
890
891
892
893
894
895
896
16/18
IN!;
input .................... ITRANSPUTDlRECTION PROC input
I TRANSPIlTDlRECTION: (inp)
lEND PROC input;
860
861
862
863
864
865
866
867
file handling
sequentiAlfile ........... IFILE PROC sequentiAl file (TRANSPUTDIRECTION CONST mode,
I
DATASPACE CONST ds)
I IF
type (ds) • file type
I THEN result: = ds
I ELIF type (ds) ( 0
I THEN result: = ds; type (ds, file type); initiAlize (result file)
I ELSE enAble stop; errorstop ("lJatenr&um hat f&Ischen Typ")
I FI;
I reset (result file, mode);
I result file .
result
I
I
Iresult : CONCR (result file)
I
IEND PROC sequential file;
I
I
sequentialflle ........... IFILE PROC sequential file (TRANSPUTDIRECTION CONST mode, TEXT CONST
I
nAme):
I
I
I
I
I
I
I
I
I
I
I
IF
exists (name)
THEN get datAspace if file
ELIF CONCR (mode) () inp
THEN get nell file space
ELSE errors top (""""+n&me+""" giht es nicht")
FI;
updAte stAtus if necessary;
reset (result file, mode);
result file .
file handli ng
enAble stop
16/18
Zeile
E LAN
897
898
899
900
901
902
903
904
905
906
907
getdataspaceiffile
908
is170file
EUMEL
10.11.86
file handling
Iget dataspace if file :
I IF type (old (name)) = file type 16
I
THEN reorganize (name)
I Fl;
I result: = old (n&me, file type)
I IF is 170 file
I
THEN result.col :- 1 .
I
result.m&rk line :. e
I
result.m&rk col : = 0
I Fl.
I
I
Iis 170 file
result .m&rk col <
e.
I
909
910
911
912
913
914
915
1.8 ••••
getnewfilespace
I
Iget new file space :
I result:= new (name);
I IF
NOT is error
I THEN type (old (n&me) , file type); ini tialize (result file)
I Fl.
I
I
916
917
918
~
updatestatusifnecess&r lupdate status if necessary:
I IF
CONCR (mode) () inp
I THEN status (name, ft"); headline (result file, name)
I Fl.
920
921
922
923
924
925
result
I
I
Iresult: CONCH (result file)
I
IEND PROC sequential file;
I
I
926
927
928
929
930
931
932
933
934
reset .................... IPROC reset (FILE VAH f)
935
936
937
936
939
940
941
reset .................... IPROC reset (FILE VAH f, TRANSPUTDIRECTION CONST mode)
942
943
944
945
946
947
948
949
16/19
I
I
IF f.mode
= end
THEN reset
I
ELSE reset
I
I FI •
I
IENDPROC reset
I
I
I
I
I
ini t1alizefileindex
I
I
I
(f, input)
(f, TRANSPUTDIRECTION: (f. mode) )
IF f. mode () mod OR new mode () mod
THEN f. mode : = new mode ;
initialize file index
Fl.
11ni tialize file index :
I IF new mode = outp
I
THEN to line without check (f, f.used.lines);
I
col := super limit
I
ELSE to line without check (f, 1);
I
col : = 1 ;
I
IF new mode = inp AND file is empty
I
THEN f. mode : = end
file handling
16/19
E LAN
Zeile
950
951
952
953
954
filelsempty
955
956
newmocie
957
958
959
960
961
col
962
963
964
965
966
967
968
1.8
EUMEL
....
10.11.86
file handling
FI
I
I FI .
I
I
f.used.lines • 0 •
Ifile is empty
I
I
CONCR (mode) .
Inew mode
I
I
CONCH (CONCR (f)) .col .
Icol
I
IEND PROC reset;
I
I
input .................... IPROC input (FILE VAR f)
I
I
reset (f. input)
I
lEND PROC input;
I
I
969
970
971
972
973
974
975
output ................... IPROC output (FILE VAR f)
976
977
978
979
modify ................... IPROG modify (FILE VAR f)
I
I
reset (f. output)
I
lEND
I
I
moe
output;
I
I
reset (f. modify)
I
980
IEND PROG modify;
981
982
I
I
983
984
985
986
987
988
989
close .................... Imoe close (FILE VAR f)
990
checkmode ................ IPROG check mode (FILE CONST f. INT CONST mode)
I
I
IEND
I
I
991
I
992
I
I
I
I
I
I
I
993
994
995
996
997
998
16/20
f . mode :. closed
I
moe
close;
IF f. mode = mode
THEN LEAVE check mode
ELIF f. mode = closed
THEN errors top ("!l&tei zu!")
ELIF f. mode = mod
THEN errors top ("unzul&esslger Zugrlff auf modify-FILE")
ELIF mode = mod
file handling
16/20
Zeile
E LAN
EUMEL
1.8
I
I
I
I
I
I
I
I
I
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
.*..
THEN
ELIF
THEN
ELIF
THEN
ELIF
THEN
FI .
10.11.86
file handling
errors top ("Zugrlff nur auf modify-FILE zulaessig")
f.mode • end
errorstop ("Leseversuch nach Dateiende")
mode • inp
errorstop ("Leseversuch auf output-FILE")
mode • outp
errorstop ("Schreibversuch auf input-FILE")
lEND PROC check mode;
I
I
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
tol1newithoutcheck ....... IPROC to line without check (FILE VAR t, INT CONST destination line)
1023
1024
1025
1026
1027
1028
1029
1030
toline ................... IPROC to line (FILE VAR f, INT CONST destination line)
1031
1032
1033
1034
1035
1036
1037
tofirstrecord ............ I PROC to first record (FILE VAR f)
1038
1039
1040
1041
1042
1043
1044
toeof .................... IPROC to eof (FILE VAR f) :
1045
1046
1047
1048
1049
putline .................. 1PROC putline (FILE VAR f, TEXT CONST word)
16/21
I
I INT CONST distance :. destination line - f.used.line
I IF distance > 0
I THEN next atoms (f.used, f. atoms , distance)
I ELIF distance ( 0
I
THEN previous atoms (f.used, f.atoms, - distance)
I FI.
I
IEND PROC to line wi thout check;
I
I
I
I
I
I
no;
check mode (f, mod);
to line without check (C, destination line)
lEND PROC to line;
I
I
I
I to line (f, 1)
I
IEND PROC to first
I
I
record;
I
I
I
to line (f, f. used. lines + 1) .
lEND PROC to eof;
I
I
I
I
I
write (f, word);
col:· super limit
I
file handling
16/21
E LAN
Ze1le
1050
1051
1052
1053
1054
col
EUMEL
10.11.86
1.8
file handling
Icol : CONCR (CONCR (f)). col
I
IEND PROC putUne;
I
I
1055
1056
1057
1058
1059
1060
1061
1062
deleterecord ............. IPROC delete record (FILE VAR f)
1063
1064
1005
1066
1067
1068
1069
1070
insertrecord ............. IPROC insert record (FILE VAR f)
1071
1072
1073
11374
11375
1076
11377
down ..................... IPROC down (FILE VAR f)
1078
1079
1080
1081
up ....................... IPROC up (FILE VAR f)
I
I
I
I
check mode (f, mod);
delete atom (f.used, f.free, f.atoms) .
lEND PROC delete record;
I
I
I
I
I
check mode (f, mod);
insert atom (f. used, f. free, f. unused tail, r .atoms) .
I
IEND
I
I
I
I
I
check mode (f, mod);
next atom (r.used, f.atoms)
I
IEND
I
1082
I
I
I
I
1083
1084
I
PROC insert record;
PROC down
check mode (f, mod);
previous atom (f. used, f.atoms) .
lEND PROC up
1085
1086
1087
1088
1089
11390
down ..................... IPROC down (FILE VAR f, INT CONST n)
11391
1092
1093
1094
11395
1096
1097
up ....................... IPROC up (FILE VAR f, INT CONST n)
16/22
I
I to line (f,
I
IENDPROC down
I
I
I to line (f,
I
IENDPROC up
I
I
!ineno (f) + n)
lineno (f)' - n)
rile handling
16/22
E LAN
Zeile
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1.8 ****
EUMEL
fUe handling
10.11.86
IIri terecord .............. IPROC IIr! te record (FILE VAH f, TEXT CONST record)
I
I
I
I
I
notateof
I
I
I
check mode (f, mod);
IF
not at eof
THEN f.atoms (f.used.index).line :. record
ELSE errors top ("'write' nach Datelende")
FI.
Inot at eof
f.used.line no <= f.used.lines .
I
IEND PROC wri te record;
I
I
1111
llU
1113
1114
1115
1116
1117
1118
readrecord ............... IPROC read record (FILE CONST f, TEXT VAH record)
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
line ..................... PROC line (FILE VAH f)
I
I
I
check mode (f, mod);
record:= f.atoms (f.used.index).line
I
IEND PROC read record;
I
I
IF
mode = end
THEN errors top ("Leseversuch Mch Dateiende")
ELIF mode = inp
THEN next a tom (f. used, f . atoms); col :. 1; check eof
ELIF mode = outp
THEN IF co 1 <= max limit
THEN col : = super limit
ELSE append empty line
FI
FI .
Iappend empty line :
I insert next (f.used, f.free, f.unused tail, f. atoms , "") .
1132
1133
1134
appendemptyline
1135
1136
col
Icol
1137
1138
mode
I
I
Imode
I
I
1139
1140
1141
1142
1143
1144
checkeof
1145
1146
1147
1148
16/23
I
I
CONCR (CONCR
(f)). col
.
CONCR (CONCR (f)). mode .
Icheck eof
I IF eof (f) THEN mode := end FI .
I
IEND
I
I
PROC li ne ;
line ..................... IPROC line (FILE VAH f, INT CONST lines) :
I
I
INT VAH i; FOR i FROM 1 UPI'O lines REP line (f) PER
I
file handling
16/23
E LAN
Zeile
1149
1150
1151
1152
1153
1154
1155
1156
1157
W8
1159
1160
1161
1162
1.8 ****
EUMEL
10.11.86
file handling
lEND PROC line;
I
I
getline. . . . . . . . . . . . . . . . .. PROC getline (FILE VAR f, TEXT VAR text)
check mode (f, inp);
text ;= subtext (record, f.col);
IF f.used.line no >= f.used.lines
THEN f. mode ; = end ;
~t~d~fi~
EISE to next line
f.col ;.1
FI .
1163
1164
1165
tonextline
1166
1167
1168
setendofflle
1169
1170
1171
1172
1173
record
I to next line :
I next atom (f.used, f.atoms)
I
I
Iset end of flle
I f. col : = LENGTH record + 1 .
I
I
Irecord : f.atoms (f.used.index).line
I
lEND PROC getline;
I
I
1174
1175
1176
1177
1178
1179
1180
1181
isfirstrecord ............ IBOOL PROC is first record (FILE CONST f)
1182
1183
1184
1185
1186
1187
1188
eof ...................... IBOOL PROC eof (FILE CONST f) :
1189
1190
I
I
I
I
check mode (f, mod);
f.used.line no = 1 .
IEND PROC is first record;
I
I
I
I
I
I
I
IF
line no < lines THEN FAISE
ELIF line no
lines THEN col > LENGTH record
EISE
TRUE
Fl.
I
I
lineno
lines
lline no
I
I lines
f. used . line no
f. used . lines
I
1191
1192
1193
1194
1195
1196
16/24
col
record
Icol
I
f.col .
Irecord
f.atoms (f.used.index) .11ne .
I
IEND
I
I
PROC eof;
file handling
16/24
E LAN
Zeile
EUMEL
1.8
••••
10.11.86
file handling
1197
1198
1199
1200
1201
1202
1203
lineno ................... 1INT PROC line no (FILE CONST f)
1204
1205
1206
1207
1208
1209
linetype ................. IPROC line type (FILE VAR 1', INT CONST t)
1210
1211
1212
1213
1214
1215
1216
linetype ................. lINT PROC line type (FILE CONST f)
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
put ...................... IPROC put (FILE VAR 1', TEXT CONST word)
I
I
l' . used. line no
I
IEND PROC line no;
I
I
I
I
f .atoms (f. used. index) . type : = t .
I
IENDPROC line type
I
I
I
l' . atoms (f. used. index) . type
I
IENDPROC line type
I
I
I
I
I
I
I
I
I
I
check mode (1', outp);
IF col + LENGTH word , l' .limi t
THEN append new line
ELSE record CAT word
FI;
record CAT " ";
col:= LENGTH record + 1
I
I
1227
1228
1229
appendnewline
1230
record
Iappend new line
I insert next (f.used, f.free, f.unused tail, f. atoms , word) .
I
I
I record
l' . atoms (f. used. index) . line .
I
1231
1232
1233
1234
1235
col
Icol:
f.col
I
lEND PROC put;
I
I
1236
1237
1238
1239
1240
1241
1242
put ...................... IPROC put (FILE VAR 1', INT CONST value)
1243
1244
1245
put ...................•.. IPROC put (FILE VAR 1', REAL CONST real)
16/25
I
I
put (1', text (value))
I
lEND
I
I
PROC put;
I
I
put (1', text (real))
file handling
16/25
E LAN
Zeile
1.8
****
10.11.86
rile h&ndling
I
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
EUMEL
lEND PROC put;
I
I
write .................... IPROC write (FILE VAR r, TEXT CONST word)
I
I
I
I
I
I
I
check mode (r, outp);
IF col .. LENGTH word - 1 ) f .limi t
THEN append new line
ELSE record CAT word
FI;
col: = LENGTH record .. 1
I
I
1259
1260
1261
appendnewline
1262
record
Iappend new line
I insert next (f.used, f.free, f.unused tail, f. atoms , word) .
I
I
Irecord
f.atoms (f.used.index).line .
I
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
col
Icol
I
lEND
f.col .
PROC write;
I
I
get ...................... IPROC get (FILE VAR f, TEXT VAR word, TEXT CONST separator)
I
I
I
I
I
I
I
I
I
1277
1278
1279
1280
sk1pseparators
1281
1282
1283
isseparator
1284
1285
wordfound
1286
1287
1288
1289
1290
1291
1292
getword
1293
1294
sepa.ra.torround
check mode (f, inp);
skip separators;
IF word found
THEN get word
ELSE try to find word 1n next line
FI .
I skip separators
I INT CONST separator length := LENGTH separator;
I WHILE 1s separator REP col INCH separator length PER
I
I
16/26
11s separator:
I subtext (record, col, col .. separator length - 1)
I
I
Iword found
col
(=
separator.
LENGTH record .
I
I
Iget word
lINT VAR end of word := pos (record, sepa.ra.tor, col) - 1;
I IF separs. tor found
THEN get text upto sepa.r& tor
I
I ELSE get rest of record
I FI .
I
I
Isepara tor found
end or word ). 0 .
I
file handling
16/26
Zelle
E LAN
1295
1296
1297
1298
1299
gettextuptoseparator
1300
1301
1302
getrestofrecord
1303
record
EUMEL
1.8
••••
11;).11.86
fUe handling
Iget text upto separator:
I word: = subtext (record, col, end of word);
I col:= end of word + separator length + 1;
I IF col> LENGTH record THEN line (f) FI .
I
I
Iget rest of record
I word:= subtext (record, col); 11ne (f) .
I
I
Irecord
f.atoms (f.used.index).line .
I
1304
1305
col
1306
1307
trytcfindwordinnextlin I try to find word in next line :
I line (f); IF eof (f) THEN word .' "" ELSE get (f, word, separator)
I
FI .
f.col .
I
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
Icol
I
I
IEND PROC get;
I
I
get ...................... IPROC get (FILE VAH f, TEXT VAH word, INT CONST max length)
I
I
I
I
I
I
I
I
check mode
IF word is
THEN get
ELSE get
(f, lnp);
only a part of record
text of certain length
rest of record
FI .
1320
1321
1322
wordisonlyapartofrecor Iword is only a part of record :
I col <= LENGTH record - max length
1323
1324
1325
1326
gettextofcertalnlength Iget text of certain length :
I word:= text (record, max length, col);
I col INCR max length
1327
1328
1329
getrestofrecord
1330
record
I
I
I
I
Iget rest of record
I word:= subtext (record, col); line (f) .
I
I
Irecord
f.atoms (f.used.1ndex).line .
I
1331
1332
1333
1334
1335
1336
1337
1338
1339
134@
1341
1342
16/27
col
Icol
f.col
I
lEND PROC get;
I
I
get ...................... IPROC get (FILE VAR f, TEXT VAH word)
I
I
get (f, word, " ")
I
lEND PROC get;
I
I
file handling
16/27
Zeile
E LAN
EUMEL
1343
1344
1345
1.8
****
10.11.86
file handling
ITEXT VMl number word;
I
I
1346
1347
1348
1349
1350
1351
1352
1353
get ...................... IPROC get (FILE VMl f, INT VMl number)
I
I get (f, number word);
I number: = int (number word)
I
IEND PROC get;
I
I
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
get ...................... IPROC get (FILE VAR f, REAL VMl number)
I
I get (f, number word);
I number:. real (number word)
I
IEND PROC get;
I
I
ITEXT VMl split record
lINT VMl indentation
1365
1366
1367
1368
1369
1370
spli tline ................ IPROC split line (FILE VMl f, INT CONST split col)
I
I split line (f, split col, TRUE)
1371
splitline ................ IPROC split line (FILE VMl f, INT CONST split col, BOOL CONST note
I
indentation ) :
I
I IF note indentation
I
THEN get indentation
I
EISE indentation : = 0
I FI;
I get split record ;
I insert split record and indentation
I cut off old record .
1372
1373
1374
1375
1376
1377
1378
1379
I
I
IENDPROC spli t line ;
I
I
I
1380
1381
1382
1383
1384
1385
1386
getindentation
1387
1388
1389
getspli trecord
1390
1391
1392
insertspli trecordandin I insert split record and indentation
I down (f) ;
I insert record (f) ;
16/28
Iget indentation :
I indentation:= pos (actual record,""33"",""254"",1) - 1
I IF indentation ( 0 OR indentation )= split col
I
THEN indentation : = split col - 1
I Fl.
I
I
Iget split record
I split record :. subtext (actual record, split col, max limit)
I
I
file handling
16/28
Zeile
E LAN
I
I
I
I
I
I
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
cutoffoldrecord
1403
1404
1405
1406
actualrecord
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1.8 ****
EUMEL
10.11.86
file handling
INT VAR i ;
FOR i FROM 1 llPTO indentation REP
actual record CAT " "
PER ;
actual record CAT split record
up (f)
I
I
Icut off old record
I actual record :=
I
I
subtext (actual record, 1, split col-l)
lactual record: f.atoms (f.used.index).line .
I
IENDPROC spli t line ;
I
concatenate line .......... PROC concatenate line (FILE VAR f, oooL CONST delete blanks)
down (f) ;
spli t record : = actual record
IF delete blanks
THEN delete leading blanks
FI ;
delete record (f)
up (f)
actual record CAT spl1 t record
1418
1419
1420
1421
1422
1423
deleteleadingblanks
1424
1425
1426
1427
actualrecord
Idelete leading blanks :
I INT CONST non blank col := pos (split record,
I IF non blank col > 0
THEN split record : = subtext (split record,
I
I FI.
I
I
f.atoms (f.used.index).line
Iactual record
I
non blank col)
IENDPROC concatenate line
I
1428
1429
14:30
1431
concatenate line .......... IPROC concatena.te line (FILE VAR f)
I concatenate line (f, TRUE)
IENDPROC concatenate line ;
1432
1433
1434
1435
1436
1437
1438
1439
1440
reorganize ............... IPROC reorganize :
16/29
""33"", ""254 U
I
I
I
I
reorganize (last pa.ra.m)
lEND PROC reorganize;
I
I
ITEXT VAR file record
I
file handling
16/29
,
1)
Zeile
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
E LAN
EUMEL
••••
10.11.86
reorganize ............... IPROC reorganize (TEXT CONST file
file h&ndling
name)
enable stop ;
FILE VAR input file, output file;
DATASPACE VAR scratch space;
INT CONST type of do. taspace : = type (old (file
INT VAR counter;
name»
last pa.ram (file name);
IF type of dataspace = file type
THEN reorganize new to new
ELIF type of dataspace = file type 16
THEN reorganize old to new
ELSE errors top ("Datenraum hat falschen Typ")
FI;
replace file space by scratch space .
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
reorganizenewtonew
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
reorganizeold tonew
16/:38
1.8
reorganize new to new :
input file: = sequential file (input, file name);
disable stop ;
scratch space : = nilspace
output file : = sequential file (output, scratch space);
copy attributes (input file, output file) ;
FOR counter FROM 1 UPI'O 9999
WHILE NOT eof (input file) REP
cout (counter);
getline (input file, file record);
putline (output file, file record);
check for interrupt
PER .
Ireorganize old to new:
I LET OLDRECORD = STRUCT (INT succ, pred, x, y, TEXT record);
I LET OLDFILE = BOUND ROW 4075 OLDRECORD;
I LET date ianker = 2, fre ianker = 1;
I INT VAR index := date1anker;
I
I
I
I
I
I
I
I
I
OLDFlLE VAR old file : = old (file name);
disable stop;
scratch space:. nilspace;
output file := sequential f11e (output, scratch space);
get old attributes ;
say ("Date1 wird in 1. 7-Format gewandelt: ")
I FOR counter FROM 1 UPI'O 9999
I WHILE NOT end of old file REP
cout (counter);
I
index : = next record;
I
file record : = record of old file ;
I
IF pos (file record, ""128"", ""259"". 1) ) 0
I
THEN change special chars
I
I FI ;
putline (output file, file record);
I
check for interrupt
I
I
I
PER •
file handling
16/38
Zeile
E LAN
1499
1500
15191
15192
getoldattributes
15193
15194
15195
getoldheadline
15196
1507
1508
getoldlimitandtabs
EUMEL
1.8 ••••
file handling
Iget old attributes:
I get old headline ;
I get old limit and tabs
I
I
Iget old headline :
I headline (output file, old file (dateianker) . record) .
I
I
Iget old limit and tabs:
I file record : = old file (freianker). record
I max line length (output file, int (subtext (file record, 11, 15))
I
1509
1510
119.11.86
I
put tabs (output file, subtext (file record, 16)) .
I
I
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
changespecialchars
1524
1525
endofoldfile
1526
1527
nextrecord
1528
1529
recordofoldfile
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
checkforinterrupt
15419
1541
1542
1543
1544
1545
1546
1547
1548
1549
replacefilespacebyscra Ireplace file space by scratch space:
I headline (output file, file name);
I forget (file name, quiet)
I type (scratch space, file type);
I copy (scratch space, file name);
I forget (scratch space)
16/31
Ichange special chars :
I change all (file record,
I change all (file record,
I change all (file record,
I change all (file record,
I change all (file record,
I change all (file record,
I change all (file record,
I change all (file record,
I change all (file record,
I change all (file record,
I change all (file record,
I
I
lend of old file
I
I
I next record
""193"",
""207"",
""213"",
""225"",
""239"",
""245"",
""235"",
""173"",
""163"",
""214"")
""215"")
""216"")
""217"")
""218"")
""219"")
""220"")
""221"")
""222"")
(.
(.
(*
(*
(.
(.
(.
(.
(.
""160"", ""223"") (*
""194"", ""251"") (.
next record
Ae .)
De .)
Ue
ae
oe
ue
k
-
*)
.)
*)
.)
.)
*)
fis
.)
blank *)
eszet .)
dateianker.
old file (index). succ .
I
I
Irecord of old file
old file (index) . record .
I
I
Icheck for interrupt :
I INT VAR size, used ;
I storage (size, used)
I IF used ) size
I
THEN errorstop ("Speicherengpass")
I FI;
I IF is error
I
THEN forget (scratch space)
LEAVE reorganize
I FI.
I
I
I
lEND PROC reorganize;
I
I
file handling
16/:31
Zeile
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
.....
ELAN
EUMEL
1. 8
••••
10.11. 86
file handling
setrange ................. ,PROC set range (FILE VAR f, INT CONST start line, start col,
' m A N G E VAR old range)
,
, check mode (f, mod);
, IF valid restriction parameters
,
THEN prepare last line ;
' p r e p a r e first line ;
' s a v e old range ;
, s e t new range
,
ELSE errors top ("mANGE ungueltig")
, FI.
,
,
1564
validrestrictionparame 'valid restriction parameters
, start line ) 0 AND start col ) 0 AND start before or at actual
,
point
,
1565
1566
1567
1568
startbeforeoratactualp 'start before or at actual point:
, start line , line no (f) OR
, start line = line no (f) AND start col
,
1569
1570
1571
1572
1573
1574
preparelastline
1575
1576
1577
1578
1579
preparefirstline
'prepare first line :
, IF start col ) 1
,
THEN split start line
, FI.
,
1580
1581
1582
1583
1584
1585
spli tstartline
,spli t start line :
, INT VAR old line no :. line no (f)
, to line (f, start line) ;
, split line (f, start col, FALSE)
, to line (f, old line no + 1) .
,
1586
1587
1588
1589
saveoldrange
'save old range
, old range.pre :. f.prefix lines;
, old range.post:. f.postfix lines.
,
1590
1591
1592
1593
1594
1595
1596
1597
1598
setnewrange
,set new range
I get pre lines
, get post lines
, disable stop ;
I f . prefix lines INCR pre lines ;
, f.postfix lines INCR post lines
, f. used . lines DECR (post lines + pre lines)
, f. used. line no DECR pre lines
1599
1600
1601
1602
getprelines
1562
1563
16/32
,
,=
col (f) .
,
'prepare last line :
, INT VAR last line
, IF col (f) ) 1
,
THEN split line (f, col( f), FALSE)
, FI.
,I
,
,
,
,,
,get pre lines :
, INT VAR pre lines
, IF start col • 1
,
THEN old range. pre was split:. FALSE
file handling
16/32
Zeile
E LAN
1603
1604
I
I
I
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1.8 ****
EUMEL
getpostlines
10.11.86
pre lines : = start line - 1
ELSE old range.pre was split := TRUE
pre lines : = start line
I FI.
I
I
Iget post lines :
I INT VAH post lines
I IF col (fl = 1
I
THEN old range. post was split: = FALSE ;
I
post lines := lines (fl - line no (f) + 1
I
ELSE old range.post was split := TRUE ;
I
post lines := lines (f) - line no (fl
I FI.
I
IEND PROC set range;
I
I
setrange ................. IPROC set range (FILE VAH f, FRANGE VAH new range)
I
I
I
I
I
I
I
I
I
I
I
I
check mode (f, mod);
INT CONST pre add : = prefix - new range. pre,
post add := postfix - new range.post;
IF pre add ( 0 OR post add ( 0
THEN errorstop ("mANGE ul1gUeltig")
ELSE set new range;
undo splitting if necessary
make range var invalid
FI.
1632
1633
1634
1635
1636
1637
1638
setnewrange
1639
1640
1641
1642
1643
1644
1645
1646
undosplittingifnecessa lunda splitting if necessary:
I IF new range. pre was split
I
THEN concatenate first line
I FI;
I IF new range.post was split
I
THEN concatenate last line
1647
1648
1649
1650
1651
1652
concatenatefirstline
1653
1654
1655
1656
1657
concatenatelastline
16/33
file handling
Iset new range
I disable stop;
I prefix DECR pre add;
I postfix DECR post add;
I used. line no INCR pre add;
I used. lines INCR (pre add + post add)
I
I
I Fl.
I
I
Iconcatenate first line :
I INT VAR old line : = line no (f)
I to line (f, pre add) ;
I concatenate line (f, FALSE)
I to line (f, old line - 1) .
I
I
Iconcatenate
I
I
I
I
last line :
old line : = line no (fl
to line (f, lines (f) - post add)
concatenate line (f, FALSE)
to line (f, old line) .
file handling
16/33
E LAN
Zeile
1.8 ....
EUMEL
file handling
I
I
1658
1659
1660
1661
rn&kerangevarinvalid
1662
used
IlII8.ke range var invalid :
I new range.pre := I118.xint
I
I
Iused
I
1663
10.11.86
prefix
Iprefix
f. used .
f. prefix lines .
I
1664
1665
1665
1667
postfix
Ipostfix : f. postfix lines .
I
IEND PROC set range;
I
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
resetrange ............... IPROC reset range (FILE VAR f)
I
I mANGE VAR complete
I complete.pre := 0 ;
I complete.post: = 0 ;
I complete. pre was split := FALSE
I complete.post was split:= FALSE
I set range (f, complete)
I
IENDPROC reset range ;
I
1679
1680
1681
1682
1683
1684
1685
1686
remove ................... IPROC remove (FILE VAR f, INT CONST size)
1687
1688
1689
1690
clearremoved ............. IPROC clear removed (FILE VAR f)
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
161M
I
I
I
check mode (f, mod);
transfer subsequence (f.used, f.scratch, f.atoms, size) .
I
IEND PROC remove;
I
I
I
I
I
check mode (f, mod);
transfer subsequence (f.scratch, f.free, f.atoms, f.scratch.lines)
I
I
lEND PROC clear removed;
I
I
reinsert ................. IPROC reinsert (FILE VAR f)
I
I
I
check mode (f, mod);
transfer subsequence (f. scratch, f.used, f.atoms, f.scratch.l1nes)
I
I
IEND PROC reinsert;
I
I
file handling
161M
E LAN
Zaile
1703
1704
1705
1706
1707
EUMEL
1.8
••••
10.11.86
file handling
copyattributes ........... IPROC copy attributes (FILE CONST source file, FILE VAR dest file)
I
I
I
I
dest.limit
:= source.limit
dest.atoms (free root).line
.- source.atoms (free root).line
dest.atoms (scratch root).line := source.atoms (scratch root).line
I
1708
1709
1710
1711
1712
1713
1714
1715
I
dest.edit info
.- source.edit info.
I
dest
source
I
Idest
CONCR (CONCR (dest file»
I
Isource
I
CONCR (CONCR (source file»
.
IENDPROC copy attributes
I
I
1716
1717
1718
1719
1720
1721
1722
maxlinelength ............ lINT PROC max line length (FILE CONST f)
1723
1724
1725
1726
1727
1728
1729
1730
1731
maxlinelength ............ IPROC max line length (FILE VAR f, INT CONST new limit)
1732
1733
1734
1735
1736
headline ................. ITEXT PROC headline (rILE CONST f)
~M
1738
I
I
f.limit.
I
lEND PROC max line length;
I
I
I
I
I
I
I
IF new limit ) 0 AND new limit <= max limit
THEN f .limi t . - new limi t
rI .
lEND PROC max line length;
I
I
I
I f . atoms (free root) . line
I
IEND PROC headline;
I
I
1739
1740
1741
1742
1743
1744
1745
headline ................. IPROC headline (FILE VAR f, TEXT CONST head)
1746
1747
1748
1749
1750
1751
get tabs .................. IPROC get tabs (FILE CONST f, TEXT VAR tabs)
16/35
I
I
f.atoms (free root) . line := head .
I
lEND PROC headline;
I
I
I
I
I
tabs:= f.atoms (scratch root).line
lEND PROC get tabs;
I
file handling
16/35
Zeile
••••
E LAN
1.8 ....
EUMEL
10.11.86
••••
file handling
1752
1753
1754
1755
1756
1757
1758
1759
putta.bs .................. IPROC put ta.bs (FILE VAR 1', TEXT CONST ta.bs)
1760
1761
1762
1763
1764
1765
1766
editinfo ................. lINT PROC edit info (FILE CONST f)
1767
1768
1769
1770
1771
1772
1773
editinfo ................. IPROC edit into (FILE VAR 1', INT CONST into)
1774
1775
1776
1777
1778
1779
1780
lines .................... lINT PROC lines (FILE CONST f)
1781
1782
1783
1784
1785
1786
1787
removedlines ............. lINT PROC removed lines (FILE CONST f)
1788
1789
1790
segments ................. lINT PROC segments (FILE CONST f) :
+
1791
1792
1793
1794
1795
1796
1797
1798
16/36
I
I
f.atoms (scratch root).line := ta.bs .
I
lEND PROC put ta.bs;
I
I
I
I
f.edit info.
I
IEND PROC edit info;
I
I
I
I
f.edit info := info
I
lEND PROC edit info;
I
I
I
I f . used. lines
I
IEND PROC lines;
I
I
I
I
f.scratch.lines.
I
IEND PROC removed lines;
I
I
I
I
I
segs(f.used,f.atoms) + segs(f.scratch,f.atoms)
segs(f.free,f.atoms) - 2 .
+
I
IENDPROC segments
I
I
col ...................... I INT PROC col (FILE CONST t)
I
I
I
t.col
tile handling
16/36
Zeile
••••
EUMEL
1.8
****
10.11.86
****
file handling
IENDPROC col
1799
1800
1801
1802
1803
1804
1805
1806
1807
E LAN
I
col ...................... IPROC col (FILE VAR 1', INT CONST new column)
I
I
I
IF new column ) 0
THEN 1'. col : = new column
I
I
FI
I ENDPROC col
I
1808
1809
1810
1811
1812
1813
1814
word ..................... ITEXT PROC word (FILE CONST f)
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
word •................•... ITEXT PROC liard (FILE CONST 1', TEXT CONST delimiter)
1825
1826
1827
1828
1829
1830
word ..................... ITEXT PROC word (FILE CONST 1', INT CONST max length)
1831
1832
1833
1834
1835
1836
1837
at ....................... IBOOL PROC at (FILE CONST 1', TEXT CONST word)
1838
1839
1840
1841
1842
1843
1844
+
1845
16/37
I
I
word (1', " ")
I
IENDPROC liard
I
I
I
I
I
I
I
I
INT VAR del pas := pas (1', delimiter, col (f»
IF del pas = 0
;
THEN del pas := len (f) + 1
FI;
subtext (1', col (f), del pas - 1)
IENDPROC liard
I
I
I
subtext (1', col (f), col (f) + max length - 1)
I
IENDPROC word
I
I
I
I
I
I
pat: = any (column-l)
pat CAT word ;
pat CAT any ;
record LIKE pat
I
I
column
record
Icolumn
I
Irecord
f.col.
f.atoms (f.used.index).line .
I
IENDPROC at
I
I
exec ................••.•. IPROC exec (PROC (TEXT VAR, TEXT CONST) proc, FILE VAR 1', TEXT OONST
I
t):
I
file handling
16/37
E LAN
Ze1le
record
10.11.86
file handling
proc (record, t) .
Irecord: f.atoms (f.used.1ndex).l1ne .
I
IEND PROC exec;
I
I
exec ..................... IPROC exec (PROC (TEXT VAR, INT CONST) proc, FILE VAR f, INT CONST 1)
I
I
1854
1855
1856
I
record
1857
1858
1859
1860
1865
1866
1867
1868
••••
I
I
1848
1849
1850
1851
1852
1861
1862
1863
1864
1.8
I
1846
1847
1853
EUMEL
proc (record, i) .
I
I
Irecord: f.atoms (f.used.1ndex).line .
I
IEND PROC exec;
I
pos
•••••••••••••••••••••• 1INT
I
I
PROC pos (FILE CONST f, TEXT CONST pattern, INT CONST il
pos (record, pattern, i) .
I
I
record
Irecord : f. a toms (f. used. index) . line .
I
lEND PROC pos
I
1869
1870
1871
1872
1873
1874
down ..................... IPROC down (FILE VAR f, TEXT CONST pattern)
1875
1876
1877
1878
1879
1880
1881
1882
1883
down
1884
1885
1886
1887
1888
1889
downety .................. IPROC downety (FILE VAR f, TEXT CONST pattern)
16/38
I
I
down (f, pattern, file size)
I
IENDPROC down
I
•••••.••••••.•.•.•••• 1PROC
down (FILE VAR f, TEXT CONST pattern, INT CONST max 11ne)
I
I
I
I
I
i
check mode (f,mod) ;
INT VAR pattern pos := f.co1 + 1 ;
search down (f.used, f. atoms , pattern, max line, pattern pos)
f.co1 := pattern pos
IENDPROC down
I
I
I
downety (f, pattern, file s1ze)
I
IENDPROC downety
I
file handling
16/38
E LAN
Zeile
EUMEL
1.8
.*..
10.11.86
file handling
1890
1891
1892
1893
1894
1895
1896
1897
1898
downety .................. IPROC downety (FILE VAR f, TEXT CONST pattern, INT CONST max 11ne)
1899
1900
1901
1902
1903
1904
up ....................... IPROC up (FILE VAR f, TEXT CONST pattern)
1905
1906
1907
1908
1909
1910
1911
1912
1913
up ....................... IFROC up (FILE VAR f, TEXT CONST pattern, INT CONST max line)
1914
1915
1916
1917
1918
1919
uppety
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
uppety ................... IPROC uppety (FILE VAR f, TEXT CONST pattern, INT CONST max line)
1930
1931
1932
1933
len ...................... 1 INT FROC len (FILE CONST f)
1
1
1
1
1
check mode (f, mod) ;
INT VAR pattern pos := f.col ;
search down (f. used, f. atoms , pattern, max line, pattern pos)
f. col :. pattern pos
1
1ENDPROC
downety
1
I
1
up (f, pattern, file size)
1
IENDFROC up
1
1
1
1
1
1
check mode (f,mod)
INT VAR pattern pos := f.col - 1 ;
search up (f.used, f.atoms, pattern, max line, pattern pos)
f.col := pattern pos
1
IENDFROC up
1
••••••••••••••••••• 1FROC
1
1
uppety (FILE VAR f, TEXT CONST pattern)
uppety (f, pattern, file size)
1
IENDPROC uppety
1
1
I
1
1
1
1
check mode (f,mod) ;
INT VAR pattern pos := f.col ;
search up (f.used, f. atoms , pattern, max line, pattern pos)
f.col := pattern pos
IENDPROC uppety
1
1
I
1
length (record) .
1
1
1934
1935
1936
1937
16/39
record
Irecord : f.atoms (f.used.1ndex).11ne .
1
1ENDPROC
len ;
1
file handling
16/39
E LAN
Zeile
1938
1939
1940
1941
EUMEL
1.8
••••
file handling
10.11.86
subtext ............ '.' .... 1TEXT PRCX:: subtext (FILE CONST f, INT CONST from, to)
1
1
subtext (record, from, to) .
1
1
1942
1943
1944
1945
1946
1947
1948
1949
1950
record
Irecord : f.atoms (f.used.index).line
1
1ENDPRCX::
subtext
1
change ................... IPRCX:: change (FILE VAR f, INT CONST from, to, TEXT CONST new)
1
1
1
check mode (r, mod) ;
change (record, from, to, new) .
1
I
1951
1952
1953
1954
1955
record.
Irecord : f.atoms (f. used. index) .11ne •
1
1ENDPRcx::
change
I
1
1956
1957
1958
1959
1960
1961
mark ..................... IBOOL PRcx:: mark (FILE CONST f)
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
mark
1973
1974
1975
1976
1977
1978
1979
1980
1981
marklineno ............... 1INT PRcx:: mark line no (FILE CONST f)
1982
1983
1984
1985
1986
1987
markcol .................• 1 INT PRCX:: mark col (FILE CONST f)
16/40
1
1
f.mark line) 0
1
IENDPRCX:: mark
1
. . . . . . . . . . . . . . . . . . . . . 1PRcx::
1
1
I
1
1
1
1
mark (FILE VAR f, INT CONST line no, col)
IF line no ) 0
THEN f. mark line
f.mark col
EUlE f. mark line
f.mark col
FI
1
1ENDPRcx::
::: line no
+
t. prefix lines
:= col
:= 0
:= 0
mark
1
I
1
1
I
1
IF f. mark line • 0
THEN 0
EUlE max (1, f . mark line - f. prefix 11nes)
FI
1
IENDPRCX:: mark Ii ne no
1
1
1
1
1
1
IF f.mark line = 0
THEN 0
ELIF f. mark line ( = f. prefix lines
THEN 1
file handling
16/40
ZeUe
E LAN
I
I
I
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
1.8 ****
EUMEL
10.11.86
file handling
ELSE f. mark col
FI
IENDPROC mark col
I
setmarkedrange ........... IPROC set marked range (FILE VAR f, mANGE VAR old rang&)
previousrangeoffile
I
I IF mark (f)
I
THEN set range (f, mark line no (f), mark col (f), old
I
ELSE old range . - previous range of file
I FI.
I
I
Iprevious range of file :
I FRANGE: (f. prefix lines, r. postfix lines, FALSE, FALSE)
range)
.
I
IENDPROC set marked range ;
I
I
2006
1(**••************. . . . . . . . . . . .***************...................... )
2007
2008
I
I
I
I
I
+
2009
+
2010
2011
2012
2013
2014
2015
(* Autor:
P. Heyderhoff *)
(* Stand: 11.10.83
*)
I
IBOUND LIST VAR datei;
VAR sortierstelle, sortanker;
IBOOL VAR ascii sort;
ITEXT VAR median, tausch, links, reehts;
lINT
I
2016
2017
2018
2019
sort ..................... IPROC sort (TEXT CONST dateiJllLllHl)
I
sort (dateiname, 1)
IEND PROC sort;
2020
2021
2022
2023
2024
sort ..................... IPROC sort (TEXT CONST dateina.me, INT CONST sortieranfang)
I
ase ii sort : = TRUE ;
I
sortierstelle :. sort1eranfang; sortiere (dateiname)
lEND PROC sort;
2025
2026
2027
2028
lexsort .................. IPROC lex sort (TEXT CONST dateiJllLllHl)
I
lex sort (date1name, 1)
IENDPROC lex sort ;
2029
2030
2031
2032
2033
lexsort ..............•..• IPROC lex sort (TEXT CONST dateinam&, INT CONST sorti&ra.nfang)
I
ascii sort : = FALSE ;
I
sortierstelle :. sortieranfang; sortiere (dateiname)
IENDPROC lex sort ;
16/41
I
I
I
I
file handling
16/41
Ze1le
20M
2035
20:36
2037
20M
E LAN
EUME!.
1. 8
****
10.11. 86
rile handling
sortiere ................. IPROC sortiere (TEXT CONST dateiname)
I
I
2039
2040
2041
2042
2043
2044
reorganizefileifnecess
2045
2046
2047
2048
2049
2050
2051
2052
2053
sortfile
reorganize file if necessary ;
I sort file .
I
I
Ireorganize file
I
if necessary :
FILE VAH f := sequential file (modify, date1name)
IF segments (f) ) 1
THEN reorganize (dateiname)
FI.
I
I
I
I
I
Isort file :
I f:= sequential
I
I
I
I
file (modify, dateiname)
INT CONST sortende : = lines (f) + 3 ;
sortanker: = 1 + 3 ;
datei:= old (d&teiname) ;
quicksort( sort.&nker, sortende)
I
lEND PROC sort1ere;
I
2054
2055
2056
2057
2058
2059
2060
2061
quicksort ................ IPROC quicksort ( INT CONST anfang, ende )
I
IF
anfang ( ende
I
THEN INT VAH p,q;
I
spalte
(anfang, ende, p, q);
I
quicksort (anfang, q);
I
quicksort (p, ende)
FI
IEND PROC quicksort;
2062
2063
2064
2065
2066
spalte ................... PROC spalte (INT CONST anfang, ende, INT VAH p, q):
fange an der seite an und waehle den median;
ruecke p und q so dicht wie moeglich zus8.llllllen;
hole ggf median in die m1tte .
2067
I
fangeandersei teanundwa
fange an der sei te an und waehle den median
p : = &nfang; q : = ende ;
INT CONST m :: (p + q) DIV 2 ;
median := subtext(datei m, sortlerstelle)
2072
2073
2074
2075
2076
rueckepundqsod1chtw1em
ruecke p und q so dicht wle moegl1ch zusa.mmen :
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 •
2077
2078
2079
vert.&uschediebelden
vert.&usche die beiden :
tausch : = datei p; datel p : = datel q; datel q . = t.&usch;
p INCR 1; q DEeR 1 .
schlebepundqsoweitwlem
schiebe p und q so weit wie moegllch auf bzw ab :
WHILE p kann groesser werden REP p INCR 1 END REP;
WHILE q k&nn kleiner werden REP q DECR 1 END REP .
2068
2069
2070
2071
2080
2081
2082
2083
2084
16/42
file handling
16/42
Zeile
2065
2086
E LAN
EUMEL
1.8
****
10.11.86
file handling
pkanngroesserwerden
p kann groesser werden :
IF p <= ende
THEN links: = subtext (datei p, sortierstelle)
IF ascii sort
THEN median ) = li nks
ELSE median LEXGREATEREQUAL links
Fl
ELSE FALSE
FI .
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
qunnkleinerwerden
q kann kleiner werden :
IF q ) = anfang
THEN rechts := subtext(datei q, sortierstelle)
IF ascii sort
THEN rechts ) = median
ELSE rechts LEXGREATEREQUAL median
FI
ELSE FALSE
Fl.
2105
2106
2107
2108
holeggfmedianindiemi tt
hole ggf median in die mi tte
IF
m < q THEN verta.usche m und q
ELIF m ) p THEN verta.usche m und p FI
2109
2110
verta.uschemundq
verta.usche m und q :
tausch := datei m; datei m .- datei q; datei q := ta.usch; q
2087
2088
2089
2090
2091
2092
2093
2094
DECR 1 •
+
2111
2112
2113
verta.uschemundp
+
verta.usche m und p :
tausch : = datei m' datei m . = datei p; datei p
INCR 1 .
.=
ta.usch; P
2114
2115
dateim
2116
dateip
2117
2118
2119
2120
2121
dateiq
16/43
datei m
I datei
I
I datei
I
lEND PROC
I
datai.atoms (m).line
p
datei.atoms (p).line
q
datei.atoms (q).line
spalte;
lEND PACKET file handling;
file handling
16/43
Zeile
1
2
E LAN
EUMEL
I
I
I
I
4
5
6
(-Autor: J.Lied
*)
(-Stand: 08.11.85
*)
do,
no do again
I
I
I
7
8
9
10
ILET
I
I
I
I
I
I
11
12
13
14
15
I
I
16
17
18
19
20
no ins = FALSE ,
no 1st = FALSE ,
no check = FALSE ,
no sermon = FALSE ,
compile line mode = 2 ,
do again mode = 4 ,
max command length = 2000
lINT VAR do again mod nr : = 0
ITEXT VAR previous command . - ""
I
IDATASPACE VAR ds
I
I
21
22
do ....................... IPROC do (TEXT CONST command)
I
I
I
I
I
I
I
I
I
I
I
26
27
28
29
30
31
32
33
doagain
35
36
37
38
39
40
41
42
43
elan do interface
10.11.86
I
3
34
****.
elandointerface ********** IPACKET elan do interface DEFINES
+
23
24
25
1.8
compileandexecute
enable stop ;
IF LENGTH command > max command length
THEN errors top ("Kommando zu lang")
ELIF do again mod nr (> 0 AND command = previous comma.nd
THEN do again
ELSE previous command .' cOlllll8.nd ;
compile and execute
FI.
Ido again :
I elan (do again mode, ds, "", do again mod nr,
I
no ins, no 1st, no check, no sermon) .
I
I
Icompile and execute :
I elan (compile line mode,
I
no ins, no 1st, no
I
ds, command, do again mod nr,
check, no sermon) .
IENDPROC do
I
44
45
46
47
48
49
nodoagain ................ IPROC no do again :
50
51
52
elan ..................... IPROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line,
I
INT VAR start module number,
I
BOOL CONST ins, 1st, rt check, ser) :
17/1
I
I do again
I
IENDPROC no
I
mod nr := 0
do agai n ;
elan do interface
17/1
Zelle
53
54
55
56
17/2
E LAN
EUMEL 1.8 ****
10.11.86
I EXTERNAL 256
IENDPROC elan ;
I
IENDPACKET elan
elan do interface
do interface
elan do interface
17/2
E LAN
Zeile
EUMEL 1.8 ....
1
1(. -------------------
2
3
4
scanner ••**** ............. 1PACKET scanner DEFINES
I
I
I
I
I
5
6
7
I
I
I
I
I
I
I
I
I
1
2
3
4
bo~
number
text
operator= 5 ,
delimi ter = 6 ,
end of file
7
\Ii thin cOlllllent = 8 ,
\lithin text
= 9
ILET digit 0
48
57
I
digit 9
I
upper case a
I
upper case z
I
lO\ler case a
I
lO\ler case z
I
I
ITEXT VAR line : =
I
char: =
I
chars: =
I
30
31
32
33
34
35
38
14.05.86 ------------------- .)
(. Autor: J . Liedtke
•j
scan,
conti nue scan ,
next symbol :
ILET t~
9
H
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
39
40
41
42
43
VERSION 4
I
8
36
37
scanner
10.11.86
65
90
97
122;
position : = 0
comment depth
IBOOL VAR continue text ;
lINT VAR
I
I
I
scan
•.........•.....•••.. IPROC scan (TEXT
I
I comment depth
I continue text
I continue scan
I
CONST scan text)
:= 0 ;
: = FALSE
(scan text)
IENDPROC scan ;
I
44
45
46
47
48
49
50
51
continuescan ............. IPROC continue scan (TEXT CONST scan text)
52
53
54
55
nextsymbol ............... IPROC next symbol (TEXT VAR symbol)
56
18/1
I
I
I
line: = scan text
position . - 0 .
I nextchar
I
IENDPROC continue
I
scan
I
I
I
I
INT VAR type ;
next symbol (symbol, type)
scanner
18/1
Zeile
E LAN
57
58
59
60
61
62
63
64
65
66
67
1.8 ****
EUMEL
10.11.86
'ENDPROC next symbol
,
nextsymbol ......•.....•.. ,PROC next symbol (TEXT VAR symbol, INT VAR type)
,
,
,
,
,
,
,
,
,
,
,
,
,
68
69
70
71
72
73
74
skip blanks ;
IF
is begin comment
ELlF comment depth ) 0
,
,
,
75
76
77
78
79
BEl
81
82
processcomment
83
84
85
86
87
88
89
90
91
92
93
94
95
process tag
ELIF
ELIF
ELIF
ELIF
ELIF
ELIF
ELSE
FI.
THEN process comment
THEN cOllBl1ent depth DECR 1
process comment
is quote OR continue text THEN process text
is lower case letter
THEN process tag
is upper case letter
THEN process bold
is digi t
THEN process number
is delimiter
THEN process delimiter
is nil text
THEN eof
process operator
'process comment :
, read comment ;
, IF comment depth ~ 0
,
THEN next symbol (symbol, type)
,
ELSE type : = within comment
' s y m b o l : = ""
, FI.
,
,
'process tag :
type : = tag
assemble chars (lower case a, lower case z)
symbol : = chars
REP
skip blanks ;
IF is lower case letter
THEN assemble chars (lower case a, lower case z)
ELIF is digit
THEN assemble chars (digi t 0, digit 9)
ELSE
LEAVE process tag
FI ;
symbol CAT chars
96
PER ;
97
98
nextchar .
99
processbold
101
102
103
108
109
110
111
112
18/2
process bold :
type: = bold
assemble chars (upper case a, upper case z)
symbol : = chars .
,,
,
,
,
100
104
105
106
107
scanner
processnumber
'process number :
, type: = number
, assemble chars (digit 0, digit 9) ;
, symbol:= chars ;
, IF char = "." AND ahead char is digi t
THEN process fraction ;
IF char = "e"
THEN process exponent
,
,
,
,
FI
scanner
18/2
Zelle
E LAN
EUMEL 1.8 ••••
113
114
115
116
aheadcharisdigi t
117
118
process fraction
119
120
121
122
123
124
125
126
processexponent
127
128
129
130
131
132
133
134
process text
I
I
I
Iprocess fraction:
I symbol CAT char ;
I nextchar;
I assemble chars (digit 0, digit 9)
I symbol CAT chars .
I
I
Iprocess exponent
I symbol CAT char ;
I nextchar;
I IF char = "+" OR char = I
THEN symbol CAT char
nextchar
I
I FI ;
I assemble chars (digit 0, digit 9)
I symbol CAT chars .
I
I
Irrocess
139
140
141
142
143
144
145
146
147
148
149
155
156
157
158
159
160
161
162
163
164
165
166
18/3
endoftextorexception
text :
type := text
symbol :,. ""
IF continue text
THEN continue text :. FALSE
ELSE next char
FI ;
WHILE not end of text REP
assemble chars (35, 254)
symbol CAT chars ;
IF NOT is quote
THEN symbol CAT char
nextchar
FI
ENJlREP
Inot
I
I
152
153
154
FI.
I
I
137
138
notendoftext
scanner
Iahead char is digit
I digit 0 <= code (ahead char) AND code (ahead char) <= digi t 9 .
135
136
150
151
10.11.86
end of text :
IF is niltext
THEN conti nue text : = TRUE ; type .' wi thin text
ELIF is quote
THEN end of text or exception
ELSE TRUE
FI.
FALSE
I
I
I
I
I
I
Iend of
I next
I
I
I
I
I
I
I
text or exception
char ;
IF is quote
THEN get quote
ELIF is digit
THEN get spacial char
ELSE
FALSE
Fl.
scanner
TRUE
TRUE
18/3
E LAN
Zeile
167
getquote
168
169
170
171
getspecialchar
173
174
processdelimiter
177
178
179
180
processoperator
186
187
188
189
190
191
192
193
I
Iget special char:
I assemble chars (digit 0, digit 9)
I symbol CAT code (int (chars) ) ;
I nextchar.
Iprocess delimiter :
I type:. delimiter
I symbol:. char
I nextchar.
I
I
Iprocess
I
I
I
I
I
194
195
196
197
198
~r
200
201
202
203
sCanner
Iget quote :
I symbol CAT char
I nextchar.
I
I
I
I
I
I
I
I
182
183
184
185
~9
***.
I
I
175
181
10.11.86
I
172
176
EUMEL 1.8 ****
islowercaseletter
204
205
I
I
I
I
I
opera tor :
type:. opera tor
symbol:. char;
next char ;
IF symbol. "."
THEN IF char· "." OR char = "."
THEN symbol :. ":."
nextchar
ELSE type :. de limi ter
FI
ELIF is relational double char
THEN symbol CAT char ;
nextchar
ELIF symbol • "." AND char = "."
THEN symbol :. "**"
next char
FI.
I~f
I
I
I
I
type. - end of rile
symbol:.""
11s lower case letter
lower case a <. code (char) AND code (char)
I
I
I
I is
I
I
I
206
207
208
isuppercaseletter
209
210
211
isdigit
212
213
isdelimi ter
214
isrelationaldoublechar lis relational double char:
I TEXT VAR double :. symbol + char ;
I double = "<)" OR double. "<." OR double
215
216
217
18/4
<=
lower case z .
upper Case letter
upper case a <= code (char) AND code (char) <- upper case z .
lis digit
dig1t 0,= code (char) AND code (char) <- digit 9 .
I
I
I
I is
delimiter
pcs ( "()[ J. ,;" , char ) ) 0 .
I
I
")."
I
scanner
18/4
Zeile
E LAN
218
219
isquote
220
221
isniltext
222
223
224
225
isbegincomment
226
227
228
229
230
231
EUMEL 1.8 ****
char •
''''''''
I
I
11s nlltext
char
I
I
lis begin comment : char
ft{ft OR char
ft{ ft AND &head char
nextchar ................. I PROC next char :
I
I
I
position INCR 1
char: = line SUB position
I
I ENDPROC next char ;
I
skipblanks ............... I PROC skip blanks :
I
I position:= pos
I IF posi tion = 0
I
THEN pos1 tion
I FI;
~5
236
237
238
239
240
241
M2
I
(line, ""3:3 ftft , ftft2M"" , position)
: = LENGTH line + 1
char: = line SUB position
I
I ENDPROC sk1p blanks ;
I
M3
244
245
246
247
M8
aheadchar ................ I TEXT PROC ahead char :
249
250
251
252
253
254
255
assemblechars ............ IPROC assemble chars (INT CONST low, high)
256
257
258
259
260
261
262
263
264
265
266
267
268
18/5
ft." .
I
IENDPROC next symbol ;
I
~2
233
234
liS quote
scanner
10.11.86
I
I
line SUB posi tion+l
I
IENDPROC ahead char
I
I
I
positionbehindvalidtex
INT CONST begin :. position;
I position behind valid text;
I chars:= subtext (line, begin,
I char: = line SUB position .
I
I
lposition behind valid text:
I position:= pos (line, ftft32ftft,
I IF position = 0
I
THEN position : = LENGTH line
I FI;
position-i)
code (low-i), begin)
+
1
I
INT CONST higher pos : = pos (line, code (high+1), ftft254 ftft , begin)
I
IF higher pos (> 0 AND higher pos ( position
THEN position . - higher pos
I
I
Fl.
I
IENDPROC assemble chars
I
I
scanner
18/0
Zeile
269
270
271
E LAN
EUMEL
1.8
TEXT VAR l&st ch&r
comment depth INCR 1
REP
l&s t ch&r : = ch&r ;
nextchar ;
IF is begin comment
THEN read comment
FI ;
IF char = ftft
THEN LEAVE read comment
FI
UNTIL is end comment PER
comment depth DEeR 1
next char ;
skip bl&nks .
273
274
275
276
277
278
279
280
281
282
28:3
284
285
286
isendcomment
288
'is end comment :
, ch&r = ftlft OR ch&r
,
=
ft)ft,
AND l&st ch&r •
ft(ft
AND &head char.
ft.ft
•
,
289
290
291
292
29:3
294
295
scanner
10.11.86
readcomment. . . . . . . . . . . . .. PROC read comment :
272
287
.....
isbegincomment
'is begin comment
, ch&r. ft{ft OR ch&r •
,
,'ENDPROC read comment
,
ft.ft
•
296
297
298
299
:300
:301
:302
sc&n ..................... 'PROC sc&n (FILE VAH f)
:303
:304
:305
:306
:307
:308
:309
310
311
nextsymbol ............... 'FROG next symbol (FILE VAH f, TEXT VAH symbol)
312
313
314
315
316
317
318
319
320
321
322
nextsymbol ............... 'PROG next symbol (FILE VAH f, TEXT VAH symbol, IN! VAH type)
18/6
,
,
,
,
getline (f, line) ;
sc&n (line)
,'ENDPROC
sc&n
,
,
,
,
IN! VAH type ;
next symbol (f, symbol, type)
,'ENDPROC next symbol
,'TEXT VAH sc&nned
,
,
,
,
,
,
i
,,
next symbol (symbol, type) ;
WHILE type ) = 7 AND NOT eof (f) REP
getline (f, line) ;
continue sc&n (line) ;
next symbol (sc&nned, type)
symbol CAT sc&nned
PER.
'ENDPROC next symbol
sc&nner
18/6
Zeile
323
324
18/7
E LAN
EUMEL 1.8 ****
10.11.86
scanner
I
IENDPACKET
scanner
scanner
18/7
Zeile
1
2
3
4
E LAN
1. 8
EUMEl
****
screen description
10.11.86
screendescription ********IPACKET screen description DEFUIES
I
i
I
I
5
6
7
8
xsize, ysize, markslze, mark refresh line mode
lINT VAR xs := 80, ys
.=
24, ms :. 1;
I
9
10
xslze .................... lINT PROC xsize: xs END PROC xslze;
11
12
ysize .................... lINT PROC ysize: ys END PROC ysize;
13
14
ma.rksize ................. IINT PROC marksize: ms END PROC marksize;
15
16
xslze •••.•..••.....••••.• IPROC xsize (INT CONST 1): xs := i END PROC xslze;
I
17
18
yslze
19
marks1ze ................. IpROC markslze (INT CONST i): ms : = i END PROC marksize;
20
21
22
23
I
I
I
..•.••••••.•........ IPROC yslze (INT CONST 1): ys : = 1 END PROC ys1ze;
I
I
I
IBOOt VAR line mode. - FALSE;
I
24
25
26
27
ma.rkrefreshlinemode ...... IBOOt PROC mark refresh line mode:
I li ne mode
IEND PROC mark refresh line mode;
28
29
markrefreshllnemode ...... IpROC mark refresh line mode (BOOt CONST b):
I line mode := b
lEND PROC mark refresh line mode;
~
31
32
19/1
I
I
IEND
PACKET screen descr1ption ;
screen descr1pt1on
19/1
Ze11e
1
2
+
:3
4
5
6
7
8
9
10
11
12
13
14
E LAN
EUMEL
1.8
••••
10.11.86
I
tastenverwaltung ......... IPACKET tasten verwaltung
I
..ee9·)
I
I
I
tasten verwaltung
DEFINES
(............... )
lernsequenz auf taste legen,
lernsequenz auf taste,
kommando auf taste legen,
kommando auf taste,
taste enthaelt kommando,
std tastenbelegung :
I
I
I
I
I
I
I
I
ILET kommandoidentlfikat1on
""0"",
esc = ""27"'" ,
niltext •
hop r1ght left up down cr tab rubin rubout mark esc
""1""2""8""3""10""13""9""11""12""16""27""
2(;)
I
I
I
I
I
I
21
22
lINT VAR i; FOR i FROM 1 UPl'O 256 REP belegung (i) . - "" PER;
23
I
24
25
26
I
I
15
16
17
18
19
27
28
29
3e
31
32
33
34
35
36
37
38
39
4(;)
41
42
43
44
45
46
47
48
49
50
51
52
20/1
IROW 256 TEXT VAR belegung;
I std tastenbelegung;
lernsequenzauftasteleg ... IPRo::: lernsequenz auf taste legen (TEXT CONST taste, lernsequenz)
I
I
belege (belegung (code (taste) + 1), taste, lernsequ"nz)
I
IENDPROC lernsequenz auf taste legen ;
I
belege ................... IPROC belege (TEXT VAR tastenpuffer, TEXT CONST taste, lernsequenz)
I tastenpuffer: = lernsequenz ;
I verhindere rekursi ves lernen .
I
I
verhindererekursi vesle Iverhindere rekursi ves lernen :
I loesche alle folgen esc taste aber n1cht esc eSC taste
I IF taste 1st rreies sonderzeichen
I
THEN change all (tastenpuffer, taste, n11text)
I
I
I
FI.
loescheallefolgenescta Iloesche alle folgen esc taste aber n1cht esc esc taste
I INT VAR 1 : = pos (tastenpuffer, "sc + taste) ;
I WHILE i ) (;) REP
I
IF 1st eSC eSC taste
I
THEN i INCR 1
I
ELSE change (tastenpuffer, 1, 1+1, n11text)
I
FI;
I i : = pos (tastenpuffer, esc + taste, i)
I PER.
I
tasten verwaltung
20/1
ZeUe
E LAN
EUMEL
53
54
55
1stescesctaste
56
57
58
tasteistfreiessonderze
59
60
61
62
63
64
65
66
67
68
69
70
1. 8
****
tasten verwaltung
10. 11. 86
Iist esc esc taste :
I (tastenpuffer SUB i-l) = esc
I
I
Itaste ist freies sonderzeichen
I taste ( ""32"" AND
I
I
I
AND (tastenpuffer SUB i-2) () esc.
:
pos (hop right left up down cr tab rubin rubout mark esc, taste)
0 .
I END PROC be lege
I
I
lernsequenzauftaste ...... ITEXT PROC lernsequenz auf taste (TEXT CONST taste)
I IF taste enthaelt kommando (taste)
I THEN""
I ELSE belegung
I FI
(code (taste) + 1)
I END PROC lernsequenz auf taste;
I
I
71
72
73
74
75
76
77
78
kommandoauftastelegen .... IPROC kommando auf taste legen (TEXT CONST taste, kommando)
79
80
81
82
kommandoauftaste ......... ITEXT PROC kommando auf taste (TEXT CONST taste)
I IF taste enthaelt kommando (taste)
I TIlEN subtext (belegung (code (taste) + 1), 2)
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
2JiJ/2
I
I
I
I
belegung (code (taste) + 1) := komm&ndoidentlfikation;
belegung (code (taste) + 1) CAT kommando
I END PROC kommando auf taste legen;
I
I
I ELSE
I FI
IEND PROC
I
I
kommando auf taste;
tasteenthael tkommando .... 1800L PROC taste enthael t kommando (TEXT CONST taste) :
I (belegung (code (taste) + 1) SUB 1) = kommandoidentiflkat1on
lEND PROC taste enthaelt kommando;
I
I
stdtastenbelegung •••••••• I PROC std tastenbelegung:
I lernsequenz auf taste legen
I lernsequenz auf taste legen
I lernsequenz auf taste legen
I lernsequenz auf taste legen
I lernsequenz auf taste legen
I lernsequenz auf taste legen
I lernsequenz auf taste legen
I lernsequenz auf taste legen
I lernsequenz auf taste legen
I lernsequenz auf taste legen
tasten verwaltung
("(", ''''91'''') ;
(")" , ''''93'''');
("(" , ""123"") ;
( " ) " , ftftl25'''') ;
(ftA", ""214'''') ;
("0", ""215"") ;
("U", ''''216"''} ;
("&" ,
""217"");
("0" , ""218"") ;
("u" , ""219"");
2JiJ/2
Zelle
103
104
105
106
107
108
109
110
111
112
2fi>/3
E LAN
EUMEL
1.8
****
10.11.86
I
I
I
I
I
I
lernsequenz auf taste legen
lernsequenz auf taste legen
lernsequenz auf taste legen
lernsequenz auf taste legen
lernsequenz auf taste legen
lernsequenz auf taste legen
lEND PROC std tastenbelegung;
tasten verwaltung
("k". ''''220'''');
("-", ""221"");
(".", ""222"");
(" ", ""223"");
("B", ''''251'''') ;
("s" , ""251"");
I
I
lEND PACKET tasten verwaltung;
tasten verwaltung
2fi>/'J
Zeile
1
2
+
3
4
E LAN
EUMEL 1.8 ****
,,
,,,
,,
6
+
49
50
51
52
53
:i4
55
21/1
(. EDITOR
edi torpaket .............. 'PACKET editor p&ket DEFINES
5
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
ed1 tor p&ket
10.11.86
,,
,
,
,,,
,
,LET
,
,
,
,,,
,
,
I
,,
,LET
,
,
,
,LET
,
,
,
,
123 .)
( ********** )
-bk- .)
(. 19.07.8:5
(.
-W9-
10.09.8:5
.)
(. 25.94.86
-sh- .)
edit, editget,
-wk- *)
quit, quit l&st,
-jl- *)
push, type,
word wrap, ma.rgin,
write permission,
set busy indic&tor,
two bytes,
is k&nJi esc,
within k&nJi,
rubin mode,
is editget,
editget comm&nd,
getch&r,
getch&rety,
is inch&rety,
get Window,
get edi tcursor,
get editline,
put editl1ne,
&ktueller editor,
groesster editor,
open edi tor,
edittlle,
hop
up ch&r
cle&r eol
piep
down ch&r
rubout
m&rk key
inscr
b&ckcr
d&ch
(.
10.86.86
(.
04.86.86
nichts neu,
s&tznr neu,
ueberschritt neu,
zelle neu,
&bschni tt neu,
bild&bschni tt neu,
b1ld neu,
&lles neu,
5&tznr ze igen,
ueberschritt zeigen,
blld zeigen:
= ""1"",
= "''''3'''',
""'18"",
""20"",
right
cle&r eop
cursor pos
lett
rubin
cr
&bscr
dezim&l
esc
""94"",
bl&nk
""5"",
""7"",
"'''10"'',
=- ""'12"",
""'16"",
no output
• 0,
out teldrest
• 2,
cle&r teldrest • 4;
""2"" ,
""4"" ,
""6"",
""8"" ,
""11"'" ,
.. ""13"",
"" ""17"",
""19"" ,
=- ""27"",
. ".,
out zeichen
out teld
• 1,
• 3,
FELDSTATUS • STRUCT (INT
stelle, <e stelle, r&nd, limit,
&nta.ng, m&rke, !&enge, verschoben,
BOOL eintuegen, tliesstext, write
access,
TEXT t&bul&tor) ;
,'FELDSTATUS VAH teldst&tus;
'TEXT VAH begin m&rk :=
,
end m&rk
:.
,
~~15~",
~~14ww;
'TEXT VAH sep&r&tor .' "", kollllll&lldo .• "" , &udit
editor p&ket
.K
zeichen .-
21/1
n
.
Zeile
E LAN
69
70
1.8
••••
I
I
56
57
58
59
68
61
62
63
64
65
66
67
68
EUMEL
lINT
10.11.86
satzrest .-
edi tor paket
merksa tz :.. '''', alter edi tsa tz : =
'''';
VAR kOllDll&ndo zeiger : = 1, umbruchstelle, umbruch verschoben,
I
I
I
zeile, spalte, output mode := no output, pestblanks := 8,
min schreibpes, ma.x schrelbpes, cpes, absatz ausgleich;
IBOO1 VAR lernmodus := FALSE, separator eingestellt := FALSE,
invertierte darstellung :. FALSE, absatzmarke steht,
cursor dlff : = FALSE, edi tget modus : = FALSE,
two byte mode : = FALSE, std fllesstext : = TRUE,
edi tget kommando darf ausge1'iihrt werden : = TRUE;.
I
I
I
I
I
schirmbrel te
schlrmhoehe
ma.xbreite
I
Ischirmbrelte
I
Ischirmhoehe
I
Imaxbrei te
X
size - 1
y size
schirmbreite - 2 .
I
71
72
73
74
75
76
77
78
79
88
81
82
83
84
85
86
87
88
89
98
91
92
93
94
95
96
97
98
99
108
101
102
183
184
105
186
187
21/2
ma.xla.enge
mark length
Imaxla.enge
schirmhoehe - 1 .
I
lmarklength
mark size .,
I
I ini tialisiere editor;
I
l.initia11s1ere editor
I anfang:. 1; zeile := 0; verschoben := 0; tabulator := ftft;
I e1nfuegen: = FALSE; fliesstext : = TRUE; zellene1nfuegen . - FALSE;
I marke:= 0; bildmarke := 8; feldm&rke := 0.;
I
ed1 tgetcolIDII&nd ........... IPROC edi tget cOlIDII&nd (BOO1 CONST schalter) :
I edi tget kOllDll&ndo darf ausgeflihrt werden : = schalter
IENDPROC edi tget cOlIIIII&nd ;
I
1(*.************************."***
I
I
editget
................................ )
edltget .................. PROC ed1tget (TEXT VAR editsatz, INT CONST editlim1t, editlaenge,
TEXT CONST sep, res, TEXT VAR exit char) :
IF ed1 tla.enge ( 1 THEN errorstop (ftFenster zu kle1nft) FI;
separator : = ftft13 ftft ; separator CAT sep;
separator eingestellt := TRUE;
TEXT VAR reservierte editget tasten :. ftftllftft12ftft
reservierte ed1tget tasten CAT res;
disable stop;
absatz ausgleich := 8; exit char :. ftft; get cursor;
FELDSTATUS CONST alter feldstatus := feldstatus;
feldstatus := FELDSTATUS : (1, 1, spalte - 1, ed1tlimit,
1, 8, editla.enge, 8,
FALSE, FALSE, TRUE, ftft);
konstanten neu berechnen;
output mode :. out feld;
feld ed1 tieren;
zeile verlassen;
!eldstatus :. alter feldstatus;
konstanten neu berechnen;
separator . _ ft";
separator eingestellt := FALSE
editor pake t
21/2
Zelle
E LAN
EUMEL
edi tor pakat
10.11.86
I
I
108
199
119
111
112
1.8 ****
feldedi tieren
I feld edi tieren
I
I
113
114
115
116
117
118
119
129
121
122
123
124
125
126
127
128
129
139
REP
feldeditor (editsatz, reservierte edltget testen);
IF
is error
THEN kommando zeiger : = 1; kommando :. MM; LEAVE feld edl tieren
FI ;
TEXT VAR t, zeichen; getchar (zeichen);
IF
zeichen ist sepa.rator
THEN exit char:. zeichen; LEAVE feld editleren
ELIF zeichen = hop
THEN feldout (edi tsa tz, stelle); getchar (zeichen)
ELIF zeichen = mark key
THEN output mode : = out feld
ELIF zeichen = abscr
THEN exit char : = cr; LEAVE feld editieren
ELIF zeichen = esc
THEN getchar (zeichen); auf exit pruefen;
IF
zeichen = rubout
(*sh*)
THEN IF
marke) 9
THEN merksatz := subtext (editsatz, marke, stelle - 1)1
change (edi tsatz, marke, stelle - 1, MM);
stelle : = marke; marke :. 9; konstenten naU
berechnen
FI
ELIF zeichen
rubin
THEN t := subtext (editsatz, 1, stelle - 1);
131
132
133
134
135
136
137
138
139
t CAT merksa tz;
satzrest := subtext (edltsatz, stelle);
t CAT satzrest;
stelle INCR LENGTH merksatz;
merksatz := MM; editsatz := t
ELIF editget kOlllll&ndo darf ausgefUhrt werden
149
CAND
141
142
143
144
145
146
147
148
149
zelchen ist kein esc kommando
COO
kommando auf teste (zeichen) ()
THEN editget kommando ausfuehren
159
+
151
FI ;
I
zeichenistke1nesckolllll& Izeichen ist kain esc kommando :
I
(*wk*)
I pos (hop + left + right, zeichen) • 9 .
152
153
154
155
156
157
158
zeileverlassen
159
169
zeichenistsepa.rator
21/3
output mode :. out feld
I
FI
I PER.
I
I
I
I
Izeile
I
I
I
I
I
I
verlassen :
IF
marke) (;) OR verschoben () 9
THEN stelle DECR verschoben; verschoben
.= a; feldout (editsatz, 8):
ELSE cursor (rand + 1 + min (LENGTH editsatz, edi tl.aenge) , zelle)
Fl.
Izeichen ist sepa.rator
pos (separator, zeichan) )
a.
I
edi tor paket
21/3
ZeUe
E LAN
EUMEL 1.8 ****
18.11.86
ed1 tor pLket
161
162
163
164
165
aufexitpruefen
166
167
editgetkommandoausfueh led1tget kommando ausfuehren
I edi tget zust&ende sichern
I do (kommando auf taste (zeichen»
I alte ed1 tget zustaende w1eder herstellen
I IF stelle < marke THEN stelle :. marke FI;
I konstanten neu berechnen .
168
169
17@
171
lauf exit pruefen :
I IF
pos (res, zeichen) ) @
I THEN exit char : = esc + zeichen; LEAVE feld edit1eren
I FI.
I
I
I
I
led1tget zustaende
I
(*wk*)
172
173
editgetzust&endesicher
+
174
175
176
177
178
179
188
181
182
163
184
185
186
187
188
189
190
191
192
+
193
194
195
196
+
197
198
+
199
200
201
+
202
I
I
I
I
I
I
I
I
I
I
sichern :
800L VAR alter edi tget modus : = ed1 tget modus;
FELllSTATUS VAR feldstatus vor do kommando := feldstatus
INT VAH zelle vor do kommando : = zelle ;
TEXT VAR separator vor do kOlll1l&ndo :. separator ;
800L VAR separator eingestellt vor do kommando :. separator
eingestellt ;
editget modus := TRUE ;
alter edi tsa tz : = edi tsa tz
al teedi tgetzust&endewi Ialte edi tget zustaende wieder herstellen
I editget modus := alter editget modus;
I editsatz : = alter edi tsatz;
I feldstatus: = feldstatus vor do kommando
I ze 11e : = ze 11e vor do kommando ;
I separator: = separator vor do kommando ;
I separator eingestallt : = separator e1ngestellt vor do kOlll1l&ndo .
I
lEND PROC ed1tget;
I
ed1tget .................. IPROC ed1tget (TEXT VAR editsatz, INT CONST edltl1mit, TEXT VAH ex1t
I
char):
I editget (editsatz, editlimit, x s1ze - x cursor,
ex1t chi
(* 85.07.84
lEND PROC editget;
I
I
-bk- *)
ed1tget .................. IPROC ed1tget (TEXT VAR editsatz, TEXT CONST sep, res, TEXT VAH exit
I
char):
I editget (editsatz, max text length, x size - x cursor, sep, res,
I
ex1t char)
IEND PROC edi tget;
(* E>li.E>7.84
I
-bk- *)
I
ed1tget .................. lpROC editget (TEXT VAR editsatz)
I TEXT VAR exit char;
I
-bk- *)
283
I ed1 tget (ed1 tsa tz, max text length, x size - x cursor,
I
exit char)
lEND PROC ed1tget;
2til4
I
21/4
edi tor pLket
"" ,
21/4
Ze1le
205
206
207
208
209
210
.....
E LAN
EUMEL 1.8 ••••
editor paket
ed1tget .................. IPROC editget (TEXT VAR editsatz, INT CONST editl1mit, editlaenge)
I TEXT VAR exit char;
I ed1 tget (ed1 tsa tz, edi tlimi t, ed1 tlaenge, n , "", exi t char)
IENDPROC editget;
I
1(****.**********.******.... ******
I
I
211
212
feldedi tor
**********•••***************. . )
ITEXT VAR reservierte feldedi tor tasten
I
I
+
213
214
215
216
217
218
219
220
221
222
223
10.11.86
(*jl*)
feldeditor ............... IPROC feldeditor (TEXT VAR satz, TEXT CONST res) :
I enable stop;
I reservierte feldeditor tasten := ""1""2""8"" ;
I reservierte feldedi tor tasten CAT res;
I absatzmarke steht : = (satz SUB LENGTH satz) = blank;
I alte stelle merken;
I cursor diff best1mmen und ggf ausgleichen;
I feld edi tieren;
I absa tzrnarke upda ten .
I
I
224
225
altestellemerken
lalte stelle merken
alte stelle .• stelle.
226
227
228
229
230
231
232
233
cursordiffbestimmenund Icursor diff bestimmen und ggf ausgleichen
I IF
cursor diff
I THEN stelle INCR 1; cursor diff : = FALSE
234
feldedi tieren
I
I
I FI;
I IF
stelle a.uf zwei tem ha.lbzeichen
I THEN stelle DEeR 1; cursor diff :. TRUE
I Fl.
I
I
Ife ld editieren
235
I
REP
236
237
238
239
I
I
feld optisch aufbereiten;
kommando annehmen und ausfuehren
PER.
I
I
I
240
241
242
243
244
245
absatzrnarkeupdaten
246
247
absatzmarkesollstehen
248
249
250
251
252
253
254
feldoptischa.ufbere1 ten I feld optisch aufberei ten
I stelle korrigieren;
I verschieben wenn erforderlich;
I randausgleich fuer doppelzeichen;
I output mode beha.ndeln;
I a.usga.be verhindern .
21/5
labsatzrnarke updaten :
I IF
absatzmarke soll stehen
I THEN IF NOT absatzrnarke steht THEN absatzrnarke schreiben (TRUE) FI
I ELSE IF
absatzmarke steht THEN absatzmarke schreiben (FALSE) 1
I Fl.
I
I
Ia.bsa.tzmarke soll stehen
(sa.tz SUB LENGTH sa.tz)
blank.
I
I
I
edi tor paket
21/5
Zeile
255
256
257
258
E LAN
EUMEL 1.9 ****
10.11.86
editor paket
randausglelchfuerdoppe I randausglelch fuer doppelzelchen :
I rr
stelle = max schrelbpos CAN] stelle auf erstem halbze1chen
I THEN verschiebe (1)
I rI.
I
~9
I
260
261
262
263
264
265
Istelle korrigieren :
I rr stelle auf zwei tem halbzeichen TIIEN stelle DEeR 1 FI .
I
I
stelleauferstemhalbzei Istelle auf erstem halbzeichen
wi thin kanji (satz, stelle
I
I
stellekorrlgieren
stelleaufzweitemhalbze
266
267
268
269
270
outPltmodebehandeln
Istelle
I
I
auf zwei tem halbzeichen
wi thin kanji (satz, stelle) .
loutput mode behandeln :
I SELECT output mode OF
I
CASE no output
I
271
272
273
274
275
~6
im markiermode markierung anpassen
CASE out zeichen
zeichen ausgeben; LEAVE output mode
behandeln
CASE out feldrest
feldrest neu schreiben
CASE out feld
feldout (satz, stelle)
CASE clear feldrest
feldrest loeschen
END SELECl';
schreibmarke positionieren (stelle) .
I
I
I
I
I
I
I
I
Iausgabe
I
I
277
278
ausgabeverhindern
279
280
281
lmmarklermodemarklerun 11m marklermode marklerung anpassen
I IF marklert THEN marklerung anpassen FI
282
283
284
285
286
287
288
marklerunganpassen
289
290
291
marklerungverlaengern
292
293
mark1erungverkuerzen
~4
295
296
297
298
299
380
301
302
21/6
+ 1) .
ze1chenausgeben
verhindern
output mode : = no output .
I
I
Imarklerung anpassen
I IF stelle) alte stelle
I THEN markierung ver Laengern
I ELIF stelle < al te stelle
I THEN marklerung verkuerzen
I Fl.
I
I
Imarklerung verlaengern
I invers out (satz, alte stelle, stelle, ,end mark) .
I
I
Imark1erung verkuerzen
I invers out (satz, stelle, alte stelle, end mark, WW) •
I
I
Ize1chen auageben
I IF NOT marklert
I THEN out (zeichen)
I ELIF mark refresh 11ne mode
I THEN feldout (satz, stelle); schrelbmarke positionleren (stelle)
I ELSE out (begln mark); markleft; out (ze1chen); out (end mark);
I
markleft
I Fl.
I
edi tor paket
21/6
Zeile
E LAN
EUMEL 1.8 ••••
10.11.86
editor paket
3(1)3
3(1)4
305
markleft
3(1)6
3(1)7
308
3(1)9
310
311
312
313
314
feldrestneuschreiben
315
316
317
1'eldrestunmarkiertneus Ifeldrest unmarkiert neu schreiben :
I schreibm&rke posi tionieren (&l te stelle);
lout subtext mit randbehandlung (satz, alte stelle, stelle am ende)
I
I
+
Ifeldrest neu schreiben :
I IF
NOT markiert
I THEN 1'eldrest unm&rkiert neu schreiben
I ELSE feldrest markiert neu schre1ben
I FI;
I WHILE postblanks ) 0 CAND x cursor (. rand
l o u t (blank); postblanks DEeR 1
I PER; postblanks :. 0 .
feldrestmarkiertneusch l1'eldrest markiert neu schreiben :
I markierung verlaengern; out subtext mit r&ndbehandlung
I
(satz, stelle, stelle am ende - 2 •
I
marklength) •
I
I
323
324
325
kommandoannehmenundaus Ikommando annehmen und aus1'uehren
I kommando annehmen; kommando aus1'uehren
326
327
kommandoannehmen
I
I
kOllllll&ndozurueckweisen1' Ikommando zurueckwelsen falls noetig :
I IF
NOT write access CAND zeichen ist druckbar
I THEN benutzer warnen; kommando ignorieren
I IT.
I
I
~
333
benutzerwarnen
lbenutzer warnen
out (piep) .
I
I
335
336
337
Ikommando annehmen
I getchar (zeichen); kommando zurueckwelsen falls noetig .
I
I
328
334
laenge REP
I
I
I
322
329
330
331
+
I
I
318
319
320
321
Imarkleft :
I marklength TlMESOUT left
kommandoignorieren
Ikommando ignorieren :
I zeichen: = Oft; LEAVE kommando annehmen und aus1'uehren .
339
340
341
342
343
344
345
346
347
348
kommandoausfuehren
Ikommando ausfuehren :
I neue satzlaenge bestlmmen;
I alte stelle merken;
I IF
zeichen ist separator
I THEN 1'eldedi tor verlassen
I ELIF zeichen ist druckbar
I THEN fortschreiben
I ELSE funktionstasten behandeln
349
350
neuesatzla.engebestinvne Ineue satzla.enge bestimmen
I
338
I
21/7
I Fl.
I
I
INT VAR satzla.enge :. LENGTH satz .
I
edi tor paket
21/7
Zeile
E LAN
351
352
feldeditorverlassen
EUMEL 1.8 ****
+
353
354
355
356
357
10.11.86
ed1 tor paleet
Ifeldedi tor verlassen
I IF NOT absatzmarke steht THEN blanks abschneiden Fl;
I
(*sh*)
I push (zeichen); LEAVE feld editieren .
I
I
blanksabschneiden
+
358
359
36@
Iblanks abschneiden :
I INT VAH letzte non blank pos := satzlaenge;
I WHILE letzte non blank pos ) 0 CAND (satz SUB letzte non blank
I
pos) = blank REP
I
letzte non blank pos DEeR 1
I PER; sa tz : = subtext (sa tz, 1, letzte non blank pos) .
I
I
361
362
zeichenistdruckbar
363
364
365
zeichenistseparator
366
367
368
369
370
fortschre1ben
371
372
373
374
375
376
zeicheninsatzeintragen Izeichen in satz elntragen :
I IF
hinter dem satz
I THEN satz mit leerzeichen auft'uellen und zeichen ant'uegen
I ELIF einfuegen
I THEN zeichen vor aktueller position eint'uegen
I ELSE altes ze1chen ersetzen
I Fl.
~
I t'ortschre1ben
I zeichen in satz eintragen;
I IF is kanji esc (zeichen) THEN kanji zeichen schreiben FI;
I bei erreichen von limit ueberlauf behandeln .
I
hinterdemsatz
I
Ihinter dem satz
stelle) satzlaenge .
I
I
satzmi tleerze1chenaut'f Isatz mit leerzeichen auffuellen und zeichen ant'uegen
I sa tz AIlFFUELLENMIT blank;
I zeichen ant'uegen;
I output mode : = out zeichen
385
386
Izeichen ist sepa.rator :
I separator eingestellt CAND pos (separator, ze1chen) ) 0 .
I
I
38S
381
382
383
384
zeichen)= blank .
I
I
378
379
Izeichen ist druckbar
I
I
zeichenant'uegen
I
I
Izeichen anfuegen
I
387
388
ze1chenignorieren
389
390
391
392
393
zeichenvoraktuellerpos Izeichen vor aktueller position einfuegen
I insert char (satz, zeichen, stelle);
I neue sa tzlaenge bestimmen;
I output mode : = out feldrest
394
395
396
397
398
399
al teszeichenersetzen
21/8
Izeichen ignorieren
satz CAT zeichen; neue satzlaenge bestilllllHln .
benutzer warnen; LEAVE kommando aust'uehren .
I
I
I
I
Ial tes zeichen ersetzen :
I replace (satz, stelle, zeichen);
I IF
stelle auf erstem halbzeichen
I THEN output mode .- out feldrest; replace (satz, stelle + 1, blank)
I ELSE output mode : = out zeichen
I Fl.
edi tor paleet
21/8
••••
E LAN
400
401
402
403
404
405
406
407
408
409
410
1. 8
EUMEL
k&nJizeichenschreiben
.. **
10.11. 86
••••
I
I
Ikanji zeichen schreiben :
I alte stelle merken;
I stelle INCH 1; getchar (zeichen);
I IF ze1chen ( ""64"" THEN ze1chen .- ""64"" FI;
I IF hinter dem satz
I THEN zeichen anfuegen
I ELIF einfUegen
I THEN zeichen vor aktueller posit1on einfuegen
I ELSE replace (satz, stelle, zeichen)
I
FI;
411
I output mode : = out feldrest .
412
I
I
lbei
I
413
beierreichenvonlimitue
+
414
415
416
417
418
419
satzl&engekrltisch
420
421
422
423
424
425
426
+
427
428
429
430
431
umbruchmoeg11ch
435
437
438
439
440
441
442
443
444
445
446
447
448
449
4~
21/9
erreichen von limit ueberlauf behandeln
(.sh.)
I IF satzlaenge kritisch
I THEN in naechste zelle falls moeglich
I ELSE stelle INCH 1
I
I
I
Fl.
I
I
I
Fl.
I
I
I
Fl.
Isatzlaenge kritisch
I IF stelle). satzl&enge
I THEN sa tzlaenge
limit
I ELSE satzlaenge - lim1 t + 1
innaechstezellefallsmo 11n naechste zeile falls moegl1ch
I IF fliesstext AND umbruch moeglich 011 NOT fliesstext AND stelle
I
). satzlaenge
I THEN in naechste zeile
I ELSE s te lle INCH 1
432
433
434
436
editor p&ket
1nnaechstezeile
lumbruch moeglich
I INT CONST st := stelle; stelle := limit;
I INT CONST 1tzt wortanf : = letzter wortanfang (satz) ;
I stelle: = st; einrueckposi tion (satz) ( ltzt wortanf
I
I
11n naechste zeile
I IF fliesstext
I THEN ueberlauf und oder umbruch
I ELSE ueberlauf ohne umbruch
I
I
I
Fl.
I
I
Fl.
ueberlaufUndoderumbruc lueberlauf und oder umbruch
I INT VAR umbruchpos :. 1;
I umbruchposi t10n bestimmen;
I loeschpos1tion bestimmen;
I IF ste lle = satzl&enge
I THEN ueberlauf mit oder ohne umbruch
I ELSE umbruch mit oder ohne ueber lauf
ed1 tor p&ket
21/9
Zeile
E LAN
1.8 ••••
EUMEL
10.11.86
editor p&ket
451
452
453
454
455
456
umbruehposi tionbestimm Iumbruehposi tion bestimmen :
I umbruehstelle: = stelle;
I stelle: = sa tzlaenge ;
I umbruehpos: = max (umbruehpos, letzter wortanfang (sa tz) ) ;
I stelle:. umbruehstelle .
457
458
459
460
loesehposi tionbest1mme Iloesehpos1 tion best1mmen
I INT VAR loesehpos := umbruehpos;
I WHILE davor noeh blank REP loesehpos DEeR 1 PER .
461
462
463
davornoehblank
464
465
ganzlinks
466
467
468
469
470
471
ueberlau!mi toclerohneum Iueberlau! mit oder ohne umbrueh :
I IF
ze1ehen. blank OR loesehpos • ganz links
I THEN stelle : = 1; ueberlauf ohne umbrueh
I ELSE ueberlauf mit umbrueh
I FI.
472
473
ueberlaufohneumbrueh
474
475
476
477
478
ueberlaufmitumbruch
479
480
481
482
483
484
umbruehkommandoau!bere lumbruehkommando au!bere1ten :
I ze 1ehen : = hop + rubout + inser;
I satzrest:= subtext (satz, umbruehpos);
I zeiehen CAT satzrest;
I IF
stelle 1st 1m umgebrochenen teil
I THEN insert char (zeiehen, backcr, max (stelle - umbruchpos + 1,
I
I
I
I
Idavor noeh blank
I loesehpos > ganz links CAND (sa tz SUB (loesehpos - 1»
blank.
I
I
Iganz links
max (1, marke) .
I
I
I
I
lueberlau! ohne umbrueh
push (er) .
I
I
Iueberlau! mit umbruch :
I ausgabe verhindern;
I umbruehkommando au!bere i ten;
I auf loesehposition positionieren
I
I
I
485
486
487
I
I
I
488
0) + 4);
zeichen CAT backer
FI;
push (ze1ehen) .
I
I
Istelle
I
I
489
490
stelleist1mumgebroehen
ist im umgebroehenen teil
stelle >= loeschpos .
491
492
au!loeschposit1onposit lau! loeschposit1on positionieren
stelle.m loeschpos .
493
494
495
496
497
498
499
umbruchmitoderohneuebe lumbruch mit oder ohne ueberlau! :
I umbruchposition anp&ssen;
I IF stelle ist 1m umgebrochenen teil
I THEN umbrueh mit ueberlau!
I ELSE umbruch ohne ueberlau!
I FI.
21/10
I
I
I
ed1 tor paket
21/10
Zaile
500
501
502
503
504
505
E LAN
EUMEL
neueloesehposi tionbest
5U
511
M2
stellenoehnichterreich
513
514
umbruchmitueberlauf
515
516
517
518
519
520
521
522
523
524
525
umbruehohneueberlauf
526
527
528
529
530
531
532
533
534
535
536
537
funktionst&stenbehande
~3
21/11
10.11. 86
edi tor pa.ket
I
I
Ineue loeschposi tion bestimmen :
I loeschpos: = umbruehpos;
I WHILE davor noeh blank AND stelle noeh
I
loesehpos DEeR 1 PER .
I
I
I stelle noeh nicht erreieht loesehpos)
I
I
lumbrueh mit ueberlauf
nieht erreicht REP
stelle + 1 .
ueberlauf mit umbruch .
I
I
lumbrueh ohne ueberlauf :
zeiehen: = inser;
satzrest:= subtext (satz, umbruehpos);
zeiehen CAT satzrest;
zeiehen CAT up char + baeker;
umbruehstelle INCR 1; umbrueh versehoben .• versehoben;
satz:= subtext (satz, 1, loesehpos - 1);
schreibm&rke positionieren (loesehpos); feldrest loeschen;
output mode: = out feldrest;
I push (zeichen)
I
I
I
I
I
I
I
I
I
I
Ifunktionst&sten behandeln
I SELECT pos (komma.ndos, zeichen) OF
I
CASE c hop
hop kOll1lll&ndos beh&ndeln
I
CASE c esc
esc kOmm&lldos behandeln
I
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
---
umbruchposltionanpasse lumbruchposition anpassen :
I IF zeichen = blank
I THEN umbruchpos : = stelle + 1;
I
umbruehposi tion bestimmen;
I
neue loesehposi tion bestimmen
I Fr.
596
507
508
509
1. 8
komma.ndos
CASE e right
naeh reehts oder ueberl&uf
I
CASE e left
wenn moeglich ein schri tt nach links
I
CASE c tab
zur naeehsten tabulator pos1 tion
I
CASE c dezim&l
dezim&len schreiben
I
CASE e rubin
einfuegen umseh&l ten
I
CASE e rubout
ein zeichen loeschen
I
CASE e abser, e inser, e down : feldeditor verl&ssen
I
CASE e up
eine zelle naeh oben
I
(-sh-)
I
CASE e cr
ggf absatz erzeugen
I
CASE e mark
markieren umseh<en
I
CASE e backcr
zurueck zur umbruchstelle
I
OTHERWISE
sondert&ste hahandeln
I END SELECT •
I
I
Ikomma.ndos
I LET e hop
1,
e right
• 2,
I
e up
3,
cleft
4,
I
e t&b
5,
c down
6,
I
e rubin
7,
c rubout
8,
leer
e abser
e dezim&l
c backcr
I
I
I
I
=
9,
11 ,
13,
15;
editor pa.ket
e mark
c inscr
c esc
18,
• 12,
= 14,
21/11
Zaile
****
E LAN
1. 8
EUMEL
I
I
I
554
555
****
10.11.86
****
edi tor paket
""1""2""3""8""9""19""11""12""13""16""17""18""19""27""20"".
556
557
dezimalenschreiben
558
559
560
zurueckzurumbruchstell Izurueck zur umbruchstelle:
I IF
umbruch stelle ) 0 THEN stelle :. umbruch stelle FI;
I IF
verschoben
umbruch verschoben
I THEN verschoben : = umbruch verschoben; output mode : = out feld
I FI.
561
562
Idezimalen schreiben
I
I
563
564
565
566
567
568
569
hopkommandosbehandeln
hop kommandos behandeln :
TEXT VAR zwei tes zeichen; getchar (zwe! tas zeichen);
zeichen CAT zwei tes zelchen;
SELECT pos (hop kommandos, zwei tes zeichen) OF
CASE h hop
nach links oben
CASE h right
nach rechts blaet tern
CASE h left
nach links blaettern
CASE h tab
tab position detinieren oder loeschen
CASE h rubin
zeile spli tten
CASE h rubout
loeschen oder rekombin1eren
CASE h cr, h up, h down: feldedi tor verlassen
OTHERWISE
: zeichen ignorieren
END SELECT .
570
571
572
573
574
575
576
577
578
579
580
581
582
583
hopkommandos
nachlinksoben
588
589
599
591
592
593
+
594
595
596
597
598
Ihop kommandos
I LET h hop
I
h up
I
h tab
I
h rubin
I
h cr
I
I
I
I
584
585
586
587
IF write access THEN dezimaleditor (satz) FI .
I
I
nachrechtsblaettern
1,
h
h
h
h
3,
= 5,
• 7,
• 9;
right
lett
down
rubout •
2,
4,
6,
8,
""1""2""3""8""9""10""11""12""13""
Inach links oben
I stelle:= max (marke, anfang)
+
verschoben; feldeditor verlassen
I
I
Inach rechts blaettern :
I INT CONST rechter rand .' stelle am ende - mark1erausgle1ch;
I IF
stelle ist am rechten rand
I THEN stelle INCR laenge - 2 * mark1erausgleich + ausgle1ch fuer
I
doppelzeichen
I ELSE stelle :. rechter rand
I FI;
I IF satzlaenge <= limit THEN stelle := min (stelle, limit) FI;
I alte einrueckposition mitziehen .
I
I
599
600
801
602
stelleistamrechtenrand Istelle ist am rechten rand:
I stelle auf erstem halbzeichen CAND stelle • rechter rand - 1
I
COR stelle
rechter rand
603
6e4
ausgleichfuerdoppelzei lausgleich fuer doppelzeichen
21/12
I
I
stelle - rechter rand .
I
ed1 tor pa.ke t
21/12
Zeile
E LAN
605
606
607
608
609
nachl1nksblaettern
EUMEL
1.8
lnach links blaettern :
INT CONST linker rand . - stelle am anfang;
IF
s te lle = linker rand
THEN stelle DEeR laenge - 2 • mark1erausgle1ch
ELSE stelle :. 11nker rand
FI;
I stelle:. max "(ganz links, stelle);
I alte e1nrueckposit1on mitz1ehen .
610
614
618
619
ed1 tor paket
10.11.86
I
I
I
I
I
611
612
M3
615
616
617
•• -
I
I
tabposi t1ondef1niereno Itab posi t10n definieren oder loeschen
I IF
stelle) LENGTH tabulator
I THEN tabula tor AUITUELLENMIT right; tabula tor CAT dach
I ELSE replace (tabulator, stelle, neues tab zeichen)
I FI;
I felded1 tor verlassen .
I
620
I
621
622
neuestabze1chen
6~
624
625
zellespli tten
+
631
632
633
634
loeschenoderrekomblnle Iloeschen oder rekombinieren
I IF NOT wri te access
I THEN zeichen ignorieren
I ELIF hinter dem sa tz
I THEN zenen rekomb1n1eren
I ELIF auf erstem ze1chen
I THEN ganze zeile loeschen
I ELSE zellenrest loeschen
635
636
637
Izelle spli tten :
I IF write access THEN felded1 tor verlas,en ELSE ze1chen 19norlerem
I
FI .
I
I
626
627
628
629
638
Ineues tab ze1chen :
IF (tabulator SUB stelle) • r1ght THEN dach ELSE r1ght FI
I
I
I
ze1lenrekombin1eren
I
I
I
FI.
Ize1len rekombinieren
felded1 tor verlassen
I
638
639
auferstemzeichen
ganzezeileloeschen
zeilenrestloeschen
M4
M5
M6
647
648
649
650
651
652
653
654
655
21/13
Iganze zelle loeschen
stelle
=
1 .
satz:. ""; feldeditor verlassen
I
I
Me
641
M2
M3
Iauf erstem zeichen
I
esckommandosbehandeln
Izeilenrest loeschen :
I change (satz, stelle, satzl&enge, "");
I output mode : = clear feldrest .
I
I
lese kommandos behandeln :
I getchar (zwe1 tes zelchen);
I zeichen CAT zwei tes zeichen;
I auf exit pruefen;
I SELECT pes (esc kommandos, zwei tes ze1chen) OF
I
CASE e hop
lernmodus umschal ten
I
CASE e right
zum naechsten wort
I
CASE e left
zum vorigen wort
I
OTHERWISE
belegte taste ausfuehren
I END SELECT .
I
edi tor paket
21/13
Zeile
E LAN
656
657
658
aufexi tpruefen
659
esckollllll&ndos
EUME!.
••••
edi tor paket
10.11.86
lauf exit pruefen :
I IF pos (res, zwei tes zeichen) ) 0 THEN feldedi tor verlassen FI .
I
I
660
661
662
Iesc kommandos
I LET e hop
I
e right
I
e left
I
I
I
I
663
664
665
666
1.8
lernmodusumschal ten
667
2,
3;
""'1""2""8""
Ilernmodus umschal ten :
I IF lernmodus THEN lernmodus ausschalten ELSE lernmodus .inschalten
I
I
668
669
1,
FI;
feldeditor verlassen .
I
I
670
671
lernmodus ausschalten :
lernmodus := FALSE;
belegbare taste erfragen;
audit := subtext (audit, 1, LENGTH audit - 2);
IF
taste = hop
THEN (* lernsequenz nicht auf taste legen *)
-ws- *)
ELSE l.rnsequenz auf taste legen (taste, audit)
lernmodusausschalten
672
673
674
675
676
677
FI ;
audit :=
678
679
680
681.
682
683
$I"
(* 16.08.~
.
belegbaretasteerfragen Ibelegbare taste erfragen :
I TEXT VAR taste; getchar (taste);
I WHILE taste ist reserviert REP
I
benutzer warnen; getchar (taste)
I
I
684
685
PER.
I
686
tasteistr.servi.rt
687
688
689
lernmoduselnschalten
690
691
zumvorigenwort
I taste ist reserviert :
(* 16.ea.~
I
-ws- *)
I taste () hop CAND pos (reservierte feldeditor tasten, taste) ) e .
I
I
Ilernmodus einschalten
audi t : =
"";
lernmodus . - TRUE .
I
I
695
Izum vorigen wort
I IF
stelle) 1
I THEN stelle DEeR 1; stelle : = letzter wortanfang (satz);
I
alte einrueckposition mitziehen;
I
IF (sa tz SUB stelle) <) blank THEN LEAVE zum vorigen wort FI
696
I
FI;
697
I
feldedltor verlassen .
698
I
I
692
693
694
699
zumnaechstenwort
700
I
I
~1
702
703
704
705
21/14
Izum naechsten wort :
I IF kein naechstes wort THEN feldeditor verlassen FI .
keinnaechsteswort
Ikein naechstes wort :
I BOOL VAR im alten wort : = TRUE;
lINT VAR i;
I FOR i FROM s te lle UPI'O satzlaenge REP
editor paket
21/14
Zeile
E LAN
EUMEL
I
I
I
I
706
707
708
709
710
I
I
I
I
I
711
712
713
714
715
716
717
****
10.1L86
edi tor paket
IF im alten wort
THEN im alten wort . - (sa tz SUB i) () blank
ELIF (sa tz SUB il () bla.nk
THEN stelle : = i; LEAVE kein naechstes wort WITH FALSE
FI
PER;
TRUE
belegtetasteausfuehren Ibelegte taste ausfuehren :
I IF
ist kommando taste
I THEN feldedi tor verlassen
I ELSE gelerntes ausfuehren
7~
719
'120
1.8
istkomma.ndota.ste
In.
I
I
list kommando taste
taste enthaelt komma.ndo (zweites zeichen) .
I
721
I
722
723
gelerntesausfuehren
nachrechtsoderueberlau I nach rechts oder ueberlauf :
I IF
fliesstext COR stelle < limit OR satzlaenge ) limit
I THEN nach rechts
I ELSE auf anfang der naechsten zeila
I Fl.
I
I
730
731
732
.
I
I
724
725
726
727
728
729
Igelerntes ausfuehren :
I push (lernsequenz auf taste (zweites zeichen»
I
(*sh*)
nachrechts
Inach rechts
I IF stelle auf erstem halbzeichen THEN stelle INCR 2 ELSE stelle
I
733
INCR 1 FI;
I alte einrueckposition mitziehen .
734
I
735
7M
aufanfangdernaechstanz lauf anfang der naechsten zeile
737
nachlinks
740
741
742
743
745
M7
748
749
750
751
752
753
21/15
stelle DEeR 1; al te einrueckposi tion mi tziehen .
alteeinrueckpositionmi lalte elnrueckposition mitziehen
I IF
satz ist leerzeile
I THEN alte einrueckposition .- stelle
I ELSE alte einrueckposi tion : = min (stelle, einrueckposition (satz»)
I FI.
744
746
Inach links
push (abscr) .
I
I
7~
739
I
I
satzistleerzelle
I
I
Isatz ist laerzeila :
I satz = "" OR satz = blank .
I
I
wennmoeglicheinschrl tt Iwenn moegl1ch ain schritt nach links
I IF
stelle = ganz links
I THEN zeichen ignorieren
I ELSE nach links
I FI.
I
editor paket
21/15
E LAN
Zeile
EUMEL 1.8 - -
10.11.86
edi tor pa.ket
Izur naechsten ta.bulator position :
I bestimme naechste expl1zi te ta.bulator
I IF ta.bula tor gefunden
I THEN explizi t ta.bulieren
I ELIF stelle
satzlaenge
I THEN implizi t ta.bulieren
754
755
756
757
758
759
760
761
762
zurnaechstenta.bulatorp
763
764
765
766
767
best1mmenaechsteexpliz I bestimme naechste explizite ta.bula tor position :
I INT VAR ta.b position := pos (ta.bulator, dach, stelle + 1);
I IF ta.b position) limit AND satzlaenge (. limit
I THEN ta.b position : = 0
I Fl.
position;
(=
I
I
I
I
7~
769
770
ta.bulatorgefunden
771
772
explizitta.bul1eren
773
774
775
776
777
778
779
implizi tta.bul1eren
780
781
einfuegenumsch&l ten
+
782
783
784
785
ELSE auf anfang der naechsten zeile
FI.
I
I
Itabulator
I
I
gefunden
lexpl1zit tabulieren
I
I
Iimplizi t
tab position () 0 .
stelle._ ta.b position; push (dezimal) .
ta.bulieren :
I ta.b position : = einrueckposi tion (s&tz);
I IF stelle ( ta.b position
I THEN stelle . - ta.b position
I ELSE stelle :. satzl&enge + 1
I FI.
I
I
Ieinfuegen umschalten
I IF NOT write access THEN zeichen ignorieren FI;
I
(osho )
I einfuegen: = NOT einfuegen;
I IF einfuegen THEN einfuegen optisch anze1gen FI;
I feldedi tor verlassen .
I
I
786
787
788
789
790
791
792
793
794
795
796
einfuegenoptisch&nzeig leinfuegen optisch anzeigen
I IF markiert
I THEN out (begin mark); markleft; out (dach left); warten;
l o u t (end mark); markleft
I ELSE out (dach left); warten;
I
IF stelle aut erstem h&lbzeichen
I
THEN out text (sdz, stelle, stelle + 1)
I
ELSE out text (satz, stelle, stelle)
I
FI
797
markiert
798
799
dschleft
800
801
802
803
warten
21/16
I FI.
I
I
Imarkiert
I
Idach left
I
I
Iwarten
I TEXT VAR
I kOmm&ndo
I
marke) 0
""94 ""8""
t : = inch&rety (2);
CAT t; IF lernmodus THEIl &udi t CAT t FI .
editor pa.ket
21/16
Zeile
E LAN
804
805
e1nzeichenloeschen
EUMEL
+
806
807
808
809
810
811
812
813
ze1chendavorsollgeloes
814
815
816
nachlinksoderignoriere
+
817
818
819
820
821
822
823
824
825
826
827
828
829
830
a.ktuelleszeichenloesch
831
einezeilenachoben
I
+
833
834
835
8M
+
838
839
ggfabsa tzerzeugen
840
841
842
+
+
21/17
zeichen loeschen :
FI .
postblanks INCR 1
FI;
delete char (satz, stelle);
postblanks INCR 1;
neue satzlaenge bestimmen;
output mode : = out feldrest
Ieine zeile nach oben :
I
(*sh*)
I IF NOT absatzmarke steht
I
umbruchkommandos
I THEN blanks abschneiden
I FI;
I push (ze1chen); LEAVE feld
I
I
CAND NOT 1st teil eines
ed1 t1eren
(kommando SUB kommandozeiger) •
I
I
Iggf absatz erzeugen
I
(*sh*)
I IF write access
I THEN IF NOT absatzmarke steht THEN blanks abschne1den
I
IF
stelle > LENGTII satz AND fl1esstext AND (satz
I
satz)
blank
I
THEN sa tz CAT blank
I
FI
I FI push (ze1chen); LEAVE feld ed1 t1eren
I
I
FI;
SUB LENGTH
(>
843
844
845
846
850
ed1 tor paket
****
istteileinesumbruchkom list teil e1nes umbruchkommandos
I
backer.
+
847
848
849
Iein
10.11.86
I IF NOT write access THEN zeichen ignorieren FI;
I
(*sh*)
I IF zeichen davor soll geloescht werden
I THEN nach links oder ignor1eren
I FI
I IF NOT hinter dem satz THEN a.ktuelles zeichen loeschen
I
I
Izeichen davor soll geloescht werden
I hinter dem sa tz COR markiert .
I
I
Inach links oder ignorieren
I IF stelle > ganz links
I THEN nach links
I
(*sh*)
I ELSE zeichen ignorieren
I Fl.
I
I
Iaktuelles zeichen loeschen :
I stelle korrigieren; alte stelle marken;
I IF stelle auf erstem halbzeichen
I THEN delete char (sdz, stelle);
I
I
I
I
I
I
I
832
837
1.8 ****
markierenumschalten
lmarkieren umschalten
IF
mark1ert
THEN marke : = 0;
ma.xschreibpos INCR marklength; cpos D!X:R
marklength
ELSE marke := stelle; ma.xschre1bpos D!X:R marklength; cpos INCR
marklength;
I
I
I
I
I
edi tor paket
21/17
Zane
E LAN
EUMEL
1. 8
858
859
860
861
852
863
864
865
edi tor paket
10.11.86
verschieben wenn erf'orderlich
FI ;
feldedi tor verla.ssen .
851
852
853
854
855
856
857
***..
sondertastebeha.nde In
Isondertaste behandeln
lEND PROG feldeditor;
push (esc + ze1chenl .
I
dezimaleditor ............ IPROC dezimaleditor (TEXT VAR satz)
I INT VAR dezimalanfang : = stelle;
I zeichen einlesen;
I IF dezimalstartzeichen CAND ueberschreibbar THEN dezimalen
I
schreiben FI;
I push (zeichen) .
zeichene i n lesen
dezimalzeichen
+
I
I
Izeichen einlesen
I
Idezimalzeichen
I
separator
TEXT VAR zeichen; getchar (zeichen) .
pos (dezimalen, zeichen) ) 0 AND nicht
I
866
dezimalst&rtzeichen
867
dezimalen
868
startdezimalen
Idezimalstartzeiche!l
I
separator
I
Idezimalen
I
Istartdezimalen
I
Inicht separator
pos (startdezimalen, zeichenl ) 0 AND nicht
"0123456789" .
"+-0123456789"
pos (separator, zeichen)
869
870
nichtseparator
871
872
873
874
ueberschreibbar
875
876
ueberschreibbarezeiche Iueberschreibbare zeichen
877
dezimalenschreiben
Iueberschreibbar
I dezimalanfang) LENGTH sa tz OR
I pos (ueberschreibbare zeichen, satz SUB dezimalanfang) ) 0 .
I
I
",. +-0123456789" .
I
I
Idezimalen schreiben :
878
I
REP
879
I
I
I
I
I
I
dezimale in satz eintrl4!en;
dezimalen zeigen;
zeichen einlesen;
dezimaIa.nfang DECR 1
UNTIL dezimaleditor beendet PER;
stelle INCR 1 .
B80
881
882
883
B84
885
886
887
8B8
889
+
890
891
892
893
21/18
0.
I
I
I
I
dezimaleinsatzeintrl4!e Idezimale in satz eintrl4!en :
I IF
dezimalanfang) LENGTH satz
I THEN satz AUFFUELLENMIT blank; satz CAT zeichen
I ELSE delete char (satz, dezimalanf'ang); insert char (satz,
I
ze1chen, stelle)
I FI.
I
I
dezimalenzeigen
Idezimalen zeigen
I INT VAR min dezimalschreibpos . - max (min schreibpos,
I
dezimalanfang) ;
edl tor paket
21/18
ZeUe
E LAN
EUMEL
894
895
896
897
898
markiert
899
900
901
902
markiertzeigen
903
904
905
906
unmarklertzeigen
907
908
909
910
911
912
dezimaleditorbeendet
1.8
**-*
editor paleet
10.11.86
I IF markiert THEN markiert zeigen ELSE unmarkiert
I schreibmarke positionieren (stelle) .
I
I
Imarkiert marke) 0 .
I
I
Imarkiert zeigen :
I invers out (So. tz, min dezimalschrei bpos, stelle,
zeigen FI;
,end mark);
lout (zeichen) .
I
I
Iunmarkiert zeigen :
I schreibmarke positionieren
(min dezimalschreibpos);
lout subtext (satz, min dezimalschreibpos, stelle) .
I
I
Idezimaleditor beendet
I Nor dezimalzeichen OR
I dezimalanfang ( max (min
I NOT ueberschreibbar .
IEND
I
schreibpos, marke) OR
PRoo dezimaleditor;
913
914
915
916
isedi tget ................ IBOOL PROC is edi tget :
I edi tget modus
lEND PROC is editget ;
917
918
919
920
921
922
923
924
getedi tl1ne
925
putedi tline
I
.............. IPROC
get edi tline (TEXT VAH editline, IN! VAH edi tpos, edi tmarke)
IF
edi tget modus
THEN editline := alter editsatz;
I
edi tpos : = stelle
I FI;
I edi tmarke : = marke
lEND PROC get editline;
I
I
I
.............. IPROC
put edi tline (TEXT CONST edi tline, IN! CONST edi tpos,
editmarke):
I IF edltget modus
I THEN alter editsatz := editline;
I
stelle := max (editpos, 1);
I
marke := max (editmarke, 0)
I FI
lEND PROC put editl1ne;
I
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
21/19
I
wi thinkanji •.•.....•.•..• IBOOL PRoo within kanji (TEXT CONST satz, IN! CONST stelle)
I count directly prefixing kanji esc bytes;
I number of kanji esc bytes is odd .
countdirectlyprefixing
I
I
Icount
I IN!
I
I
I
directly prefixing kanji esc bytes :
VAH pos : = stelle - 1, kanji esc bytes : = 0;
WHILE pos ) 0 CAND is kanji esc (satz SUB pos) REP
kanji esc bytes INCR 1; pos DEeR 1
PER.
editor paleet
21/19
Zeile
E LAN
EUMEL
1.8
943
945
946
947
+
948
949
+
950
951
952
10.11.86
edi tor pa.ket
I
I
942
944
._.
numberofkanjiescbytesi Inumber of kanji esc bytes 1s odd
I (kanji esc bytes AND 1) < > 0 .
lEND PROC within kanji;
I
iskanjiesc ............... IBOOL PROC is kanji esc (TEXT CONST char) :
I
(.sh.)
I two byte mode CAND
I (char >= Rft129 Rft AND char <= ""159"" OR char >= ""224"" AND char
I
<= ""239 Rft )
lEND PROC is kanji esc;
I
two bytes ................. IBOOL PROC two bytes
two byte mode END PROC two bytes;
I
~3
954
955
956
957
two bytes ................. IPROC two bytes (BOOL CONST new mode)
I two byte mode : = new mode
IEND PROC two bytes;
958
959
960
961
962
963
964
965
966
outtext .................. IPROC outtext (TEXT CONST source, INT CONST from, to)
lout subtext mit randbehandlung (source, from, to);
I INT VAR trailing;
I IF
from <= LENGTH source
I THEN trailing : = to - LENGTH source
I ELSE trailing : = to - from + 1
I FI; trailing TIMESOUT blank
IEND PROC au t text;
967
outsubtextmitrandbehan ... IPROC out subtext mit randbehandlung (TEXT CONST satz, INT CONST von,
Ibis) :
I IF
von > bis
I THEN
I ELIF bis >= LENGTH satz COR NOT within k&nji (satz, bis + 1)
I THEN out subtext mit anfangsbehandlung (satz, von, bis)
I ELSE out subtext mit anfangsbehandlung (satz, von, bis - 1); out
I
(blank)
I FI
lEND PROC out subtext mit randbehandlung;
+
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
21/20
I
I
I
outsubtextmitanfangsbe ... IPROC out subtext mit anfangsbehandlung (TEXT CONST satz, INT CONST
I
von, bis) :
I IF
von > bis
I THEN
I ELIF von· 1 COR NOT wi thin kanji (satz, von)
I THEN out subtext (satz, von, bis)
I ELSE out (blank); out subtext (satz, von + 1, bis)
I FI
I END PROC out subtext mit anfangsbehandlung;
I
edi tor pa.ket
21/28
ZeUe
E LAN
EUMEL
1.8
*.**
10.11.86
98:i
'+
986
getcursor ...........•..•. IPROC get cursor
987
+
988
xcursor .................. lINT PROC x cursor
I
cursor;
989
wri tepermission .......... IBOOL PROC write permission
I
permission;
9~
I
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
I
edi tor paket
get cursor (spal te, zeUe)
END PROC get
get cursor; spalte
END PROC x
cursor;
I
I
write access
END PROC write
push .•................... IPROC push (TEXT CONST ausfuehrkommando)
I IF
ausfuehrkommando
""
I
(.sh.)
I THEN
I ELIF kommando •
I THEN kommando := ausfuehrkommando
I ELIF (kommando SUB kommando zeiger - 1) • ausfuehrkommando
I THEN kommando zeiger DEeR 1
I ELIF replace moeglich
I THEN kommando zeiger DEeR laenge des ausfuehrkommandos;
replace (kommando, kommando zeiger, ausfuehrkommando)
I
I ELSE insert char (kommando, ausfuehrkommando, kOllllll&ndo zeiger)
I Fl.
replacemoeglich
I
I
Ireplace moeglich :
I INT CONST laenge des ausfuehrkommandos : = LENGTH ausfuehrkollllll&ndo;
I kommando zeiger ) laenge des ausfuehrkommandos .
lEND PROC push;
I
1009
1010
1011
1012
type ...................•. IPROC type (TEXT CONST ausfuehrkommando)
I kommando CAT ausfuehrkommando
IEND PROC type;
I
1013
+
1014
stelleamanfang ........... 1INT PROC stelle am anfang
I
anfang;
1015
+
1016
stelleamende ............. lINT PROC stelle am ende
I
stelle am ende;
I
stelle am anfang+laenge-1 END PROC
1017
SIGN marke. mark length END PROC
1018
markierausgleich ......... lINT PROC markierausglelch
I
markierausgleich;
I
1019
1020
1021
1022
verschiebenwennerforde ... IPROC verschieben wenn erforderl1ch :
I IF
stelle) max schreibpos
I THEN verschiebe (stelle - max schreibpos)
I ELIF stelle < min schreibpos
21/21
anfang + verschoben END PROC stelle
I
editor pake t
21/21
&III
Zeile
11323
11324
11325
11326
11327
11328
11329
11330
11331
11332
11333
11334
11335
11336
1037
11338
11339
1040
11341
11342
11343
11344
E LAN
EUMEL
1.8
••••
113.11.86
edi tor paket
I THEN verschiebe (stelle - min schre1bpos)
IF!
IEND PROC verschieben wenn erforderlich;
I
verschiebe ............... IPROC verschiebe (TNT CONST i)
INCR i'
I verschoben
I min schreibpos INCR i;
I max schre i bpo s INCR i'
DEeR i;
I cpos
I output mode :. out reId;
I schreibmarke posi tionieren ( stelle)
-ws- .)
I
lEND PROC verschiebe ;
I
(* 11.135.85
konst&ntenneuberechnen ... IPROC konst&nten neu berechnen :
I min schrelbpos : = anfang + verschoben;
I IF
min .;chreibpos < 13
(* 17.05.85
I
-ws- .)
I THEN min schreibpos DEeR verschoben; verschoben : = 13
I FI;
I max schreibpos : = min schrelbpos + laenge - 1 - markierausgle1ch;
I cpos:. rand + laenge - max schreibpos
IEND PROC konst&nten neu berechnen;
I
11345
11346
1047
1048
schrelbnarkeposl tionie ... IPROC schre1bmarke positionieren (INT CONST sstelle)
I cursor (cpos + sstelle, zeile)
IEND PROC schreibnarke positionieren;
1049
113513
1051
11352
1053
11354
simplefeldout ............ IPROC simple feldout (TEXT CONST satz, INT CONST dunvny)
I (* PRECONDITION
NOT markiert AND verschoben = 13 *)
I (.
AND feldrest schon geloescht
.)
I schreibnarke an feldanfang posi tionieren;
lout subtext mit randbehandlung (satz, anfang, anfang + laenge - 1);
I IF (satz SUB LENGTH satz) = blank THEN absatzmarke schreiben
1055
1056
11357
1058
11359
11360
11361
11362
11363
I
I
I
I
schreibmarkeanfeldanfa Ischrelbmarke an feldanfang positlar.ieren
IEND PROC simple feldout;
cursor (rand + 1, ze1le) .
I
feldout .................. IPROC feldout (TEXT CONST satz, INT CONST sstelle)
I schreibnarke an feldanfang positionieren;
I reId ausgeben;
I feldrest loeschen;
I IF (satz SUB LENGTH satz)
blank THEN absatzmarke schreiben
I
1064
(TRUE) FI .
(TRUE) FI .
I
I
1065
11366
21/22
schreibmarkeanfeldanfa I schreibmarke an feldanfang posi tianieren
cursor (rand
+ 1,
zene) .
I
ed1tor paket
21/22
Zeile
E LAN
EUME!.
1.8
........
10.11.86
edi tor pe.ket
1067
1068
1069
1070
1071
1072
1073
1074
1075
feldeusgeben
1076
1077
nichtm&rkiert
1078
1079
1080
markiertesnichtsichtba lmarkiertes nicht sichtbar :
Ibis DECR marklength .. (1 + SIGN sstelle); marke ) bis
1081
1082
1083
unm&rkierta.usgeben
1084
markierta.usgeben
+
1092
1093
1@94
1095
1@96
11397
11398
11399
1100
1101
1102
1103
1104
11@5
FI.
Imcht markiert
marke
(=
0 .
+
1 •
I
I
Iunmarkiert ausgeben
lout subtext mit randbehandlung (satz, von, bis) .
I
I
Imarkiert ausgeben
I INT VAR smarke : = max (von, marke);
lout text (satz, von, smarke - 1); out (begin mark);
I verschiedene feldout modes behandeln .
I
I
verschiedenefeldoutmod Iverschiedene feldout modes behandeln :
I IF
sstelle = 0
I THEN out subtext mit randbehandlung (satz, smarke, bis); out (end
I
mark)
I ELSE out text (satz, smarke, zeilenrand); out (end mark);
I
(..sh.. )
l o u t subtext mit randbehandlung (satz. sstelle, bis)
I Fl.
I
zeilenrand
I
Izeilenrand : min (bis, sstelle - 1) .
IEND PROC feldout;
I
absatzmarkeschreiben ..... IPROC absatzmarke schreiben (BOOL CONST schreiben)
I IF
fliesstext AND nicht markiert
I THEN cursor (rand + 1 + laenge, zeile);
l o u t (absatzmarke)
I
absa tzmarke s teht : = TRUE
I Fl.
I
I
1106
1107
nichtmarkiert
1108
1109
11113
1111
111?
1113
1114
1115
1116
absatzmarke
21/23
I
I
I
I
I
1085
1086
1087
1088
1089
11390
11391
Ifeld ausgeben :
I INT VAR von := anfang + verschoben, bis := von + laenge - 1;
I IF
nicht markiert
I THEN unmarkiert ausgeben
I ELIF markiertes nicht sichtbar
I THEN unmarkiert ausgeben
I ELSE markiert ausgeben
Inlcht markiert
I
I
marke
(=
13 .
labsatzmarke
I IF
NOT schreiben
I
THEN"
"
I
ELIF mark length ) 13
I THEN ""15""14""
I ELSE ""15" "14" "
I Fl.
lEND PROC absatzmarke schreiben;
I
edi tor pe.ket
21/23
Zeile
1117
+
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1136
E LAN
EUMEL
1. 8
****
edi tor paleet
10.11. 86
inversout ................ IPROC invers out (TEXT CONST satz, INT CONST von, bis, TEXT CONST
I
pre, post) :
I IF
mark refresh line mode
I THEN feldout (satz, stelle)
I ELSE schreibmarke posi tionieren (von);
l o u t (begin mark); markleft; out (pre);
l o u t text (satz, von, bis - 1); out (post)
I FI.
I
I
markleft
lmarkleft
I marklength TIMESOUT
I
IEND PROC invers out;
I
left
feldrestloeschen ......... IPROC feldrest loeschen :
I IF rand + laenge ( maxbreite COR invertierte darstellung
I THEN INT VAR x; get cursor (x, zeile);
I
(rand + laenge - x + 1 + absatz ausgleich) TIMESOUT blank;
I
(*sh*)
I
cursor (x, zeile)
I ELSE out (clear eol); absatzmarke steht : = FALSE
I FI
lEND PROC feldrest loeschen;
I
1139
1140
1141
1142
1143
1144
1145
AUFFUELLENMIT ............ IOP AUFFUELLENMIT (TEXT VAR satz, TEXT CONST fuellzeichen)
I INT VAR i;
I FOR i FROM stelle - LENGTH satz IlOWNTO 2 REP
I
satz CAT fuellzeichen
1146
einrueckposi tion ......... lINT PROC e1nrueckposi tion (TEXT CONST satz)
I
(*sh*)
I IF fliesstext AND satz = blank
I THEN anfang
I ELSE max (pos (satz, ""33"", ""254"", i), 1)
I FI
lEND PROC einrueckposition;
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
21/24
I
PER
lEND OP AUFFUELLENMIT;
I
I
letzteNortanfang ........ I INT PROC letzter wortanfang (TEXT CONST sa tz)
I
(*sh*)
INT CONST ganz links : = max (1, marke);
BOOL VAR noch nicht im neuen wort := TRUE;
INT VAR 1;
FOR i FROM stelle DOWNTO ganz links REP
IF
noch nicht im neuen wort
THEN noch nicht 1m neuen wort :. char = blank
ELIF is kanJ 1 esc (char)
THEN LEAVE letzter wortanfang WITH
ELIF nicht mehr im neuen wort
THEN LEAVE letzter wortanfang WITH
+ 1
FI
PER ;
ed1 tor paleet
21/24
E LAN
Zeile
EUMEL
I
1166
1167
1168
1169
char
1170
1171
1172
nichtmehrimneuenwort
117~
1174
1175
1176
1177
1178
1179
1180
1181
1182
1.8
I
I
1187
1188
1189
1190
1191
1192
119~
1194
1195
1196
1197
1198
1199
1200
1201
1202
120~
1204
1205
1206
1207
1208
1209
1210
1211
1212
121~
1214
1215
1216
1217
21/25
10.11.86
edi tor pa.ket
ganz links .
Ichar : Batz SUB i .
I
I
Inicht mehr im neuen wort : char
IEND PROC letzter wortanfang;
blank COR wi thin kanji (satz, 1)
I
getchar .................. PROC getchar (TEXT VAR zeichen) :
IF
komma.ndo = ••
THEN inchar (zeichen); IF lernmodus THm aud1t CAT zeichen
ELSE zeichen := kommando SUB kommando zeiger;
kommando zeiger INCR 1;
IF
kommando zeiger ) LENGTH kommando
THEN kOllllll&ndo zeiger :. 1; komma.ndo :.
FI
FI ;
IF
LENGTH kommando - kommando zeiger <
THEN kommando CAT inchety
FI
11~
1184
1185
1186
••••
~
FI .
IEND PROC getchar;
I
inchety .................. ITEXT PROC inchety
I IF
lernmodus
I THEN TEXT VAR t : = incharety; audit CAT t; t
I ELSE incharety
I FI
IEND PROC inchety;
I
isincharety .............. IBOOL PROC is incharety (TEXT CONST muster)
I IF
kornrnando = ••
I THEN TEXT CONST t := inchety;
I
IF t = muster THEN TRUE ELSE kOllllll&ndo . - t; FALSE FI
I ELIF (kommando SUB kommando zeiger) = muster
I THEN kommando zeiger INCR 1;
I
IF komma.ndo zeiger ) LENGTH kommando
I
THEN kommando zeiger : = 1; kOllDll&ndo : = ••
I
FI ;
I
TRUE
I ELSE FALSE
IFI
IEND PROC is incharety;
I
getcharety ............... ITEXT PROC getcharety
I IF
komma.ndo = ••
I THEN inchety
I ELSE TEXT CONST t := kommando SUB kommando zeiger;
I
kOllDll&ndo zeiger INCR 1;
I
IF kommando zeiger ) LENGTH komma.ndo
I
THEN kommando zeiger : = 1; kOllDll&ndo :.
I
FI ; t
I FI
IEND PROC getcharety;
edi tor pa.ket
21/25
Zeile
E LAN
EUMEL
1. 8
****
editor pa.ket
10.11.86
1218
1219
+
1220
1221
1222
1223
1224
1225
1226
1227
getedi tcursor ............ IPROC get editcursor (INT VAR x, y) :
I
(*sh*)
I IF actual editor ) 0 THEN a.ktualisiere bildparameter FI;
I x : = rand - (anfang + verschoben - 1 - markierausgleich) + stelle;
I y := zeile .
I
I
aktualisierebildparame I
1228
1229
1230
.
1(***....****.*** •••**••• **** Zugriff auf Feldstatus
1232
stelle
1233
altestelle
1234
rand
1235
limit
1236
anfang
1238
y)
PROC get edi tcursor;
***••• **.** .........*** . . . *** ) .
I
I
I
feldstatus.stelle
I stelle
I
1231
1237
aktualisiere bildparameter :
INT VAR old x, old y; get cursor (old x, old y);
dateizustand holen; bildausgabe steuern; satznr zeigen;
fenster zeigen; zeile . - bildrand + zeilennr; cursor (old x, old
I
I
I
I
IEND
I
marke
laenge
Ialte stelle
I
Irand
I
I limit
I
.
feldstatus.alte stelle
feldstatus. rand
feldstatus.limit .
feldstatus.anfang .
lanfang
I
feldstatus.marke .
lmarke
I
Ilaenge
feldstatus .laenge .
I
Iverschoben
I
feldstatus.verschoben
1239
verschoben
1240
einfuegen
leinfuegen
feldstatus.einfuegen .
fl1esstext
I
Ifliesstext
I
feldsta tus. fliesstext .
1241
1242
wri teaccess
1243
1244
1245
tabulator
Iwri te access
feldstatus.write access
I
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
+
21/26
Itabulator
feldstatus. tabulator.
I
I (•••••** •• ** •••••• ** •••••••* ................................JllI ............. 11
I
••••••• )
I
ILET undefinierter bereich
bildzeile
abschnitt
bild
I
I
I
I
ILET
I
I
I
I
I
I
I
I
I
BILDSTATUS
0,
2,
3,
4,
nix
a.kt satznr
ueberschrift
fehlermeldung
1,
2,
3,
4;
STRUCT (INT feldlaenge, kurze feldlaenge,
blldrand, bildlaenge, kurze bildla.enge,
ueberschriftbereich, bildbereich,
erster neusatz, letzter neusatz,
old zeilennr, old lineno, old mark
11neno,
BOCL zeileneinfuegen, old line update,
TEXT satznr pre, ueberschrift pre,
ueberschrift text, ueberschrift post,
old satz,
editor paket
21/26
Zelle
E LAN
EUMEL
I
I
I
I
I
I
I
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
+
1282
1283
+
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
21/27
10.11.86
ed1 tor paleet
FRANGE old range,
FILE file),
EDITSTATUS = STRUCT (FELDSTATUS feldstatus, BILDSTATUS
bildstatus) ,
max editor 10,
EDITSTACK = ROW max edi tor EDITSTATUS;
I
IROW max editor INT VAH einrueckstack;
I
IBOOL VAH markiert;
ITEXT VAH fllena.me, tab, bildsatz, bildzeichen, fehlertext,
akt bildsatz ;
I
lINT VAH zeilennr, satznr, bildanfang, bildm&rke, feldm&rke,
actual editor : = 0, max used editor . - 0,
I
letzer editor auf dieser datei,
I
alte einrueckposition := 1;
I
I
aktuelleredi tor .......... lINT PROC aktueller editor
I
editor;
actual editor
END PROC aktueller
I
groessteredi tor .......... lINT PROC groBSster edi to!'
I
editor;
I
max used editor END PROC groesstar
I(.....**.......................... bi ldedi tor
I
............................... )
I
1284
1285
****
IBILDSTATUS VAH b11dstatus
IEDITSTACK VAH editstack;
1280
1281
1 •8
bildeditor ............... IPROC bilded1 tor (TEXT CONST res, PROC (TEXT CONST) komma.ndo
I
interpreter):
I evtl fehler behandeln;
I enable stop;
I TEXT VAH reservierte tasten . - ""11""12""27"bf"
I reservierte tasten CAT res ;
I INT CONST my highest editor . - max used editor;
laenge : = feldlaenge;
konstanten neu berechnen;
REP
markierung justieren;
alte. feld nachbereiten;
feldlaenge einsteller.;
ueber.chrift zeigen;
fenster zeigen ;
zeile bereitstellen;
zeile edi tieren;
kommando ausfuehren
PER .
evtlfehlerbehandeln
levtl fehler behandeln :
I IF
is error
I THEN fehlertext : = errormessage;
I
IF fehlertext
"" THEN neu (fehlermeldung, nix) FI;
I
c lear error
I ELSE fehlertext :=
editor paket
21/27
Zeile
****
E LAN
1.8 ****
EUMEL
me.rki"rungjustieren
1322
zeilebereitstellen
+
1323
1324
hinterletztemsatz
1325
1326
1327
1328
1329
1330
1331
al tesfeldnachberei ten
Izeile bereitstellen
I
(file) rr
I
Ihinter letztem satz
IF hinter letztem satz THEN insert record
lineno (file) ) lines (file) .
Ial tes feld nachberei ten :
I IF
old line update AND lineno (file) () old lineno
I THEN IF
verschoben <) 0
I
THEN verschoben := 0; konstanten neu berechnen;
I
FI ;
I
INT CONST alte zeilennr : = old lineno - bildanfang + 1;
I
IF
al te zellennr ) 0 AND al te zellennr <= attuelle
I
bildlaenge
I
THEN INT CONST m : = marke;
I
IF
lineno (file) < old lineno
I
THEN marke : = 0
I
ElIF old lineno = bildms.rke
I
THEN marke := min (feldms.rke, LENGTH old. satz + 1)
I
ElSE marke := min (marke,
LENGTH old satz + 1)
I
FI ;
I
zeile := blldrand + alte zeilennr;
I
feldout (old satz, 0); marke := m
I
FI
I FI;
I old line update : = F~E; old satz : =
I
feldla.engeeinstellen
1355
1356
1357
zelleedi tieren
21/28
I
I
I
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
+
Ims.rkierung justieren :
I IF
bildmarke) 0
satznr < = bildmarke
I THEN IF
I
THEN bildms.rke : = sa tznr;
I
ste Ue : = III8.X (stelle, feldms.rke);
I
ms.rke : = feldms.rke
I
ELSE ms.rke . - 1
I
FI
I FI.
I
I
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1358
1359
1360
1361
1362
edi tor paket
I rr.
I
I
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
10.11.86
Ifeldla.enge ein.teUen
I INT CONST alte l&enge : = laenge;
I IF
zeilennr) kurze bildlaenge
I THEN laenge : = kurze feldlaenge
I ElSE laenge := feldlaenge
I FI;
I IF
laenge < > al te laenge
I THEN konstanten neu berechnen
I FI.
I
I
Izeile editieren :
I zeile:= bildrand + zeilennr;
I exec (PROC (TEXT VAR, TEXT CONST) feldeditor, file, reservierte
I
tasten);
I old line no : = satznr;
I IF
markiert oder verschoben
I THEN old line update := TRUE; read record (file, old satz)
I FI.
I
edi tor paket
21/28
Zeile
E LAN
EUMEL
1.8
****
10.11.86
1363
1364
m&rk1ertoderverschoben Im&rk1ert oder verschoben
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
kommandoausfuehren
ed1 tor paket
mark1ert COR verschoben () 0 .
I
I
+
1375
1376
1377
1378
Ikommando ausfuehren :
I getchar (b1ldzeichen);
I SELECT pos (kolMl&ndos, b1ldzeichen) OF
I
CASE x hop
hop kommando verarbe1ten
I
CASE x esc
esc kommando verarbeiten
I
CASE x up
zum vorigen sa tz
I
CASE x down
zum folgenden satz
I
CASE x rubin
zeicheneinfuegen umsch<on
I
CASE x mark
m&rkierung umsch<en
I
CASE x cr
eingerueckt mit cr
I
-ws- *)
I
CASE x inscr
eingerueckt zum folgenden satz
I
CASE x abscr
zum anfang des folgenden satzes
I
I
I
(*
08.06.81
END SELECT •
1379
1380
1381
1382
1383
1384
1385
1386
1387
kommandos
Ikommandos
I LET x hop
• 1,
I
x down
3,
I
x cr
5,
I
x abscr 7,
I
x esc
• 9;
1388
1389
1390
1391
zeicheneinfuegenumscha Izeicheneinfuegen umsch&l ten
I rubin segment in ueberschr1ft eintragen;
I neu (ueberschrift, nix) .
1392
1393
1394
rubinsegmentinuebersch Irubin segment in ueberschr1ft e1ntragen :
I repl&ce (ueberschrift text, 9, rubin segment)
1395
1396
1397
rub1nsegment
1398
1399
1400
1401
1402
1403
1404
1405
1406
hopkommandoverarbeiten Ihop komm&ndo verarbe1ten :
I getch&r (bildzeichen);
I read record (file, bildsa tz) ;
I SELECT pos (hop kommandos, bildzeichen) OF
I
CASE y hop
nach oben
I
CASE y cr
neue se i te
I
CASE Y up
zurueckblaettern
I
CASE Y down
wei terblaettern
I
CASE Y tab
put tabs (f1le, tabulator); neu (ueberschr1ft,
I
nix)
I
CASE Y rubout
zeile loeschen
I
CASE Y rubin
zeileneinfuegen umsch<en
x up
• 2,
x rubin 4,
x ma.rk
6,
x inscr • 8,
I
I ""1""3""10""11""13""16""17""16""27""
I
I
I
I
I
I
lrubin segment :
I IF einfuegen THEN "RUBIN" ELSE "
" FI .
I
I
1407
1408
1409
1410
1411
1412
1413
1414
1415
21/29
hopkomm&ndos
I
I
I
END SELECT •
Ihop kommandos
I LET y hop
I
Y tab
I
y rubin
I
y cr
1,
Y up
3,
5,
Y down
= 4,
Y rubout • 6,
• 2,
7;
ed1 tor paket
21/29
Zeile
E LAN
EUMEL
1.8
I
I
I
I
1416
1417
"W
---
10.11.86
edi tor pa.ket
""1""3""9""10""11""12""13"".
1419
1420
1421
1422
1423
1424
1425
ze1leneinfuegenumschal Izeileneinfuegen umschal ten
I zeileneinfuegen: = NOT zeileneinfuegen;
I IF
zelleneinfuegen
I THEN zeile aufspalten; logisches eof setzen
I EISE leere zeile am ende loeschen; logisches eof loeschen
I FI; restbild zeigen .
1426
1427
1428
1429
143e
zeileaufspalten
1431
loescheggftrennendebla Iloesche ggf trennende blanks und spalte zeile:
I
-bk- .)
I INT VAR first non blank pos : = stelle;
I WHILE first non blank pos <= length (b1ldsatz) CAND
I
(bildsatz SUB first non blank pos) = blank REP
I
first non blank pos INCR 1
I
I
Izeile
aufspalten
I IF
stelle <= LENGTH b1ldsatz OR stelle. 1
I THEN loesche ggf trennende blanks und spal te zeile
I
I
FI.
I
+
1432
1433
1434
1435
(- 26.06.~
1436
I
PER;
1437
I
I
I
I
I
split line and indentation;
(-sh-)
first non blank pos : = stelle - 1;
WHILE first non blank pos >= 1 CAND
(bildsatz SUB first non blank pos)
first non blank pos DECR 1
I
PER;
I
I
bildsatz: = subtext (bildsatz, 1, first non blank pos);
wri te record (file, bildsatz) .
I
1438
1439
1440
1441
1442
1443
1444
1445
blank REP
I
I
1446
1447
1448
splitlineandindentatio Isplit line and indentation:
I split line (file, first non blank pos, TRUE) .
1449
1450
1451
1452
logischeseofsetzen
1453
1454
1455
1456
14"
leerezeilea.mendeloesch Ileere zeile a.m ende loeschen :
I to line (file, lines (file));
I IF len (file) = 0 THEN delete record (file) FI;
I to line (file, satznr) .
1458
1459
1460
logischeseofloeschen
1461
1462
1463
1464
1465
1466
21/3e
I
I
Ilogisches eof setzen :
I down (file); col (f1le, 1);
I set range (file, 1, 1, old range); up (file) .
I
I
I
I
Ilog1sches eof loeschen :
I col (file, stelle); set range (file, old range) .
I
restbildzeigen
I
Irestbild zeigen :
I erster neusatz : = satznr;
I letzter neusatz : = bildanfang + blldla.enge - 1;
I rest segment in ueberschrift eintragen;
I neu (ueberschrift, abschnitt) .
I
edi tor pa.ket
21/3e
Zeile
E LAN
EUMEL
****
1.8
edi tor pe.ket
10.11.86
Irest segment in ueberschrift elntragen :
I replace (ueberschrift text. feldlaenge
I
I
Irest segment :
I IF zeilenelnfuegen THEN "REST" ELSE "
I
I
1467
1468
1469
restsegmentinueberschr
1470
1471
1472
restsegment
1473
1474
1475
esckommandoverarbeiten lese kommando verarbeiten :
I getchar (bildzelchen);
I eventuell zeichen zurueckllelsen;
I
I
I
I
I
I
I
1476
1477
1478
1479
1400
1481
I
I
I
I
erlaubtetaste
1487
zulaessigezeichen
1488
1489
benutzerwarnen
1490
1491
1492
endenachqui t
1493
1494
tasteistreserviert
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
festvordefinierteescfu
1509
1510
1511
1512
1513
1514
1515
1516
esckommandos
21/31
IF
THEN
ELSE
FI;
• FI .
(* 04.eO.65
*)
taste ist reserviert
belegte taste ausfuehren
fest vordefinierte esc funktlon
ende nach quit.
(. 04.0~.8li
eventuellzeichenzuruec leventuell zelchen zuruecklleisen :
1482
1483
1484
1485
1486
-IIS-
- 2~. rest segment) .
-IIS-
*)
IF
Nar write access CAND Nar erlaubte taste
THEN benutzer lIarnen; LEAVE kommando ausfuehren
FI.
I
I
Ierlaubte
taste
I
Izulaessige zeichen
I
Ibenutzer lIarnen
I
I
Iende nach quit:
I IF max used editor
I
I
ltaste ist reserviert
I
I
pos (zulaessige zeichen. bildzeichen)
>
0 .
res + ""1 ""2""8""27"brq"
out (piep) .
< my highest editor THEN LEAVE bildedi tor FI .
pos (res, bildzeichen) > 0 .
fest vordefinierte esc funktion :
read record (file. bildsatz) ;
SELECT pos (esc kommandos. bildzeichen) OF
CASE z hop
lernmodus umschal ten
CASE z esc
kOllll18.ndodialog versuchen
CASE z left
zum vorigen lIort
CASE z right
zum naechsten lIort
CASE z b
bild an aktuelle zeile angleichen
CASE z f
belegte taste ausfuehren
CASE z rubout
markiertes vorsichtig loeschen
CASE z rubin
v',rsichtig geloeschtes einfuegen
OTHERWISE
belegte taste ausfuehren
END SELECT •
Iesc kommandos
I LET z hop
1.
I
z left
3.
z rubout
5,
I
z b
7.
I
I
I ""1""2""8""11""12""27"bf"
I
edi tor paket
z right
z rubin
•
z esc
•
z f
2.
4.
6.
8;
21/31
ZeUe
E LAN
1517
1518
1519
1520
1521
1522
zumvorigenwort
1523
1524
1525
vorgaengererlaubt
1526
1527
zumnaechstenwort
+
1528
1529
1.8 ****
EUMEL
nichtaut'letztemsatz
edi tor paket
10.11.86
Izum vorigen wort :
I IF vorgaenger erlaubt
I
I
I
I
I
THEN vorgaenger; read record (file, bildsatz);
stelle:. LENGTH bildsatz + 1; push (esc + left)
FI.
Ivorgaenger erlaubt
I satznr ) III&X (1, bildmarke)
I
I
Izum naechsten wort
IF nicht auf letztem satz THEN weitersuchen wenn nicht gefunden FI
I
I
I
I
Inicht auf letztem satz
line no (file) < lines (file) .
I
I
~~
1531
1532
1533
1534
1535
1536
1537
wei tersuchenwennnichtg lwei tersuchen wenn nicht gefunden :
I nachfolgenden satz holen;
I IF
(nachfolgender satz SUB anfang) • blank
I THEN push (abscr + esc + right)
I ELSE push (abscr)
I FI.
1538
1539
1540
nachfolgendensatzholen I nachfolgenden satz holen :
I down (file); read record (file, nachfolgender satz); up (file) .
1541
1542
1543
1544
1545
bUdanaktuellezeileang IbUd an aktuelle zeUe angleichen :
I anfang INCR verschoben; verschoben . = 0;
I margin segment in ueberschrift eintragen;
I neu (ueberschrift, bUd) .
1546
1547
1548
marginsegmentinuebersc lmargin segment in ueberschrift eintragen :
I replace (ueberschrift text, 2, margin segment)
1549
1550
1551
1552
1553
1554
1555
marginsegment
1556
1557
belegtetasteausfuehren Ibelegte taste ausfuehren :
I kommando analysieren (bildzeichen, PROC(TEXT CONST) kolllll&lldo
I
interpreter) .
+
1558
1559
1560
1561
1562
1563
1564
21/32
I
I
I
I
I
I
I
I
Imargin segment :
I IF anfang <= 1
I THEN" •..... "
I ELSE TEXT VAR margin text : = "M" + text (anfang);
I
(6 - LENGTH margin text) * ft ft + margin text
I Fl.
I
I
I
I
komma.ndodialogversuche Ikommandodialog versuchen:
I IF fenster ist zu schmal fuer dialog
I THEN kommandodialog ablehnen
I ELSE komma.ndodialog fuehren
I FI.
I
editor paket
21/32
Zelle
E LAN
EIlMEL
1.8
****
19.11.86
ed1 tor pa.ket
1565
1566
fenster1stzuschmalfuer Ifenster ist zu schmal fuer dialog
I
1567
1568
1569
konunandodialogablehnen Ikonunandodialog ablehnen
I fehlertext: z ~zu schmal fuer ESC
I
1579
1571
1572
1573
1574
1575
1576
1577
1578
1579
1589
1581
1582
konunandodialogfuehren
+
160~
+
1696
1697
1698
1699
1619
1611
1612
1613
1614
1615
1616
1617
1618
1619
21/33
28 .
ESC~;
neu (fehlermeldung, nix)
I
Ikonunandod1alog fuehren:
I INT VAH xe, xl, x2, x3, y;
I get cursor (xe, y);
I cursor (rand + 1, bildrand + zeilennr);
I get cursor (xl, y);
lout (begin mark); out (monitor meldung);
I get cursor (x2, y);
I (lunge - LENGTH monitor meldung - marklength) TIMESOUT blank;
I get cursor (x3, y);
lout (end mark); out (blank);
I konunandozeile editieren;
I ueberschrift zeigen;
I absatz ausgleich : = 2;
I
(*sh*)
I IF konunandotext = ~~ THEN LEAVE kOlllllandodialog fuehren FI;
I konunando auf taste legen ("f~, konunandotext);
I konunando analysieren ("f", PROC(TEXT CONST) kommando interpreter)
I IF
fehlertext <> ""
I THEN push (esc + esc + esc + "k")
I ELIF markiert
I THEN ze lle neu
I FI.
I
I
kOll1lll&ndozeileedit1eren Ikommandozene editieren :
I TEXT VAH konunandotext : = "";
I cursor (xl, y); out (begin mark);
I disable stop;
I darstellung invertieren;
I editget schleife;
I darstellung invertieren;
I enable stop;
I cursor (x3, y); out (end mark);
I exec (PROC (TEXT CONST, INT CONST) feldout, file, stelle);
I cursor (xe, y)
I
I
1693
1694
1695
<
I
1583
1564
1585
1586
1587
1588
1589
1599
1591
1592
1593
1594
1595
1596
1597
1598
1599
1690
1691
lunge
darstellunginvertieren Idarstellung invertieren :
I TEXT VAH dummy := begin mark; begin mark :. end mark; end mark :.
I
dummy;
I invertierte darstellung : = NOT invertierte darstellung .
I
edi tgetschleUe
I
Iedi tget schleife :
I TEXT VAH exit char;
I REP
I
cursor (x2, y);
I
edi tget (konunandotext, max text length , rand + laenge - x cursor
I " " , "k?!", exit char);
I
neu (ueberschrift, nix);
I
IF exit char = ~~27"k"
I
THEN kommando text :: kOl!lll&ndo auf taste ("f")
I
ELIF exit char = ""27"?"
I
THEN TEXT VAH taste; getchar (taste);
I
kommando text :. kommando auf taste (taste)
edi tor pa.ket
21/33
Zoile
E LAN
EUMEL
1620
1621
1622
1623
+
1624
1625
1626
1627
1628
1629
1630
1631
1632
lstreserviertetaste
1633
1634
monitorneldung
1635
neueseite
I
I
I
I
I
I
I
I
I
I
I
I
I
I
••••
10.11.86
edi tor paket
ELIF exit char = ""27"!"
THEN getchar (taste);
IF
ist reserviarte taste
THEN set busy indicator;
(.sh.)
out ("FEfll,ER: """ + taste + """ ist reserviert"7"")
ELSE kommando auf taste legen (taste, kOllll1&ndotaxt);
kommandotext : = ow; LEAVE edi tget schleife
FI
ELSE LEAVE edi tget schleife
FI
PER •
list reservierte taste
I
Imoni tor meldung
pos (res, taste) ) 0
"gib kommando : • .
I
+
I
Ineue seite
I
bild)
bildanfang:= satznr; zeilennr
.= 1; neu (akt satznr,
I
I
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
lIei terbl&ettern
1654
1655
1656
1657
1658
1659
1660
1661
1662
zurueckblaettern
1663
1664
1665
1666
1667
1668
1669
1670
1671
zeileloeschen
21/34
1.8
Ilieiterblaettern
I INT CONST akt bildlaenge := aktuelle bildlaenge;
I IF
nicht auf letztem satz
I THEN erster neusa tz : = sa tznr;
I
IF
zeilennr)= akt bildlaenge
I
THEN blldanfang INCR akt blldlaenge; neu (akt satznr, blld)
I
FI ;
I
satznr := min (lines (file), blldanfang + akt bildlaenge - 1);
letzter neusa tz : = satznr;
I
tol1ne (file, satznr) ;
I
stelle DECR verschoben;
I
neu (akt satznr , nix);
I
zellennr :. satznr - bildanfang + 1;
I
IF markiert THEN neu (nix, abschnitt) FI;
I
einrueckposition bestimmen
I
I FI.
I
I
Izurueckblaettern
I IF
vorgaenger er l&ubt
zellennr ( = 1
I THEN IF
I
THEN bildanfa.ng : = max (1, bildanfang - aktuelle bildlaenge);
I
neu (akt satznr, bild)
FI ;
I
nach oben; einrueckposition bestimmen
I
I FI.
I
I
Ize ile loeschen :
I IF
stelle = 1
I THEN delete record (file);
erster nausa tz : = sa tznr;
I
letzter neusa tz : = bildanfang + bildlaenge - 1;
I
nau (nix, abschnitt)
I
I ELSE zeilen rekombinieren
I FI .
I
edi tor paket
21/34
Zeile
E LAN
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
zeilenrekombinieren
1684
1685
1686
&ktuellensatzmitblanks I&ktuellen satz mit blanks auffuellen
I blldsa tz AUFFUELLENMIT blank .
1687
1688
1689
1690
nachfolgendensatzlesen Inachfolgenden satz lesen :
I TEXT VAR nachfolgender satz;
I read record (file, nachfolgender satz) .
1691
1692
1693
1694
nachfolgendersatzohnef Inachfolgender satz ohne fuehrende blanks:
I satzrest: = subtext (nachfolgender satz,
I
einrueckposi tion (nachfolgender satz»; satzrest .
1695
1696
1697
1698
1699
1700
1791
1792
1793
1704
1705
1706
1707
zell..aufspli tten
1706
1709
1710
1711
1712
1713
naechstenonblankposi ti Inaechste non blank position :
I INT VAR non blank pos : = stelle;
I WHILE (bildsatz SUB non blank pos) • blank REP
I
non blank pos INCR 1
I PER; non blank pos .
1714
1715
zumvorigensatz
1718
1719
1720
1721
21/35
1.8
Izeilen
I IF
I THEN
I
I
I
I
I
I
I
I FI.
••••
10.11.86
edi tor pa.ket
rekombinieren :
nicht auf letztem satz
&ktuellen satz mit blanks auffuellen;
delete record (file);
nachfolgenden satz lesen;
bildsatz CAT nachfolgender satz ohne fUehrende blanks;
wri te record (file, bildsa tz) ;
ers tar neusa tz : = sa tznr;
letzter neusatz : = blldanfang + blldl&enge - 1;
neu (nix, abschnitt)
I
I
I
I
I
I
I
I
zeile aufspl1 tten :
nachtolgender satz :. ""';
INT VAR i;
FOR i FROM 2 UPTO min (stelle, einrueckposit1on (b11dsatz» REP
nachfolgender sa tz CAT blank
PER;
satzrest :. subtext (blldsatz, naechst.. non blank position);
nachfolgender satz CAT satzrest;
blldsatz := subtext (bildsatz, 1, stelle - 1);
wri te record (file, bildsatz);
down (file); insert record (file);
write record (file, nachfolgender satz); up (file) .
I
I
1716
1717
EUMEL
zUlDfolgendensatz
Izum vorigen satz :
I IF vorgaer.ger erlaubt THEN vorgaenger; einrueckposition bestimmen
I
FI .
I
I
Izum folgenden satz :
(. 12.09.85
-ws- .)
I IF nachfolger erlaubt THEN nachfolger; einrueckposi tion besti...en
I
ELSE col (file, len (f11e) + 1); neu (nix,
I
nix)
I
I
I
FI.
edi tor pa.ket
21/35
Zelle
1722
+
1723
1724
1725
1726
1727
1728
1729
E LAN
EUMEL
1.8
••••
10.11.86
edl tor paleet
elnrueckposltionbestim lelnrueckposition bestimmen :
I
-ws- .)
I read record (fl1e, akt bildsatz);
I INT VAR neue einrueckposi tion : = einrueckposi tion (akt bildsatz);
I IF
akt bildsatz ist leerzeile
I THEN al te einrueckposit10n : = max (stelle, neue elnrueckpos1 t10n)
ELSE
alte
einrueckposi tion : = min (stelle, neue einrueckposi tion)
I
I FI •
I
I
173El
1731
1732
aktbl1dsatzistleerzeil lakt b11dsatz 1st leerzel1e
I akt bildsatz = flfl OR akt bild.atz • blank .
1733
1734
1735
zumanfangdesfo~endens
1736
1737
1738
nachfo~ererlaubt
1739
1740
eingeruecktm1 tcr
I
I
Izum anfang des fo~enden satzes :
I IF nachfo~er erlaubt THEN nachfo~er; stelle . = anfang FI •
I
I
lnachfo~er
I
I
I
leingerueckt mit cr :
I IF NOT nachfo~er erlaubt THEN LEAVE eingerueckt mit cr FI;
+
I
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
I
I
+
1752
1753
1754
1755
1756
1757
1758
1759
1760
b11dsatz1stleerze11e
1761
eingeruecktzumfo~ende
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
21/36
erlaubt
write access COR nicht auf letztem satz .
(••h-)
read record (file, bildsatz) ;
INT VAR epos := einrueckposition (b11dsatz);
nachfo~er; col (file, 1);
IF
eof (file)
THEN IF
LENGTH bildsatz ( = epos
THEN stelle : = alte e1nrueckposl tlon
ELSE stelle := epos
FI
ELSE read record (file, blldsatz) ;
stelle := einrueckposition (bildsatz);
IF
bildsatz 1st leerzeile
-ws- -)
THEN stelle := alte elnrueckposition;
aktuellen satz mit blanks auffuellen
FI
FI ;
alte e1nrueckposition .= stelle.
Ib11dsatz ist leerzeile :
I blldsa tz = flO OR bildsa tz = blank .
I
I
le"llgerueckt zum fo~enden satz :
(.sh-)
IF NOT nachfo~er erlaubt OR NOT wr1te access
THEN LEAVE e1ngerueckt zum fo~enden satz
I FI;
I alte einrueckpos1tion merken;
I naechsten satz holen;
I neue einrueckposition bestimmen;
I alte e1nrueckpos1t10n := stelle .
I
I
I
I
I
altee1nrueckposlt10nme lalte e1nrueckpos1tlon merken :
I read record (flle, bildsatz) ;
I epos:= elnrueckpos1t10n (b11dsatz);
editor paleet
21/36
Zeile
E LAN
1.8 ****
EUMEL
1773
1774
1775
1776
1777
1778
1779
I
I
aufaufuehlungpruefen
1staufzaehlung
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
vorherabsatzzeile
1800
1801
1802
1803
wortfolgt
1820
1821
1822
1823
21/37
auf aufuehlung pruefen;
IF epos ) LENGTH b11dsatz THEN epos
.=
anfang Fl.
lauf aufzaehlung pruefen
I BOOL CONST aufzaehlung gefunden . =
I
1st aufuehlung CAND vorher absatzzeile CAND wort folgt;
I IF
aufuehlung gefunden THEN epos := anfang des naechsten worts.
I
FI .
list aufuehlung
lINT CONST wortende .= pos (bildsatz, blank, epos, epos + 20) - 1;
I SELECT pos (' -*) . : ' , bildsatz SUB wortende) OF
I
CASE 1,2
wortende
epos
I
CASE 3,4
wortende <= epos + 7
I
CASE 5
TRUE
I
OTHERWISE: FALSE
I ENDSELECT.
I
I
Ivorher
I IF
I THEN
I EISE
I
I
I
I
I Fl.
absatzzeile
satznr = 1
TRUE
up (file);
INT CONST vorige sa tzlaenge : = len (file);
BOOL CONST vorher war absatzzelle :.
subtext (file, vorige satzlaenge, vorige satzlaenge) • blank;
down (file); vorher war absatzzelle
I
I
Iwort folgt
I INT CONST anfang des naechsten wortes : =
I pos (bildsatz, "33"', '"254'", wortende + 1);
I anfang des naechsten wortes ) wortende .
I
I
1804
+
ed1 tor pa.ket
I
I
1781
1782
1783
1784
1785
1786
1787
1788
1789
1815
1816
1817
1818
1819
****
I
I
1780
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
10.11.86
naechstensatzholen
Inaechsten satz holen :
I nachfolger; col (file, 1);
I IF
eof (file)
I THEN bildsa tz : = '"
I EISE IF
neue zeile einfuegen erforderlich
I
THEN 1nsert record (file); b1ldsatz := "";
I
letzter neusa tz : = bildanfang + bildlaenge - 1
I
ELSE read record (file, b1ldsatz);
I
letzter neusatz := satznr;
I
ggf trennungen zurueckwandeln und umbruch indikator
I
einfuegen
I
FI ;
I
erster neusatz := satznr;
I
neu (nix, abschni ttl
I
I
I
FI.
neuezelleeinfuegenerfo Ineue ze1le einfuegen erforderl1ch :
I BOOL CONST war absatz :. war absatzzelle;
I war absatz COR neuer satz ist zu lang .
I
ed1 tor pa.ket
21/'37
Zeile
E LAN
EUMEL
1.8 ---
10.11.86
edi tor paket
1824
1825
1826
1827
warabsa tzze ile
1828
1829
neuersatzlstzulang
1830
1831
1832
1833
1834
1835
l&engedesneuensa tzes
1836
1837
upb&ckcr
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
Wl
1852
1853
ggt'trennungenzurueckwa Iggt' trennungen zurueckwande1n und umbruch indikator eint'uegen
I LET trenn k
= ww22E)ww,
I
trenn strlch = wW221 ww;
I TEXT VAH umbruch indikator;
IF
1etztes zelchen 1st trenn strlch
THEN entferne trenn strich;
IF
1etztes zeichen = trenn k
THEN wand1e trenn k um
FI ;
umbruch lndikator := up b&ckcr
ELIF 1etztes umgebrochenes ze1chen 1st k&njl
THEN umbruch indikator : = up b&ckcr
ELSE umbruch indlkator : = blank + up b&ckcr
IT;
ch&nge (kollllll&ndo, wl, w1+1, umbruch indikator)
1854
letztesumgebrochenesze Iletztes umgebrochenes zeichen ist kanji
I
w1-1).
I
+
1855
Iwar absa tzze 11e :
I INT VAH w1 : = pos (kommando, up b&ckcr, komma.ndo zelger);
I w1 = 0 COR (kommando SUB (w1 - 1» • blank .
I
I
Ineuer satz ist zu lang
I
I
11aenge
I IF
I THEN
I ELSE
I Fl.
I
I
1aenge des neuen satzes
)=
11mi t .
des neuen sa tzes
len (t'11e) ) 0
len (f11e) + w1
w1 + epos
Iup b&ckcr
I
wW3 ww 2E)ww.
I
withln kanJl (kollllll&ndo,
I
1856
1857
1858
1859
1860
letzteszelchenlsttrenn Iletztes zelchen ist trenn strich :
I TEXT CONST last ch&r : = 1etztes zelchen;
I last char
trenn strich COR
I last char = w_w CAND wl ) 2 CAND (kommando SUB (wl-2)) () blank .
1861
1etzteszelchen
1862
1863
entfernetrennstrich
wandletrennkum
I
I
Iletztes zeichen
I
Ientferne trenn strlch
I
Iwand1e trenn k um
I
Iloesche 1ndikator
I
kommando SUB (wl-1) .
delete char (kollllll&ndo, wl-1); wl DECR 1
replace (kommando, wl-1, WCW)
1864
1865
loeschelnd1kator
delete char (komm&ndo, wl) .
1866
1867
1868
1869
1870
1871
1872
1873
neueeinrueckpositionbe Ineue einrueckposition bestimmen :
I IF
aut'zaehlung gefunden CAND bildsatz 1st leerzeile
I THEN stelle : = epos
I ELIF NOT bildsatz ist leerzeile
I TIIEII stelle := elnrueckpos1tlon (blldsatz)
I ELIF war absatz COR auf 1etztem satz
I THEN stelle : = epos
I ELSE down (t'ile); read record (f11e, nachfolgender sati);
I
21/38
eeli tor peket
21/38
Zaile
E LAN
EIlMEL
1.8 ._.
10.11.86
edt tor paleet
up
(file); stelle : = e1nrueckpos1 t10n (l1&Chfo~ender setz)
FI;
I IF
ist einfuegender aber nicht 1nduzierter umbruch
I THEN loesche indika tor;
I
umbruchstelle : = stelle + III - kOllllll&ndo zeiger - anzahl der
I
stz;
I
umbruchverschoben :. 0
I Fl.
1874
1875
1876
1877
1878
I
I
1879
1880
1881
I
I
1882
1883
aut'letztemsa tz
Iauf letztem sa tz
NOT nicht auf letztem satz .
1884
1885
1886
1887
isteinfuegenderabern1c 11st einfuegender aber nicht 1nduzierter umbruch :
I wI: = pos (kolllll&ndo, backcr, kornma.ndo ze1ger);
I Ill) 0 CAND (kommando SUB (Ill - 1)) () up char
1888
1889
anzahlderstz
I
I
I
I
189EJ
+
1891
1892
Ianzahl der stz :
I TEXT CONST umgebrochener anfang .' subtext (kommando, kommando
I
ze1ger, 111-1);
I INT VAR anz := 0, anf := pos (umgebrcchener anfang, ""1"", ""31 WW ,
I
1);
I WHILE anf ) 0 REP
I
anz INCH 1; anf .= pos (umgebrccbener ant'ang, nl n , ""31"", ant'
I
1893
1894
I
+ 1)
PER; anz .
I
I
1895
1896
1897
1898
1899
1900
1901
1902
1903
markiertesvorsicht1g10 Imarkiertes vorsichtig loeschen :
I IF
wri te access CAND markiert
I THEN c lear removed (file);
I
IF
nur im satz mark1ert
I
THEN behandle einen satz
I
ELSE behandle mahrere saetze
I
FI
I Fl.
1904
1905
nur1msatzmarkiert
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
behandlee1nensatz
21/39
I
I
Inur im satz markiert
line no (file)
blldmarke.
I
I
Ibehandle e1nen satz :
I 1nsert record (file);
I satzrest:= subtext (bildsatz, marke, stelle - 1);
I write record (file, satzrest);
remove (file, 1);
change (blldsatz, marke, stelle - 1, "");
stelle : = marke;
marke := 0; bildmarke := 0; feldmarke :. 0;
markiert :. FALSE; mark (file, 0, 0);
konst&nten neu berechnen;
IF
bildsatz = ""
THEN delete record (file);
erster neusetz : = satznr;
letzter neusatz : = bildanfang + bildlaenge - 1;
neu (nix, abschni tt)
ELSE wr1 te record (file, bildsa tz) ;
neu (nix, bildze 11e )
FI .
edi tor palest
21/39
Zeile
E LAN
1.8
EUMEL
1925
1926
1927
1928
1929
1930
1931
1932
behandlemehreresaetze
1933
1934
1935
1936
1937
1938
1939
1940
1941
zeileanaktuellerstelle
1942
nichtamanfangderzeile
••••
10.11.86
edi tor paket
lbehandle mehrere saetze :
erster neusatz :. bildmarke;
letzter neusatz := bildanfang + bildlaenge - 1;
zeile an aktueller stelle auftrennen;
ersten markierten satz an markieranfang autspalten;
marklerten bereich entternen;
I bild anpassen .
I
I
I
I
I
I
I
Izeile an aktueller stelle auttrennen :
I INT VAR markierte saetze :. line no (tile)
I IF nicht am ende der zeile
I THEN IF nicht am anfang der zeile
I
THEN zeile aufspli tten
I
ELSE up (tile); marklerte saetze DEeR
I
FI
I FI.
I
I
Inicht
- bildmarke + 1;
1
am anfang der zeile
stelle) 1 .
am ende der zeile
stelle (= LENGTH bildsatz
I
Inicht
I
I
1943
1944
nlcht&mendederzeile
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
erstenmarkiertensatzan lersten markierten satz an markieranfang aufspalten :
I to line (file, line no (file) - (markierte saetze - 1»;
I read record (file, bildsatz);
I stelle:= feldmarke;
I IF nicht am anfang der zeile
I THEN IF nicht am ende der zeile
I
THEN zeile aufspli tten
I
ELSE markierte saetze DECR 1
I
FI
I
to line (file, line no (file) + markierte saetze)
I ELSE to line (file, line no (file) + marklerte saetze - 1)
I FI;
I read record (file, bildsa tz) .
1959
1960
1961
1962
1963
1964
1965
1966
markiertenbereichentfe
1967
1968
1969
1970
1971
1972
1973
1974
bildanpassen
1975
1976
1977
1978
1979
vorsichtiggeloeschtese
21/40
I
I
Imarkierten bereich entfernen
I zeilen nr := line no (file)
- marklerte saetze - bildanfang + 2;
I remove (file, markierte saetze);
I marke:= 0; bildmarke :. 0; feldmarke := 0;
I markiert:= FALSE; mark (f11e, 0, 0);
I konst&nten neu berechnen;
I stelle: = 1 .
I
I
Ibild anpassen
I satz nr : = line no (file);
I IF zeilen nr (. 1
I THEN bildanfang : = line no (fUe); zeUen nr : = 1;
I
neu (akt sa tznr, bild)
I ELSE neu (akt satznr, abschnltt)
I FI.
I
I
Ivorslchtig geloeschtes elnfuegen :
I IF NCYr wrl te access OR removed lines (fUe) = e
I THEN LEAVE vorsichtig geloeschtes e1nfuegen
I FI
I IF nur ein satz
ed1 tor paket
21/48
Zeile
E LAN
EUMEL 1.8 *-*
I
I
I
I
I
1980
1981
1982
1983
1984
nureinsatz
1986
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
+
2026
2027
2028
2029
2030
2031
2032
2033
2034
****
edi tor pa.ket
THEN in alctuellen satz einfuegen
ELSE alctuellen satz aufbrechen und einfuegen
FI .
Inur ein satz
removed lines (file)
=
1 .
I
I
1985
1987
1988
1989
1990
1991
1992
10.11.86
inaktuellensatzeinfueg lin aktuellen satz einfuegen :
I reinsert (file);
I read record (file, n&chfo~ender sdz);
I delete record (file);
I TEXT VAR t := bildsatz;
I bildsatz:= subtext (t, 1, stelle - 1);
I alctuellen satz mit blanks auffuellen;
I
(*sh*)
I bildsatz CAT n&Chfo~ender satz;
I satzrest:= subtext (t, stelle);
I bildsa tz CAT sa tzrest;
I wri te record (file, bildsatz) ;
I stelle INCR LENGTH n&ehfo~ender satz;
I neu (nix, bildzeile) .
alctuellensatzaufbreche
I
I
aktuellen satz aufbrechen und einfuegen :
INT CONST alter bild&nfang := bl1d&nfang;
old lineno := satznr;
IF
stelle = 1
THEN reinsert (file);
read record (file, bildsatz)
ELIF stelle ) LENGTH bildsatz
THEN down (file);
reinsert (file);
read record (file, bildsatz)
ELSE INT VAR von : = stelle;
WHILE (bildsatz SUB von) = blank REP von INCR 1 PER;
satzrest := subtext (bildsatz, von, LENGTH b11dsatz);
INT VAR bis : = stelle - 1;
WHILE (bildsatz SUB bls) = blank REP bis DECR 1 PER;
bildsatz := subtext (bildsatz, 1, bis);
write record (file, bildsatz);
down (file);
reinsert (f11e);
read record (file, b11dsatz) ;
nachfo~ender satz : = einrueckposi tion (blldsatz) * blank;
n&chfo~ender satz CAT satzrest;
down (file); insert record (fl1e);
wrlte record (file, n&chfo~ender 8atz); up (file)
FI ;
stelle := max (1, LENGTH bildsatz);
(* 22.06.84
-bk- *)
satz nr :. line no (file);
zeilennr INCR satznr - old 11neno;
zeilennr :. min (zeilennr, alctuelle bildl&enge);
bl1d&nfang := satznr - zel1ennr + 1;
IF
bildanfang veraendert
THEN abschnitt neu (blld&nfang, 9999)
ELSE abschnitt neu (old 11neno, 9999)
FI ;
neu (alct satznr, nix).
2035
21/41
edl tor palcet
21/41
EUMEL 1.8 _..
10.11.86
Zeile
E LAN
2036
2037
bild&nfangveraendert
2038
2039
2049
lernmodusumsch<en
2041
2042
2043
learnsegmentinuebersch Ilearn segment in ueberschrift eintragen :
I replace (ueberschrift text, feldlaenge - 19, learn segJlMlnt) .
2044
learnsegment
Ibildanfang veraendert
edi tor paleet
bild&nfang () alter bildanfang .
I
I
Ilernmodus umschal ten :
I learn segment in ueberschrlft eintr&6en; neu (ueberschrift, nix) .
I
I
I
I
204~
Ilearn segment :
I IF lernmodus THEN wLEARN w ELSE w..... w FI .
2046
I
2047
2048
marklerungumsch&l ten
2049
20~
markierungelnsch&l ten
2051
20:12
2053
20~4
2055
2056
20:17
2058
2059
2060
2061
2062
2063
marklerungaussch&l ten
I
lmarkierung umschal ten
I IF markiert THEN markierung aussch<en ELSE markierung
I
elnschalten FI .
I
I
Imarklerung elnsch&l ten
I bildmarke:= satznr; feldmarke .- marke; markiert := TRUE;
I mark (file, bildmarke, feldmarke);
I neu (nix, bildzeile) .
I
I
2064
Imarklerung aussch&l ten
I erster neusatz := max (blldmarke, b11danfang);
I letzter neusa tz : = satznr;
I bildmarke:= 0; feldmarke := 0; markiert := FALSE;
I mark (f11e, 0, 0);
I IF
erster neusatz = letzter neusatz
I THEN neu (nix, bildzeile)
I ELSE neu (nix, abschnitt)
I FI.
lEND PROC bildeditor;
206~
I
2066
2067
2068
2069
2070
2071
neu ...................... IPROC neu (INT CONST ue bereich, b bereich) :
I ueberschrlftberelch: = max (ueberschr1ftberelch, ue bereich);
I bildbereich. - max (bildbereich, b bereich)
lEND PROC neu;
2072
2073
2074
2075
2076
2077
2078
2079
nacho ben ................. IPROC Mch oben :
I letzter neusatz . - satznr;
I satznr: = max (bildanfang, bildmarke);
I toline (file, satznr);
I stelle DECR verschoben;
I zeilennr: = satznr - bildanfang + 1;
I erster neusatz : = satznr;
I IF
markiert
I THEN neu (akt sa tznr, abschnit t)
I ELSE neu (akt satznr, nix)
I FI
lEND PROC nach oben;
208@
2081
2082
2083
2084
21/42
I
I
I
editor palee t
21/42
Zeile
2085
2086
2087
2088
E LAN
EUMEL
edi tor p&ket
vorgaenger ............... Imoc vorgaenger :
I up (file); satznr DEeR 1;
I marke:. 0; stelle DEeR verschoben;
I IF ze ilennr = 1
I THEN bildanCang DEeR 1; neu (ue berschr itt, blld)
I ELSE zeilennr DEeR 1; neu (akt satznr, nix);
I
I
I
2099
2100
2101
2102
(*sh*)
IF markiert THEN neu (nix, bildzeile) FI
FI
IEND PIIOC vorgaenger;
I
moc
nacbColger. . . . . . . . . . . . . ..
Mchfolger :
down (file); satznr INCR 1;
stelle DEeR verschoben;
IF
zeilennr = aktuelle blldlaenge
THEN bildanCang INCR 1;
IF
rollup erl&ubt
THEN rollup
ELSE neu (ueberschriCt, blld)
FI
ELSE neu (akt satznr, nix); zeilennr INCR 1
(*sh*)
FI
IF
markiert THEN neu (nix, blldzeile) FI •
2113
2114
2115
2116
2117
2118
rolluperl&ubt
2119
2120
2121
2122
2123
rollup
Irollup erl&ubt :
I kurze bildlaenge
maxl&enge AND kurze Celdlaenge
maxbreite.
I
I
Irollup
lout (down char);
I IF
bildzeichen = inscr
I THEN neu (ueberschrict, nix)
I ELIF is cr or down CAND (write access COR nicht auf letztem sa tz)
I
+
(*sh-)
I THEN neu (nix, blldzelle)
I ELSE neu (ueberschriCt, bildzeile)
I FI.
2124
2125
2126
2127
I
I
2128
2129
2130
2131
iscrordown
2132
2133
kOllllllLndochar
21/43
10.11.86
I
(*wk-)
I ELSE kurze bildlaenge
I FI
IEND PROC aktue lle blldl&enge;
I
+
2103
2104
2105
2106
2107
2108
2109
2110
Z11
2112
****
aktuellebildl&enge ....... lINT PROC aktuelle bildlaenge :
I IF stelle - stelle am anfang ( kurze feldlaenge
I
AND fe ldlaenge ) 0
I THEN bildlaenge
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
1.8
lis cr or down:
I IF konunando • •• THEN kommando : = inchety FI;
I komma.ndo char = down char COR kommando char • cr .
I
I
Ikommando char
konunando SUB kommando zeiger
I
editor p&ket
21/43
EUMEL
Zeile
E LAN
2134
2135
2136
n1chteufletztemsa tz
2137
2136
2139
2140
+
2141
2142
2143
2144
+
2145
2146
2147
2146
2149
2150
2151
2152
2153
2154
2155
1.8 ••••
10.11.86
Inicht
auf letztem sa tz
lEND PROC nachfolger;
ed1 tor paket
line no (file)
<
lines (file) .
I
nextincharetyis .......... IBOOL PROC next incharety is (TEXT CONST muster) :
I INT CONST klen : = LENGTH kommando - kommando zeiger + 1,
I
mIen : = LENGTH muster;
I INT VAR i; FOR i FROM 1 UPI'O mIen - klen REP kommando CAT 1nchety
I
PER;
I subtext (kommando, kommando zeiger, kommando zeiger + mIen - 1) =
I
muster
IEND PROC next incharety is;
I
quitlast ................. IPROC quit last:
(. 22.86.84
I
-bk- .)
I IF actual edi tor ) 0 AND actual editor < max used editor
I THEN verlasse alle groesseren editoren
I FI.
I
I
verlasseallegroesseren Iverlasse aIle groesseren editoren :
I open editor (actual edi tor + 1); quit
lEND PROC quit last;
I
quit ..................... 1PROC quit:
I IF actual editor ) 0 THEN verlasse aktuellen editor FI .
I
I
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
verlasseaktuellenedi to Iverlasse aktuellen editor :
I disable stop;
I INT CONST aktueller editor .' actual editor;
I in innersten editor gehen;
I REP
I
IF ze1leneinfuegen THEN hop rubin simulieren FI;
I
ggf bildschirmdarstellung korrigieren;
I
innersten editor schliessen
I UNTIL aktueller editor ) max used editor PER;
I actual editor :. max used editor .
2167
2168
ininnerstenedi torgehen
2169
2170
2171
hoprubinsimulieren
+
2172
2173
2174
2175
2176
2177
2178
2179
2160
21/44
innersteneditorschlies
I
I
Iin
I
I
innersten edi tor gehen
open editor (max used editor) .
hop rubin simulieren :
zeileneinfuegen : = FALSE;
leere zeilen am dateiende loeschen;
(.sh.)
ggf bildschirmdarstellung korrigieren;
logisches eof loeschen .
innersten editor schliessen
max used editor DEeR 1;
IF
max used editor) 0
THEN open editor (max used editor);
b1lde1nschraenkung aufheben
FI .
edt tor paket
21/44
Zeile
E LAN
EUMEL
1.8
**-
edi tor paket
10.11.86
I
I
2181
2182
2183
2184
logischeseofloeschen
2185
leerezeilenamdateiende Ileere zeilen &III dateiende loeschen
(* 15.08.Bl!
I
-ws- *)
I satz nr := line no (file) ;
I to line (file, lines (file»
I WHILE lines (file) ) 1 AND bildsatz 1st leerzeile REP
I
delete record (file);
I
to line (file, lines (file»
+
2186
2187
2188
2189
2190
2191
2192
2193
Ilogisches eof loeschen :
I col (file, stelle); set range (f11e, old range) .
I
I
I PER;
I
to11ne (file, satznr) .
I
I
2194
2195
2196
2197
2198
bildsatz1stleerzeile
2199
2200
2201
istleerzeile
2202
2203
ggfbildschirmdarstellu Iggf b11dsch1rmdarstellung korrigieren
I satz nr DECR 1;
(* fOr
I
Bildschirmkorrektur .)
I IF
satznr) lines (file)
I THEN zeUen nr DECR satz nr - lines (file);
I
satz nr := lines (file);
I
dateizustand retten
I FI.
+
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
Ibildsatz 1st leerzeile :
I TEXT VAR bildsatz;
I read record (f11e, bildsatz);
l i s t leerzeile .
I
I
11st leerzeile :
I bildsa tz • "" OR bildsatz • blank .
I
I
I
I
bildeinschraenkungaufh Ibildeinschraenkung aufheben
I laenge: = fe ldlaenge ;
I kurze feldlaenge : = feldlaenge;
I kurze b1ldlaenge := bildlaenge;
I neu (nix, bild)
lEND PROC quit;
I
2217
2218
n1chtsneu ............... ·IPROC n1chts neu
I
neu (n1x,
n1x)
END PROC nichts neo
2219
2220
satznrneu ................ IPROC satznr neu
I
neu (akt .atznr,
n1x)
END PROC satznr net
2221
ueberschr1ftneu .......... IPROC ueberschr1ft neu : neu (ueberschr1ft, n1x)
I
ueberschr1ft neu;
+
2222
2223
2224
2225
21/45
END PROC
I
zeUeneu ................. IPROC zeUe neu :
I INT CONST zene : = line no (file);
I abschnitt neu (zeile, ze11e)
ed1 tor paket
21/4:5
Zeile
E LAN
2226
2227
EUMEL
1.8
****
10.11.86
editor paket
lEND PROC zeile neu;
I
2228
2229
2230
2231
2232
2233
2234
2235
2236
abschnittneu ............. IPROC abschnitt neu (INT CONST von satznr, bis satznr) :
I IF von satznr <= bis satznr
I THEN erster neusatz := min (erster neusatz, von satznr);
I
letzter neusatz : = max (letzter neusatz, bis satznr);
I
neu (nix, abschnitt)
I ELSE abschnitt neu (bis satznr, von satznr)
I FI
lEND PROG abschn1tt neu;
2237
bildabschnittneu ......... IPROC bildabschnitt neu (INT CONST von zeile, bis zeile)
I
(*sh*)
I IF von zeile < = bis zeile
I THEN erster neusatz : = max (1, von zeile + bildanfang - 1);
1
letzter neusa tz : = min (bildl&enge, bis zeile + bildanfang -
+
2238
2239
2240
I
I
2241
2242
2243
22M
2245
2246
2247
2248
2249
1);
IF
von zeile < 1
I
THEN neu (ueberschrift, abschnitt)
1
ELSE neu (nix
, abschn1 tt)
1
IT
I ELSE bildabschnitt neu (bis zeile, von zeile)
I FI
lEND PROG bildabschnitt neu;
1
1
bildneu .................. IPROG bild neu
I
(*sh*)
2250
neu (nix, bild) END PROC blld neu;
1
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
bildneu ••..•..••...•..•.. IPROC bild neu (FILE VAR f) :
lINT CONST edi tor no : = abs (edi t1nfo (f) DIV 256;
1
IF
edi tor no ) 0 AND edi tor no <= max used edi tor
1
THEN IF
editor no = actual editor
1
THEN bild neu
1
ELSE editst&ck (editor no). blldst&tus. bildbereich : = bild
I
FI
1 FI
1END PROC bild neu;
2261
2262
2263
2264
2265
2266
2267
2268
2269
a11esneu
2270
2271
2272
satznrzeigen ............. 1 PROC satznr zeigen :
lout (satznr pre); out (text (text (11neno (file», 4»
IEND PROC satznr ze1gen;
21/46
editor paket
1
a11es neu :
neu (ueberschrift, blld);
1 INT VAR i;
1 FOR i FROM 1 UPTO max used editor REP
I
edits tack (i).bildstatus.b11dbere1ch .- bild;
I
ed1 tst&ck (i). bildstatus. ueberschr1ftbere1ch : = ueberschrUt
1
PER
1END PROG a11es neu;
••••••••••••••••• 1PROG
I
1
21/46
Zaile
E LAN
EUMEL
1.8
****
10.11.86
edi tor paket
2273
2274
2275
2276
2277
2278
;;279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
ueberschriftzeigen ....... IPROC ueberschrift zeigen :
I SELECT ueberschriftbereich OF
I
CASE akt satznr
satznr zeigen;
I
ueberschriftbereich : = nix
I
CASE ueberschrift
ueberschrift schreiben;
I
ueberschriftbereich : = nix
I
CASE fehlermeldung
fehlermeldung schreiben;
I
ueberschriftbereich . - ueberschrift
I END SELECT
IEND PROC ueberschrift zeigen;
I
fensterzeigen ............ IPROC fenster zeigen :
I SELECT bildbereich OF
I
CASE bildzeile :
I
zeile : = bildrand + zeilennr;
I
IF
line no (file) ) lines (file)
I
THEN feldout (ftft, stelle)
I
ELSE exec (PROC (TEXT CONST, INT CONST) feldout, file,
stelle)
FI
CASE abschni tt :
bild ausgeben
CASE bild :
erster neusatz ,: 1;
letzter neusa tz : = 9999;
bild ausgeben
OTHERWISE:
2301
2302
2303
2304
2305
LEAVE fenster zeigen
END SELECT;
erster neusatz : = 9999;
letzter neusa tz : = 0;
bildbereich : = nix
IEND PROC fenster zeigen
2306
I
2300
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
21/47
bildausgeben ............. IPROC bild ausgeben :
I BOOL CONST schreiben ist ganz einfach . - NOT markiert AND
I
verschoben = 0;
I INT CONST save marke : = marke,
I
save verschoben : = verschoben,
I
save laenge : = laenge,
I
act l1neno : = lineno (file),
I
von : = maX (1, erster neu ... tz - bildanfang + 1);
I INT VAR bis := min (letzter neusatz - bildanfang + 1,
I
bildlaenge) ;
I IF kurze feldlaenge (. 0 THEN bis :. min (bis, kurze bildlaenge)
I
FI;
I IF von ) bis THEN LEAVE bild ausgeben FI;
I verschoben: = 0;
I IF markiert
I THEN IF mark lineno (file) ( blldanfang + von - 1
I
THEN marke . - anfang
I
ELSE marke . - 0
I
I
I
FI
FI;
abschni tt loeschen und neuschreiben;
edi tor paket
21/47
Zeile
E LAN
1.8 ****
EUMEL
2325
2326
2327
2328
2329
I
I
I
I
10.11.86
****
edi tor pa.k.et
to line (file, act line no);
la.enge: = save la.enge;
verschoben: = save verschoben;
marke: = save marke .
I
I
2330
2331
markiert
Imarkiert
mark 11neno (fl1e) ) 0 .
2332
2333
2334
2335
2336
2337
abschnittloeschenundne labschnitt loeschen und neuschrelben :
I abschnitt loeschen;
I INT VAR line number : = bildanfang + von - 1;
I to line (file, line number);
I abschnltt schreiben .
2338
2339
2340
2341
2342
2343
2344
abschnittloeschen
2345
2346
2347
2348
bildrestdarfkomplettge Ibildrest darf komplett geloescht werden :
Ibis = ma.xlaenge AND kurze bildlaenge = ma.xla.enge
I
AND kurze feldlaenge = ma.xbrei te
2349
2350
2351
2352
2353
2354
2355
2356
2357
zeilenweiseloeschen
2358
2359
2360
2361
2362
2363
feldla.engeelnstellen
2364
2385
ganzezelleslchtba.r
2366
2367
abschnittschreiben
I
I
I
I
labschnitt loeschen :
I cursor (rand + 1, bildrand + von);
I IF
bildrest darf komplett geloescht werden
I THEN out (clear eop)
I ELSE zeilenweise loeschen
I
FI.
I
I
I
I
2368
2369
2370
2371
2372
2373
2374
2375
2376
21/48
Izeilenweise loeschen :
INT VAR i;
I FOR i FROM von UPI'O bis REP
I
check for interrupt;
I
feldla.enge einstellen;
I
feldrest loeschen;
I
IF 1 < bls THEN out (down char) FI
I PER.
I
I
I
Ifeldlaenge elnstellen :
I IF
ganze zene sichtba.r
I THEN laenge . - feldla.enge
I ELSE laenge : = kurze feldla.enge
I FI.
I
I
Iganze zelle slchtba.r
i <= kurze blldla.enge .
I
I
Iabschnitt schreiben :
I INT CONST last line :. lines (file);
I FOR 1 FROM von UPI'O bis
I WHILE line number <= last line REP
I
check for lnterrupt;
I
feldla.enge einstellen;
I
zeile schreiben;
I down (! 11e) ;
I
line number INCR 1
I PER.
I
edi tor pa.k.et
21/48
Zeile
2377
2378
2379
2380
2381
2382
E LAN
checkforinterrupt
2383
2384
2385
2386
EUMEL
1.8 ****
vorgaengererlaubt
2390
upcommand
2391
2392
2393
2394
2395
downcommand
2395
2397
n1chtletztersatz
2398
2399
2400
2401
2402
zeileschrelben
Fl.
I
I
Ivorgaenger erlaubt
I satznr) max (1, bildmarke)
I
I
lup command: next lncharety 1s (""3"") COR next 1ncharety is
I
I
I
(""1""3"")
Idown command
I next 1ncharety is (""10"") CAND bildl&enge < maxlaenge
I COR next incharety is (""1""10"") .
I
I
Inicht .letzter satz
Izeile schreiben :
I ze ile : = bildrand + i;
I IF
schreiben ist ganz einfach
I THEN exec (PROC (TEXT CONST, INT CONST) simple feldout, file, 0)
I ELSE zeile kompliziert schrelben
~~
I
IT
I
IF
~07
2408
2409
2410
~11
~12
2413
2414
act 11neno < lines (file) .
I
I
2404
2405
2405
I
I
line number
=
old 11neno THEN old 11ne update : = FALSE FI .
zeilekomp11ziertschrel Izeile komp11z1ert schre1ben :
I IF
11ne number
mark lineno (file) THEN marke .' mark col
I
(file) FI;
I IF
line number
act l1neno
I THEN verschoben . - save verschoben;
I
exec (PROC (TEXT CONST, INT CONST) feldout, file, stelle);
I
verschoben := 0; marke :. 0
I ELSE exec (PROC (TEXT CONST, INT CONST) feldout, file, El);
I
IF line number = mark lineno (file) THEN marke :. anfang FI
I
Fl.
~15
lEND PROC bild ausgeben;
2415
I
~17
+
2418
2419
~20
~21
2422
2423
~24
2425
~26
21/49
edi tor pa.ket
Icheck for interrupt :
I kommando CAT inchety;
I IF
kommando <) ""
I THEN IF
zeilen nr = 1 CAND up command CAND vorgaenger erla.ubt
I
THEN LEAVE abschnitt loeschen und neuschreiben
I
ELIF zeilen nr = bildlaenge CAND down command CAND n1cht
I
letzter sa tz
I
THEN LEAVE abschnitt loeschen und neuschre1ben
I
FI
I
2387
2388
2389
10.11.86
bildzeigen ............... IPROC blld ze1gen
I
(* wk *)
I
I dateizustand holen ;
I ueberschrift zeigen
I bildausgabe steuern
I bild neu ;
I . fenster zeigen ;
I ·oldline no :. satznr
laId 11ne update : = FALSE
I old satz :. "" ;
editor pa.ket
21/49
Zeile
E LAN
EUMEL
1.8
2427
2428
2429
2430
2431
2432
2433
2434
**.*
editor paket
10.11.86
I old zeilennr : = sa tznr
I dateizustand retten
I
IENDPROC bild zeigen ;
I
- bildanfang
+
1
ueberschriftinitialisi ... IPROC ueberschrift initialisieren
I
(*sh*)
I satznr pre : =
cursor pos + code (bildrand - 1) + code (rand + feldlaenge I
I
I
I
+
2435
24:36
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
I
I
I
I
,,
,
,
,
,
,
,
,I
6) ;
ue berschrift pre : =
cursor pos + code (bildrand - 1) + code (rand) + mark anf;
ueberschrift text := ""; INT VAR i;
FOR i FROM 16 UPrO feldlaenge REP ueberschrift text CAT "." PER;
ueberschrift pest : = blank + mark end + "Zeile
" + mark anf;
ueberschrift post CAT blank + mark end +" ";
filename : = headline (file);
filename : = subtext (filename, 1, fe ldlaenge - 24);
insert char (filename, blank, 1); filename CAT blank;
replace (ueberschrift text, filenamepos, filename);
rubin segment in ueberschrift eintragen;
margin segment in ueberschrift eintragen;
rest segment in ueberschrift e1ntragen;
learn segment in ueberschrift eintragen .
, filenamepos
,
DIV 2
(LENGTH ueberschrift text - LENGTH filename
,'mark anf
,'mark end
,'mark ausgleich
,
begin mark + mark ausgleich.
2450
filenamepes
2451
markanf
2452
markend
2453
2454
markausgleich
2455
2456
2457
rubinsegmentinuebersch 'rubin segment in ueberschrift eintragen :
, replace (ueberschrift text, 9, rubin segment)
2458
2459
2460
rubinsegment
2461
2462
2463
marginsegmentinuebersc 'margin segment in ueberschrift eintragen :
, replace (ueberschrift text, 2, margin segment)
2464
2465
2466
2467
2468
2469
2470
marg1nsegment
2471
2472
2473
restsegmentinueberschr
21/50
,
end
mark
+
+
mark ausgle1ch.
(1 - sign (max (mark size, 0))) • blank .
,,
'rubin segment :
IF einfuegen THEN "RUBIN" ELSE "
,I
,
" FI .
,
I
'margin segment :
, IF
an fang ( = 1
, THEN" ...... "
I ELSE TEXT VAR margin text : = "M" + text (anfang);
(6 - LENGTH margin text) *
+ margin text
I
,,
,
FI.
Irest
,
,
segment in ueberschrift eintragen :
replace (ueberschrift text, feldlaenge - 25, rest segment) .
edi tor paket
21/~
3)
Zeile
2474
2475
E LAN
restsegment
EUMEL
1.8
****
10.11.86
edi tor paket
Irest segment :
I IF zeileneinfuegen THEN "REST" ELSE " .... " FI .
I
I
M%
M77
2478
2479
learnsegmentinuebersch Ilearn segment in ueberschrift eintragen :
I replace (ueberschr1ft text, feldlaenge - 19, learn segment) .
2480
M81
2482
2483
MM
learn segment
2485
M86
M87
2488
2489
2490
2491
2492
M93
2494
I
I
Ilearn segment :
I IF lernmodus THEN "LEARN" ELSE " ..... " FI
I
IEND PROC ueberschrift ini tialis1eren;
I
ueberschriftschreiben .... IPROC ueberschrift schreiben :
I replace (ueberschrlft post, satznr pos, text (text (linene
I
( file) ), 4));
lout (ueberschrift pre); out (ueberschrift text); out (ueberschrift
I
post);
I get tabs (file, tab);
I IF
pos (tab, dach) ) 0
I THEN out (ueberschrift pre);
I
out subtext (tab, anfang + 1, anfang + feldlaenge - 1);
I
cursor (rand + 1 + feldla.enge, blldrand); out (end mark)
I FI.
2496
I satznr pos : IF mark size) 0 THEN 9 ELSE 10 FI
I
(*sh*)
IEND PROC ueberschrift schre1ben;
M~
I
2495
satznrpos
I
I
2498
2499
2500
2501
2502
2503
2504
25135
2506
2507
fehlermeldungschreiben ... IPROC fehlermeldung schreiben
I ueberschrift schreiben;
lout (ueberschrift pre);
lout ("FEIILER: ");
lout subtext (fehlertext, 1, feldla.enge - 21);
lout (blank);
lout (p1ep);
I cursor (rand + 1 + feldlaenge, bildrand); out (end mark)
lEND PROC fehlermeldung schre1ben;
2508
25139
2510
2511
setbusyindicator ......... IPROC set busy indicator:
I cursor (rand + 2, blldrand)
IEND PROC set busy indicator;
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
kommandoanalysieren ...... IPROC kommando analysieren (TEXT CONST taste,
PROC (TEXT CONST) kOlllll18.ndo interpreter)
I
I disable stop;
I bildausgabe normieren;
I zustand 1n date 1 s ichern;
I edi tfile modus setzen;
I kOlllll18.ndo 1nterpreter (taste);
I editfile modus zuruecksetzen;
o THEN LEAVE kommando analysieren FI;
I IF actual editor
I absatz ausglelch . - 2·
(*sh*)
I
21/51
I
I
edt tor paket
21/01
Ze1le
E LAN
1. B .... **
EUMEL
2522
252:3
2524
2525
2526
2527
10 . 11 . B6
edi tor paket
I konst&nten neu berechnen;
I neues bild bel undefinierter benutzeraktion;
I evtl fehler behandeln;
I zust&nd aus datel holen;
I bildausgabe steuern .
I
I
2528
2529
25:30
2531
editfilemodussetzen
2532
253:3
2534
edl tfilemoduszurueckse Iedi tfile modus zuruecksetzen :
I edi tget modus : = alter edi tget modus
2535
2:536
2537
2538
2539
2540
2541
2542
evtlfehlerbehande In
Ievtl fehler behande In :
I IF
is error
I THEN fehlertext :. errormessage;
I
IF fehlertext () "" THEN neu (fehlermeldung, nix) FI;
I
clear error
I ELSE fehlertext : =
I FI.
2543
2544
2545
2546
2547
zustandindateisichern
I zust&nd in datei slchern :
I old zeilennr : = zeilennr;
laId mark l1neno : = bildmarke;
I dateizust&nd ret ten .
Iedi tfile modus setzen :
I BOOL VAH alter edi tget modus : = edi tget modus
I edi tget modus : = FALSE .
I
I
I
I
I
I
I
I
2548
2549
2550
2551
2552
2553
zust&ndausdat&iholen
2554
2555
2556
2557
2558
2559
2560
2561
zurueckaufalteposition Izurueck auf alte position:
I to line (file, old I1neno);
I col (file, alte stelle);
I IF
fllesstext
I THEN edi tinfo (file,
old zeilennr)
I ELSE edit1nfo (fl1e, - old zel1ennr)
I FI; datelzust&nd holen .
2562
2563
2564
2565
2566
bildausgahenormieren
2567
2568
2569
2570
neuesbildheiundef1nler I neues bild hel undefinlerter henutzeraktlon :
I IF bildbereich • undefinierter bereich THEN alles neu FI .
lEND PROG kommando ana!ysieren;
2571
2572
257:3
21/52
Izust&nd aus datei holen :
I dateizust&nd holen;
I IF
letzer edltor auf dleser datei () actual editor
I THEN zurueck auf alte post tion; neu (ueherschrift, bild)
I FI.
I
I
I
I
Ibildausgahe norm1eren :
I bildhereich: = undefinlerter berelch;
I erster neusatz :. 9999;
I letzter neusa tz : = 0 .
I
I
I
blldausgabesteuern ....... IPROC bildausgabe steuern :
I IF
marklert
I THEN IF
old mark lineno • 0
edi tor paket
21/52
Zeile
E LAN
EUMEL
1.8
****
editor pe.ket
10.11.86
THEN a.bschni t t neu (bildma.rke, sa. tznr) ;
konsta.nten neu berechnen
ELIF stelle vera.endert
(*sh*)
THEN ze ile neu
FI
ELIF old ma.rk l1neno ) 0
THEN a.bschnitt neu (old ma.rk lineno, (ma.x (sa.tznr, old lineno)));
konsta.nten neu berechnen
FI ;
IF
sa.tznr () old lineno
THEN neu (a.kt sa.tznr, nix);
neuen bilda.ufba.u bestimmen
ELSE zeilennr : = old zeilennr
FI ;
zellennr : = min (min (zellennr, sa.tznr), a.ktuelle blldla.enge);
blldanfang : = satznr - zeilennr + 1 .
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
2590
2591
2592
stellevera.endert
2593
2594
2595
2596
2597
2598
2599
neuenbilda.ufbaubestimm
2600
2601
2602
imfensterspringen
2603
2604
2605
2606
bildneuaufbauen
2607
2608
2609
2610
2611
2612
2613
2614
2615
I
I
I
I
I
I
fliesstextindateisetze
2616
2617
21/53
() alte stelle .
:
+ sa.tznr - old l1neno;
IF
1 (= zeilennr AND zellennr (. a.ktuelle bildlaenge
THEN im fenster springen
ELSE bild neu aufbauen
FI.
lim fenster springen :
I IF ma.rkiert THEN abschni tt neu (old l1neno, sa.tznr) FI .
I
I
Ibild neu a.ufba.uen
I neu (nix, bild); zeilennr := ma.x (1, a.ktuelle bildlaenge
IEND FROC blldausgabe s'teuern;
I
DIV 2) .
wordwra.p ................. IPROC word wra.p (BOOL CONST b)
I IF a.ctual edi tor = 0
I THEN std fliesstext :. b
I ELSE fliesstext in da.tei setzen
I Fl.
+
2618
2619
2620
2621
2622
Istelle vera.endert stelle
I
I
Ineuen bildaufbau bestimmen
I zellennr:= old zeilennr
fliesstextveraendert
I
I
Ifliesstext in da.tei setzen :
I fliesstext:= b;
I IF fliesstext veraendert THEN edi tinfo
I
FI;
I neu (ueberschrift, bild)
I
I
Ifliesstext veraendert :
I fliesstext AND editinfo (file) ( 0 OR
I NOT fliesstext AND editinfo (file) ) 0
(file, - editinfo (file))
lEND FROC word wra.p;
I
edi tor pa.ket
21/53
Zeile
2623
+
2624
2625
2626
2627
2628
2629
E LAN
EUMEL
1.8
••••
10.11.86
editor p&ket
wordwrap ................. IBOOL PROC word wrap :
I
(.sh.)
I IF
actual edi tor = 0
I THEN std fliesstext
I ELSE fliesstext
I FI
lEND PROC word wrap;
I
anfang
END PROC margin;
2630
2631
margin ................... lINT PROC margin
2632
margin ................... IPROC margin (INT CONST il
I
(.sh.)
I IF
anfang <) i CAND i ) 0 AND i < 16001
I THEN a.nfang := i; neu (ueberschrift, bild);
I
margin segment in ueberschrift eintragen
I ELSE IF i ) = 16001 OR i < 0
I
THEN errorstop ("ungueltige Anfangsposition (1 - 16eee)")
I
FI
I FI.
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
I
I
I
marg1nsegmentinuebersc Imarg1n segment in ueberschrift eintragen :
I replace (ueberschrift text, 2, margin segment)
I
I
2643
2644
marginsegment
2645
2646
2647
2648
2649
2650
2651
2652
2653
+
I
IEND PROC margin;
I
rubinmode ................ IBOOL PROC rubin mode
I
mode;
+
2656
2657
2658
2659
2660
2661
2662
2663
2664
2665
2666
2667
2668
21/54
rubin mode (actual ed1 tor)
END PROC rubi'
I
2654
2655
lmargin segment:
I IF
anfang <= 1
I THEN" ...... "
I ELSE TEXT VAH margin text := "M" + text (anfang);
I
(6 - LENGTH margin text) *
+ margin text
I FI.
rub1nmode
•••••••••••••••• 1BOOL
PROC rubin mode (INT CONST editor nr) :
(.sh-)
I IF
edi tor nr < 1 OR editor nr ) max used editor
I THEN errorstop ("Editor nicht eroeffnet")
I FI;
I IF
editor nr = actual editor
I THEN einfuegen
I ELSE editst8.ck (editor nr).feldstatus.einfuegen
I FI
IEND PROC rubin mode;
I
I
ed1 t ..................... IPROC edit (INT CONST i, TEXT CONST res,
I
PROC (TEXT CONST) kommando interpreter)
I edit (i, i, i, res, PROC (TEXT CONST) kommando interpreter)
lEND PROC edit;
edi tor p&ket
21/M
Zeile
*-*
ELAN
1.8 ••*.
EUMEL
10.11.86
ed1 tor p&ket
2669
2670
2671
2672
U73
U74
U75
U76
2677
2678
2679
2680
2681
2682
2683
2684
2685
edit
.........•.......•..• IPROC edit (INT CaNST von, bis, start, TEXT CONST res,
I
PROC (TEXT CONST) kommando interpreter) :
I disable stop;
I IF von ( bis
I THEN edit (von+1, bis, start, res, PROC (TEXT CONST) kOmm&ndo
I
interpreter) ;
I
IF II1&X used editor ( von THEN LEAVE edit FI;
I
open editor (von)
I ELSE open editor (start)
I FI;
I absatz ausgleich : = 2;
I bildeditor (res, PROC (TEXT CONST) komma.ndo interpreter);
I cursor (1, schirmhoehe);
I
I
I
2686
2687
2688
2689
lIarnung ausgeben :
l o u t (clear eop); out ("WARNUNG: Lernmodus nicht
I
ausgeschaltet"13""10"")
lEND PROC edit;
U~
I
2691
U92
U93
U94
2695
2696
2697
2698
2699
2700
2701
2702
2703
+
27E14
27E15
2706
27E17
27E18
27E19
271E1
2711
2712
2713
2714
2715
2716
2717
2718
2719
272E1
21/55
lIarnungausgeben
I
I
I
I
I
IF
is error
THEN komma.ndo zeiger : = 1; komma.ndo :. ""; quit
FI
IF
lernmodus CAND actual ed1 tor = 0 THEN lIarnung ausgaben FI
(*sh*)
date1zustandholen ........ PROC d&teizustand holen :
modify (file);
get tabs (file, tabula tor) ;
zeilennr und fliesstext und letzter editor aus editinfo decod1.eren;
limit : = II1&X line length (file);
stelle : = col (file);
markiert : = mark (file);
IF
markiert
THEN markierung holen
ELSE keine markierung
FI ;
satz nr : = lineno (file);
IF
zeilennr) &ktuelle bildlaenge
(*sh*)
THEN zeilennr :. min (satznr, aktuelle blldlaenge); bild neu
ELIF zeilennr ) satznr
THEN zeilennr := min (satznr, aktuelle blldl&enge)
FI ; zeilennr := II1&X (zeilennr, 1);
bildanfang : = satz nr - zellennr + 1 .
zeilennrundfliesstextu
Izeilennr und fliesstext
I zeilennr: = edit info
I IF
I
THEN
I
I
I
I
I
I
ELIF
THEN
ELSE
I
und letzter editor aus edi tinfo decodieren
(file);
zeilennr = e
zeilennr := 1;
fliesstext : = std fliesstext
zeilennr ) EI
fliesstext : = TRUE
zeilennr : = - zeilennr;
fliesstext : = FALSE
FI;
letzer editor auf dieser datei . = zellennr DIV 256;
editor paket
Zeile
E LAN
markierungholen
2733
2734
2735
2736
2737
2738
keinemarkierung
2746
2747
2748
2749
~~
2751
2752
2753
2754
2755
2756
2757
••••
10.11.86
edi tor paket
zeilennr: = zeilennr MOD 256 .
I
I
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2745
1.8
I
2721
2722
2739
2740
2741
2742
2743
2744
EUMEL
lmarkierung holen
I bildmarke: = mark lineno (file);
I feldmarke: = mark col (file);
I IF
line no (file) <= bildmarke
I THEN to line (file, bildmarke);
I
marke : = feldmarke;
I
stelle := max (stelle, feldmarke)
I ELSE marke . - 1
I FI.
I
I
Ikeine markierung :
I bildmarke: = 0;
I feldmarke: = 0;
I marke
:= 0 .
lEND PROC dateizustand holen;
I
date1zustandretten ....... PROC date1zustand retten :
put tabs (file, tabulator);
IF
fliesstext
THEN edi tinfo (file,
zeilennr + actual editor • 256)
ELSE edit info (file, - (zellennr + actual editor. 256»
FI ;
ma.x line length (file, 11m1 t);
col (file, stelle);
IF
markiert
THEN mark (file, bildmarke, feldmarke)
ELSE mark (file, 0, 0)
TI
lEND PROC dateizustand retten;
I
openeditor ............... IPROC open editor (FILE CONST new file, BOOL CONST access)
I disable stop; quit last;
I neue bildparameter bestimmen;
I open editor (actual editor + 1, new file, access, x, y, x len, y
I
len).
I
I
2758
2759
2760
2761
2762
2763
2764
neuebildparameterbesti Ineue bildparameter bestimmen :
I INT VAR x, y, x len, y len;
I IF
actual editor ) 0
I THEN tellblld des aktuellen editors
I ELSE valles bild
I TI.
2765
2766
2767
teilbilddesaktuellened I teilblld des aktuellen editors :
I get editcursor (x, y); bildgroesse bestimmen;
I IF
fenster zu schmal
I
(.sh.)
I THEN enable stop; errorstop ("Fenster zu klein")
I ELIF fenster zu kurz
I THEN verkuerztes altes bild nehmen
I FI.
+
2768
2769
2770
2771
2772
21/56
I
I
I
editor paket
21/56
Zeile
E LAN
2773
2774
2775
2776
bildgroessebestimmen
2777
fensterzuschma.l
EUME!.
1.8
****
10.11.86
****
edl tor paket
Ibildgroesse bestimmen :
I x len .' rand + feldl&enge - x + 3;
I y len : = bildrand + bUdlaenge - y + 1 .
I
I
I fenster zu schma.l
I
fensterzukurz
2780
2781
2782
verkuerztesaltesbildne Iverkuerztes altes bild nehmen :
I x: = rand + 1; y : = bildrand + 1;
I IF fenster zu kurz THEN enable stop; errors top ("Fenster zu
I
klein") FI;
I x len :. feldlaenge + 2;
I y len : = bildlaenge;
I kurze fe ldlaenge : = 0;
I kurze bildlaenge := 1 .
+
2788
2789
2790
2791
2792
2793
2794
2795
2796
2797
2798
2799
2800
2801
2802
2803
2804
vollesbild
Ivolles bUd :
I x: = 1; y : = 1; x len : = schlrmbrei te; y len . - schlrmhoehe .
IEND PROC open edi tor;
openedi tor ............... IPROC open edi tor (INT CONST edi tor nr,
I
FILE CONST new file, BOOL CONST access,
I
INT CONST x start, y, x len start, y len)
I INT VAH x := x start,
I x len := x len start;
I IF
editor nr ) max edltor
I THEN errors top ("zu vlele Edltor-Fenster")
I ElIF editor nr ) max used editor + 1 OR editor nr < 1
I THEN errorstop ("Editor nicht eroeffnet")
I ElIF fenster ungue ltig
I THEN errorstop ("Fenster ungueltlg")
I ELSE neuen editor stacken
I FI.
fensterungueltig
2809
2810
21/57
I
I
I
2808
2811
2812
2813
2814
2815
2816
2817
2818
2819
2820
2821
2822
2823
2824
2825
1
I
I
2805
2806
2807
y ) schirmhoehe
17
2778
2779
2783
2784
2785
2786
2787
Ifenster zu kurz
x) schirmbrei te
I
I
I fenster ungueltig
I x < 1 COR X) schirmbre1te COR y < 1 COR y) schirmhoehe COR
I x len - 2 < = 15 COR Y len - 1 < 1 COR
I x + x len - 1 ) schirmbrei te COR y + y len - 1 ) schirmhoehe
I
I
neuenedl torstacken
Ineuen editor stacken
I disable stop;
I IF
actual editor ) 0 AND 1st elnschraenkung des &1ten bildes
I THEN dateizust&nd holen;
I
aktuelles edi torbild elnschraenken;
I
arbei tspunkt in das restbild posi tlonleren;
I
abgrenzung beruecks1cht1gen
I FI;
I aktuellen zust&nd retten;
I neuen zust&nd setzen;
I neues edi torbild zeigen;
I actual ed1 tor : = edl tor nr;
I IF
actual editor ) max used edt tor
I THEN max used edl tor : = actual edt tor
I FI.
edi tor paket
21/57
Zeile
E LAN
EUMEL
10.11.86
edi tor pa.l rand
CAND x + x len
rand + feldlaenge + 3 CAND
I y > bildrand CAND y + y len • bildrand + bildlaenge + 1 .
I
I
I&ktuelles
2830
2831
2832
2833
••••
I
2826
2827
2828
2829
1.8
&ktuelleseditorbildein
I
I
I
I
2834
edi torbild einschraenken :
kurze feldlaenge : = x
rand - 3;
kurze bildlaenge : = y - bildrand - 1 .
2835
2836
2837
2838
2839
2840
2841
2842
arbei tspunktindasrestb Iarbeitspunkt in das restbild posi tionieren :
I IF
stelle > 3
I THEN stelle DEeR 3; alte stelle := stelle
I ELSE WHILE zeilennr > 1 AND zeilennr > kurze bildlaenge REP
I
vorgae nger
I
PER; old lineno := satznr
I FI.
2843
2844
2845
2846
2847
2848
2849
abgrenzungberuecksicht labgrenzung beruecksichtigen
I IF
x-rand>l
I THEN balken malen;
2850
balken~alen
I
I
I
I
I
I
I
x
INCR 2;
x len DEeR 2
FI.
lbalken malen
VAR i;
i FROM 0 UPrO y len-1 REP
I
cursor (x, y+i); out (kloetzchen)
I
(.sh*)
I INT
I FOR
2851
2852
2853
+
2854
2855
I PER.
I
I
kloetzchen
2858
2859
&ktuellenzustandretten l&ktuellen zustand retten :
I IF
actual edi tor ) 0
I THEN dateizustand retten;
I
editst&ck (actual editor).feldstatus .= feldstatus;
I
editstack (actual editor) .bUdstatus := bildstatus;
I
einrueckstack (actual editor) := alte einrueckposition
I FI.
2860
2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
21/58
Ikloetzchen
IF mark size> 0 THEN ftft15 ftft14ftW ELSE wW15 w "14" WFI .
2856
2857
I
I
neuenzustandsetzen
I
I
Ineuen
I
I
I
I
I
I
I
I
I
I
I
zustand setzen :
FRANGE VAR frange;
feldstatus:= FELDSTATUS
(1, 1, x-1, 0, 1,0, x len-2, 0, FALSE, TRUE, access, "");
bildsta tus : = BILDSTATUS
(x len-2, x len-2, y, y len-1, y len-1, ueberschr1ft, bUd,
0, 0, 1, 0, 0, FALSE, FALSE, "ft, "ft, "M, "M, "M, frange, new
file);
al te einrueckposition : = 1;
dateizustand holen;
ueberscbrift initialisieren
editor pa.l end of file THEN FAUlE
I
ELIF 81 • "u"
THEN perhaps sImple up
I
ELIF sl = "D"
THEN perhaps simple down
I
ElSE FAUlE
I
FI
I ElSE FAUlE
I Fl.
I
I
lperhaps simple up
I IF t2. string THEN up (s2);
TRUE
I ELIF t2 • integer THEN up (int (s2»; TRUE
I
ELSE
FAUlE
I Fl.
I
I
Iperhaps simple down
I IF t2 = string THEN down (52);
TRUE
I ELIF t2 • integer THEN down (int (52»; TRUE
I
ELSE
FAUlE
I Fl.
I
I
Iperhaps simple change to :
I IF t1 = string AND s2 • "c" AND t3 is string
I THEN s1 C s3; TRUE
I ELSE FAUlE
I Fl.
I
I
It3 is strIng :
I next symbol (93, t3);
I t3 = string .
edi tor functions
AND t4 is eof
22/3
Zeile
--
ELAN
168
169
1713
171
t4iseof
172
173
174
175
176
177
178
+
179
leG
181
182
+
183
184
185
186
187
188
189
+
190
191
192
193
+
194
195
196
197
198
199
200
2131
202
203
204
205
206
207
208
209
218
211
212
213
22/4
EUMEL
1.8
.......
113.11.86
.. - ..
edi tor functions
I
I
I t4 is eof :
I TEXT VAR s4; INT VAR t4;
I next symbol (s4, t4);
I t4 = end of file .
lEND PROC std kommando interpreter;
I
I
edit ..................... IPROC edit (FILE VAR f) :
I enable stop;
I IF &ktueller editor ) 13
(.wk.)
I
THEN ueberschrlft neu
I
I FI ;
I open editor (f, write acc);
I edit (groesster editor, std res, PROC(TEXT CONST) std kOlllll&ndo
I
interpreter)
lEND PROC edit;
I
I
edit ..................... IPROC edit (FILE VAR f, INT COIIST x, y, x size, y size) :
I enable stop;
I open editor (groesster editor + 1, f, write &cc, x, y, X size, y
I
size);
I edit (groesster editor, std res, PROC(TEXT CONST) std kommando
I
interpreter)
IEND PROC edit;
I
I
edit ...............•..... IPROC edit (FILE VAR f, TEXT CONST res, PROC (TEXT CONST) kdo
I
interpreter):
I enable stop;
I open editor (f, write acc);
I edit (groesster editor, res, PROC(TEXT COIIST) kdo interpreter)
lEND PROC edit;
I
I
edit ..................... IPROC edit :
I IF &ktueller editor ) 13
I THEN d&teiname einlesen;
I
edit (d&teiname)
I EI.SE edit (last p&ram)
I FI.
d&teinameeinlesen
I
I
Idateiname einlesen
I INT VAR x, y; get edi tcursor (x, y);
I IF x ( x size - 17
I
I
I
I
I
(.sh.. )
THEN cursor (x, y);
out (""15"D& teiname: "14"") ;
(x size-14-x) TIMESOUT " ";
(x size-14-x) TIMESOUT U8"";
edi tor functions
22/4
Zeile
E LAN
EUMEL
214
215
216
217
218
219
22@
221
222
trailingblanksentt'erne
223
224
225
226
227
+
228
229
quotesentfernen
236
237
240
241
+
242
+
243
244
245
246
247
248
249
250
251
252
+
253
254
255
256
257
258
259
26e
22/5
edi tor functions
I
TEXT VAR dateinllJl1e : = std;
I
editget (dateiname);
I
trailing blanks entt'ernen;
I
quotes entfernen
I ELSE errors top ("Fenster zu klein")
I Fl.
I
I
I trailing blanks entfernen:
I INT VAR i :. LENGTH dateinllJl1e;
I WHILE (dateiname SUB i) • " " REP i DECR 1 PER;
I dateinllJl1e:= subtext (dateiname, 1, i) .
I
I
Iquotes entfernen
I IF (dateinllJl1e SUB 1) = """" AND (dateiname SUB LENGTH dateiname)
I
I THEN dateiname := subtext (dateiname, 2, LENGTH dateiname - 1)
I Fl.
edi t ..................... IPROC edit (TEXT CONST filename) :
I IF filename <) ""
I THEN edit named file
I ELSE errors top ("Name unguel tig")
I FI.
238
239
10.11.86
I
I
231
232
235
****
lEND PROC edit;
230
233
234
1.8
edi tnamedfile
I
I
Iedit named file
I last param (filename);
I IF exists (filenllJl1e)
COR yes ("" .... + filename + """ neu
einrichten")
THEN IF aktueller editor ) 0 THEN ueberschrift neu FI;
I
(*sh*)
I
FILE VAR f := sequential file (modify, filename);
I
headline (f, filename); edit (f); last param (filename)
I ELSE errors top ("")
I Fl.
IEND PROC edit;
I
I
I
I
edit •....•.•.......•..••• IPROC edit (TEXT CONST filenllJl1e, INT CONST x, y, x Size, y size)
I last param (filenllJl1e);
I IF exists (filename) COR yes (" .. "W + filename + "w .. neu
I
einrichten")
I THEN FILE VAR f := sequential file (modify, filename);
I
headline (f, filename); edit (f, x, y. x size, y size);
I
last param (filename)
I ELSE errors top ( .... )
I FI
lEND PROC edit;
I
I
edi tor functions
22/5
Zeile
261
262
263
264
265
266
267
268
269
+
278
271
272
273
+
274
275
276
277
278
279
2&'l
281
282
283
284
285
286
287
-
E LAN
EUMEL
1.8....
18.11.86
edit ..................... IPROC edit (INT CONST i) :
I edit (i, std res, PROC (TEXT CONST) std kolllll&lldo interpreter)
lEND PROC edit;
I
I
shOll ..................... IPROC shOll (FILE YAH f) :
I ell&ble stop;
I open edi tor (f, read acc);
I edlt(groesster edltor, std res, PROC(TEXT CONST) std kolllll&lldo
I
lnterpreter);
IEND PROC sholl;
I
I
shOll ..................... IPROC shOll (TEXT CONST filename)
I
(*sh.)
I last param (filename);
I IF
exlsts (filename)
I THEN FlLE YAH f := sequential file (modify, filename);
I
shOll (f); last pe.ram (filename)
I ELSE errors top ("""" + filename + """ gibt es nicht")
I FI
lEND PROC shOll;
I
I
sholl ..................... IPROC shOll :
I shOll (last param)
IEND PROC sholl;
I
I
299
IDATASPACE YAH local space;
I INT YAH zeilenoffset;
ITEXT YAH kopierzeile;
291
292
I
I
288
289
293
294
295
PUT ...................... lOP PUT (TEXT CONST filename) :
I nichts neu;
I
296
I
m
I
I
I
298
299
3ge
381
302
303
+
394
385
3e6
397
308
3e9
318
22/6
edl tor functions
IF
mark
THEN markierten bereich 1n date1 schrelben
Fl.
mark1ertenberelch1ndat Imark1erten bereich 1n datel schrelben
I disable etop;
I zleldate1 vorberelten;
I quelldatel oeffnen;
I IF
noch genuegend platz in der zleldatei
I
(*sh*)
I TIIEN zeilenwelse kopieren
I ELSE errorstop ("FlLE-Ueberlauf")
I FI;
I quelldatei schl1essen;
I zieldatel schl1essen;
I set busy lndlcator .
I
ed1tor functions
22/6
Zaile
311
312
313
314
315
316
317
318
319
-
ELAN
EUMEL
zield&teivorbereiten
+
320
321
322
323
324
325
326
327
328
I
I
I
I
I
I
329
33e
zeilenweisekopieren
I
I
336
quelld&teischliessen
35El
351
352
353
3:)4
3:)5
3:)6
3:)7
3:)8
3:)9
zleld&telschliessen
22/7
quelld&tei oeffnen :
zeilenoffset:. m&rk line no (edfile) - 1;
INT CONST old line :. line no, old col :. col;
FRANGE VAH g&nZe d&tei;
set r&nge (edfile, m&rk lineno (edfile), III&l'k col (edfile),
d&tei);
input (edfile) •
zeilenwelse kopieren
en&ble stop;
satznr nau;
INT VAH zeile;
roll zeile FROM 1 UPl'O lines (edfile) REP
getline (edfile, kopierzeile);
putline (destin&tion, kopierzeile);
s&tznr ze 1gen
PD! •
344
345
346
347
348
349
360
editor functions
nochgenuegendpl&tzinde Inoch genuegend pl&tz in der zield&tel :
I lines + groesse der zield&tei ( file slze
337
338
339
Me
341
342
343
361
18.11.86
I
I
333
334
335
-*
IZield&tel vorbereiten :
I FRANGE VAH g&nze zield&tei;
IF exists (filen&me) TIIDI forget (filell&llle); ueberschrift neu rI;
FILE VAH destin&tion;
IF
filen&me'··
TIIDI forget (100&1 spe.ce); 100&1 spe.ce :. nilspe.ce;
destin&tion :. sequenti&l flle (output, lae&l spe.ce)
ELSE destln&tion :. sequenti&l file (modlfy, fllell&llle) ;
INT CONST groesse der zield&tei: • lines (destin&tion);
(*sh*)
set m&rked r&nge (destin&tion, g&nZII zield&tei) ;
output (destin&tlon)
FI .
quelld&teioeffnen
+
331
332
1.8
quelld&tei schliessen :
I modify (edfUe);
I set r&nge (edfUe, g&nze d&tei);
I to line (old line);
I col (old col) .
I
I
I zleld&tei schliessen :
I IF
filen&me <) ••
I TIIDI INT CONST l&st line wrltten :. line no (destin&tion)
I
modify (dastin&tion) ;
I
to lina (destin&tlon, l&st line written)
I
col (destin&tlon, Ian (dastin&tion) + 1)
I
bild neu (destin&tion) ;
I
set r&nge (destln&tlon, g&nZII zield&tei)
I Fl.
IEND OP ror;
I
I
editor functions
22/7
g&nZII
Zeile
E LAN
EUMEL 1.8 ****
10.11.86
****
362
363
364
365
366
P ........................ IOP P (TEXT CONST filename)
I PUT filename
lEND OP P
367
GET.....................
edi tor functions
I
I
+
368
369
370
371
OP
GET
(TEXT CONST filename)
(*sh*)
IF
Nor write permission
THEN errorstop (·Schreibversuch auf 'show' -Jl&tei·)
FI;
quelldatei oeffnen;
IF
nicht mehr genuegend platz 1m edltfl1e
THEN quelldatei schliessen; errorstop (·FlLE-Ueberlauf·)
372
373
374
375
376
FI;
disable stop;
zieldatei oeffnen;
zeilenwelse kopieren
zleldatei schliessen;
quelldatei schliessen;
set busy lndicator .
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
22/6
Iquelldatei oeffnen :
I FILE VAR source;
I FRANGE VAR ganze quelldatei;
filename =
I IF
I THEN source : = sequential file (input, local sp&Oe)
I ELSE IF Nor exists (filename)
THEN errors top (.... + filename + ••• gibt es nicht·)
I
FI;
I
source : - sequential file (modify, filell&lll8);
I
INT CONST old line : = line no (source),
I
old col :. col (source);
I
set marked range (source, ganze quelldatei);
I
input (source)
I
I FI .
I
I
nichtmehrgenuegendplat Inicht mehr genuegend platz im edi tfUe :
I lines (source) + lines ). file siZe.
I
I
Izeilenweise kopieren
zeilenweisekopieren
I enable stop;
I satznr neu;
I INT VAR zeile;
I FOR zeile FROM 1 UPTO lines (source) REP
getline (source, kopierzeile) ;
I
putline (edfile, kopierzeile) ;
I
satznr zeigen
I
I PER .
I
I
Izleldatei oeffnen :
zieldateioeffnen
I zeilenoffset :. line no - 1;
I leere datel in edi tfile einsch&cht8ln;
I output (edfile)
I
quelldateioeffnen
..
editor functions
22/8
Zeile
415
416
417
418
419
E LAN
EUMEL
quelld&teischliessen
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
---
10.11.86
edi tor functions
leered&teiinedi tfileei Ileere datei in edi tfile einsch&chteln
I INT CONST range sta.rt col : = col;
I FRANGE VAH ganze d&tei;
I set range (edfile, line no, col, ganze d&tel);
I IF lines = 1 THEN delete record (edfUe) FI .
42El
421
422
423
424
1.8
zield&telschliessen
I
I
Iquelld&tei schliessen :
I IF
filename <) ftft
I THEN modify (source);
I
se t range (source, ganze que lld&te 1) ;
I
to line (source, old line);
I
col (source, old col)
I Fl.
I
I
Izieldatei schliessen
I modify (edfile);
I to line (lines);
I col (range sta.rt col);
I set range (edfile, ganze d& tel) ;
I abschnitt neu (zeUenoffset + 1, lines) •
IEND OP GET;
I
I
G ........................ lOP G (TEXT CONST fUename)
I GET fUename
lEND OP G;
I
I
443
444
445
446
447
len ...................... I INT PROC len :
I len (edfile)
IEND PROC len;
448
449
450
col ...•.................. IPROC col (INT CONST stelle) :
I nichts neu; col (edfile, stelle)
lEND PROC col;
451
452
453
454
455
e6
457
458
459
460
461
462
22/9
I
I
I
I
col ...................... lINT PROC col :
I col (edfile)
lEND PROC col;
I
I
liml t .................... IPROC limit (INT CONST lim1 t) :
I nichts neu; max line length (edfUe, limit)
IEND PROC lim1 t ;
I
I
editor functlons
22/9
Zeile
E LAN
EUMEL
1.8
••••
10.11.86
463
464
465
466
%7
limi t .................... I INT PROC limit:
I max line length (eMile)
lEND PROC limit;
468
469
470
471
472
lines .................... lINT moc lines :
I lines (edfile)
IEND moc lines;
473
474
475
lineno ................... lINT moc line no :
I line no (edfile)
IEND moc line no;
I
I
I
I
I
I
"6
"7
478
479
480
481
482
483
484
485
486
487
488
489
toline
................... IPROC to li ne (INT CaNST s&tz nr)
I satznr neu;
I edfile := editfile;
I IF S&tz nr ) lines
I THEN toline (edfile. lines); col
I ELSE to line (edfile. S&tz nr)
I FI
lEND PROC to line;
T •••.•.•••••••..••..••••• IOP T (INT CONST S&tz nr)
I
to line (S&tz nr)
lEND OP T;
491
492
I
I
493
494
495
496
497
down ..................... IPROC down (INT CaNST &nz) :
I nichts neu; down (edfile. &nz)
IEND moc down;
498
499
500
501
D •••••••.•••••••••.•••••• lOP D (INT CaNST &nz)
503
~4
~5
506
~7
22/10
(len + 1)
I
I
490
~2
edi tor functions
I
I
I
down (&nz)
lEND OP D;
I
I
up ....................... IPROC up (INT CONST &nz) :
I nichts neu; up (edflle. &lIZ)
IEND PROC up;
I
I
edi tor functions
22/10
Zeile
E LAN
508
509
510
511
U ••.•..••...•.•....•••...
EUMEL
1.8
••••
10.11.86
edi tor functions
loP
U (INT DONST anz)
up (anz)
lEND OP U;
I
I
I
M2
513
514
515
516
517
518
519
52E1
521
522
523
524
down ...•..•••...•..•••..• IPRoo down (TEXT CaNST muster) ;
I nichts neu;
I REP
I
down (muster, schri tt - line no MOD schri ttl ;
I
IF
pattern found
I THEN LEAVE down
I ELSE satznr zeigen
FI
I
I UNTIL eof PER
IEND PROG down;
525
526
527
528
529
D ••••••••••.•••••••••••••
53E>
531
532
533
534
down ..................... IPROC down (TEXT CaNST muster, INT DONST anz)
I nichts neu; down (edfile, muster, anz)
lEND PROC down;
535
536
537
up ....................... IPROC up (TEXT CaNST muster) ;
I nichts neu;
I REP
I
up (muster, (line no - 1) MOD schritt + 1);
I
IF
pattern found
I
THEN LEAVE up
I
ELSE satznr zeigen
I
FI
I UNTIL li ne no • 1 PER
IEND PROC up;
538
539
540
541
542
543
544
545
546
I
I
Iop
D (TEXT DONST muster)
down (mustor)
lEND OP D;
I
I
I
I
I
I
I
547
548
549
550
551
U .•.•••.....•.•••..••••.. IOP U (TEXT CaNST muster)
I up (muster)
lEND OP U;
552
553
554
555
556
up ...............•....... lpROO up (TEXT DONST muster, INT DONST anz)
I nichts neu; up (edfile, muster, anz)
lEND PRoo up;
22/11
I
I
I
I
edi tor functions
22/11
Zaile
557
558
559
560
561
562
563
564
E LAN
EUMEL
**-
1. 8
1@.11.86
edi tor functlons
downety .............•.... IPROC downety (TEXT CONST muster)
I nlchts neu;
I IF N= " "
I
THEN textline CAT cha.r
I
out (".")
I
ELSE
out (bell)
I FI
I PER.
I
2
I
I
Idelete la.st cha.r :
I IF LENOn! textline = 0
I
THEN out (bell)
I
ELSE out (ba.ck bla.nk ba.ck)
I
delete cha.r (textline, LENGn! textline)
I Fl.
I
I
Iget line little secret :
I cursor to sta.rt position ;
I editget (textline, "", "", exit cha.r) .
I
I
I
std tra.nsput
23/5
Zeile
258
259
26(;)
261
262
263
23/6
._.
ELAN
EUMEL 1.8 .**.
cursortostartposi tion
10.11.86
*.**
std trans put
Icursor to start position
I cursor (x, Y) •
I
IENDPROC get secret line ;
I
IENDPACKET std transput ;
std transput
23/6
Zeile
1
2
3
4
5
6
7
8
9
1@
E LAN
EUMEL
1.8 ••••
I
I
I
list:
ITEXT VAR file name, status text;
I
I
list ..................... IPROC list :
I
I
I
I
I
I
I
I
disable stop
DATASPACE VAR ds : = nilspace ;
FILE VAR list file := sequential f11e (output, ds)
headline (list file, "list") ;
list (list file)
show (list file)
forget (ds)
I
2@
IENDPROC list
21
I
3@
34
35
36
37
38
39
4@
24/1
(- Autor: J.Liedtke .:.
(. Stand: 25.82.B:i -'
I
I
12
13
14
15
16
17
18
19
31
32
33
local manager part 2
localmanagerpart2 ••••-"-IPACKET local manager part 2 DEFINES
11
22
23
24
25
26
27
28
29
1@.11.86
list ..................... IPROC list (FILE VAR 1')
I
I
I
I
enable stop ;
begin list ;
putline (f, "")
I REP
I
I
I
I
I
I
I
I
I
I
get list entry (file name, status text)
IF file name = ""
THEN LEAVE list
FI;
write (1', status text +" """)
write (f, file name)
write (1', """") ;
line (f)
PER.
IENDPROC list
I
IENDPACKET local manager part 2
local manager part 2
24/1
Zelle
1
+
2
3
4
5
6
7
8
9
10
E LAN
EUMEL 1.8 ****
eumel coder part 1
10.11.86
eUlDBlcoderp&rtl **********IPACKET eumsl coder part 1
(* Autor: U.
I
Bartling *)
I
DEFINES run, run again,
I
insert,
I
prot, prot off,
I
check, check on, check off,
I
warnings, warnings on, warnings off,
I
I
(
11
help, bulletin, packets
....................................................................
+
...... )
12
+
(.
13
E U MEL
COD E R
*)
+
14
(*
15
(*
*)
+
16
+
17
+
18
+
19
+
20
21
+
22
23
24
25
26
27
28
29
30
31
32
33
34
1(*
I
1(*
I
*)
Zur Beschreibung des Coders siehe
*)
U.Bartllng, J. Liedtke: EUMEL-Coder-Interfe.ce
*)
1(*
I
1(*
I
1(*
*)
Stand der Dokumentation
*)
Stand der Implementation
16.04.1986
I
1(*
I
1(*
I
I (*********.....................................****..................................
I
****-)
I
I
(--- Globale Variable ---)
I
I
ITEXT VAR object name;
I
IFILE VAR bulletin f11e;
I
lINT VAR hash table pointer, nt link, permanent pointer, param link,
I
index, mode, word;
I
35
IBOOL VAR found, end of pe.re.ms;
36
I
25/1
13.02.1986
eumsl coder part 1
25/1
ZeUe
E LAN
EUMEL 1.8 ••••
10.11.86
eume 1 coder p&rt 1
(....***.***...***.*•••• * •• ****...****..............**.*****~
..*.**)
+
39
+
1. Interface zum ELAN-Compiler
40
10.04.1986 .)
+
1.7.5.4
41
+
42
+
(.
43
1
44
+
45
+
46
+
1(·
1
1(.
1
48
1
1 (.
1
51
1
LET
+
61
62
63
64
65
79
80
.81
82
83
84
85
.)
Lesen aus und Schreiben in Na.mens- bzw. Permanent-Tabelle
.)
(.
o
begin of hash table
end of hash table
begin of permanent table
before first pt entry
first permanent entry
end of permanent table
60
76
77
78
Initialisieren und Beenden des Compilers,
...... )
53
54
55
56
57
58
59
73
74
75
Kennungen.
1
1
66
67
68
69
70
71
72
und
.)
1(····..•..•....••............•..•............•................•.......................
50
52
internen Vercodung von Typen
1
1(·
+
Tabellen (-grousen),
.)
1(·
47
49
.)
Beschreibung der
1023 ,
22784
22784
22785
32767
wordlength
time .)
two word length
three word length
1
permanent
permanent
permanent
permanent
permanent
permanent
permanent
permanent
permanent
10000
:20000,
p&ram const
var
proc op
type
row
struct
p&ra.m proc
p&ra.m proc end marker
type field
p&r&m
ptt limit
begin of pt minus ptt limit
void
int
real
string
bool
bool result
dat&space
row
struct
(. compile
u n d
2 ,
3
s380E)0,
:30000,
10 ,
11
12
o .)
o,
10000
= 12784 ,
e
1
2
3
5
6
7
10
11
86
25/2
eume 1 coder part 1
25/2
run
E LAN
Zeile
I
I
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
1.06
107
108
109
110
111
112
113
114
115
116
117
118
119
1~
121
122
123
124
125
126
127
128
129
138
131
132
133
134
135
136
25/3
EUMEL 1.8 ••••
1(*
(.
eumel coder part 1
10.11.86
canst
1
var
2
3
proc
denoter
bold
5
2
TRUE ,
FALSE
FALSE
TRUE
FALSE
ins
no ins
no 1st
sermon
no sermon
I
I
I
I
I
I INT
I
I
I
lINT
I
I
I
I
.)
.)
run agai n mode
compile file mode
0
warning message
error message
2
4
1
...............
point line
CONST permanent packet
permanent end
:=
.=
-2
-3
VAH run again mod nr
.=
0
(_ •••
Start/Ende - )
..................... IPROC elan (INT CONST mode, FILE VAR source, TEXT CONST line,
I
INT VAH start module number, BOOL CONST ins, 1st,
I
ser) :
I EXTERNAL 256
IENDPROC elan
I
I
(••••• Hash/Namenstabelle ••••• )
I.
I
nexthashentry
Inext hash entry
I
hash table pointer INCR word length .
I
I
endofhashtablereached Iend of hash table reached :
elan
yetanotherntentry
I
I
I
Iyet
I
I
rtc,
hash table pointer ) end of hash table .
another nt entry :
nt link . - cdb int (nt link)
nt link <) 0 . ;
I
declareobject ............ IPROG declare object (TEXT CONST name, INT VAH nt link, pt pointer)
I
EXTERNAL 10031
IENDPROC declare object ;
I
eumel coder part 1
25/3
E LAN
Zeile
137
138
139
140
147
148
149
150
addmultcyclic
eumel coder part 1
Ihash
I
hash code : = 0 ;
I
FOR index FROM 1 UPI'O LENGTH searched object REP
I
addmul t cyclic
I
ENDREP .
I
I
laddmult cyclic:
I
hash code INCR hash code
I
IF hash code , end of hash table THEN wrap around FI ;
I
hash code . - (hash code + code (searched object SUB index)) MOD
I
1924 .
I
I
151
152
153
154
wraparound
155
156
hashcode
157
158
159
160
161
162
163
164
165
166
searchntentry
167
readcurrententry
168
169
170
Iwrap around
I
hash code DECR end of hash table .
I
I
Ihash code
nextprocedure
nt link .
I
I
Ise&1'ch nt entry :
I
found : = FALSE
WHILE yet another nt entry REP
I
read current entry ;
I
IF object name = sea.rched object
I
THEN found : = TRUE ;
I
LEAVE to object
I
FI
I
I
I
I
PER
Iread current entry :
I
permanent pointer . - cdb int (nt link + wordlength)
I
object name : = cdb text (nt link + two word length)
IENDPROC to object ;
I
I
I
I·
I
171
172
173
174
25/4
10.11.86
I
I
hash
178
179
180
181
182
183
184
185
****
toobject ................. IPROC to object (TEXT CONST sea.rched object)
I
hash;
I
search nt entry .
141
142
143
144
145
146
175
176
177
1.8
EUMEL
(.*••• Permanent Tabelle ..... )
Inext procedure
I
permanent pointer :& cdb int (permanent pointer) .
I
nextptparam .............. IPROC
I
I
I
I
next pt param :
mode : = cdb int (param link) MOD ptt limit;
param link INCR wordlength ;
IF
mode
permanent row
THEIl skip over permanent row
ELIF mode = permanent struct THEN skip over permanent struct
I
FI;
I
set end ma.rker if end of list .
I
eumel coder part 1
25/4
Zeile
E LAN
186
187
188
189
skipoverpermanentrow
190
191
192
193
194
195
196
197
skipoverpermanentstruc Iskip over permanent struct
198
199
200
201
~7
eumel coder part 1
I skip over permanent row :
I
param link INCR word length
I
next pt param .
I
REP
I
next pt param ;
I
mode := cdb int (param link)
I
UNTIL mode = permanent type field PEII
I
param link INCR word length
IENDPROC next pt param ;
I
setendmarkerifendoflis ... 1PROC set end marker if end of list :
I
mode := cdb int (param link) ;
I
end of params : = mode ) = permanent proc op OR mode
IENDPROC set end marker if end of list ;
I
typeofparamproc
I
Itype
I
I
I
of param proc :
param link INCR word length
get type &nd mode (type) ;
mode : = permanent param proc
I
I
214
215
216
217
218
219
220
221
222
typeofobject
223
224
225
tr&nsl&tetypeifnecess& I tr&nsl&te type if necess&ry :
I
IF permanent row or struct THEN tr&nsl&te type FI .
226
227
228
tr&nsl&tetype
229
230
231
232
tr&nsl&temodeifnecess& Itr&nsl&te mode if necess&ry :
I
IF
mode
permanent param const THEN mode .• const
I
ELIF mode = permanent param V&r
THEN mode : = V&r
I
Fl.
I type of object :
I
IF mode < 0 THEN type .' 2769 • (32767 • mode)
I
mode := 0
I
EI£E type : = mode MOD ptt limit ;
I
mode DECR type
I
tr&nsl&te type if necess&ry
I
tr&nsl&te mode if necess&ry
I
Fl.
I
I
I
I
I tr&nsl&te type :
I
type . - param link - begin of pt minus ptt limit.
I
I
I
I
233
25/5
0
gettype&ndmode ........... IPROC get type &nd mode (INT VAR type) :
I
mode : = cdb int (param link) ;
I
IF mode = permanent param proc THEN type of param proc
I
EI£E type of object
I
FI .
210
211
212
213
234
235
236
<=
I
208
~9
10.11.86
I
I
~2
~3
~4
~5
~6
1.8 - -
EllMEL
permanentroworstruct
Ipermanent row or struct :
I
type • permanent row OR type • permanent struct
IENDPROC get type &nd mode ;
eumel coder part 1
25/0
ZeUe
E LAN
EUMEL 1.8 ••••
10.11.86
237
238
239
240
eumel coder part 1
( ..... Allgemeine Zugriffsprozeduren *****)
241
242
243
244
cdbint ................... I IN! PROC cdb int (IN! CONST index)
245
246
247
248
cdbtext .................. ITEXT PROC cdb text (IN! CONST index)
I EXTERNAL 117
IENDPROC cdb text
25/6
I
EXTERNAL 116
IENDPROC cdb int
I
I
eumel coder part 1
25/6
leile
E LAN
EllMEL
1.8
****
10.11.86
eumel coder part 1
(**. . . . . . . . . . ** •••••••• ** ••••••••****.........................****~
250
...... )
251
252
10. Inspector
16.04.1986
.)
253
.)
(
254
................................................................... .
+
255
256
257
258
259
260
261
262
263
264
265
266
267
lINT
I
280
VAR line number, pattern length, packet link,
begin of packet, last packet entry, indentation;
ITEXT VAR bulletin name, type and mode, pattern, buffer;
I
IDATASPACE VAR bulletin ds :: nilspace ;
I
I . packet
I
name :
cdb text (cdb int(packet link + wordlength) + two word length) •
I
I . wi thin editor :
I
aktueller editor ) 0 .
269
270
281
282
283
)
I
268
271
272
273
274
275
276
277
278
279
.......
I
nameoftype
.........••..•. IPROC
I
I
I
I
I
I
I
I
I
I
I
I
284
285
286
287
288
complextype
289
290
291
292
293
294
295
296
perhapspermanentstruct
name of type (INT CONST type)
SELECT type OF
CASE void
CASE int
type and mode CAT "INT"
CASE real
type and mode CAT "REAL"
CASE string
type and mode CAT "TEXT"
CASE baal, baol result
type and mode CAT "BOOL"
CASE dataspace
type and mode CAT "DATASPACE"
CASE row
type and mode CAT "ROW "
CASE struct
type and mode CAT "STRUCT"
OTHERWISE
complex type
ENDSELECT
I
Icomplex type
I
IF type ) ptt limit THEN perhaps permanent struct or row
I
ELSE get complex type
I
Fl.
I
I
Iperhaps permanent struct or row :
I
index : = type + begin of pt minus ptt limit ;
I
mode : = cdb int (index) MOD ptt limit;
I
IF
mode
permanent row
THEN get permanent row
I
ELIF mode = permanent struct THEN get permanent struct
I
I
ELSE type and mode CAT "-'
FI .
I
I
297
298
299
300
301
25/7
getcomplextype
Iget complex type :
I
index : = type + begin of permanent table ;
I
IF is complex type THEN get name
I
ELSE type and mode CAT "-'
I
FI
eume 1 coder part 1
25/7
Zeile
E LAN
1.8
iscomplextype
I is
~4
I
~5
I
I
~6
getname
~7
308
~9
.....
10.11.86
eumel coder part 1
I
I
~2
~3
EUMEL
l1nktotypename
310
complex type :
permanent type definition mode
Iget name :
I
type and mode CAT cdb text (link to type name + two word
I
length)
I
I
llink to type name :
I
cdb int (index + three word length)
I
I
311
312
313
314
permanenttypedefini tio Ipermanent type definition mode :
I
cdb int (index + wordlength)
315
getpermanentrow
I
I
316
317
318
319
320
321
322
~3
324
permanent type .
getpermanentstruct
Iget permanent row :
INT VAR t;
I
type and mode CAT "ROW " ;
I
type and mode CAT text (cdb int (index + wordlength»
type and mode CAT " "
I
I
param link : = index + two word length ;
I
get type and mode (t)
I
name of type (t)
I
I
I
326
Iget permanent struct :
I
type and mode CAT "STRUCT ( ••. )"
IENDPROC name of type ;
327
I
325
328
329
help ..................... IPROG help (TEXT CONST proc name)
I
prep bulletin ;
~
I
~p~~;
331
332
333
334
335
336
337
I
I
I
I
I
scan (object name)
next symbol (pattern)
pa.cket link : = end of permanent table
IF function
0 THEN standard help
ELSE asterisk help
Fl.
338
339
340
341
342
343
344
345
346
347
348
349
I
prephelp
I
I
Iprep
I
I
I
I
I
I
I
I
I
I
I
350
I
351
352
353
I
I
25/8
I
help
object name : = compress (proc name)
INT VAR function :: 0 ;
INT CONST 1 :: LENGTH object name ;
IF 1 ) 1 AND object name <) " • • "
THEN IF (object name SUB 1) • "."
THEN function INCH 2 ;
delete char (object name, 1)
FI ;
IF (object name SUB 1) • "."
THEN function INCH 1 ;
de lete char (object name, 1)
FI;
IF another asterisk THEN wrong function FI
Flo
eumel coder part 1
25/8
Zeile
E LAN
354
355
356
anotherasterisk
357
wrongfunction
EUMEL 1.8 ••••
eumel coder part 1
Ianother asterisk :
I
pos (object name. ".") <> 0 .
I
I
Iwrong function :
I
errors top ("unzulaessige Sternfunktion") .
358
I
359
360
361
362
363
10.11.86
I
standardhelp
Istandard help
I
to object (pattern)
I
IF found THEN display
I
ELSE error stop ("unbekannt: " + proc name)
I
I
I
364
365
Fl.
366
367
368
369
370
371
372
373
d1splay
374
375
376
377
378
379
putnameofpacketifneces Iput name of packet if necessary :
I
IF new packet THEN packet link : = permanent po1nter
I
find beg1n of packet
I
wr1teline (2) ;
I
wri te packet name
I
FI •
381
382
383
384
385
f1ndbeg1nofpacket
386
387
beg1nofpacketfound
394
399
400
401
402
403
404
405
406
25/9
show bulletin file
I
I
Ifind beg1n of packet
REP
I
packet link DEeR word length
I
UNTIL begin of packet found PER
I
I
lbegin of packet found
I
cdb 1nt (packet link) • permanent packet .
I
I
newpacket
Inew packet
permanent pointer < packet link .
I
I
391
395
396
397
398
ENDREP ;
I
I
388
392
393
I
I
I
380
389
390
Id1splay
I
WHILE permanent pointer < > 0 REP
I
put name of packet i f necessary
I
put specificat10ns (pattern) ;
I
next procedure
asteriskhelp
I
Iaster1sk
I
I
I
I
I
I
I
help :
hash table pointer .- begin of hash table
pattern length : = LENGTH pattern - 1 ;
REP
list all objects in current hash table chain
next hash entry
UNTIL end of hash table reached ENDREP
show bullet1n fH.. .
I
I
listallobjectsincurren llist all objects in current hash table chain
I
nt l1nk := hash table pointer;
I
WHILE yet another nt entry REP
I
permanent pointer : = cdb 1nt (nt link + wordlength)
I
object name : = cdb text (nt link + two word length)
I
IF matching THEN into bullet1n FI
eumel coder part 1
25/9
ZeUe
E LAN
407
408
409
410
411
412
EUMEL
1.8
1
* ..*
10.11.86
eume 1 coder part 1
PER •
1
matching
413
1
1matching
1
1NT
CONST P :: pos (object name, pa.ttern) ;
1
1
SELECT function OF
CASE 1:
p <) 0 AND P = LENGTH object name - pa.ttern
1
1
length
CASE2:
p=l
CASE3:
po0
OTHERWISE FALSE
ENDSELECT .
414
I
415
416
417
1
1
1
1
418
1nto bulletin
419
420
421
1 into bulletin
1
object names 1nto bulletin (BOOL PROC not end of chain)
1ENDPROC help
1
422
423
424
425
notendofcha1n ............ 1 BOOL PROG not end of chain :
1
permanent pointer <) 0
1ENDPROG not end of chain
426
427
428
429
430
431
432
433
434
435
436
writepa.cketname .......... IPROC write pa.cket name :
1
indenution : = 0 ;
1
wri te line ;
1
wri te bulletin line ('PACKET ")
1
indentation :. 7 ;
1
object name : = packet name ;
1
wri te bullet1n line (obJect name)
1
write bulletin line (":")
1
writeline (2)
1ENDPROC wr1 te packet name
1
437
438
439
440
441
442
putspecifications ........ 1PROG put specifications (TEXT CONST proc name)
1
put obj name (proc name) ;
1
to first param ;
1
IF NOT end of pa.rams THEN put param list FI
1
put result ;
1
wri tel1ne .
1
«3
1
1
444
445
446
447
448
449
450
451
452
453
454
455
456
25/10
tofirstparam
1to
1
1
first param :
param link : = permanent pointer + word length
set end marker if end of list .
1
putresult
1
1put result
I
INT VAP. type;
1
get type and mode (type) ;
1
IF type () void THEN type and mode . =" --)";
1
name of type (type)
1
write bulletin line (type and mode)
1
FI
IENDPROC put specifications;
1
eumel coder part 1
25/10
Zeile
457
458
459
460
461
462
463
464
465
466
467
~
469
470
471
472
473
474
475
476
E LAN
EllMEL
puttypeandmode
nameofmode
484
485
maybeparamproc
486
putvirtualparams
4~
491
492
493
skipoverresulttypeifco
494
495
496
497
endofvlrtualparams
498
504
25/11
put type and mode :
type and mode : = "" •
I
name of type (type) ;
I
type and mode CAT name of mode ;
I
write bulletin line (type and mode)
I
I
Iname
I
I
of mode :
IF
param mode
ELIF param mode
canst THEN " CONST"
var
THEN" VAR"
ELSE " FROC"
I
I
IT .
I
I
Imaybe param proc :
I
IF mode = permanent param proc THEN put virtual params
I
I
Iput virtual params :
I
skip over result type if complex type ;
I
IF Nerr end of virtual params THEN put param list FI.
I
I
Iskip over result type if complex type
I
next pt param .
I
I
IT .
lend of virtual params :
of params
put param list ;
I
end
IENDPROC
I
next packet ............... IPRo:: next packet :
I
REP
I
packet link
I
word : = cdb
I
IF
word =
I
ELIF end of
I
FI
505
506
507
508
509
eumel coder part 1
10.11.86
I
478
479
480
481
482
483
499
500
501
502
503
****
putparamlist ............. PROC put param list
write bulletin line (" (") ;
REP
TNT VAR type. param mode;
get type and mode (type)
param mode : = mode ;
pu t type and mode ;
maybe param proc
next pt param ;
IF end of params THEN write bulletin line (")")
LEAVE put param list
IT;
write bulletin line (". ") ;
PER •
~7
487
488
489
1.8
truereturn
I
I
I
I true
I
I
INCR word length ;
int (packet link)
permanent packet THEN true return
permanents
THEN false return
ENDREP .
return :
found : = TRUE ;
LEAVE next packet
eumel coder part 1
25/11
Zeile
E LAN
EUMEL
510
1.8
****
10.11. 86
eumel coder part 1
/
/
511
512
513
514
falsereturn
515
516
517
518
endofpermanents
/ false return :
found : = FALSE
/
LEAVE next packet
/
/
/
lend of permanents :
word = permanent end OR packet link ) end of permanent table
/
/ENDPROC next packe t ;
/
519
520
521
522
523
524
525
526
prepbulletin ............. / PROC prep bulletin :
/
forget (bulletin ds)
/
bulletin ds : = nilspace
/
bulletin file : = sequential file (output. bulletin ds)
/
line number : = 0
/
buffer : = ""
/ ENDPROC prep bulletin
/
527
528
529
5:30
531
532
533
showbulletinfile ......... / PROC show bulletin file :
IF within editor THEN ueberschrift neu FI ;
/
/
DATASPACE VAR loca.l ds :: bulletin ds ;
/
FILE VAR local file:: sequential file (modify. local ds)
/
show (local file) ;
/
forget (loc&1 ds)
/ ENDPROC show bulletin file
534
/
535
536
537
538
539
wri tebulletinline ........ / PROC write bulletin line (TEXT CONST line) :
/
IF LENGTH buffer + LENGTH line ) 75 THEN wri teline FI
/
buffer CAT line
/ ENDPROC write bulletin line ;
/
540
541
542
543
544
545
546
547
writeline ................ /PROC writeline
write (bulletin file. buffer)
/
line (bulletin file)
/
/
line number INCR 1 ;
cout (line number) ;
/
/
buffer := indentation *
/ENDPROC writeline ;
548
549
550
551
552
553
554
555
556
557
558
writeline ................ / PROC writeline (INT CONST times) :
IF LENGTH compress (buffer) <> 0 THEN index : = times - 1
/
write line
/
EISE index :. times
/
FI;
/
line (bulletin file. index)
/
line number INCH index;
/
indentation : = 0 ;
/
cout (line number)
/
/ENDPROC writeline
25/12
/
/
eumel coder part 1
25/12
E LAN
Zeile
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
EUMEL
1.8
bulletin ................. IPROC
I
I
I
I
I
I
I
I
I
I
topacket
582
583
584
+
585
586
587
588
589
bulletin (TEXT CONST packet name)
prep bulletin ;
scan (packet name) ;
next symbol (pattern)
to packet ;
IF found THEN list packet
show bulletin file
ELSE error stop (packet name + " ist kein P&ketname")
FI .
I
I
p&eketfound
I packet found
I
IF cdb int (packet link + wordlength) = nt link
I
THEN last packet entry :. packet link FI .
I
I
return
I return
I
IF last packet entry ()
I
I
I
598
FI ;
I
LEAVE to packet
IENDPROC bulletin
599
I
606
6@7
608
609
610
611
25/13
eumel coder part 1
getnametablinkofpacket Iget nametab link of packet name
I
to object (pattern) ;
I
IF NOT found THEN error stop ("unbekanntes Paket :" + packet
I
name) ;
LEAVE to packet
I
FI .
I
591
600
601
602
'*>3
604
605
****
I
I
590
592
593
594
595
596
597
10.11.86
to packet
last packet entry : = 0 ;
get name tab link of packet name ;
packet link : = before first pt entry
REP
packet link INCH word length ;
word: = cdb int (packet link)
IF word ( 0 THEN IF
word = permanent packet THEN packet
found
THEN return
ELIF word • permanent end
FI
FI
ENDREP
+
577
578
579
580
581
****
listpacket ............... IPROC
I
I
I
I
o THEN
found : = TRUE ;
packet link : = last packet entry
ELSE found : = FALSE
list packet :
begin of packet : = packet link + word length
wri te packet name ;
find end of packet ;
run through name tab and list all packet obJects .
I
I
findendofpacket
Ifind end of packet
I
last packet entry : = begin of packet ;
I
REP
I
last packet entry INCH wordlength ;
I
word : = cdb int (last packet entry)
I
UNTIL end of packet entries PER .
eumel coder part 1
2:1/13
Zeile
E LAN
1. 6
EllMEL
M2
**-
10. 11. 66
eume 1 coder part 1
I
I
613
614
615
endotpacketentries
Iend 01' packet entries
I
word = permanent packet OR word
616
617
616
619
620
621
622
623
runthroughnamet&b&ndli Irun through namet&b and list all packet objects
I
hasht&ble pointer := begin 01' hasht&ble
I
REP
I
nt link : = hasht&ble pointer ;
I
list objects 01' current packet in this chain
I
next hash entry
I
UNTIL end 01' hash table reached ENDREP .
624
625
626
627
626
629
listobjectsotcurrentpa llist objects 01' current packet in this chain :
I
WHILE yet another nt entry REP
I
permanent pointer : - cdb int (nt link + wordlength)
I
put objects 01' this name
I
PER .
630
631
putobjectsofthisname
=
peranent end .
I
I
I
I
632
I
I
Iput objects 01' this name :
I
IF there is at least one object
I
packet
I
THEN into bulletin FI .
ot th1s name 1n the current
I
I
633
634
635
636
637
636
639
640
641
642
643
thereisatleastoneobjec I there is at least one object of this name in the current packet
I
REP
I
IF permanent pointer ) = begin of packet AND
I
permanent pointer ( Last packet entry
I
THEN LEAVE there 1s at least one object of this name
I
1n the current packet WITH TRUE FI
I
next procedure
I
UNTIL permanent pointer = 0 PER ;
I
FALSE.
644
645
646
647
646
1ntobulletin
649
650
651
652
~3
654
655
656
657
656
659
660
25/14
I
I
linto bulletin :
I
object name : = cdb text (nt link + two word length) ;
I
object names into bulletin (BOOL PROC within packet)
IENDPROC list packet ;
I
withinpacket ............. IBOOL PROC wi thin packet :
I
permanent pointer ). begin of packet AND
I
permanent pointer ( Last packet entry
IENDPROC within packet
I
objectnamesintobulleti ... IPROC
I
I
I
I
I
I
object names into bullet1n (BOOL PROC link ok)
scan (object name) ;
next symbol (object name. mode) ;
IF type defin1 t10n THEN put type det1n1 t10n
EUlE put object detini tions
FI .
eumel coder part 1
25/14
Zeile
E LAN
EUMEL
661
662
663
typedefini tion
664
665
666
nopara.ms
667
668
669
670
671
puttypedefini tion
672
673
674
675
676
677
678
putobjectdefini tions
1.8
****
10.11.86
eumel coder part 1
Itype definition :
I
mode = bold AND no params .
I
I
Ino params :
I
cdb int (permanent pointer + word length) ) = permanent type .
I
I
I put type definition :
I
put obj name (object name)
I
write bulletin line ("TYPE ")
writeline (1) .
I
I
I
Iput object definitions:
I
WHILE link ok REP
I
put specifica.tions (object name)
next procedure
I
I
ENDREP
IENDPROC object names into bulletin
I
679
680
681
682
683
684
685
686
687
688
589
bulletin ................. IPROC bulletin:
I
prep bulletin
I
packet link : = first permanent entry
I
REP
I
list packet ;
I
write line (4)
I
next packet
I
UNTIL NOT found PER
I
show bulletin file
IENDPROC bulletin ;
690
691
692
693
594
695
696
putobjname ............... IPROC
I
I
I
I
I
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
25/15
I
put obj name (TEXT CONST name)
buffer := •
" ;
bulletin name : = point line ;
change (bulletin name, 1, end of line or name, name)
buffer CAT bulletin name ;
indents. tion : = LENGTH buffer + 1 .
I
I
endoflineorname
lend of line or name :
I
min (LENGTH name, LENGTH bulletin name)
IENDPROC put obj name ;
I
packets .................. IPROC
I
I
I
I
I
packets :
prep bulletin
packet link := first permanent entry
REP
object name : = packet name
put obj name (object name)
I
wri te line ;
I
next packet
I
UNTIL NOT found PER
I
show bulletin file
IENDPROC packets
I
sume 1 coder part 1
25/15
Zeile
714
E LAN
EUMEL
1. 8
eumel coder part 1
******)
1(*
I
716
10 . 11. 86
1(***************************************************************. . *M
I
715
****
*)
1(*
I
11. ELAN Run-Interface
09.01.1986·)
717
1(*
718
(*
Uebersetzen von ELAN-Progranunen
719
(.
BereHstellen der Ausgabeprozeduren fuer den ELAN-Compiler
*)
*)
*)
720
*)
(******.*******.***********. . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . ...
721
.*.... )
722
723
724
725
726
727
728
729
730
731
732
733
734
: = FALSE
IBOOL VAR list option
check option
I
· - TRUE
warning option · - FALSE
I
listing enabled · - FALSE
I
I
IFILE VAR listing file
I
ITEXT VAR listing file name :=
I
I
735
736
737
738
739
740
741
742
743
run ...................... IPROG run (TEXT CONST file name)
I enable stop ;
I IF NOT exists (file name)
I
THEN errors top ("""" + file name +
I FI;
I last param (file name)
I run elan (file name, no ins)
IEND PROG run;
744
745
746
747
run ...................... IPROG run :
I run (last param)
IENDPROC run ;
748
749
750
751
752
753
754
755
runagain ................. IPROC run again:
I IF run again mod nr <) 0
I
THEN elan (run again mode, bulletin file, "", run again IIIOd nr,
I
no ins, no 1st, check option, no sermon)
I
ELSE errors top ("' run again' nicht moegl1ch")
I FI
IENDPROC run again;
756
757
758
759
insert ................... IPROC insert (TEXT CONST file name)
I enable stop ;
I IF NOT exists (file name)
I
THEN errorstop (""MM + file name + """ gibt es nicht")
25/16
MM"
gibt es nicht")
I
I
I
eume I coder part 1
25/16
Zeile
E LAN
--..
10.11.86
I
insert ................... IPROC insert :
I insert (last param)
IENDPROC insert ;
I
runelan ••.•......•.•..•.. IFROC run elan (TEXT CONST file name, BOOL CONST insert option)
I FILE VAH source : = sequential file (modify, file name) ;
I IF listing enabled
I
THEN open listing file
I FI;
I
I
I
I
I
I
I
I
I
I
I
I
I
I
disable stop ;
no do again ;
elan (compile file mode, source, "" , run again mod nr,
insert option, list option, check option, sermon)
IF anything noted AND command dialogue
THEN ignore halt during compiling
note edi t (source) ;
last param (file name) ;
errorstop ("")
Fl.
787
788
789
790
791
792
793
ignorehaltduringcompil lignore halt during compiling
I IF is error
I THEN put error ;
I
clear error
I
pause (5)
I Fl.
794
795
796
797
798
799
openlistingfile
800
801
802
803
804
805
+
806
807
808
809
~
811
M2
25/17
eume I coder part 1
FI;
last par&m (file name) ;
run elan (file name, ins)
IENDPROC insert
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
1.8
I
I
I
760
761
762
763
764
765
766
767
EUMEL
I
I
lopen listing file :
listing file := sequential file (output, listing file name)
III&X line length (listing file, 130)
I
I
I
IENDPROC run elan
I
outtext .................. IPROC out text (TEXT CONST text, INT CONST out type)
I INTERNAL 257 ;
I IF online
I THEN out (text)
I FI;
I IF out type = error message OR (warning option AND out type =
I
warning message)
I THEN note (text)
I FI;
I IF listing enabled
I THEN write (listing file, text)
I FI
IENDPROC out text
I
eumel coder part 1
25/17
Zeile
E LAN
EUMEL
1.8
****
10.11.86
eumel coder part 1
813
814
815
816
817
818
819
820
821
822
823
824
825
outlina .................. IPROC out line (INT CONST out type)
I INTERNAL 258 ;
I IF online
I
THEN out (~~13~~10~~)
I FI;
I IF out type = error mess~e
I
OR (warning option AND out type = warning mess~e)
I
THEN note line
I ELIF listing enabled
I
THEN line (listing file)
I FI
IENDPROC out line
826
827
828
829
830
831
prot ..................... IPROC prot (TEXT CONST file na.me)
I list option : = TRUE ;
I listing file name : = file name
I listing en&bled : = TRUE
IENDPROC prot
832
833
834
835
8M
protoff .................. IPROC prot off :
I list option : = FALSE ;
I listing an&bled : = FALSE
IENDPROC prot off
837
838
839
M0
prot .........•••......... IBOOL PROC prot
I list option
IENDPROC prot
Ml
M2
M3
chackon .................. IPROC check on :
I check option :. TRUE
IENDPROC check on
M4
I
I
I
I
I
M5
M6
M7
M8
checkoff ................. I PROC check off :
I check option : = FALSE
IENDPROC check off
M9
850
851
852
check .................... IBOOL PROC check
I check option
IENDPROC check
853
854
855
856
warnlngson ............... IPROC warnings on:
I warning option : = TRUE
I ENDPROC warnings on
25/18
I
I
I
eumel coder part 1
25/18
Zeile
857
858
859
86@
861
862
863
864
865
25/19
-
E LA N
EUMEL
1.8
---
10.11.86
eumel coder part 1
wa.rnJ.l1Isoff . ............. IPROC warnings off :
I warning option . - FALSE
I ENDPROC warnings off ;
I
w&rlling_ ................. IBOOL PROC warnings
I warning option
IENDPROC warnings ;
I
I ENDPACKEI' eumel coder part 1
eumel coder part 1
25/19
Zeile
E LAN
EUMEL
1.8
****
mathlih
10.11.86
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
1(* ------------------- VERSION 2
06.03.86 ------------------mathlib ********* ••***.*.* IPACKET mathlib DEFINES sqrt, **, exp, In, log2, logi0, a, pi,
I
sin, cos, tan, sind, cosd, tand,
1
arctan, arctand, random, initializerandom
25
pi ....................... IREAL PRoo pi:
pii
END PROC pi;
26
27
e ........................ IREAL PROC e
ei
END PRoo e;
28
29
30
31
In ....................... I REAL PRoo
32
33
log10 .................... IREAL PROC log10 ( REAL CONST x ):
I
log2(x) * :!g2
I END PROC log10;
34
1
ILET
1
1
1
36
38
39
40
41
42
43
44
45
46
47
48
26/1
3.141592653589793238462,
1. 570796326794896619231,
1.047197551196597746154,
0.523598775598298873077,
1.273239544735162686151,
0.693147180559945309417,
0.301029995663981195213,
2. 302585092994045684e18 ,
e.434294481ge3251827651,
2.7182818284591;)45235361;),
57. 29577951308232l'J876798,
1. 732051il807568877293527,
e. 57735e2691896257645e9,
3. 732e50807568877293527,
e. 2679491924311227e6473,
0.707106781186547524400;
IREAL VAR rdg: :0.4711;
I
I
I
In
(REAL CONST x ):
log2(x) * ln2
1END PROC
In;
I
I
35
37
pH
pi2
pi3
pi6
pi4
ln2
:!g2
ln10
:!ge
ei
pi180
sqrt3
sqr3 =
sqr3p2=
sqr3m2=
sqr2 =
log2 ..................... 1REAL PRoo log2 ( REAL CONST z ):
1 REAL VAR t, summe: :0.e, x: :z;
I IF x=1.0 THEN 0.0
1 ELIF x,0.0 THEN normal
I
ELSE errorstop( "log2: " + text (x,20)); 0.0
FI.
1
normal
I
Inormal:
I IF x, = 0.5 THEN normalise dOllnllards
I
ELSE normalise upllards
I IF x (sqr2 THEN summe .- summe - 0.75;
I
ELSE summe .- summa - 0.25;
I summe + reihenentllicklung.
I
mathlih
FI;
t := trans8
t := trans2
FI;
26/1
E LAN
Zaile
EUMEL
1.8
****
mathlib
10.11.86
normalise downwards;
WHILE x)= 8.0 REP
WHILE x)= 1.0 REP
x ._
normalise upwards:
WHILE x<=0.0625 REP
WHILE x<= 0.5
REP
x.=
x.-
49
50
51
52
normalisedollnlla.ros
53
54
55
56
normaliseupllards
57
trans8
trans8: (x - 0.5946035575013605)/(x + 0.5946035575013605).
58
59
trans2
trans2: (x - 0.8408964152537145)/(x + 0.8408964152537145).
relhenentlllckiung
reihenentllicklung:
x ._ 0.0625 * x;
8.5 • x;
x: = t
16.0 * x;
2.0 * x;
* t;
summe:=summe+4.0
summe: =summe+1.0
PER;
PER.
summe:=summe-4.0 PER;
summe:=summe-1.0 PER.
t * 0.06405572387119384648
+
(( (( ( (3.465*x+4.095)*x+5 .005)*x+6.435)*x+9.009)*x+15.015)*x+45 .045)1
IEND FROC log2;
61
62
63
64
65
66
67
68
69
70
?1
72
I
sqrt •.................... IREAL FROC sqrt ( REAL CONST z ):
I REAL VAR y0, yl, x: :z;
INT VAR P :: decimal exponent( x) DIV 2;
IF
p <= -64 THEN 0.0
ELIF x < 0.0 THEN errorstop("sqrt: " + text (x,20»; 0.0
ELSE nontrivial
Flo
nontrivial
?3
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
26/2
nontrivial:
set exp (decimal
IF x<10.0 THEN x
ELSE x
y0 := x;
set exp (decimal
y1 . - 0.5 * ( y0
y0 : = 0.5 * ( yl
y1 : = 0.5 * ( y0
0.5 * ( yl
IEND PROC sqrt;
exponent (x) -p-p, x);
.- 5.3176703 - 40.760905/( 8.408065 + x
:= 16.81595 - 1288.973 I( 84.08065 + x
FI;
exponent (x) + p, y0);
+ z/y0 );
+ z/yl );
+ z/y0 );
+
z/y1 )
I
exp ...................... IREAL PROC exp ( REAL CONST z ):
I REAL VAR x: :Z, a: :1.0; BOOL VAR negativ .. x<0.0;
I IF
negatlv
THEN x := -x FI;
I IF
x)292.42830676
I
THEN IF NOT negativ THEN errorstop (~REAL-Ueberlaut~) FI
I ELIF x< =0.0001
I
THEN ( 0.5*z + 1.0 ) * z + 1.0
I
ELSE approx
I Flo
approx
0.0
I
I
I approx:
IIFx)ln10
I THEN x : = 1ge*x;
I
a:=lo,
I
set exp (int(x), a);
I
x : = trae( x)*ln10
I FI;
math lib
25/2
Zaile
100
101
102
103
104
105
106
107
lElA
109
110
E LAN
1.8
EUMEL
****
10.11.86
mathlib
I IF x ,= 2.0 THEN a : = 7. 389056098930650227230-a; x = x-2.0 FI;
I IF x ,= 1.0 THEN a := 2.718281828459045235360*a; x = x-1.0 FI;
I IFx ,= 0.5 THEN a : = 1. 648721270700128146848-a; x = x-0.5 FI;
I IF x ,= 0.25 THEN a : = 1. 284025416687741484073-a; x = x-El.25 FI;
I IF x ,= 0.125 THEN a : = 1. 133148453066826316829-a; x = x-0.125 FI;
I IF x , = 0. 0625THEN a : = 1. 064494458917859429563-a; x = x-El.0625FI;
I
a: =a/50.4*( (( (( ((0.01.x+0.07).x+0.42).x+2.1).x+8.4).x+25.2).x+5
I
0.4)*x+50.4) ;
I
I IF negativ THEN 1.0/8. ELSE a FI
I
IENDPROC exp
I
111
112
113
114
115
tan ...................... IREAL PROC tan (REAL CaNST x):
I IF x < 0.0 THEN - tg( -x • p14)
I
ELSE
tg( x * pi4)
IEND PROC tan;
116
117
118
119
120
tand ..................... IREAL PROC tand (REAL CaNST x):
I IF x < 0.El THEN - tg( -x / 45.0)
I
ELSE
tg( x / 45.0) FI
IEND PROC tand;
121
122
123
124
125
126
127
128
129
130
131
132
133
tg ....................... IREAL PROC tg (REAL CONST x ):
I REAL VAR q: :floor(x), s: :x-q; INT VAR n;
I q:= q - floor(0.25-q) .4.0 ;
I IF q < 2.El
I THEN IF q < 1.0
I
THEN n:=0;
I
ELSE n:=l; s := 1.0 - s FI
I ELSE IF q ( 3.El
I
THEN n: =2;
I
ELSE n:=3; s := 1.0 - s FI
I FI;
I q:= s • s;
q : = (( (( (( (( (-5. 116186989653121!le-11-q-5.608325El22830701e-1El).q-
FI
I
I
134
9. 526170109403018e-9)-q-1. 517906721393745e-7 )-q-2. 430939946375
515e-6).q135
3. 901461426385464e-5)-q-6.324811612385572e-4)-q-1.El76696829172
646e-2)-q0.2617993877991508)-q+p14);
+
136
137
138
139
140
141
142
143
144
145
26/3
SELECT n OF
CASE 0 : s/q
CASE 1 : q/s
CASE 2 : -q/s
OTHERWISE : -s/q ENDSELECT
IEND
PROC tg;
I
mathlib
26/3
Zone
E LAN
EUMEL
1. 8
****
10.11 .86
mathlib
...................... IREAL
PROC sin ( REAL CONST x ):
REAL VAR y, r, q;
IF x ( 0.0 THEN y := -x; q .- 4.0 ELSE Y := x; q := 0.0 FI;
y: = y * pi4;
r : = floor(y);
sincos( q+r , y-r
IEND PROC sin;
146
147
148
149
150
151
152
153
sin
154
155
156
157
158
159
160
161
sind
162
163
164
165
166
167
168
169
cos
170
171
172
173
174
175
176
177
cosd
178
179
180
sincas ................... IREAL PROC sincos ( REAL CONST q, Y ):
I REAL VAR r :: q - floor( 0.125*q + 0.1 )
I IF r ,= 4.0 THEN IF r ,= 6.0 THEN IF r
approx( 1.0-y)
181
182
183
184
+
185
186
187
188
189
26/4
I
I
I
I
I
I
..................... IREAL PROC sind ( REAL CONST x ):
I REAL VAR y, r, q;
I IF x ( 0.0 THEN y .- -x; q := 4.0
I y:= y / 45.0;
I r:= floor(y);
I sincos( q+r , y-r
ELSE y := x; q := 0.0 FI;
lEND PROC sind;
I
...................... IREAL PROC cos ( REAL CONST x ):
I REAL VAR y, q;
I IF x ( 0.0 THEN Y .- -x ELSE y
I y: = y * pi4;
I q:= floor(y);
I sincos( q+2.0, y-q )
IEND PROC cos;
I
..................... IREAL PROC cosd ( REAL CONST x ):
I REAL VAR y, q;
I IF x ( 0.0 THEN Y . - -x ELSE y
I y:. y / 45.0;
I q:= flaor(y);
I sincos( q+2.0, y-q )
:= x FI;
.' x FI;
lEND PROC cosd;
I
*
8.0;
7.0 THEN - sin
ELSE - cos approx( y)
FI
ELSE IF r ,. 5.0 THEN - cos
approx(1.0-y)
ELSE - sin approx(y)
FI FI
ELSE IF r ,= 2.0 THEN IF r ,= 3.0 THEN
sin
approx( 1. 0-y)
ELSE
cos approx( y)
FI
ELSE IF r , = 1. 0 THEN
cos
approx( 1. 0-y)
ELSE
sin approx( f
FIFIFI
lEND PROC sincos;
I
math lib
26/4
Zeile
190
191
192
+
E LAN
1.8
****
mathlib
10.11.86
sinapprox ................ I REAL PROC sin approx ( REAL CONST x ):
I REAL VAR z: :x*x;
I
I
I
I
I
I
I
193
x.((((((0.6877101540593035e-ll.z-0.1757149296873372e-8).z+0.313
3615215572568
e-5) .z-0. 3657620415845891e-4 ).z+0. 24903945701887378-2 ).z-0. 8074
55121882e-l).
z+0.7853981633974483)
IEND PROC sin a.pprox;
194
195
196
197
198
199
EUMEL
I
cosapprox ................ 1REAL PROC cos approx ( REAL CONST x ):
1 REAL VAR z: :x.x;
1
( ( ( ( ( ( -0. 3857761864560276e-12.z+0 . 115004970178141e-9).z-0 . 24611
363826741ge-7
1
1
200
1
1
) .z+0. 3590860445885748e-5 ) .. z-0. 3259918869266875e-3).z+0 .1585434
424381541e-l)
1 "z-0.3084251375340425).z+1.0
1END PROC cos approx;
I
201
202
203
204
205
206
207
208
209
210
+
1
arctan ................... IREAL PROC arctan (
I REAL VAR f, z, x;
I IF neg THEN x
IF
x)1.0 THEN f
REAL CONST Y ):
BOOL VAR neg .. y < 0.0;
.- -y ELSE x := y FI;
:= a ELSE f := -b; neg := NOT neg FI;
z.-x*x;
x : = x/( (( (( ( (0. 0107890276046822.z-0 . 01647757182108040)-z
211
212
213
IF
214
a
215
b
+0.02177846332482151) .z-0. 83019339673273880) .z+0. 046560835
61183398)-z
-0. 0888888888888888).z+0. 3333333333333333)-z+1.0) ;
neg
THEN x - f ELSE f - x FI.
a:IF x)sqr3p2 THEN x := 1.0/x; pi2 ELSE x :*
4.0/(sqrt3+x+x+x)-sqr3; pi3 Fl.
1
b:IF x.1:.86
E _ " ti
I; * ------------------2
get command •
analyze command
do corr-.mand •
command error ,
CO'ler tracks :
10
11
12
13
14
15
16
17
18
19
20
21
22
23
ILET cr If
esc k
I
I
I
I
I
I
I
I
I
~''"4''''13'"''10,.''
""27"k"
command pre
command post
m&X
""4""13'"
""13""10"
command length : 2010
tag type
text type
eof type
1
4
7
I
ITEXT VAR command handlers own command line ; =
previous command line : = "" ,
symbol •
procedure •
pattern •
error note :=
I
I
24
25
26
27
28
29
30
31
32
INT VAR
symbol type ;
getcommand •••......•••... I PROC get command (TEXT CONST command text) :
I
I
I
get command (command text. command handlers own command line)
IENDPROC get command;
I
38
ge tcomrnand •••••.••.•••••• I PROC get command (TEXT CONST command text. TEXT VAR command line)
I
I
I
I
I
I
45
46
47
48
49
50
51
errorprotocoll
52
53
54
55
56
getcommandfromconsole
27/1
05.05.86 ------------------- * I
\* Auto,.: J.Liedtke *)
I
8
9
39
40
41
42
43
44
VERSIOt; 2
commandhandler *********** I PACKET command handler DEFINES
3
33
34
35
36
37
ccmmand handler
set line nr (0) ;
error protocoll ;
get command from console
lerror protocoll :
IF is error
THEN put error
clear error
ELSE command line : =
FI.
I
I
I
I
I
I
I
Iget command from console
I normalize cursor ;
I REP
I
out (command pre)
l o u t (command text) ;
command handler
27/1
Zelle
E LAN
EmlEL
1.8
........
10.11.86
command handler
out (command postl ;
edi tget command
UNTIL commar.d line () "" PE!l
para~ posltlon IIENGTH command linel
out (command postl .
57
58
59
50
61
62
I
63
64
65
edi tgeocommand
leditget command
TEXT VAH e:·:it char
I FEP
I
get cursor Ix. yJ ;
I
ed1tget (comman:t symbo: ;
IT symbol type (> tag type AllD symbol
THEN error : "Name unguel tig")
impossib:e command
ELIT pos (command list, symbol) > Ii)
THEIl procedure name ;
parameter list pack option ;
nothlng else in command line
decode command
ELSE imposs;,ble command
"?"
rr.
Iprocedure name :
I procedure: = symbol
! next symbo 1 .
I
I
Iparamote!' list pack option
I number of params :. 13 ;
I param 1 : = "" ;
I param 2 : = "" ;
14~
I
145
146
H7
148
149
1513
151
152
:'53
I
I
I
I
I
I
I
IF symbol. "I"
THEN next symbol
parameter list
rr symbol () ")" AND error note THEN error 1"1 fehh")
FI
ELrr symbol type (> eof type
THEN error ("( fehlt")
I rI.
I
I
154
155
156
157
158
159
160
parameterl1st
161
162
163
164
165
:'66
nothingelseincommandli
'C:I/3
Iparameter list :
I parameter I param 1. number
I rr symbol = "."
I
THEN next symbol ;
I
I
rr.
of params, permi t ted type)
parameter I param 2. number ot params. permitted type)
I
I
Inothing
I
I
I
I
else in command line
next symbol ;
rr symbol (>
THEN error ("Kommando zu schlli.rig")
l'I.
I
command handler
'C:I/3
E LAN
1.6;
decodecommand
158
EU!.:r:L
1..8
""***
command handler
:0.11.86
Idecode command :
I command inde;·:
index
I
command list, procedure, number of paramsl
I
169
170
171
172
173
174
impossi blecommand
Ilmposs 1 ble command
I command inde:< : = 0
i
IENDPROC analyze command
I
175
176
177
178
179
180
181
182
183
184
185
186
parameter ................ IPROC parameter (TEXT VAR param, INT VAR number of params,
I
INT CONST permitted type I :
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
lndex .................... lINT PRoe i nde;:
204
205
206
207
I
I IT s:lmbol type = text type OR symbol type = permitted type
THEN param :. symbo 1 ;
I
n~mber of params :NCR 1 ;
I
ne:-:t symbol
I
ELSE error ,"Parameter ist kein TEXT (." fehltl":
I
I rr
I
!ENDPR08 parameter
I
INT CONS': params)
TI
ELSE 0
TI.
procedure name found
211
212
213
getparamlndex
Iprocedure name found :
I HIT VAR index pas : = pos (11st, pattern) ;
I WHILE index pas > <;) REP
I
IF index pas = 1 COR (list SUB index pos - 1) (. "9"
!
THEN LEAVE procedure name found WITH TRUE
I
rr;
1ndex pos .- pas (11st, pattern, 1ndex pos
I
I PER ;
I FALSE .
I
I
+
1)
Iget param index :
I INT CONST param index : =
I
poe = 0
Th"EN command index + param index
ELSE - command index
208
217
TElT CONST list,
! pattern := procedure;
I pattern CAT ":" ;
I IF procedure name found
209
210
214
215
216
I
I
1 .
I
command handler
27/4
Zeile
218
219
220
221
command handler
E LAN
getcomrr.andir.de:<
Iget oo:r.",and index :
INT CONST command ':nde;.: : =
int ( subte:= 0.0
THEN int (em * font store. >: unit + 0.5
ELSE int (em * font store. Y. unit - 0.5
n
I
lEND PROe
Y.
step conversion;
I
!
228
· ......... IREA1 p:«Je " step conversion (INT CONST
I
I in1 tiallze if necessary;
I real ~ steps J / font store. X unit
I
IEND PROe :.: step conversion;
I
I
steps)
229
230
231
232
233
234
235
236
>:stepconyersior.
237
238
239
240
241
242
243
244
245
246
247
ystepconversion · •..••.••. lINT PROC
248
249
250
251
252
253
254
255
ystepconversion
256
257
258
259
onstring ................. ITEXT PROC on string (INT CONST mod1fication)
26E)
261
262
263
264
265
266
267
268
S31/5
j'
step conversion
(REAL
I
I in1 tialize if necessary;
I IF e!ll >= 0.0
TIIEN int (em. font store.
I
ELSE int (em. font store.
I
I n
I
CONST em)
y unit + 0.5
y unit - 0.5
lEND PROC y step conversion;
I
I
· ...... " .. IREAL PROC y step conversion (INT CONST
I
I initialize if necessary;
I real (steps) / font store. y unit
I
steps)
lEND PROC Y step conversion;
I
I
I
I
ini tialize if necessary;
I SELECT modification OF
I
CASE underline
I
CASE bold
I
CASE italics
I
CASE reverse
I
OTHERWISE
I END SELECT
I
font store. on strings (1)
font store. on strings (2)
font store. on strings (3)
font store. on strings (4)
errcrstop ("unzulaessige Modifikation");
lEND PROC on string;
I
font store
S31/5
Zeile
....
ELAN
EllMEL
1.8
••••
10.11.86
font store
269
270
offstring ................ ITEXT PROC
~1
I
272
273
274
275
276
277
278
279
I
I
I
I
I
I
I
I
I
28(')
284
285
286
287
initialize if necessary;
SELECT modification OF
CASE underline
font store. off strings
CASE t~ld
font store. off strings
CASE i ta.llcs
font store. off strings
CASE reverse
font store. off strings
Ol'IIERWISE
errorstop (ftunzulaessige
END SELECT
IEND PROC
I
281
282
283
off string (IN! CONST modification)
(1)
(2)
(3)
(4)
Modifilcation ft );
off string;
I
font ..................... I IN! PROG font (TEXT CONST font name)
I
288
I
I
I
289
290
291
292
293
294
295
296
297
I
I
I
I
I
IEND
I
I
I
ini tialize if necessary;
buffer: = font name;
change all (buffer, ft ft, ftft);
IN! CONST link nr : = link (font names, buffer)
IF link nr () 0
THEN font name links ISUB link nr
EI.'>E (;)
FI
PROC font;
298
299
300
301
302
303
304
305
306
307
308
309
310
font ..................... ITEXT PROC font (IN! CONST font number)
311
M2
313
314
315
M6
317
fontexists ............... IBOOL FROG font exists (TEXT CONST font name)
318
319
nextla.rgerfontexists ..... IBOOL PROC next la.rger font exists( IN! CONST font number,
I
IN! VAR
next la.rger font)
320
S31/6
I
I
I
I
I
I
I
I
I
ini tialize i f necessary;
IF font number ) = first font AND font number < = la.st font
THEN name (font names, fonts. font name indexes ISUB 1)
EI.'>E ftft
FI
. fonts : font store. fonts (font number)
lEND FROG font;
I
I
I
I font (font name) () (;)
I
IEND PROC font exists;
I
I
I
font store
S31/6
E LAN
EUMEL
1. 8
321
322
323
324
325
I
I
IF next larger font <) 0
THEN next larger font : = font name links ISUB next
larger font;
next larger font <) 0
ELSE FALSE
FI
ELSE errors top ("Font" + text (font number) + " gibt es
nicht") ;
FALSE
I
I
I
I
I
I
I
IF!
I
I . fonts
I
328
329
330
331
332
333
334
335
336
337
lEND PROC next larger font exists;
I
nextsmallerfontexists .... IBOOL PROC next smaller font exists (INT CONST font number.
I
INT VAR
next smaller font)
I
I ini tialize if necessary;
I IF font number )= first font AND font number <= last font
I
THEN next smaller font : = fonts. next smaller font;
I
IF next smaller font <) 0
I
THEN next smaller font : = font name links ISUB next
I
smaller font;
I
next smaller font <) 0
I
ELSE FALSE
I
FI
I
ELSE errorstop ("Font" + text (font number) + " g1bt es
I
nicht");
I
FALSE
I IT
I
I . fonts : font store. fonts (font number)
I
IEND PROC next smaller font ex1sts;
I
I
+
~0
~1
~2
353
354
355
~6
357
+
364
365
366
367
368
369
370
S31/7
: font store. fonts (font number)
I
346
347
348
349
358
359
360
361
362
363
font store
10.11. 86
I initialize if necessary;
I IF font number ) = first font AND font number <= last font
THEN next larger font : = fonts. next larger font;
I
326
327
338
339
340
341
342
343
344
345
.... "..
fontlead
................. IINT PROC font lead (INT CONST font
I
I ini tialize i f necessary;
I IF font number ) = first font AND
I
I
I
I
I
I
number)
font number <= last font
THEN fonts. font lead
ELSE errors top ("Font "
nicht"); 0
+
text (font number) + " gibt es
FI
. fonts : font store. fonts (font number)
I
lEND PROC font lead;
I
I
font store
S31/7
E LAN
Zeile
371
:572
:57:5
374
375
:576
I
I
I
I
I
I
10.11.86
font store
ini tialize if necessary;
IF font number )= first font AND font number < = last font
THEN fonts. font height
EISE errors top ("Font" + text (font number) + " gibt es
nicht"); 8
IF!
I
I
I
. fonts : font store. fonts (font number)
lEND PROC font height;
I
I
:583
fontdepth
................ I INT
I
I
:586
i
:587
I
:588
I
I
I
:589
+
:590
:591
392
393
394
395
396
:597
:598
399
400
481
402
n_
fontheight ............... lINT PROC font height (INT CONST font number)
377
378
379
380
:581
:582
:584
:585
EUMEL 1.8
PROC font depth (INT CONST font number)
ini tialize if necessary;
IF font number ) = first font AND font number <= last font
THEN fonts. font depth
EISE errors top ("Font " + text (font number) + " gibt es
nicht"); 8
FI
I
I .
I
IEND
I
I
fonts : font store. fonts (font number)
PROC font depth;
indentationpitch ......... INT PROC indentation pitch (INT CONST font number)
initialize if necessary;
IF font number ) = first font AND font number <= last font
THEN fonts . indentation pitch
EISE errors top ("Font " + text (font number) + " gi bt es
nicht"); 8
FI
+
403
4Cil4
. fonts : font store. fonts (font number)
485
4Cil6
487
lEND PROC indentation pitch;
488
I
I
489
418
411
412
413
414
415
+
416
417
+
418
419
428
421
531/8
charpitch
................ I INT PROC char pitch (INT CONST font number,
I
TEXT CONST char ) :
I
I initialize if necessary;
I IF font number ) = first font AND font number <= last font
THEN INT CONST pitch : = font. pitch table (code (char SUB
I
1) ;
I
IF
pi tch = maxint
I
THEN extended char pitch (font number, char SUB
I
char SUB 2)
I
ELIF pitch < 8
I
THEN pitch XOR (-maxint-1)
I
EISE pitch
I
F!
I
font store
S:51/6
1) +
1,
E :. A N
EUMEL
1. 8
422
I
423
I
In
I
424
425
-l27
lEND
428
I
I
429
moc
434
435
436
437
438
439
440
441
442
4-<3
444
445
446
447
I
IEND
I
I
448
449
e0
451
replacement
char pitch;
CONST font number,
PROC extended char pi tch;
.............. ITEXT PROC replacement ( INT CONST font number,
TEXT CONST char ) :
I
I
I ini tialize i f necessary;
I IF font number ). first font AND font number
(. last font
THEN link nr : = font. replacements table (code (char SUB 1) +
1) ;
+
IF link nr = maxint
THEN extended replacement (font number, char SUB 1,
char SUB 2)
ELSE process font replacement
FI
ELSE errors top (·Font • + text (font number) + • gibt es
nicht"); ""
458
459
460
461
462
+
S31/9
font store. fonts (font number)
I
TEXT CONST esc char, char)
I
I ini tiaUze if necessary;
I IF font number ) = first font AND font number (= last font
I
THEN extension. pitoh table (code (char) + 1)
I
ELSE errors top (·Font • + text I font number) + • gibt es
I
nicht·); 0
I TI
I
I
font
font store. fonts (font number)
I
I
extension
font store. extensions (extension number)
I
I
extension number
I
INT CONST index: = pos (font. extension chars, esc char);
I
IF index = 0
I
THEN errors top ( •••• + esc char + char + ••• hat keine
I
Erwei terung·) n;
I
font. extension indexes ISUB index
432
433
463
464
465
466
467
468
469
470
471
472
473
font store
extendedcharpi tch ........ lINT PROC extended char pitch (INT
431
452
453
454
455
456
457
10.11. 86
ELSE errorstop ("Fa", " + text (font number) + " gi bt es
nicht"); 0
I • font
I
426
430
****
FI
font
: font store. fonts (font number)
process font replacement :
IF link nr ( 0 THEN link nr : = link nr XOR (-maxint-l) FI;
IF
link nr = 0
THEN char
ELIF link nr ) font store replacements length
THEN link nr DECR font store replacements length;
replacement text (font. replacements)
font store
S31/9
Zeile
474
475
.. 76
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
E 1 A N
EUME1
1.8
I
I
I
IEND
I
I
****
ELSE replaceme::t te:·:t (font store. replacements I
FRoe replacement;
e>:tendedreplacement ...... ITEXT PROe e>:tended replacerr.ent (INT
499
501
502
503
504
505
506
507
508
509
510
511
eONST font number,
I
TEXT eONST esc char, char
I
I initialize if llecessary;
I IT font number >= first font AN:) font number <= last font
I
THEN process extension replacement
I
ELSE errors top ("rant " + text (font number) + " gi bt es
I
nicht" I; ""
I rr
I
I
process extension replacement :
I
determine extension link nr;
I
IT
link nr = 0
I
THEll char
ELIT :ink nr > font store extension replacements length
THEN link nr DECR font store extension replacements
length;
replacement text (font extension. replacements I
ELSE replacement text (font store extension. replacements)
496
500
font store
rr
495
497
498
10.11.86
rr
determine extension link nr :
INT CONST inde:< 1 . - pos (font. extension chars, esc
char) ;
INT CONST index 2 : = pos (font store. extension chars, esc
char);
IT
index 1 <> 0
THEN link nr . - font extension. replacements table
(code (char) + 1);
ELIF index 2 < > 0
THEN link nr : = font store extension. replacements
table (code (chari + 1);
ELSE errors top {7t''''" + esc char + char + .. ."" hat
keine Erweiterung")
fI;
font extension
extension number)
font store. ex:ensions (font
font extension number
index 1
font. extension indexes ISUB
font
font store. fonts (font number)
font store extension
store extension number)
font store. extensions (font
font store extension number
ISUB index 2
font store. extension indexes
512
513
514
515
516
517
+
518
519
520
521
522
S31/10
font store extension replacements length
IF index 2 = 0
THEN 0
ELSE LENGTH font store extension. replacements
font store
S31/1@
E L A 11
Zeile
IENll PROC extended replacement;
replacement text .......... i TEXT PROC replacement text (TEXT CONST replacements)
I
I
I
I
I
532
533
534
535
I
I
I
I
I
539
540
541
542
+
~
544
545
546
547
548
549
S31/11
PROC replacement text;
fontstring ............... ITEXT PROC font string (INT CaNST font number)
536
569
570
571
572
buffer: = subtext (replacements, link nr + 1,
link nr + code (replacements SUB
link nr)):
buffer
IEND
I
I
536
563
564
565
566
567
568
font store
I
I
531
556
557
558
559
560
561
562
10.11.86
rr
I
530
550
551
552
553
554
555
****
I
~9
537
1.8
,
523
524
525
526
527
528
EUMEL
I
initialize if necessary:
IF font number ) = first font AND font number <= last font
THEN fonts. font string
ELSE errorstop ("Font" + text (font number) + " g1bt es
nicht"); ""
I
I rr
I
I .
I
fonts : font store. fonts (font number)
lEND PROC font string;
I
I
yoffsets
................. ITEXT PROC Y offsets (INT CaNST font number)
I
I initialize if necessary;
I IF font number ) = first font AND font number < = last font
THEN fonts. y offsets
I
ELSE errors top ("Font " + text (font number) + " g1bt es
I
nicht"); ""
I
I FI
I
I . fonts : font store. fonts (font number)
I
lEND PROC Y offsets;
I
boldoffset ............... lINT PROC bold offset (INT CONST font number)
I
I ini tialize if necessary;
I IF font number )= first font AND font number <=
THEN fonts. bold offset
I
ELSE errorstop ("Font " + text (font number)
I
nicht"); 0
I
I FI
I
I . fonts font store. fonts (font number)
I
font store
last font
+ " g1bt es
S31/11
E LAN
Zeile
IEN1l
I
I
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
6e0
601
602
603
604
+
605
606
607
608
609
610
611
612
U3
614
615
616
617
618
619
620
621
622
623
EUMEL 1.8 ****
getfont
PROC bold offset;
.................. IPROC get font (INT CONST font number.
INT VAR indentation pitch. font
I
font depth.
I
ROW 256 INT VAR pitch table ) :
I
I
I 1n1 t1alize if necessary;
I
I
I
I
I
I
IF font number ) = first font
THEN indentation pitch .pi tch table
:=
font lead
.font height
:=
font depth
._
ELSE error.top (WFont " +
nicht") ;
I
I
I FI;
I
I . fonts : font store.
I
IEND moe get font;
I
I
lead. font height.
AND font number (= last font
fonts. indentation pitch;
fonts. pi tcb table;
fonts. font lead;
fonts. font height;
fonts. font depth;
text (font number) + " gibt es
fonts (font number)
getreplacements .......... IPROC get replacements (INT CONST font number.
I
TEXT VAR replacements.
I
ROW 256 INT VAR replacements table)
I
I ini t1alize if necessary;
I IF font number ) = first font AND font number (= last font
I
THEN replacements
:= font store. replacements;
I
replacements
CAT fonts. replacements;
I
replacements table : = fonts. replacements table;
I
ELSE errors top ("Font" + text (font number) + " gibt es
I
nicht W);
I TI;
I
I . fonts : font store. fonts (font number)
I
IEND moe get replacements;
I
I
in1t1alizeifnecessary .... IPROC initialize if necessary :
I
I
I
I
I
I
IF NOT initialized (in this task)
THEN IF font table • ""
THEN in this task : = FALSE;
errors top ("Fonttabelle noch nicbt eingestellt");
ELSE font table (font table);
I
I
I
FI;
FI;
lEND
moe
initialize if necessary;
6~
I
I
625
lEND PACKET font store;
S31/12
font store
10.11.86
font store
S31/12
E LAN
Zeile
10.11.86
1.8.....
1(. -------------------
1
2
EUMEL
nameset _
SOME ,
LIKE ,
7
+
1 ,
do ,
FILLBY ,
rema.i ndar ,
11
12
13
14
15
fetch,
save,
fetch all ,
save all
forget,
16
17
18
19
20
erase,
insert •
21
edit:
25
26
27
17.03.86 ------------------- .)
(* Autor: J.Liedtlce .)
ALL ,
8
9
10
24
VERSION 3
................. PAcm name set DEFINES
3
4
5
6
22
23
nameset
ILET cr If • ""13""19"·
I
ITEXT VAH name ;
IDATASPACE VAH edit space ;
28
I
29
ITHESAURUS VAH remaining thesaurus .' empty thesaurus
30
I
I
31
32
+ .••••••••••••••••••••••• ITHESAURUS OP + (THESAURUS CONST lett, right)
33
I
34
35
36
37
38
39
40
41
42
43
44
45
46
I
I
I
I
I
I
47
48
49
50
51
52
53
I
I
I
I
I
IENDOP
+
I
+ •..•.•••..••.•...•••••.. ITHESAURUS OP + (THESAURUS CONST left, TEXT CONST right)
I
I
I
I
I
I
54
I
55
56
I
39/1
THESAURUS VAH union :. lett
INT VAH index := 9 ;
get (right, name, index) ;
WHILE name () •• REP
IF NOT (union CONTAINS name)
THEN insert (union, name)
FI;
get (right, name, index)
PER;
union
THESAURUS VAH union := left;
IF NOT (union CONTAINS right)
THEN insert (union, right)
FI;
union
IENDOP +
name set
39/1
Zeile
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
E LAN
1. 8
****
I
I
I
I
I
I
I
I
I
I
I
I
THESAURUS VAR difference : = empty thesaurus ;
INT VAR index : = 0 ;
get (left, name, index) ;
WHILE name <) " " REP
IF NOT (right CONTAINS name)
THEN insert (difference, name)
FI;
get (left, name, index)
PER;
difference
IENOOP
I
........................ ITHESAURUS
I
I
I
I
I
I
OP - (THESAURUS CONST left, TEXT CONST right)
THESAURUS VAR difference : = left ;
INT VAR index ;
delete (difference, right, index) ;
difference
IENOOP -
I
/
........................ ITHESAURUS OP / (THESAURUS CONST
I
I THESAURUS VAR intersection : =
84
lINT VAR index
85
86
87
I
I
I
I
I
I
I
I
I
88
89
90
91
92
93
94
95
left, right) :
empty thesaurus
:= 0 ;
get (left, name, index) ;
WHILE name <) " " REP
IF right CONTAINS name
THEN insert (intersection, name)
FI ;
get (left, name, index)
PER ;
intersection
IENDoP /
I
96
97
98
99
100
101
102
103
104
ALL
105
106
107
108
109
110
SOME
39/2
nameset
10.11. 86
- ........................ ITHESAURUS OP - (THESAURUS CONST left, right) :
72
73
74
75
76
77
78
79
80
81
82
83
EUMEL
...................... ITHESAURUS OP ALL (TEXT CONST file name) :
I
I FILE VAR file : = sequential file (input, file
I THESAURUS VAR thesaurus := empty thesaurus;
I thesaurus FILLBY file
I thesaurus
I
name)
IENDOP ALL
I
..................... ITHESAURUS OP SOME (THESAURUS
I
I copy thesaurus into file
I edit file
I copy file into thesaurus
CONST thesaurus)
I
nameset
39/2
Zeile
E LAN
111
112
113
114
115
116
copythesaurusintofile
117
118
119
120
editfile
121
122
123
copyfileintothesaurus
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
1. 8
EUMEL
****
10.11.86
name set
Icopy
I
I
I
I
I
I
thesaurus into file
forget (edi t space) ;
edit space := nilspace
FILE VAR file := sequential file (output, edit space)
file FILLBY thesaurus .
ledit file:
I modify (file)
I edit (file) .
I
I
Icopy file into thesaurus :
I THESAURUS VAR result . - empty thesaurus
I input (file) ;
I result FILLBY file ;
I forget (edit space) ;
I result.
I
IENDOP
I
SOME
SOME ................••... I THESAURUS OP SOME (TASK CONST task)
I
I
SOME ALL task
I
IENDOP
I
SOME
SOME ..................... ITHESAURUS OF SOME (TEXT CONST file name)
I
I
SOME ALL file name
I
IENooP SOME
I
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
LIKE ..................... ITHESAURUS OF LIKE (THESAURUS CONST thesaurus, TEXT CONST pattern)
157
remainder ................ I THESAURUS PROC remainder
158
159
160
161
W2
39/3
I
I
I
THESAURUS VAR result: = empty thesaurus
INT VAR index: = 0 ;
I
I
I
I
I
REP get (thesaurus, name, index)
IF name = ••
THEN LEAVE LIKE WITH result
ELIF name LIKE pattern
THEN insert (result, name)
I
FI
I FER ;
I result
I
IENooF LIKE
I
I
I
rema.ining thesaurus
I
I ENDFROC remainder
I
name set
39/3
ZeUe
163
164
165
E LAN
1.8 ****
EUMEL
do ....................... IPROC do
I
I
I
:f)6
(PROC
10.11.86
nameset
(TEXT CaNST) operate, THESAURUS CaNST thesaurus)
INT VAR index : = 0 , operation number :. 0 ;
TEXT VAR name
I
167
168
169
170
171
172
I
I
I
I
remaining thesaurus . - empty thesaurus
disable stop ;
\lork off thesaurus ;
fill leftover \Ii th remainder
I
I
173
174
175
176
177
178
179
180
181
182
183
\lorkoffthesaurus
184
185
186
187
188
189
190
191
fillleftover\li thremain Ifill leftover \lith remainder :
I WHILE name <) " " REP
I
insert (remaining thesaurus, name)
I
get (thesaurus, name, index)
192
193
194
195
196
197
I
I
I PER.
I
IENDPROC do
I
execute .................. IPROC execute (PROC (TEXT CaNST) operate, TEXT CaNST name)
I
I
I
200
201
202
203
204
IENDPROC execu te ;
I
do ....................... PROC do (PROC (TEXT CaNST, TASK CaNST) operate, THESAURUS CaNST
thesaurus,
TASK CaNST task) :
INT VAR index . - 0 , operation number : = 0
TEXT VAR name
remaining thesaurus . - empty thesaurus
disable stop ;
\lork off thesaurus ;
fill leftover \lith remainder
205
206
207
208
209
210
211
212
213
214
215
216
39/4
enable stop ;
operate (name)
I
1~
199
I\lork off thesaurus :
REP
I
get (thesaurus, name, index) ;
I
IF name = ""
I
THEN LEAVE \lork off thesaurus
I
FI;
I
opera tion number INCR 1 ;
I
cout (operation number) ;
I
execute (PROC (TEXT CaNST) operate, name)
I UNTIL is error ENDREP .
I
workoffthesa.urus
Iwork off thesaurus:
REP
I
get (thesaurus, name, index) ;
I
IF name = ""
I
THEN LEAVE \lark off thesaurus
I
FI;
I
operation number INCR 1 ;
I
name set
39/4
Zeile
E LAN
EUMEL
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
1.8
I
I
I
39/5
do
execute .................. IPROC execute (PROe (TEXT eONST, TASK CaNST) operate,
I
TEXT eONST name, TASK OONST task) :
I
I
I
I
254
255
256
257
258
259
260
261
262
263
264
265
266
cout (operation number) ;
execute (PROC (TEXT CONST, TASK CONST) operate, name, task)
UNTIL is error ENDREP .
I
I ENDPROC
I
I
~3
nameset
fillleftoverwithremain Ifill leftover with remainder
I WHILE name () •• REP
I
insert (remaining thesaurus, name)
I
get (thesaurus, name, index)
I PER.
234
247
248
249
250
251
252
10.11.86
I
I
235
236
237
238
239
240
241
242
243
244
245
246
****
enable stop ;
operate (name, task)
IENDPROC execu te
FILLBY ................... lOP FILLBY (THESAURUS VAR thesaurus, FILE VAR file)
I
I
I
I
I
I
I
I
WHILE NOT eof (file) REP
getline (file, name) ;
delete trailing blanks
IF name () •• CAND NOT (thesaurus CONTAINS name)
THEN insert (thesaurus, name)
FI
PER.
I
I
deletetrailingblanks
Idelete trailing blanks :
I WHILE (name SUB LENGTH name) = • • REP
I
name: = subtext (name, 1, LENGTH name - 1)
I PER.
I
IENDOP FILLBY
I
FILLBY ................... IOP FILLBY (FILE VAR file, THESAURUS OONST thesaurus)
I
I INT VAR index : = 0 ;
I REP
get (thesaurus, name, index)
I
IF name =
I
THEN LEAVE FILLBY
I
FI ;
I
putline (file, name)
I
I PER .
I
IENDOP FILLBY
I
name set
39/5
Zeile
267
268
269
270
271
272
273
274
275
E 1 AN
EUMEL
1.8
****
namasat
10.11.86
FILLBY •..•.••..•.•••••.•. lOP FILLBY (TEXT CONST file name, THESAURUS CONST thesaurus)
I
I
I
I
FILE VAH f := sequential file (output, file name) ;
f FILLBY thesaurus
I ENIXlP FILLBY
I
I
I
276
277
278
279
280
281
fetch ••..•.....•...•••... IPROG fetch (THESAURUS CONST nameset) :
282
283
284
280
286
287
fetch •••...•.•.•...•..... IPROC fetch (THESAURUS CONST nameset, TASK CONST task) :
288
289
290
291
292
293
save •.....••...••...••... I PROC save (THESAURUS CONST name set ) :
294
295
296
297
298
299
save •••....•..•••..•.••.. I PROC save (THESAURUS CONST namesat, TASK CONST task) :
300
301
302
303
304
305
fetchall ................. I PROC fetch all :
306
307
fetchall ................. IPROC fetch all (TASK CONST
308
309
310
311
312
M3
314
39/6
I
I
do (PROC (TEXT CONST) fetch, nameset)
I
I ENDPROC fetch
I
I
I
I
do (PROC (TEXT CONST, TASK CONST) fetch, nameset, task)
I ENDPROC fetch ;
I
I
I
do (PROC (TEXT CONST) save, namesat)
I
I ENDPROC sava ;
I
I
I
do (PROG (TEXT CONST, TASK CONST) save, namesat, task)
I
IENDPROC save
I
I
I
fetch all (father)
I
IENDPROC
I
I
I
I
fetch all
ma~er)
fetch (ALL manager, manager)
I ENDPROC fetch all
I
savaall .................. I PROC save all :
I
I
save all (father)
nameset
39/6
Zeile
315
316
317
E LAN
EUMEL
1.8
****
10.11.86
nameset
I
I ENDPROC save all
I
318
319
320
321
322
323
saveall ...............•.. I PROC save all (TASK CONST manager)
324
325
326
327
328
329
forget .........•......... I PROC forget (THESAURUS CONST nameset) :
330
331
332
333
334
335
erase .................... I PROC erase (THESAURUS CONST nameset) :
336
337
338
339
340
341
era.se •••....•......••.... I PROC erase (THESAURUS CONST nameset, TASK CONST task) :
342
343
344
345
346
347
insert ••..••..•.......•.• I PROC insert (THESAURUS CONST na.meset) :
348
349
350
351
352
edit ..•...•........••••.. IPROC edit (THESAURUS CONST nameset) :
~3
~4
39/7
I
I
I
save (ALL myself, manager)
I ENDPROC save all
I
I
I
do (PROC (TEXT CONST) forget, name set )
I
I ENDPROC forget ;
I
I
I
do (PROC (TEXT CONST) erase, na.meset)
I
I ENDPROC erase
I
I
I
do (PROC (TEXT CONST, TASK CONST) erase, nameset, task)
I
I ENDPROC erase
I
I
I
do (PROC (TEXT CONST) insert, nameset)
I
IENDPROC insert;
I
I
I
do (PROC (TEXT CONST) edit, nameset)
I
I ENDPROC edit;
I
I ENDPACKET name set
na.meset
39/7
Zeile
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
S40/1
E LAN
EUMEL
1.8
****
10.11.86
system info
system info **********.**** IPACKET system info DEFINES
I
I
I
I
I
I
I
I
(*
Autor: J. Liedt~
(*
Stand: 22.09.84
*)
*)
task status ,
storage info ,
help:
LET channel field
prio field
cr If
cr
4
6
''''13'' "le""
""13"" I
""1 ""4""
page
begin mark= ""15"" ,
""14 "" ~
end mark
""7"" ,
bell
""27'''' ;
esc
cputimeof ................ ITEXT PROC cpu time of (TASK CONST actual task)
I
I
disable stop ;
I TEXT VAR result .- subtext (time (clock (actual task),
I
12), 1, 10)
I
I
I
IF is error
THEN clear error
result := 10 • "."
I FI;
I result
I
IENDPROC cpu time of
I
taskstatus ............... IPROC task status
I
I
I
I
I
I
I
I
line;
put (date); put (time of day) ;
line (2) ;
put ("Speicher:"); put (storage (myself»; putUne ("K");
put ("CPU-Zeit:"); put (cpu time of (myself» ; line;
line.
IENDPROC task status
I
storageinfo .............. IPROC storage info :
I
I INT VAR size, used
I storage (size, used)
lout (""13""10"
")
I put (used) ;
I put ("K von") ;
I put (size plus reserve)
I putline ("K sind belegt!")
system info
840/1
Zelle
E LAN
EUMEL
54
55
56
57
58
59
60
1.8
••••
10.11.86
1
sizeplusreserve
1
1size plus reserve :
1 int (real (size +
24) • 64.0 / 63.0 ) .
1
IENDPROC storage info ;
1
1
61
62
63
64
65
66
67
68
69
70
help ••••••••••••••••••••• 1PROC help :
71
72
73
74
75
76
77
78
79
80
help ..................... IPROC help (FILE VAR help file)
81
82
83
84
85
system info
1
1
1
1
1
IF exists ("help")
THEN FILE VAR f := sequential file (modify, "help")
help (f)
ELSE errors top ("""help"" gibt es nicht")
1 Fl.
1
1ENDPROC
help
1
1
.\nitialize help command
REP
out (page) ;
to paragraph
show paragraph
get show command
UNTIL is quit command PER
ini tializehelpcommand
ini tialize help command :
TEXT VAR
help command : = getcharety
IF help command = ""
THEN help command : = "0"
86
FI .
87
88
89
toparagraph
90
91
92
93
94
95
96
1 to paragraph :
1 col (help file,
1
1) ;
to l1ne (help file, 1)
downety (help file, "." + help command + "#")
IF eof (help file)
THEN to line (help file, 1) ;
out (bell)
1
FI.
1
1
1
1
97
98
99
100
101
102
103
showparagraph
104
105
106
showheadl1 ne
1
1
1show
1
1
1
1
1
paragraph
show headline ;
WHILE NOT end of help subfile REP
show help line
PER;
show bottom line
1
1
S40/2
1 show headline
lout (begin mark)
I INT CONST dots : = (x size - len (help file) - 5) DIV 2
system info
S40/2
Zeile
E LAN
107
108
109
110
111
112
113
114
115
116
117
showhelpline
118
119
120
121
122
showbottomline
123
124
125
126
127
128
129
130
131
132
133
getshowcommand
1M
endofhelpsubfile
135
136
137
138
139
140
141
142
143
144
145
146
S40/3
isqui tcommanc.
EUMEL
1.8
****
10.11.86
system info
I dots TlMESOUT "." ;
I exec (PROC show line, help file, 4)
I dots TlMESOUT "." ;
I out (end mark) ;
I down (help file)
I
I
I show help line
I out (cr If) ,
I exec (PROC show line, help file, 1)
I down (help file)
I
I
I show bottom line
I cursor (5, y size)
I exec (PROC show line, help file, 3)
I out (cr)
I
I
I get show command
I TEXT VAR char;
I get char (char)
I IF char = esc
THEN get char (char)
I
I FI ;
I IF char ,. " "
THEN help command .- char
I
ELSE out (bell)
I
I FI .
I
I
pos (help file, "n" ,1) <, 0 OR eof (help file)
I end of help subfile
I
I
I
"q" OR help command = "Q" .
help command
I is quit command
I
IENDPROC help
I
showline ................. IPROC show line (TEXT CONST line, INT CONST from)
I
I
I
outsubtext (line, from, x size - from)
I ENDPROC show line ;
I
I ENDPACKET system info
system info
S40/3
E LAN
Zeile
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
EUMEL 1.8 ****
single user monitor
10.11.86
1(* ------------------- VERSION 2
singleusermonitor *** ••••* IPACKET single user monitor DEFINES
26.05.86 ------------------- *)
(* Autor: J. Liedtke *)
I
I
I
I
I
I
I
I
monitor,
shutup,
save system ,
fixpoint,
collect garbage blocks ,
set clock ,
set date :
I
I
ILET command list =
I
I "edit: 1.01run: 3. 01runagain: 5.0insert:6.01forget:8.01rename: 10.2copy:l
1.2
+
16
list
17
18
19
20
21
22
23
24
25
26
27
help
I
I
llist: 12.0storageinfo: 13.0fetch: 14.1save: 15. 01saveall: 17 .0shutup: 18.8
I
28
29
30
31
32
33
34
35
36
37
Ihelp:19.0 " ;
I
ILET text param type
I
main channel
I
cr = ""13"" ,
I
I
I
I
I
garbage collect code
fixpoint code
shutup code
shutup and save code
lINT VAR command index , number of params , previous heap size ,
I
old session : = session ;
ITEXT VAR param 1, param 2 , date text;
I
I
monitor .................. IPROC monitor :
I
I
monitor (PROC set up)
I
38
IENDPROC monitor
I
45
46
47
48
49
50
51
52
53
54
543/1
2
4
12;
I
I
39
40
41
42
43
44
4
1
monitor .................. IPROC moni tor (PROC init system)
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
disable stop ;
previous heap size
.= heap size
REP
continue (main channel)
command dialogue (TRUE)
sysin ("") ;
sysout ("") ;
reset editor;
ini t system if necessary
cry if not enough storage ;
get command ("gib kommando :")
analyze command (command list, text par&III type,
command index, number of params, param1,
param2) ;
single user monitor
843/1
Zeile
••••
E LAN
EUMEL
55
56
57
58
59
60
61
62
63
64
collectheapgarh&geifne
65
66
67
68
69
70
initsystemifnecessary
71
72
73
74
75
76
77
78
79
cryifnotenoughstorage
80
reseteditor
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
S43/2
••••
10.11.86
single user monitor
I
execute command ;
I collect heap garh&ge if necessary
I PER.
I
I
Icollect heap garh&ge if necessary :
I
I
I
I
I
I
IF heap size ) previous heap size + 6
THEN collect heap garh&ge ;
previous heap size : = heap size
FI.
ini t system if necessary :
IF session () old session
THEN old session : = session
continue (main channel)
clear error ;
init system;
eumel must advertise
set date;
storage info
FI.
81
82
83
1.8
executecommand
Icry
i f not enough storage
lINT VAR size, used;
I storage (size, used) ;
I IF used ) size
I
THEN out (""7"Speicher Engpass! Da.teien loeschen!"13""10"")
I FI.
I
I
Ireset editor :
I WHILE aktueller
I
quit
I PER.
I
IENDPROC moni tor
I
editor ) 0 REP
........... IPROC execute command
I
I enahle stop ;
I SELECT command index OF
CASE 1
edit
I
edi t (paraml)
CASE 2
I
CASE 3
run
I
run (paraml)
CASE 4
I
run again
CASE 5
I
CASE 6
insert
I
CASE 7
lnsert (paramll
I
forget
CASE 8
I
forget (p&raml)
CASE 9
I
CASE 10: rename (paraml, param2)
I
CASE 11: copy (paraml, par&m2)
I
CASE 12: list
I
CASE 13: storage info
I
CASE 14: fetch (p&raml)
I
CASE 15: save
I
CASE 16: save (paraml)
I
CASE 17: save all
I
single user monitor
S43/2
Zeile
E LAN
1.8
I
I
I
I
I
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
EUMEL
****
10.11.86
single user monitor
CASE 18: shutup
CASE 19: help
OTHERWISE do command
ENDSELECT .
IENDPROC
execute command ;
I
IBOOL VAR hard"are clock ok
IREAL VAR now;
I
setdate .................. IPROC set date:
I
I
I
I
I
I
I
hardware clock ok : = TRUE ;
try to get date and time from hardware
IF NOT hard"are c lock ok
THEN get date and time from user
FI;
define date and time .
I
I
130
131
132
133
134
135
136
137
138
139
140
141
trytogetdateandtimefro Itry to get date and time from hardware
I disable stop ;
I REAL VAR previous no" ;
I now:= 0.0 ;
I INT VAR try ;
I FOR try FROM 1 UPl'O 3 WHILE hardware clock ok REP
I
previous no" : = no" ;
I
now:= date (hardwares today) + time (hardwares time)
I UNTIL now = previous now OR is error PER ;
I clear error
I enable stop
I
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
getdateandtimefromuser Iget date and time from user :
line (2) ;
put ("
Bi tte geben Sie das heutige Datum ein :")
date text: = date ;
TEXT VAR exit char ;
editget (date text, cr, "", exit char)
now: = date (date text)
line ;
put ("
und die aktuelle Uhrzeit :")
date text : = time of day ;
edi tget (date text, cr, "", exit char) ;
now INCR time (date text) ;
IF NOT last conversion ok
THEN errorstop ("Falsche Zeitangabe")
FI .
158
hardwarestoday
I
calendar (3) +
+ calendar (4) +
calendar (2) +
+ calendar (1) .
I
I
159
160
161
hard"arestime
162
163
164
definedateandtime
S43/3
Ihardwares today :
I
calendar (5)
Ihard"ares time
I
I
Idefine date and time
I set clock (now) .
I
single user monitor
S43/3
Ze1le
E LAN
.***
1. 8
1ENDPROC
165
166
167
168
169
170
171
172
173
174
175
EUMEL
10.11. 86
single user monitor
set date
1
calendar ................. 1TEXT PROC calendar (INT CONST index)
1
1
1
1
INT VAR bed ;
control (10, index, 0, bed) ;
IF bed < 0
THEN hardware clock ok := FALSE· ""
ELSE text (low digit + 10 * high d1git)
1
Fl.
1
1
1
176
177
lowigi t
178
179
highdigit
1
1 low
digi t
bed AND 15 .
1
1
Ihigh digit:
lee
1
1ENDPROC
181
1
182
183
184
185
186
187
188
189
190
191
192
~3
194
195
196
197
(bcd AND (15*256»
calendar ;
shutup ................... 1PROC shutup
1
1
1
1
1
1
page;
cursor (32, 15) ;
put ("bi tte warten")
cursor (35, 12) ;
system operation (shutup code)
1
1ENDPROC
shutup
1
savesystem ............... 1PROC save system :
1
1
1
1
1
archive ("save")
IF yes ("Leere Floppy e1ngelegt")
THEN
system operat1on (shutup and save code)
Fl.
~8
1
199
200
1
1ENDPROC
201
1
202
203
204
205
206
207
collectgarbageblocks ..... 1PROC collect garbage blocks
208
209
210
211
212
213
fixpcint ................. 1PROC fixpcint :
S43/4
DIV 256 .
1
1
save system
system operation (garbage collect code)
1
1ENDPROC
collect garbage blocks ;
1
1
1
system operation (fixpc1nt code)
1
1ENDPROC
fixpcint
1
s1ngle user monitor
S43/4
Zeile
214
215
216
217
E LAN
EUMEL
1.8
****
single user monitor
10.11.86
systemoperation .......... PROC system operation (INT CONST code)
INT VAR size, used ;
storage (size, used)
IF used <= size
THEN disable stop ;
sys op (code) ;
ignore start message error
ELSE errorstop ("nicht genuegend System - Speicher vorhanden")
FI .
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
S43/5
ignorestartmessageerro
Iignore
I pause
I clear
I
IENDPROC
I
start message error
(5) ;
error .
system operation
sysop .................... IPROC sys op (INT CONST code)
I EXTERNAL 90
IENDPROC .ys op ;
I
setclock ................. IPROC set clock (REAL CONST time)
I EXTERNAL 103
IENDPROC .et clock ;
I
IENDPACKET single user
monitor
single user monitor
S43/~
Zeile
1
2
3
4
5
6
7
8
44/1
E LAN
EUMEL
1.8
Ike
••••
10.11.86
sysgen off
(. ma.intenance ke *)
I
sysgenoff ................ IPROC sysgen off (INT CONST mode, INT VAR a,b,c,d,e,f,g,h,i,j,k)
I EXTERNAL 256
IENDPROC sysgen
I
off
lINT VAR x : = 0 ;
Isysgen off (3,x,x,x,x,x,x,x,x,x,x,x)
sysgen off
44/1
Zeile
1
2
3
4
6
7
8
9
10
11
12
13
14
15
16
17
845/1
****
ELAN
EUMEL
1.8
****
10.11.86
****
ur start
I
Icheck on ;
Icommand dialogue (TRUE) ;
Iset clock (date ("19.06.86"))
Idisable stop ;
Isave system;
IREP UNTIL yes ("help") PER
larchive ("help") ;
Ifetch ("help", archive) ;
IREP UNTIL yes ("dev") PER
larchive ("dev") ;
Ifetch all (archive)
Irelease (archive)
Isave system
Iconfigurate
Iset up ;
Imonitor ;
ur start
845/1
E L
Zelle
2
3
4
5
6
7
5
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
basicarch~ ye
****
1.8
06.03.86 --------------.
archi ',e blocks
I
I
I
format archive
read block •
read ,
rewind,
search da taspace •
seek,
size.
skip dataspace
write block.
write:
INT VAR blocknr
:= 0 •
._ 0 ,
rerun
page
:= -1 ,
bi t word ._ 1 •
unreadable sequence length .' 0
lINT CONST all ones : =-1 ;
I
I
IDATASPACE VAR label ds
I
ILET
I
I
I
I
I (*
I
I
I
write normal
archive version
first page stored
dr size
first bi t word
•
write de leted data mark
inconsistent
read error
label size
•
I
IBOUND
I
I
I
I
0
1
2
3
4 ,
64
*)
90 •
92 ,
131 ;
STRUCT (ALIGN dummy for paf;e1,
(* Page 2 begins: *)
ROW label size INT lab) VAR label;
blocknumber .............. I INT PROC block number :
I block nr
IENDPROC block number ;
I
47
48
49
50
seek ..................... IPROG seek (INT CONST block)
I block nr :. block
IENDPROC seek ;
51
52
53
54
55
56
rewind
48/1
basic archive
10.11.86
1(* ------------------- VERSIOII 11
************* IPACKET basic archive DE!INES
I
I
I
I
I
39
40
41
42
45
46
EUMEL
I block number •
I check read .
38
44
N
I
I
34
35
36
37
43
~.
I
................... IPROC rewind :
I forget (label ds);
I label ds :. nilspace;
I label:= label ds;
I block nr := 0;
I rerun: = session
basic archive
48/1
Zei2.e
E L !. N
EUME1
IEND
I
57
58
59
60
61
62
63
64
65
66
67
1.8
......
10.11.86
basic archive
PROC rewind;
skipdataspace ............ IPROC skip dataspace:
I check rerun;
I get label;
I IF is error
THEN
I
I ELIF olivetti
THEN block nr INCR label. lab (dr size+l)
I
ELSE block nr INCR label. lab (dr size)
I
I
68
FI
lEND PROC skip data.pace;
69
I
70
71
72
73
read ..................... IPROC read (DATASPACE VAR ds):
I read (ds, 30000, FAlSE)
IENDPROC read
74
read ..................... IPROC read (DATASPACE VAR ds, INT CONST max pages,
I
accept):
I enable stop ;
I check rerun;
I get label;
I init next page;
I INT VAR i ;
I FOR i FROM 1 UPTO max pages REP
I
next page;
I
IF no further page THEN LEAVE read FI;
I check storage
I
check rerun ;
I
read block ;
I
block nr INCR 1;
I PER.
75
76
77
78
79
80
81
82
83
84
85
86
87
I
88
89
readblock
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
48/2
ignorereaderrorifnoerr
checkstorage
I
I
Iread block
I disable .top
I get external block (ds, page, block nr)
I ignore read error if no errors accepted
I enable stop .
I
I
I ignore read error if no errors accepted :
I IF is error CAND error code = read error
I
THEN clear error
I FI.
I
I
Icheck storage :
I INT VAR size, used ;
I storage (size, used)
I IF used > size
I THEN forget (ds) ;
I
ds : = nils pace
I
errors top ("Speicherengpass")
I
LEAVE read
I FI.
basic archive
oooL
CONST error
CAND NOT error accept
48/2
ZeLe
EL
N
EUMEL
1. -'l
..**
10.11. 86
basic archive
I
I
109
110
111
112
113
114
115
116
117
~.
checkrerun
Icheck rerun
I
IF rerun () session
I
THEN errors top ("RERUN
I
LEAVE read
I
I
IEND
I
beim Archi v-Zugriff")
FI.
PROC read;
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
checkread •.•..••••••...•• I PROC check read
I
I enable stop ;
I get label ;
I INT VAR pages, i;
I IF olivetti
THEN pages - label. lab (dr size+1)
I
ELSE pages - label. lab (dr size)
I
I FI ;
I FOR i FROM 1 UPI'O pages REP
get external block (label ds, 2, block nr)
I
block nr INCR 1
I
I PER .
I
IENDPROC check read
I
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
IIri te .................... I PROC IIri te (DATASPACE CONST ds):
enable stop ;
check rerun;
INT VAR labe 1 block nr : = block nr;
block nr INCR 1; ini t label;
INT VAR page := -l,i;
FOR i FROM 1 UPI'O ds page s (ds) REP
check rerun ;
page := next ds page(ds,page);
put external block (ds, page, block nr)
reset archive bit;
label.lab(dr size) INCR 1;
block nr INCR 1
PER;
put label.
.
.
151
152
153
154
155
156
157
158
159
ini tlabel
ini t label:
label.lab(archive version) : = 0 ;
label.lab( first page stored) : = 0
laool.lab(dr size) := 0;
INT VAR j;
FOR j FROM first bi t lIord UPI'O label size REP
label.lab (j) : = all ones
PER.
160
161
162
putlabel
put label:
put external block (label ds, 2, label block nr).
48/3
basic a.rchive
48/3
Zelle
163
164
165
166
167
168
169
170
171
172
173
174
E LAN
EUMEL
resetarchivebit
1. 8
I
I
I
****
basic archive
10.11. 86
reset archive bit:
reset bit (label.lab
(~e
DIV 16+flrst bit word),
~e
MOD 16).
lEND PROC write;
I
getlabel ................. IPROC get label:
I
I enable stop ;
I get external block (label ds, 2, block nr)
I block nr INCR 1;
I check label.
I
I
175
176
177
178
179
180
checklabel
Icheck label:
I IF may be z80 format label OR may be old olivetti format label
I
THEN
I
ELSE errorstop (inconsistent, "Archiv inkonsistent")
I FI.
I
181
182
183
maybez80formatlabel
184
185
maybeoldolivettiformat Imay be old olivetti format label:
I olivetti AND label.lab(first ~e stored):!;) AND label.lab(dr
I
size+1) ) 0 .
I
I
IEND
186
187
PROC get label;
I
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
lmay be z80 format label:
z80 archive AND label.lab(dr size) ) 0 .
I
I
I
next~e.
. . . . . . . . . . . . . . .. PROC next ~e:
IF z80 archive
THEN
WHILE labelbi ts = all ones REP
bitword INCR 1;
IF bi tword ) = label size THEN
no further ~e : = true; i.EAVE next ~e FI
PER;
INT VAH p : = lowest reset (labelbits);
set bit (labelbits, p);
~e := 16*(bitword-first bit word)+p
ELSE
WHILE oli bi ts = 0 REP
bi tword INCR 1;
IF bitword ) = labelsize-64 THEN
no further ~e := true; LEAVE next ~e FI
PER;
P : = lowest set (oli bits);
reset bit (olibi ts, p);
~e . _ 16*(bitword-firstbitword)+p;
FI.
211
labelbits
label bits: label.lab (bitword).
212
213
214
olibi ts
oli bits: label. lab (bitword+l).
48/4
lEND PROC next
~e;
basic archive
48/4
Zelle
E LAN
216
217
olivetti
218
219
zOOarchive
220
221
222
223
ini tnextpage
224
225
226
227
checkrerun
48/5
Iolivetti
I
I
IzOO archive
label.lab (archive version)
label.lab (archive version)
-1.
0.
I init next page:
I
800L VAR no further page : = false;
I
bi tword : = first bit word.
I
I
Icheck rerun :
IF rerun <) sess ion
I
THEN errorstop ("RERUN beim Archiv-Zugriff")
I
Fr.
I
I
I
I
I
I
I
I
I
I
I
I
I
readsucceeded
243
244
254
255
256
257
258
259
260
261
262
263
264
265
266
basic archive
getexternalblock ......... IPROC get external block (DATASPACE VAR ds, INT CONST page,
I
INT CONST block nr):
241
245
246
247
248
249
250
251
252
253
10.11.86
I
231
232
233
234
235
236
237
238
239
240
242
****
I
I
2re
230
1.8
I.
I
215
229
EUMEL
readfailed
INT VAR error ;
read block (ds, page, block nr, error)
SELECT error OF
CASE 0: read succeeded
CASE 1: error stop ("Lesen unmoeglich (Archiv)")
CASE 2: read failed
CASE 3: error stop ("Archiv-Ueberlauf")
OTHERWISE error stop ("11? (Archiv)")
END SELECT .
Iread succeeded :
I unreadable sequence length . = 0 .
I
I
Iread
I
I
I
I
I
I
failed :
unreadable sequence length INCR 1 ;
IF unreadable sequence length )= 30
THEN errors top ("30 unlesb&re Bloecke bintereinander")
ELSE error stop (read error, "Lesefehler (Archiv)")
Fr.
IEND PROC get external block;
I
putexternalblock. . . . . . . .. PROC put external block (DATASPACE CONST ds, INT CONST page,
INT CONST block nr):
INT VAR error;
wri te block (ds, page, write normal, block nr, error)
SELECT error OF
CASE 0:
CASE 1: error stop ("Schreiben unmoegl1ch (Archiv)")
CASE 2: error stop ("Schreibfehler (Archiv)")
CASE 3: error stop ("Archiv-Ueberlauf")
OTHERWISE error stop ("?11 (Archiv)")
END SELECT .
IEND PROC put external block;
basic archive
48/5
Zeile
E LAN
EUMEL
1.8 ••••
10.11.86
basic archive
267
268
269
270
271
272
273
274
readblock ................ IPROC read block (DATASPACE VAR ds,
I
INT CONST ds ~e no,
I
INT CONST block no,
I
INT VAR return code)
I read block;
I retry if read error.
I
I
275
276
277
readblock
278
279
280
281
282
283
284
retryifreaderror
285
286
287
288
289
290
291
resettoblock0iffifthtr Ireset to block 0 if fifth try:
I IF retry = 5
I
THEN block in (ds, ds ~e no, 0,
I FI.
I
IEND PIIOC read block;
I
292
293
294
295
296
297
298
299
Iread block:
I block in (ds, ds ~e no, 0, block no, return code).
I
I
Iretry if read error:
I INT VAR retry;
I FOR retry FROM 1 UPl'O 10 WHILE return code
I
reset to block 0 if fifth try;
I
read block
I pm.
2 REP
I
I
e,
return code)
wri teblock ............... IPROC write block (DATASPACE CONST ds,
I
INT CONST ds ~e no,
I
INT CONST mode,
I
INT CONST block no,
I
INT VAR return code):
I wri te block;
I retry if write error.
I
I
300
:301
:302
writeblock
:303
:304
:305
:306
:307
retry1fwriteerror
Iwrite block:
I block out (ds, ds
I
~e
no, mode • 256, block no, return code) .
I
308
:309
Iretry if write error:
I INT VAR retry;
I FOR retry FROM 1 UPl'O 10 WHILE return code
I
reset to block 0 i f fifth try;
I
wri te block
I pm.
I
2 REP
I
310
311
312
313
314
315
316
317
318
resettoblock(;)ift'1fthtr Ireset to block (;) it' fifth try:
I IF retry = 5
I
THEN disable stop;
I
DATASPACE VAR dummy ds : = nllsp&Ce;
I
block 1n (dummy ds, 2, 0, 0, return code);
I
forget (dummy ds);
I
enable stop
I FI.
48/6
basic archive
I
48/6
Zeile
E LAN
EUMEL
1.8
••••
10.11.86
basic archive
lEND PROC write block;
319
320
I
321
322
323
324
325
326
327
328
size ....................• lINT PROG size (INT CaNST key)
329
330
331
332
archi veblocks ............ lINT PROG archive blocks :
I size (0)
IENDPROG archi ve blocks ;
333
334
335
336
337
338
339
340
341
342
343
344
345
346
searchda taspace .......... IPROG se'arch da taspace (INT VAR ds pages)
I
I
I
I
I
IENDPROG size ;
I
I
I
I disable stop ;
I ds pages : = -1
lINT CaNST last block : = archive blocks
I
I WHILE block nr < last block REP
I
IF block is dataspace label
I
I
I
I
I
blockisdataspacelabel
358
359
lookatlabelblock
360
361
362
363
365
366
367
368
369
370
371
48/7
THEN ds pages : = pages counted
LEAVE search dataspace
FI;
block nr INCR 1
UNTIL is error PER
I
I
347
348
349
350
351
352
353
354
355
356
357
364
INT VAR return code
control (5, key, 0, return code)
return code .
block is dataspace label
look at label block ;
IF is error
THEN IF error code = read error OR error code
inconsistent
THEN clear error
FI ;
FALSE
ELSE count pages
number of pages as label says
pages counted
FI .
Ilook at label block:
lINT CaNST
I old block nr : = block nr ;
I get label ;
I block nr : = old block nr.
I
I
countpages
Icount pages :
INT VAR
I pages counted : = 0
I ini t next page ;
I next page ;
I WHILE NOT no further page REP
pages counted INCR 1 ;
I
next page
I
I
basic archive
48/7
Zelle
E LAN
EUMEL
1.8
****
1e.11.86
basic archive
PER .
372
37:5
374
375
376
377
378
numberofpagesaslabelsa I number of pages as label says
IENDPROC search da taspace
I
formatarchive ............ IPROC format archive (INT CaNST format code)
~9
I
380
381
382
383
384
I
I
I
385
formatispossible
386
387
388
3ge
48/8
I
I
I
IF format 1s possible
THEN format
ElSE errors top ("' format' ist hier nicht implement1ert")
Fl.
Iformat is possible;
I INT VAR return code
I control (l,e,e, return code)
I bit (return code, 4) .
I
I
389
391
392
393
394
395
396
397
398
399
400
label.lab (dr size) .
I
format
Iformat
I control (7, format code, 13, return code) ;
I IF return code ; 1
I
THEN errorstop ("Formatieren unmoeglich")
I ELIF return code ) 1
I
THu'i errors top ("Schreibfehler (Archi v)·)
I Fl.
I
IENDPROC format archive ;
I
IEND PACKET basic archive;
basic archive
48/8
Zeile
1
••-
ELAN
archivesingle
EUMEL
1.8.***
I
2
I
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
archi ve single
••••
(. Autor:
••••••••••-IPACKET archive single DEFINES
+
+
10.11.86
I
I
I
I
I
I
I
I
J . Liedtke· )
(. 8tand:
31.07.85 .)
archive,
release ,
save,
fetch,
erase,
check ,
exists,
I
ALL ,
I
clear ,
list,
format:
I
I
I
I
I
ILET archive channel
I
mai n channe 1
31
1
I
I
I
I
I
I
read error
92 ,
max files = 200 ,
start of volume
1000
end of volume
1
file header
3
number of header blocks
2.
quote
dummy name
dummy date
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
~2
53
54
55
56
57
58
59
60
S49/1
HEADER
STRUCT (TEXT name, date, INT type, TEXT password)
ITEXT VAR archive name : =
nn
,
write stamp
I
IREAL VAR last access time : = 0.0 ;
I
IBOOL VAR was already write access := FALSE
I
I
IDATASPACE VAR header space . = nilspaca , ds : = nilspace
IBOUND HEADER VAR header;
I
ITEXT VAR file name: =
I
ILET invalid
• 0 ,
I
read only
1
I
valid
2
I
ILET accept read errors
I
ignore read errors
TRUE,
FALSE;
I
I
lINT VAR directory state := invalid
I
archi va single
849/1
Zeile
E LAN
EUMEL
1.8
-**
10.11.86
****
ITHESAURUS VAR directory , all names
61
62
63
64
65
66
67
68
69
70
71
lINT VAR dir index ;
I
lINT VAR archive size
I
lINT VAR end of volume block
IROW max files INT VAR header block
IROW max files TEXT VAR header date
I
I
I
72
73
74
75
76
77
78
79
80
archive .................. IPROC archive (TEXT CONST name)
81
82
83
84
85
86
87
release .................. IPROC release (TASK CONST t) :
88
89
90
91
92
93
94
95
96
accessarchi ve ............ IPROC access archive :
97
98
99
archi ve single
I
I
I
I
I
I
disable stop ;
directory state .- invalid;
archi va name : = name ;
last access time : = clock (1)
IENDPROC archive
I
I
I
directory state .- invalid
I
IENDPROC release;
I
I
I
I
I
I
I
I
IF directory state = invalid
THEN open archive
ELIF last access more than two seconds ago
THEN check volume name ;
new open i f somebody changed medium
I Fl.
I
I
lastaccessmorethantwos Ilast access more than two seconds ago :
I abs (clock (1) - last access time) , 2.0
I
I
100
101
102
103
104
105
newopenifsomebodychang Inew open if somebody changed medium
I IF header. date () write stamp
I
THEN directory state . - invalid
I
access archive
I Fl.
106
107
10e
109
110
111
112
113
openarchive
S49/2
I
I
lopen archive
I directory state : = invalid
I check volume name ;
I write stamp : = header. date
I was already write access : = FALSE
I read directory ;
I make directory valid if no read errors occurred .
I
archive single
849/2
Zeile
E LAN
EUMEL
1.8
****
10.11.86
archive single
114
115
116
11 7
118
119
120
121
122
123
124
125
126
127
readdirectory
128
129
130
131
132
133
134
makedirectoryvalidifno Imake directory valid if no read errors occurred
I IF directory state = invalid
I
THEN directory state : = valid
I FI
135
136
137
138
139
140
141
I PER.
I
I
I
IENDPROC access archi ve
I
accessfile ............... IPROC access fi Ie (TEXT CONST name)
I
I
I
154
155
156
157
158
159
160
161
162
163
164
165
166
167
S49/3
file name : = name
dir index .- link (directory, file name) .
I
IENDPROC access file
I
I
~2
143
144
145
146
~7
148
149
150
151
152
153
I read directory :
I directory: = empty thesaurus
I rewind;
I get next header ;
I WHILE header. type = file header REP
I
IF directory CONTAINS header. name
I
TIIEN rename (directory, header. name, dummy name)
I
FI;
I
insert (directory, header. name , dir index) ;
I
header block (dir index) : = end of volume block
I
header date (dir index) := header.date ;
I
get next header ;
checkvolumename .......... IPROC check volume name
I
I
I
I
I
I
I
disable stop ;
archive size : = archive blocks ;
read volume header ;
IF header. type () start of volume
THEN simulate header (start of volume, "?????")
ELIF header. name () archive name
THEN errors top ("'Archiv heisst ""'" + header. name + """")
I
I FI.
I
readvolumeheader
I
I read volume header
I rewind;
I read header ;
I IF is error
I
THEN clear error
I
simulate header (start of volume, "?????")
I Fl.
I
IENDPROC check volume name
I
getnextheader ............ IFROC get next header
I
I
I
disable st~p ;
skip da taspa.ce
archi ve single
549/3
Zeile
E LAN
EUMEL 1.8 ****
10.11.85
archi ve single
IF NOT is error
THEN read header
168
169
170
FI;
IF is error
THEN clear error ;
directory state .- read only
search header
171
172
173
174
175
175
FI;
end of volume block : = block number - number of header blocks .
177
178
179
searchheader
180
181
182
183
184
185
186
187
isheaderspace
188
Isearch header
lINT VAR ds pages
I search da taspace (ds pages)
I IF ds pages ( 0
I
THEN simula.te header (end of volume, "")
I ELIF NOT is header space
I
THEN simulate header (file header, "????? " + text (bl?ck
I
number))
I FI.
I
I
I is header space :
I IF ds pages () 1
THEN FALSE
ELSE remember position
189
190
read header ;
IF read error occurred
THEN clear error; back to old position; FALSE
ELIF header format looks ok
191
192
193
194
195
196
197
198
199
200
THEN TRUE
ELSE back to old position
FI .
readerroroccurred
201
202
203
204
205
headerformatlooksok
206
207
208
rememberposl tion
209
210
211
212
213
214
215
Z6
217
218
219
220
S49/4
FALSE
FI
Iread error occurred :
I is error CAND error code
I
I
Iheader forma. t looks ok :
I
read error .
header. type = file header OR header. type
end of volume .
I
I
Iremember position
lINT CONST old block nr : = block number .
I
backtooldposi tion
I
Iback
I
to old position :
seek (old block nr) .
I
IENDPROC
I
I
get next header
fetch .................... IPROC fetch (TEXT CONST file name)
I
I
I
fetch (file name, archive)
IENDPROC fetch
I
arch i ve single
S49/4
Zeile
221
222
223
224
225
226
227
228
229
E LAN
I
I
I
I
I
I
I
243
244
245
246
247
248
249
overwri tepermi tted
Iget archive file:
I last pa.ram (file name) ;
I disable stop ;
I continue (archive channe l)
I fetch file (file name) ;
I last access time : = clock (1)
I continue (main channel) ;
I IF NOT is error
I
THEN forget (file name, quiet)
I
copy (ds, file name)
I FI;
I forget (ds)
I
I
loverwrite permi t ted :
I say ("eigene datei """)
I say (file name) ;
I yes ("." ueberschreiben")
I
IENDPROC fetch ;
I
fetchfile ................ IPROC fetch file (TEXT CONST name)
I
I enable stop ;
I access archive
I access file (name)
I IF no read error remarked
I
THEN disable stop ;
I
fetch ds (accept read errors)
I
IF read error occurred
I
THEN remark read error
_
I
261
262
263
264
I
I
265
266
267
noreaderrorremarked
268
readerroroccurred
I
I
I
TI;
enable stop
ELSE fetch ds (ignore read errors)
Fl.
Ino read error remarked:
I pos (name, " mit Lesefehler")
0.
I
I
269
270
S49/5
enable stop;
IF NOT (from = archive)
THEN errors top ("Task gibt es nicht")
ELIF NOT exists (file name) COR overwr1 te permitted
THEN get archive file
Fl.
I
I
getarchi vefile
271
272
273
274
275
archive single
10.11.86
fetch .................... IPROC fetch (TEXT CONST file name, TASK CONST from)
2:30
231
232
233
2M
235
236
237
238
239
240
241
242
250
251
252
253
254
255
256
257
258
259
EUMEL 1.8 ****
remarkreaderror
Iread error occurred
I is error AND error code
read error .
I
I
Iremark read error
I dir index : = link (directory, file name)
I
REP
I
I
file name CAT " mit Lesefehler" ;
UNTIL NOT (directory CONTAINS file name) PER
archi ve single
S49/5
Zeile
E LAN
280
281
284
285
286
287
288
289
10.11.86
archi ve single
I IF LENGTH file name ( 100
I
THEN rename (directory, dir index, file name)
I Fl.
I
IENDPROC fetch file
I
276
277
278
279
282
283
EUMEL 1.8 ***.
fetchds .................. IPROC fetch ds (BOOL CONST error accept)
I
I enable stop
I IF file name (> dummy name
I
THEN fetch from archive
I
ELSE error ("Name unzulaessig")
I Fl.
I
290
291
292
293
294
295
296
297
298
299
300
fetchfromarchi ve
301
302
303
positiontofile
304
305
306
307
fileindirectory
I
Ifetch from archive
I IF file in directory
I
THEN position to file
I
forget (ds) ;
I
ds : = nilspace ;
I
read (ds, 30000, error accept) ;
I ELIF directory state = read only
I
THEN error ("gibt es nicht (oder Lesefehler)")
I
ELSE error ("gibt es nicht")
I Fl.
I
I
I posi tion to file :
I seek (header block (dir index) + number of header blocks) .
I
I
Ifile in directory:
I
IENDPROC fetch ds ;
I
dir index> 0 .
308
309
310
311
312
M3
erase .................... IPROG erase :
I
I erase (last param)
314
315
316
317
318
319
erase .................... IPROC erase (TEXT CONST file name)
320
321
322
323
324
325
326
erase .................... IPROC erase (TEXT CONST file name, TASK CONST dest)
S49/6
I
IENDPROC erase
I
I
I
erase (file name, archive)
I
IENDPROC erase
I
I
I
I
I
I
I
= archive
THEN disable stop
continue (archive channel) ;
erase on archive (file name)
last access time := clock (1) ;
IF dest
a.rchive single
649/6
Zeile
E LAN
1. 8
EUMEL
****
327
328
I
329
FI
,
'ENDPROC erase
,
,
348
349
350
351
352
3~3
354
355
356
357
358
359
360
361
362
363
364
365
~
367
archi ve single
continue (main channel)
ELSE errors top ("Task gibt es nicht")
,
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
10. 11. 86
eraseonarchi ve ........... , PROC erase on archive (TEXT CONST file name)
,
, enable stop ;
, access archive
, access file (file name) ;
, continue (main channel) ;
, IF NOT file in directory
,
THEN putline ("gibt es nicht")
' L E A V E erase on archive
, ELIF NOT yes (""""+file name+ ftM " loeschen")
,
THEN LEAVE erase on archive
'Fl;
I continue (archive channel)
, erase archive entry .
,
,
fileindirectory
'file in directory: dir index ) 0 .
,
'ENDPROG erase on archive
,
erasearchi veentry ........ , PROG erase archive entry :
,
, IF directory state = read only
,
THEN errors top ("' save' /'erase' wegen Lesefehler verboten")
,
ELSE update write stamp if first write access;
' e r a s e archl ve
'Fl.
,
,
updatewritestampiffirs ,update write stamp if first write access
, IF NOT war. already write access
,
THEN rewind ;
' w r i t e stamp := text (clock (i), 13, 1) ;
, w r i t e header (archive name, write stamp, start of volume)
' w a s already write access . - TRUE
, Fl.
,
,
368
369
370
371
372
373
374
375
erasearchive
'erase archive :
, IF file in directory
,
THEN IF is last file of archive
' T H E N cut off all erased files
' E L S E rename to dummy
'FI
, Fl.
,
376
fileindirectory
'file in directory
377
S49/7
,
dir index ) 0 .
,
archive single
S49/7
Zene
318-
E LAN
isl&stfileofarchi ve
379
38e
1.8 .." .."
EUMEL
cutoffallerasedfi les
lis last file of archive
I
I
381
382
383
archi ve single
10.11.86
dir index. highest entry (directory) .
cut off all erased files :
directory state : = invalid
REP
delete (directory, dir index)
dir index DECR 1
UNTIL dir index = 0 COR name (directory, dlr index) <> dummy name
384
385
PER ;
behind last valid file ;
wri te end of volume ;
directory state := valid
386
387
388
389
390
391
392
393
behindlastvalidfile
394
395
396
397
398
399
renametodummy
Ibehind last valid file :
I seek (header block (dir index + 1))
I end of volume block := block number
I
I
400
401
402
403
404
405
406
407
408
409
tofileheader
415
416
Ito file header:
I seek (header block (dir index))
I
IENDPROC erase archive entry ;
I
410
411
412
413
414
rename to dummy :
directory state . - invalid
to file header
read header ;
to file header
header. name : = dummy name
header.date : = dummy date
write (header space) ;
rename (directory, file name. dummy name)
header date (dir index) : = dummy date ;
directory state := valid.
save
..................... IPROC
I
I
save :
save (last param)
I
IENDPROC
I
save ;
417
418
419
420
421
422
save _.................... IPROC save (TEXT CONST file name)
423
424
425
426
427
428
save ..................... IPROC save (TEXT CONST file name. TASK CONST to)
S49/8
I
I
save (file name, archive)
I
IENDPROC
I
save
I
I
I
I
I
IF to = archive
THEN disable stop
continue (archive channel) ;
save to archive (file name) ;
archive single
849/8
Zeile
E LAN
429
430
431
1
1
1
4~
10.11.86
••••
archive single
last access time : = clock (1) ;
continue (main channel)
ELSE errorstop ("Task gibt es nicht")
n.
1
4~
434
435
436
437
438
439
440
441
442
443
444
EUMEL 1.8 ••••
1
1
ENDPROC save
1
savetoarchi ve ............ 1PROC save to archive (TEXT CONST file name)
1
1
1
1
1
1
1
1
«5
enable stop ;
access archive
access file (file name)
continue (main channel)
IF file in directory
THEN IF NOT yes ("ftft" +file name+"ftft ueberschreiben")
THEN LEAVE save to archive
n
1
446
447
448
449
450
451
452
453
454
455
456
457
1
1
1
1
1
1
1
1
1
1
1
FI;
continue (archive channel)
access archive ;
access file (file name) ;
erase archive entry ;
IF file name = dummy name
THEN error ("Name unzulaessig")
ELIF file too large OR highest entry (directory)
max files
THEN error ("kann nicht geschrieben werden (Archiv vall)")
ELSE write new file
Fl.
)=
1
1
458
459
fileindirectory
460
461
462
filetoolarge
Ifile in directory
dir index) 0 .
1
1
1file too
1 end of
large :
volume block + ds pages (ds) + 5 ) archive size
1
1
1write
463
464
465
466
467
468
469
470
471
472
473
474
wri tenewfile
new file :
seek (end of volume block)
disable stop ;
wri te file (file name. old (file name»
IF is error
THEN seek (end of volume block)
ELSE insert (directory. file name. dir index)
remember begin of header block ;
remember date
FI ;
wri te end of volume .
475
476
477
rememberbeglnofheaderb Iremember begin of header block:
1 header block (dir index) : = end of volume block .
478
479
480
rememberdate
1
1
481
Iremember date
header date (dir index) := date .
1
1ENDPROC save to archive ;
482
1
549/9
1
archive single
549/9
Zeile
483
484
485
486
487
488
489
490
491
82
493
494
495
496
497
498
E LAN
EUMEL
1. 8
-**
10.11.86
archive single
writefile ................ IPROC write file (TEXT CaNST file na.me, DATASPACE CONST ds)
I
I eMble stop ;
I wr1 te
I write
I
IENDPROC
I
header (file lI&DIe, date, file header)
(ds)
write file
wri teendofvolume ......... I PROC write end of volume
I
I
I
I
I
disable stop ;
end of volume block : = block number ;
write header ("", "", end of volume)
I ENDPROC write end of volume ;
I
499
500
501
502
503
504
505
506
507
508
509
510
511
512
writeheader .............. I PROC write header (TEXT CaNST name, date, INT CaNST header type)
513
514
515
516
517
518
M9
520
521
re& ' ' ' '
THEN IF NOT yes (wa.rcbiv W"w+header.name+ WW " loescben")
THEN LEAVE c lea.r archi ve
FI
ELSE IF NOT yes ("a.rchi v initialisieren W)
THEN LEAVE clea.r archive
FI
FI ;
continue (archive channel)
710
711
712
713
714
715
716
717
718
719
720
721
722
IENDPROC clea.r archive
I
format ................... IPROC format (INT CONST form&t code, TASK CONST dest)
723
I
724
725
I
I
I
I
I
I
I
I
I
I
I
I
726
727
728
729
730
731
732
733
734
735
I
736
737
738
739
I
I
740
741
742
743
744
745
S49/14
a.rchive single
ask for erase all ;
directory state := invalid
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
10.11.86
I
IF dest = a.rchi ve
TIlEN IF yes (WW7 WFor01&tieren ueberschreibt alles! Richtlge
Diskette elngelegt W)
THEN disable stop ;
continue (a.rchi ve channel) ,
form&t a.rchive (form&t code)
directory state : = invalid ;
rewind ;
write header ( a.rchive name, text (clock (1),13,1)
,sta.rt of volume)
wri te end of volume ;
continue (main channel)
FI
ELSE errcrstop ("Task gibt es nicht")
Fl.
IENDPROC format
I
form&t ................... IPROC format (TASK CONST dest)
I
I
format (0, dest)
I
IENDPROC format ;
I
a.rchive single
849/14
Zelle
746
747
748
749
750
751
752
849/15
E LAN
error
EUMEL
1.8 _..
10.11.86
a.rchi ve single
.................... IPROC error (TEXT CONST error msg) :
I
I errorstop (---- + file name + n_ I
IENDPROC error ;
I
+ error msg)
IENDPACKET archive single
archi V8 single
849/15
Zeile
1
2
3
4
5
6
7
8
9
19
11
12
13
14
15
16
17
18
19
2Cil
21
22
23
E LAN
EUMEL
1.8
_..
I
I
I
I
I
I
I
I
I
I
I
I
I
ans 1 cursor,
b&ucirate,
bits,
cursor logic ,
elbi t cursor ,
enter incode
enter outcode ,
flow,
1nput buffer size
link ,
new configurat10n ,
new type ,
ysize:
I
ILET max d type nr
I
device table
I
ack = 9 ;
I
IBOUND
31
32
33
34
35
36
37
38
t
5, (.. maximum number of act1 ve dev1ce tables .. )
32889,
I
27
29
22.94.86 ------------------- .. )
( .. Autor: D.Heinrichs .. :
I
I
I
I
3Cil
konfigurieren
1(" ------------------- VERSION 4
konfigur1eren --"--IPACKET konfigurieren DEFINES
24
25
26
28
19.11.86
lINT VAR next outstring,
I
next 1nstr1ng;
I
I
I
I
STRUCT (ALIGN space,
umsetzcodetabelle .. )
ROW 128 INT ou tcodes ,
ROW 64 INT outstrings,
ROW 64 INT instrings) VAR x;
( ..
I
I
IROW max dtype nr DATASPACE VAR device code table;
I
ITHESAURUS VAR dtypes
I
I
39
49
41
42
43
44
45
46
47
48
49
59
51
newconf1gura tion ......... IPROC new configuration :
52
53
54
55
56
57
blockout ................. IPROC block out (DATASPACE CONST ds, INT CONST page, code):
I INT VAR err;
I block out (ds,page,9,code,err);
I announce error (err)
IEND PROC block out;
52/1
I
I
I
I
I
I
I
I
I
d type s : = empty the saurus
INT VAR i ;
insert (dtypes, "psi", i) ;
insert (dtypes, "transparent", i) ;
FOR i FROM 1 UPI'O max d type nr REP
forge t (dev i ce code table (i»
PER.
IENDPROC new conf1guration
I
I
I
konfigurieren
52/1
Zeile
E LAN
EUMEL
1. 8
......
10.11. B6
konfigurieren
58
59
60
61
62
63
64
65
66
67
announceerror ............ IPROC announce error (INT CONST err):
I SELECT err OF
I CASE 0:
I CASE 1: errors top ("unbekanntes Terminalltomma.ndo")
I CASE 2: errorstop ("Nummer der Terminal-Typ-Tabelle falsch")
I CASE 3: errorstop ("falsche Terminalnummer")
I OTHERWISE errorstop ("blackout: unzula.essiger Ka.na.l")
I ENDSELECT
IEND PROC announce error;
68
69
70
71
flow ..................... IPROC flow (INT CONST nr, INT CONST dtype):
I control (6, dtype, nr)
IEND PROC flow;
72
73
74
75
ysize .................... IPROC ysize (INT CONST channel ,new size, INT VAR old size)
I control (11, channel, new size, old size)
IENDPROC ysize
76
77
78
79
80
inputbuffersize .......... IPROC input bu1"fer size (INT CONST nr,size):
I INT VAR err;
I control (2,nr,size,err)
IEND PROC input buffer size;
81
82
83
baudrate ................. IPROC baudrate (INT CONST nr, rate)
I control (8, rate, nr)
IENDPROC baudra te
B4
I
I
I
I
I
85
B6
87
88
bits ..................... IPROC bits (INT CONST channel, number, parity)
I bits (channel, number-l + a..parity)
IENDPROC b1 ts ;
89
90
91
92
bits ..................... IPROC bits (INT CONST channel, key)
I control (9, key, channel)
IENDPROC bi ts
93
94
95
96
97
98
99
control .................. IPROC control (INT CONST function, key, channel)
~
101
102
103
104
52/2
I
I
I
lINT VAR err ;
I IF key ) -128 AND key < 127
I
THEN control (function, channel, key, err)
I ELIF key = -128
I
THEN control (function, channel, -maxint-1, err)
I IT
I
IENDPROC control
I
I
konfigurieren
52/2
Zelle
E LAN
1.8 ****
EUMEL
10.11.86
konfigurieren
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
nelltype .................. IPROC nell type (TEXT CONST dtype):
I x: = nell (dtype);
I type (old (dtype), device ta.ble);
I next outstring : = 4;
I next instring : = 0;
I INT VAR i;
I (* Defaults, dami t trmpret den cursor mi tfuehrt: *)
I
FOR i FROM 1 UPl'O 6 REP
I
enter outcode (i, i )
I
PER;
I
enter outcode (8,8);
I
enter outcode (10,10);
I
enter outcode (13,13);
I
enter outcode (14,126);
I
enter outcode (15,126);
IEND PROC nell type;
I
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
activatedtype ............ IINT PROC activate dtype (TEXT CONST dtype):
I
I INT VAR i := link (dtypes, dtype);
I IF (exists (dtype) CAND type (old (dtype)) = device ta.ble)
I
THEN IF i <= 0
I
THEN insert (dtypes, dtype, i);
I
FI;
I
forget(device code ta.ble (1-2));
I
device code ta.ble (1-2) :a old (dtype)
I FI;
I IF i ) max dtype nr +2 (* 5 neue Typen erLaubt *)
I
THEN delete (dtypes,i);
I
error stop ("Anzahl Term1naltypen ) "+text (i));0
I
ELIFi<=0
I
THEN error stop ("Unbekannter Term1naltyp" + dtype); 0
I
ELSE i
I
I
138
139
140
141
Flo
lEND PROC activate dtype;
I
142
143
144
145
146
147
148
149
150
151
152
153
154
155
link....................
PROC link (INT CONST nr, TEXT CONST dtype):
156
157
158
159
160
enteroutcode ............. IPROC enter outcode (INT CONST eumel code, ziel code):
52/3
konfigurieren
INT VAR 1st nr := activate dtype (dtype)-3;
IF 1st nr < 0
THEN 1st nr INCR 256 (. fuer std term1nal und std device *)
ELSE blockout (device code ta.ble(lst nr+1), 2, 1st nr);
fI;
INT VAR err : = 0;
control (l,nr,lst nr,err)
announce error(err)
lEND
I
I
I
I
I
I
PROC link;
IF ziel code < 128
THEN simple entry (eumel code, z1el code)
ELSE enter outcode (eumel code, e, code (z1el code))
52/3
Zeile
E LAN
I
161
162
163
164
165
166
167
168
169
170
171
172
173
174
H5
176
177
1.8 ****
EUMEL
10.11.86
konfigurieren
Fl.
I
IENDPROC enter outcode
I
simpleentry .............. IPROC simple entry (INT CONST eumel code, ziel code)
I
I INT CONST position : = eumel code DIV 2 +1,
I
teil : = eumel code - 2*posi tion + 2;
I TEXT VAR h : ="
";
I replace (h,l,out word);
I replace (h,l+teil,code (zlel code»;
lout word :. (h ISUB 1).
I
outword
I
lout word: x.outcodes (position).
I
IEND PROC simple entry ;
I
190
191
192
193
enteroutcode ............. IPROC enter outcode (INT CONST eumel code, wartez9it,
TEXT CONST sequenz):
I
I
INT VAR i;
I
simple entry (eumel code, next outstring + 128);
I
enter part (x.outstrings, next outstring, wartezeit);
I
FOR i FROM 1 UPTO length (sequenz) REP
I
enter part (x. outstrings , next outstring + i, code
I
(sequenzSUB1) )
I
PER;
I
next outstring INCR length ( sequenzl+2;
I
abschluss.
I
I
I
abschluss
a.bschluss:
I
enter part (x.outstrings, next outstring-l, 0)
I
lEND PROC enter outcode;
I
194
195
196
197
enteroutcode ............. IPROC enter outcode (INT CONST eumelcode, TEXT CONST wert):
I enter outcode (eumelcode,code(wert»
IEND PROC enter outcode;
I
198
199
200
201
enterpart ................ IPROC enter part (ROW 64 INT VAR a,INT CONST index, wert):
I INT CONST position := index DIV 2 +1,
I
teil := index - 2*position + 2;
I IF position ) 64 THEN errorstop ("Ueberl&uf der
I
Termin<ypt&belle") FI;
I TEXT VAR h :="
";
I replace (h,l,out word);
I repl&ce (h,l+teil,code (wert»;
I out word := (h ISUB 1).
178
179
180
181
182
183
184
185
186
187
188
189
202
203
~4
205
206
207
208
209
52/4
I
I
outword
lout word: & (position).
lEND PROC enter part;
I
konfigurieren
~2/4
Zeile
EUMEL
E LAN
1.6 ••••
10.11.66
konfigurieren
219
211
212
213
214
215
216
217
enterincode. . . . . . . . . . . . .. PROC enter incode (INT CONST elan code, TEXT CaNST sequenz):
IF elan code ) 254 OR elan code ( 0 THEN errors top ("kein
Eingabecode")
ELSE
INT VAH i;
enter part (x. instrings, next instring, elan code);
FOR i FROM 1 UPTO length (sequenz) REP
enter part (x.instrings, next instring + i, code
( sequenzSUBi) )
PER;
216
219
next instring INCH length (sequenzl+2;
220
221
222
FI
223
IEND PROG enter incode;
224
I
225
226
227
226
229
230
cursor logic .............. lpROG cursor logic (INT CaNST dist, TEXT CONST pre, mid, post):
231
232
233
234
235
236
anslcursor ............... IPROG ansi cursor (TEXT CONST pre, mid, post):
237
236
239
cursor logic
2413
241
242
243
244
245
246
247
248
249
250
251
252
253
52/5
I
I
cursor logic (dist,255,pre,mid,post)
I
IEND PROG cursor logic;
I
I
I
cursor logic (13, 1, pre, mid, post)
I
lEND PROG ansi cursor;
I
......
00
00
00
00
IPROC cursor logic (INT CONST dist, modus, TEXT CONST pre, mid, post)
I
I
I
I
I
I
I
enter
enter
enter
enter
enter
part (x.outstrings,2,dist);
part (x.outstrings,3,dist);
part (x.outstrings,e,modus);
part (x.outstr1ngs,1,modus);
outcode (6,0,pre+''''E)''y''+m1d+''''E)''x''+post+'''''e'''')
lEND PROC cursor logic;
I
elbitcursor .............. IPROG elbit cursor:
I
cursor logic (0, ""27"" , "" • "") ;
I
enter part (x.outstrings,e,2);
I
enter part (x.outstrings,1,255);
lEND PROC elb1t cursor;
I
IENDPACKET konf1gurieren;
konfigurieren
52/5
Zeile
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
S53/1
E LAN
1.8
EUMEL
••••
configurator single
19.11.86
1(. ------------------- VERSION 11
configuratorsi ngle ....... IPACKET configurator single DEFINES
I
I
I
I
I
10.06.86 ------------------- .)
configura te ,
exec conf1gurat1on •
setup:
ILET baucirates
= ""1"50"2"75"3"110"4"134.5"5"150"6"300"7"see
1"8"1200"9"1800"10"2490"11 "3690"12"4800"13"72e0
1"14 "9690"15"192e0"16"38490"17"",
I pari ties
""0"no"1 "odd"2"even"3"" ,
bits per char
""9"1"1"2"2"3"3"4"4"5"5"6"6"7"7"8"8""
I
I
stopbits
""9"1"1"1.5"2"2"3"" •
I
flow modes
""0"ohne Protokoll"1"XON/XOIT"2"RTS/CTS
1"3""4""5"XON/XOIT - ausgabeseitig"6"RTS/CTS - ausgabese1tig"7""8"
1"9"XON/XOIT - e1ngabeseitig"19"RTS/CTS - e1ngabese1t1g"11"" ,
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
I
ok
esc
cr
right
"j" ,
psi
transparent
"psi" ,
"transparent"
std
std
std
std
""27""
""13""
rate
= 14 ,
.22,
bits
flow
= e ,
16 ,
inbuffer size
device table
ed1t terminal
configuration channel
III&X
CONF
=
• 15 ,
32
STRUCT (TEXT dev type,
INT balld, bits par stop, flow control, inbuffer
size) ;
IBOUND ROW
III&X
ed1 t term1nal CONF VAH conf
I
lINT VAH channel no
I
ITEXT VAH prelude
last feature, answer
I
I
I
shardpermits ............. IBOOL PROC shard permits (INT CONST code, key)
I
I INT VAH reply ;
I IF key) -128
THEN control (code,
I
ELSE control (code,
I
I FI ;
I reply = 9 .
I
channel no, key, reply)
channel no, -1II&X1nt-l, reply)
IENDPROC shard permi ts
I
configurator s1ngle
S53/1
Zeile
59
60
61
62
63
64
65
E LAN
EUMEL
1.8
****
10.11.86
****
configurator single
askuser .................. IPROC ask user (TEXT CONST feature, question)
I
I
I
1
1
last feature : = feature
put question ;
skip pre typed chars
get valid answer .
1
1
66
67
68
69
70
71
72
73
74
75
76
77
putquestion
1
clearline
skippretypedchars
81
82
83
84
85
86
87
getvalidanswer
88
98
105
+
106
107
108
109
110
S53/2
I
1skip pre typed chars
1 REP UNTIL incharety
"" PER •
I
I
1get
valid answer :
REP
inchar (answer)
1 UNTIL pes ("jJyYnN"27"·, answer) ) 0 PER
I IF answer) ·"31··
1
TIlEN out (answer)
1 FI;
lout (or) ;
1 normalize answer
1
1
1
89
90
99
100
101
102
103
104
1
1clear line :
lout (cr) ;
1 79 TIMESOUT " "
lout (cr) .
1
78
79
80
91
92
93
94
95
96
97
1put question
1 clear line
lout (prelude)
lout (feature)
lout (question) ;
lout (" (j/n) ") .
normalizeanswer
1
1normalize answer
1 IF pes ("jJyY",
1
I
:
answer) ) 0
TIlEN answer . - ok
Fl.
1
IENDPROC ask user
1
yes •.•••.••..•••••...•••• IBOOL PROC yes (TEXT CONST question)
1
1 ask user (.", question) ;
1 answer = ok
1
1ENDPROC yes
1
ohosekey ................. 1PROC chose key (INT VAH old key, INT CONST max key, TEXT CONST key
1
string,
1
key entity, BOOL PROC (INT CONST) shard permits):
I
IF shard permits at least one standard key
THEN try all keys
1 FI.
1
1
oonfigurator single
S53/2
E LAN
Zeile
EUMEL
1.8
••••
configurator single
10.11.86
I
111
I
112
113
114
115
116
117
118
119
120
sha.rdpermi tsatleastone Ishard perm! ts at least one standard key
I INT VAR key ;
I FOR key FROM 0 UPTO max key REP
I
IF shard permi ts (key)
I
THEN LEAVE shard permits at least one standard key Wlrn TRUE
I
FI
I PER;
I FALSE
121
122
123
124
125
126
127
tryalIkeys
128
129
130
131·
132
133
134
135
136
137
exa.minethiskey
138
139
140
keyvalue
I
I
142
143
keypos
145
146
nextkeypos
147
chosethlskey
149
150
151
nextkey
155
156
157
S53/3
this key :
IF shard permi ts (key) CAND key value () ""
TIlEN ask user (key value, key enti ty)
IF answer • ok
THEN chose this key
ELIF answer = esc
THEN key :. -129
FI
Fl.
I
I
I
I
I
Ikey value
I IF key ). 0
I
THEN subtext (key
I
ELSE text (key)
I Fl.
I
I
Ikey pos
I
string, key pos + 1, next key pos - 1)
pos (key string, code (key)) .
Inext key pos
pos (key string, code (key+l))
Ichose this key
I remember calibration
I old key :. key ;
I LEAVE chose key
I
I
Inext
I
I
I
154
158
159
160
161
152
163
Iexamine
I
I
148
152
153
I
I
I
I
I
I
I
141
144
Itry all keys
I key: = old key
I REP
I
examine this key
I
next key
I PER.
I
I
I
remembercalibration
key
IF key ( max key
THEN key INCR 1
ELSE key := 0
Fl.
Iremember calibration
I prelude CAT last feature
I prelude CAT ", " .
I
IENDPROC
I
chose key ;
configurator single
853/3
Zelle
E LAN
EUMEL 1.8 *.**
configurator single
10.11.86
164
165
166
167
168
169
ra teok •.................. IBOOL PROC rate ok (INT CONST key)
170
171
172
173
174
175
176
bits ok ................... IBOOl PROC bi ts ok (INT CONST key)
177
178
179
180
181
182
183
I
I
shard permits (8, key)
I
IENDPROC rate ok
I
I
I
I
I
IF key ( 0
THEN shard permits (9, key)
ELSE some standard combination ok
I Fl.
I
I
somestandardcombinatio Isome standard combination ok
I INT VAH combined : = key ;
I REP
I
IF shard permits (9, combined)
I
THEN LEAVE bits ok WITH TRUE
I
FI;
combined INCR 8
UNTIL combined , 127 PER
FALSE
184
I
I
185
186
187
188
I
I
IENDPROC
I
bi ts ok
189
190
191
192
193
194
195
196
197
pari tyok ...............•. IBOOl PROC pari ty ok (INT CONST key) :
198
199
200
201
202
stopbitsok ............... IBOOl PROC stopbits ok (INT CONST key) :
~3
204
205
206
207
I
I
I
I
I
INT VAH combined : =
key,= 0 AND (shard
shard
shard
8 * key
permits
permits
permits
IENDPROC parity ok
I
I
I
key,= 0 AND shard permits (9, 32
key + 8 * parity + data bits)
IENDPROC stopbi ts ok ;
I
flowmodeok ............... IBOOl PROC flow mode ok (INT CONST key)
I
I
shard permi ts (6, key)
I
~9
211
I
I
I
212
213
214
215
lINT VAR operators channel ,
I
data bits
I
pari ty ,
I
stop ;
553/4
*
I
IENDPROC flow mode ok ;
zs
(9, combined)
OR
(9, combined + 32) OR
(9, combined + 64)
I
~8
210
+ data bits
I
configurator single
S~3/4
Zeile
E LAN
217
218
Z9
220
221
222
223
224
225
226
227
configurate .............. 1PROC configurate :
I
I IT.
I
I
~
ini tializeconfigura tio I ini tialize configuration ;
I FOR channel no FROM 1 UPI'O max edit terminal REP
I
conf (channel no) ; =
I
CONF; (transparent, std rate, std bits, std flow, std inbuffer
I
size)
I PER;
I conf (l).dev type ;= psi.
I
I
showalldevicetypes
260
261
262
263
264
265
266
267
268
553/5
setup this channel
FI;
channe 1 no INCR 1
UNTIL channel no ) 15 PER ;
prelude; = "" ;
IF yes ("Koennen unbenutzte Geraetetypen geloescht werden")
THEN forget unused device tables
FI.
accessconfigurationtab laccess configuration table;
I IF exists ("configuration")
I
THEN conf ;= old ("configuration")
I
ELSE conf ;= new ("configuration")
I
ini tial1ze configuration
244
252
253
254
255
256
257
258
259
REP
IF channel hardware exists
THEN try thi schanne 1 ;
I
I
I
237
+
I
I
I
I
I
I
236
249
250
251
new configuration
access configuration table
show all device types
channel no ;= 1 ;
I
232
233
234
235
247
248
I
I
I
I
I
I
I
231
245
configurator single
ITEXT VAR table name, dummy
229
230
246
10.11.86
I
I
228
238
239
240
241
242
EUMEL 1.8 ••••
Ishow all device types
I show prelude ;
I begin li st ;
I get lis t entry (table name, dummy)
I WHILE table name <) "" REP
I
IF dataspace is device table
I
THEN show table name
I FI;
I
get list entry (table name, dummy)
I PER;
I line (2) .
I
I
showpre lude
Ishow pre lude
I line (30) ;
I outtext (psi, 1, 20) ;
I outtext (transparent, 1, 20) .
I
configurator single
553/:5
Zeile
E LAN
EUMEL
1.8.....
10.11.86
configurator single
269
270
271
dat&spaceisdevicet&ble Idat&space is device table
I type (old (t&ble name)) = device table .
272
273
274
showt&blename
I
I
I show table name :
I outtext (t&ble name, 1, 20) .
I
I
275
276
277
278
279
280
re1
re2
trythischannel
Itry this channel :
pre lude : = "K&Il&l " ;
I ask user ("", text (channel no))
I IF answer • ok
I
THEN prelude CAT text (channel no) + ": " ;
I
get configuration from user (cont (channel no))
I
283
I
I
I
I
li~
Fl.
284
re5
re6
287
288
re9
290
291
292
293
294
295
296
297
298
299
300
channelh&rdwareexists
301
302
303
getchanneltypefromshar Iget channel type from shard
I control (1, 0, 0, channel type)
304
305
inoutm&sk
306
307
308
309
310
311
W
313
314
315
forgetunuseddevicet&bl Iforget unused device tables :
I begin list ;
I get list entry (t&ble name, dummy) ;
I WHILE table name < > "" REP
I
IF type (old (t&ble name)) = device table
I
THEN forget if unused
I TI;
I
get list entry (t&ble name, dummy)
I PER.
316
317
318
319
320
321
322
323
forgetifunused
853/6
Ichannel hardware exists:
I operators channel := channel
I INT VAR channel type ;
I disable stop ;
I continue (channel no) ;
I IF is error
I
THEN IF error message • "kein Kanal"
I
THEN channel type : = 0
I
ELSE channel type : = inout mask
I
FI
I
ELSE get channel type from shard
I FI;
I c lear error ;
I disable stop ;
I continue operators channel ;
I (channel type AND inout mask) <> 0 .
I
I
I
I
linout mask
3.
I
I
I
I
I forget if unused :
I FOR channe 1 no FROM 1 UPl'O III&K edi t termi 11&1 REP
I
IF cont (channel no). dev type : table n&me
I
THEN LEAVE forget if unused
I FI
I PER;
I forget (t&ble n&me, quiet) .
I
configurator single
853/6
Zeile
324
325
326
327
328
329
****
ELAN
setupthischannel
continueoperatorschann Icontinue operators channel:
I continue (operators channel)
I IF is error
I
THEN clear error ;
I
LEAVE configurate
I FI;
I enable stop .
338
I
I
350
351
352
353
354
configurator single
Isetup this channel:
I operators channel : = channel ;
I disable stop ;
I continue (configuration channel)
I set up channel (channel no. conf (channel no))
I continue operators channel .
339
340
341
342
343
344
345
346
347
348
349
10.11.86
I
I
330
331
332
333
334
335
336
337
EUMEL 1.8 ****
IENDPROC configura te
getconfigurationfromus ... IPROC get configuration from user (CONF VAR conf)
I
I
I
I
getdevicetype
get
get
get
get
get
I
I
I
I
I
Iget
device type ;
baud rate ;
bits and pari ty and stopbi ts
protocol ;
buffer size .
device type
begin list ;
table name : = conf. dev type
IF NOT is valid device type
THEN next device type
~
IT;
356
357
358
359
360
361
362
363
REP
IF NOT (table n&me = transparent AND channel no = 1)
THEN ask user ("". table n&me) ;
IF answer = ok COR was esc followed by type table name
THEN IF is valid device type
THEN remember device type ;
LEAVE get device type
ELSE out (""7" unbekannter Typ"); pause (20)
FI
FI
FI ;
next device type
~
365
366
367
368
369
37@
371
:372
373
374
375
376
377
378
S53/7
PER .
wasescfollowedbytypeta Iwas esc followed by type table name
I IF answer = esc
I
THEN 9 TlMESOUT right ;
I
put ("Typ:") ;
I
edi tget (table name)
I
TRUE
I
ELSE F~E
I Fl.
I
configurator single
S53/7
Zeile
379
380
381
E LAN
isvaliddevicetype
382
383
rememberdevicetype
384
385
386
387
388
389
390
391
392
nextdevicetype
EUMEL
1.8
10.11.86
configurator single
I is valid device type :
I table name = psi OR table name = transparent OR
I (exists (table name) CAND type (old (table name» • device table)
I
I
Iremember device type :
I prelude CAT table name
I conf . dev type : = table name
I prelude CAT" "
I
I
Inext device type :
I IF table name = psi
I
THEN table name : = transparent
I
ELSE IF table name = transparent
I
THEN begin list
~
I
394
395
396
I
397
398
399
400
****
I
I
I
IT;
search next device type space
IT.
searchnextdevicetypesp Isearch next device type space :
I
REP
I
I
+
I
get list entry (table name, dummy)
UNTIL table name
"" COR type (old (table name» = device table
401
402
403
404
I
I
PER;
IF table name = ""
THEN table name : = ps i
Fl.
405
getba.udrate
406
416
417
418
419
420
getbi tsandparityandsto Iget bits and parity and stopbi ts :
data bits : = conf. bi ts par stop MOD 8
pari ty : = (conf. bi ts par stop DIV 8) MOD 4
stop := (conf.bits par stop DIV 32) MOD 4 ;
chose key (data bits, 7, bits per char, " Bits", PROO bits ok) ;
IF data bits)= 0
THEN chose key (parity, 2, parities, " parity", PROO parity ok)
chose key (stop, 2, stopbits, " Stopbi ts", PROO stopbi ts
ok) ;
conf.bits par stop := data bits + 8 * parity + 32 * stop
ELSE conf. bits par stop : = data bits
FI .
getprotocol
421
422
423
424
425
426
427
428
429
S53/8
Iget ba.udr&te
I chose key (conf.baud, 16, ba.udrates, " Baud", PROC rate ok) .
I
I
407
408
409
410
411
412
413
414
415
I
I
I
getbuffersize
get protocol :
I chose key (conf. flow control, 10, flow modes,
I " " , PROC flow mode ok)
I
I
Iget buffer size :
I IF dev type is transparent
I
THEN chose buffer size
I
ELSE conf. inbuffer size : = std inbuffer size
I Fl.
I
configurator single
S53/8
EUMEL
Ze1le
E LAN
430
devtypeistransparent
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
1.8
chosebuffersize
Ichose buffer size:
REP
I
IF conf. inbuffer size = 16 CAND yes ("normaler Puffer")
I
THEN LEAVE chose buffer size
I FI;
I
conf. inbuffer size : = 512
I
IF yes ("grosser Puffer")
I
THEN LEAVE chose buffer size
I FI;
I
conf .1nbuffer size . - 16
I PER.
I
I
IENDPROC get configuration from user
I
execconfiguration ........ IPROC exec conf1guration
I
I
451
452
I
457
458
459
setup .................... IPROC setup :
I
I
I
I
I
I
I
461
462
I
463
I
conf:= old ("configuration") ,
continue (configuration channel)
FOR channel no FROM 1 UPl'O max ed1 t term1nal REP
set up channel (channel no, conf (channel no»
PER;
continue (operators channel)
IENDPROC set up ;
setupchannel ............. IPROC set up channel (INT CONST channel no, CONF CONST cont)
465
I
466
467
468
469
470
471
472
H3
474
475
I
I
I
I
I
S53/9
setup
IENDPROC exec configurat10n
460
464
configura tor single
I
I
I
456
10.11.86
Idev type is transparent :
I conf . dev type • "transparent"
450
453
454
455
**-
link (channel no,
baudrate (channel
bits (channel no,
flow (channel no,
1nput buffer size
conf.dev type) ;
no, conf.baud) ;
conf.bits par stop)
conf.flow control) ;
(channel no, conf.1nbuffer s1ze)
I
IENDPROC setup channel;
I
IENDPACKET conf1gurator single
I
conf1gurator s1ngle
S53/9
Source Exif Data:
File Type : PDF File Type Extension : pdf MIME Type : application/pdf PDF Version : 1.6 Linearized : No Create Date : 2014:05:04 19:19:01+02:00 Creator : Adobe Acrobat 11.0.6 Modify Date : 2014:07:21 21:21:08-07:00 Title : XMP Toolkit : Adobe XMP Core 4.2.1-c043 52.372728, 2009/01/18-15:56:37 Metadata Date : 2014:07:21 21:21:08-07:00 Creator Tool : Adobe Acrobat 11.0.6 Format : application/pdf Document ID : uuid:e6823391-443c-4b42-8631-6decf2b59ca7 Instance ID : uuid:fa940781-5250-644e-95da-3f1961b8137e Producer : Adobe Acrobat 9.55 Paper Capture Plug-in Page Layout : SinglePage Page Count : 356EXIF Metadata provided by EXIF.tools