runoff_.alm 11/04/82 1921.3rew 11/04/82 1632.2 21231 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " Outer module transfer vector for the runoff_ dim. " Last modified on 05/31/74 at 10:38:58 by R F Mabee. " Converted for 6180 Multics in May 1973 by R F Mabee. " First written for 645 Multics and installed in November 1971 by R F Mabee. " Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc. " General permission is granted to copy and use this program, but not to sell it, provided that the above " copyright statement is given. Contact Information Processing Services, MIT, for further information. " Please contact R F Mabee at MIT for information on this program and versions for other machines. entry runoff_module runoff_module: cmpx6 entries,du " Check range. tnc table,6 " Dispatch through table. missent: ldq ap|0 " Arg count and flags. lda |[missent] eppbp ap|0,qu* sta bp|0 stz bp|1 short_return table: tra |[runoff_attach] tra |[runoff_detach] tra missent " tra |[runoff_read] tra |[runoff_write] tra missent " tra |[runoff_abort] tra |[runoff_order] tra missent " tra |[runoff_resetread] tra missent " tra |[runoff_resetwrite] tra missent " tra |[runoff_setsize] tra missent " tra |[runoff_getsize] tra missent " tra |[runoff_setdelim] tra missent " tra |[runoff_getdelim] tra missent " tra |[runoff_seek] tra missent " tra |[runoff_tell] tra |[runoff_changemode] tra missent " rem this slot currentry unused tra missent " rem this slot currently unused tra missent " rem this slot currently unused tra missent " rem this slot currently unused tra missent " tra |[runoff_readsync] tra missent " tra |[runoff_writesync] equ entries,*-table end  runoff_dim.bcpl 11/04/82 1921.3rew 11/04/82 1605.3 65115 // This module implements the defined I/O system calls for the runoff_ dim. // Last modified on 05/30/74 at 18:42:47 by R F Mabee. // // Routines defined in this module: // SetModes Fetch mode string and set modes. // GetModeArg Scan mode string for next field. // OldModes Store settable modes in PL/I arg string. // StNum Store numeric mode. // StSwitch Store on/off mode. // Save Stuff globals into SDB. // Unsave Retrieve globals from SDB. // DimAttach Set up runoff_ attachment. // DimDetach Remove runoff_ attachment. // DimWrite Process some text through runoff_. // DimOrder Execute control line from outside. // DimChangemode Alter internal modes and get old modes. // Only the last five routines are external. // Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc. // General permission is granted to copy and use this program, but not to sell it, provided that the above // copyright statement is given. Contact Information Processing Services, MIT, for further information. // Please contact R F Mabee at MIT for information on this program and versions for other machines. get "head" get "runoff_head" external $( DimAttach = "runoff_dim$runoff_attach" DimDetach = "runoff_dim$runoff_detach" DimWrite = "runoff_dim$runoff_write" DimOrder = "runoff_dim$runoff_order" DimChangemode = "runoff_dim$runoff_changemode" Ionmat = "error_table_$ionmat" BadMode = "error_table_$undefined_order_request" $) static $( FreeSDBlist = 0 $) global $( SDB : 70 StatPtr : 71 SdbLV : 72 ModeArg : 73 Global : 0 $) manifest $( SdbIoname2 = 10 SdbSave = 20 SaveLen = 250 SdbLength = 250 + 20 $) let SetModes (n) be $( let OldChars, OldDevice, OldPaging, OldControl, OldFill = Charsw, Device, NoPaging, NoControl, NoFill ModeArg := vec 128 Pl1ArgString (n, ModeArg) ArgIndex := 1 let Names = list "device", "margin", "chars", "pagination", "control", "fill", "hyphenate", "number" and Pointers = list lv Device, lv ExtraMargin, lv Charsw, lv NoPaging, lv NoControl, lv NoFill, lv Hyphenating, lv PrintLineNumbers and Flags = table OptConvert, OptConvert, OptNegatable, OptNegatable | OptNegate, OptNegatable | OptNegate, OptNegatable | OptNegate, OptNegatable, OptNegatable OptionParse (GetModeArg, 8, Names, Pointers, Flags, 0) if OldChars neqv Charsw do SetCharsw (Charsw) if OldDevice ne Device do SetDevice (Device) if OldPaging neqv NoPaging do SetPaging (NoPaging) if OldControl neqv NoControl do LIno := NoControl -> 1000000, 0 if OldFill neqv NoFill do Fi := not NoFill $) and GetModeArg (v) = valof $( let Len = Length (ModeArg) while ArgIndex le Len & Subch (ModeArg, ArgIndex) = '*s' do ArgIndex := ArgIndex + 1 if ArgIndex > Len resultis false let First = ArgIndex while ArgIndex le Len & Subch (ModeArg, ArgIndex) ne '*s' do ArgIndex := ArgIndex + 1 Substr (v, ModeArg, First, ArgIndex - First) resultis true $) and OldModes (n) be $( let v = vec 128 SetLength (v, 0) StNum (v, "device", Device) StNum (v, "margin", ExtraMargin) StSwitch (v, "chars", Charsw) StSwitch (v, "pagination", not NoPaging) StSwitch (v, "control", not NoControl) StSwitch (v, "fill", not NoFill) StSwitch (v, "hyphenate", Hyphenating) StSwitch (v, "number", PrintLineNumbers) let Sp, Desc = Pl1ArgPtr (n), Pl1Descriptor (n) MakePl1String (v, Sp, Desc & Right) $) and StNum (Space, Name, Value) be $( let v = vec 20 Concatenate (Space, 511, Space, "-", Name, "*s", ConvertNtoS (Value, v), "*s") $) and StSwitch (Space, Name, Value) be $( let b = Value -> "-", "-no_" Concatenate (Space, 511, Space, b, Name, "*s") $) and Save () be for i = 0 to SaveLen do SDB!(SdbSave + i) := (lv Global)!i and Unsave (n) be $( let Sptr = Pl1ArgPtr (1) let s = BCPLaddr (Sptr) for i = 32 to SaveLen do (lv Global)!i := s!(SdbSave + i) StatPtr := Pl1ArgPtr (n) StatPtr!0, StatPtr!1 := 0, 0 SdbLV := Sptr $) let DimAttach () be main // call attach (ioname1, dimname, ioname2, mode, status, sdbptr) $( Errcode, ProgramID := 0, "runoff_dim" StatPtr := Pl1ArgPtr (5) StatPtr!0, StatPtr!1 := 0, 0 SdbLV := Pl1ArgPtr (6) unless BCPLaddr (SdbLV) = Null do $( StatPtr!0 := rv Ionmat return $) SDB := FreeSDBlist test SDB = 0 then SDB := Allocate (SdbLength + 10000) or FreeSDBlist := SDB!0 NewvecInit (SDB + SdbLength, 10000 - 2) let Arg = vec 200 MakePl1String (Pl1ArgString (2, Arg), SDB, 32) ITS (ITS (Null, SDB + SdbIoname2), SDB + 8) MakePl1String (Pl1ArgString (3, Arg), SDB + SdbIoname2 + 3, 32) SDB!(SdbIoname2+2) := Length (Arg) MONITOR, OUTPUT := Open (StreamName + Write, "error_output"), Open (StreamName + Write, Arg, 1000, 0) Output := OUTPUT CONSOLE := 0 Errorstream, ChStream := MONITOR, 0 Waitsw, Stopsw, Filesw := false, false, false FileName := "" From, To, Start := 1, 999999, 1 Charsw, Selsw, Device := false, false, 37 NoPaging, Hyphenating := false, false ExtraMargin, PrintLineNumbers := 0, false NoControl, NoFill := false, false Passes := 1 Parameter := "" ErrorTempID, TimeNow := 0, 0 InitializeSymbolTree () InputStack := Newvec (MaxDepth) let w = vec 2 TimeNow := TimeToSeconds (RawClockTime (w)) Char := Newvec (Maxline * 2) Rawchar := Newvec (Maxline + 20) Rawchar!0 := 0 Eh, Oh, Ef, Of := Newvec (Maxheads), Newvec (Maxheads), Newvec (Maxheads), Newvec (Maxheads) for i = 0 to Maxheads do Eh!i, Oh!i, Ef!i, Of!i := 0, 0, 0, 0 Conv, TrTable, DeviceTable, CharsTable := Newvec (128), Newvec (128), Newvec (128), Newvec (128) for i = 0 to 127 do CharsTable!i := '*s' FillTrTable () SetDevice (Device) Footbuf := Newvec (Maxline + 20) Temp := Newvec (Maxline * 2) SetSwitches () SetModes (4) Save () ITS (SDB, SdbLV) $) and DimDetach () be main // call detach (sdbptr, ioname2, disp, status) $( Unsave (4) Break () Eject () unless OUTPUT = 0 do Close (OUTPUT) unless ChStream = 0 do Close (ChStream) Close (MONITOR) SDB!0 := FreeSDBlist FreeSDBlist := SDB NewvecCleanup () ITS (Null, SdbLV) StatPtr!0, StatPtr!1 := 0, $84000000 $) let DimWrite () be main // call write (sdbptr, workspace, offset, nelem, nelemt, status) $( Unsave (6) let Workspace, Offset, Nelem = BCPLaddr (Pl1ArgPtr (2)), rv Pl1ArgPtr (3), rv Pl1ArgPtr (4) Workspace := Workspace + Offset / 4 Offset := Offset rem 4 INPUT := Open (Pointer + Read, Workspace, Nelem + Offset) for i = 1 to Offset do Readch (INPUT, lv Ch) RoffProcess (INPUT) Writeout (Output) Save () rv Pl1ArgPtr (5) := Nelem $) let DimOrder () be main // call order (sdbptr, request, pointer, status) $( Unsave (4) let Arg = vec 200 Pl1ArgString (2, Arg) Unpackstring (Arg, Rawchar) Nr := Rawchar!0 Rawchar!0 := 0 Rawchar!(Nr + 1) := '*s' while Rawchar!Nr = '*s' do Nr := Nr - 1 test Rawchar!1 = '.' then Control () or if Rawchar!1 = '%' do $( let Retptr = BCPLaddr (Pl1ArgPtr (3)) Nrx, Nr := 1, Nr + 1 Check_ref () rv Retptr := ReadParam (0) $) Nr := 0 Save () $) and DimChangemode () be main // call changemode (sdbptr, newmode, oldmode, status) $( Unsave (4) OldModes (3) SetModes (2) Save () $)  runoff_driver.bcpl 11/04/82 1921.3rew 11/04/82 1605.4 72072 // This is the command interface for runoff. // Last modified on 06/23/74 at 19:16:49 by R F Mabee. // // Routines defined herein are: // RunoffCommand This implements the runoff command described in the MPM. // RfEntry For the command abbreviation "rf". Ugh. // FindInput To open an input stream. Removes .runoff suffix. // PrintErrorFile Dump out error messages saved during console output. // Cleanup Close streams, delete temporaries, etc. // The last two mentioned are not external to this part of the program. // Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc. // General permission is granted to copy and use this program, but not to sell it, provided that the above // copyright statement is given. Contact Information Processing Services, MIT, for further information. // Please contact R F Mabee at MIT for information on this program and versions for other machines. get "runoff_head" get "head" external $( RunoffCommand = "runoff" RfEntry = "rf" TtyInfo = "user_info_$tty_data" IosWritePtr = "ios_$write_ptr" $) global $( Streams : 300 EntryNames : 301 Sn : 302 ArgITS : 26 // Multics save sequence leaves argument list pointer here (two words). $) // This routine is called directly from command level to execute the runoff command. // Its parameters (all character strings) are intermingled options and pathnames of // source files. Its usage is described in the MPM runoff command writeup. let RunoffCommand () be main $( MONITOR := Open (StreamName + Write, "error_output") // Errors, etc. written here. OUTPUT, CONSOLE, ChStream, Errorstream := 0, 0, 0, 0 Errcode, ProgramID := 0, "runoff" From, To, Start, Stopsw, Charsw, Device := 1, 999999, 1, false, false, 0 NoPaging, Hyphenating, Passes, Waitsw := false, false, 1, false PrintLineNumbers, ExtraMargin, Parameter := false, -1, "" NoControl, NoFill := false, false Filesw := false Streams, EntryNames, Sn := vec 100, vec 100, 0 ErrorTempID := 0 let Xvec = vec 10000 NewvecInit (Xvec, 10000) let w = vec 2 TimeNow := TimeToSeconds (RawClockTime (w)) let Cvec = vec 20 SetHandler ("cleanup", Cleanup, Cvec) // Set up for release of streams. // Scan command arguments. ArgIndex := 1 let Names = list "file", "segment", "sm", "chars", "character", "ch", "stop", "sp", "wait", "wt", "pagination", "pgnt", "npgn", "hyphenate", "hph", "number", "nb", "control", "fill", "parameter", "pm", "pass", "margin", "indent", "in", "from", "fm", "to", "start", "page", "pg", "ball", "bl", "device", "dv" and Pointers = list lv Filesw, lv Filesw, lv Filesw, lv Charsw, lv Charsw, lv Charsw, lv Stopsw, lv Stopsw, lv Waitsw, lv Waitsw, lv NoPaging, lv NoPaging, lv NoPaging, lv Hyphenating, lv Hyphenating, lv PrintLineNumbers, lv PrintLineNumbers, lv NoControl, lv NoFill, DoParam, DoParam, lv Passes, lv ExtraMargin, lv ExtraMargin, lv ExtraMargin, lv From, lv From, lv To, lv Start, lv Start, lv Start, lv Device, lv Device, lv Device, lv Device and Flags = table OptNegatable, OptNegatable, OptNegatable, OptNegatable, OptNegatable, OptNegatable, OptNegatable, OptNegatable, OptNegatable, OptNegatable, OptNegatable | OptNegate, OptNegatable | OptNegate, 0, OptNegatable, OptNegatable, OptNegatable, OptNegatable, OptNegatable | OptNegate, OptNegatable | OptNegate, OptCallOut | OptGetNext, OptCallOut | OptGetNext, OptConvert, OptConvert, OptConvert, OptConvert, OptConvert, OptConvert, OptConvert, OptConvert, OptConvert, OptConvert, OptConvert, OptConvert, OptConvert, OptConvert OptionParse (GetNextCommandArg, 35, Names, Pointers, Flags, DoName) if Sn = 0 do Complain ("Pathnames of input segments expected. Options:*n^a*n^a", "-file -stop -wait -chars -no_pagination -hyphenate -number -no_control -no_fill", "-from -to -start -device -pass -margin ") // Determine default device type. test Filesw then $( if Device = 0 do Device := 202 Errorstream := MONITOR $) or $( OUTPUT := Open (StreamName + Write, "user_output", 1000, 0) // Big buffer, no delimiter. unless Errcode = 0 do Complain ("user_output") if Device = 0 do $( let x, y = 0, 0 call TtyInfo (lv x char 0, lv y) Device := y le 2 | y = 6 -* 963, 37 $) $) if ExtraMargin < 0 do ExtraMargin := (Device = 202 | Device = 300) & Filesw -> 20, 0 unless Device = 1050 | Device = 2741 | Device = 963 // "Normal" IBM type codes. | Device = 012 | Device = 015 | Device = 041 // IBM terminal with office typewriter element. | Device = 088 | Device = 37 | Device = 202 | Device = 300 do // Full ASCII device. Complain ("Illegal device type specified. Legal devices:*n1050 2741 37 202 300 963 012 015 041 088") let FromX, ToX, StartX, StopswX, CharswX, DeviceX = From, To, Start, Stopsw, Charsw, Device and NoPagingX, HyphenatingX, PassesX, WaitswX = NoPaging, Hyphenating, Passes, Waitsw and PrintLineNumbersX, ExtraMarginX, ParameterX = PrintLineNumbers, ExtraMargin, Parameter and NoControlX, NoFillX = NoControl, NoFill // Process input files, one at a time. for i = 1 to Sn do $( FileName := EntryNames!i if Filesw do $( let w = vec 20 OUTPUT := Open (EntryName + Write + MultiSegmentFile, Concatenate (w, 32, FileName, ".runout")) unless Errcode = 0 do Complain (w) $) From, To, Start, Stopsw, Charsw, Device := FromX, ToX, StartX, StopswX, CharswX, DeviceX NoPaging, Hyphenating, Passes := NoPagingX, HyphenatingX, PassesX PrintLineNumbers, ExtraMargin := PrintLineNumbersX, ExtraMarginX Parameter := StoreString (ParameterX) NoControl, NoFill := NoControlX, NoFillX Waitsw := WaitswX | StopswX // Invoke runoff main program for each source segment. Roff (lv Streams!(i - 1), 1, OUTPUT) if Filesw do $( Close (OUTPUT) OUTPUT := 0 $) unless ChStream = 0 do $( Close (ChStream) ChStream := 0 $) $) // Finished with all source files, clean up and return to command level. if Stopsw do Wait () unless Filesw do $( Close (OUTPUT) OUTPUT := 0 $) PrintErrorFile () Cleanup () $) and RfEntry () be main Pl1Call (RunoffCommand, BCPLaddr (lv ArgITS)) and DoName (Arg) be // Called by OptionParse to process file-name argument. $( Streams!(Sn + 1) := FindInput (Arg, 0) Sn := Sn + 1 unless Errcode = 0 do Complain ("^a.runoff", Arg) let w, D, E = vec 50, vec 50, vec 10 SplitPathname (ExpandPathname (Arg, w), D, E) EntryNames!Sn := StoreString (MakeBcplString (E, 32, w)) $) and DoParam (Arg) be // Called by OptionParse to process "-parameter" option. Parameter := StoreString (Arg) and FindInput (Name, ParentStream) = valof // BEWARE! This routine is defined to update its argument. $( let v = vec 50 let l = Length (Name) if l ge 8 do $( Substr (v, Name, l - 6) if EqualString (v, ".runoff") do $( Substr (v, Name, 1, l - 7) CopyString (v, Name) $) $) Concatenate (v, 168, Name, ".runoff") resultis ParentStream = 0 -> Open (PathName + Read + MultiSegmentFile, v), Open (SearchName + Read + MultiSegmentFile, v, ParentStream) $) and PrintErrorFile () be $( if Errorstream = 0 | Filesw return unless OUTPUT = 0 do Writeout (OUTPUT) let l = StreamOffset (Errorstream) Close (Errorstream) Errorstream := 0 let v, Zero = vec 2, 0 call IosWritePtr (ITS (ErrorfilePointer, v), lv Zero, lv l) $) and Cleanup () be $( while Sn > 0 do $( Sn := Sn - 1 Close (Streams!(Sn + 1)) $) unless OUTPUT = 0 | Filesw do $( ResetStream (OUTPUT, 0) Close (OUTPUT) OUTPUT := 0 $) unless CONSOLE = 0 do Close (CONSOLE) CONSOLE := 0 ChStream := 0 unless Errorstream = 0 | Filesw do Close (Errorstream) Errorstream := 0 Close (MONITOR) NewvecCleanup () unless ErrorTempID = 0 do DeleteTempSeg (ErrorTempID, "error_messages") $)  runoff_mr0.bcpl 11/04/82 1921.3rew 11/04/82 1605.4 54567 // This file contains miscellaneous utility programs for runoff. // Many of them are system-dependent by nature. // Last modified on 05/30/74 at 18:42:57 by R F Mabee. // // Routines defined in this module: // Wait Wait until line is typed in on console. // ConsoleReadLine Get line from console input. // FixTab Insert blanks into buffer to properly convert tab. // Typeout Print body of control line on console. // ExecuteCommand Pass body of control line to command processor. // NewOutputStream Make new output file when current one is full. // SetCharsw Turn "chars" option on or off. // Report Generate error message. Save if main output is to console. // StoreString Make unshared copy of string in free storage. // Nx_open Stack new input stream. // Nx_close Revert to previous input stream. // Nx_reset Reprocess input text (file). // ReadLine Get next input line from nested input streams. // RoffProcess Do all the text from a given input stream. // Only FixTab is not external. // Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc. // General permission is granted to copy and use this program, but not to sell it, provided that the above // copyright statement is given. Contact Information Processing Services, MIT, for further information. // Please contact R F Mabee at MIT for information on this program and versions for other machines. get "runoff_head" get "head" external $( CuCp = "cu_$cp" $) global $( EndL : 320 // Return point on end of all data. EndP : 321 // Stack frame to go with EndL. $) static $( ErrorfileCounter = 0 // Unique id for error message segments. $) let Wait () be $( let v = vec Maxline unless Filesw do ConsoleReadline (v) $) and ConsoleReadline (v) = valof $( unless Filesw do Writeout (OUTPUT) if CONSOLE = 0 do CONSOLE := Open (Console + Read) let i = 0 $( if i < Maxline do i := i + 1 Readch (CONSOLE, lv Ch) v!i := Ch & $8177 if Ch = '*t' do i := FixTab (v, i) $) repeatuntil Ch = '*n' v!i := '*s' v!0 := i - 1 resultis i - 1 $) and FixTab (v, i) = valof $( let p = 0 for j = 1 to i - 1 do p := p + Width (v!j) for j = p rem 10 to 9 do $( v!i := '*s' i := i + 1 $) resultis i - 1 $) and Typeout () be $( Check_ref () unless Filesw do Writeout (OUTPUT) for i = Nrx to Nr - 1 do Writech (MONITOR, Rawchar!i) Writech (MONITOR, '*n') $) and ExecuteCommand () be $( Check_ref () unless Filesw do Writeout (OUTPUT) let v, w = vec Maxline, vec Maxline let l = Nr - Nrx if l le 0 return Rawchar!(Nrx - 1) := l Packstring (Rawchar + Nrx - 1, v) MakePl1String (v, w, l) call CuCp (ITS (w, v), lv l, lv Errcode) $) let SetCharsw (New) be $( if New & ChStream = 0 do $( let v = vec 20 ChStream := Open (EntryName + Write, Concatenate (v, 32, FileName, ".chars")) unless Errcode = 0 do Complain (v) WrChInit () $) Charsw := New $) and Report (s) be $( if Errorstream = 0 do $( test Filesw then Errorstream := MONITOR or $( ErrorfileCounter := ErrorfileCounter + 1 ErrorTempID := ErrorfileCounter ErrorfilePointer := MakeTempSeg (ErrorTempID, "error_messages") Errorstream := Open (Pointer + Write, ErrorfilePointer) $) $) Format (Errorstream, "^a in line ^d of file ^a. ", s, InputLines, InputFileName) for i = 1 to Nr - 1 do Writech (Errorstream, Rawchar!i) Writech (Errorstream, '*n') $) and StoreString (S) = valof $( let P = Newvec (LengthInWords (S) - 1) CopyString (S, P) resultis P $) // The following function is used to open a stream. Its // argument is the name of the file to open. let Nx_open (Name) be { test NestingDepth ge MaxDepth then Report ("Input files nested too deeply") or { InputStack[NestingDepth] := INPUT // Remember current stream. InputStack[NestingDepth + 1] := InputLines // And line number. InputStack[NestingDepth + 2] := InputFileName // And file name. NestingDepth := NestingDepth + 3 INPUT := FindInput (Name, INPUT) unless Errcode = 0 do Report ("Unable to open input file") InputLines := 0 InputFileName := StoreString (Name) } } // This parameter-less routine may be called to close off the // current stream. and Nx_close () be { unless JumpLine = -1 do $( Nx_reset () let J = JumpLine - 1 JumpLine := -1 while InputLines < J do $( Nr := 0 Readline () $) Nr, Ch := 0, 0 return $) if NestingDepth le 0 do Longjump (EndL, EndP) Close (INPUT) Freevec (InputFileName) NestingDepth := NestingDepth - 3 INPUT := InputStack[NestingDepth] InputLines := InputStack[NestingDepth + 1] InputFileName := InputStack[NestingDepth + 2] } // This routine resets the current position in the current // input file back to the beginning so that the input will be read again. and Nx_reset () be $( ResetStream (INPUT, 0) InputLines := 0 $) and Readline () be // Read next line into Rawchar[1]...Rawchar[Nr]. $( $( Readch (INPUT, lv Ch) if Ch = Endofstreamch do $( Nx_close () loop $) if Nr < Maxline do Nr := Nr + 1 Rawchar!Nr := Ch & $8177 if Ch = '*t' do Nr := FixTab (Rawchar, Nr) $) repeatuntil Ch = '*n' InputLines := InputLines + 1 Rawchar!Nr := '*s' while Rawchar!Nr = '*s' do Nr := Nr - 1 // Delete blanks. $) let RoffProcess (Stream) be $( INPUT := Stream InputLines := 0 InputFileName := FileName // Not always right, but close enough for now... NestingDepth := 0 EndL, EndP := End, Level () $( Readline () Process: test LIno = 0 then test Rawchar!1 = '.' then $( Control () if Again do $( Again := false goto Process $) $) or Text () or $( Text () unless NoControl do LIno := LIno - 1 $) Nr := 0 $) repeat // Eventually we run out of input and jump to End. End: Nx_reset () // So it can be read again if necessary. $)  runoff_mr1.bcpl 11/04/82 1921.3rew 11/04/82 1605.4 67599 // Roff for MULTICS // // The first ROFF for Multics was written in March, 1969, by // Doug McIlroy of Bell Labs. Art Evans made extensive // modifications to it in May and June, 1969, adding many // comments and making various changes. // Footnoting added by Dennis Capps in 1970. // Maintained by Harwell Thrasher in 1971. // Many new features added and bugs fixed by R Mabee in 1971-1972. // RUNOFF and BCPL were brought over to the 6180 Multics (from 645) in May of 1973 by R F Mabee. // Last modified on 05/30/74 at 18:43:28 by R F Mabee. // The following files compose the RUNOFF command: // runoff_driver the command and driver. // runoff_mr0 Miscellaneous utility subroutines. // runoff_mr1 Roff - the main routine. // runoff_mr2 Control line processors. // runoff_mr3 Routines for text printing. // runoff_mr4 Miscellaneous output subroutines. // runoff_mr5 Routines for header and footer printing. // runoff_mr6 Routines for footnote processing // runoff_mr7 Routines for the "chars" option // runoff_mr8 ReadExp - expression reading and evaluating subroutines. // runoff_mr9 Reference symbol subroutines. // runoff_dim Routines for optional use of runoff as IOSIM. // runoff_ Outer module transfer vector for ios_ to use above. // runoff_head Global and other declarations for RUNOFF. // This last file includes a table-of-contents, listing for each // routine which file it is declared in. // In addition, of course, the usual BCPL library is used. // This file contains the main program for RUNOFF on Multics. // Roff is called by the driver, and sets things up before calling // RoffProcess to do the work. Its parameters are as follows: // Streams a vector of input streams to be processed. // Sn the number of streams in the vector Streams (1 to Sn). // OutStream the main output stream. // In addition, many global variables must be set (encoding options) before Roff is entered. // Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc. // General permission is granted to copy and use this program, but not to sell it, provided that the above // copyright statement is given. Contact Information Processing Services, MIT, for further information. // Please contact R F Mabee at MIT for information on this program and versions for other machines. get "runoff_head" // Include declarations for ROFF. let Roff (Streams, Sn, OutStream) be $( Output := OutStream // Set up buffers for input and output lines. Char := vec Maxline * 2 // Text buffer for output lines. Rawchar := vec Maxline + 20 // Buffer for input lines. Rawchar[0] := 0 // Establish buffer to hold one footnote line. Footbuf := vec Maxline + 20 // Establish a temporary storeroom for the unprocessed stuff in // Char while a footnote is being processed. Temp := vec Maxline * 2 // Set up translation tables. TrTable, DeviceTable, Conv, CharsTable := vec 128, vec 128, vec 128, vec 128 for i = 0 to 127 do CharsTable!i := '*s' // Establish buffers for headers' addresses. Eh, Oh := vec Maxheads, vec Maxheads // Headers. for i = 0 to Maxheads do Eh!i, Oh!i := 0, 0 Ef, Of := vec Maxheads, vec Maxheads // Footers. for i = 0 to Maxheads do Ef!i, Of!i := 0, 0 // Other initialization. InitializeSymbolTree () InputStack := vec MaxDepth $(Pass // Make requested number of passes. Output is produced only on last pass. // This is a repeatwhile Passes > 0 loop. // Initialize various switches and things in global: SetSwitches () if Passes > 1 do Fp, Lp, Print := 999999, 999999, false // Not final pass, suppress output. // Set up conversion table for output. FillTrTable () SetDevice (Device) SetCharsw (Charsw) SetPaging (NoPaging) // Do all the work. for i = 1 to Sn do RoffProcess (Streams!i) if Ft do Foot_end () // Otherwise we die. Break () Eject () repeatuntil Fl = 0 Freeheads (Oh) Freeheads (Eh) Freeheads (Of) Freeheads (Ef) unless Fth = 0 do Freevec (Fth) Freevec (FootRef) Freevec (TextRef) Passes := Passes - 1 $)Pass repeatwhile Passes > 0 $) and SetDevice (New) be $( Printersw, Selsw := false, false Device := New for i = 0 to 127 do DeviceTable!i := i let T = valof switchon Device into $( case 1050: case 2741: case 963: resultis table 6, '{', '}', '[', ']', '`', '~' case 041: Selsw := true resultis table 2, '[', ']' case 015: case 012: case 088: Selsw := true resultis table 0 case 202: case 300: Printersw := true default: resultis table 0 $) if Selsw do $( let St = "-M;**:%m*"(>Bg.kh9y2384657#Ee b H*c *Bg.kh912384657#**;<=%H*c *-P|XVUCAZO+WYJSQDFNR\TL!?I) _ K^*c * p,xvucazo&wyjsqdfnr@tl$/i0 G " Unpackstring (St, DeviceTable + '*s') DeviceTable!'*s', DeviceTable!Skip := '*s', Skip // Limits of above string. $) for i = 1 to T!0 do DeviceTable!(T!i) := '*s' for i = 0 to 127 do Conv!i := DeviceTable!(TrTable!i) $) and FillTrTable() be $( for i = 0 to $8037 do TrTable!i := Skip for i = $8040 to $8176 do TrTable!i := i TrTable!Skip := Skip TrTable!'*t', TrTable!'*b', TrTable!'*n' := '*t', '*b', '*n' TrTable!'*f', TrTable!'*d', TrTable!'*k' := '*f', '*d', '*k' $) and SetPaging (New) be $( NoPaging := New test NoPaging then Pl, Ma1, Ma2, Ma3, Ma4 := 1000000000, 0, 0, 0, 0 or Pl, Ma1, Ma2, Ma3, Ma4 := PL_, MA1_, MA2_, MA3_, MA4_ SetLinesLeft () $) and SetSwitches () be $( Fp := From // First page to print. Lp := To // Last page to print. Np := Start // Number to be on first page. NNp := Np + 1 // Next page number. Print := Fp le Np le Lp & Passes le 1 // Are we now printing? OddPage := Np rem 2 ne 0 Ad := true // Adjust Again := false // Control line to be reprocessed Ce := 0 // Do not center. Eq := 0 // Do not print line as equation. Eqcnt := 1 // Start equation counter at 1 Fc := 0 // Number of characters in Footbuf Fl := 0 // Number of lines in FootList Flp := false // Pagefull override off Fi := not NoFill // Fill lines unless global override option. Foot := 1 // Start footnote counter at 1 FootList := 0 // Top of list (growing end). FootListBase := 0 // Base of list. Fr := true // Reset footnote counter at each page Ft := false // Not processing a footnote Fth := 0 // Footnote demarcation. In := 0 // No indenting. JumpLine := -1 // Not performing goto. LIno := NoControl -> 1000000000, 0 // Process control lines normally. Ll := LL_ // Default line length. Ma1 := MA1_ // Space above header Ma2 := MA2_ // Space below header Ma3 := MA3_ // Space above footer Ma4 := MA4_ // Space below footer MultiplePagecount := 1 // Print every page. Ms := 1 // Multiple spacing Nc := 0 // No characters stored yet. Nl := 0 // Last used line number on page. NoFtNo := false // Number footnotes normally. Nr := 0 // Count of characters in Rawchar. PadLeft := false // Start adjusting with right end. Pi := 0 // Space needed for a picture. Pl := PL_ // Page length, in lines. Roman := false // Print page numbers in Arabic. SavedCc := 0 // Initially no character in buffer cell. Spec_char := '%' // Special character for symbol references. Un := 0 // No undenting. FootRef := StoreString ("(%Foot%) ") TextRef := StoreString (" (%Foot%) ") $)  runoff_mr2.bcpl 11/04/82 1921.3rew 11/04/82 1605.4 65043 // ROFF for Multics // // Last modified on 05/30/74 at 18:43:45 by R F Mabee. // // This file contains the main routine for processing control // lines for ROFF for Multics, and some short routines used by it. // Routines are: // Control Routine to process control line. // Set_param Update parameter with possibly signed value. // Number Read numeric expression from line. // Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc. // General permission is granted to copy and use this program, but not to sell it, provided that the above // copyright statement is given. Contact Information Processing Services, MIT, for further information. // Please contact R F Mabee at MIT for information on this program and versions for other machines. get "runoff_head" // Declarations for ROFF. // Control is called with a control line in // Rawchar[1] ... Rawchar[Nr] // when Rawchar[1] is '.' . It processes // the control word in columns 2 and 3. let Control () be { // Control // Set Nrx to point to first non-blank // after column 3. (We know column 3 is non-blank.) Nrx := 4 // Start scan here. Nr := Nr + 1 // So characters in the last column of input can be read (kludge) while Rawchar[Nrx] ne '*s' & Nrx < Nr do Nrx := Nrx + 1 while Rawchar[Nrx] = '*s' & Nrx < Nr do Nrx := Nrx + 1 // Branch, depending on the control word in columns 2 and 3. switchon (Rawchar[2]lshift ByteBits logor Rawchar[3]) into { default: if Rawchar[2] = '**' return // Valid comment. Report ("Unknown control request") return case '** ': return // Most comments. case '~ ': if Charsw do // .~ means copy line into chars file. $( for i = 1 to Nr - 1 do WrCh (Rawchar!i) WrCh ('*n') $) return case 'ad': Break (); Ad := true; return case 'ar': Roman := false; return case 'bp': Break (); Eject (); return case 'br': Break (); return case 'cc': test Nrx = Nr then Spec_char := '%' else Spec_char := Rawchar[Nrx] return case 'ce': Break (); Ce := Number (); Need (Ce); return case 'ch': while Nrx < Nr do $( CharsTable!(Rawchar!Nrx) := Rawchar!(Nrx + 1) Nrx := Nrx + 2 $) return case 'ds': Break (); Ms := 2; Need (2); return case 'ef': Sethead (Ef); SetLinesLeft (); return case 'eh': Sethead (Eh); return case 'eq': // Next n lines are equations. Break (); Eq := Number (); Need (Eq); return case 'ex': if Nrx < Nr do ExecuteCommand () return case 'fh': unless Fth = 0 do Freevec (Fth) Fth := Gethead () return case 'fi': Break (); unless NoFill do Fi := true; return case 'fo': Sethead (Ef); Sethead (Of); SetLinesLeft (); return case 'fr': if Rawchar[Nrx] = 'f' do { Fr := false; return } // Renumber on each page - _false. if Rawchar[Nrx] = 't' do { Fr := true; return } // '' - _true. if Rawchar[Nrx] = 'u' do { NoFtNo := true; return } // Next footnote _unnumbered. Fr := false return case 'ft': test Ft then Foot_end () or Foot_begin () return case 'gb': Skiptolabel (false) // Jump backwards. return case 'gf': Skiptolabel (true) // Jump forward. return case 'he': Sethead (Eh); Sethead (Oh); return case 'if': InsertFile (); return case 'in': // Establish indenting. Break () Set_param (lv In, 0) Un := In return case 'la': return // Label for jumps, ignore. case 'li': // Treat next n lines as text. LIno := Number (); return case 'll': // Set line length. Set_param (lv Ll, LL_); return case 'ma': // Establish top and bottom margins. Set_param (lv Ma1, MA1_); Set_param (lv Ma4, MA4_) SetLinesLeft () return case 'm1': // Set space above header Set_param (lv Ma1, MA1_) return case 'm2': // Set space below header and above text Set_param (lv Ma2,MA2_) return case 'm3': // Set space above footer and below text Set_param (lv Ma3,MA3_) SetLinesLeft () return case 'm4': // Set space below footer Set_param (lv Ma4,MA4_) SetLinesLeft () return case 'mp': // Set multiple paging. Set_param (lv MultiplePagecount, 1) return case 'ms': // Set multiple spacing Break () Set_param (lv Ms, 1) Need (2) return case 'na': Break (); Ad := false; return case 'ne': NeedSS (Number ()); return case 'nf': Break (); Fi := false; return case 'of': Sethead (Of); SetLinesLeft (); return case 'oh': Sethead (Oh); return case 'op': Break (); Eject (); Np := Np + 1 - Np rem 2; goto SetPrint case 'pa': // Start a new page, with designated page number. Break (); Eject () // Finish this page. Set_param (lv Np, Np) // Set next page number. SetPrint: NNp := Np + 1 Print := Fp le Np le Lp & Passes le 1 return case 'pi': // Leave space for a picture to be drawn. Pi := Pi + Number () if Pi le LinesLeft do $( Newline (Pi) Pi := 0 $) return case 'pl': // Set up paper length. unless NoPaging do Set_param (lv Pl, PL_) SetLinesLeft () return case 'rd': Nr := ConsoleReadline (Rawchar) Again := true return case 'ro': Roman := true; return case 'rt': Nr := 0; Nx_close (); return case 'sk': NNp := NNp + Number (); return case 'sp': // Leave n lines blank. Break () // Finish current line. if Nl = 0 do Spacing () // If new page, print header. Newline (MinI (Number (), LinesLeft)) Need (2) return case 'sr': Set_ref () return case 'ss': Break (); Ms := 1; Need (2); return case 'tr': // Modify character conversion table. while Nrx < Nr do $( TrTable!(Rawchar!Nrx) := Rawchar!(Nrx + 1) Conv!(Rawchar!Nrx) := DeviceTable!(Rawchar!(Nrx + 1)) Nrx := Nrx + 2 $) return case 'ts': if Number () = 0 do Readline (); return // Conditional skip. case 'ty': Typeout (); return case 'un': // Undent next line n spaces. Break () Un := Nrx ge Nr -> 0, In - Number () // Default is undent to left margin. if Un < 0 do Un := 0 return case 'ur': if Nrx < Nr do $( let w = vec Maxline Nr := Use_ref (Rawchar + Nrx - 1, w, Nr - Nrx) for i = 1 to Nr do Rawchar!i := w!i Rawchar!(Nr + 1) := '*s' Again := true $) return case 'wt': Wait (); return } } // Control // This subroutine sets some parameter of runoff to either some value // or to some offset from its current value. If the operand is omitted // in the control line, the result is Default. If the operand is signed, // it is added into the old value. Otherwise the operand field value // replaces the old value. // Param is actually the lv of the cell to update. // This function returns the value of the operand field of a control line. // If the operand is omitted, it returns one. and Set_param (Param, Default) be $( Check_ref () if Nrx ge Nr do $( rv Param := Default return $) let OldNrx = Nrx let P = ReadParam (rv Param) if P < 0 do P := 0 rv Param := P Nrx := OldNrx $) and Number () = valof $( if Nrx ge Nr resultis 1 Check_ref () ExpError := false let v = vec Maxline let n = ReadExp (0, v) if ExpError | Nrx < Nr do Report ("Malformed expression") resultis n $)  runoff_mr3.bcpl 11/04/82 1921.3rew 11/04/82 1605.4 83466 // ROFF for Multics // // Last modified on 08/29/74 at 19:23:28 by R F Mabee. // // This file contains the following routines for printing text: // Text process a line of text // * Fill make a complete line if possible // * TrytoHyphenate break word if possible // * Adjust print a line, right-adjusted // Width return the width of a character // Break break text, emptying buffers // Spacing prepare to upspace paper // Eject finish printing a page // * Center print a line, centered // * Equation print an equation line // Routines marked * are not external. // Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc. // General permission is granted to copy and use this program, but not to sell it, provided that the above // copyright statement is given. Contact Information Processing Services, MIT, for further information. // Please contact R F Mabee at MIT for information on this program and versions for other machines. get "runoff_head" // Declarations for ROFF. external $( HyphenateWord = "hyphenate_word_" $) // Text is called after a line of text has been read into // Rawchar[1] ... Rawchar[Nr] // It arranges to print the text, as required. let Text () be { if Nr = 0 do { Break (); Spacing (); Newline (1); return } // Blank line produces break and blank output line. if Rawchar[1] = '*s' do Break () // Line indented is automatic break. if Eq > 0 do { Equation (); return } // Print an equation. for i = 1 to Nr do Char[Nc + i] := Rawchar[i] // Move text to output buffer. Nc := Nc + Nr if Ce>0 do { Center (); return } // Center a line. unless Fi do { Break (); return } // Fill. // Nothing special is happening, so do the work. Fill () // Loops while enough text to fill line. // Not enough to fill line, prepare for next to be concatenated. while Nc > 0 & Char!Nc = '*s' do Nc := Nc - 1 if Nc > 0 do $( let x, y = Char!(Nc - 1), Char!Nc if y = '.' | y = ':' | y = ';' | y = '!' | y = '?' | (y = '"' | y = ')') & (x = '.' | x = '!' | x = '?') do $( Nc := Nc + 1 // Two spaces after period, etc. Char!Nc := '*s' $) Nc := Nc + 1 // And anyway one. Char!Nc := '*s' $) } and Fill () be // Routine to print out as much as will fit on one line. $( if Nc < Ll - Un return // Not enough to possibly fill line. let Ne = 0 // Elements (character positions) so far. let Nc1, Ne1 = 0, 0 // Characters and elements at previous gap. let Nco = 0 // Characters in undented part. let Usable = Ll - Un // Remaining elements on line. and Undent = In - Un // Elements at left exempt from adjusting. Char!(Nc + 1) := '*s' for i = 1 to Nc + 1 do $( test Char!i = '*s' then $( if Ne le Usable | Ne1 = 0 do Nc1, Ne1 := i, Ne if Ne ge Usable do $( unless Hyphenating & Ne > Usable break let x = TryToHyphenate (Nc1, i, Usable - Ne1) while Nc1 < x do $( Ne1 := Ne1 + Width (Char!Nc1) Nc1 := Nc1 + 1 $) break $) while i le Nc do $( Ne := Ne + 1 // Width ('*s') unless Char!(i + 1) = '*s' break i := i + 1 $) $) or Ne := Ne + Width (Char!i) if Nco = 0 & Ne ge Undent do Nco := i + 1 $) if Ne < Usable return // Now print a line. Spacing () if Print | Ft do $( PrinterIndent () Blank (Un) // Leading blanks for indent. test Ad & Ne1 < Usable then test Undent = 0 then Adjust (1, Nc1 - 1, Usable - Ne1) or $( PadLeft := false if Nco = 0 | Nco > Nc1 do Nco := Nc1 for i = 1 to Nco - 1 do WriteChar (Char!i) Adjust (Nco, Nc1 - 1, Usable - Ne1) $) or for i = 1 to Nc1 - 1 do WriteChar (Char!i) $) Newline (1) // Now move unprinted stuff in Char to the left. while Char!(Nc1 + 1) = '*s' & Nc1 < Nc do Nc1 := Nc1 + 1 Nc := Nc - Nc1 if Nc < 0 do Nc := 0 for i = 1 to Nc do Char!i := Char!(Nc1 + i) Un := In Fill () // Print more if possible. $) // This routine attempts to break a word across lines. // It calls a user-supplied hyphenation procedure to determine // where and whether the word can be broken. // It moves text around in Char to insert a hyphen, // and returns the offset to the new breaking place. and TryToHyphenate (Begin, End, Space) = valof $( while Char!Begin = '*s' & Begin le Nc do Begin, Space := Begin + 1, Space - 1 let Len = End - Begin if Space < 3 | Len < 4 resultis 0 let v, w = vec Maxline, vec Maxline / 4 for i = 1 to Len do v!i := Char!(Begin + i - 1) v!0 := Len Packstring (v, w) let h = 0 call HyphenateWord (w string, lv Space, lv h) if h le 0 | h ge Len resultis 0 for i = Nc + 1 to Begin + h by -1 do Char!(i + 2) := Char!i Char!(Begin + h), Char!(Begin + h + 1) := '-', '*s' Nc := Nc + 2 resultis Begin + h + 1 $) // This routine prints a line, with right-adjustment. It alternates // between putting extra blanks on the right and on the left. // It operates on the text between Begin and End in Char. // Pad is the number of spaces which must be inserted into the line. and Adjust (Begin, End, Pad) be $( let Gaps = 0 // Find out how many gaps there are with which to stretch line. for i = Begin to End if Char!i = '*s' do $( if i > Begin do Gaps := Gaps + 1 while Char!(i + 1) = '*s' & i < End do i := i + 1 $) let s, k = 0, -1 unless Gaps = 0 do $( s := Pad / Gaps k := Pad - s * Gaps $) for i = Begin to End do { WriteChar ( Char[i] ) // Print next character. if Char[i + 1] = '*s' & Char[i] ne '*s' & i < End do // We have just encountered a gap. { Blank (s) // Most of the space required. test PadLeft // Where to put the extra space? then if k > 0 do { WriteChar ('*s'); k := k - 1 } else test k < Gaps then k := k + 1 or WriteChar ('*s') } } PadLeft := not PadLeft $) and Width (Char) = // How many print positions does Char take? $8040 le Conv!Char le $8176 -* 1, // Most characters take 1. Conv!Char = '*b' -* -1, // Backspace takes -1. 0 // Anything else takes 0. // Break in the text, so print out anything already read. and Break () be { if Fi do Fill () while Nc > 0 & Char!Nc = '*s' do Nc := Nc - 1 if Nc > 0 do $( Spacing () // Do we need some upspacing? if Print | Ft do $( PrinterIndent () Blank (Un) // Leading blanks, for indented lines. for i = 1 to Nc do WriteChar ( Char[i] ) // Print the line. $) Newline (1) // and upspace. Un := In // Back to the usual indenting. $) Nc := 0 // Nothing more to print. } // This routine is called just before any up-spacing. It does // two things for us: // 1. It takes care of double spacing. // 2. If we are about to complete a page, it does head // and foot printing, and such. and Spacing () be { if Nl > 0 do // Have we printed yet on this page? $( Newline (MinI (Ms - 1, LinesLeft + Fl)) if LinesLeft ge Ms logor Ft logor Flp do $( Flp := false // Clear switch indicating footnote reference. return $) Eject () // Close to bottom, so to work... $) if Ft return if Waitsw & Print do $( Wait (); Waitsw := Stopsw $) OddPage := Np rem 2 ne 0 // Skip lines above the header. if Printersw do Nl := Nl + 3 // Defect in printer DIM - can't use first three lines on page. Newline (Ma1 - Nl) for i = 1 to Maxheads do Title ((OddPage -> Oh, Eh)!i) Newline (Ma2) // Space below the header. if LinesLeft + Fl le 0 do LinesLeft := 1 - Fl // Make sure at least some text appears on page. if Pi = 0 return // No lines waiting for picture. // Now print space required for pictures to be drawn. if Pi ge LinesLeft do $( Newline (LinesLeft + Fl) if Pi > Pl * 10 do Pi := Pi rem (Pl * 10) Pi := Pi - Pl Flp := false Spacing () return $) Newline (Pi) Pi := 0 } and Eject () be // Eject paper, first printing footer and footnotes. { if Ft return // Can happen. unless Fl = 0 do PrintFootnotes () // If there are footnotes to print do it now. if Nl = 0 return // Page empty, don't print footers or count page. Newline (NoPaging -> Ma3, Pl - Nl - Ma4 - (OddPage -> Of, Ef)!0) // Skip down to footer. for i = Maxheads to 1 by -1 do Title ((OddPage -> Of, Ef)!i) test Printersw & ^ NoPaging then for i = 1 to MultiplePagecount do WriteChar ('*f') or Newline (NoPaging -> Ma4, Pl - Nl) Nl := 0 LinesLeft := Pl // Soon reset by Spacing. if Fr do Foot := 1 // Reset footnote counter if required. Np := NNp; NNp := NNp + 1 Print := Fp le Np le Lp & Passes le 1 } and Center () be // Print current line, centered. { let Ne = 0 for i = 1 to Nc do Ne := Ne+Width (Char[i]) Spacing () PrinterIndent () Blank ( (Ll-In-Ne)/2 + In) for i = 1 to Nc do WriteChar (Char[i]) Newline (1) Nc := 0 Ce := Ce - 1 } // The next routine prints a line as an equation. An // equation is like a title, and is of the form // 'aaa'bbb'ccc' // (where ' is the first non-blank character on the line). // aaa is printed at the left margin, ccc at the right and bbb centered. and Equation () be { Spacing () Nrx := 1 let v = vec Maxline Title (Readhead (v)) Eq := Eq - 1 }  runoff_mr4.bcpl 11/04/82 1921.3rew 11/04/82 1605.4 49311 // ROFF for Multics // // Last modified on 05/30/74 at 18:44:49 by R F Mabee. // // This file contains the following miscellaneous routines used for ROFF: // // Need Eject paper if less than n lines at current spacing on page. // NeedSS Eject paper if less than n lines on page. // Newline Upspace paper n lines. // SetLinesLeft Keep track of lines left on page. // Blank Store n blanks into output. // WriteChar Write a character. // PrinterIndent Make output for printer start indented twenty spaces. // StoreArabic Convert number to character, decimal arabic numerals. // StoreRoman Convert number to roman numeral representation. // StoreDate Convert current date to character representation. // ReadName Read name from control line and pack into vector. // Skiptolabel Scan through input for particular label line. // InsertFile Use new input file. // All are declared external. // Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc. // General permission is granted to copy and use this program, but not to sell it, provided that the above // copyright statement is given. Contact Information Processing Services, MIT, for further information. // Please contact R F Mabee at MIT for information on this program and versions for other machines. get "runoff_head" // Declarations for ROFF. let Need (n) be // Eject paper if less than n lines left. if n * Ms > LinesLeft do Eject () and NeedSS (n) be // Need for n lines, regardless of double spacing if n > LinesLeft do Eject () and Newline (n) be // Print n 'newline' characters. { for i = 1 to n do { test Ft then $( let P = Newvec (Fc + 1) for j = 1 to Fc do P!(j + 1) := Footbuf!j P!0, P!1 := 0, Fc test FootListBase = 0 then FootListBase := P or FootList!0 := P FootList := P Fl := Fl + 1 Fc := 0 $) or $( WriteChar ('*n') Nl := Nl + 1 $) } SetLinesLeft () } and SetLinesLeft () be LinesLeft := Pl - Nl - Ma3 - Ma4 - Fl - (OddPage -> Of, Ef)!0 and Blank (n) be for i = 1 to n do WriteChar ('*s') and WriteChar (c) be // Write 'c' into output stream or footnote buffer. { test Ft then { Footbuf[Fc + 1] := c Fc := Fc + 1 } else if Print do { if Charsw do WrCh (TrTable!c) let Cc = Conv[c] if Cc = Skip return // Partially canonicalize output by eliminating space-backspace pairs. // This is necessary because the printer DIM can't handle them. // Whenever a space or backspace arrives, we delay printing it // until the next character arrives. Then if the two form a space-backspace // pair, we don't put out either. If the second is some other character, // the held character has to be forced out first. test Cc = '*s' | Cc = '*b' then test SavedCc = 0 then $( SavedCc := Cc return $) or if SavedCc ne Cc do $( SavedCc := 0 return $) or unless SavedCc = 0 do $( Writech (Output, SavedCc) SavedCc := 0 $) Writech (Output, Cc) } } and PrinterIndent () be if Print logor Ft do $( let p = 0 if PrintLineNumbers do $( let v = vec 20 StoreArabic (InputLines, v) p := v!0 for i = p to 5 do WriteChar ('*s') for i = 1 to p do WriteChar (v!i) if p < 10 do $( WriteChar ('*t') p := 10 $) $) unless ExtraMargin = 0 do $( while p / 10 < ExtraMargin / 10 do $( WriteChar ('*t') p := p + 10 - p rem 10 $) while p < ExtraMargin do $( WriteChar ('*s') p := p + 1 $) $) $) and StoreArabic (n, v) be $( let w = vec 20 Unpackstring (ConvertNtoS (n, w), v) $) and StoreRoman (n, v) be $( let i, Wa, Wb = 0, vec 3, vec 3 let Ta, Tb = (table 'i', 'x', 'c', 'm') - 1, (table 'v', 'l', 'd') - 1 if n < 0 do n := -n for j = 1 to 3 do $( let r = n rem 10 Wa!j, Wb!j := r rem 5, r / 5 n := n / 10 $) if n > 20 do n := 20 for j = 1 to n do $( i := i + 1 v!i := 'm' $) for j = 3 to 1 by -1 do test Wa!j = 4 then $( i := i + 1 v!i := Ta!j i := i + 1 v!i := Wb!j = 0 -> Tb!j, Ta!(j + 1) $) or $( unless Wb!j = 0 do $( i := i + 1 v!i := Tb!j $) for k = 1 to Wa!j do $( i := i + 1 v!i := Ta!j $) $) v!0 := i $) let StoreDate (v) be $( let w = vec 10 FormDate (TimeNow, w, false) v!1, v!2 := w!0 / 10 + '0', w!0 rem 10 + '0' v!3 := '/' v!4, v!5 := w!2 / 10 + '0', w!2 rem 10 + '0' v!6 := '/' v!7, v!8 := w!3 / 10 rem 10 + '0', w!3 rem 10 + '0' v!0 := 8 $) and ReadName (v) = valof $( let i = 0 let w = vec Maxline while Nrx < Nr & Rawchar!Nrx ne '*s' do $( i := i + 1 w!i := Rawchar!Nrx Nrx := Nrx + 1 $) while Nrx < Nr & Rawchar!Nrx = '*s' do Nrx := Nrx + 1 w!0 := i Packstring (w, v) resultis i $) let Skiptolabel (Forward) be $( let L, v = Nr - 1, vec Maxline for i = 1 to L do v!i := Rawchar!i v!2, v!3 := 'l', 'a' JumpLine := InputLines unless Forward do Nx_reset () Loop: Nr := 0 Readline () if JumpLine < 0 do $( Nr := Nr + 1 Report ("Target label not found") return $) unless Nr = L goto Loop for i = 1 to L do unless v!i = Rawchar!i goto Loop JumpLine := -1 $) let InsertFile () be $( let v = vec Maxline / 4 if ReadName (v) = 0 do $( Report ("Missing file name") return $) Nx_open (v) if Nrx < Nr do UpdateSymbol ("Parameter") $)  runoff_mr5.bcpl 11/04/82 1921.3rew 11/04/82 1605.4 28350 // ROFF for Multics // // Last modified on 05/30/74 at 18:45:20 by R F Mabee. // // This file contains the following routines for processing // headers, footers, etc.: // // Readhead Read a header into a vector. // Gethead Allocate a new vector and call Readhead. // Sethead Set a header or a footer from control line. // Freeheads Free up one set of headers or footers. // Title Print a header or a footer. // All are declared external. // Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc. // General permission is granted to copy and use this program, but not to sell it, provided that the above // copyright statement is given. Contact Information Processing Services, MIT, for further information. // Please contact R F Mabee at MIT for information on this program and versions for other machines. get "runoff_head" // Declarations for ROFF. let Readhead (Head) = valof // Read in head or foot. $( let l = Nr - Nrx for i = 1 to l do Head!(i + 2) := Rawchar!(i + Nrx - 1) Head!0, Head!1, Head!2 := Ll, In, l // Save line length and indenting by definition. resultis Head $) and Gethead () = Nrx = Nr -* 0, Readhead (Newvec (Nr - Nrx + 2)) and Sethead (EOhf) be $( let OldNrx = Nrx test Nrx = Nr then Freeheads (EOhf) or $( let Fline = 0 test '0' le Rawchar!Nrx le '9' then $( Fline := ReadNumber (10) unless 0 < Fline le Maxheads do $( Report ("Bad header number") Fline := 1 $) unless EOhf!Fline = 0 do Freevec (EOhf!Fline) EOhf!Fline := 0 $) or $( Fline := 1 Freeheads (EOhf) $) if Nrx < Nr do EOhf!Fline := Gethead () $) let h = 0 for i = 1 to Maxheads unless EOhf!i = 0 do h := h + 1 EOhf!0 := h Nrx := OldNrx $) and Freeheads (EhOf) be $( for i = 1 to Maxheads unless EhOf!i = 0 do $( Freevec (EhOf!i) EhOf!i := 0 $) EhOf!0 := 0 $) and Title (Head) be $( if Head = 0 return unless Print logor Ft goto Out let w = vec Maxline let Ll, In, l = Head!0, Head!1, Head!2 for i = 1 to l do $( w!i := Head!(i + 2) if w!i = Spec_char do $( l := Use_ref (Head + 2, w, l) break $) $) let Delim, Count = w!1, 0 for i = 1 to 4 do $( l := l + 1 w!l := Delim $) let Start, Lengths = vec 3, vec 3 for i = 1 to l do if w!i = Delim do $( Lengths!Count := i - Start!Count - 1 Count := Count + 1 Start!Count := i if Count ge 4 break $) if Lengths!3 = 0 & Lengths!2 = 0 & Lengths!1 = 0 goto Out let Widths, Gaps = vec 3, vec 3 for i = 1 to 3 do $( let p, k, c = w + Start!i, Lengths!i, 0 for j = 1 to k do c := c + Width (p!j) Widths!i := c $) Gaps!1 := In test Lengths!2 = 0 then Gaps!2, Gaps!3 := 0, Ll - Widths!3 - Widths!1 - In or $( Gaps!2 := MaxI (0, (Ll - In - Widths!2) / 2 - Widths!1) Gaps!3 := Ll - Widths!3 - Widths!2 - Gaps!2 - Widths!1 - In $) if Lengths!3 = 0 do Gaps!3 := 0 PrinterIndent () for i = 1 to 3 do $( Blank (Gaps!i) let p = w + Start!i for j = 1 to Lengths!i do WriteChar (p!j) $) Out: Newline (1) $)  runoff_mr6.bcpl 11/04/82 1921.3rew 11/04/82 1605.4 30141 // ROFF for Multics // // Last modified on 06/23/74 at 19:31:29 by R F Mabee. // // This file contains the routines peculiar to the processing of footnotes: // // Foot_begin Start processing a footnote. // Foot_end Finish processing a footnote. // PrintFootnotes Print out the saved footnotes at the bottom of a page. // All are declared external. // Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc. // General permission is granted to copy and use this program, but not to sell it, provided that the above // copyright statement is given. Contact Information Processing Services, MIT, for further information. // Please contact R F Mabee at MIT for information on this program and versions for other machines. get "runoff_head" // Foot_begin starts processing footnotes. let Foot_begin () be { NeedSS (NoFtNo -> 3, 4) // Make sure room enough for some part of footnote. unless NoFtNo do // Insert numbers into text and footnote unless requested not to. $( let B = false Nc := Nc - 1 // Remove trailing blanks from previous line. if Char!Nc = '*s' do $( B := true // B indicates that line ended with . so extra space goes after number. Nc := Nc - 1 $) let v = vec Maxline // Expand user-settable footnote number reference. Unpackstring (TextRef, v) Nr := Use_ref (v, Rawchar, v!0) if B do $( Nr := Nr + 1 Rawchar!Nr := '*s' $) for i = 1 to Nr do Char!(Nc + i) := Rawchar!i Nc := Nc + Nr Unpackstring (FootRef, v) Nr := Use_ref (v, Rawchar, v!0) Again := Nr > 0 $) Fd, Findent, Fundent := Ms, In, Un // Remember parameters re-used by footnotes. Ms, In, Un := 1, 0, 0 PadLeft := false Ft := true // Say we are now processing a footnote if Fl = 0 do Fl := 1 // Count footnote demarcation line. Newline (1) // Blank line to begin footnote. for i = 1 to Nc do Temp[i] := Char[i] // Save unprinted stuff in Char Tempc := Nc Nc := 0 } // Foot_end finishes processing footnotes and Foot_end () be { Break() // Finishes last line of footnote Ft := false // No longer processing footnote Ms, In, Un := Fd, Findent, Fundent // Restore text parameters. for i = 1 to Tempc do Char[i] := Temp[i] //Restore Char Nc := Tempc Flp := not NoFtNo // Print the next text line regardless of room. // It contains the reference to a footnote to be // printed on this page. NoFtNo := false Foot := Foot + 1 } // PrintFootnotes puts out as much footnote text as will fit. and PrintFootnotes () be { if Nl = 0 do Spacing () let Lleft = LinesLeft + Fl // Number of lines available for footnotes on this page. let Ftp = MinI (Fl, Lleft) // Number to print this page. if Ftp = Fl - 1 > 3 do Ftp := Fl - 2 // Never leave just one line unprinted. if Ftp le 1 return Newline (NoPaging -> 1, Lleft - Ftp) test Fth = 0 then $( PrinterIndent () for i = 1 to Ll do WriteChar ('_') // Default separator. Newline (1) $) or Title (Fth) for i = 2 to Ftp unless FootListBase = 0 do $( for j = 1 to FootListBase!1 do WriteChar (FootListBase!(j + 1)) Newline (1) let t = FootListBase FootListBase := FootListBase!0 Freevec (t) Fl := Fl - 1 $) if Fl le 1 | FootListBase = 0 | FootList = 0 do Fl, FootListBase, FootList := 0, 0, 0 }  runoff_mr7.bcpl 11/04/82 1921.3rew 11/04/82 1605.4 21618 // Roff for Multics // // Last modified on 05/30/74 at 18:45:47 by R F Mabee. // // This file contains the routines needed to create the ".chars" file // that contains lines unprintable with the device being used: // // WrChInit Initializes things-called from mr1. // WrCh Called from Write to process a character. // Wrline Write a complete line. // Store Store a character. // The first two are external, the others not. // Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc. // General permission is granted to copy and use this program, but not to sell it, provided that the above // copyright statement is given. Contact Information Processing Services, MIT, for further information. // Please contact R F Mabee at MIT for information on this program and versions for other machines. get "runoff_head" // Declarations for Mulrof. global // The following are used by all of these routines: { LineC : 330 // Line counter on page. LineP : 331 // Character position on line. FF : 332 // Unprintable character on line so far? LPW : 333 // Last page number written on. Buff : 334 // Buffer for the line. Red : 335 // Was the last character stored red? } let WrChInit () be // Initialize the static quantities { Buff := Newvec (Maxline) // Storage for the line LPW := -1 LineC := 1 LineP := 0 FF := false Red := false for i = 0 to 127 do CharsTable!i := '*s' let T1 = table '[', ']', '{', '}', '~', '`' and T2 = table '<', '>', '(', ')', 't', '*'' for i = 0 to 5 do CharsTable!(T1!i) := T2!i } and WrCh (c) be // Write out character c. $( test CharsTable!c = '*s' then $( if Red do $( Store ('*k') Red := false $) Store (c) $) or $( unless Red do $( Store ('*d') Red := true $) Store (CharsTable!c) FF := true $) if c = '*n' do $( if FF do Wrline () LineP, FF, Red := 0, false, false $) $) and Wrline () be $( if Red do Store ('*k') if LPW ne Np do // First line printed on this page. $( WriteS (ChStream, "*n*n*nPage ") WriteN (ChStream, Np) WriteS (ChStream, "*n*n*n") LPW := Np $) if Nl < 10 do Writech (ChStream, '*s') WriteN (ChStream, Nl) Writech (ChStream, '*t') for i = 1 to LineP do Writech (ChStream, Buff[i]) $) and Store (c) be $( LineP := LineP + 1 Buff[LineP] := c $)  runoff_mr8.bcpl 11/04/82 1921.3rew 11/04/82 1605.4 59733 // Expression reading routines for runoff. // Last modified on 05/30/74 at 18:45:50 by R F Mabee. // // Routines defined in this module: // ReadNumber Scan and evaluate numeric field of control line. // MakeN Convert string to number (character constant). // ReadExp Scan and evaluate arbitrary expression in control line. // Skip Advance pointer to next non-blank. // ReadParam Evaluate expression setting or adding to old value. // ReadString Scan string constant. // GetString Read string and store in free storage vector. // SubscriptString Evaluate substring expression. // Only ReadNumber, ReadExp, ReadParam, ReadString, and GetString are external. // Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc. // General permission is granted to copy and use this program, but not to sell it, provided that the above // copyright statement is given. Contact Information Processing Services, MIT, for further information. // Please contact R F Mabee at MIT for information on this program and versions for other machines. get "head" get "runoff_head" let ReadNumber (b) = valof // Read and evaluate a number, base b. $( let n = 0 while 0 le Rawchar!Nrx - '0' < b & Nrx < Nr do // For all digits. $( n := n * b + Rawchar!Nrx - '0' // Add in digit. Nrx := Nrx + 1 $) while Rawchar!Nrx = '*s' & Nrx < Nr do Nrx := Nrx + 1 // Skip over following white space. resultis n $) and MakeN (v) = valof // Convert string to character (number). $( let x = 0 for i = 1 to Length (v) do x := x lshift ByteBits logor Subch (v, i) resultis x $) let ReadExp (n, v) = valof // Read and evaluate a subexpression of precedence n. // v is work space for strings. $( if Nrx ge Nr do $( ExpError := true // Null expression is error. resultis 0 $) let String = false let A = valof switchon Rawchar!Nrx into // Get primary expression. $( case '^': Skip () resultis ^ ReadExp (3, v) case '-': Skip () resultis - ReadExp (5, v) case '(': Skip () A := ReadExp (0, v) test Rawchar!Nrx = ')' then Skip () or ExpError := true resultis A case '0': case '1': case '2': case '3': case '4': case '5': case '6': case '7': case '8': case '9': resultis ReadNumber (10) case '#': Skip () resultis ReadNumber (8) case '"': String := true ReadString (v) resultis MakeN (v) default: ExpError := true // Unrecognizable character, must be error. resultis 0 $) while Nrx < Nr do // Read possible multiple operators at this precedence. $( let Op = Rawchar!Nrx let NewNrx = Nrx if Rawchar!(Nrx + 1) = '*b' do $( Op := (Op lshift ByteBits logor '*b') lshift ByteBits logor Rawchar!(Nrx + 2) NewNrx := NewNrx + 2 $) let p = valof switchon Op into // Get precedence of current operator. $( case '=_': case '|': resultis 2 case '&': resultis 3 case '=': case '<': case '>': case '/=': case '<_': case '>_': resultis 4 case '+': case '-': resultis 5 case '**': case '/': case '\': resultis 6 case '#': unless String break A := Length (v) Nrx := NewNrx Skip () String := false loop default: break // Not a known operator, end of expression. $) if p le n break // Operator less binding, return. Nrx := NewNrx Skip () // Over operator. let B = 0 test String & Rawchar!Nrx = '"' & p = 4 // Check for string comparison. then $( let w = vec Maxline ReadString (w) A := CompareStrings (v, w) $) or B := ReadExp (p, v) String := false A := valof switchon Op into // Apply the operator. $( case '|': resultis A | B case '=_': resultis A eqv B case '&': resultis A & B case '=': resultis A = B case '<': resultis A < B case '>': resultis A > B case '/=': resultis A ne B case '<_': resultis A le B case '>_': resultis A ge B case '+': resultis A + B case '-': resultis A - B case '**':resultis A * B case '/': resultis B = 0 -> 0, A / B case '\': resultis B = 0 -> 0, A rem B $) $) // Repeat until done. resultis A $) and Skip () be // Skip over current character and following blank space. Nrx := Nrx + 1 repeatwhile Rawchar!Nrx = '*s' & Nrx < Nr and ReadParam (P) = valof // Read parameter where leading + or - means add or subtract from current value. $( ExpError := false let v = vec Maxline test Rawchar!Nrx = '+' // Adding. then $( Skip () P := P + ReadExp (4, v) $) or test Rawchar!Nrx = '-' // Subtracting. then $( Skip () P := P - ReadExp (4, v) $) or P := ReadExp (0, v) // Or just setting. if ExpError | Nrx < Nr do Report ("Malformed expression") resultis P $) and ReadString (w) be // Read string expression into vector. $( let i, v = 0, vec Maxline $( Nrx := Nrx + 1 let c = Rawchar!Nrx test c = '**' // Escape convention. then $( Nrx := Nrx + 1 c := valof switchon Rawchar!Nrx into $( case 'n': resultis '*n' case 't': resultis '*t' case 's': resultis '*s' case 'b': resultis '*b' case 'c': c := 0 for i = 1 to 3 do $( unless '0' le Rawchar!(Nrx + 1) le '9' break Nrx := Nrx + 1 c := c * 10 + Rawchar!Nrx - '0' $) resultis c & $8177 default: resultis Rawchar!Nrx $) $) or if c = '"' do // End of string. $( Skip () while Nrx < Nr & Rawchar!Nrx = '(' do i := SubscriptString (v, i) if Nrx < Nr & Rawchar!Nrx = '"' loop break $) i := i + 1 v!i := c $) repeatwhile Nrx < Nr // Gather characters of string until end of line. v!0 := i Packstring (v, w) $) and GetString () = valof // Read string and store in new vector. $( let v = vec Maxline ExpError := false ReadString (v) if ExpError | Nrx < Nr do Report ("Malformed string expression") resultis StoreString (v) $) and SubscriptString (v, i) = valof // Take substring, read subscript expression. $( Skip () let w = vec Maxline let a = MinI (ReadExp (4, w), i + 1) // Character index for beginning of substring. if a < 0 do a := a + i + 1 // Negative first indicates offset from end. if a le 0 do a := 1 let b = i - a + 1 if Rawchar!Nrx = ',' do $( Skip () // Second operand, length of substring. b := MinI (ReadExp (4, w), b) if b < 0 do b := MaxI (b + i - a + 2, 0) $) if Rawchar!Nrx ne ')' do $( ExpError := true resultis i $) for i = 1 to b do v!i := v!(a + i - 1) // Take the indicated substring. Skip () resultis b $)  runoff_mr9.bcpl 11/04/82 1921.3rew 11/04/82 1605.4 87048 // ROFF for Multics // // Last modified on 05/30/74 at 18:45:56 by R F Mabee. // // Tree_search Find a named symbol in the symbol table. // GetSymbol Return value and type of a named symbol. // SetSymbol Assign new value and type to a named symbol. // SetCtable Update any character translation table. // StoreCtable Evaluate translation table as string. // UpdateSymbol Set value and type of named symbol from control line. // Set_ref Process a .sr control line. // Use_ref Perform substitutions for named symbols. // Check_ref Implicit .ur for expression beginning with %. // Only Tree_search, GetSymbol, and SetSymbol are not declared external. // Copyright (c) 1974 by Massachusetts Institute of Technology and Honeywell Information Systems, Inc. // General permission is granted to copy and use this program, but not to sell it, provided that the above // copyright statement is given. Contact Information Processing Services, MIT, for further information. // Please contact R F Mabee at MIT for information on this program and versions for other machines. get "head" get "runoff_head" global $( Global : 0 $) manifest $( NUMBER = 1 STRING = 2 CTABLE = 3 FUNCTION = 4 COUNTER = 5 BUILTIN = 8 SETS_PRINT = 16 READ_ONLY = 32 RELOCATE = 64 $) let Tree_search (Name, Create) = valof $( let x = Name!0 let k = LengthInWords (Name) - 1 let P, Q = 0, lv TreeRoot $( P := rv Q if P = 0 break let d = P!4 - x if d = 0 for i = 1 to k do $( d := P!(i + 4) - Name!i unless d = 0 break $) if d = 0 resultis P Q := d < 0 -> lv P!3, lv P!2 $) repeat unless Create resultis 0 P := Newvec (k + 4) for i = 0 to k do P!(i + 4) := Name!i P!0, P!1, P!2, P!3 := 0, NUMBER, 0, 0 rv Q := P resultis P $) let GetSymbol (Name, Space) be // Return value of named symbol as unpacked string. $( let P = Tree_search (Name, false) if P = 0 do // Undefined name - value is null string by definition. $( Space!0 := 0 return $) let Value, Flags = lv P!0, P!1 if (Flags & BUILTIN) ne 0 do $( Value := rv Value if (Flags & RELOCATE) ne 0 do Value := Value + (lv Global) $) switchon Flags & 7 into // Dispatch on Type. $( case NUMBER: StoreArabic (rv Value, Space) return case STRING: Unpackstring (rv Value, Space) return case FUNCTION: Value (Space, false) return case CTABLE: StoreCtable (Value, Space) return case COUNTER: rv Value := rv Value + 1 StoreArabic (rv Value - 1, Space) return $) $) and SetSymbol (Name, Type, Value) be $( let P = Tree_search (Name, true) let OldValue, Flags = lv P!0, P!1 if (Flags & BUILTIN) ne 0 & (Flags & READ_ONLY) = 0 do $( OldValue := rv OldValue if (Flags & RELOCATE) ne 0 do OldValue := OldValue + (lv Global) switchon Flags & 7 into // Dispatch on old Type. $( case NUMBER: case COUNTER: unless Type = NUMBER goto UserCell rv OldValue := Value if (Flags & SETS_PRINT) ne 0 do Print := Fp le Np le Lp & Passes le 1 return case STRING: unless Type = STRING goto UserCell Freevec (rv OldValue) rv OldValue := Value return case CTABLE: unless Type = STRING goto UserCell SetCtable (OldValue, Value) return case FUNCTION: unless Type = NUMBER goto UserCell OldValue (Value, true) return $) $) if Flags = STRING do Freevec (P!0) UserCell: P!0, P!1 := Value, Type $) and SetCtable (Table, Value) be $( let w = vec 512 Unpackstring (Value, w) let l = w!0 if l > 128 do l := 128 while l < 128 do $( l := l + 1 w!l := '*s' $) for i = 0 to 127 do Table!i := w!(i + 1) Freevec (Value) $) and StoreCtable (Table, v) be $( let j = 0 for i = 0 to 127 do $( j := j + 1 let c = Table!i c := valof switchon c into $( case '*b':resultis 'b' case '*n':resultis 'n' case '*t':resultis 't' case '**':resultis '**' case '"': resultis '"' default: if $8040 le c le $8176 do $( v!j := c loop $) v!j := '**' v!(j + 1) := 'c' v!(j + 2) := c / 100 + '0' v!(j + 3) := c / 10 rem 10 + '0' v!(j + 4) := c rem 10 + '0' j := j + 4 loop $) v!j := '**' v!(j + 1) := c j := j + 1 loop $) v!0 := j $) let UpdateSymbol (Name) be $( Check_ref () // Do substitutions if necessary. let Type, Value = 0, 0 test Rawchar!Nrx = '"' then Type, Value := STRING, GetString () or $( let v = vec Maxline ExpError := false Type, Value := NUMBER, ReadExp (0, v) if ExpError | Nrx < Nr do Report ("Malformed expression") $) SetSymbol (Name, Type, Value) $) and Set_ref () be $( let v = vec Maxline / 4 if ReadName (v) = 0 return UpdateSymbol (v) $) and Use_ref (In, Out, Inl) = valof // = Outl $( let Ini, Outi = 0, 0 let v = vec Maxline * 2 while Ini < Inl & Outi < Maxline do $( Ini := Ini + 1 unless In!Ini = Spec_char do $( Outi := Outi + 1 Out!Outi := In!Ini loop $) if In!(Ini + 1) = Spec_char do // Double escape turns to single in output. $( Ini := Ini + 1 Outi := Outi + 1 Out!Outi := Spec_char loop $) for i = Ini + 1 to Inl do $( let c = In!i if c = Spec_char do $( let w = vec Maxline for j = 1 to i - Ini - 1 do v!j := In!(Ini + j) v!0 := i - Ini - 1 Packstring (v, w) GetSymbol (w, v) Ini := i goto StoreS $) unless 'a' le c le 'z' logor 'A' le c le 'Z' logor '0' le c le '9' logor c = '_' break $) (Roman -> StoreRoman, StoreArabic) (Np, v) StoreS: for i = 1 to v!0 do Out!(Outi + i) := v!i Outi := Outi + v!0 $) resultis Outi $) and Check_ref () be // Do symbol substitution for control line if first or second character is %. $( unless Rawchar!Nrx = Spec_char logor Rawchar!(Nrx + 1) = Spec_char return let w = vec Maxline for i = 1 to Nr do w!i := Rawchar!i let OldRoman = Roman Roman := false Nr := Use_ref (w + Nrx - 1, Rawchar + Nrx - 1, Nr - Nrx + 1) + Nrx - 1 Roman := OldRoman $) let InitializeSymbolTree () be // Set up symbol table with built-in names. $( TreeRoot := 0 Define ("Ad", lv Ad, NUMBER | RELOCATE) Define ("Ce", lv Ce, NUMBER | RELOCATE) Define ("Eq", lv Eq, NUMBER | RELOCATE) Define ("Fi", lv Fi, NUMBER | RELOCATE) Define ("Fr", lv Fr, NUMBER | RELOCATE) Define ("Ft", lv Ft, NUMBER | RELOCATE) Define ("Ll", lv Ll, NUMBER | RELOCATE) Define ("Ms", lv Ms, NUMBER | RELOCATE) Define ("Nl", lv Nl, NUMBER | RELOCATE) Define ("Pi", lv Pi, NUMBER | RELOCATE) Define ("Pl", lv Pl, NUMBER | RELOCATE) Define ("To", lv To, NUMBER | RELOCATE) Define ("Un", lv Un, NUMBER | RELOCATE) Define ("Ma1", lv Ma1, NUMBER | RELOCATE) Define ("Ma2", lv Ma2, NUMBER | RELOCATE) Define ("Ma3", lv Ma3, NUMBER | RELOCATE) Define ("Ma4", lv Ma4, NUMBER | RELOCATE) Define ("NNp", lv NNp, NUMBER | RELOCATE) Define ("Foot", lv Foot, NUMBER | RELOCATE) Define ("From", lv From, NUMBER | RELOCATE) Define ("Print", lv Print, NUMBER | RELOCATE) Define ("Start", lv Start, NUMBER | RELOCATE) Define ("Roman", lv Roman, NUMBER | RELOCATE) Define ("NoFtNo", lv NoFtNo, NUMBER | RELOCATE) Define ("Stopsw", lv Stopsw, NUMBER | RELOCATE) Define ("Waitsw", lv Waitsw, NUMBER | RELOCATE) Define ("PadLeft", lv PadLeft, NUMBER | RELOCATE) Define ("ExtraMargin", lv ExtraMargin, NUMBER | RELOCATE) Define ("Hyphenating", lv Hyphenating, NUMBER | RELOCATE) Define ("PrintLineNumbers", lv PrintLineNumbers, NUMBER | RELOCATE) Define ("MultiplePagecount", lv MultiplePagecount, NUMBER | RELOCATE) Define ("Fp", lv Fp, NUMBER | SETS_PRINT | RELOCATE) Define ("Lp", lv Lp, NUMBER | SETS_PRINT | RELOCATE) Define ("Passes", lv Passes, NUMBER | SETS_PRINT | RELOCATE) Define ("In", lv In, NUMBER | READ_ONLY | RELOCATE) Define ("Np", lv Np, NUMBER | READ_ONLY | RELOCATE) Define ("Selsw", lv Selsw, NUMBER | READ_ONLY | RELOCATE) Define ("Time", lv TimeNow, NUMBER | READ_ONLY | RELOCATE) Define ("Filesw", lv Filesw, NUMBER | READ_ONLY | RELOCATE) Define ("LinesLeft", lv LinesLeft, NUMBER | READ_ONLY | RELOCATE) Define ("Printersw", lv Printersw, NUMBER | READ_ONLY | RELOCATE) Define ("InputLines", lv InputLines, NUMBER | READ_ONLY | RELOCATE) Define ("NestingDepth", lv NestingDepth, NUMBER | READ_ONLY | RELOCATE) Define ("Eqcnt", lv Eqcnt, COUNTER | RELOCATE) Define ("FootRef", lv FootRef, STRING | RELOCATE) Define ("TextRef", lv TextRef, STRING | RELOCATE) Define ("Parameter", lv Parameter, STRING | RELOCATE) Define ("FileName", lv FileName, STRING | READ_ONLY | RELOCATE) Define ("InputFileName", lv InputFileName, STRING | READ_ONLY | RELOCATE) Define ("ConvTable", Conv, CTABLE) Define ("TrTable", TrTable, CTABLE) Define ("CharsTable", CharsTable, CTABLE) Define ("DeviceTable", DeviceTable, CTABLE) Define ("Date", StoreDate, FUNCTION | READ_ONLY) Define ("Console", ConsoleReadline, FUNCTION | READ_ONLY) Define ("NoPaging", NoPagingFUNCTION, FUNCTION) Define ("Charsw", CharswFUNCTION, FUNCTION) Define ("Device", DeviceFUNCTION, FUNCTION) $) and Define (Name, Value, Flag) be $( let P = Tree_search (Name, true) if (Flag & RELOCATE) ne 0 do Value := Value - (lv Global) P!0, P!1 := Value, Flag | BUILTIN $) and NoPagingFUNCTION (Arg, SetSw) be test SetSw then SetPaging (Arg) or StoreArabic (NoPaging, Arg) and CharswFUNCTION (Arg, SetSw) be test SetSw then SetCharsw (Arg) or StoreArabic (Charsw, Arg) and DeviceFUNCTION (Arg, SetSw) be test SetSw then SetDevice (Arg) or StoreArabic (Device, Arg) bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull and Bull HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by Bull HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved