github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-21 02:08:50 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/dcp/versa.211
Adam Sampson 6fe2bc3aab VERSA: Fix handling of multiple files given as JCL. 
Two bugs in my JCL-parsing code:

- B was getting clobbered at some point in the loop, so rfn"rfn only
  stored the first filename in the right place.

- The device's finish routine wasn't being called. For the hargld
  backend, this meant that the last few lines of each file weren't always
  being written to disk.
2018-06-01 11:23:04 +01:00

6573 lines
145 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.

.symtab 4001. ;it's prime
ilinwid==2 ;initial line width
dov80==0 ;0<==> don't send to v80
title Versatec Spooler
commen ~
first concepts for the V80
2112 scan lines across
1700 scan lines down
print speed 1000 lines/minute = 17 lines/second
plot speed 1.2 inches/second
2112 bits is about 66 32. bit words (PDP-10)
66 words/scan line * 1700 scan lines is about 113K of PDP-10 memory.
2112 bits/scan is 264 (8.bit) bytes/scan.
Use CHAOS opcode 200 to use 8 bit data transmission.
On the PDP-10 we use integers to represent floating point numbers in the
following way: Integer part is in the high 18. bits, fractional part is
in the low 18. bits. Addition and subtraction by normal methods.
Multiplication by the MUL instruction produces integer portion in AC+1
and fractional part in AC (almost). Use ASHC AC,+17. to recover the
number in our notation. Rounding should not be necessary because the
error factor is about 2^-17 already. Division by the DIV instruction
and basically reversing the steps of multiplication.
Line width is not constant. This is for simplicity of
programming. The line width changes with angle, and has a maximum
value of N at horizontal and vertical, and N/sqrt(2) 45 degrees.
Perhaps if the user requests N, we should give him N*2^.25 to
average things out. (Actually averaging requires some hairy
averaging over all angles. Assuming each angle is equally likely,
the average width is N/((pi+2)/2*pi) or N/.81831, while N/2^.25
is N/.8409 (close). To compensate we should multiply N by 1.222
for equal distribution or 1.1892 (= 2^.25). I would tend toward
the latter, since it is easier to explain and it is probably more
realistic of the angles that are normally drawn (vertical,
horizontal, and 45 degree).) The ends of lines will be
rectangular. this is also for ease of programming. It would
probably be a good idea to extend the lines one half width in
each direction. This is to account for the point case (zero
length vector) which really does want to put a dot on the paper.
This should not be too hard to do.
Examples of lines (width = 4)
Vertical lines
**** **** **** ****
**** **** **** ****
**** **** **** ****
**** **** **** ****
**** **** **** ****
**** **** **** ****
**** **** **** ****
**** **** **** ****
**** **** **** ****
**** **** **** ****
Horizontal lines
(They look like rotated vertical lines. I don't draw them because aspect
ratios suck so hard.)
Initial CHAOS statistics:
With receive and transmit windows of 8 (we don't really need
transmit for this) for an echo server, it looks like we can
expect 15-20 packets per second through the network on a single
connection. It may be a little better for the versatec, since the
packets will probably be of constant size (maximum since as much
info as possible is being put into a packet). After a packet is
received and processed, it is turned into a STS and transmitted.
This is to suppress retransmission of already received packets
and stimulate transmission of new ones. With a large window size
(16 perhaps), it should be possible to keep the network as busy
as is networkly possible. Let's get optimistic and assume 40
packets per second. If a plot is so nasty that each scan line
must be sent in full, it is probably only possible to put one
scan line in a packet. This is after all encoding optomizations
have been done. This comes to 40 scan lines per second. The
versatec can plot at 1.2_in/sec_*_200_scans/inch which gives 240
scans per second. This is 1/6 inch per second (48 seconds per
page (assuming entire page is plotted)). With data compression, I
guess at least 3 scan lines can fit in a packet, increasing
throughput to 1/2 inch per second. Since transmission is often
limitted by the network (take DPRESS for example), it is
reasonable to assume the two computers have some extra processing
time to use for scan line optimization.
Scan line optimization:
A packet is a series of 8 bit opcodes each followed by arguments
for the opcode. The opcodes are even. This is to to avoid
shifting in the PDP-11 at the expense of testing to make sure it
is even. (If it is odd, somebody goofed, and information should
be sent back informing of such lossage (error recovery on the
fly). Possible opcodes include the following:
%V8... arg arg operation
NOP ... ... No Operation
;scan line operations
SCN <bytes> <bytes> are usually rasters. 000 or 377 is
instruction which takes an argument telling
how many times to repeat the 000 or 377. 000
000 means end the SCN command
XOR ... ... XOR previous scan line into this one
;printing operations
PRZ N ... Print N lines of zeros
PRT N ... Print the new scan line N times
PAG ... ... Go on to next page
These should be enough to handle just about any plotting job.
Here are a few possible optimizations the above set can allow: It
compresses repetitions of all ones or all zeros. This is a very
crude form or run length encoding. If the argument to 000 or 377
in SCN mode is a 1, then we waste a byte, an argument of 2 breaks
even, and 3 or more starts winning us bandwidth. The XOR command
allos small changes in the line to be sent at very small cost
(probably taking full advantage of the pseudo run length
encoding).
Conjecture time: If plots are not to hairy, an average 3 or 4
scan lines worth of information should fit in a packet. If we are
lucky, we may get 6, making 240 scan lines per second, which is
the speed of the Versatec.
Update 09/29/81:
Significant progress has been made. There exists a
reasonable interface to the plotting routines. There exists an
ARDS interpreter and a TEKTRONIX interpreter. Both work quite
well and have been tested by a TV viewing routine (similar to
DPRESS (uses SUPDUP Graphics)). The routine to put the bitmap
into CHAOS packets seems to work with the operations described
above. The data compression seems quite good. The most complex
plot seen so far (-pics-;phx pic) takes 203 packets.
<1700_lines>/<240_lines_sec>=7_sec per page. 203 packets in
seven seconds is 30 (big) packets per second. This may acutally
be possible as far as the network is concerned. I have doubts as
to whether MC can do the computation to produce packets that
fast; it seems to take about 6 seconds to compute the packets on
a 43% fair share machine. The only real test is when the versatec
actually arrives and we try the thing.
Update 10/31/81:
Thanks to BDB, the Tektronix interpreter now understands
the 12 bit Tektronix codes. For more info, see him, or
programer's manuals for the latest Tektronix graphics terminals.
The Versatec is here. As always there were some small
bugs in pieces of code; but bugs can be stomped, and they were!!
The code in this spooler is quite compatible now with the code in
the 11, and several test plots have been made. We seem to be
bandwidth and CPU time limited however. We are not getting full
speed output. There could be (and probably are) several reasons
for this: the LSI-11/2 may not be able to discombobulate the
packets fast enough, the CHAOSNET is limiting us, the actual bits
really can't be shoved down fast enough (n packets per page does
not say very much, because the initial and trailing whitespace
often makes the figures look better), and MC just can crunch
enough. Therefore, it is time to tune the code. I can try to
make the loops tighter on the LSI-11 and perhaps allow more DMA
scans to be queued. Perhaps I should make the window size larger
on the CHAOSNET. As for MC, I am going to flush the XOR hack,
becuase I think the time it takes to do it on MC plus the time to
undo it on the 11 isn't worth the overhead. I will not get rid
of the code on MC, but I will comment it out with a failing
conditional. At the time of this update, the piece of code is
PAGSND in block CHAOS. Since we no longer have to compare costs
for regular line and XOR line, there is no need to buffer the
commands and then later put them in a packet. So, they will go
directly into a packet.
~ ; end comment
;;; system dependent things
pagsiz==2000 ;ITS page size
;;; Accumulater definitions
nil==0 ;super SUPER temp
a=1 ;general accumulators
b=2
c=3
d=4
e=5
f=6
g=7
t=10 ;temps
tt=11
w=12 ;temporary, argument/value regs
x=13
y=14
z=15
zz=16
p=17 ;PDL
lpdl==200
dskich==1 ;disk file input
chaosi==2 ;chaos input
chaoso==3 ;chaos output
dirhng==4 ;directory hang
logfil==5 ;log output file
logtmp==6 ;temp log input file while copying
fntich==7 ;font (raster) input file
f.wich==10 ;font (widths) input file
A.HALF==0,,400000 ;one half in the integer,,fraction scheme
;;; convention macros
call=pushj p,
return=popj p,
define syscal name,args
.call [setz ? sixbit/name/ ? args((setz))]
termin
define ucase ac
cail ac,"a ;"
caile ac,"z ;"
skipa
subi ac,<"a-"A>
termin
;; arithmetic macros
define divide x,y,z
move t,x
setzi tt,
ashc t,-17. ;yup
div t,y
movem t,z
termin
define multip x,y,z
move t,x
mul t,y
ashc t,17.
movem t,z
termin
define min a,b
ifg <a-b>,[<b-a>+]a!termin
commen ~ Packages and subroutines
Package JCL
GO()
Non-spooler mode: parses input filenames from the JCL, and
outputs them either as Gould scan files using the HARGLD
device, or (with /D) as SUPDUP graphics.
Package SPOOLR
WAIT()
returns when something to do.
GETSRT()
no files
Gets and sorts by creation date the spooling directory. If
there are any files, it skips
NEXTF()
no next file
Sets up the next file. Skips if there is one.
GFLAGS()
error someplace
Figures out what to do with the spoole file. Skips if
everything OK. Failure to skip indicates lossage. The error
recovery is inside GFLAGS
@GRAFIT()
Actually graphs and outputs the file. GFLAGS sets this up.
All error recovery, requeueing, etc. is done within this
routine.
FINISH()
Successfully completes a spool file. Cleans up by deleteing,
notifying, etc.
Package PLOT
INIT()
Initializes the plotting world for the spool file. This
includes initializing the device (calling its INIT routine),
settimg up the width, height, bits per inch, etc., and
requesting the BITARRAY.
SETUP(X,Y,W,Z,ZZ)
Setup the plotting world for the device. (X,Y) is the lower
left hand corner of the coordinate system in the units of the
filetype, in high resolution units (eg, 1 is really <1,,0>).
(W,Z) is the upper right. ZZ are bit flags: 001 means rotate
90 degrees clockwise; 002 means put in 1/2 inch margins.
NEXT()
Gets ready for the next plot or page (also gets ready for the
first one). This involves sending the old to the device, then
clearing the BITARRAY.
FINISH()
Signals a finish of this series of plots. (This really does a
NEXT at the moment.)
PAGCLR()
Clears the BITARRAY. The user normally does do this.
DCHAR(X)
Draws the character whose ascii code is X on the page. The
lower left corner of the current cursor position.
DLINE(x,y,w,z)
Draw a line from point (x,y) to (w,z). The coordinates are in
the high resolution (int,,frac) form. This does an incorrect
form of clipping, BUT THAT'S OK, CLIPPING SHOULDN'T BE NEEDED!
File interpreters:
Package ARDS -- interpret an ARDS format file
Package TEK -- interpret a TEKTRONIX format file
Device drivers:
Package DEVICE
Defines device parameter offsets and the macro OUTDEV to
create the device structure consistent with the offsets. The
packages must define the variables BITWID (width of page in
bits), BITHIG (height of page in bits), BPI (bits per inch),
CHRWID (width of page in characters) and CHRHIG (height of
page in characters). In addition, each package must define the
entrypoints
INIT()
couldn't init
Skip if properly initialized. PLOT:INIT calls this function.
PAGSND()
Send the bitarray starting at BITMAP to the device. Error
recovery is done within the individual package, and bad errors
do non-local goto's. (Perhaps there will be a CATCH/THROW
mechanism someday.)
TXTLIN(X)
Sends the line of text starting at BITMAP that is X characters
long. It does not contain any newline characters -- the
device is responsible for adding whatever is necessary.
TXTPAG()
Do a page eject.
TXTFIN()
Finish printing (cut paper if necessary, etc.)
Package PFCV80 -- Driver for the V80 at PFC (is probably general
purpose, assuming same protocol is used).
Package GOULD -- Driver for the GOULD in building 38
Package HARGLD -- Driver for the Harvard Gould (creates disk file)
Utility packages:
Package STRING -- Strings
If you want to compare strings with CAM or CAI, then put the
strings here. Example: contact names.
Package UTIL -- Random junk that is sometimes useful
ASSOC(X,Y)
no match
Y is a table of KEY,,VALUE entries. When X=KEY, the entire
KEY,,VALUE is returned in Z. (Perhaps this should be called
ASSQ and ASSOC should be X=(KEY)?)
CATCH(X)
<thrown back>
Sets up a CATCH wall waiting for THROW(X). It always skips.
If it gets thrown to, then execution starts from the non-skip
location. DO NOT push things on the stack before calling
CATCH and expect the program to run unless you have a call to
UNCATCH after the critical code.
THROW(X)
Never returns. Does a non-local throw to a waiting CATCH or
CATCH-ALL.
UNCATCH()
Removes a CATCH frame. Assumes (does not check) that the
CATCH frame is the last thing on the stack.
BITARR(X,Y)
X is width in bits, Y is height in bits. Allocates memory
starting from BITMAP that is sufficient to contain a bit array
that is X by Y. Also does a little CORBLK initialization.
Package LOG -- Makes entries in log file
OPNTTY()
Write log messages to the TTY instead of a log file
LOG(X)
X is pointer to address of format string followed by arguments
CLOSE()
Close the log file
Package CORBLK -- Core manager
INIT()
Complete RESET. Deletes all allocated data pages
RESERV(X)
couldn't
Reserves X pages of memory. Does not allocate them. On
return X is -npages,,firstpage.
FRESH(X)
couldn't reserve
X is either npages or -npage,,firstpage. Allocates the pages.
Does not zero them. On return X is -npages,,firstpage.
DELETE(X)
X is -npages,,firstpage. Returns the pages to the system.
Package MAPPER -- performs sequential file operations (should
probably be called SFILE)
INIT(x,y)
Init the disk file for sequential read. X is byte size, Y is
mask.
NEXT()
eof
Returns eof, or skips positioning at next page of file.
FINISH()
Finish using the file (closes it and releases core).
NXTBYT()
eof
Returns eof or skips with next file character in X.
BACKUP()
Goes backward one byte in the file. The last character read
will be read again.
Package CHAOS -- interface to the CHAOS network.
INIT()
Reset the chaosnet routines. Clears last host and contact
name. Closes IO channels.
INIT1()
Closes IO channels.
OPEN(X,Y)
couldn't
X is CHAOS host number. Y is contact name pointer (into string
package so that string-equal===eq).
CLOSE()
does a FINISH on the CHAOS net, sends a close packet, and
reinits with the INIT routine.
SNDPKT(Z,ZZ)
error in sending
Z is number of bytes, ZZ is opcode. Skips if the packet
succesfully sent.
SNDRFC(X,Y)
error or didn't open.
X is octal host address, Y is pointer to ASCIZ string which is
the contact name.
SNDDT1(Z)
error
Z is byte count of packet. Sets opcode to 201 and sends
packet.
SNDDAT(Z)
error
Z is byte count of packet. Sets opcode to 200 (normal data)
and sends packet.
SNDEOF()
Sends an EOF packet. No error return.
SNDCLS()
Sends a close packet with the message "Spooler closing
connection." No error return.
STRINS(Z,Y)
Z is current byte count, Y is pointer to ASCIZ string to
insert into packet. On return Z is updated byte count.
Package TV -- Hack SUPDUP Graphics for testing
TVINIT()
Sets up the terminal as a SUPDUP Graphics display device.
SHOW()
Shows the bitmap on the screen with crude movement commands.
~
.scalar bitmpe ;the end of the bitmap (not 1+)
.scalar bitwrd ;number of words in the bitmap
.scalar spoolp ;should we spool
.scalar REALTM ;what to do for realtime interrupts
;0 = kick DRWAIT
;1 = make sure device is responding
.scalar SNDLST ;<3 if device is responding during
;transmission.
go: move p,[-lpdl,,pdl-1] ;initialize PDL
call init
call corblk"init ;"init the core manager
setom spoolp ;assume we are going to spool
.suset [.rxjname,,xjname']
move xjname
camn [sixbit /versa/]
jrst [call jcl"go ? jrst exit]
call spoolr"init ;"initialize the spooler
movei x,string"catcha ;"catch all
call util"catch ;"install it
jrst .-2 ;reset catch all
wait: call spoolr"wait ;"wait for something to do
call spoolr"getsrt ;"get the dir and sort it
jrst wait ;no files, just wait some more
goloop: call spoolr"nextf ;"get the next file
jrst wait ;end of this batch, see if any came in since
movei x,string"badreq ;"bad request
call util"catch ;"
jrst [ call spoolr"badreq ;"
jrst goloop]
call spoolr"gflags ;"determine flags, etc for the file
jrst golooe ;oops, error someplace. GFLAGS should
;have done any error recovery necessary.
movei x,string"deverr ;"
call util"catch ;"catch device errors
jrst [ movei x,[ [asciz /~%~T Device error, putting device on wait queue/]]
call log"log ;"
call spoolr"devwat ;install a wait for the device
jrst golooe] ;and try more files
call @spoolr"grafit ;"go do the graphing
call util"uncatch ;"remove the DEVERR catch
call spoolr"finish ;"
golooe: call util"uncatch ;"remove the BADREQ catch
jrst goloop
go2: .break 16,
.logout 1,
exit: .break 16,160000
.value
.scalar linwid,lin2wd,bitmsk
init: setzm var...
move a,[var...,,var...+1]
blt a,var..e-1
move b,[ilinwid,,] ;initial line width
movem b,linwid ;initial line with
lsh b,-1 ;divide by two
movem b,lin2wd
setoi a, ;all ones
move b,linwid
addi b,A.HALF ;plus 1/2 for rounding
hlrz b,b ;convert to familiar integer
movn b,b ;for left normalized lsh
lsh a,(b)
setcam a,bitmsk
cpopj: return
.begin jcl
.vector jbuf(100) ;JCL string
.scalar jdev,jfn1,jfn2,jdir ;filename
.scalar jcount ;number of files processed
$$RFN==-1
$$SWITCH==-1
.insrt syseng; rfn >
rsixtp: caie a,"/ ;allow switches
cain a,"(
aos (p)
cain a,", ;allow multiple filenames
aos (p)
return
switch: cain a,"D ;SUPDUP mode
setzm spoolp
return
go: setom jcount ;init to -1
call log"opntty ;log messages to the TTY
setzm jbuf
.break 12,[..rjcl,,jbuf]
skipn jbuf ;no JCL?
jrst [ movei x,[[asciz \Usage: :VERSA [/D] FILE 1,FILE 2,...\]]
call log"log
return ]
move [sixbit/dsk/] ;filename defaults
movem jdev
setzm jfn1
move [sixbit/>/]
movem jfn2
.suset [.rsname,,jdir]
move d,[440700,,jbuf]
next: movei b,jdev
call rfn"rfn ;parse filename
push p,a ;save terminating char
push p,d ;and pointer
aose jcount ;only do setup the first time
jrst rest
skipe spoolp ;want SUPDUP output? (/D)
jrst nod ;no
movei pfcv80"pfcfil ;/D; set up for SUPDUP
movem spoolr"device
call pfcv80"init
.lose
call tv"tvinit
call chaos"init
jrst rest
nod: movei hargld"hargld ;no /D; set up for HARGLD
movem spoolr"device
rest: syscal open,[[.bii,,dskich] ? jdev ? jfn1 ? jfn2 ? jdir]
jrst [ movei x,[[asciz /Couldn't open ~6:~6;~6 ~6/]
jdev ? jdir ? jfn1 ? jfn2]
call log"log
.lose ]
syscal rfname,[movei %jself ? movei dskich
movem jdev ? movem jfn1
movem jfn2 ? movem jdir]
.lose
hlrz x,jfn2 ;look up FN2 in gtype table
movei y,spoolr"gtype
call util"assoc
skipa ;not found
jrst found
hlrz x,jfn1 ;how about FN1?
movei y,spoolr"gtype
call util"assoc
jrst [ movei x,[[asciz /Unknown filetype in ~6:~6;~6 ~6/]
jdev ? jdir ? jfn1 ? jfn2]
call log"log
.lose ]
found: tlz z,-1
call @z ;call the handler
move z,spoolr"device ;flush the output device
call @device"finish(z)
pop p,d
pop p,a
cain a,", ;any more filenames?
jrst next
return
.end
.begin spoolr
.scalar drwait ;flag for waiting
tsint: loc 42
-ltsint,,tsint
loc tsint
p ;pdl address pointer
%piioc ? 0 ? 0 ? -1 ? iocint
0 ? 1_dirhng ? 0 ? 1_dirhng ? dirint
%pirlt ? 0 ? %pirlt ? -1 ? rltint
ltsint==.-tsint
dirint: aos drwait ;kick the spoolr
syscal dismis,[p]
.lose ;wow, are we losing if we get here
iocint: ;just ignore it and keep going. this
;is on the assumption that it was a
;.call and it will take care of itself
;on non-skip.
aos (p)
syscal dismis,[p] ;bye
.lose
rltint: push p,a
move a,REALTM ;get the realtime mode
jrst @(a)[ [ ;0
pop p,a
jrst dirint]
sndint ;1
]
sndint: aos a,sndlst
cail a,3
jrst [ move a,[400000,,[0 ? 0]]
setzm REALTM
.realt a,
pop p,a
syscal dismis,[p ? movei sndtmo]
.lose
]
pop p,a
syscal dismis,[p]
.lose
sndtmo: movei x,[ [asciz /~%~T Device not responding for 3 minutes./]]
call log"log ;"
move x,spoolr"device ;"get the device
call @device"timout(x) ;"time it out
movei x,string"deverr ;"
call util"throw ;"
.lose
init: .suset [.roption,,a]
tlne a,optddt
.value [asciz /7 /]
movei 30.*5
.sleep
syscal detach,[movsi 7 ? movei %jself]
.lose 1000
irps name,,[xuname uname jname hsname sname
]val,,[ dcp v80 spoolr .glpr. dcp]
syscal usrvar,[movei %jself ? [sixbit/name/] ? [sixbit /val/]]
.lose 1000
termin
syscal open,[[.uai,,dirhng]
[sixbit /dirhng/] ? 0 ? 0 ? [sixbit /.glpr./]]
.lose 1400 ;bad, bad, die, die
movei 777777
movem drwait ;pretend DIRHNG kicked
.suset [.roption,,a] ;get the option bits
tlo a,optint\optopc ;new style interrupts
.suset [.soption,,a] ;set it
.suset [.sdf1,,[0]] ;No defered first word interrupts
.suset [.smask,,[%piioc\%pirlt]] ;turn on IOC error and
;realtime interrupt recognition
.suset [.sdf2,,[0]] ;No defered class 2 interrupts
.suset [.smsk2,,[1_dirhng]] ;allow DIRHNG interrupts
movei x,[ [asciz /~%~%~T ---------- Spooler launched and ready ----------~%~%/]]
call log"log ;"
return
wait: skiple drwait
return
.close dskich, ;close any disk channel that is open
skipe a,spoolr"device ;"
call [ setzm REALTM
aos REALTM ;realtm=1
setzm SNDLST ;zero the count
move tt,[600000,,[60.*60. ? 0]]
.realt tt,
call @device"finish(a) ;"
move a,[400000,,[0 ? 0]]
.realt a,
return]
call chaos"close ;"close any chaos connection
call log"close ;"close the log file
call corblk"init ;"reset the core manager
skipe ndvswt
call [ move a,[600000,,[60.*60.*15. ? 0]]
setzm REALTM ;realtime mode = 0
.realt a,
return]
skipg drwait
.hang
move a,[400000,,[0 ? 0]]
.realt a,
return
.insrt system;fsdefs
getsrt: setzm drwait ;no hang
setzm ndvswt ;no devices waiting
call get
call sort
return ;nothing
aos (p)
return ;something
.vector buffer(2000) ;one page for the UFD
.scalar nfiles ;number of files to after sorting
.scalar bufptr ;pointer into buffer for next file
get: syscal open,[[.bii,,dskich]
[sixbit /dsk/]
[sixbit /.file./] ? [sixbit /(dir)/]
[sixbit /.glpr./]]
.lose 1400 ;only if directory not there !!
move t,[-2000,,buffer]
.iot dskich,t
.close dskich,
return
sort: setzm nfiles ;no files yet
move b,buffer+udnamp ;relative pointer to name area
movei c,2000
subi c,(b)
idivi c,lunblk ;c=number of entries to try
jumpe c,cpopj ;no files
addi b,buffer ;b=pointer to name area
movei a,buffer ;put new stuff at beginning
sort02: move x,unfn1(b) ;first file name
move y,unfn2(b) ;second file name
move tt,unrndm(b) ;random stuff
move z,undate(b) ;creation date
tlne tt,unigfl ;should it be ignored?
jrst sort20 ;go on to next file
camn x,[sixbit /-queue/]
jrst sort10 ;use it
camn x,[sixbit /-log/]
jrst sort10 ;use it
camn x,[sixbit /-broke/]
jrst [ hlrz x,y ;get fn2
movei y,gdest ;and the assoc list
call util"assoc ;"try and find the device
jrst sort20 ;mumble, don't want to register move
;around just to delete file
push p,device
push p,a
push p,b
hrli z,(@(tt)) ;this makes the device "proper"
movem z,device
call devwat ;put device on wait queue
pop p,b
pop p,a
pop p,device
jrst sort20]
ldb t,[360600,,x] ;get first char of FN1
cail t,<'A> ;compare to A
caile t,<'Z> ;and with Z
jrst sort20 ;not in range
;ignore some files:
irps igfn1,,[ glp done
]igfn2,,[ notice queue
]
camn x,[sixbit /igfn1/]
came y,[sixbit /igfn2/]
skipa
jrst sort20 ;ignore specified files
termin
sort10: movem x,0(a) ;FN1
movem y,1(a) ;FN2
movem z,2(a) ;CDATE
movei a,3(a) ;go on to next
aos nfiles ;another file counted
sort20: addi b,lunblk ;go on to next file in UFD
sojg c,sort02 ;loop for all files
%i==x
%j==y
left==z
right==zz
skipn right,nfiles
return ;no files
aos (p) ;skip return --> files
imuli right,3 ;three words per block
addi right,buffer-3 ;point to the last one
movei left,buffer ;point to the first one
push p,[0]
push p,[0]
sortq2: cail left,(right)
jrst [ pop p,left
pop p,right
jumpn left,sortq2
movei buffer
movem bufptr
return]
;partition
movei %i,(left)
movei %j,3(right)
move a,2(%i) ;get the key
sortl1: movei %i,3(%i)
caile %i,(right)
jrst sortl2
camle a,2(%i)
jrst sortl1
sortl2: movei %j,-3(%j)
camge a,2(%j)
jrst sortl2
cail %i,(%j)
jrst sortex
irps off,,0 1 2
move b,off(%i) ? move c,off(%j)
movem c,off(%i) ? movem b,off(%j) ? termin
jrst sortl1
sortex: irps off,,0 1 2
move b,off(left) ? move c,off(%j)
movem c,off(left) ? movem b,off(%j) ? termin
movei b,(right)
subi b,+3(%j)
movei c,-3(%j)
subi c,(left)
cail c,(b) ;skip if [left,j-3] < [j+3,right]
jrst [ movei b,-3(%j)
push p,b
push p,left
movei left,3(%j)
jrst sortq2]
push p,right
movei right,3(%j)
push p,right
movei right,-6(right)
jrst sortq2
nextf: skipg nfiles
return ;no files
move t,bufptr
move 0(t)
movem fn1 ;first file name
move 1(t)
movem fn2 ;second file name
move 2(t)
movem cdate
addi t,3
movem t,bufptr
sos nfiles
aos (p)
return
.scalar device ;device this file is being sent to
.scalar grafit ;function to call to do this file
.scalar fn1,fn2,cdate ;file name of current file (and cdate)
.scalar gdev,gfn1,gfn2,gdir ;file spec for actual graphic file
gflags: hlrz x,fn1
movei y,gdest
call util"assoc ;"
jrst gflag1 ;don't give error now
hrli z,(@(tt)) ;indexable
movem z,device ;save the device
call devok ;make sure the device is not on wait
;queue
return
gflag1: movei x,[ [asciz /~%~T Processing DSK:.GLPR.;~6 ~6/]
fn1 ? fn2]
call log"log ;"
move x,cdate
move a,p
ldb b,[.bp <177000,,>,x]
push p,b ;1(a) year
ldb b,[.bp <000740,,>,x]
push p,b ;2(a) month
ldb b,[.bp <000037,,>,x]
push p,b ;3(a) day
movei x,(x)
idivi x,2
idivi x,60.
push p,y ;4(a) seconds
idivi x,60.
push p,y ;5(a) minutes
push p,x ;6(a) hours
movei x,[ [asciz "{~D/~D/~D ~d:~d:~d}"]
2(a) ? 3(a) ? 1(a) ? 6(a) ? 5(a) ? 4(a)]
call log"log ;"
sub p,[6,,6]
move a,fn1
move b,fn2
camn a,[sixbit /-queue/]
foo [asciz /figure out what to do with queue files/]
camn a,[sixbit /-log/]
jrst manlog ;manual log entry
movem a,gfn1
movem b,gfn2
move t,[sixbit /dsk/]
movem t,gdev
move t,[sixbit /.glpr./]
movem t,gdir
hlrz x,fn1
movei y,gdest
call util"assoc ;"
gflbad: jrst badreq ;do a bad request
hrli z,(@(tt)) ;indexable
movem z,device ;save the device
call devok ;make sure the device is not on wait
;queue
return
hrrz x,fn1
movei y,gtype
call util"assoc ;"
jrst gflbad
hrrzm z,grafit
move tt,device
gflag2: syscal open,[[.bii,,dskich]
gdev ? gfn1 ? gfn2 ? gdir]
jrst [ movei x,[ [asciz /~%~T ??? Couldn't open file ???/]]
call log"log ;"
jrst gflbad]
aos (p) ;good return
syscal lnkedp,[movei dskich ? movem x]
jrst gflag4
skipn x
jrst gflag4
syscal rfname,[movei %jself ? movei dskich
movem a ? movem b ? movem c ? movem d]
jrst gflag4
movei x,[ [asciz / (pointing to ~6:~6;~6 ~6)/]
a ? d ? b ? c]
call log"log ;"
gflag4: return
gdest: 'pfc,,pfcv80"pfcv80 ;"
'v80,,pfcv80"pfcv8t ;"alias for testing
'v8f,,pfcv80"pfcv8f ;"alias for forcing page ejects
'gld,,gould"gould ;"
'b38,,gould"gouldt ;"alias for testing
; 'xgp,,aixgp"aixgp ;"
;;; 'ts7,,pfcv80"ts7v80 ;"Tech Square 200bpi Versatec
;;; 't7t,,pfcv80"ts7v8t ;"alias for testing
;;; 't7f,,pfcv80"ts7v8f ;"alias for forcing page ejects
'fil,,pfcv80"pfcfil ;"
'har,,hargld"hargld ;"harvard gould format files
0,,0
gtype: 'txt,,text"text ;"
'tex,,text"text ;"
'chr,,text"text ;"
'tnh,,text"textnh ;"text with no header
'ard,,ards"ards ;"
'tek,,tek"tek7 ;"
'tk8,,tek"tek8 ;"
'ddv,,ddv"ddv ;"
'scn,,scn"scn ;"xgp scan files
'xgp,,xgp"xgp ;"
'@xg,,xgp"xgp ;"
'prs,,press"press ;"
'har,,harscn"harscn ;"harvard scan file format (MACRAK)
; 'sup,,supdup"supdup ;"
; 'fr8,,fr80"fr80 ;"
; 'f80,,fr80"fr80 ;"
0,,0
badreq: move a,fn1
lsh a,-6
ior a,[sixbit/./]
movei x,[ [asciz "~%~T <<----->> Bad request. Renaming file to ~6 >"]
a]
call log"log ;"
syscal rename,[['dsk,,] ? fn1 ? fn2 ? ['.glpr.] ;<
a ? [sixbit/>/] ]
jfcl
return
finish: movei x,[ [asciz /~%~T Deleting queue file DSK:.GLPR.;~6 ~6/]
fn1 ? fn2]
call log"log ;"
syscal delete,[gdev ? gfn1 ? gfn2 ? gdir]
jfcl
syscal delete,[[sixbit /dsk/] ? fn1 ? fn2 ? [sixbit /.glpr./]]
jfcl
return
.vector ndvswt(1),dvwtbl(10)
devwat: move a,ndvswt ;number of devices waiting now
move b,device ;get device to wait for
movem b,dvwtbl(a)
aos ndvswt ;another device to wait for
return
devok: ;skip if current device OK
aos (p) ;assume OK
skipn a,ndvswt
return
imul a,[-1,,]
hrri a,dvwtbl
move b,device
devok1: camn b,(a)
jrst [ sos (p) ? return]
aobjn a,devok1
return
manlog: movei x,[ [asciz /~%~T Manual log entry from DSK:.GLPR.;~6 ~6/]
fn1 ? fn2]
call log"log ;"
movei x,[ [asciz /~%--------------------~%/]]
call log"log ;"
syscal open,[[.uai,,dskich] ? ['dsk,,] ? fn1 ? fn2 ? ['.glpr.]]
jrst manlg8
manlg2: .iot dskich,a
jumpl a,manlg8
andi a,177 ;ascii part
cain a,^C
jrst manlg8
movei x,[ [asciz /~C/] ? a]
call log"log ;"this is gross
jrst manlg2
manlg8: movei x,[ [asciz /~%--------------------/]]
call log"log ;"
.close dskich,
syscal delete,[['dsk,,] ? fn1 ? fn2 ? ['.glpr.]]
jfcl
return
.end spoolr
.begin plot
.scalar numtry ;number of tries to init device
.scalar bitwid,wrdwid,bithig,wrdhig,bpi,orient,fntyet,rotatp
.scalar maxx,maxy
.scalar pltnum ;number of last plot on this page
.scalar plttim ;system time plot was started
.scalar pagdrt ;<>0 means page has something on it (dirty)
.scalar a00,a01,a10,a11 ;matrix entries
.scalar b0,b1 ;offsets
;;; ;;; [ a00 a01 ] [ x ] [ b0 ] [ x ]
;;; ;;; [ ] [ ] + [ ] gives new [ ]
;;; ;;; [ a10 a11 ] [ y ] [ b1 ] [ y ]
init: call devopn ;open the device
move a,spoolr"device ;"get it again (don't trust anybody)
move t,device"bitwid(a) ;"the width
movem t,bitwid
addi t,31.
idivi t,32.
movem t,wrdwid ;word width
move t,device"bithig(a) ;"
movem t,bithig
movem t,wrdhig
move t,device"bpi(a) ;"
movem t,bpi
move t,device"orient(a)
movem t,orient
move x,bitwid
move y,bithig
call util"bitarr ;"make sure we have the bit array
movs t,bitwid
sub t,[1,,]
movem t,maxx
movs t,bithig
sub t,[1,,]
movem t,maxy
call font"init ;"
setzm fntyet
setzm pltnum ;start on page zero
.rdtime t,
movem t,plttim ;and remember current time
return
devopn: move a,spoolr"device ;"get the device
call @device"init(a) ;"init the device (to make sure we can
;get there)
jrst [ movei x,string"deverr ;"
call util"throw] ;["]
return
;;; ;;; (x,y) is lower left, (w,z) is upper right
;;; ;;; zz bits:
;;; ;;; 001 rotate 90o if orientation is sideways
;;; ;;; 002 put in margins
setup: setzm rotatp ;assume no rotation
move a,spoolr"device ;"get the device object
trne zz,001
skipn device"orient(a) ;"
skipa
setom rotatp ;if requested and device needs it, rotate
skipn rotatp
call [ ;do not rotate 90o
move a,w
sub a,x ;dx
move c,bitwid
trne zz,002 ;margins?
sub c,bpi ;yes
hrlz c,c
divide c,a,a ;get x scaling factor
move b,z
sub b,y ;dy
move c,bithig
trne zz,002 ;margins?
sub c,bpi ;1/2 inch margins
hrlz c,c
divide c,b,b ;get y scaling factor
camle a,b
move a,b ;get min
movem a,a00
setzm a01
setzm a10
movnm a,a11
return]
skipe rotatp
call [ ; do rotate 90o
move a,w
sub a,x ;dx
move c,bithig
trne zz,002 ;margins
sub c,bpi
hrlz c,c
divide c,a,a
move b,z
sub b,y ;dy
move c,bitwid
trne zz,002 ;margins?
sub c,bpi
hrlz c,c
divide c,b,b
movm c,a
movm d,b
camle c,d
move c,d
setzm a00
movem c,a01
movem c,a10
setzm a11
skipge a
movns a10
skipge b
movns a01
return]
move a,x
add a,w
ash a,-1 ;center of x plot space
move b,y
add b,z
ash b,-1 ;center of y plot space
hrlz x,bitwid
ash x,-1 ;center of bitarray
multip a,a00,y
sub x,y
multip b,a01,y
sub x,y ;b0=<bitwid/2>-<center x transformed>
movem x,b0
hrlz x,bithig
ash x,-1
multip a,a10,y
sub x,y
multip b,a11,y
sub x,y ;b1=<bithig/2>-<center y transformed>
movem x,b1
return
blkpag: call next ;force out a blank page
hrli 400000
iorm bitmap ;make sure there is a bit on someplace
setom pagdrt ;declare it dirty
return
next: skipn pltnum ;is this the first plot?
jrst next50 ;if so, just clear and return
skipn pagdrt ;is it dirty yet?
return
skipn spoolp
call tv"show ;"show it on the TV if not spooling
skipn spoolp
jrst next50 ;if not spooling, don't send page
next1: movei x,string"pgserr ;"
call util"catch ;"catch page send errors
jrst [ movei x,[ [asciz /~%~T Error while sending page/]]
call log"log ;"
movei 30.*30.
.sleep ;wait 30 seconds.
call devopn ;try and reopen the device
jrst next1] ;succeeded if we returned
setzm REALTM
aos REALTM ;realtm=1
setzm SNDLST ;zero the count
move tt,[600000,,[60.*60. ? 0]]
.realt tt,
move tt,spoolr"device ;"get the device type
call @device"pagsnd(tt) ;"send off the page
move tt,[400000,,[0 ? 0]]
.realt tt, ;release realtime
call util"uncatch ;"remove the catch frame
next50: call pagclr
aos pltnum
return
finish: call next ;fake a new plot
sos pltnum
.rdtime a,
sub a,plttim
idivi a,30.
movei x,[ [asciz /~%~T PLOT: ~D page~S in ~D second~S./]
pltnum ? a]
call log"log ;"
call font"flush"all ;flush all fonts
return
;note: I think this is sufficient for plot"finish"
pagclr: setzm bitmap
move a,[bitmap,,bitmap+1]
blt a,@bitmpe
setzm pagdrt ;page is not dirty yet
return
transf:
push p,a
push p,b
multip w,a00,a
multip z,a01,b
add a,b
add a,b0
multip w,a10,w
multip z,a11,z
add z,w
add z,b1
move w,a
skipg w
setzi w,
skipg z
setzi z,
camle w,maxx
move w,maxx
camle z,maxy
move z,maxy
jrst tranx1
tranxy: push p,a
push p,b
tranx1: multip x,a00,a
multip y,a01,b
add a,b
add a,b0
multip x,a10,x
multip y,a11,y
add y,x
add y,b1
move x,a
skipg x
setzi x,
skipg y
setzi y,
camle x,maxx
move x,maxx
camle y,maxy
move y,maxy
pop p,b
pop p,a
return
dline: call transf ;transform coordinates
line: ; (x,y) to (w,z)
setom pagdrt ;page is now dirty
move a,w
sub a,x ;get dx
skipge c,a
movn c,c ;make it abs valued
move b,z
sub b,y ;get y diff
skipge d,b
movn d,d ;make it abs valued
camge d,c ;compare dy,dx
jrst linhrz ;draw horizontal line
linvrt: ;else line is up/down
jumpn d,linv02
sos y ;take it up a very little
aos d ;fix up things for a single dot
aos b
linv02: jumpg b,linv04 ;jump if y.lt.z
movn a,a
movn b,b
exch x,w
exch y,z ;y.le.z
linv04: ;X=(a/b)Y+(x-(a/b)y)
;X= e *Y+ f
divide a,b,e
multip e,y,f
movn f,f
add f,x
;compute new y,z and starting bit position
sub y,lin2wd ;go up half a width at the top
add z,lin2wd ;and down half a width at the bottom
multip e,y,x
add x,f ;new x -- start position
sub x,lin2wd ;go over half a width
addi x,A.HALF ;round the values (add 1/2)
addi y,A.HALF
addi z,A.HALF
hlrz y,y ;get the starting y position
hlrz z,z ;and the stopping y position
sub z,y ;number of scan lines to hit
imul y,wrdwid ;index at left of scan line
addi y,bitmap ;address at left of scan line
move a,bitmsk ;get the bits (one width worth)
linv10: hlrz t,x
idivi t,32.
add t,y ;word offset to word address
movn tt,tt ;tt=bit offset (for lshc)
move b,a ;get the bit mask
setzi c, ;clear the upper word for lshc
lshc b,-4(tt) ;shift it all the way over
lsh b,4 ;and restore the left part
iorm b,(t) ;put the bits in the bitmap
iorm c,1(t) ;and the rest
add y,wrdwid ;step the y
add x,e ;and the x by the slope
sojg z,linv10 ;loop
return ;done
linhrz: ;horizontal line
jumpg a,linh04 ;jump if x.lt.w
movn a,a
movn b,b
exch x,w
exch y,z ;x now .lt. w
linh04: ;Y=(b/a)X+(y-(b/a)x)
;Y= e *X+ f
divide b,a,e
multip e,x,f
movn f,f
add f,y
;compute new x,w and starting bit
;position
sub x,lin2wd ;go left half a width at the left
add w,lin2wd ;and right at the right
multip e,x,y
add y,f ;new y -- start position
sub y,lin2wd ;go up half a line width
addi x,A.HALF ;round the values (add 1/2)
addi w,A.HALF
addi y,A.HALF
hlrz x,x ;get the starting x position
hlrz w,w ;and the stopping x position
sub w,x ;number of scan lines to hit
move t,x ;get the starting x
idivi t,32. ;get word and bit offset
move x,t ;get word offset
addi x,bitmap ;address into bitmap
movn tt,tt ;for LSHing
movsi a,400000 ;put a bit up top
lsh a,(tt) ;and move it down to the right place
move b,linwid
addi b,A.HALF ;for rounding
hlrz b,b
linh10: hlrz t,y ;get the y
imul t,wrdwid ;make it offset
add t,x ;address into memory
move tt,b ;get the line width rep count
linh12: iorm a,(t)
add t,wrdwid ;go down a scan
sojg tt,linh12
lsh a,-1
trze a,17 ;if it went into the low four bits we
;have to step the x
aosa x ;step the x
trna
tlo a,400000 ;put the bit back up top
add y,e
sojg w,linh10
return
drect: call transf ;transform the coordinates
rect: ;(x,y) to (w,z)
irps ac,,x y w z
addi ac,a.half
hlrz ac,ac
termin
cail x,(w)
exch x,w
cail y,(z)
exch y,z
subi w,(x)
subi z,(y)
caie w,0
cain z,0
return
imul y,wrdwid
movei t,(x)
idivi t,32.
addi y,bitmap(t) ;pointer into bitmap
movni x,(tt) ;- <number of unused bits on left of word
drect2: push p,y ;save address
push p,z ;and height
move t,[-1]
movei tt,32.
add tt,x
sub tt,w
caig tt,
setzi tt,
sub tt,x
lsh t,4(tt)
lsh t,(x)
drect4: cail y,bitmap
camle y,bitmpe
trna ;skipa
iorm t,(y) ;only if in range
add y,wrdwid
sojg z,drect4
pop p,z
pop p,y
addi y,1
movn tt,tt
addi tt,32.
sub w,tt
setzi x, ;all bits are left justified
jumpg w,drect2
return
dchar: skipn fntyet
call [ push p,x ? push p,y ? push p,z
call font"getrdy ;"get ready to do fonts
movei x,777777 ;wierd numbered font
movei y,[sixbit/dsk/ ? sixbit/25fr/
sixbit/kst/ ? sixbit/fonts/]
call font"xgpfnt ;"register it
movei x,777777
call font"switch ;"switch to the font
.lose
pop p,z ? pop p,y ? pop p,x
setom fntyet
return]
call font"dchar ;"returns new x,y
return
constants
.end plot
.begin font
maxfnt==100.
.scalar nfonts ;number of fonts delcared
.scalar nload ;number of fonts loaded
.scalar fontok ;0 iff last SWITCH failed
.scalar raster,width ;indirectable pointers to raster data
;and width info
.scalar scalef ;scale factor
.vector fntmap(maxfnt+1) ;map between user font and font index
;for assoc
.vector fntras(maxfnt) ;raster arrays
.vector fntwid(maxfnt) ;width info arrays
.vector fntbas(maxfnt) ;baselines for the fonts (xgp sucks)
.scalar curbas ;baseline of current font
.vector fnthgt(maxfnt) ;heights of the fonts
.scalar curhgt ;suck, suck...
.vector fntfil(maxfnt) ;file info arrays
.scalar fnttim ;incremented on each font switch
.vector fntliv(maxfnt) ;least recently used table (lowest loses)
.scalar f.w ;-npages,,page if fonts.widths mapped in
.scalar f.wadr ;base address of fonts.widths
.scalar f.wdon ;entire font already done
init: ;gets called by plot"init." there are
;no arrays to zero
setzm fontok ;current font NOT ok
setzm fnttim ;zero the time
setzm nfonts ;no fonts
setzm nload ;none of them are loaded either
setzm fntmap ;nothing to assoc
return
getrdy: call font"flush"all
jfcl ;doesn't matter if nothing flushed
move a,plot"a00 ;"get top left
add a,plot"a01 ;"add top right (one of these is zero)
divide [[1,,]]a,a
movmm a,scalef ;scaling factor for widths
return
switch: setzm fontok ;assume lose (probably won't)
tro x,400000 ;so <external 0,,internal 0> isn't zero
movei y,fntmap
call util"assoc
return ;did lose, font not declared
hrrzi x,(z)
trze x,400000 ;is it loaded?
jrst switok ;on means yes
push p,x
swit20: call loadfn ;load the font
jrst [ call .c"flush"lru ;flush least recently used
jrst [pop p,x ? return] ;complete loss
move x,(p)
jrst swit20] ;try again
pop p,x
switok: aos y,fnttim
movem y,fntliv(x) ;keep this font alive
move y,fntras(x)
movem y,raster
move y,fntwid(x)
movem y,width
move y,fntbas(x)
movem y,curbas
move y,fnthgt(x)
movem y,curhgt
setom fontok
aos (p)
return
dchar: skipn fontok
return
push p,x
push p,y
push p,z
call plot"tranxy ;"transform x and y
addi x,a.half
addi y,a.half
hlrz x,x
hlrz y,y
move tt,(p) ;get character
move tt,@raster ;get offset into array
skipe tt
call rdchar
pop p,tt ;get character
pop p,y ;and coordinates
pop p,x
hll t,@width ;get x increment
ash t,-3 ;for extra resolution
add x,t
hrl t,@width ;get y increment
ash t,-3 ;for extra resolution
add y,t
return
rdchar: ;really draw the character
movei zz,@raster ;pick up the raster definition
setom plot"pagdrt ;"page is dirty (has something on it)
hrli zz,441200 ;10.bit byte pointer
ildb t,zz ;get x offset
trne t,1000 ;sign bit for 10.bits
ior t,[-1,,777000] ;sign extend
sub x,t
ildb t,zz ;get y offset
trne t,1000 ;sign bit for 10.bits
ior t,[-1,,777000] ;sign extend
sub y,t
imul y,plot"wrdwid ;"
exch x,y
idivi y,32.
addi x,bitmap(y)
caige x,bitmap
return ;off the top of the page
movni y,4(z) ;-4-remainder
ildb w,zz ;get height
movei z,(w)+1 ;height+1
imul z,plot"wrdwid ;"descending distance in pdp-10 words
addi z,(x) ;max address
camle z,bitmpe
return ;off the bottom
tlc zz,001200#000600 ;convert to 6 bit
ildb z,zz ;get width (in words)
addi zz,1 ;go to first word of rasters
rdch10: push p,w
push p,x
rdch20: setzi tt,
move t,(zz)
addi zz,1
lshc t,(y)
lsh t,4
iorm t,0(x)
iorm tt,1(x)
add x,plot"wrdwid ;"
sojg w,rdch20
pop p,x
pop p,w
addi x,1
sojg z,rdch10
return
F%BOLD==700000 ; for bold regular
F%REG== 077000 ; for medium regular
F%BITL==000700 ; for bold italic
F%ITAL==000077 ; for medium italic
F%ALL== 777777 ; for all the font faces
irps off,,$$dev $$fn1 $$fn2 $$dir $$lod $$wid lfntblk
off==.irpcnt
termin
$$psiz==lfntblk
$$pfac==$$psiz+1
$$pfam==$$pfac+1
lprsblk==$$pfam+<24./4>
;;; x is ildb pointer to base start of font description
prsfnt: move a,x
tlz a,007700
tlo a,000800 ;8 bit byte pointer
ibp a ? ibp a ;skip entry length
ildb b,a ;font set
imuli b,16.
ildb c,a
addi b,400000(c) ;b = font number (external)
movei x,(b)
movei y,fntmap
call util"assoc ;"
jrst [
move z,nfonts
aos nfonts
setzm fntmap+1(z)
jrst pfnt10]
tlz z,-1 ;right half only
push p,z
skipe x,fntfil(z)
call array"free ;"free the old array that was there
pop p,z
setzm fntfil(z)
pfnt10: hrli z,(b) ;external,,internal
move b,z ;put it in b
movei x,lprsblk
call array"alloc ;"get an array for the info
jrst [ movei x,[ [asciz "~%~T PRSFNT: font registration: memory bloat -- FATAL"]]
call log"log ;"
movei x,string"badreq ;"
call util"throw ;"
]
movem b,fntmap(b)
movem x,fntfil(b) ;remember the array
ibp a ? ibp a ;skip lowest,highest
push p,a
ildb c,a ;get length of bcpl string
movei tt,$$pfam
movei d,@(x) ;get pointer to $$pfam
hrli d,440800 ;8 bit byte pointer
pfnt14: ildb e,a ;get a byte
idpb e,d
sojg c,pfnt14
setzi e,
idpb e,d ;make it 8.bit ASCIZ
pop p,a
addi a,20./4 ;skip family bytes
setzi tt,
movei b,@(x) ;get pointer to array
ildb c,a ;get face
hrli c,(c) ;face,,face
trz c,777774 ;face,,<face&3>
movem c,$$pfac(b)
ibp a ;skip source
tlc a,001000#002000 ;convert to 16.bit
ildb c,a ;get size
trne c,100000 ;is it .lt.0
jrst [ ;.lt.0, this is micas
movn d,c ;get micas into d
andi d,077777
movei t,(d)
imuli t,72.
addi t,2540./2
idivi t,2540. ;points
movei c,(t)
jrst pfnt16]
movei d,(c)
imuli d,2540.
addi d,72./2
idivi d,72.
pfnt16: hrli c,(d) ;micas,,points
movem c,$$psiz(b)
call prsmap ;map the press file to xgp file
move tt,[@xgplod] ;use xgpfiles to load font
movem tt,$$lod(b)
move tt,[@prswid] ;but press widths
movem tt,$$wid(b)
return
prsmap: movei c,$$pfam(b) ;get pointer to family
hrli c,440800 ;8 bit byte pointer
movei d,fnttrn ;get pointer to table
pmap02: skipn (d)
jrst [ movei x,[ [asciz "~%~T PRESS: font mapping: couldn't find ~8"]
c]
call log"log ;"
movei x,string"badreq ;"
call util"throw ;"
]
push p,c
hlrz e,(d) ;get pointer to family string
hrli e,440700 ;7.bit byte pointer
pmap04: ildb t,c ;get byte from user
ildb tt,e ;get byte from table
ucase t ;uppercasify
ucase tt
caie t,(tt)
jrst [ pop p,c ? aoja d,pmap02] ;go on to next table entry
jumpn t,pmap04 ;if both not zero, keep comparing
pmap10: ;;; now determine what size to use
sub p,[1,,1] ;flush string on stack
hrrz c,(d) ;get pointer to descriptions
hrrz d,$$psiz(b) ;get desired size (in points)
setzi tt, ;last size encountered
push p,c ;save good pointer on stack
pmap12: skipn (c)
jrst pmap20 ;go find the right face now
hlrz t,(c) ;get size
cain t,(d)
jrst [ ;equal, easy
movem c,(p) ;replace stack entry
jrst pmap20] ;and use it
jumpe tt,[movei tt,(t) ? aoja c,pmap12] ;always accept first entry
cain t,(tt)
aoja c,pmap12 ;already saw this size
caig t,(d)
jrst [ movem c,(p) ;t still too small, but bigger than before
movei tt,(t) ;remember as last size seen
aoja c,pmap12]
subi t,(d) ;delta with higher
subi tt,(d) ;delta with lower
movm tt,tt ;probably was negative
lsh tt,-1 ;bias for the lower
caile tt,(t)
movem c,(p) ;use upper if it is somewhat closer
pmap20: ;now find the face to use
pop p,c ;get pointer to descriptions of the right size
move d,$$pfac(b) ;get desired face
move d,(d)[f%reg ? f%ital ? f%bold ? f%bitl] ;get mask
pmap22: hrrz e,(c) ;get pointer to face/filname block
tdnn d,(e)
aoja c,pmap22
pmap30: ;now have block
move t,[sixbit/dsk/]
movem t,$$dev(b)
move t,1(e)
movem t,$$dir(b)
move t,2(e)
movem t,$$fn1(b)
move t,3(e)
movem t,$$fn2(b)
pmap40: movei c,$$pfam(b)
hrli c,440800 ;pointer to family string
movei d,widtrn ;get the width translation table
pmap42: hlrz e,(d) ;get old string
jumpe e,pmap50
hrli e,440700 ;make it a byte pointer
push p,c
pmap44: ildb t,c
ildb tt,e
ucase t
ucase tt
caie t,(tt)
jrst [ pop p,c ? aoja d,pmap42]
jumpn t,pmap44
pop p,c
hrrz e,(d)
hrli e,440700
pmap46: ildb t,e
ucase t
idpb t,c
jumpn t,pmap46
pmap50:
return
;;; not allowed to touch the low regs
prswid: skipe f.wdon
jrst [aos (p) ? return] ;already done
skipe f.w
jrst pwid02
movei x,f.wich
movei y,[sixbit/dsk/ ? sixbit/fonts/ ? sixbit/widths/ ? sixbit/fonts/]
call mapper"mapin ;"
jrst [ movei x,[ [asciz /~%~T PRSWID: ~A -- FATAL/]
[[asciz /couldn't open FONTS;FONTS WIDTHS/]]]
call log"log ;"
movei x,string"badreq ;"
call util"throw ;"
]
movem x,f.w
movem y,f.wadr
pwid02: move x,f.wadr
hrli x,242000 ;point to first 16 bit word
pwid04: ldb y,x ;get a word
movei z,(y)
lsh z,-12. ;get its type
cain z,1
jrst pwid10 ;found a type 1
pwid05: andi y,7777 ;get low 12. bits
jumpe y,[
movei tt,$$pfam
movei a,@fntfil(a)
movei x,[ [asciz "~%~T PRSWID: ~A~8~A -- FATAL"]
[[asciz "couldn't find font ("]]
a
[[asciz ") in FONTS;FONTS WIDTHS"]]]
call log"log ;"
movei x,string"badreq ;"
call util"throw ;"
]
idivi y,2
add x,y
skipe z
ibp x
jrst pwid04
pwid10: ; x:=byte pointer into f.w pointing to index entry of type 1
; y is length of entry. go to pwid05 if this isn't the right one
push p,x ;save it in case this isn't the right one
ildb w,x ;get the code word
tlc x,002000#001000 ;convert to 8.bit
ildb z,x ;get number of characters in entry
movei tt,$$pfam
movei zz,@fntfil(a) ;get pointer to desired family
hrli zz,440800 ;8.bit
pwid12: ildb t,zz ;get from desired
jumpe t,[
jumpn z,pwid16
jrst pwid20]
jumpe z,pwid16 ;loss
ildb tt,x ;get from entry
ucase t
ucase tt
cain t,(tt)
soja z,pwid12
pwid16: pop p,x
jrst pwid05
pwid20: ;w is code word being looked for
sub p,[1,,1] ;punt pointer
move x,f.wadr ;get address to f.w
hrli x,242000 ;LDBable to first word
setzm f.w.ok' ;have not found an OK font
setzm f.w.sc' ;nor a scalable font
setzm f.w.bd' ;in case we have nothing at all
pwid22: ldb y,x ;get the type information
movei z,(y)
lsh z,-12. ;the type
cain z,4 ;looking for type 4
jrst pwid30 ;found it
pwid24: andi y,7777 ;width
jumpe y,pwid40 ;finished scanning
idivi y,2
addi x,(y)
skipe z
ibp x
jrst pwid22
pwid30: ;x:=f.w byte pointer, y:=length of entry{type 4}, w:=family code
push p,x
tlc x,002000#001000 ;convert to 8.bit
ildb z,x ;get family code
caie z,(w)
jrst pwid38
move t,(p) ;get byte pointer
movem t,f.w.bd ;we found something
ildb z,x ;get face encoding
movei tt,$$pfac
hlrz tt,@fntfil(a) ;get desired face
caie z,(tt)
jrst pwid38 ;nope
ibp x ? ibp x ;skip bc and ec
tlc x,001000#002000 ;back to 16.bit bytes
ildb z,x ;get the size
jumpe z,[ ;scalable font
movem t,f.w.sc ;remember it as scalable
jrst pwid38]
imuli z,72. ;convert to points
addi z,2540./2
idivi z,2540.
movei tt,$$psiz
hrrz tt,@fntfil(a) ;get point size
cain z,(tt)
movem t,f.w.ok ;best one so far
pwid38: pop p,x
jrst pwid24
pwid40: skipe x,f.w.ok ;top priority
jrst pwid50
skipe x,f.w.sc ;scaling font next priority
jrst pwid50
skipe x,f.w.bd ;hopefully something was found
jrst pwid50
movei tt,$$pfam
movei b,@fntfil(a)
movei x,[ [asciz "~%~T PRSWID: ~8 not registered in fonts.widths -- FATAL"]
b]
call log"log ;"
movei x,string"badreq ;"
call util"throw ;"
pwid50: ;x has LDB (not ILDB) pointer to best entry for family
movei tt,$$psiz
hrrz tt,@fntfil(a) ;get point size
movem tt,f.w.pt' ;remember it
ibp x ;skip family byte and face byte
tlc x,002000#001000 ;8.bit bytes
ildb y,x ;beginning character
movem y,f.w.bc'
ildb y,x ;ending character
movem y,f.w.ec'
tlc x,001000#002000 ;back to 16.bit bytes
ildb y,x ;size
movem y,f.w.sz'
ibp x ;skip rotation
ildb y,x ;get high part of pointer
lsh y,16. ;put it up high
ildb z,x ;get low part
addi y,(z) ;offset into file
move x,f.wadr ;get base address of file
hrli x,442000 ;16.bit byte pointer
idivi y,2
add x,y ;point to the pdp-10 word
skipe z
ibp x ;point to the press word
addi x,4/2 ;skip FBBox, FBBoy, FBBdx, FBBdy
ildb t,x ;get proportion bits
andi t,140000 ;and only proportion bits
pwid60: trne t,2 ;is y done (if so, x already done)
jrst pwid70 ;finished
trne t,1
move w,[hrrm y,@tmpwid] ;setting instruction for y
trnn t,1
move w,[hrlm y,@tmpwid] ;settint instruction for x
move tt,f.w.bc
pwid62: camle tt,f.w.ec
jrst [ troe t,1 ;did we already do x
tro t,2 ;if so, this was y
jrst pwid60]
trne t,1 ;already done x?
jrst pwid63 ;yup, this is y
trnn t,100000 ;is x it fixed?
jrst pwid66 ;nope, do variable
jrst pwid64 ;fixed
pwid63: trnn t,040000 ;is y fixed?
jrst pwid66 ;nope, do variable
pwid64: ;;; font is fixed width
ildb y,x ;get the width/height
trne y,100000
ior y,[-1,,700000] ;sign extend
skipn f.w.sz
call [ imuli y,2540.
imul y,f.w.pt
idivi y,72000.
return]
lsh y,3 ;keep a little extra precision
pwid65: camle tt,f.w.ec
jrst pwid62
xct w
aoja tt,pwid65
pwid66: ;;; font is proportional
ildb y,x
cain y,100000
setzi y, ;character doesn't exist. Make sure
;it's width is zero
trne y,100000
ior y,[-1,,700000] ;sign extend
skipn f.w.sz
call [ imuli y,2540.
imul y,f.w.pt
idivi y,72000.
return]
lsh y,3
xct w
aoja tt,pwid62 ;loop
pwid70: setom f.wdon ;declare width info done
aos (p) ;sucessfully did character
return
define defprs family,name,desc
[asciz /family/],,<name=[desc ? 0,,0]>
termin
define defali family,name
[asciz /family/],,name
termin
define pfont size,dir,fn1,fn2,face
size!.,,[face ? sixbit/dir/ ? sixbit/fn1/ ? sixbit/fn2/]
termin
define xfont size,dir,fn1,fn2,face
<size!.*72.+100.>/200.,,[face ? sixbit/dir/ ? sixbit/fn1/ ? sixbit/fn2/]
termin
fnttrn:
defprs CMATHX, p.cmax,[
pfont 10,texfnt,cmathx,kst, f%all
]
defprs CMB, p.cmb,[
pfont 06,texfnt,cmb6,kst, f%all
pfont 08,texfnt,cmb8,kst, f%all
pfont 09,texfnt,cmb9,kst, f%all
pfont 10,texfnt,cmb10,kst, f%all
]
defali CMBI, p.cmb
defprs CMCSC, p.ccsc,[
pfont 10,texfnt,cmcsc,kst, f%all
]
defprs CMDUNH, p.dunh,[
pfont 13,texfnt,cmdunh,kst, f%all
]
defprs CMI, p.cmi,[
pfont 05,texfnt,cmi5,kst, f%all
pfont 06,texfnt,cmi6,kst, f%all
pfont 07,texfnt,cmi7,kst, f%all
pfont 08,texfnt,cmi8,kst, f%all
pfont 09,texfnt,cmi9,kst, f%all
pfont 10,texfnt,cmi10,kst, f%all
]
defprs CMR, p.cmr,[
pfont 05,texfnt,cmr5,kst, f%all
pfont 06,texfnt,cmr6,kst, f%all
pfont 07,texfnt,cmr7,kst, f%all
pfont 08,texfnt,cmr8,kst, f%all
pfont 09,texfnt,cmr9,kst, f%all
pfont 10,texfnt,cmr10,kst, f%all
]
defprs CMS, p.cms,[
pfont 08,texfnt,cms8,kst, f%all
pfont 09,texfnt,cms9,kst, f%all
pfont 10,texfnt,cms10,kst, f%all
]
defprs CMSC, p.cmsc,[
pfont 10,texfnt,cmsc10,kst, f%all
]
defprs CMSS, p.cmss,[
pfont 08,texfnt,cmss8,kst, f%all
pfont 10,texfnt,cmss10,kst, f%all
pfont 12,texfnt,cmss12,kst, f%all
]
defprs CMSSB, p.ssb,[
pfont 10,texfnt,cmssb,kst, f%all
]
defali CMSSBI, p.ssb
defprs CMSSS, p.sss,[
pfont 08,texfnt,cmsss8,kst, f%all
]
defprs CMSY, p.cmsy,[
pfont 05,texfnt,cmsy5,kst, f%all
pfont 06,texfnt,cmsy6,kst, f%all
pfont 07,texfnt,cmsy7,kst, f%all
pfont 08,texfnt,cmsy8,kst, f%all
pfont 09,texfnt,cmsy9,kst, f%all
]
defprs CMTI, p.cmti,[
pfont 08,texfnt,cmti8,kst, f%all
pfont 09,texfnt,cmti9,kst, f%all
pfont 10,texfnt,cmti10,kst, f%all
]
defprs CMTITL, p.titl,[
pfont 14,texfnt,cmtitl,kst, f%all
]
defprs CMTT, p.cmtt,[
pfont 08,texfnt,cmtt8,kst, f%all
pfont 09,texfnt,cmtt9,kst, f%all
pfont 10,texfnt,cmtt,kst, f%all
pfont 13,texfnt,cmtt1,kst, f%all
]
defali CMTTI, p.cmtt
defprs CREAM, p.crea,[
pfont 12,fonts1,script,12pt, f%all
]
defprs ELITE, p.elit,[
xfont 20,fonts,20fr,kst, f%all
xfont 25,fonts,25fr2,kst, f%all
]
defprs GACHA, p.gach,[
xfont 16,fonts,16fg,kst, f%all
xfont 18,fonts,18fg,kst, f%all
xfont 22,fonts,22fg,kst, f%all
xfont 25,fonts,25fg1,kst, f%reg
xfont 25,fonts,25fgb1,kst, f%bold
xfont 25,fonts,25fgi1,kst, f%ital+f%bitl
xfont 30,fonts,30fgb1,kst, f%all
]
defprs HELVETICA,p.hv,[
xfont 13,fonts,13vg,kst, f%all
xfont 20,fonts,20vg,kst, f%reg+f%bold
xfont 20,fonts,20vgi,kst, f%ital+f%bitl
xfont 25,fonts,25vg,kst, f%reg
xfont 25,fonts,25vgb,kst, f%bold
xfont 25,fonts,25vgi,kst, f%ital+f%bitl
xfont 31,fonts,31vg,kst, f%reg
xfont 31,fonts,31vgb,kst, f%bold
xfont 31,fonts,31vgi,kst, f%ital+f%bitl
xfont 40,fonts,40vgl,kst, f%reg+f%ital
xfont 40,fonts,40vg,kst, f%bold+f%bitl
]
defali HELVETICAD,p.hv
; defprs HELVETICAD,p.hvd,[
defali HELVETICASC,p.hv
; defprs HELVETICASC,p.hvsc,[
; defprs HIPPO, p.hipp,[
; defprs LOGO, p.logo,[
defprs LPT, p.lpt,[
xfont 13,fonts,13fg,kst, f%all
xfont 20,fonts,20fg,kst, f%reg+f%bold
xfont 20,fonts,20fgi,kst, f%ital+f%bitl
xfont 25,fonts,25fg,kst, f%all
xfont 30,fonts,30fg,kst, f%all
xfont 31,fonts,31fg,kst, f%all
xfont 40,fonts,40fg,kst, f%all
]
defprs MATH, p.math,[
xfont 30,fonts,plunk,kst, f%all
]
defprs NEWVEC, p.newv,[
pfont 02,dovutl,newvc2,kst, f%all
pfont 04,dovutl,newvc4,kst, f%all
pfont 06,dovutl,newvc6,kst, f%all
]
defali HNEWVEC,p.newv
defali SNEWVEC,p.newv
; defprs OLDENGLISH,p.oe,[
; defprs SAIL, p.sail,[
; defprs SIGMA, p.sigm,[
; defprs SLIDESCMATHX,p.scmx,[
; defprs SLIDESCMI,p.scmi,[
; defprs SLIDESCMR,p.scmr,[
; defprs SLIDESCMSY,p.scms,[
; defprs SPLUNK, p.splu,[
defali SYMBOL, p.cmsy
; defprs TEMPLATE,p.temp,[
; defprs TGATHX, p.tgax,[
; defprs TGB, p.tgb,[
; defprs TGI, p.tgi,[
; defprs TGR, p.tgr,[
; defprs TGS, p.tgs,[
; defprs TGSY, p.tgsy,[
; defprs TGTT, p.tgtt,[
defprs TIMESROMAN,p.tr,[
pfont 08,fonts,times,8rom, f%reg+f%bold
pfont 08,fonts,times,8ital, f%ital+f%bitl
pfont 09,fonts,times,9rom, f%all
pfont 10,fonts,times,10rom, f%reg
pfont 10,fonts,times,10bold, f%bold
pfont 10,fonts,times,10ital, f%ital+f%bitl
pfont 11,fonts,times,11rom, f%all
pfont 12,fonts,times,12rom, f%reg
pfont 12,fonts,times,12bold, f%bold
pfont 12,fonts,times,12ital, f%ital+f%bitl
pfont 14,fonts,times,14rom, f%reg
pfont 14,fonts,times,14bold, f%bold
pfont 14,fonts,times,14ital, f%ital+f%bitl
pfont 18,fonts,times,18rom, f%reg+f%bold
pfont 18,fonts,times,18ital, f%ital+f%bitl
pfont 24,fonts,times,24rom, f%reg+f%bold
pfont 24,fonts,times,24ital, f%ital+f%bitl
]
defali TIMESROMAND,p.tr
; defprs TIMESROMAND,p.trd,[
defprs TIMESROMANSC,p.trsc,[
pfont 12,fonts,times,12spec, f%all
]
0,,0
;;; make family aliases here for fonts not in FONTS.WIDTHS
define defwid old,new
[asciz /old/],,[asciz /new/]
termin
widtrn: defwid CMBI,CMB
defwid TIMESROMANSC,TIMESROMAN
0,,0
xgpfnt: tro x,400000
push p,y
push p,x
movei y,fntmap
call util"assoc ;"
jrst [ ;not found, easy
move z,nfonts
aos nfonts
setzm fntmap+1(z)
jrst xfnt10]
hrrzi z,(z) ;get internal number
push p,z
skipe x,fntfil(z)
call array"free ;"free the old array that was there
pop p,z
setzm fntfil(z)
xfnt10: pop p,x
hrli z,(x) ;external,,internal
movem z,fntmap(z) ;set the map
push p,z
movei x,lfntblk
call array"alloc ;"get an array for the file info
jrst [ movei x,[ [asciz "~%~T XGPFNT: font registration: memory bloat -- FATAL"]]
call log"log ;"
movei x,string"badreq ;"
call util"throw ;"
]
pop p,z
pop p,y
movem x,fntfil(z) ;remember it
setzi tt,
movei x,@(x) ;get pointer to word zero
hrli x,(y) ;blt pointer
movei y,(x)
blt x,$$dir(y) ;copy into array
move tt,[@xgplod] ;loading routine
movem tt,$$lod(y)
move tt,[@xgpwid] ;width getting routine
movem tt,$$wid(y)
return
loadfn: setzm f.wdon ;width info not done
aos (p) ;assume winnitude
push p,x
movei tt,$$dev
movei y,@fntfil(x) ;get pointer to file block
movei x,fntich ;channel to use
call mapper"mapin ;"open and map the file
jrst [ pop p,x ? sos (p) ? return]
exch x,(p)
movei tt,$$lod
move tt,@fntfil(x)
call (tt)
sos -1(p) ;lossage
pop p,x
call corblk"delete ;"
return
;;; x = font number
;;; y = base address of disk pages
.vector regsav(t+1)
.scalar tmpras,tmpwid
.scalar bl,ht
xgplod: setzm tmpras
setzm tmpwid
move t,[0,,regsav]
blt t,regsav+t
move a,x ;font #
move b,y ;base address of disk pages
move x,mapper"fillen ;"assume the length of the file
call array"alloc ;"
jrst xlod98
movem x,tmpras
movei x,256. ;width array
call array"alloc ;"
jrst xlod98
movem x,tmpwid
ldb x,[220900,,1(b)] ;get baseline
movem x,bl
movem x,fntbas(a) ;save it in baseline table
hrrz x,1(b) ;get height in rasters
movem x,ht
movem x,fnthgt(a) ;save in the height table
addi b,2 ;pointer after header
movei c,256. ;next position in array
xlod02: move x,(b)
addi b,1
cain x,1
jrst [ call xlodch
jrst xlod98
jrst xlod02]
came x,[-1]
jrst xlod98
call xgpcpr ;compress the font
skipe plot"rotatp ;"
call xgprot ;rotate if orientation matters and
;device is 90o rotated
move x,tmpras
movem x,fntras(a)
move x,tmpwid
movem x,fntwid(a)
movei x,400000
iorm x,fntmap(a) ;declare font loaded
aos nload ;and count it
aos (p) ;good return
jrst xlod99
xlod98: skipe x,tmpras
call array"free ;"
setzm tmpras
skipe x,tmpwid
call array"free ;"
setzm tmpras
xlod99: move t,[regsav,,0]
blt t,0+t
return
.scalar cw,ch
xlodch: hrli b,442200
ildb d,b ;LK
ildb e,b ;ascii code
movem e,ch
cail e,256.
.break 16,
ildb f,b ;RW
ildb g,b ;CW
movem g,cw
tlc b,002200#000800 ;convert to 8.bit
addi f,7
lsh f,-3 ;number of bytes wide
movei y,3(f)
lsh y,-2
imul y,ht
addi y,1(c) ;need at least this much
push p,y
move x,tmpras
call array"atleast ;"
jrst [sub p,[1,,1] ? return]
movem x,tmpras
movei tt,(e) ;get the ascii code
movem c,@tmpras ;set pointer to base raster info
movei tt,(c)
movei zz,@tmpras ;get pointer to raster section
hrli zz,441200 ;10.bit byte pointer
pop p,c ;new updated c
idpb d,zz ;set x-offset
move t,bl
idpb t,zz ;set y-offset
move t,ht
idpb t,zz ;height
tlc zz,001200#000600 ;final 6 bits
movei t,3(f)
lsh t,-2
idpb t,zz ;wrdwid
movei zz,1(zz) ;advance to next word
move d,ht ;loop count for height
xlch10: push p,f ;save RW
push p,zz
xlch12: movei e,4 ;4 bytes per word
setzm (zz) ;make sure it is zero to start
hrli zz,440800
xlch14: ildb t,b
circ t,-8
idpb tt,zz
sojg f,[sojg e,xlch14
add zz,ht
jrst xlch12]
pop p,zz
pop p,f
addi zz,1
sojg d,xlch10
movei b,1(b) ;advance b to next word
movei tt,$$wid ;should be routine to set width
move x,@fntfil(a) ;do it
jrst (x)
;;; not allowed to touch the low registers
xgpwid: push p,a
hrlz a,cw ;int,,
multip a,scalef,a
ash a,3 ;keep 3 bits of the fraction
move tt,ch
hllzm a,@tmpwid ;set the x width [y wid = 0]
pop p,a
aos (p) ;get this far, character is ok
return
.scalar tmpcpr ;temp compressed font pointer
xgpcpr: move x,tmpras
call array"size ;"
movei x,(y) ;assume size of old array
call array"alloc ;"get another array
return ;just return if fail (no compress)
movem x,tmpcpr ;save it
movei b,256. ;starting place for new rasters
setzi c, ;start at character 0
xcpr02: cail c,256.
jrst [ move x,tmpras ? call array"free ;"
move x,tmpcpr ? movei y,(b) ? call array"shrink ;"
movem x,tmpras
return]
movei tt,(c)
setzm @tmpcpr ;nothing new to start
move tt,@tmpras ;get index of raster
jumpe tt,[aoja c,xcpr02] ;nothing there
movei d,@tmpras ;get pointer to raster
hrli d,441200 ;10.bit byte pointer
ibp d ;skip xoff
ibp d ;and yoff
ildb e,d ;get height
tlc d,001200#000600 ;convert to 6 bit
ildb f,d ;pickup word width
movei d,1(d) ;get pointer to first raster
skipe e
skipn f
aoja c,xcpr02
setzi x, ;number of blank scan lines above
movei t,(e) ;loop count for height
push p,d ;save pointer
xcpr10: movei zz,(f) ;get width
movei tt,(d) ;and pointer
xcpr12: skipe (tt)
jrst xcpr18
addi tt,(e) ;go over one width
sojg zz,xcpr12 ;loop on width
addi x,1 ;count blankness of scan
addi d,1 ;go down one scan line
sojg t,xcpr10 ;loop on height
xcpr18: pop p,d ;get back pointer
cain x,(e) ;everything blank?
aoja c,xcpr02 ;yup, go on to next character
setzi y, ;number of blank scan lines below
movei t,(e) ;loop count for height
push p,d ;save pointer
addi d,-1(e) ;go to last scan line
xcpr20: movei zz,(f) ;get width
movei tt,(d) ;and pointer
xcpr22: skipe (tt)
jrst xcpr28
addi tt,(e) ;go over one width
sojg zz,xcpr22 ;loop on width
addi y,1 ;count blankness of scan line
subi d,1 ;go up one scan line
sojg t,xcpr20 ;loop on height
.lose ;should NEVER-EVER get here
xcpr28: pop p,d ;get back pointer
push p,x ? push p,y
addi x,(y) ;total blankness
movei y,(e) ;old height
subi y,(x) ;new height
imuli y,(f) ;times word width
addi y,1(b) ;necessary array size
move x,tmpcpr ;get the array
call array"atleast ;"try and get it
jrst [ move x,tmpcpr ? call array"free ;"
sub p,[2,,2]
return]
movem x,tmpcpr ;new array
pop p,y ? pop p,x
movei tt,(c)
move tt,@tmpras ;index to raster info
movei d,@tmpras ;pointer to raster info
hrli d,441200 ;10.bit byte pointer
movei tt,(c) ;character index
movem b,@tmpcpr ;new index to rasters
movei tt,(b)
movei zz,@tmpcpr ;get pointer to new rasters
hrli zz,441200 ;10.bit byte pointer
ildb t,d ;get old xoff
idpb t,zz ;it is new xoff
ildb t,d ;get old yoff
subi t,(x) ;without blankness on top
idpb t,zz ;new yoff
movei t,(e) ;old height
subi t,(x) ;without blankness on top
subi t,(y) ;nor on the bottom
idpb t,zz ;new height
tlc zz,001200#000600 ;convert to 6.bit pointer
idpb f,zz ;new word width is same as old
movei tt,(t) ;new height
imuli tt,(f) ;time width
addi b,1(tt) ;new end of array
movei d,1(d) ;pointer to raster
addi d,(x) ;pointer to first raster we will use
movei zz,1(zz) ;pointer to new raster
addi x,(y) ;how many to skip between rasters
xcpr40: movei z,(t) ;get new height
xcpr42: move y,(d) ;get old
movem y,(zz) ;save in new
addi d,1
addi zz,1
sojg z,xcpr42 ;loop on new height
addi d,(x) ;skip some rasters
sojg f,xcpr40 ;loop on width
aoja c,xcpr02
.scalar tmprot
xgprot: move x,tmpras
call array"size ;"
movei x,(y) ;assume size of old array
call array"alloc ;"get another array
return ;bad return (complain)
movem x,tmprot ;save it
movei b,256. ;starting place for new rasters
setzi c, ;start at character 0
xrot02: cail c,256.
jrst [ move x,tmpras ? call array"free ;"
move x,tmprot ? movem x,tmpras
call xgpcpr ;compress it
aos (p)
return]
movei tt,(c)
setzm @tmprot ;nothing new to start
move tt,@tmpras ;get index of raster
jumpe tt,[aoja c,xrot02] ;nothing to rotate
movei d,@tmpras ;get pointer to old raster
hrli d,441200 ;10.bit byte pointer
ibp d ? ibp d ;skip x-off and y-off
ildb e,d ;height
tlc d,001200#000600 ;convert to 6.bit byte pointer
ildb f,d ;word width
movei y,31.(e) ;get height+31.
idivi y,32. ;new word width
push p,y
imuli y,(f) ;times old width
imuli y,32. ;times 32 [wid*32 = new height]
addi y,1(b)
move x,tmprot
call array"atleast ;"
jrst [ sub p,[1,,1]
move x,tmprot ? call array"free ;"
return]
movem x,tmprot
movei tt,(c)
move tt,@tmpras
movei d,@tmpras ;pointer to old raster info
hrli d,441200 ;10.bit byte pointer
movei tt,(c) ;character index
movem b,@tmprot ;new index to rasters
movei tt,(b)
movei zz,@tmprot ;get pointer to new rasters
hrli zz,441200 ;10.bit byte pointer
ildb t,d ;old x-off
ildb tt,d ;old y-off
movni tt,(tt) ;negate
addi tt,(e)-1 ;new x-off is height-<y-off>-1
idpb tt,zz ;set it
idpb t,zz ;new y-off is old x-off
movei t,(f) ;old width
imuli t,32. ;new height
idpb t,zz ;set it
pop p,tt ;new word width
tlc zz,001200#000600 ;6.bit byte pointer
idpb tt,zz
movei d,1(d) ;point to old raster
addi d,(e)-1 ;point to last line
movei zz,1(zz) ;point to new raster
move x,[400000,,] ;bit to set in new raster
movei g,(e) ;loop count for old height
xrot40: push p,g
movei g,(f) ;loop count for word width
push p,d
push p,zz ;save old pointers
xrot42: move y,(d) ;get word from old raster
movei z,32.
xrot44: tlne y,400000
iorm x,(zz)
lsh y,1
addi zz,1
sojg z,xrot44
addi d,(e) ;point at next column
sojg g,xrot42 ;loop on width
pop p,zz ;restore new pointer
pop p,d ;restore old pointer
pop p,g ;restore height loop count
subi d,1 ;go up a scan line
lsh x,-1 ;go over a scan column
trze x,10 ;check for overflow
call [ tlo x,400000 ;high bit again
addi zz,(t) ;go to next word column
return]
sojg g,xrot40
imuli t,(tt) ;hieght*word width
addi b,1(t) ;update b
aoja c,xrot02
.begin flush
.scalar skpret
all: setzm skpret ;assume lossage
call junk ;flush any junk (fonts.widths, etc)
skipa
setom skpret
move x,[-maxfnt,,fntmap]
all2: skipn nload ;any more loaded?
jrst all6 ;nope, finished
push p,x
hrr x,(x)
trzn x,400000 ;is it loaded
jrst all4 ;nope
call this ;yup, say bye-bye
setom skpret ;at least on flushed
all4: pop p,x
aobjn x,all2
all6: skipe skpret
aos (p)
return
lru: setzm skpret ;assume lossage
;;; call junk ;flush any junk
;;; skipa
;;; setom skpret ;flushed something
skipn nload
jrst lru6
setoi t, ;current font = -1
move tt,[377777,,] ;used last in the future
move y,[-maxfnt,,0]
lru2: move x,fntmap(y)
trzn x,400000 ;is it loaded?
jrst lru4 ;nope
camge tt,fntliv(y) ;used less recently than current?
jrst lru4 ;nope
move tt,fntliv(y) ;update lifetime
movei t,(x) ;remember font
lru4: aobjn y,lru2
skipge x,t
call [ movei x,[ [asciz /~%~T~% NLOAD out of sync~%~%/]]
skipn spoolp
.value
call log"log ;"
call log"close ;"
.value]
call this
skipa
lru6: skipe skpret
aos (p)
return
this: sosge nload
.lose ;somebody out of phase. program bug.
push p,x
move x,fntwid(x)
call array"rstidx ;reset the index (we may have bashed
;it for fixed width font)
call array"free ;"free the width array
move x,(p)
move x,fntras(x) ;get the raster array
call array"free ;"free it
pop p,x
setzm fntwid(x)
setzm fntras(x)
movei t,400000
andcam t,fntmap(x) ;declare it not loaded
return
junk: push p,skpret
setzm skpret
skipn x,f.w
jrst junk2
call corblk"delete ;"get rid of fonts.widths
setzm f.w
setom skpret
junk2:
skipe skpret
aos -1(p)
pop p,skpret
return
.end flush
constants
.end font
.begin text
.scalar xpos,xrem,ypos ;x,remaining in x,y
.scalar chrwid,chrhig ;width and hieght in characters
.scalar header,infook,pagnum,pagtim
textnh: setzm header ;don't put header on pages
jrst text1
text: setom header
text1: move a,spoolr"device ;"get the device
call @device"init(a) ;"init the device
jrst [ movei x,string"deverr ;"
call util"throw] ;["]
call util"textln ;"get the page for the text line
move a,spoolr"device ;"
move t,device"chrwid(a) ;"
movem t,chrwid
move t,device"chrhig(a) ;"
movem t,chrhig
movei x,7 ;byte size
movei y,177 ;mask
call mapper"init ;"set up the file reader
call mapper"test7 ;"test file for 7 bitness
jrst [ movei x,[ [asciz /~%~T <<----->> FILE ERROR <<----->>
File does not appear to be 7 bit data./]]
call log"log ;"
movei x,string"badreq ;"
call util"throw ;"
]
setzm infook ;info for file is not OK
setzm pagnum ;page zero to start
.rdtime a,
movem a,pagtim ;remember current system time
setzm xpos
setzm ypos
move chrwid
movem xrem
setzm REALTM
aos REALTM ;realtm=1
setzm SNDLST ;zero the count
move tt,[600000,,[60.*60. ? 0]]
.realt tt,
chloop: call mapper"nxtbyt ;"get the next byte
jrst [ skipe ypos
call frmfed
move a,[400000,,[0 ? 0]]
.realt a,
.rdtime a,
sub a,pagtim
idivi a,30.
movei x,[ [asciz /~%~T PRINT: ~D page~S in ~D second~S./]
pagnum ? a]
call log"log ;"
move a,spoolr"device ;"
jrst @device"txtfin(a) ;"
]
call @chrtbl(x) ;process the character
setzm SNDLST
jrst chloop ;normal return
define chrcom first,last,routin
repeat "last-"first+1, routine
termin
chrtbl: chrcom @,H,ctlchr ;^@ to ^H
tabchr ;^I = tab
lnfeed ;^J = line feed
ctlchr ;^K
frmfed ;^L = form feed
crret ;^M = carriage return
chrcom N,Z,ctlchr ;^N to ^Z
chralt ;altmode
chrcom [\]_,ctlchr ;^\ to ^_
chrcom [ ]~,inschr ;printing characters insert
ctlchr ;delete turns into ^?
ctlchr: push p,x
movei x,"^ ;"
call inschr ;put in the uparrow
pop p,x
trc x,^A#"A ;complement the correct bit
jrst inschr ;put it in
chralt: movei x,"$ ;"convert alt to $
inschr: skipn ypos
call [ push p,x
call pgtitl
pop p,x
return]
skipn xrem
call [ push p,x
call outlin
pop p,x
return]
move t,xpos
idivi t,4
addi t,bitmap
dpb x,(tt)[340800,,(t) ? 240800,,(t) ? 140800,,(t) ? 040800,,(t)]
aos xpos
sos xrem
return
tabchr: movei x,<" > ;<">
movei a,8
move b,xpos
andi b,7
sub a,b
tbloop: push p,a
call inschr ;insert the space
pop p,a
sojg a,tbloop
return
lnfeed: skipn ypos
call pgtitl
skipn xpos
jrst outlin
jrst ctlchr
frmfed: skipe xpos
call outlin
skipe ypos
jrst outpag
return
crret: call mapper"nxtbyt ;"
jrst crret1
cain x,^J
jrst [skipn ypos ? call pgtitl ? jrst outlin]
call mapper"backup
crret1: movei x,^M
jrst ctlchr
insstr: hrli z,440700
insst1: ildb x,z
skipn x
return
push p,z
call inschr
pop p,z
jrst insst1
outlin: move x,xpos
move a,spoolr"device ;"
call @device"txtlin(a) ;"
setzm xpos
move chrwid
movem xrem
aos a,ypos
addi a,3
camle a,chrhig
jrst outpag ;execute a form feed
return
outpag: move a,spoolr"device ;"
call @device"txtpag(a) ;"
setzm xpos
setzm ypos
return
pgtitl: aos pagnum
setzm xpos
call outlin
skipn header
return ;no header
skipn infook
call [ .ryear a,
.rdati b,
movem a,ryear'
movem b,rtime'
movem c,rdate'
syscal rfname,[movei %jself ? movei dskich
movem rdev' ? movem rfn1'
movem rfn2' ? movem rdir']
call [ irps loc,,[rdev rdir rfn1 rfn2
]nam,,[error while readin filnam]
move [sixbit/nam/]
movem loc
termin
return]
setom infook
return]
ldb z,[.bp <003400,,>,ryear]
move z,(z)[ irps day,,[Sunday Monday Tuesday Wednesday
Thursday Friday Saturday]
[asciz /day/] ? termin ]
call insstr
movei z,[asciz /, /]
call insstr
ldb z,[.bp <000077000000>,rdate]
ldb y,[.bp <000000770000>,rdate]
subi z,'0
imuli z,10.
addi z,(y)-'0
move z,(z)-1+[ irps mon,,[January February March April
May June July August
September October November December]
[asciz /mon/] ? termin ]
call insstr
movei x,<" > ;<">
call inschr
ldb x,[.bp <7700>,rdate]
addi x,"0-'0 ;"
caie x,"0 ;"
call inschr
ldb x,[.bp <0077>,rdate]
addi x,"0-'0 ;"
call inschr
movei z,[asciz /, 19/]
call insstr
ldb x,[.bp <770000,,>,rdate]
addi x,"0-'0 ;"
call inschr
ldb x,[.bp <007700,,>,rdate]
addi x,"0-'0 ;"
call inschr
call tabchr
repeat 3,[
ldb x,[.bp <<770000,,>_<-.rpcnt*12.>>,rtime]
addi x,"0-'0 ;"
call inschr
ldb x,[.bp <<007700,,>_<-.rpcnt*12.>>,rtime]
addi x,"0-'0 ;"
call inschr
ifn .rpcnt-2, movei x,": ? call inschr ;"
]
call tabchr
irp what,,[[[-1]],rfn2,[[sixbit/ /]],rfn1,[[sixbit/;/]],rdir,[[sixbit/:/]],rdev]
push p,what ? termin
pgtit2: pop p,x-1
camn x-1,[-1]
jrst pgtit4
pgtit3: setzi x,
rotc x-1,6
push p,x-1
addi x,40
call inschr
pop p,x-1
jumpn x-1,pgtit3
jrst pgtit2
pgtit4: call tabchr
movei z,[asciz /Page /]
call insstr
move x,pagnum
push p,[-1]
pgtit5: idivi x,10.
push p,y
jumpn x,pgtit5
pgtit6: pop p,x
jumpge x,[
addi x,"0 ;"
call inschr
jrst pgtit6]
call outlin
call outlin
return
.end text
.begin ards
%ard.l==34 ;lowest valued ards byte
%ardch==34 ;character mode
%ardsp==35 ;setpoint
%ardlv==36 ;long vector
%ardsv==37 ;short vector
%ard.h==37 ;highest values ards byte
%ard.i==000001 ;invisibility flag for long coordinates
.scalar ardsx,ardsy ;current ards x and y values
.vector temp(4) ;4 bytes worth for holding characters
;as we accumulate them
test: return ;test file for ARDSness
ards: call plot"init ;"initialize the plotting routines
movsi x,-512.
movsi y,-512.
movsi w,+511.
movsi z,+511.
movei zz,<001*0>+<002*1>;no rotate, yes margins
call plot"setup ;"set up the scaling
movei x,7 ;7 bits per character
movei y,177 ;7 bit mask
call mapper"init ;"set up the file mapper
ards01: call plot"next ;"go on to the next plot
ards04: call mapper"nxtbyt ;"get the next byte
jrst ards50 ;when finished cleanup
call tstbyt ;test byte
jrst [ call pltchr ;plot command on no skip
jrst ards04]
cain x,^L ;plot separater?
jrst ards01 ; go do another plot
movei z,(x)
move x,ardsx
move y,ardsy
call plot"dchar ;"go draw the character
movem x,ardsx
movem y,ardsy
jrst ards04 ;and loop
ards50: call mapper"finish ;"no longer need the file
call plot"finish ;"finished with this set of plots
return ;and th.th.th.that's all folks
tstbyt: cail x,%ard.l ;lower limit
caile x,%ard.h ;upper limit
aos (p) ;skip return if a non-plotting char
return
pltchr: jrst @(x)-%ard.l+[ chrmod ? setpnt ? lngvec ? shtvec ]
chrmod: return
setpnt: call 4bytes
return ;couldn't get, so just return
movem x,ardsx
movem y,ardsy
jrst setpnt ;stays in this mode (sigh)
lngvec: call 4bytes
return
move w,ardsx
move z,ardsy
addb x,ardsx ;create relative vector
addb y,ardsy ;and set it back in the x,y
trnn t,%ard.i ;is vector invisible
call plot"dline ;"if visible, draw the line
jrst lngvec
shtvec: call 2bytes
return
move w,ardsx
move z,ardsy
addb x,ardsx ;create relative vector
addb y,ardsy ;and set it back in the x,y
call plot"dline ;"draw the line
jrst shtvec
4bytes: repeat 4,[
call mapper"nxtbyt ;"
return
trnn x,100 ;make sure 100 bit is on
jrst mapper"backup ;"
movem x,temp+.rpcnt
]
aos (p) ;skip return
jrst cnvrt ;and convert to x,y
2bytes: repeat 2,[
call mapper"nxtbyt ;"
return
trnn x,100 ;make sure 100 bit it on
jrst mapper"backup ;"
movem x,temp+<2*.rpcnt>+0
setzm temp+<2*.rpcnt>+1
]
aos (p) ;skip return
cnvrt: setzi t, ;no flags
move w,temp+2 ;get the y portion
move z,temp+3
call cnvrt1
move y,x ;put it in y
move w,temp+0 ;get the x
move z,temp+1
call cnvrt1 ;and convert it also
return
cnvrt1: lsh t,1 ;shift the flags over
ldb x,[010500,,w] ;get the low order bits
ldb tt,[000500,,z] ;and the high
lsh tt,5 ;shift the high up
add x,tt ;add them in
trne w,1 ;should it be negative?
movn x,x ;yup, so make it so
trne z,40 ;flag on?
tro t,1 ;if so, set it in t
hrlz x,x ;convert to integer,,fraction
return
constants
.end ards
.begin tek
%tek.l==33 ;lowest valued tek byte
%tekes==33 ;escape
%tekfs==34 ;enter point mode
%tekgs==35 ;enter vector mode
%tekrs==36 ;nop -> alpha mode
%tekus==37 ;nop -> alpha mode
%tek.h==37
.scalar bitsiz ;number of bits per character
.scalar tekx,teky ;current tek x and y values
.vector temp(4) ;4 bytes for holding characters
test: return ;test file for TEKness
tek7: skipa a,[7] ;7 bits per character
tek8: movei a,8
movem a,bitsiz ;number of bits per character
tek: call plot"init ;"initial the plot routines
movsi x,0
movsi y,0
movsi w,1023.
movsi z,0890.
movei zz,<001*0>+<002*1>;no rotate, yes margin
call plot"setup ;"setup the scalings
move x,bitsiz ;size of bits
movei y,177 ;mask
call mapper"init ;"initialize the file mapper
setzm tekx ;these only get zeroed once!!
setzm teky
teknxt: call plot"next ;"
movsi 0,<1023./82.> ;pretty close to top of page
movem 0,tekx
movsi 0,890.-<890./60.> ;pretty close to top of page
movem 0,teky
tekalp: call mapper"nxtbyt ;"in alpha mode
jrst tekfin ;cleanup when finished
tekal2: call tektst
jrst tekplt
cail x,40
call [ movei z,(x)
move x,tekx
move y,teky
call plot"dchar ;"
movem x,tekx
movem y,teky
aos (p)
return]
call [
cain x,^M
setzm tekx
cain x,^J
call [ movsi 0,-<890./58.>
add 0,teky
camge 0,[<890./60.>,,]
move 0,[<890./60.>,,]
movem 0,teky
return]
return]
jrst tekalp
tekfin: call mapper"finish
call plot"finish
return
tektst: cail x,%tek.l ;lower limit
caile x,%tek.h ;upper limit
aos (p) ;skip return if non printing character
return
tekplt: jrst @(x)-%tek.l+[ tekesc ? tekpnt ? tekvec ? tekalp ? tekalp]
tekesc: call mapper"nxtbyt ;"
jrst tekfin ;finished when run out of bytes
cain x,^L
jrst teknxt ;yup, go on to next plot
jrst tekalp ;go back to alpha mode
tekpnt: move a,tekx
move b,teky
call tekcor ;get a point
jrst tekalp ;go back to alpha mode
move w,x
move z,y
movem x,tekx
movem y,teky
call plot"dline ;"
jrst tekpnt
tekvec: move a,tekx
move b,teky
call tekcor ;get the starting values
jrst tekalp
movem x,tekx
movem y,teky
tekve2: move a,tekx ;defaults
move b,teky
call tekcor ;do successive lines
jrst tekalp
move w,tekx
move z,teky
movem x,tekx
movem y,teky
call plot"dline ;"
jrst tekve2
;;; A coordinate is a 7-bit character CCvvvvv where CC are command
;;; bits and vvvvv are value bits. At any time, CC=00 is an out
;;; of band signal, aborts the coordinate, and the entire
;;; character gets reinterpreted. Other than that CC can take on
;;; the following series of values with the associated meanings.
;;; Values change in context. Context normally goes down, and
;;; only goes up
;;; 01 (A) Change the high 5 bits of the y coordinate (optional).
;;; Return to state (A).
;;; 11 (B) Change the low 5 bits of the y coordinate (optional).
;;; 01 (C) Change the high 5 bits of the x coordinate (optional).
;;; 11 (D) Special hack to get 12 bit resolution (extremely
;;; optional). Coordinates are allowed to have two
;;; fraction bits. Unlike coordinates in which the high
;;; and low five bits get defaulted to the previous
;;; values, the fraction bits are always defaulted to
;;; zero. Here's the hack: the previous 11 command
;;; (change low y) was not really a change low y. It was
;;; the extension bits (you can get them back by getting
;;; the low five bits of the y). View vvvvv (from the
;;; previous change low y command) as nyyxx where n is
;;; don't care, yy are the y fraction bits, and xx are the
;;; x fraction bits. The new low y is obtained from the
;;; vvvvv of this command. BTW, return to state (C).
;;; 10 (E) Change the low 5 bits of the x coordinate. This is
;;; required and this command ends the coordinate.
tekst1: mapper"backup ? tekchy ? tekclx ? tekcly
tekst2: mapper"backup ? tekchx ? tekclx ? tekcll
tekcor: movei tt,tekst1
tekclp: call mapper"nxtbyt ;"
return
movei y,(x)
lsh y,-5
addi tt,(y)
jrst @(tt)
tekchy: dpb x,[270500,,b]
movei tt,tekst1
jrst tekclp
tekcly: dpb x,[220500,,b]
movei tt,tekst2
jrst tekclp
tekcll: ldb y,[220500,,b] ;last low-y was lowXY -- fix this
dpb y,[200200,,a]
lsh y,-2
dpb y,[200200,,b]
jrst tekcly
tekchx: dpb x,[270500,,a]
movei tt,tekst2
jrst tekclp
tekclx: dpb x,[220500,,a]
move x,a
move y,b
aos (p) ;win, win
return
constants
.end tek
.begin ddv
.scalar topmar,lftmar,rigmar ;margins
.scalar bytwid,bytrem ;byte width, remaining bytes in this line
.scalar endflg ;-1 <==> last command was page eject
.scalar xorflg ;-1 <==> next line XORs with previous
.scalar bitptr,lstptr ;bit pointer and last one
.scalar remlin ;number of lines remaining on this page
ddv: call plot"init ;"initialize the plot routines
;plot"setup is irrelavent"
movei x,8
movei y,377
call mapper"init ;"init the file reader
call mapper"nxtbyt ;"get the density byte
jrst ddvfin ;"nothing
caie x,1
jrst ddvfin ;oops
setzm topmar
setzm lftmar
setzm rigmar
setzm endflg
setzm xorflg
setzm bitptr
setzm lstptr
ddvnxt: call plot"next ;"
call setup ;setup the margins
ddvlp: call mapper"nxtbyt ;"get the next byte
ddvfin: jrst [ call mapper"finish ;"finished with the file
call plot"finish ;"finished with the plot
return]
jumpe x,[
skipe endflg
jrst ddvfin ;finished if two consequtive 0's
call linfin ;finish current line if it needs it
setom endflg
jrst ddvnxt] ;special page eject command
setzm endflg ;wasn't page eject
trzn x,200 ;test for high bit
jrst [ trzn x,100
jrst rpeatn ;00 repeat the following byte
jrst skpplt] ;01 skip some and plot the next
trzn x,100
jrst pltnxt ;10 plot a sequence
jrst contrl ;11 special formatting codes
rpeatn: movni a,1(x) ;number of times to repeat
call mapper"nxtbyt ;"get the next byte
jrst ddvfin ;finished at eof
addm a,bytrem
idpb x,bitptr
aojl a,.-1
setom plot"pagdrt ;"page is dirty
skipg bytrem
call linfin
jrst ddvlp ;go loop
skpplt: addi x,1
movni a,(x)
addm a,bytrem
idivi x,4
addm x,bitptr
skipe y
ibp bitptr
sojg y,.-1
call mapper"nxtbyt ;"
jrst ddvfin
idpb x,bitptr
sosg bytrem
call linfin
setom plot"pagdrt ;"page is dirty
jrst ddvlp
pltnxt: movni a,1(x)
addm a,bytrem
pltnx2: call mapper"nxtbyt
jrst ddvfin
idpb x,bitptr
aojl a,pltnx2
setom plot"pagdrt ;"page is dirty
skipg bytrem
call linfin
jrst ddvlp
contrl: caig x,00
jrst eol ;end of line
caig x,36
jrst rptlin ;repeat last line
caig x,37
jrst xornxt ;next line will XOR
caig x,47
jrst margin ;setup margins
caig x,50
jrst bigmar ;big margins
jrst ddvlp
eol: call linadv ;advance line
jrst ddvlp
.vector tmpbuf(<2112.+31.>/32.)
rptlin: call linfin
rptli2: hrr a,lstptr
hrl a,a
sub a,plot"wrdwid ;"
movs a,a ;previous,,this
movei b,(a)
add b,plot"wrdwid
blt a,-1(b)
push p,x
call linadv
pop p,x
sojg x,rptli2
jrst ddvlp
xornxt: call linfin
setom xorflg
jrst ddvlp
margin: andi x,7
movei a,(x)
call mapper"nxtbyt ;"
jrst ddvfin
lsh x,3
addi x,(a)
idivi x,1700.
movem y,topmar ;don't print too many blank pages.
call mapper"nxtbyt ;"
jrst ddvfin
sos x ;convert fortran 1-based to assembler 0-based
movem x,lftmar
call mapper"nxtbyt ;"
jrst ddvfin
sos x ;convert fortran 1-based to assembler 0-based
movem x,rigmar
call setup
jrst ddvlp
bigmar: call mapper"nxtbyt ;"
jrst ddvfin
movei a,(x)
lsh a,8
call mapper"nxtbyt ;"
jrst ddvfin
addi a,(x)
sos a
movem a,lftmar
call mapper"nxtbyt ;"
jrst ddvfin
movei a,(x)
lsh a,8
call mapper"nxtbyt ;"
jrst ddvfin
addi a,(x)
sos a
movem a,rigmar
call setup
jrst ddvlp
setup1: skipa a,[0]
setup: move a,topmar
movei t,1700.
subi t,(a)
movem t,remlin
imul a,plot"wrdwid ;"
move b,lftmar
idivi b,4
addi a,bitmap(b)
hrl a,(c)[440800 ? 340800 ? 240800 ? 140800]
movem a,bitptr
movem a,lstptr
move a,rigmar
sub a,lftmar
addi a,1
movem a,bytwid
movem a,bytrem
return
linfin: move t,lstptr
camn t,bitptr
return
movem t,bitptr
skipe xorflg
call doxor
setzm xorflg
linadv: move t,lstptr
came t,bitptr
jrst linfin
add t,plot"wrdwid ;"
movem t,lstptr
movem t,bitptr
move bytwid
movem bytrem
sosg remlin
call earlye ;early end
return
doxor: hrrz tt,lstptr
movei t,(tt)
movn zz,plot"wrdwid ;"
add t,zz ;go up a line
hrli t,(zz) ;and make aobjn
doxor2: move 0,(t)
xorm 0,(tt)
addi tt,1
aobjn t,doxor2
return
earlye: call plot"next ;"
call setup1
return
constants
.end ddv
.begin scn
;;; process an XGP scan file (rotate for v80 and gould)
;;; the format of XGP scan files is in INFO /xgp/scan
xgpwid==<2112.+31.>/32. ;pdp-10 words wide
.scalar curlin,virlin
scn: call plot"init ;initialize the plot routines
;plot"setup is irrelavent
movei x,8
movei y,377
call mapper"init ;"init the file reader
setzm curlin ;current line
setzm virlin ;virtual line (should be same as curlin)
call plot"next
scnlp: call pdp11w
jrst scnfin
move a,x ;get word count
call pdp11w
jrst scnfin
move b,x
subi a,2
jumpg b,line ;go cut the paper
jumpe b,scnfin
jrst cut
scnfin: call mapper"finish ;"
call plot"finish ;"
return
cut: tlz b,400000 ;clear the sign bit
call plot"next ;"
setzm curlin ;current real line
movem b,virlin ;virtual line
jumple a,cutfin
cut2: call pdp11w
jrst scnfin
sojg a,cut2
cutfin: jrst scnlp ;go loop
line: move c,b ;get desired line
sub c,virlin ;how many lines he thinks he wants to advance
skipg c ;must be positive
movei c,1 ;it is now
movem b,virlin ;where he thinks he is
add c,curlin ;where we want to go
line02: caig c,2112. ;page break?
jrst line04 ;OK, just do the work
push p,a
push p,c
call plot"next
pop p,c
pop p,a
subi c,2112.
jrst line02
line04: movem c,curlin ;set current line
jumple a,scnlp ;in case there is nothing there
setom plot"pagdrt ;"it is dirty
movei b,2112.
sub b,c
idivi b,32.
addi b,bitmap
movsi d,400000
movn c,c
lsh d,(c) ;d has bit, b has offset into bitmap
call pdp11w
jrst scnfin
sojle a,scnlp
cain x,2_8
jrst image
cain x,0_8
jrst runlen
jrst scnfin
image: call pdp11w
jrst scnfin
movei c,16.
image2: trne x,1
iorm d,(b)
addi b,xgpwid
caml b,bitmpe ;make sure we didn't overshoot
jrst runfin ;read rest of line silently
lsh x,-1
sojg c,image2
sojg a,image
jrst scnlp
runlen: movei c,0 ;state <+1 = black, +2 = zero seen last>
runln2: call pdp11w
jrst scnfin
move e,x ;get the word
andi e,377 ;first byte
call runln6
jrst runfin ;that's all folks
move e,x
lsh e,-8 ;get the high byte
call runln6
jrst runfin
sojg a,runln2
jrst scnlp
runfin: sojle a,scnlp
call pdp11w
jrst scnfin
jrst runfin
runln6: aos (p) ;assume good
jumpe e,[
troe c,2
sos (p)
jrst runln8]
trz c,2 ;didn't see 0
trnn c,1
jrst [ ;white
imuli e,xgpwid
add b,e
caml b,bitmpe ;make sure we didn't overshoot
sos (p)
jrst runln8]
runln7: iorm d,(b)
addi b,xgpwid
caml b,bitmpe ;make sure we didn't overshoot
sosa (p) ;bad return and fall through
sojg e,runln7
runln8: trc c,1 ;toggle color
return
pdp11w: call mapper"nxtbyt ;"
return
lsh x,8
push p,x
call mapper"nxtbyt
jrst [pop p, ? return]
add x,(p)
pop p,
aos (p)
return
constants
.end scn
.begin harscn ;harvard scan files
comment ~
Graphics mode file format for Gould printer-plotter
The Gould printer plotter is a bit-raster printer.
It has 2112 bits per horizontal line (11" long) and approximately
1700 lines per page. The rollers slip, so don't depend on the 1700
exactly.
Files for plotting on the Gould as graphics should have the extension
.GLD and be plotted with PLOT file/G(for graphics).
The software driving the device GLD: expects zero compressed
rasters. These are packed 2 bytes per word. Each byte is 16 bits long.
One byte is packed in each PDP-10 halfword, right justified.
Diagram:
1 1 3
0 2 7 9 5
------------------------------------
XX one byte XX another byte
------------------------------------
where X's are don't care (ignored) bits.
The bytes are considered a stream; word boundaries are ignored.
If a byte is 0 or -1 (177777 in 16 bits) then it is a flag,
and the next byte is interpreted specially. If the flag was 0,
the next byte is a count of the number of 0 bytes this pair represents.
E.g. 0,,100 represents 100 octal bytes of 16 bits of 0.
If the flag is -1, then in general the next byte is also a compression
count. However, if the count is -2 through -3 inclusive, it is
a command to the software in the 11.
2'nd byte Meaning
-----------------------
177776 (-2) Form feed following printing of current line
177775 (-3) Print blank raster (1 bit high)
177774 (-4) Print n blank rasters (n follows)
(this list is subject to change on very short notice)
(-3 & -4 are not yet implemented, but will be soon)
/G Steckel
~
harscn: call plot"init ;initialize the plot routines
;plot"setup is irrelavent
movei x,18.
movei y,177777
call mapper"init
harnxt: call plot"next ;"
setzi a, ;line zero
harfig: move c,a
imul c,plot"wrdwid ;"
add c,[442000,,bitmap]
move b,plot"wrdwid ;"number of words to go
lsh b,1 ;number of 16.bit bytes to go
harlop: caml a,plot"bithig ;"
jrst harnxt
call mapper"nxtbyt
jrst harfin
skipe x
cain x,177777
jrst harcom
idpb x,c ;plop the byte down
setom plot"pagdrt ;"page is dirty
sojg b,harlop
aoja a,harfig
harcom: move e,x ;get the previous byte
call mapper"nxtbyt ;"get the next one
jrst harfin
jumpe e,harrpt
cain x,177776
jrst harnxt
cain x,177775
jrst harblk
cain x,177774
jrst harbln
jrst harrpt
harblk: movei x,1
jrst harbl5
harbln: call mapper"nxtbyt ;"
jrst harfin
harbl5: add a,x
jrst harfig
harrpt: skipe e
setom plot"pagdrt ;"
harrp1: jumpe x,harlop
caml a,plot"bithig ;"
jrst harnxt
idpb e,c
subi x,1
sojg b,harrp1
aos c,a
imul c,plot"wrdwid ;"
add c,[442000,,bitmap]
move b,plot"wrdwid ;"number of words to go
lsh b,1 ;number of 16.bit bytes to go
jrst harrp1
harfin: call mapper"finish
call plot"finish
return
constants
.end harscn
.begin press
;;; Press file interpreter
prs.hi==2540.*11. ;height in micas
prs.wi==2540.*17./2 ;width in micas
.scalar gxpos,gypos,spacex,spacey ;random necessary variables
.scalar nofont ;set if no font yet determined
.scalar prslen,prtdir,prtadr,prtrec,prtnrc,nparts ;pointers and counters
high16==242000
low16==<042000>
first8==341000
secnd8==241000
third8==141000
fourt8==041000
press: call plot"init ;"initialize the plotting routines
movsi x,0
movsi y,0 ;lower left
movsi w,prs.wi ;press height
movsi z,prs.hi ;press width (upper right)
movei zz,<001*1>+<002*0>;yes rotate, no margins
call plot"setup ;"
movei x,8
movei y,377 ;make mapper happy
call mapper"init ;"gets FILLEN among other things
move mapper"fillen ;"
movem prslen ;rememver file length
call getdoc ;get the document directory and info
call getprt ;get the part dir into memory
call getfnt ;get the font part and register fonts
call dopags ;do the pages
call cleanup ;cleanup after myself (release mem, etc)
return
cleanup:
call plot"finish ;"finished plotting
move x,prtdir
call corblk"delete ;"release the part dir pages
call mapper"finish ;"finished with the file
return
badfil: move a,x
movei x,[ [asciz /~%~T PRESS: BADFIL: ~A/] ? a]
call log"log ;"
movei x,string"badreq ;"
call util"throw ;"
getdoc: move x,prslen ;get felgth of file in words
idivi x,128. ;number of records in file
jumpn y,[movei x,[asciz /Not multiple of 256 (press) words/]
jrst badfil]
subi x,1 ;last record
hrli x,1 ;n,,start
call getrec ;get the record, returns
;x=begadr,,endadr
;y=corblk"delete arg"
jrst [ movei x,[asciz /Couldn't get Document Directory./]
jrst badfil]
push p,y ;remember docdir corblk arg
hlrz x,x ;get starting address
hrli x,442000 ;create 16. bit byte ponter
ildb a,x
came a,[27183.] ;magic password
jrst [ movei x,[asciz /Bad password in file./]
jrst badfil]
ildb a,x ;number of records
ildb a,x ;number of parts
movem a,nparts
ildb a,x ;part dir record start
movem a,prtrec
ildb a,x ;number of records in part dir
movem a,prtnrc
pop p,x ;get corblk arg
call corblk"delete ;"don't need it anymore
return
getprt: hrr x,prtrec
hrl x,prtnrc ;n,,start
call getrec ;get the records
jrst [ movei x,[asciz /Couldn't get part dir./]
jrst badfil]
hlrzm x,prtadr ;starting address of part dir
movem y,prtdir ;corblk"delete arg for part dir"
return
.scalar fntprt
getfnt: call font"getrdy ;"get ready to do fonts
move a,nparts
move tt,prtadr
hrli tt,442000
gtfn02: ildb b,tt
caie b,1
jrst [ repeat 3, ibp tt
sojg a,gtfn02
movei x,[asciz /Couldn't find font part./]
jrst badfil]
ildb x,tt ;get starting record
ildb a,tt ;number of records
hrli x,(a) ;n,,start
call getrec ;get the font records
jrst [ movei x,[asciz /Couldn't get font part./]
jrst badfil]
movem y,fntprt ;remember to delete afterwords
hlrz x,x ;get starting address
hrli x,442000
gtfn04: push p,x
ildb y,x
jumpe y,[pop p,x ? jrst gtfn06]
move x,(p)
push p,y
call font"prsfnt ;"register the press font
pop p,y ? pop p,x
idivi y,2
addi x,(y)
skipe z
ibp x
jrst gtfn04
gtfn06: move x,fntprt
call corblk"delete ;"don't need font part anymore
return
dopags: move a,nparts ;number of parts in the part dir
move tt,prtadr
hrli tt,444400 ;36.bit byte pointer
dopgs2: ildb b,tt
ildb c,tt
ldb d,[high16,,b] ;get the type
cain d,0
call [ push p,a
push p,tt
call dopage ;do the page
pop p,tt
pop p,a
return]
sojg a,dopgs2
return
.scalar begadr,endadr
dopage: push p,b ? push p,c
call plot"next ;"go to the next page
pop p,c ? pop p,b
ldb x,[low16,,b] ;get start record
ldb t,[high16,,c] ;and number of records
hrli x,(t) ;n,,start
call getrec ;get records
jrst [ move a,x
movei x,[ [asciz "~%~T PRESS: Record out of range (~O)"]
a]
call log"log ;"
movei x,string"badreq ;"
call util"throw ;"
]
hlrzm x,begadr ;save beginning address of page records
hrrzm x,endadr ;and end address
push p,y
call doents ;do entities
pop p,x ;get corblk"delete argument"
call corblk"delete ;"free up the pages for the page
return
doents: push p,[0] ;finish marker
ldb b,[low16,,c] ;get padding
move a,endadr ;point at end
hrli a,442000 ;point just beyond last word
dents2: idivi b,2 ;convert to pdp-10 words
subi a,1(b) ;go down one extra
ibp a
skipn c
ibp a ;now points at top of next entity
ldb b,a ;get length of entity
jumpn b,[push p,a ? jrst dents2] ;non-zero
dents4: pop p,a
skipn a
return
call doent ;do this entity
jrst dents4
.scalar enttyp,begbyt,bytlen,xe,ye,pgleft,bottom,width,height,entlen
.scalar fntset,font
.scalar numcom
doent: subi a,12./2 ;go down 12. press words
setom nofont ;no font set/font determined yet
setzm font ;start off with font zero
tlz a,007700
tlo a,000800 ;8.bit byte pointer
ildb b,a ;get entity type
movem b,enttyp
ildb b,a ;get font set
movem b,fntset
tlc a,<001000#002000> ;back to 16. bit
ildb b,a ;get high order of begin byte
lsh b,16. ;make it high
ildb c,a ;get low order
addi b,(c) ;full number
movem b,begbyt
ildb b,a ;get high order of byte length
lsh b,16.
ildb c,a
addi b,(c) ;byte length
movem b,bytlen
irps what,,xe ye pgleft bottom width height entlen
ildb b,a
movem b,what
termin
push p,b ;save entity length
subi b,12. ;minus trailer words
imuli b,2 ;number of command bytes
movem b,numcom
pop p,b ;number of press words in entity
idivi b,2
subi a,1(b) ;go down+1
ibp a ;up a word
skipn c
ibp a ;extra if even
tlc a,<001000#002000> ;entity commands are 8 bit
move b,numcom ;number of commands
move c,begbyt
idivi c,4 ;press bytes to pdp-10 words
hrl c,(d)[441000 ? 341000 ? 241000 ? 141000]
add c,begadr ;offset into real memory
;;; a is EL pointer
;;; b is count of bytes in EL
;;; c is DL pointer
entlop: jumple b,[return]
ildb d,a ;get command
subi b,1 ;coun it
movei e,cmdtbl ;get the command table
entlp2: hlrz f,(e)
cail d,(f)
aoja e,entlp2
hrrz f,-1(e)
call (f)
jrst entlop
cmdtbl: 000,,SHOWSH ;SHOW CHARACTERS SHORT
040,,SKIPSH ;SKIP CHARACTERS SHORT
100,,SHOWSK ;SHOW CHARACTERS AND SKIP
140,,SSPXSH ;SET SPACE X SHORT
150,,SSPYSH ;SET SPACE Y SHORT
160,,STFONT ;SET FONT
200,,AVAIL ;AVAILABLE
240,,SPARE ;SPARE
353,,SKCBI ;SKIP CONTROL BYTES IMMEDIATE
354,,ALTERN ;ALTERNATE
355,,ONLYON ;ONLY ON COPY
356,,SETX ;SET X
357,,SETY ;SET Y
360,,SHOWCH ;SHOW CHARACTERS
361,,SKIPCH ;SKIP CHARACTERS
362,,SKCBYT ;SKIP CONTROL BYTES
363,,SHOWI ;SHOW CHARACTER IMMEDIATE
364,,SETSPX ;SET SPACE X
365,,SETSPY ;SET SPACE Y
366,,RSETSP ;RESET SPACE
367,,SPACE ;SPACE
370,,STBRIT ;SET BRIGHTNESS
371,,SETHUE ;SET HUE
372,,SETSAT ;SET SATURATION
373,,SHOWOB ;SHOW OBJECT
374,,SHOWDT ;SHOW DOTS
375,,SHOWDO ;SHOW DOTS OPAQUE
376,,SHWREC ;SHOW RECTANGLE
377,,NOOP ;NOOP
400,, ;THIS IS THE END OF THE TABLE
define elarg num
setzi x,
repeat num,[
ifn .rpcnt, lsh x,8
ildb y,a
addi x,(y)]
subi b,num
termin
define dlarg num
setzi x,
repeat num,[
ifn .rpcnt, lsh x,8
ildb y,c
addi x,(y)]
termin
showsh: addi d,1 ;com=000+n-1 so n=com+1
movei x,(d)
jrst shch.1 ;connect with show character
skipsh: subi d,40-1 ;com=040+n-1 so n=com-(040-1)
movei x,(d)
jrst skch.1 ;connect with skip characters
showsk: subi d,100-1 ;com=100+n-1 so n=com-(100-1)
movei x,(d)
call shch.1 ;show the characters
movei x,1 ;one byte
jrst skch.1 ;and skip it
sspxsh: subi d,140-1
movei x,(d)
jrst sspx.1 ;connect with set space x
sspysh: subi d,150-1
movei x,(d)
jrst sspy.1 ;connect with set space y
stfont: subi d,160
movem d,font
setom nofont ;invaildate current font
return
avail: return
spare: return
skcbi: elarg 1
jrst skcb.1 ;connect with skip control bytes
altern: elarg 2
elarg 4
dlarg 4
return
onlyon: elarg 1
return
setx: elarg 2
add x,xe
andi x,077777 ;only 15. bits
movem x,gxpos
return
sety: elarg 2
add x,ye
andi x,077777 ;only 15. bits
movem x,gypos
return
showch: elarg 1
shch.1: sojl x,[return]
push p,x
ildb x,c ;get character from data list
call show ;show the character
pop p,x
jrst shch.1
skipch: elarg 1
skch.1: idivi x,4
addi c,(x)
skipa
ibp c
sojge y,.-1
return
skcbyt: elarg 1
skcb.1: subi b,(x)
idivi x,4
addi a,(x)
skipa
ibp a
sojge y,.-1
return
showi: elarg 1
jrst show
setspx: elarg 2
sspx.1: movem x,spacex
return
setspy: elarg 2
sspy.1: movem x,spacey
return
rsetsp: setzm spacex
setzm spacey
return
space: movei x,40
jrst show
stbrit: elarg 1
return
sethue: elarg 1
return
setsat: elarg 1
return
showob: elarg 2
jrst skch.1 ;may have to really do it someday
showdt: elarg 4
jrst skch.1 ;may have to really do it someday
showdo: elarg 4
jrst skch.1 ;may have to really do it someday
shwrec: elarg 2 ;get width
push p,x
elarg 2 ;get height
movei y,(x)
pop p,x
jrst rect ;and go show it
noop: return
show: skipe nofont
call [ push p,x
move x,fntset
imuli x,16.
add x,font
push p,x
call font"switch ;"
jrst [ pop p,a
movei x,[ [asciz "~%~T PRESS: couldn't switch to font ~O(octal)."]
a]
call log"log ;"
movei x,string"badreq ;"
call util"throw ;"
]
sub p,[1,,1] ;flush font number
pop p,x
setzm nofont
return]
movei z,(x)
movs x,gxpos
movs y,gypos
call font"dchar ;"draw the character
hlrzm x,gxpos ;resoter updated x and y
hlrzm y,gypos
return
rect: move w,gxpos
move z,gypos
addi x,(w)
addi y,(z)
irps ac,,x y w z
movsi ac,(ac) ? termin
call plot"drect
return
getrec: ;x = n,,start records
;returns x = start,,stop addresses
; y = -npages,,fpage for corblk
hlrz y,x ;number of records
tlz x,-1 ;start record only
addi y,(x)
imuli x,128. ;start address within file
imuli y,128. ;stop address within file
camge x,prslen
camle y,prslen ;range check
return
sub y,x ;number of words
push p,y ? push p,x
move x,y
addi x,pagsiz-1
idivi x,pagsiz
call corblk"fresh ;"
jrst [ pop p,x ? pop p,y ? return] ;bad return
hrrzi y,(x) ;get page number
exch x,(p) ;get file start addr, put corblk on stack
movn z,-1(p) ;get number of words
imuli y,pagsiz ;convert to pdp-10 memory address
push p,y ;save memory address
hrli y,(z) ;-nwords,,memadr
call mapper"blkred ;"
jrst [ pop p,z ? pop p,y ? pop p,x ? return] ;bad return
pop p,x ;get memory address
imul x,[1,,1] ;addr,,addr
pop p,y ;get corblk for return
pop p,z ;get nwords
add x,z ;start,,end
aos (p) ;good return
return
.end press
.begin xgp
xgp.hi==2112. ;almost 11.0 inches high
xgp.wi==200.*17./2 ;8.5 inches wide
.scalar xgp.x ;current x coordinate
.scalar xgp.y ;current y coordinate
.scalar scanln ;current scan line from baseline adjusts are made
.scalar seper ;inter-char spaceing
.scalar stubit ;xgp.x at time of start_underline
.scalar basel ;height of line above baseline
.scalar chrrct ;max baseline distance.
.scalar movdwn ;amount to move down from xgp.y after line is done
.vector rescan(100.) ;500 characters worth
.scalar outena,count,ptr,eofp,eopp
;;; xgp file interpreter
xgp: call plot"init ;"initialize the plotting routines
movsi x,0
movsi y,xgp.hi ;lower left
movsi w,xgp.wi
movsi z,0 ;upper right
movei zz,<001*1>+<002*0>;yes rotate, no margins
call plot"setup ;"
movei x,7 ;7 bits per character
movei y,177 ;7 bit mask
call mapper"init ;"initialize the file mapper
call scrimp ;process scrimp commands
call getrdy ;get ready to process the file
setzm eofp ;not end of file yet
xgp02: call plot"next ;"go on to the next page
call dopage ;process the next page
jrst xgp50 ;finished
jrst xgp02
xgp50: call mapper"finish ;"no longer need the file
call plot"finish ;"finished plotting (for this file)
return ;and th.th.th.that's all folks
.scalar nskip,ksetok,lftmar,topmar,vsp
scrimp: setzm nskip
setzm ksetok
movei a,128
movem a,topmar
movem a,lftmar
movei a,6
movem a,vsp
scrmor: call mapper"nxtbyt ;"
jrst scrfin
cain x,"; ;"
jrst scrcom
scrloo: cain x,^L ;find first ^L
jrst scrfin
call mapper"nxtbyt ;"
jrst scrfin
cain x,^J
jrst scrmor
jrst scrloo
scrfin: skipe ksetok ;have we seen a ;KSET?
jrst scrfi2
call font"getrdy ;"no - load the XGP's default font
movei x,0
movei y,[sixbit /dsk/ ? sixbit /25fg/
sixbit /kst/ ? sixbit /fonts/]
call font"xgpfnt ;"
scrfi2: movei 1
came nskip
jrst [ movei x,[ [asciz "~%~T XGP: File error: must have ;SKIP 1"]]
call log"log ;"
movei x,string"badreq ;"
call util"throw ;"
]
return
scrcom: call scrget ;get the command
return ;eof
camn a,['kset]
jrst scrkset ;get fonts
camn a,['skip]
jrst scrskip ;do a ;skip
camn a,['lftmar]
jrst scrlft
camn a,['topmar]
jrst scrtop
camn a,['vsp]
jrst scrvsp
jrst scrloo ;ignore rest
scrget: setzi a,
scrge2: call mapper"nxtbyt ;"
return ;eof
ucase x ;uppercase it
cail x,"A ;"
caile x,"Z ;"alphabetic?
jrst [aos (p) ? return]
subi x,"A-'a ;'"
lsh a,6
addi a,(x)
jrst scrge2
scrnum: setzi a, ;read numeric arg into a
scrnm2: call mapper"nxtbyt
return ;eof
cail x,"0 ;"numeric?
caile x,"9 ;"
return ;no, done
subi x,"0
imuli a,10
add a,x
jrst scrnm2
scrskip:
call scrnum
movem a,nskip
jrst scrloo
scrlft: call scrnum
movem a,lftmar
jrst scrloo
scrtop: call scrnum
movem a,topmar
jrst scrloo
scrvsp: call scrnum
movem a,vsp
jrst scrloo
.vector ksetbf(50.),ksetfi(4)
.scalar ksetnm,ksetmr
scrkset:
call font"getrdy ;"
setom ksetnm ;last font was #-1
move a,[440700,,ksetbf]
scrks2: call mapper"nxtbyt ;"
jrst scrks4
caige x,40
jrst scrks4
idpb x,a
jrst scrks2
scrks4: move a,[sixbit /dsk/]
movem a,ksetfi+0
move a,[sixbit /kst/]
movem a,ksetfi+2
setom ksetok
move d,[440700,,ksetbf]
movei b,ksetfi
scrks5: setzm ksetmr ;assume no more
call .c"rfn"rfn
jumpe e,[
skipn ksetmr
jrst scrloo
aos ksetnm ;skip this one
jrst scrks5]
aos x,ksetnm
movei y,ksetfi
call font"xgpfnt ;"
jrst scrks5
rsixtp: cain a,",
call [ aos -1(p)
setom ksetmr
return]
caige a,40
aos (p)
return
$$rfn==-1
.insrt syseng;rfn
getrdy: movei x,0
call font"switch ;"
jrst [ movei x,[ [asciz "~%~T XGP: Couldn't switch to font 0"]]
call log"log ;"
movei x,string"badreq ;"
call util"throw ;"
]
return
xarg1: skipe outena
jrst [ sosge count
return ;eof on rescan
ildb x,ptr ;get character
aos (p)
return]
skipe eofp
return ;eof return
call mapper"nxtbyt ;"
jrst [ setom eofp ? return] ;eof return
idpb x,ptr
aos count
aos (p)
return
xarg1s: call xarg1
return
trne x,100
subi x,200
aos (p)
return
xarg2: call xarg1
return
lsh x,7
push p,x
call xarg1
jrst [ sub p,[1,,1] ? return]
add x,(p)
sub p,[1,,1]
aos (p)
return
dopage: setzm eopp ;not end of page
move y,topmar
movem y,scanln
; setzm nscanl ;next scan line
dopag1: call doline
jrst [ ;end of page, maybe end of file
skipn eofp
aos (p) ;not eof
return]
jrst dopag1
doline: setzm outena ;disable output
setzm chrrct
setzm movdwn
call normal ;initial line height based on
jfcl ; current font, in case line is empty
setzm count ;count of saved characters
move x,lftmar ;underline from left margin by default
movem x,stubit
setzm basel
move x,[440700,,rescan]
movem x,ptr
call dolin1
setom outena
setzm seper
setzm basel
move x,[440700,,rescan]
movem x,ptr
call dolin1
skipn eofp ;end of file
skipe eopp ;or end of page
skipa ;causes non-skip return
aos (p)
return
dolin1: call xarg1 ;get a character
jrst linfin ;finish the line
movei y,cl.top ;top level command list
call util"assoc ;"see if it is in there
movei z,normal ;normal character
call (z) ;call the command
return ;end of line
jrst dolin1
cl.top: ^@,,[aos (p) ? return] ;ignore
^H,,backsp
^I,,tab
^J,,linefd
^L,,[setom eopp ? jrst linfin]
^M,,cretrn
177,,xgpesc
0,,0
normal: skipn outena
jrst [ ;if disabled
move y,basel
add y,font"curbas ;"xgp sucks so hard...
camle y,chrrct
movem y,chrrct
sub y,font"curhgt ;"boy does it suck...
camge y,movdwn
movem y,movdwn
aos (p)
return]
movei z,(x)
move x,xgp.x
add x,seper
movsi x,(x)
move y,xgp.y
sub y,basel
movsi y,(y)
call font"dchar ;"
hlrzm x,xgp.x
hlrz y,y
add y,basel
hrrzm y,xgp.y
aos (p)
return
backsp:
tab: skipn outena ;do nothing if output disabled
jrst bspfin
push p,x ;save char
move x,xgp.x ;save original pos
push p,x
movei x,40 ;output space
call normal
jfcl
move z,xgp.x ;compute width of space (including seper)
pop p,x ;restore original pos
sub z,x
pop p,y ;are we doing a backspace?
cain y,^H
jrst bspbsp
imuli z,8 ;compute width of tab
sub x,lftmar ;how many tabs are we from the margin?
idiv x,z
aos x ;move right to next tab stop
imul x,z
add x,lftmar
skipa
bspbsp: sub x,z ;move left by one space
movem x,xgp.x
bspfin: aos (p)
return
linefd: jrst linfin
linfin: skipn outena
jrst [ ;if output not enabled
move y,scanln ;get top scan line
add y,chrrct
add y,vsp
movem y,xgp.y
sub y,movdwn
movem y,scanln
return]
return
cretrn: move lftmar ;get leftmargin
movem xgp.x
aos (p)
return
xgpesc: call xarg1 ;get the arg
return
movei y,cl.esc ;get the command list for escapes
call util"assoc ;"
movei z,normal ;else quoted, just display it
jrst (z)
cl.esc: 001,,xe1
002,,xe2
003,,xe3
004,,xe4
0,,0
xe1: call xarg1 ;yet another character
return
movei y,cl.es1 ;escape 1 command list
call util"assoc ;"
call [ movei z,[aos (p) ? return]
caige x,32.
movei z,fntchg ;font change
return]
jrst (z)
cl.es1: 40,,setcol ;set column (column[2])
41,,undera ;underscore (y-off{abs}, length[2])
42,,linspc ;line space (y-space)
43,,bsladj ;base line adjust (offset{abs})
44,,ppgnum ;print page number
45,,hedtxt ;heading text (length, text[length]
46,,stundr ;start underline
47,,undend ;end underscore (y-offset)
50,,intrsp ;intercharacter spacing (spacing)
51,,undenw ;end underscore (thickness, y-offset)
52,,bsladr ;base line adjust (offset{rel})
53,,underr ;underscore (y-off{rel}, length[2])
0,,0
fntchg: call font"switch ;"
jrst [ move a,x
movei x,[ [asciz "~%~T XGP: couldn't switch to font ~D"] a]
call log"log ;"
movei x,string"badreq ;"
call util"throw ;"
]
setzm basel ;zeros baseline adjustments
aos (p)
return
setcol: call xarg2
return
hrrzm x,xgp.x
aos (p)
return
underr: skipa b,basel ;relative to curent baseline
undera: setzi b, ;relative to zero
call xarg1s
return
add b,x ;baseline
add b,xgp.y ;y top
call xarg2 ;get length
return
add x,xgp.x ;x right
movei y,2 ;width of 2
move w,xgp.x
doundr: ;b=y down, x=one x (not current), y=width,
;w=other x
aos (p) ;if get this far, success
skipn outena
return ;don't do anything if not outputing
movsi w,(w) ;to X
movsi x,(x) ;from X
move z,b
add z,y
movsi z,(z) ;to Y
movsi y,(b) ;from Y
call plot"drect ;"
return
undenw: call xarg1
return
skipa a,x
undend: movei a,2
call xarg1s
return
move b,x
add b,xgp.y
move x,stubit
move w,xgp.x
sub w,seper
move y,a
jrst doundr
linspc: call xarg1
return
addm x,xgp.y
return
.value foo
bsladr: skipa a,basel
bsladj: setzi a, ;relative to 0 (absolute)
call xarg1s
return
add a,x
movem a,basel
aos (p)
return
ppgnum: aos (p)
return
.value foo
hedtxt: .value foo
stundr: move x,xgp.x
movem x,stubit
aos (p)
return
intrsp: call xarg1
return
movem x,seper
aos (p)
return
xe2: call xarg1s ;relative set column
return
addm x,xgp.x
hrrzs xgp.x
aos (p)
return
xe3: call xarg2 ;set y pos
return
movem x,scanln
aos (p)
return
.end xgp
subttl Output device drivers
.begin device
irps off,,[init finish timout host contact
bitwid bithig bpi orient pagsnd
chrwid chrhig txtlin txtpag txtfin]
off==.irpcnt
termin
.end device ;; it looks like this has to come before outdev
define outdev +host,contact,orient,init=INIT+
init ? finish ? timout ? host ? string"contact
bitwid ? bithig ? bpi ? orient ? pagsnd
chrwid ? chrhig ? txtlin ? txtpag ? txtfin
termin
;;; aixgp: outdev host=-1,contact=0,orient=0
.begin pfcv80
bitwid==2112.
bithig==1700.
bpi==200.
wrdwid==<bitwid+31.>/32.
wrdhig==bithig
chrwid==132.
chrhig==66.
pfcv80: outdev host=3641,contact=versatec,orient=1
pfcv8t: outdev host=3641,contact=versatec,orient=1
pfcv8f: outdev host=3641,contact=versatec,orient=1,init=initf
;;; ts7v80: outdev host=3117,contact=versatec,orient=1
;;; ts7v8t: outdev host=3117,contact=versatec,orient=1
;;; ts7v8f: outdev host=3117,contact=versatec,orient=1,init=initf
pfcfil: outdev host=1440,contact=fileo,orient=1
%v8nop==0
%v8scn==2
%v8xor==4
%v8prz==6
%v8prt==10
%v8pag==12
.scalar feject ;<>0 :: force a page eject on end of page
initf: skipa a,[-1]
init: setzi a,
movem a,feject
move a,spoolr"device ;"
move x,device"host(a) ;"get the chaos host
move y,device"contact(a);"and the contact name
skipn spoolp
jrst init2
call chaos"open ;"try and open the connection
return ;error recovery donwe at a higher level
init2: aos (p) ;good return
return
finish: call chaos"finish ;"
return
timout: call chaos"init ;"flush chaos connection
return
txtlin: jumpe x,txtli2
move y,[440800,,bitmap]
syscal siot,[movei chaoso ? y ? x]
txterr: jrst chaos"txterr ;"text send error on chaos net
txtli2: move y,[444400,,[^M ? ^J]]
movei x,2
syscal siot,[movei chaoso ? y ? x]
jrst txterr
return
txtpag: move y,[444400,,[^L]]
movei x,1
syscal siot,[movei chaoso ? y ? x]
jrst txterr
return
txtfin: syscal force,[movei chaoso]
jrst txterr
return
%lleop==0
%llrpt==<0_6>
%llskp==<1_6>
%llplt==<2_6>
%lleol==300
%llrpl==300
%llxor==337
%llmar==340
%llma1==350
.scalar topmar,botmar,lefmar,rigmar ;margins
.scalar linptr,nbytes,nwords
pagsnd: call pagmar ;get margins
return ;nothing on the page
call pagnpk ;get a new packet
call pagpre ;put in the preamble
setzm okprvl ;previous line not ok
setom prvfin ;previous line (none) did finish
move a,topmar ;start at the first non-zero line
pagsn2: camle a,botmar
jrst pagfin ;finish the page
call paglin ;send the line (updates a and linptr)
setzm SNDLST ;still sending if get here
jrst pagsn2
pagmar: move a,bitwrd
subi a,1
skipn bitmap(a)
sojge a,.-1
jumpl a,[return] ;nothing on page
aos (p) ;something on the page
idivi a,wrdwid ;convert to line number
movem a,botmar
setzi b,
skipn bitmap(b)
aoja b,.-1
idivi b,wrdwid
movem b,topmar
movei t,(b)
imuli t,wrdwid
addi t,bitmap
movem t,linptr ;first approximation (point to beg of line)
subi a,(b)
movei b,1(a) ;number of scan lines to check
movei a,(t) ;get pointer into lines
;left margin
setzb e,f
pagml0: movei d,(e)
addi d,(a)
movei c,(b)
pagml1: ior f,(d)
addi d,wrdwid
sojg c,pagml1
jumpe f,[aoja e,pagml0]
addm e,linptr ;second approximation to line pointer
movei t,(e)
imuli e,4
jffo f,.+1
movei f,(g)
idivi f,8
move (f)[440800 ? 340800 ? 240800 ? 140800]
hrlm linptr ;final value of line pointer
addi e,(f)
movem e,lefmar
movei tt,(e)
;right margin
setzi f,
movei e,wrdwid-1
pagmr0: movei d,(e)
addi d,(a)
movei c,(b)
pagmr1: ior f,(d)
addi d,wrdwid
sojg c,pagmr1
jumpe f,[soja e,pagmr0]
subi t,1(e)
movem t,nwords ;-number of words to consider
imuli e,4
addi e,3
circ f,32.
move f,g ;get the reversed bits
jffo f,.+1
move f,g
idivi f,8
subi e,(f)
movem e,rigmar
subi tt,1(e)
movem tt,nbytes ;-number of bytes to consider
return
pagpre: move t,topmar
aos t ;convert to one based
idivi t,8
addi tt,%llmar ;margin command
idpb tt,zz
idpb t,zz
move a,lefmar
move b,rigmar
addi a,1
addi b,1
idpb a,zz
idpb b,zz
addi z,4 ;just put four bytes in
caig a,255.
caile b,255.
skipa
return
movei %llma1 ;big margin
idpb zz
ldb [.bp <377_8>,a]
idpb zz
ldb [.bp <377_0>,a]
idpb zz
ldb [.bp <377_8>,b]
idpb zz
ldb [.bp <377_0>,b]
idpb zz
addi z,5 ;five more bytes
return
pagfin: movei b,1724. ;real number of scan lines down
subi b,(a) ;number of scan lines to go
skipn feject ;should we force a page eject
cail b,150. ;3/4 inch threshhold
call [ ;do it as a page eject
setzi ;this is the end of page command
idpb zz
addi z,1
aos (p)
return]
call [ ;do it as separate blank lines
skipn prvfin
call [ movei %lleol ;finish previous line if necessary
idpb zz
addi z,1
setom prvfin
return]
movei %lleol ;signal blank line
idpb zz
addi z,1
call pagli0 ;do repetitions
return]
pagpkt: call chaos"snddt1 ;"send with opcode=201
jrst chaos"pgserr ;"PAGE SEND ERROR on chaos net
pagnpk: setzi z,
move zz,[440800,,chaos"opkt+chaos"%cpkdt]
return
.scalar okprvl,prvfin,thsfin,regcnt,xorcnt,regfin,xorfin
.vector reglin(wrdwid+8),xorlin(wrdwid+8)
paglin: movei 377777 ;big number (still possitive)
movem xorcnt ;XOR is very expensive...
call paglrg ;regular line comuputation
jrst paglzr ;line is zeros, treat it specially
skipe okprvl
call pagxor ;try an xor if previous line ok
setom okprvl ;previous line is OK now.
move b,xorcnt
camge b,regcnt
jrst [ ;do xor
movei %llxor
idpb zz
addi z,1
move c,[440800,,xorlin]
move d,xorfin
jrst pagli2]
move b,regcnt
move c,[440800,,reglin]
move d,regfin
skipn prvfin
jrst [
movei %lleol ;finish previous line if needed
idpb zz
addi z,1
jrst pagli2]
pagli2: movem d,prvfin
pagli4: cail z,chaos"%cpmxc-15 ;"
call pagpkt
ildb d,c
caige d,%llplt
jrst [ idpb d,zz
ildb d,c
idpb d,zz
addi z,2
subi b,2
jumpg b,pagli4
jrst paglrp]
movei e,(d)-%llplt+1 ;number of bytes in this sequence -1
movei f,1(e)
addi f,(z)
cail f,chaos"%cpmxc-15 ;"
call pagpkt
addi z,1(e)
subi b,1(e)
idpb d,zz ;put in command byte
pagli6: ildb d,c
idpb d,zz
sojg e,pagli6
jumpg b,pagli4
paglrp: setzi b,
move d,linptr ;get this line
move e,nwords
pagli7: movei c,(d) ;get this line
movei d,wrdwid(c) ;advance (and remember) next
movei f,(d) ;get next for AOBJNing
hrli f,(e)
pagli8: move t,(c)
came t,(f)
jrst pagli9
addi c,1
aobjn f,pagli8
aoja b,pagli7
pagli9: hrrm d,linptr
addi a,1(b)
pagli0: skipn c,b
return
setom prvfin
caile c,36
movei c,36
subi b,(c)
addi c,%llrpl
idpb c,zz
addi z,1
caile z,chaos"%cpmxc-15 ;"
call pagpkt
jrst pagli0
paglzr: skipn prvfin
call [ movei %lleol
idpb zz
addi z,1
setom prvfin
return]
movei %lleol
idpb zz
addi z,1
setzi b,
move d,linptr
move e,nwords
paglz7: movei d,wrdwid(d)
movei f,(d)
hrli f,(e)
paglz8: skipe (f)
jrst pagli9
aobjn f,paglz8
aoja b,paglz7
paglrg: move b,linptr ;get pointer to current line
move c,[440800,,reglin]
call pagscn ;scan the line
return
aos (p)
movem d,regcnt
movem e,regfin
return
.vector xorbuf(wrdwid)
pagxor: move b,linptr ;this line
movei c,-wrdwid(b) ;previous line
movei d,xorbuf
hrl d,nwords
pagxo2: move e,(b)
xor e,(c)
movem e,(d)
addi b,1
addi c,1
aobjn d,pagxo2
hrri b,xorbuf ;left half still there !!
move c,[440800,,xorlin]
call pagscn
.break 16, ;shouldn't get here
movem d,xorcnt
movem e,xorfin
return
;;; a=line number, b=source pointer, c=dest pointer, d:=count e:=self finish?
pagscn: movei f,(b)
hrl f,nwords
pagsc1: skipn (f)
jrst [ aobjn f,pagsc1 ? return]
aos (p) ;not all zeros
move f,nbytes
setzi d, ;no count
pagsc2: ildb tt,b
pagsc4: aoje f,[movei <%llplt-1>+1
idpb c
idpb tt,c
addi d,2
setoi e,
return]
ildb t,b
skipn t
jumpe tt,pgzer0 ;started reading zeros
cain t,(tt)
jrst pgrep0 ;started reading a repetition
ibp c ;plot <n> goes here (determine n later)
movsi x,-<64.-5> ;safety margin for compressing repeat/skip
move y,c ;remember where to put it
pgpll0: idpb tt,c ;put in one byte
aobjp x,[
addi d,1(x)
addi x,<%llplt-1>
dpb x,y
movei tt,(t)
jrst pagsc4]
pgpllp: aoje f,[idpb t,c
addi d,2(x)
addi x,<<%llplt-1>+1>
dpb x,y
setoi e,
return]
movei tt,(t)
ildb t,b
skipn t
jumpe tt,pgplzr
caie tt,(t)
jrst pgpll0 ;loop and put it in
aoje f,[idpb tt,c
idpb tt,c
addi d,3(x)
addi x,<%llplt-1>+2
dpb x,y
setoi e,
return]
ildb t,b
caie tt,(t)
jrst [ idpb tt,c
add x,[1,,1]
jrst pgpll0]
aoje f,[idpb tt,c
idpb tt,c
idpb tt,c
addi d,4(x)
addi x,<%llplt-1>+3
dpb x,y
setoi e,
return]
ildb t,b
caie tt,(t)
jrst [ idpb tt,c
idpb tt,c
add x,[2,,2]
jrst pgpll0]
addi d,1(x)
addi x,<%llplt-1>
dpb x,y
movei e,4
jrst pgrepe
pgrep0: movei e,2
pgrepe: hrli e,(e)
add e,[-65.,,]
pgrep2: aoje f,pgrep6
ildb tt,b
caie t,(tt)
jrst pgrep6
aobjn e,pgrep2
subi e,1
pgrep6: addi e,<%llrpt-1>
idpb e,c
idpb t,c
addi d,2
jumpn f,pagsc4
setoi e,
return
pgplzr: aoje f,[addi d,1(x)
addi x,<%llplt-1>
dpb x,y
setzi e,
return]
ildb t,b
jumpe t,[addi d,1(x)
addi x,<%llplt-1>
dpb x,y
movei e,3
jrst pgzero]
add x,[1,,1]
idpb tt,c
jrst pgpll0
pgzer0: movei e,2
pgzero: aoje f,[setzi e, ? return]
ildb t,b
skipn t
aoja e,pgzero
pgzer6: caile e,64.
jrst [ subi e,64.
movei g,<%llskp-1>+63.
idpb g,c
idpb tt,c
addi d,2
jrst pgzer6]
addi e,<%llskp-1>
idpb e,c
idpb t,c
addi d,2
aoje f,[setoi e, ? return]
jrst pagsc2
constants
.end pfcv80
.begin gould
bitwid==2112.
bithig==1700.
bpi==200.
wrdwid==<bitwid+31.>/32.
wrdhig==bithig
chrwid==132.
chrhig==66.
gould: outdev host=500,contact=gould,orient=1
gouldt: outdev host=500,contact=gould,orient=1
%go==200 ;chaos opcode to use
%gocut==01 ;cut operation
%goalp==102 ;enter alpha mode (with byte swapping)
%goslw==04 ;force slow down
%gogrf==100 ;16 bit bytes
.scalar linnum ;text line number
init: move a,spoolr"device ;"
move x,device"host(a) ;"
move y,device"contact(a);"
call chaos"open ;"
return ;error recovery downe at a higher level
setzm linnum ;starting on line aero
aos (p) ;good return
return
finish: call chaos"finish ;"
return
timout: call chaos"init ;"
return
txtlin: jumpn x,txtli2
move x,[.byte 8 ? repeat 4,[40 ? ] ? .byte]
movem x,bitmap
movei x,2
txtli2: trne x,1 ;is it odd?
call [ move t,x
idivi t,4
addi t,bitmap
movei z,40
dpb z,(tt)[341000,,(t) ? 241000,,(t) ? 141000,,(t) ? 041000,,(t)]
aos x
return]
move a,[bitmap,,chaos"opkt+chaos"%cpkdt]
movei t,3(x)
idivi t,4
blt a,chaos"opkt+chaos"%cpkdt-1(t)
move z,x
movei zz,%go\%goalp
skipn linnum
tro zz,%gocut ;cut if first line
call chaos"sndpkt ;"send the packet
txterr: jrst chaos"txterr ;"text send error on chaos net
aos linnum
return
txtpag: movei a,chrhig
sub a,linnum
jumple a,txtpa8
move t,[.byte 8 ? repeat 2,[40 ? ] ? .byte]
movem t,chaos"opkt+chaos"%cpkdt
txtpa2: movei z,2 ;at least two bytes
movei zz,%go\%goalp
skipn linnum
tro zz,%gocut
push p,a
call chaos"sndpkt ;"
jrst txterr
pop p,a
aos linnum
sojg a,txtpa2
txtpa8: setzm linnum
return
txtfin: movei z,2
movei zz,%go\%goalp\%gocut
move [.byte 8 ? 40 ? 40 ? .byte]
movem chaos"opkt+chaos"%cpkdt
call chaos"sndpkt ;"
jrst txterr
return
pagsnd: movei a,bithig
movei b,bitmap
pags02: hrli b,-wrdwid
setzi zz,
movei z,1 ;byte count must be at least one
movei c,chaos"opkt+chaos"%cpkdt
pags04: move t,(b) ;get word from bitmap
movem t,(c) ;put it in packet
addi zz,1
skipe t
movei z,(zz)
aos c
aobjn b,pags04
imuli z,4 ;four bytes per packet
caile z,chaos"%cpmxc ;"
movei z,chaos"%cpmxc ;"clamp it down
movei zz,%go\%gogrf ;initial opcode
caie a,bithig
skipn a
iori zz,%gocut ;cut if first or last line
caig a,12.
iori zz,%goslw ;force a slowdown toward the end
call chaos"sndpkt ;"send the packet
jrst chaos"pgserr ;"
setzm SNDLST ;still winning if we get here
sojg a,pags02
movei z,4 ;four bytes (has to be something)
setzm chaos"opkt+chaos"%cpkdt ;zero the word
movei zz,%go\%gogrf\%gocut
call chaos"sndpkt ;"
jrst chaos"pgserr ;"
return
constants
.end gould
.begin hargld
;;; send raster page to .temp.; in harvard scan format. See HARSCN
;;; package for desription of this format.
bitwid==2112.
bithig==1700.
bpi==200.
wrdwid==<bitwid+31.>/32.
chrwid==132. ;not used
chrhig==66.
hargld: outdev host=0,contact=none,orient=1
%hgfrm==-2 ;code for form feed
%hgblk==-3 ;blank line
%hgbln==-4 ;n blank lines, n to folow
maxcnt==077777 ;keep things pdp-11 positive (for no
;good reason)
.scalar dskany ;anything ever sent to it??
.scalar dskptr,dskcnt ;pointer and count for disk output
init: call chaos"finish ;"make sure nobody using chaos net
;[<]
move a,[sixbit />/]
syscal open,[[.bio,,chaoso]
[sixbit /DSK/]
[sixbit /HARSCN/] ? a
[sixbit /.TEMP./]]
return ;bad return
setzm dskany ;nothing on the disk (or buffer) yet
call dskrst ;reset disk pointers
movem c,dskptr
movem d,dskcnt
aos (p) ;good return
return
finish: skipn dskany
jrst [ syscal delewo,[movei chaoso]
jfcl
return]
move c,dskptr
move d,dskcnt
trne d,1
call [ setzi e,
idpb e,c
sos d
return]
call dskout
.close chaoso,
return
timout: return
txtlin: return
txtpag: return
txtfin: return
lhgbuf==200 ;maximum 16bit words per block
.vector hgbuff(lhgbuf/2) ;the disk buffer
.scalar dofrmf ;0:== don't form feed at end
pagsnd: movei a,bitmap+<bithig*wrdwid>-1
movei b,<bithig*wrdwid>-1
pags05: skipn (a)
jrst [subi a,1 ? sojge b,pags05 ? return]
setom dskany ;something on the disk (there will be,
;at least)
setom dofrmf ;assume we will do a form feed
cail b,<bithig-1>*wrdwid
setzm dofrmf ;nope, data on last line
idivi b,wrdwid ;number of lines to do (zero based)
addi b,1 ;one based
imuli b,wrdwid*2 ;number of 16bit bytes to do
move a,[442000,,bitmap] ;setup from pointer
move c,dskptr
move d,dskcnt ;get disk pointer and disk count
pags20: jumple b,pagfin
ildb e,a
subi b,1
idpb e,c ;always put byte down
sosg d ;count it
call dskout ;maybe force out buffer
skipe e
cain e,177777
skipa
jrst pags20 ;continue
movei f,1 ;count
pags30: caige f,maxcnt ;hit the max yet?
skipn b ;or the end of everything?
pags40: jrst [idpb f,c
sosg d
call dskout
jrst pags20]
move t,a ;save pointer in case byte changes
ildb tt,a
subi b,1
caie e,(tt)
jrst [ ;byte changed, back out
move a,t
addi b,1
jrst pags40]
aoja f,pags30
pagfin: skipn dofrmf
return
movei e,-1
idpb e,c
sosg d
call dskout
movei e,%hgfrm
idpb e,c
sosg d
call dskout
movem c,dskptr
movem d,dskcnt
return
dskout: movn d,d
addi d,lhgbuf ;count of bytes in buffer
jumpe d,dskou9 ;if nothing, don't output
addi d,1
lsh d,-1 ;now word count
imul d,[-1,,]
addi d,hgbuff
syscal iot,[movei chaoso ? d]
.lose 1000 ;until we have a better idea
dskou9: setzm SNDLST ;still alive
dskrst: move c,[442200,,hgbuff] ;setup to pointer
movei d,lhgbuf
return
constants
.end hargld
.begin string
inierr: asciz /Error during initialization/
catcha: asciz /CATCH ALL/
pgserr: asciz /PAGE SEND ERROR/
deverr: asciz /DEVICE ERROR (open timeout, transmission break, etc.)/
badreq: asciz /Bad request. Renaming file./
versatec:
asciz /VERSATEC/
gould: asciz /GOULD/
fileo: asciz /DCPFOO/
none: asciz /NONE/
.end string
.begin util
assoc: skipn z,(y)
return
movs z,z
caie x,(z)
aoja y,assoc
movs z,z
aos (p)
return
catch: hrli x,catch
push p,x ;put marker on stack
move x,-1(p) ;get caller's return pointer
call 1(x) ;and skip return
catchr: ;sucessful return
pop p,x ;flush marker
pop p,x ;flush our caller
return ;return to his caller
;;; if FOO: call catch
;;; <thrown>
;;; OK
;;; then stack looks like
;;; ???,,<FOO's caller>+1
;;; ???,,FOO+1
;;; CATCH,,catch-string
;;; ???,,CATCHR
throw: hrli x,catch ;thing to look for
throw1: pop p,y ;get an item from the stack
movei y,(y) ;only address portion
caie y,catchr
jrst throw1 ;if not CATCHR then loop
pop p,y ;get the string
came y,x
camn y,[catch,,string"catcha] ;["]
return ;throw if catch-all or match
jrst throw1
uncatc: pop p,x ;get return pointer
sub p,[3,,3] ;pop three catch words
jrst (x) ;and return
.scalar oldwid,oldhig
;;; x has width, y has height
bitarr: camn x,oldwid
came y,oldhig
skipa
return ;return if same as last time
push p,x
push p,y
movei t,31.(x)
idivi t,32.
imuli t,1(y) ;allow a little extra
movem t,bitwrd ;number of words in the bitmap
addi t,pagsiz-1
idivi t,pagsiz
push p,t ;save it for FRESH
imuli t,pagsiz
addi t,bitmap-1 ;point to the end of the bitmap
movem t,bitmpe ;this is the end
call corblk"init1 ;fake the CORBLK package
pop p,x ;get count
imul x,[-1,,]
hrri x,bitmap/pagsiz ;aobjn pointer for bitmap
call corblk"fresh ;get the pages
.lose ;don't allow errors
pop p,oldhig
pop p,oldwid
return
textln: call corblk"init ;"fake it out
move x,[-1,,<bitmap/pagsiz>]
call corblk"fresh ;"get one page for a text line
.lose
return
.end util
.begin corblk
.scalar baspag ;lowest page available for random stuff
.vector pagtbl(<1,,>/pagsiz/32.) ;bit map of pages
init: .core membeg/pagsiz
.lose
init1: movei membeg/pagsiz
movem baspag
setzm util"oldwid ;"don't confuse bitarr
setzm util"oldwid ;" ditto
setzm array"nxtbpt ;" no arrays (no memory to have them in)
setzm pagtbl
move x,[pagtbl,,pagtbl+1]
blt x,pagtbl+<<1,,>/pagsiz/32.>-1
move x,[-<membeg/pagsiz>,,]
move zz,[iorm w,pagtbl(t)]
move z,[skipa]
call chptbl ;call first pages as allocated
jfcl ;can't fail
return
reserv: jumpe x,[aos (p) ? return]
push p,x
move z,[-<<1,,>/pagsiz>,,]
reser2: move y,z ;find next free page
movei t,(y)
idivi t,32.
movei w,1
lsh w,(tt)
tdne w,pagtbl(t)
jrst [ aobjn z,reser2 ? pop p,x ? return]
move x,(p) ;get desired count
reser4: movei t,(z)
idivi t,32.
movei w,1
lsh w,(tt)
tdne w,pagtbl(t)
jrst reser2
sose x
jrst [ aobjn z,reser4 ? pop p,x ? return] ;bad
pop p,x
movn x,x
hrl x,x
hrr x,y
reser8: move zz,[iorm w,pagtbl(t)] ;set instruction
move z,[tdne w,pagtbl(t)] ;skip instruction
call chptbl ;change the page table
jrst [ move zz,[andcam w,pagtbl(t)]
move z,[skipa]
call chptbl ;release them back
return] ;bad return
aos (p)
return
fresh: skipl x
jrst [ call reserv
return ;error
jrst fresh2]
call reser8
return ;error
fresh2: push p,x
fresh3: syscal corblk,[movei %cbred+%cbwrt ? movei %jself ? x ? movei %jsnew]
jrst [movei 30.*5 ? .sleep ? jrst fresh3]
pop p,x
aos (p)
return
delete: move zz,[andcam w,pagtbl(t)]
move z,[skipa] ;deletion doesn't fail
call chptbl ;change the page table
jfcl ;can't lose
delet1: syscal corblk,[movei 0 ? movei %jself ? x]
jrst delet1
return
chptbl: push p,x
chptb2: movei t,(x)
idivi t,32.
movei w,1
lsh w,(tt)
xct z ;do the skip instruction
jrst [pop p,x ? return] ;bad return
xct zz ;change the page table as instructed
aobjn x,chptb2
pop p,x
aos (p) ;good return
return
.end corblk
.begin log
ltmpbuf==400
.scalar isopen,logfn2
.vector logbuf(200./5),tmpbuf(ltmpbuf)
open: skipe isopen
return
.rdate tt,
movem tt,logfn2
syscal open,[[.uao,,logfil]
[sixbit /dsk /] ? [sixbit /%log/] ? [sixbit /%next/]
[sixbit /.glpr./]]
jrst [movei 30.*15. ? .sleep ? jrst open]
syscal open,[[.uai,,logtmp]
[sixbit /dsk /] ? [sixbit /%log/] ? logfn2 ? [sixbit /.glpr./]]
jrst open8
open2: move t,[440700,,tmpbuf]
movei tt,ltmpbuf*5
syscal siot,[movei logtmp ? t ? tt]
jrst open8
cain tt,ltmpbuf*5
jrst open8
subi tt,ltmpbuf*5
movn tt,tt
move t,[440700,,tmpbuf]
syscal siot,[movei logfil ? t ? tt]
jrst open8
jrst open2
open8: .close logtmp,
setom isopen
return
opntty: skipe isopen
return
syscal open,[[.uao,,logfil]
[sixbit /tty /]]
.lose
setom isopen
return
close: skipn isopen
return
setzm isopen
syscal renmwo,[movei logfil ? [sixbit /%log/] ? logfn2]
jfcl
.close logfil,
sos spoolr"drwait ;"
return
log: call open ;open it if it isn't
move y,(x) ;get pointer to string
hrli y,440700 ;create byte pointer
movei x,1(x) ;point to first argument
move z,[440700,,logbuf]
setzi zz,
logloo: ildb t,y ;get character
jumpe t,logfin ;finished
cain t,"~ ;"magic?
jrst [call logmag ? jrst logloo]
idpb t,z
aoja zz,logloo
logfin: move z,[440700,,logbuf]
syscal siot,[movei logfil ? z ? zz]
jrst close ;if error, close and reopen later
return
logmag: ildb t,y
jumpe t,[pop p,t ? jrst logfin]
irp thing,,[[%newlin],[66bit],[Ttime],[Astring],[Ddecim],[d2dec],[Ooct],[Splural],[Ccharac],[88type]]
irpc ch,subr,[thing]
cain t,"ch ;"
jrst subr
.istop
termin
termin
return
newlin: movei t,^M
idpb t,z
movei t,^J
idpb t,z
addi zz,2
return
6bit: move tt,@(x)
addi x,1
6bit2: jumpe tt,[return]
setzi t,
lshc t,6
addi t,"A-'A ;'"
idpb t,z
aoja zz,6bit2
time: .rtime tt,
jrst 6bit2
charac: move t,@(x)
aos x
idpb t,z
aos zz
return
8type: skipa t,[440800,,]
string: hrli t,440700
hrr t,@(x)
strin2: ildb tt,t
jumpe tt,[aos x ? return]
idpb tt,z
aoja zz,strin2
2dec: push p,[0]
move t,@(x)
addi x,1
idivi t,10.
addi tt,"0 ;"
push p,tt
jrst decim2
decim: push p,[0]
move t,@(x)
addi x,1
decim2: idivi t,10.
addi tt,"0 ;"
push p,tt
jumpn t,decim2
decim4: pop p,t
jumpe t,[return]
idpb t,z
aoja zz,decim4
oct: push p,[0]
move t,@(x)
addi x,1
oct2: idivi t,8.
addi tt,"0 ;"
push p,tt
jumpn t,oct2
jrst decim4
plural: movei t,1
camn t,@-1(x)
return
movei t,"s ;"
idpb t,z
addi zz,1
return
.end log
.begin mapper
.scalar bitsiz,mask,bpw ;bits/char, mask, bytes per word
.scalar bplh ;byte pointer left half
.scalar dbpval ;decrement byte pointer value
.scalar fillen ;length of file in words
.scalar filpag ;length of file in pages (rounded up)
.scalar eofp ;flag indicating eof has been found
.scalar nxtpag ;next page to be read sequentially
;from disk
.scalar rempag ;number of pages remaining (to be read)
.scalar dsklen ;length of primary disk file
.scalar corpag,corbeg ;-1,,pagnum and pagnum*pagsiz
.scalar point ;pointer into file
.scalar count ;count of number of bytes left in file
init: movem x,bitsiz
movem y,mask
movei y,36. ;bits per word
idiv y,x ;bytes per word
movem y,bpw
movei y,440000 ;build byte pointer left half
dpb x,[060600,,y]
movem y,bplh
lsh x,30. ;what to add to b.p. to decrement it
movem x,dbpval
setzm eofp ;not at eof
setzm nxtpag
setzm count
.access dskich,[0] ;position file at the beginning
syscal fillen,[movei dskich ? movem t]
jrst [ setom eofp ;pretend eof happened
return]
jumpe t,.-1 ;if zero lengthed, setup for eof
movem t,fillen
movem t,dsklen
addi t,pagsiz-1
idivi t,pagsiz
movem t,filpag ;number of pages
movem t,rempag ;number of pages not read
movei x,1 ;ask for one page
call corblk"reserve ;"
.lose ;barf
movem x,corpag
movei x,(x) ;get page number
imuli x,pagsiz
movem x,corbeg ;start of core for the file pages
return
test7: ;test file for 7bit-ness (exclude
;8-bit files)
aos (p) ;assume 7 bit
;make sure page is mapped:
call nxtbyt ;get a byte
return ;EOF return
call backup ;put it back
move a,corbeg ;get the base of the page
move b,fillen
caile b,pagsiz
movei b,pagsiz
movn b,b
hrli a,(b) ;aobjn pointer
setzi b, ;count of bad words
movei c,17 ;bit mask to test with
test7a: tdnn c,(a)
addi b,1
aobjn a,test7a
cail b,pagsiz*7/8
sos (p) ;lossage
return
;;; block read request: x := file start addr, y := -n,,addr for IOT
blkred: syscal access,[movei dskich ? x]
return ;bad resturn for some reason
syscal iot,[movei dskich ? y]
return
aos (p) ;good return
return
;;; mapin(x{channel}, y{filename block}) gives x{corblk arg}, y{base address}
mapin: syscal open,[movsi .bii ? x
0(y) ? 1(y) ? 2(y) ? 3(y)]
return
syscal fillen,[x ? movem fillen]
mapin2: jrst [ syscal close,[x]
jfcl
return]
skipn y,fillen
jrst [ syscal close,[x]
jfcl
aos (p)
return]
addi y,pagsiz-1
idivi y,pagsiz
push p,x
move x,y
call corblk"reserv ;"
jrst [pop p,x ? jrst mapin2]
exch x,(p)
move y,(p)
setzi z,
syscal corblk,[movei %cbred
movei %jself ? y
x ? z]
jrst [pop p,y ? jrst mapin2]
syscal close,[x]
jfcl
pop p,x
movei y,(x)
imuli y,pagsiz
aos (p)
return
next: skipe eofp
return ;return if already at eof
hrrz x,corpag ;get the page the file is in
syscal corblk,[movei %cbndr ?
movei %jself ? x
movei dskich ? move nxtpag]
return ;pretend eof if lost
aos (p) ;skip-return
move x,corbeg
movei y,pagsiz
aos t,nxtpag
sosle rempag
return
setom eofp
;y=fillen-(nxtpag-1)*pagsiz
sos y,t
imul y,[-pagsiz]
add y,dsklen
return
finish: skipe x,corpag ;don't delete nothing
call corblk"delete ;"finished with this page
setzm corpag
.close dskich,
return
nxtbyt: ;non-skip on eof
sosge y,count
jrst nxtby2
ildb x,point
cain x,^C
caile y,3 ;if in the last word, do a bad return
trna
skipe rempag
aos (p) ;OK if (or (not ^C) (not lastword) (not lastpage))
and x,mask ;mask it
return
nxtby2: call next ;get next block
return ;eof return
hrl x,bplh ;create byte pointer
movem x,point
imul y,bpw ;times bytes per word
movem y,count
jrst nxtbyt
backup:
move x,point
add x,dbpval
skipg x
sub x,[<440000,,>+1]
movem x,point
aos count
return
.end mapper
.begin array
;;; Moby array hacking routines.
;;; An array is referenced by a pointer to a word which contains the
;;; instruction MOVE base(TT). Thus to get a word: load tt with the word
;;; offset and do MOVE ac,@ptr. These base pointers are kept in the top
;;; page of memory. Since the word count is kept after the base pointer
;;; the entire descriptor takes two words. This allows 512 arrays on ITS.
;;; If the base pointer is actually negative (ORed with SETZ) then the
;;; array is free and may be GC'ed. GC'ing takes place on array
;;; allocation.
;;; Allocate an array. Desired size in X. Skip on success.
.scalar nxtbpt ;current next slot for array allocation
.scalar curbtm ;current lowset address
alloc: push p,x
call gc
move y,(p)
move x,curbtm
subi x,1(y) ;new desired bottom
call downto ;get down to there
jrst [ pop p,x ;failure
return]
movem x,curbtm ;new bottom
hll x,[move (tt)] ;create base pointer
move y,nxtbpt ;get current base pointer
pop p,z ;get size
movem x,0(y)
movem z,1(y)
addi z,(x) ;point to backpointer
movei x,(y) ;get pointer to base pointer
movem x,(z) ;set backpointer
ior x,[move @]
aos (p) ;success
aclear: hrrz t,(x) ;base
setzm (t) ;zero it
movei tt,(t) ;base
hrli t,(t) ;base,,base
addi t,1 ;base,,base+1 [blt pointer]
add tt,1(x) ;base+length
blt t,(tt)-1 ;zero it
return
rstidx: move y,[move (tt)]
hllm y,(x)
return
free: hllz y,(x)
came y,[move (tt)]
.lose
move y,[SETZ]
iorm y,(x)
return
size: move y,1(x)
return
atleast:
camg y,1(x)
jrst [aos (p) ? return]
imuli y,3
lsh y,-1
push p,x ? push p,y
movei x,(y)
call alloc
jrst [sub p,[2,,2] ? return]
pop p,y
exch x,(p)
push p,x
move y,1(x) ;get old size
movei tt,
hrli x,@(x)
hrri x,@-1(p)
add y,x
blt x,-1(y) ;copy old array
pop p,x
call free
pop p,x
aos (p)
return
shrink: push p,y ? push p,x
movei x,(y)
call alloc
jrst [ pop p,x ? pop p,y ? return] ;oh well
exch x,(p)
setzi tt,
hrli t,@(x) ;from old array
hrri t,@(p) ;to new array
movei y,(t) ;get to pointer
add y,-1(p) ;add the length
blt t,(y)-1 ;copy
call free ;free the old array
pop p,x
pop p,y
return
gc: skipn nxtbpt
jrst setup ;no array's. Setup top page
movei x,<<1,,>-pagsiz> ;curbtm when we get finished
movei y,(x) ;pointer scanning arrays
gcloop: camg y,curbtm
jrst [ push p,x ;save the next curbtm
idivi x,pagsiz
move y,curbtm
idivi y,pagsiz
caie x,(y)
call [ exch x,y ;flush old pages
subi y,(x)
movni y,(y)
hrli x,(y)
call corblk"delete ;"
return]
pop p,curbtm
jrst fndnxt] ;and a free slot
move t,-1(y) ;go through the backpointer
skipg (t)
jrst [ ;this is a freed array
sub y,1(t) ;skip the data
soja y,gcloop] ;and the backpointer and loop
move z,1(t)
cain x,(y)
jrst [ subi x,1(z) ;no movement needed, just put x down
movei y,(x) ;it is also y
jrst gcloop]
gcloo2: subi x,1
subi y,1
move zz,(y)
movem zz,(x)
sojge z,gcloo2 ;move backpointer also
hrrm x,(t)
jrst gcloop
fndnxt: movei x,<1,,>-2
fndnx1: skipg (x)
jrst [ movem x,nxtbpt
return]
subi x,2
jrst fndnx1
setup: move x,[-1,,<<1,,>/pagsiz-1>] ;top page
call corblk"fresh ;"
.lose ;no core, die horibly
setzm <1,,>-pagsiz
move x,[<<1,,>-pagsiz>,,<<1,,>-pagsiz>+1]
blt x,777777 ;zero it all
movei x,<1,,>-2 ;nxtbpt
movem x,nxtbpt
movei x,<<1,,>-pagsiz>
movem x,curbtm ;current bottom
return
downto: push p,x
idivi x,pagsiz
move y,curbtm
idivi y,pagsiz
cain x,(y)
jrst downt5
subi y,(x)
movni y,(y)
hrli x,(y)
call corblk"fresh ;"
jrst [ pop p,x ? return] ;couldn't get it
downt5: pop p,x
aos (p)
return
.end array
.begin chaos
.insrt system;chsdef >
.vector opkt(%cpmxw),ipkt(%cpmxw)
.scalar curhst,curcon,npkts ;current host and contact name we are
;talking to
init: setzm curhst ;no current host
setzm curcon
init1: .close chaosi, ;make sure they are closed
.close chaoso,
return
;;; x/ host address to send this plot to
;;; y/ contact name
open: camn x,curhst
came y,curcon
skipa
jrst openok
push p,x ;save current host
push p,y ;and current contact name
call finish
syscal chaoso,[movei chaosi ? movei chaoso ? movei 2]
opnbad: jrst [ pop p,
pop p,
jrst init] ;bad return (reinit)
move y,(p)
move x,-1(p)
call sndrfc ;send the rfc
jrst opnbad ;bad return (reinit)
setzm npkts
pop p,curcon
pop p,curhst
movei x,[ [asciz /~%~T CHAOS: connection open to ~O at contact ~A/]
curhst ? curcon]
call log"log ;"
openok: aos (p) ;good return
return
finish: skipn curhst
return
call sndeof
call sndeof
syscal finish,[movei chaoso]
jfcl
call chslog
jrst init
close: call sndcls
skipe curhst
call chslog
jrst init ;init the chaos routines
chslog: movei x,[ [asciz /~%~T CHAOS: ~D packet~S./] ? npkts]
call log"log ;"
setzm npkts
return
sndpkt: aos npkts
dpb z,[$cpknb opkt]
dpb zz,[$cpkop opkt]
syscal pktiot,[movei chaoso ? movei opkt]
return ;bad return
aos (p) ;good return
return
sndrfc: dpb x,[$cpkda opkt]
setzi z, ;nothing there yet
call strins ;insert the string
movei zz,%corfc
call sndpkt
return ;bad return
movei t,30.*30. ;30 seconds of wait
syscal netblk,[movei chaoso ? movei %csrfs ? t ? movem tt]
return
caie tt,%csopn
return ;connection did not open
aos (p) ;good return
return
snddt1: skipa zz,[%codat+1] ;make it a plot sequence
snddat: movei zz,%codat
jrst sndpkt
sndeof: setzi z,
movei zz,%coeof
call sndpkt
jfcl ;no error return
return
sndcls: setzi z,
movei y,[asciz /Spooler closing connection./]
call strins ;insert the string
movei zz,%cocls ;make it a close packet
call sndpkt
jfcl ;no error return
return
strins: move t,z
idivi t,4
addi t,opkt+%cpkdt
hrl t,(tt)[441000 ? 341000 ? 241000 ? 141000]
hrl y,[440700]
strin2: ildb tt,y
jumpe tt,cpopj
idpb tt,t
addi z,1
jrst strin2
pgserr: ;page send error on chaos net
call init ;reinit the chaos channels
movei x,string"pgserr ;"PAGE SEND ERROR
call util"throw ;"do a throw
txterr: ;text send error on chaos net
call init ;reinit the chaos channels
movei x,string"deverr ;"device error
call util"throw ;"do a throw
constants
.end chaos
.begin tv
ttyoch==17
ttyich==16
imageo==15
%TQWID==001700
%TQHGT==076000
%GOMVA==021
%GODSC==105
%GODRN==106
define princ &str&
move t,[440700,,[asciz str]]
movei tt,.length str
.call csiot
jfcl
termin
csiot: setz ? sixbit/siot/ ? movei ttyoch ? t ? setz tt
tvinit: setzm row'
setzm col'
syscal open,[[.uao+%tjsio,,imageo] ? ['tty,,]]
.lose 1000
syscal open,[[.uao+%tjdis,,ttyoch] ? ['tty,,]]
.lose 1000
syscal open,[[.uai,,ttyich] ? ['tty,,]]
.lose 1000
syscal cnsget,[movei ttyoch ? movem a ? movem b] ;height/width
.lose 1000
syscal ttyvar,[movei ttyoch ? ['ttysmt] ? movem c]
.lose 1000
ldb d,[.bp <%TQWID,,>,c]
imul b,d
move d,b
lsh b,-1 ;divide by two
movnm b,SGxoff'
andcmi d,31.
movem d,tv.b' ;tv width in bits
sos tv.b
idivi d,32.
movem d,tv.w' ;words wide
ldb d,[.bp <%TQHGT,,>,c]
imul a,d
movei d,-1(a)
lsh d,-1
movem d,SGyoff'
movem a,tv.h'
sos tv.h
return
show: princ /C/
setzi b,
show01: syscal iot,[movsi %tinwt+%tipek ? movei ttyich ? movem a]
jfcl
skipl a
jrst kbd
move c,b
add c,row
imul c,plot"wrdwid ;"
add c,col
addi c,bitmap ;point into the bitmap
movei t,-1 ;lowest non zero address
movei tt,0 ;highest non zero address
movei z,-1 ;where on the screen
setzi a,
show03: caml a,tv.w
jrst show05
move d,a
add d,c
skipn (d)
jrst show04
camle t,d
move t,d
camge tt,d
move tt,d
camle z,a
move z,a
show04: aoja a,show03
show05: jumpe tt,show09
.vector siobuf(200.)
move x,[441000,,siobuf]
movei d,%TDGRF
idpb d,x
movei d,%GOMVA
idpb d,x
movei y,2
imuli z,32.
add z,SGxoff
ldb d,[.bp 177,z]
idpb d,x
ldb d,[.bp 177_7,z]
idpb d,x
movn z,b
add z,SGyoff
ldb d,[.bp 177,z]
idpb d,x
ldb d,[.bp 177_7,z]
idpb d,x
addi y,4
;run SUPDUP Graphics run-length encoding
movei d,%GODRN
idpb d,x
addi y,1
sub tt,t
aos tt
setzi a, ;current count of bits
setzi c, ;polarity of last bit
skipge (t)
setca c, ;correct it if necessary
show07: move d,(t)
movei f,32. ;limit
show7b: skipe c
setca d,
tro d,1 ;always put a bit in
jffo d,.+1
cail e,(f)
jrst show7q
skipe c
setca d, ;set it back to original
addi a,(e)
lsh d,(e)
subi f,(e)
show7d: call [ move z,a
caile a,77
movei z,77
sub a,z
skipe c
tro z,100
idpb z,x
addi y,1
jumpn a,@show7d
return]
setca c,
setzi a,
jrst show7b
show7q: addi a,(f)
aos t
sojg tt,show07
xct show7d ;output the last byte
setzi d,
idpb d,x
addi y,1
move x,[441000,,siobuf]
syscal siot,[movei imageo ? x ? y]
jfcl
show09: aos b
camge b,tv.h
jrst show01
kbd: princ /ZL/
.iot ttyich,a
ucase a ;uppercase it
setzi b,
kbdloo: skipn c,kbdtbl(b)
jrst kbd
hlrz d,c
came a,d
aoja b,kbdloo
jrst (c)
kbdtbl: "Q,,[return] ;"
"<,,[ movni 200./32.
addm col
jrst show] ;>"<"
">,,[ movei 200./32.
addm col
jrst show]
"V,,[ movei 200.
addm row
jrst show] ;"
"^,,[ movni 200.
addm row
jrst show] ;"
"1,,[ setzm row
setzm col
jrst show] ;"
"2,,[ setzm row
move plot"wrdwid;"
sub tv.w
movem col
jrst show] ;"
"3,,[ setzm col
move plot"wrdhig;"
sub tv.h
movem row
jrst show] ;"
"4,,[ move plot"wrdwid;"
sub tv.w
movem col
move plot"wrdhig;"
sub tv.h
movem row
jrst show] ;"
0,,0
.end tv
con...: constants
pdl: block lpdl ;initer clears variables, don't want
;it to bash the pdl, so it is
;separate.
var...:: variables
var..e:: 0 ;make sure page exists
membeg==<.+pagsiz-1>&<-pagsiz>
bitmap=membeg
end go
;;; local modes:
;;; mode:midas
;;; auto fill mode:
;;; fill column:70
;;; compile command: :midas dcp;_1/e <20>
;;; end:
Reference in New Issue View Git Blame Copy Permalink