/ FORM--FORMAT PRINTING PROGRAM / FORMAT PRINTING PROGRAM / TO PRINT OUT DOCUMENTATION / FORM LETTERS, OR TABLES / WRITTEN BY: / CLYDE G. ROBY, JR. / DEPARTMENT OF MEDICINE / WEST VIRGINIA UNIVERSITY / MORGANTOWN, WEST VIRGINIA / MARCH, 1970 / MODIFIED BY D. J. DUFFY NOV 1970 / MODIFIED BY C. G. ROBY, JR. JUNE 1971 / TO RUN UNDER LAP6/DIAL-WVU / MODIFIED BY C. G. ROBY, JR. MARCH 1972 / TO RUN UNDER PS/8 AGAIN / MODIFIED BY C. G. ROBY, JR. MAY 1972 / FOR NEW INPUT ROUTINE / MODIFIED BY T. W. MCINTYRE 17 AUG 1972 / FOR MULTIPLE COPIES /MODIFIED BY TMC DECEMBER 1972 FOR ROBY'S L.A. CHANGES /AND EVEN ODD CAPABILITY / MODIFIED BY C. G. ROBY, JR. AUGUST, 1973 / FIXED A LOT OF BUGS; PUT RELATIVE NUMERIC ARGS IN / NEW COMMAND TO DEFINE DOCUMENT PARAMETERS / MODIFIED BY C. G. ROBY, JR. SEPTEMBER, 1973 / MADE BOTTOM & TOP OF PAGE BREAK LOGICALLY CONSISTENT / MODIFIED BY C. G. ROBY, JR. MAY, 1974 / PROGRAM CAN BE CHAINED TO, NOW / ALSO FIXED UP PAGE NUMBERING TO PRINT NOS. > 99 PMODE /PROGRAM WRITTEN IN PDP8 MODE FIXMRI INC=2000 /ISZ WHEN NOT EXPECTED TO SKIP FIXTAB OBUFL=400 /OUTPUT BUFFER LENGTH AOBUFL=OBUFL^3%2 /CHARS IN OBUFL IBUFL=1000 /INPUT BUFFER LENGTH *20 PAGSWT, 0 /EVEN ODD PAGE SWITCH NUMFLG, 0 /ASCBIN USES THIS FOR =0 KCHAR, 0 COUNT, 0 OUTPUT, 0 OUTCTR, 0 CTR1, 0 CTR2, 0 PTR1, 0 PTR2, 0 CURCOL, 0 SIGN, 0 RELFLG, 0 CVRTQ, 0 TEMP, 0 CPTR, 0 ASCHAR, 0 NUMBER, 0 USWITC, 0 /U SWITCH, FORCE OUTPUT TO UPPER CASE ASCIIC, 0 /UNINITIALIZED VALUES GO BELOW HERE NSPACE, 0 /VALUES INITIALIZED TO 0 BEGIN HERE HFILL, 0 BTSWIT, 0 PAGPFG, 0 MCOUNT, 0 LETLOW, 0 /INHIBIT UPPER CASE TABPTR, 0 SAVCTR, 0 EXTCTR, 0 OFCOL, 0 TOPCT, 0 TABCOL, 0 TABCHR, 0 PCOUNT, 0 JUSTIFY, 0 /0000 TO JUSTIFY MARGINS CASE, 0 /LOWER CASE = 0, ASSUMED UQCASE, 0 UPCASE, 0 UPFSTC, 0 UPFST, 0 INCHAR, 0 UPFIRST, 0 SPFIRST, 0 /7777 => OUTPUT TWO SPACES BEFORE 1ST CHR WDCASE, 0 LETCAS, 0 MSWITC, 0 /** TO 0, MULTI-LITH SWITCH EOLCTR, 0 /VALUES INITIALIZED TO 0 END HERE CRSWIT, -1 /VALUES INITIALIZED TO -1 START HERE LINECT, -1 CSPACE, -1 QTAB, -1 PAGEN, -1 /VALUES INITIALIZED TO -1 END HERE PAGECT, 0 /VALUES SPECIALLY INITIALIZED BEGIN HERE PARTAB, FTAB /INITAL VALUES GO IN INLIST OSTARM, OUTBUF-1 OSTART, OUTBUF OLAST, OUTBUF+OLENGTH-1 OEXEND, OUTEXT+OLENGTH-1 OLONG, -OLENGTH OLONGP, -OLENGTH+1 FCOLUM, 1 LCOLUM, OLENGTH /INITIALIZATION ENDS HERE DECIMAL DTABLE, -1000 -100 -10 OCTAL / DOCUMENT DEFINITION PARAMETERS DECIMAL PWIDTH, OLENGTH /WIDTH OF PAGE PLENGTH, 66 /LENGTH OF PAGE FORMAT, 0 /FORMAT OF TITLES NLINE1, 3 /NO. OF LINES FROM PAGE BREAK TO 'TOP TITLE' NLINE2, 3 /NO. OF LINES FROM 'TOP TITLE' TO BODY NLINE3, 3 /NO. OF LINES FROM BODY TO 'BOTTOM TITLE' NLINE4, 3 /NO. OF LINES FROM 'BOTTOM TITLE' TO PAGE BREAK BODYLN, 0 /CALCULATED LENGTH OF BODY OCTAL MTYPE, 0 /LITTLE ROUTINE FOR MESSAGES TLS TSF JMP .-1 CLA JMP I MTYPE GET= JMS I . XGET OUTRTN, PUT= JMS I . XPUT GETC= JMS I . XGETC BACKUP= JMS I . XPOPC SORTJ= JMS I . CCHECK SAVEC= JMS I . SAVEIT RETURN= JMP I . RETRNX PAGE / THIS IS WHERE FORM STARTS (LOC 00200) SKP CLA /THIS IS STARTING ADDRESS JMP NOVER /CHAINED TO TAD (MTYPE) JMS ASCOUT /OUTPUT FORM'S CURRENT VERSION NO. VERSION-1 STA NOVER, CIF 10 /CALL GEN I/O PACKAGE SETUP JMS I (SETUP) TEXT \DC\ /ASSUME .DC EXTENSION EOFILE /END-OF-FILE ROUTINE JMS INITLZ /MAKE IT RESTARTABLE JMS COPCHK /CHECK IF MULTIPLE COPIES RESTRT, TAD (BUFST-1 DCA 10 /SET UP TO CLEAR OUT ALL BUFFERS TAD (BUFST-BUFEND DCA COUNT /NO. OF WORDS TO CLEAR DCA I 10 /ZERO THE BUFFERS ISZ COUNT JMP .-2 JMS NEWLINE /SET UP PTRS, CTRS, ETC. CIF 10 JMS I (OTYPE) /CHECK OUTPUT DEVICE TYPE SNA CLA /IS IT TTY? JMP TTYGO /YES, READY TO GO TAD PLENGTH CIA TAD NLINE3 TAD NLINE4 /FIX UP GOOD LINE CT DCA LINECT INC PAGEN /FUDGE PAGE NUMBER, TOO NOP STA DCA BTSWIT /DO A TOP BREAK JMP NCHAR TTYGO, JMS CRLF /OUTPUT A CR/LF COMBO NCHAR, GETC TAD INCHAR /GET AN INPUT CHAR SNA JMP NCHAR /EOL, GET NEW LINE SORTJ /CHECK FOR SPACE, TAB, OR ^ SPCHRS-1 NJMPS-SPCHRS ISZ UPFIRST /FIRST CHAR OF LINE? JMP SCHAR0 /DON'T WORRY ABOUT CAPS JMS SETUPC /MAKE IT AN UPPER CASE CHAR ISZ SPFIRST /OUTPUT SPACES FIRST? JMP SCHAR0 /NO, JUST SAVE THE CHAR TAD [" ] /YES, OUTPUT TWO SPACES SAVEC TAD [" ] SAVEC SCHAR0, DCA SPFIRST /DO NOT OUTPUT SPACES FIRST SCHAR, TAD INCHAR /GET CHAR BACK SAVEC /GO SAVE CHAR IN OUTPUT TAD INCHAR /GET CHAR BACK AGAIN SORTJ /CHECK FOR ., !, OR ? ENDLIST-1 ENDJUMP-ENDLIST SCHAR1, GETC SCHAR2, TAD INCHAR /GET CHAR FROM INPUT SNA JMP EWORD /EOL SORTJ /CHECK FOR SPACE, TAB, OR ^ SPCHRS-1 EJMPS-SPCHRS JMP SCHAR /GO SAVE THE GOOD CHAR EWORD, TAD [" ] /SPACE OR TAB SAVEC /SAVE A SPACE JMP NCHAR /GET NEXT CHAR CONTROL, GETC TAD INCHAR /CHAR FOLLOWING "^" SNA JMP CONEOL /CONTROL EOL, FORCE IT SORTJ /CHECK AGAINST OTHER CHARS CLIST-1 CJMPS-CLIST TAD INCHAR /GET INPUT CHAR AND (337) /MAKE IT CAP SORTJ /CHECK IT AGAINST CONTROL CHARS AGAIN CLIST-1 CJMPS-CLIST JMS ASCBIN /TRY TO CONVERT TO BINARY TAD CVRTQ /DID CONVERSION TAKE PLACE? SNA CLA RETURN /NO CONVERSION JMS FORCE /FORCE THE LINE OUT TAD RELFLG /RELATIVE NUMBER FOR LINE NOS.? SNA CLA JMP EOL2 /NO, ABSOLUTE LINE SKIP TAD SIGN /WHICH END OF PAGE (TOP OR BOTTOM)? SMA CLA JMP EOL4 /FROM TOP OF PAGE TAD LINECT /FROM BOTTOM OF PAGE CIA EOL2, TAD NUMBER /MAKES NO. OF LINES TO SKIP EOL3, SPA SNA /MUST BE POSITIVE RETURN /IGNORE IF CAN'T DO IT ON PAGE EOL5, CIA DCA EOLCTR /SAVE COUNTER DCA I OUTPUT /ZERO TO END THE BUFFER JMS CRLF /FORCE AN EOL ISZ EOLCTR /KEEP GOING DOWN THE PAGE JMP .-2 RETURN EOL4, TAD BODYLN /FROM TOP OF PAGE TAD LINECT /(-) GET LINE NO. FROM TOP OF PAGE CIA TAD NUMBER /CAN WE GO TO LINE NO? SPA SNA RETURN /NO JMP EOL5 /YES, GO TO IT PAGE / ^- OR ^#, START A NEW PARAGRAPH BY INDENTING / TO APPROPRIATE COLUMN NPARA, JMS FORCE /FORCE EOL AND PRINT LINE JMS CRLF STA TAD PARTAB /GET PARAGRAPH TAB JMS NEWLINE /SET UP FOR NEW LINE STA DCA UPFIRST /FIRST CHAR OF PARAGRAPH IS CAPS DCA SPFIRST /FORGET ABOUT LEADING SPACES RETURN /GET NEXT PARAGRAPH / ^"..." OR ^"...(CR) / INPUT A NEW TITLE FOR TOP OF PAGE NTITLE, TAD (TITLEX-1) DCA 10 TAD (-TLENGTH) DCA CTR1 NTITL1, GETC TAD INCHAR /GET AN INPUT CHAR SNA JMP ETITLE /EOL, END OF TITLE TAD (-"") SNA CLA JMP ETITLE /", END OF TITLE TAD INCHAR DCA I 10 /SAVE GOOD CHAR IN BUFFER ISZ CTR1 /END OF TITLE? JMP NTITL1 /NO, GET MORE CHARS NTITL2, GETC /TITLE FILLED, GO TO END TAD INCHAR SNA JMP ETITLE /END OF LINE TAD (-"") SZA CLA JMP NTITL2 /KEEP HUNTING FOR END ETITLE, DCA I 10 /ZERO TO END THE TITLE RETURN / ^/N SPACE FORWARD OR BACKWARD TO THE APPROPRIATE COLUMN COLUMN, GETC /GET CHAR AFTER '/' JMS ASCBIN /CONVERT NUMBER TAD CURCOL /FIX UP FOR CURRENT COLUMN JMS RELQ /USE SUPPLIED ARGUMENT (REL OR ABS) DCA NUMBER /SAVE FOR TEMP TAD LCOLUM CIA TAD NUMBER SPA CLA /NEW COLUMN > LAST COLUMN? JMP .+3 /NOPE, OK TAD LCOLUM /YES, RESET TO LAST COLUMN DCA NUMBER COLUM4, TAD NUMBER /NOW CHECK FOR WHICH DIRECTION CIA TAD CURCOL /CURRENT COLUMN SNA /ARE WE AT THE COLUMN? JMP COLUM5 /YES SPA /PAST CURRENT COLUMN? JMP COLUM3 /NO, GO SPACE OVER CLA DCA I OUTPUT /END THE OUTPUT BUFFER JMS PRINT /PRINT BUFFER OUT, NO LINE FEED TAD (4215) PUT /OUTPUT NON-PRINTING CHAR FOR TTY TAD NUMBER /ABSOLUTE COLUM NO. CIA /MAKE IT NEG. JMS NEWLINE /GO TO THE COLUMN AND RESET TEMPORARILY RETURN COLUM3, JMS MARGIN /SPACE OVER TO CORRECT COLUMN COLUM5, TAD CURCOL DCA OFCOL /COL FOR SPACING NEATLY RETURN / ^TN1+N2,N3,N4+N5,0 / GET A NEW SET OF TAB STOPS FOR "TYPWRITER" MODE / IF NO TAB STOPS ARE PRESENT, USE WHAT WE HAVE TABTAB, TAD (TTABLE) DCA PTR1 /SET UP POINTER FOR SAVE DCA TABCOL /ZERO THE TAB COLUMN NTTAB, GETC JMS ASCBIN /GET A COLUMN TAD RELFLG /RELATIVE OR ABSOLUTE? SZA CLA JMP NTTAB2 /RELATIVE, GO ADD OR SUBTRACT TAD NUMBER /ABSOLUTE, GET THE NUMBER SNA JMP TSTART /ZERO, START OF TYPEWRITER MODE GOADD, DCA I PTR1 /SAVE TAB IN TABLE TAD I PTR1 /GET CURRENT TAB COLUMN INS PTR1 /POINT TO NEXT TABLE ENTRY DCA TABCOL /SAVE CURRENT TAB COLUMN DCA I PTR1 /ZAP NEXT LOC IN TABLE JMP NTTAB /GET NEXT TAB NTTAB2, TAD TABCOL /RELATIVE, GET CURRENT TAB COLUMN TAD NUMBER /ADD OR SUBTRACT RELATIVE VALUE JMP GOADD /AND GO SAVE IT / OUTPUT A CR/LF COMBINATION CRLF, 0 JMS BTPRTQ /PRINT TOP OF PAGE TITLE? JMS NEWLIN /RESET FOR NEW LINE TAD [215] JMS TYPEIT TAD [212] JMS TYPEIT JMP I CRLF / SPACE OVER NO. OF SPACES IN ACC / ENTER N SPACES INTO OUTPUT BUFFER MARGIN, 0 SNA JMP I MARGIN /NOTHING, JUST RETURN DCA MCOUNT /SAVE NUMBER OF SPACES TO SAVE MARG2, TAD [" ] DCA I OUTPUT /SAVE SPACES IN BUFFER INC OUTPUT INC CURCOL /INCREMENT CURRENT COLUMN INC OUTCTR NOP TAD OUTCTR SNA CLA JMP MARTN /NO MORE ROOM, RETURN ISZ MCOUNT /ALL SAVED YET? JMP MARG2 JMP I MARGIN MARTN, STA TAD OUTCTR DCA OUTCTR /DECREMENT OUTPUT COUNTER JMP I MARGIN PAGE CENTER, GETC TAD INCHAR /GET AN INPUT CHAR SNA JMP CENRET-2 /GO CENTER ON PAGE DCA I OUTPUT /SAVE CHAR IN BUFFER INC OUTPUT ISZ OUTCTR /IS BUFFER FULL? JMP CENTER /NO, KEEP GETTING CHARS GETC TAD INCHAR /YES, GO TO END OF LINE SZA CLA JMP .-3 JMS CENLIN /CENTER THE LINE JMS FORCE /OUTPUT THE LINE CENRET, TAD QTAB /WHICH MODE? SPA CLA JMP NCHAR /"NOTAB", GET NEW LINE JMP TNCHAR /"TAB", NEW INPUT LINE CENLIN, 0 /CENTER LINE IN OUTPUT BUFFER TAD OUTCTR SNA CLA /AT END OF BUFFER? JMP .+6 TAD [" ] /NO, FILL TO END DCA I OUTPUT /PUT SPACES ON REST OF LINE INC OUTPUT ISZ OUTCTR JMP .-4 TAD (OUTBUF-1) /CHECK FOR AN EMPTY LINE DCA 10 TAD LCOLUM CIA DCA OUTCTR /NO. OF CHARS ON LINE CENL1, TAD I 10 /GET A CHAR SNA JMP I CENLIN /NOTHING ON LINE TO CENTER TAD [-" ] SZA CLA /IS IT A SPACE? JMP QCEN /NO, SOMETHING ON LINE TO CENTER ISZ OUTCTR /ALL CHARS CHECKED? JMP CENL1 /NOPE QCEN, DCA CTR1 /ZERO LEFT AND RIGHT CTRS DCA CTR2 TAD OSTART /INITIALIZE LEFT AND RIGHT PTRS DCA PTR1 TAD OLAST DCA PTR2 TAD I PTR1 INC PTR1 TAD [-" ] /FIRST COUNT SPACES IN FRONT SZA CLA JMP .+3 /NON-SPACE, CHECK END INC CTR1 /INCREMENT FRONT COUNTER JMP .-6 TAD I PTR2 TAD [-" ] /COUNT SPACES FROM END OF LINE SZA CLA JMP .+6 /COMPARE RESULTS FOR SHIFT INC CTR2 /INCREMENT RIGHT COUNTER STA TAD PTR2 DCA PTR2 JMP .-10 QCENQ, TAD CTR1 /ARE WE CENTERED YET? CIA /COMPARE LEFT AND RIGHT CTRS TAD CTR2 AND (7776) /IF OFF BY 1, O.K. SNA JMP I CENLIN /END OF CENTERING, RETURN SPA CLA /WHICH WAY TO SHIFT? JMP MLEFT /SHIFT TO LEFT STA TAD OLAST DCA PTR2 /MUST MOVE TO RIGHT TAD OLONGP DCA CCTR TAD I PTR2 INC PTR2 /INCREMENT FOR STORE DCA I PTR2 /MOVE LEFT TO RIGHT CLL STA RAL /-2 TO ACC TAD PTR2 DCA PTR2 ISZ CCTR JMP .-7 TAD [" ] /SAVE A SPACE AT FRONT DCA I OSTART INC CTR1 /INCREMENT LEFT CTR STA TAD CTR2 DCA CTR2 /DECREMENT RIGHT CTR JMP QCENQ /IS IT COMPLETELY CENTERED? MLEFT, TAD OSTARM DCA 10 TAD OSTART DCA 11 TAD OLONGP DCA CCTR TAD I 11 DCA I 10 /MOVE RIGHT TO LEFT ISZ CCTR JMP .-3 TAD [" ] /SAVE SPACE AT END DCA I OLAST INC CTR2 /INCREMENT RIGHT CTR STA TAD CTR1 DCA CTR1 /DECREMENT LEFT CTR JMP QCENQ /IS IT COMPLETELY CENTERED? CCTR, 0 /CTR USED IN CENTERING / FORCE THE LINE OUT TO THE OUTPUT FILE FORCE, 0 TAD OUTCTR /MUST PRINT THE LINE SZA CLA /AT END OF BUFFER? DCA I OUTPUT /NO, ZERO TO END BUFFER TAD OSTARM DCA 14 /LOOK AT THE OUTPUT LINE TAD I 14 /GET A CHAR SNA JMP FORCEL /ZERO, NOTHING IN LINE, FORCE EOL TAD [-" ] /IS CHAR A SPACE? SNA CLA JMP .-5 /YES, KEEP CHECKING LINE JMS FORCEP /NO, GO PRINT OUT THE LINE FORCEL, DCA SPFIRST /FORGET ABOUT THOSE LEADING SPACES JMP I FORCE PAGE / OUTPUT A STRING OF CODE IN ASCII / OUTPUT DEVICE IN ACC, ADDR-1 AS ARG ASCOUT, 0 DCA ASCDEV /SAVE OUTPUT FILE DEV ROUTINE TAD I ASCOUT /GET LOC OF STRING INC ASCOUT DCA 15 /AUTOXR FOR FETCHING CHARS ASCOU2, TAD I 15 /GET AN ASCII CHAR SNA JMP I ASCOUT /0 ENDS THE STRING JMS I ASCDEV /OUTPUT TO THE OUTPUT FILE JMP ASCOU2 /GO FOR MORE CHARS ASCDEV, 0 /OUTPUT DEVICE ROUTINE / END OF FILE PROCEDURE EOFILE, JMS FORCE /OUTPUT BUFFER JMS PRINTQ /ARE WE PRINTING JMP EOFIL1 /NO, DON'T PUSH TAD BTSWIT /ARE WE AT TOP OF PAGE? SZA CLA JMP EOFIL1 /YES TAD (214) /NO, GO TO BOTTOM OF PAGE JMS TYPEIT /AND TYPE BOTTOM HEADING EOFIL1, TAD PAGSWT /FANCY PAGES? SNA CLA JMP .+3 /NO, DON'T DUMP CIF 10 JMS I (XXDUMP) /YES, DUMP THE BUFFER JMP COPIES /CHECK IF ALL COPIES OUT CCHECK, 0 SNA TAD INCHAR /IF ZERO, ASSUME INPUT CHAR DCA CCHAR /SAVE CHAR IN LOC "CCHAR" TAD I CCHECK /GET CHARLIST-1 INC CCHECK DCA CPTR /SAVE IN CHAR POINTER INC CPTR TAD I CPTR /GET NEXT CHAR SNA JMP CHKNO /ZERO, END OF LIST, RETURN CIA TAD CCHAR /COMPARE WITH OBJECT CHAR SZA CLA JMP .-7 /NOT THE CHAR, TRY NEXT TAD CPTR TAD I CCHECK DCA CCHECK /SAVE LOC TO GET JMP TAD I CCHECK /GET JMP LOC DCA CCHECK /SAVE IT JMP I CCHECK /JMP TO CHAR ROUTINE CHKNO, INC CCHECK /CHAR NOT IN TABLE, INCREMENT JMP I CCHECK /AND THEN RETURN CCHAR, 0 / SUBROUTINE TO OUTPUT THE TITLE LINE AT TOP OF PAGE OTITLE, 0 TAD I (TITLEX) /IS THERE ANY TITLE? SNA CLA JMP I OTITLE /NO TITLE, RETURN JMS SAVCOL /SAVE CURRENT MARGINS TAD (OUTBUF-1) /PREPARE TO MOVE OUTPUT BUFFER DCA 11 TAD (OUTMBF-1) /TO TEMPORARY BUFFER IN FIELD 1 DCA 12 OTITL2, TAD I 11 SNA JMP OTITL3 /END OF OUTPUT BUFFER CDF 10 DCA I 12 CDF 00 JMP OTITL2 OTITL3, CDF 10 DCA I 12 /END THE OUTPUT BUFFER CDF 00 TAD (TITLEX-1) DCA 11 OTITL4, TAD I 11 SNA JMP OTITL5 JMS LFSAVE /MOVE TITLE TO OUTPUT BUFFER JMP OTITL4 OTITL5, JMS OUTPRT /PRINT THE CENTERED TITLE LINE JMS RSTCOL /RESTORE THE COLUMN PARMS TAD (OUTBUF-1) /NOW MOVE BACK TO OUTPUT BUFFER DCA 11 TAD (OUTMBF-1) DCA 12 OTITL6, CDF 10 TAD I 12 /GET A WORD FROM TEMP BUFFER CDF 00 SNA JMP OTITL7 /END OF BUFFER DCA I 11 JMP OTITL6 OTITL7, DCA I 11 /0 ENDS THE OUTPUT BUFFER JMP I OTITLE / ROUTINE TO DO STUFF AFTER ., !, OR ? ENDCHAR, GETC /GET NEXT CHAR AFTER ., !, OR ? TAD INCHAR /CHECK IF END-OF-LINE SZA CLA JMP ENDCH2 /NOT, CHECK FOR 2 SPACES ENDCH1, STA /EOL OR 2 SPACES AFTER ., !, OR ? DCA UPFIRST /CAPITALIZE FIRST CHAR OF LINE STA DCA SPFIRST /ALSO OUTPUT 2 SPACES AT START OF LINE JMP NCHAR /GO GET A NEW LINE ENDCH2, TAD INCHAR /IS CHAR A SPACE? TAD [-" ] SZA CLA JMP SCHAR2 /NO, GO SAVE THE CHAR GETC /YES, CHECK IF 2 SPACES TAD INCHAR TAD [-" ] SNA CLA JMP ENDCH1 /2 SPACES, GOOD TAD [" ] /FIRST SAVE A SPACE SAVEC JMP SCHAR2 /THEN GO SAVE THE CHAR PAGE SAVEIT, 0 DCA I OUTPUT /SAVE CHAR IN OUTPUT BUFFER STA TAD FCOLUM CIA TAD LCOLUM /AT FIRST COLUMN OF LINE? TAD OUTCTR /COMPARE WITH COUNTER SZA CLA JMP .+5 /NO, GO INCREMENT POINTER TAD I OUTPUT /YES, IS FIRST CHAR A SPACE? TAD [-" ] SNA CLA JMP I SAVEIT /YES, DONT SAVE IT INC OUTPUT /INCREMENT FOR NEXT TIME DCA I OUTPUT /ZERO TO END THE OUTPUT BUFFER INC CURCOL /INCREMENT CURRENT COLUMN ISZ OUTCTR /IS BUFFER FULL? JMP I SAVEIT /NO, RETURN TAD (-24) DCA SAVCTR /TRY TWENTY TIMES TO FIX LINE TAD OEXEND DCA PTR1 TAD OLAST DCA PTR2 TAD LCOLUM CMA TAD OFCOL DCA CTR1 /NO. OF CHARS ON LINE BETWEEN MARGINS DCA CTR2 NSCHAR, TAD I PTR2 TAD [-" ] SNA CLA JMP ADJUST-4 TAD I PTR2 DCA I PTR1 STA TAD PTR2 DCA PTR2 STA TAD PTR1 DCA PTR1 INC CTR2 ISZ CTR1 JMP NSCHAR PLINE, TAD I OLAST TAD [-" ] /BUFFER FIXED YET? SZA CLA JMP .+3 /YES, GO PRINT OUT ISZ SAVCTR /NO, TIME TO GIVE UP? JMP AGAIN /NO, TRY IT AGAIN PLINEX, JMS FORCE /GIVE UP AND PRINT JMS MOVEXT /MOVE EXTENSION DOWN JMP I SAVEIT /DONE, RETURN TAD CTR2 CIA DCA EXTCTR /SAVE NO. CHARS IN EXT. BUFFER JMP ADJUST+4 ADJUST, STA TAD PTR2 DCA PTR2 INC CTR2 TAD I PTR2 TAD [-" ] SNA CLA JMP ADJUST TAD CTR2 SNA JMP PLINE /ALREADY TO PRINT CIA DCA CTR2 /MAKE A COUNTER TAD [" ] INC PTR2 DCA I PTR2 /BLANK OUT REST OF OUTPUT BUFFER ISZ CTR2 JMP .-4 TAD JUSTIFY /DO WE JUSTIFY BOTH MARGINS? SZA CLA JMP PLINEX /NO, JUST THE LEFT MARGIN, GO PRINT TAD I OLAST TAD [-" ] SZA CLA JMP PLINE /NO MOVING NECESSARY AGAIN, ISZ HFILL /WHICH SIDE TO FILL? JMP RFILL /FILL THE RIGHT SIDE TAD OSTARM DCA 17 TAD OLONG DCA CTR1 JMP FSPACE /SKIP OVER FIRST SPACES TAD I 17 TAD [-" ] SNA CLA JMP MRIGHT /MUST MOVE TO RIGHT NWORD, ISZ CTR1 JMP .-5 JMP PLINE MRIGHT, TAD I OLAST TAD [-" ] SZA CLA JMP PLINE /GO PRINT OUT LINE STA TAD OLAST DCA PTR2 IAC TAD CTR1 SNA JMP PLINE /AT END, GO PRINT DCA CTR2 TAD I PTR2 INC PTR2 /INCREMENT POINTER DCA I PTR2 CLL STA RAL /-2 TO ACC TAD PTR2 DCA PTR2 ISZ CTR2 JMP .-7 JMP .+5 FSPACE, TAD I 17 TAD [-" ] SZA CLA JMP NWORD ISZ CTR1 JMP .-5 JMP PLINE PAGE RFILL, STA DCA HFILL /FILL LEFT SIDE NEXT TIME IAC TAD OLAST DCA PTR1 TAD OLONG DCA CTR1 /NO. OF CHARS TO CHECK JMP SPACEF /TAKE CARE OF FIRST SPACES STA TAD PTR1 DCA PTR1 TAD I PTR1 TAD [-" ] SNA CLA JMP .+4 BWORD, ISZ CTR1 JMP .-10 JMP PLINE ISZ CTR1 SKP JMP PLINE TAD I OLAST TAD [-" ] SZA CLA JMP PLINE STA TAD OLAST DCA PTR2 TAD OLONG CIA TAD CTR1 SNA JMP PLINE /TIME TO PRINT LINE CIA IAC DCA CTR2 TAD I PTR2 INC PTR2 DCA I PTR2 CLL STA RAL /-2 TO ACC TAD PTR2 DCA PTR2 ISZ CTR2 JMP .-7 SPACEF, STA TAD PTR1 DCA PTR1 TAD I PTR1 TAD [-" ] SZA CLA JMP BWORD ISZ CTR1 JMP SPACEF JMP PLINE / START OF "TYPEWRITER" MODE TSTART, CLA DCA QTAB /SET TABBING MODE JMS FORCE /FORCE AN EOL TMODE, TAD (TTABLE-1) DCA TABPTR /SET UP POINTER TO TAB TABLE JMP TNCHAR /GET A CHAR (ONLY FIRST TIME) TNTAB, INC TABPTR CLA TAD I TABPTR /GET NEXT TAB SNA JMP TSTART /IF ZERO, END OF LINE TAD (-1) SNA JMP TNCHAR /ALREADY AT TAB TAD FCOLUMN /ADJUST FOR FIRST COL CIA TAD CURCOL /COMPARE WITH CURRENT COLUMN SMA JMP TNTAB /PAST, GET NEXT TAB JMS MARGIN /NOT THERE YET, GO TO MARGIN TNCHAR, GETC TAD INCHAR /GET AN INPUT CHAR SNA JMP TABEOL /EOL, GET NEW LINE SORTJ /CHECK FOR SPACE, TAB, AND ^ SPCHRS-1 TBJMPS-SPCHRS ISZ UPFIRST /FIRST CHAR OF LINE? SKP /DON'T WORRY ABOUT CAPS JMS SETUPC /MAKE IT AN UPPER CASE CHAR TSCHAR, TAD INCHAR /GET CHAR BACK DCA I OUTPUT /SAVE IN OUTPUT BUFFER INC OUTPUT /INCREMENT FOR NEXT SAVE INC CURCOL /INCREMENT CURRENT COLUMN ISZ OUTCTR /OUTPUTBUFFER FULL? JMP TNCHAR JMP TSTART /YES, GO PRINT OUT TABEOL, STA /***** "CLA" IF 'DO NOT' DCA UPFIRST /CAPITALIZE FIRST CHAR OF LINE JMP CONEOL UPCHAR, "U "L "% "! "[ "K "W "] "N " /THAT'S A SPACE FOLKS "^ 0 / GENERALIZED RETURN / DEPENDING UPON CURRENT MODE (TYPEWRITER OR NOT) / RETURN TO CORRECT LOC TO GET NEXT CHAR RETRNX, CLA TAD QTAB /WHICH MODE, "TAB" OR "NOTAB" SPA CLA JMP NCHAR /"NOTAB" RET1, DCA QTAB /WILL BECOME POSITIVE JMP TMODE /"TYPWRITER" MODE ENDLIST, ". "! "? 0 ENDJUMP, ENDCHAR ENDCHAR ENDCHAR PAGE / SUBROUTINE TO DO SOME SPEEDING UP OF OUTPUT / ESPECIALLY TO A TELETYPE-LIKE DEVICE / ENTER WITH CHAR IN ACC TYPEIT, 0 DCA ASCIIC /SAVE THE ASCII CHAR TAD ASCIIC /GET ASCII CHAR BACK TAD [-212] SNA JMP TYPELF /GO TYPE LINE FEED TAD (212-215) SNA JMP CRET /CARRIAGE RETURN, SET SWITCH IAC SNA JMP TYPEFF /OUTPUT A FORM FEED TAD (214-" ) SPA JMP NOCHAR /CHAR < 240, DO NOT PRINT SNA CLA JMP TYPESP /SPACE, GO INCREMENT COUNTER TAD NSPACE /ANY SPACES TO PRINT BEFORE SNA / WE PRINT THE GOOD CHAR? JMP TYPOUT /NO, GO PRINT CHAR CIA DCA NSPACE /YES, MAKE A COUNTER TAD [" ] PUT /GO TYPE OUT SPACES ISZ NSPACE /ALL SPACES TYPED OUT? JMP .-3 /NO, KEEP TYPING THEM OUT TYPOUT, STA DCA CRSWIT /SET SWITCH FOR CARRIAGE RETURN TAD ASCIIC /TYPE OUT GOOD CHAR PUT /OUTPUT THE CHAR DCA NSPACE /ZERO OUT SPACE COUNTER NOCHAR, CLA CLL /RETURN WITH CLEAR ACC AND LINK JMP I TYPEIT TYPESP, INC NSPACE /INCREMENT SPACE COUNTER JMP NOCHAR CRET, ISZ CRSWIT /DO WE PRINT CARRIAGE RETURN? JMP NOCHAR-1 /NO, JUST RETURN JMP TYPOUT+2 /YES, GO TYPE IT OUT TYPCHR, 0 LFOCTR, 0 / OUTPUT NO. OF LINE FEEDS IN ACC LFOUT, 0 SNA JMP I LFOUT /IF ZERO, JUST RETURN DCA LFOCTR /TEMP COUNTER TAD [212] PUT /OUTPUT THE LINE FEEDS ISZ LINECT /DOES NOT SKIP OUT HERE ISZ LFOCTR JMP .-4 JMP I LFOUT / OUTPUT THE LINE TO OUTPUT DEVICE / THIS IS USED AS A FAKE OUT ROUTINE FOR / THE HEADING PRINT OUT AND THE PAGE NUMBER PRINTOUT OUTLINE, 0 JMS SAVCOL /GO SAVE COLUMN PARMS TAD NLINE3 CIA JMS LFOUT /NO. OF LFS TO PAGE NO. LINE TAD PAGEN /OUTPUT THE PAGE NUMBER SPA SNA CLA /IF <=0 DON'T PRINT PAGE NO. JMP OUTLI2 TAD PAGPFG /SHOULD WE PRINT THE PAGE NUMBER? SZA CLA JMP OUTLI2 /NO, BUT GO INCREMENT IT TAD ("-) JMS LFSAVE /OUTPUT A "-" BEFORE THE NUM STA JMS BINASC /ENTRY FOR GET NUMBER PAGEN /FROM THIS LOCATION TAD ("-) JMS LFSAVE /OUTPUT A "-" AFTER THE NUM DCA NSPACE /NO SPACES HAVE BEEN OUT JMS OUTPRT /PRINT THE CENTERED LINE OUTLI2, JMS RSTCOL /RESTORE THE PARMS JMP I OUTLINE OUTLLC, 0 OUTLFC, 0 OUTLFS, 0 SAVCOL, 0 TAD LCOLUM /SAVE FIRST, LAST COLS DCA OUTLLC TAD FCOLUM DCA OUTLFC TAD PWIDTH /RESET FIRST TO 1, LAST TO PAGE WIDTH DCA LCOLUM IAC DCA FCOLUM JMS NEWLIN /SET UP FOR NEW LINE JMP I SAVCOL OUTPRT, 0 JMS CENLIN /CENTER THE PAGE NUM ON THE LINE TAD TYPEIT DCA OUTLFS /SAVE THE RETURN JMS PRINT /CALL THE PRINT ROUTINE TAD OUTLFS /RESTORE THE RETURN DCA TYPEIT JMP I OUTPRT RSTCOL, 0 TAD OUTLLC /RESTORE FIRST AND LAST COLS DCA LCOLUM TAD OUTLFC DCA FCOLUM JMS NEWLIN /SET UP FOR PREVIOUS LINE JMP I RSTCOL / ^SPACE FORCE A SPACE DON'T PAD IT FORSPC, TAD (400+" /EXTRA BIT TO PASS FORM DCA XGCHAR JMP XGETC1 / ^!CHARS^! => QUOTE,UPPER CASE CHARS,QUOTE UQUOTE, TAD UQCASE CMA DCA UQCASE /COMPLEMENT THE SWITCH TAD (247) /THIS IS THE SINGLE QUOTE DCA XGCHAR JMP XGETC1 /GO SAVE IN INPUT BUFFER / ^J, JUSTIFY LEFT AND RIGHT MARGINS / ^H, JUSTIFY LEFT MARGIN ONLY LJUST, STA LRJUST, DCA JUSTIFY RETURN PAGE / SUBROUTINE TO MOVE THE OUTPUT EXTENSION BUFFER / BACK TO THE MAIN OUTPUT BUFFER MOVEXT, 0 TAD EXTCTR SNA JMP I MOVEXT /NOTHING TO MOVE IAC TAD OEXEND DCA PTR1 TAD I PTR1 INC PTR1 DCA I OUTPUT INC OUTPUT INC CURCOL INC OUTCTR /SHOULD NEVER SKIP ISZ EXTCTR JMP MOVEXT+7 JMP I MOVEXT / ^E, END OF "TYPEWRITER" MODE / IF NUMBER FOLLOWS, USE IT AS ASSUMED TAB FOR PARAGRAPHS ENDTAB, STA DCA QTAB /TO INDICATE "NOTAB" MODE GETC JMS ASCBIN /GET A BINARY NUMBER TAD NUMBER /GET THE NUMBER SPA SNA CLA JMP .+3 /<= 0, USE STANDARD TAD NUMBER /OTHERWISE, USE THE NUMBER SKP TAD (FTAB) /IF ZERO ASSUME STANDARD FIRST TAB DCA TEMP TAD TEMP /COMPARE WITH LAST COLUMN CIA TAD LCOLUM SPA CLA JMP .-6 /BAD, ASSUME STANDARD TAD TEMP DCA PARTAB /STORE PARAGRAPH TAB JMS FORCE JMP NCHAR / ^M; GET NEW MARGINS NMARGS, JMS FORCE /FORCE AN EOL GETC /GET NEXT CHAR JMS ASCBIN /GET A NEW MARGIN TAD INCHAR TAD (-",) SZA CLA JMP STMARG /CHAR NOT A COMMA TAD FCOLUM JMS RELQ DCA ASCIIC /SAVE FIRST COLUMN IN "ASCIIC" GETC /SKIP OVER COMMA JMS ASCBIN /GET SECOND COLUMN TAD LCOLUM JMS RELQ DCA TEMP /AND SAVE IT "TEMP" NMARG2, TAD TEMP CIA TAD ASCIIC /IS MARG2 <= MARG1? SMA CLA JMP MRET /YES, IGNORE MARGINS TAD ASCIIC /LEGAL, RESET FIRST, LAST COLS DCA FCOLUM /FIRST COLUMN TAD TEMP DCA LCOLUM /LAST COLUMN MRET, JMS NEWLIN /SET UP FOR NEW LINE JMS FORCE /FORCE NEW EOL ON NEW MARGINS RETURN STMARG, TAD CVRTQ /DID CONVERSION TAKE PLACE? SZA CLA JMP LMARG /YES, GET NEW LAST MARGIN DOMARG, TAD PWIDTH /NO, ASSUME A STANDARD MARGIN DCA LCOLUMN /LAST COLUMN = PAGE WIDTH JMP LMARG2 LMARG, TAD LCOLUM /CHECK OUT LAST COLUMN JMS RELQ DCA LCOLUM /AND SAVE IT LMARG2, CLA IAC DCA FCOLUM /SET FIRST COLUMN = 1 JMP MRET / SUBROUTINE TO SET UP FOR A NEW LINE NEWLIN, 0 DCA NSPCES /SAVE NO. OF SPACES TO INDENT FOR LMARG TAD (OUTBUF) /RESET EVERYTHING FOR NEW LINE DCA OUTPUT TAD LCOLUM CIA DCA OUTCTR /SET UP OUTPUT COUNTER DCA CURCOL /ZAP CURRENT COLUMN NO. TAD NSPCES /GET NO. OF SPACES FOR LMARG SPA /STANDARD OR PARAGRAPH? JMP NEWL2 /NO, USE WHAT WE WANT TAD FCOLUM TAD (-1) SPA SNA JMP NEWL3 /DONT SPACE OVER, ALREADY THERE CMA /MAKE A NEG. CTR NEWL2, IAC /FUDGE FOR NEG. ALREADY JMS MARGIN /SET UP FOR TAB TO FIRST MARGIN NEWL3, CLA TAD OUTCTR DCA OLONG /LENGTH OF OUTPUT BUFFER IAC TAD OLONG DCA OLONGP DCA SPFIRST /FORGET ABOUT LEADING SPACES INC CURCOL /SO OTHER ALGORITHMS WORK TAD CURCOL DCA OFCOL /OUTPUT FIRST COLUMN TAD OFCOL TAD (OUTBUF-1) DCA OSTART STA TAD OSTART DCA OSTARM TAD (OUTBUF-1) TAD LCOLUMN DCA OLAST TAD (OUTEXT-1) TAD LCOLUM DCA OEXEND JMP I NEWLINE /RETURN TO CALLER NSPCES, 0 PAGE / ROUTINE TO OUTPUT A LINE FEED / DOES COUNTING FOR PAGE LENGTH, ALSO TYPELF, DCA CRSWIT /SET SWITCH FOR CARRIAGE RETURN TAD ASCIIC /TYPE OUT THE LINE FEED PUT /PUT THE CHAR TO OUTPUT FILE ISZ LINECT /AT BOTTOM OF PAGE? JMP NOCHAR-1 /NO, RETURN TYPEFF, JMS BBREAK /DO BOTTOM OF PAGE BREAK INC PAGEN /INCREMENT PAGE NO. NOP STA DCA BTSWIT /DON'T FORGET TO DO TOP OF PAGE BREAK JMP NOCHAR-1 / SUBROUTINE TO DO THE ACTUAL BOTTOM OF PAGE BREAK BBREAK, 0 TAD LINECT /ANY LINES ON PAGE? SNA JMP .+3 /NO IAC JMS LFOUT /YES, GO TOP BOTTOM JMS OUTLINE /OUTPUT THE LINE CIF 10 /NOW TO CHECK FOR OUTPUT DEV TYPE JMS I (OTYPE) SZA CLA JMP BBRK2 /IS NOT THE TTY: TAD NLINE4 CIA JMS LFOUT /LINE FEEDS TO PAGE BREAK TAD MSWITC /MULTI-LITH SWITCH SET? SZA CLA JMP BBRK1 /YES TAD OUTRTN /OUTPUT ROUTINE JMS ASCOUT /OUTPUT PAGE BREAK HMINUS-1 JMP I BBREAK /NOT MULTILITH BBRK1, CIF 10 /MULIT-LITH SET JMS I (XXDUMP) /DUMP THE BUFFER OUT JMS GETKEY /WAIT FOR A KEYBOARD CHAR TAD (-220) /CTRL/P ? SZA CLA JMP .-3 /NO, WAIT FOR CTRL/P JMP I BBREAK BBRK2, TAD (214) PUT /OUTPUT A FORM FEED IF NOT TTY JMP I BBREAK / SUBROUTINE TO DO THE ACTUAL TOP OF PAGE BREAK TBREAK, 0 TAD NLINE1 CIA JMS LFOUT /LINE FEEDS TO TITLE DCA BTSWIT /TOP OF PAGE BREAK DONE JMS OTITLE /OUTPUT THE TITLE IF NECESSARY TAD NLINE2 CIA JMS LFOUT /LINE FEEDS TO BODY TAD NLINE1 TAD NLINE2 TAD NLINE3 TAD NLINE4 CIA TAD PLENGTH /CALCULATE BODY LENGTH DCA BODYLN /AND SAVE IT FOR OTHER POSSIBLE USE TAD BODYLN CIA DCA LINECT /- BODY LENGTH FOR CTR JMP I TBREAK / CONVERT A NUMBER IN AC FROM BINARY / TO DECIMAL ASCII CHAR FOR OUTPUT FILE BINASC, 0 DCA LZSWIT /SAVE LEADING SWITCH TAD I BINASC /GET ADDR OF NUM TO OUTPUT INC BINASC DCA BINNUM TAD I BINNUM /GET THE BINARY NUMBER TO OUTPUT DCA BINNUM /SAVE THE BINARY NUMBER STA DCA LZERO /LEADING ZERO SWITCH TAD (DTABLE-1) DCA NSPACE /TEMPORARY POINTER CLL STA RTL /-3 TO ACC DCA DIGCTR BINEXT, INC NSPACE /POINT TO NEXT POWER OF 10 DCA DIGIT /ZERO DIGIT TAD BINNUM TAD I NSPACE /POWER OF 10 SPA JMP .+4 INC DIGIT /INCREMENT DIGIT DCA BINNUM JMP .-6 CLA TAD DIGIT SNA JMP LEADZ /IS IT A LEADING ZERO? TAD ("0) JMS LFSAVE /SAVE DIGIT IN OUTPUT BUFFER DCA LZERO /CLEAR LEAD ZERO SWITCH BINLAST, ISZ DIGCTR /ALL DIGITS? JMP BINEXT TAD BINNUM TAD ("0) /LAST DIGIT JMS LFSAVE JMP I BINASC /RETURN LEADZ, TAD LZERO SNA CLA JMP BINLAST-3 /NOT LEADING ZERO TAD LZSWIT /LEADING ZERO, BLANK OR IGNORE? SZA CLA JMP BINLAST /IGNORE LEADING ZERO TAD (" -"0) /CONVERT TO SPACE JMP BINLAST-3 BINNUM, 0 LZERO, 0 LZSWIT, 0 DIGIT, 0 DIGCTR, 0 SPCHRS, "^ 240 211 0 PAGE / SUBROUTINE TO READ A KEY FROM THE KEYBOARD GETKEY, 0 CLA CLL KSF JMP .-1 KRB DCA KCHAR TAD KCHAR TAD [-203 /RET TO SYSTEM? SNA CLA JMP I [7600] /YES, GO TO IT TAD KCHAR JMP I GETKEY /NO, RETURN WITH CHAR IN ACC PRINTQ, 0 /SHOULD WE PRINT CHARS? TAD PAGECT CIA TAD PAGEN /AT RIGHT PAGE? SPA CLA JMP I PRINTQ /NO RETURN TAD PAGSWT /-1 PRINT ODD 0 ALL 1 EVEN SNA JMP PRINTY /YES GO TO IT TAD PAGEN /NO, ODD OR EVEN? CLL /JUST IN CASE RAR CLA RAL /FANCY ARITHMATIC ODD OR EVEN TAD PAGSWT /-1 ODD-ODD 2 EVEN-EVEN RTR /0 OR 1 OTHERWISE SZL CLA /GOOD BIT IN LINK JMP PRINTY /WE PRINT IT JMP I PRINTQ /WE INHIBIT PRINTY, ISZ PRINTQ /RETURN TO .+2 JMP I PRINTQ GETPAG, 0 TAD (MTYPE) /ASK FOR STARTING PAGE JMS ASCOUT /"START AT PAGE: " PAGEM-1 DCA NUMBER NPAG, JMS GETKEY /INPUT CHAR DCA ASCHAR TAD ASCHAR TAD (-"9) SMA SZA JMP PAGEND /END OF NUMBER TAD ("9-"0) SPA JMP PAGEND /END OF NUMBER DCA TEMP TAD NUMBER CLL RTL TAD NUMBER CLL RAL TAD TEMP DCA NUMBER TAD ASCHAR JMS MTYPE /OUTPUT THE GOOD CHAR JMP NPAG /GET NEXT DIGIT PAGEND, CLA TAD ASCHAR TAD (-377) /CHAR WAS RUBOUT? SNA CLA JMP GETPAG+1 /YES, START OVER TAD [215] JMS MTYPE TAD [212] JMS MTYPE /OUTPUT CR/LF COMBO TAD NUMBER DCA PAGECT /NUMBER OF PAGES TO SKIP TAD PAGECT /SAVE FOR COPIES DCA PAGEX STA /-1 INITIALLY DCA PAGEN /FOR PAGE NUMBER JMP I GETPAG / ^R, RELEASE MARGIN TO ABSOLUTE COLUMN N MRELS, JMS FORCE /FORCE AN EOL TAD OUTPUT /SAVE OUTPUT BUFFER PTR DCA MRT1 TAD CURCOL /SAVE CURRENT COLUMN DCA MRT2 GETC JMS ASCBIN /GET COLUMN TO RELEASE TO TAD CVRTQ /DID CONVERSION TAKE PLACE? SZA CLA JMP .+3 /YES, USE FCOLUMN AS BASE CLA IAC /NO, ASSUME COL 1 SKP TAD FCOLUM JMS RELQ /FIX UP FOR ABS COLUMN SPA SNA CLA IAC /IF <= ZERO, ASSUME 1 TAD (OUTBUF-1) DCA OUTPUT /SET UP OUTPUT POINTER NMREL, GETC TAD INCHAR /GET AN INPUT CHAR SNA JMP .+4 /0, EOL; END OF INPUT LINE DCA I OUTPUT /SAVE IN OUTPUT BUFFER INC OUTPUT /INCREMENT OUTPUT BUFFER PTR JMP NMREL TAD MRT2 /RESET CURRENT COLUMN DCA CURCOL TAD MRT1 /RESET OUTPUT POINTER DCA OUTPUT RETURN MRT1, 0 MRT2, 0 NJMPS, CONTROL NCHAR NCHAR EJMPS, CONTROL EWORD EWORD TBJMPS, CONTROL TSCHAR TNTAB PAGE / INPUT A CHARACTER FROM INPUT FILE AND / CHECK FOR SPECIAL EDITING COMMANDS XGETC, 0 CLA CLL /CLEAR GARBAGE FROM AC TAD XGCARX /IS OLD CHAR GOOD? SMA JMP XGETC9 /YES, GO RETURN IT CLA CLL JMP I .+1 /NO, GET ANOTHER ONE XGETCR, XGETC3 /GO TO RIGHT PLACE IN COROUTINE XGETC9, DCA INCHAR /SAVE THE CHAR STA DCA XGCARX /CLEAR OUT OLD CHAR JMP I XGETC XGETC1, CLA CLL TAD XGCHAR /RETURN WITH CURRENT CHAR JMS XGETCR XGETC3, GET /GET ANOTHER CHAR FROM INPUT FILE DCA XGCHAR XGETC7, TAD XGCHAR /CHECK LEGALITY OF CHAR TAD [-215] /END OF LINE? SNA JMP XGETC6 /YES, RETURN WITH ZERO CHAR IAC SNA JMP XGETC6 /FORM FEED, TREAT LIKE END-OF-LINE TAD (214-211) SNA JMP XGETC6+1 /TAB, LET IT PASS TAD (211-" ) SNA JMP XGETC6+1 SPA JMP XGETC3 /IGNORE CHARS < 240 TAD (" -377) SNA CLA JMP XGETC3 /IGNORE RUBOUT CHAR XGETC4, CLA /GOOD CHARS COME THRU HERE TAD XGCHAR TAD (-"^) /IS IT ^ (SPECIAL FORM COMMAND)? SZA CLA JMP XGETC5 /NO, GO SAVE THE GOOD CHAR GET /GET THE CHAR AFTER ^ DCA XGCHAR TAD XGCHAR SORTJ /CHECK FOR SPECIAL EDIT COMMANDS UPCHAR-1 UPJUMP-UPCHAR TAD XGCHAR AND (337) /MAKE UPPER CASE CHAR SORTJ /CHECK FOR SPECIAL EDIT COMMANDS AGAIN UPCHAR-1 UPJUMP-UPCHAR TAD ("^) /NOT A SPECIAL EDI COMMAND JMS XGETCR /RETURN WITH ^ FIRST JMP XGETC3+2 /RETURN WITH CAHR XGETC5, TAD CASE /ARE WE IN ANY UPPER CASE MODE? TAD UQCASE TAD UPCASE TAD LETLOW /INHIBIT UPPER CASE TAD WDCASE SPA CLA JMP XGETC1 /YES, UPPER CASE; GO SAVE AS IS TAD UPFSTC /CAP 1ST CHAR OF WORD? TAD LETCASE /OR LETTER? TAD LETLOW /INHIBIT ONE TIME SMA CLA JMP .+4 /NO GO CONVERT TO LC ZAPCAS, DCA LETCASE /YES, ZAP 1 TIMERS DCA UPFSTC JMP XGETC1 /KEEP UPPER CASE CHAR TAD XGCHAR /NO, CONVERT TO LOWER CASE AND (337) TAD (40) /MAKE IT A LOWER CASE CHAR DCA XGCHAR DCA LETLOW /CLEAR LOW CASE FORCE JMP ZAPCAS /OK, SPACE IS UPPER CASE XGETC6, DCA XGCHAR /ZERO FOR END OF LINE DCA WDCASE /END OF WORD, CLEAR IT TAD UPFST /CAP 1ST CHAR NEXT WORD? DCA UPFSTC /7777 IF YES JMP XGETC1 /THEN GO SAVE THE CHAR XGCHAR, 0 /INPUT CHAR FROM INPUT FILE XGCARX, -1 /PREVIOUS CHAR / GO BACKWARD 1 CHAR BY USING PREVIOUS INPUT CHAR XPOPC, 0 CLA CLL TAD INCHAR DCA XGCARX JMP I XPOPC / SPECIAL EDIT COMMAND CHARS AND JUMP TABLE UPJUMP, UCASE /^U LCASE /^L ENTCHR /^% UQUOTE /^! UPPER /^[ CAPLET /^K CAPWD /^W CAPFST /^] LOWLET /^N FORSPC /^ - A FORCED SPACE UPARROW /^^ / SPECIAL ROUTINES FOR SPECIAL EDIT CHARS UPARROW, TAD ("^+400) /^ SAVE IN BUFFER WITH EXTRA BIT DCA XGCHAR /THIS ALLOWS IT TO PASS FORM JMP XGETC1 / ^L OR ^U, CHANGE CASE UCASE, STA /UPPER CASE = 7777 LCASE, DCA CASE /LOWER CASE = 0 JMP XGETC3 /GET MORE CHARS / ^K, CAPITALIZE NEXT LETTER CAPLET, STA DCA LETCASE JMP XGETC3 / ^W, CAPITALIZE ALL OF NEXT WORD CAPWD, STA DCA WDCASE JMP XGETC3 / ^]WORD.....WORDN^] CAPITALIZE FIRST CHAR / OF EACH WORD BETWEEN ^]....^] CAPFST, TAD UPFST CMA DCA UPFST /COMPLEMENT THE SWITCH JMP CAPLET /HE WANTS NEXT CHAR TOO / ^[CHARS^[ => UPPER CASE CHARS WITHOUT QUOTES UPPER, TAD UPCASE CMA DCA UPCASE /JUST COMPLEMENT THE SWITCH JMP XGETC3 /GET NEXT CHAR FROM INPUT PAGE / ^%NUMBER, ENTER ASCII EQUIVALENT OF NUMBER IN STREAM / NOTE: IGNORE THE CHAR THAT ENDS THE NUMBER ENTCHR, DCA ENTCN /ZERO OUT NUMBER FOR CONVERSION GET /GET NEXT CHAR FROM INPUT FILE DCA XGCHAR TAD XGCHAR TAD (-"7) SMA SZA JMP ENTC1 /ILLEGAL NUMERIC CHAR TAD ("7-"0) SPA JMP ENTC1 /DITTO OTHER END DCA TEMP /SAVE THE OCTAL NUMBER TAD ENTCN CLL RTL RAL /MULTIPLY NUMBER BY 10(8) TAD TEMP /ADD IN NEW DIGIT JMP ENTCHR /GO UPDATE THE NUMBER ENTC1, CLA /IGNORE CHAR THAT ENDS NUM TAD ENTCN /GET THE CONVERTED NUMBER DCA XGCHAR /SAVE AS ASCII CHAR JMP XGETC7 /CHECK LEGALITY OF CHAR ENTCN, 0 COPIES, ISZ COPCTR /ANY MORE COPIES? SKP /NO MORE JMP COPCLS /CLOSE OUTPUT JMS INITLZ /YES RE INITIALIZE CIF 10 /NOW REOPEN FILES JMS I (IOPEN) JMP RESTRT /NOW, MAKE ANOTHER COPY COPCTR, 0 TEMCT, 0 COPCTX, 0 COPCLS, TAD PAGSWT SNA /STRAIGHT PRINT OUT? JMP COPFIN /YES, FORGET THIS ISZ DUNALL /DID WE ALREADY DO BOTH? JMP COPFIN /YES, WE'RE DONE CIA /IF NOT, NEGATE SWITCH DCA PAGSWT /AND PUT IT BACK TAD (MTYPE) JMS ASCOUT OPMESS-1 /"RELOAD THE PAPER JMS GETKEY /WAIT FOR TTY JMS MTYPE /IGNORE CHAR, BUT ECHO TAD COPCTX /TELL IT HOW MANY COPIES DCA COPCTR JMP COPIES+3 /START ON OTHER SIDE COPFIN, CIF 10 JMS I (XXCLOSE) JMP I (7600) / OUTPUT AN END-OF-LINE CHAR CONEOL, TAD QTAB /WHICH MODE? SPA CLA JMP .+3 /"NOTAB", FORCE AND GET NEW LINE JMS FORCEP /FORCE THE LINE JMP TMODE JMS FORCE JMP NCHAR CJMPS, NPARA /-; NEW PARAGRAPH NPARA /#; NEW PARAGRAPH LSPACE /S; SINGLE, DOUBLE, TRIPLE SPACE NPAGE /P; TOP OF NEW PAGE CENTER /C; CENTER THE LINE COLUMN //; RESET THE COLUMN NTITLE /"; NEW TITLE NMARGS /M; NEW MARGINS TABTAB /T; TABS FOR TYPEWRITER MODE ENDTAB /E; END OF TYPEWRITER MODE MRELS /R; RELEASE THE MARGIN IFLINE /F; CONDITIONAL TEST LRJUST /J; JUSTIFY LEFT AND RIGHT MARGINS LJUST /H; JUSTIFY LEFT MARGIN ONLY DEFDOC /D; DEFINE DOCUMENT PARAMETERS / PRINT THE LINE ONLY; PRINT A CARRIAGE RETURN BUT NO LINE FEED PRINT, 0 JMS BTPRTQ /PRINT TOP OF PAGE TITLE? TAD (OUTBUF-1) /INITIALIZE POINTER TO OUTPUT BUFFER DCA 10 TAD LCOLUM /NUMBER OF CHARS TO PRINT CIA DCA OUTCTR TAD I 10 /GET A CHAR TO PRINT SNA JMP .+4 /ZERO, END OF OUTPUT JMS TYPEIT /OUTPUT THE CHAR ISZ OUTCTR /ALL CHARS OUT? JMP .-5 /NO, LOOK FOR MORE JMS NEWLIN /SET UP FOR NEW LINE TAD [215] JMS TYPEIT /OUTPUT A CARRIAGE RETURN JMP I PRINT BTPRTQ, 0 TAD BTSWIT /DO TOP OF PAGE BEFORE LINE? SNA CLA JMP I BTPRTQ /NO, RETURN TAD PRINT /YES, BUT SAVE RETURN DCA PRTSAV TAD BTPRTQ DCA BTSAVE /SAVE THE SUBR RETURN JMS TBREAK /DO TOP OF PAGE BREAK TAD PRTSAV /RESET PRINT RETURN DCA PRINT TAD BTSAVE DCA BTPRTQ /RESTORE RETURN LOC JMP I BTPRTQ PRTSAV, 0 BTSAVE, 0 PAGE / ROUTINE TO GET A CHAR FROM INPUT FILE / USES GENERAL I/O PACKAGE XGET, 0 CLA CLL CIF 10 /CALL GEN I/O PACKAGE JMS I (XXGET) /IN FIELD 1 JMP I XGET / SUBROUTINE TO CHECK CURRENT AND CAPITALIZE IT, IF NECESSARY SETUPC, 0 TAD INCHAR /GET THE CHAR AND (377) /JUST WANT CHAR PART TAD (-340) /IS IT ALREADY UPPER CASE? SPA CLA JMP I SETUPC /YES, RETURN TAD INCHAR /NO, GET THE CHAR AND (7737) /MAKE IT UPPER CASE DCA INCHAR /AND SAVE IT BACK JMP I SETUPC /RETURN /SET 1 LEVEL CAPITAL INHIBIT LOWLET, CLA STL RTL /GET A 2 DCA LETLOW /THIS WILL CANCEL THE -1'S JMP XGETC3 /GO BACK AND PROCESS LFSAVE, 0 DCA I OUTPUT INC OUTPUT ISZ OUTCTR NOP JMP I LFSAVE / ^S1, ^S2, ^S3, ^S GET THE SPACING NUM LSPACE, JMS FORCE /FORCE AN EOL GETC JMS ASCBIN /GET THE NUMBER TAD NUMBER SNA IAC /IF ZERO, ASSUME 1 TAD (-4) /IN RANGE 1 - 3 ? SMA RETURN /NO, IGNORE IT TAD (4) /YES, REGENERATE NUMBER CIA /MAKE MINUS DCA CSPACE /AND SAVE THE COUNTER RETURN /THE FOLLOWING CODE ADDED BY TMC 17/8/72 /FOR MULTIPLE COPY CAPABILITY COPCHK, 0 /CHECK PARAMS FOR COPIES STA DCA DUNALL /SET FOR POSSIBLE 2 SIDES DCA PAGSWT /EVEN & ODD ASSUMED DCA PAGEX /ZAP PAGE SWITCH RESET CDF 10 TAD I (MPARAM) CDF AND (200) /"E"? SNA CLA /DOES HE WANT EVEN PAGES? JMP .+3 /NOT EVEN CLA IAC /YES, HE WANTS EVEN PAGES DCA PAGSWT /OK, SET IT CDF 10 TAD I (MPARAM+1) CDF AND (1000) /"0"? SNA CLA /DOES HE WANT ODD PAGES? JMP .+3 /NOT ODD PAGES STA /YES, HE WANTS ODD PAGES DCA PAGSWT /SET IT THEN CDF 10 /CHECK FOR COPIES TAD I (MPARAM+3) /GET NUMERIC PARAMETER CDF /OUR FIELD BACK SNA /DOES HE WANT COPIES? JMP NOCOP /NO, SKIP THIS AND (377 /255 COPIES IS ENOUGH CIA /MAKE A CTR DCA COPCTR /AND FILL IT TAD COPCTR /SAVE IT FOR PAGES DCA COPCTX JMP COPRMS /RETURN TO CALLER NOCOP, CLA CMA /GET -1 DCA COPCTR /WILL CAUSE FAST TRIP OUT STA DCA COPCTX COPRMS, CDF 10 TAD I (MPARAM+1) CDF AND (400 /DO WE WANT PAGES? SZA CLA JMS GETPAG /YES, GET PAGES TO PRINT. CDF 10 TAD I (MPARAM+1) CDF 00 AND (10 /CHECK FOR SWITCH U DCA USWITC /FORCE UPPER CASE ON OUTPUT STL CLA RAR /4000 TO ACC CDF 10 AND I (MPARAM+1) /CHECK FOR OPTION CHAR 'M' CDF DCA MSWITC /SET MULTILITH SWITCH JMP I COPCHK /NOW GO ON BACK DUNALL, 0 CLIST, "- "# "S "P "C "/ "" "M "T "E "R "F "J "H "D 0 PAGE INITLZ, 0 /INITIALIZATION MAY BE USEFUL CLA /JUST IN CASE TAD XASCII /VALUE OF FIRST LOC DCA 10 /AN AUTO INDEX REG TAD COUNT1 /ASCIIC+1-EOLCTR DCA TEMCT /FOR NUMBER OF LOCS DCA I 10 /ZERO A BUNCH INC TEMCT /DONE YET? JMP .-2 /NO GET SOME MORE TAD COUNT2 /EOLCTR-PAGEN DCA COUNT STA /THESE ARE -1'S DCA I 10 ISZ COUNT JMP .-3 TAD INLIST DCA 11 TAD COUNT3 /PAGEN-LCOLUM DCA COUNT TAD I 11 /INITIALIZE LIST DCA I 10 ISZ COUNT JMP .-3 STA /THIS LOC IS SPECIAL DCA I PTXGCR JMP I INITLZ PAGEX, 0 /REMEMBERS 1ST PAGE FOR COPIES FTAB /PARTAB OUTBUF-1 /OSTARM OUTBUF /OSTART OUTBUF+OLENGTH-1 /OLAST OUTEXT+OLENGTH-1 /OEXEND -OLENGTH /OLONG -OLENGTH+1 /OLONGP 1 /FCOLUM OLENGTH /LCOLUM PTXGCR, XGCARX /IN GETC ROUTINE XASCII, ASCIIC /FIRST LOC COUNT1, ASCIIC-EOLCTR COUNT2, EOLCTR-PAGEN COUNT3, PAGEN-LCOLUM INLIST, PAGEX-1 / ^F; CONDITIONAL ON NO. OF LINES LEFT ON CURRENT PAGE IFLINE, GETC /GET CHAR JMS ASCBIN /CONVERT TO NUMBER TAD NUMBER TAD LINECT /LINE COUNTER (-) SPA SNA CLA /CAN N LINES FIT ON PAGE? RETURN /YES, GO AHEAD AND PRINT JMP NPAGE /NO, GO TO TOP OF NEW PAGE / SUBROUTINE TO CONVERT ASCII CHARS TO / A DECIMAL NUMBER / SETS CERTAIN FLAGS FOR RELATIVE OR ABSOLUTE, TOO ASCBIN, 0 CLA CLL DCA NUMBER /CLEAR NUMBER DCA SIGN /ASSUME + NUMBER DCA RELFLG /ASSUME ABSOLUTE DCA CVRTQ /NO CONVERSION YET TAD INCHAR /CHECK FOR SIGN TAD (-"+) SNA JMP ASCBN8 /IS PLUS, SET RELATIVE FLAG ASCBN2, TAD ("+-"-) /CHECK FOR MINUS SIGN SZA CLA JMP ASCBN3 /NOT "+" OR "-" STA DCA SIGN /SET FOR NEGATIVE NUMBER ASCBN8, STA DCA RELFLG /RELATIVE NUM JMP ASCBN6 ASCBN3, TAD INCHAR /CHECK FOR GOOD NUMERIC CHAR TAD (-"9) SMA SZA JMP ASCBN4 /NO, GO RETURN TAD ("9-"0) SMA JMP ASCBN7 /GOOD NUMBER, USE IT ASCBN4, CLA CLL /RETURN ON BAD CHAR TAD INCHAR TAD (-",) /WAS CHAR A COMMA? SZA CLA BACKUP /BACKUP ONE CHAR IF NOT COMMA TAD SIGN /CHECK SIGN OF RESULT SMA CLA JMP I ASCBIN /+, JUST RETURN TAD NUMBER CIA DCA NUMBER /-, MAKE THE NUMBER NEGATIVE JMP I ASCBIN ASCBN6, GETC /GET NEXT CHAR ASCBN5, TAD INCHAR /CHECK THE CHAR OUT TAD (-"9) SMA SZA JMP ASCBN4 /ILLEGAL CHAR TAD ("9-"0) SPA JMP ASCBN4 /ILLEGAL CHAR, TOO ASCBN7, DCA DIGIT /SAVE THE DIGIT TAD NUMBER CLL RTL TAD NUMBER CLL RAL /MULTIPLY PREVIOUS BY 10(10) TAD DIGIT /ADD IN NEW DIGIT DCA NUMBER /AND UPDATE NUMBER STA DCA CVRTQ /CONVERSION HAS TAKEN PLACE JMP ASCBN6 /GET NEXT CHAR / SUBROUTINE TO DO RELATIVISTIC CALCULATION, IF NECESSARY RELQ, 0 DCA RELQTM /SAVE OUT BASE NUMBER TAD CVRTQ /DID CONVERSION TAKE PLACE? SNA CLA JMP RELQ2 /NO, GO RETURN WITH BASE NUM TAD RELFLG /YES, WAS RELATIVE OR ABSOLUTE? SZA CLA TAD RELQTM /RELATIVE, ADD BASE NUMBER IN TAD NUMBER /ABSOLUTE, JUST GET NUMBER JMP I RELQ RELQ2, TAD RELQTM /GET BASE NUMBER BACK JMP I RELQ /AND RETURN RELQTM, 0 PAGE / ^D; DEFINE DOCUMENT PARAMETERS / PAPER WIDTH, PAPER LENGTH, FORMAT / 4 NUMBERS GIVING LONGITUDUNAL MARGINS DEFDOC, JMS FORCE /FORCE OUT WHAT WE HAVE GETC JMS ASCBIN /GET A NUMBER TAD PWIDTH /SEE IF THER'S A NEW WIDTH JMS RELQ DCA TEMP /SAVE THE WIDTH TAD TEMP TAD (-MXLENGTH) /IS IT GREATER THEN MAX ALLOWED? SMA SZA CLA JMP .+3 /YES, KEEP WHAT WE HAVE TAD TEMP /NO, USE THE NEW PAPER WIDTH DCA PWIDTH JMS COMMAQ /ANY MORE ARGS? GETC JMS ASCBIN /YES, GET THE PAGE LENGTH TAD PLENGTH JMS RELQ DCA PLENGTH JMS COMMAQ GETC JMS ASCBIN /THEN THE FORMAT TAD FORMAT /FORMAT RANGE CURRENTLY 0-0 JMS RELQ DCA FORMAT JMS COMMAQ GETC JMS ASCBIN /NEXT NUMBER, IF PRESENT IS TAD NLINE1 /NUMBER OF LINES FROM PAGE BREAK JMS RELQ / TO 'TOP TITLE' LINE DCA NLINE1 JMS COMMAQ GETC JMS ASCBIN /THE FOLLOWING NUMBER IS TAD NLINE2 /NUMBER OF LINES FROM 'TOP TITLT' LINE JMS RELQ / TO BODY OF PAGE DCA NLINE2 JMS COMMAQ GETC JMS ASCBIN /THEN COMES TAD NLINE3 /NUMBER OF LINES FROM BODY JMS RELQ / TO 'BOTTOM TITLE' DCA NLINE3 JMS COMMAQ GETC JMS ASCBIN /FINALLY, TAD NLINE4 /NUMBER OF LINES FROM 'BOTTOM TITLE' JMS RELQ / TO PAGE BREAK DCA NLINE4 DEFDR, JMP DOMARG /SET MARGINS TO 1 AND PWIDTH, FIX LINE / SUBROUTINE TO CHECK CURRENT CHAR FOR COMMA COMMAQ, 0 TAD INCHAR TAD (-",) SNA CLA JMP I COMMAQ /IF COMMA, RETURN FOR NEXT ARG JMP DEFDR /END OF ^D COMMAND, SET NEW LINE / ^P, SKIP TO TOP OF NEW PAGE / IF NUMBER IS PRESENT, THEN USE TO RENUMBER PAGES / ^P-0 COMPLEMENTS THE PAGE PRINT FLAG NPAGE, JMS FORCE /FORCE LINE TO PRINT TAD BTSWIT /ARE WE AT TOP OF PAGE? SZA CLA JMP .+3 /YES, DON'T DO ANOTHER EJECT TAD (214) /NO, GO TO TOP OF PAGE JMS TYPEIT GETC JMS ASCBIN /GET NEW NUMBER TAD PAGEN JMS RELQ /EITHER USE PAGE, OR + OR - NUM SPA CLA /IF NEG, CLEAR IT DCA PAGEN /YES IT IS, USE IT TAD NUMBER /WAS VALUE OF NUMBER ZERO? SZA CLA RETURN /NO, NEW NUMBER TAD RELFLG /^P-0 MEANS RELATIVE TAD CVRTQ /CONVERSION TOOK PLACE TAD SIGN /NEGATIVE NUMBER TAD (3) /DID ALL 3 FLAGS GET SET? SZA CLA RETURN /NO, JUST RETURN TAD PAGPFG /YES, COMPLEMENT PAGE PRINT FLAG CMA DCA PAGPFG RETURN / PUT A CHAR TO OUTPUT FILE XPUT, 0 DCA XPUTCH /SAVE THE CHAR JMS PRINTQ /SHOULD WE PRINT? JMP I XPUT /NO, JUST RETURN TAD USWITC /FORCE UPPER CASE? SNA CLA JMP XPUT1 /NO, USE THE CHAR TAD XPUTCH /YES, BUT ONLY IF LOWER CASE TAD (-340) SPA CLA JMP XPUT1 /ALREADY UPPER CASE TAD XPUTCH /LOWER CASE AND (337) /FORCE IT TO UPPER CASE DCA XPUTCH /AND SAVE IT XPUT1, TAD XPUTCH /GET THE CHAR BACK CIF 10 JMS I (XXPUT) /GO OUTPUT THE CHAR JMP I XPUT XPUTCH, 0 / PRINT OUT THE LINE FOLLOWED BY THE NECESSARY / NUMBER OF CARRIAGE RETURN/LINE FEED COMBOS FORCEP, 0 TAD OUTCTR /IS LINE FULL? SZA CLA DCA I OUTPUT /NO, ZERO TO END THE BUFFER JMS PRINT /PRINT OUT BUFFER TAD CSPACE /SINGLE, DOUBLE, OR TRIPLE SPACE? DCA PCOUNT JMS CRLF ISZ PCOUNT JMP .-2 JMP I FORCEP PAGE / MESSAGES USED THROUGHOUT THIS PROGRAM OPMESS, 215;212 ASCII "RELOAD PAPER" 215;212;0 PAGEM, 215;212 ASCIIZ "START AT PAGE: " HMINUS, ASCII "------" 215;0 VERSION, ASCII "FORM V7" 215;212;0 DECIMAL FTAB=6 /FIRST TAB TLENGTH=60 /LENGTH OF TITLE MXLENGTH=150 /MAXIMUM PAGE WIDTH OLENGTH=80 /OUTPUT PAGE WIDTH OCTAL BUFST=. /START OF THESE BUFFERS TITLEX=.;*.+TLENGTH+1 /TITLE BUFFER OUTBUF=.;*.+MXLENGTH+1 /OUTPUT LINE BUFFER OUTEXT=.;*.+MXLENGTH+1 /EXTENDED OUTPUT LINE BUFFER TTABLE=.;*.+100 /TAB TABLE BUFEND=. /END OF THESE BUFFERS TO CLEAR PAGE / DEFINE SOME BUFFERS FOR GEN I/O OUBUF=. /MUST BE LOWER THAN INBUF OUCTL=OBUFL%2!4000 /OUTPUT BUFFER OF OBUFL WORDS INBUF=OUBUF+OBUFL INCTL=IBUFL%2!0000 /INPUT BUFFER OF IBUFL WORDS INRECS=INCTL%200 /NO. OF INPUT RECORDS IFG INBUF+IBUFL-6600 /6600 IS LOC OF HANDLERS FIELD 1 /NOW OUTPUT PAGE 0 LITERALS / GENERALIZED I/O PACKAGE / A MODIFIED VERSION OF PIP'S I/O PACKAGE / MODIFIED BY: CLYDE G. ROBY, JR. / DEPARTMENT OF MEDICINE / WEST VIRGINIA UNIVERSITY / MORGANTOWN, WEST VIRGINIA / MARCH 24, 1972 /EQUIVALENCES FOR GENERAL CHARACTER I/O ROUTINES IFNDEF OUBUF IFNDEF OUCTL IFNDEF OUDEVH IFNDEF INBUF IFNDEF INCTL IFNDEF INRECS IFNDEF INDEVH /EQUIVALENCES NECESSARY TO INTERFACE WITH MONITOR DCB=7760 MPARAM=7643 /CD PARAMETER AREA PTP=20 /INTERNAL TYPE CODE: PAPER TAPE PUNCH FIELD 1 /EXECUTES IN FIELD 1 /GENERAL CHARACTER I/O ROUTINES /CALLED AS FOLLOWS: /JMS I (IOPEN INITIALIZES THE INPUT ROUTINE /JMS I (ICHAR READS A CHARACTER /ERROR RETURN AC>0 IF EOF, AC<0 IF READ ERROR /JMS I (OOPEN INITIALIZES THE OUTPUT ROUTINE /ERROR RETURN AC>P IF NO OUT DEV/FILE, AC<0 IF ERR /JMS I (OCHAR OUTPUTS A CHARACTER /ERROR RETURN OUTPUT ERROR OR TOO MUCH OUTPUT /JMS I (OCLOSE CLOSES THE OUTPUT FILE /ERROR RETURN FILE TOO LARGE TO BE CLOSED OR OUTPUT ERR /JMS I (OTYPE RETURNS DCB WORD OF OUT DEVICE IN AC /PARAMETERS NEEDED: /INBUF= ADDRESS OF INPUT BUFFER /INCTL= INPUT BUFFER CONTROL WORD /OUBUF= ADDRESS OF OUTPUT BUFFER /OUCTL= OUTPUT BUFFER CONTROL WORD (MUST BE NEGATIVE) /INRECS= [INCTL/128] /INDEVH= ADDRESS OF PAGE FOR INPUT HANDLER /OUDEVH= ADDRESS OF PAGE FOR OUTPUT HANDLER /CAN BE CALLED FROM ANY FIELD WITH BUFFERS IN ANY FIELD. INFLD=INCTL&70 /GET FIELD OF INPUT BUFFER OUFLD=OUCTL&70 /DITTO OUTPUT BUFFER *4000 / IOPEN: INITIALIZE INPUT FILES IN7400, 7400 /*****MUST BE FIRST LOC OF PAGE***** IOPEN, 0 CLA CMA DCA INCHCT /SET INCHCT TO FORCE A READ ISZ INEOF /SET E-O-F FLAG TO FORCE A NEW FILE TAD (7617 DCA INFPTR /RESET FILE POINTER RDF TAD INCDIF DCA .+1 INPTR, HLT /RESTORE CALLING FIELDS JMP I IOPEN / ICHAR: GET A CHAR FROM INPUT FILES / RETURN TO .+1 IF ERROR (<0) / OR IF END-OF-FILE (>0) / RETURN TO .+2 WITH CHAR IN ACC ICHAR, 0 IN7600, 7600 RDF TAD INCDIF DCA INRTRN /SAVE CALLING FIELDS INCHRX, CDF INFLD ISZ INJMP /BUMP THREE-WAY UNPACK SWITCH ISZ INCHCT INJMPP, JMP INJMP TAD INEOF SNA CLA /DID LAST READ YIELD END-OF-FILE? JMP INGBUF /NO - DO ANOTHER GETNEW, JMP INNEWF /OPEN A NEW INPUT FILE INGBUF, TAD INKTR CLL TAD (INRECS SNL DCA INKTR /RESTORE INKTR IF IT HASN'T OVERFLOWED SZL /IS THIS THE LAST READ? ISZ INEOF /YES - SET END-OF-FILE FLAG CLL CML CMA RTR /CONSTRUCT A CTRL WORD FOR THE READ RTR /FROM THE AMOUNT OF THE OVERFLOW RTR /(IF ANY) AND THE STANDARD CTRL WORD TAD (INCTL+1 DCA INCTLW INCDIF, CDF CIF 0 CDF 10 JMS I INHNDL /CALL THE DEVICE HANDLER INCTLW, 0 INBUFP, INBUF INREC, 0 JMP INERRX /INPUT HANDLER ERROR INBREC, TAD INREC TAD (INRECS DCA INREC /UPDATE THE RECORD NUMBER TAD INCTLW AND IN7600 CLL RAL TAD INCTLW AND IN7600 CMA DCA INCHCT /COMPUTE THE NEW CHARACTER COUNT TAD INJMPP DCA INJMP /RESET THE CHARACTER SWITCH TAD INBUFP DCA INPTR /AND THE WORD POINTER JMP INCHRX /GO BACK AND MAKE BELIEVE / THIS NEVER HAPPENED INERRX, ISZ INEOF /EITHER AN END-OF-FILE OR A BADDIE SMA CLA /WHICH TYPE WAS IT? JMP INBREC /END OF FILE - RESUME THY PROCESSING INERR, CLA CLL CML RAR /BADDIE - GIVE ERR RETURN WITH NEG AC EOFERR, JMP INRTRN INJMP, HLT /THIS IS THE 3 - WAY CHARACTER SWITCH JMP ICHAR1 JMP ICHAR2 ICHAR3, TAD INJMPP DCA INJMP TAD I INPTR IN200, AND IN7400 CLL RTR RTR /COMBINE THE HIGH-ORDER FOUR BITS OF TAD INCTLW RTR /THE TWO WORD TO FORM THE 3RD CHAR RTR ISZ INPTR JMP INCOMN ICHAR2, TAD I INPTR AND IN7400 DCA INCTLW /SAVE HI-ORDER BITS FOR THE 3RD CHAR ISZ INPTR /BUMP THE WORD POINTER ICHAR1, TAD I INPTR INCOMN, AND (377 TAD (-232 SNA /IS THE CHARACTER A ^Z? JMP GETNEW /YES - GET A NEW FILE TAD (232 /RESTORE THE CHARACTER ISZ ICHAR /BUMP RETURN TO NORMAL RETURN INRTRN, 0 /RESTORE CALLING FIELDS JMP I ICHAR /AND RETURN /IOPEN IS UNNECESSARY. INCHCT, -1 /INPUT CHARACTER COUNT INNEWF, CDF 10 /NEW INPUT FILE JMS CHKHND /IS IT THE SAME HANDLER DCA INHNDL /INITIALIZE HANDLER ADDRESS TAD I INFPTR /GET NEXT CD INPUT FILE ENTRY SNA /ANY MORE? JMP EOFERR /NO - OUT OF INPUT JMS FETCHH /FETCH DEVICE HANDLER INHNDL, 0 /WILL HOLD RETURN ADDR JMS PUTUSR /RESTORE CORE TAD I INFPTR AND (7760 /GET LENGTH PART OF WORD SZA /LENGTH OF 0 MEANS LENGTH >=256 TAD (17 /ADD HIGH-ORDER BITS CLL CML RTR RTR DCA INKTR /STORE LENGTH OF FILE ISZ INFPTR TAD I INFPTR DCA INREC /STORE STARTING RECORD NUMBER OF FILE ISZ INFPTR DCA INEOF /ZERO END-OF-FILE FLAG JMP INGBUF /GO READ INKTR=IOPEN INFPTR, 0 /INPUT FILE POINTER INEOF, 0 /INPUT END-OF-FILE INDICATOR PAGE / OOPEN: SET UP OUTPUT FILE OOPEN, 0 OU7600, 7600 / RDF / TAD OUCDIF / DCA OORETN TAD OU7601 DCA OUBLK TAD (OUDEVH+1 DCA OUHNDL CDF 10 TAD I OU7600 /GET DEV NUM WORD OF OUTPUT FILE ENTRY AND (17 /STRIP OFF ANY LENGTH INFO SNA /IS THERE AN OUTPUT DEVICE? JMP ONOFIL /NO - INHIBIT OUTPUT JMS FETCHH /FETCH DEVICE HANDLER OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY OUENTR, TAD I OU7600 JMS I (200 3 /ENTER OUTPUT FILE OUBLK, 7601 /REPLACED WITH STARTING BLOCK OUELEN, 0 /REPLACED WITH LENGTH OF HOLE JMP OEFAIL /FAILED - MAYBE WE ASKED TOO MUCH DCA OUCCNT DCA I (OUTINH /ZERO OUTPUT INHIBIT FLAG JMS I (OUSETP ISZ OOPEN OORETN, CDF CIF 10 /RESTORE CALLING FIELDS JMP I OOPEN OEFAIL, TAD I OU7600 AND (7760 /GET REQUESTED LENGTH SNA CLA /WAS IT AN INDEFINITE REQUEST JMP ONTERR /YES - CANNOT ENTER THE FILE TAD I OU7600 AND (17 /MAKE THE REQUESTED LENGTH ZERO DCA I OU7600 JMP OUENTR /TRY, TRY AGAIN ONTERR, CLA CLL CML RAR JMP OORETN /TAKE THE ERROR RETURN WITH AC<0 ONOFIL, ISZ I (OUTINH JMP OORETN /TAKE THE ERROR RETURN WITH AC=0 OUTDMP, 0 DCA OUCTLW /STORE THE CONTROL WORD CDF 10 TAD I (OUTINH SZA CLA JMP OUNOWR TAD OUCCNT SNA ISZ OUCTLW TAD OUBLK DCA OUREC /COMPUTE START BN OF THIS TRANSFER TAD OUCTLW CLL RTL RTL RTL AND (17 /COMPUTE THE NUMBER OF RECORDS TAD OUCCNT /UPDATE NUMBER OF BLOCKS IN THE FILE DCA OUCCNT TAD OUCCNT CLL CML TAD OUELEN SNL SZA CLA /DOES LENGTH EXCEED GIVEN LENGTH? JMP I OUTDMP /YES - SIGNAL OUTPUT ERROR OUCDIF, CDF CIF 0 CDF 10 JMS I OUHNDL OUCTLW, 0 OUBUF OUREC, 0 JMP OUERRX /OUTPUT HANDLER ERROR OUNOWR, ISZ OUTDMP /BUMP OUTDMP TO NORMAL RETURN OUERRX, JMP I OUTDMP /.+1 IF ERROR RTN / OCLOSE: CLOSE THE OUTPUT FILE / RETURN TO .+1 IF ERROR / RETURN TO .+2 IF A.O.K. OCLOSE, 0 / RDF / TAD OUCDIF / DCA OCRET CDF 10 TAD I (OUTINH SZA CLA /IS OUTPUT INHIBITED? JMP OCISZ /YES - CLOSE IS A NOP JMS I (OTYPE AND (770 TAD (-PTP /CHECK FOR PAPER TAPE PUNCH OUTPUT SZA CLA /AND SKIP ^Z OUTPUT IF TRUE TAD (232 /OUTPUT A ^Z JMS I (OCHAR JMP OCRET JMS I (OCHAR JMP OCRET FILLLP, JMS I (OCHAR JMP OCRET JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE SPA CLA TAD (100 /IF ITS A DIRECTORY DEV FORCE A RECORD TAD (77 /BOUNDARY - OTHERWISE A HALF-RECORD AND I (OUDWCT SZA CLA /UP TO THE BOUNDARY YET? JMP FILLLP /NO - FILL WITH ZEROS TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT TAD (OUCTL&3700 SNA /A FULL WRITE LEFT? JMP NODUMP /YES, DON'T DO IT; THE ^Z IS ALREADY OUT TAD (4000+OUFLD /PUT IN THE FIELD BITS AND THE WRITE BIT JMS OUTDMP JMP OCRET /AN ERROR OCCURRED WHILE DUMPING BUFFER NODUMP, NOP /CATCHES SOME PORNO FOR FORCED DMP TAD I OU7600 /GET THE DEVICE NUMBER JMS I (7700 /JUST A ONE-SHOT 4 /CLOSE THE OUTPUT FILE OU7601, 7601 /POINTER TO THE OUTPUT FILE NAME OUCCNT, 0 SKP /ERROR WHILE CLOSING THE FILE - BAD! OCISZ, ISZ OCLOSE OCRET, CDF CIF 10 /RESTORE CALLING FIELDS JMP I OCLOSE PAGE OUSETP, 0 /ROUTINE TO INITIALIZE CHAR POINTERS TAD (OUCTL&3700 /GET SIZE OF BUFFER IN DOUBLEWORDS CIA /NEGATE IT (PAL10 BLOWS) DCA OUDWCT TAD (OUBUF DCA OUPTR /INITIALIZE WORD POINTER TAD OUJMPE DCA OUJMP /INITIALIZE THREE-WAY CHARACTER SWITCH JMP I OUSETP / OCHAR: OUTPUT A CHAR TO OUTPUT DEVICE / RETURN .+1 IF ERROR OR NO ROOM / RETURN TO .+2 IF CHAR WENT OUT O.K. OCHAR, 0 AND (377 DCA OUTEMP RDF TAD (CDF CIF 0 DCA OUCRET TAD OUTINH SZA CLA /IS THERE AN OUTPUT FILE? JMP OUCOMN /NO - EXIT OUCHAR, CDF OUFLD /SET DATA FIELD TO BUFFER'S FIELD ISZ OUJMP /BUMP THE CHARACTER SWITCH OUJMP, HLT /THREE WAY CHARACTER SWITCH JMP OCHAR1 JMP OCHAR2 OCHAR3, TAD OUTEMP CLL RTL RTL AND (7400 TAD I OUPOLD DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH /ORDER 4 BITS OF THIRD CHAR TAD OUTEMP CLL RTR RTR RAR AND (7400 TAD I OUPTR DCA I OUPTR /UPDATE 2ND WORD FROM LOW ORDER 4 BITS TAD OUJMPE DCA OUJMP /RESET SWITCH ISZ OUPTR ISZ OUDWCT /BUMP DOUBLEWORD COUNTER EVERY 3 CHARS JMP OUCOMN TAD (OUCTL /LOAD CONTROL WORD FOR A FULL WRITE JMS I (OUTDMP /DUMP THE BUFFER JMP OUCRET /OUTPUT ERROR - GIVE ERROR RETURN JMS OUSETP /RE-INITIALIZE THE POINTERS JMP OUCOMN OCHAR2, TAD OUPTR DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO ISZ OUPTR /BUMP WORD POINTER TO 2ND WORD OCHAR1, TAD OUTEMP DCA I OUPTR OUCOMN, ISZ OCHAR OUCRET, HLT /RESTORE CALLING FIELDS JMP I OCHAR OUTEMP, 0 OUPOLD, 0 OUPTR, 0 OUJMPE, JMP OUJMP OUDWCT, 0 OUTINH, 0 / OTYPE: GET DEVICE TYPE OF OUTPUT DEVICE OTYPE, 0 RDF TAD (CDF CIF 0 DCA OTRTN CDF 10 TAD I (7600 AND (17 TAD (DCB-1 DCA OUTEMP TAD I OUTEMP OTRTN, HLT JMP I OTYPE / GET USR INTO CORE GETUSR, 0 TAD USRSTAT /IS USR ALREADY IN CORE? SNA CLA JMP I GETUSR /YES, JUST RETURN JMS I (7700 /NO, GET USR INTO CORE 10 DCA USRSTAT /USR NOW IN CORE JMP I GETUSR USRSTAT, 7777 /7777 NOT IN CORE; 0 IN CORE / PUT USR BACK OUT OF CORE FETCHD, /FETCH HANDLER DEVICE NUMBER PUTUSR, 0 /SAVES A LOC ON PAGE TAD USRSTAT /IS USR ALREADY OUT? SZA CLA JMP I PUTUSR /YES, JUST RETURN JMS I (200 /NO, PUT USR AWAY 11 STA DCA USRSTAT /NOW USR IS NOT IN CORE JMP I PUTUSR / FETCH DEVICE HANDLER FETCHH, 0 DCA FETCHD /SAVE DEVICE NUM TO FETCH JMS GETUSR /MAKE SURE USR IS IN CORE TAD I FETCHH /GET LOC TO LOAD HANDLER DCA FETCHA TAD FETCHD /GET DEVICE TO LOAD JMS I (200 1 /FETCH DEVICE HANDLER FETCHA, 0 /HANDLER ADDR GOES HERE HLT /HUH!! TAD FETCHA DCA I FETCHH /SAVE FOR ROUTINE TO USE ISZ FETCHH JMP I FETCHH /RETURN / CLOSE ROUTINE AS USER SEES IT XXCLOSE, 0 CLA RDF TAD (CDF CIF 0) DCA XXCLSR /SAVE USER CALLING FIELDS CDF 10 /WE'RE IN FIELD 1 JMS I (OCLOSE /CLOSE THE OUTPUT FILE JMP XXCLSE /CLOSE ERROR XXCLSR, HLT /RESET USER CALLING FIELDS JMP I XXCLOSE /RETURN IF NO ERROR PAGE / I/O PACK STARTS HERE / SETUP: SET UP AND CALL COMMAND DECODER / ARG1 IS USER END-OF-FILE ROUTINE / ARG2 IS ASSUMED COMMAND DECODER EXTENSION SETUP, 0 DCA CDFLAG /WHETHER WE CALL CD OR NOT RDF /GET USER FIELDS TAD (CDF CIF 00 DCA SETUPR /SAVE RETURN LOC TAD I SETUP /GET COMMAND DECODE EXTENSION ISZ SETUP DCA CDEXT /SAVE FOR CALL TO CD TAD I SETUP ISZ SETUP CDF 10 /NOW CHANGE TO THIS FIELD SNA JMP .+4 /GO SAVE ASSUMED LOCS DCA EOFRTN /SAVE USER RETURN LOC TAD SETUPR /ALSO SAVE HIS CALLING FIELD JMP .+4 TAD (XXXEOF /ASSUMED E-O-F PROCEDURE DCA EOFRTN TAD (CDF CIF 10) DCA EOFR /SAVE FIELD RETURN, TOO JMS GETUSR /GET USR IN CORE ISZ CDFLAG /DO WE CALL THE COMMAND DECODER? JMP NOCD /NOPE CIF 10 JMS I (200 5 /CALL COMMAND DECODER CDEXT, 0 /ASSUMED EXTENSION HERE NOCD, TAD I (7600) SZA CLA /IS THERE AN OUTPUT FILE? JMP SETOPN /YES, GO OPEN I/O FILES DCA LPTDEV+1 /NO, TRY 'LPT' FIRST JMS I (200) 12 /INQUIRE WITHOUT FETCH LPTDEV, LP+T0!4000 /COMPRESSED CODE FOR 'LPT' 0 /DEVICE NUM GOES HERE 0 /ADDR IF HANDLER ALREADY IN CORE JMP TRYTTY /LPT: NOT AVAILABLE, TRY 'TTY' TAD LPTDEV+1 /GET DEVICE NUMBER JMP GOTDEV /WE HAVE THE DEVICE TRYTTY, DCA TTYDEV+1 /NO, ASSUME TTY: AS OUTPUT JMS I (200 12 /INQUIRE WITHOUT FETCH TTYDEV, TT+Y0!4000 /COMPRESSED CODE FOR TTY 0 /DEVICE NUM GOES HERE 0 /ADDR IF IN CORE GOES HERE HLT /WHAT - NO TTY: !!! TAD TTYDEV+1 /GET DEVICE NO. GOTDEV, DCA I (7600) /SAVE AS OUTPUT DEVICE NO. SETOPN, JMS I (OOPEN /INITIALIZE OUTPUT ROUTINE SMA CLA JMP .+3 TAD (ERR5) JMP ERRPRT /IS AN ERROR MESSAGE JMS I (IOPEN /INITIALIZE INPUT ROUTINE JMS I (OTYPE /GET OUTPUT DEV TYPE AND (770 /PHYSICAL DEVICE TYPE TAD (-PTP) /IS IT THE PAPER TAPE PUNCH? SZA CLA JMP SETUPX /NO, GO RETURN TAD (-200) DCA XXTEMP /YES, NOW OUTPUT SOME LEADER/TRAILER JMS XXPUT /OUTPUT IT ISZ XXTEMP JMP .-2 SETUPX, JMS PUTUSR /RELEASE USR FROM CORE SETUPR, CDF CIF 00 /CHANGE TO USER FIELDS JMP I SETUP /AND RETURN CDFLAG, 0 TT="T-300^100+"T-300 Y0="Y-300^100 LP="L-300^100+"P-300 T0="T-300^100 / GET ROUTINE AS USER SEES IT XXTEMP, XXGET, 0 CLA RDF TAD (CDF CIF) DCA XXGETR /SAVE FIELD FRO M WHENCE WE WERE CALLLED CDF 10 /WE'RE IN FIELD 1 JMS I (ICHAR) JMP .+3 /ERROR RETURN XXGETR, HLT /CHANGE FIELDS BACK TO USER JMP I XXGET /O.K., RETURN WITH CHAR IN AC SMA CLA /FINAL END-OF-FILE? JMP EOFGO /YES, GO TO USER EXIT ROUTINE XXGETE, TAD (ERR4) /NO, IS HARDWARE ERROR JMP ERRPRT PAGE / PUT AS USER SEES IT XXPUT, 0 AND (377) /JUST WANT ASCII CHAR DCA XXPUTC /SAVE OUTPUT CHAR RDF TAD (CDF CIF) DCA XXPUTR /SAVE CALLING FIELDS CDF 10 /WE'RE IN FIELD 1 TAD XXPUTC JMS I (OCHAR /OUTPUT THE CHAR JMP XXPUTE /ERROR ON OUTPUT TAD XXPUTC TAD (-214 /SPECIAL CHAR CHECKING SNA JMP XXPFF /FORM FEED IAC /213 SNA JMP XXPVT /VERTICAL TAB TAD (213-211 SNA CLA JMP XXPHT /HORIZONTAL TAB XXPUTR, HLT /RESET USER FIELDS JMP I XXPUT /RETURN O.K. XXPFF, TAD (11-5 /FORM FEED, OUTPUT 9 ZEROS XXPVT, TAD (5-2 /VERTICAL TAB, OUTPUT 5 RUBOUTS XXPHT, TAD (2 /HORIZONTAL TAB, OUTPUT 2 RUBOUTS CIA JMS XXRUB /OUTPUT RUBOUTS OR ZEROES JMP XXPUTR XXPUTC, 0 /SAVE CHAR HERE / SUBROUTINE TO DUMP THE CURRENT BUFFER OUT / OUTPUT DEVICE SHOULD BE NON-DIRECTORY IF THIS ROUTINE USED PORNO=OCRET&177+5200 XXDUMP, 0 /ROUTINE TO FORCE BUFFER OUT CLA /WITHOUT CLOSING FILE RDF TAD (CDF CIF 0 DCA XXDMPR CDF 10 TAD (PORNO /SET UP TO NOT CLOSE DCA NODUMP /REPLACES OUR NOP JMS OCLOSE /DOES EVERYTHING ELSE BUT TAD (NOP /RESTORE PORNO LOC DCA NODUMP JMS OUSETP /START OVER AT BEGINNING XXDMPR, HLT /IF DIRECTORY DEV. HE'S CRAZY ANYWAY JMP I XXDUMP /GO ON BACK CHKHND, 0 /CHECK IF NEW HANDLER IS NEEDED. TAD INFPTR /WE NEED THE POINTER DCA CHKPTR /GET IT HERE TAD I CHKPTR /NEXT FILE SNA /NO MORE FILES? JMP EOFERR AND (17 /JUST THE HANDLER CIA /TO COMPARE TAD OLDHND SNA CLA /IF ZERO, NO CHANGE JMP INHNDL+2 /JUST GET NEW BLK NUM TAD I CHKPTR /GET NEW HANDLER AND (17 /JUST THE HANDLER DCA OLDHND /AND SAVE FOR NEXT TIME TAD (INDEVH+1 /GET HIS HANDLER ADDR. JMP I CHKHND /GO ON BACK OLDHND, 0 CHKPTR, 0 PAGE / PUT OR CLOSE ERROR ROUTINE XXCLSE, XXPUTE, SMA CLA /HARD OR SOFT ERROR? TAD (ERR0-ERR2 /SOFT: ERR0 TAD (ERR2) /HARD: ERR2 JMP ERRPRT /PRINT ERROR MESSAGE / END-OF-FILE ROUTINE EOFGO, EOFR, HLT /CHANGE TO FIELD JMP I .+1 /THEN EXECUTE E-O-F PROCEDURE EOFRTN, XXXEOF XXXEOF, JMS XXCLOSE XXXSGO, CDF CIF 00 /PS/8 IN FIELD 0 JMP I XXXCLA /RETURN TO SYSTEM / OUTPUT NO. OF RUBOUTS OR NULLS IN AC / UNLESS OUTPUT IS TO A DIRECTORY DEVICE XXRUB, 0 DCA XXXTMP /SAVE COUNT JMS I (OTYPE /GET TYPE OF OUTPUT DEV SPA CLA JMP I XXRUB /DIRECTORY DEVICE - DON'T BOTHER XXRUBL, TAD XXPUTC /GET THE CHAR TAD (-214) SNA CLA /IS THE CTRL CHAR A FORM-FEED? IAC /YES - OUTPUT BLANK TAPE INSTEAD TAD (377 /OTHERWISE, OUTPUT RUBOUTS JMS I (OCHAR /OUTPUT THEM JMP XXPUTE /ERROR RETURN ISZ XXXTMP JMP XXRUBL /LOOP FOR THE REQUIRED COUNT JMP I XXRUB XXXTMP, 0 /USED AS COUNTER AND POINTER XXXTTY, 0 TLS TSF JMP .-1 XXXCLA, 7600 /LOC TO RETURN TO PS/8 SYSTEM JMP I XXXTTY /NOT DEVICE INDEPENDENT - TOUGH BLEEP /ERROR MESSAGE PRINTOUT ROUTINE ERRPRT, DCA XXXTMP /SAVE LOC OF ERROR MESSAGE ERLP, TAD I XXXTMP RTR RTR RTR JMS ERPCH /PRINT HIGH-ORDER CHARACTER TAD I XXXTMP JMS ERPCH /PRINT LOW-ORDER CHARACTER ISZ XXXTMP JMP ERLP ERPCH, 0 AND (77 SNA JMP ERCRLF /0 CHARACTER TERMINATES TAD (-37 SNA JMP FILENR /"_" CHARACTER IS SPECIAL SPA TAD (100 TAD (237 JMS XXXTTY /OUTPUT THE CHAR JMP I ERPCH FILENR, TAD ("# JMS XXXTTY TAD INFPTR /GET PTR TO CURRENT INPUT FILE TAD (321 /MAGIC NUMBER CLL RAR JMP FILENR-2 ERCRLF, TAD (215 JMS XXXTTY TAD (212 JMS XXXTTY JMP XXXSGO /RETURN TO PS/8 SYSTEM ERR2, TEXTZ /OUTPUT ERROR/ ERR0, TEXTZ /NO ROOM FOR OUTPUT FILE/ ERR4, TEXTZ /INPUT ERROR, FILE_/ ERR5, TEXTZ /CAN'T OPEN OUTPUT FILE/ PAGE OUTMBF=. /TEMPORARY OUTPUT BUFFER DOT=OUTMBF+MXLENGTH+1 IFG DOT-7600 $-$-$ RAR JMP FILENR-2 ERCRLF, TAD (215 JMS XXXTTY TAD (212 JMS XXXTTY JMP XXXSGO /RETURN TO PS/8 SYSTEM ERR2, T