1 //  This file contains miscellaneous utility programs for runoff.
  2 //  Many of them are system-dependent by nature.
  3 //  Last modified on 05/30/74 at 18:42:57 by R F Mabee.
  4 //
  5 //  Routines defined in this module:
  6 //        Wait                Wait until line is typed in on console.
  7 //        ConsoleReadLine     Get line from console input.
  8 //        FixTab              Insert blanks into buffer to properly convert tab.
  9 //        Typeout             Print body of control line on console.
 10 //        ExecuteCommand      Pass body of control line to command processor.
 11 //        NewOutputStream     Make new output file when current one is full.
 12 //        SetCharsw           Turn "chars" option on or off.
 13 //        Report              Generate error message. Save if main output is to console.
 14 //        StoreString         Make unshared copy of string in free storage.
 15 //        Nx_open             Stack new input stream.
 16 //        Nx_close            Revert to previous input stream.
 17 //        Nx_reset            Reprocess input text (file).
 18 //        ReadLine            Get next input line from nested input streams.
 19 //        RoffProcess         Do all the text from a given input stream.
 20 //  Only FixTab is not external.
 21 
 22 //  Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc.
 23 
 24 //  General permission is granted to copy and use this program, but not to sell it, provided that the above
 25 //  copyright statement is given.  Contact Information Processing Services, MIT, for further information.
 26 //  Please contact R F Mabee at MIT for information on this program and versions for other machines.
 27 
 28 get "runoff_head"
 29 get "head"
 30 
 31 external
 32      $(   CuCp = "cu_$cp"
 33      $)
 34 
 35 global
 36      $(   EndL : 320                    //  Return point on end of all data.
 37           EndP : 321                    //  Stack frame to go with EndL.
 38      $)
 39 
 40 static
 41      $(   ErrorfileCounter = 0          //  Unique id for error message segments.
 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 //  The following function is used to open a stream.  Its
122 //  argument is the name of the file to open.
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                 //  Remember current stream.
128                     InputStack[NestingDepth + 1] := InputLines        //  And line number.
129                     InputStack[NestingDepth + 2] := InputFileName     //  And file name.
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 //  This parameter-less routine may be called to close off the
140 //  current stream.
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 //  This routine resets the current position in the current
164 //  input file back to the beginning so that the input will be read again.
165 
166 and Nx_reset () be
167      $(   ResetStream (INPUT, 0)
168           InputLines := 0
169      $)
170 
171 and Readline () be            //  Read next line into Rawchar[1]...Rawchar[Nr].
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  // Delete blanks.
184      $)
185 
186 let RoffProcess (Stream) be
187      $(   INPUT := Stream
188           InputLines := 0
189           InputFileName := FileName               //  Not always right, but close enough for now...
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              //  Eventually we run out of input and jump to End.
209 
210   End:    Nx_reset ()                   //  So it can be read again if necessary.
211      $)