1
0
mirror of https://github.com/PDP-10/its.git synced 2026-02-24 16:17:26 +00:00
Files
PDP-10.its/src/sysen2/xgpspl.197
2018-05-28 12:22:28 +01:00

3931 lines
96 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;-*-MIDAS-*-
title XGPSPL XGP unspooler
subttl Definitions, etc...
a=1
b=2
c=3
d=4
e=5
t=6 ;super temporaries, not prserved over subroutine calls
tt=7
x=10
z=11
y=12
x0=13
y0=14
font=15 ;font index
chnl=16 ;ten to 11 channel
p=17
.xcref a b c d e t tt x z y x0 y0 font chnl p xx
nq1bq2==5 ;number of things from q1 before q2
;don't forget to change XGPDEV when you
;change this!!!
nchnl==3 ;# of 10 to 11 channels we are willing to admit
cochnl==0 ;command out
cichnl==1 ;command in
dochnl==2 ;data out
;time sharing i/o channels
ch==,,-1 ;Bit typeout mask
chttyi==0 ;TTY input
chttyo==1 ;TTY output
chfnti==2 ;Font file input
chtxti==3 ;Text and SCN and PLX file input
cherri==4 ;ERR: device input
chcmdi==5 ;Queue file input
chstao==6 ;Status file output
chmail==7 ;Mail (notification) output
chfoo==10
lambda==10.*60. ;10 second time out on xgp
pagpsl==5 ;Number of pages we assume were lost when hardware complains.
xgp11==1 ;identification # of xgp pdp-11
maxfnt==20 ;maximum # fonts we will send to pdp11
tty1==3 ;only these ttys can send to xgp
tty2==24
mapmsk==574377776000 ;mask to type 10-11 map table entries
define conc a,b,c
a!b!c
termin
mk==117. ;max number of blocks allowable for plot files
wdspl==51.+2
ybitl==51.*32.
xbitl==11.*200.
bytmax==52.*4
pjrst==jrst ;replace PUSHJ/POPJ pair
define syscal call,args
.call [setz ? sixbit/call/ ? args ((setz))]
termin
loc 42
jsr tsint
loc 70
; NOTE!! Do not, repeat, NOT mung these locations without changing
; XGPDEV too. XGPDEV depends upon locations 70-101 being these parameters
; and in this order(when it reads USR:XGP XGPSPL).
cuname: 0 ;Uname of request currently being printed
xslver: .fnam2 ;version of this XGPSPL
nffq1: 0 ;number of frobs from q1
forms: 0 ;-1 if thesis forms, 0 if normal, 1 if waiting
;for forms change
cqin: 0 ;queue index number of current request
abortf: 0 ;-1 if XGP 11 program gronked or abort req.
maintr: 0 ;-1 if actually in maint mode (not just ^X typed).
idlep: -1 ;0 if not idle
;-1 if idle
;>0 (error code)if losing
filsiz: -1 ;size of current file in words, or -1 if unknown
filptr: 0 ;# words output so far from current file.
lsterr: 0 ;address of error message describing XGP lossage.
;0 => XGP and pdp-11 not known to be losing,
;except can be nonzero temporarily
;while TYI is being called.
subttl data areas
pdl==60
pdb: block pdl
nxgpfw: 0 ;0 or mapped address of system's nxgpfw variable
lxgpfw: -1 ;last value of that variable seen (aoses when file written on .XGPR.)
bypr: 0 ;bytes per row while loading fonts
cmdfil: 0 ;spooled command file active flag
dothis: 0 ;which queue to "Continue printing this file" from. See abort logic.
dskcmd: 0 ;reading commands from text file (NOT queue file) flag
;-1 => reading, 1 => stop after this line, 0 => not reading.
qtype: 0 ;patch this non-zero to type out queue files as read
chsts: block 8 ;storage for currently plotted/scanned file
txtbfl==200
txtcnt: 0 ;text buffer counter
txtptr: 0 ;byte pointer into text buffer
txtflg: 0 ;negative=>eof seen
txtrhd: 0 ;-1 => a word of read-ahead is in txtrhw.
txtrhw: 0 ;a word of read ahead saved from one bufferfull for the next one.
;This makes sure that eof is always anticipated by at least one word,
;for the sake of flushing ^C's from the end of the file.
0 ;dummy text buffer location used for end
;test at dbplr... must precede txtbuf
txtbuf: block txtbfl
txtpos: 0 ;char pos in file of where we are reading from the buffer.
combfl==200
comcnt: 0 ;# chars left to read from the command.
compnt: 0 ;pointer to read from the command.
combuf: block combfl ;buffer for the current command line.
qfn1: 0 ;fn1 of current queue file, zero if none
qfn2: 0
quitf: 0 ;non-zero if aborted file should go last in queue.
;-1 means ask user for ABFLSF setting. 1 means ABFLSF already set.
abflsf: 0 ;non-zero if aborted file shouldn't be requeued at all.
oforms: 0 ;While switching forms (FORMS > 0), this has old value of forms.
notflg: 0 ;non-zero ;NOTIFY seen
notluz: 0 ;non-zero => notification contains error messages, so mail, not just send.
notbfl==200
notcnt: 0 ;# chars used in notbuf
notpnt: 0 ;pointer for storing into notbuf
notbuf: block notbfl ;Text to send as notification. All error messages appended to it.
notusl==10
notusr: block 10 ;Name of user to send notification to.
nothst: 0
pfnbuf: block 10 ;buffer for printing filenames.
centf: 0 ;-1 => plotting a subsheet of a multi-sheet plot.
buf: block 200 ;buffer for plot files.
bufl==.-buf
t11pag: 0 ;next page to get from 11
buforg: 0 ;origin of buffers in 11 space
txtdev: sixbit/DSK/ ;Filenames of file we are printing.
txtfn1: 0
txtfn2: 0
txtsnm: 0
newtxt: 0 ;non-zero text file spec changed, re-open, otherwise can .access to 0.
maintp: 0 ;-1 => want to be in maint mode for next file (parity of ^X's typed)
;as opposed to maintr, which says we are in maint mode right now.
;default page parameters
iinitx0==1100.
iinity0==-180.
isqshfl==0
ilftmar==200.
itopmar==200
ibotmar==174
islines==3504 ;vsp, slines, topmar, botmar set to make 60 lines of 25fg per page
iplines==islines+itopmar+ibotmar
ilsp==-1
dlsp==25.+6 ;25 high font + 6 lines of vsp
ivsp==-1 ;default is to use lsp
dvsp==6
iautcut==-1
iffcut==0
itxtcmd==-1
iudepth==-1
;page parameters
initx0: 0
inity0: 0
sqshfl: 0 ;non-zero => ;SQUISH, so squish useless chars out of fonts
lftmar: 0
topmar: 0 ;allows 60 lines of text on one 11" page
botmar: 0
nlines: 0 ;11 inches
autcut: 0 ;-1 => cut paper evry so many inches.
ffcut: 0 ;non-zero forces xgp to cut only at form feeds
pskip: 0 ;# pages to skip at begining
txtcmd: 0 ;0 implies dont look for commands in text file
lsp: 0 ;base line spacing
vsp: 0 ;-1 => use lsp, other wise lspheight+vsp
udepth: 0 ;# prints in progress
plines: 0 ;# scan lines on page
slines: 0 ;# scan lines in text area
page: 0 ;page # of first printed page
tpages: 0 ;# of title pages in current ;title group.
dfhdrf: 0 ;-1=>put default header on each page
hdrcnt: 0 ;# characters in page header
hdrtxl==<200+4>/5 ;size of text header area
hdrtxt: block hdrtxl ;buffer for header text
prsqsh: 0 ;-1 => file was pre-squished, and had ;KSUBSET commands.
;SQSHTB was set up by them, so we need not squish.
sqshtb: block 200 ;one word for each ascii char
;bit 4.9 = font 0, 4.8 = font 1, etc.
;bit set => this char in this font is needed by the file.
opcode: 0 ;Which operation should be performed on this file?
op%txt==0 ;0 => print as text.
op%plt==1 ;1 => plot it as PLX file.
op%scn==2 ;2 => treat it as a SCN file.
op%smp==3 ;3 => treat it as a font and make a sample of it.
;font variables
fntspc: 0 ;-1 => fonts have been specified explicitly.
;A ;KSET in the file being printed doesn't count.
fntbeg::
fnto: sixbit /DSK/
fntfn1: sixbit /25FG/ ;used as a flag, if 0 then font not specified
fntfn2: sixbit /KST/
fntsnm: sixbit /FONTS/
height: 0 ;height of font
base: 0 ;base line
cpa: 0 ;column positon adjustment
kstid: 0 ;font id
fchflg: -1 ;-1=> transmit to 11
fntvln==.-fntbeg ;length of font variable area
loc fntbeg+<maxfnt*fntvln>
delbeg:: ;Beginning of delete queue variables.
delete::
deltxt: 0 ;-1 => delete this text file when done.
delqln==10.
delque: block delqln ;for each file on delete que, time (uptime in 30'ths) at which to delete.
delqdv: block delqln ;device, fn1, fn2 and sname for each file on queue.
delqf1: block delqln ;An entry which is not in use is all zeros.
delqf2: block delqln
delqsn: block delqln
delend:: ;End of delete queue variables.
cskip: 0 ;# of chars to skip at beginning (using .ACCESS) before printing.
pagpos: block pagpsl ;Hold cskip values -- char positions in file -- of last pagpsl pages.
;The last word applies to the last page.
tskip: 0 ;# of chars to skip at beginning before looking for commands in file.
ttlpos: block pagpsl ;Like pagpos but holds tskip values rather than cskip values.
baspag: 0 ;page number of page we started printing on.
junk: block 10 ;Can be supplied as address of where to store some garbage data.
;10-11 channel data areas
cmdpar: block nchnl ;parity
cmdcnt: block nchnl ;bugger byte counter
cmdsiz: block nchnl ;size of this buffer
cmdbuf: block nchnl ;byte pointer to first 11 word of buffer
cmdptr: repeat nchnl,conc cmdpt,\.rpcnt,(t)
repeat nchnl,[
conc cmdpt,\.rpcnt,[: block 2]
]
chhdrp: repeat nchnl,chhdr+<bprchl/4>*.rpcnt
subttl Initialization and main loop
go: .suset [.runame,,a]
came a,[sixbit /XGP/]
.value [asciz /:You must be logged in as XGP
/]
move p,[-pdl,,pdb-1] ;get a pdl
.open chttyi,['TTY] ;open the tty
.lose %lssys
.open chttyo,[1,,'TTY]
.lose %lssys
pushj p,vertyp
.core icore ;reduce to initial core
.lose %lssys
setzm cmdfil
movei a,lnkvpg
movem a,t11pag
syscal T11MP,[t11pag ? [<3_34.>\1777\<lnkv_10>\<xgp11_26.>]]
.value nopdp11
skipn 10lnkv
.hang ;wait for 11 to set things up
move a,[%pirlt+%piioc+%picli]
movei b,1_<chttyi>
.setm2 a,
move a,[200000,,b]
movei b,lambda ;xgp time out
.realt a,
jfcl
push p,[442000,,10lnkv]
ildb a,(p) ;points at channel headers
ildb b,(p) ;# channels
imuli b,bprchl ;# bytes in area
pushj p,get11 ;get that page
ildb a,(p) ;origin of buffer area
ildb b,(p) ;size (bytes)
movem a,buforg
sub p,[1,,1]
pushj p,get11 ;get buffer in map
movei chnl,cochnl
pushj p,open
setzm nxgpfw
move a,[squoze 0,nxgpfw]
.eval a,
jrst recycl
ldb b,[121000,,a]
syscal corblk,[ %climm,,%cbndr ? %climm,,%jself ? %climm,,syspag
%climm,,%jsabs ? b]
.lose %lsfil
movei b,syspag
dpb b,[121000,,a]
movem a,nxgpfw
.suset [.roptio,,a]
tlne a,%opcmd ;if we have JCL, enter maint mode
setom maintp ;before considering anything on the queue.
;main loop
recycl: move p,[-pdl,,pdb-1] ;reset the stack
movei chnl,cochnl
setzb font,dskcmd
setzm abortf ;XGP not believed to be losing until we find that it is.
setzm lsterr
pushj p,vreset ;reset variables and flush core.
pushj p,freset ;reset fonts
pushj p,nreset ;Reset some things special for top level loop.
pushj p,cmnds ;get command from tty or other
;Important error: give up trying to print file, but do send a notify,
;which will contain the error message.
lossag: move p,[-pdl,,pdb-1] ;reset the stack
pushj p,notify
;Come here after doing one actual output (;SCAN or ;PLOT or ;PRINT or ;LIST, etc)
done: skipe cmdfil ;No queue file is allowed to specify more than one,
jrst cmdeof ;so mark this one "finished" and flush it.
jrst recycl
;this is the file name reader
RFN"$$RUC==1
RFN"$$RFN==1
RFN"$$PFN==1
rfn"ruc:
pushj p,comget
cail a,140
subi a,40
popj p,
rfn"rsixtp:
cain a,^J
jrst popj1
jrst (t)
if2 rfn"psixtp=cpopj
;CONC prevents @ from seeing this.
.INSRT SYSENG;RFN >
;To read in a filename, call RFNM.
;B should contain the address of the block to store it in,
;which will hold the device, fn1, fn2 and sname in that order.
;T should contain a routine to skip if the character in A
;is a break character. Note that CR and LF are always break characters anyway.
;On return, A has the terminating character.
;E is zero if the filespec was null.
rfnm==rfn"rfn
;Get a stream (such as a queue file) to read commands from.
;Read the commands, returning when we have read the name of a file to print.
cmnds: skipe maintp ;If we are supposed to be in maint mode,
jrst maintm ;enter it or remain in it.
.suset [.ssname,,['.XGPR.]] ;read from spooling directory
skipe forms ;are thesis forms mounted?
jrst cmdtss ;yes, only do thesis requests
skipn a,dothis
jrst donorm
setzm dothis
cain a,'Q1 ;continue interrupted listing
jrst cmdq1
cain a,'Q2
jrst cmdq2
cain a,'Q3
jrst cmdq3
donorm: .open chcmdi,['DSK ? sixbit/ Q10/]
caia ; no ;PRIORITY request
jrst cmdopn ; yes, this is VERY special
move a,nffq1
cail a,nq1bq2
jrst cmdq2a
cmdq1: .open chcmdi,['DSK ? sixbit/ Q1</]
jrst cmdq2 ;no queue 1 requests
aos nffq1
jrst cmdopn ;process queue 1 request
;here to stick a Q2 request in ahead of normal order
cmdq2a: .open chcmdi,['DSK ? sixbit/ Q2</]
jrst cmdq1 ;no queue 2 requests
.open chfoo,['DSK ? sixbit/ Q1</]
jrst cmdq2b ;no queue 1 request, okay to charge on
syscal RFDATE,[movei chcmdi ? movem a]
.lose %lsfil
syscal RFDATE,[movei chfoo ? movem b]
.lose %lsfil
.close chfoo,
caml a,b ;is the queue 1 request older?
jrst cmdq1 ;yeah, better not do this!!
cmdq2b: setzm nffq1 ;Now, last thing was not from Q1.
jrst cmdopn ;process a queue 2 request
cmdq2: .open chcmdi,['DSK ? sixbit/ Q2</]
jrst cmdq3 ;no queue 2 requests
setzm nffq1 ;Now, last thing was not from Q1.
jrst cmdopn ;process a queue 2 request
cmdq3: .open chcmdi,['DSK ? sixbit/ Q3</]
jrst cmdtss ;no queue 3 requests
setzm nffq1
jrst cmdopn ;do a queue 3 request
cmdtss: .open chcmdi,['DSK ? sixbit/ QT</]
jrst cmdidl ;no thesi(?), XGP is idle
skipl forms ;are thesis forms mounted?
pushj p,formsc ;no, demand forms change
jrst cmdopn ;and get a command line
cmdidl: skipe forms ;are normal forms mounted?
pushj p,formsc ;no, demand putting normal forms back in XGP
setom idlep ;and flag being idle
skipe nxgpfw ;system helping?
jrst fwait ;yes, wait for file to be written
movei 2.*30. ;sleep for two seconds
.sleep ; ...zzz...
jrst cmnds ;and try try again
fwait: move a,lxgpfw
camn a,@nxgpfw
fwait1: .hang ;pc here at interrupt => unhang please
move a,@nxgpfw
movem a,lxgpfw
jrst cmnds
subttl command processing
;Having just found a queue file to process, set up to read it.
cmdopn: syscal RFNAME,[movei %jself ? movei chcmdi ? movem b ? movem a ? movem b]
.lose %lsfil ;can't get filename??
movem a,qfn1 ;save queue file name
movem b,qfn2
andi a,'_ ;only want queue number
rot a,-6 ;get queue number left justified
lsh b,-6 ;get queue state number
movem a,cqin ;save queue number
iorm b,cqin ;and save the current QIN for later reference
setzm idlep ;not idle any more
move b,[010700,,combuf-1] ;load byte pointer
setom cmdfil ;indicate command file active
setzm maintr ;And not now in maintenance mode.
jrst comman
;Enter maintenance mode, or reenter after printing a file.
maintm: skipe maintr ;Were we already in it?
jrst comman
movei b,[ASCIZ/
XGP testing mode
/]
pushj p,outstr
movsi b,'dsk ;When we first enter maint mode, reset default device.
movem b,txtdev
setom maintr
;Read the next command from the stream we are reading from.
comman: skipn maintp
skipe cmdfil
caia
jrst cmnds ;No stream to read from now => look for another.
skipn cmdfil ;Read from tty, if not processing a queue file.
jrst maint1 ;We already know that we must be in maint mode.
pushj p,cmdlin ;Read stream from queue file, if reading one.
jrst coman1
;Remain in maintenance mode after a ;SKIP, etc.
maint1: movei b,[ASCIZ /-->/]
pushj p,outstr
setom idlep ;claim to be idle
pushj p,ttylin ;gobble message from XGP TTY
setzm idlep ;claim to be doing work
coman1: pushj p,spcsk1 ;Skip past initial spaces in the command.
cain a,"; ;If line's first nonblank is a ";", it is
jrst alter ;a special command.
cain a,^j ;If it is a ^J, this is a blank line. Ignore it.
jrst comman
coman2: pushj p,combac ;Otherwise we just read 1st char of filename. Unread it.
move a,opcode ;Then go print, plot, etc. the file. The operation routines
jrst @optab(a) ;read the filename since some do it differently.
optab: jrst prtfil ;Go print the file.
jrst plotfil ;Go plot it
jrst scanfil ;Go print as bit map SCN file
jrst sampfil ;Go make sample of font.
;Here when a command is read that consists of a filename to print.
prtfil: movei b,txtdev ;Else it starts with a filename to print. Parse it,
movsi a,(SIXBIT/>/)
movem a,txtfn2
move tt,txtdev
movei t,[
cain a,"_ ;Stopping if we see an unquoted "_".
aos (p)
popj p,]
pushj p,rfnm
setom newtxt
exch tt,txtdev ;If user specifies a device of DSK, don't change his default.
came tt,['DSK,,]
movem tt,txtdev
getfnt: cain a,15
pushj p,comget ;ignore carriage returns
pushj p,spcsk2 ;bugs in @ and xqueue manage to get ^M ^J
cain a,12
jrst ptext ;end of line, no font specs.
caie a,"_
skipa b,[[asciz /Ignoring font spec/]]
pushj p,getf0 ;read font file names
jrst comerr
ptext: move p,[-pdl,,pdb-1] ;reset the stack. Come back here after printing title pages.
pushj p,txtopn ;open text input file
jrst txtluz ; file not found
pushj p,open ;open up the data channel
.call [ setz ? 'TTYVAR ? movei chttyo ? ['IDLTIM] ? setzi 0 ]
jfcl ;We're doing something, zero idle time (for <esc>F)
pushj p,prschk ;Barf at press files.
skipe txtcmd ;Unless inhibited, read ";" commands from text file.
pushj p,rtxtcm ;read settings from txtfile
skipe sqshfl ;squish?
skipe prsqsh ;and not done by XQUEUE already?
jrst recyc2
skipe tpages ;and not in title pages (squishing not done on them)?
jrst recyc2
pushj p,prescn ; must perform pre-scan
pushj p,txtopn ;then re-open the text file.
jrst txtluz
recyc2: pushj p,fonts ;send those fonts
movei font,0
pushj p,notify ;send notification if any
pushj p,sndtxt ;skip pages and send remainder
.close chtxti,
pushj p,delchk ;delete any text files whose time has come.
skipe deltxt
pushj p,delreq ;request deletion of this file in 1 minute if all well.
jrst done
;Assuming that the data of a file is already in TXTBUF,
;refuse to print it if it looks like a press file.
prschk: move a,[-txtbfl,,txtbuf]
setz b,
ior b,(a) ;IOR all the file words together,
aobjn a,.-1
trne b,17 ;If any word has one of the low four bits, that is good.
popj p,
movei a,txtdev ;Otherwise it is a press file (or so it seems)
movei b,[asciz /Text /] ;so refuse to print it.
push p,a
pushj p,eprnt
pop p,b
move d,[440700,,pfnbuf]
pushj p,rfn"pfn ;Convert filenames to a string.
movei b,pfnbuf
pushj p,eprnt ;Print it on tty and into notification.
movei b,[asciz / IS NOT A TEXT FILE
/]
pushj p,eprnt
jrst lossag
;routine to read font file names, assuming the "_" has already been read.
;No skip => ASCIZ string error message is in B.
getf0: movei t,[ ;Comma terminates a font file name.
cain a,",
aos (p)
popj p,]
skipn dskcmd
setom fntspc
movei font,0
move c,[sixbit /dsk/] ;Initial sticky defaults for device and directory
move d,[sixbit /fonts/]
getf0a: movei b,fnto(font) ;Parse the next font's filename.
skipe fntspc
skipn dskcmd ;If this is a ;KSET inside a file being printed,
jrst getf0b
skipn fchflg(font) ;and this font was already specified,
jrst getf0b
movei b,junk ;don't override the user about it.
pushj p,rfnm
jrst getf2
getf0b: movem c,fnto(font) ;First store in last font's device and dir as defaults.
movem d,fntsnm(font)
pushj p,rfnm
tlnn e,17 ;If it was empty,
jrst getf2 ;this font isn't specified.
movsi b,'KST
tlne e,1_rfn"fn1 ;If FN1 was spec'd and not FN2, default FN2 to KST.
tlne e,1_rfn"fn2
caia
movem b,fntfn2(font) ;fnam2
setom fchflg(font)
cain a,15
pushj p,comget ;ignore carriage returns
getf2: caie a,15 ;End of line => no more fonts specified; return.
cain a,12
jrst popj1
move c,fnto(font) ;more fonts left => get this font's dev and dir as
move d,fntsnm(font) ;defaults for next one, and loop to read the next filename.
addi font,fntvln
caie a,",
jrst [
movei b,[asciz /Ignoring junk at end of font specs./]
popj p,]
caige font,maxfnt*fntvln
jrst getf0a ;go back for more
movei b,[asciz /Ignoring excess fonts. 16. is the maximum./]
popj p,
;routine to demand forms change
formsc: skipe a,forms ;determine which message to do
skipa b,[[asciz/Mount normal forms in the XGP/]]
movei b,[asciz/Mount thesis forms in the XGP/]
setzm forms ? aos forms ;indicate waiting for funny forms
movem a,oforms ;remember what type of forms now loaded in case quit.
pushj p,outstr ;and type message
movei b,[asciz/
Type any character when ready (^G to refuse) ->/]
pushj p,outstr ;and output prompt message
.reset chttyi, ;flush input
movei a,[asciz/waiting for forms change/]
pushj p,tyi
move a,oforms ;we got the char ok, and wasn't ^G, so forms were changd.
setcam a,forms
popj p,
subttl Read and buffer a command line
;Read a line from the current queue file.
cmdlin: setzm comcnt
move b,[010700,,combuf-1] ;load command byte pntr
movem b,compnt ;save it
cmdln1: .iot chcmdi,a
andi a,177
cain a,^L ;ignore form feeds. They are used by requeueing.
jrst cmdln1 .see abort3
jumpe a,cmdln1 ;ignore nulls
aosn abortf ;abort?
jrst abort
cain a,^C ;EOF?
jrst cmdln2 ;yup
skipe qtype ;if desired,
.iot chttyo,a ;echo on XGP TTY
cmdln3: pushj p,comput ;save the character
caie a,^J ;hit the <LF>?
jrst cmdln1 ;nope, gobble down more
popj p,
cmdln2: movei a,^J ;If EOF is not after a null line,
skipe comcnt ;Finish the unterminated line. Will come back here
jrst cmdln3 ;after that command.
;delete old done queue entry, put current entry in the done queue, and close
;off the channel
cmdeof: setzm cmdfil ;indicate no command file active now
move a,['dsk,,] ;Make sure our defaults our unsurprising,
movem a,txtdev ;in case we now enter maintenance mode.
move a,['.xgpr.] ;(.XGPR. is as good as anything)
movem a,txtsnm
syscal DELETE,[['DSK,,] ? [sixbit/DONE/] ? [sixbit/QUEUE/] ? ['.XGPR.]]
jfcl ;guess no queues done
syscal RENMWO,[movei chcmdi ? [sixbit/DONE/] ? [sixbit/QUEUE/]]
jfcl
.close chcmdi, ;close off channel
jrst recycl ;Look for next queue file, or enter maint mode.
;fill combuf with a command line from disk file
;This is used for the commands that go at the front of files being printed,
;not for queue files.
dsklin: setzm comcnt
move b,[010700,,combuf-1]
movem b,compnt
dskl1: pushj p,txti
jumpe a,dskl1 ;ignore nulls
jumpl a,dskstp ;eof?
caie a,^C
cain a,^L
jrst dskstp ;on EOF or end of page, treat as newline and stop reading the file.
cain a,^J ;Treat LF as a newline.
jrst dsklf
caie a,^M ;ignore carriage returns
pushj p,comput
jrst dskl1
dskstp: movei a,1 ;stop reading from disk file after this line
movem a,dskcmd
dsklf: movei a,^M
pushj p,comput
movei a,^J
pushj p,comput
movei a,0
jrst comput
;Read a command line from the TTY, in maintenance mode.
ttylin: move b,[010700,,combuf-1]
setzm comcnt
ttyl1: setz a,
pushj p,tyi
jumpe a,ttyl1
cain a,177
jrst rubout ;rubout
cain a,4
jrst [ movei b,[asciz / <--/]
pushj p,outstr
pushj p,sout ;control-d cancels whole line
jrst ttylin]
cain a,14
jrst ttyff ;form feed retypes buffer
cain a,15
jrst ttycr
cain a,12
jrst ttylf
pushj p,comput
jrst ttyl1
;Read a character of input. If not in maintenance mode,
;then if we don't get any input for 5 minutes we tell everyone on the queue.
;A should contain a string to tell them, or 0 to use LSTERR.
;The caller should also bind LSTERR to a short string if the
;XGP status is not going to know about this state for any other reason.
tyi: skipe maintp
jrst tyimnt
skipn a
move a,lsterr
skipn a
.value
push p,b
push p,d
movei b,5*60./2 ;# of 2-second intervals to sleep before crying loud for help.
abcry1: movei d,60.
.sleep d,
.listen d, ;If there's input, we've been noticed,
jumpn d,abcry2 ;so don't cry for help.
sojg b,abcry1 ;If time interval elapses and no input,
pushj p,cry ;yell at everyone on the queue.
abcry2: .iot chttyi,a ;Now that we told them, we can just wait for input.
pop p,d
pop p,b
popj p,
tyimnt: .iot chttyi,a
popj p,
rubout: sosge comcnt
jrst [ pushj p,crlf
jrst ttylin]
ldb a,b
pushj p,tyo
pushj p,decbp ;decrement byte pointer
jrst ttyl1
decbp: add b,[070000,,0]
jumpge b,cpopj
sub b,[430000,,1]
popj p,
ttyff: push p,b ;form feed retypes buffer
push p,c
pushj p,crlf
skipg c,comcnt
jrst ttyffx
move b,[010700,,combuf-1]
ttyff1: ildb a,b
pushj p,tyo
sojg c,ttyff1
ttyffx: pop p,c
pop p,b
jrst ttyl1
ttylf: movei a,15
pushj p,tyo
ttycr: pushj p,comput
movei a,12
pushj p,comput
move b,[010700,,combuf-1]
movem b,compnt
popj p,
comput: camn b,[010700,,combuf+combfl-1]
popj p,
idpb a,b
aos comcnt
popj p,
subttl ";"-command processing
;Process a line starting with a ";" from a queue file or the tty.
alter: pushj p,spcskp ;skip over spaces, tabs, and crs
cain a,12
jrst comman ;ignore blank alter commands
altcom: pushj p,decode
jrst [ pushj p,huh
jrst comman] ;undefined command
pushj p,spcskp
move c,comtab(b)
pushj p,(c)
pushj p,comerr ;routine lost, print err msg (asciz string addr in B)
pushj p,comxit ;gobble up rest of line
jrst comman ;back to print mode
;here to skip over spaces in command line
spcskp: cain a,12 ;don't skip over line feed
popj p,
spcsk1: pushj p,comget
spcsk2: caie a,40
cain a,11
jrst spcsk1
cain a,15
jrst spcsk1
popj p,
;tty level command return
comerr: push p,a
comer1: pushj p,terprn
pushj p,terpri
popxit: pop p,a
comxit: cain a,12
popj p,
pushj p,comget
jrst comxit
huh: movei b,[asciz /Unknown command/]
jrst comerr
badarg: movei b,[asciz /Argument error/]
popj p,
pophuh: pop p,a
althuh: movei b,[asciz /Syntax error/]
popj p,
;read next character from buffer command line, into A.
comget: sosge comcnt
jrst gronkd
ildb a,compnt
popj p,
gronkd: setzm idlep ? aos idlep
.value [asciz\:Spooler gronked

.jpc/q/\]
;Back up one character (unread it) in command line.
combac: move b,compnt
pushj p,decbp ;decrement byte pointer
movem b,compnt
aos comcnt
popj p,
;command dispatch table
define xx name,routin
[sixbit /name/],,routin
termin
;should be in alphabetical order
;all these routines should skip return if no errors
; error return with pointer to asciz string in b
; norml return
;Routines that actually send to the XGP should return, if successful, to DONE.
comtab:
xx autcut,setcut
xx botmar,setbot
xx cskip,xcskip
xx defaul,defaul
xx delete,delcmd
xx ffcut,setffc
xx header,header
xx height,shwhgt
xx kill,kill
xx kset,kset
xx ksubset,ksubset
xx lftmar,setlft
xx list,list
xx lsp,setlsp
xx nlines,setlin
xx notify,donote
xx noxgp,cpopj1
xx plot,plot
xx print,print
xx priori,print
xx reset,reset
xx rotate,rotate
xx sample,sample
xx scan,scan
xx show,show
xx size,size
xx skip,setpsk
xx sndfnt,fontsa
xx squish,squish
xx status,status
xx test,settst
xx thesis,print
xx title,xtitle
xx topmar,settop
xx tskip,xtskip
xx txtcmd,setxtc
xx verse,verse
xx vsp,setvsp
xx x0,setx0
xx y0,sety0
comtbl==.-comtab
;reads commands from text file
rtxtcm: aosn abortf
jrst abort
push p,udepth ;to see if it changes
push p,dskcmd
setom dskcmd
txtcm1: skipl dskcmd
jrst txtcxt
pushj p,dsklin ;get command from disk
pushj p,comget ;get command character
cain a,^M
jrst txtcm1 ;ignore null line
caie a,";
jrst txtcxt ;exit
pushj p,spcskp
cain a,12
jrst txtcm1 ;ignore null command line
movei b,combuf
push p,a
skipn cmdfil
pushj p,outstr ;let him know what's going on
pop p,a
pushj p,decode
jrst txtcxt ;not in table, go away
pushj p,spcskp
move c,comtab(b)
pushj p,(c)
pushj p,comerr ;give error message for lossage
pushj p,comxit
jrst txtcm1
;here to exit text file command reader
txtcxt: pop p,dskcmd
pushj p,txtopn ;reopen, it might even be a different file
jrst txtluz ; can't => error message and give up.
pop p,a
came a,udepth
jrst rtxtcm ;that was the command file, now read the print file
popj p,
;here to decode command
decode: move c,[440600,,d]
tdza d,d
decod1: pushj p,comget
pushj p,cvsix ;convert to six bit
jumpl b,[ cain a,15
pushj p,comget ;ignore carriage returns
cain a,12
jrst decod2
popj p,] ;command not understood
jumpe b,decod2 ;search command table
tlne c,770000
idpb b,c ;only 6 characters
jrst decod1
;look up command in d
decod2: jumpe d,[ cain a,":
jrst decode ;don't screw for leading colon
popj p,] ;error
movei b,comtbl-1
decod3: movs c,comtab(b)
camn d,(c)
jrst popj1 ;found him
sojge b,decod3
popj p, ;not found
;convert a to sixbit, leave result in b
cvsix: cain a,11
movei a,40
movni b,1 ;assume not sixbit
cail a,"a
caile a,"z
caia ;not lower case
subi a,40 ;lower case: upper caseify
cail a,40 ;now check for sixbit
caile a,"_
popj p, ;not sixbit
movei b,-40(a) ;convert from ascii to sixbit
popj p,
;read in a decimal number and leave result in d
; non-skip return, number not read
;call with first character already in a.
;break character left in a.
decin: movei c,1 ;sign
cain a,"-
pushj p,[ movni c,1 ;negative number
jrst comget]
pushj p,cvdig ;convert character code to digit
jumpl b,cpopj ;not a digit, no number there
tdza d,d
decin1: pushj p,comget
pushj p,cvdig ;leave digit in b
jumpl b,[ jumpge c,popj1
movns c
movns d
jrst popj1]
imuli d,10.
imuli c,10. ;keep track of digits read
add d,b
jrst decin1
;Read octal number into D.
;Call with first character already in A.
;Break character left in A.
octin: setz d,
octin1: pushj p,cvdig ;Try converting char in A to its value as a digit.
jumpl b,cpopj ;Return when we come to a non-digit.
imuli d,10 ;Accumulate digits into the result.
add d,b
pushj p,comget ;and move on in the command string.
jrst octin1
;covert digit in a to number
cvdig: movni b,1 ;assume failure
cail a,"0
caile a,"9
popj p, ;failure
movei b,-"0(a)
popj p,
;get positive argument
; non-skip return for failure
posarg: pushj p,argin
popj p,
jumpl d,cpopj
jrst popj1
argin: pushj p,decin
popj p, ;error return
pushj p,spcsk2
cain a,12
cpopj1: aos (p)
popj p,
subttl ;TITLE and title pages
; ;TITLE <n> identifies the next <n> pages (after this one) as title pages.
; It is allowed only in a file being printed.
; We continue to look for semicolon commands, and print the file as usual,
; except that after <n> pages have been processed we mark all of the file so far
; as processed titles (by setting tskip) and pretend that the file begins
; at the point we have reached. That is, we start again looking for
; semicolon commands, etc. All fonts and so forth
; for the text after the title pages must be respecified there
; since they unpredictably may or may not be inherited from the titles.
; ;SQUISH and ;KSUBSET may not be used in title pages, though they may be
; used in the body of the file following the title pages.
; Page numbers start at 1 again after each group of title pages ends.
; ;SKIP in a group of titles is local to the titles and ;SKIP after
; the titles applies only to what follows the titles.
xtitle: skipn dskcmd
popj p,
pushj p,posarg
jrst badarg
movem d,tpages
jrst popj1
; ;TSKIP <n> command is used in requeueing files which have had titles printed.
; It says to skip to character position <n> when looking at the file
; because everything up to there was made up of titles.
xtskip: pushj p,posarg
jrst badarg
caml d,tskip
movem d,tskip
jrst popj1
subttl ;SCAN and ;PLOT
; The ;SCAN and ;PLOT commands themselves just set OPCODE,
; so that when the filename is encountered we dispatch through OPTAB
; to SCANFIL or PLOTFIL to read the filename and output the file.
scanfil:
pushj p,scnfn
jrst [ movei b,[asciz /???/]
popj p,]
skipge delup ;Notify now if ;SCAN * SCN.
pushj p,notify
scan2: pushj p,nxtfil ;Open the scan file, or the next file if * was spec'd.
movei a,sbuf
scan1: hrrz b,a
lsh b,-12
caile b,mk+1 ;read the whole scan file into core.
jrst seof
.core 1(b)
.lose %lssys
hrli a,-2000
.iot chtxti,a
jumpl a,seof
movei b,seof+mk*2000
cail b,(a)
jrst scan1
seof: .close chtxti,
pushj p,sndscn ;send over the scan file data now in core.
pushj p,scndun ;Done with this file; if one-file command, exit.
jrst scan2 ;Else loop back for next file.
;Here to send over a scan file in core.
sndscn: push p,a
movei a,2
pushj p,cmdo
pushj p,cmdof
movei a,30. ;wait for 11 to be ready for it.
.sleep a,
pop p,a
subi a,sbuf
hrrzs a
lsh a,-12
aos a ;Say how many K of core the data occupies.
push p,a
move d,a
pushj p,decpnt
movei b,[asciz /K core locked
/]
pushj p,outstr
pop p,a
hrl a,a
hrri a,sbuf_-12
syscal XGPIM,a ;Send it over, using I.T.S. interrupt level.
jrst xpltl
movei a,30.*30. ;Wait till it should all be over.
.sleep a,
.core sbufp ;Flush the core.
.lose
popj p,
xpltl: movei b,[asciz /XGP lossage!
/]
pushj p,notstr
pushj p,outstr
.core sbufp
.lose
jrst lossag
;Read filename arg to ;SCAN or ;PLOT
scnfn: setzm delup ;Delup gets set if this is a multi-file "*" request.
movei b,txtdev
movei t,cpopj
pushj p,rfnm
move a,[sixbit/*/]
tlnn e,1_rfn"fn1
movem a,txtfn1
move a,[sixbit/SCN/]
tlnn e,1_rfn"fn2
movem a,txtfn2
move a,txtfn1
camn a,[sixbit /*/]
jsp b,[setom delup
movsi e,(sixbit /</)
movem e,txtfn1
jrst (b) ]
setom newtxt
jrst popj1
;Open file for ;SCAN or ;PLOT. If multi-file command,
;open the next file and print its name.
nxtfil: syscal OPEN,[movsi .bii ? movei chtxti ? txtdev ? txtfn1 ? txtfn2 ? txtsnm]
jrst [ skipl delup
jrst txtluz ;If single-file ;SCAN, not found is error.
jrst done] ;For multi-file, it means we're finished.
skipl delup
pushj p,notify ;For single-file command, notify after open wins.
skipge delup'
pushj p,sfnpnt
.core sbufp
.lose %lssys
popj p,
;Come here at end of processing a scan or plot file,
;in case there are more files in this request.
SCNDUN: skipl delup ;is this a deletable * SCN type?
jrst scndu1 ; no, go check for maybe deleting it anyway
syscal DELETE,[chsts ? chsts+1 ? chsts+2 ? chsts+3]
jfcl ;somebody beat us!
popj p,
scndu1: pushj p,delchk ;check for pending deletions
skipe deltxt ;did he ask to delete this?
pushj p,delreq ; then do request it!
jrst done
;Print out the current SCN or PLT file name, for multi-file ;SCAN or ;PLOT.
;Leaves the filenames in CHSTS ... CHSTS+3 for deleting the file later.
sfnpnt: syscal RFNAME,[%climm,,chtxti ? %clout,,chsts ? %clout,,chsts+1
%clout,,chsts+2 ? %clout,,chsts+3]
jfcl
movei a,chsts
pushj p,pntfnm
movei b,[asciz/ ... /]
jrst outstr
plotfil:
pushj p,scnfn
jrst [ movei b,[asciz /Invalid PLOT specification/]
popj p,]
move a,txtfn2
camn a,['SCN,,]
move a,['PLX,,]
movem a,txtfn2
skipge delup ;Notify now if ;PLOT * PLX
pushj p,notify
plot2: pushj p,nxtfil ;Open the file, or the next file of a * request.
setzm centf ;So far, no need for multiple sheets or centering.
pushj p,plot3a ;Attempt to plot it. Win, unless it needs several sheets.
pushj p,qmm ;It needs several sheets. Hack that.
pushj p,scndun ;Finished with this file; maybe get next.
jrst plot2
;Plot the open text file. If CENTF is set, we are doing a sheet of a
;multi-sheet plot, so ignore things that are out of bounds.
;If CENTF is not set, we are not aware that this is a multi-sheet plot;
;anything out of bounds means that this ought to be one, so go to QMM to hack it.
PLOT3A: .core sbufp+mk+1
.lose %lssys
movei tt,m1 ;initialize tt to up position
move x0,initx0 ;initial x coordinate
move y0,inity0 ;inital y coordinate
loop: move a,[-bufl,,buf] ;file buffer
.iot chtxti,a
movni a,-buf(a) ;get number of words really transferred
jumpe a,[ ;empty buffer, finished. Convert to run length and output.
aos (p) ;Skip to say we really output it.
jrst sllup]
hrlzs a ;get length of stuff transferred
hrri a,buf ;construct aobjn pointer
move b,(a)
m1: jffo b,doit ;dispatch on bits set
aobjn a,.-2 ;end of this word, pick up next word of file
jrst loop ;back for another buffer full
doit: andcm b,bitab(c) ;clear bit for next dispatch
xct dobit(c) ;dispatch on bit position of set bit
jrst (tt) ;write the bit into the bit map or not
dobit: block 36.
pltd1: repeat 5,[
jrst m1 ;ignored
movei tt,write ;pendown
movei tt,m1 ;penup
soja x0,(tt)
aoja x0,(tt)
soja y0,(tt)
aoja y0,(tt)
]
jrst m1 ;ignored
pltd2: repeat 5,[
jrst m1
movei tt,write
movei tt,m1
aoja y0,(tt)
soja y0,(tt)
soja x0,(tt)
aoja x0,(tt)
]
jrst m1
bitab: repeat 36.,1_<35.-.rpcnt>
write: hrrz x,x0 ;pick up x position of bit to write
tdne b,mormsk(c) ;don't mark till all motion done
JRST M1 ;NEXT BIT
cail x,xbitl ;out of range?
JRST QTEST ;TEST IF ALREADY DOING EXPANDED PLOT
imuli x,wdspl ;words per scan line
hrrz z,y0 ;pick up y position
cail z,ybitl ;out of range?
JRST QTEST ;TEST IF ALREADY DOING EXPANDED PLOT
lshc z,-5 ;word # in line into z, bit position in high part of y
add x,z ;add in the word number in the line
lsh y,-<36.-5> ;move the bit position into spot to index with
move z,bitab(y) ;pick up the bit we really want to use
iorm z,bitbuf(x) ;zap it into the buffer
jrst m1 ;back for another bit in the file
qtest: skipge centf ;Here on point that is out of range.
jrst m1 ;Already hacking multi-sheets, just don't plot it.
popj p, ;Not hacking multi-sheets; this plot attempt has failed.
;make this call to PLOT3A fail so QMM is called.
cnter==36.
mormsk: repeat 5,[
cnter==cnter-7
0
0
0
7_cnter
3_cnter
1_cnter
0
]
0
;QMM and the other Q... routines are for computing how big the
;plot is without printing it, when we have seen that the plot is too big to print.
;When EOF is reached, PLOT3 is called several times set to print various
;subplots, which when put side-by-side will add up to the whole plot.
QMM: .CORE SBUFP
.lose %lssys
syscal OPEN,[movsi .bii ? movei chtxti ? txtdev ? txtfn1 ? txtfn2 ? txtsnm]
jrst txtluz
SETZB X0,Y0
MOVE A,[4*XBITL]
MOVEM A,XMIN'
MOVNM A,XMAX'
MOVE A,[4*YBITL]
MOVEM A,YMIN'
MOVNM A,YMAX'
MOVEI TT,QM1
QLOOP: MOVE A,[-BUFL,,BUF] ;BUFFER LOCATION
.IOT chtxti,A
MOVNI A,-BUF(A) ;# WORDS TRANSFERED
JUMPE A,QFILDN
HRLZS A
HRRI A,BUF
MOVE B,(A) ;WORD
QM1: JFFO B,QDOIT
AOBJN A,.-2
JRST QLOOP
QDOIT: ANDCM B,BITAB(C)
XCT QDOBIT(C)
JRST (TT)
QDOBIT: BLOCK 36.
QPLTD1: REPEAT 5,[
JRST QM1
MOVEI TT,QWRITE
MOVEI TT,QM1
SOJA X0,(TT)
AOJA X0,(TT)
SOJA Y0,(TT)
AOJA Y0,(TT)
]
JRST QM1
QPLTD2: REPEAT 5,[
JRST QM1
MOVEI TT,QWRITE
MOVEI TT,QM1
AOJA Y0,(TT)
SOJA Y0,(TT)
SOJA X0,(TT)
AOJA X0,(TT)
]
JRST QM1
QWRITE: CAML X0,XMAX
MOVEM X0,XMAX
CAMG X0,XMIN
MOVEM X0,XMIN
CAML Y0,YMAX
MOVEM Y0,YMAX
CAMG Y0,YMIN
MOVEM Y0,YMIN
JRST QM1
;Reopen the plot file and plot whatever fits on the paper, ignoring what doesn't.
plot3: syscal OPEN,[movsi .bii ? movei chtxti ? txtdev ? txtfn1 ? txtfn2 ? txtsnm]
jrst txtluz
setom centf
pushj p,plot3a
.value
popj p,
;Here at end of QMM's pass. XMAX, XMIN, YMAX, YMIN now have the ranges
;or the two co-ordinates that the plot occupies. Determine how many subsheets
;are needed and call PLOT3 to plot them.
QFILDN: MOVE X0,XMAX
SUB X0,XMIN
JUMPLE X0,SCNDUN
MOVE Y0,YMAX
SUB Y0,YMIN
JUMPLE Y0,SCNDUN
CAIL X0,XBITL
JRST QF1
CAIL Y0,YBITL
JRST QF1
ASH X0,-1 ;Fits on one sheet if we translate it.
ASH Y0,-1
ADD X0,XMIN
ADD Y0,YMIN
MOVNM X0,INITX0
MOVNM Y0,INITY0
MOVEI X0,XBITL/2
ADDM X0,INITX0
MOVEI Y0,YBITL/2
ADDM Y0,INITY0
jrst plot3
QF1: CAIL X0,2*XBITL
JRST QF2
CAIL Y0,2*YBITL
JRST QF2
CAIGE X0,XBITL
JRST QF1A
CAIGE Y0,YBITL
JRST QF1B
ASH X0,-1
ASH Y0,-1
ADD X0,XMIN
ADD Y0,YMIN
MOVNM X0,INITX0
MOVNM Y0,INITY0
MOVEI X0,XBITL
ADDM X0,INITX0
MOVEI Y0,YBITL
ADDM Y0,INITY0
pushj p,plot3
MOVNI X0,XBITL
ADDM X0,INITX0
pushj p,plot3
MOVEI X0,XBITL
ADDM X0,INITX0
MOVNI Y0,YBITL
ADDM Y0,INITY0
pushj p,plot3
MOVNI X0,XBITL
ADDM X0,INITX0
pushj p,plot3
popj p,
QF1A: ASH X0,-1 ;X FITS ON ONE SHEET
ASH Y0,-1
ADD Y0,YMIN
ADD X0,XMIN
MOVNM X0,INITX0
MOVNM Y0,INITY0
MOVEI X0,XBITL/2
ADDM X0,INITX0
MOVEI Y0,YBITL
ADDM Y0,INITY0
pushj p,plot3
MOVNI Y0,YBITL
ADDM Y0,INITY0
jrst plot3
QF1B: ASH X0,-1
ASH Y0,-1
ADD Y0,YMIN
ADD X0,XMIN
MOVNM X0,INITX0
MOVNM Y0,INITY0
MOVEI X0,XBITL
ADDM X0,INITX0
MOVEI Y0,YBITL/2
ADDM Y0,INITY0
pushj p,plot3
MOVNI X0,XBITL
ADDM X0,INITX0
jrst plot3
QF2: ASH X0,-1
ASH Y0,-1
ADD Y0,YMIN
ADD X0,XMIN
MOVNM X0,INITX0
MOVNM Y0,INITY0
MOVEI X0,XBITL+<XBITL/2>
ADDM X0,INITX0
MOVEI Y0,YBITL+<YBITL/2>
ADDM Y0,INITY0
pushj p,plot3
MOVNI X0,XBITL
ADDM X0,INITX0
pushj p,plot3
MOVNI X0,XBITL
ADDM X0,INITX0
pushj p,plot3
MOVEI X0,2*XBITL
ADDM X0,INITX0
MOVNI X0,YBITL
ADDM X0,INITY0
pushj p,plot3
MOVNI X0,XBITL
ADDM X0,INITX0
pushj p,plot3
MOVNI X0,XBITL
ADDM X0,INITX0
pushj p,plot3
MOVEI X0,2*XBITL
ADDM X0,INITX0
MOVNI X0,YBITL
ADDM X0,INITY0
pushj p,plot3
MOVNI X0,XBITL
ADDM X0,INITX0
pushj p,plot3
MOVNI X0,XBITL
ADDM X0,INITX0
jrst plot3
;this routine converts the bit map just produced into a possibly more compact
;representation, using the run length encoding option, and then outputs it.
;it can never result in a longer representation, since it can always use
;the image representation if that is more efficient.
sllup: .close chtxti,
move a,lftmar
movem a,vpos'
movei a,sbuf
movem a,fptr'
movei a,bitbuf
sllup1: aos vpos
push p,a
pushj p,cnvrt
pop p,a
jumpe b,sllup2
move c,fptr
move d,b
addi d,1 ;for the extra position/length word
lsh d,1
dpb d,[242000,,(c)]
move d,vpos
dpb d,[042000,,(c)]
aos c
move d,c
add d,b
movem d,fptr
hrli c,bytbf ;source
blt c,-1(d)
sllup2: addi a,wdspl
caige a,bitbuf+mk*2000
jrst sllup1
move a,fptr
hrli a,442000
movei b,2
idpb b,a
movei b,xbitl+100
add b,lftmar
tro b,100000
idpb b,a
setzm 1(a)
aos fptr
aos a,fptr
jrst sndscn ;Output the run-length encoded data and return.
cnvrt: setzm lstbb'
setzm bytcnt'
setzb e,d ;bit count, last different bit count
movei c,0
jsp t,dep
jfcl
movei c,0
jsp t,dep
jfcl
hrli a,-wdspl+2
w1: move b,(a)
w2: jffo b,dow ;found a black bit
w3: addi d,32. ;all bits of this word white
aobjn a,w1
move c,lstbb
movem c,bytcnt ;backup byte buffer to last black bits
repeat 3,[ movei c,0 ;escape code
jsp t,dep
jrst imsl
]
movei c,1
jsp t,dep
jrst imsl
jrst esl
b1: setcm b,(a)
b2: jffo b,dob ;found a white bit
b3: addi d,32.
aobjn a,b1
movei c,0
jrst dob ;pretend we just got a white bit
dow: andca b,mtb(c)
cail c,40
jrst w3
add c,d ;bit position of this bit
exch c,e ;last change update
subm e,c ;difference in c
dow2: caile c,377
jrst dow1
jsp t,dep
jrst imsl
jrst b2
dow1: movem c,temp'
movei c,377
subm c,temp
jsp t,dep
jrst imsl
jsp t,dep
jrst imsl
movn c,temp
jrst dow2
dob: andca b,mtb(c)
cail c,40
jrst b3
add c,d
exch e,c
subm e,c
dob2: caile c,377
jrst dob1
jsp t,dep
jrst imsl
move c,bytcnt
movem c,lstbb ;save last byte used for blackness
jrst w2
dob1: movem c,temp
movei c,377
subm c,temp
jsp t,dep
jrst imsl
jsp t,dep
jrst imsl
movn c,temp
jrst dob2
mtb: repeat 36.,[
<-1>_<-.rpcnt>
]
dep: move x,bytcnt
cail x,bytmax ;can we do better in image mode?
jrst (t) ;yes
move y,x
andi y,3
lsh x,-2
dpb c,bytab(y) ;deposit in the kludgy format wanted by the xgp
movei c,0
aos bytcnt
jrst 1(t)
bytab: 241000,,bytbf(x)
341000,,bytbf(x)
041000,,bytbf(x)
141000,,bytbf(x)
bytbf: block wdspl
;get here when the run length encoded version is longer than an image scan line,
;and we want to convert the bit map into an image scan line.
imsl: move a,-1(p) ;pointer to beg of bit map
hrli a,-wdspl+2
setom lstbb ;we have blackness in this line
setzm bytcnt ;start at beg of the bytcount
movei c,0 ;esc
jsp t,dep
jfcl
movei c,2 ;enter image mode
jsp t,dep
jfcl
imsl1: move c,(a) ;pickup word from bit map
circ c,44 ;reverse bit order
move c,d ;pickup first 8 bits
jsp t,dep
jfcl
lsh d,-8 ;next 8, etc.
move c,d
jsp t,dep
jfcl
lsh d,-8
move c,d
jsp t,dep
jfcl
lsh d,-8
move c,d
jsp t,dep
jfcl
aobjn a,imsl1 ;back for the next bit map word
esl: move b,bytcnt
addi b,3 ;round off to next higher word
lsh b,-2 ;four bytes/word
skipn lstbb
movei b, ;return zero if this line is null
popj p,
subttl notification
;type out char from a into notification buffer
notyo: setom notluz ;Any addition to notify string after the notify command
;is an error message.
push p,a
move a,notcnt
cail a,notbfl*5
jrst popaj
aos notcnt
pop p,a
idpb a,notpnt
popj p,
;type out string pointed to be b into notification, no clobberage
notstr: push p,a
push p,b
hrli b,440700
notst1: ildb a,b
jumpe a,popbaj
pushj p,notyo
jrst notst1
;same but then give crlf
terprn: pushj p,notstr
nocrlf: push p,a
movei a,^M
pushj p,notyo
movei a,^J
pushj p,notyo
jrst popaj
popbaj: pop p,b
pop p,a
popj p,
;Process NOTIFY command.
donote: setom notflg ; notify seen
move b,[440700,,nothst] ; get host # as ASCIZ
donot1: tlne b,040000
idpb a,b
pushj p,comget ; get another character
caie a,<",> ; got a comma?
jrst donot1 ; no, still getting a site number
pushj p,comget ; get first character in UNAME
move b,[440700,,notusr]
movei c,5*notusl-1
move d,[440600,,cuname]
setzm cuname
donot2: sosl c ; skip if name buffer full
idpb a,b ; output it
caige a,140
subi a,40
tlne d,770000
idpb a,d
pushj p,comget ; get another UNAME character
caie a,<" > ; got a space?
jrst donot2 ; no, still getting UNAME
setz a, ; yes, terminate name
idpb a,b
donot3: pushj p,comget ; get message character
pushj p,notyo ; output it
caie a,^J ; hit terminating linefeed?
jrst donot3 ; no, continue hacking message
setzm notluz ; so far, there is no error message in the notification.
jrst popj1 ; and return
;here to tell the world that XGP output is starting
notify: skipn notflg ;send notification if desired
popj p,
syscal OPEN,[[.uao,,chmail] ? ['DSK,,] ? [sixbit/MAIL/] ? [sixbit/>/]
['.MAIL.]] ; write a mail file
.lose %lsfil ; can't
movei b,[ASCIZ /FROM-JOB:XGPSPL
FROM:XI"The-XGP
TO:(/]
pushj p,notifz
movei b,notusr ;output (user host (R-MODE-SEND mode))
pushj p,notifz
.iot chmail,[40]
movei b,nothst
pushj p,notifz
movei b,[asciz / (R-MODE-SEND /]
pushj p,notifz
movei b,[asciz /0/] ;If reporting error, mail if can't send.
skipn notluz ;If no lossage to report, never mail.
movei b,[asciz /-1/]
pushj p,notifz
movei b,[asciz /))
TEXT;-1
/] ; now comes the message!!!
pushj p,notifz
setz a, ;make it asciz, then send as asciz string.
move b,notpnt
idpb a,b
movei b,notbuf
pushj p,notifz
.close chmail,
popj p,
;Output asciz string B points at to chmail. Clobbers B, C.
notifz: hrli b,440700
push p,a
push p,b
setz c,
notfz1: ildb a,b
skipe a
aoja c,notfz1
pop p,b
syscal siot,[%climm,,chmail ? b ? c]
.lose %lsfil
jrst popaj
subttl deletion of text files
;delete all files on the delete queue whose time has come.
delchk: push p,a
push p,b
.rdtime a, ;read uptime in 30'ths as of now.
movsi b,-delqln
delch1: skipe delque(b) ;Ignore queue entries that aren't in use.
camge a,delque(b)
jrst delch2 ;File deletion time is still in the future.
syscal DELETE,[delqdv(b) ? delqf1(b) ? delqf2(b) ? delqsn(b)]
jfcl
setzm delque(b) ;clear out queue entries no longer in use.
setzm delqdv(b)
setzm delqf1(b)
setzm delqf2(b)
setzm delqsn(b)
delch2: aobjn b,delch1
jrst popbaj
;request deletion of the current text file, two minutes from now.
deldly==120.*30. ;Two minutes of 30'ths.
delreq: push p,a
push p,b
.rdtime a, ;get uptime as of now, in 30'ths.
addi a,deldly ;compute time to delete the file.
movsi b,-delqln
skipe delque(b) ;find a queue entry that is free.
aobjn b,.-1
jumpge b,popbaj ;give up if queue is full. (10 files in 1 minute???)
movem a,delque(b) ;store time at which this file should be deleted.
move a,txtdev
movem a,delqdv(b) ;store the names of the file.
move a,txtfn1
movem a,delqf1(b)
move a,txtfn2
movem a,delqf2(b)
move a,txtsnm
movem a,delqsn(b)
jrst popbaj
; ;DELETE command - delete this file after processing it.
delcmd: setom deltxt
jrst popj1
subttl status line printout
; ;STATUS line types line on the tty and into the stats file.
status: push p,a
sretry: syscal OPEN,[movsi 100000\.uao ? movei chstao ? moves b
['DSK,,] ? [sixbit/QUEUE/] ? [sixbit/STATS/] ? ['.XGPR.]]
jrst [ caie b,%ensfl ;FNF error?
jrst [ movei b,[asciz/Waiting to access statistics file...
/]
pushj p,outstr ;and report what's goin' down
movei b,60.*30. ;try waiting 60 seconds
.sleep b, ;...zzz...
jrst sretry] ;and try again
movei b,[asciz/
Warning: Queue statistics file cannot be written over.
A new file is being created!
/]
pushj p,outstr ;type warning
syscal OPEN,[movsi .uao ? movei chstao ? ['DSK,,] ? [sixbit/QUEUE/]
[sixbit/STATS/] ? ['.XGPR.]]
.lose %lsfil ;lose here...must have file
pop p,a ;restore clobbered character
jrst gotoit] ;and go to it!
syscal FILLEN,[movei chstao ? movem b]
.lose %lsfil
syscal ACCESS,[movei chstao ? b]
.lose %lsfil
pop p,a ;restore a
gotoit: .iot chstao,a ;echo it
.iot chttyo,a
cain a,^J ;end of command?
jrst [ .close chstao, ;close it off so it can be read
jrst popj1] ;all done
pushj p,comget ;gobble down another character
jrst gotoit ;and try again
defaul: cain a,^J ;EOL?
jrst comman ;losey lose
pushj p,combac ;regobble down last character
movei t,cpopj
movei b,txtdev ;Gobble filespec to set default device and sname.
pushj p,rfnm
jrst popj1
kill: pushj p,notify ;say who dun it
syscal DELETE,[['DSK,,] ? [sixbit/DONE/] ? [sixbit/QUEUE/] ? ['.XGPR.]]
jfcl ;don't really care
syscal RENMWO,[movei chcmdi ? [sixbit/DONE/] ? [sixbit/QUEUE/]]
jfcl ;don't really care at all!
.close chstao, ;close the statistics channel
.close chcmdi, ;close command channel
.logout
.break 16,160000
subttl parameter setting and examining commands
;Print out "Height".
shwhgt: movei e,height
romshw: caie a,12
jrst althuh
shwarg: skipe cmdfil
jrst popj1
move d,(e)
push p,a
pushj p,decpnt
jrst popaj1
;Print number of text lines per page.
setlin: movei e,nlines
jrst romshw
;positive only variables
onearg: cain a,12
jrst shwarg ;no arg, show what we have
pushj p,posarg
jrst badarg
movem d,(e)
jrst popj1
setlft: movei e,lftmar
jrst onearg
settop: skipa e,[topmar]
setbot: movei e,botmar
setvs1: pushj p,onearg
jrst badarg
setvs2: pushj p,caline ;recalculate nlines
jrst popj1
setlsp: caie a,12
pushj p,posarg
jrst shwarg
movem d,lsp
setom vsp ;can't have it both ways
jrst setvs2
settst: movei a,3
pushj p,cmdo
pushj p,cmdof
jrst comman
setvsp: caie a,12 ;vsp is a funny one
pushj p,posarg
jrst badarg
movem d,vsp
setom lsp
jrst setvs2
;any value legal variables
setx0: skipa e,[initx0]
sety0: movei e,inity0
jrst anyval
setffc: movei e,ffcut ;causes xgp to cut only on form feed
jrst anyval
setxtc: skipa e,[txtcmd]
setcut: movei e,autcut
anyval: cain a,12
jrst shwarg
pushj p,argin
jrst badarg
movem d,(e)
jrst popj1
;miscellaneous routines
rotate: movsi a,pltd2
hrri a,dobit
blt a,dobit+43
MOVSI A,QPLTD2
HRRI A,QDOBIT
BLT A,QDOBIT+43
jrst popj1
squish: setom sqshfl ;just set squish flag
jrst popj1 .see sndfnt
verse: caie a,12
jrst badarg
pushj p,vertyp ;type out version #
pushj p,crlf ;restores a to right thing!
jrst popj1
header: setzm hdrcnt ;sets heading text
cain a,12 ;null header
jrst popj1 ; is easy
movei b,hdrtxl*5 ;size of buffer
move c,[440700,,hdrtxt]
head1: pushj p,comget
sosl b ;don't overflow buffer
idpb a,c
aos hdrcnt
caie a,12 ;go until we find a line feed
jrst head1
jumpge b,popj1 ;jumpe if all is okay
movei b,[asciz /Header truncated/]
popj p,
; ;PLOT, ;SCAN, ;SAMPLE specify different operations to be done on the file to be printed.
; They can be followed by a filename on the same line.
plot: skipa b,[op%plt]
scan: movei b,op%scn
caia
sample: movei b,op%smp
movem b,opcode ;Note that the default value of OPCODE is op%txt (0),
jrst print ;for ordinary output.
;list prints files with default header (time, date, and page #)
list: setom dfhdrf ;flag for default header
print: skipe dskcmd
jrst print1 ;different things for dsk comnmands
sub p,[1,,1] ;Don't return to ALTER.
cain a,12 ;List, Plot, etc. just set flags if not followed by a filename.
jrst comman ;In that case we expect tha filename to follow on another line.
jrst coman2 ;Filename follows => read it and process the file.
;here to for print command while reading disk commands
print1: aose udepth
jrst popj1 ;only allow 1 level
pushj p,combac ;unread the last character
movei b,txtdev
movsi a,(sixbit />/)
movem a,txtfn2
movei t,cpopj
pushj p,rfnm
tlnn e,17
jrst print2 ;no file spec, ignore
setom newtxt
jrst popj1
print2: sos udepth ;not a different file after all
jrst popj1
;Print out all parameter settings and the selected font names.
show: skipe cmdfil
jrst popj1
push p,a
movei b,[asciz /Skip /]
movei e,pskip
pushj p,show1
irp var,,[Cskip,Tskip,Lsp,Vsp,Lftmar,Topmar,Botmar,Nlines,Autcut,Ffcut,Txtcmd,Delete]
movei b,[asciz /var! /]
movei e,var
pushj p,show1
termin
movei b,[asciz /Ksets:/]
pushj p,terpri
jrst kset0a
;Print a list of the specified fonts.
kset0: skipe cmdfil
jrst popj1
push p,a
kset0a: movei font,0
kset1: skipn fntfn2(font)
jrst kset69
pushj p,kset4
movei a,fnto(font)
pushj p,pntfnm ;print file name
pushj p,crlf
kset69: addi font,fntvln
caige font,maxfnt*fntvln
jrst kset1
pushj p,crlf
aos -1(p) ;do the skip return
jrst popxit
show1: pushj p,outstr
move d,(e)
pushj p,decpnt
jrst crlf
; ;KSET - Specify fonts, or, with no arg, list the specified fonts.
kset: cain a,12
jrst kset0
pushj p,combac ;un read the last character
pushj p,getf0 ;Get font file names.
popj p, ;error return
push p,a
movei font,0
kset2: skipn fntfn2(font)
jrst kset3
move a,fnto
skipn fnto(font)
movem a,fnto(font)
move a,fntsnm
skipn fntsnm(font)
movem a,fntsnm(font)
pushj p,fntopn
jrst [ skipe cmdfil
jrst kset3
pushj p,kset4
pushj p,fntfnf
pushj p,crlf
jrst kset3]
.close chfnti,
kset3: addi font,fntvln
caige font,maxfnt*fntvln
jrst kset2
jrst popaj1
kset4: move d,font
idivi d,fntvln
pushj p,decpnt
movei a,40
pushj p,tyo
jrst tyo
;Generate a sample of a font. Dispatch here when encounter a filename,
;when we see the opcode as set up by the ;SAMPLE command.
sampfil:
pushj p,vreset
pushj p,getf0
popj p, ;error
jumpn font,cpopj ;more chance for lossage
push p,a
move a,[fntbeg,,fntbeg+fntvln]
blt a,fntbeg+<fntvln*2>-1
move a,[['DSK,, ? sixbit /25FG/ ? 'KST,, ? sixbit /FONTS/],,fntbeg]
blt a,fntbeg+fntvln-1
movei font,0
samp1: setom fchflg(font)
pushj p,fntopn
jrst popaj ;lossage
.close chfnti,
setzm hdrcnt
movei a,fnto+fntvln
move c,[440700,,hdrtxt]
pushj p,samp3 ;put font name in page header
movei b,[asciz\ \]
pushj p,samp6
pushj p,hdrdat ;put today's date in header
pushj p,samp8 ;throw in some extra carriage returns
pushj p,samp8
move a,[['DSK,, ? sixbit /CODES/ ? sixbit />/ ? sixbit /FONTS/],,txtdev]
blt a,txtsnm
pop p,a
pushj p,comxit
jrst ptext ;Now output the sample text as an ordinary text file.
samp3: push p,a
move b,(a) ;device
camn b,[sixbit /DSK/] ;only AI has an XGP
move b,[sixbit /AI/]
pushj p,samp4
movei a,":
pushj p,samp5
move a,(p)
move b,3(a) ;sname
pushj p,samp4
movei a,";
pushj p,samp5
move a,(p)
move b,1(a) ;file name 1
pushj p,samp4
movei a,40
pushj p,samp5
pop p,a
move b,2(a) ;file name 2
samp4: movei a,0
lshc a,6
addi a,40
pushj p,samp5
jumpn b,samp4
popj p,
samp8: movei a,15
pushj p,samp5
movei a,12
samp5: aos hdrcnt
idpb a,c
popj p,
samp6: hrli b,440700
samp7: ildb a,b
jumpe a,cpopj
pushj p,samp5
jrst samp7
;:SKIP <n> command - set to skip first <n> pages of file
setpsk: movei e,pskip
cain a,12
jrst shwarg
xcski1: pushj p,posarg
jrst badarg
movns d
camge d,pskip ;pskip actually has minus number of pages to skip.
movem d,pskip
jrst popj1
;:CSKIP <n> <p> command - set to skip first <n> characters of file.
;Also remember that after doing so we will be on page <p>.
;This command is put into queue files by the requeueing mechanism.
xcskip: pushj p,posarg
caia
jrst badarg
camle d,cskip
movem d,cskip
jrst xcski1
; ;KSUBSET font bits bits bits bits
;Prespecify the result of a ;SQUISH, by saying which characters
;of font <font> (a font number) are actually needed.
;Each "bits" is an octal number specifying 32 bits,
;so there are 128 bits, one for each character. Each bit says whether
;the corresponding character is needed. The chars are in ascii order.
KSUBSE: pushj p,decin ;Read the font number.
jrst badarg
jumpl d,badarg
setom sqshfl
setom prsqsh ;indicate that ;SQUISH info is available.
movns d
movsi b,400000
lsh b,(d) ;get SQSHTB bit for that font.
setz c, ;C points to character to set or clear bit for.
ksubs1: push p,b
pushj p,spcsk2 ;Skip over any spaces, and read 1st char of number.
pushj p,octin ;read next 32-bit octal number, into D.
pop p,b
hrli c,-40 ;Set next 32 chars from this octal number.
ksubs3: andcam b,sqshtb(c) ;Set this font's bit of next char, in sqshtb,
tlne d,1_<31.-18.> ;according to next bit in the number.
iorm b,sqshtb(c)
lsh d,1 ;advance to next bit.
aobjn c,ksubs3 ;advance to next character. Each number handles 32 characters.
caie c,200 ;If not finished with all 200 chars, must be expecting
jrst ksubs1 ;another arg, so read it.
jrst popj1
subttl reset things between files
;Reset some things just for new file to be printed.
nreset: move a,[440700,,notbuf]
movem a,notpnt
irps x,,notflg notcnt notusr nothst notluz cmdfil qfn1
setzm x
termin
move a,[.iot chttyo,a]
movem a,tyo
setzm txtfn1
setzm txtfn2
setom newtxt
popj p,
; ;RESET command: Reset page sizes, etc.
reset: pushj p,vreset
aos (p)
jrst comxit
;reset variables
vreset: .core sbufp
.lose %lssys
movsi b,pltd1
hrri b,dobit
blt b,dobit+43
MOVSI B,QPLTD1
HRRI B,QDOBIT
BLT B,QDOBIT+43
setom sqshtb ;In case anyone looks, squish table says all chars
move b,[sqshtb,,sqshtb+1] ;of all fonts are needed.
blt b,sqshtb+177
setom filsiz ;We don't know file's size yet.
setzm pagpos ;Zero out pagpos in case we abort before start of printing.
move b,[pagpos,,pagpos+1]
blt b,pagpos+pagpsl-1
irps var,,prsqsh deltxt opcode page filptr pskip cskip tskip hdrcnt dfhdrf
setzm var
termin
irp var,,[vsp,lsp,lftmar,topmar,botmar,plines,autcut,txtcmd,udepth,initx0,inity0,sqshfl,ffcut]
move b,[i!var]
movem b,var
termin
;calculates # text lines in text area
caline: move d,plines
sub d,topmar
sub d,botmar
movem d,slines
skipge e,lsp ;use lsp if set
jrst calin1
skipge e,vsp
movei e,dvsp ;if vsp not set use default
add e,height
calin1: idiv d,e
movem d,nlines
popj p,
;reset fonts
freset: move a,[[sixbit /DSK/ ? sixbit /25FG/ ? sixbit /KST/ ? sixbit /FONTS/
25. ;height
20. ;base line
0 ;cpa
0 ;kst id
-1],,fntbeg] ;fchflg
blt a,fntbeg+fntvln-1
setzm fntbeg+fntvln
move a,[fntbeg+fntvln,,fntbeg+fntvln+1]
blt a,fntbeg+<fntvln*maxfnt>-1
setzm fntspc ;Say fonts have not been explicitly specified.
popj p,
;calculates size of page with current settings
size: movei font,0 ;do caluclations with this font
caie a,12
jrst size2 ;set size of page by specification in inches
skipe cmdfil
jrst popj1
push p,a
pushj p,fntopn
jrst [ pushj p,fntfnf
jrst pophuh]
.close chfnti,
jumple a,[ movei b,[asciz /Illegal height/]
jrst comer1]
move a,slines ;# scan lines in text area
add a,topmar
add a,botmar
idivi a,192. ;scan line density (lines/inch)
push p,b
move d,a
pushj p,decpnt
movei a,".
pushj p,tyo
move d,(p)
imuli d,1000. ;three decimal places suffices
idivi d,192. ;scan line density
movei a,"0
caige d,10.
pushj p,tyo
caige d,100.
pushj p,tyo
pushj p,decpnt
movei a,""
pushj p,tyo
skipn (p)
jrst size1
movei b,[asciz / (/]
pushj p,outstr
move d,(p)
pushj p,decpnt
movei b,[asciz \/192)\]
pushj p,outstr
size1: pop p,(p)
aos -1(p) ;skip return
jrst popxit
;here read page size in inches and set slines
size2: pushj p,argin ;read string of digits
jrst [ caie a,".
jrst badarg
jrst .+1]
jumple d,badarg
imuli d,1000. ;thousandths of inches
push p,d
cain a,12
jrst size4 ;no decimal
pushj p,comget ;get first digit for argin
cain a,15
jrst .-2
cain a,12
jrst size4
pushj p,argin
size3: jrst [ pop p,(d)
jrst badarg]
jumpl d,size3
imuli d,1000. ;thousandth's of inches
idiv d,c ;scale to # digits read
addm d,(p)
size4: pop p,d
imuli d,192.
idivi d,1000. ;scan lines in text area
move e,d
sub d,topmar
sub d,botmar
jumple d,[ movei b,[asciz /Top and bottom margins exceed size specified/]
popj p,]
movem e,plines
jrst setvs2 ;recalculate nlines and skip return
;here to transmit fonts in alter mode
fontsa: caie a,12
jrst huh
push p,a
movei font,0 ;if he's gone to all this trouble. . .
fonta1: skipe fntfn1(font) ;make sure a font is specified
setom fchflg(font) ;transmit all fonts
addi font,fntvln
caige font,maxfnt*fntvln
jrst fonta1
pushj p,fonts
jrst popaj
;here to transmit fonts
fonts: pushj p,clrkst ;clear all characters sets first
movei font,0 ;transmit fonts that need it
.core sbufp+fntpgs ;get extra pages to load fonts with.
jrst lossag
fonts0: aose fchflg(font)
jrst fonts1 ;dont need to send that one
pushj p,fntopn ;open font file (reads first 2 words)
jrst fntluz ;file not found
pushj p,sndfnt
.close chfnti,
fonts1: addi font,fntvln
caige font,maxfnt*fntvln
jrst fonts0
.core sbufp ;flush the extra core used for loading the fonts.
.lose %lssys
popj p,
;here to clear all ksets in pdp-11
clrkst: movei e,maxfnt-1
clrks1: movei a,0
pushj p,cmdo ;kset mode
pushj p,cmdo ;clear . . .
move a,e ;this character set
pushj p,cmdo
sojge e,clrks1
popj p,
subttl tty output routines
terpri: pushj p,outstr
crlf: movei a,15
pushj p,tyo
movei a,12
tyo: .iot chttyo,a
popj p,
sout: movei a,"*
jrst tyo
vertyp: move b,[.fnam1] ;print version number
pushj p,sixo
movei a,".
pushj p,tyo
move b,[.fnam2]
pushj p,sixo
pjrst crlf
sixo: move c,[440600,,b]
sixo1: ildb a,c
jumpe a,cpopj
addi a,40
pushj p,tyo
tlne c,770000
jrst sixo1
popj p,
outstr: hrli b,440700
outs1: ildb a,b
jumpe a,cpopj
pushj p,tyo
jrst outs1
;Decimal print number in D on terminal.
decpnt: jumpge d,decpn1
movei a,"-
pushj p,tyo
movms d
decpn1: idivi d,10.
hrlm e,(p)
jumpe d,decpn2
pushj p,decpn1
decpn2: hlrz a,(p)
addi a,"0
jrst tyo
;decimal output of number in D to notification string.
decnot: jumpge d,decno1
movei a,"-
pushj p,notyo
movms d
decno1: idivi d,10.
hrlm e,(p)
jumpe d,decno2
pushj p,decno1
decno2: hlrz a,(p)
addi a,"0
jrst notyo
;Octal printout of number in D.
octpnt: idivi d,10
hrlm e,(p)
jumpe d,decpn2
pushj p,octpnt
jrst decpn2
subttl files not found
txtluz: pushj p,txtfnf
jrst lossag
fntluz: pushj p,fntfnf
jrst lossag
txtfnf: movei a,txtdev
movei b,[asciz /Text /]
jrst fnf
fntfnf: movei b,[asciz /Font /]
movei a,fnto(font)
fnf: push p,a
pushj p,eprnt
pop p,b
move d,[440700,,pfnbuf]
pushj p,rfn"pfn ;Convert filenames to a string.
movei b,pfnbuf
pushj p,eprnt ;Print it on tty and into notification.
movei a,40
pushj p,tyo
pushj p,notyo
errtyp: .open cherri,['ERR ? 1]
.lose 1400 ;don't take no for an answer
errty1: .iot cherri,a
caige a,40
jrst [ .close cherri, ;any control character stop this non-sense
pushj p,crlf
jrst nocrlf]
pushj p,tyo
pushj p,notyo
jrst errty1
;print file name <- A on terminal.
pntfnm: push p,b
push p,d
move b,a
move d,[440700,,pfnbuf]
pushj p,rfn"pfn
movei b,pfnbuf
pushj p,outstr
popdbj: pop p,d
popbj: pop p,b
popj p,
;print file name <- A to notification string.
notfnm: push p,b
push p,d
move b,a
move d,[440700,,pfnbuf]
pushj p,rfn"pfn
movei b,pfnbuf
pushj p,notstr
jrst popdbj
;print filename to both terminal and notification.
errfnm: pushj p,pntfnm
movei b,pfnbuf
jrst notstr
subttl pdp10 - pdp11 channels
;gets pages from pdp-11
; call with 11 address in a and # bytes desired in b
get11: lsh b,-2 ;protection in 10 words
trz a,3 ;avoid possible embarassement
lsh a,10 ;10 style address
tlo a,600000 ;valid and write enable
movei c,xgp11
lsh c,26. ;pdp-11 #
ior a,c
get11a: movei c,1777 ;possible protection
camg b,c
move c,b ;only wants part of page
aos t11pag
ior c,a ;map entry
syscal T11MP,[t11pag ? c]
.value nopdp11
add a,[2000_12] ;set for next page
subi b,2000
jumpge b,get11a ;he wants more
popj p,
nopdp11:
asciz /: Cannot get PDP-11 pages 
/
;sends 8 bit byte to 11
cmdo: sosge t,cmdpar(chnl) ;get parity
movns t,cmdpar(chnl)
skipl @chhdrp(chnl)
jrst abrted ;channel closed by 11
idpb a,@cmdptr(chnl)
ibp @cmdptr(chnl)
sosle cmdcnt(chnl)
popj p, ;more room in buffer
;here to force buffer
cmdof: move t,cmdsiz(chnl) ;size of this buffer
sub t,cmdcnt(chnl) ;number of bytes room in buffer
jumpe t,cpopj ;don't force
skipl @chhdrp(chnl)
jrst abrted ;channel closed by 11
idpb t,cmdbuf(chnl) ;mark with valid count
ildb t,cmdbuf(chnl) ;next on ring
jumpe t,[ skipn @cmdbuf(chnl) ;10-11 interface is on level 7
.hang ;and so is rug
ldb t,cmdbuf(chnl)
jrst .]
pushj p,setcbf
.call [ setz ? 'TTYVAR ? movei chttyo ? ['IDLTIM] ? setzi 0 ]
jfcl ;We're doing something, zero idle time (for <esc>F)
skipl @cmdbuf(chnl)
.hang ;wait for that one to free up
cmdof1: push p,a
addi t,1 ;point at next ten word
ildb a,t ;size of this buffer
movem a,cmdcnt(chnl)
movem a,cmdsiz(chnl)
movei a,10 ;switch to 8 bit bytes
dpb a,[300600,,t]
movei a,0
exch a,t
movem a,@cmdptr(chnl)
addi t,1
ibp a
movem a,@cmdptr(chnl)
setzm cmdpar(chnl)
popaj: pop p,a
cpopj: popj p,
;here to open a 10-11 channel
open: skipl @chhdrp(chnl)
.hang
movei t,@chhdrp(chnl)
pushj p,adring ;will point to buffer 11 is hacking
pushj p,adring ;advance to next buffer
skipl (t)
jrst gronkd ;that buffer better be free
jrst cmdof1 ;found him set pointers
adring: ldb t,[042000,,(t)]
setcbf: sub t,buforg ;offset in bytes
skipge t
jrst gronkd ;pdp-11 buffers buggered
lsh t,-2 ;in pdp-10 words
add t,[442000,,buffer]
movem t,cmdbuf(chnl)
popj p,
;here to send word in a to 11
wrdo: push p,a
pushj p,cmdo ;low order byte first
move a,(p)
lsh a,-10 ;now high order byte
pushj p,cmdo
jrst popaj
;time sharing i/o routines
fntopn: setzm height(font)
setzm kstid(font)
move a,fntsnm(font)
syscal OPEN,[movsi .bii ? movei chfnti ? fnto(font) ? fntfn1(font) ? fntfn2(font) ? a]
popj p,
pushj p,fntin
movem a,kstid(font)
pushj p,fntin
hrrzm a,height(font)
push p,a
ldb a,[221100,,(p)]
movem a,base(font)
ldb a,[331100,,(p)]
movem a,cpa(font)
hrrzs (p) ;returns height of font in a
pushj p,caline
popaj1: pop p,a
popj1: aos (p)
popj p,
;Open text file and position TSKIP characters into the file.
;If the file is already open, just do the .access
txtopn: skipl a,newtxt
jrst txtopa
txtop2: syscal OPEN,[movsi .bai ? movei chtxti ? txtdev ? txtfn1 ? txtfn2 ? txtsnm]
popj p,
seto a,
setzm newtxt
setzm filptr ;Right after opening, we are at position 0 in the file.
setzm txtpos
setz b,
skipn tskip ;Just after opening, need not do .access
jrst txtopb ;to get to position 0.
txtopa: move c,a
move a,tskip
idivi a,5 ;Do the .access, with hair because of block mode.
syscal ACCESS,[%climm,,chtxti ? a]
jrst [ jumpe c,txtop2 ;Not random access device => reopen file (unless we just did)
move b,tskip ;Skip all those chars from the beginning.
jrst txtopb]
movem a,filptr ;The ACCESS has changed our position in the file.
imuli a,5
movem a,txtpos
txtopb: push p,b ;B has number of characters to skip now.
pushj p,txtop1 ;initialize buffering
pop p,b
jumpe b,popj1
pushj p,txti ;If must skip a few extra chars into the word,
sojg b,.-1 ;read them out of the buffer.
jrst popj1
txtop1: setzm txtflg ;We have not encountered EOF yet.
setzm txtrhd ;We have no word of read-ahead in core.
;reload the text-file input buffer.
txtbf: skipge a,txtflg
popj p, ;found eof on previous refill => exit.
setzm txtbuf
move a,[txtbuf,,txtbuf+1]
blt a,txtbuf+txtbfl-1
move a,[440700,,txtbuf]
movem a,txtptr
move a,[-txtbfl,,txtbuf]
skipl txtrhd ;Is there a word of read-ahead?
jrst txtbf1
move a,txtrhw ;Yes => store it at front of buffer,
movem a,txtbuf
setzm txtrhd
move a,[1-txtbfl,,txtbuf+1] ;and any further file input follows it.
txtbf1: .iot chtxti,a
movem a,txtflg ;TXTFLG is set negative if we are at EOF.
jumpge a,[
move a,txtbuf+txtbfl-1
movem a,txtrhw ;If no eof, take last word and save as read-ahead.
setom txtrhd
movei a,txtbfl*5-5
movem a,txtcnt ;Don't count it as part of this buffer.
movei a,txtbfl-1 ;Update FILPTR, the count of words of file
addm a,filptr ;ALREADY PROCESSED (includes prev. buffer, not this one).
movei a,0
popj p,]
movei a,0
hlro a,txtflg ;calculate # words read
addi a,txtbfl
push p,a
imuli a,5 ;# characters read
movem a,txtcnt
pop p,a ;Now discard padding characters from end of buffer.
addi a,txtbuf
setom txtbuf-1 ;Don't lose if buffer is all padding!
hrli a,010700 ;bp to last byte of last occupied word in buffer
push p,b
dbplr: ldb b,a ;go backward char by char.
jumpe b,dbpl ;null, ignore
caie b,3
cain b,14
jrst dbpl ;either eof char or form feed, flush
txtbix: movei a, ;On reaching non-padding char, we are done.
pop p,b
popj p,
dbpl: movei b,0 ;For a padding character, delete it from the buffer
dpb b,a ;by turning it into a null character.
add a,[070000,,] ;backup the byte pointer
jumpge a,dbplr ;return to check this char
sos a
hrli a,10700 ;back up a word worth
jrst dbplr
;here to get one character from text buffer
txtbfi: pushj p,txtbf
jumpl a,cpopj ;eof
txti: sosge txtcnt
jrst txtbfi
ildb a,txtptr
aos txtpos
popj p,
;Peek ahead at the next character from the text buffer.
txtpek: skipn txtcnt
jrst [ pushj p,txtbf
jumpl a,cpopj
jrst txtpek]
move a,txtptr
ildb a,a
popj p,
;here to get word from font file
fntin: hrroi x,a
.iot chfnti,x
popj p,
;;; routine to pre-scan text file and decide what chars are needed.
;;; sets bits in sqshtb for the sndfnt routine to look at.
;;; skips on ***** failure **** to open the text file.
.see recycl
prescn: setzm sqshtb ;clear bit table
move a,[sqshtb,,sqshtb+1]
blt a,sqshtb+177
pushj p,txtopn ;open text file
jrst popj1 ;failed
skipa e,[400000,,0] ;initially in font 0
prsc0: iorm e,sqshtb(a) ;here if char is actually used (set bit)
prsc1: pushj p,txti ;gobble char from file
jumpl a,cpopj ;exit on eof
jrst @.+1(a)
prsc1 ;null
repeat 7, prsc0 ;normal guys
repeat 3, prsc1 ;bs, tab, lf
prsc0 ;^K (normal)
repeat 2, prsc1 ;ff, cr
repeat 176-^M, prsc0 ;normal guys
prsc2 ;rubout (xgp escape)
prsc2: pushj p,txti ;xgp escape. Read escaped character.
jumpl a,cpopj ;EOF??
jrst @.+1(a)
prsc0 ;normal
prsc3 ;xgp escape 1 (gobbles n bytes)
prsc3c ;xgp escape 2 (gobbles 1 byte)
prsc3b ;xgp escape 3 (gobbles 2 bytes)
prsc11 ;xgp escape 4 (gobbles 11. bytes)
repeat 3, prsc1 ;reserved
repeat 3, prsc0 ;bs, tab, lf -- normal
prsc1 ;reserved
repeat 2, prsc0 ;ff, cr -- normal
repeat 37-^M, prsc1 ;reserved
repeat 137, prsc0 ;normal guys
prsc0 ;rubout -- normal
prsc3: pushj p,txti ;escape 1. Read command character.
jumpl a,cpopj ;EOF??
jrst @prst(a)
prst: repeat 40, prsc3a ; font select
prsc3b ;40 column select (2 bytes)
prsc3c ;41 ! underscore (1 byte)
prsc3c ;42 " line space (1 byte)
prsc3c ;43 # absolute base line adj (1 byte)
prsc1 ;44 $ page number (no bytes)
prsc3d ;45 % heading (count, then n bytes)
prsc1 ;46 & start underline (no bytes)
prsc3c ;47 ' stop underline (1 byte)
prsc3c ;50 ( interchar spacing (1 byte)
prsc3b ;51 ) variable width underline (2 bytes)
prsc3c ;52 * relative base line adjust (1 byte)
prstl==.-prst
repeat 200-prstl, prsc1 ;reserved
prsc3a: movsi e,400000 ;font select
movns a
lsh e,(a)
jrst prsc1
prsc3b: pushj p,txti ;skip 2 bytes
prsc3c: pushj p,txti ;skip 1 byte
jrst prsc1
prsc3d: pushj p,txti ;skip n bytes
skipa d,a
prsc11: movei d,11. ;skip 11. bytes
prsc3e: sojl d,prsc1
pushj p,txti
jrst prsc3e
comment $ MIT font format and CMU font format
words 0-1
kstid
byte (9) column_position_adjustment,base_line (18) height
;base line # rasters from top of character matrix
remainder of file: one block of data for each character
user_id
;not used 4/10/74 but low order bit must be 1
left_kern,,code
;left kern always 0 for cmu
raster_width,,character_width
;raster width always 0 for cmu
character_matrix
;the matrix is stored 4 8-bit bytes per word so that
;ildb with 8-bit byte size gets successive bytes.
;the bits are bit reversed in each byte (high order
;bit of character in low order bit of byte).
;the matrix is stored row by row.
$
;transmits font over command channel
;Assume that we have 20 extra pages at SBUF to read it in via.
sndfnt: move a,[-fntpgs*2000,,sbuf]
.iot chfnti,a ;read the whole font into core.
jumpge a,[
movei b,[asciz /Font too large to process: /]
jrst sndluz]
move z,[444400,,sbuf] ;fetch the font file words with ildb off Z.
move a,font ;convert font index to font #
idivi a,fntvln
movn b,a
movsi x,400000
lsh x,(b) ;x has bit for sqshtb
skipge sqshfl
skipe tpages
caia
jsp e,sqchk ;don't send font if no characters used
push p,a ;save font #
movei a,0 ;escape to kset
pushj p,cmdo
movni a,1 ;load this font
pushj p,cmdo
pop p,a ;font #
pushj p,cmdo
move a,height(font) ;height
pushj p,wrdo
move a,base(font) ;base line
pushj p,wrdo
sndfn0: ildb a,z ;ignore user id
trnn a,1 ;check terminating bit
jrst [ movei b,[asciz /Bad font: /]
jrst sndluz]
sndf0a: ildb a,z ;character code
move e,a
hrrzs a ;clear kern info
caile a,177
hrroi a,200 ;any illegal character stops us
skipge sqshfl ;if squishing, and if not end of font,
skipe tpages
caia
jumpge a,sndf7 ; then decide whether to send character
sndf0h: movem a,lstchr
pushj p,cmdo ;"send" it
jumpl a,sndfxt ;force buffer and exit
hlres e ;left kern
add e,cpa(font) ;fudge cpa into kern
movn a,e ;fudge for the pdp-11 program
pushj p,cmdo
ildb a,z ;raster width,,character width
jumple a,[movei b,[asciz /Zero or negative char width: /]
jrst cfntnm ;0 or negative width
]
add a,e ;fudge in kern and column position adjustment
jumple a,[ movei b,[asciz /Kern or CPA problem: /]
jrst cfntnm
] ;half hearted check
pushj p,wrdo ;spacing width
tlne a,-1
hlrzs a
pushj p,wrdo ;raster width
addi a,7
lsh a,-3 ;# 8 bit bytes per row
movem a,bypr ;byts per row
move e,height(font)
move c,bypr
sndf1: ildb a,z
move d,a ;bytes come packed 4 per word
move b,[441000,,d] ;this is how we unpack them
sndf2: ildb a,b
pushj p,cmdo
sojle c,sndf5 ;thats all for this row
sndf21: tlnn b,700000
jrst sndf1 ;that's all for this word
jrst sndf2
cfntnm: pushj p,eprnt
move d,lstchr'
pushj p,decpnt
move d,lstchr'
pushj p,decnot
movei b,[asciz /. /]
sndluz: pushj p,eprnt
movei a,fnto(font)
pushj p,errfnm
pushj p,nocrlf
pushj p,crlf
jrst lossag
sndf5: move c,bypr
movei a,0
trne c,1 ;if odd # of bytes, send a 0 byte
pushj p,cmdo
sojle e,sndfn0 ;thats all for this char
jrst sndf21
;here to decide whether to send char in squish mode
sndf7: tdne x,sqshtb(a) ;if bit not set in sqshtb,
jrst sndf0h ; must skip over character
ildb a,z ;skip raster width,,character width
sndf7a: ildb a,z
trnn a,1 ;bit 1.1 => user id for next char
jrst sndf7a
jrst sndf0a
;here exit sndfnt
sndfxt: pushj p,cmdof ;force buffer
skipge kstlod ;wait for pdp-11 to finish
.hang
ldb d,[242000,,kstlod] ;# characters missed
jumpe d,cpopj
push p,tyo ;If font didn't fit, print error message
move a,[jrst notyo] ;to tty or notification
skipe cmdfil
movem a,tyo
pushj p,decpnt ;saying how many characters didn't make it.
movei b,[asciz / characters of font /]
pushj p,outstr
move d,font
idivi d,fntvln
pushj p,decpnt ;print font #
movei a,",
pushj p,tyo
movei a,40
pushj p,tyo
movei a,fnto(font)
pushj p,pntfnm
movei b,[asciz /, didn't fit.
/]
pushj p,outstr
pop p,tyo
popj p,
;scan through sqshtb for this font, if no characters in this font
;are used the take popj return other wise return to sndfnt
sqchk: movei b,177 ;character code
sqchk1: tdne x,sqshtb(b)
jrst (e) ;found a character that is used in this font
sojge b,sqchk1
popj p, ;no characters in this font used
;SNDTXT - prepare for sending text to the pdp-11.
;Take care of skipping pages or characters, and of the default header.
;Then go to XGPLPT to do the real work.
sndtxt: syscal fillen,[%climm,,chtxti ? %clout,,filsiz]
setom filsiz ;How big is this file? So XGP^F can tell people.
setzm page
aos page ;start printing on page 1
aosn dfhdrf ;want default header?
pushj p,defhdr ; yes
move a,cskip ;Skip to specific character position if desired.
came a,tskip
pushj p,skpchr
sndtx1: skipl pskip ;skiping pages
jrst sndtx2 ;no, print some goodies
pushj p,txti ;get a character
cain a,177 ;rubout is escape character
pushj p,txtrub ;process rubout
jumpl a,cpopj ;eof while skipping?
caie a,^L ;page mark?
jrst sndtx1
aos pskip
aos a,page
skipn tpages ;If we are doing title pages, see if they are finished.
jrst sndtx1
camle a,tpages ;They can be finished because we have done
jrst ptext ;the required number of pages, or
pushj p,txtpek
caie a,^L ;because we come to an empty page.
jrst sndtx1
pushj p,txti ;And skip the empty page.
jrst ptext
;Now that we have reached the place to start actually printing,
;set up the data base of the starting char positions of the last few pages.
sndtx2: move a,txtpos
movem a,pagpos ;init page position buffer to the starting point.
move a,[pagpos,,pagpos+1]
blt a,pagpos+pagpsl-1
move a,page
movem a,baspag ;Remember which page number we are starting printing at.
move a,tskip
movem a,ttlpos ;Also remember tskip value at start of each page.
move a,[ttlpos,,ttlpos+1]
blt a,ttlpos+pagpsl-1
jrst xgplpt
skpchr: idivi a,5 ;Skip to char pos in A, assuming current pos is TXTPOS.
syscal ACCESS,[%climm,,chtxti ? a]
jrst [ imuli a,5 ;Not random access device =>
add b,a
sub b,txtpos ;read forward to desired position.
jrst skpch1]
movem a,filptr ;Update remembered position in file for what ACCESS did.
imuli a,5
movem a,txtpos
setzm txtrhd ;We have no word of read-ahead in core now.
skpch1: setzm txtcnt
movn a,pskip ;Initialize PAGE to the number of the page which
addm a,page ;the character we are going to is located on.
setzm pskip ;But don't skip those pages over again.
jumpe b,cpopj
pushj p,txti ;Then skip the excess characters.
sojg b,.-1
popj p,
;here to process rubout while skipping pages in the text file
txtrub: pushj p,txti ;get next character
jumple a,cpopj ;eof?
caile a,txtrdl ;legal control code
jrst rubsxt ;no, just clobber a and return
jrst @.(a) ;dispatch
txtrdo: rubca ;1 complicated
rubs1 ;2 column increment, soaks up 1 character
rubs2 ;3 skip to scan line, soaks up 2 characters
rubs13 ;4 vector, soaks up 13 characters
txtrdl==.-txtrdo
;soaks up characters from input stream, looks for eof
rubs3: skipa b,[3]
rubs13: movei b,13
jrst rubs
rubs1: skipa b,[1]
rubs2: movei b,2
rubs: pushj p,txti ;get character
jumpl a,cpopj ;eof?
sojg b,rubs
rubsxt: movei a,0 ;clobber character
popj p,
;here to process rubout<cntrl-a>
rubca: pushj p,txti ;get character
jumpl a,cpopj ;eof?
caige a,maxfnt ;font switch?
move font,a
subi a,37 ;look for other control codes
jumple a,rubsxt ;under?
caile a,txtadl ;over?
jrst rubsxt
jrst @.(a) ;dispatch
txtado: rubs2 ;40 column select
rubs3 ;41 ! underscore
rubs1 ;42 " line space
rubs1 ;43 # absolute baseline adjust
rubsxt ;44 $ print page number
takhdr ;45 % accept heading text
rubsxt ;46 & start underline
rubs1 ;47 ' stop underline
rubs1 ;50 ( set intercharacter spacing
rubs2 ;51 ) varible width underline
rubs1 ;52 * relative baseline adjust
rubs3 ;53 + relative baseline underscore
txtadl==.-txtado
;send heading text to the PDP-11
takhdr: pushj p,txti ;get character count of header
movem a,hdrcnt
jumple a,cpopj ;eof?
setzm hdrtxt ;clear header buffer
move a,[hdrtxt,,hdrtxt+1]
blt a,hdrtxt+hdrtxl-1
move b,hdrcnt ;prepare to read header text
move c,[440700,,hdrtxt]
movei d,hdrtxl*5
tkhdr1: pushj p,txti
jumpl a,cpopj ;eof?
sosl d
idpb a,c
sojg b,tkhdr1
jumpge d,rubsxt
addm d,hdrcnt ;d has -# characters lost
jrst rubsxt
;set up the default header
defhdr: setzm hdrcnt
move c,[440700,,hdrtxt]
pushj p,hdrdat
move a,[chtxti,,chsts]
.rchst a,
movei a,chsts
hrlzs chsts
pushj p,samp3 ;file name
movei b,tensp
pushj p,samp6
movei b,[asciz /Page <20>$
/]
pushj p,samp6
movei a,hdrtxl*5
movei b,[asciz /Header buffer overflow/]
camge a,hdrcnt
pjrst terpri
popj p,
tensp: asciz / /
;Store today's date into the header buffer.
hdrdat: .rlpdt a,
ldb a,[320300,,b] ;get day of week (0 => sunday)
move b,[ [asciz /Sun/]
[asciz /Mon/]
[asciz /Tues/]
[asciz /Wednes/]
[asciz /Thurs/]
[asciz /Fri/]
[asciz /Satur/]](a)
pushj p,samp6
movei b,[asciz /day, /]
pushj p,samp6
.rdate b,
lshc a,2*6 ;two six bit characters is year
lsh a,44-<2*6> ;suitable for six bit printing
push p,a
movei a,0
lshc a,6 ;first digit of month
movei d,-20(a)
imuli d,10.
movei a,0
lshc a,6 ;second digit of month
addi d,-20(a)
push p,b
move b,[ [asciz /????/]
[asciz /January /]
[asciz /February /]
[asciz /March /]
[asciz /April /]
[asciz /May /]
[asciz /June /]
[asciz /July /]
[asciz /August /]
[asciz /September /]
[asciz /October /]
[asciz /November /]
[asciz /December /]](d)
pushj p,samp6
pop p,b
movei a,0 ;print day of month
lshc a,6 ;get first digit
caie a,'0 ;don't print leading zero
lshc a,-6
pushj p,samp4
movei b,[asciz /, 19/]
pushj p,samp6
pop p,b
pushj p,samp4 ;year
movei a,40
pushj p,samp5
pushj p,samp5
pushj p,samp5
.rtime b, ;date
lshc a,2*6
lsh a,6
iori a,':
lshc a,2*6
lsh a,6
iori a,':
push p,b
move b,a
pushj p,samp4
pop p,b
pushj p,samp4
movei b,tensp
pushj p,samp6 ;ten spaces
popj p,
;here to print the real goods
xgplpt: movei a,1 ;escape to "mixed"
pushj p,cmdo
skipl lsp ;lsp specified
jrst sndvar ; lsp is specified, use it
skipge a,vsp
movei a,dvsp ;vsp was not specified, use the default value
add a,height
movem a,lsp
sndvar: movei a,zz
pushj p,cmdo ;send count of number of parameter that follow
zz==0
irp b,,[lsp,lftmar,topmar,botmar,plines,page,autcut,ffcut]
zz==zz+1
move a,b
pushj p,wrdo
termin
pushj p,cmdof ;force output
movei chnl,dochnl ;all the rest goes on data out
pushj p,open
pushj p,sndrca ;send rubout<cntrl-a>
move a,font ;do explicit font select
pushj p,cmdo
skipg b,hdrcnt ;send header text?
jrst xgplop
pushj p,sndrca
movei a,45 ;accept header text
pushj p,cmdo
move a,hdrcnt
pushj p,cmdo
move c,[440700,,hdrtxt]
ildb a,c
pushj p,cmdo
sojg b,.-2
move c,[440700,,hdrtxt] ;and now we send it
xgplp1: ildb a,c ;so that it appears as header of first page
pushj p,cmdo
sosle hdrcnt
jrst xgplp1
xgplop: pushj p,txti
jumpl a,txteof ;eof?
cain a,177
jrst xgplp7 ;rubout, process escape without form feed check
cain a,14
jrst xgplp4 ;form feed, count pages printed
xgplp0: pushj p,cmdo
aose abortf
jrst xgplop
pushj p,txteof ;Abort! First, phony an EOF in the text stream.
jrst abort ;Then abort, returning to RECYCL.
;When ^L is seen, update the data base of where the last few pages started in the file.
xgplp4: aos b,page
skipn tpages ;If we are doing title pages, see if they are finished.
jrst xgplp5
camle b,tpages ;They are finished if we have done enough pages
jrst [ pushj p,txteof
jrst ptext]
pushj p,txtpek
caie a,^L ;or if we come to an empty page.
jrst xgplp5
pushj p,txti ;Skip the empty page.
pushj p,txteof
jrst ptext
xgplp5: movei a,^L
move b,[pagpos+1,,pagpos]
blt b,pagpos+pagpsl-2 ;Make sure that PAGPOS contains the char pos
move b,txtpos ;of the start of the page pagpsl pages ago.
movem b,pagpos+pagpsl-1
move b,[ttlpos+1,,ttlpos]
blt b,ttlpos+pagpsl-2 ;Also remember the tskip values at the start of each page.
move b,tskip
movem b,ttlpos+pagpsl-1
jrst xgplp0
xgplp7: pushj p,cmdo
pushj p,txti
jumpl a,txteof ;eof
caile a,4
jrst xgplp0
jrst @.+1(a)
xgplp0
xgplr1
xgplr2
xgplr3
xgplr4
xgplr2: movei b,1
jrst xgplr5
xgplr3: movei b,2
jrst xgplr5
xgplr4: movei b,13
xgplr5: movem b,xgplcn'
xgplr6: pushj p,cmdo
pushj p,txti
jumpl a,txteof
sosle xgplcn
jrst xgplr6
jrst xgplp0
xgplr1: pushj p,cmdo
pushj p,txti
jumpl a,txteof
cail a,40
caile a,40+txtadl
jrst xgplp0
skipe b,[2 ? 3 ? 1 ? 1 ? 0 ? 0 ? 0 ? 1 ? 1 ? 2 ? 1]-40(a)
jrst xgplr5
jrst xgplp0
;sends rubout<cntrl-a>
sndrca: movei a,177
pushj p,cmdo
movei a,1
jrst cmdo
txteof: movei a,200 ;eof code
pushj p,cmdo
pushj p,cmdof ;force buffer
movsi a,400000
andcam a,@chhdrp(chnl) ;close data out channel
popj p, ;and return
subttl interrupt routines and abort logic
tsint: 0
0
push p,a
skipge a,tsint
jrst ttybrk ;tty channel interupt
tlze a,%pjrlt
pushj p,tsclk ;clock interupt
trze a,%picli
pushj p,cliint ;cli tells us to quit.
trze a,%piioc
jrst iocerr ;io channel error
jrst tsx
ttybrk: trzn a,1_<chttyi>
jrst tsx
movei a,chttyi
.ityic a,
jrst tsx
caie a,^X
cain a,^G ;Avoid having our input buffer get full
.reset chttyi, ;slowly due to many quits.
cain a,^X ;XEROX XGP hardware person come in?
setcmm maintp ;complement maintenence flag
skiple forms
caie a,^G ;If get ^G while asking for a forms change,
jrst ttybr1
move a,oforms ;Indicate old forms still in the machine,
movem a,forms ;and check queue again.
.dismi [recycl]
ttybr1: cain a,^G
pushj p,quit
tsx: hrrz a,tsint+1 ;unhang from idle wait
cain a,fwait1
aos tsint+1
pop p,a
.dismi tsint+1
cliint: .iopush chfoo, ;CLI interrupt. Discard the CLI file and quit.
.open chfoo,[sixbit / CLA/]
.lose
.close chfoo,
.iopop chfoo,
setzm quitf
aosa quitf ;1 so ABFLSF will be left 0.
;Here when ^G is typed. Set ABORTF to request abort at some later time.
;Set QUITF so that that abort will ask user whether to requeue.
quit: setom quitf ;-1 so will ask user whether to requeue.
setom abortf
setzm abflsf
push p,b
movei b,[asciz /Quit! /]
pushj p,eprnt
jrst popbj
;Here from ABORT when it sees QUITF set to -1.
;Ask user whether to requeue and set ABFLSF if no.
quit0: push p,b
push p,lsterr
movei b,[asciz /Asking question/]
movem b,lsterr
movei b,[asciz/ Requeue remainder of file?/]
pushj p,outstr
quit1: movei a,[asciz/waiting for Y or N after ^G/]
pushj p,tyi
push p,a
pushj p,crlf
pop p,a
cail a,141
subi a,40
cain a,"N
setom abflsf
caie a,"N
cain a,"Y
jrst quit2
movei b,[asciz/ [Y or N]/]
pushj p,outstr
jrst quit1
quit2: pop p,lsterr
pop p,b
popj p,
tsclk: move a,abortl ;Clock interrupts every 10 seconds.
tlz a,777774 ;Has the pdp-11 signaled an abort?
jumpe a,delchk ;not aborted => do pending deletions.
.dismi [crash]
;here for io channel error
iocerr: pushj p,txteof ;We will abort; prevent 11 from aborting a second time.
movei b,[asciz /IO channel error: /]
pushj p,eprnt
.suset [.rbchn,,a]
cain a,chfnti ;is it font lossage
jrst [ pushj p,fntfnf
jrst iocer1]
cain a,chtxti ;perhaps it is the text file
jrst [ pushj p,txtfnf
jrst iocer1]
pushj p,errtyp ;huh? what's this channel
iocer1: .close chtxti,
.close chfnti,
pushj p,error ;Prepare for abort due to unexpected error.
movei a,10.*30. ;Sleep a while to give network or whatever a chance to recover.
.sleep a,
.dismis [abort] ;Notify user, then try again to print.
error: setzm delbeg
move b,[delbeg,,delbeg+1]
blt b,delend
setzm quitf
setzm abflsf
popj p,
eprnt1: movem b,lsterr
movei b,[asciz / -- /]
pushj p,eprnt
move b,lsterr
eprnt: skipe cmdfil
pushj p,notstr
jrst outstr
subttl abort signalled by pdp11
;Mysterious lossage in opening a channel to the pdp-11.
abrted: movei b,[asciz/Listing aborted by pdp11/]
pushj p,eprnt
movem b,lsterr
jrst crash1
;Error condition reported asynchronously by pdp-11 program
crash: movei b,[asciz/Listing aborted by pdp11/]
pushj p,eprnt
movem b,lsterr
move c,abortl+1 ;Get the error flags.
movei d,10
movem d,abortl
lsh c,-24
movem c,idlep ;Indicate XGP losing for queue status.
trne c,4
pushj p,e5
trne c,10
pushj p,e4
trne c,20
pushj p,e3
trne c,40
pushj p,e2
trne c,200
pushj p,e1 ;Print and remember the error message.
crash1: move a,pagpos ;Make sure we requeue from pagpsl pages back.
movem a,pagpos+pagpsl-1
move a,ttlpos
movem a,ttlpos+pagpsl-1
movni a,pagpsl-1
add a,page
camge a,baspag
move a,baspag
movem a,page
pushj p,crlf
pushj p,crlf
pushj p,nocrlf
pushj p,error
pushj p,abort0 ;Notify user, requeue file.
.reset chttyi, ;Now try to get the XGP fixed.
movei b,[asciz /
Waiting for corrective action.
Type any character to continue ->/]
pushj p,outstr
setzm cmdfil ;clear reading from a command file flag
.reset chttyi,
move a,lsterr
pushj p,tyi ;wait for the char. notify queue if wait too long.
setom idlep ;claim to be idle again
pushj p,crlf
pushj p,crlf
jrst recycl
e1: movei b,[asciz /out of paper/]
jrst eprnt1
e2: movei b,[asciz /paper jam (power off)/]
jrst eprnt1
e3: movei b,[asciz /fuser cold/]
jrst eprnt1
e4: movei b,[asciz /paper jam (filament cold)/]
jrst eprnt1
e5: movei b,[asciz /out of web or out of paper/]
jrst eprnt1
abort: setzm lsterr
skipge quitf ;If quitting from terminal, ask user whether to requeue file.
skipn cmdfil ;But not if there isn't any queue file.
caia
pushj p,quit0
pushj p,abort0 ;Abort the current queue file
pushj p,crlf
jrst recycl ;and look for another.
;QUITF indicates a ^G, ABFLSF indicates ^G and don't requeue, LSTERR indicates XGP losing.
;LSTERR zero means an IOC error or similar problem with the file.
abort0: sosg d,page ;D and PAGE get # pages we trust were really printed.
setzb d,page
syscal open,[[.uai,,chtxti] ? [sixbit/dsk/]
qfn1 ? qfn2 ? [sixbit/.xgpr./]]
setom abflsf ;Queue file has been deleted => say it is being cancelled.
.close chtxti,
movei b,[asciz/Cancelled after /]
skipn abflsf
movei b,[asciz/Printing interrupted after /]
pushj p,eprnt
push p,d
pushj p,decpnt
pop p,d
push p,tyo
move b,[jrst notyo]
movem b,tyo
skipe cmdfil
pushj p,decpnt
pop p,tyo
movei b,[asciz/ pages./]
pushj p,eprnt
pushj p,crlf
skipn cmdfil
jrst abort9
movei b,[asciz /
Please come to the XGP to fix this condition.
When it is fixed, printing will be resumed./]
skipn lsterr
movei b,[asciz /
An attempt will be made to reopen the file./]
skipn quitf
pushj p,notstr
pushj p,notify
skipe abflsf ;Either flush the file,
jrst abort7
jrst abort2 ;or requeue or continue it.
;Requeue a file (either at beginning or at end, according to QUITF).
;We requeue the file by adding new commands at the front of the queue file
;and putting it back in the queue in the right place.
;The new commands are ;CSKIP, ;TSKIP and ;KSUBSET and they say
;where in the file to resume printing.
;The new commands are followed by a ^L which precedes the original queue file.
;This is so that when a file is requeued a second time the commands added
;the first time can be flushed.
abort2: syscal open,[[.uai,,chtxti] ? [sixbit/dsk/]
qfn1 ? qfn2 ? [sixbit/.xgpr./]]
.lose %lsfil
syscal open,[[.uao,,chfoo] ? [sixbit/dsk/]
[sixbit/_queue/] ? [sixbit/output/] ? [sixbit/.xgpr./]]
.lose %lsfil
push p,tyo
move a,[.iot chfoo,a]
movem a,tyo
skipg d,pagpos+pagpsl-1
jrst abort8
movei b,[asciz /;CSKIP /]
pushj p,outstr ;Put a ;CSKIP <position of first suspect page> CRLF
pushj p,decpnt ;at the front of the queue file.
movei b,[asciz / /]
pushj p,outstr ;Also output the number of that page
move d,page ;so that the page numbers will be right after we requeue.
pushj p,decpnt
pushj p,crlf
skipn d,ttlpos+pagpsl-1
jrst abort8
movei b,[asciz /;TSKIP /]
pushj p,outstr ;Also arrange to skip over any titles already output.
pushj p,decpnt
pushj p,crlf
;If we have done a ;SQUISH, output ;KSUBSET commands to save the info
;so we need not repeat the squish when we start up again.
abort8: skipn sqshfl
jrst abfnt5
move d,[-maxfnt,,0]
;Write a ;KSUBSET command to save the info on the font w/ number in rh(D).
abfnt1: hrrz c,d
imuli c,fntvln ;Don't output a KSUBSET command for a non-existent font.
skipn fntfn1(c)
jrst abfnt4
movsi c,400000
movn b,d
lsh c,(b) ;Get the SQSHTB bit for the font we will do next.
movsi a,-200
tdne c,sqshtb(a) ;Are all chars of the font needed (default state)?
aobjn a,.-1
jumpge a,abfnt4 ;Yes => there is no need for a KSUBSET cmd for this font.
movei b,[asciz /;KSUBSET /]
pushj p,outstr
push p,d
andi d,-1
pushj p,decpnt ;Output ;KSUBSET <n> where <n> is the font number.
setz a,
abfnt2: hrli a,-40 ;Output 4 32-bit octal numbers
setz d,
abfnt3: lsh d,1
tdne c,sqshtb(a) ;32 characters go into making up each number.
iori d,1
aobjn a,abfnt3
push p,a
.iot chfoo,[" ] ;After handling 32 characters,
pushj p,octpnt ;output the number,
pop p,a
caie a,200 ;and go on to the next 32 characters.
jrst abfnt2
pushj p,crlf
pop p,d
abfnt4: aobjn d,abfnt1 ;Do this for each font.
abfnt5: .iot chfoo,[^L] ;^L separates stuff added on requeueing from original stuff.
pop p,tyo
abort3: .iot chtxti,a ;Now skip all of the old queue file up through the ^L,
jumpl a,[ ;but if there's no ^L, don't skip anything;
.access chtxti,[0] ;go back to the beginning.
jrst abort6]
caie a,^L
jrst abort3
abort6: .iot chtxti,a ;Copy all but what we skipped
jumpl a,abort4 ;from the old queue file into the new one.
.iot chfoo,a
jrst abort6
abort4: skipe quitf
jrst abort5
syscal renmwo,[movei chfoo ? qfn1 ? qfn2]
.lose %lsfil
move a,qfn1
movem a,dothis ;endeavor to do same request again when restarted
jrst abort7
abort5: syscal renmwo,[movei chfoo ? qfn1 ? [sixbit/>/]] ;to end of same queue
.lose %lsfil
abort7: syscal delete,[[sixbit/dsk/] ? qfn1 ? qfn2 ? [sixbit/.xgpr./]]
jfcl
abort9: .close chtxti,
.close chfoo,
.close chcmdi,
popj p, ;done aborting
subttl cry for help
;Call CRY to notify everyone on the XGP queue that the XGP is in trouble.
;A contains the address of the string which describes the problem.
cry: syscal open,[[.bii,,chfoo] ? ['dsk,,] ? ['.file.] ? [sixbit/(dir)/] ? ['.xgpr.]]
popj p,
.core sbufp+1 ;Make a page to hold the directory.
popj p,
move b,[-2000,,sbuf] ;We will look at each file in the .XGPR. directory.
.iot chfoo,b
.close chfoo,
cryyes: syscal OPEN,[[.uao,,chmail] ? ['DSK,,] ? [sixbit/_XGPSP/] ? [sixbit/OUTPUT/]
['.MAIL.]] ; write a mail file
popj p,
push p,a ;Save the error string.
movei b,[ASCIZ /FROM-JOB:XGPSPL
FROM:XI"The-XGP
/]
pushj p,notifz
setz c, ;C counts number of users we notify, in case it's 0.
move a,1+sbuf ;index in .XGPR. dir of first filename block.
cryfil: cain a,2000
jrst cry1
move b,sbuf(a)
trz b,77
came b,[sixbit/ Q/] ;is the next file a queue file?
jrst cry9 ;Don't look at any other random files.
syscal open,[[.bai,,chtxti] ? ['dsk,,] ? sbuf(a) ? sbuf+1(a) ? ['.xgpr.]]
jrst cry9 ;don't get upset if it has been deleted.
push p,a
push p,c
pushj p,txtop1 ;Initialize buffering the file for input.
jfcl
setom newtxt ;Be aware that previous text file isn't open.
setzm dskcmd ;DSKCMD is set to 1 by DSKLIN on EOF.
crylin: skipe dskcmd ;Give up on this file if just reached EOF.
jrst cry8
pushj p,txti ;Skip over any ^L now so that DSKLIN doesn't think it's eof.
cain a,^L
jrst cryli1
aos txtcnt ;If we find something other than a ^L, unread it.
move a,[070000,,]
addm a,txtptr
cryli1: pushj p,dsklin ;Read the next line from the file.
move b,combuf ;Keep reading till we find a ;notify.
ior b,[ascii / /_-7] ;Ignore case in comparing the letters.
came b,[ascii /;noti/]
jrst crylin
crychr: pushj p,comget ;Skip the ";notify " itself, so the ;notify command routine
caie a,40 ;can gobble the arguments.
jrst crychr
aos (p) ;Increment count of users to be notified.
pushj p,donote ;Gobble them.
jfcl
setzm notflg
movei b,[asciz /
TO:(/]
pushj p,notifz
movei b,notusr ;output (user host (R-MODE-SEND -1))
pushj p,notifz
.iot chmail,[40]
movei b,nothst
pushj p,notifz
movei b,[asciz / (R-MODE-SEND -1))
/]
pushj p,notifz
cry8: .close chtxti,
setzm dskcmd
pop p,c
pop p,a
cry9: addi a,5
jrst cryfil
;Come here with all of message written except the text.
;The address of the error message is still on the stack.
cry1: jumpe c,crylos ;Give up if no users were found on the queue.
movei b,[asciz /TEXT;-1
The XGP needs human assistance:
/] ; now comes the message!!!
pushj p,notifz
pop p,b ;Get it off the stack.
skipe b
pushj p,notifz ;output it into the mail file.
syscal renmwo,[%climm,,chmail ? [sixbit /MAIL/] ? [sixbit />/]]
.lose %lsfil
.close chmail,
popj p,
crylos: pop p,b ;Discard
syscal delewo,[%climm,,chmail]
.lose %lsfil
.close chmail,
popj p,
litter: constants
vars:: variables
pat:
patch: block 100
patche: -1
icore==<.+1777>_<-12>
;memory map
;program pages 0-icore
;channel header pointer area
lnkvpg==icore+1 ;page #
10lnkv=lnkvpg_12 ;origin
lnkv==124 ;origin in 11 address space
abortl=<402-lnkv>/4+10lnkv ;10 address of abort flag
kstlod=abortl+6 ;pdp-10 address of kst loader flag
;channel header area
chhdpg==lnkvpg+1 ;page #
chhdr=chhdpg_12 ;origin
bprchl==10 ;# bytes in 1 channel header
;10-11 buffer area
bufpg==chhdpg+1 ;first page #
buffer=bufpg_12
syspag==bufpg+1 ;mapped into system to access nxgpfw
sbufp==syspag+1
sbuf=sbufp_12
bitbuf=sbuf+wdspl
fntpgs==20. ;font loading uses 20 pages starting at sbufp as buffer.
end go