.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 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!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) 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=-
movem x,b0 hrlz x,bithig ash x,-1 multip a,a10,y sub x,y multip b,a11,y sub x,y ;b1=-
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) ;- 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,, 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/],, 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 /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--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==/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 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==/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==/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+-1 movei b,-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,*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 ;;; ;;; OK ;;; then stack looks like ;;; ???,,+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,,] 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,[-,,] 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 î ;;; end: