Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/press.fai
There are no other files named press.fai in the archive.
COMMENT VALID 00026 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00009 00002 FTNXP SAILSW
C00011 00003 FL A B C D W X Y Z Q R S T PUP P PDLEN CMDBLN PRIMAX OCHAN ICHAN TCHAN CM%INV SCANON MRUNCM DIGSEN DOVSOK
C00013 00004 IFBLK FBDEV FBNAM FBEXT FBPRT FBPPN FBDAT FBPRO FBSIZ FBLEN OFBLK PDLIST CMDBUF AMBIG RPGFLG SAVDEL QMODE PRIDX PRBUF NULLOK TBUFH IBUFH NIBUF IBUFAD OBUFH NOBUF OBUFAD OUTXCT RECEND BCPPTR BCPPTX BCPBYC OPOINT OCOUNT OBLOCK IPOINT ICOUNT IBLOCK ENTCNT ENTPNT ENTHED ENTTAI ENTFRE ELBYTC PDIRH PDIRT PDCNT PDPNT PDBYTC PDRECN PDRECL BYTNUM PSTART CURPOS CURY CURX EPAD NUMPAG PGIDX PGNUM SPGNUM HIPAGE LOPAGE LUSRNA USRMAX USRNAM PAGHED PAGNPT HDRPTR HDRCNT ENTAIL ENTLBC DEFSIZ RDFSIZ FDIR FDLEN ROTPTR FSZPTR FNTPTR PDBASE PDWRC PARTCN PAGECN FNTDCN UNKPCN FNTDAD RECNUM NEWPDA NUPARC PGARRY HEADFL ROTARG CPYCNT DDKEEP FNTSIZ PNTSIN MARUNT INCHWD PAGWID PAGHGT DEFWID DFTMAR DFLMAR DFBMAR DFXLIN RDFWID RDTMAR RDLMAR RDBMAR RDFLHT MAXWID TMAR BMAR LMAR LINHGT NLINES XLINES RTMAXX CHARSF TMARSF BMARSF LMARSF LINESF XLINSF DPAGE DDPASS DDRECT DDPART DDPDRN DDPDRC DDOBSL DDUNU1 DDUNU2 DDFCPY DDLCPY DDFNAM DDFCRE DDFDAT GENPAS DRMAX DATABL EOEP EOEPC EOFPC BCOUNT BPOINT NNAMES PNAMES FPREV FTYPMD
C00028 00005 EFSOCK ENHADR DVRHST .PTEDA .PTEAK .PTEEN .PTEAB .PTERR pupmsg pupout PUPLEN PUPTRN PUPTYP PUPID PUPDHN PUPDNT PUPDHS PUPDS1 PUPDS2 PUPSHN PUPSNT PUPSHS PUPSSK PUPDAT PUPBDT PUPBL LSOCK FSOCK HOST PREVID NOACK MTADR MTSTAT IRECNM CLSXCT PUTXCT PUPIOW
C00032 00006 START RESTAR CMDGO START1
C00034 00007 CPARSE CPARS0 PARSE1 PARSE2 GETPRG GETPR0 GETPR1 GETPR2 GETNUM GETNM1 GETSWT SWTAB SWTLN SWDISP SWNAM HEADST HEADCL COPSET SIZSET CHARST NLINST XLINST KEEPST FONTST FONTS1 FONTSX FONTS2 GTSARG GTSARG TMARST BMARST BMARS0 LMARST LINEST UNITFX CPAINI DEFFNT DEFFN2 DEFFN3 ROTSET MARADJ MARAD2 MARAD3 MARAD4
C00052 00008 ILLPPN NOPARS ILLSIX NOPAR1 NOPAR2 NOPAR3 MISARG DUPMAR PRBFUL AMBIGS ILLSWT ILSWAR SWNMRQ SWAOOB NSDERR NOIFL0 NOIFIL NOOFIL NOONAM BADPRS ERRPC NOCORE INERR NOTIMP
C00057 00009 OUTSET BCPSET BCPPUT BCPFIN GETLIN GETLN1 GETLNX PUTSIX PUTFIL PUTFL1 PUTFL2 LADJ PROCT PROCT1 PROCTR PROCTB PROCT6 PROT60 PROT6A PROT6B PROT6C PRDECT PRDEC PRDEC0 PRDEC1 PUTSTR PUTST1 PUTCHR TYDATE TYTIME TYTIM2 MONTAB PSHACS
C00064 00010 USRINI USRIN1 USRIN2 USRIN3 USRIN4 USRLRT USRIN5 TGET TGET1 TOPEN TOPEND USRFIL SPLPPN
C00068 00011 GETFIL GETFL1 GETFL2 RADJ GETFLM
C00071 00012 GETIPR OPENO OPENOT OPENOF OPENID OPENIT OPENIF
C00076 00013 CPOPJ2 CPOPJ1 CPOPJ GETSIX GETSX1 QSET GETSX2 GETSX3 TAB BLANK ILLEG MAKLF QMARK DELIM SLASH
C00078 00014 CHRTAB
C00081 00015 GETCMD GETCM1 TBLUK TBLUK0 TBLUK1 TBLUK2 TBLUK4 TBLUK3
C00085 00016 COMTAB COMTL COMTB1 COMNAM COMHLP AMBIGC ILLCOM ILLCM1
C00087 00017 HELP HELP0 HELPL HELP1 H.HELP H.EXIT EXIT DDTCOM MONCOM DDTGO NODDT CRLF
C00091 00018 H.PPAR Example PART PART0 PART1 PART1L PART1M PART1N PART1X PART2 COPYFD COPYPG COPYP0 COPYP1 MAKPDE WRITPD WRTPD1 WRITDD
C00100 00019 H.PTYP Example TYPE TYPE1 TYPE1L TYPE1M TYPE1N TYPE1X TYPEPP TYPPP1 TYPEFD TYPHDR TYPEPD TYPPD1 TYPPD2 TYPPD5 TYPPD4 TYPPD3 TYPPD6
C00121 00020 H.EMPR TMar EMPRESS EMPRS0 CONVRT FFPRC FFPRC1 FFPRC2 PGFLU FFPRC3 CHLOOP CHDSP CHPNT CRPRC LFPRC TABPRC FINDON CHLP1 CHLP2 CHLPRT IFF ICRLF PSTRT SETCR SETCR1 SETX SETLF2 SETLF SETY CNTPUT FINPAR FINPR0 FINPR1 COPYEL COPYPD GETFSZ PUTBLK PDCOPY MAKDD MAKDD1 MAKDD2 MAKDD3 MAKDD4 MAKDD8 MAKDD9 OSETUP OPUT1 OPUT OFORCE OFORC0 OFORC1 MKPDIR ADPDIR ADPDR2 PPDRB1 PPDIRB MKENTL ADENTL ADENT1 ADENT2 PUTEN1 PUTENT GETCHR GETCH1 PGRINI HDRINI HDRIN3 HDRIN4 HDRFIL HDRFL1 HDRPUT WRTHDR WRTHD1 HDRSET SCRCO2 SCRCOP
C00154 00021 H.EXPR Example EXPRESS
C00156 00022 H.FONT WIDFIL T.NAME T.WIDI FONTEX CNTOUT FONTS FONTS0 FONTSL FONTNS FNAME FONTAB FWIDI FWIDI2 FNONAM FNOSIZ FNOROT NOFIXX NOFIXY TYFNAM TYFNA2 DISCN2 DISCNT BGET BGET0 BGET2 BGET3 BGETWD BGT2WD FGTSWT FSWIT FSWTAB FSWTLN FSWDSP FSWNAM TERSET VERSET MEDSET FONTS FONTSL FONTSS FONTNL FONTNE FONTAB FONTNX FONTNS
C00173 00023 CHKPRS CHKPR1 CHKPR2 CHKPR3 CHKPR5 CHKPR6 CHKPR7 CHKPR8 PRBCPS PRBCP1 INFODD INFOPD INFPD1 CHKPSW
C00181 00024 H.DOVR Example DOVER DOVGO
C00184 00025 DVROPN SOCKIT TOME PUPCLS PUPPUT PUPPU1 PUPPU2 PUPPU3 SNDPUP OSEND REPWAT DLOOP DALLY DALLY1 BADTYP BADTY0 BADTY1 ABTPUP BADT1 BADLP BADT2 ERRPUP ABTDSP ABTDTN NOTSPL RBUSY SPAUSE SPAUS2 MDELAY SUPXMT PRTHST GETCHK GETCK1 CHKCHK PUTCHK ERR06 ERR07 ERR08 PUPOER PPOER1
C00201 00026 IFN FTNXP,< BEND PRESS > END START
C00204 ENDMK
C;
;FTNXP SAILSW
IFNDEF FTNXP,<FTNXP__0> ;FTNXP non-zero means we are subroutine of spooler (NXP.FAI)
FTNXP__FTNXP
IFNDEF TOPS20,<TOPS20==0> ;non-zero for TOPS-20 features
IFNDEF SAILSW,<SAILSW==1> ;non-zero for SAIL features
SAILSW__SAILSW ;must be available inside PRESS block (next page)
DEFINE SAIL <IFN SAILSW>
DEFINE NOSAIL <IFE SAILSW>
DEFINE T20 <IFN TOPS20>
DEFINE NOT20 <IFE TOPS20>
NOSAIL,<
OPDEF DSKPPN [GETPPN] ;Old form instead of GETPPN
OPDEF TTYSET [CAI] ;no-op for TTYSET (not JFCL since AC not 0)
OPDEF SHOWIT [CAI] ;no-op for SHOWIT
DEFINE ACCTIM (ZZZ)< ;Simulate ACCTIM UUO
PUSH P,[0] ;Room for date on stack
PUSH P,ZZZ+1 ;save: clobbered by divide
DATE ZZZ, ;TOPS-10 date
MOVEM ZZZ,-1(P) ;save on stack
TIME ZZZ, ;Time in ticks since midnight
DATE ZZZ+1, ;get date again
CAME ZZZ+1,-1(P) ;same as date before?
JRST .-4 ;no. try again to get date & time on same day
IDIVI ZZZ,74 ;convert to seconds
POP P,ZZZ+1 ;restore from stack after divide
HRL ZZZ,(P) ;date in the left
ADJSP P,-1 ;discard from stack.
>;ACCTIM
>;NOSAIL
;FL A B C D W X Y Z Q R S T PUP P PDLEN CMDBLN PRIMAX OCHAN ICHAN TCHAN CM%INV SCANON MRUNCM DIGSEN DOVSOK
IFN FTNXP,<
BEGIN PRESS
>;IFN FTNXP
IFE FTNXP,<
TITLE PRESS Press Utilities
>;IFE FTNXP
SUBTTL REG 11/29/80
EXTERN .JBDDT,.JBREL,.JBFF,.JBSYM,.JBSA,.JBOPC
FL==0
A=1
B=2
C=3
D=4
W=5
X=6
Y=7
Z=10
Q=11
R=12
S=13
T=14
PUP=15 ;contains address of pup for byte pointer and routines
P=17
IFE FTNXP,<K__Q> ;Q is one of our ACs, K is defined in NXP.
PDLEN==100
CMDBLN==30
^PRIMAX==200 ;number of page range entries allowed
IFE FTNXP,<
;I/O channels
OCHAN==1
ICHAN==2
TCHAN==3 ;temp channel
>;IFE FTNXP
;command flags
CM%INV==400000 ;invisible to help. no command message
;Flag register (FL)
;Right:
SCANON==1 ;on while doing a rescan
MRUNCM==2 ;set if rescanned command was a monitor RUN command
DIGSEN==4 ;set when a digit is seen in number scan
OPDEF CALL [PUSHJ P,]
OPDEF RET [POPJ P,]
OPDEF ADJBP [IBP]
IFE FTNXP,<
DOVSOK__DOVWAT__DOVBSY__DOVDLY__DOVSUS__DOVNOS__0 ;Unused symbols
>;IFE FTNXP
;IFBLK FBDEV FBNAM FBEXT FBPRT FBPPN FBDAT FBPRO FBSIZ FBLEN OFBLK PDLIST CMDBUF AMBIG RPGFLG SAVDEL QMODE PRIDX PRBUF NULLOK TBUFH IBUFH NIBUF IBUFAD OBUFH NOBUF OBUFAD OUTXCT RECEND BCPPTR BCPPTX BCPBYC OPOINT OCOUNT OBLOCK IPOINT ICOUNT IBLOCK ENTCNT ENTPNT ENTHED ENTTAI ENTFRE ELBYTC PDIRH PDIRT PDCNT PDPNT PDBYTC PDRECN PDRECL BYTNUM PSTART CURPOS CURY CURX EPAD NUMPAG PGIDX PGNUM SPGNUM HIPAGE LOPAGE LUSRNA USRMAX USRNAM PAGHED PAGNPT HDRPTR HDRCNT ENTAIL ENTLBC DEFSIZ RDFSIZ FDIR FDLEN ROTPTR FSZPTR FNTPTR PDBASE PDWRC PARTCN PAGECN FNTDCN UNKPCN FNTDAD RECNUM NEWPDA NUPARC PGARRY HEADFL ROTARG CPYCNT DDKEEP FNTSIZ PNTSIN MARUNT INCHWD PAGWID PAGHGT DEFWID DFTMAR DFLMAR DFBMAR DFXLIN RDFWID RDTMAR RDLMAR RDBMAR RDFLHT MAXWID TMAR BMAR LMAR LINHGT NLINES XLINES RTMAXX CHARSF TMARSF BMARSF LMARSF LINESF XLINSF DPAGE DDPASS DDRECT DDPART DDPDRN DDPDRC DDOBSL DDUNU1 DDUNU2 DDFCPY DDLCPY DDFNAM DDFCRE DDFDAT GENPAS DRMAX DATABL EOEP EOEPC EOFPC BCOUNT BPOINT NNAMES PNAMES FPREV FTYPMD
SUBTTL Storage
^IFBLK: PHASE 0 ;block for input file name
^FBDEV:: 0
^FBNAM:: 0
^FBEXT:: 0
FBPRT:: 0
^FBPPN:: 0
FBDAT:: 0 ;file date word (rh of ext word from LOOKUP)
FBPRO:: 0 ;file protection, mode, date, time word
FBSIZ:: 0 ;positive wc from LOOKUP
FBLEN==.
DEPHASE
OFBLK: BLOCK FBLEN ;block for output file name
IFE FTNXP,<
PDLIST: BLOCK PDLEN
CMDBUF: BLOCK CMDBLN
AMBIG: 0 ;flag for ambiguous cmd. Index to cmd
RPGFLG: 0 ;set if started+1
SAVDEL: 0 ;save delimiter
QMODE: 0 ;quote mode
>;IFE FTNXP
^PRIDX: 0 ;index to PRBUF
^PRBUF: BLOCK PRIMAX ;page range buffer
NULLOK: 0 ;nonzero flag if OK for TGET to return nulls
TBUFH: BLOCK 3 ;Temp buffer header
IBUFH: BLOCK 3 ;input buffer header
NIBUF__=19 ;optimum number of input buffers
IBUFAD: BLOCK NIBUF*203 ;input buffers are made here
OBUFH: BLOCK 3 ;output buffer header
NOBUF__=19 ;optimum number of input buffers
OBUFAD: BLOCK NOBUF*203 ;output buffers here
OUTXCT: 0 ;CALL PUTCHR or OUTCHR A
RECEND: 0 ;word address of end of page part
BCPPTR: 0 ;BCPPUT Initial Byte Pointer
BCPPTX: 0 ;BCPPUT Intermediate Byte Pointer
BCPBYC: 0 ;BCPPUT Byte Count
OPOINT: 0 ;Control count, pointer, & storage
OCOUNT: 0 ;for the OPUT routine
OBLOCK: BLOCK 200
IPOINT: 0 ;Control count, pointer, & storage
ICOUNT: 0 ;for the IGET routine
IBLOCK: BLOCK 200
ENTCNT: 0 ;count of bytes avail in current Ent blk
ENTPNT: 0 ;byte pointer to Entity block
ENTHED: 0 ;entity list header
ENTTAI: 0 ;entity list tail
ENTFRE: 0 ;entity free block list
ELBYTC: 0 ;Entity list byte count
PDIRH: 0 ;part directory list header
PDIRT: 0 ;part directory list tail
PDCNT: 0 ;16-bit words avail in current PD block
PDPNT: 0 ;byte pointer to Part Directory block
PDBYTC: 0 ;Part directory byte count
PDRECN: 0 ;number of records in Part Dir
PDRECL: 0 ;record number of first rec in PD
BYTNUM: 0 ;absolute byte number in output file
PSTART: 0 ;starting record number of current page
CURPOS: 0 ;Column number of last used column on this line
CURY: 0 ;Current Y value in MICAS
CURX: 0 ;Current X value in MICAS
EPAD: 0 ;number of words of entity pad
NUMPAG: 0 ;count of pages processed
PGIDX: 0 ;index to page count list
PGNUM: 0 ;page number of current input page
SPGNUM: 0 ;Sub-page number of current output page
HIPAGE: 0 ;High page number of current page range
LOPAGE: 0 ;Low page number of current page range
LUSRNA__20
^USRMAX__5*LUSRNA
^USRNAM:BLOCK LUSRNA ;room for 80 characters of user name string
PAGHED: BLOCK 24 ;room for the page heading for output files
PAGNPT: 0 ;pointer to PAGE string
HDRPTR: 0 ;pointer to PAGHED
HDRCNT: 0 ;count in PAGHED
;Entity Trailer
ENTAIL: BYTE(8)0,1(16)0 ;entity type 0; font set 1; Begin byte (MSB)
BYTE(16)0,0 ;Begin Byte (LSB). DL Byte Count(MSB)
BYTE(16)0,0 ;DL Byte Count (LSB). XE value (0).
BYTE(16)0,5667 ;YE value; LEFT value.
BYTE(16)60727,450 ;BOTTOM value; WIDTH value.
BYTE(16)0,0 ;HEIGHT value; Entity Length (Words)
ENTLBC==4*<.-ENTAIL> ;number of bytes in entity tail
DEFSIZ__10 ;Default font size
RDFSIZ__10 ;Default size of rotated font
;The FONT DIRECTORY
;The default font is defined in routine DEFFNT.
FDIR: BYTE(16)20(8)1,0 ;Entry Length; Font Set #; Font number.
byte(8)0,177,4,"S" ;M:0; N:177; BCPL String of byte 1,2
byte(8)"A","I","L",0 ;of family name (=20 bytes) byte 3,4,5,6
BYTE(8)0,0,0,0 ;more BCPL string. byte 7,8,9,10
BYTE(8)0,0,0,0 ;more string byte 11,12,13,14
BYTE(8)0,0,0,0 ;more string Byte 15,16,17,18
BYTE(8)0,0,0,0 ;end of string; FACE; SOURCE
byte(16)DEFSIZ,0 ;SIZE=8; Rotation = 0;
FDLEN==4*<.-FDIR> ;byte length of Font dir
ROTPTR: POINT 16,FDIR+7,31 ;byte pointer to rotation word in Font Dir
FSZPTR: POINT 16,FDIR+7,15 ;byte pointer to size word in Font Dir
^FNTPTR:POINT 8,FDIR+1,23 ;byte pointer used to deposit font name
PDBASE: 0 ;base address of part directory
PDWRC: 0 ;word count of part directory
PARTCN: 0 ;part count
PAGECN: 0 ;count of page parts
FNTDCN: 0 ;Count of font directory parts
UNKPCN: 0 ;count of parts (of type) unknown
FNTDAD: 0 ;address of Font Directory Block
RECNUM: 0 ;total count of output records
NEWPDA: 0 ;address of newly built Parts Directory
NUPARC: 0 ;New Parts Count
PGARRY: 0 ;Address of base of map: page # to Part blk
;Switches
^HEADFL:0 ;non-zero to make page headings
ROTARG: 0 ;rotation of font in degrees
^CPYCNT:0 ;count of copies for DOVER command
DDKEEP: 0 ;no-zero to keep old Doc Directory
^FNTSIZ:0 ;font size, if positive, else use default
PNTSIN__=72 ;standard number of points per inch
MARUNT__=1000 ;user gives margin units in thousandths of an inch
DEFINE UNTFX(A)<<=A*INCHWD>/MARUNT>> ;converts from thousandths of an inch to micas
INCHWD__=2540 ;number of units in an inch
PAGWID__<=17*INCHWD>/2 ;actual X position of righthand edge of paper: 8.5in
PAGHGT__<=11*INCHWD> ;actual Y position of top edge of paper: 11inches
DEFWID__=95 ;max chars per line in default setup
DFTMAR__UNTFX(1092) ;default top of page margin
DFLMAR__UNTFX(1070) ;default lefthand page margin
DFBMAR__UNTFX(950) ;default bottom of page margin
;;DFLHGT__UNTFX(133) ;default line height (NO LONGER MEANINGFUL!)
DFXLIN__UNTFX(20) ;default xlines value
;Rotated defaults
RDFWID__=132 ;default rotate width
RDTMAR__DFLMAR ;default rotated top margin
RDLMAR__DFBMAR ;default rotated left margin
RDBMAR__UNTFX(850) ;default rotate bottom margin
RDFLHT__UNTFX(115) ;default rotated line height
^MAXWID:0 ;max number of chars on a line
TMAR: 0 ;top of page margin
BMAR: 0 ;bottom of page margin
LMAR: 0 ;lefthand page margin
LINHGT: 0 ;line height (amount to advance on LF)
^NLINES:0 ;number of lines per page
XLINES: 0 ;special "interline spacing"
RTMAXX: 0 ;maximum X with /rotate
CHARSF: 0 ;nonzero if seen /charactersperline
TMARSF: 0 ;nonzero if seen /tmar
BMARSF: 0 ;nonzero if seen /bmar
LMARSF: 0 ;nonzero if seen /lmar
LINESF: 0 ;nonzero if seen /lheight
XLINSF: 0 ;nonzero if seen /xline
DPAGE: BLOCK 200 ;press file document directory page
DDPASS: POINT 16,DPAGE,15 ;document directory password
DDRECT: POINT 16,DPAGE,31 ;dd total record count
DDPART: POINT 16,DPAGE+1,15 ;dd total parts count
DDPDRN: POINT 16,DPAGE+1,31 ;dd record number of part directory
DDPDRC: POINT 16,DPAGE+2,15 ;dd record count of part directory
DDOBSL: POINT 16,DPAGE+2,31 ;dd obsolete word
DDUNU1: POINT 16,DPAGE+3,15 ;dd unused word
DDUNU2: POINT 16,DPAGE+3,31 ;dd unused word
DDFCPY: POINT 16,DPAGE+4,15 ;dd first copy number
DDLCPY: POINT 16,DPAGE+4,31 ;dd last copy number
DDFNAM: POINT 8,DPAGE+100 ;initial byte of file name
DDFCRE: POINT 8,DPAGE+115 ;initial byte of creator
DDFDAT: POINT 8,DPAGE+125 ;initial byte of date string
GENPAS== =27183 ;press file general password
DRMAX== =30 ;maximum number of data records to read at once.
DATABL: BLOCK 203*DRMAX ;Also used as a temp buffer (203 not 200)
EOEP: 0 ;P saved for restoration upon end of entry in BGET
EOEPC: 0 ;PC to use upon end of entry in BGET
EOFPC: 0 ;PC to use upon end of file in BGET
BCOUNT: 0 ;byte count for reading a byte string
BPOINT: 0 ;byte pointer for reading byte string
NNAMES__100 ;max number of name pointers we can hold
PNAMES: BLOCK NNAMES ;index pointers to font names in FONTS.WID
FPREV: 0 ;index of previously typed out font
FTYPMD: -1 ;mode of font name typing. -1 terse, 0 medium, 1 verbose.
;Cells for the TYPE command
PPORG: 0 ;type command. Origin of current printing part
PPWC: 0 ;type command. 16-bit word count of printing part
ENTORG: 0 ;Origin of Entity list entries in TYPE
ENTTOP: 0 ;Address (beyond) entity list entries in TYPE
ENTNUM: 0 ;Entity number for type
ELPTR: 0 ;Entity list byte pointer
DLPTR: 0 ;Data list byte pointer
DLCNT: 0
ELCNT: 0
;EFSOCK ENHADR DVRHST .PTEDA .PTEAK .PTEEN .PTEAB .PTERR pupmsg pupout PUPLEN PUPTRN PUPTYP PUPID PUPDHN PUPDNT PUPDHS PUPDS1 PUPDS2 PUPSHN PUPSNT PUPSHS PUPSSK PUPDAT PUPBDT PUPBL LSOCK FSOCK HOST PREVID NOACK MTADR MTSTAT IRECNM CLSXCT PUTXCT PUPIOW
SUBTTL Storage and Definitions for DOVER/EFTP
EFSOCK==20 ;Well-known socket for EFTP receive
ENHADR==302 ;Our host number
DVRHST==201 ;Dover host number
.PTEDA==30 ;PUP type for EFTP Data
.PTEAK==31 ;EFTP Ack
.PTEEN==32 ;EFTP End
.PTEAB==33 ;EFTP Abort
.PTERR==4 ;PUP Error
pupmsg: 0 ;byte(8)dest,source(16)1000
0 ;BYTE(16)PUPLENGTH(8)TCTL,PUPTYPE
0 ;byte(16)pupident1,pupident2
0 ;byte(8)destnet,desthost(16)destsoc1
0 ;byte(16)destsock2(8)srcnet,srchost
0 ;byte(16)srcsock1,srcsock2
block =134 ;rest of pup
pupout: 0 ;Ethernet header slot
block 1 ;fill in len,type
block 1 ;fill in ID here
block 1 ;fill in dest net,host, sock1
byte (16) 0 (8) 0,enhadr ;fill in destsock2,our net address
block 1 ;fill in our socket number
block =134 ;rest of pup
;Pointers to pup fields for LDB and DPB into pup pointed to by ac PUP
PUPLEN: POINT 16,1(PUP),15 ; Pup length
PUPTRN: POINT 8,1(PUP),23 ; transport control
PUPTYP: POINT 8,1(PUP),31 ; Pup type
PUPID: POINT 32,2(PUP),31 ; Pup identifier
PUPDHN: POINT 16,3(PUP),15 ; destination network/host
PUPDNT: POINT 8,3(PUP),7 ; destination network
PUPDHS: POINT 8,3(PUP),15 ; destination host
PUPDS1: POINT 16,3(PUP),31 ; destination socket (first part)
PUPDS2: POINT 16,4(PUP),15 ; destination socket (second part)
PUPSHN: POINT 16,4(PUP),31 ; source network/host
PUPSNT: POINT 8,4(PUP),23 ; source network
PUPSHS: POINT 8,4(PUP),31 ; source host
PUPSSK: POINT 32,5(PUP),31 ; source socket
PUPDAT: POINT 8,6(PUP) ;pointer to 8-bit bytes in data.
PUPBDT: point 32,6(PUP) ;pointer to 32-bit bytes.
PUPBL: ;LOOKUP block for pup channel
LSOCK: 0 ;local socket
FSOCK: 0 ;foreign socket
HOST: 0 ;foreign host
PREVID: 0 ;remember ID to check sequencing
NOACK: 0 ;Timeout counter
MTADR: 4 ;Block for MTAPE SKIP IF INPUT PRESENT
MTSTAT: 0 ;status info returned here (not really????)
IRECNM: 0
CLSXCT: 0 ;XCT to CLOSE OUTPUT. CALL PUPCLS or CLOSE OCHAN,
PUTXCT: 0 ;XCT to do OUTPUT. CALL PUPPUT or OUTPUT OCHAN,A
PUPIOW: 0 ;cell for PUPPUT routine
;START RESTAR CMDGO START1
SUBTTL Initialization
IFE FTNXP,<
START: TDZA A,A
MOVNI A,1
MOVEM A,RPGFLG
RESET
SETZ FL, ;Zero all the flags
MOVE P,[IOWD PDLEN,PDLIST] ;setup a stack
CALL USRINI ;convert PPN to user's name
;change to repeat 1 if the program is put up on [1,3] with monitor dispatch
repeat 1,<
TTCALL 10, ;Rescan for command line
TRO FL,SCANON ;Mark we are doing a rescan
>
JRST START1 ;continue
RESTAR: CLRBFI ;restart: clear typeahead
TRNN FL,MRUNCM ;Was this a monitor command?
TRNN FL,SCANON ;No: a real command. Are we Rescanning?
TDZA FL,FL ;Do another command. Clear flags
EXIT ;Exit after one REAL RESCANNED command
CMDGO: TRZ FL,MRUNCM!SCANON ;Clear monitor run command
START1: MOVE P,[IOWD PDLEN,PDLIST] ;setup a stack
CALL GETCMD ;Read a command from the TTY
TRNN FL,MRUNCM ;Was this a monitor command?
TRNN FL,SCANON ;No: a real command. Are we Rescanning?
JRST CMDGO ;No rescan or a Run Command. Do another
EXIT ;Exit after one REAL RESCANNED command
>;IFE FTNXP
;CPARSE CPARS0 PARSE1 PARSE2 GETPRG GETPR0 GETPR1 GETPR2 GETNUM GETNM1 GETSWT SWTAB SWTLN SWDISP SWNAM HEADST HEADCL COPSET SIZSET CHARST NLINST XLINST KEEPST FONTST FONTS1 FONTSX FONTS2 GTSARG GTSARG TMARST BMARST BMARS0 LMARST LINEST UNITFX CPAINI DEFFNT DEFFN2 DEFFN3 ROTSET MARADJ MARAD2 MARAD3 MARAD4
SUBTTL CPARSE Command Arguments Parse
IFE FTNXP,<
;Called from any command. This routine expects to see the standard command
;format: output_input(pages)
;
;Alternates:
; accepts simply the input portion unless the first file name ends with _
;
CPARSE: CALL CPARS0 ;do the parsing
CALL MARADJ ;do adjustments now that we have all margins
JRST DUPMAR ;can't say both /nlines and /lheight!
RET
CPARS0: JUMPE A,MISARG ;jump if end of line already seen
CALL CPAINI ;set up all the defaults
MOVEI R,OFBLK ;setup for an output name
CALL GETFIL ;get a file name
JUMPN B,NOPARS ;not good file name.
MOVEI R,IFBLK ;(next will be the input name)
CAIE A,"_" ;output name delim follows?
CAIN A,"="
JRST PARSE1 ;yes. Get second name
MOVE B,[OFBLK,,IFBLK] ;single file name must be input name
BLT B,IFBLK+FBLEN-1 ;so copy it to the input block
SETZM OFBLK ;discard output extension (use default)
MOVE B,[OFBLK,,OFBLK+1]
BLT B,OFBLK+FBLEN-1
MOVSI B,'DSK'
MOVEM B,OFBLK+FBDEV ;set output device to DSK
JRST PARSE2
PARSE1: CALL GETFIL ;get input name (R=IFBLK)
JUMPN B,NOPARS ;test for losing.
PARSE2: HLRZ B,IFBLK+FBEXT ;get input file's extension
CAIN B,'LST' ;.LST means that
SETZM HEADFL ; default is /NOHEAD
SETZB B,PRIDX ;no entries in the page range table.
CAIN A,"(" ;is ending delimiter a page range?
CALL GETPRG ;yes. get page range
JUMPN B,NOPARS ;dangling stuff at end.
CAIN A,"/" ;switches present?
CALL GETSWT ;read switches
JUMPN A,NOPARS ;at end, no parse unless eof
RET
GETPRG: CALL GETNUM ;read a number. Result in B, delim in A
TRNN FL,DIGSEN ;digit seen?
JRST GETPR1 ;no number. check for *
SKIPN B ;page zero means page 1
MOVEI B,1
AOS C,PRIDX
CAILE C,PRIMAX
JRST PRBFUL ;page range buffer full
HRLZM B,PRBUF-1(C)
CAIN A,":"
CALL GETNUM
MOVE C,PRIDX
TRNN FL,DIGSEN
JRST GETPR2 ;no number. check for *.
SKIPN B ;page zero means page 1
MOVEI B,1
HRRM B,PRBUF-1(C)
GETPR0: CAIN A,","
JRST GETPRG
MOVEI B,0
CAIE A,")"
JRST NOPARS
CALL GETSIX ;get next term.
RET
GETPR1: CAIE A,"*"
JRST NOPARS ;lose if not *
AOS C,PRIDX
CAILE C,PRIMAX
JRST PRBFUL ;page range buffer full
SETOM B,PRBUF-1(C)
ILDB A,Q
JRST GETPR0 ;check for valid delimiter
GETPR2: CAIE A,"*"
JRST NOPARS ;no parse if not *
HLLOS PRBUF-1(C)
ILDB A,Q
JRST GETPR0
GETNUM: MOVEI B,0
TRZ FL,DIGSEN
GETNM1: ILDB A,Q
CAIL A,"0"
CAILE A,"9"
RET
IMULI B,12
ADDI B,-"0"(A)
TRO FL,DIGSEN
JRST GETNM1
GETSWT: CALL GETSIX ;get a sixbit switch name & delim.
MOVE C,[-SWTLN,,SWTAB]
CALL TBLUK ;perform table lookup
SKIPL C
SUBI C,SWTAB
HRRZ C,SWDISP(C)
CALL (C)
CAIN A,"/" ;more switches?
JRST GETSWT ;yes: do that too.
RET
;NOTE: Switch handing routines must return A unchanged, or as the next character
DEFINE SWLST<
SWMAC(HEADER,HEADST)
SWMAC(NOHEADER,HEADCL)
SWMAC(ROTATE,ROTSET)
SWMAC(COPIES,COPSET)
SWMAC(REPEAT,COPSET)
SWMAC(KEEP,KEEPST)
SWMAC(FSIZE,SIZSET) ;Font size
SWMAC(NCHARS,CHARST)
SWMAC(TMARGIN,TMARST)
SWMAC(BMARGIN,BMARST)
SWMAC(LMARGIN,LMARST)
SWMAC(LHEIGHT,LINEST)
SWMAC(NLINES,NLINST) ;number of lines per page
SWMAC(XLINES,XLINST) ;special interline spacing
SWMAC(FONT,FONTST)
>
DEFINE SWMAC(NAME,DISP) <<SIXBIT/NAME/>>
SWTAB: SWLST
SWTLN==.-SWTAB
DEFINE SWMAC(NAME,DISP) <0,,DISP>
ILLSWT ;unknown switch
AMBIGS ;ambiguous switch
SWDISP: SWLST
DEFINE SWMAC(NAME,DISP) <[ASCIZ/NAME
/]>
SWNAM: SWLST
HEADST: SETOM HEADFL
RET
HEADCL: SETZM HEADFL
RET
COPSET: CALL GTSARG ;get switch argument (numeric)
MOVEM B,CPYCNT ;Copy count
RET
SIZSET: CALL GTSARG ;get switch argument (numeric)
MOVEM B,FNTSIZ ;Font size
RET
CHARST: CALL GTSARG ;get switch argument (numeric)
MOVEM B,MAXWID ;max chars per line
SETOM CHARSF ;flag that this parameter was set
RET
NLINST: CALL GTSARG ;get switch argument (numeric)
MOVEM B,NLINES ;max lines per page
RET
KEEPST: SETOM DDKEEP ;Preserve Document Directory
RET
FONTST: CAIE A,":"
CAIN A,"="
JRST .+2
JRST ILSWAR ;ill-formed switch argument
MOVSI C,-=20 ;max length of name, counting length byte
MOVE B,FNTPTR ;byte ptr for storing name
FONTS1: ILDB A,Q ;next char
CAIL A,"a"
CAILE A,"z"
CAIA
TRZ A,40 ;Make upper case
CAIL A,"A"
CAILE A,"Z"
CAIA
JRST FONTS2 ;letters are only valid chars in font name
AOBJP C,FONTSX ;not valid char in font name, assume end of name
PUSH P,A
MOVEI A,0 ;fill out name with nulls
IDPB A,B
AOBJN C,.-1
POP P,A
MOVEI B,0 ;now maybe collect size of font
FONTSX: CAIL A,"0"
CAILE A,"9"
RET
IMULI B,=10 ;previous digit total
ADDI B,-"0"(A) ;add in new digit
MOVEM B,FNTSIZ ;store size (so far)
ILDB A,Q ;next char of command
JRST FONTSX
;Here with char of font name
FONTS2: AOBJP C,FONTS1 ;ignore chars beyond max length
IDPB A,B ;store char of name
DPB C,FNTPTR ;Store length (so far) of font name
JRST FONTS1
GTSARG: CAIE A,":"
CAIN A,"="
JRST .+2
JRST ILSWAR ;ill-formed switch argument
CALL GETNUM ;get a number
TRNN FL,DIGSEN
JRST SWNMRQ ;number required
RET
>;IFE FTNXP
IFN FTNXP,<
GTSARG: PUSH P,B ;Save AC
MOVE B,-2(P) ;Get return address of caller (address in NXP)
PUSH P,-2(B) ;push instr preceding call
MOVE B,-1(P) ;restore AC, may have arg in it
MOVE B,@(P) ;pick up arg, pointed to by instr before call
SUB P,[1,,1] ;flush instr from stack
CALL @-1(P) ;call caller
POP P,B ;restore AC
SUB P,[1,,1] ;flush return to caller
RET ;and return to caller's caller
>;IFN FTNXP
^XLINST:CALL GTSARG ;get switch argument (numeric)
CALL UNITFX ;adjust units to internal form
MOVEM B,XLINES ;extra amount of interline spacing
SETOM XLINSF ;flag that this parameter was set
RET
^TMARST:CALL GTSARG ;get switch argument (numeric)
CALL UNITFX ;adjust units to internal form
MOVEM B,TMAR ;top of page margin
SETOM TMARSF ;flag that this parameter was set
RET
^BMARST:CALL GTSARG ;get switch argument (numeric)
CALL UNITFX ;adjust units to internal form
BMARS0: MOVEM B,BMAR ;bottom of page margin
MOVN B,B ;now figure same for rotated version
ADDI B,PAGWID ;actual page width less margin is max X
MOVEM B,RTMAXX ;store max X for rotated version
SETOM BMARSF ;flag that this parameter was set
RET
^LMARST:CALL GTSARG ;get switch argument (numeric)
CALL UNITFX ;adjust units to internal form
MOVEM B,LMAR ;save lefthand margin
SETOM LMARSF ;flag that this parameter was set
RET
^LINEST:CALL GTSARG ;get switch argument (numeric)
CALL UNITFX ;adjust units to internal form
MOVEM B,LINHGT ;store distance between consecutive lines
SETOM LINESF ;flag that this parameter was set
RET
UNITFX: PUSH P,B+1
IMULI B,INCHWD ;Convert from thousandths of inches
IDIVI B,=1000 ;to micas(?) (standard unit)
POP P,B+1
RET
;Initialize parameters for CPARSE.
^CPAINI:SETOM HEADFL ;default: headings
SETZM ROTARG ;rotation of font
SETZM CPYCNT ;copy count
SETZM DDKEEP ;Don't keep an old Doc Directory
SETZM FNTSIZ ;use default font size
SETZM CHARSF ;no /charactersperline seen
SETZM TMARSF ;no /tmar seen
SETZM BMARSF ;no /bmar seen
SETZM LMARSF ;no /lmar seen
SETZM LINESF ;no /lheight seen
SETZM NLINES ;no /nlines seen
SETZM XLINSF ;no /xline seen
MOVEI R,DEFWID
MOVEM R,MAXWID ;setup default line width in chars
MOVEI R,DFTMAR
MOVEM R,TMAR ;setup default top of page margin
MOVEI R,DFLMAR
MOVEM R,LMAR ;setup default lefthand page margin
MOVEI R,DFBMAR
MOVEM R,BMAR ;setup default bottom of page margin
;; MOVEI R,DFLHGT ;Default line height
;; MOVEM R,LINHGT ;Regular line height
CALL DEFFNT ;set default font name into FDIR
RET
;Routine to set up the default font name
DEFFNT: MOVE B,FNTPTR ;setup default font
MOVSI C,-=20+1 ;max length of font name, less length byte
MOVE R,[POINT 7,[ASCIZ/SAIL/]] ;this is the default font name
DEFFN2: ILDB A,R
JUMPE A,DEFFN3
IDPB A,B
AOBJN C,DEFFN2
DPB C,FNTPTR ;store length of name
RET ;name limit reached, all done
DEFFN3: DPB C,FNTPTR ;store length of name
MOVEI A,0 ;fill out name will nulls
IDPB A,B
AOBJN C,.-1
RET
^ROTSET:MOVEI B,=90*=60
MOVEM B,ROTARG
; MOVEI B,RDFSIZ ;Set up default font size for rotation
; SKIPG FNTSIZ ;unless explicit size set
; MOVEM B,FNTSIZ
MOVEI B,RDFWID ;Set up default width for rotation
SKIPN CHARSF ;unless explicit width set
MOVEM B,MAXWID
MOVEI B,RDTMAR ;Set up default top margin for rotation
SKIPN TMARSF ;unless explicit size set
MOVEM B,TMAR ;set initial X
MOVEI B,RDBMAR ;Set up default bottom margin for rotation
SKIPN BMARSF ;unless explicit size set
PUSHJ P,BMARS0 ;set bottom margin
MOVEI B,RDLMAR ;Set up default left margin for rotation
SKIPN LMARSF ;unless explicit size set
MOVEM B,LMAR ;set initial Y
MOVEI B,RDFLHT ;Set up default line height for rotation
SKIPN LINESF ;unless explicit height set
MOVEM B,LINHGT
RET
;Here after reading all margins. Set up line height according to number of
;lines user wants to get on the page, if specified.
;Skips unless both /nlines and /lheight were given.
^MARADJ:SKIPG NLINES ;user specify number of lines?
JRST MARAD2 ;no
PUSH P,A
MOVE A,NLINES ;number of lines per page
SUBI A,1 ;number of gaps (between lines) per page is one less
MOVEM A,LINHGT ;set divisor of great divide
MOVEI A,PAGHGT ;page height
SKIPE ROTARG ;rotated page?
MOVEI A,PAGWID ;yes, then this is really max height of text
SUB A,TMAR ;no text in top margin
SUB A,BMAR ;no text in bottom margin
IDIVM A,LINHGT ;text area/gapcount = lheight
SKIPN LINHGT ;if user asked for one line/page, then this is zero
HLLOS LINHGT ; so set it big to force next line to next page!
POP P,A
SKIPN LINESF ;if user already gave /lheight, this is error
SKIPE XLINSF ;or if use gave /xline, this is error
RET ;error (but continue if we're spooler)
JRST CPOPJ1 ;success
MARAD2: SKIPN XLINSF ;interline spacing specified /xlines=?
JRST MARAD3 ;no
SKIPE LINESF ;yes, /lheight given too?
RET ;yes, error (use /lheight if we're spooler)
PUSH P,A ;save AC
MOVE A,XLINES ;interline spacing arg
JRST MARAD4
MARAD3: SKIPE LINESF ;explicit /lheight given?
JRST CPOPJ1 ;yes, use it
SKIPE ROTARG ;rotated?
SKIPLE FNTSIZ ;yes, explicit font size?
CAIA ;normal spacing algorithm
JRST CPOPJ1 ;rotated default is special to fit lineprinter format
PUSH P,A ;save AC
MOVEI A,DFXLIN ;default XLINE
MARAD4: PUSH P,B ;save another AC
PUSH P,A ;save XLINES setting
CALL GETFSZ ;get font size into A
IMULI A,INCHWD ;convert to micas
IDIVI A,PNTSIN ;72 points per inch standard gives basic spacing
ADDM A,(P) ;adjust basic spacing by XLINES
POP P,LINHGT ;store final result
POP P,B
POP P,A
JRST CPOPJ1 ;success
;ILLPPN NOPARS ILLSIX NOPAR1 NOPAR2 NOPAR3 MISARG DUPMAR PRBFUL AMBIGS ILLSWT ILSWAR SWNMRQ SWAOOB NSDERR NOIFL0 NOIFIL NOOFIL NOONAM BADPRS ERRPC NOCORE INERR NOTIMP
SUBTTL Error handling
IFE FTNXP,<
;PARSING ERRORS
ILLPPN: OUTSTR [ASCIZ/Illegal PPN specificiation ... /]
JRST NOPAR1
NOPARS: OUTSTR [ASCIZ/Command Error: Can't make sense of ... /]
JUMPE B,NOPAR1
ILLSIX: PUSH P,A
CALL OUTSET ;print on tty
CALL PUTSIX
POP P,A
NOPAR1: JUMPE A,NOPAR3 ;jump if already reached end of cmd
OUTCHR [12] ;show where scan failed
NOPAR2: OUTCHR A
ILDB A,Q
JUMPN A,NOPAR2
NOPAR3: OUTSTR CRLF
JSP K,RESTAR
MISARG: OUTSTR [ASCIZ/This command needs a file name argument that you must supply.
/]
JSP K,RESTAR
DUPMAR: OUTSTR [ASCIZ \Can't use more than one of /NLINES, /LHEIGHT, and /XLINES.
\]
JSP K,RESTAR
PRBFUL: OUTSTR [ASCIZ/Too many Page Range terms. Buffer overflow.
Specify a smaller number of different ranges, or rebuild this program.
/]
JRST NOPAR1
AMBIGS: OUTSTR [ASCIZ/Ambiguous Switch name: /]
JRST ILLSIX
ILLSWT: OUTSTR [ASCIZ/Unknown Switch name: /]
JRST ILLSIX
ILSWAR: OUTSTR [ASCIZ/Ill-formed switch argument; "=" required. Switch: /]
JRST ILLSIX
SWNMRQ: OUTSTR [ASCIZ/Ill-formed switch argument; number required... /]
JRST NOPAR1
SWAOOB: OUTSTR [ASCIZ/Numeric switch argument out of bounds. /]
CALL OUTSET
MOVE A,B
CALL PRDEC
JRST NOPAR1
>;IFE FTNXP
;RUNTIME ERRORS
NSDERR: OUTSTR [NSDMSG: ASCIZ/No such device (or device unavailable): /]
MOVE B,FBDEV(R)
CALL OUTSET ;print on tty
CALL PUTSIX
OUTSTR CRLF
IFN FTNXP,<
MOVEI B,NSDMSG
MOVEM B,DOVERR
>;IFN FTNXP
JSP K,RESTAR
NOIFL0: SETZM IFBLK+FBEXT
NOIFIL: OUTSTR [NOIMSG: ASCIZ/Can't find file. /]
CALL OUTSET ;print on tty
CALL PUTFIL
OUTSTR CRLF
IFN FTNXP,<
MOVEI B,NOIMSG
MOVEM B,DOVERR
>;IFN FTNXP
JSP K,RESTAR
NOOFIL: OUTSTR [ASCIZ/Can't Enter file. /]
CALL OUTSET ;print on tty
CALL PUTFIL
OUTSTR CRLF
JSP K,RESTAR
NOONAM: OUTSTR [ASCIZ/No output name was specified
/]
JSP K,RESTAR
BADPRS: OUTSTR [BADMSG: ASCIZ/Input file is not a properly-formed press file. /]
OUTSTR CRLF
OUTSTR @(T) ;message follows
OUTSTR CRLF
IFN FTNXP,<
MOVEI B,BADMSG
MOVEM B,DOVERR
>;IFN FTNXP
ERRPC: OUTSTR [ASCIZ/Called from /]
CALL OUTSET ;print on tty
MOVE A,T
CALL PROCT
OUTSTR CRLF
JSP K,RESTAR
NOCORE: OUTSTR [ASCIZ/Attempt to allocate more core has failed
/]
JRST ERRPC
INERR: OUTSTR [INEMSG: ASCIZ/File Input Error. /]
OUTSTR CRLF
IFN FTNXP,<
MOVEI B,INEMSG
MOVEM B,DOVERR
JSP K,RESTAR ;Don't halt the spooler!
>;IFN FTNXP
HALT .+1
JSP K,RESTAR
NOTIMP: OUTSTR [ASCIZ/Not implemented
/]
RET
;OUTSET BCPSET BCPPUT BCPFIN GETLIN GETLN1 GETLNX PUTSIX PUTFIL PUTFL1 PUTFL2 LADJ PROCT PROCT1 PROCTR PROCTB PROCT6 PROT60 PROT6A PROT6B PROT6C PRDECT PRDEC PRDEC0 PRDEC1 PUTSTR PUTST1 PUTCHR TYDATE TYTIME TYTIM2 MONTAB PSHACS
SUBTTL UTILITIES
OUTSET: PUSH P,[OUTCHR A] ;normal output instr (to TTY)
POP P,OUTXCT
RET
BCPSET: MOVEM A,BCPPTR
MOVEM A,BCPPTX
SETZB A,BCPBYC
IDPB A,BCPPTX
MOVE A,[CALL BCPPUT]
MOVEM A,OUTXCT
RET
BCPPUT: IDPB A,BCPPTX
AOS BCPBYC
RET
BCPFIN: MOVE A,BCPBYC
IDPB A,BCPPTR
JRST OUTSET
;Get one line from terminal. Call with Q=pointer to buffer of size CMDBLN
;Places uppercase text in the line buffer. Buffer ends with null.
GETLIN: MOVEI B,CMDBLN*5-1
GETLN1: INCHWL A
ANDI A,177 ;no bucky bits
CAIN A,15
JRST GETLN1
CAIE A,12
CAIN A,175
JRST GETLNX
CAIL A,"a"
CAILE A,"z"
JRST .+2
TRZ A,40 ;uppercase
SOSL B
IDPB A,Q
JRST GETLN1
GETLNX: MOVEI A,0
IDPB A,Q
RET
;Write Sixbit name in B to terminal
PUTSIX: JUMPE B,CPOPJ
MOVEI A,0
LSHC A,6
ADDI A," "
XCT OUTXCT
JRST PUTSIX
PUTFIL: MOVE B,FBDEV(R)
CAMN B,['DSK ']
JRST PUTFL1
CALL PUTSIX
MOVEI A,":"
XCT OUTXCT
PUTFL1: MOVE B,FBNAM(R)
CALL PUTSIX
HLLZ B,FBEXT(R)
JUMPE B,PUTFL2
MOVEI A,"."
XCT OUTXCT
CALL PUTSIX
PUTFL2: SKIPN B,FBPPN(R)
RET
MOVEI A,"["
XCT OUTXCT
HLLZ B,FBPPN(R)
CALL LADJ
CALL PUTSIX
MOVEI A,","
XCT OUTXCT
HRLZ B,FBPPN(R)
CALL LADJ
CALL PUTSIX
MOVEI A,"]"
XCT OUTXCT
RET
LADJ: TLNE B,770000
RET
LSH B,6
JUMPN B,LADJ
RET
PROCT: PUSH P,B ;preserve B
PUSH P,A
HLRZ A,(P)
JUMPE A,PROCT1
CALL PROCTR
MOVEI B,[ASCIZ/,,/]
CALL PUTSTR
PROCT1: HRRZ A,(P)
CALL PROCTR
POP P,(P)
POP P,B
RET
PROCTR: IDIVI A,10
PUSH P,B
SKIPE A
CALL PROCTR
POP P,A
ADDI A,"0"
XCT OUTXCT
RET
PROCTB: PUSH P,B ;print octal (32 bits) in 12 places
PUSH P,C
MOVEI C,14
JRST PROT60
PROCT6: PUSH P,B
PUSH P,C
MOVEI C,6
PROT60: CALL PROT6A
POP P,C
POP P,B
RET
PROT6A: IDIVI A,10
PUSH P,B
SUBI C,1
JUMPE A,PROT6C
CALL PROT6A
PROT6B: POP P,A
ADDI A,"0"
XCT OUTXCT
RET
PROT6C: JUMPLE C,PROT6B
MOVEI A," "
XCT OUTXCT
SOJA C,PROT6C
PRDECT: CALL PRDEC ;print decimal with a tab
MOVEI A,11
XCT OUTXCT
RET
PRDEC: JUMPGE A,PRDEC0
PUSH P,A
MOVEI A,"-"
XCT OUTXCT
POP P,A
MOVN A,A
PRDEC0: PUSH P,B ;preserve B
CALL PRDEC1
POP P,B ;restore AC
RET
PRDEC1: IDIVI A,12
PUSH P,B
SKIPE A
CALL PRDEC1
POP P,A
ADDI A,"0"
XCT OUTXCT
RET
PUTSTR: HRLI B,440700 ;output string to whatever
PUTST1: ILDB A,B
JUMPE A,CPOPJ
XCT OUTXCT
JRST PUTST1
PUTCHR: SOSG OBUFH+2 ;output character in A to file
OUTPUT OCHAN,
IDPB A,OBUFH+1
RET
;Type a Date, Given a Date in A
TYDATE: IDIVI A,=31 ;get day of month
ADDI B,1
PUSH P,B ;save Day of month
IDIVI A,=12 ;get month and year
PUSH P,B ;save month
ADDI A,=1964
EXCH A,-1(P) ;Year to stack, day into A
CALL PRDEC ;print day of month in decimal
MOVEI A," "
XCT OUTXCT
POP P,B
MOVEI B,MONTAB(B) ;address of month string
CALL PUTSTR
MOVEI A," "
XCT OUTXCT
POP P,A
CALL PRDEC
RET
;Type the time, given minutes since midnight in A
TYTIME: IDIVI A,=60 ;Hours in A, Minutes in B
PUSH P,B ;save minutes
CAIL A,=10
JRST TYTIM2
PUSH P,A
MOVEI A,"0"
XCT OUTXCT ;force hours to have two digits
POP P,A
TYTIM2: CALL PRDEC
MOVEI A,":"
XCT OUTXCT
MOVE B,(P) ;minutes
MOVEI A,"0"
CAIGE B,=10
XCT OUTXCT
POP P,A
CALL PRDEC
RET
MONTAB: ASCII /Jan/
ASCII /Feb/
ASCII /Mar/
ASCII /Apr/
ASCII /May/
ASCII /Jun/
ASCII /Jul/
ASCII /Aug/
ASCII /Sep/
ASCII /Oct/
ASCII /Nov/
ASCII /Dec/
PSHACS: ADJSP P,17 ;Room for ACs 0:16
MOVEM 16,0(P) ;Save 16
MOVEI 16,-16(P) ;Destination of BLT. Source is zero
BLT 16,-1(P) ;Save AC's on stack
CALL @-17(P) ;return to caller
SKIPA ;non-skip return
AOS -20(P) ;skip to caller's caller
MOVSI 16,-16(P) ;Restore ACs from the stack
BLT 16,16
ADJSP P,-20 ;pop garbage, including caller's address
RET
;USRINI USRIN1 USRIN2 USRIN3 USRIN4 USRLRT USRIN5 TGET TGET1 TOPEN TOPEND USRFIL SPLPPN
SUBTTL Read file of user names
IFE FTNXP,<
USRINI: GETPPN B, ;Get PPN
JFCL
HRLZ B,B ;Programmer name only
CALL LADJ ;Left adjust it in the word
PUSH P,OUTXCT ;save prevailing output instr
MOVE D,[IDPB A,D]
MOVEM D,OUTXCT
MOVE D,[POINT 7,USRNAM]
CALL PUTSIX ;convert sixbit to ASCII string in USRNAM
MOVEI A,0 ;end string with null
XCT OUTXCT
POP P,OUTXCT
MOVE D,[USRFIL,,A]
CALL TOPEN ;Open USRFIL on TCHAN
JRST USRLRT ;release & return, INIT or LOOKUP failed
SETZM NULLOK ;make TGET ignore nulls
USRIN1: MOVE C,[POINT 7,USRNAM]
USRIN2: CALL TGET ;get a character
JRST USRLRT ;none there. release and return
ILDB B,C ;get a byte
CAMN A,B
JRST USRIN2 ;loop in search
JUMPN B,USRIN5 ;failed
CAIE A,11 ;Tab ends PPN text
JRST USRIN5 ;failed to match
MOVE C,[POINT 7,USRNAM] ;Matches. Copy name to USRNAM
USRIN3: CALL TGET
JRST USRIN4 ;make end of line
CAIE A,15
CAIN A,12
USRIN4: MOVEI A,0 ;add null to end string
IDPB A,C
JUMPN A,USRIN3 ;loop if there's more of user's name
USRLRT: RELEAS TCHAN,
RET
USRIN5: CALL TGET ;failed to match. Flush thru LF
JRST USRLRT ;eof
CAIE A,12
JRST USRIN5
JRST USRIN1 ;try next line
TGET: SOSLE TBUFH+2 ;decrement buffer byte count
JRST TGET1
INPUT TCHAN, ;Get another buffer.
STATZ TCHAN,760000 ;test error flags and eof
RET ;EOF or error - no skip return
TGET1: ILDB A,TBUFH+1 ;get a byte from the buffer
SKIPN NULLOK ;Skip if nulls are OK to return
JUMPE A,TGET ;discard zeros
AOS (P) ;success return
RET
;Open file pointed to by LH of D on channel TCHAN. RH(D) must contain A.
;Skips on success, direct return if INIT or LOOKUP fails. Sets up buffers.
TOPEN: INIT TCHAN,0
'DSK '
0,,TBUFH
RET
BLT D,D
LOOKUP TCHAN,A
RET ;release & return
MOVEI A,DATABL
EXCH A,.JBFF
INBUF TCHAN,DRMAX
MOVEM A,.JBFF
JRST CPOPJ1
;Open file pointed to by LH of D on channel TCHAN. RH(D) must contain A.
;Opens files in Dump mode, and returns length of file in D.
;Skips on success, direct return if INIT or LOOKUP fails.
TOPEND: INIT TCHAN,17 ;dump mode
'DSK '
0
RET
BLT D,D
LOOKUP TCHAN,A
RET ;failure return
MOVS D,D ;unswap file length
NOSAIL,<
SKIPL D
LSH D,7 ;convert positive block count to wc
>;NOSAIL
MOVM D,D ;return positive length
JRST CPOPJ1
USRFIL: 'FACT '
'TXT',,
0
SPLPPN: 'SPLSYS'
>;IFE FTNXP
;GETFIL GETFL1 GETFL2 RADJ GETFLM
SUBTTL GETFIL
IFE FTNXP,<
;Get File Name from command buffer (as pointed to by Q).
;Call with R=address of file name block
GETFIL: SETZM FBDEV(R)
MOVSI A,FBDEV(R)
HRRI A,FBDEV+1(R)
BLT A,FBLEN-1(R)
MOVSI A,'DSK'
MOVEM A,FBDEV(R)
CALL GETSIX
CAIE A,":"
JRST GETFL1 ;must be a file name
MOVEM B,FBDEV(R)
CALL GETSIX
GETFL1: MOVEM B,FBNAM(R)
CAIN A,"" ;special file hack for mail file?
CALL GETFLM ;yes. Bleh!
MOVEI B,0
CAIE A,"." ;extension given?
JRST GETFL2 ;nope
CALL GETSIX
HLLOM B,FBEXT(R) ;save only left half of ext. Flag ext seen
MOVEI B,0
GETFL2: CAIE A,"["
RET
CALL GETSIX
TRNN B,-1
TLNN B,-1
JRST ILLPPN ;some error
CALL RADJ
HLLZM B,FBPPN(R)
CAIE A,","
JRST ILLPPN
CALL GETSIX
TRNN B,-1
TLNN B,-1
JRST ILLPPN ;some error
CALL RADJ
HLRM B,FBPPN(R)
MOVEI B,0 ;looks ok so far!
CAIE A,"]"
RET
CALL GETSIX ;get next delimiter, hopefully immediate
RET
RADJ: SKIPE B
TLNE B,77
RET
LSH B,-6
JRST RADJ
;here if a "partial" character is seen. must be a mail file name.
GETFLM: JUMPN B,NOPARS ;can't make sense of this. NAME
MOVEI B,0 ;setup prg.msg[2,2]
GETPPN B,
CAI
HRRZM B,FBNAM(R) ;default name
MOVSI B,'MSG'
MOVEM B,FBEXT(R) ;default ext
MOVE B,[' 2 2']
MOVEM B,FBPPN(R) ;default ppn
MOVEI B,0
CALL GETSIX ;see if a name is given. Get next DELIM
JUMPE B,CPOPJ ;keep what we have
TRNE B,-1 ;don't know what to do with more than 3 letters
JRST NOPARS
CALL RADJ ;right adjust into left half
MOVSM B,FBNAM(R)
RET
>;IFE FTNXP
;GETIPR OPENO OPENOT OPENOF OPENID OPENIT OPENIF
SUBTTL OPEN FILES
;OPEN an INPUT PRESS File. Call with R=file block address
GETIPR: CALL OPENID ;open input device
JRST NSDERR ;no such device (or not available)
CALL OPENIF ;open input file
JRST .+2 ;lose.
RET
SKIPE IFBLK+FBEXT
JRST NOIFIL ;no such input file.
MOVSI A,'PRE'
MOVEM A,IFBLK+FBEXT
CALL OPENIF
JRST .+2
RET
MOVSI A,'PRS'
MOVEM A,IFBLK+FBEXT
CALL OPENIF
JRST NOIFL0
RET
;Open the specified input file. Call with R=file block address
;Open the specified output file in dump mode. R = file block address
OPENO: MOVEI A,17
MOVE B,FBDEV(R)
MOVEI C,0
CAMN B,['DOVER ']
JRST DVROPN
OPEN OCHAN,A
JRST NSDERR
PUSH P,[OUTPUT OCHAN,A]
PUSH P,[CLOSE OCHAN,]
POP P,CLSXCT
POP P,PUTXCT
JRST OPENOF
;Open the specified output file as a text file. R=file block address
OPENOT: MOVEI A,0
MOVE B,FBDEV(R)
MOVSI C,OBUFH
SKIPN FBNAM(R)
JRST NOONAM ;no output name given
OPEN OCHAN,A
JRST NSDERR ;no such device
MOVEI A,OBUFAD
EXCH A,.JBFF
OUTBUF OCHAN,NOBUF ;set up output buffers
MOVEM A,.JBFF
OPENOF: MOVSI D,FBNAM(R)
HRRI D,A
BLT D,D
ENTER OCHAN,A
JRST NOOFIL ;can't enter the file
RET ;all happy
OPENID: MOVEI A,17
MOVE B,FBDEV(R)
MOVEI C,0
OPEN ICHAN,A
RET
JRST CPOPJ1
;Open an input file in TEXT mode. R=file block. S=default ext
OPENIT: MOVEI A,0 ;input in text mode
MOVE B,FBDEV(R)
MOVEI C,IBUFH
OPEN ICHAN,A
JRST NSDERR ;no such device (or not available)
MOVEI A,IBUFAD
EXCH A,.JBFF
INBUF ICHAN,NIBUF ;set up input buffers
MOVEM A,.JBFF
CALL OPENIF ;open input file
SKIPA ;not found
RET
JUMPE S,NOIFIL ;lose if no extra ext to try
SKIPE FBEXT(R)
JRST NOIFIL
MOVEM S,FBEXT(R)
CALL OPENIF
JRST NOIFIL
RET
OPENIF: MOVSI D,FBNAM(R)
HRRI D,A
BLT D,D
LOOKUP ICHAN,A
RET
PUSH P,S
MOVEI S,ICHAN
SHOWIT S, ;Put filestatus on wholine
POP P,S
;For SAIL we have a swapped negative word count.
;Elsewhere it's a swappped negative word count, or a swapped positive record count
MOVS D,D ;unswap
NOSAIL,<
SKIPL D ;not SAIL: skip if negative
LSH D,7 ;convert positive block count to +WC
>;NOSAIL
MOVMM D,FBSIZ(R) ;store positive wc in memory
IFN FTNXP,<
PUSH P,D
MOVN D,D ;positive
ADDI D,177 ;round up
LSH D,-7 ;convert to records
MOVEM D,XBLOCK ;number of records to read
MOVEM D,XFILEN ;remember file length in records
POP P,D
>;IFN FTNXP
HRRZM B,FBDAT(R) ;Save date word
MOVEM C,FBPRO(R) ;save protection word
JRST CPOPJ1
;CPOPJ2 CPOPJ1 CPOPJ GETSIX GETSX1 QSET GETSX2 GETSX3 TAB BLANK ILLEG MAKLF QMARK DELIM SLASH
SUBTTL GETSIX READ SIXBIT COMMAND, FILE NAME, ETC RDNUMB
CPOPJ2: AOS (P)
CPOPJ1: AOS (P)
CPOPJ: POPJ P,
IFE FTNXP,<
GETSIX: MOVE C,[POINT 6,B]
SETZB B,QMODE ;B ACCUMULATES TEXT. QMODE FOR QUOTING
GETSX1: ILDB A,Q
MOVE D,CHRTAB(A) ;GET NORMAL DISPATCH
SKIPE QMODE ;SKIP IF NORMAL
MOVS D,D ;USE QUOTE MODE DISPATCH
JRST (D)
QSET: SETCMM QMODE ;HERE FOR CTRL A (DOWN ARROW)
JRST GETSX1 ;COMPLEMENT QUOTE FLAG AND GET MORE.
GETSX2: TRZ A,40 ;HERE FOR LOWER CASE LETTER
GETSX3: SUBI A," " ;HERE FOR UPPER CASE LETTER
TLNE C,770000 ;BYTE OVERFLOW?
IDPB A,C ;NOT OVERFLOW. DEPOSIT BYTE
JRST GETSX1 ;LOOP
TAB: MOVEI A,40 ;tab converts to blank
BLANK: JUMPE B,GETSX1 ;Leading blanks are flushed
RET ;Trailing blank is a delimiter
ILLEG: OUTSTR [ASCIZ/Illegal character "/]
CAIE A,15
OUTCHR A
OUTSTR [ASCIZ/" occurred in scan/]
SKIPE QMODE
OUTSTR [ASCIZ/ while in quote mode/]
SETZM QMODE
OUTSTR CRLF
JSP K,RESTAR
MAKLF: MOVEI A,12
QMARK:
DELIM: RET
SLASH: RET ;a switch delimiter
>;IFE FTNXP
;CHRTAB
SUBTTL Character Table for GETSIX
IFE FTNXP,<
CHRTAB: ILLEG,,DELIM ;NULL (Line ends with null
QSET,,QSET ;CTRL A = DOWN ARROW. SETS QUOTE MODE
ILLEG,,ILLEG ;2
ILLEG,,ILLEG ;3
ILLEG,,ILLEG ;4
ILLEG,,ILLEG ;5
ILLEG,,ILLEG ;6
ILLEG,,ILLEG ;7
ILLEG,,ILLEG ;10
ILLEG,,TAB ;11
ILLEG,,DELIM ;12
ILLEG,,ILLEG ;13
ILLEG,,MAKLF ;14 INVENT LF FOR FF
ILLEG,,GETSX1 ;15 IGNORE
ILLEG,,ILLEG ;16
ILLEG,,DELIM ;17 for mail file hacks
REPEAT 33-20,<ILLEG,,ILLEG> ;20-32 ARE ALL ILLEGAL
ILLEG,,DELIM ;33 DEC ALTMODE
REPEAT 40-34,<ILLEG,,ILLEG>
GETSX3,,BLANK ;40 BLANK IS A DELIMITER
GETSX3,,ILLEG ;41 !
GETSX3,,ILLEG ;42 "
GETSX3,,ILLEG ;43 #
GETSX3,,GETSX3 ;44 $ LEGAL IN FILE NAMES
GETSX3,,ILLEG ;45 %
GETSX3,,ILLEG ;46 &
GETSX3,,ILLEG ;47 '
GETSX3,,DELIM ;50 (
GETSX3,,ILLEG ;51 )
GETSX3,,ILLEG ;52 *
GETSX3,,ILLEG ;53 +
GETSX3,,DELIM ;54 , COMMA
GETSX3,,ILLEG ;55 -
GETSX3,,DELIM ;56 . PERIOD
GETSX3,,SLASH ;57 /
REPEAT 72-60,<GETSX3,,GETSX3> ;60-71 (0-9) ARE LEGAL
GETSX3,,DELIM ;72 :
GETSX3,,ILLEG ;73 ;
GETSX3,,ILLEG ;74 <
GETSX3,,DELIM ;75 = (Like _)
GETSX3,,ILLEG ;76 >
GETSX3,,QMARK ;77 ?
GETSX3,,DELIM ;100 @
REPEAT 133-101,<GETSX3,,GETSX3> ;101-132 (A-Z) ARE LEGAL
GETSX3,,DELIM ;133 [
GETSX3,,ILLEG ;134 \
GETSX3,,DELIM ;135 ]
GETSX3,,ILLEG ;136 ^
GETSX3,,DELIM ;137 _
ILLEG,,ILLEG ;140 `
REPEAT 173-141,<GETSX2,,GETSX2> ;141-172 (a-z) ARE LEGAL AND ALWAYS CONVERTED
ILLEG,,ILLEG ;173
ILLEG,,ILLEG ;174
ILLEG,,DELIM ;175
ILLEG,,ILLEG ;176
ILLEG,,ILLEG ;177
>;IFE FTNXP
;GETCMD GETCM1 TBLUK TBLUK0 TBLUK1 TBLUK2 TBLUK4 TBLUK3
SUBTTL GETCMD, TBLUK
IFE FTNXP,<
GETCMD: TRNN FL,SCANON
INSKIP ;clear ^O
JFCL
TRNN FL,SCANON ;while rescan, no prompt
;"<" to match opposite on next line
OUTSTR [ASCIZ/Press>/] ;prompt
CALL OUTSET ;setup OUTXCT
MOVE Q,[POINT 7,CMDBUF] ;line buffer
CALL GETLIN ;read a line
MOVE Q,[POINT 7,CMDBUF] ;line buffer
CALL GETSIX ;Get a sixbit item. Command name.
SKIPN A ;Skip unless end of line
JUMPE B,CPOPJ ;eol. return if null command.
JUMPN B,GETCM1 ;jump if not null command
CAIE A,"?"
JRST ILLCOM ;Jump if null cmd and not eol
MOVEI A,0
MOVE B,['HELP '] ;? alone means a help command
GETCM1: MOVE C,[-COMTL,,COMTAB]
CALL TBLUK ;perform table lookup
SKIPL C
SUBI C,COMTAB
MOVE C,COMTB1(C)
JRST (C) ;dispatch
;Table Lookup.
; Call with C = -length,,Command List
; B = Command name
;returns with C set to the index to the command list, or
; C = -2 for unknown command, or
; C = -1 for ambiguous.
;
TBLUK: PUSH P,A
MOVSI D,770000 ;Create a mask for the cmd search
TLNN B,7700 ;second char present?
JRST TBLUK0 ;no
TLO D,7700
TLNN B,77 ;third char present?
JRST TBLUK0 ;no
TLO D,77
TRNN B,770000 ;fourth character present?
JRST TBLUK0 ;no
TRO D,770000
TRNN B,7700 ;fifth char present?
JRST TBLUK0 ;no
TRO D,7700
TRNE B,77 ;Sixth char present?
TRO D,77 ;yes.
TBLUK0: SETZM AMBIG ;REMEMBER LOCATION OF COMMAND
TBLUK1: MOVE A,(C) ;fetch a command
CAMN B,A ;exact match?
JRST TBLUK4 ;yes. do it.
AND A,D ;inexact. does it match with mask?
CAME A,B
JRST TBLUK2 ;no match.
HRRZ A,C ;this is an abiguous match.
EXCH A,AMBIG ;Remember index to this command
SKIPE A ;skip if first match.
SETOM AMBIG ;second partial match. flag it.
TBLUK2: AOBJN C,TBLUK1 ;loop through command table?
SKIPN C,AMBIG ;no exact match. anything ambig?
MOVNI C,2 ;nothing at all
SKIPA
TBLUK4: HRRZ C,C ;exact match: make it non-negative
TBLUK3: POP P,A ;POP A
RET ;return result of TBLUK
>;IFE FTNXP
;COMTAB COMTL COMTB1 COMNAM COMHLP AMBIGC ILLCOM ILLCM1
SUBTTL Command Table
IFE FTNXP,<
DEFINE COMLST<
COMMAC(R,MONCOM,CM%INV,0)
COMMAC(RUN,MONCOM,CM%INV,0)
COMMAC(START,MONCOM,CM%INV,0)
COMMAC(S,MONCOM,CM%INV,0)
COMMAC(CONTIN,MONCOM,CM%INV,0)
COMMAC(DDT,DDTCOM,CM%INV,0)
COMMAC(DOVER,DOVER,0,H.DOVR)
COMMAC(FONTS,FONTS,0,H.FONT)
COMMAC(TYPE,TYPE,0,H.PTYP)
COMMAC(PART,PART,0,H.PPAR)
COMMAC(EMPRESS,EMPRESS,0,H.EMPR)
COMMAC(EXPRESS,EXPRESS,0,H.EXPR)
COMMAC(HELP,HELP,0,H.HELP)
COMMAC(EXIT,EXIT,0,H.EXIT)
COMMAC(EX,EXIT,CM%INV,H.EXIT)
COMMAC(QUIT,EXIT,CM%INV,H.EXIT)
>
DEFINE COMMAC(NAME,DISP,FLAGS,HELPM) <<SIXBIT/NAME/>>
COMTAB: COMLST
COMTL==.-COMTAB
DEFINE COMMAC(NAME,DISP,FLAGS,HELPM) <<FLAGS>,,DISP>
ILLCOM ;unknown command
AMBIGC ;ambiguous command
COMTB1: COMLST
DEFINE COMMAC(NAME,DISP,FLAGS,HELPM) <[ASCIZ/NAME
/]>
COMNAM: COMLST
DEFINE COMMAC(NAME,DISP,FLAGS,HELPM) <0,,HELPM>
[ASCIZ/Unknown command name
/]
[ASCIZ/Ambiguous command name
/]
COMHLP: COMLST
AMBIGC: OUTSTR [ASCIZ/Ambiguous command "/]
JRST ILLCM1
ILLCOM: OUTSTR [ASCIZ/Illegal command "/]
ILLCM1: CALL OUTSET
CALL PUTSIX
OUTSTR [ASCIZ/"
/]
CLRBFI
RET
>;IFE FTNXP
;HELP HELP0 HELPL HELP1 H.HELP H.EXIT EXIT DDTCOM MONCOM DDTGO NODDT CRLF
Subttl HELP Command. Also DDT, MONCOM, EXIT
IFE FTNXP,<
HELP: JUMPN A,HELP1 ;jump if maybe long form
HELP0: OUTSTR [ASCIZ/
For help on any particular command, type HELP and the command name.
For a general description of the program, type HELP HELP
The PRESS command names are:
/]
MOVSI C,-COMTL
HELPL: MOVE A,COMTB1(C)
TLNN A,CM%INV
OUTSTR @COMNAM(C)
AOBJN C,HELPL
OUTSTR CRLF
RET
HELP1: CALL GETSIX ;get argument name
JUMPE B,HELP0 ;jump if there's really no argument
MOVE C,[-COMTL,,COMTAB]
CALL TBLUK ;perform table lookup
SKIPL C
SUBI C,COMTAB
HRRZ C,COMHLP(C)
SKIPN C
HRRZI C,[ASCIZ/No help available for this command
/]
OUTSTR (C)
RET
H.HELP: ASCIZ /
The PRESS program performs useful manipulations of press files.
Among the commands are
DOVER Transmit a file to the Dover printer
FONTS Lists the available Dover fonts
EMPRESS Text file to Press file conversion
PART Select pages from a Press file
For more up-to-date information about the PRESS program, run it
and use its HELP command to identify command names.
Use its HELP <command-name> to get details about each command.
/
H.EXIT: ASCIZ /The EXIT command stops this program. QUIT is a synonym.
/
EXIT: EXIT
;Here for DDT command. Either this is a command, so flush typein before
;calling DDT, or this is a rescanned command, in which case, flush script
;of user's session in DDT
DDTCOM: CLRBFI ;Flush type ahead.
TRNN FL,SCANON ;Rescan in progress?
JRST DDTGO ;No. User wants to call DDT now
MONCOM: TRO FL,MRUNCM ;Discard this monitor command.
RET
DDTGO: HRRZ A,.JBDDT ;Get .JBDDT
JUMPE A,NODDT ;if zero, you lose.
PUSH P,[10000,,CPOPJ]
POP P,.JBOPC ;set up $P address
OUTSTR [ASCIZ/[DDT. Return with $P]
/]
JRST (A) ;Call DDT
NODDT: OUTSTR [ASCIZ/No DDT
/]
RET
CRLF: BYTE(7)15,12
>;IFE FTNXP
;H.PPAR Example PART PART0 PART1 PART1L PART1M PART1N PART1X PART2 COPYFD COPYPG COPYP0 COPYP1 MAKPDE WRITPD WRTPD1 WRITDD
SUBTTL PART Command
IFE FTNXP,<
H.PPAR: ASCIZ \
The PART command copies a portion of a press file file to form a new press
file. Any range consisting of whole pages may be selected. The syntax is
PART outfile.pre_infile.pre(page range)
The page range consists of terms with commas between them. Each term is
either a single page number, or a range of pages specified by the first
page of the range, a colon, and the last page. The symbol "*" can be used
to specify the last page of the file.
The output file will be a new press file containing the selected
pages (and font directory) of the input press file.
Example:
PART OUT.PRE_BOOK.PRE(1:25,67,542:*)
Switches available are
/KEEP Keep the original file name, date, and creator
for the header sheet.
\
PART: CALL CPARSE ;Parse file names, etc.
MOVEI R,IFBLK
CALL GETIPR ;Get an input press file
SKIPA A,[OUTCHR A] ;Noisy part typeout
>;IFE FTNXP
PART0: MOVE A,[JFCL] ;Make part typeout silent
PUSH P,A
MOVE A,[JFCL] ;Make CHKPRS silent
MOVEM A,OUTXCT
CALL CHKPRS ;Check a press file for goodness
POP P,OUTXCT
MOVEI R,OFBLK ;R_output block
MOVSI A,'PRE' ;default type for out = PRE
SKIPN FBEXT(R)
MOVEM A,FBEXT(R)
CALL OPENO ;open output dev
SETZM RECNUM ;count of output records so far
SETZM NUPARC ;new parts count
SETZM NUMPAG ;number of page parts written
MOVE Z,.JBFF ;Build a new part directory here
MOVEM Z,NEWPDA ;address of new parts dir.
MOVEI W,0 ;From 0 to PRIDX-1
PART1: HLRZ X,PRBUF(W) ;low bound
HRRZ Y,PRBUF(W) ;hi bound
CAMGE Y,X ;is high bound higher or equal?
JRST PART1M ;no. Suprise! we go backwards.
CAMLE X,PAGECN
JRST PART1X ;Lo bound exceeds minimum. no work
CAMLE Y,PAGECN ;Make sure high bound is in bound
MOVE Y,PAGECN
PART1L: CALL COPYPG ;copy page (page number in X)
CAMGE X,Y
AOJA X,PART1L
JRST PART1X
PART1M: CAMLE Y,PAGECN ;Hi bound in X, Low in Y
JRST PART1X ;Lo bound exceeds minimum. no work
CAMLE X,PAGECN ;Make sure high bound is in bound
MOVE X,PAGECN
PART1N: CALL COPYPG
CAMLE X,Y
SOJA X,PART1N
PART1X: ADDI W,1
CAMGE W,PRIDX
JRST PART1
SKIPE RECNUM ;anything written yet?
JRST PART2 ;yes
OUTSTR [ASCIZ/The specified page list contains no pages.
Consequently, no output was written.
/]
RESET
RET
;the page parts are done. now do the font directory
PART2: CALL COPYFD ;add font directory to file
CALL WRITPD ;write part directory
CALL WRITDD ;write document directory
CLOSE ICHAN,
IFE FTNXP,< ;leave file there, spooler may delete it
RELEAS ICHAN,
>;IFE FTNXP
XCT CLSXCT
RELEAS OCHAN,
RET
;Copy the font directory part to the output file. Uses most of COPYPG
COPYFD: CALL MAKPDE ;make room in part directory
MOVEI B,[ASCIZ/FD /]
CALL PUTSTR
MOVE A,FNTDAD ;address of PD entry for Font Part
JRST COPYP0 ;copy part
;Copy a printing page part to the output file. X=page number of the PP
;Z = pointer to free stg for the new part directory
COPYPG: CALL MAKPDE ;make room for an entry in the part dir
IFN FTNXP,<
AOS TPAGES ;count pages output
MOVEM X,XSPAGE ;note current output page
>;IFN FTNXP
MOVE A,X ;print page number
CALL PRDEC
MOVEI A," "
XCT OUTXCT
MOVE A,X ;copy of page number
ADD A,PGARRY ;+origin = addr of pointer
MOVE A,(A) ;a:=addr of the PP block
AOS NUMPAG ;count a page part written
COPYP0: AOS NUPARC ;count a new part written
MOVE B,(A) ;part type; record start
MOVE C,1(A) ;record count; entity padding
MOVE D,RECNUM
DPB D,[POINT 16,B,31] ;store current record number
MOVEM B,(Z)
MOVEM C,1(Z)
ADDI Z,2
LDB B,[POINT 16,(A),31] ;record number in input file
USETI ICHAN,1(B) ;select input record
IFN FTNXP,<
MOVNI C,(B)
ADD C,XFILEN
MOVEM C,XBLOCK ;let Qspool know where we are
SKIPE STOP
JRST SPAUS2 ;abort listing quickly
>;IFN FTNXP
LDB C,[POINT 16,1(A),15] ;record count
ADDM C,RECNUM ;to adjust our record count too.
COPYP1: MOVEI A,DRMAX ;max number of records to read
CAMLE A,C ;skip if more than that many to read
MOVE A,C ;no. read only as many as we need
SUB C,A ;C_number of records left to read
ASH A,7 ;convert to word count
MOVN A,A
HRLZ A,A ;-wc,,0
HRRI A,DATABL-1 ;IOWD WC,ADDR
MOVEI B,0
IFN FTNXP,<
SOS XBLOCK
SKIPE STOP
JRST SPAUS2 ;abort listing quickly
>;IFN FTNXP
INPUT ICHAN,A ;slosh it in, and
XCT PUTXCT ;put it out
JUMPG C,COPYP1 ;loop thru the entire page part
RET
MAKPDE: MOVEI A,2(Z) ;Next free address for Z
CAMGE A,.JBREL
RET
CORE A,
JSP T,NOCORE
RET
;Write the new PART DIRECTORY. Z=next avail addr in PD. NEWPDA = origin
WRITPD: MOVE A,Z
SUB A,NEWPDA ;A:=size of part directory
TRNN A,176 ;are we at a record boundary?
JRST WRTPD1
CALL MAKPDE ;make sure room exists
SETZM (Z)
SETZM 1(Z)
ADDI Z,2
JRST WRITPD ;loop to fill up the PD record
WRTPD1: MOVE B,RECNUM
MOVEM B,PDRECL ;rec number of PD for the Document Dir
MOVE B,A ;wc of the PD
LSH B,-7 ;record count of the PD
MOVEM B,PDRECN ;save for the document directory
ADDM B,RECNUM ;recnum of the DocDir
MOVN A,A
HRLZ A,A
HRR A,NEWPDA
SUBI A,1
MOVEI B,0
XCT PUTXCT
MOVEI B,[ASCIZ/PD /]
CALL PUTSTR
RET
WRITDD: PUSH P,OUTXCT
CALL MAKDD1
SKIPN DDKEEP ;user wants to keep parts of old dd?
CALL MAKDD2 ;no. make all new doc dir
POP P,OUTXCT
MOVE A,[IOWD 200,DPAGE] ;Send doc dir to file (or to PUP:)
MOVEI B,0
XCT PUTXCT
MOVEI B,[ASCIZ/DD!
/]
CALL PUTSTR
RET
;H.PTYP Example TYPE TYPE1 TYPE1L TYPE1M TYPE1N TYPE1X TYPEPP TYPPP1 TYPEFD TYPHDR TYPEPD TYPPD1 TYPPD2 TYPPD5 TYPPD4 TYPPD3 TYPPD6
SUBTTL TYPE Command
IFE FTNXP,<
H.PTYP: ASCIZ /
The TYPE command converts selected pages of a press file to a text file.
This command is intended to help debug problems in press files, by
converting the file to a readable form, and by checking for internal
consistency.
The command syntax is
TYPE outfile.txt_infile.ext(page range)
The page range consists of terms with commas between them. Each term is
either a single page number, or a range of pages specified by the first
page of the range, a colon, and the last page. The symbol "*" can be used
to specify the last page of the file.
The output file will be a text file containing an interpretation of the
selected pages of the original.
Example:
TYPE OUT.TXT_BOOK.PRE(1:25,67,542:*)
======= NOT FULLY IMPLEMENTED!
/
TYPE: CALL CPARSE ;Parse file names, etc.
MOVEI R,IFBLK
CALL GETIPR ;Get an input press file
MOVE A,[JFCL]
MOVEM A,OUTXCT
CALL CHKPRS ;Check a press file for goodness
MOVEI R,OFBLK ;R_output block
MOVSI A,'TXT'
SKIPN FBEXT(R)
MOVEM A,FBEXT(R)
MOVE A,FBNAM+IFBLK
SKIPN FBNAM(R)
MOVEM A,FBNAM(R) ;default output to same as input name, .TXT
CALL OPENOT ;open output dev
CALL TYPHDR ;type the header
CALL TYPEPD ;type part directory
CALL TYPEFD ;type the font directory
MOVEI W,0 ;From 0 to PRIDX-1
TYPE1: HLRZ X,PRBUF(W) ;low bound
HRRZ Y,PRBUF(W) ;hi bound
CAMGE Y,X ;is high bound higher or equal?
JRST TYPE1M ;no. Suprise! we go backwards.
CAMLE X,PAGECN
JRST TYPE1X ;Lo bound exceeds minimum. no work
CAMLE Y,PAGECN ;Make sure high bound is in bound
MOVE Y,PAGECN
TYPE1L: CALL TYPEPP ;Type page part (page number in X)
CAMGE X,Y
AOJA X,TYPE1L
JRST TYPE1X
TYPE1M: CAMLE Y,PAGECN
JRST TYPE1X ;Lo bound exceeds minimum. no work
CAMLE X,PAGECN ;Make sure high bound is in bound
MOVE X,PAGECN
TYPE1N: CALL TYPEPP ;type page part
CAMLE X,Y
SOJA X,TYPE1N
TYPE1X: ADDI W,1
CAMGE W,PRIDX
JRST TYPE1
CLOSE OCHAN,
RELEAS OCHAN,
CLOSE ICHAN,
RELEAS ICHAN,
RET
;PGARRY is the zero-orgin address of a short table, indexed by page number,
;of pointers to the two-word part-directory entry for this page.
;the part-directory entry contains:
;
; Byte(16) 0, record number of start of page part ;0=type of printing page
; Byte(16) record count, entity pad
;
TYPEPP: MOVEI B,[ASCIZ/Printing Page Part for Page Number /]
CALL PUTSTR
MOVE A,X
CALL PRDEC
MOVEI B,CRLF
CALL PUTSTR
MOVE Z,X ;copy of page number
ADD Z,PGARRY ;+origin = addr of pointer
MOVE Z,(Z) ;Z:=addr of the PP block
MOVEI B,[ASCIZ/Page Part starts at record /]
CALL PUTSTR
LDB A,[POINT 16,(Z),31] ;Record number
USETI ICHAN,1(A) ;set to that record
CALL PROCT
MOVEI B,[ASCIZ/; record count = /]
CALL PUTSTR
LDB A,[POINT 16,1(Z),15] ;record count
CALL PROCT
MOVEI B,[ASCIZ/; entity pad = /]
CALL PUTSTR
LDB A,[POINT 16,1(Z),31] ;entity pad
CALL PROCT
MOVEI B,CRLF
CALL PUTSTR
;a record happens to be 512 bytes = 256 16-bit words = 128 pdp-10 words.
;read the entire page part into memory.
LDB D,[POINT 16,1(Z),15] ;record count
LSH D,7 ;convert to pdp-10 word count
MOVE A,D
LSH A,1
MOVEM A,PPWC ;count of 16-bit words in PP
MOVE A,.JBFF
ADDI A,-1(D)
MOVEM A,RECEND ;last address of record
CAMG A,.JBREL
JRST TYPPP1
CORE A,
JSP T,NOCORE
TYPPP1: MOVE A,.JBFF ;form IOWD for reading this record
MOVEM A,PPORG ;save origin of page part core-image.
SUBI A,1 ;Note: USETI was done above
MOVN D,D
HRL A,D
MOVEI B,0
INPUT ICHAN,A
;entity pad is the number of unused bytes at the end of the last record
;of the printing part. These people insist that we scan backwards to the
;front of the entity list....
MOVEI B,[ASCIZ/
Here are the locations and contents of the entity trailer words.
Loc Data (i.e., the entity word count)
/]
CALL PUTSTR
LDB C,[POINT 16,1(Z),31]
MOVN C,C
ADD C,PPWC ;relative word number in Printing Part
MOVE A,RECEND
ADDI A,1
MOVEM A,ENTORG ;origin of entity storage
MOVEM A,ENTTOP ;Top-end of entity storage
PPTYBB: PUSH P,C ;C:=rel wc of end of some entity.
;save address of entity at end of the list
MOVE A,ENTTOP
CAMGE A,.JBREL
JRST PPTYBC
CORE A,
JSP T,NOCORE
PPTYBC: AOS A,ENTTOP
MOVEM C,-1(A)
MOVE A,C
CALL PRCT6T
MOVE C,(P)
ADJBP C,[POINT 16,0]
ADD C,PPORG
LDB A,C
MOVN B,A
ADDM B,(P) ;moving backwards....
PUSH P,A
CALL PROCT6
MOVEI B,CRLF
CALL PUTSTR
POP P,A
POP P,C ;c:=end of next entity, unless A=0
JUMPE A,PPTYBX ;done with moving backwards
JUMPGE C,PPTYBB ;loop until zero found.
MOVEI B,[ASCIZ/I got lost.
Following the entity list backwards, I ran off the front of the record.
I give up.
/]
CALL PUTSTR
RET
;here we found the address of the first entity.
;ENTTOP now addresses a word containing the location of the zero word.
;Run backwards, processing entities, until ENTTOP is less than ENTORG
PPTYBX: MOVEI B,[ASCIZ/Here follow the entities
----------------
/]
CALL PUTSTR
SETZM ENTNUM
SOS ENTTOP ;discard pointer to zero word
PPTYBY: SOS Z,ENTTOP ;move backwards.
CAMGE Z,ENTORG ;are we still in-range?
JRST PPTYBZ ;end of entity list
CALL ENTYPE ;type an entity
JRST PPTYBY
PPTYBZ: MOVEI B,[Asciz/
----------------
/]
CALL PUTSTR
RET
;type entire contents of an entity.
ENTYPE: MOVEI B,[ASCIZ/Entity number /]
CALL PUTSTR
AOS A,ENTNUM
CALL PRDEC
MOVE Z,(Z) ;this is the location of entity trailer
MOVE C,Z
ADJBP C,[POINT 16,0]
ADD C,PPORG
LDB Y,C ;Y := the wc of the entity
MOVE X,Z ;address of end of entity
SUB X,Y ;-wc = word address before start of EL
MOVE B,X
LSH B,1 ;convert from 16-bit words to 8-bit bytes
ADJBP B,[POINT 8,0] ;byte pointer before start of EL.
ADD B,PPORG
MOVEM B,ELPTR ;Byte pointer before first byte of EL
SUBI Y,14 ;12 words of Entity Trailer
LSH Y,1 ;Convert to bytes. Number of bytes in EL
MOVEM Y,ELCNT
MOVEI B,[ASCIZ/
Entity List starts at word /]
CALL PUTSTR
ADDI X,1 ;Word number of origin of EL
MOVE A,X
CALL PROCT6
MOVEI B,[ASCIZ/; entity ends at word /]
CALL PUTSTR
MOVE A,Z
CALL PROCT6
MOVEI B,CRLF
CALL PUTSTR
;Here we do all the work, if we knew how.
;Z=location of entity trailer. ELPTR = Byte pointer to entity list.
;Now, print the entity trailer
MOVEI X,-14(Z) ;go back 12 words to before the en trailer
ADJBP X,[POINT 16,0]
ADD X,PPORG ;byte pointer to before EN trailer
MOVEI B,[ASCIZ/Data from Entity Trailer
TYP FNT DLORG DLLENG XE YE Left Bottom Width Height
/]
CALL PUTSTR
ILDB A,X ;get first EN TRAIL WORD
PUSH P,A
LSH A,-8 ;first EN Trailer byte = TYPE
CALL PROCT
MOVEI A," "
XCT OUTXCT
POP P,A
ANDI A,377 ;Font set byte
CALL PROCT
MOVEI A,11
XCT OUTXCT
CALL ASM2W ;get the data list byte origin
MOVE C,A ;Data list byte number of origin
MOVE B,[POINT 8,0] ;make real pointer before adjust
ADD B,PPORG ;incase A contains zero
ADJBP C,B
MOVEM C,DLPTR
CALL PROCTB
CALL ASM2W ;get byte length
MOVEM A,DLCNT
CALL PROCTB
MOVEI A," "
XCT OUTXCT
ILDB A,X ;XE
CALL PRDECT
ILDB A,X ;YE
CALL PRDECT
ILDB A,X ;Left
CALL PRDECT
ILDB A,X ;Bottom
CALL PRDECT
ILDB A,X ;Width
CALL PRDECT
ILDB A,X ;Height
CALL PRDECT
MOVEI B,CRLF
CALL PUTSTR
CALL TYPEEL ;type the entity list
RET
;Here we are, ready to do the work.
;ELPTR is a byte pointer to the entity list
;DLPTR is a byte pointer to the data list.
;Method: Read a byte from the entity list. Interpret and print it.
; as necessary, bytes will be read from the DL and printed.
TYPEEL: CALL GETELB ;get a byte from EL.
JRST TYPEL1 ;end of list
CALL ELPNT
JRST TYPEEL
TYPEL1: MOVEI B,[ASCIZ/<End of Entity List>
/]
CALL PUTSTR
RET
ELPNT:
GETELB: SOSGE X,ELCNT
RET
ILDB X,ELPTR
JRST CPOPJ1
GTELBX: CALL GETELB
SKIPA
RET
MOVEI B,[ASCIZ/<!!!!!!! Ran off the Entity List! >
/]
CAMN X,[-1]
CALL PUTSTR ;only print once....
MOVEI X,0
RET
GETDLB: SOSGE Y,DLCNT
JRST GTDLB1
ILDB Y,DLPTR
RET
GTDLB1: MOVEI B,[ASCIZ/<!!!!!!! Ran off the Data List! >
/]
CAMN Y,[-1]
CALL PUTSTR ;only print once....
MOVEI Y,0
RET
;FNTDAD is the address in the in-core part directory of the entry for
;the font directory part. Entry in the same two-word format as
;mentioned above in TYPEPP
TYPEFD: MOVEI B,[ASCIZ/Font Directory Part
/]
CALL PUTSTR
MOVE Z,FNTDAD ;Z:= address of the FD entry in the PD
MOVEI B,[ASCIZ/Font Directory Part starts at record /]
CALL PUTSTR
LDB A,[POINT 16,(Z),31] ;Record number
USETI ICHAN,1(A) ;set to that record
CALL PROCT
MOVEI B,[ASCIZ/; record count = /]
CALL PUTSTR
LDB A,[POINT 16,1(Z),15] ;record count
CALL PROCT
MOVEI B,[ASCIZ/; undefined word = /]
CALL PUTSTR
LDB A,[POINT 16,1(Z),31] ;
CALL PROCT
MOVEI B,CRLF
CALL PUTSTR
;a record happens to be 512 bytes = 256 16-bit words = 128 pdp-10 words.
;read the entire page part into memory.
LDB D,[POINT 16,1(Z),15] ;record count
LSH D,7 ;convert to pdp-10 word count
MOVE A,D
LSH A,1
MOVEM A,PPWC ;count of 16-bit words in PP
MOVE A,.JBFF
ADDI A,-1(D)
MOVEM A,RECEND ;last address of record
CAMG A,.JBREL
JRST TYFDP1
CORE A,
JSP T,NOCORE
TYFDP1: MOVE A,.JBFF ;form IOWD for reading this record
MOVEM A,PPORG ;save origin of page part core-image.
SUBI A,1 ;Note: USETI was done above
MOVN D,D
HRL A,D
MOVEI B,0
INPUT ICHAN,A
MOVEI B,[ASCIZ/
Length Fontset Font M:N Family Face Source Size Rot
/]
CALL PUTSTR
;now process the font-directory info.
MOVE X,PPORG ;first address for the fd page
HRLI X,441000 ;eight-bit bytes....
TYFDP2: MOVEI Y,0 ;count of bytes.
CALL ASM2B ;get two bytes of entry length.
JUMPE A,TYFDP3 ;Zero means end of FD part.
MOVE Z,A ;length in words
LSH Z,1 ;length in bytes
CALL PRCT6T
ILDB A,X ;Font set
ADDI Y,1
CALL PRCT6T
ILDB A,X ;Font
ADDI Y,1
CALL PRCT6T
ILDB A,X ;M
ADDI Y,1
CALL PROCT
MOVEI A,":"
XCT OUTXCT
ILDB A,X ;N
ADDI Y,1
CALL PROCT
MOVEI A,11
XCT OUTXCT
LDB A,X
CAIN A,377 ;all ones is special.....
JRST TYFDSP ;process special.
;next 20 (decimal) bytes are BCPL string name of the family.
ILDB B,X ;count of family name (BCPL string)
ADDI Y,1
MOVEI C,1 ;count the count byte.
TYFPLL: ILDB A,X ;byte from the string
ADDI Y,1
SOSGE B ;count byte taken from string
MOVEI A," " ;not in the string. make it blank
XCT OUTXCT
ADDI C,1 ;count another byte of the 20 done.
CAIGE C,24 ;done enough?
JRST TYFPLL
MOVEI A,11
XCT OUTXCT
ILDB A,X
ADDI Y,1
CALL PRCT6T ;Face code
ILDB A,X
ADDI Y,1
CALL PRCT6T ;Source Code
CALL ASM2B ;two bytes of size
CALL PRCT6T ;size
CALL ASM2B
CALL PROCT ;rotation
MOVEI B,CRLF
CALL PUTSTR
CAMN Y,Z ;are these now identical?
JRST TYFDP2 ;yes. do another line.
MOVEI B,[ASCIZ/
Confusion about the length of an FD entry...
We stop interpreting the Font Directory here./]
CALL PUTSTR
JRST TYFDP3
TYFDSP: MOVEI B,[ASCIZ/This is the special format that I don't understand.
You can add code at TYFDSP to make this better. meanwhile I'll skip it.
/] ;process second format
CALL PUTSTR
TYFDS1: CAIL Y,Z
JRST TYFDP2
IBP X
AOJA Y,TYFDS1
TYFDP3: MOVEI B,CRLF
CALL PUTSTR
RET
TYPHDR: MOVE A,[CALL PUTCHR] ;fix output instruction
MOVEM A,OUTXCT
CALL INFODD ;info from document directory
CALL INFOPD ;part count from part directory
RET
TYPEPD: MOVEI B,[ASCIZ/
Part Directory
Entry Record Record Last
Type Addr Count Word
(octal) (octal) (octal)
/]
CALL PUTSTR
MOVN D,PARTCN
HRLZ D,D ;-part count,,0
HRR D,PDBASE ;-Part Count,,Address of part dir
TYPPD1: LDB A,[POINT 16,(D),15] ;get part type
JUMPE A,[CALL TYPPD3 ;type Printing Page Info
JRST TYPPD2]
CAIN A,1
JRST [CALL TYPPD4
JRST TYPPD2]
CALL TYPPD5
TYPPD2: ADD D,[1,,2] ;advance to next PD entry
JUMPL D,TYPPD1
MOVEI B,CRLF
CALL PUTSTR
MOVEI B,CRLF
CALL PUTSTR
RET
TYPPD5: MOVEI B,[ASCIZ/Unknown entry type:
/]
CALL PUTSTR
LDB A,[POINT 16,(D),15]
CALL PRCT6T
JRST TYPPD6
TYPPD4: SKIPA B,[[ASCIZ/FP /]]
TYPPD3: MOVEI B,[ASCIZ/PP /]
CALL PUTSTR
TYPPD6: LDB A,[POINT 16,(D),31] ;record start
CALL PRCT6T
LDB A,[POINT 16,1(D),15] ;record count
CALL PRCT6T
LDB A,[POINT 16,1(D),31] ;fourth word
CALL PROCT6
MOVEI B,CRLF
JRST PUTSTR
PRCT6T: CALL PROCT6 ;print octal in 6 characters and add a tab
MOVEI A,11
XCT OUTXCT
RET
ASM2B: ILDB A,X ;assemble two 8-bit bytes
LSH A,8
PUSH P,A
ILDB A,X
ADDI Y,2
IOR A,(P)
ADJSP P,-1
RET
ASM2W: ILDB A,X ;assemble two 16-bit words
LSH A,20
PUSH P,A
ILDB A,X
ADDI Y,2
IOR A,(P)
ADJSP P,-1
RET
>;IFE FTNXP
;H.EMPR TMar EMPRESS EMPRS0 CONVRT FFPRC FFPRC1 FFPRC2 PGFLU FFPRC3 CHLOOP CHDSP CHPNT CRPRC LFPRC TABPRC FINDON CHLP1 CHLP2 CHLPRT IFF ICRLF PSTRT SETCR SETCR1 SETX SETLF2 SETLF SETY CNTPUT FINPAR FINPR0 FINPR1 COPYEL COPYPD GETFSZ PUTBLK PDCOPY MAKDD MAKDD1 MAKDD2 MAKDD3 MAKDD4 MAKDD8 MAKDD9 OSETUP OPUT1 OPUT OFORCE OFORC0 OFORC1 MKPDIR ADPDIR ADPDR2 PPDRB1 PPDIRB MKENTL ADENTL ADENT1 ADENT2 PUTEN1 PUTENT GETCHR GETCH1 PGRINI HDRINI HDRIN3 HDRIN4 HDRFIL HDRFL1 HDRPUT WRTHDR WRTHD1 HDRSET SCRCO2 SCRCOP
SUBTTL EMPRESS Command ASCII to PRESS conversion
IFE FTNXP,<
H.EMPR: ASCIZ $
The EMPRESS command converts an ordinary text file to a press file.
EMPRESS outfile.pre_infile.ext(page range)/switch
The output file will be a press file corresponding to the selected pages of
the original text.
The page range consists of terms with commas between them. Each term is
either a single page number, or a range of pages specified by the first
page of the range, a colon, and the last page. The symbol "*" can be used
to specify the last page of the file. The text file is processed only once:
the selected pages must be in ascending sequence.
Switches are (these apply to both EMPRESS and DOVER commands):
/NoHeader suppress heading at top of each page (default for .LST files)
/Header put heading at the top of each page (normal default)
/Font=<name> use named font (default is SAIL) (name can include size)
/FSize=n set font size to n (default is 8)
/NChars=n set max number of chars per line to n (default 95)
/NLines=n set number of lines/page to n (sets LHeight implicitly)(69)
/LHeight=n set line height (vert distance per line) to n (default 131)
/XLineS=n set extra interline spacing to n (default is 20, sets LHeight)
/TMargin=n set top margin to n (default 1092)
/BMargin=n set bottom margin to n (default 950)
/LMargin=n set lefthand margin to n (default 1070)
/Rotate rotate listing 90 degrees counter-clockwise.
Rotated defaults: Font=SAIL8(rot90); NChars=132; NLines=58;
TMar=1070; LMar=950; BMar=850; LHeight=115.
(Margins, LHeight, and XLineS above are specified in thousandths of an inch.)
The line spacing can be set with any one of the three switches /NLines, /LHeight
and /XLineS, or it can be left to the default. The default spacing is done by
setting XLineS=20 and using the formula below. Setting XLineS=0 results in
fairly tight line spacing, but negative values for XLineS are also permitted,
for even tigher spacing. Unless NLines or LHeight is specified, this formula
determines the spacing:
FSize * 1000
LHeight = XLineS + ------------ (thousandths of an inch)
72
(Actually, for rotated output with neither NLines nor LHeight specified, this
formula applies unless there is also NO FONT SIZE and NO XLINES given, in which
case NLines=58 is used, to fit one lineprinter-format page per Dover page.)
Example command:
EMPRESS OUT.PRE_PRESS.FAI/Font=SAIL6/XL=10/TMar=500/BMar=500
$
EMPRESS:CALL CPARSE ;Parse file names, etc.
>;IFE FTNXP
EMPRS0: MOVEI A,0
DSKPPN A,
MOVEI R,IFBLK
SKIPN FBPPN(R) ;Any PPN set?
MOVEM A,FBPPN(R) ;no. use current connected directory
MOVEI S,0 ;default input ext = none.
CALL OPENIT ;Get an input file
MOVEI R,OFBLK ;R_output block
MOVSI A,'PRE'
SKIPN FBEXT(R)
MOVEM A,FBEXT(R)
MOVE A,FBNAM+IFBLK
SKIPN FBNAM(R)
MOVEM A,FBNAM(R)
CALL OPENO ;open output dev
CONVRT: SETZM RECNUM ;record number of output record
SETZM ENTFRE ;the entity list free list.
SETZM NUMPAG ;number of page parts written
CALL HDRINI ;initialize header
CALL PGRINI ;initialize to deal with page ranges
CALL OSETUP ;setup for output, byte pointer, counts
CALL MKPDIR ;Make Part Dir record list
SKIPA ;skip form feed processing
FFPRC: CALL FINPAR ;here for form feed. finish current part
SETZM BYTNUM ;no bytes on this page yet
FFPRC1: AOS A,PGNUM ;increment main page number
IFN FTNXP,<
MOVEM A,XSPAGE ;note page we're working on
>;IFN FTNXP
FFPRC2: CAMGE A,LOPAGE ;above low boundary?
JRST PGFLU ;nope. skip this page
CAMG A,HIPAGE
JRST FFPRC3 ;in range. copy this one!
AOS A,PGIDX
CAML A,PRIDX ;Skip if within list of page ranges
JRST FINDON ;end of page ranges. Finish up
MOVE A,PRBUF(A)
HRRZM A,HIPAGE
HLRZM A,LOPAGE
MOVE A,PGNUM
JRST FFPRC2
PGFLU: CALL GETCHR ;discard current page.
JRST FINDON ;end of file.
CAIE A,14 ;end of page?
JRST PGFLU ;not yet. discard more.
JRST FFPRC1 ;count another page.
FFPRC3: SETZM SPGNUM ;initialize sub-page number
CALL PSTRT ;Initialize for start of page (part)
CHLOOP: CALL GETCHR ;Get a character
JRST FINDON ;end of file. Finish up
CAIL A,11
CAILE A,15
JRST CHPNT
XCT CHDSP-11(A)
CHDSP: JRST TABPRC ;11 h tab
JRST LFPRC ;12 lf
JRST CHPNT ;13 vt - ordinary
JRST FFPRC ;14 ff new page
JRST CRPRC ;15 cr
CHPNT: CALL CHLP1 ;print one character
JRST CHLOOP ;loop
CRPRC: CALL SETCR ;send characters, set new position cmd
JRST CHLOOP ;loop
LFPRC: CALL SETLF ;set new Y position
JRST CHLOOP
TABPRC: MOVEI A,40 ;convert tab to space
CALL CHLP1 ;send character
MOVE A,CURPOS
TRNE A,7
JRST TABPRC
JRST CHLOOP
FINDON: CALL SETCR ;in case of files that don't end with crlf
CALL PUTBLK ;finish up
CLOSE ICHAN,
IFE FTNXP,< ;leave file there, spooler may delete it
RELEAS ICHAN,
>;IFE FTNXP
XCT CLSXCT
RELEAS OCHAN,
RET
;*****
;Secondary Routines. CHLP1 - put character in file
; CHLP2 - put header character in output file
CHLP1: SKIPE ROTARG ;is picture rotated?
JRST CHLPRT ;use rotated version
MOVE B,CURY ;get current Y position
CAMG B,BMAR ;skip if there's room on page
JRST IFF ;insert form-feed
MOVE B,CURPOS ;Get column number
CAML B,MAXWID
JRST ICRLF ;must insert CRLF
CHLP2: CALL OPUT ;send to output file
AOS CURPOS
RET
;Here if doing rotated output
CHLPRT: MOVE B,CURX ;current X
CAML B,RTMAXX ;skip if haven't reached margin yet
JRST IFF ;nope. insert ff now
MOVE B,CURPOS ;cursor position
CAML B,MAXWID ;on line?
JRST ICRLF
JRST CHLP2 ;go print character.
IFF: PUSH P,A
CALL FINPAR ;Finish current page
CALL PSTRT ;make a new page part
POP P,A
JRST CHLP1
ICRLF: PUSH P,A ;insert new line (crlf)
CALL SETCR ;send characters, add new position cmd
CALL SETLF ;new Y position.
POP P,A
JRST CHLP1 ;check for valid Y position.
;********
;Start a page part.
PSTRT: AOS SPGNUM ;increment sub-page number of input page
IFN FTNXP,<
AOS TPAGES ;count total pages being output
>;IFN FTNXP
MOVE A,RECNUM ;current record number
MOVEM A,PSTART ;Save starting record of this page part
CALL MKENTL ;make a new entity list
MOVN A,TMAR ;top margin negated
ADDI A,PAGHGT ;plus distance to top edge of paper is Y
SKIPE ROTARG ;rotated display?
MOVE A,LMAR ;yes. start with small Y
MOVEM A,CURY ;set current Y
; MOVEI A,<BYTE(20)0(8)13,267>
MOVE A,LMAR ;normal left margin
SKIPE ROTARG ;rotated?
MOVE A,TMAR ;yes, use top margin
MOVEM A,CURX ;set current X
SETZM BYTNUM ;Byte number of output byte on page
SETZM CURPOS ;zero the character position.
CALL SETX ;set X from CURX
CALL SETY ;Set Y from CURY
MOVEI A,160 ;Font Zero
CALL PUTENT
MOVEI A,366 ;reset space
CALL PUTENT
SKIPE HEADFL ;skip if no headings are wanted
CALL WRTHDR ;Write page header to output file
RET
SETCR: SKIPG B,CURPOS ;how many chrs since the start of line?
RET ;none: no work here.
SETCR1: MOVEI A,360 ;SHOW CHARACTERS
CALL PUTENT ;Add to entity list
MOVE A,B ;number of chr to display
CAILE A,377 ;but not more than 377
MOVEI A,377
SUB B,A ;B := number of chrs left unshown
CALL PUTENT
JUMPG B,SETCR1 ;loop if more chr to show.
SETZM CURPOS ;now at column zero again
SKIPE ROTARG ;rotated picture?
JRST SETY ;yes. all different.
SETX: MOVEI A,356 ;SET-X command to simulate CR
CALL PUTENT
LDB A,[POINT 8,CURX,27]
CALL PUTENT
LDB A,[POINT 8,CURX,35]
CALL PUTENT
RET
SETLF2: MOVE B,LINHGT ;rotated picture. CR advances X
ADDM B,CURX ;set New X-value
JRST SETX
;add LF to file
SETLF: SKIPE ROTARG ;rotated picture?
JRST SETLF2 ;yes.
MOVN B,LINHGT ;number of micas to move down
ADDM B,CURY ;get the current y-coordinate.
SETY: MOVEI A,357 ;SET-Y command to simulate LF
CALL PUTENT
LDB A,[POINT 8,CURY,27] ;get first half of new y-coordinate.
CALL PUTENT
LDB A,[POINT 8,CURY,35]
CALL PUTENT ;get both halves in.
RET
;Output bytes via count.
;Count in B, Byte pointer in C
CNTPUT: ILDB A,C
CALL OPUT
SOJG B,CNTPUT
RET
;Finish the current part
FINPAR: SKIPG B,BYTNUM ;Any bytes written on this page?
JRST FINPR1 ;No. Avoid most work for no data
MOVEI A,0 ;null byte
TRNE B,1 ;is there an odd number of DL bytes?
CALL OPUT ;yes, make data list even!
LDB A,[POINT 16,BYTNUM,19] ;Get high-order word of BYTNUM
DPB A,[POINT 16,ENTAIL+1,31];Put it in the entity trailer
LDB A,[POINT 16,BYTNUM,35] ;Get low-word of BYTNUM
DPB A,[POINT 16,ENTAIL+2,15];put byte count in entity tail
MOVEI A,0
CALL OPUT ;put a full-word of zero in
CALL OPUT ;to separate the DL and the EL
MOVEI A,541 ;arbitrary height value.
DPB A,[POINT 16,ENTAIL+5,15];for trailer
MOVEI A,377 ;a no-op byte
MOVE B,ELBYTC ;Get entity list length.
TRNE B,1 ;Skip if it's even
CALL PUTENT ;ODD. ADD NO-OP BYTE
MOVE B,ELBYTC ;current entity count
ADDI B,ENTLBC ;plus byte count of entail
LSH B,-1 ;count in words of this entity
DPB B,[POINT 16,ENTAIL+5,31];Save entity size in entity trailer
MOVE D,ENTHED ;head of entity list
FINPR0: CALL COPYEL ;Copy one EL block
SKIPE D,(D) ;Advance to next EL block
JRST FINPR0 ;Loop until all EL blocks done
;now, copy entity trailer to the file
MOVE C,[POINT 8,ENTAIL] ;pointer to entity tail
MOVEI B,ENTLBC ;Length of entity tail
CALL CNTPUT ;copy to file.
MOVE A,OCOUNT ;get size of entity pad in bytes
LSH A,-1 ;divide to make words
MOVEM A,EPAD ;save it for the Part Dir
CALL OFORCE ;Force zeros to finish record.
;advance to next record
SETZ A, ;"page part type"
CALL PPDIRB
MOVE A,PSTART ;page starts at this record
CALL PPDIRB
MOVE A,RECNUM ;get number of records on page.
SUB A,PSTART ;
CALL PPDIRB
MOVE A,EPAD ;Entity padding (words)
CALL PPDIRB ;store that.
AOS NUMPAG ;count another page done
FINPR1: MOVE A,ENTFRE ;head of free list (if any)
MOVEM A,@ENTTAI ;store at end of entity list
MOVE A,ENTHED ;store head of el as the new
MOVEM A,ENTFRE ;head of the free list
RET
COPYEL: MOVE C,[POINT 8,1(D)] ;byte pointer to data area
MOVEI B,200*4 ;byte count of full block
SKIPN (D) ;skip if full block
SUB B,ENTCNT ;last block, reduce count
CALL CNTPUT ;copy data to file
RET
COPYPD: MOVE C,[POINT 8,1(D)] ;byte pointer to data area
MOVEI B,200*4 ;byte count of full block
SKIPN (D) ;skip if full block
SUB B,PDCNT ;last block, reduce count
CALL CNTPUT
RET
GETFSZ: MOVEI A,DEFSIZ ;normal font is SAIL8, this is default size
SKIPE ROTARG ;but in a rotated page
MOVEI A,RDFSIZ ;default rotated size
SKIPLE FNTSIZ ;skip if no size specified
MOVE A,FNTSIZ ;use size specified by user
RET
;PUTBLK puts the counters into the blocks, and puts the blocks into the file.
PUTBLK: CALL FINPAR ;finish current part
MOVE A,ROTARG ;rotation of font
DPB A,ROTPTR ;store in FDIR
CALL GETFSZ ;get font size into A
DPB A,FSZPTR ;store in font directory
MOVE C,[POINT 8,FDIR] ;send font directory next
MOVEI B,FDLEN
CALL CNTPUT ;copy FD to file
CALL OFORCE ;Pad remainder of FD record with zero
MOVEI A,1 ;Font directory part type
CALL PPDIRB ;put it in part directory.
MOVE A,RECNUM ;current record number
SUBI A,1
CALL PPDIRB ;put it in block.
MOVEI A,1 ;number of records in font dir
CALL PPDIRB
MOVEI A,0 ;ignored for font dir?
CALL PPDIRB
;now, send the part directory to the output file
MOVE A,RECNUM
MOVEM A,PDRECL ;record number of start of Part Dir
MOVE D,PDIRH ;head of part directory list
PDCOPY: CALL COPYPD ;Copy one PD block
SKIPE D,(D) ;Advance to next PD block
JRST PDCOPY ;Loop until all PD blocks done
CALL OFORCE ;fill to end of record with nulls
CALL MAKDD ;fill in good stuff for doc directory
MOVE C,[POINT 8,DPAGE]
MOVEI B,200*4 ;byte count of doc directory
CALL CNTPUT ;copy doc directory to file
CALL OFORCE ;force last record out
RET
;Make document directory. Also called from PART command
MAKDD: CALL MAKDD1
CALL MAKDD2
RET
MAKDD1: MOVEI A,GENPAS ;general password
DPB A,DDPASS ;put in doc dir.
MOVE A,RECNUM ;total thru the part directory
ADDI A,1 ;plus doc dir
DPB A,DDRECT ;Total number of records for DD
MOVE A,NUMPAG ;total number of pages
ADDI A,1 ;+FD = number of parts
DPB A,DDPART ;for DD
MOVE A,PDRECL ;rec num of Part Directory
DPB A,DDPDRN ;rec number of part dir
MOVE A,PDRECN ;get number of records for p.d.
DPB A,DDPDRC ;# of rec in part dir
MOVEI A,0
DPB A,DDOBSL ;Obsolete word
MOVNI A,1
DPB A,DDUNU1 ;unused word
DPB A,DDUNU2 ;unused word
MOVEI A,1 ;set copy count in document directory
DPB A,DDFCPY ;first copy number
MOVS A,OFBLK+FBDEV
CAIN A,'PUP' ;Skip unless output device is dover
SKIPG A,CPYCNT ;Device is dover, skip if repeat count set
MOVEI A,1 ;Not Dover or no count set. Make one copy
DPB A,DDLCPY ;last copy number
;put -1 into unused words
SETOM DPAGE+5 ;put first word out there.
MOVE A,[DPAGE+5,,DPAGE+6] ;get ready to BLT
BLT A,DPAGE+77
RET
;Set up the information for the header sheet.
MAKDD2: MOVE A,DDFNAM ;Byte pointer for a BCPL string
CALL BCPSET ;Setup for BCPL Byte output
IFN FTNXP,<
SKIPN R,SCRFLG ;spooling from score?
JRST MAKDD3 ;nope
CALL SCRCOP ;yes, copy score filename
JRST MAKDD4
MAKDD3: MOVEI R,AFBLK ;alias file name, from spooler block
>;IFN FTNXP
IFE FTNXP,<
MOVEI R,IFBLK ;write file name
>;IFE FTNXP
CALL PUTFIL ;Write INPUT file name
MAKDD4: CALL BCPFIN
IFN FTNXP,<
MOVEI R,IFBLK ;just in case someone expects this here
>;IFN FTNXP
MOVE A,DDFCRE ;Pointer for name string
CALL BCPSET
MOVE C,[POINT 7,USRNAM]
MAKDD8: ILDB A,C
JUMPE A,MAKDD9
XCT OUTXCT
JRST MAKDD8
MAKDD9: CALL BCPFIN
MOVE A,DDFDAT ;String pointer for the date string
CALL BCPSET ;Setup for BCPL Byte output
LDB A,[POINT 12,IFBLK+FBPRO,35] ;low date
LDB B,[POINT 3,IFBLK+FBDAT,20]
DPB B,[POINT 3,A,23]
CALL TYDATE ;type date
MOVEI A," "
XCT OUTXCT
LDB A,[POINT 11,IFBLK+FBPRO,23] ;Minutes since midnight
CALL TYTIME
CALL BCPFIN
RET
OSETUP: MOVE A,[POINT 8,OBLOCK]
MOVEM A,OPOINT
MOVEI A,200*4 ;number of words in an output block
MOVEM A,OCOUNT
RET
OPUT1: CALL OFORC1 ;force current record
OPUT: SOSGE OCOUNT ;send a byte
JRST OPUT1
IDPB A,OPOINT
AOS BYTNUM
RET
OFORCE: MOVE A,OCOUNT
CAIN A,200*4
RET
OFORC0: SKIPG OCOUNT ;skip if room left in record
JRST OFORC1 ;force current, full record
MOVEI A,0
CALL OPUT
JRST OFORC0
OFORC1: PUSH P,A
PUSH P,B
MOVE A,[IOWD 200,OBLOCK] ;force current record
MOVEI B,0
XCT PUTXCT
AOS RECNUM
CALL OSETUP
POP P,B
POP P,A
RET
MKPDIR: MOVEI A,PDIRH ;Address of head of Part Dir List
MOVEM A,PDIRT ;Store as tail of Part Dir List
SETZM PDRECN ;number of records in Part Dir
SETZM PDBYTC ;Part Dir byte count
ADPDIR: MOVE A,.JBFF ;add to part dir list
MOVEI B,201 ;length of this block 200 data + link
ADDB B,.JBFF ;bump .JBFF
CAMG B,.JBREL ;make sure we have room
JRST ADPDR2
CORE B,
JSP T,NOCORE
ADPDR2: MOVE B,PDIRT ;get old tail of part dir list
MOVEM A,(B) ;store link out of old tail
MOVEM A,PDIRT ;tail of Part Dir List
SETZM (A) ;zero link out of part dir list
HRL A,A
ADDI A,1
MOVSI B,(<POINT 16,0>)
HRR B,A
MOVEM B,PDPNT ;16-bit words in Part Dir list
MOVEI B,177(A)
BLT A,(B)
MOVEI A,200*2 ;# of 16 bit words avail in Part Dir list
MOVEM A,PDCNT
AOS PDRECN ;count a Part Dir Record
RET
;add a byte to the part directory
PPDRB1: PUSH P,A
PUSH P,B
CALL ADPDIR
POP P,B
POP P,A
PPDIRB: SOSGE PDCNT ;decrement count of bytes avail
JRST PPDRB1
IDPB A,PDPNT
RET
;**** Entity list manipulations
MKENTL: MOVEI A,ENTHED ;Address of head of Entity List
MOVEM A,ENTTAI ;Store as tail of Entity List
SETZM ELBYTC ;Entity list byte count
ADENTL: SKIPN A,ENTFRE ;is there a free block available?
JRST ADENT1 ;nope.
MOVE B,(A) ;get pointer to next free block
MOVEM B,ENTFRE ;set that block as head of free list.
JRST ADENT2
ADENT1: MOVE A,.JBFF ;add to entity list
MOVEI B,201 ;length of this block
ADDB B,.JBFF ;bump .JBFF
CAMG B,.JBREL ;make sure we have room
JRST ADENT2
CORE B,
JSP T,NOCORE
ADENT2: MOVE B,ENTTAI ;get old tail of entity list
MOVEM A,(B) ;store link out of old tail
MOVEM A,ENTTAI ;tail of Entity List
SETZM (A) ;zero link out of part dir list
HRL A,A
ADDI A,1
MOVSI B,(<POINT 8,0>)
HRR B,A
MOVEM B,ENTPNT ;8-bit bytes in Enity list
MOVEI B,177(A)
BLT A,(B)
MOVEI A,200*4 ;# of 8 bit bytes avail in Entity block
MOVEM A,ENTCNT
RET
;add a byte to the entity list
PUTEN1: PUSH P,A
PUSH P,B
CALL ADENTL ;add a block to entity list
POP P,B
POP P,A
PUTENT: SOSGE ENTCNT ;decrement count of bytes avail
JRST PUTEN1
IDPB A,ENTPNT
AOS ELBYTC ;count another entity byte
RET
;GETCHR read a 7-bit byte from the file open on ICHAN
GETCHR: SOSLE IBUFH+2 ;decrement buffer byte count
JRST GETCH1
INPUT ICHAN, ;Get another buffer.
IFN FTNXP,<
SOS XBLOCK
SKIPE STOP
JRST SPAUS2 ;abort listing quickly
>;IFN FTNXP
STATZ ICHAN,740000 ;test error flags
JRST INERR ;input error
STATZ ICHAN,20000 ;test for eof
RET ;EOF - no skip return
GETCH1: ILDB A,IBUFH+1 ;get a byte from the buffer
JUMPE A,GETCHR ;discard zeros
AOS (P) ;success return
RET
PGRINI: SETZM PGIDX ;index to page count list
SETZM PGNUM ;page number of current input page
HRLOI C,1 ;1,,-1 The value of 1:*
SKIPN PRIDX ;Did user supply a page range?
MOVEM C,PRBUF ;No. Put 1:* in slot 0
MOVE A,PRBUF
HRRZM A,HIPAGE
HLRZM A,LOPAGE
RET
HDRINI: CALL HDRSET
ACCTIM A, ;Date,,Seconds since midnight
PUSH P,A ;save time
HLRZ A,A ;date
CALL TYDATE
MOVEI C,=14
CALL HDRFIL ;fill to column 14
POP P,A
HRRZ A,A ;discard date
IDIVI A,=60 ;discard seconds
CALL TYTIME ;type time of day
MOVEI C,=27 ;fill to column 27
CALL HDRFIL
IFN FTNXP,<
SKIPN R,SCRFLG ;spooling from score?
JRST HDRIN3 ;nope
CALL SCRCOP ;yes, copy score filename
JRST HDRIN4
HDRIN3: MOVEI R,AFBLK ;alias file name, from spooler block
>;IFN FTNXP
IFE FTNXP,<
MOVEI R,IFBLK ;write file name
>;IFE FTNXP
CALL PUTFIL
IFN FTNXP,<
HDRIN4: MOVEI R,IFBLK ;just in case someone expects this here
>;IFN FTNXP
MOVEI C,=56
CALL HDRFIL ;fill to 56
MOVEI B,[ASCIZ/Page /]
CALL PUTSTR ;copy string
MOVE A,HDRPTR
MOVEM A,PAGNPT
MOVEI A,0
XCT OUTXCT
RET
HDRFIL: MOVEI A," "
HDRFL1: XCT OUTXCT
MOVE B,HDRCNT
CAMGE B,C
JRST HDRFL1
RET
HDRPUT: IDPB A,HDRPTR ;Put byte into header. Call by XCT OUTXCT
AOS HDRCNT
RET
WRTHDR: CALL HDRSET
MOVE A,PAGNPT ;reset pointer to end of PAGE string
MOVEM A,HDRPTR ;byte pointer for OUTXCT (CALL HDRPUT)
MOVE A,PGNUM ;page number of input page
IFN FTNXP,<
HLRZ B,CMDBUF+CBITS ;GET ALIAS PAGE NUMBER
SOJGE B,.+2
MOVEI B,0 ;DON'T BE NEGATIVE.
ADD A,B ;adjust printed page number
>;IFN FTNXP
CALL PRDEC ;print as decimal
MOVE A,SPGNUM ;is there a sub-page number to print?
CAIGE A,2 ;print sub-page numbers starting at 2
JRST WRTHD1 ;don't print it
MOVEI A,"-"
XCT OUTXCT
MOVE A,SPGNUM
CALL PRDEC
WRTHD1: MOVEI A,0
XCT OUTXCT
MOVE A,[CALL CHLP2]
MOVEM A,OUTXCT
MOVEI B,PAGHED
CALL PUTSTR
CALL SETCR
CALL SETLF
CALL SETLF
RET
;co-routine. Sets up for header output
HDRSET: PUSH P,OUTXCT ;S
MOVE A,[POINT 7,PAGHED]
MOVEM A,HDRPTR
SETZM HDRCNT
MOVE A,[CALL HDRPUT]
MOVEM A,OUTXCT
CALL @-1(P)
POP P,OUTXCT
ADJSP P,-1
RET
IFN FTNXP,<
SCRCO2: XCT OUTXCT ;put out a char
SCRCOP: ILDB A,R ;get char from name string
JUMPN A,SCRCO2 ;loop until null
POPJ P,
>;IFN FTNXP
;H.EXPR Example EXPRESS
SUBTTL EXPRESS Command
IFE FTNXP,<
H.EXPR: ASCIZ /
======= NOT IMPLEMENTED
The EXPRESS command converts an XGP file to a press file.
EXPRESS outfile.pre_infile.xgp(page range)
The output file will be a press file corresponding to the selected pages of
the original XGP file. Selecting page 1 of the XGP file is understood to
mean the first printing page, not the header page that has font selections.
The XGP header page must be present. The selected pages must be in ascending
sequence.
Example:
EXPRESS OUT.PRE_BOOK.XGP(1:5)
======= NOT IMPLEMENTED
/
EXPRESS:CALL CPARSE ;Parse file names, etc.
MOVEI R,IFBLK
MOVSI S,'XGP' ;default input ext = XGP
CALL OPENIT ;Get an input file
MOVEI R,OFBLK ;R_output block
MOVSI A,'PRE'
SKIPN FBEXT(R)
MOVEM A,FBEXT(R)
MOVE A,FBNAM+IFBLK
SKIPN FBNAM(R)
MOVEM A,FBNAM(R)
CALL OPENO ;open output dev
JRST NOTIMP
>;IFE FTNXP
;H.FONT WIDFIL T.NAME T.WIDI FONTEX CNTOUT FONTS FONTS0 FONTSL FONTNS FNAME FONTAB FWIDI FWIDI2 FNONAM FNOSIZ FNOROT NOFIXX NOFIXY TYFNAM TYFNA2 DISCN2 DISCNT BGET BGET0 BGET2 BGET3 BGETWD BGT2WD FGTSWT FSWIT FSWTAB FSWTLN FSWDSP FSWNAM TERSET VERSET MEDSET FONTS FONTSL FONTSS FONTNL FONTNE FONTAB FONTNX FONTNS
IFE FTNXP,<
H.FONT: ASCIZ\The FONTS command lists the fonts available on the Dover, using FONTS.WID.
The following optional switches are allowed:
/Terse just list font names (the default)
/Medium list additional info (B=bold,M=medium,L=light,I=italic,#=point size)
/Verbose list lots of information
\
'DSK ' ;Device is for NOIFIL
WIDFIL: 'FONTS '
'WID '
0
' 1 3'
;;FTYPMD is mode of font name typing. -1 terse, 0 medium, 1 verbose.
T.NAME__1 ;type field meaning this is a name
T.WIDI__4 ;type field meaning this is a WidthIndexEntry
FONTEX: OUTSTR CRLF ;No more fonts
RELEAS TCHAN, ;let go of file
RET
;here via XCT OUTXCT
CNTOUT: OUTCHR A ;type char
ADDI C,1 ;count column position
RET
;new version, reads whole FONTS.WIDTHS file into core before continuing.
FONTS: SETOM FTYPMD ;assume terse mode
MOVEI B,0
PUSHJ P,FSWIT ;look for switches
JUMPN A,NOPARS ;at end, no parse unless eof
MOVE A,[CALL CNTOUT] ;routine to type char and count cols
MOVEM A,OUTXCT ;set up output routine
SETOM FPREV ;no previous font yet
MOVE D,[WIDFIL,,A]
MOVEI R,WIDFIL-1
CALL TOPEND ;Open font-widths file on TCHAN in dump mode
JRST NOIFIL ;Failed
JUMPE D,NOIFIL ;zero length is silly!
MOVE A,.JBFF ;here's where we'll read the file into
ADD A,D ;need this much room
CAMG A,.JBREL ;got enough core already?
JRST FONTS0 ;yes
CORE A, ;no, get it
JRST NOCORE
FONTS0: MOVE A,.JBFF
SUBI A,1 ;make iowd address
MOVN B,D ;negative file length
HRL A,B ;make iowd
MOVEI B,0
INPUT TCHAN,A ;read whole file
CAIA
JRST INERR ;input error
MOVE A,.JBFF
HRLI A,441000 ;make byte pointer to beginning of file
MOVEM A,BPOINT ;store initial pointer
LSH D,2 ;change word count to byte count for file
MOVEM D,BCOUNT ;store count for end check
HRROI A,[6000,,D] ;Get tty width
TTYSET A, ;Get width
SUBI D,=20 ;Allow room for max length fontname
MOVEI C,0 ;start with whole width of line for output
MOVEM P,EOEP ;save P for restoration on end of entry
MOVEI A,FONTSL
MOVEM A,EOEPC ;set PC to go to on end of entry
MOVEI A,FONTEX
MOVEM A,EOFPC ;set PC to go to on end of file (end of string)
FONTSL: CALL BGET0 ;Get char from file, this is byte (4) type,length1
MOVE R,A ;Save type
CALL BGET0 ;Get remaining length bits, for entry, in 16-bit wds
MOVE B,A ;Save length
DPB R,[POINT 4,B,27] ;make 12-bit length value
LSH R,-4 ;flush length bits, leave 4 type bits
LSH B,1 ;Convert to 8-bit byte count
SUBI B,2 ;Discount two bytes already read
CAIN R,T.NAME ;Is this a font name?
JRST FNAME ;yes
CAIN R,T.WIDI ;WidthIndexEntry?
JRST FWIDI ;yes
FONTNS: CALL BGET ;Ignore final bytes of entry
JRST FONTNS ;Keep reading until BGET notices end of entry
FNAME: CALL BGETWD ;get 16-bit word
CAIL A,NNAMES ;too big for our table?
JRST FONTNS ;yes, ignore this name
MOVE S,BPOINT ;get current byte pointer
MOVEM S,PNAMES(A) ;and save as pointer to name
SKIPL FTYPMD ;skip if just listing name
JRST FONTNS
CALL TYFNAM ;type name
TRO C,7 ;Adjust col position for next tab
ADDI C,1 ;Tab col
CAMG C,D ;Room on line for another name?
JRST FONTAB ;Yes, just output tab
OUTSTR CRLF
TDZA C,C ;Starting new line
FONTAB: OUTCHR [11] ;Type a tab between font names
JRST FONTNS
FWIDI: SKIPGE FTYPMD ;typing more than just name?
JRST FONTNS ;no, skip this stuff
CALL BGET ;get family name code
CAIGE A,NNAMES ;in our range?
SKIPN S,PNAMES(A) ;yes, have we seen name?
JRST FONTNS ;no, ignore width entry
SKIPLE FTYPMD
JRST FWIDI2 ;verbose mode, use new line
CAMN A,FPREV
OUTSTR [ASCIZ/, /]
CAMN A,FPREV ;same as prev font
JRST FNONAM ;yes, avoid typing name again
FWIDI2: SKIPL FPREV ;skip if no previous font
OUTSTR CRLF ;end previous font
MOVEI C,0 ;back to col 0
MOVEM A,FPREV
CALL TYFNAM ;type font name, using byte pointer in S
OUTCHR [" "]
CAIGE C,=13
AOJA C,.-2
FNONAM: CALL BGET ;get face code
MOVEI S,[ASCIZ/X/] ;Xerox (0)
CAIL A,=18
MOVEI S,[ASCIZ/A/] ;ASCII (18)
CAIL A,=36
MOVEI S,[ASCIZ/O/] ;other (36)
SKIPLE FTYPMD ;only type in verbose mode
OUTSTR (S)
MOVEI S,=18
CALL DISCNT
MOVEI S,[ASCIZ/R/] ;regular (0)
CAIL A,6
MOVEI S,[ASCIZ/C/] ;condensed (6)
CAIL A,=12
MOVEI S,[ASCIZ/E/] ;expanded (12)
SKIPLE FTYPMD ;only type in verbose mode
OUTSTR (S)
MOVEI S,6
CALL DISCNT
MOVEI S,[ASCIZ//] ;medium (0)
SKIPLE FTYPMD ;only type in verbose mode
MOVEI S,[ASCIZ/ /] ;medium (0)
SKIPN FTYPMD ;only type in medium mode
MOVEI S,[ASCIZ/M/] ;medium (0)
CAIL A,2
MOVEI S,[ASCIZ/B/] ;bold (2)
CAIL A,4
MOVEI S,[ASCIZ/L/] ;light (4)
OUTSTR (S)
MOVEI S,[ASCIZ//] ;regular (0)
SKIPLE FTYPMD ;only type in verbose mode
MOVEI S,[ASCIZ/ /] ;regular (0)
TRNE A,1
MOVEI S,[ASCIZ/I/] ;italic (1)
OUTSTR (S)
CALL BGET ;beginning char code
SKIPLE FTYPMD ;only type in verbose mode
OUTSTR [ASCIZ/ bc=/]
SKIPLE FTYPMD ;only type in verbose mode
CALL PROCT ;print octal char
CALL BGET ;ending char code
SKIPLE FTYPMD ;only type in verbose mode
OUTSTR [ASCIZ/ ec=/]
SKIPLE FTYPMD ;only type in verbose mode
CALL PROCT ;print octal char
CALL BGETWD ;get two bytes as size word
JUMPE A,FNOSIZ
PUSH P,A+1
IDIVI A,=35 ;convert from micas to points, approx.
POP P,A+1
SKIPLE FTYPMD ;only type in verbose mode
OUTSTR [ASCIZ/ size=/]
SKIPL FTYPMD ;type unless terse mode
CALL PRDEC ;print decimal size
FNOSIZ: CALL BGETWD ;get two byte as rotation
JUMPE A,FNOROT ;jump if not rotated
PUSH P,A+1
IDIVI A,=60 ;convert from minutes to degrees
POP P,A+1
OUTSTR [ASCIZ/ rot=/]
CALL PRDEC
FNOROT: CALL BGT2WD ;get 2-wd segment address
MOVE S,.JBFF ;get beginning address of file
HRLI S,442000 ;make byte pointer, 16-bit bytes
ADDI A,2 ;skip FBBox and FBBoy
ADJBP A,S ;make byte pointer to FBBdx (when Incr'd)
MOVEM A,S ;adjusted byte pointer
ILDB A,S ;get FBBdx
SKIPG FTYPMD ;only type in verbose mode
JRST NOFIXY
OUTSTR [ASCIZ/ FBBdx=/]
CALL PRDEC ;print in decimal
ILDB A,S ;get FBBdy
OUTSTR [ASCIZ/ FBBdy=/]
CALL PRDEC ;print in decimal
ILDB R,S ;get flag word
ILDB A,S ;get first Xwidth
TRNN R,100000 ;fixed Xwidth?
JRST NOFIXY ;no, avoid finding where Y widths begin
JUMPE A,NOFIXX ;don't mention zero width
OUTSTR [ASCIZ/ X-width=/]
CALL PRDEC
NOFIXX: ILDB A,S ;get first Ywidth
JUMPE A,NOFIXY ;don't mention zero width
TRNN R,40000 ;fixed Ywidth?
JRST NOFIXY ;no
OUTSTR [ASCIZ/ Y-width=/]
CALL PRDEC
NOFIXY: JRST FONTNS
;Type string pointed to by S. First byte is string length.
TYFNAM: ILDB R,S ;Get byte containing length of font name
TYFNA2: ILDB A,S ;Get font name char
OUTCHR A ;Type char
ADDI C,1 ;record line width
SOJG R,TYFNA2 ;Loop typing font name
RET
DISCN2: SUBI A,(S)
DISCNT: CAIL A,(S) ;call here to reduce A to less than (S)
JRST DISCN2
POPJ P,
;get one byte, return in A, skip unless eof
BGET: SOJL B,BGET2 ;jump if end of entry
BGET0: SOSGE BCOUNT ;any more bytes?
JRST BGET3 ;nope, eof
ILDB A,BPOINT ;yes, get one
POPJ P,
BGET2: MOVE P,EOEP ;restore P to right level
JRST @EOEPC ;return to right place for end of entry
BGET3: MOVE P,EOEP ;restore P to right level
JRST @EOFPC ;return to right place for end of file
;get two bytes, return as 16-bit word in A, skip unless eof
BGETWD: CALL BGET ;first byte
LSH A,8 ;shift first byte over to high position
PUSH P,A
CALL BGET ;second byte
IOR A,(P) ;combine bytes
ADJSP P,-1
POPJ P,
;get two words, return as 32-bit value in A, skip unless eof
BGT2WD: CALL BGETWD ;first word
LSH A,=16 ;shift first word over to high position
PUSH P,A
CALL BGETWD ;second word
IOR A,(P) ;combine words
ADJSP P,-1
POPJ P,
FGTSWT: CALL GETSIX ;get a sixbit switch name & delim.
MOVE C,[-FSWTLN,,FSWTAB]
CALL TBLUK ;perform table lookup
SKIPL C
SUBI C,FSWTAB
HRRZ C,FSWDSP(C)
CALL (C)
FSWIT: CAIN A,"/" ;more switches?
JRST FGTSWT ;yes: do that too.
RET
;NOTE: Switch handing routines must return A unchanged, or as the next character
DEFINE SWLST<
SWMAC(TERSE,TERSET)
SWMAC(VERBOSE,VERSET)
SWMAC(MEDIUM,MEDSET)
>
DEFINE SWMAC(NAME,DISP) <<SIXBIT/NAME/>>
FSWTAB: SWLST
FSWTLN==.-FSWTAB
DEFINE SWMAC(NAME,DISP) <0,,DISP>
ILLSWT ;unknown switch
AMBIGS ;ambiguous switch
FSWDSP: SWLST
DEFINE SWMAC(NAME,DISP) <[ASCIZ/NAME
/]>
FSWNAM: SWLST
TERSET: SETOM FTYPMD ;terse mode
RET
VERSET: MOVEI B,1
MOVEM B,FTYPMD ;verbose mode
RET
MEDSET: SETZM FTYPMD ;medium mode
RET
>;IFE FTNXP
;CHKPRS CHKPR1 CHKPR2 CHKPR3 CHKPR5 CHKPR6 CHKPR7 CHKPR8 PRBCPS PRBCP1 INFODD INFOPD INFPD1 CHKPSW
SUBTTL PRESS FILES
;here to check that a given file is truly a press file.
CHKPRS: CALL CHKPSW ;Check password in file
JSP T,BADPRS
CAI [ASCIZ/Press file general password is invalid./]
MOVE B,FBSIZ(R) ;size of file
TRNE B,177
JSP T,BADPRS
CAI [ASCIZ/Press file length must be a multiple of 512 bytes./]
LDB B,DDRECT ;get the total record count
CAME B,A ;must match our idea
JSP T,BADPRS
CAI [ASCIZ/File size does not match document directory's record count./]
LDB A,DDPART ;part count of this file
MOVEM A,PARTCN ;save part count
CALL INFODD ;type info about doc dir on tty
LDB A,DDPDRN ;get record number of part dir
USETI ICHAN,1(A) ;set to point to part dir
IFN FTNXP,<
MOVNI B,(A)
ADD B,XFILEN
MOVEM B,XBLOCK ;let Qspool know where we are
SKIPE STOP
JRST SPAUS2 ;abort listing quickly
>;IFN FTNXP
LDB A,DDPDRC ;record count of parts dir
MOVE B,PARTCN ;total part count
LSH B,1 ;2 PDP-10 words per part
LSH A,7 ;convert rc to word count
MOVEM A,PDWRC ;save part dir word count
CAMGE A,B ;part dir must be large enough
JSP T,BADPRS ;to hold all the parts
CAI [ASCIZ/Part directory is not large enough to hold all the parts./]
MOVN B,A ;-WC
HRLZ B,B ;-WC,,
HRR B,.JBFF ;-WC,,first free address
HRRZM B,PDBASE ;save base address of part directory
SUBI B,1
MOVEI C,0 ;IO command list in B and C
ADD A,.JBFF
MOVEM A,.JBFF
CAMG A,.JBREL ;does it fit in memory?
JRST CHKPR1 ;yes.
CORE A, ;ask for more core
JSP T,NOCORE ;failure
CHKPR1: INPUT ICHAN,B ;read data into memory
IFN FTNXP,<
SOS XBLOCK
SKIPE STOP
JRST SPAUS2 ;abort listing quickly
>;IFN FTNXP
SETZM PAGECN ;count of page parts
SETZM FNTDCN ;Count of font directory parts
SETZM UNKPCN ;count of parts (of type) unknown
MOVN D,PARTCN
HRLZ D,D ;-part count,,0
HRR D,PDBASE ;-Part Count,,Address of part dir
CHKPR2: LDB A,[POINT 16,(D),15] ;get part type
JUMPE A,[AOS PAGECN
JRST CHKPR3]
SOJE A,[AOS FNTDCN ;count a font directory part
HRRZM D,FNTDAD ;save address of FD part
JRST CHKPR3]
AOS UNKPCN ;unknown part
CHKPR3: ADD D,[1,,2] ;count one part seen, advance to next
JUMPL D,CHKPR2
CALL INFOPD ;print info from part directory
MOVE A,FNTDCN
CAIE A,1 ;must be only one font directory
JSP T,BADPRS
CAI [ASCIZ/Not precisely one Font Directory./]
ADD A,UNKPCN
ADD A,PAGECN
CAME A,PARTCN
JSP T,BADPRS ;part count inconsistent.
CAI [ASCIZ/Part count is inconsistent./]
;now, allocate a block of space for the page pointers
MOVE A,.JBFF
MOVEM A,PGARRY
SOS PGARRY ;offset to zero-origin indexing
ADD A,PAGECN
MOVEM A,.JBFF
CAMG A,.JBREL
JRST CHKPR5
CORE A,
JSP T,NOCORE
CHKPR5: MOVE C,PGARRY ;base of page pointer array
MOVN D,PARTCN ;
HRLZ D,D ;-part count,,0
HRR D,PDBASE ;-Part Count,,Address of part dir
CHKPR6: LDB A,[POINT 16,(D),15] ;get part type
JUMPN A,CHKPR7 ;jump unless a printing page
ADDI C,1
HRRZM D,(C) ;store address of this part
CHKPR7: ADD D,[1,,2] ;count one part seen, advance to next
JUMPL D,CHKPR6
;convert the page ranges table to something reasonable.
MOVSI C,1
HRR C,PAGECN ;store value of last page for *
SKIPE A,PRIDX
JRST CHKPR8 ;non zero count to process
MOVEM C,PRBUF ;1,,* in slot 0
AOS A,PRIDX
CHKPR8: HLRO B,PRBUF-1(A)
AOSN B
HRLM C,PRBUF-1(A)
HRRO B,PRBUF-1(A)
AOSN B
HRRM C,PRBUF-1(A)
SOJG A,CHKPR8
RET
;Print a BCPL string from file
PRBCPS: ILDB B,C ;get byte count
JUMPE B,CPOPJ
PRBCP1: ILDB A,C
XCT OUTXCT ;CALL PUTCHR or OUTCHR A
SOJG B,PRBCP1
RET
INFODD: MOVEI B,[ASCIZ/File name = /]
CALL PUTSTR
MOVE C,DDFNAM
CALL PRBCPS ;print BCPL String
MOVEI B,[ASCIZ/
Created by /]
CALL PUTSTR
MOVE C,DDFCRE
CALL PRBCPS ;print BCPL String
MOVEI B,[ASCIZ/
on /]
CALL PUTSTR
MOVE C,DDFDAT
CALL PRBCPS ;print BCPL String
MOVEI B,[ASCIZ/
Total of /]
CALL PUTSTR
MOVE A,PARTCN
CALL PRDEC
MOVEI B,[ASCIZ/ parts in this file
/]
CALL PUTSTR
RET
INFOPD: MOVEI B,[ASCIZ/Count of parts:
Printing Pages: /]
CALL PUTSTR
MOVE A,PAGECN
CALL PRDEC
MOVEI B,[ASCIZ/
Font Directory part: /]
CALL PUTSTR
MOVE A,FNTDCN
CALL PRDEC
SKIPG A,UNKPCN
JRST INFPD1
MOVEI B,[ASCIZ/
Parts of Unknown type: /]
CALL PUTSTR
MOVE A,UNKPCN
CALL PRDEC
INFPD1: MOVEI B,CRLF
JRST PUTSTR
CHKPSW: MOVE A,FBSIZ(R) ;word count of input file
ADDI A,177 ;adjust for last record maybe short
LSH A,-7 ;convert to record count (rn of last r)
USETI ICHAN,(A) ;first record is number one
INPUT ICHAN,[IOWD 200,DPAGE ;read last record
0]
LDB B,DDPASS ;get password from DPAGE
CAIN B,GENPAS
AOS (P)
RET
;H.DOVR Example DOVER DOVGO
SUBTTL DOVER Command
IFE FTNXP,<
H.DOVR: ASCIZ \
The DOVER command transmits a file to the Dover printer. The file may be
either a Press file or a plain text file. In either case, a page range
may be selected as in the PART command. (See also the description of the
PART command, with HELP PART.)
If the specified file is NOT a Press file, it will be converted as in the
EMPRESS command, with output sent to the DOVER. EMPRESS switches as well
as DOVER switches may be applied. (Say HELP EMPRESS for list of EMPRESS
switches and further description of the EMPRESS command.) Note that with
a Press file, EMPRESS switches are irrelevant and ignored since a Press
file contains all of its own formatting information.
Example:
DOVER INFILE(5:16)
Switches available in the DOVER command:
/Copies=nn The Dover will print the specified number of copies.
See also the switches available in EMPRESS (say HELP EMPRESS).
\
DOVER: CALL CPARSE ;Parse command arguments
MOVEI R,OFBLK
SKIPE FBNAM(R) ;no file name is allowed as dest
JRST NOPARS
SKIPE A,FBDEV(R) ;no device name
CAMN A,['DSK '] ;except CPARSE may invent DSK
SKIPA A,['DOVER '] ;invent internal name for device
JRST NOPARS ;anything else is an error
>;IFE FTNXP
IFN FTNXP,<
;Spooler enters here with PUSHJ P,DOVGO
^DOVGO: MOVEI R,OFBLK
MOVE A,['DOVER '] ;Here to print on Dover
>;IFN FTNXP
MOVEM A,FBDEV(R) ;store new device name
MOVEI A,0
DSKPPN A,
MOVEI R,IFBLK ;prepare input side
SKIPN FBPPN(R)
MOVEM A,FBPPN(R)
PUSHJ P,GETIPR ;open the file
PUSHJ P,CHKPSW ;Check for a press password
JRST EMPRS0 ;Not a press file. Convert it
JRST PART0 ;Already in press. Do parts.
;DVROPN SOCKIT TOME PUPCLS PUPPUT PUPPU1 PUPPU2 PUPPU3 SNDPUP OSEND REPWAT DLOOP DALLY DALLY1 BADTYP BADTY0 BADTY1 ABTPUP BADT1 BADLP BADT2 ERRPUP ABTDSP ABTDTN NOTSPL RBUSY SPAUSE SPAUS2 MDELAY SUPXMT PRTHST GETCHK GETCK1 CHKCHK PUTCHK ERR06 ERR07 ERR08 PUPOER PPOER1
SUBTTL Ethernet transmissions to Dover
DVROPN: MOVEI A,17
MOVSI B,'PUP'
MOVEI C,0
MOVEM B,FBDEV(R) ;save real device name
OPEN OCHAN,A
JRST NSDERR
PUSH P,[PUSHJ P,PUPPUT]
PUSH P,[PUSHJ P,PUPCLS]
POP P,CLSXCT
POP P,PUTXCT
MOVEI A,DVRHST
MOVEM A,HOST
MOVEI PUP,PUPOUT
DPB A,PUPDHN ;store destination host number
MOVEI A,EFSOCK ;well-known socket number for EFTP
MOVEM A,FSOCK ;as the foreign socket number
DPB A,PUPDS2 ;low order socket number
MOVEI A,0
DPB A,PUPDS1 ;zero for high-order socket number
MOVEI C,0 ;count of socket attempts
SOCKIT: TIMER A, ;get real time in 1/60th sec
PJOB B, ;our job number
LSH A,7 ;move over time
IOR A,B ;OR in job number
MOVEM A,LSOCK ;our local socket number
DPB A,PUPSSK ;store "unique" local socket num
LOOKUP OCHAN,PUPBL ;Link our socket to 0#host#20
SKIPA
JRST TOME ;ok.
CAIL C,4
JRST ERR07 ;can't wait forever
MOVE A,[DOVSOK,,1]
CALL SPAUSE ;sleep some
AOJA C,SOCKIT
TOME: MOVEI A,.PTEDA ;EFTP Data type pup
DPB A,PUPTYP
MOVEI A,0
DPB A,PUPTRN ;zero transport ctl
SETOM PREVID ;set previous id to -1, indicating no prev
RET
PUPCLS: MOVEI PUP,PUPOUT
MOVEI A,.PTEEN ;EFTP END command
DPB A,PUPTYP
MOVEI B,0 ;pup data length = 0, only a header
CALL SNDPUP ;send it
MOVEI PUP,PUPOUT
MOVEI A,.PTEEN ;Second EFTP END command
DPB A,PUPTYP
AOS A,PREVID
DPB A,PUPID ;2nd end has next id number, all else the same
OUTPUT OCHAN,PUPOUT ;send it out
STATZ OCHAN,740000 ;check that all is well
JRST PUPOER
OUTSTR [ASCIZ/The Dover has accepted this file. Please pick up your output.
/]
RELEASE OCHAN,
IFN FTNXP,<
SETOM NWAIT ;successful, so minimize waiting next time
>;IFN FTNXP
RET
PUPPUT: MOVEM A,PUPIOW ;Save IOWD to data to send
PUSHJ P,PSHACS ;Save all ACs (Co-routine)
PUPPU1: SKIPL A,PUPIOW ;Any data left to send?
RET ;All done
MOVEI B,0 ;Count of words actually sent
MOVEI PUP,PUPOUT ;Aim at output pup block
MOVE C,PUPBDT ;Initial byte pointer to 32-bit data
PUPPU2: LDB D,[POINT 32,1(A),31] ;Get a data byte from the "file"
IDPB D,C ;Store in pup buffer
ADDI B,1 ;Count a byte (word) sent
AOBJP A,PUPPU3 ;Advance to next "file" word. or exit
CAIGE B,200 ;Sent enough in this packet?
JRST PUPPU2 ;Not yet.
PUPPU3: MOVEM A,PUPIOW ;Save IOWD to remainder of data
PUSHJ P,SNDPUP ;Send this pup, get response.
JRST PUPPU1 ;Loop until IOWD done.
SNDPUP: LSH B,2 ;change word count to byte count
ADDI B,=22 ;count overhead bytes in header
DPB B,PUPLEN ;put in length
AOS A,PREVID ;increment ID for pup
DPB A,PUPID ;put it in pup
CALL PUTCHK ;put in checksum
SETZM NOACK ;zero count of non-acknowledgement
OSEND: OUTPUT OCHAN,PUPOUT ;repeat send to Spruce
STATZ OCHAN,740000 ;any error
JRST PUPOER ;yes. lose.
REPWAT: MOVEI X,2 ;wait 1 second or so.
ACCTIM C, ;get time and date
DLOOP: MOVEI A,0 ;sleep for 1/60 sec.
SLEEP A,
MTAPE OCHAN,MTADR ;see if input waiting
JRST DALLY ;nothing there yet.
INPUT OCHAN,PUPMSG ;read our pup
STATZ OCHAN,740000
JRST ERR06
MOVEI PUP,PUPMSG ;current pup is the one just read
CALL CHKCHK ;check the checksum
JRST REPWAT ;wait for something better
LDB A,PUPTYP
CAIE A,.PTEAK ;is it acknowledgement?
JRST BADTYP ;nope.
LDB A,PUPID ;get the ID
CAME A,PREVID ;is this the right ack?
JRST REPWAT ;wrong ack. go wait for another.
IFN FTNXP,<
SETOM NWAIT ;clear number of times we've failed
PUSH P,[STBUSY]
POP P,STATUS ;restore busy status, in case waited
>;IFN FTNXP
RET
;Wait for an input pup to be ready
DALLY: ACCTIM D, ;get new time
SUB D,C ;subract old time
CAMGE D,X ;see if greater than limit in X
JRST DLOOP ;keep waiting
AOS A,NOACK ;count no acknowledge
CAIGE A,3
JRST OSEND
TRNE A,10
JRST DALLY1 ;never acknowledgement
MOVEI A,1 ;wait one second
SLEEP A,
JRST OSEND
DALLY1: CAIGE A,100
SKIPE PREVID
JRST ERR08 ;no resp in the middle of transmission.
OUTSTR [ASCIZ/Waiting... /]
IFN FTNXP,<
AOS A,NWAIT ;make us wait longer and longer if
CAILE A,100 ; spooler continues to lose
MOVEI A,100 ;don't wait longer than 64 secs
CAIGE A,10 ;nor less than 8 secs
>;IFN FTNXP
MOVEI A,10 ;wait at least this many seconds
HRLI A,DOVWAT
CALL SPAUSE ;sleep some
JRST OSEND
BADTYP: PUSH P,OUTXCT
PUSHJ P,OUTSET ;must set to tty output
CALL BADTY1
JRST BADTY0 ;wait some more.
SETZM NOACK ;retransmit. no non-acknowledgements
OUTPUT OCHAN,PUPOUT ;repeat send to Spruce
STATZ OCHAN,740000 ;any error?
JRST PUPOER ;yes. lose.
BADTY0: POP P,OUTXCT
JRST REPWAT
;from here, either go die, or no-skip to wait for reply, or skip 1 to send again
BADTY1: LDB B,PUPLEN ;get length
SUBI B,=22 ;get data length.
MOVE C,PUPDAT ;data byte pointer
LDB A,PUPTYP ;get the pup type again
CAIN A,.PTERR ;error Pup?
JRST ERRPUP
CAIN A,.PTEAB ;Abort?
JRST ABTPUP
OUTSTR [ASCIZ/?A pup of type /]
LDB A,PUPTYP
CALL PROCT
OUTSTR [ASCIZ/ from /]
CALL PRTHST
OUTSTR [ASCIZ/ has been received, and will be discarded.
/]
RET
ABTPUP: SUBI B,2
PUSH P,B ;the string length after the error word
ILDB A,C ;get the error byte
ILDB B,C
LSH A,8
ADD A,B
POP P,B
CAIGE A,ABTDTN ;abort dispatch table length
XCT ABTDSP(A) ;Don't come back, except to die.
PUSH P,B ;the string length after the error word
OUTSTR [ASCIZ/Abort code /]
CALL PROCT
OUTCHR [" "]
POP P,B ;error string count
BADT1: JUMPLE B,BADT2
BADLP: ILDB A,C ;get a data byte
OUTCHR A
SOJG B,BADLP ;go until done.
BADT2: OUTSTR CRLF
OUTSTR [ASCIZ/Transmission terminated unsucessfully
/]
JSP K,RESTAR ;lose. can't go any further
;here for an ERROR PUP (Pup type = 4). Read error code (data word =10 of packet)
ERRPUP: LDB A,[POINT 16,13(PUP),15] ;Get the error code.
CAIE A,1 ;Skip if it's a checksum error
CAIN A,3 ;Skip unless resource limit at destination
JRST CPOPJ1 ;retransmit this pup...
OUTSTR [ASCIZ/Error pup, error code = /]
CALL PROCT
OUTSTR [ASCIZ/ /]
ADDI C,6 ;skip 6 words of binary
SUBI B,=24 ;account this in byte count
JRST BADT1 ;go die
ABTDSP: JFCL ;Abort code 0: unknown
JFCL ;1: External Sender abort. Unk.
OUTSTR [ASCIZ/File rejected by Spruce Server. /]
;;The thing is that hardware errors sometimes
;;cause a perfectly good file to be rejected.
;; OUTSTR [ASCIZ/File rejected by Spruce Server. Do not send it again. /]
JRST RBUSY ;3: receiver busy abort. try later
OUTSTR [ASCIZ/Out of sequence: try the whole transmission again. /]
JFCL ;5: unknown
PUSHJ P,NOTSPL ;6: not printing or not spooling
JRST MDELAY ;7: medium wait delay
JRST SUPXMT ;8: suspend transmission
ABTDTN==.-ABTDSP
NOTSPL: OUTSTR [ASCIZ/Dover is not printing or not spooling. Try much later. /]
IFN FTNXP,<
MOVE A,[DOVNOS,,100]
CALL SPAUSE ;We'll wait a while before giving up
>;IFN FTNXP
POPJ P,
RBUSY: OUTSTR [ASCIZ/Receiver is busy with another request. I'll wait.
/]
MOVE A,[DOVBSY,,12]
CALL SPAUSE ;sleep some
JRST CPOPJ1 ;try again
SPAUSE:
IFN FTNXP,<
SKIPE STOP
JRST SPAUS2
PUSHJ P,ENDTIM ;don't charge this time to the user
HLRZM A,STATUS
>;IFN FTNXP
MOVEI A,(A)
SLEEP A,
IFN FTNXP,<
PUSHJ P,BEGTIM ;resume charging user for time
>;IFN FTNXP
RET
IFN FTNXP,<
;Here when requested to stop current listing
SPAUS2: RELEAS OCHAN,
JSP K,RESTAR ;take error return back to NXP
>;IFN FTNXP
MDELAY: OUTSTR [ASCIZ/Spruce server has requested a delay. I'll wait...
/]
MOVE A,[DOVDLY,,50] ;spruce server requested a delay
CALL SPAUSE ;sleep some
JRST CPOPJ1
SUPXMT: OUTSTR [ASCIZ/Spruce server requests a suspension. I'll dally...
/]
MOVE A,[DOVSUS,,24]
CALL SPAUSE ;sleep some
JRST CPOPJ1
;Print source net#host# from PUP
PRTHST: LDB A,PUPSNT ;source net
CALL PROCT
MOVEI A,"#"
XCT OUTXCT
LDB A,PUPSHS ;source host
CALL PROCT
MOVEI A,"#"
XCT OUTXCT
RET
;Generate checksum for PUP pointed to by ac PUP, return in ac1
;Checksum is generated by "ones-complement left add-and-cycle"
;Clobbers ac's A,B,C,D. Returns in C a byte pointer to the checksum word.
GETCHK: LDB D,PUPLEN ;get pup length
ADDI D,1 ;round up for possible garbage byte
LSH D,-1 ;divide by two for 16-bit word count
SUBI D,1 ;don't look at checksum word
MOVE C,[POINT 16,1(PUP)] ;first word for checksum
MOVEI A,0 ;use to accumulate checksum
GETCK1: ILDB B,C ;get a word
ADD A,B ;add it into ac2
TRZE A,200000 ;zero overflow bit, skip if it wasn't set
ADDI A,1 ;add overflow bit for 1's-complement sum
LSH A,1 ;shift bits left
TRZE A,200000 ;skip if overflow bit not set, zero it
ADDI A,1 ;add it in on right
SOJG D,GETCK1 ;go until we are done
CAIN A,177777 ;see if -0
MOVEI A,0 ;make into real 0
RET
;CHKCHK checks a checksum from ac PUP, returns +1 on failure, +2 on success.
CHKCHK: CALL GETCHK ;compute checksum of this pup into A.
ILDB B,C ;get the actual received checksum
CAIE B,177777 ;Skip if there's no checksum given
CAMN A,B ;do they match?
JRST CPOPJ1 ;yes, ok.
OUTSTR [ASCIZ/A PUP with a bad checksum was received. It will be ignored.
/]
RET
;PUTCHK computes checksum and enters it in pup in (PUP)
PUTCHK: PUSH P,B ;save it
PUSH P,C
CALL GETCHK ;get checksum to ac1
IDPB A,C ;put it in place
POP P,C
POP P,B ;restore it
RET
ERR06: OUTSTR [ASCIZ\I/O error while reading an acknowledge
\]
RELEAS OCHAN,
JSP K,RESTAR
ERR07: OUTSTR [ASCIZ/Four attempts to make a unique socket have failed.
Get a wizard.
/]
RELEAS OCHAN,
JSP K,RESTAR
ERR08: OUTSTR [ASCIZ/The dover doesn't acknowledge my transmissions.
I give up.
/]
RELEAS OCHAN,
JSP K,RESTAR
PUPOER: STATO OCHAN,200000 ;IODERR set?
JRST PPOER1 ;unknown error
OUTSTR [ASCIZ/Console PDP-11 sick. You need a wizard.
/]
RELEAS OCHAN,
JSP K,RESTAR
PPOER1: OUTSTR [ASCIZ/Unknown error status from OUTPUT to PUP:
/]
RELEAS OCHAN,
JSP K,RESTAR
IFN FTNXP,< BEND PRESS ;> END START