diff --git a/build/misc.tcl b/build/misc.tcl index 88d84ed5..ef798309 100644 --- a/build/misc.tcl +++ b/build/misc.tcl @@ -908,6 +908,15 @@ respond "*" ":midas sys3;ts versa_dcp; versa\r" expect ":KILL" # respond "*" ":link channa; rakash v80spl,sys3; ts versa\r" +# SCAN +respond "*" ":midas sysbin;_sysen1; scan\r" +expect ":KILL" +respond "*" ":job scan\r" +respond "*" ":load sysbin; scan bin\r" +respond "*" "purify\033g" +respond "*" ":pdump sys3; ts scan\r" +respond "*" ":kill\r" + # DDT subroutines respond "*" ":midas sys3;ts cmd_dcp; cmd\r" expect ":KILL" diff --git a/doc/programs.md b/doc/programs.md index ba79097a..75833fef 100644 --- a/doc/programs.md +++ b/doc/programs.md @@ -179,6 +179,7 @@ - RMAIL, mail reading client. - RMTDEV, MLDEV for non-ITS hosts. - SALV, old file system tool for KA and KL. +- SCAN, TEX output to XGP SCAN file. - SCANDL, TTY output spy. - SCHEME, Scheme interpreter. - SCNV, convert plotter files to XGP scan files. diff --git a/src/sysen1/scan.561 b/src/sysen1/scan.561 new file mode 100755 index 00000000..6b14de1d --- /dev/null +++ b/src/sysen1/scan.561 @@ -0,0 +1,3016 @@ +; -*- MIDAS -*- +title SCAN -- TEX output to XGP SCAN file + +$debug==0 ; we are not debugging +.insrt system;chsdef > +cs$win==10 ; CHAOSnet window size + +x=0 ; super temporary +a=1 ; argument register, value return +b=2 ; argument register +c=3 +d=4 +e=5 +f=6 +bt=7 ; # of bits left in word +ch=11 ; current character in font +fn=12 ; current font +ct=13 ; address of character tab in current font +t=14 ; temporary +tt=15 ; temporary +cl=16 ; points to current closure +p=17 + +fntmax==:200 ; highest font number +pdllen==:100 ; moby PDL +fbufln==:200 ; 200 words for font input buffer +tbufsz==:200 ; 200 words for text input buffer +jclsiz==:20 ; 20 words for JCL and filename parsing + +fntc==:1 ; read fonts on channel 1 +txti==:2 ; read text input on channel 2 +scno==:3 ; scan output on channel 3 +ttyo==:4 ; error message output +queo==:5 ; queue file output +chsi==:6 ; CHAOSnet output +chso==:7 ; CHAOSnet output +mapi==:10 ; mapping channel + +call=:pushj p, +ret=:popj p, + +Comment | +MIT FONT FORMAT + +WORDS 0-1 + KSTID + BYTE (9) COLUMN_POSITION_ADJUSTMENT,BASE_LINE (18) HEIGHT + ;base line # rasters from top of character matrix +REMAINDER OF FILE: ONE BLOCK OF DATA FOR EACH CHARACTER + USER_ID + ;NOT USED 4/10/74 but LOW ORDER BIT MUST BE 1 + LEFT_KERN,,CODE + ;Left Kern = amount to move left from the + ;Logical left end of the character to the left edge + ;of the raster. + means move left, - move right. + ;left kern always 0 for CMU + RASTER_WIDTH,,CHARACTER_WIDTH + ;raster width always 0 for CMU + ;Character Wdith = amount that the line bit position + ;is increased by printing the character. + CHARACTER_MATRIX + ;the matrix is stored 4 8-bit bytes per word so that + ;ILDB with 8-bit byte size gets successive bytes. + ;The bits are bit reversed in each byte (high order + ;bit of character in low order bit of byte). + ;the matrix is stored row by row. +| + +define calblk op,args +setz ? sixbit /OP/ ? args ((setz)) +termin + +define syscal op,args + .call [setz ? sixbit /OP/ ? args ((SETZ))] +termin + +argi=:1000,,0 +val=:2000,,0 +erro=:3000,,0 +cnti=:5000,,0 +cnt=:4000,,0 + +define type &string + move t,[440700,,[asciz string]] + movei tt,<.length string> + call typer +termin + +;; error typer +define etype &string + move t,[440700,,[asciz string]] + movei tt,<.length string> + call etyper +termin + +define qtype &string + move t,[440700,,[asciz string]] + movei tt,<.length string> + .call qtypbl + .lose %lsfil +termin + + + +define struct prefix,args + prefix==:,,-1 + $$ZZ$$==0 + irpw frob,,[args] + irps a,b,frob + ife .irpcnt, prefix!!a==:$$ZZ$$ + ifse b,(,[ + irpc x,y,[frob] + ifse x,(,{ + $$ZZ$$==$$ZZ$$+((y) + .istop + } + termin + ] + .else $$ZZ$$==$$ZZ$$+1 + .istop + termin + termin +prefix!.ln==:$$ZZ$$ +expunge $$ZZ$$ +termin + + +;;; Internal font data structures + +;; Font definition +struct $fn,[ + dev ; device name for font file + fn1 ; FN1 for font file + fn2 ; FN2 for font file + snm ; directory for font file + hit ; height of char in scan lines + sb0 ; KSUBSET wd 0 + sb1 ; KSUBSET wd 1 + sb2 ; KSUBSET wd 2 + sb3 ; KSUBSET wd 3 + chr(200) ; table of characters +] + +;; characters. Pointers to these are what goes in $FNCHR entries +struct $ch,[ + chr ; ascii for this char + fnt ; font this char corresponds to + krn ; Kern, in scan lines. Positive is left + wid ; Width, in scan lines, to move "cursor" + rwd ; raster width. # of bits per row + row ; AOBJN ptr to character rows (for humans) + rw1 ; AOBJN ptr to first row (for $CE's) + ] + +;; Character Entities. The active objects which write characters on scan lines +struct $ce,[ + fun ; functional handler + nxt ; next character entity in list + prv ; previous character entity in list + chr ; pointer to the character object + chm ; AOBJN ptr to raster array + wrd ; word to start writing on + lsh ; amount to shift left before starting + hit ; height remaining (scan lines before end) + ] + +;; Box Entities. The active objects which draw black boxes on scan lines +struct $be,[ + fun ; functional handler + nxt ; next box entity in list + prv ; previous box entity in list + lbt ; left bits + rbt ; right bits + str ; place to put right bits + stl ; place to put left bits + one ; location of word to SETOM + blt ; AC for BLT of SETOM + ben ; end of BLT of SETOM + hit ; height remaining (scan lines before end) + ] + + +loc 40 ; UUO and interrupt vector + 0 + 0 ; no UUO's + -intlng,,tsint + +byelos: 0 ; PC we lost at goes here + skipe debug ; debugging? + .value ; stay aroud to find out what happened + .logout + +losepc: 0 ; address of losing .CALL for .CALL LOSE + +patch: block 50 ; plenty of patch space + +servep: 0 ; -1 if we are a server? +server: 0 ; -1 asserts we are a debugging server + +filesw: 0 ; -1 if we have an output file open + +pagnum: 0 ; page number +opgnum: 0 ; number of pages output so far + +inqgrp: "? ; INQUIR group, when we hack that + +thesis: 0 ; -1 if we want ;THESIS option +queue: sixbit / Q1/ ; FN1 of queue file. Made QT for thesis. + +machin: -1 ; sixbit machine we are on +smachn: -1 ; sixbit machine queued from +runame: 0 ; local UNAME +suname: 0 ; who we are, who to notify. + +fntcnt: -1 ; # of fonts hacked so far + +fontab: block fntmax ; table of fonts + +topmar: 0 ; top margin, in scan lines +botmar: 0 ; bottom margin, in scan lines +lftmar: 0 ; left margin, in scan lines +lsp: 0 ; # of scan lines to move down on ^J + +scnwrd: scnlin ; current word on scan line +scnlsh: 0 ; amount to LSHC before putting on scan line + +scnbot: 4100 ; When we get here, cut the page +goalin: 0 ; line to process until before reading more +scanum: 0 ; current scan line number +voff: 50. ; offset for page/file status line hack + +scnlpd: 0 ; off-page, for sake of IORM's that don't + ; look for the edge +scnlin: block 57 ; one scan line +scnrpd: block 57 ; off-page, for sake of IORM's that don't +scnend:: ; look for the edge (characters that fall + ; off the end of the line) + +outhed: 0 ; line number, length. Must preceed OUTLIN +outlin: block 66 ; space to write into before moving into +outend: ; output buffer. +outcnt: 0 ; # of bytes room left in OUTLIN + +sndpkt: getpkt ; unless over CHAOS net, sending is done by + +aichad==:2026 ; AI chaosnet address + +;; packet opcodes +%codko==:201 ; open disk file +%coioc==:202 ; IOC error, disk full +%cobye==:203 ; BYE message, close disk file +%copag==:204 ; end of page, start new file +%coini==:205 ; initialize. +$cpkdt==:441000,,%cpkdt ; Byte Pointer to data part + +falpnt: 0 ; point in packet to back up to if + ; run-length encoding exceeds length of + ; image-mode line. +falstk: 0 ; stack pointer to back up to in above case + +runsts: 0 ; 0 if counting zeros, -1 if counting ones +pktptr: pktdat-1 ; packet is initially empty + +packet: +pkthed::0 ; holds opcode and size +pktdes: 0 ; ITS fills in this +pktsrc: 0 ; ITS fills in this +pktnum: 0 ; ITS fills in this +pktdat: block 172 ; data area of packet buffer +pktend:: ; end of packet + +ctlpkt: block 126. ; control packet. + +ife $debug,[ +outdev: sixbit /AI/ +outdir: sixbit /.XGPR./ +] +.else [ +outdev: sixbit /DSK/ +outdir: sixbit /.TEMP./ +] +outfn2: -1 ; SCAN is FN2 but we AOS it first + +quedir: sixbit /.XGPR./ +quedev: sixbit /AI/ + + ; invoking the guy who reads packets. +rfcslp: [setom chsopn ? ret] ; what to do to complete connection +chsopn: 0 ; -1 if our connection is established + +fntfre: 1,,0 ; start of next free font block +fntbot: 1,,0 ; bottom address of bottom font block page +lowptr: corend ; start of next free character-space word +lowend: /2000*2000 ; start of unallocated pages for char-space + +cefree: 0 ; free-list for character entities +befree: 0 ; free-list for box entities +enthed: [.lose] ; dummy entity for entity list header +entlst: 0 ; list of active entities +entprv: 0 ; dummy previous list for entity list + +bytpos: 0 ; how many bytes still to go on this raster +bptput: 0 ; 4-bit BP writing into raster line + + +reverse: creverse ; reverse 8-bit byte (maybe using CIRC) +36circ: circ a,36. ; XCT this instead of doing CIRC + +pdl: [.lose] ; underflow trap + block pdllen ; PDL + + +filblk:: ; filename parser block +$$DEV: sixbit /DSK/ +$$FN1: 0 +$$FN2: 0 +$$SNM: 0 + +fbufpt: 0 ; AOBJN ptr to words still in FBUF +fbuf: block fbufln + +txteof: 0 ; if non-zero, we've hit EOF on text input +texbug: 0 ; 0 means don't look for spurious null + +tbfcnt: 0 ; count of characters in TBUF +tbufbp: 0 ; Byte pointer into TBUF +tbuf: block tbufsz+1 ; include space in TBUF for lookahead! + +ifg .-2000 .ERR Low page has been overflowed +loc 2000 +$$RFN==:1 ; we want filename reader +$$PFN==:1 ; we want filename printer +$$SWITCH==:1 ; we want to hack switches +.insrt syseng;rfn + +psixtp: ret ; printed filenames we don't quote + +rsixtp: caie a,"/ ; / starts switches + cain a,"( ; so does ( +popj1: aos (p) +cpopj: ret + +tsint: p + %piioc ? 0 ? -1 ? -1 ? iocerr ; hack IOC errors + 0 ? 1_chsi ? 0 ? 0 ? chsint ; hack input packets +intlng==:.-tsint + +;; open file in mode in T, channel in TT +filopn: calblk OPEN,[cnt t ? argi (tt) ? $$DEV ? $$FN1 ? $$FN2 ? $$SNM] +typblk: calblk SIOT,[argi ttyo ? t ? tt] +qtypbl: calblk SIOT,[argi queo ? t ? tt] + +go: .close 1, ; close the channel we were loaded with! + move p,[-pdllen,,pdl] ; get a PDL + .suset [.roption,,t] ; check the state of the world + tlo t,%opint\%opopc ; turn on winnage + .suset [.soption,,t] + syscal SSTATU,[val x ? val x ? val x ? val x ? val x ? val machin] + .lose %lssys + .suset [.runame,,runame] ; get who we are + move x,machin ; check which machine we are on + camn x,[sixbit /MC/] ; are we on MC? + jrst [ movei x,putpkt ; set things up to go over the chaos net + movem x,sndpkt ; by switching which routine we use + .suset [.simsk2,,[1_chsi]] ; accept CHAOS input interrupts + jrst .+1] ; otherwise use AI: or disk + came x,[sixbit /MC/] ; unless this is MC + .suset [.simask,,[%piioc]] ; try to handle IOC errors + camn x,[sixbit /AI/] ; Are we on AI? + jrst [move x,[sixbit /VISION/] ; we try to use the VISION device + movem x,outdev ; to put our moby temporary files + movem x,quedev ; also our tiny queue files + jrst .+1] + .suset [.rcnsl,,tt] ; get whether or not we're on a TTY + jumpl tt,serve ; yes, go hack that trip + skipe server ; is this a debugging server? + jrst serve ; yes, be a server + syscal open,[cnti .uao\%tjdis ? argi ttyo ? [sixbit /TTY/]] + .lose %lsfil + tlnn t,%OPCMD ; do we have JCL? + jrst [ etype /AUse JCL!/ + .logout 1,] + .break 12,[..rjcl,,jclbuf] ; gobble our JCL + skipn jclbuf ; no JCL at all? + jrst [ etype /AUse JCL!/ + .logout 1,] + .suset [.rsname,,$$SNM] ; MSNAME is default SNAME + move x,[sixbit /XGP/] + movem x,$$FN2 ; default FN2 is XGP + setzm $$FN1 ; must have FN1 specified! + move x,[sixbit /DSK/] ; default device is DSK: + movem x,$$dev + move d,[440700,,jclbuf] ; get our filename from the JCL buffer + movei b,filblk ; and put the parsed name in FILBLK + call rfn"rfn ; read the filename + movei b,filblk ; now take that parsed filename + move d,[440700,,jclbuf] ; and write it back out to JCLBUF + call rfn"pfn ; but this time cannonicalized + + skipn $$fn1 ; did we get a filename? + jrst [ etype /APlease give the filename on the JCL line!/ + .logout 1,] + movei t,.uai ; Unit Image Ascii mode + movei tt,txti ; text input channel + .call filopn ; open the file + jrst [ etype /AFile not found!/ + .logout 1,] + syscal RFDATE,[argi txti ? val a] ; get the file date + .lose %lsfil + move d,[440700,,srcdat] ; buffer for source file date + call timhak ; hack the time + syscal RQDATE,[val a] ; get the current date + .lose %lssys + move d,[440700,,sqdate] ; time queued date + call timhak ; hack the time + move a,runame + move d,[440700,,name] + call 6bit ; write the sixbit UNAME to ascii + move a,machin + move d,[440700,,mname] + call 6bit ; write the sixbit machine name to ascii + move x,[[ .byte 8 + "X ? "G ? "P ? "S ? "C ? "N ? .byte ],,ctlpkt+%cpkdt] + blt x,ctlpkt+%cpkdt+1 + movei x,aichad ; set the address to AI's CHOAS address + dpb x,[$cpkda ctlpkt] ; set the destination + movei a,ctlpkt + movei b,%corfc ; prepare to RFC the beggar + movei c,6 ; 6 bytes + call makpkt ; send this packet, or do whatever with it + + move tt,runame ; get our uname, to segment it into bytes + lshc t,40 ; first 40 bits go in the first word + lsh t,4 ; left justify it + movem t,ctlpkt+%cpkdt ; put it in the first data word + movem tt,ctlpkt+%cpkdt+1 ; put the rest in the next data word + move t,machin ; tell him what machine it's queued from + movem t,ctlpkt+%cpkdt+2 + setzm ctlpkt+%cpkdt+3 ; 0 means no thesis queue + skipe thesis ; do we want ;thesis? + setom ctlpkt+%cpkdt+3 + move t,[440700,,jclbuf] ; get our JCL argument + move tt,[441000,,ctlpkt+%cpkdt+4] ; and put that into the packet +jclcop: ildb x,t ; get a byte + idpb x,tt ; put a byte + jumpn x,jclcop ; and continue until a null + + move x,[jclbuf,,srcnam] ; copy this into our SRCNAM too. + blt x,srcnam+jclsiz-1 ; so we can have it for the status line + + movei a,ctlpkt + movei b,%coini ; operation is initialize + movei c,%cpmxc ; send an entire packet + call makpkt ; make and send the packet + call txtini ; initialize text input buffer + setom texbug ; gotta look out for null on first page + +kloop: call tin ; get a charcter + cain a,^L ; start of page? + jrst endttl ; start our scan + caie a,"; ; had better have font info, etc. + jrst goblin ; barf + call 6read ; read a command name + camn a,[sixbit /KSET/] ; specification of character set? + jrst kset ; yes, read in the font names, etc. + camn a,[sixbit /KSUBSET/] ; specification of SQUISH info? + jrst ksubse ; yes, read 4 octal words of squish info + camn a,[sixbit /TOPMAR/] ; # of raster lines to leave blank? + jrst ktopma ; yes, read in an decimal # of scan lines + camn a,[sixbit /BOTMAR/] ; # of scan lines to barf if not left blank + jrst kbotma ; yes, read in a decimal # of scan lines + camn a,[sixbit /LFTMAR/] ; # of bits to leave blank at left + jrst klftma ; yes, read in a decimal # of bits + came a,[sixbit /LSP/] ; # of scan lines to move down on ^J + camn a,[sixbit /VSP/] + jrst klsp ; yes, read in a decimal # of scan lines + +goblin: call gobble ; gobble up the line + jrst endttl ; hit end-of-page, that's it! + jrst kloop ; keep reading commands + +gobble: call tin ; get a char + caige a,0 ; EOF here is absurd + call badfil ; no return, just barf + cain a,^L ; formfeed marks the end of the title page + ret ; so go process the fonts and get set up + caie a,^M ; end of line? + jrst gobble ; no, get another + call tin ; get the linefeed too + caie a,^J ; it IS a linefeed, isn't it? + call badfil ; no, barf at him (no return) + jrst popj1 + +kset: setzm jclbuf ; reuse the JCL buffer for font filenames + move x,[jclbuf,,jclbuf+1] + blt x,jclbuf+jclsiz ; clear out the entire buffer + move d,[440700,,jclbuf] ; Byte Pointer to send the filenames down + call kset0 ; gobble up all the fonts + jrst kset ; still more fonts, keep on truckin' + jrst kloop ; and go process any other frobs + +kset0: call tin ; read a char + caie a,^L ; FF in the middle of the command line? + caige a,0 ; is it an EOF? + call badfil ; no, barf at him + cain a,^M ; is it the end of the line? + jrst [ call kset2 ; yes, parse, cons font, and return + call tin ; flush the line-feed + jrst popj1] ; and then return our final success + cain a,", ; is it the end of the filename? + jrst [ call kset1 ; yes, process the font and gobble next + ret] ; and then process previous + cain d,[010700,,jclbuf+jclsiz-1] ; end of JCL buffer? + jrst [ etype /AFont file name too long!/ + call badfil ; no return + .lose] + idpb a,d ; character is OK, send it along + jrst kset0 ; and get another + +kset1: call kset2 ; parse the file, cons the font, and + ret ; and return to caller, to get next one + +kset2: setzm $$fn1 ; detect missing fonts by no FN1 + aosg t,fntcnt ; count this as the next font + skipn fontab+0 ; is this this font 0 and already loaded? + caia ; no, so must load this font, + ret ; otherwise our work is done + cail t,fntmax ; too many fonts? + jrst [ etype /AToo many fonts!/ + call badfil ; no return + ret] ; if RETX'd, just punt + move t,[sixbit /KST/] + movem t,$$fn2 ; reset the FN2 default + move t,[sixbit /DSK/] ; reset the DEV default + movem t,$$dev + skipn t + .lose + move t,[sixbit /FONTS/] ; reset the directory default + movem t,$$snm + movei b,filblk ; point to the filename block + move d,[440700,,jclbuf] ; and to the buffer with the text + call rfn"rfn ; parse up the filenames + skipn $$fn1 ; was there any filename? + ret ; no, no font for that number + + call makfnt ; make the font + move t,fntcnt ; find out it's font number + movem fn,fontab(t) ; remember it in the font table + ret + +ksubse: setzm crflag ; say we haven't seen a CR yet + call rdec ; read a decimal number + + skipn fn,fontab(a) ; get the font for this number + jrst [ etype /A;KSUBSET for unspecified font!/ + call badfil ; barf at him + jrst goblin] ; flush the line if continued + call roct ; read an octal subset word + movem a,$fnsb0(fn) + call roct + movem a,$fnsb1(fn) + call roct + movem a,$fnsb2(fn) + call roct + movem a,$fnsb3(fn) + skipn crflag ; if we haven't seen a CR yet + jrst goblin ; gobble the rest of the gubbish + jrst kloop ; keep on trucking + +getnum: setzm crflag ; we haven't seen a CR yet + call rdec ; read a decimal number + skipe crflag ; if we have seen the end of the line, + ret ; we're all set + push p,a ; otherwise we have to flush the rest first + call gobble ; so gobble it up + pop p,a ; recover our return value + ret ; and return + +;; # of raster lines to leave at the top, bottom, and left side +ktopma: call getnum ; get the right margin + movem a,topmar ; remember it + jrst kloop ; look for more commands + +kbotma: call getnum ; get the bottom margin + movem a,botmar ; remember it + jrst kloop ; look for more commands + +klftma: call getnum ; get the left margin + movem a,lftmar ; remember it + jrst kloop ; look for more commands + +klsp: call getnum ; get vertical spacing + movem a,lsp ; remember the crock + jrst kloop ; look for more commands + +;; loads a font, pointed to by FN, saving E, and counting the font in F + +fntlod: push p,e ; save our AOBJN ptr + aos f ; count this font + push p,f ; save our count of fonts loaded + call fntget ; get the font + pop p,f ; recover our count of fonts loaded + pop p,e ; recover our AOBJN ptr + ret + +endttl: setzm texbug ; TEX bug is behind us + movsi e,-fntmax ; AOBJN ptr to the fonts + setz f, + skipe puresw ; are we purified? + add e,[1,,1] ; don't hack font zero +endtt1: skipe fn,fontab(e) ; is there a font? + call fntlod ; yes, load it, counting it in F + aobjn e,endtt1 + + skipn fn,fontab ; pick up font 0 + jrst [ etype /ANo font 0 ??/ + call badfil + jrst .+1] + + movei ct,$fnchr(fn) ; get location of character tab in cur font + type /A/ ; new line + move a,f ; get the # of fonts loaded + call decprt ; print the number + type / fonts loaded, / + move a,lowptr ; calculate how much space was needed + subi a,corend-1777 ; for the characters + add a,[1,,0] ; and the font objects themselves + sub a,fntfre ; we want the answer in terms of blocks + idivi a,2000 ; because that's easier to read + call decprt ; print the number + type / blocks used. +/ + setzm pagnum ; count pages +; skipn goalpg ; if we don't have a specific goal + aos pagnum ; 1 is where we start + skipe goalpg ; do we have a starting page? + call flpags ; yes, flush some pages + move x,[377777,,777777] ; plus infinity + skipn goalpg ; do we want all pages? + movem x,goalpg ; yes, hack till P = infinity + setzm scnlpd ; clear the scan area + move x,[scnlpd,,scnlpd+1] ; in case we've been re-started + blt x,scnend-1 ; clear out the entire area + +nxtpag: call tin ; get a character so we can check for EOF + jumpl a,tclos1 ; EOF? close it up now, but don't NXTPG0 + push p,a ; no, save the character for our loop + call pagtyp ; type the page number + call status ; print the status line + pop p,a ; get back our buffered back character + call rdlin0 ; hack this page + call nxtpg0 ; force out rest of page and cut + + aos t,pagnum ; get the page number, incrementing + camg t,goalpg ; have we printed our goal page? + jrst nxtpag ; no, hack the next page + + ildb x,pagebp ; check the delimiter + cain x,"] ; is it the end of the page spec? + jrst tclos1 ; yes, close up shop + call pagred ; find out what page to hack next + call flpags ; flush pages until that page + ildb x,pagebp ; get the next delimiter + cain x,"] ; is this the last page to be hacked? + jrst [ move t,pagebp ; copy the byte pointer + idpb x,t ; be sure we see the ] on the next pass + jrst nxtpag] ; on with the show + cain x,"- ; is this a page range? + call pagred ; find out the end of the page range + jrst nxtpag + + +;;; flush a page of XGP output +pagefl: call tin ; get a character + jumpl a,tclos1 ; at end of file, just end things + cain a,177 ; rubout? + jrst flxesc ; flush escape codes + caie a,^L ; end of page? + jrst pagefl ; no, just keep flushing + aos pagnum ; count pages flushed + ret ; yes, return! + +;; flush an XGP escape code +flxesc: call tin ; find out which XGP escape it is! + jumpl a,tclos1 + cain a,^A ; XGP escape 1? + jrst flxes1 ; hack that monster! + caie a,^N ; XGP escape 16? + cain a,^B ; XGP escape 2? + jrst [ call tin ? jrst pagefl] ; gobble one byte arg and continue + cain a,^C ; XGP escape 3? + jrst [ call tin ? call tin ? jrst pagefl] ; same, but two byte args + cain a,^D ; XGP escape 4? + jrst [ repeat 11.,[? call tin] ? jrst pagefl] ; same, but 11. bytes + cain a,^F ; XGP escape 6? + jrst [ call tin ? jrst pagefl] ; just flush + caie a,^I ; tab? + cain a,^J ; Linefeed? + jrst pagefl ; just a quoting, no arguments to gobble + caie a,^M ; return? + cain a,^L ; FF? + jrst pagefl ; just a quoting + caie a,^H ; backspace? + cain a,0 ; null? + jrst pagefl ; just a quoting + cain a,177 ; rubout? + jrst pagefl ; just a quoting + call pagprt ; error, tell what page we're on +flose: etype /A>> Page skipper out of phase in XGP escape skipper. +>> Either not TEX output or internal bug. +/ + jrst pagefl ; will get back in phase, eventually + +;; flush an XGP escape 1 code +flxes1: call tin ; find out which XGP escape 1 it is + jumpl a,tclos1 ; end of file, just end it + caige a,40 ; < 40 is font select of that font + jrst pagefl ; so go gobble more + caie a,40 ; is it 40? + jrst flose ; no, don't understand, tell him so. + call tin ; yes, gobble two bytes + call tin ; of horizontal positioning info + jrst pagefl ; and flush rest of page + +flpags: move t,pagnum ; check which page + caml t,goalpg ; are we to our page yet? + ret ; yes, that's it! + call pagefl ; flush a page + jrst flpags ; and check again + +;; read in a page number from our saved list of pages +pagred: push p,d ; we can be called from SWITCH, don't bash D + move d,pagebp ; get our pointer + setz a, ; we count in A +pagrd0: ildb x,d ; get a byte + cain x,"[ ; open? + jrst pagrd0 ; yes, ignore it + caige x,40 ; is it a control? + jrst pagrd9 ; yes, that's the end + cail x,"0 + caile x,"9 + jrst pagrd9 ; a delimiter? that's it then + movem d,pagebp ; remember our bp as possible end of number + subi x,"0 ; convert to number + imuli a,10. ; left shift one decimal digit + add a,x ; include this digit + jrst pagrd0 ; keep reading + +pagrd9: movem a,goalpg ; make that page our goal + pop p,d ; restore D + ret ; and return + + +rdline: call tin +rdlin0: jumpl a,tclose ; at end of file, close up shop + cain a,177 ; rubout? + jrst xgpesc ; that's XGP escape + cain a,^M ; CR? + jrst endlin ; end of line + cain a,^J ; LF? + jrst nxtlin ; move down LSP lines + cain a,^L ; FF? + ret ; that is the end of this page! + +; it is a printing character, create a character entity for it. + +ordchr: call chrhak ; hack a character for output + jrst rdline ; keep on reading the line + +;;; cons a character entry for character in A in font in FN (character table +;;; pointer into font in CT) and put it on the list of stuff to print + +chrhak: movei t,(a) ; copy the character + addi t,(ct) ; get location of char object ptr in font + skipn ch,(t) ; get the character object in CH + jrst nochar ; no character, complain! + call cealc ; cons up a character entity + movei cl,(a) ; get the closure in CL + movem ch,$cechr(cl) ; put pointer to the char obj into the ent + move t,$chrw1(ch) ; get AOBJN ptr to first line's bits + movem t,$cechm(cl) ; put it into the entity + move t,$fnhit(fn) ; get height of character + movem t,$cehit(cl) ; put that into the entity + move t,scnwrd ; get word of scan line to hack + movem t,$cewrd(cl) ; put that into the entity + movn t,scnlsh ; get amount to right-shift + sub t,$chkrn(ch) ; allow for the kern + idivi t,44 ; convert to words and bits + jumpl tt,[ sos t ; left kern moved over word, back up + addi tt,44 ; to previous word, adjust shift + jrst .+1] + addm t,$cewrd(cl) ; compensate for any word bounds moved over + movnm tt,$celsh(cl) ; remember how much to LSHC before IORMing + movn t,scnlsh ; get current bit offset + add t,$chwid(ch) ; calculate new one from character width + idivi t,44 ; convert to bit and word offset + movnm tt,scnlsh ; bit offset + addb t,scnwrd ; and increment the word position + cail t,scnrpd ; is there an overflow? + jrst [ skipn scnlsh ; if there's no right shift + caie t,scnrpd ; and it points to right edge + caia + jrst .+1 ; that's highly marginal, but legal + etype /A>> Line overflow. Wrapping around to left margin. +/ + movei t,scnlin ; start it over at zero + movem t,scnwrd ; so he can see what went wrong, and so we + setzm scnlsh ; don't give infinite errors + push p,silent ; temporarily + setzm silent ; we unsilence output + movei a,$CHECK ; check out all the entities + call ecalls ; to see if we can find the culprit + pop p,silent ; restore silence + jrst .+1] ; probably should have an ERROR list for + ; sake of looking at the chars with errors + + caige t,scnwrd ; underflow? + jrst [ etype /A>> Line underflow. Reseting to left margin. +/ + setzm scnlsh ; no right shift + movei t,scnlin ; start at left margin + movem t,scnlsh ; so we don't get infinite errors + push p,silent ; temporarily + setzm silent ; we unsilence output + move a,$CHECK ; check out all the entities + call ecalls ; to see if we can find the culprit + pop p,silent ; back to normal silence/verbosity + jrst .+1] ; probably should have an ERROR list + + movei t,enthed ; make it point back to entity list header + movem t,$ceprv(cl) ; so removal works properly + movei t,(cl) ; copy entity pointer + exch t,entlst ; put this entity on the entity list + movem t,$cenxt(cl) ; linking it into the list + movem cl,$ceprv(t) ; make the old one point back here + ret ; that's it, all done! + +;; Carriage return. End current line, start horizontal counters from beginning + +endlin: move t,lftmar ; start again at the left margin + idivi t,44 ; get that in terms of words and bits + movnm tt,scnlsh ; remember bits as neg amount to shift left + addi t,scnlin ; make the scan position absolute + movem t,scnwrd ; and remember that too + jrst rdline ; keep on reading characters + +;; Linefeed. Move down LSP scan lines. + +nxtlin: move x,lsp ; get # of scan lines to hack + add x,scanum ; get the goal scan # + movem x,goalin ; set the goal line to run entities to. + camle x,scanum ; unless we haven't moved down at all + call movdwn ; move down until we hit the goal + jrst endlin ; also perform a next-line + +;; XGP Escape. Find out which XGP escape it is and handle + +xgpesc: call tin ; next character is escape # + cain a,^A ; XGP escape 1? miscellaneous + jrst xgpes1 ; yes, handle it + cain a,^B ; XGP escape 2? (rel position horizontal) + jrst xgpes2 ; yes, handle it + cain a,^C ; XGP escape 3? (rel position vertical) + jrst xgpes3 ; yes, handle it + cain a,^D ; XGP escape 4? (black rectangle) + jrst xgpes4 ; yes, handle it +; ; XGP escape 5 is unknown + caie a,^N ; XGP escape 16? (font switch) + cain a,^F ; XGP escape 6? (font switch) + jrst xgpes6 ; yes, handle it + caie a,^I ; quotes tab + cain a,^H ; quotes backspace + jrst ordchr ; pretends it's an ordinary character + caie a,^J ; quotes linefeed + cain a,0 ; quotes null + jrst ordchr ; pretends it's an ordinary character + caie a,^L ; quotes formfeed + cain a,^M ; quotes carriage carriage + jrst ordchr ; pretends it's an ordinary character + cain a,177 ; quotes rubout as well + jrst ordchr ; pretends it's an ordinary character + call pagprt ; tell what page error is on + etype /A >>Unknown XGP escape code +/ + call badfil ; lose lose + jrst ordchr ; just print it if he continues + +;; XGP escape 1. We implement two flavours, one is font select (second byte +;; < 40), the other is Absolute Horizontal Position (2 bytes) + +xgpes1: call tin ; get what kind it is + caige a,40 ; < 40 is font select + jrst xgpes6 ; XGP escape 6 is font select + caie a,40 ; we only understand 40, had better be 40 + jrst [ call pagprt ; tell what page error is on + etype /A >>Unknown XGP escape 1 code! +/ + call badfil ; barf at him + jrst rdline] ; ignore it if he continues +;; horizontal position absolute command + call tin ; get high-order hpos bits + lsh a,7 ; position them in their high-order place + push p,a ; remember them + call tin ; get low-order hpos bits + add a,(p) ; get the whole thing + sub p,[1,,1] ; flush the stack + idivi a,44 ; convert to words and bits + addi a,scnlin ; make the word position absolute + movem a,scnwrd ; and salt it away + movnm b,scnlsh ; and salt away how much to LSH (negative) + jrst rdline ; and on with the loop + +;; XGP escape 6 ... read one byte of font # to make current font + +xgpes6: call tin ; get font #. One byte so must be legal + cail a,fntmax ; is it a legal font number? + jrst [ push p,silent ; temporarily + setzm silent ; we unsilence things + call pagprt ; tell what page error is on + type /A >>Illegal font number: / + call decprt ; yes, print it + call badfil ; barf at him + pop p,silent ; un-un-silence + jrst rdline] ; continue processing input if proceeded + skipn fn,fontab(a) ; check this font out + jrst [ push p,silent ; temporarily + setzm silent ; we unsilence things + call pagprt ; tell what page error is on + type /A >>Font # / + call decprt ; print it + type / is used but not specified. +/ + call badfil ; barf at him + pop p,silent ; back to normal verbosity + jrst rdline] ; continue processing input if proceeded + movei ct,$fnchr(fn) ; get pointer to character table as well + jrst rdline ; keep on trucking + +;; XGP escape 2. Read one byte, that's signed 7-bit #, columns to move right + +xgpes2: call tin ; get the amount to move right + lsh a,44-7 ; we've got to make it a 36-bit signed + ash a,7-44 ; integer + call scnmov ; move the scan over that much + jrst rdline ; on with the line + +;; XGP escape 3. Take two bytes data, 14-bit pos bit #, new scan line + +xgpes3: call vpos ; do the vertical positioning + jrst rdline ; keep hacking this stuff + +vpos: call 14read ; read a 14-bit number from TXTI + add a,voff ; if we're offsetting, include that + camge a,scanum ; it had better not be a move up + jrst moveup ; it is, go barf + camg a,scanum ; if we're already on that line + ret ; just do nothing + movem a,goalin ; remember it how far to move down to + jrst movdwn ; do that many columns and return + +;; read a 14 bit positive number from 2 bytes from TXTI, return in A + +14read: call tin ; get the first byte of position + lsh a,7 ; position it + push p,a ; save it for later + call tin ; get second byte of hpos + add a,(p) ; calculate entire number + sub p,[1,,1] ; flush the stack + ret ; return the number + +;; XGP escape 4, box drawing. +;; ^?^Dyyxxzzzhhww; Y=vertical, X = horizontal, Z = zero (slant, actually, but +;; not implemented) H = height, and W = width +xgpes4: call vpos ; do the vertical positioning (XGP ESC 3) + call bealc ; allocate a box + movei cl,(a) ; remember that as our closure + call 14read ; read the HPOS + push p,a ; save the result + call tin ; next 3 bytes we expect to be zero + jumpn a,es4bd2 ; check it out + call tin + jumpn a,es4bd1 + call tin + jumpn a,es4bd0 + call 14read ; read the height in raster lines + movem a,$behit(cl) ; remember it in the structure + call 14read ; get the width in bits + pop p,t ; get the hpos in T + idivi t,44 ; get the position in words and bits offset + addi t,scnlin ; make word position absolute + add a,tt ; get width relative to starting word + idivi a,44 ; get width in terms of words and bits + addi a,(t) ; make word position absolute, not relative + ; to start of box! + cain a,(t) ; boundary condition (fits inside one word?) + jrst [ move b,rhtmsk(b) ; get the bits, as far as they go on right + and b,lftmsk(tt) ; don't go too far to left either + movem b,$belbt(cl) ; save it as the left mask + movem b,$berbt(cl) ; it's the right mask too + movem t,$bestl(cl) ; where to put left mask + movem a,$bestr(cl) ; The right mask will go in same place + setzm $beone(cl) ; say don't do SETOM either + jrst bnoblt] ; mark as no blT, and hook into ENTLST + +;; At this point: +;; A contains the word where the right mask should write +;; B contains the number of bits which are one in the right-hand partial word +;; T contains the word where the left mask should write +;; TT contains the number of bits which are zero in the left-hand partial word + + move tt,lftmsk(tt) ; shift determines left edge bit pattern + move b,rhtmsk(b) ; extra bit count decides right bit pattern + movem tt,$belbt(cl) ; save that info away, left edge + movem b,$berbt(cl) ; right edge + movem a,$bestr(cl) ; where to put right edge word + movem t,$bestl(cl) ; where to put left edge word + subi a,1(t) ; + movns a ; negate for AOBJN ptr + hrli a,(a) ; get it where an AOBJN ptr belongs + hrri a,1(t) ; word after T is where it goes + movem a,$beone(cl) ; remember it in the entity + hlre t,a ; get 0,, + camge t,[-1] ; just one word? + jrst [ movns t ; no, get + addi t,(a) ; get final word of SETOM plus one + sos t ; allow for the zero-origin now + movem t,$beben(cl) ; remember the end word to BLT into + move t,$beone(cl) ; prepare to BLT it into place + hrlzi a,(t) ; from where it went + hrri a,1(t) ; to next word + movem a,$beblt(cl) ; that's the AC to BLT with + jrst bhook] ; and now to hook it into the entity list +;; one word of SETOM or less, don't do a BLT +bnoblt: setzm $beben(cl) ; end word may as well be zero + setzm $beblt(cl) ; this notes: NO BLT! + +;; hook in the entity into the free list +bhook: movei t,enthed ; make it point back to entity list header + movem t,$beprv(cl) ; so removal works properly + movei t,(cl) ; copy entity pointer + exch t,entlst ; put this entity on the entity list + movem t,$benxt(cl) ; linking it into the list + movem cl,$beprv(t) ; make the old one point back here + jrst rdline ; keep on trucking + + +pagtyp: move a,pagnum ; count pages + type /APage / + call decprt ; print them too. + type /. +/ + ret + + +;; macros used by the STATUS routine + +; SSTRT prints the contents of , which should be an ASCIZ frob +define sstrt loc + move a,[440700,,loc] + call $sstrt +termin + +;; STYPE /string/ prints the string to the page +define stype &string + move a,[440700,,[asciz string]] + call $sstrt +termin + + +;;; the STATUS routine prints status info on the top 1/4 in of each page +;;; to identify it. +status: skipn voff ; if we're not hacking status lines + setzm scanum ; start at the top of the page + skipn t,voff ; if we're not having a status line + jrst stats9 ; just do the page initialization part + subi t,13.+12. ; we back off enough for the line plus a bit + movem t,scanum ; that's where we start our scan lines + push p,fn ; bind the font accross the status line + push p,ct ; bind the character table pointer too + move fn,fontab+0 ; we use font 0 + movei ct,$fnchr(fn) ; get address of the character table + setzm scnlsh ; we just start on word boundaries + movei x,<<200.+43>/44>+scnlin ; we start one inch from left margin + movem x,scnwrd + stype /TEX file "/ + sstrt srcnam ; tell what file it is + stype /", dated / + sstrt srcdat ; tell when the file was created + stype /, queued by / + sstrt name ; tell who did it + stype / at / + sstrt mname ; tell where he did it from + stype /. Time = / + sstrt sqdate ; tell when he did it + stype /. / + sstrt scnvrs ; tell what scan version this is + movei x,<<1600.-250.+43>/44>+scnlin ; move edge (1 1/4 in. from left) + movem x,scnwrd + stype /Page / + move a,pagnum ; get the number + call sdectp ; type it + stype /./ ; period too. + pop p,ct ; restore the pointer into the font's + ; character table + pop p,fn ; restore the font to what was being used + +stats9: move x,topmar ; now find where we start real text + add x,voff ; allowing for our offset + aos x ; move past those + movem x,goalin ; that's where to move to + jrst movdwn ; move down there, and return + +;; take a byte pointer in A, write it as text on the page +$sstrt: push p,a ; save Byte pointer on stack, ACs are hacked +$sstr0: ildb a,(p) ; get a character + cain a,40 ; is it a space? + call $$spac ; hack horizontal motion + jumpe a,[pop p,a ? ret] ; null byte marks EOL + call chrhak ; add the character to the queue + jrst $sstr0 ; and loop until EOL + +;; we loop, counting spaces, and then move our position that much. +;; takes characters from a byte pointer at -1(P) +$$spac: setz c, ; we count number of spaces in C +$$spc0: addi c,10 ; space width + ildb a,-1(p) ; get the next character + cain a,40 ; still a space? + jrst $$spc0 ; yes, keep counting + movei t,(c) ; get the count, including the initial one + idivi t,44 ; convert to words and bits of motion + addm t,scnwrd ; words + sub tt,scnlsh ; amount of right shift + movei t,(tt) ; shuffle + idivi t,44 ; (0/1) word overflow + addm t,scnwrd + movnm tt,scnlsh ; amount of left shift + ret ; return character found in A + +;;; take a number in A, and put it on the page as a number +sdectp: movms a ; get absolute value (paranoia) +sdecpn: idivi a,10. ; figure first digit + push p,b ; push remainder + skipe a ; done? + call sdecpn ; no compute next one + + pop p,a ; yes, take out in opposite order + addi a,60 ; make ascii + call chrhak ; add it to the queue + ret ; and return for the next one. + + +nxtshp: call pktout ; send out the packet and fall through + jrst nxtpg1 ; back to work on the loop + +nxtpg0: call movdwn ; move down to there + skipe scnlpd ; any underflow on the left? + jrst [ push p,silent ; unsilence output for the error + setzm silent + call pagprt ; tell what page error occured on + etype /A >>Line underflow detected. +/ + movei a,$CHECK ; check all the characters for which ones + call ecalls ; map $CHECK over them + setzm scnlpd ; clear it out + pop p,silent + jrst .+1] + move t,[-47,,scnrpd] ; AOBJN ptr to right-hand padding +rchk: skipe (t) ; anything get put there? + jrst [ push p,silent + setzm silent + push p,t ; don't let PAGPRT clobber our AOBJN ptr + call pagprt ; tell what page error occured on + etype /A >>Line overflow detected. +/ + movei a,$CHECK ; check all the boxes for which ones suck + call ecalls ; map $CHECK over all the boxes + pop p,t + setzm (t) ; clear out the bashed padding + pop p,silent + jrst rchked] ; don't barf every time on single line + aobjn t,rchk ; check next line + jrst nxtpg1 ; if it's all OK, no need to BLT + +rchked: setzm scnlpd ; clear out the line, including padding + move x,[ scnlpd,,scnlpd+1 ] ; propogate the zero + blt x,scnend + +nxtpg1: aos t,pktptr ; get pointer to area of packet buffer + cail t,pktend ; is it beyond the end of the packet? + jrst nxtshp ; yes, ship out the packet + move x,[.byte 20 ? 2 ? 0 ? .byte] ; command word is two PDP-11 words + movem x,(t) ; set that in the buffer + move x,scanum ; get the scan line to cut it on + tro x,100000 ; set the PDP-11 sign bit to signal page cut + dpb x,[042000,,(t)] ; and put that in the command word in buffer + aos pktptr ; PKTOUT expects it to have been incremented + call pktout ; send it as a data packet + movei a,packet ; point to our packet + movei b,%copag ; operation is new_page + movei c,4 ; 4 bytes of data: page number + move x,pagnum ; get the page number + dpb x,[044000,,%cpkdt(a)] ; and stuff it into the packet-to-be + call makpkt ; send out the packet by whatever means + skipn cl,entlst ; do we still have things trying to print? + ret ; no, we're all set, now for next page + +;; lost, barf at him and flush active characters. + + push p,silent ; we want to type out + setzm silent + call pagprt ; tell what page error is on + etype /A >>Page too long! Truncating / + skipe debug ; if we're debuging + .value ; we want to have a look now + setz a, ; count it + push p,a ; save our count +kkloop: movei a,$KILL ; operation is KILL (delete self) + call @(cl) ; perform it + aos (p) ; count it + skipe cl,entlst ; still more? + jrst kkloop ; yes, keep killing + move a,(p) ; get the count from the stack + call decprt ; type it + type / character/ + pop p,a ; restore count, reset stack + caig a,1 ; more than one? + jrst [ type /. / + pop p,silent + jrst badfil] ; barf at him + type /s. / + pop p,silent + jrst badfil ; barf barf lose lose + ; and on with the show + +;; Handler for Character Entities +cehack: cain a,$LINE ; is this a line operation? + jrst celine ; yes, hack it + cain a,$KILL ; is this a KILL operation? + jrst cekill ; yes, delete it from the list + cain a,$CHECK ; check for out-of-range? + jrst cechk ; yes, print message if out of range, + call pagprt ; tell what page the error is on + etype /A >>> BUG: Unknown operation for character entity. +/ + skipe debug ; are we debugging? + .value ; yes, wait for debugger to have a look + move cl,$cenxt(cl) ; point to the next one + ret ; return it + +;; Put one line of a character entity on the line +celine: move c,$cechm(cl) ; get AOBJN ptr to raster matrix + move a,$cewrd(cl) ; get the word to put it on + move b,$celsh(cl) ; get amount to shift +ceiorm: move t,(c) ; get the word to IORM + setz tt, ; overflow word starts out empty + lshc t,(b) ; shift it + iorm t,(a) ; deposit it + iorm tt,1(a) ; and the overflow from the shift + aos a ; next word + aobjn c,ceiorm ; next, if any + + sosg $cehit(cl) ; next line + jrst cekill ; no more, flush self! + hll c,$cechm(cl) ; prepare for same # words next time + movem c,$cechm(cl) ; except from later in raster array +cexit: move cl,$cenxt(cl) ; point to this one's successor + ret ; that's it, return + +;; kill a Character entity. +cekill: call kkill ; delete it from the entity list + exch cl,a ; The new one is now current + move t,cefree ; get the current free list + movem t,$cenxt(a) ; make this one point to old free list + movem a,cefree ; make this one head of free list + ret ; that's it! + +;; check a character entity, printing what it is if found. +cechk: move ch,$cechr(cl) ; get pointer to the character involved + move x,$cewrd(cl) ; get where it's supposed to output + hlre tt,x ; get how much there is + sub x,tt ; get last word hacked + move t,$chrwd(ch) ; get the raster width + idivi t,44 ; get bits remainder + subi tt,44 ; get amount to LSH before next word + camg tt,$celsh(cl) ; next word? + aos x ; yes, count the overflow word + move t,$cewrd(cl) ; now that we've calculated everything + caige t,scnlin ; check for underflow + jrst cechk1 ; good thing we did, too! + caige x,scnrpd ; is this an overflow? + jrst cexit ; no, just return now +cechk1: push p,silent ; temporarily + setzm silent ; enable typeout + type /A >>Character off page: "/ + move a,$chchr(ch) ; get the ascii character code + call chrprt ; print the character + type /" in font / + push p,fn ; remember our current font + move fn,$chfnt(ch) ; get the font to go with this character + call fntprt ; print out the font number + pop p,fn ; recall the current font + type /. Horizontal = / + move a,$cewrd(cl) ; get where it starts + imuli a,44 ; in terms of bits + sub a,$celsh(cl) ; including the shift + call decprt ; print it + type / +/ + pop p,silent ; restore typeout state + jrst cekill ; kill this one so don't get more errors + +chrprt: cain a,177 ; is it a rubout? + jrst [ .iot ttyo,["^] ; yes, print as ^? + movei a,"? + jrst .+1] + caige a,40 ; is it a control frobie? + jrst [ .iot ttyo,["^] ; yes, tell him which character + addi a,40 ; convert to upper case non-control + jrst .+1] + .iot ttyo,a ; type the character now + ret ; that's it + +;; Handler for Box Entities. +behack: cain a,$LINE ; is this a scan-line request? + jrst beline ; yes, hack it. + cain a,$KILL ; is this a request to kill self? + jrst bekill ; yes, do so. + cain a,$CHECK ; check out this box for bounds? + jrst bechk ; check it out. + call pagprt ; tell where the error occured + etype /A >>> BUG: Unknown operation for box entity. +/ + skipe debug ; are we debugging? + .value ; yes, wait for debugger to have a look +bexit: move cl,$benxt(cl) ; point to the next one + ret ; return it +;; Put bits of a box on the raster line +beline: move x,$belbt(cl) ; get the left mask + move t,$bestl(cl) ; and where it goes + iorm x,(t) ; put it there + move x,$berbt(cl) ; get the right mask + move t,$bestr(cl) ; get where it goes + iorm x,(t) ; set it + skipl t,$beone(cl) ; check if we're SETOMing anything + jrst noblt ; nope, we're all done + setom (t) ; OK, set that bit + skipn t,$beblt(cl) ; are we going to BLT? + jrst noblt ; no, we're all done + skipn tt,$beben(cl) ; get the end too + .lose ; take this out some day + blt t,(tt) ; extend the SETOM'd word + +;; now count down till time to stop drawing boxes +noblt: sosg $behit(cl) ; count the lines we've done this + jrst bekill ; it's the end, kill self + move cl,$benxt(cl) ; next entity + ret ; return it + +;; Kill a Box Entity. +bekill: call kkill ; delete it from the entity list + exch cl,a ; The new one is now current + move t,befree ; get the current free list + movem t,$benxt(a) ; make this one point to old free list + movem a,befree ; make this one head of free list + ret ; that's it! + +;; check a box for fitness +bechk: move a,$bestl(cl) ; is it underflow? + caige a,scnlin ; check... + jrst badbox + move a,$bestr(cl) ; is it overflow? + caige a,scnrpd ; check against buffer bounds + jrst bexit ; it's OK, return + +badbox: push p,silent ; temporarily + setzm p,silent ; enable typeout + etype /A >>Box off page: Horizontal = / + subi a,scnlin ; find out how many + imuli a,44 ; as bits, to nearest word + move t,$belbt(cl) ; get left bits + jffo t,.+1 ; count bit displacement + addi a,(tt) ; include that too, to make it exact + call decprt ; print it + etype /. +/ + pop p,silent + jrst bekill ; kill the son of a bitch + +movdwn: move t,scanum ; check the current scan line +movdw1: caml t,goalin ; there yet? + ret ; already there, keep trucking + skipn entlst ; is there nothing to go on the line? + jrst [ move t,goalin ; then we can take a short-cut + movem t,scanum ; by simply jumping to that point + ret] ; since no need for blank lines + + movei a,$LINE ; operation is LINE + call ecalls ; call the entities + call shpout ; ship out the line + setzm scnlin ; clear it from left to right, leave padding + move x,[scnlin,,scnlin+1] ; extend the 0 at SCNLPD to rest of line + blt x,scnrpd-1 ; to start of right padding + aos t,scanum ; next line + jrst movdw1 ; and keep moving + +;; perform an operation on each entity on ENTLST. Takes operation in A +ecalls: skipn cl,entlst ; start at the head of the list + ret ; no entities, that's easy! + push p,a ; remember the operation + +ecall0: move a,(p) ; get the operation + call @(cl) ; call the current entity + jumpn cl,ecall0 ; if there's a new current entity, call that + sub p,[1,,1] ; throw away the operation from the stack + ret ; return + +;; Take the scan line and put it into the packet, sending if necessary + +shpout: setzm outlin ; clear the output line + move x,[outlin,,outlin+1] ; extend the zeros across the board + blt x,outend-1 ; to the very end + + move x,[.byte 20 ? 66*2 ? 0 ? .byte] + movem x,outhed ; set up the output header + move x,scanum ; get line number + dpb x,[042000,,outhed] ; set it in the output line + call runout ; do run-length encoding, if possible + ret + +;;; come here (with stack adjusted) to do image mode encoding instead of +;;; run length, if buffer room is insufficient +imageo: move a,[.byte 10 ? 2 ? 0 ? .byte] ; 0,2 means enter image mode + xct 36circ ; prepare for later CIRCing of this + movem b,outlin ; put this at the start of the line + + movsi tt,-65 ; AOBJN ptr to the output buffer + move t,[440400,,scnlin] ; intput Byte pointer is from scan line + jrst byte2 ; The first 2 bytes are already out there + +shplop: + repeat 10,[ +ife .rpcnt-4,byte2: + ildb x,t ; get a byte + dpb x,shpobp+.rpcnt ; output that byte +] ; END REPEAT 10, + + aobjn tt,shplop ; and do that for all bytes + jrst pktcpy ; copy the line to the packet buffer +; falls through + +pktshp: call pktout ; send the packet and fall through again + +;; now we have an encoded line, copy it to the packet buffer + +pktcpy: aos tt,pktptr ; get pointer to area of packet buffer + addi tt,65 ; we'll take 66 words of that space + cail tt,pktend ; is it beyond the end of the packet? + jrst pktshp ; yes, ship out the packet + exch tt,pktptr ; exchange our line for the new free pointer + + move a,outhed ; get output header + movem a,(tt) ; write it out + aos tt ; count that word + + movsi t,-65 +circlp: move a,outlin(t) ; get a word + xct 36circ ; reverse the bits (SHIT!) + movem b,(tt) ; put out the fixed word into the packet + aos tt + aobjn t,circlp ; next? + + ret ; that's all, I guess + +;; ship out a packet and output a scan line run-length encoded. +runshp: aos pktptr ; PKTOUT expects caller to have incremented + call pktout ; send the packet. Fall through + +;; output a scan line run-length encoded. Clobbers almost all AC's + +runout: move x,pktptr ; remember where we start in case we run + movem x,falpnt ; out of space and revert to image mode. + cail x,pktend-66 ; do we need more room? (66 is max can take) + jrst runshp ; yes, get it + move x,p ; get current stackpointer + movem x,falstk ; so we can fail back to this level + aos t,pktptr ; allocate a word for scan line and length + setzm (t) ; zero it for now + aos t,pktptr ; word for two bytes 0,0 (run-length) + setzm (t) ; make sure the two bytes are zero + setzb c,runsts ; we are initially white, looking for black + ; C gets bit count + movei d,2 ; byte counter, 2 zero bytes already + movsi e,-57 ; hack all 57 words of scan line + movei f,65*4-2 ; maximum number of bytes before try image +runou1: move a,scnlin(e) ; get a new word + movei bt,44 ; start out with 44 bits uncounted in word + skipe runsts ; are we counting ones? + xor a,[-1] ; then make the 0's 1's to mark the end +runou5: jffo a,[ addi c,(b) ; count the bits before the first 1 + subi bt,(b) ; that many fewer bits to count + jumpe bt,runou8 ; that's the end of the word, find next + aose runsts ; toggle RUNSTS's state + setom runsts ; was zero, make -1 + movei t,(b) ; copy the # of bits found + move b,runsts ; prepare to shift in 0's or 1's as needed + lshc a,(t) ; adjust position to be zero + xor a,[-1] ; toggle it for next state + push p,a ; remember the frob we're looking at + call runcnt ; send the run count out to the packet + pop p,a ; get back the frob we're looking at + jrst runou5] ; on with the loop! + addi c,(bt) ; all the remaining bits count now +runou8: aobjn e,runou1 ; we're done with this word + skipe runsts ; if we're black + call runcnt ; finish up with this mode + cail c,57*44 ; is this an entire line? + jrst sndnul ; A blank line, don't bother sending + setz c, ; send zero bytes + call runcnt ; to end up in command mode + call runcnt ; send out three null bytes + call runcnt ; god knows why! + movei c,1 ; dunno why we do this either + call runcnt ; but we do! + andi d,3 ; be sure to be mod 4 + setz a, ; must pad the rest with 0 bytes + jrst .+1(d) ; deposit whichever need it + jrst runxit ; full house, no padding needed + dpb a,runbyt+1 ; pad second byte + dpb a,runbyt+2 ; pad thrid + dpb a,runbyt+3 ; pad fourth +runxit: move x,pktptr ; get the current packet pointer + sub x,falpnt ; how much have we advanced? + lsh x,1 ; in terms of PDP-11 words, please + aos t,falpnt ; recover where we wrote to + dpb x,[242000,,(t)] ; so set the length + move x,scanum ; get the scan number + dpb x,[042000,,(t)] ; and set it in the output buffer + ret ; that's all! + +;; at this point the run-encoded line should be ready + +;; ** NOTE ** -- this takes arg in C, not in A +;; output the count of bits in C, as expected by the PDP-11. If needs more +;; than 54. words, should punt and cause an image line to be generated. +;; clobbers A, resets C to zero + +runcnt: movei a,(c) ; get count to send + caile a,377 ; we can't send more than 377 + movei a,377 ; so enforce this limit + subi c,(a) ; but account for however much we can send + call sndbyt ; send the byte (from A) + jumpe c,cpopj ; if we sent the entire thing, return + setz a, ; we didn't send it all, now must send a 0 + call sndbyt ; to indicate none of the alternate color + jrst runcnt ; but more of this color to come + +;; send out a single byte to the packet +sndbyt: sojl f,sndfal ; if we run out of bytes, fall back to image + trnn d,3 ; is this a fresh word? + jrst sndalc ; yes, allocate a word to write into + andi d,3 ; eliminate any over-run + move t,pktptr ; get the word to write into + dpb a,runbyt(d) ; and write into the apropriate byte + aos d ; next byte + ret ; and return + +sndalc: aos t,pktptr ; get the new word to write into + dpb a,runbyt+0 ; and write into the apropriate byte + movei d,1 ; next byte + ret ; and return + +sndfal: move p,falstk ; restore the stack back to failure point + move x,falpnt ; back up the packet location to old loc + movem x,pktptr + jrst imageo ; resort to image output + +;;; don't bother sending this line, it's null +sndnul: move p,falstk ; throw out to where we were called from + move x,falpnt ; back up the packet buffer to where it was + movem x,pktptr + ret ; return to our caller, having done nothing + +runbyt: 241000,,(t) ; first byte is the second byte + 341000,,(t) ; second is the first + 041000,,(t) ; third is the last + 141000,,(t) ; and last is the third, what a crock + +;; Set the size and opcode of a data packet, and ship it out to the receiver. + +pktout: movei a,packet ; give a pointer to the packet + movei b,%codat ; data output + move c,pktptr ; find the end of the data + subi c,pktdat ; find out how many PDP-10 words are in use + lsh c,2 ; get number of bytes in use + call makpkt ; send out the packet by whatever means + movei x,pktdat-1 ; meanwhile, start the packet out at + movem x,pktptr ; beginning. + ret + +;; the routine to send a packet over the chaos net. +putpkt: skipn chsopn ; is our connection open? + jrst chsblk ; check and wait if needed +putpk1: syscal PKTIOT,[argi chso ? argi (a)] ; send it + .lose %lsfil ; lost somehow? + ret ; that's it! Easy, wasn't it! + +chsblk: ldb t,[$cpkop (a)] ; get the opcode + cain t,%corfc ; RFC's are sent while state is closed + jrst chsini ; so go open channel, then PKTIOT + movei t,30.*60. ; normally we time out after a minute + skipe debug ; but if we're debugging, + move t,[377,,777777] ; we'll wait forever + syscal NETBLK,[ argi chso ? argi %csrfs ? t ; wait + val tt] ; and get our state when we wake up + .lose %lsfil + cain tt,%csopn ; is it open now? + setom chsopn ; note that we've found it open + cain tt,%csopn ; is it open? + jrst putpk1 ; yes, now do I/O + + hrrz t,chstat(tt) ; get a byte pointer to an apropriate + hrli t,440700 ; message + hlrz tt,chstat(tt) ; and get a count as well + .call typblk ; type it + .lose %lsfil + skipn debug + .logout ; byebye + .lose + +define tabent &string + <.length string>,,[asciz string] +termin +chstat: tabent /A>> Error: CHAOSnet connection closed./ + tabent /A>> Error: Very confused network: Listen./ + tabent /A>> Error: Very confused network: RFC-received./ + tabent /A>> Error: CHAOSnet timeout./ + tabent /A>> Error: Why are we barfing about an OK connection?/ + tabent /A>> Error: CHAOSnet connection broken by receipt of "LOS" packet/ + tabent /A>> Error: Incomplete CHAOSnet transmision (AI is not responding)/ + +chsini: syscal CHAOSO,[argi chsi ? argi chso ? argi cs$win] + .lose %lsfil + jrst putpk1 ; now send the packet for real now + +;; the routine to make and send a packet. Takes packet in A, +;; opcode in B and length in C. + +makpkt: dpb b,[$cpkop (a)] ; set the opcode for the packet + dpb c,[$cpknb (a)] ; set the byte count + jrst @sndpkt ; send out the packet + + +;; This is the packet reciever. Takes address of packet in A +getpkt: ldb x,[$cpkop (a)] ; get the opcode for the packet + cain x,%codat ; is this a data packet? + jrst dskout ; yes, write the data to disk + cain x,%corfc ; is this an RFC packet? + jrst rfcopn ; yes, initialize stuff + cain x,%cobye ; is this a BYE packet? + jrst byebye ; yes, close the file and finish up + cain x,%copag ; end of page? + jrst clsfil ; yes, start up a new page + cain x,%coini ; get initialization info? + jrst inipkt ; yes, so copy out that info + cain x,%cocls ; close? + jrst chclos ; hack a closed connection + cain x,%colos ; LOS packet? + jrst chlost ; handle the lossage + cain x,%coioc ; IOC error? + jrst iocinf ; inform the user + etype /A +----------------------------- +Unknown CHAOSnet message. +----------------------------- +/ + .lose + +;; handle a closed CHAOSnet connection +chclos: setom closed ; note that it has been closed + skipe servep + jsr byelos ; then go away + skipe gone ; have we told it to go away? + jrst [ pop p,x ; yes, so pop off our return address + jrst chsdis] ; yes, so ignore it and dismis from our + ; caller + etype /A +---------------------------------------- +The CHAOSnet connection has been closed. +/ + jrst chlos0 + +;; Tell the user of the arival of a LOS packet. +chlost: skipe servep ; are we a server? + jsr byelos ; yes, go away + type /A +------------------------------------------------------------- +The CHAOS connection has lost. The reason returned by AI is: +/ +chlos0: move a,[$cpkdt inpkt] ; pointer to the ASCII reason for complaint +chlos1: ildb x,a ; get a byte + trne x,200 ; 200 bit on? + jrst chlos5 ; that's the end of the text + jumpe x,chlos5 ; if it's a 0, that marks the end too + .iot ttyo,x ; type the character + jrst chlos1 ; next? + +chlos5: etype /A +------------------------------------------------------------- + +/ + .logout 1, + +;; handle an %COIOC packet informing of an IOC error +iocinf: skipe servep ; are we a server? + .lose ; how the fuck??? + etype /A +------------------------------------------------------------- +AI's DISKS ARE FULL! +This program will wait two minutes and try again, hoping that +the XGP will delete some of the files it has sent already. +If your files are way down in the queue, it may be advisable +to wait for a time before proceeding this job, to avoid +leaving AI high and dry with no disk space. +------------------------------------------------------------- + +/ + ret + +rfcopn: skipe servep ; If we're not a server, or + skipe server ; if we're an inferior server + ret ; we can't log in, rest is meaningless + ldb tt,[$cpksa (a)] ; get the source address + lsh tt,33 ; 3 rightmost digits, left justified + setz t, + lshc t,3 ; a digit + lsh t,3 ; space + lshc t,3 ; another digit + lsh t,3 ; more space + lshc t,3 ; more digit + lsh t,6 ; save space for the C in the name + .suset [.ruind,,tt] ; get our user index + lsh tt,35 ; left justify the user index + lsh t,2 ; sligtly less space than usual + lshc t,4 ; digit + lsh t,3 ; space + lshc t,3 ; another digit + add t,[sixbit /000C00/] ; turn digits into sixbit! +login: syscal LOGIN,[t ? [sixbit /MIT-MC/] ? t] + jrst [ aos t ? jrst login] + .suset [.sjname,,[sixbit /XGPSCN/]] + .suset [.ssname,,[sixbit /XGPSCN/]] + ret ; just return, at this stage + +;; did we get an initialization packet? +inipkt: move t,%cpkdt(a) ; get the first word of data + move tt,%cpkdt+1(a) ; get the second word of data + lsh t,-4 ; concatenate + lshc t,4 ; and malign + movem t,suname ; and remember this, it's our user's name! + .suset [.ssname,,t] ; for sake of PEEK + move tt,%cpkdt+2(a) ; get the machine name + movem tt,smachn ; remember that too + skipe %cpkdt+3(a) ; thesis queue? + jrst [ setom thesis + move tt,[sixbit / QT/] + movem tt,queue + jrst .+1] + move t,[441000,,%cpkdt+4(a)] ; get pointer to this wonderful data + move tt,[440700,,srcnam] ; and copy it to a buffer as our source name +iniput: ildb x,t ; get the character + idpb x,tt ; save the character + jumpn x,iniput ; and if it's not null (end-of-string), save + ret + +byebye: call clsfil ; close and rename the file + setom closed ; in case we're local, say connection closed + skipn servep ; are we a server? + ret ; no, return to caller + skipe debug ; debugging? + .value + .logout 1, ; bye-bye + +;; close and rename the current output file +clsfil: skipn filesw ; do we have a file really there? + ret ; no, just return now + ldb tt,[044000,,%cpkdt(a)] ; get the page number + movem tt,opgnum ; and salt away for later use + move t,suname + syscal OPEN,[ cnti .uii + argi mapi + [sixbit /DSK/] + [sixbit / SCAN/] + [sixbit / QFN2/] + [sixbit /DEVICE/] + erro x] + call fn2los ; if it loses, fix it maybe + syscal CORBLK,[ cnti %cbndr\%cbndw + argi 0 + argi %jself + argi fn2pag + argi mapi ; open on MAPI + argi 0] ; page 0 in the file + .lose %lssys + +getnam: aosn t,fn2pag*2000 ; first word of file is our frobie! + jrst getnam ; 0 not a good name! + camn t,[sixbit />/] ; don't use ">" either! + jrst getnam + camn t,[sixbit //]] + .lose %lsfil + .close queo, ; all done, file is now queued + ret + + +;; expects an error code in X. If the preceeding call failed, create +;; the file DSK:DEVICE;  SCAN   QFN2 with 1 block + +fn2los: sos (p) ; back up the PC + sos (p) ; to point to the .CALL + caie x,%ensfl ; No such file? + jrst opnlos ; nope, don't understand this error! + syscal CORBLK,[ cnti %cbndr\%cbndw ; grab a fresh page + argi 0 + argi %jself + argi fn2pag + argi %jsnew] + .lose %lssys + syscal OPEN,[ cnti .uio + argi mapi + [sixbit /DSK/] + [sixbit / SCAN/] + [sixbit / QFN2/] + [sixbit /DEVICE/]] + .lose %lssys + move t,[444400,,fn2pag*2000] + movei tt,2000 + syscal SIOT,[argi mapi ? t ? tt] + .lose %lsfil + ret ; return to try again + +;; takes a Byte Pointer in A, and copies ASCIZ string to QUEO +qstrt: ildb t,a ; get a character +cpysrc: .iot queo,t ; write it + ildb t,a ; get a character + jumpn t,cpysrc ; maybe repeat. Null terminates + ret + +datprt: +repeat 2,[ +repeat 2,[ + ildb t,tt ; get a byte + addi t,40 + .iot queo,t] ; send it out + .iot queo,c] ; separate for times or date, as needed +repeat 2,[ + ildb t,tt + addi t,40 + .iot queo,t] + ret + +;; pick another pack to try if original choice was not available +;; expects X to contain the error code + +novisn: sos (p) ; back up the PC + sos (p) ; to the preceeding instruction + caie x,%ENAPK ; is the error "Pack not mounted"? + jrst opnlos ; No, go complain + move x,outdev ; what device are we hacking now? + camn x,[sixbit /AI/] ; are we already hacking the AI device? + .lose ; Huh? Should be Device Not Available + camn x,[sixbit /SECOND/] ; are we hacking the SECOND: device? + move x,[sixbit /DSK/] ; try ordinary primary, and lots of luck! + camn x,[sixbit /VISION/] ; are we hacking the VISION: device? + move x,[sixbit /SECOND/] ; try the SECOND: next + movem x,outdev ; use that for scan files + movem x,quedev ; and queue files + ret ; return to try again! + +opnlos: move x,(p) ; get losing PC + move losepc ; remember it + movei x,%lsfil ; lossage-code = file + hrlm x,(p) ; set up the word on top of stack to have + movss (p) ; ,, + pop p,x ; collect it in X + syscal LOSE,[ cnti 5 ; so losing SYSCAL LOSE can lose + x ? losepc] + .lose %lssys ; HUH? + + +;; open a file to write data to + +opnfil: syscal OPEN,[ cnti .uio ? argi scno ? outdev + [sixbit /_SCAN_/] ? [ sixbit /OUTPUT/] ? outdir + erro x] + call novisn ; backs up and retries + setom filesw ; note the file is open + +;; Packet with address in A contains data to be written to disk. + +dskout: skipn filesw ; do we have an output file? + jrst opnfil ; no, open it first + ldb tt,[$cpknb (a)] ; get # of bytes used in data + addi tt,3 ; prepare for roundoff + idivi tt,4 ; get # of PDP10 words we're hacking + move t,[444400,,%cpkdt(a)] ; get pointer to the data + syscal SIOT,[argi scno ? t ? tt] ; send the data out to disk + .lose %lsfil + ret ; done + +tclose: call nxtpg0 ; do and end-of-page bit +tclos1: setom gone ; say it's OK for server to vanish + movei a,packet ; this is in the data packet (why not?) + movei b,%cobye ; tell other end to finish up + setz c, ; no data + call makpkt ; send this packet out + type /ARun time = / + .suset [.rrunt,,a] ; get the run time + idivi a,<1000./4> ; get mili-seconds of run time + call decprt ; print the mili-seconds + type / milli-seconds. +All pages queued. +/ + skipe debug ; debugging? + .lose + skipn closed ; has it been queued? + .hang ; not yet, wait for it! + .logout 1, ; bye-bye! + +;; ship-out output byte pointers +shpobp: 140400,,outlin(tt) + 100400,,outlin(tt) ; second from end is first byte + 040400,,outlin(tt) + 000400,,outlin(tt) ; last byte is next + 340400,,outlin(tt) + 300400,,outlin(tt) ; leftmost becomes rightmost, that's next + 240400,,outlin(tt) + 200400,,outlin(tt) ; last one is here.....what a crock this is + +$nxt==$cenxt ; all should be the same +$prv==$ceprv +ifn $cenxt-$benxt,.FATAL Entity structures incompatible +ifn $ceprv-$beprv,.FATAL Entity structures incompatible + +;; Delete an entity from the ENTLST. Expects entity to delete in CL, +;; puts it's successor in A. Does not add to the freelist + +kkill: move t,$nxt(cl) ; get next frobbie + move tt,$prv(cl) ; get previous frobbie + movem t,$nxt(tt) ; previous exists. Set it's next. + skipe t ; if no next, don't try setting it + movem tt,$prv(t) ; next exists, set it's previous + movei a,(t) ; return the next in A + ret ; return it. + +;; Atom table +$KILL: sixbit /KILL/ +$LINE: sixbit /LINE/ +$CHECK: sixbit /CHECK/ + +;; Table of bit masks according to # of zeros left justified, for left edge of +;; box +lftmsk: repeat 44, <1_<44-.rpcnt>>-1 + +;; Table of bit masks according to # of ones left justified for right edge of +;; box +rhtmsk: repeat 44, -1_<44-.rpcnt> + +;; barf if the dX misfeature of XGP Escape 4 is used + +es4bd2: call tin ; flush a byte of the sequence +es4bd1: call tin ; flush a byte of the sequence +es4bd0: call pagprt ; tell which page lost + etype /A >>Unimplemented mis-feature of XGP Escape 4 encountered! +/ + call badfil ; go barf at him some more + call tin ; flush a byte of the sequence + jrst tin ; flush a byte of the sequence and return + +;; Barf if move up + +moveup: call pagprt ; tell him where it happened + etype /A >> Attempt to move up. Ignored. +/ + jrst badfil ; barf some more, and return + +;; Take amount to move right in A, and adjust SCNLSH and SCNWRD + +scnmov: sub a,scnlsh ; get total amount to right shift + idivi a,44 ; convert to words (in A) and bits (in B) + addm a,scnwrd ; adjust the word position + movnm b,scnlsh ; and the scan position as a left shift + ret + +;; print a font number +fntprt: movsi t,-fntmax +fntpr1: camn fn,fontab(t) ; is this the font? + jrst [ movei a,(t) ; get the font # in A + call decprt ; type it + ret] + aobjn t,fntpr1 ; next font + call pagprt ; tell him where + etype /A >>AIII!!! Font in use but unknown! What a screw, this can't happen! +/ + ret + +nochar: push p,silent ; temporarily + setzm silent ; enable output + push p,a ; remember the character + call pagprt ; tell him where + etype /A >>Character "/ + pop p,a ; remember the character + .iot ttyo,a + etype /" not found in font #/ + movsi t,-fntmax ; AOBJN ptr to the fonts +nochr1: camn fn,fontab(t) ; is this the font? + jrst [ movei a,(t) ; get the font # in A + call decprt ; type it + type / +/ + pop p,silent + ret] + aobjn t,nochr1 ; next font + etype / + >>AIII!!! Current font unknown! Setting to font 0 +/ + move fn,fontab ; totally arbitrary, should never happen + pop p,silent ; restore output status + ret + +pagprt: push p,silent ; temporarily enable output + setzm silent + etype /A >>Error on page / + move a,pagnum ; get the page number + call decprt ; print it + etype /. +/ + pop p,silent + ret + +badfil: etype /AWhat is the gubbish of an input file you're feeding me? +Are you >>SURE<< this is TEX output? +/ + skipe debug + .lose + .logout 1, + +serve: setom servep ; note that we're a server + movei x,putpk1 ; instead of calling ourself with packets + movem x,sndpkt ; we send the over to the user side! + .suset [.simask,,[%piioc]] ; be sure we can handle IOC errors + syscal CHAOSO,[argi chsi ? argi chso ? argi cs$win] + .lose %lsfil + movei x,%colsn ; we want to listen + dpb x,[$cpkop ctlpkt] ; so we set up the control packet + move x,[ .byte 8 ? "X ? "G ? "P ? "S ? .byte ] ; as a LISTEN packet + movem x,ctlpkt+%cpkdt ; for the XGPSCN protocol + move x,[ .byte 8 ? "C ? "N ? .byte ] + movem x,ctlpkt+%cpkdt+1 + movei x,6 ; byte count is six + dpb x,[$cpknb ctlpkt] + syscal PKTIOT,[argi chso ? argi ctlpkt] ; send the packet (LISTEN) + .lose %lsfil + skipe debug ; unless we're debugging + move t,[377777,,777777] ; in which case we'll wait forever + movei t,30.*60. ; sixty seconds max time to wait for it + syscal NETBLK,[ argi chsi ? argi %cslsn ? t ; wait until it's open or + val tt] ; or for a minute max + .lose %lsfil + caie tt,%csrfc ; did it time out? + jsr byelos ; yes, just go away quietly + movei x,%coopn ; say we accept the charges + dpb x,[$cpkop ctlpkt] ; by giving him a OPN opcode + setz x, ; I think a byte count of zero + dpb x,[$cpknb ctlpkt] ; will work, since we don't much care... + syscal PKTIOT,[argi chso ? argi ctlpkt] ; send the packet (OPEN) + .lose %lsfil + movei t,30.*60. ; wait up to a minute + syscal NETBLK,[ argi chsi ? argi %csrfc ? t ; wait for it to change + val tt] ; hopeing for a OPEN state now + .lose %lsfil + caie tt,%csopn ; is it OPEN now? + jsr byelos ; no, must have timed out or lost + +servlp: syscal PKTIOT,[argi chsi ? argi packet] ; get info in return + .lose %lsfil + movei a,packet + call getpkt ; gobble the packet + jrst servlp ; keep doing this + +;;; FILBLK contains the filenames for this font. Create a font-object, return +;;; it in FN + +makfnt: move fn,fntfre ; get bottom of last allocated font + subi fn,$fn.ln ; get bottom of this font + movem fn,fntfre ; remember it + camge fn,fntbot ; have we gone over a page boundary? + call fntalc ; yes, allocate the page + hrlzi tt,(fn) ; we first clear out the entire entry + hrri tt,1(fn) ; by copying zero into next location + setzm (fn) ; there's the zero. + blt tt,$fn.ln-1(fn) ; blt the entire character object + move x,$$DEV + movem x,$fndev(fn) ; remember the filename in the font + move x,$$FN1 + movem x,$fnfn1(fn) + move x,$$FN2 + movem x,$fnfn2(fn) + move x,$$snm + movem x,$fnsnm(fn) + setom $fnsb0(fn) ; by default we load all the characters of + setom $fnsb1(fn) ; a font, unless we're told otherwise + setom $fnsb2(fn) ; by a ;KSUBSET frobie + setom $fnsb3(fn) ; a 1 bit means to load the char + ret + +;; FNTGET loads in the data for the font-object in FN + +fntget: skipn $fnsb0(fn) ; if non of the characters are used + skipe $fnsb1(fn) ; as determined by the ;KSUBSET info + jrst fntgt0 + skipn $fnsb2(fn) + skipe $fnsb3(fn) + caia + ret ; then we don't bother loading + +fntgt0: syscal OPEN,[ cnti .uii ? argi fntc ; open the file for the font + $fndev(fn) + $fnfn1(fn) + $fnfn2(fn) + $fnsnm(fn)] + .lose %lsfil + setzm fbufpt ; invalidate font buffer + call fin ; throw away garbage word + call fin ; get size, etc. + hrrz x,a ; get the height + movem x,$fnhit(fn) ; remember the height in the font + call fin ; get a word, well either be -1 or have 1 + ; bit on. + jumple a,fnteof ; end of font file? +fntchr: call rdchar ; get a character from the file + jumple a,fnteof ; end of font file? + jrst fntchr ; and try reading another + +fnteof: .close fntc, + ret + +; Allocate a new page for fonts +; clobbers X,A + +fntalc: move x,fntbot ; get current bottom page + subi x,2000 ; calculate new one + movem x,fntbot ; remember for next time + caige x,lowend ; this had better be above low core + jrst [ call pagprt ; tell him where it happened + etype /A >> URK!!!! Ran out of core! +>> Fatal error. +/ + .logout 1,] + idivi x,2000 ; get page number in X + syscal CORBLK,[argi %cbndw\%cbndr ? argi %jself ? x ? argi %jsnew] + .lose %lssys ; just barf, for now + ret + +; initialize font input buffer +fbfin0: move t,[444400,,fbuf] ; read in info into FBUF + movei tt,fbufln ; up to FBUFLN words of it + syscal SIOT,[argi fntc ? t ? tt] ; from FNTC + .lose %lsfil + subi tt,fbufln ; calculate -<# of words in buffer> + jumpe tt,badfnt ; if EOF, must be a bad font file + hrlzi tt,(tt) ; put -count in LH for AOBJN ptr + hrri tt,fbuf ; AOBJN ptr into FBUF + movem tt,fbufpt ; and that's our pointer + ret + +fbfini: call fbfin0 ; refill the buffer, and fall through + +; read in a word from the font. Note that for efficiency the CHRGBL routine +; contains a copy of this routine. If this is updated, it should be as well + +fin: skipl tt,fbufpt ; get pointer into the buffer + jrst fbfini ; ran out of stuff, re-fill the buffer + move a,(tt) ; get the word we were looking for + add tt,[1,,1] ; increment to next word + movem tt,fbufpt ; and remember for next time + ret + +badfnt: etype /ABad format in font file./ + skipe debug + .lose + .logout + +;; makchr makes a character object, returning it in CH + +makchr: move ch,lowptr ; get pointer to new character + movei x,(ch) ; and copy to caluclate + addi x,$ch.ln ; where next goes + movem x,lowptr ; remember it + camle x,lowend ; before the page boundary? + jrst pagalc ; no, gotta get more space + setzm (ch) ; we start out with the character being + hrlzi x,(ch) ; blank, zeroing out all + hrri x,1(ch) ; the entries + blt x,$ch.ln-1(ch) ; >>> !! ZAP !! <<< + ret + +rdchar: call fin ; get the next word (kern,,code) + movei t,(a) ; copy the character + idivi t,40 ; get word and bit in word for KSUBSET test + movns tt ; negate for shift right + movsi b,20000 ; left most significant bit + lsh b,(tt) ; THE bit! + addi t,$fnsb0(fn) ; get location of mask + tdnn b,(t) ; Is this bit on? + jrst chrgbl ; No, just gobble this char + call makchr ; make a character to get all this + movem fn,$chfnt(ch) ; point back at the font so we can debug + hrrzm a,$chchr(ch) ; remember the character code for debugging + movei t,$fnchr(fn) ; locative to character table of font + addi t,(a) ; locative to this char in table + skipe (t) ; it had better still be empty + .lose ; no? Bug! (or bad file!) + movem ch,(t) ; put this char in the table + hlre t,a ; get kern, as full word + movem t,$chkrn(ch) ; remember the kern + call fin ; get next word + hrrz t,a ; get character width + movem t,$chwid(ch) ; and remember that. + hlrz t,a ; get raster width + cain t,0 ; if not there + hrrz t,a ; user character width instead + movem t,$chrwd(ch) ; remember this as width of rasters + addi t,43 ; round up + idivi t,44 ; get # of words used + movns t ; negate it + push p,t ; save for later + imul t,$fnhit(fn) ; get -1* + hrls t ; put it in left half for AOBJN ptr + hrr t,lowptr ; make it an AOBJN ptr to the array + movem t,$chrow(ch) ; remember it for people's sake + pop p,t ; get - + hrls t ; put it in left half for AOBJN ptr + hrr t,lowptr ; AOBJN ptr to first row of raster array + movem t,$chrw1(ch) ; remember it for $CE's + setzm bytpos ; note we're at start of raster +getrow: call fin ; get a word + trne a,1 ; Is this the end of the char? + ret ; yes, maybe end of file too + move d,a ; move into a more permanent AC + move e,[441000,,d] ; Byte Pointer into that word + movei c,4 ; there are 4 of these bytes +getwr2: ildb a,e ; get the first byte + call @reverse ; reverse the bits + call putbyt ; put the byte away as part of whatever line + sojg c,getwr2 ; if more bytes in this word, check them too + jrst getrow ; get another word to go with it + + +;; GUBBLE a character. Throw it away. Take no space. +;; note that this contains a virtual copy of the FIN routine + +chrgbl: call fin ; throw away raster width,,char width + move tt,fbufpt ; get pointer to our buffer +chrgb1: skipl tt ; are we at the end of the buffer? + jrst [ call fbfin0 ; ran out of stuff, re-fill the buffer + jrst chrgb1] ; and keep on gubbling + move a,(tt) ; get the word we were looking for + add tt,[1,,1] ; increment to next word + movem tt,fbufpt ; and remember for next time + trnn a,1 ; end of character definition? + jrst chrgb1 ; no, keep on gubbling + movem tt,fbufpt ; salt away the buffer pointer for later + ret ; yes, end of GUBBLE + +putbyt: sosge bytpos ; count bytes + jrst bptalc ; no more on this line, next word + movei t,(a) ; copy the byte where we can hack + lshc t,-4 ; split it into two bytes + lsh tt,-40 ; both right justified + idpb t,bptput ; write out the byte + idpb tt,bptput ; in such a way to completely fill the word + ret ; that's it! + +;; allocate raster more words for character array +bptalc: move t,$chrwd(ch) ; get raster width + addi t,7 ; prepare for rounding-up division + idivi t,10 ; T <- # of 8-bit bytes needed for this frob + movem t,bytpos ; that's how often to reset + move t,$chrwd(ch) ; get raster width in bits + addi t,35. ; prepare for rounding-up division + idivi t,36. ; T <- # of words needed for this raster + push p,t ; remember how long our entry is + move tt,lowptr ; get where free word is now + push p,tt ; remember where our entry is + hrli tt,440400 ; make Byte Pointer to new line + movem tt,bptput ; to put half-bytes down + addb t,lowptr ; update to be after what we have now + caml t,lowend ; do we need more space? + call pagalc ; yes, must allocate a new page + pop p,tt ; recover where start of entry is + pop p,t ; recover count + movns t ; negate count + hrli tt,(t) ; turn TT into AOBJN ptr to new words +bptclr: setzm (tt) ; clear a word + aobjn tt,bptclr ; if still more words, keep on clearing + jrst putbyt ; all set for next line, resume PUTBYT + +;;; Allocate page for lower core. +pagalc: move x,lowend ; get first non-available location + addi x,2000 ; make it point to next page + camle x,fntbot ; there had better be no overlap with upper + jrst [ call pagprt ; tell him where it happened + etype /A >> URK!!! Ran out of core. + >> Fatal error. +/ + .logout 1,] ; Oh well. + exch x,lowend ; and save it away + lsh x,-10. ; get this page # + syscal CORBLK,[argi %cbndw\%cbndr ? argi %jself ? x ? argi %jsnew] + .lose %lssys ; just barf, for now, if no core + move x,lowptr ; now before we leave + camle x,lowend ; we had better check that there's enough + jrst pagalc ; no, better allocate another page + ret ; got the core, return + + +;;; allocate a character entity, return it in A +cealc: skipe a,cefree ; are there any already made, free? + jrst [ move x,$cenxt(a) ; yes, find next in chain + movem x,cefree ; make it the head of free-list + ret] ; and return our entity. + movei a,$ce.ln ; length in A + call lowalc ; allocate a block that long of low core + movei x,cehack ; address of handler for a character entity + movem x,$cefun(a) ; put that info in the entity + ret ; return it, let caller fill in the rest + +;; Allocate a box entity, return it in A +bealc: skipe a,befree ; are there any already made, free? + jrst [ move x,$benxt(a) ; yes, find next in chain + movem x,befree ; make it the head of free-list + ret] ; and return our entity. + movei a,$be.ln ; length in A + call lowalc ; allocate a block that long of low core + movei x,behack ; address of handler for a character entity + movem x,$befun(a) ; put that info in the entity + ret ; return it, let caller fill in the rest + +;; Take size to allocate in A, allocate that much low core, return pointer to +;; it in A + +lowalc: push p,lowptr ; get pointer to low core + addb a,lowptr ; allocate the core + camle a,lowend ; is it off the end of last page? + call pagalc ; yes, allocate a new page + pop p,a ; return result in A, as always + ret + +; operations to reverse a 36 bit word +circ36: circ a,36. +rvrs36: call nrevr1 ; reverse without CIRC + +;; NREVR1 reverses the bits in A, leaving result in A and B without using CIRC + +nrevr1: movss b,a ; swap halves, get a copy + and a,[000777,,000777] ; one half + and b,[777000,,777000] ; the other half + lsh a,11 ; swap + lsh b,-11 ; swap with other half + iorb a,b ; result in A and B + move t,a ; this swap has bits that don't move + and t,[020020,,020020] ; so need a third word that gets just those + and a,[740740,,740740] ; one half + and b,[017017,,017017] ; other half + lsh a,-4 ; swap + lsh b,4 ; swap with other half + ior a,t ; put the stationary bits in A + iorb a,b ; result in A and B + and a,[631463146314] ; one half + and b,[146314631463] ; other half + lsh a,-2 ; swap + lsh b,2 ; swap with other half + iorb a,b ; result in A and B + and a,[525252,,525252] ; one half + and b,[252525,,252525] ; the better half + lsh a,-1 ; swap + lsh b,1 ; swap with the other half + iorb a,b ; result in A and B + ret + +;; reverse an 8-bit-byte, contained in A. Clobbers B, and uses CIRC +crever: circ a,36. ; reverse + setz a, ; flush any garbage from B + lshc a,10 ; recover our byte + ret ; that's it! + +;; reverse an 8-bit-byte, contained in A, with no CIRC instruction. Clobbers B +nrever: move b,a ; get a copy + andi a,17 ; low 4 bits + andi b,360 ; high 4 bits + lsh a,4 ; make them high + lsh b,-4 ; make them low + iorb a,b ; result in both + andi a,125 ; lower bits by pairs + andi b,252 ; higher bits by pairs + iorb a,b ; result in A and B + ret ; that's it! + +;;; Read in a character from the text input file, return it in A + +tin: sosge tbfcnt ; is there still stuff in the buffer? + jrst tbfget ; no, fill it up + ildb a,tbufbp ; get a character + cain a,^M ; terpri? + setom crflag ; yes, let it be known it came + skipn texbug ; do we have to look out for TEX bug? + ret ; no, just return it + jumpe a,tin ; yes, if it's null try again + ret ; otherwise we've got it + +;;; fill the Text input buffer from TXTI + +tbfget: skipe txteof ; have we already hit EOF? + jrst [ move a,[-1] ; yes, return a -1 + ret] ; to denote EOF + move x,tbuf+tbufsz ; get previous look-ahead + movem x,tbuf ; and make it current + move t,[440700,,tbuf+1] ; Byte Pointer into TBUF + movei tt,tbufsz*5 ; # of bytes read into TBUF + syscal SIOT,[argi txti ? t ? tt] ; read in more stuff + .lose %lsfil + jumpn tt,teofck ; if end of file, go check it out + movei tt,tbufsz*5 ; otherwise, we got full buffer + movem tt,tbfcnt ; but don't include lookahead + move t,[440700,,tbuf] ; and we take our input from the start of + movem t,tbufbp ; the buffer, at last time's lookahead + jrst tin ; and go gobble input + +;; got an EOF, check for gubbish (^C's) at the end of the file, in case +;; the file was edited with losing TECO + +teofck: pushj p,teofc1 ; back up to the last real char + move t,[440700,,tbuf] ; we gobble from the start of the buffer + movem t,tbufbp ; so point there + movei t,*5 ; trying to read full buffer, plus lookahead + subi t,(tt) ; but were short (tt) bytes + movem t,tbfcnt ; so this is how many we have left + jrst tin ; and go gobble real input + +txtini: move t,[440700,,tbuf] ; we don't have any look-ahead yet + movei tt,*5 ; so try to get some + syscal SIOT,[argi txti ? t ? tt] ; read in some cruft + .lose %lsfil + jumpn tt,txieof ; early EOF, gubble gubble + move t,[440700,,tbuf] ; get our characters from TBUF + movem t,tbufbp ; from the very start + movei tt,tbufsz*5 ; don't count lookahead in # of characters + movem tt,tbfcnt ; in buffer (that's how it's lookahead!) + ret + +;; got an EOF while trying to get the look-ahead + +txieof: move t,[440700,,tbuf] ; we gobble from the start of the buffer + movem t,tbufbp ; so point there + movei t,*5 ; trying to read full buffer plus look-ahead + subi t,(tt) ; but were short (tt) bytes + movem t,tbfcnt ; so this is how many we have left + ret ; end of buffer initialization + + +;; common handler to back up Byte Pointer and count (in T and TT, respectively) +;; to avoid the ^C GUBBLE TECO puts into files. + +teofc1: setom txteof ; note we've hit EOF + .close txti, ; close it as well + ldb x,[360600,,t] ; did it fill a word? + caie x,1 ; (i.e. only 1 bit to right) + cain x,44 ; (or if we transfered nothing at all) + caia ; if so, might have been padded with ^C + ret ; Else must be exact byte count, OK. + cain x,44 ; is it a non-standard byte-pointer? + jrst [ sos t ; yes, back over word + hrli t,010700 ; and give proper left half + jrst .+1] +tbaklp: ldb x,t ; check the character + skipe x ; it it null + cain x,^C ; or a padding char? + caia ; yes, keep backing upt + ret ; no, that's the end of the padding + add t,[070000,,0] ; yes, padding, so back up the byte pointer + aos tt ; and the count + jumpg t,tbaklp ; check for more padding + + sos t ; word boundary, back up the pointer + hrli t,010700 ; and point at the last byte in that word + jrst tbaklp ; and check for more padding + +;; read a word of 6bit from TIN, returning result in A + +6read: setz a, ; our result + push p,a ; put our result on the stack + push p,[440600,,-1(p)] ; our byte pointer +6read0: call tin ; get a character + caige a,0 ; EOF + caie a,^L ; or end-of-page + caia ; nope, must be OK + call badfil ; yes, bletch, what are they doing? + caig a,40 ; is it a for-real character? + jrst 6aread ; no, return + cail a,"a ; lower case? + subi a,40 ; yes, upper-casify + subi a,40 ; and 6-bitify + idpb a,(p) ; add our result in + tdnn a,-1(p) ; since no included spaces, last char=end + jrst 6read0 ; no last yet, get a new character + +6read8: call tin ; find the final delimiter + jumpl a,6aread ; eof, just return + caile a,40 ; printing? + jrst 6read8 ; yes, keep on gobbling + cain a,^M ; end of line? + call tin ; flush the ^J too. +6aread: + pop p,a ; throw away the Byte Pointer + pop p,a ; recover our return value + ret ; and return + +;; read a unsigned decimal number in from TXTI, return it in A + +rdec: push p,b ; accumulate answer here + push p,c ; count + setz b, ; initially zero +rdecx: call tin ; cai + caie a,^I ; tab? + cain a,40 ; or space? + jrst rdecx ; gobble another + skipa +rdec0: call tin ; get a character + jumpe a,rdec0 ; TEX bug, crock to get around, awful + caie a,^I ; tab + cain a,40 ; or space + jrst rdec9 ; mark the end (burma shave) + cain a,^M ; terpri + jrst rdec8 ; then also exit + caig a,"9 ; if not a digit + caige a,"0 + jrst [ etype /ANon-digit where decimal number expected!/ + call badfil ; barf at him + jrst rdec9] ; return what we have if continued + subi a,"0 ; turn into a number + imuli b,10. ; previous gets shifted a digit + addi b,(a) ; and this gets included + jrst rdec0 ; and read another digit + +rdec8: call tin ; flush a ^J following a ^M? + caie a,^J ; really a ^J? + jrst [ etype /AStray CR in header of file!/ + call badfil ; barf at him + jrst .+1] +rdec9: move a,b ; return value in standard return value AC + pop p,c ; recover our scratch AC's + pop p,b + ret ; and return our answer + +;; read an unsigned octal number from TXTI + +roct: push p,b ; accumulate answer here + push p,c ; count + setz b, ; initially zero +roctx: call tin ; cai + caie a,^I ; tab? + cain a,40 ; or space? + jrst roctx ; gobble another + skipa +roct0: call tin ; get a character + jumpe a,roct0 ; TEX bug, cludge + caie a,^I ; tab + cain a,40 ; or space + jrst rdec9 ; mark the end (burma shave) + cain a,^M ; terpri? + jrst rdec8 ; yes, handle the ^J and return +roct1: caig a,"7 ; if not a digit + caige a,"0 + jrst [ etype /ANon-octal digit where octal number expected!/ + call badfil ; barf at him + jrst rdec9] ; return what we have if continued + subi a,"0 ; turn into a number + lsh b,3 ; multiply B by 10 + addi b,(a) ; and this gets included + jrst roct0 ; and read another digit + +;; type number in A as a decimal number + +decprt: skipe silent ; are we silenced? + ret ; yes, don't print anything! + move t,a ; get the number to print + caige t,0 ; negative? + .iot ttyo,["-] ; prefix with minus sign + movms t ; get absolute value +decpnt: idivi t,10. ; figure first digit + push p,tt ; push remainder + skipe t ; done? + call decpnt ; no compute next one + + pop p,t ; yes, take out in opposite order + addi t,60 ; make ascii + .iot ttyo,t ; type it + ret ; and return for the next one. + +;; type number in A as a decimal number + +qdecpr: move t,a ; get the number to print + movms t ; get absolute value (paranoia) +qdecpn: idivi t,10. ; figure first digit + push p,tt ; push remainder + skipe t ; done? + call qdecpn ; no compute next one + + pop p,t ; yes, take out in opposite order + addi t,60 ; make ascii + .iot queo,t ; type it + ret ; and return for the next one. + +;; write a word of sixbit, in A, to QUEO +q6type: move tt,a ; copy the word +q6typ0: setz t, + lshc t,6 ; get a byte + skipn t ; does it need quoting? + .iot queo,[^Q] ; yes, quote it + addi t,40 ; convert it to ascii + .iot queo,t ; type it + jumpn tt,q6typ0 ; if there's more, type that too + ret ; otherwise return + +purify: move p,[-pdllen,,pdl] ; set up the PDL so we can call stuff + move a,versio ; get first file name + move d,[440700,,scnvrs] ; point to our version number + call 6bit ; start the renaming + movei x,40 ; space + idpb x,d + move a,versio+1 ; get our second name + call 6bit + setz x, ; now we deposit a trailing null + idpb x,d ; to mark the end + + move t,[-,,1] ; AOBJN ptr to pages to be made pure + setom puresw ; note that we've been purified + syscal CORBLK,[argi %cbndr ? argi %jself ? t] ; purify + .lose %lssys + +irp fnm,,[DSK,13VG,KST,FONTS]prt,,[$$dev,$$fn1,$$fn2,$$snm] + move x,[sixbit /fnm/] ; set up the filename table to point + movem x,prt ; our own-typeout font for internal use +termin + call makfnt ; make the font + movem fn,fontab+0 ; that's font zero + call fntlod ; load the font into core + move x,fntbot ; get address of bottom font page and start + movem x,fntfre ; allocating below that, will purify above + idivi x,2000 ; get page number + move t,x ; copy the number + subi t,400 ; get -<# of pages taken for fonts> + hrli x,(t) ; make an AOBJN ptr to the pages + syscal CORBLK,[argi %cbndr ? argi %jself ? x] ; purify + .lose %lssys + move x,lowend ; get first unallocated page + movem x,lowptr ; allocate beginning there. + idivi x,2000 ; turn it into a page number + subi x,/2000 ; purify from first available page for pure + movns x ; make negative + hrlzs x ; (make an AOBJN ptr) + hrri x,fntpur ; AOBJN ptr to pages to purify + syscal CORBLK,[argi %cbndr ? argi %jself ? x] ; purify + .lose %lssys + .break 16,100000 ; putrified. + +$$OUTF==:-1 ; we want the fancy output routines +$$OUTT==:-1 ; we want the DOW tables +$$ABS==:-1 ; need this to get TIMDOW +.insrt syseng;datime > + + +;; routine to hack dates in a nice format. Takes date word in A and +;; Byte Pointer of where to put it in D + +timhak: push p,a ; save for date + push p,d ; save for outputing to + call datime"timdow ; get the day of week + move b,datime"dowlng(b) ; get address of long name of day + hrli b,440700 ; make it into a byte pointer + pop p,d ; get Byte pointer to output to + ildb x,b ; get byte +datcop: idpb x,d ; put byte + ildb x,b ; get byte + jumpn x,datcop ; copy some more + movei x,", ; comma + idpb x,d + movei x,40 ; space + idpb x,d + pop p,a ; recover date + jrst datime"timeng ; hack the english time + +;; routine to take 6bit in A and Byte Pointer in D and deposit ascii for the +;; sixbit +6BIT: move tt,a ; copy the word +6bit0: setz t, ; character accumulator + lshc t,6 ; get first character + addi t,40 ; make it into ASCII + idpb t,d ; send it out + jumpn tt,6bit0 ; and get the next character, if any + ret + +;; this is the IOC error handler +iocerr: movem x,iocadr ; borrow X for a bit + move x,(p) ; get the PC at which the IOC error happened + exch x,iocadr ; and save it, restoring X + push p,t + push p,tt + push p,x + push p,a + push p,b + .suset [.rjpc,,iocjpc] ; remember our JPC + .suset [.rbchn,,x] ; find out which channel it was + cain x,scno ; disk output? + jrst dskful ; yes, probably full disks +ioclos: skipe servep ; are we a server? + skipe debug ; but before going away, are we debugging? + caia ; don't go, give a visible error + .logout ; server can't report error, just die + + pop p,b ; resore AC's so person debugging doesn't + pop p,a ; get confused + pop p,x + pop p,tt + pop p,t + syscal LOSE,[argi 1+.lz %piioc ? iocadr] ; report the error to DDT + .lose %lssys + +dskful: .status scno,t ; get the status + ldb x,[330500,,t] ; get the error code + caie x,11 ; disk full? + cain x,14 ; directory full? + jrst dskhng ; wait a while and retry + jrst ioclos ; don't understand, go barf or die + +dskhng: push p,c ; push the rest of the AC's that + push p,d ; SNDPKT routines might hack + push p,e + push p,f + movei x,%coioc ; opcode=full + dpb x,[$cpkop ctlpkt] ; use CTLPKT since probably hacking other + setz x, ; no data contained in an IOC packet + dpb x,[$cpknb ctlpkt] ; just existance + movei a,ctlpkt ; tell packet sender which packet to hack + call @sndpkt ; send it out + pop p,f ; restore the stack and AC's + pop p,e + pop p,d + pop p,c + move x,ioctim ; get time to wait + .sleep x, ; sleep and try again + + pop p,b ; restore the AC's we had before + pop p,a + pop p,x + pop p,tt + pop p,t + syscal DISMIS,[p] ; dismis the interrupt + .lose %lssys + +;; hack input packets +chsint: push p,x ; push a whole bunch of AC's so we can hack + push p,a + push p,b + push p,c + push p,d + push p,e + push p,f +whyint: syscal WHYINT,[argi chsi ? val tt ? val x ? val t] + .lose %lssys + cain tt,%csrfc ; if state is RFC sent + .value ; I'd like to know about it, for now + hlrzs t ; get number of packets available + jumpe t,chsdis ; if no packets, don't try to read any! + syscal PKTIOT,[argi chsi ? argi inpkt] ; read in the packet! + .lose %lsfil + movei a,inpkt ; tell GETPKT to hack it + call getpkt ; process it + jrst whyint ; check for more input packets. + +chsdis: pop p,f + pop p,e + pop p,d + pop p,c + pop p,b + pop p,a + pop p,x + syscal DISMIS,[p] ; return from the interrupt + .lose %lssys + +etyper: .call typblk ; type out, ignoring what SILENT is set to + .lose %lsfil + ret + +typer: skipe silent ; are we silenced? + ret ; yes, don't type out unless it's an error + .call typblk ; type out + .lose %lsfil + ret + +;;; process switch options Gets character of switch in A, Byte Pointer to more +;;; info in D +switch: cain a,"H ; does he want to suppress the header? + jrst [ setzm voff ? ret] ; just zero the vertical offset. + caie a,"Q ; Quiet running? + cain a,"S ; silent running? + jrst [ setom silent ? ret] ; take note of that. + cain a,"T ; Thesis Q? + jrst [ setom thesis ? move a,[sixbit / QT/] ? movem queue ? ret] + cain a,"P + jrst pagopt ; go handle page selection option + etype /AUnknown switch "/ + .iot ttyo,a + etype /". +/ + ret + +;;; gobble in a page list and copy it to PAGBUF. Takes Byte Pointer to input +;;; in D. +pagopt: move a,[440700,,pagbuf] ; initialize pointer into page buffer + movem a,pagebp ; and keep a pointer for ourselves in A +pagop0: camn a,[010700,,pagbfe-1] ; have we reached the end? + jrst [ etype \A>> Too many page specifications. +\ + .logout 1,] + ildb x,d ; get a character + caie x,40 ; space? + cain x,^I ; tab? + jrst pagop0 ; we ignore those + cail x,"0 ; is it a digit? + caile x,"9 + caia ; no + jrst pagop5 ; yes, hack it + caie x,", ; comma? + cain x,"; ; semi? + jrst pagop5 ; those are valid separators + cain x,"- ; - is a valid delimiter + jrst pagop5 + caie x,"[ ; is this an open + cain x,"] ; or a close? + caia ; yes + jrst gibber ; no, gibberish +pagop5: idpb x,a ; write out the byte + caie x,"] ; unless that was the end of the spec + jrst pagop0 ; get another +pagop9: call pagred ; set the first goal + ret ; the end, stop + +gibber: caie a,^M ; terpri? + cain a,^C ; or other form + jrst eol ; of end? + caie a,^_ ; ^_ marks end sometimes too + cain a,0 ; also 0 + jrst eol + etype \A>> Gibberish in /P[....] switch option. Should be +>> page numbers separated by comma, or ranges as in "59-63". I.e. +>> /P[1-15,34,35,59-63] +\ + .logout 1, + +eol: movei x,"] ; be sure that it gets terminated + idpb x,a ; by depositing an end mark + jrst pagop9 ; done, return + + +puresw: 0 ; set to -1 before purification +debug: $debug ; -1 means don't kill self, etc. +ioctim: 30.*60.*2 ; wait two minutes before retrying + ; after a disk full IOC error. +scnvrs: asciz /EXPERIMENTAL/ ; goes into headers +versio: .fnam1 + .fnam2 +constants +endpur:: +loc <<.+1777>/2000>*2000 ; round up to nearest page +fn2pag==:./2000 ; save a page for the FN2 +.==.+2000 +endpag==:./2000 +variables + +iocadr: 0 ; address of last IOC error +iocjpc: 0 ; JPC when last IOC happened + +crflag: 0 ; set to -1 whenever a CR is read on TXTI + +inpkt: block 126. ; packet from server to user! + +jclbuf: block jclsiz ; plenty of room for a filename spec + 1 ; mark end of JCL buffer +srcnam: block jclsiz ; our parsed filename goes here + +srcdat: block 10 ; buffer for creation date of source file +sqdate: block 10 ; date file was :SCAN'ed +name: block 2 ; ascii version of UNAME +mname: 0 ; machine name +silent: 0 ; set to -1 inhibits printing +goalpg: 0 ; page we're looking for. 0 means all +pagebp: 440700,,pagbuf ; Byte Pointer into page buffer for page + ; range hacking +pagbuf: block 40 ; large area for specifying lots of options +pagbfe:: ; end of page buffer +gone: 0 ; -1 means OK for server to vanish +closed: 0 ; -1 means that the server has closed + +corend: +fntpur==:/2000 ; first page of font area that's safe to + ; purify + + +; Local Modes: ::: +; Comment Begin:; ::: +; Comment Column:35 ::: +; End: ::: +end go