1 //  This module implements the defined I/O system calls for the runoff_ dim.
  2 //  Last modified on 05/30/74 at 18:42:47 by R F Mabee.
  3 //
  4 //  Routines defined in this module:
  5 //        SetModes            Fetch mode string and set modes.
  6 //        GetModeArg          Scan mode string for next field.
  7 //        OldModes            Store settable modes in PL/I arg string.
  8 //        StNum               Store numeric mode.
  9 //        StSwitch            Store on/off mode.
 10 //        Save                Stuff globals into SDB.
 11 //        Unsave              Retrieve globals from SDB.
 12 //        DimAttach           Set up runoff_ attachment.
 13 //        DimDetach           Remove runoff_ attachment.
 14 //        DimWrite            Process some text through runoff_.
 15 //        DimOrder            Execute control line from outside.
 16 //        DimChangemode       Alter internal modes and get old modes.
 17 //  Only the last five routines are external.
 18 
 19 //  Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc.
 20 
 21 //  General permission is granted to copy and use this program, but not to sell it, provided that the above
 22 //  copyright statement is given.  Contact Information Processing Services, MIT, for further information.
 23 //  Please contact R F Mabee at MIT for information on this program and versions for other machines.
 24 
 25 get "head"
 26 get "runoff_head"
 27 
 28 
 29 external
 30      $(   DimAttach = "runoff_dim$runoff_attach"
 31           DimDetach = "runoff_dim$runoff_detach"
 32           DimWrite = "runoff_dim$runoff_write"
 33           DimOrder = "runoff_dim$runoff_order"
 34           DimChangemode = "runoff_dim$runoff_changemode"
 35 
 36           Ionmat = "error_table_$ionmat"
 37           BadMode = "error_table_$undefined_order_request"
 38      $)
 39 
 40 static $( FreeSDBlist = 0 $)
 41 
 42 global
 43      $(   SDB       : 70
 44           StatPtr   : 71
 45           SdbLV     : 72
 46           ModeArg   : 73
 47 
 48           Global    : 0
 49      $)
 50 manifest
 51      $(   SdbIoname2 = 10
 52           SdbSave = 20
 53           SaveLen = 250
 54           SdbLength = 250 + 20
 55      $)
 56 
 57 let SetModes (n) be
 58      $(   let OldChars, OldDevice, OldPaging, OldControl, OldFill = Charsw, Device, NoPaging, NoControl, NoFill
 59           ModeArg := vec 128
 60           Pl1ArgString (n, ModeArg)
 61           ArgIndex := 1
 62           let Names = list "device", "margin", "chars", "pagination", "control",
 63                               "fill", "hyphenate", "number"
 64           and Pointers = list lv Device, lv ExtraMargin, lv Charsw, lv NoPaging, lv NoControl,
 65                               lv NoFill, lv Hyphenating, lv PrintLineNumbers
 66           and Flags = table OptConvert, OptConvert, OptNegatable, OptNegatable | OptNegate, OptNegatable | OptNegate,
 67                               OptNegatable | OptNegate, OptNegatable, OptNegatable
 68 
 69           OptionParse (GetModeArg, 8, Names, Pointers, Flags, 0)
 70 
 71           if OldChars neqv Charsw do SetCharsw (Charsw)
 72           if OldDevice ne Device do SetDevice (Device)
 73           if OldPaging neqv NoPaging do SetPaging (NoPaging)
 74           if OldControl neqv NoControl do LIno := NoControl -> 1000000, 0
 75           if OldFill neqv NoFill do Fi := not NoFill
 76      $)
 77 and GetModeArg (v) = valof
 78      $(   let Len = Length (ModeArg)
 79           while ArgIndex le Len & Subch (ModeArg, ArgIndex) = '*s' do ArgIndex := ArgIndex + 1
 80           if ArgIndex > Len resultis false
 81           let First = ArgIndex
 82           while ArgIndex le Len & Subch (ModeArg, ArgIndex) ne '*s' do ArgIndex := ArgIndex + 1
 83           Substr (v, ModeArg, First, ArgIndex - First)
 84           resultis true
 85      $)
 86 and OldModes (n) be
 87      $(   let v = vec 128
 88           SetLength (v, 0)
 89           StNum (v, "device", Device)
 90           StNum (v, "margin", ExtraMargin)
 91           StSwitch (v, "chars", Charsw)
 92           StSwitch (v, "pagination", not NoPaging)
 93           StSwitch (v, "control", not NoControl)
 94           StSwitch (v, "fill", not NoFill)
 95           StSwitch (v, "hyphenate", Hyphenating)
 96           StSwitch (v, "number", PrintLineNumbers)
 97           let Sp, Desc = Pl1ArgPtr (n), Pl1Descriptor (n)
 98           MakePl1String (v, Sp, Desc & Right)
 99      $)
100 and StNum (Space, Name, Value) be
101      $(   let v = vec 20
102           Concatenate (Space, 511, Space, "-", Name, "*s", ConvertNtoS (Value, v), "*s")
103      $)
104 and StSwitch (Space, Name, Value) be
105      $(   let b = Value -> "-", "-no_"
106           Concatenate (Space, 511, Space, b, Name, "*s")
107      $)
108 
109 and Save () be for i = 0 to SaveLen do SDB!(SdbSave + i) := (lv Global)!i
110 and Unsave (n) be
111      $(   let Sptr = Pl1ArgPtr (1)
112           let s = BCPLaddr (Sptr)
113           for i = 32 to SaveLen do (lv Global)!i := s!(SdbSave + i)
114           StatPtr := Pl1ArgPtr (n)
115           StatPtr!0, StatPtr!1 := 0, 0
116           SdbLV := Sptr
117      $)
118 
119 let DimAttach () be main      //  call attach (ioname1, dimname, ioname2, mode, status, sdbptr)
120      $(   Errcode, ProgramID := 0, "runoff_dim"
121           StatPtr := Pl1ArgPtr (5)
122           StatPtr!0, StatPtr!1 := 0, 0
123           SdbLV := Pl1ArgPtr (6)
124           unless BCPLaddr (SdbLV) = Null do
125                $(   StatPtr!0 := rv Ionmat
126                     return
127                $)
128 
129           SDB := FreeSDBlist
130           test SDB = 0
131           then SDB := Allocate (SdbLength + 10000)
132           or FreeSDBlist := SDB!0
133 
134           NewvecInit (SDB + SdbLength, 10000 - 2)
135 
136           let Arg = vec 200
137           MakePl1String (Pl1ArgString (2, Arg), SDB, 32)
138           ITS (ITS (Null, SDB + SdbIoname2), SDB + 8)
139           MakePl1String (Pl1ArgString (3, Arg), SDB + SdbIoname2 + 3, 32)
140           SDB!(SdbIoname2+2) := Length (Arg)
141 
142           MONITOR, OUTPUT := Open (StreamName + Write, "error_output"), Open (StreamName + Write, Arg, 1000, 0)
143           Output := OUTPUT
144           CONSOLE := 0
145           Errorstream, ChStream := MONITOR, 0
146           Waitsw, Stopsw, Filesw := false, false, false
147           FileName := "<stream>"
148           From, To, Start := 1, 999999, 1
149           Charsw, Selsw, Device := false, false, 37
150           NoPaging, Hyphenating := false, false
151           ExtraMargin, PrintLineNumbers := 0, false
152           NoControl, NoFill := false, false
153           Passes := 1
154           Parameter := ""
155           ErrorTempID, TimeNow := 0, 0
156 
157           InitializeSymbolTree ()
158           InputStack := Newvec (MaxDepth)
159           let w = vec 2
160           TimeNow := TimeToSeconds (RawClockTime (w))
161 
162           Char := Newvec (Maxline * 2)
163           Rawchar := Newvec (Maxline + 20)
164           Rawchar!0 := 0
165 
166           Eh, Oh, Ef, Of := Newvec (Maxheads), Newvec (Maxheads), Newvec (Maxheads), Newvec (Maxheads)
167           for i = 0 to Maxheads do Eh!i, Oh!i, Ef!i, Of!i := 0, 0, 0, 0
168 
169           Conv, TrTable, DeviceTable, CharsTable := Newvec (128), Newvec (128), Newvec (128), Newvec (128)
170           for i = 0 to 127 do CharsTable!i := '*s'
171           FillTrTable ()
172           SetDevice (Device)
173 
174           Footbuf := Newvec (Maxline + 20)
175           Temp := Newvec (Maxline * 2)
176 
177           SetSwitches ()
178           SetModes (4)
179 
180           Save ()
181           ITS (SDB, SdbLV)
182      $)
183 and DimDetach () be main                //  call detach (sdbptr, ioname2, disp, status)
184      $(   Unsave (4)
185           Break ()
186           Eject ()
187           unless OUTPUT = 0 do Close (OUTPUT)
188           unless ChStream = 0 do Close (ChStream)
189           Close (MONITOR)
190           SDB!0 := FreeSDBlist
191           FreeSDBlist := SDB
192           NewvecCleanup ()
193           ITS (Null, SdbLV)
194           StatPtr!0, StatPtr!1 := 0, $84000000
195      $)
196 let DimWrite () be main       //  call write (sdbptr, workspace, offset, nelem, nelemt, status)
197      $(   Unsave (6)
198           let Workspace, Offset, Nelem = BCPLaddr (Pl1ArgPtr (2)), rv Pl1ArgPtr (3), rv Pl1ArgPtr (4)
199           Workspace := Workspace + Offset / 4
200           Offset := Offset rem 4
201           INPUT := Open (Pointer + Read, Workspace, Nelem + Offset)
202           for i = 1 to Offset do Readch (INPUT, lv Ch)
203           RoffProcess (INPUT)
204           Writeout (Output)
205           Save ()
206           rv Pl1ArgPtr (5) := Nelem
207      $)
208 
209 let DimOrder () be main       //  call order (sdbptr, request, pointer, status)
210      $(   Unsave (4)
211           let Arg = vec 200
212           Pl1ArgString (2, Arg)
213           Unpackstring (Arg, Rawchar)
214           Nr := Rawchar!0
215           Rawchar!0 := 0
216           Rawchar!(Nr + 1) := '*s'
217           while Rawchar!Nr = '*s' do Nr := Nr - 1
218           test Rawchar!1 = '.'
219           then Control ()
220           or if Rawchar!1 = '%' do
221                $(   let Retptr = BCPLaddr (Pl1ArgPtr (3))
222                     Nrx, Nr := 1, Nr + 1
223                     Check_ref ()
224                     rv Retptr := ReadParam (0)
225                $)
226           Nr := 0
227           Save ()
228      $)
229 and DimChangemode () be main            //  call changemode (sdbptr, newmode, oldmode, status)
230      $(   Unsave (4)
231           OldModes (3)
232           SetModes (2)
233           Save ()
234      $)