Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/podtyp.bcp
There are no other files named podtyp.bcp in the archive.
//Head file for <JWALKER>
//Globals for routines of general interest
//Handy manifests
//My structures
get "<bcpl>head"
get "<bcpl>utilhead"
get "<bcpl>stringhead"
get "<bcpl>jshead"
get "<bcpl>psihead.bcp"
get "<bcpl>whichsystem.bcp" //for system function IS10X
global
{ SetBit: 1 //turn on indicated bit
ShowBits: 2 //show values of 36 bits in octal grouping
ReadFilePointer: 3 //read current JFN pointer
ChangeFilePointer: 4 //relative change for jfn pointer
SetFilePointer: 5 //set pointer for JFN
ShowFileName: 6 //show name associated with JFN
FindNameField: 7 //find field of file name assoc. with JFN
ShowError: 8 //output error message for failure on JSYS call
OpenFile: 9 //open JFN supplied for input
Transparent: 10 //set .PRIIN to binary mode or back
FindInputFile: 11 //use GTJFN, supply default file type
SuppressMessages: 12 //suppress or allow system messages
ClearInput: 13 //clear terminal input buffer
BackUp: 14 //back up a designated stream
YNConfirm: 15 //prompt for confirmation (binary decision)
CRConfirm: 16 //require RETURN before continuing
ClearOutput: 17 //clear terminal output buffer
}
manifest
{ NEWLINE := "*c*l" //keep output clean
ON := true
OFF := false
IN := true
OUT := false
PROCESS := #400000 //current process handle
NULIO := #377777 //null dest designator
}
structure
{ BinWord
{ Bit^0^35 bit
}
OctWord
{ Byte^0^11 bit 3
}
}
// originally, bufhead.bcp
//[BBNA]<JWALKER>BUFHEAD.BCP.35, 13-Feb-82 15:35:25, Ed: JWALKER
//added RUBOUT manifest
//[BBNA]<JWALKER>BUFHEAD.BCP.33, 26-Jun-81 11:23:06, Ed: JWALKER
//added structure definition for File Block
//[BBNA]<JWALKER>BUFHEAD.BCP.24, 19-Aug-80 14:53:00, Ed: JWALKER
//Revised to add PS: to file specification for help file for TOPS-20
//Part of the package for the PodType program
//Copyright (C) Bolt Beranek and Newman Inc. 1979, 1980, 1981
//Global designations
get "janhead" //my library of standard utilities
global
{ SendIt: 100
GetCommand: 101
ShutDown: 102
PageHandler: 103
ResetPrams: 104
SendPage: 105
InitDiablo: 106
GetString: 107
EvalString: 108
WhatType: 109
BreakPage: 110
FillBuffer : 111
SendBuffer : 112
WaitForDone : 113
InDoubleCommandSet : 114
ReadPaperLength : 115
ParsePages : 116
//now for the global variables
Hmi : 200
Vmi : 201
PaperLength : 202
DefaultPaperLength : 203
PageFlag : 204
TransferType : 205
StandardVmiSequence : 206
FileType : 207
BUFFERMAX : 208
PPointers : 209
HelpPP : 210
PFile : 211
HelpFile : 212
ETXACKProtocol : 213
CTRLC : 214
ControlCReturn : 215
ControlCStackPtr : 216
}
manifest
{ ESC := #33 //escape character
LF := #12 //linefeed key
CR := #15 //bare carriage return
RUBOUT := #177 //rubout key
PAGEMARK := $^L //marks end of page sequence in POD file
CTRLF := $^F //^F synch signal (from terminal) ACK
CTRLD := $^D //^D to abort a page
CTRLX := $^X //^X to abort all
CTRLP := $^P //^P to request pause at end of page
BEL := $^G //^G for messages and warnings
PLUS := $+ //for relative page specs
MINUS := $- //for relative page specs
EQ := $= //for absolute pgae specs
SP := #40 //space bar
QUIT := $Q //for stop command
SAMEPAGE := $.
PREVPAGE := $^
NEXTPAGE := SP
NEXTPAGEKEY := "the space bar" //for instructions to user
SAMEPAGEKEY := "the period key" //for instructions to user
INITIALPAGE := $1
DOTPAGE := $.
FINALPAGE := $%
ALLPAGES := $**
EJECT := true
NOEJECT := false
BACKWARDS := -1
FORWARDS := +1
COLON := $:
CONTINUOUS := ON
PAGEPAUSE := OFF
STARTOVER := -1
MAXNOPAGES := 511
PAGEBLOCK := #100000 //lots of space for SIN
POD := 'POD' //ASCIZ string for the default file type
}
structure
{ FB //for packaging info about any file
{ JFN word 1 //the file JFN
FileStatus word 1 //0 means more, -1 means EOF found
NextPagetoFind word 1 //next read will find this page no.
PagePointers word 1 //array holding pointers into file
PageCount word 1 //init 0, gets actual count at end
Device word 1 //string pointer to "TXT" or "POD"
}
}
//[BBNA]<JWALKER>PT.BCP.7, 24-Feb-82 19:25:06, Ed: JWALKER
//2B(23) tries to get ETX/ACK protocol being recognized again
//[BBNA]<JWALKER>PT.BCP.4, 22-Feb-82 21:01:54, Ed: JWALKER
//2B(22) added PSI handling for control C
//[BBNA]<JWALKER>PT.BCP.4, 14-Feb-82 16:46:36, Ed: JWALKER
//2B(21) tried putting in PSI handling for C-O
//[BBNA]<JWALKER>PT.BCP.140, 13-Feb-82 15:54:58, Ed: JWALKER
//2B(20) cleanup of protocol handling, missing help file, E command, string get
//[BBNA]<JWALKER>PT.BCP.139, 22-Jul-81 10:38:47, Ed: JWALKER
//2B(19) added support for XON/XOFF protocol (in StartUp,WaitForDone)
//[BBNA]<JWALKER>PT.BCP.138, 2-Jul-81 18:27:24, Ed: JWALKER
//[BBNA]<JWALKER>PT.BCP.137, 30-Jun-81 22:07:23, Ed: JWALKER
//2A(18) many bug fixes to parsing and incremental page number figuring
//[BBNA]<JWALKER>PT.BCP.130, 26-Jun-81 10:27:23, Ed: JWALKER
//2A(16) Change to on-demand page parsing for (user perception of) speed
//[BBNA]<JWALKER>PT.BCP.129, 29-Apr-81 11:58:03, Ed: JWALKER
//1B(15) reduces buffer size for Xerox 1700; refixes typewheel determination.
//[BBNA]<JWALKER>PT.BCP.128, 15-Apr-81 00:16:00, Ed: JWALKER
//1B(14) Oh-vay. Bugs in determining Typewheel. Old Scribe is different.
//[BBNA]<JWALKER>PT.BCP.125, 9-Apr-81 12:15:34, Ed: JWALKER
//1B(13) figured out how to report required typewheel.
//[BBNA]<JWALKER>PT.BCP.124, 9-Mar-81 18:47:36, Ed: JWALKER
//1B(10) Fixed scoping error (prevented C-P from working)
//[BBNA]<JWALKER>PT.BCP.119, 28-Feb-81 15:12:39, Ed: JWALKER
//1B(9) change parsing to use SIN, for speed
//[BBNA]<JWALKER>PT.BCP.115, 23-Feb-81 17:40:16, Ed: JWALKER
//v 0a(6) add extra ETX, add paper length support
//[BBNA]<JWALKER>PT.BCP.113, 10-Feb-81 13:34:29, Ed: JWALKER
//v 0a(5) refuse system msgs, redo ESC seq parsing in FillBuffer
//[BBNA]<JWALKER>PT.BCP.109, 19-Aug-80 14:54:21, Ed: JWALKER
//v 0A(4) added PS: to file specification for help file in BUFHEAD
//[BBN-TENEXA]<JWALKER>PT.BCP.108, 22-May-80 22:08:55, Ed: JWALKER
//v 0A(3) fixed parsing problem in ParsePODPages
//Copyright (C) 1979 Bolt Beranek and Newman
/* PODTYP is a typing program for typing any file on a Diablo 1620
compatible style printing terminal. It was originally written for
typing Scribe POD files but works on any ASCII text file.
PODTYP was designed, implemented, and documented at BBN as a spare time
project by Jan Walker. It benefitted from discussions with Doug Dodds
and Chris Ryland on implementation issues.
*/
get "bufhead"
static
{ Copyright := "Copyright (C) 1979,1980,1981,1982 Bolt Beranek and Newman Inc."
PPointers := vec MAXNOPAGES //array of pointers to file
HelpPP := vec 2 //needs pages 0,1,2
PFile := vec (size FB) //file block for main file
HelpFile := vec (size FB) //file block for help file
HELPFILENAME := vec 10 //help file name (system dependent)
Hmi := 13 //default char width is 10 pitch for Diablo
Vmi := 9 //default vertical spacing for Diablo
PaperLength := 66 //actual physical paper size (6 to inch)
DefaultPaperLength := 66 //default physical paper size
PageFlag := nil //for temporary page pause
TransferType := PAGEPAUSE //default for paper feed
StandardVmiSequence := "*$^^*t" //ESC Vmi 9 for Diablo
FileType := 'NUL' //Spot for byte pointer return
BUFFERMAX := 120 //full size buffer (device dependent)
ETXACKProtocol := false //default for protocol
DefaultJFNModeWord := 0 //for reading/resetting tty stuff
CTRLC := $^C //^C synch signal (to terminal) ETX
ControlCReturn := 0
ControlCStackPtr : 0
}
manifest
{ TYPE := 3
}
//Major control loop. Has to prompt user, find and parse
//file, collect user commands and supervise printout according
//to commands, including getting new file and new set of commands.
//assumption: Transparent OFF
let Start() be
{ SuppressMessages(true) //turn off system msgs
InitFB(PFile) // do easy defaults
PFile>>FB.PagePointers := PPointers //make it point to an array
InitFB(HelpFile) //do easy defaults
test IS10X() //different for TENEX and TOPS-20
ifso HELPFILENAME := "<SCRIBE>STYDOC.POD" //location of the help text
ifnot HELPFILENAME := "SCRIBE:STYDOC.POD" //TOPS-20 Rel 4
[I've FILDDT'ed this ^ to be HLP:STYDOC.POD.
It's at 6336 in 9-bit! - DAW]
HelpFile>>FB.JFN := FindInput(HELPFILENAME) //get its JFN
unless HelpFile>>FB.JFN=0 do //keep failure non-serious
{ HelpFile>>FB.PagePointers := HelpPP //make it point to small array
HelpFile>>FB.Device := "POD" //device type for help
ParsePages(HelpFile,MAXNOPAGES,OFF) //parse the help file
}
StartUp() //deal with tty and protocol
SetUpFile(PFile,POD,"Print file: ") //collect file to print
while true do
{ let Next := GetCommand(PFile,HelpFile)
switchon Next into
{ case QUIT: break //bail out
case STARTOVER:
if PFile>>FB.JFN > 0
then EndRead(PFile>>FB.JFN) //finish with the old file
InitFB(PFile) //reset various stuff
SetUpFile(PFile,POD,"New file name: ") //get a new file
endcase
default:
WriteS(NEWLINE)
WriteS("Ooops. Something wrong with GetCommand")
endcase
}
}
ShutDown(PFile>>FB.JFN,HelpFile>>FB.JFN) //clean up tty and protocol
finish //stop
} repeat //and allow for continue from exec
//Send out the banner stuff
//assumption: Transparent OFF
and StartUp() be
{ SetUpPSI() //we'll trap ^O and ^C only
Transparent(ON)
PBOUT(ESC) //have to be sure to set lines per page
PBOUT(PAGEMARK)
PBOUT(PaperLength) //lines per page calculated at 6 per inch
PBOUT(CTRLC) //send out a dove (for guessing protocol)
WriteS(NEWLINE)
WriteS("Copyright (C) 1982 Bolt Beranek and Newman Inc.")
WriteS(NEWLINE)
WriteS("PODTYP Version 2B(23)(Feb82). See HELP PODTYP")
GuessProtocol()
Transparent(OFF) //now make i/o normal briefly
}
/* GuessProtocol is a procedure for determining which of two protocols a
particular terminal is using. The choices are ETX/ACK (where program sends ETX
and terminal responds with ACK when it reads the ETX in the input stream) and
XON/XOFF where the terminal sends XOFF to host when buffer is close to full and
XON when buffer is close to empty. This routine sends out an ETX and waits a
modest time interval (2 sec) for the answering ACK. If none arrives, it
assumes that the terminal is set wired for XON/XOFF and sets up to handle it
accordingly. This is all fine except when the host front end is grossly tied
up and it can make the wrong guess. The user can back out of this with E.
Doesn't care about Transparent since ETX has been sent.
Assumes that the ETX has already been sent. Had to do this to interleave the
printing of the startup message with the waiting for the ACK. Note carefully
the placement of the PBOUT(CTRLC)
*/
and GuessProtocol() be
{gp
let AC := vec 20
Wait(2000) //wait awhile
AC|1 := INPUT
if 1 = JSYS(jsSIBE,AC) //check for olive branch
then for I := 1 to AC|2 do //check input for valid ACK
if (#177&PBIN())=CTRLF //remember to mask, 8 bits in
then ETXACKProtocol := true //turn on flag if OK
unless ETXACKProtocol do //if ETXACK flag got turned on, then OK
{ CTRLC := 0 //otherwise, make this a null
WriteS(NEWLINE)
WriteS("Assuming XON/XOFF protocol.")
unless IS10X() do //this stuff not available on TENEX
{ let AC := vec 20 //let TENEX fend for self
AC|1 := OUTPUT
JSYS(jsRFMOD,AC) //find JFN mode word
DefaultJFNModeWord := AC|2 //we can put this back to previous
AC|2 := AC|2 logor 2 //enable pause-on-command
JSYS(jsSTPAR,AC)
AC|2 := #43 //.MOXOF code; won't work for TENEX
AC|3 := 0 //disable pause-at-end-of-page
JSYS(jsMTOPR,AC) //no way to restore to previous later
}
}
}gp
/* SetUpPSI is a procedure for enabling interrupts. The ones we are using are
C-O and C-C. The C-O is necessary to keep users from falling into black hole
if they use it. C-C is necessary to reset the terminal printing
characteristics so that using the terminal afterwards is possible.
*/
and SetUpPSI() be
{ PSIClear() //make sure everything is kosher to start
PSISetCh(1,1,CTRLOService) //connect ch 1 to CTRLO service routine
ATI($^O,1) //assign C-O to Ch 1
let ACs := vec 20 //ensure that process can handle own ^C
ACs|1 := PROCESS //current process handle
JSYS(jsRPCAP,ACs) //find current capabilities
ACs|3 := SetBit(lv (ACs|2),0,ON) //now enable the C-C capability
JSYS(jsEPCAP,ACs)
PSISetCh(1,3,CTRLCService) //connect ch 3 to CTRLC service routine
ATI($^C,3) //assign C-C to Ch 3
PSIOn() //let 'er rip
}
//function: SetUpFile(Fileblock,DefaultType,Message)
//parameter 1: pointer to file block structure for file being set up
//parameter 2: pointer to ASCIZ string containing default file type
//parameter 3: string containing prompt message to type on terminal
//side effects on the file block
//operation: works for any file; finds Hmi, Vmi only for POD files
//assumption: Transparent OFF
and SetUpFile(File,DefaultType,Message) be
{ File>>FB.JFN := FindInputFile(DefaultType,Message) //finds the JFN
OpenFile(IN,File>>FB.JFN) //open this file for input
let DestPointer := -1,,FileType //create a byte pointer for FileType
FindNameField(File>>FB.JFN,DestPointer,TYPE) //get file type from JFN
let Temp1,Temp2 := vec 3,vec 3 //kludge around, compare it to "POD"
test Eqstr(ASCIZToString(FileType,Temp1),ASCIZToString(POD,Temp2))
ifso //for a POD file
{ File>>FB.Device := "POD" //save the file class as POD
ParsePages(File,1,ON) //just get the first real page
FindPrams(File,lv Vmi,lv Hmi) //find the built in Hmi
WriteS(NEWLINE)
ReportTypeWheel(Hmi) //report it to user
}
ifnot File>>FB.Device := "TXT"
WriteS(NEWLINE)
}
//ParsePages locates all the end-of-page markers in any input
//file and stores their locations in a vector to use as pointers
//into the file while printing each page.
//structure of POD files: initial preamble with its ^L is page 0 in
//the file. The last printing page in the file ends with ^L. The
//epilogue (shutdown sequence has no ^L).
//structure of text files: first character begins first printing page
//last character ends last printing page, no trailing ^L in file.
//function: ParsePages
//value: returns no. of printing pages found in file
//parameter 1: Pointer to file block structure for file being parsed
//parameter 2: Last page needed for this call
//parameter 4: Boolean, true=>prints stuff about file, false=>no stuff
//assumption: Transparent OFF
and ParsePages(File,TargetP,Announced) := valof
{ParsePages
if File>>FB.FileStatus ne 0 then resultis false //all found already
if File>>FB.NextPagetoFind > TargetP then resultis false //enough found
if Announced then
{ WriteS(NEWLINE)
WriteS("Preparing to print ")
ShowFileName(File>>FB.JFN)
}
let PP := File>>FB.PagePointers //copy the pointer
let Block := vec PAGEBLOCK //maximum size possible for page
let BPtr := POINT(7,Block) //byte pointer to it
if (File>>FB.NextPagetoFind = 0)&Eqstr(File>>FB.Device,"TXT") then
{ File>>FB.NextPagetoFind := 1 //get set for plain ASCII files
PP|0 := 0 //dummy page 0 with length 0
if TargetP = 0 then resultis false //nothing to look for
}
test File>>FB.NextPagetoFind = 0 //make sure pointer is valid
ifso SetFilePointer(File>>FB.JFN,0) //before parsing
ifnot SetFilePointer(File>>FB.JFN,PP|(File>>FB.NextPagetoFind - 1))
while File>>FB.FileStatus = 0 do //EofFlg does not work with SIN
{Check //now look for each ^L in file
while TargetP ge File>>FB.NextPagetoFind do //parse until page found
{innerCheck
let InAC := vec 20
let Count := 0
let MaxSize := PAGEBLOCK * 5 //for lots of chars
InAC|1 := File>>FB.JFN //input stream
InAC|2 := BPtr //where to put the string
InAC|3 := MaxSize //biggest string possible
InAC|4 := $*f //terminate on ^L
JSYS(jsSIN,InAC) //grab a string
Count := MaxSize - InAC|3 //how many chars sinned?
if (Count = MaxSize) logand (not LDB(InAC|2) = $*f) then
{ WriteS(NEWLINE) //guard against the unlikely
WriteS("This would have been page ")
WriteN(File>>FB.NextPagetoFind)
WriteS(" but it is too long to process.")
WriteS(NEWLINE)
WriteS("PAGEBLOCK in ParsePages")
resultis false
}
if Eqstr(File>>FB.Device,"POD") then //figure out if ^L is pagemark
{ let ThirdLastChar := SP //dummy for when Count is 2
switchon Count into //assume it can't be negative
{ case 0: break Check //bogus, file must be empty
case 1: endcase //bare FF, consider it real
default: //anything else
InAC|1 := NULIO
InAC|2 := BPtr //back to beginning of str
InAC|3 := - (Count - 2) //forward except last two
JSYS(jsSOUT,InAC) //bleep over most
let NewBPtr := InAC|2 //new temp pointer
unless Count = 2 do
ThirdLastChar := LDB(NewBPtr) //examine context of 3rd last
let SecondLastChar := ILDB(lv NewBPtr) //and 2nd last chars
if (ThirdLastChar = ESC) logand //to determine if ^L is just an
InDoubleCommandSet(SecondLastChar) then loop innerCheck //arg or a
if not InDoubleCommandSet(ThirdLastChar) logand //real page break
(SecondLastChar = ESC) then loop innerCheck
}
}
InAC|1 := 0,,File>>FB.JFN //a real one
JSYS(jsGTSTS,InAC) //check for eof
File>>FB.FileStatus := (InAC|2) & (#001000,,0) //should be nonzero at end
if (File>>FB.FileStatus ne 0) logand Eqstr(File>>FB.Device,"POD")
then break Check //don't count epilog page for POD
PP|(File>>FB.NextPagetoFind) := ReadFilePointer(File>>FB.JFN)
//save position following each ^L
File>>FB.NextPagetoFind := File>>FB.NextPagetoFind + 1 //incr
if (File>>FB.FileStatus ne 0) then break Check //for TXT, save position
}innerCheck
resultis false //found enough pages before EOF
}Check
/* if Announced then
{ WriteS(NEWLINE)
WriteN(PageCount)
test PageCount > 1
ifnot WriteS(" page found in ")
ifso WriteS(" pages found in ")
ShowFileName(File>>FB.JFN)
}
*/
File>>FB.PageCount := File>>FB.NextPagetoFind - 1 //real count found
File>>FB.FileStatus := -1 //parsing done
resultis true
}ParsePages
/* FindPrams is a procedure for determining the default Hmi from the
actual file. This is harder than it sounds. An initial approach just
read a bunch of characters from the file and then scanned through
looking for the first HMI setting command sequence that was immediately
followed by a printing character (not a space). This fails in certain
pathological POD files where another the HMI sequence is followed only
by space or by some other ESC sequence and never by a printing
character. Sounds impossible but a user did it. (Much more likely with
the old Scribe actually.) Gets #13 for Elite and #15 for Pica.
Assumption: Transparent OFF, POD file input
*/
and FindPrams(File,lvVmi,lvHmi) be
{FindPrams
let JunkStr := vec 100 //place to put some characters
let AC := vec 16
let EPtr := nil //some byte pointers
SetFilePointer(File>>FB.JFN,File>>FB.PagePointers|0) //at first real page
{Try
let BPtr := POINT(7,JunkStr) //need this for travelling along
AC|1 := File>>FB.JFN //file to get from, trust current ptr
AC|2 := BPtr //pointer to junk area
AC|3 := - 500 //500 characters is more than enough?
JSYS(jsSIN,AC) //grab the string
EPtr := AC|2 //end of the junk string
if AC|3 = -500 then //nothing read, at end of file
{ rv lvHmi := 13 //assign it one or the other
break Try //give up
}
while EPtr ne BPtr do //look for first real ESC HMI
{ switchon ILDB(lv BPtr) into //check character from string
{ case $*s: endcase //don't trust spaces to be using good Hmi
case $*$: //serious case, the altmode
switchon ILDB(lv BPtr) into //interpret its command char
{ case $0 to $9: endcase //tossing single char seqs
case $A: case $B: case $D: case $U: endcase
case #11: case #13: case #36: //double command set
ILDB(lv BPtr) //just toss its arg
endcase
case #37: //AHA! found one, sets the Hmi
rv lvHmi := ILDB(lv BPtr) //take it literally
default: endcase //some kind of error, no-op
}
endcase //end the ESC case
case $! to $~:
if (rv lvHmi = 11) logor (rv lvHmi =13)
then break Try //Hmi in force now is default
endcase //keep looking unless valid overall Hmi
default: endcase //most nonprinting chars
} //end the main switchon
} //end the while loop
}Try repeatuntil (rv lvHmi=11) logor (rv lvHmi=13)
//in case perverse file
rv lvVmi := 9 //default vertical is single-spaced
}FindPrams
//GetCommand parses user commands, knows defaults and sets up
//parameters for each set of pages. Then it gets things going because
//"begin processing" is one of the commands.
//GetCommand returns a value to main program indicating whether
//to stop altogether (QUIT) or start again for a new file (STARTOVER)
//assumption: Transparent OFF, turns it ON and OFF again before returning.
and GetCommand(File,HelpFile) := valof
{ let CommandMessage := "Commands are B, C, D, E, F, L, N, P, R, S, W, X, and ?"
//these are the default settings:
static
{ Page1 := 1 //low page limit for printing
PageN := MAXNOPAGES + 1 //high page limit for printing
CurrentPage := nil //start out at the beginning
Direction := FORWARDS //it prints in forwards order
}
let Char := nil
let PromptFlag := ON
ControlCReturn := CommandModeLabel //now route ^C in here
ControlCStackPtr := Level()
Page1 := 1 //default for any new file
test File>>FB.PageCount = 0 //0 if file has not been parsed
ifso PageN := MAXNOPAGES + 1 //high page limit for printing
ifnot PageN := File>>FB.PageCount //upper limit has been found
CurrentPage := Page1 //start out at the beginning
PaperLength := DefaultPaperLength //reset for each file
WriteS(NEWLINE)
WriteS(CommandMessage)
Transparent(ON) //all routines now expect it on
while true do
{ CommandModeLabel: //continuing after ^C picks up here
test PromptFlag //if message is appropriate
ifso
{ WriteS(NEWLINE) //print it
WriteS("Enter command: ")
}
ifnot PromptFlag := ON //owise, turn flag back on
Char := PBIN() & #177 //mask necessary in image mode
switchon Char into
{ case $a:
case $A: WriteS("Auto paper feeder expected. OK")
PaperLength := PaperLength + 6
endcase
case $b:
case $B:
{ WriteS("Begin processing.")
WriteS(NEWLINE)
WriteS(NEWLINE)
WriteS("Position paper and press ")
WriteS(NEXTPAGEKEY)
//make sure page length is right
if PaperLength ne DefaultPaperLength then
{ PBOUT(ESC)
PBOUT(PAGEMARK)
PBOUT(PaperLength)
}
test Eqstr(File>>FB.Device,"POD") //different initializing needed
ifso SendPage(File>>FB.JFN,File>>FB.PagePointers,0,EJECT)
ifnot InitDiablo(EJECT) //Initialize for ASCII file
switchon Direction into
{ case BACKWARDS:
CurrentPage := PageHandler(File,PageN,Page1,EJECT,TransferType)
endcase
case FORWARDS:
CurrentPage := PageHandler(File,Page1,PageN,EJECT,TransferType)
endcase
default:
ResetPrams(Vmi,Hmi)
WriteS(NEWLINE)
WriteS("Ooops, something wrong with defaults")
endcase
}
if (Page1 = MAXNOPAGES + 1) logand (File>>FB.FileStatus ne 0)
then Page1 := File>>FB.PageCount //adjust Page1 if possible/nec
if (PageN = MAXNOPAGES + 1) logand (File>>FB.FileStatus ne 0)
then PageN := File>>FB.PageCount //fix PageN if possible/nec
ResetPrams(Vmi,Hmi) //necessary?
}
endcase
case $c:
case $C: WriteS("Continuous paper feeding, no wait, OK")
TransferType := CONTINUOUS
endcase
case $d:
case $D: WriteS("Done. Stopping program...")
// case CTRLC: //bogus. We can't see this as input anyhow
ResetPrams(Vmi,Hmi)
Transparent(OFF)
resultis QUIT
case $e:
case $E:
WriteS("ETX/ACK protocol being enabled.")
Transparent(OFF) //needs this for confirm routine
if YNConfirm() then //make them confirm this, no command to reverse
{ CTRLC := $^C
ETXACKProtocol := true
}
Transparent(ON)
endcase
case $f:
case $F:
WriteS("Finished with ")
ShowFileName(File>>FB.JFN)
WriteS(" Requesting new file.")
Transparent(OFF) //so the confirmation will work
test YNConfirm()
ifso
{ Page1 := 1 //reset defaults
CurrentPage := Page1
PageN := MAXNOPAGES + 1
Transparent(OFF)
resultis STARTOVER
}
ifnot
{ WriteS(NEWLINE)
WriteS("Staying with ")
ShowFileName(File>>FB.JFN)
}
Transparent(ON)
endcase
case $l: //setting physical paper length
case $L:
Transparent(OFF) //let someone else echo
WriteS("Length of paper (in inches) = ")
PaperLength := ReadPaperLength(INPUT)
Transparent(ON)
endcase
case $n:
case $N: WriteS("Normal page order, OK")
Direction := FORWARDS
CurrentPage := Page1
endcase
case $p: //real problems come from not knowing what
case $P: //the max page count is before starting
{ WriteS("Page range (? for options): ")
Transparent(OFF) //just makes it easy
let NextChar := PBIN()
switchon NextChar into
{ case $?:
test HelpFile>>FB.JFN=0
ifso
{ WriteS(NEWLINE)
WriteS(HELPFILENAME)
WriteS(" is not available.")
}
ifnot
{ WriteS(NEWLINE)
WriteS("Make sure you have half a sheet of paper")
WriteS(NEWLINE)
WriteS("Then press ")
WriteS(NEXTPAGEKEY)
Transparent(ON)
SendPage(HelpFile>>FB.JFN,HelpFile>>FB.PagePointers,0,NOEJECT)
PageHandler(HelpFile,2,2,NOEJECT,CONTINUOUS)
ResetPrams(Vmi,Hmi)
}
Transparent(OFF) //for collecting more input easily
WriteS(NEWLINE)
WriteS("Enter page options: ")
PBIN() //read a char
//now, default case applies, fall through
default: //Parse a string here
{ let InString := vec 5 and AllFlag := false
ChangeFilePointer(INPUT,-1) //want to reread a char
//GetString initializes string length
let EndChar := GetString(INPUT,InString)
if InString>>String.C^1 = ALLPAGES then
{ InString>>String.C^1 := $1
AllFlag := true
}
Page1 := EvalString(InString,((File>>FB.FileStatus=0)=>
MAXNOPAGES+1,File>>FB.PageCount),
CurrentPage,Direction)
test EndChar = COLON //is more coming?
ifso //find 2nd number in range
{ EndChar := GetString(INPUT,InString)
PageN := EvalString(InString,((File>>FB.FileStatus=0)=>
MAXNOPAGES+1,File>>FB.PageCount),
CurrentPage,Direction)
}
ifnot //only one number found
test AllFlag = true
ifso PageN := ((File>>FB.FileStatus=0)=>MAXNOPAGES+1,
File>>FB.PageCount)
ifnot PageN := Page1
if Page1 > PageN then
{ let N := Page1; Page1 := PageN; PageN := N
} //make sure they are in ascending order
test Direction = FORWARDS
ifso CurrentPage := Page1
ifnot CurrentPage := PageN
}
endcase
}
}
Transparent(ON) //resume full control
endcase
case $r:
case $R: WriteS("Reverse page order, OK")
Direction := BACKWARDS
CurrentPage := PageN
endcase
case $s:
case $S: WriteS("Show current set-up")
WriteS(NEWLINE)
switchon Direction into
{ case FORWARDS: WriteS("Printing ")
ShowFileName(File>>FB.JFN)
WriteS(" from page ")
ShowPageNumber(File,Page1)
WriteS(" to page ")
ShowPageNumber(File,PageN)
endcase
case BACKWARDS: WriteS("Printing ")
ShowFileName(File>>FB.JFN)
WriteS(" from page ")
ShowPageNumber(File,PageN)
WriteS(" to page ")
ShowPageNumber(File,Page1)
endcase
default: WriteS("Problem: Direction for page needs")
WriteS(" be either Normal or Reverse but is undefined")
endcase
}
WriteS(" on ")
WriteN(PaperLength/6)
if PaperLength rem 6 > 0 then //worry about fraction
{ WriteS(".") //not perfect, but...
WriteN(((PaperLength rem 6)*10)/6)
}
WriteS(" inch long paper")
ReportTypeWheel(Hmi)
WriteS(NEWLINE)
WriteS("The current page is page ")
ShowPageNumber(File,CurrentPage)
WriteS(" in the file.")
WriteS(NEWLINE)
WriteS("Printing will ")
switchon TransferType into
{ case CONTINUOUS: WriteS("be continuous with no wait between pages")
endcase
case PAGEPAUSE: WriteS("wait between pages")
endcase
default: WriteS("fail because the printing type has to be either Continuous or Wait but is undefined")
endcase
}
endcase
case $w:
case $W: WriteS("Wait between pages, OK")
WriteS(NEWLINE)
TransferType := PAGEPAUSE
endcase
case $x:
case $X: //This stupid terminal has a small buffer
WriteS("Xerox 1700 terminal (using smaller buffer)")
WriteS(NEWLINE)
BUFFERMAX := 79
endcase
case $?:
test HelpFile>>FB.JFN=0
ifso
{ WriteS(NEWLINE)
WriteS(HELPFILENAME)
WriteS(" is not available.")
}
ifnot
{ WriteS(NEWLINE)
WriteS("Make sure you have half a sheet of paper.")
WriteS(NEWLINE)
WriteS("Then press ")
WriteS(NEXTPAGEKEY)
SendPage(HelpFile>>FB.JFN,HelpFile>>FB.PagePointers,0,NOEJECT)
PageHandler(HelpFile,1,1,NOEJECT,CONTINUOUS)
ResetPrams(Vmi,Hmi)
WriteS(NEWLINE)
}
endcase
case LF: //ignore trailing LF
case CR: //or CR
case CTRLF: //ignore stray synchs
PromptFlag := OFF //don't bug user with irrelevance
endcase
default:
WriteS(NEWLINE)
PBOUT(BEL)
WriteS("No meaning for that character: ")
test Char > 32
ifso PBOUT(Char)
ifnot
{ WriteS("#")
WriteOct(Char)
}
WriteS(NEWLINE)
WriteS(CommandMessage)
endcase
}
}
}
//ShowPageNumber figures out what to display as a page number.
//Problem arises because you don't know the page number when you first
//start but you want to start showing it as soon as you know it. Also,
//when you don't know it, you want to show something that means "last
//page" (i.e. the user command for last page, which is a character in
//manifest FINALPAGE).
//parameter 1: file block pointer
//parameter 2: candidate page number (to be checked in case something
//better is available!)
and ShowPageNumber(File,P) be
{showpagenumber
test P=MAXNOPAGES+1 //just the flag for "maximum"
ifso test File>>FB.FileStatus=0 //if the file is all parsed
ifso PBOUT(FINALPAGE) //no, show the character meaning "last"
ifnot WriteN(File>>FB.PageCount) //yes, show the real limit
ifnot WriteN(P) //some number other than maximum
}showpagenumber
//ResetPrams sets the Diablo to revert to normal printing
//parameters.
//Pages from POD files have been designed to print standalone, so
//it is safe to reset the parameters any time you need a message
//to the terminal.
//assumption: Transparent ON, leave it on
and ResetPrams(Vert,Horiz) be
{ let ResetList := list ESC, #11, #13, //Tab to left margin
ESC, #36, nil, //esc seq for Vmi
ESC, #37, nil //esc seq for Hmi
let ResetLength := 9
ResetList|5 := Vert //Vert must be (req'd Vmi + 1)
ResetList|8 := Horiz //Horiz must be (req'd Hmi + 1)
for I := 0 to ResetLength - 1 do PBOUT(ResetList|I)
}
and ReportTypeWheel(Hmi) be
{ReportTypeWheel
WriteS(NEWLINE)
switchon Hmi into
{ case #13: WriteS("12 pitch ");endcase
case #15: WriteS("10 pitch ");endcase
default: WriteS("Unknown kind of ");endcase
}
WriteS("typewheel expected for this file")
}ReportTypeWheel
//ShutDown send out the codes to restore the printer to its
//default settings of single-spaced, 10 pitch, 11-inch paper and
//restores terminal JFN mode word and paging behavior.
//assumption: Transparent OFF
and ShutDown(InFileChan,HelpFileChan) be
{ let ResetTable := table ESC,#11,1,ESC,#36,#11,ESC,#37,
CR,ESC,$9,CR,LF,ESC,PAGEMARK,72
and ResetLength := 16
EndRead(InFileChan) //close the files
EndRead(HelpFileChan)
Transparent(ON)
for I := 0 to ResetLength - 1 do PBOUT(ResetTable|I)
Transparent(OFF)
WriteS(NEWLINE)
WriteS("EXIT")
WriteS(NEWLINE)
SuppressMessages(false)
unless DefaultJFNModeWord=0 do //if there is one, then restore stuff
{ unless IS10X() do //unless this is TENEX, in which case, punt
{ let AC := vec 20
AC|1 := OUTPUT
AC|2 := DefaultJFNModeWord
JSYS(jsSTPAR,AC) //restore original pause-on-command
AC|2 := #43 //.MOXOF code
AC|3 := 1 //enable pause-at-end-of-page
JSYS(jsMTOPR,AC)
}
CTRLC := $^C //reset this stuff in case continued
ETXACKProtocol := false //with tty in different mode (not likely)
}
ControlCReturn:=0 //"reset" interrupts in case continued
}
and InitFB(BlockName) be
{ BlockName>>FB.FileStatus := 0
BlockName>>FB.NextPagetoFind := 0
BlockName>>FB.PageCount := 0
BlockName>>FB.Device := ""
}
/* CTRLC: an interrupt service routine for Control-C.
*/
and CTRLCService(level,channel,lvpc) be
{ if ControlCReturn=0 then //not into critical part yet
{ finish //do ordinary halt
return //and ordinary continue
}
Transparent(ON) //critical, terminal could have been hacked
ResetPrams(Vmi,Hmi) //make the terminal act normal regardless
Transparent(OFF)
ClearOutput() //clean out any pending output
WriteS(NEWLINE) //fresh line
finish //halt
ClearInput() //be sure no type ahead
Transparent(ON) //now, if started again
LongDebrk(lvpc,ControlCReturn,ControlCStackPtr) //go somewhere sensible
}
/* An interrupt service routine for C-O. Nothing fancy here. In order to
avoid learning anything, we are just stuffing the input buffer with the
character that we want to alias C-O to.
*/
and CTRLOService(level,channel,lvpc) be //args can be ignored
{ let ACs := vec 16
ClearOutput() //flush output right away
ACs|1 := INPUT
ACs|2 := CTRLX
JSYS(jsSTI,ACs) //stuff input buffer with CTRLX
return
}
//[BBNA]<JWALKER>PAGE.BCP.73, 13-Feb-82 15:42:45, Ed: JWALKER
//revised to clear terminal output buffer on abort
//Copyright (C) 1979 Bolt Beranek and Newman Inc.
get "bufhead"
//function: PageHandler
//parameter 1: file block structure for file being printed
//parameter 2: first page to print
//parameter 3: last page to print
//parameter 4: Boolean, true ==> eject the page, false ==> no page eject
//parameter 5: Transfer dynamics, CONTINUOUS or PAGEPAUSE
//value: last completed (or current if interrupted) page number
//assumptions: Transparent ON
//Some thrashing in this routine, due to the fact that either Page1 or
//PageN (or both) can be in essence a flag meaning "maximum". The number has
//to be anchored to reality eventually -- i.e. as soon as the real number is
//available from the parsing.
let PageHandler(File,Page1,PageN,BlockPage,Type) := valof
{pagehandler
let Increment := FORWARDS //default direction
let IsSameType := (Type=TransferType) //record if using default type
PageFlag := ON //make it always stop for first page
test PageN > Page1 //figure out the direction
ifso Increment := FORWARDS //definitely forward printing
ifnot //just one page or backward printing
{ if ((PageN < Page1) logor ((Page1=PageN) logand (Page1=MAXNOPAGES+1)))
then //allow for "just last page" case
{ Increment := BACKWARDS
if File>>FB.FileStatus = 0 then //parsing is not complete
{ if ParsePages(File,Page1,OFF) //returns boolean, true if all done
//backwards anyhow so go find enough pages
then
{ Page1 := File>>FB.PageCount //set real limit
if PageN = MAXNOPAGES+1 then PageN := File>>FB.PageCount
}
}
}
}
let ThisPage := Page1
let FirstTimeThrough := true
//start of a repeatuntil. Send N pages but need to do the "flow control" N+1
//times. Leads to nasty loop structure.
{pageloop
//When SendPage fails, the user wants to get to command mode
unless FirstTimeThrough do //just do flow control first time
{ if ParsePages(File,ThisPage,OFF) //make sure page is known
then if Increment = FORWARDS //we've just completed parsing
then
{ PageN := File>>FB.PageCount //so get the upper limit right
if Eqstr(File>>FB.Device,"POD") then break //last time through
} //just for parsing when doing POD file
if Increment=FORWARDS //what if bogus number?
then if ThisPage>PageN then break pageloop //make it stop
if SendPage(File>>FB.JFN,File>>FB.PagePointers, //send the page
ThisPage,BlockPage) = CTRLX //return CTRLX when aborted
then resultis ThisPage //return page no being printed
ThisPage := ThisPage + Increment //increment only after printing
}
FirstTimeThrough := false //redundant flag fixing
if IsSameType ne (Type = TransferType) then //TransferType is global
{ Type := TransferType //if different, user has changed the type
IsSameType := (Type = TransferType)
}
if (Type = PAGEPAUSE) logor (PageFlag = ON) then //whether to wait
{ PageFlag := OFF //not first page anymore, flag goes off
switchon EvalCommand() into //go wait for user input
{ case NEXTPAGE: endcase //just go do ThisPage
case SAMEPAGE: unless ThisPage=Page1 //redo the previous page
do ThisPage := ThisPage - Increment //adjust page number
endcase //and do
case QUIT: resultis ThisPage - Increment //last completed page
default: WriteS(NEWLINE)
ResetPrams(Vmi,Hmi)
WriteS("Something wrong with result from EvalCommand")
Transparent(ON)
loop
}
}
}pageloop repeatuntil ThisPage = PageN + Increment
resultis PageN //return last completed page
}pagehandler
//SendPage figures out the limits on a page and hands
//the limits on to the SendIt procedure for buffering
//procedure: SendPage
//parameter 1: JFN for file being printed
//parameter 2: vector of pointers for locations of beginnings of pages
//parameter 3: Page number to print (page 0 is for terminal init)
//parameter 4: Boolean, true=>eject page; false=> no page eject
//value: returns CTRLX when it finds user wants to go back to
// command mode; otherwise, true when page completes
//assumptions: Transparent ON
//
//StartPointer has to point to the first character to read.
//Note: The pointers in the vector all point to the first character on
//a page, so to get the count, remember to reduce difference by 1 to
//allow for the ^L separating pages.
and SendPage(InFileChan,PagePointers,PageNumber,BlockPage) := valof
{ let StartPointer := nil
let PCount := nil //no of chars on the page
//Assume that the page number limits have previously been checked
//for validity
test PageNumber = 0
ifso StartPointer := 0 //page 0 has the initialization stuff
ifnot StartPointer := PagePointers|(PageNumber - 1)
PCount := PagePointers|PageNumber - StartPointer - 1 //inhibit pagemark
while true do
{ let Result := SendIt(InFileChan,StartPointer,PCount)
test Result = true
ifso
{ if BlockPage = EJECT then BreakPage() //send out pagebreak if OK
ClearInput() //throw away extra synchs now
resultis true //page completed printing
}
ifnot
{ ClearOutput() //keep tty from getting stuff buffered in host
PBOUT(CR) //put print head in rational place
test Result = CTRLX
ifso //user aborted to command level
{ ClearInput() //make sure no synchs around
resultis CTRLX //go back
}
ifnot
{ BreakPage()
switchon EvalCommand() into //page aborted to between-page
{ case SAMEPAGE: //go print it again
loop
case NEXTPAGE: //return to sender, it evaluates command again
case QUIT:
ChangeFilePointer(INPUT,-1) //backup input pointer
resultis true
default:
WriteS(NEWLINE)
WriteS("Invalid result from EvalCommand")
resultis false
}
}
}
}
}
//SendIt is the procedure that manages the buffering and
//synch stuff, given the JFN and the pointer limits
//function: SendIt
//parameter 1: JFN of file being printed
//parameter 2: location of first character in file to print
//parameter 3: count of number characters in the block to print
//value: true when page prints to completion; false when user interrupts it;
// CTRLX when user wants to return to command mode
//assumption: Transparent ON
and SendIt(InFileChan,StartPointer,CharsLeft) := valof
{SendIt
if CharsLeft = 0 then resultis true //don't sweat empty page
if CharsLeft > PAGEBLOCK * 5 then //might happen?
{ WriteS(NEWLINE)
WriteS("This page is too long to be printed.")
WriteS(NEWLINE)
WriteS("See PAGEBLOCK in SendIt")
ClearInput()
resultis CTRLX
}
let FirstTimeThrough := true //flag for starting a page
let PageArea := vec PAGEBLOCK //get space for this page
let BCount := nil //initialize buffer count
let BPtr := POINT(7,PageArea) //travelling byte pointer
let InAC := vec 20
SetFilePointer(InFileChan,StartPointer) //get file set to roll
InAC|1 := InFileChan //source dest to read from
InAC|2 := BPtr //pointer to the dest area
InAC|3 := - CharsLeft //no of chars to read
JSYS(jsSIN,InAC) //grab it
InAC|1 := CTRLC
JSYS(jsPBOUT,InAC) //synch char primes the pump
{sendloop
let Target := CharsLeft > BUFFERMAX => BUFFERMAX,CharsLeft //how many
BCount := FillBuffer(BPtr,Target) //get another buffer ready
CharsLeft := CharsLeft - BCount //update the countdown
unless FirstTimeThrough do //don't wait, just send first buffer
switchon WaitForDone() into //check for a return synch
{ case true: endcase //OK, ready for more
case QUIT: resultis false //indicates that page was aborted
case CTRLX: resultis CTRLX //indicates return to command mode
}
BPtr := SendBuffer(BPtr,BCount) //send out last buffer found,
//returning start for next buffer
test CharsLeft = 0 //was that the last one?
ifso break //yes, bail out
ifnot PBOUT(CTRLC) //no, follow sending with synch
FirstTimeThrough := false //not first time anymore
}sendloop repeat
switchon WaitForDone() into //soak up the final synch
{ case true: resultis true //page completed normally
case QUIT: resultis false //indicates that page was aborted
case CTRLX: resultis CTRLX //indicates return to command mode
}
}SendIt
//function: EvalCommand
//value: NEXTPAGE, SAMEPAGE, or QUIT
//parameter: None
//operation: collect user commands when printing is "between pages"
//assumption: Transparent ON
and EvalCommand() := valof
{ let Mask := #177 and NextChar := nil
while true do
{ NextChar := PBIN() & Mask
switchon NextChar into
{ case $q:
case QUIT:
resultis QUIT //abort page, return to command mode
case $c:
case $C: TransferType := CONTINUOUS;loop //switch trans. type
case $w:
case $W: TransferType := PAGEPAUSE;loop //switch trans. type
case SAMEPAGE: resultis SAMEPAGE //repeat same page
case NEXTPAGE: resultis NEXTPAGE
case CTRLF: loop //ignore any stray synchs
endcase
default: ResetPrams(Vmi,Hmi)
WriteS(NEWLINE)
WriteS("That command character has no meaning between pages: ")
PBOUT(NextChar)
Transparent(ON)
endcase
}
}
}
//procedure: BreakPage
//no parameters
//operation: perform page eject
// Has to reset Vmi to standard so that Xerox 1750 operates right
//assumption: Transparent ON
and BreakPage() be
{ WriteS(StandardVmiSequence) //needed to defeat 1750 bug
PBOUT(CR) //isolate us from dumb Scribe driver
PBOUT(PAGEMARK)
}
//[BBNA]<JWALKER>BUF.BCP.78, 13-Feb-82 15:41:48, Ed: JWALKER
//WaitForDone revised again to handle spurious input quietly
// Copyright (C) 1979 Bolt Beranek and Newman Inc.
//
// This set of procedures controls buffered output for Diablo
// printers.
get "bufhead"
//FillBuffer is a function. It requires a byte pointer to start reading
//at and the maximum number of characters to read. We need this
//function to keep us from chopping an escape sequence in pieces by just
//blindly doing a SOUT with some fixed byte count. It returns the
//number of bytes that the next transfer ought to send.
//assumptions: Transparent ON
let FillBuffer(BPtr,TargetCount) := valof
{ if TargetCount < BUFFERMAX then resultis TargetCount //last one
let InAC := vec 20
InAC|1 := NULIO //just blow past some
InAC|2 := BPtr //a trick
InAC|3 := TargetCount - 2 //for getting near the end
InAC|4 := 0
JSYS(jsSOUT,InAC) //blip over a bunch of bytes
BPtr := InAC|2 //now, use where we are
let ThirdLastChar := LDB(BPtr) //find char we are on
let SecondLastChar := ILDB(lv BPtr) //get next char
let LastChar := ILDB(lv BPtr) //and finally last candidate
test InDoubleCommandSet(LastChar) logand (SecondLastChar=ESC) //check
ifso resultis TargetCount - 2 //use two less than max possible
ifnot if (LastChar=ESC) then //possible trouble
unless (ThirdLastChar=ESC) logand //but OK if the ESC is an arg
InDoubleCommandSet(SecondLastChar)
do resultis TargetCount - 1 //use one less than max possible
resultis TargetCount //situation OK
} //FillBuffer end
//InDoubleCommandSet returns true when a character arg is one of the
//characters that can appear following ESC in a 3-character esc sequence.
//For example, ESC US 13 is a 3-character esc sequence and #37 should
//return true.
and InDoubleCommandSet(Ch) := valof
{ switchon Ch into
{ case #11: //Tab = ESC HT x
case #13: //Vtab = ESC VT x
case #36: //Vmi = ESC ^^ x
case #37: //Hmi = ESC ^_ x
resultis true
default:
resultis false
}
}
//SendBuffer is a procedure that sends a buffer load (as defined by the
//count) out to the printer, all at once. It returns the updated byte
//pointer. assumptions: Transparent ON
and SendBuffer(BPtr,BCount) := valof
{ let InAC,OutAC := vec 20,vec 20 //lay out those ACs
InAC|1 := OUTPUT //dest
InAC|2 := BPtr //byte pointer
InAC|3 := - BCount //how many bytes out
JSYS(jsSOUT,InAC,OutAC) //out they go
resultis OutAC|2 //returns updated byte pointer
}
//function: WaitForDone
//parameter: None
//value: true,QUIT,CTRLX
//operation: wait for ACK from Diablo if ETX/ACK protocol in use
//or executes when character input is available, even with XON/XOFF
//protocol, to allow for aborting a page.
//assumption: Transparent ON
and WaitForDone() := valof
{ unless (ETXACKProtocol logor IsCharInput(INPUT)) do resultis true
let CodeChar := nil
let Mask := #177 //to make sure bit 8 is off
let Result := true
while true do
{ CodeChar := PBIN() & Mask //Mask off bit 8 from input
switchon CodeChar into
{ case CTRLF: resultis Result
case CTRLD:
PageFlag := ON //return to between-page mode
resultis QUIT
case CTRLX: //return to command mode
resultis CTRLX //bailout
case CTRLP:
PageFlag := ON //pause at end of this page
test ETXACKProtocol
ifso Result := true //so, set flags
ifnot resultis true //no use going back to look for more
loop //continue proper printing
case CR: //standard error is user pressing RETURN
case LF:
loop //quietly ignore
default: //anything else could be a flow control error
PBOUT(BEL) //but is more likely user error now
loop //noisily ignore
}
}
}
//The following code used to be in the default case, for reporting
//errors in the flow control code. It no longer seems to be worth it and
//user's are seeing spurious reports due to their own impatient key pressing.
//Reinstall this though if true protocol problems are suspected.
//WriteS(NEWLINE)
//ResetPrams(Vmi,Hmi)
//PBOUT(CR)
//WriteS("? Flow control problem, received #")
//WriteOct(CodeChar)
//PBOUT(CR)
//[BBNA]<JWALKER>MISC.BCP.13, 13-Feb-82 15:40:56, Ed: JWALKER
//added RUBOUT handling to the horrid string collection routine
//Copyright (C) 1979 Bolt Beranek and Newman Inc.
//Set of procedures for manipulating terminal characteristics.
get "bufhead"
//procedure: InitDiablo
//parameter 1: Boolean, true means eject the page following printing
//operation: sets up the terminal for printing ASCII files,
// Imitates page 0 setup for POD files
//assumption: Transparent ON
let InitDiablo(BlockPage) be
{ let InitTable := table ESC,#62, //clear all tabs
ESC,#37,#15, //set Hmi to #15 => 12 (10 pitch)
ESC,#11,#1, //absolute tab to 0
ESC,#11,#6, //absolute tab to 5
ESC,#71, //set left margin
#15 //CR to left margin
for I := 0 to 13 do PBOUT(InitTable|I)
//set tab stops for plain ASCII files
//I checked this to be sure they line up with system tabs
for Column := 15 to 85 by 8 do //offset to allow for left marg at 5
{ PBOUT(ESC) //move the carriage to desired spot
PBOUT(9) //with absolute horizontal tab
PBOUT(Column+1) //to Column
PBOUT(ESC) //now set the tabstop in that spot
PBOUT($1)
}
PBOUT(CR) //retreat to left edge of page
if BlockPage = EJECT then BreakPage()
}
//GetString
//function: GetString(Where,Buffer)
//parameter 1: JFN for source of bytes
//parameter 2: pointer to BCPL string
//value: COLON if colon separator, LF if CRLF terminator
//use: Char := GetString(INPUT,StringName)
//assumption: Transparent OFF
and GetString(Where,Buffer) := valof
{ let Ptr := 1 //flag or pointer to next location to fill
let Char := nil
Buffer>>String.N := 0 //be sure string is "empty"
while true do
{ Char := BIN(Where)
switchon Char into
{ case $0 to $9: //for real digits
if Ptr > 0 then //unless string is blocked
{ addch(Char,Buffer) //add the digit
Ptr := Ptr + 1 //up counter
}
endcase
case COLON:
resultis COLON //return the terminator
case CR:
endcase //assume this is CR of CRLF terminator (ignore)
case $*n: //EOL, terminator for TENEX
case LF:
resultis LF //return the terminator
case PLUS:
case MINUS:
case EQ:
test Ptr = 1 //only if nothing is already there
ifso addch(Char,Buffer) //add the special character
ifnot PBOUT(BEL)
endcase
case FINALPAGE:
case DOTPAGE:
case ALLPAGES:
test Ptr = 1 //string still empty?
ifso
{ addch(Char,Buffer) //yup, add the car
Ptr := -1 //block anything further from this string
}
ifnot PBOUT(BEL) //only a digit is valid now
endcase
case RUBOUT:
{ let N := Buffer>>String.N
if N>0 then //if something is in the string
{ PBOUT($\) //echo it as being deleted (yukk!)
PBOUT(Buffer>>String.C^N)
PBOUT($\)
Buffer>>String.N := N-1 //shorten the string by 1
test Ptr = -1 //was it blocked?
ifso Ptr := 1 //empty now, unblock it
ifnot Ptr := Ptr - 1 //shorten it
}
endcase //end of rubout handler
}
case SP: //quietly ignore spaces
endcase
default: PBOUT(BEL)
endcase
}
}
}
//EvalString
//function: EvalString(Buffer,PageCount,CurrentPage,Increment)
//parameter 1: pointer to BCPL string
//parameter 2: no. of pages in the printing file
//parameter 3: current page in the file
//parameter 4: direction of printing
//value: pagenumber referred to by the string
//use: Page1 := EvalString(String1,PageCount,CurrentPage,Increment)
//assumption: Transparent OFF
and EvalString(Buffer,PageCount,CurrentPage,Increment) := valof
{ let Spot := -1
let Num := 0
let Len := Buffer>>String.N //no. of chars in string
for Ptr := Len to 1 by -1 do //go through string back to front
switchon Buffer>>String.C^Ptr into
{ case $0 to $9: endcase //no special action
default: Spot := Ptr //position of first nondigit
break //bail out now at look at the first nondigit
}
test Spot = -1 //Spot is still -1 unless nondigit was found
ifso Num := TxtToInt(Buffer) //string is all digits
ifnot
test Spot = Len //string was only nondigits
ifso switchon Buffer>>String.C^Len into //string has 1 spec. char.
{ case DOTPAGE: resultis CurrentPage
case FINALPAGE: resultis PageCount
default: WriteS(NEWLINE)
WriteS("Unrecognized special character in page option")
WriteS(NEWLINE)
resultis false
}
ifnot //string has leading + or - sign and digits
{ let TempString := vec 2
TempString>>String.N := 0
for I := 1 to Len - Spot do
addch(Buffer>>String.C^(Spot+I),TempString)
Num := TxtToInt(TempString)
switchon Buffer>>String.C^Spot into
{ case MINUS: Increment := -Increment //change direction
//in other respects, MINUS is treated the same as PLUS
case PLUS: Num := CurrentPage + (Num * Increment)
endcase
default: WriteS(NEWLINE)
WriteS("Can't figure out this number")
endcase
}
}
test Num < 1
ifso resultis 1 //keep number within file
ifnot test Num > PageCount
ifso resultis PageCount
ifnot resultis Num
}
//ReadPaperLength is a function for reading the paperlength and
//converting it to "lines per page" for the command that sets the paper
//length. This is probably a device dependent function.
and ReadPaperLength(Stream) := valof
{ let Buffer := vec 5 //collect characters here
Buffer>>String.N := 0 //empty it first
if numbargs < 1 then Stream := INPUT //default is from terminal
ReadWord(Stream,Buffer) //hope for some characters
unless PBIN() = LF do //fcn doesn't strip LF
{ let InACs := vec 20 //so do it the hard way
JSYS(jsBKJFN,InACs)
}
let Num := Buffer>>String.N
if Num = 0 then resultis 66 //default is "11in"
let NewBuf := vec 5 //string for copying
NewBuf>>String.N := 0 //empty it
let Place := -Num //to accum decimal places
for I := 1 to Num do //strip out garbage by copying
{ let Ch := Buffer>>String.C^I
test (Ch ge $0) logand (Ch le $9) //be sure it is a digit
ifso
{ addch(Ch,NewBuf) //add it to digit string
Place := Place +1 //for virtual decimal place
}
ifnot if Ch = $. //fractional part follows
then Place := 0 //reset decimal place count
}
let Nums := TxtToInt(NewBuf) //collect magnitude
test Place le 0 //was there a dec point?
ifso resultis Nums*6 //no, return at 6lines/inch
ifnot //yes, do fixed pt math
{ let Factor := 1
for I := 1 to Place do Factor := Factor*10 //for adjusting
resultis (3*Factor/10+Nums*6)/Factor //will round
}
}
//[BBNA]<JWALKER>LIB.BCP.18, 13-Feb-82 15:48:45, Ed: JWALKER
//Copyright (C) 1979 Bolt Beranek and Newman Inc.
//Set of procedures for manipulating things to do with
//file pointers, terminals, and JFNs.
//All completely standalone and program independent.
get "janhead"
//ReadFilePointer is a function that returns the current
//file pointer.
let ReadFilePointer(InFileChan) := valof
{ let InputACs,OutputACs := vec 16,vec 16
InputACs|1 := InFileChan
test 2 = JSYS(jsRFPTR,InputACs,OutputACs)
ifso resultis OutputACs|2
ifnot ShowError(OutputACs|1,"Error failure in RFPTR")
}
/*------------------------------------------------------------
SuppressMessages is a procedure with one boolean argument.
true -> suppress system messages
false -> allow system messages
This applies only on TOPS-20 (rel 4).
*/
and SuppressMessages(Flag) be
{ if IS10X() then return //no such feature on TENEX
let InACs,OutACs := vec 16,vec 16
InACs|1 := OUTPUT //JFN to suppress or whatever
InACs|2 := #34 //.MOSNT
InACs|3 := Flag => 1,0 //start suppressing if 1, enable if 0
JSYS(jsMTOPR,InACs,OutACs)
}
/* BackUp is a procedure for backing up any "source designator".
*/
and BackUp(Stream) be
{ let AC := vec 16
AC|1 := Stream
if JSYS(jsBKJFN,AC) ne 2 then
ShowError(AC|1,"Error failure for BKJFN in BackUp")
}
/*------------------------------------------------------------
ClearInput is a procedure for clearing the terminal input buffer.
*/
and ClearInput() be
{ let InACs := vec 16
InACs|1 := INPUT
JSYS(jsCFIBF,InACs,InACs)
}
/*------------------------------------------------------------
ClearOutput is a procedure for clearing the standard terminal output buffer.
*/
and ClearOutput() be
{ let InACs := vec 16
InACs|1 := OUTPUT
JSYS(jsCFOBF,InACs,InACs)
}
/*------------------------------------------------------------
YNConfirm is a procedure for prompting user to confirm some binary
choice. It takes a message as an argument. It accepts y, Y, LF,
RETURN, or TENEX EOL for returning "true" and n, or N for returning
"false". It requires RETURN as confirmation for either Y or N.
It should probably accept the options as arguments but that is
too hard to hack quickly in BCPL where case labels have to be constants.
Assumes Transparent Off.
*/
and YNConfirm(HMessage,Message) := valof
{ if numbargs < 1 then HMessage :=
"*c*lUse Y or RETURN for yes, N for no. Complete with RETURN."
if numbargs < 2 then Message := "[Confirm, Y or N?] "
ClearInput(INPUT)
while true do
{ WriteS(NEWLINE)
WriteS(Message)
switchon PBIN() into
{ case $*c: PBIN() //toss LF
case $*n: //TENEX
case $*l: WriteS("Y") //supply missing part of default
resultis true
case $y:
case $Y:
WriteS("es [Complete with RETURN]")
CRConfirm()
resultis true
case $n:
case $N:
WriteS("o [Complete with RETURN]")
CRConfirm()
resultis false
case $?:
WriteS(HMessage)
loop
default:
loop
}
}
}
/*CRConfirm is a procedure for requiring the user to press RETURN at a
certain point in an interaction. It is not the same as YNConfirm (which
requires Y or N followed by RETURN). It accepts no substitutes... Some
day one should add a facility for aborting out of something like this
with error throws.
Assumes Transparent Off
*/
and CRConfirm() := valof
{CRConfirm
while true do
{ switchon PBIN() into
{ case $*c: PBIN()
case $*l:
case $*n:
resultis true
default:
WriteS(" Press RETURN to continue")
loop
}
}
}CRConfirm
//ChangeFilePointer is a procedure that takes the JFN and a
//relative increment (decrement) and changes the file pointer.
and ChangeFilePointer(InFileChan,RelativeChange) be
{ test RelativeChange = 0
ifso return
ifnot test RelativeChange < 0
ifso
{ let InputACs,OutputACs := vec 16,vec 16
InputACs|1 := InFileChan
for I := 1 to -RelativeChange //back up N times
do
{ if 2 ne JSYS(jsBKJFN,InputACs,OutputACs)
then ShowError(OutputACs|1,"Error failure for BKJFN")
}
}
ifnot SetFilePointer(InFileChan,RelativeChange + ReadFilePointer(InFileChan))
}
//SetFilePointer takes a JFN and an absolute file pointer.
//It sets the file pointer to the supplied value.
and SetFilePointer(InFileChan,NewValue) be
{ let InputACs,OutputACs := vec 16,vec 16
InputACs|1 := InFileChan
InputACs|2 := NewValue
if 1 = JSYS(jsSFPTR,InputACs) //failure case
then ShowError(OutputACs|1,"Error failure for SFPTR")
}
//function: FindInputFile(FileTypeDefault,Message)
//parameter 1: FileTypeDefault is ASCIZ string with default file type
//parameter 2: string containing prompt string to go on users terminal
//value: JFN
//assumption: Transparent OFF
and FindInputFile(FileTypeDefault,Message) := valof
{ manifest
{ NORMALINPUT := #100000000000
}
while true do
{ let OutputACs := vec 16
let InputACs := table 0,0,0,0,0,0,0,0,0,0,0
let ArgTable := table NORMALINPUT,0,0,0,0,0,0,0,0
rh InputACs|1 := ArgTable //pointer to table goes in rh AC1
lh ArgTable|1 := INPUT //file name coming from user terminal
rh ArgTable|1 := OUTPUT //for recognition output
ArgTable|5 := FileTypeDefault
WriteS(NEWLINE)
WriteS(Message)
test 2 = JSYS(jsGTJFN,InputACs,OutputACs)
ifso resultis rhz OutputACs|1
ifnot ShowError(OutputACs|1,"Problem finding error string for GTJFN")
} //keeps going until it gets a file JFN
}
//procedure: ShowFileName
//parameter 1: JFN
//Finds the name associated with the JFN and shows it on
//primary output device
//uses JFNS JSYS
and ShowFileName(FileJFN) be
{ let OutputACs := vec 16
let InputACs := vec 16
InputACs|1 := OUTPUT //destination designator
InputACs|2 := FileJFN //"indexable file handle or pointer to string"
InputACs|3 := 0
InputACs|4 := 0
JSYS(jsJFNS,InputACs,OutputACs)
}
//procedure: FindNameField
//parameter 1: JFN for file
//parameter 2: Destination designator (OUTPUT or ASCIZ pointer)
//parameter 3: Field (0 to 6) for dev,dir,nam,typ,gen,pro,acc fields
//operation: feeds correct values to JFNS JSYS
and FindNameField(FileJFN,Dest,Field) be
{ let InputACs,OutputACs := vec 16,vec 16
InputACs|1 := Dest //This has to look like an ASCIZ string pointer
InputACs|2 := FileJFN
InputACs|3 := 0
InputACs|4 := 0
if Field ge 0 logand Field le 6
then InputACs|3<<OctWord.Byte^Field := 1 //indicate which field to get
JSYS(jsJFNS,InputACs,OutputACs)
}
//procedure: OpenFile(Kind,FileJFN)
//parameter 1: Kind of access needed to file, input or output
// (expects value of manifest IN or OUT)
//parameter 2: JFN for the file
//operation: opens the requested file
and OpenFile(Kind,FileJFN) be
{ let InputACs,OutputACs := vec 16,vec 16
lh InputACs|1 := 0
rh InputACs|1 := FileJFN
lh InputACs|2 := #070000 //byte size 7 for byte I/O
switchon Kind into
{ case IN: rh InputACs|2 := #201000 //read access
endcase
case OUT: rh InputACs|2 := #101000 //write access
endcase
default: WriteS(NEWLINE)
WriteS("Unknown file access type requested")
return
}
if 2 ne JSYS(jsOPENF,InputACs,OutputACs)
then ShowError(OutputACs|1,"Error failure for OPENF")
}
//procedure: ShowError(Code,Message)
//parameter 1: Error code returned in ACx by a JSYS call
//parameter 2: The message to print out if the attempt to print out
// an error message fails
//Uses ERSTR JSYS
and ShowError(Code,Message) be
{ let InputACs := vec 16
let OutputACs := vec 16
WriteS(NEWLINE)
InputACs|1 := OUTPUT
lh InputACs|2 := #400000 //current process handle
rh InputACs|2 := Code
lh InputACs|3 := 0
rh InputACs|3 := 0
InputACs|4 := 0
if 3 ne JSYS(jsERSTR,InputACs,OutputACs)
then WriteS(Message)
}
//procedure: ShowBits
//parameter 1: The value of the word being examined
//operation: Shows values of bits in the word in octal grouping
and ShowBits(StatWord) be
{ WriteS(NEWLINE)
for I := 0 to 33 by 3 do
{ for J := 0 to 2 do
WriteN(StatWord<<BinWord.Bit^(I+J))
PBOUT($*s)
}
}
//function: SetBit
//parameter 1: Pointer to the word being changed
//parameter 2: Which bit is being changed (0 to 35)
//parameter 3: Boolean (ON => set; OFF => clear)
and SetBit(lvStatWord,Which,Value) := valof
{ if Which ge 0 logand Which le 35 then
{ if Value = ON then lvStatWord>>BinWord.Bit^Which := 1
if Value = OFF then lvStatWord>>BinWord.Bit^Which := 0
resultis true
}
resultis false
}
//function: Transparent
//parameter 1: Boolean, true ==> make terminal binary mode (transp on),
// false ==> make terminal echo normal ASCII mode.
//value: true when it succeeds, false when it fails.
//operation: first time through, it stores the terminal mode word.
// After that, it looks at the current status (on or off) and
// changes the status when necessary.
and Transparent(BoolVal) := valof
{ let InputACs,OutputACs := vec 16,vec 16
let TranspMask,EchoMask := #777777777477,#000000000100
InputACs|1 := INPUT //applies to primary terminal
static
{ TerminalModeWord := 0
TermStatus := nil
}
if TerminalModeWord = 0 //is this first time through?
then
{ test 1 = JSYS(jsRFMOD,InputACs,OutputACs) //look at mode word
ifso TerminalModeWord := OutputACs|2 //save mode word
ifnot
{ WriteS(NEWLINE)
WriteS("Problem reading mode word")
resultis false
}
}
test TermStatus = BoolVal //does it need changing?
ifso resultis true //no change necessary
ifnot
{ switchon BoolVal into
{ case true: TerminalModeWord := TerminalModeWord & TranspMask
endcase
case false: TerminalModeWord := TerminalModeWord \ EchoMask
endcase
default: WriteS(NEWLINE)
WriteS("Argument must be Boolean");resultis false
}
InputACs|2 := TerminalModeWord
if 1 ne JSYS(jsSFMOD,InputACs)
then { WriteS(NEWLINE)
WriteS("Problem setting mode word")
resultis false
}
TermStatus := BoolVal
resultis true
}
}