diff --git a/Makefile b/Makefile index abfeb75b..9d7469c2 100644 --- a/Makefile +++ b/Makefile @@ -12,7 +12,7 @@ SRC = system syseng sysen1 sysen2 sysen3 sysnet kshack dragon channa \ tensor transl wgd zz graphs lmlib pratt quux scheme gsb ejs mudsys \ draw wl taa tj6 DOC = info _info_ sysdoc sysnet syshst kshack _teco_ emacs emacs1 c kcc \ - chprog sail draw wl pc tj6 share + chprog sail draw wl pc tj6 share _glpr_ BIN = sys2 emacs _teco_ lisp liblsp alan inquir sail comlap c decsys moon \ graphs draw datdrw fonts fonts1 fonts2 diff --git a/build/misc.tcl b/build/misc.tcl index 53dfa796..9caec861 100644 --- a/build/misc.tcl +++ b/build/misc.tcl @@ -798,3 +798,9 @@ respond "*" "purify\033g" respond "DSK: SYS; TS NTJ6" "\r" respond "*" ":kill\r" respond "*" ":link sys; ts tj6, sys; ts ntj6\r" + +# Versatec spooler +# This has some harmless unresolved symbols (FOO, XE4). +respond "*" ":midas sys3;ts versa_dcp; versa\r" +expect ":KILL" +# respond "*" ":link channa; rakash v80spl,sys3; ts versa\r" diff --git a/doc/_glpr_/-read-.-this- b/doc/_glpr_/-read-.-this- new file mode 100644 index 00000000..7c545547 --- /dev/null +++ b/doc/_glpr_/-read-.-this- @@ -0,0 +1 @@ +This is the spool directory for the Gould and Versatec printer spoolers. diff --git a/doc/programs.md b/doc/programs.md index 82750a78..a8bd9746 100644 --- a/doc/programs.md +++ b/doc/programs.md @@ -193,6 +193,7 @@ - UP/DOWN, check if host is online. - UPTIME, Chaosnet uptime server. - USQ, unsqueeze/uncram a file. +- VERSA/SPOOLR, Versatec/Gould printer spooler. - VV/VJ/DETREE, list jobs. - XHOST, tool for replacing host nicnames with real hostnames. - WHAT, humorous quips to various "what" questions. diff --git a/src/dcp/versa.210 b/src/dcp/versa.210 new file mode 100644 index 00000000..e8c33b37 --- /dev/null +++ b/src/dcp/versa.210 @@ -0,0 +1,6429 @@ +.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 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 + + 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 [setzm spoolp ? jrst gonosp] + 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 + +gonosp: movei pfcv80"pfcfil ;" + movem spoolr"device ;" + call pfcv80"init ;" + .break 16, + + call tv"tvinit ;" + + call chaos"init ;" + +define $open chan,dev,fn1,fn2,dir + syscal open,[[.bii,,chan] + [sixbit/dev/] ? [sixbit/fn1/] + [sixbit/fn2/] ? [sixbit/dir/]] + .lose +termin + + $open dskich,dsk,pfcddv,foo,dcp + call ddv"ddv ;" + + $open dskich,dsk,dragon,fplots,dcp2 + call tek"tek7 ;" + + $open dskich,dsk,pfcddv,1,.glpr. + call ddv"ddv ;" + + $open dskich,dsk,foog,ards,dcp + call ards"ards ;" + + $open dskich,dsk,logain,press,cindyr + call press"press ;" + + $open dskich,dsk,chaos,xgp,dcp + call xgp"xgp ;" + + $open dskich,dsk,chaos,press,dcp + call press"press ;" + +go2: .break 16, + .logout 1, + .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 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 ;" + '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 plot"blkpag ;"force out a blank page + + 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"blkpag ;"force out a blank page + 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 +.scalar rvsp ;line spacing + +.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 + call plot"blkpag ;"blank page at the front +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"blkpag ;"blank page at the end + call plot"finish ;"finished plotting (for this file) + return ;and th.th.th.that's all folks + +.scalar nskip,ksetok +scrimp: setzm nskip + setzm ksetok +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: skipn ksetok + jrst [ movei x,[ [asciz "~%~T XGP: File error: no ;KSET command (no fonts)"]] + call log"log ;" + movei x,string"badreq ;" + call util"throw ;" + ] + skipn nskip + jrst [ movei x,[ [asciz "~%~T XGP: File error: no ;SKIP command"]] + 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 (assume 1 for now) + 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 + +scrskip: + setom nskip + jrst scrloo ;assume just one for now + +.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 + setzm 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 ;should really be current height?? + setzm movdwn ;nothing forced us down yet + setzm count ;count of saved characters + move x,[440700,,rescan] + movem x,ptr + call dolin1 + setom outena + 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 ? return] + ^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) + movs x,xgp.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: aos (p) + return + +linefd: jrst linfin + +linfin: skipn outena + jrst [ ;if output not enabled + move y,scanln ;get top scan line + add y,chrrct + movem y,xgp.y + sub y,movdwn + movem y,scanln + return] + return + +cretrn: ;get leftmargin + movem x,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 ;interline 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 + movn b,b + 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 x,(x) + addi y,(b) ; + movsi y,(y) + movs w,xgp.x + move z,xgp.y + sub z,basel + movsi z,(z) + call plot"drect ;" + return + +undenw: call xarg1 + return + skipa a,x +undend: movei a,2 + call xarg1s + return + movn 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 + movem x,rvsp + addm x,xgp.y + setzm seper + return + .value foo + +bsladr: skipa a,basel +bsladj: setzi a, ;relative to 0 (absolute) + call xarg1s + return + addi 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 + +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: