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 get "runoff_head"
29 get "head"
30
31 external
32 $( CuCp = "cu_$cp"
33 $)
34
35 global
36 $( EndL : 320
37 EndP : 321
38 $)
39
40 static
41 $( ErrorfileCounter = 0
42 $)
43
44
45 let Wait () be
46 $( let v = vec Maxline
47 unless Filesw do ConsoleReadline (v)
48 $)
49 and ConsoleReadline (v) = valof
50 $( unless Filesw do Writeout (OUTPUT)
51 if CONSOLE = 0 do CONSOLE := Open (Console + Read)
52 let i = 0
53 $( if i < Maxline do i := i + 1
54 Readch (CONSOLE, lv Ch)
55 v!i := Ch & $8177
56 if Ch = '*t' do i := FixTab (v, i)
57 $) repeatuntil Ch = '*n'
58 v!i := '*s'
59 v!0 := i - 1
60 resultis i - 1
61 $)
62 and FixTab (v, i) = valof
63 $( let p = 0
64 for j = 1 to i - 1 do p := p + Width (v!j)
65 for j = p rem 10 to 9 do
66 $( v!i := '*s'
67 i := i + 1
68 $)
69 resultis i - 1
70 $)
71 and Typeout () be
72 $( Check_ref ()
73 unless Filesw do Writeout (OUTPUT)
74 for i = Nrx to Nr - 1 do Writech (MONITOR, Rawchar!i)
75 Writech (MONITOR, '*n')
76 $)
77 and ExecuteCommand () be
78 $( Check_ref ()
79 unless Filesw do Writeout (OUTPUT)
80 let v, w = vec Maxline, vec Maxline
81 let l = Nr - Nrx
82 if l le 0 return
83 Rawchar!(Nrx - 1) := l
84 Packstring (Rawchar + Nrx - 1, v)
85 MakePl1String (v, w, l)
86 call CuCp (ITS (w, v), lv l, lv Errcode)
87 $)
88
89 let SetCharsw (New) be
90 $( if New & ChStream = 0 do
91 $( let v = vec 20
92 ChStream := Open (EntryName + Write, Concatenate (v, 32, FileName, ".chars"))
93 unless Errcode = 0 do Complain (v)
94 WrChInit ()
95 $)
96 Charsw := New
97 $)
98 and Report (s) be
99 $( if Errorstream = 0 do
100 $( test Filesw
101 then Errorstream := MONITOR
102 or $( ErrorfileCounter := ErrorfileCounter + 1
103 ErrorTempID := ErrorfileCounter
104 ErrorfilePointer := MakeTempSeg (ErrorTempID, "error_messages")
105 Errorstream := Open (Pointer + Write, ErrorfilePointer)
106 $)
107 $)
108
109 Format (Errorstream, "^a in line ^d of file ^a. ", s, InputLines, InputFileName)
110 for i = 1 to Nr - 1 do Writech (Errorstream, Rawchar!i)
111 Writech (Errorstream, '*n')
112 $)
113
114 and StoreString (S) = valof
115 $( let P = Newvec (LengthInWords (S) - 1)
116 CopyString (S, P)
117 resultis P
118 $)
119
120
121
122
123
124 let Nx_open (Name) be
125 { test NestingDepth ge MaxDepth
126 then Report ("Input files nested too deeply")
127 or { InputStack[NestingDepth] := INPUT
128 InputStack[NestingDepth + 1] := InputLines
129 InputStack[NestingDepth + 2] := InputFileName
130 NestingDepth := NestingDepth + 3
131 INPUT := FindInput (Name, INPUT)
132 unless Errcode = 0 do Report ("Unable to open input file")
133 InputLines := 0
134 InputFileName := StoreString (Name)
135 }
136 }
137
138
139
140
141
142 and Nx_close () be
143 { unless JumpLine = -1 do
144 $( Nx_reset ()
145 let J = JumpLine - 1
146 JumpLine := -1
147 while InputLines < J do
148 $( Nr := 0
149 Readline ()
150 $)
151 Nr, Ch := 0, 0
152 return
153 $)
154 if NestingDepth le 0 do Longjump (EndL, EndP)
155 Close (INPUT)
156 Freevec (InputFileName)
157 NestingDepth := NestingDepth - 3
158 INPUT := InputStack[NestingDepth]
159 InputLines := InputStack[NestingDepth + 1]
160 InputFileName := InputStack[NestingDepth + 2]
161 }
162
163
164
165
166 and Nx_reset () be
167 $( ResetStream (INPUT, 0)
168 InputLines := 0
169 $)
170
171 and Readline () be
172 $( $( Readch (INPUT, lv Ch)
173 if Ch = Endofstreamch do
174 $( Nx_close ()
175 loop
176 $)
177 if Nr < Maxline do Nr := Nr + 1
178 Rawchar!Nr := Ch & $8177
179 if Ch = '*t' do Nr := FixTab (Rawchar, Nr)
180 $) repeatuntil Ch = '*n'
181 InputLines := InputLines + 1
182 Rawchar!Nr := '*s'
183 while Rawchar!Nr = '*s' do Nr := Nr - 1
184 $)
185
186 let RoffProcess (Stream) be
187 $( INPUT := Stream
188 InputLines := 0
189 InputFileName := FileName
190 NestingDepth := 0
191 EndL, EndP := End, Level ()
192
193 $( Readline ()
194 Process:
195 test LIno = 0
196 then test Rawchar!1 = '.'
197 then $( Control ()
198 if Again do
199 $( Again := false
200 goto Process
201 $)
202 $)
203 or Text ()
204 or $( Text ()
205 unless NoControl do LIno := LIno - 1
206 $)
207 Nr := 0
208 $) repeat
209
210 End: Nx_reset ()
211 $)