Directory of image this file is from
This file as a plain text file
/ TEXT FORMATTER - PRINTR / BY: CLYDE G. ROBY, JR. / DEPARTMENT OF PHYSIOLOGY AND BIOPHYSICS / WEST VIRGINIA UNIVERSITY MEDICAL CENTER / MORGANTOWN, WEST VIRGINIA / JANUARY 10, 1974 / VERSION 0: 1/10/74 / INITIAL TYPE IN OF PROGRAM / MAJOR REWRITING OF SOME ROUTINES 5/74 AND 6/74 / VERSION 1: 7/74 / ADDING IN NEW FEATURES / ADD IN .FLAG COMMANDS / CAPITALIZE WORDS WITH " AS FLAG CHARACTER / ALSO ADDED IN .AUTOCAPITALIZE COMMAND / VERSION 2: 7/23/74 / STARTED WORK ON .FOOTNOTE / MAJOR MOVING OF ROUTINES AND REWRITING / VERSION 3: 9/4/74 / BETTER LOGIC FOR MULTIPLE COPIES / BETTER FOOTNOTE PROCESSING AND " PROCESSING / CAPITALIZE FIRST CHARS OF WORDS WITH ^' AND \' / CLEANED UP OUTPUT ROUTINES / VERSION 4: 9/12/74 / BETTER .HEADER COMMAND IMPLEMENTED / BETTER COMCHK ROUTINE / IMPLEMENTED .TABS ABSOLUTE AND .TABS RELATIVE COMMANDS / ADDED .CHAPTER COMMAND / CLEANED UP FLAG COMMAND PROCESSING / ALSO CLEANED UP HEADER AND FOOTER PROCESSING / PATCH B: FIXED BUG IN FOOTER ROUTINE IN COMBO WITH .NOHEADER / IMPROVED CENTERING AND FIXED BUG THERE / CLEANED UP 'GETARG' ROUTINE AND "TITLE" COMMAND VERSION="4 /THE VERSION NUMBER PATCH="B /THE PATCH LEVEL
/ DEFINE SPECIAL INSTRUCTIONS TO ASSEMBLER FIXMRI INC=2000 /ISZ WHEN NOT EXPECTED TO SKIP MTWO=CLL STA RAL /GENERATE A -2 IN ACC / SOME USEFUL EQUALITIES SMALLA="A!40 SMALLZ="Z!40 YES=0000 NO=7777 SKIPYES=SZA CLA SKIPNO=SNA CLA / SOME LOCATIONS USED BY THE 'PUSH' AND 'POP' ROUTINES *6 PUSHTM, 0 PPTEMP, 0 / THE AUTO-INDEX REGISTERS (10-17) *10 AUTOX1, 0 /GENERAL XR'S USED THROUGHOUT PROG. AUTOX2, 0 AUTOX3, 0 BRKXR, 0 SORTXR, 0 /USED BY "SORTC" AND "SORTJ" PRTXR, 0 /USED BY SUBROUTINE "PRINT" FNXR, 0 /AUTOXR USED BY FOOTNOTE ROUTINES / GENERAL SWITCHES USED BY CERTAIN COMMANDS *20 / LOCATIONS THAT ARE INITIALIZED TO SPECIALIZED VALUES / KEEP THESE LOCATIONS IN THE SPECIFIED ORDER (SEE 'INITS') OTHERS=. LSPACE, -1 /ASSUME SINGLE SPACING FNPTR, FNBUFF /FOOTNOTE BUFFER POINTER SUBPGN, 0 /SUBPAGE LETTER LMARG, 1 /LEFT MARGIN (COLUMN) RMARG, 106 /RIGHT MARGIN (70) PWIDTH, 120 /LENGTH OF OUTPUT LINE (80) ALMARG, 1 /ACTUAL LEFT MARGIN FOR CURRENT LINE COPYWD, 0 /THE COPY WIDTH ALLOWED FOR THIS LINE PLENGTH,102 /LENGTH OF PAGE (66) STKPTR, STACK /STACK POINTER FOR PUSH-POP LIST PARAGN, 5 /INDENT 5 SPACES ON PARAGRAPH PARAGV, -1 /LEGAL VALUES ARE 1 TO 5 AND -1 /DEFAULT IS (SPACING + 1) / 2 PARAGP, 2 /.TEST PAGE ARG FOR PAGRGRAPH HWORD, 0111 /HEADER AT TOP OF PAGE ON RIGHT SIDE /"PAGE" IN UPPER CASE / SWITCHES THAT USER CAN SET SWJUST, YES /0 = .JUSTIFY, 7777 = .NOJUSTUFY SWFILL, YES /0 = .FILL, 7777 = .NOFILL SWPARA, NO /0 = .AUTOPARAGRAPH, /7777 = .NOAUTOPARAGRAPH SWHEAD, YES /0 = .HEADER, 7777 = .NOHEADER SWPAGE, YES /0 = .PAGING, 7777 = .NOPAGING SWSBPG, NO /0 = .SUBPAGE, 7777 = .NOSUBPAGE SWCC, NO /0 = .CONTROL CHARACTERS, 7777 = .NCC SWCAP, YES /0 = .AUTOCAPITALIZE, 7777 = .NAC SWPER, YES /0 = .PERIOD, 7777 = .NOPERIOD /0 = OUTPUT 2 SPACES AFTER .!?;: SWPNUM, YES /0 = .NUMBER, 7777 = .NONUMBER / COMMAND FLAGS / 0 = CHARACTER USED, 7777 = CHAR FLAG NOT USED CMDFLAGS, CTFLAG, YES /., COMMAND FLAG (ALWAYS USED) EFFLAG, YES /!, END OF FOOTNOTE FLAG (ALWAYS USED) SPFLAG, YES /#, FORCED SPACE CHARACTER QUFLAG, YES /_, QUOTE CHARACTER PRECEDENT ULFLAGS, UCFLAG, YES /^, UPPER CASE PRECEDENT UNFLAG, YES /&, UNDERLINE CHAR PRECEDENT CFFLAG, NO /', CAPITALIZE FIRST CHARS CQFLAG, NO /", CAPITALIZE ENTIRE WORD LCFLAG, YES /\, LOWER CASE PRECEDENT MODE, 7777 /7777 = \\, SET LOWER CASE MODE /0000 = ^^, SET UPPER CASE MODE UNMODE, 7777 /7777 = \&, CLEAR UNDERLINE MODE /0000 = ^&, SET UNDERLINE MODE UNCASE, 7777 /UNDERLINE SWITCH FOR CURRENT CHAR CQMODE, 7777 /0000 = ^", SET CAPITALIZE WORD MODE /7777 = \", CLEAR CAPITALIZE WORD MODE CQCASE, 7777 /0000 = SET CAP WORD, 7777 = CLEAR IT CFMODE, 7777 /0000 = \', CLEAR CAPITALIZE FIRST MODE /7777 = ^', SET CAPITALIZE FIRST CHAR MODE OTHEREND=. / LOCATIONS THAT SHOULD BE INITIALIZED TO ZERO ZEROS=. /ZERO THESE LOCS ON RE-INITIALIZATION ECAPSW, 0 /NON-ZERO FOR CAPITALIZING FIRST CHARS DEFERN, 0 /NO. OF "FIGURE DEFERRED" LINES FNCTR, 0 /NO. OF "FOOTNOTE" LINES OVERFLOW HFILL, 0 /0 = FILL WITH SPACES ON RIGHT END /7777 = FILL WITH SPACES ON LEFT END FNFLAG, 0 /7777 = WE ARE PROCESSING FROM /FOOTNOTE BUFFER FNLINE, 0 /NO. OF FOOTNOTE LINES ALLOCATED ON PAGE LOWONE, 0 /NONZERO IF TO MAKE SINGLE CHAR LOW CASE UPONE, 0 /NONZERO IF TO CAPITALIZE SINGLE CHAR TABFLG, 0 /0000 = ABSOLUTE TABS, 7777 = RELATIVE ZEROEND=. /END OF ZERO INITIALIZATION LOCS / THE TOP AND BOTTOM OF PAGE PARAMETER TABLES / THE FIRST NUMBER IS NO. OF BLANK LINES FROM "TOP" TO / THE FIRST PRINTED LINE. / THE SECOND NUMBER IS NO. OF BLANK LINES FROM LAST PRINTED / LINE TO "BOTTOM" SECTION OF BLANK LINES. / THE TOTAL NUMBER OF LINES AT TOP OR BOTTOM IS 6. TOP, 1; 2 /3 PRINTED LINES AT TOP BOTTOM, 3; 2 /1 PRINTED LINE AT BOTTOM / GENERAL LOCATIONS USED THROUGHOUT PROGRAM, NOT INITIALIZED COUNT, 0 /GENERAL COUNTER CTR1, 0 /OTHER COUNTERS CTR2, 0 PTR1, 0 /TEMPORARY POINTERS PTR2, 0 CHAR, 0 /HOLDS LAST INPUT CHAR NUMBER, 0 /HOLDS LAST NUMBER CONVERTED (ALSO TEMP) SIGN, 0 /SIGN OF LAST NUMBER CONVERTED CVRTQ, 0 /INDICATES WHETHER LAST NO. WAS CONVERTED RELFLG, 0 /INDICATES IF RELATIVE PSWITC, 0 /NON-ZERO IF /P SWITCH GIVEN /PAUSE AT PAGE BREAK TO CHANGE PAPER FSWITC, 0 /NON-ZERO IF /F SWITCH GIVEN /SIMULATE FORM FEED CHAR NCOPY, 0 /NO. OF COPIES OF OUTPUT USWITCH,0 /NON-ZERO TO FORCE UPPER CASE ON OUTPUT CURCOL, 0 /CURRENT COLUMN (ABSOLUTE) IN OUTPUT /LINE THAT NEXT CHAR IS TO BE STORED FNPTR2, 0 /2ND PTR USED IN FOOTNOTE PROCESSING NOFLG, 0 /THE "NO" FLAG FOR COMMANDS, 7777 IF "NO" LENOL, 0 /LENGTH OF OUTPUT LINE BETWEEN MARGS OUTPTR, 0 /GET SET TO CURRENT POSITION IN LINE OUTCTR, 0 /(-) NO. OF CHARS LEFT ON LINE NLINES, 0 /NO. OF LINES LEFT ON PAGE PAGENO, 0 /CURRENT PAGE NUMBER TOPSW, 0 /7777 IF AT TOP OF NEW PAGE SORTCN, 0 /ARGUMENT NO. FOR SORTJ AND COMCHK / EFFECTIVE MACRO CALLS GET= JMS I . /GET A CHAR FROM OS/8 INPUT FILE GETX PUT= JMS I . /OUTPUT CHAR TO OS/8 OUTPUT FILE PUTX GETC= JMS I . /GET A CHAR FROM INPUT FILE GETCX OSAVE= JMS I . /SAVE CHAR IN OUTPUT LINE BUFFER OSAVEX SPNOR= JMS I . /IGNORE SPACES ON COMMAND LINE SPNORX SORTJ= JMS I . /CHARACTER DISPATCH AND JUMP ROUTINE SORTJX GARBAGE=JMS I . /IGNORE GARBAGE AT END OF COMMAND LINE GARBJX COMCHK= JMS I . /COMMAND DISPATCH ROUTINE CMDCKX WORDCK= JMS I . /CHECK FOR SINGLE COMMAND WORD WRDCKX GETNUM= JMS I . /GET A NUMBER FROM COMMAND LINE GETNMX DOEJECT=JMS I . /SKIP TO TOP OF NEW PAGE EJECTX BREAK= JMS I . /"BREAK" THE OUTPUT LINE BY FORCING IT BREAKX EOCQ= JMS I . /IS THIS CHAR "END OF COMMAND" CHAR? EOCQX CRLF= JMS I . /OUTPUT A CR/LF COMBO CRLFX ERROR= JMS I . /OUTPUT AN ERROR MESSAGE ERRORX ERRORC= JMS I . /OUTPUT ERROR MESSAGE, GET NEXT CMD ERRCX ERRORF= JMS I . /OUTPUT A FATAL ERROR MESSAGE ERRFX PUSHA= JMS I . /PUSH ACC ONTO STACK PUSHAX POPA= JMS I . /POP TOP OF STACK TO ACC POPAX PUSHJ= JMS I . /RECURSIVE JMS PUSHJX BADCMD= JMP I . /JMP!! ILLEGAL COMMAND ILLCMD POPJ= JMP I . /JMP!! RETURN FROM PUSHJ POPJX RETURN= JMP I . /JMP!!! GET A NEW COMMAND LINE NLINE PAGE
/ START OF THE PROGRAM "PRINTR" / IF PROGRAM IS STARTED AT LOCATION 200, THEN COMMAND DECODER / IS INVOKED AND THE FOLLOWING IS REQUESTED: / *OUTPUT<INPUTS(OPTIONS) / IF PROGRAM IS STARTED AT LOCATION 201 (BY CHAINING), THESE / FILES ARE ASSUMED TO BE IN CD AREA IN FIELD 1 *200 PRINTR, SKP CLA /START PROGRAM HERE JMP NOCD /CHAINED, DON'T INVOKE COMMAND DECODER TAD (VERMESS-1) /PREPARE TO GIVE CURRENT VERSION NO. DCA AUTOX1 PRTV, TAD I AUTOX1 /GET AN ASCII CHAR SNA JMP GETCD /END OF STRING, GET COMMAND DECODER JMS TYPEIT /PRINT THE CHAR JMP PRTV /KEEP PRINTING CHARS GETCD, CIF 10 JMS I (7700) /GET USR TO MEMORY 10 CIF 10 JMS I (200) /USR STILL IN MEMORY 5 /CALL COMMAND DECODER TEXT \RO\ /ASSUMED INPUT EXTENSION NOCD, CIF 10 JMS I (SETIO) /SET UP I/O FOR US TO WORK WITH CDF 10 /LOOK FOR /P OPTION TAD [400] AND I (MPARAM+1) DCA PSWITC /SAVE THE PAUSE SWITCH TAD I (MPARAM) AND (100) /LOOK FOR /F OPTION DCA FSWITCH /IF /F, SIMULATE FORM FEED TAD I (MPARAM+1) AND (10) /LOOK FOR /U SWITCH DCA USWITCH /FORCE UPPER CASE ON OUTPUT TAD I (NPARAM) /GET =N ARGUMENT SNA IAC CIA DCA NCOPY /SAVE (-) NO. OF COPIES TO GENERATE CDF 00 CLA IAC DCA NLINES /NO. OF LINES LEFT ON PAGE STA /INITIALIZE PAGE NO. FOR INIT START PRTGO, DCA PAGENO /ALL OTHERS, ZAP TO ZERO JMS INIT /INITIALIZE BUFFERS, FLAGS, ETC. DCA I (TITLEB) /ZAP TITLE AND SUBTITLE BUFFERS DCA I (SBTTLB) DCA I (CHBUFF) /CLEAR CHAPTER BUFFER, TOO TAD TOPSW /ARE WE AT TOP OF PAGE? SNA CLA DOEJECT /NO, GO TO TOP OF PAGE? / GET A NEW LINE / CHECK FIRST CHAR FOR COMMAND OR COMMENT NLINE, GETC /GET AN INPUT CHAR TAD CHAR /FIRST CHAR OF LINE CIA TAD CTLCHR /IS IT COMMAND CHAR (".") ? SNA CLA JMP COMMAND /YES, GO DO A COMMAND TAD SWFILL SKIPYES JMP NLINE1 /.NOFILL, GO SAVE CHAR TAD SWPARA /(.FILL) IS AUTOPARAGRAPH ON? SKIPYES JMP NLINE1 /NO, GO SAVE CHAR TAD CHAR TAD [-" ] SZA TAD (" -211) SNA CLA /FIRST CHAR OF LINE A SPACE OR TAB? JMP PARAG /YES, START A NEW PARAGRAPH. NLINE1, TAD CHAR /GET THE CHAR BACK PUSHJ /SAVE THE CHARS IN PRINT BUFFER SAVECX TAD CHAR /IS CHAR END-OF-LINE? SNA CLA JMP NLINE /YES, MAYBE ANOTHER PARAGRAPH GETC /NO, GET ANOTHER CHAR JMP NLINE1 / PUSH CONTENTS OF ACCUMULATOR ONTO TOP OF STACK PUSHAX, 0 DCA PPTEMP /SAVE ACC TAD STKPTR CLL CIA TAD (STKEND) SNL CLA /STACK OVERFLOW? JMP PUSHA2 /NO, STILL IN STACK ERRORF /ERROR, STACK OVERFLOW SIXBIT \SO\ PUSHA2, TAD PPTEMP DCA I STKPTR /PUT ACC ONTO STACK STA TAD STKPTR DCA STKPTR /DECREMENT STACK PTR JMP I PUSHAX /RETURN WITH CLEAR ACC / POP TOP ITEM OF STACK AND PLACE IN ACC POPAX, 0 CLA CLL /CLEAR GARBAGE IN ACC INC STKPTR TAD STKPTR CLL CIA TAD (STACK) SZL CLA /STACK UNDERFLOW? JMP POPAX2 /NO, STILL IN STACK ERRORF /ERROR, STACK UNDERFLOW SIXBIT \SU\ POPAX2, TAD I STKPTR /GET ITEM FROM TOP OF STACK JMP I POPAX / PUSHJ / PUSH RETURN LOC TO TOP OF STACK / JUMP TO ADDRESS GIVEN AS ARGUMENT PUSHJX, 0 DCA PUSHTM /SAVE ACC CLA CLL IAC TAD PUSHJX PUSHA /SAVE RETURN LOC ON TOP OF STACK TAD I PUSHJX /GET LOC TO JUMP TO DCA PUSHJX TAD PUSHTM /RESTORE ACC JMP I PUSHJX /JUMP TO THE ROUTINE PAGE
/ CHECK FOR LEGAL COMMANDS IN COMMAND LIST / IF EQUAL, DISPATCH TO ROUTINE IN JUMP LIST CMDCKX, 0 RDF /WHERE IS THE STRING? TAD CDFINS DCA CFIELD+1 /DATA FIELD OF STRINGS CDFINS, CDF 00 /CHANGE BACK TO US JMS GETARG /GET COMMAND WORD TO COMMAND BUFFER CLA IAC /ADD ONE TO THE TAD I CMDCKX /COMMAND LIST - 1 INC CMDCKX DCA CMDPTR /SAVE THE POINTER TAD I CMDCKX /GET LIST OF JUMPS INC CMDCKX DCA AUTOX3 DCA SORTCN /CLEAR ARGUMENT NO. CMDCK3, JMS CHKCOM /CHECK COMMAND VERSUS LIST ELEMENT JMP CMDCK5 /FOUND IT INC SORTCN /NOT IT, ONE MORE ARGUMENT BY TAD I CMDPTR /END OF ELEMENT LIST? SZA CLA JMP CMDCK3 /NO, CHECK NEXT ONE OUT CDF 00 TAD AUTOX3 /YES, PREPARE TO RETURN SNA CLA /THRU LIST OR AFTER ARGS? INC CMDCKX /AFTER ARGUMENTS JMP I CMDCKX /RETURN NOT FOUND IN COMMAND LIST CMDCK5, CDF 00 /BACK TO OUR FIELD DCA I [CMDLINE] /SO NEXT GETARG WILL WORK TAD AUTOX3 /HOW TO RETURN? SNA JMP I CMDCKX /ZERO, RETURN AFTER ARGS TAD SORTCN DCA AUTOX3 /ADDR TO GET JUMP TAD I AUTOX3 /GET LOC FOR ROUTINE DCA CMDCKX JMP I CMDCKX /DISPATCH TO ROUTINE / SUBR TO CHECK IF COMMAND LINE IS EQUAL TO CURRENT CMD IN LIST CHKCOM, 0 CDF 00 TAD (CMDLINE-1) /LOOK AT COMMAND BUFFER DCA AUTOX2 TAD I [CMDLINE] /CHECK FOR "NO" IN COMMAND TAD (-1617) /"NO" SZA CLA JMP .+3 INC AUTOX2 /YES, SKIP OVER IT STA /BUT SET THE "NO" FLAG DCA NOFLG /7777 IF "NO" JMS CFIELD /CHANGE TO FIELD OF TEXT STRINGS CMDEN4, TAD I CMDPTR /GET 2 CHARS FROM LIST CIA CDF 00 /CMD BUFFER IN FIELD$0 TAD I AUTOX2 /CHECK WITH COMMAND BUFFER JMS CFIELD /TEXT FIELD IS 1 SNA CLA JMP CMDEN3 /CHARS ARE EQUAL CMDEN2, TAD I CMDPTR /GET CHARS FROM LIST INC CMDPTR AND [77] /JUST WANT RIGHT-HAND CHAR SZA CLA /TO SEE IF END OF COMMAND JMP CMDEN2 /NOT, GO TO END OF COMMAND INC CHKCOM /RETURN .+2 IF NOT EQUAL JMP I CHKCOM CMDEN3, TAD I CMDPTR /CHARS WERE EQUAL INC CMDPTR AND [77] SZA CLA /END OF COMMAND JMP CMDEN4 /NO, COMPARE NEXT 2 CHARS JMP I CHKCOM /RETURN .+1 IF FOUND IN LIST CFIELD, 0 /CHANGE TO FIELD OF TEXT STRINGS HLT /CHANGED TO "CDF N0" JMP I CFIELD CMDPTR, 0 / SUBROUTINE TO CONVERT NUMBER IN ACC TO DECIMAL ASCII CHARACTERS / LEADING ZEROES ARE IGNORED BINASC, 0 DCA BINNUM /SAVE NUMBER TO CONVERT TAD (DTABLE) DCA PTR1 /INITIALIZE POINTER CLL STA RTL /-3 TO ACC DCA CTR1 /INITIALIZE CTR, TOO BIN1, DCA BINDIG /INITIALIZE DIGIT EACH TIME JMP .+3 BIN2, DCA BINNUM INC BINDIG CLL /ALLOWS 0-4095 TAD BINNUM TAD I PTR1 /SUBTRACT POWER OF 10 SZL JMP BIN2 /NOT YET OVERFLOWED CLA INC PTR1 /NEXT POWER OF TEN TAD BINDIG /GET THE DIGIT SNA JMP BIN3 /LEADING ZERO, IGNORE TAD ("0) AND [377] JMS OTSAVE /SAVE THE ASCII NUMERIC CHAR STL CLA RAR /4000 TO ACC BIN3, ISZ CTR1 /ALL DIGITS OUT YET? JMP BIN1 /NO TAD BINNUM /GET LAST DIGIT TAD ("0) AND [377] JMS OTSAVE /AND SAVE IT JMP I BINASC /RETURN TO CALLER BINNUM, 0 BINDIG, 0 DECIMAL DTABLE, -1000 -100 -10 OCTAL / SUBROUTINE TO CHECK BITS IN ACC AND RETURN / TO APPROPRIATE PLACE AFTER CALL / IF ACC = 0, RETURN .+1 / IF BIT 11 IS SET, RETURN .+2 / IF BIT 10 IS SET, RETURN .+3, ETC. BITCHK, 0 SNA JMP I BITCHK /ZERO, RETURN .+1 INC BITCHK /INCREMENT RETURN CLL RAR /GET NEXT BIT TO LINK SNL JMP BITCHK+1 /ZERO, GET NEXT BIT CLA JMP I BITCHK /SET, RETURN TO CALLER ECHARS, ASCIIZ ".:;!?" PAGE
/ SAVE A CHARACTER IN THE OUTPUT BUFFER / THIS IS THE OUTERMOST ROUTINE / CONVERTS TABS TO SPACES; CHECKS EOL IN .NOFILL AND PRINTS LINE SAVECX, SNA JMP SAVC4 /EOL, MORE CHECKING DCA SAVCHR /SAVE THE CHAR TAD SAVCHR TAD [-211] SZA CLA /IS IT A TAB CHAR? JMP SAVC3 /NOT A TAB, GO SAVE IT TAD (TABS-1) /TAB, MUST EXPAND TO SPACES DCA SAVTPT /INITIALIZE TAB PTR SAVC1, INC SAVTPT /POINT TO NEXT TAB CLA TAD I SAVTPT /GET A TAB STOP SNA CLA JMP SAVC2 /NO MORE STOPS, SAVE A SPACE TAD TABFLG /ABSOLUTE OR RELATIVE TAB STOPS? SNA CLA JMP .+3 /ABSOLUTE STA TAD ALMARG /RELATIVE, USE ACTUAL LEFT MARGIN - 1 TAD I SAVTPT /GET THE TAB STOP AGAIN CIA TAD CURCOL /HAVE WE REACHED CURRENT COLUMN YET? SMA JMP SAVC1 /NO, GET NEXT TAB STOP DCA SAVSPC /SAVE NO. OF SPACES TO EXPAND TAD [" ] JMS SAVECL /SAVE A SPACE ON LINE ISZ SAVSPC /IS TAB EXPANDED? JMP .-3 /NOPE POPJ /RETURN IF TAB EXPANDED SAVC2, TAD [" ] /JUST SAVE A SPACE IF NO MORE STOPS SKP SAVC3, TAD SAVCHR /SAVE CURRENT CHAR JMS SAVECL POPJ SAVC4, TAD SWFILL /EOL, WHAT FILL MODE ARE WE IN? SKIPNO JMP SAVC3+1 /.FILL, GO SAVE EOL (0 CHAR) PUSHJ /.NOFILL, PRINT THE FULL LINE PRINT TAD LSPACE /(-) LINE SPACING CRLF TAD (SAVCL2+1) /RESET CO-ROUTINE ENTRY POINT DCA SAVECR POPJ /RETURN TO CALLER SAVSPC, 0 SAVTPT, 0 SAVCHR, 0 / ANOTHER SUBROUTINE A LEVEL DEEPER TO SAVE A CHAR / CHECKS FOR SPECIAL END-OF-LINE PUNCTUATION COMBINATIONS SAVECL, 0 DCA SAVCHR /SAVE THE CHARACTER AGAIN TAD SAVECL /SAVE RETURN LOC ON STACK PUSHA JMP I SAVECR /GO TO CORRECT PLACE IN ROUTINE SAVECR, SAVCL2+1 /NORMAL ENTRY POINT POPJ /RETURN TO CALLER SAVCL2, JMS SAVECR /RETURN FOR ANOTHER CHAR TAD SAVCHR /CHECK THE CHARACTER OUT SNA TAD [" ] /CONVERT EOL TO SPACE DCA SAVCHR TAD SAVCHR TAD [-" ] SNA CLA JMP SAVCL4 /SPACE, GO SAVE IT, END OF WORD SAVCL3, TAD SAVCHR /NOW CHECK CHAR FOR ENDING CHAR SORTJ /IS CHAR ONE OF FOLLOWING? ECHARS-1 /. ; : ! ? 0 JMP SAVCL7 /YES, SPECIAL PROCESSING SAVCL4, TAD SAVCHR /NO, SAVE THE CHAR JMS SAVEIT JMP SAVCL2 / SPECIAL END OF LINE CHARACTER PROCESSING (IF .PERIOD) / THE SPECIAL CHARS ARE . : ; ! ? SAVCL7, TAD SWPER /SPECIAL CHAR PROCESSING? SKIPYES JMP SAVCL4 /NO, JUST SAVE THE CHAR TAD SAVCHR /SPECIAL CHARS: . : ; ! ? JMS SAVEIT /SAVE IT JMS SAVECR /GO GET CHAR AFTER IT TAD SAVCHR SNA JMP SAVCL8 /ECHAR FOLLOWED BY EOL, => 2 SPACES TAD [-" ] SZA CLA JMP SAVCL3 /NOT A SPACE, CHECK FOR GOOD CHARS AGAIN JMS SAVECR /ECHAR AND SPACE, TRY AGAIN TAD SAVCHR TAD [-" ] SZA CLA JMP SAVCL9 /NOT A SPACE, GO SAVE CHARS SAVCL8, TAD [" ] /ECHAR FOLLOWED BY 2 SPACES => 2 SPACES JMS SAVEIT /SAVE THE 2 SPACES AFTER ECHAR TAD [" ] JMS SAVEIT STA DCA ECAPSW /CAPITALIZE NEXT CHAR (MAYBE) JMP SAVCL2 /GET ANOTHER CHAR SAVCL9, TAD [" ] /SAVE THE FIRST SPACE AFTER CHAR JMS SAVEIT JMP SAVCL3 /THEN GO SAVE CURRENT CHAR / POPJ RETURN FROM LAST PUSHJ POPJX, POPA /GET RETURN FROM TOP OF STACK DCA PPTEMP /SAVE IT FOR JUMP JMP I PPTEMP /RETURN TO CALLER / .COMMENT COMMAND GETC /GET ANOTHER CHAR CMDCOM, TAD CHAR /CHECK CURRENT OUT SNA CLA /END OF LINE? RETURN /YES JMP CMDCOM-1 CENTJ, CWDTH CMARG / CONSTANTS USED THROUGHOUT PROGRAM CTLCHR, ". EFCHAR, "! CMDCHR, "# "_ UPLOWC, "^ "& "' "" "\ 0 CMDLST, "! "; ", 240 211 0 /THE EOL CHAR PAGE
/ SUBROUTINE TO SAVE A CHAR IN OUTPUT LINE BUFFER / IF LINE BUFFER OVERFLOWS, RETURN .+2 / OTHERWISE, RETURN NORMALLY .+1 OSAVEX, 0 DCA I OUTPTR /SAVE CHAR IN OUTPUT LINE BUFFER INC OUTPTR /INCREMENT PTR INC CURCOL /INCREMENT CURRENT ABSOLUTE COLUMN INC LENOL /LENGTH OF OUTPUT LINE ISZ OUTCTR /ANY MORE CHAR POSITIONS LEFT? SKP INC OSAVEX /NO, RETURN .+2 JMP I OSAVEX /NORMAL RETURN .+1 / SAVE A CHARACTER IN OUTPUT LINE BUFFER / CHECK IF LINE BUFFER FULL (BY WORDS) / CHECK TO SEE IF WE JUSTIFY LINE, ALSO SAVEIT, 0 DCA SAVETC /SAVE CHAR TO PUT IN BUFFER TAD SAVEIT /SAVE RETURN LOC ON STACK PUSHA SAVE1, TAD OUTCTR /IS BUFFER FULL? SNA CLA JMP SAVE3 /YES, MUST SAVE A "WORD" SAVE2, TAD LENOL /NO, SAVE THE CHAR SZA CLA /ANY CHARS ON LINE YET? JMP SAVE22 /YES, GO SAVE THE CHAR TAD SAVETC /NO, IS CHAR A SPACE? TAD [-" ] SZA CLA JMP SAVE22 /CHAR NOT A SPACE, GO SAVE IT TAD SWFILL /YES, A SPACE...FILL MODE ON? SKIPNO POPJ /YES, IGNORE THOSE INITIAL SPACES SAVE22, TAD SAVETC /GET THE CHAR OSAVE /AND SAVE IT NOP POPJ /RETURN SAVE3, TAD SAVETC /SAVE CURRENT CHAR ON STACK PUSHA SAVE33, JMS SAVDEC /DECREMENT PTR, LENGTH OF LINE TAD I OUTPTR /GET THE CHAR TAD [-" ] SNA /IS CHAR A SPACE? JMP SAVE37 /YES, WE HAVE OUR WORD TAD [" ] /REGENERATE CHAR PUSHA /AND SAVE IT ON STACK STA TAD OUTCTR DCA OUTCTR /DECREMENT OUTPUT BUFFER CTR TAD LENOL /HAVE WE MOVED EVERYTHING OUT? SZA CLA JMP SAVE33 /NO, KEEP LOOKING FOR A SPACE SAVE35, POPA /EVERYTHING OUT OSAVE /MOVE EVERYTHING BACK TO OUTPUT BUFFER JMP .-2 PUSHJ /THEN PRINT THE LINE PRINT TAD LSPACE /CURRENT SPACING (-) CRLF JMP SAVE62 /GO GET CURRENT CHAR SAVE37, TAD LENOL /HAVE WE MOVED ALL CHARS OUT? SNA CLA JMP SAVE35 /YES, RESTORE EVERYTHING, THEN JMS SAVDEC /DECREMENT POINTER, LENGTH OF LINE TAD I OUTPTR /GET A CHAR TAD [-" ] SNA CLA JMP SAVE37 /ANOTHER SPACE INC LENOL /COUNT LAST NON-SPACE CHAR TAD OUTCTR PUSHA /SAVE CTR FOR MOVE LATER ON SAVE5, TAD SWJUST /DO WE JUSTIFY THE LINE? SKIPYES JMP SAVE60 /NO, GO PRINT LINE TAD (-20) DCA SAVCTR /TRY TO JUSTIFY LINE 20(8) TIMES SAVE8, JMS PLINEQ /SEE IF WE CAN PRINT LINE ISZ HFILL /MUST JUSTIFY LINE, WHICH HALF? JMP RFILL /JUSTIFY STARTING ON RIGHT SIDE STA DCA HFILL JMS LEFILL /JUSTIFY STARTING ON LEFT SIDE SKP RFILL, JMS RIFILL /JUSTIFY STARTING AT RIGHT SIDE ISZ SAVCTR /TRIED 20(8) TIMES? JMP SAVE8 /NO, TRY AGAIN JMP SAVE6 /YES, GIVE UP AND PRINT / SUBROUTINE TO CHECK TO SEE IF WE CAN PRINT THE OUTPUT LINE PLINEQ, 0 TAD LENOL /IS THE LENGTH OF THE LINE CIA TAD COPYWD /EQUAL TO THE ALLOWABLE LENGTH? SZA CLA JMP I PLINEQ /NO, TRY AGAIN SAVE6, TAD HFILL /MAKE SURE WE START AT OPPOSITE SMA CLA / END NEXT TIME STA DCA HFILL SAVE60, PUSHJ /PRINT THE OUTPUT LINE PRINT TAD LSPACE /CURRENT SPACING (-) CRLF POPA DCA SAVCNT /RESTORE CTR FOR MOVE TAD SAVCNT SNA CLA JMP SAVE62 /GET CURRENT CHAR SAVE61, POPA /RESTORE CHARS THAT WE SAVED OSAVE SKP JMP SAVE9 /BAD ERROR ISZ SAVCNT /ALL CHARS SAVED YET? JMP SAVE61 SAVE62, POPA /EFFECTIVE CURRENT CHAR DCA SAVETC /SAVE THE CURRENT CHAR JMP SAVE1 SAVE9, ERRORF /FATAL ERROR, BAD PROGRAM SIXBIT \OE\ SAVETC, 0 SAVCNT, 0 SAVCTR, 0 / IGNORE SPACES OR TABS ON COMMAND LINE / OR LEADING SPACES OR TABS AT BEGINNING OF PARAGRAPH. SPNORX, 0 TAD CHAR TAD [-" ] SNA JMP .+4 /SPACE, IGNORE IT TAD (" -211) SZA CLA JMP I SPNORX /NON-SPACE OR TAB, RETURN GETC /TAB OR SPACE, IGNORE IT JMP SPNORX+1 PAGE
/ SUBROUTINE TO FILL THE OUTPUT LINE WITH SPACES / STARTING ON THE LEFT SIDE OF THE LINE LEFILL, 0 TAD (LINE) /INITIALIZE PTR AND CTR DCA PTR1 TAD LENOL /ACTUAL LENGTH OF OUTPUT LINE CIA DCA CTR1 LEFIL2, TAD I PTR1 INC PTR1 TAD [-" ] SZA CLA JMP LEFIL4 LEFIL8, ISZ CTR1 JMP LEFIL2 JMP I LEFILL LEFIL3, TAD I PTR1 INC PTR1 TAD [-" ] SNA CLA JMP LEFIL6 LEFIL4, ISZ CTR1 JMP LEFIL3 JMP I LEFILL LEFIL6, JMS PLINEQ TAD CTR1 SNA JMP I LEFILL JMS SAVFILL JMP LEFIL2 / SUBROUTINE TO FILL THE OUTPUT LINE / BY INSERTING SPACES STARTING AT RIGHT END OF LINE RIFILL, 0 TAD LENOL TAD (LINE) DCA PTR1 /POINTS TO LAST CHAR OF LINE+1 TAD LENOL CIA DCA CTR1 RIFIL7, STA TAD PTR1 DCA PTR1 TAD I PTR1 TAD [-" ] SZA CLA JMP RIFIL3 ISZ CTR1 JMP RIFIL7 JMP I RIFILL RIFIL2, STA TAD PTR1 DCA PTR1 TAD I PTR1 TAD [-" ] SNA CLA JMP RIFIL4 RIFIL3, ISZ CTR1 JMP RIFIL2 JMP I RIFILL RIFIL4, ISZ CTR1 SKP JMP I RIFILL JMS PLINEQ TAD LENOL /LENGTH OF OUTPUT LINE TAD CTR1 SNA JMP I RIFILL CIA JMS SAVFILL JMP RIFIL7 / SUBROUTINE TO MOVE THE OUTPUT LINE BUFFER / 1 CHAR TO RIGHT FOR SPECIFIED COUNT SAVFILL,0 DCA CTR2 TAD LENOL TAD (LINE-1) DCA PTR2 /INITIALIZE TO LAST CHAR-1 OF LINE SAVFL2, TAD I PTR2 INC PTR2 DCA I PTR2 MTWO TAD PTR2 DCA PTR2 ISZ CTR2 JMP SAVFL2 INC LENOL /WE HAVE ONE MORE CHAR ON THE LINE JMS PLINEQ JMP I SAVFILL / SUBROUTINE TO FIX UP PARAMETERS FOR A NEW OUTPUT LINE / NORMALLY ENTER WITH CLEAR ACC / OTHERWISE, ENTER WITH LEFT MARGIN MODIFIER IN ACC NLPARM, 0 TAD LMARG /ADD TO CURRENT LEFT MARGIN DCA ALMARG /THE ACTUAL LEFT MARGIN STA /NORMAL CALL VIA "JMS" NPARMS, DCA NLSWIT /ENTRY VIA "PUSHJ; NPARMS" (ALMARG SETUP) TAD ALMARG /ACTUAL LEFT MARGIN CIA IAC TAD RMARG /RIGHT MARGIN DCA COPYWD /COPY WIDTH = RMARG-ALMARG+1 TAD (LINE) DCA OUTPTR /INITIALIZE POINTER TAD COPYWD CIA DCA OUTCTR /MAX NO. OF CHARS ON LINE DCA LENOL /LENGTH OF OUTPUT LINE IS 0 TAD ALMARG DCA CURCOL /INITIALIZE CURRENT COLUMN ISZ NLSWIT /HOW TO RETURN POPJ /CALLED VIA "PUSHJ" JMP I NLPARM /NORMAL CALL, RETURN TO CALLER NLSWIT, 0 / SUBROUTINE TO MOVE A BUFFER TO OUTPUT LINE MOVEL, 0 TAD I MOVEL /ADDR-1 OF BUFFER TO MOVE INC MOVEL DCA AUTOX2 TAD I AUTOX2 SNA JMP I MOVEL /ZERO ENDS CHAR STRING JMS OTSAVE /SAVE IN OUTPUT BUFFER JMP .-4 / SAVE A CHAR IN OUTPUT BUFFER FROM OTITLE ROUTINES OTSAVE, 0 OSAVE /SAVE IN OUTPUT BUFFER JMP I OTSAVE /RETURN IF O.K. ERROR /LONG TITLE OR WHATEVER, NO MORE ROOM SIXBIT \LH\ JMP OHEAD6 /NOW PREPARE TO RETURN FIGWD, TEXTZ "DEFERRED" PAGE
/ THE JUMP LIST FOR THE LEGAL COMMANDS CMDJ, AUTCAP AUTCAP AUTOP AUTOP BLANK BLANK BREAKC BREAKC CENTC CENTC CENTC CHAPTER CHAPTER CMARG CWDTH CMDCOM CCHARS CCHARS END ESUBPG FIGURE FIGURE FILLC FILLC FLAGC FLAGC FLAGSC FNOTE FNOTE HEADER HEADER INDENT INDENT JUST JUST LEFT LEFT LMARGC LCASE LOWER MARGNS MARGNS NAUTOC NAUTOP NOCCHR NOFILL NOFLGC NOHEAD NOJUST NONUM NOPAGE NOPER NUMCMD NUMCMD PAGEC PAGEC PAPERC PAGSIZE PAGING PAGING PARAGRAPH PARAGRAPH PERIOD PERIOD RIGHT RIGHT RMARGC SKIP SKIP SPACING SPACING SUBPG SUBPG SBTTLC SBTTLC SBTTLC TABGET TABSTP TABABS TABREL TABSAR TSTPG TESTPG TITLEC TITLEC UCASE UPPER INITS, -1 /LSPACE FNBUFF /FNPTR 0 /SUBPGN 1 /LMARG 106 /RMARG 120 /PWIDTH 1 /ALMARG 0 /COPYWD 102 /PLENGTH STACK /STKPTR 5 /PARAGN -1 /PARAGV 2 /PARAGP 0111 /HWORD YES /SWJUST YES /SWFILL NO /SWPARA YES /SWHEAD YES /SWPAGE NO /SWSBPG NO /SWCC YES /SWCAP YES /SWPER YES /SWPNUM YES /CTFLAG YES /EFFLAG YES /SPFLAG YES /QUFLAG YES /UCFLAG YES /UNFLAG NO /CFFLAG NO /CQFLAG YES /LCFLAG 7777 /MODE 7777 /UNMODE 7777 /UNCASE 7777 /CQMODE 7777 /CQCASE 7777 /CFMODE PAGE
/ GENERAL GET-A-CHAR ROUTINE / DOES SOME CHECKING FOR CASE, AND UNDERLINE GETCX, 0 CLA CLL GETCX1, TAD UNMODE /UNDERLINE THE SAME WAY DCA UNCASE GETCX2, GET /GET AN INPUT CHAR DCA CHAR /AND SAVE IT GETCX3, TAD CHAR /GET THE CURRENT CHAR SORTJ /CHECK FOR CERTAIN CTRL/CHARS CTRLS-1 CTRLJ-CTRLS TAD CHAR /NOT A SPECIAL CHAR TAD [-" ] SNA CLA JMP GCSP /A SPACE, SPECIAL DOINGS TAD CHAR /GET CHAR BACK AGAIN AND [377] /DON'T CARE WHETHER IT'S A TAD [-" ] / QUOTED OR UNQUOTED CTRL/CHAR SMA CLA /IS IT A REAL LIVE CTRL/CHAR? JMP GETCX6 /NO TAD SWCC /YES, CTRL/CHARS ALLOWED? SKIPNO JMP GETCXR /YES, KEEP IT QUOTED OR UNQUOTED ERROR /NO, GIVE ERROR, ILLEGAL CTRL/CHAR SIXBIT \IC\ JMP GETCX2 /GET ANOTHER CHAR GETCX6, TAD CHAR /CHECK FOR SPECIAL TEXT CHARS SORTJ CMDCHR-1 CMDJMP-CMDCHR GETCX4, TAD CHAR /REG. CHAR COMES THRU HERE JMS TSTALL /TEST FOR LARGE ALPHABETICS JMP GETCX5 /NOT ALPHABETIC TAD UPONE /CAPITALIZE ONE CHAR? SZA CLA JMP GETCX5 /YES, LET IT PASS TAD LOWONE /LET A SINGLE CHAR GO LITTLE? SZA CLA JMP GETCLO /YES, MAKE IT SMALL TAD MODE /UPPER CASE MODE SNA CLA JMP GETCX5 /YES, LET CHAR PASS TAD CQCASE /CAPITALIZE A WORD? SNA CLA JMP GETCX5 /YES, PASS CHAR THRU TAD SWCAP /AUTOCAPITALIZE ON? SKIPYES JMP GETCLO /NO, LET IT GO FOR SMALL CHAR TAD ECAPSW /YES, DO WE CAPITALIZE THIS CHAR? SZA CLA JMP GETCX5 /YES GETCLO, TAD CHAR /NO, CONVERT FROM UPPER TO LOWER AND [7737] TAD [40] DCA CHAR /AND SAVE THE CHAR GETCX5, DCA ECAPSW /TURN OFF CAP FIRST CHAR SWITCH TAD UNCASE /UNDERLINE THE CHARACTER? SZA CLA JMP GETCXR /NO, GO RETURN TAD CHAR CLL RAL /SET 4000 BIT FOR UNDERLINING STL RAR DCA CHAR /AND SAVE IT GETCXR, CLA CLL DCA UPONE /CLEAR SINGLE CAP GETCX7, DCA LOWONE /CLEAR SINGLE LOWER CASE JMP I GETCX /RETURN TO CALLER GCFF, INC INPAGE /FORM FEED IS END OF PAGE, INC PAGE# DCA INLINE /RESET LINE NO. SKP GCVT, GCLF, INC INLINE /END OF LINE, INCREMENT LINE NO. CLA CLL /EOL CHAR IS 000 DCA CHAR GCCR, GCTAB, GCSP, TAD CQMODE /IF CAPITALIZING A LOT OF WORDS DCA CQCASE /SET UP CAPITALIZATION CASE TAD CFMODE CMA /MAKE IT NON-ZERO TO SET UPONE IF ON DCA UPONE /CAPITALIZE ONE CHAR, MAYBE TAD CHAR TAD [-215] SNA CLA /WAS CHAR A CARRIAGE RETURN? JMP GETCX1 /YES, IGNORE IT JMP GETCX7 /NO, USE GOOD CHAR GETUP, TAD UCFLAG SKIPYES JMP GETCXR /NOT USING UPPER CASE FLAG CHARACTER JMP GETUP2 /LOCK OR UPPER = 0000 GETLOW, TAD LCFLAG SKIPYES JMP GETCXR /NOT USING LOWER CASE FLAG CHARACTER STA /UNLOCK OR LOWER = 7777 JMP GETUP2 /GO SET UP AND CHECK NEXT CHAR GETUN, TAD UNFLAG SKIPYES JMP GETCXR /NO UNDERLINE FLAG AVAILABLE DCA UNCASE /"&", UNDERLINE NEXT CHAR JMP GETCX2 GETSP, TAD SPFLAG SKIPYES JMP GETCXR /NO FORCED SPACE FLAG TAD [" ] /#, FORCE A SPACE TO PASS JMP GETCX9 /IT MIGHT BE UNDERLINE, TOO GETCHR, TAD QUFLAG SKIPYES JMP GETCXR /NOT USING QUOTE FLAG GET /"_", TAKE NEXT CHAR LITERALLY GETCX9, TAD [400] /SET 400 TO PASS PROGRAM DCA CHAR JMP GETCX5 /IT MIGHT BE UNDERLINED GETCWD, TAD CQFLAG /CAN WE USE THE CHAR AS FLAG? SKIPYES JMP GETCXR /NO, RETURN AS NORMAL CHAR DCA CQCASE /YES, SET CAP WORD FOR NEXT WORD JMP GETCX1 /GET NEXT CHAR GETCFL, TAD CFFLAG /CAN WE USE THE CHAR AS FLAG? SKIPYES JMP GETCXR /NO, USE AS REGULAR CHAR STA DCA UPONE /YES, SET TO CAPITALIZE 1 CHAR JMP GETCX1 /GET ANOTHER CHAR INLINE, 0 /INPUT LINE NO. ON CURRENT PAGE INPAGE, 0 /CURRENT INPUT EDIT PAGE NO. MARGWD, TEXTZ "MARGIN" PAGE
/ THERE CAN BE FOOTNOTES IN THIS DUMB PROGRAM!! / .FOOTNOTE N SAVE N LINES ON PAGE FOR FOOTNOTE FNOTE, TAD FNFLAG /ARE WE PROCESSING A FOOTNOTE? SNA CLA JMP .+3 /NO, PROCESS IT ERRORF /YES, FATAL ERROR SIXBIT \FF\ /FOOTNOTE IN FOOTNOTE GETNUM /GET NO. OF LINES TO RESERVE GARBAGE /IGNORE OTHER GARBAGE TAD LSPACE /NO, GET LINE SPACING (-) DCA COUNT TAD NUMBER /RESERVE N * LINE SPACING SPA SNA CLA JMP BADARG /BAD FOOTNOTE ARGUMENT TAD NUMBER ISZ COUNT JMP .-2 DCA COUNT /TOTAL NO. OF LINES TAD COUNT CIA TAD NLINES SPA SNA /CAN FOOTNOTE FIT ON THIS PAGE? JMP FNOTE8 /NOPE DCA NLINES /YES, NEW LINE COUNTER IS UPDATED TAD COUNT TAD FNLINE /NO. OF LINES OF FOOTNOTE ON PAGE DCA FNLINE /UPDATE THE COUNTER FNOTE1, GET DCA CHAR /GET CHAR FROM OS/8 INPUT TAD CHAR CIA TAD EFCHAR SZA CLA /IS IT END OF FOOTNOTE? JMP FNOTE5 /NO, SAVE THIS LINE JMP CMDCOM /REMAINDER OF LINE IS A COMMENT FNOTE4, GET /GET NEXT CHAR ON LINE DCA CHAR FNOTE5, TAD CHAR /CURRENT CHAR CDF 10 /FOOTNOTE BUFFER IN FIELD 1 DCA I FNPTR /SAVE CHAR IN FOOTNOTE BUFFER CDF 00 INC FNPTR TAD FNPTR /AT END OF BUFFER? TAD (-FNBEND) SNA CLA JMP FNOTE6 /YES, ERROR MESSAGE TAD CHAR /NOPE TAD [-215] /IS IT LINE TERMINATOR? SMA SZA JMP FNOTE4 /NO, GET NEXT CHAR TAD (215-212) SPA CLA JMP FNOTE4 /NO, GET MORE CHARS ON LINE JMP FNOTE1 /YES, GET ANOTHER LINE FNOTE6, ERRORF /FATAL ERROR TO RUN OUT OF ROOM SIXBIT \FO\ FNOTE8, CLA TAD FNCTR /FOOTNOTE ALREADY ON OTHER PAGE? SZA JMP .+3 /YES, ADD TO CURRENT CTR TAD FNPTR /NO FOOTNOTE ON NEW PAGE DCA FNPTR2 /SAVE PTR FOR OTHER PAGE TAD COUNT /SAVE THESE LINES DCA FNCTR /FOR CORRECT COUNT ON OTHER PAGE JMP FNOTE1 /GO GET THE FOOTNOTE / SUBROUTINE TO OUTPUT A BREAK / IF LINE IS ALL SPACES, DO NOT OUTPUT IT / OTHERWISE, PRINT THE LINE AND END IT BREAKX, 0 TAD LENOL SNA JMP BREAK2 /NOTHING IN LINE, RETURN CIA DCA BRKCNT /SAVE THE NO. OF CHARS ON LINE TAD (LINE-1) DCA BRKXR /GET READY TO LOOK AT LINE BREAK1, TAD I BRKXR /GET A CHAR FROM BUFFER TAD [-" ] /IS CHAR A SPACE? SZA CLA JMP .+4 /IS NOT A SPACE, GO PRINT LINE ISZ BRKCNT /IS A SPACE, ALL CHARS CHECKED? JMP BREAK1 /NOPE JMP BREAK2 /RETURN IF LINE FULL OF SPACES PUSHJ /NO, WE HAVE TO PRINT THE LINE PRINT CRLF /OUTPUT CR/LF, TOO BREAK2, JMS NLPARM /SET UP NEW LINE PARMS JMP I BREAKX BRKCNT, 0 / DISPATCH SUBROUTINE / ARG 1 IS CHARLIST - 1, ARG 2 IS JUMPLIST-CHARLIST / IF TARGET CHAR MATCHES CHAR IN CHAR LIST, THEN / APPROPRIATE JUMP IS MADE / OTHERWISE RETURNS TO CALLER IF CHAR NOT IN LIST SORTJX, 0 DCA SORTCC /SAVE THE TARGET CHARACTER DCA SORTCN /CLEAR CHAR NO. TAD I SORTJX /GET CHARLIST-1 INC SORTJX DCA SORTXR /USE AUTO-XR SKP SORTJ1, INC SORTCN /INCREMENT NO. OF CHAR IN LIST TAD I SORTXR /GET CHAR FROM CHAR LIST SNA JMP SORTJ3 /ZERO ENDS THE LIST CIA TAD SORTCC /EQUAL TO TARGET CHAR? SZA CLA JMP SORTJ1 /NO, CHECK NEXT CHAR IN LIST SORTJ2, TAD I SORTJX /GET JLIST-CLIST SNA JMP I SORTJX /IF 0, RETURN IMMEDIATELY TAD SORTXR /MAKE PTR TO JUMPLIST DCA SORTJX TAD I SORTJX /GET THE JUMP LOCATION DCA SORTJX JMP I SORTJX /DISPATCH TO ROUTINE SORTJ3, TAD SORTCC /WAS TARGET CHAR 0 ALSO? SNA CLA JMP SORTJ2 /YES, SO WE HAVE EQUALITY TAD I SORTJX /GET CLIST-JLIST INC SORTJX /PREPARE TO RETURN TO CALLER SNA CLA INC SORTJX /IF 0, SKIP TO FAIL RETURN JMP I SORTJX /RETURN TO CALLER SORTCC, 0 MODES, MODE UNMODE CFMODE CQMODE MODE PAGE
/ .FIGURE N SKIP N LINES FOR A FIGURE ON THIS PAGE / OR EJECT AND THEN SKIP N LINES / .FIGURE DEFERRED N SAVE CTR FOR NEXT PAGE FOR FIGURE / IF DOESN'T FIT, BUT CONTINUE WITH TEXT ON / THIS PAGE FIGURE, WORDCK /CHECK FOR "DEFERRED" FIGWD JMP FIGDEF /YES, IS DEFERRED FIGURE GETNUM /GET A NUMBER TAD CVRTQ /DID CONVERSION TAKE PLACE? SNA CLA BADCMD /NO, ILLEGAL COMMAND STA /NOT DEFERRED FIGURE JMP FIGDEF+5 FIGDEF, DCA I [CMDLINE] /TO GET ANOTHER ARGUMENT GETNUM /GET THE NUMBER TAD CVRTQ /DID CONVERSION TAKE PLACE? SNA CLA JMP BADARG /NO, BAD ARGUMENT DCA CTR1 /USED AS TEMP FLAG GARBAGE /IGNORE GARBAGE ON LINE BREAK PUSHJ /IN CASE WE'RE AT BOTTOM OF PAGE PRTHEAD TAD NUMBER CIA TAD NLINES /NO. OF LINES LEFT ON PAGE SMA CLA JMP .+4 /YES, GO SKIP PROPER NO. OF LINES ISZ CTR1 /NO, DEFER THE FIGURE? JMP .+5 /YES DOEJECT /NO, MUST SKIP TO NEW PAGE TAD NUMBER CRLF /THEN SAVE FIGURE RETURN TAD NUMBER /DEFER TO NEXT PAGE TAD DEFERN /BY KEEPING UPDATED CTR DCA DEFERN RETURN / .INDENT N / USE AS INDENTION FOR THIS LINE INDENT, GETNUM /GET NO. TO INDENT LEFT MARG BREAK GARBAGE STA TAD NUMBER TAD LMARG SMA SZA CLA /ILLEGAL LEFT MARG? JMP INDEN2 /NO, USE AS LEFT MARG FOR THIS LINE INDEN1, ERRORC /BAD MARGIN SIXBIT \BM\ INDEN2, TAD RMARG /CHECK AGAINST RIGHT MARGIN CIA TAD NUMBER TAD LMARG SMA CLA JMP INDEN1 /PAST RIGHT MARGIN, ERROR TAD NUMBER /LEFT MARGIN MODIFIER JMS NLPARM /SET UP PARMS FOR LINE RETURN / .FLAG TYPE C /SET TYPE FLAG TO CHARACTER C / .NOFLAG TYPE /CLEAR TYPE FLAG NOFLGC, STA DCA NOFLG /SET "NO" FLAG FLAGC, TAD NOFLG DCA FLAGNO /SAVE THE "NO" FLAG CDF 10 /FLAG TYPES IN FIELD 1 COMCHK /CHECK THEM OUT FLGWDS-1 0 JMP GOODFG /IS A GOOD FLAG WORD ILLFC, ERRORC /ILLEGAL FLAG COMMAND SIXBIT \FG\ GOODFG, TAD SORTCN /WHICH TYPE? TAD (CMDFLAGS) DCA PTR1 /POINTS TO APPROPRIATE FLAG SWITCH TAD FLAGNO DCA I PTR1 /SET OR CLEAR THE FLAG TAD FLAGNO SKIPYES /WAS IF .FLAG COMMAND? JMP FLAGC1 /NO, IT WAS .NOFLAG COMMAND SPNOR /IGNORE SPACES AFTER THE TYPE TAD CHAR EOCQ RETURN /IF NO CHARS ON LINE, RETURN TAD SORTCN /WHICH TYPE? TAD (CMDCHR-2-1) DCA PTR1 /POINTS TO FLAG CHARACTER TAD CHAR AND [377] /JUST WANT GOOD ASCII CHAR DCA I PTR1 /SAVE NEW FLAG CHARACTER GETC /GET NEXT CHAR FLAGC1, GARBAGE /IGNORE GARBAGE ON LINE DCA CTFLAG /CONTROL FLAG ALWAYS ON DCA EFFLAG /ENDFOOTNOTE FLAG ALWAYS ON, TOO RETURN FLAGNO, 0 / .FLAGS ALL / .NOFLAGS ALL NFLGSC, STA DCA FLAGNO /SET "NO" FLAG FLAGSC, WORDCK /CHECK SPELLING OF "ALL" ALLWD SKP JMP ILLFC /ILLEGAL FLAG COMMAND TAD (CMDFLAGS-1) /PREPARE TO SET ALL FLAGS TO DCA AUTOX1 /"YES" OR "NO" TAD (-10) DCA COUNT TAD FLAGNO /CONTAINS "YES" OR "NO" DCA I AUTOX1 ISZ COUNT JMP .-3 JMP FLAGC1 /GO FINISH UP ALLWD, TEXTZ "ALL" / SUBROUTINE TO CHECK SPELLING OF A COMMAND WORD / RETURN .+1 IF SPELLED CORRECTLY / RETURN .+2 IF NOT LEGAL WRDCKX, 0 STA TAD I WRDCKX /COMMAND TEXT ADDRESS INC WRDCKX DCA .+2 /SAVE ADDR-1 OF TEXT ADDRESS COMCHK /CHECK THE COMMAND 0 /ADDR-1 OF TEXT WORD 0 /INDICATES TO RETURN HERE IF FOUND SKP /FOUND INC WRDCKX /NOT FOUND, RETURN .+2 JMP I WRDCKX /RETURN GOOD AT .+1 CTRLS, 211; 212; 213; 214; 215; 0 PAGE
/ .SKIP N / OUTPUT N * LINE SPACING BLANK LINES / .BLANK N / OUTPUT N BLANK LINES / IF N<0, THEN SKIP TO N LINES FROM BOTTOM OF PAGE SKIP, STA /SKIP COMMAND, 7777 BLANK, DCA SKPSW /BLANK COMMAND, 0000 GETNUM /GET NUMBER OF SKIPS TO PERFORM TAD CVRTQ /DID CONVERSION TAKE PLACE? SZA CLA JMP .+3 /YES CLA IAC DCA NUMBER /ASSUME 1 IF NOT GARBAGE BREAK TAD NUMBER /IS THE ARGUMENT O.K. ? SPA CLA JMP SKIP3 /NEGATIVE, RELATIVE ISZ SKPSW /SKIPPING OR BLANKING? JMP BLANK3 /BLANKING, GO GIVE CR/LF'S TAD LSPACE /(-) CURRENT LINE SPACING DCA COUNT TAD NUMBER /GET ACTUAL NO. OF LINES TO SKIP ISZ COUNT JMP .-2 DCA NUMBER /AND SAVE THE NO. BLANK3, TAD NUMBER /GET THE NUMBER OF LINES TO SKIP SPA SNA JMP BADARG /<= 0, IS ERROR CRLF /SKIP THE LINES TAD LSPACE /(-) CURRENT LINE SPACING TAD LSPACE / MULTIPLY BY 2 TAD NLINES /CAN WE FIT ON THIS PAGE? SPA CLA DOEJECT /NO, EJECT TO NEW PAGE RETURN /RETURN SKIP3, TAD NUMBER /(-) FOR RELATIVE TAD NLINES /SKIP TO N LINES FROM BOTTOM SMA SZA /CAN WE DO IT ON THIS PAGE? CRLF /YES, GO TO N LINES FROM BOTTOM RETURN /CAN'T DO IT, RETURN SKPSW, 0 BADARG, ERRORC /BAD ARGUMENT SIXBIT \BA\ / .PARAGRAPH / OPTIONAL 3 ARGUMENTS / INDENTION FOR PARAGRAPH, SPACING TO THE PARAGRAPH, AND / ".TEST PAGE" ARGUMENT PARAGRAPH,GETNUM /GET FIRST ARGUMENT TAD CVRTQ /DID CONVERSION TAKE PLACE? SNA CLA JMP PARAG0 TAD NUMBER /YES SPA JMP BADARG /NEGATIVE, BAD ARGUMENT DCA PARAGN /INDENTION FOR PARAGRAPH PARAG0, DCA I [CMDLINE] GETNUM /SECOND ARGUMENT TAD CVRTQ SNA CLA JMP PARAG1 TAD NUMBER /USE CONVERTED NO. AS SNA JMP BADARG /CANNOT BE ZERO, ILLEGAL ARG TAD (-5) SMA SZA CLA /IS ARG -, OR 1 TO 5? JMP BADARG /NO, ILLEGAL ARGUMENT TAD NUMBER /USE CONVERTED NO. AS DCA PARAGV /SPACING TO THE PARAGRAPH PARAG1, DCA I [CMDLINE] GETNUM /THIRD ARG TAD CVRTQ /WAS THERE A THIRD ARGUMENT? SNA CLA JMP PARAG4 TAD NUMBER /YES SPA JMP BADARG /IT WAS MINUS, TOO BAD! DCA PARAGP /USE AS ".TEST PAGE" ARG PARAG4, GARBAGE STA /7777 IF .PARAGRAPH COMMAND SKP PARAG, MTWO /7776 IF .AUTOPARAGRAPH AND SPACES DCA NUMBER /SMALL SWITCH BREAK /PARAGRAPH ENTRY IF .AUTOPARAGRAPH SET TAD PARAGV SMA JMP PARAG2 /USER SUPPLIED VERTICAL SPACING STA /-1 TO ACC TAD LSPACE /(-) STL RAR /USE (LINE SPACING + 1) / 2 PARAG2, CRLF TAD LSPACE /CAN PART OF PARAGRAPH FIT ON PAGE? DCA COUNT TAD PARAGP ISZ COUNT /.TEST PAGE ARG * LINE SPACING JMP .-2 SNA JMP PARAG3 /WE CAN FIT ON PAGE (NO SPECIAL TEST IF 0) CIA TAD NLINES SPA CLA /CAN WE FIT? DOEJECT /NO, MUST DO EJECT FIRST PARAG3, TAD PARAGN /PARAGRAPH INDENTION FOR LMARG MODIFIER JMS NLPARM /SET UP NEW LINE PARMS STA DCA ECAPSW /CAPITALIZE NEXT CHAR ISZ NUMBER SPNOR /IGNORE LEADING SPACES AND TABS ISZ NUMBER RETURN /RETURN IF .PARAGRAPH JMP NLINE1 /GO SAVE THE CHAR, IF .AUTOPARAGRAPH / .TEST PAGE N / IF N LINES CAN FIT ON PAGE, O.K. / OTHERWISE, EJECT FIRST TESTPG, WORDCK TSTPGL JMP TSTPG BADCMD /ILLEGAL COMMAND TSTPG, GETNUM /GET NO. OF LINES TO TEST PAGE TAD CVRTQ SNA CLA /DID CONVERSION TAKE PLACE? JMP BADARG /NOPE, NO ARGUMENT GARBAGE BREAK TAD NUMBER /IS ARGUMENT LEGAL? SPA SNA CLA JMP BADARG /ILLEGAL NUMERIC ARG TAD NUMBER /FIT ON PAGE? CIA TAD NLINES SPA CLA DOEJECT /NO, MUST DO AN EJECT RETURN / THE .BREAK COMMAND (ABBREVIATION .BR OR SIMPLY .) / SEND THE OUTPUT LINE TO OUTPUT FILE IF THERE IS SOMETHING IN IT BREAKC, GARBAGE BREAK RETURN PAGE
/ .JUSTIFY SET JUSTIFY MODE / .NOJUSTIFY SET NO JUSTIFICATION MODE NOJUST, STA DCA NOFLG /SET "NO" FLAG JUST, TAD NOFLG DCA SWJUST /SET JUSTIFY-NOJUSTIFY FLAG TAD SWJUST DCA JUSTFG /SAVE THE FLAG, TOO BREAK JMP NUMC2 /IGNORE GARBAGE AND RETURN JUSTFG, 0 / .FILL SET FILL MODE; SET LAST JUSTIFY-NOJUSTIFY MODE / .NOFILL SET NOFILL MODE; SET NOJUSTIFICATION MODE NOFILL, STA DCA NOFLG FILLC, TAD NOFLG DCA SWFILL /SET THE FILL-NOFILL FLAG TAD SWFILL /IS IT FILL? SKIPYES JMP .+3 TAD JUSTFG /YES, SET LAST JUSTIFICATION SKP STA /NO, SET NOJUSTIFY, TOO DCA SWJUST /SET JUSTIFICATION SWITCH BREAK JMP NUMC2 /IGNORE GARBAGE AND RETURN / .NUMBER N / RENUMBER THE PAGE NO. TO N / .NONUMBER NONUM, STA DCA NOFLG /SET THE "NO" FLAG NUMCMD, TAD NOFLG DCA SWPNUM /SET THE PAGE NO. FLAG TAD SWPNUM SKIPYES JMP NUMC2 /IF .NONUMBER, GO RETURN GETNUM /GET THE NUMBER TAD NUMBER SMA CLA JMP NUMC1 /GOOD NUMBER, RETURN ERRORC /PAGE NO. < 0 IS ERROR SIXBIT \PG\ NUMC1, TAD PAGENO JMS RELQ DCA PAGENO /RESET PAGE NUMBER NUMC2, GARBAGE RETURN / .CHAPTER CHAPTER NAME / TAKE REST OF COMMAND LINE AS NEW CHAPTER NAME / .SUBTITLE THIS IS A SUBTITLE / TAKE REST OF COMMAND AS NEW SUBTITLE / .TITLE THIS IS A TITLE / TAKE REST OF COMMAND LINE AS NEW TITLE CHAPTER,TAD (CHBUFF-1) /INITIALIZE PTR, CTR FOR CHAPTER DCA AUTOX3 TAD (-CHLENGTH) JMP TITLE1 SBTTLC, TAD (SBTTLB-1) /INITIALIZE PTR, CTR FOR SUBTITLE DCA AUTOX3 TAD (-STLENGTH) JMP TITLE1 TITLEC, TAD (TITLEB-1) /INITIALIZE PTR, CTR FOR TITLE DCA AUTOX3 TAD (-TLENGTH) TITLE1, DCA COUNT /SAVE THE COUNT TAD CHAR EOCQ /END OF COMMAND AFTER THE COMMAND? JMP TITLE5 /YES, EMPTY BUFFER SPNOR /IGNORE LEADING SPACES SKP TITLE2, GETC /GET A CHAR FROM INPUT FILE TAD CHAR /CHECK IT OUT SNA JMP TITLE5 /END OF TITLE OR SUBTITLE DCA I AUTOX3 /SAVE IN BUFFER ISZ COUNT /BUFFER FULL? JMP TITLE2 ERROR /YES, TITLE BUFFER FULL SIXBIT \HL\ TITLE4, GETC /NOW GO TO END OF COMMAND TAD CHAR SZA CLA JMP TITLE4 TITLE5, DCA I AUTOX3 /ZERO TO END THE TITLE OR SUBTITLE RETURN /THEN RETURN / .AUTOPARAGRAPH / .NOAUTOPARAGRAPH NAUTOP, STA DCA NOFLG AUTOP, TAD NOFLG DCA SWPARA JMP NUMC2 /IGNORE GARBAGE AND RETURN / .PAGING / .NOPAGING NOPAGE, STA DCA NOFLG PAGING, TAD NOFLG DCA SWPAGE JMP NUMC2 /IGNORE GARBAGE AND RETURN / .SUBPAGE / .END SUBPAGE (.ES) SUBPG, TAD ("A-1) /INITIALIZE SUBPAGE LETTER DCA SUBPGN SKP ESUBPG, STA DCA SWSBPG JMP NUMC2 /IGNORE GARBAGE AND RETURN / .END / CHECK OUT NEXT WORD FOR LEGAL COMMAND END, WORDCK /CHECK SPELLING OF "SUBPAGE" ENDWORD JMP ESUBPG /IT IS, SET FLAG BADCMD /BAD SPELLING, ILLEGAL COMMAND ENDWORD,TEXTZ "SUBPAGE" / .UPPER CASE (.UC) / .LOWER CASE (.LC) LOWER, STA /LOWER = 7777 UPPER, DCA NUMBER /UPPER = 0000 WORDCK /MAKE SURE OF COMMAND CASEWD JMP ULCASE /IS GOOD COMMAND BADCMD /ILLEGAL COMMAND LCASE, STA /LOWER CASE = 7777 UCASE, DCA NUMBER /UPPER CASE = 0000 ULCASE, GARBAGE TAD NUMBER /GET THE APPROPRIATE CASE DCA MODE /SET MODE RETURN CASEWD, TEXTZ "CASE" PAGEM, "P; "A+40; "G+40; "E+40; " ; 0 TABSJS, TABREL TABABS PAGE
/ .LEFT N / .RIGHT N / LEFT ADJUST OR RIGHT ADJUST THE LINE / IF N APPEARS, MODIFY THE MARGIN / .LEFT MARGIN N / .RIGHT MARGIN N / CHANGE THE LEFT OR RIGHT MARGIN TO N LEFT, STA /SET "LEFT" RIGHT, DCA LRFLAG /SET "RIGHT" WORDCK /SEE WHAT WE GOT MARGWD JMP MARGS BREAK GETNUM JMS GLINE /GET THE LINE TO BE ADJUSTED ISZ LRFLAG /LEFT OR RIGHT ADJUST JMP RADJ /RIGHT ADJUST THE LINE TAD LMARG JMS RELQ /GET NEW LEFT MARGIN LADJ1, DCA ALMARG /FIX UP FOR ADJUSTING LINE PUSHJ /PRINT THE LINE PRINT TAD LSPACE CRLF GARBAGE /IGNORE GARBAGE ON COMMAND LINE RETURN RADJ, TAD RMARG /GET THE NEW MARGIN JMS RELQ DCA NUMBER /SAVE IT TEMPORARILY STA TAD LENOL CIA TAD NUMBER /NEW RMARG-LENOL+1 JMP LADJ1 /FIX UP FOR RIGHT ADJUSTMENT LMARGC, STA /.LM, SET LEFT MARGIN RMARGC, DCA LRFLAG /.RM, SET RIGHT MARGIN MARGS, DCA I [CMDLINE] /SO WE CAN GET A NUMERIC ARG GETNUM /GET NEW MARGIN SETTING ISZ LRFLAG /LEFT OR RIGHT? JMP RMARGS TAD LMARG /LEFT MARGIN RESET JMS RELQ SPA SNA JMP MARGE /NEG. IS ERROR DCA NUMBER /SAVE TEMPORARILY TAD NUMBER CIA TAD RMARG SPA SNA CLA /LEFT MARGIN >= RIGHT MARGIN? JMP MARGE /YES, GIVE ERROR TAD NUMBER DCA LMARG /SAVE GOOD LEFT MARGIN MARGS2, GARBAGE BREAK /NEW MARGINS ARE SET UP RETURN RMARGS, TAD RMARG /RIGHT MARGIN RESET JMS RELQ DCA LRFLAG /SAVE NEW RIGHT MARGIN TAD LRFLAG CIA TAD LMARG SMA CLA /RIGHT MARGIN <= LEFT MARGIN? JMP MARGE /YES, GIVE ERROR TAD LRFLAG /GET RIGHT MARGIN BACK CIA TAD PWIDTH /IS IT GREATER THAN PAGE WIDTH? SMA CLA JMP .+3 /NO, GO SAVE IT MARGE, ERRORC /ILLEGAL MARGIN SETTING SIXBIT \BM\ TAD LRFLAG /GET GOOD RIGHT MARGIN DCA RMARG /AND SAVE IT JMP MARGS2 LRFLAG, 0 / .MARGINS N,M / SET LEFT MARGIN TO N, SET RIGHT MARGIN TO M MARGNS, GETNUM /GET NO. FOR LEFT MARGIN TAD LMARG JMS RELQ DCA LRFLAG /SAVE IT TEMPORARILY DCA I [CMDLINE] /TO GET ANOTHER NUMERIC ARG GETNUM /GET NUMBER FOR RIGHT MARGIN GARBAGE TAD RMARG JMS RELQ DCA NUMBER /SAVE RIGHT MARGIN TEMPORARILY TAD LRFLAG SPA SNA CLA JMP MARGE /LEFT MARGIN NEGATIVE, ERROR TAD PWIDTH CIA TAD NUMBER SMA SZA CLA JMP MARGE /RIGHT MARGIN EXCEEDS PAGE WIDTH, ERR TAD NUMBER CIA TAD LRFLAG SMA CLA JMP MARGE /LEFT MARGIN > RIGHT MARGIN, ERROR TAD LRFLAG /GOOD MARGINS DCA LMARG /SAVE LEFT MARGIN TAD NUMBER DCA RMARG /SAVE RIGHT MARGIN JMP MARGS2 /GO SET UP MARGINS AND RETURN / .SPACING N (N = 1-5) SPACING,GETNUM GARBAGE BREAK TAD NUMBER /GET THE SPACING NO. SNA IAC /IF ZERO, ASSUME 1 DCA NUMBER TAD NUMBER TAD (-5) /IN RANGE 1 TO 5? SMA SZA CLA JMP BADARG /NO, BAD ARGUMENT TAD NUMBER /USE THE ARGUMENT AS CIA DCA LSPACE /THE NEW SPACING NUMBER (-) RETURN / GET A CHAR FROM OS/8 INPUT FILE GETX, 0 CLA CLL TAD FNFLAG /PROCESSING A FOOTNOTE? SZA CLA JMP GETCFN /YES, GET CHARS FROM FOOTNOTE BUFFER CIF 10 JMS I (XXGET) /GET A CHAR FROM I/O PACKAGE GETXRT, JMP I GETX /'GETCFN' RETURNS HERE PAGE
/ A FOOTNOTE IS TO BE AT THE BOTTOM OF CURRENT PAGE / DO THE FOOTNOTE PRE-PROCESSING DOFNOTE,TAD LMARG /SAVE LEFT MARGIN PUSHA TAD RMARG /RIGHT MARGIN PUSHA TAD LSPACE /LINE SPACING PUSHA TAD PARAGN /PARAGRAPH INDENTION PUSHA TAD MODE /UPPER/LOWER CASE MODE PUSHA TAD CQMODE /CAPITALIZING MODE PUSHA TAD UNMODE /UNDERLINING MODE PUSHA TAD ECAPSW /END OF SENTENCE CAPITALIZATION PUSHA TAD SWJUST /JUSTIFICATION MODE PUSHA TAD SWFILL /FILL MODE PUSHA STA /WE ARE CURRENTLY PROCESSING DCA FNFLAG / INSIDE A FOOTNOTE TAD (FNBUFF-1) /INITIALIZE AUTOXR FOR FETCH DCA FNXR /FROM FOOTNOTE BUFFER CLA IAC DCA LMARG /SET LEFT MARGIN TO 1 TAD PWIDTH DCA RMARG /SET RIGHT MARGIN TO PAGE WIDTH STA DCA LSPACE /SET SINGLE SPACING DCA PARAGN /NO PARAGRAPH INDENTION STA DCA MODE /SET LOWER CASE MODE STA DCA CQMODE /NO CAPITALIZATION STA DCA UNMODE /NO UNDERLINING DCA SWJUST /JUSTIFY MODE DCA SWFILL /FILL MODE JMS NLPARM /SET UP NEW PARAMETERS RETURN /TO DO THE FOOTNOTE / CONTINUATION OF "GETCX" ROUTINE / GET CHARACTERS FROM FOOTNOTE BUFFER GETCFN, TAD FNXR /AT END OF FOOTNOTE BUFFER? TAD (-FNBEND) SZA CLA JMP GETCF1 /NO, MORE CHECKING TO DO ERRORF /FATAL ERROR SIXBIT \FX\ /FOOTNOTE BUFFER EXHAUSTED GETCF1, TAD FNXR /END OF FOOTNOTE BUFFER? CMA /FNPTR IS 1 MORE THAN LAST CHAR TAD FNPTR /LAST LOC USED IN BUFFER + 1 SNA CLA JMP GETCF2 /YES, PREPARE TO EXIT FOOTNOTE PROCESSING TAD FNPTR2 /NO SNA JMP GETCFR /NO FOOTNOTES ON NEXT PAGE CIA TAD FNXR /AT START OF NEXT PAGE FOOTNOTE? SNA CLA JMP GETCF3 /YES, RESET FOR REGULAR PROCESSING GETCFR, CDF 10 /FOOTNOTE BUFFER IN FIELD 1 TAD I FNXR /NO, GET CURRENT CHAR FROM FOOTNOTE BUFFER CDF 00 JMP GETXRT /GO BACK TO "GETX" GETCF2, TAD (FNBUFF) /RESET FOOTNOTE BUFFER POINTER DCA FNPTR / TO BEGINNING OF THE BUFFER JMP EXFNOTE /EXIT FROM FOOTNOTE PROCESSING GETCF3, TAD (FNBUFF-1) /END OF FOOTNOTE, THIS PAGE DCA FNXR /MOVE BUFFER OF NEXT PAGE DOWN CDF 10 /FOOTNOTE BUFFER IN FIELD 1 GETCF4, TAD I FNPTR2 INC FNPTR2 DCA I FNXR /SAVE CHAR AS WE MOVE TAD FNPTR2 /ARE WE AT END OF BUFFER CIA TAD FNPTR SZA CLA JMP GETCF4 /NO, CONTINUE TO MOVE CDF 00 /YES EXFNOTE,BREAK /OUTPUT LAST LINE OF FOOTNOTE DCA FNFLAG /NO LONGER PROCESSING A FOOTNOTE POPA DCA SWFILL /RESTORE FILL MODE POPA DCA SWJUST /JUSTIFICATION MODE POPA DCA ECAPSW /END OF SENCTENCE CAPITALIZATION POPA DCA UNMODE /UNDERLINE MODE POPA DCA CQMODE /CAPITALIZING MODE POPA DCA MODE /UPPER/LOWER CASE MODE POPA DCA PARAGN /PARAGRAPH INDENTION POPA DCA LSPACE /LINE SPACING POPA DCA RMARG /RIGHT MARGIN POPA DCA LMARG /LEFT MARGIN JMP CRLFX3 /RETURN TO FINISH FOOTER / SUBROUTINE TO SKIP GARBAGE ON COMMAND LINE GARBJX, 0 SPNOR /IGNORE ANY LEADING SPACES TAD CHAR EOCQ /END OF COMMAND LINE? JMP I GARBJX /YES, RETURN ERROR /NOPE SIXBIT \GJ\ GARBJ2, GETC /GET CHARS TAD CHAR EOCQ /MUST GO TO END OF COMMAND JMP I GARBJX JMP GARBJ2 / SUBR TO DECREMENT POINTER AND LENGTH OF LINE SAVDEC, 0 STA TAD OUTPTR DCA OUTPTR STA TAD LENOL DCA LENOL JMP I SAVDEC PAGE
/ GET A NUMBER FOR A COMMAND / NUMERIC CHARS ARE IN COMMAND LINE GETNMX, 0 TAD I [CMDLINE] /ANY CHARS IN CMD LINE? SNA CLA JMS GETARG /NO, GO GET AN ARGUMENT TAD [CMDLINE] /YES, SET UP PTR & HALF SWITCH DCA NUMPTR DCA NUMHLF DCA SIGN /ASSUME + DCA CVRTQ /NO CONVERSION YET DCA RELFLG /NO RELATIVE DCA NUMBER /CLEAR NUMBER JMS NUMGET /GET A CHAR DCA GETNCH /AND SAVE IT TAD GETNCH TAD (-"+) SNA JMP GETN3 /"+"; SIGN IS + , SET RELATIVE TAD ("+-"-) SZA CLA JMP GETN4 STA /"-", SIGN IS -, SET RELATIVE GETN3, DCA SIGN /SET SIGN STA DCA RELFLG /SET RELATIVE FLAG, TOO JMP GETN6 GETN4, TAD GETNCH /NOT SIGN, GET CHAR AND CHECK FOR NUM SKP GETN6, JMS NUMGET /GET ANOTHER CHAR TAD (-"9) SMA SZA JMP GETN7 /NOT A DIGIT TAD ("9-"0) SPA JMP GETN7 /DITTO DCA GETDIG /SAVE GOOD DECIMAL DIGIT TAD NUMBER CLL RTL TAD NUMBER CLL RAL /MULTIPLY BY 10(10) TAD GETDIG /ADD IN NEW DIGIT DCA NUMBER /UPDATE THE NUMBER STA DCA CVRTQ /CONVERSION HAS TAKEN PLACE JMP GETN6 GETN7, CLA CLL /END OF NUMBER TAD CVRTQ /DID CONVERSION TAKE PLACE? SZA CLA TAD SIGN /YES, WAS SIGN (-) ? SNA CLA JMP I GETNMX /NO, JUST RETURN TAD NUMBER /YES, NEGATE THE NUMBER CIA DCA NUMBER JMP I GETNMX GETNCH, 0 GETDIG, 0 / GET A CHARACTER FROM COMMAND LINE FOR "GETNUM" NUMGET, 0 TAD I NUMPTR /YES, GET 2 CHARS ISZ NUMHLF /WHICH HALF TO USE? JMP NUML INC NUMPTR /NEXT 2 CHARS NUMR, AND [77] /USE RIGHT HALF TAD [" ] /GENERATE ASCII CHAR AND [77] TAD [" ] JMP I NUMGET /AND RETURN WITH IT NUML, CLL RTR; RTR; RTR /GET CHAR FROM LEFT HALF DCA NUMTMP STA DCA NUMHLF TAD NUMTMP JMP NUMR /AND GO CHECK IT OUT NUMHLF, 0 NUMPTR, 0 NUMTMP, 0 / SUBROUTINE TO OUTPUT A CARRIAGE RETURN / LINE FEED COMBO / ENTER WITH NO. OF CR/LF'S IN ACC (+) CRLFX, 0 SNA IAC /IF ZERO, ASSUME 1 SMA /SKIP IF ALREADY NEG CIA /MAKE NEG FOR CTR DCA CRLFC /SAVE THE COUNTER TAD CRLFX /SAVE RETURN LOC FOR REENTRY PUSHA /PRETEND HE CALLED VIA "PUSHJ" CRLFX2, TAD CRLFC /SAVE THE COUNTER ON THE STACK PUSHA PUSHJ /PRINT HEADER IF NECESSARY PRTHEAD TAD [215] /OUTPUT THE CARRIAGE RETURN FIRST PUT TAD [212] /OUTPUT THE LINE FEED NOW PUT STA TAD NLINES DCA NLINES /DECREMENT NO. OF LINES ON PAGE TAD NLINES SZA CLA /ANY LINES LEFT ON PAGE? JMP CRLFX5 /YES, MAYBE RETURN TAD FNFLAG /NO, ARE WE PROCESSING A FOOTNOTE? SZA CLA JMP CRLFX4 /YES, GO DO FOOTER TAD FNLINE /NO, IS THERE A FOOTNOTE ON THIS PAGE? SNA JMP CRLFX4 /NO, GO DO THE FOOTER DCA NLINES /YES, SET UP NO. OF LINES LEFT ON PAGE DCA FNLINE /ZAP NO. OF FOOTNOTE LINES TO ZERO JMP DOFNOTE /GO DO THE FOOTNOTE CRLFX3, TAD TOPSW /RETURN TO HERE AFTER FOOTNOTE PROCESSING SNA CLA /DO WE NEED TO GO TO TOP OF PAGE? DOEJECT /YES SKP CRLFX4, JMS FOOTER /IF ZERO, PRINT PAGE FOOTER CRLFX5, JMS NLPARM /SET UP PARMS FOR NEW LINE POPA DCA CRLFC /RESTORE CURRENT CTR ISZ CRLFC /ALL LINES OUT YET? JMP CRLFX2 POPJ /YES, RETURN TO CALLER CRLFC, 0 PAGE
/ PRINT THE OUTPUT LINE / SEND THE OUTPUT LINE TO THE OUTPUT FILE PRINT, PUSHJ /DO WE DO TOP OF PAGE? PRTHEAD TAD (LINE-1) /PREPARE TO PRINT THE LINE DCA PRTXR /INITIALIZE PTR AND CTR TAD LENOL /LENGTH OF OUTPUT LINE SNA JMP PRINT6 /NOTHING IN LINE, JUST RETURN CIA DCA PRTCTR STA TAD ALMARG JMS TSPACE /OUTPUT LEADING SPACES DCA PRTCNT /NO. OF UNDERLINES ON LINE PRINT2, TAD I PRTXR /GET A CHAR DCA PRTCHR /SAVE CHAR FOR CHECKING TAD PRTCHR PUT /OUTPUT CHAR FIRST TAD PRTCHR /IS CHAR TO BE UNDERLINED? SMA CLA JMP PRINTC /NO, JUST COUNT IT TAD UNSWIT /YES, CAN WE UNDERLINE IT NOW? SPA CLA JMP .+3 /YES INC PRTCNT /NO, JUST COUNT IT JMP PRINTC TAD (210) /SEND A BACKSPACE CHARACTER PUT TAD ("_) /FOLLOWED BY AN UNDERLINE PUT PRINTC, ISZ PRTCTR /BUFFER EMPTY? JMP PRINT2 /NO, KEEP PRINTING MORE? TAD PRTCNT /DO WE NEED TO UNDERLINE THIS LINE? SNA CLA JMP PRINT6 /NO, GO RETURN TAD UNSWIT /BUFFER IS EMPTY SPA SNA CLA /DO WE UNDERLINE ANY CHAR? JMP PRINT6 /NOPE, PREPARE TO RETURN TAD [215] /FIRST OUTPUT CR TO GET TO START OF LINE PUT MTWO TAD UNSWIT SNA CLA /UNDERLINES ON SAME LINE (=2) ? CRLF /NO, UNDERLINE ON SEPARATE LINE STA TAD ALMARG /FIX UP LEFT MARGIN JMS TSPACE /LEADING SPACES ON NEXT LINE TAD (LINE-1) /PREPARE TO CHECK BUFFER AGAIN DCA PRTXR /INITIALIZE PTR AND CTR TAD LENOL CIA DCA PRTCTR PRINT4, TAD I PRTXR /GET A CHARACTER SNA JMP PRINT6 /END OF BUFFER, PREPARE RETURN SMA CLA /UNDERLINE THE CHAR? JMP PRINT5 /NO, JUST SPACE OVER MTWO TAD UNSWIT /YES, BUT PRINT UNDERLINE OR "-" ? SNA CLA TAD ("--"_) /PRINT A "-" ON SEPARATE LINE TAD ["_-" ] /PRINT UNDERLINE ON SAME LINE PRINT5, TAD [" ] /JUST A SPACE PUT /OUTPUT THE CHARACTER ISZ PRTCTR JMP PRINT4 PRINT6, JMS NLPARM /RESET PARMS FOR NEW LINE POPJ /AND RETURN TO CALLER / HOW DO WE UNDERLINE A CHAR? / 0, NO UNDERLINE ALLOWED / 4000, FOLLOW CHAR BY BACKSPACE AND UNDERLINE CHARS / 1, SPACES AND UNDERLINES ON SAME LINE / 2, SPACES AND DASHES ON NEXT LINE UNSWIT, 1 /SPACES AND UNDERLINES ON SAME LINE PRTCTR, 0 PRTCHR, 0 PRTCNT, 0 / SUBROUTINE TO PRINT SPACES NECESSARY TO EFFECT LEFT MARGIN TSPACE, 0 SNA JMP I TSPACE /NO LEADING SPACES, RETURN CIA DCA TSPCTR /SAVE CTR TAD [" ] PUT ISZ TSPCTR JMP .-3 JMP I TSPACE TSPCTR, 0 / OUTPUT AN ERROR MESSAGE / FINISH CURRENT LINE BY PRINTING IT / OUTPUT ERROR MESSAGE TO OUTPUT FILE AND TELETYPE ERRORX, 0 BREAK TAD I ERRORX CLL RTR; RTR; RTR AND [77] TAD [" ] OSAVE NOP TAD I ERRORX AND [77] TAD [" ] OSAVE NOP BREAK INC ERRCTR /ANOTHER ERROR WE HAVE ENCOUNTERED NOP STA DCA NCOPY /JUST THIS COPY INC ERRORX /SKIP OVER ERROR MESSAGE JMP I ERRORX /AND RETURN ERRCTR, 0 / GIVE ERROR MESSAGE AND GET NEXT COMMAND ERRCX, 0 CLA CLL TAD I ERRCX /PICK UP ERROR MESSAGE DCA .+2 ERROR /OUTPUT IT 0 GARBAGE /IGNORE GARBAGE ON ERRONEOUS COMMAND LINE RETURN /RETURN TO NEXT COMMAND / .TABS ABSOLUTE OR .TABS RELATIVE TABSAR, CDF 10 /ARGUMENT LIST IN FIELD 1 COMCHK /CHECK FOR ANYTHING AFTER "TABS" TABSLJ-1 TABSJS-1 BADCMD /NOPE, ILLEGAL COMMAND TABREL, STA /SET FOR RELATIVE TAB STOPS TABABS, DCA TABFLG /SET FOR ABSOLUTE TAB STOPS GARBAGE RETURN PAGE
/ .HEADER OPTIONS / PLACES THE HEADER LINE AND TELLS WHERE AND HOW TO PRINT IT / .NOHEADER NOHEAD, STA /SET THE "NO" FLAG DCA NOFLG HEADER, TAD NOFLG /SET THE HEADER SWITCH DCA SWHEAD TAD SWHEAD /WAS IT "NOHEADER" ? SKIPYES JMP HEAD2 /YES IT IS, JUST RETURN SPNOR /IGNORE SPACES AFTER COMMAND TAD CHAR EOCQ /END OF COMMAND? JMP HEAD2 /YES, JUST RETURN DCA HWORD /CLEAN UP HEADER OPTION WORD FOR NEW ONE HEAD1, CDF 10 /CHECK FOR LEGAL ARGUMENT IN FIELD 1 COMCHK HEADWD-1 0 JMP HEAD4 /IT IS, CHECK IT OUT TAD I [CMDLINE] /NOT, AN ARG THERE? SZA CLA JMP HEAD3 /YES, ILLEGAL HEADER ARGUMENT TAD NOFLG /NO, WAS IT SIMPLY "NO" ? SZA DCA SWHEAD /YES, JUST "NO", EQUIV. TO "NOHEADER" HEAD2, GARBAGE /IGNORE GARBAGE ON COMMAND LINE RETURN HEAD3, ERRORC /ILLEGAL HEADER ARGUMENT SIXBIT \HD\ HEAD4, TAD NOFLG /GOOD ARGUMENT SZA /DID "NO" PRECEDE IT? DCA SWHEAD /YES, SET "NOHEADER" TAD SORTCN /OR IN CORRECT BIT CMA DCA SORTCN STL CLA /FIRST GET CORRECT BIT RAL ISZ SORTCN JMP .-2 DCA SORTCN /WE HAVE THE RIGHT BIT!! TAD SORTCN /NOW WE CAN OR IT INTO THE HEADER WORD CMA AND HWORD TAD SORTCN DCA HWORD /UPDATE THE WORD JMP HEAD1 /CHECK FOR ANOTHER HEADER OPTION / THE CENTERING COMMANDS / .CENTER (.C) CENTERS ON 1 AND PAPER WIDTH / .CENTER N CENTERS OVER COLUMN N/2 / .CENTER WIDTH (.CW) CENTERS ON 1 AND PAPER WIDTH / .CENTER MARGINS (.CM) CENTERS ON CURRENT LEFT AND RIGHT MARGINS / .CENTER MARGINS N,M CENTERS ON MARGINS N AND M CENTC, COMCHK /CHECK FOR ANYTHING AFTER .CENTER CENTW-1 CENTJ-1 GETNUM /GET A NUMBER TAD CVRTQ /DID CONVERSION TAKE PLACE? SZA CLA JMP CENTC9 /YES TAD I [CMDLINE] /IS THERE ANYTHING AFTER .CENTER? SZA CLA BADCMD /YES, IS ILLEGAL COMMAND CWDTH, JMP CENTC8 /ASSUME STANDARD PAGE WIDTH FOR CENTERING CENTC3, TAD CENTLM /SET UP "CWIDTH" TAD CENTRM /CWIDTH = CENTRM+CENTLM CENTC8, DCA CWIDTH /SET UP CWIDTH FOR CENTERING GARBAGE /IGNORE GARBAGE ON COMMAND LINE BREAK JMS GLINE /GET A LINE TO CENTER TAD CWIDTH /GET THE CWIDTH TO ACC JMS CENTER /CENTER THE LINE (SET UP ALMARG) PUSHJ /PRINT CENTERED LINE PRINT TAD LSPACE /(-) LINE SPACING CRLF /RIGHT NO. OF CR/LF'S RETURN CENTC9, TAD PWIDTH JMS RELQ /SET UP THE CENTERING WIDTH JMP CENTC8 /GET THE LINE CMARG, GETNUM /GET THE MARGINS TO CENTER ON TAD LMARG JMS RELQ DCA CENTLM /SET LEFT MARGIN FOR CENTERING DCA I [CMDLINE] /SO WE CAN GET ANOTHER NUMBER GETNUM TAD RMARG JMS RELQ DCA CENTRM /SET RIGHT MARGIN FOR CENTERING JMP CENTC3 /GO CENTER NEXT LINE CENTLM, 0 CENTRM, 0 / GET A LINE TO ADJUST OR CENTER GLINE, 0 GLINE4, GETC /GET CHARS TO CENTER TAD CHAR SNA JMP I GLINE /END OF LINE, PREPARE TO CENTER IT TAD [-211] /IS CHAR A TAB? SNA CLA TAD (" -211) /YES, CONVERT IT TO A SPACE TAD CHAR OSAVE /SAVE IT IN OUTPUT LINE JMP GLINE4 ERROR /TOO MANY CHARS ON LINE SIXBIT \LL\ GLINE5, GETC /GO FOR END OF LINE TAD CHAR SZA CLA JMP GLINE5 JMP I GLINE /RETURN WHEN FOUND / USE NUMBER IN ACC AS BASE OF LAST CONVERSION / DEPENDING UPON SETTINGS OF "CVRTQ" AND "RELFLG" RELQ, 0 DCA RELQTM /SAVE ACC AS WE MIGHT USE IT TAD CVRTQ /DID CONVERSION TAKE PLACE? SNA CLA JMP RELQ2 /NO, JUST USE NUMBER WE CAME IN WITH TAD RELFLG /YES, WAS IT RELATIVE? SZA CLA TAD RELQTM /YES, ADD OR SUBTRACT BASE NUM TAD NUMBER /NO, ABSOLUTE: USE THE NEW NUMBER JMP I RELQ RELQ2, TAD RELQTM /NO CONVERSION JMP I RELQ /USE WHAT WE ENTERED WITH RELQTM, 0 STOPC, TEXTZ "STOPS" PAGE
/ SUBROUTINE TO SET "ALMARG" SO THAT THE OUTPUT LINE IS CENTERED / IF ACC IS ZERO, USE THE STANDARD PAGE WIDTH / OTHERWISE, THE ACC CONTAINS CENTER LMARG + CENTER RMARG CENTER, 0 SNA TAD PWIDTH /IF ZERO, ASSUME CENTER ON PWIDTH DCA CWIDTH /USE FOR CENTER WIDTH TAD LENOL /ACTUAL LENGTH OF OUTPUT LINE CIA IAC TAD CWIDTH /CWIDTH = CENTER LMARG + CENTER RMARG CLL RAR DCA ALMARG /ALMARG=INT((CWIDTH-LENOL+1)/2) TAD PWIDTH CIA TAD LENOL TAD ALMARG SPA SNA CLA JMP I CENTER /THE ENTIRE LINE DOESN'T EXCEED PWIDTH TAD LENOL /YES, IT DOES CIA TAD PWIDTH DCA ALMARG /SO SET ACTUAL LEFT MARGIN SO THAT /THE ENTIRE LINE WILL FIT JMP I CENTER CWIDTH, 0 / FATAL ERROR HAS OCCURRED / GIVE ERROR MESSAGE AND RETURN TO SYSTEM ERRFX, 0 K7600, 7600 /CLEAR GARBAGE FROM ACC TAD I ERRFX DCA .+2 ERROR /OUTPUT ERROR MESSAGE 0 JMP EOFIL3 /THEN FALL THRU FOR END OF FILE / END OF FILE PROCEDURE / CHECK TO SEE IF ALL COPIES OUT / THEN RETURN TO SYSTEM EOFILE, BREAK /END OF FILE, OUTPUT LAST LINE TAD TOPSW /ARE WE AT TOP OF PAGE? SNA CLA DOEJECT /NO, GO TO TOP OF PAGE ISZ NCOPY /ANY MORE COPIES? SKP JMP EOFIL3 /NO CIF 10 JMS I (IOPEN) /OPEN INPUT FILES AGAIN JMP PRTGO EOFIL3, CIF 10 JMS I (XXCLOSE) /CLOSE CURRENT OUTPUT FILE CDF 10 TAD I (7642) /CD ENDED WITH CR OR ALTMODE? CDF 00 SMA CLA JMP GETCD /CARRIAGE RETURN, GET ANOTHER CD LINE JMP I K7600 /ALTMODE, RETURN TO SYSTEM / GET A WORD TO COMMAND BUFFER GETARG, 0 TAD [CMDLINE] /INITIALIZE COMMAND PTR DCA ARGPTR DCA I ARGPTR /ZERO CHARS TAD (-20) /LENGTH OF BUFFER DCA ARGCTR /INTIALIZE THE CTR DCA ARGHLF /STORE IN LEFT HALF FIRST GTARG1, SPNOR /IGNORE SPACES BEFORE ANYTHING SKP GTARG3, GETC /GET ANOTHER CHAR TAD CHAR SORTJ /SPECIAL COMMAND CHAR CHECK CMDLST-1 /!, ;, COMMA, SPACE, TAB, AND 0 (EOL) CMDLJ-CMDLST TAD ARGCTR SNA CLA JMP GTARG3 /IGNORE EXCESS CHARS TAD CHAR /IS CHAR A SMALL ALPHABETIC? JMS TSTALS /TEST FOR LOWER CASE ALPHABETIC SKP CLA JMP GTARG4 /YES, MAKE IT UPPER CASE TAD CHAR /NOT LOWER CASE ALPHABETIC AND [77] /STRIP TO 6 BITS JMP GTARG4+2 /AND GO STORE IT GTARG4, TAD CHAR /NOT A NUMERIC CHAR AND (37) /STRIP IT TO 5 BITS TO KEEP UPPER CASE ISZ ARGHLF JMP ARGLEFT /STORE IN LEFT HALF TAD I ARGPTR DCA I ARGPTR /STORE IN RIGHT HALF INC ARGPTR DCA I ARGPTR /MAKE SURE NEXT LOC IS ZERO ISZ ARGCTR /ANOTHER 2 CHARS IN NOP JMP GTARG3 ARGLEFT,CLL RTL; RTL; RTL /MOVE TO LEFT HALF DCA I ARGPTR /AND SAVE IT STA DCA ARGHLF /RIGHT HALF NEXT TIME JMP GTARG3 GETNOQ, TAD I [CMDLINE] /CHECK WHAT WE HAVE TAD (-1617) /"NO" SZA CLA JMP .+4 /SOMETHING THERE, GO RETURN TAD I (CMDLINE+1) /IS COMMAND JUST "NO" ? SNA CLA JMP GTARG1 /YES, IGNORE SPACES, GET REST OF IT CMDEND, JMP I GETARG /RETURN TO CALLER GTCOM, GETC /GET THE CHAR AFTER THE COMMA JMP CMDEND /TO START OFF NEXT TIME / COMMENT IN COMMAND LINE COMMENT,GETC /GET ANOTHER CHAR TAD CHAR EOCQ /END OF COMMAND? JMP CMDEND /YES, END OF COMMAND JMP COMMENT /NO, CONTINUE TO END ARGPTR, 0 ARGCTR, 0 ARGHLF, 0 PAGEU, ASCIIZ "PAGE " PAGE
/ .PAGE COMMANDS / .PAGE OR .PAGE N / .PAGE TOP / .PAGE BOTTOM / .PAGE SIZE PAGEC, CDF 10 COMCHK /CHECK FOR LEGAL "PAGE" COMMANDS PAGCMD-1 PAGJMP-1 GETNUM /GET A NUMBER GARBAGE BREAK /GET LAST LINE OF PAGE PRINTED OUT TAD TOPSW /ARE WE AT TOP OF PAGE ALREADY? SNA CLA DOEJECT /NO, SKIP TO TOP OF NEW PAGE TAD PAGENO JMS RELQ /SET UP NEW PAGE NO. SMA JMP PAGEC2 /GOOD ERRORC /BAD PAGE NO., GIVE MESSAGE SIXBIT \PG\ PAGEC2, DCA PAGENO /UPDATE THE PAGE NO. RETURN / .PAGE SIZE OR .PAPER SIZE COMMANDS / TWO ARGS, FIRST IS PAGE LENGTH, SECOND IS PAGE WIDTH PAPERC, CDF 10 COMCHK /CHECK LEGAL COMMANDS PAPERL-1 PAPERJ-1 BADCMD /ILLEGAL COMMAND PAGSIZE,GETNUM /GET THE FIRST ARG TAD PLENGTH JMS RELQ DCA NUMBER /NEW PAGE LENGTH TAD NUMBER TAD (-21) /MUST BE AT LEAST 6+6+5 LONG SMA CLA JMP PAGSZ3 /LEGAL PAGE LENGTH PSIZER, ERRORC /PAGE SIZE MUST BE > 17 SIXBIT \PS\ PAGSZ3, TAD NUMBER /THE PAGE LENGTH IS GOOD DCA PLENGTH /SO GIVE NEW PAGE LENGTH DCA I [CMDLINE] /TO GET NEW NUMBER GETNUM /GET THE PAGE WIDTH TAD PWIDTH JMS RELQ DCA NUMBER /SAVE TEMPORARILY TAD NUMBER TAD (-MAXWIDTH) /MAXIMUM PAGE WIDHT SMA SZA CLA JMP PSIZER /PAGE SIZE IS TOO LARGE TAD NUMBER CIA TAD LMARG SMA CLA /PAGE WIDTH > LEFT MARGIN? JMP PSIZER /NO, BAD PAGE TAD NUMBER DCA PWIDTH /RESET PAGE WIDTH TAD NUMBER DCA RMARG /ALSO RESET RIGHT MARGIN GARBAGE BREAK /RESET FOR NEW WIDTH, NEW PARMS RETURN / .PAGE TOP N,M / .PAGE BOTTOM N,M PAGTOP, TAD (TOP-BOTTOM) /USE TOP OF PAGE TABLES PAGBOT, TAD (BOTTOM) /USE BOTTOM OF PAGE TABLES DCA PAGPTR /INITIALIZE THE PTR GETNUM /GET NO. OF LINES TO SKIP AT "TOP" TAD I PAGPTR JMS RELQ DCA I PAGPTR /SAVE IN APPROPRIATE TABLE INC PAGPTR /POINT TO 2ND ENTRY IN TABLE DCA I [CMDLINE] /CLEAR TO GET ANOTHER NUMBER GETNUM /GET NO. OF LINE TO SKIP AT "BOTTOM" GARBAGE TAD I PAGPTR JMS RELQ DCA I PAGPTR /SAVE IN APPROPRIATE TABLE RETURN PAGPTR, 0 / TEST CHAR IN ACC FOR LARGE ALPHABETIC TSTALL, 0 AND [377] /JUST WANT GOOD CHAR TAD (-"Z) SMA SZA JMP TSTRTN /NOT ALPHABETIC TAD ("Z-"A) SMA CLA ISZ TSTALL /.+2 IF ALPHABETIC TSTRTN, CLA CLL JMP I TSTALL /.+1 IF NOT LARGE ALPHABETICS / SUBROUTINE TO SKIP TO TOP OF NEW PAGE EJECTX, 0 TAD EJECTX /PRETEND WE WERE CALLED BY "PUSHJ" PUSHA TAD NLINES /NO. OF LINES TO BOTTOM OF PAGE CRLF /GO TO BOTTOM AND DO FOOTER, TOO POPJ /WE MUST RETURN THIS WAY / SUBROUTINE TO CHECK FOR END-OF-COMMAND CHAR EOCQX, 0 SZA /CHAR IN ACC TAD (-";) /NOT ZERO, IS IT SEMI-COLON? SZA CLA INC EOCQX /NOT SEMI OR EOL, RETURN .+2 JMP I EOCQX /EOL OR SEMI, RETURN .+1 / SUBROUTINE TO TEST CHAR IN ACC FOR SMALL ALPHABETIC / RETURN .+1 IF NOT, .+2 IF GOOD SMALL ALPHABETIC TSTALS, 0 AND [377] /GET RID OF EXTRA GARBAGE TAD (-SMALLZ) SMA SZA JMP TSTAL2 /NOT ALPHABETIC TAD (SMALLZ-SMALLA) SMA CLA INC TSTALS /RETURN .+2 IF GOOD SMALL ALPHABETIC TSTAL2, CLA CLL JMP I TSTALS /RETURN .+1 IF NOT / .CONTROL CHARACTERS / .NOCONTROL CHARACTERS NOCCHR, STA DCA NOFLG /SET "NO" FLAG CCHARS, WORDCK /CHECK SPELLING OF "CHARACTERS" CCHRS JMP CHARCC BADCMD /ILLEGAL COMMAND CHARCC, TAD NOFLG DCA SWCC /SET THE SWITCH CORRECTLY GARBAGE RETURN CTRLJ, GCTAB GCLF GCVT GCFF GCCR PAGE
/ BOTTOM OF PAGE BREAK FOOTER, 0 TAD SWPAGE /DO WE FORM PAGES? SKIPYES JMP BBRK56 /NO DCA NLINES /NO LINES ON PAGE YET JMS HSAVE /SAVE CURRENT LINE BUFFER TAD SWHEAD /ANY FOOTER AT BOTTOM OF PAGE? SKIPYES JMP BBRK2 /NO, JUST OUTPUT FORM FEED TAD BOTTOM /ANY PRINTOUT AT BOTTOM OF PAGE? SZA CRLF /YES, FIRST OUTPUT "TOP" OF BOTTOM BREAK TAD HWORD /HEADER WORD CLL RTR /"BOTTOM" BIT TO LINK JMS OHEAD /OUTPUT THE HEADER LINE TAD FSWITC /SIMULATE A FORM FEED? SNA CLA JMP BBRK2 /NO TAD BOTTOM+1 /TTY, OUTPUT TO A PAGE BREAK SZA CRLF TAD PSWITC /PAUSE AT PAGE BREAK? SZA CLA JMP BBRK1 /YES, DON'T OUTPUT PAGE BREAK TAD (-6) /SIMULATE FORM FEED AND PAGE BREAK DCA BRKCTR BBRK0, TAD ("-) /PAGE BREAK IS "------" PUT ISZ BRKCTR JMP BBRK0 TAD [215] /FOLLOWED BY CARRIAGE RETURN PUT JMP BBRK5 BBRK1, CIF 10 JMS I (XXDUMP) /DUMP CURRENT BUFFER IF PAUSE TAD (207) /BELL CHARACTER JMS TYPEIT /PRINT IT OUT BBRK11, KSF JMP .-1 /WAIT AROUND UNTILL OPERATOR IS READY KRB /READ THE CHAR TAD (-220) /MUST HIT CTRL/P SZA CLA JMP BBRK11 /OTHERWISE, WAIT AROUND JMP BBRK5 BBRK2, TAD [214] /OUTPUT A FORM FEED TO PUT /GO TO TOP OF NEW PAGE BBRK5, JMS HREST /RESTORE LINE BUFFER TAD SWSBPG SKIPYES /OUTPUT SUBPAGE NO. ? JMP BBRK55 /NOPE TAD SUBPGN /YES TAD (-"Z) /ARE WE PAST THE LETTER "Z" ? SZA CLA JMP BBRK52 /NO, WE CAN INCREMENT SUBLETTER ERROR /YES, GIVE ERROR MESSAGE SIXBIT \BL\ SKP BBRK52, INC SUBPGN /INCREMENT SUBLETTER SKP BBRK55, INC PAGENO /INCREMENT PAGE NUMBER NOP BBRK56, STA DCA TOPSW /WE NEED A TOP HEADER TAD PLENGTH DCA NLINES /NO. OF LINES ON PAGE JMP I FOOTER /RETURN TO CALLER BRKCTR, 0 / PART OF GETC ROUTINE / COME HERE IF ^, &, ', ", OR \ / PROCESSING SPECIAL CHARS (^^, ^&, ^', ^", \\, \&, \', \") GETMODE,TAD SORTCN TAD (ULFLAGS) DCA PTR1 /POINTS TO CORRECT FLAG CHARACTER FLAG TAD I PTR1 /CAN WE USE THIS FLAG CHARACTER? SKIPYES JMP GETCXR /NO, JUST RETURN TAD SORTCN /YES TAD (MODES) DCA PTR1 TAD I PTR1 DCA PTR1 /POINTS TO CORRECT MODE WORD TAD LOWONE DCA I PTR1 /SET THE MODE (UP/LOW, UNDERLINE, CAP) TAD SORTCN TAD (GETRJM) DCA PTR1 /FIGURE OUT WHERE TO RETURN TAD I PTR1 DCA PTR1 /ACTUAL LOC TO RETURN TO JMP I PTR1 /AND RETURN THERE GETRJM, GETCX1 GETCX1 GETCFL GETCWD GETCX1 GETUP2, DCA LOWONE /SAVE UPPER OR LOWE SET GET DCA CHAR /GET CHAR AFTER ^ OR \ TAD CHAR SORTJ /CHECK IT OUT AGAINST UPLOWC-1 / ^, &, ', ", \ 0 JMP GETMODE /YES IT IS TAD LOWONE CMA DCA UPONE /SET UPONE AS COMPLEMENT OF LOWONE JMP GETCX3 /NOT, JUST PLAY WITH CHARACTER CMDJMP, GETSP GETCHR GETUP GETUN GETCFL GETCWD GETLOW PAGJMP, PAGTOP PAGBOT PAPERJ, PAGSIZE PAGE
/ DO A TOP OF PAGE BREAK / CALLED BY "PUSHJ;PRTHEAD" PRTHEAD,TAD TOPSW /ARE WE AT TOP OF PAGE? SNA CLA POPJ /NO, RETURN DCA TOPSW /NO LONGER WE AIN'T TAD SWPAGE /DO WE FORM PAGES? SKIPYES JMP TBRK3 /NO, JUST RETURN DCA NLINES /NO LINES ON PAGE NOW TAD SWHEAD /DO WE DO A HEADING? SKIPYES JMP TBRK3 /NO, JUST SET UP LINES ON NEXT PAGE JMS HSAVE /SAVE CURRENT LINE BUFFER TAD TOP /DO "TOP" OF TOP OF PAGE SZA CRLF /SKIP APPROPRIATE NO. OF LINES TAD HWORD CLL RAR /GET "TOP" BIT TO LINK JMS OHEAD /DO THE TOP OF PAGE HEADER LINE TAD I (TITLEB) /ANY TITLE? SNA CLA JMP TBRK2 /NO JMS MOVEL /YES, MOVE TITLE LINE TO LINE BUFFER TITLEB-1 JMS CENTER /CENTER THE TITLE PUSHJ /PRINT IT PRINT TBRK2, CRLF TAD I (SBTTLB) /ANY SUBTITLE TO PRINT? SNA CLA JMP TBRK22 /NOPE JMS MOVEL /YES, MOVE TO LINE BUFFER SBTTLB-1 JMS CENTER /CENTER IT, TOO PUSHJ /AND PRINT IT PRINT TBRK22, CRLF TAD TOP+1 /THEN NO. OF LINES TO BODY SZA CRLF JMS HREST /RESTORE THE LINE BUFFER TAD TOP /CALCULATE BODY LENGTH TAD TOP+1 TAD BOTTOM TAD BOTTOM+1 TAD (3+1) /3 FOR TOP TITLES, 1 FOR BOTTOM HEADER CIA TBRK3, TAD PLENGTH DCA NLINES /NO. OF LINES IN MAIN BODY TAD FNFLAG SZA CLA /PROCESSING A FOOTNOTE? POPJ /YES, RETURN IMMEDIATELY TAD DEFERN /DEFERRED FIGURE COUNT CIA TAD NLINES /CAN IT FIT SPA SNA CLA JMP TBRK4 /NO, ERROR TAD DEFERN SZA CRLF /SKIP APPROPRIATE NO. OF LINES DCA DEFERN /AND CLEAR DEFERRED FIGURE CT. TAD FNCTR /FOOTNOTE ON THIS PAGE? CIA TAD NLINES SPA JMP TBRK5 /CAN'T FIT DCA NLINES /YES, RESET LINE CTR TAD FNCTR /NO. OF LINES ON NEXT PAGE DCA FNLINE /INITIALIZE FOOTNOTE COUNTER DCA FNCTR /NO MORE FOOTNOTES YET POPJ /GO RETURN TBRK4, ERRORF /PAGE OVERFLOW ON DEFERRED FIGURE SIXBIT \DF\ TBRK5, ERRORF /PAGE OVERFLOW ON FOOTNOTE SIXBIT \FN\ / GET A COMMAND TO THE COMMAND BUFFER / CHECK FOR LEGAL COMMAND AND GO DO IT / .; OR .! IS COMMENT / . ; OR . ! IS A BREAK COMMAND COMMAND,GETC /SKIP PAST THE COMMAND CHAR (.) TAD CHAR TAD (-"!) SNA JMP COMCOM /.! IS A COMMENT TAD ("!-";) SNA CLA JMP COMCOM /.; IS A COMMENT, TOO CDF 10 /COMMAND STRINGS IN FIELD 1 COMCHK CMDS-1 CMDJ-1 TAD I [CMDLINE] /NOT A LEGAL COMMAND SNA CLA /WAS COMMAND SIMPLY "." ? JMP BREAKC /YES, SHORT FOR .BREAK ILLCMD, ERRORC /BAD COMMAND SIXBIT \BC\ COMCOM, GETC /GET CHARS TAD CHAR EOCQ /END OF COMMAND LINE? RETURN /YES, RETURN JMP COMCOM /NO, GET MORE CHARS / PUT CHAR TO OS/8 OUTPUT FILE PUTX, 0 DCA PUTCHR /SAVE THE OUTPUT CHAR TAD USWITC /FORCE UPPER CASE? SNA CLA JMP PUTX2 /NO, JUST PASS CHAR TAD PUTCHR JMS TSTALS /TEST FOR SMALL ALPHABETICS JMP PUTX2 /NOT SMALL CHAR TAD PUTCHR /GET THE CHAR AND [7737] DCA PUTCHR /MAKE THE UPPER CASE CHAR PUTX2, CLA CLL TAD PUTCHR /GET THE GOOD OUTPUT CHAR CIF 10 JMS I (XXPUT) /OUTPUT TO OS/8 FILE JMP I PUTX PUTCHR, 0 PAGE
/ SUBROUTINE TO OUTPUT THE HEADER LINE AT THE APPROPRIATE POSITION / THE LINK BIT IS SET IF THIS IS TIME TO OUTPUT IT OHEAD, 0 SNL CLA JMP OHEAD6 /DON'T OUTPUT THE LINE TAD PAGENO /DO WE OUTPUT HEADER? SPA SNA CLA /ONLY IF PAGE NUMBER IS > 0 JMP OHEAD6 /NO TAD SWPNUM /DO WE OUTPUT PAGE NUMBER? SKIPYES JMP OHEAD6 /NO JMS MOVEL /MOVE CHAPTER BUFFER IN, IF ANY CHBUFF-1 TAD I (CHBUFF) /ANY CHAPTER TO OUTPUT? SNA CLA JMP .+3 /NOPE TAD ("-) /YES, SEPARATE CHAPTER AND PAGE NO. JMS OTSAVE /BY A MINUS SIGN TAD HWORD AND (1000) /CHECK FOR "NUMBER" SZA CLA JMP OHEAD3 /NO "PAGE" IN HEADING IF BIT IS SET TAD HWORD CLL RTR RTR RTR AND (7) /JUST CHECK OUT "UPPER, LOWER, MIXED" JMS BITCHK /CHECK TO SEE IF BITS ARE SET NOP /NONE SET, ASSUME "UPPER" TAD (PAGEU-PAGEL) /"UPPER" TAD (PAGEL-PAGEM) /"LOWER" TAD (PAGEM-1) /"MIXED" DCA .+2 /SAVE CORRECT "PAGE " JMS MOVEL /MOVE CORRECT "PAGE " TO LINE 0 OHEAD3, TAD PAGENO /CONVERT THE NUMBER TO ASCII JMS BINASC TAD SWSBPG /HOW ABOUT SUBLETTER? SKIPYES JMP .+3 /NONE YET TAD SUBPGN /YES, JMS OTSAVE /SAVE THE SUBLETTER ON LINE, TOO TAD HWORD /WHERE TO PUT IT ON LINE? CLL RTR AND (17) /"LEFT, RIGHT, CENTER, ALTER" JMS BITCHK /CHECK FOR CORRECT BITS JMP OHEAD4 /0, ASSUME "RIGHT" JMP OHEAD5 /"LEFT" JMP OHEAD4 /"RIGHT" JMP OHEAD7 /"CENTER" TAD PAGENO /"ALTER" CLL RAR /CHECK IF PAGE NUMBER IS EVEN OR ODD SNL CLA JMP OHEAD5 /"LEFT" FOR EVEN OHEAD4, STA /"RIGHT" IF ODD TAD LENOL CIA TAD PWIDTH /PWIDTH-LENOL+1 SKP /SET UP FOR CORRECT MARGINS OHEAD5, CLA IAC /AGAINST LEFT MARGIN IF "LEFT" DCA ALMARG /SET LEFT MARGIN CORRECTLY SKP OHEAD7, JMS CENTER /CENTER THE HEADER LINE PUSHJ /PRINT THE HEADER LINE PRINT OHEAD6, CRLF /FOLLOWED BY CR/LF COMBO JMP I OHEAD /RETURN TO CALLER / SAVE THE CURRENT LINE BUFFER HSAVE, 0 TAD LENOL /NO. OF CHARS IN OUTPUT LINE SNA JMP HSAVE5 /NOTHING ON LINE, SKIP SAVING TAD (LINE-1) DCA HSAVEP /INITIALIZE POINTER FOR STACKING LINE TAD LENOL CIA DCA HSAVEC /INITIALIZE COUNTER HSAVE1, TAD I HSAVEP PUSHA /SAVE THE LINE ON THE STACK STA TAD HSAVEP DCA HSAVEP /DECREMENT POINTER ISZ HSAVEC JMP HSAVE1 HSAVE5, TAD LENOL /ALSO SAVE LENGTH OF OUTPUT LINE PUSHA TAD ALMARG /PUSH LEFT AND RIGHT MARGS PUSHA TAD RMARG PUSHA JMS NLPARM /SET UP NEW LINE PARAMETERS JMP I HSAVE / SUBROUTINE TO RESTORE THE LINE BUFFER HREST, 0 POPA DCA RMARG /RESTORE MARGINS POPA DCA ALMARG PUSHJ /SET UP NEW LINE PARMS NPARMS /"ALMARG" ALREADY SETUP, THOUGH POPA SNA JMP HREST6 /NOTHING TO RESTORE ON LINE CIA DCA HSAVEC /RESTORE CTR HREST4, POPA OSAVE /SAVE CHAR CORRECTLY IN BUFFER SKP JMP HREST6 /BUFFER FULL, RETURN ISZ HSAVEC /ALL CHARS MOVE? JMP HREST4 /NO HREST6, JMP I HREST /RETURN TO CALLER HSAVEP, 0 HSAVEC, 0 PAGE
/ MAJOR INITIALIZATION ROUTINE INIT, 0 CLA CLL TAD (ZEROS-1) /FIRST CLEAR THE ZEROABLE VARIABLES DCA AUTOX1 TAD (ZEROS-ZEROEND) DCA COUNT DCA I AUTOX1 ISZ COUNT JMP .-2 TAD (OTHERS-1) /THEN INITIALIZE SPECIALIZED VARIABLES DCA AUTOX1 TAD (INITS-1) DCA AUTOX2 TAD (OTHERS-OTHEREND) DCA COUNT TAD I AUTOX2 DCA I AUTOX1 ISZ COUNT JMP .-3 TAD (TABS) DCA PTR1 /PREPARE TO INITIALIZE TAB TABLE TAD (-40) /32 TABS IN TABLE DCA CTR1 CLA IAC /1 IS INITIAL TAB SETTING INIT3, DCA I PTR1 TAD (10) /AND EVERY 8 THEREAFTER TAD I PTR1 INC PTR1 ISZ CTR1 /ALL TABS IN? JMP INIT3 CLA CLL /YES DCA I PTR1 /0 TO END THE TABLE JMP I INIT /THEN RETURN / .TAB STOPS N1,N2,...,N32 / SETS TAB STOPS IN TAB TABLE (MAX OF 32(10)) TABSTP, WORDCK /CHECK FOR "STOPS" STOPC JMP TABGET BADCMD /ILLEGAL COMMAND TABGET, TAD (TABS-1) /INTIALIZE PTR, CTR, INITIAL CHAR DCA TABPTR TAD (-40) DCA TABCTR DCA TABCOL /NOT AT ANY COLUMN NOW TABG2, DCA I [CMDLINE] /SO WE CAN GET A NEW NUMBER INC TABPTR GETNUM /GET A NUMBER FOR TAB STOP TAD CVRTQ /DID CONVERSION TAKE PLACE? SNA CLA JMP TABG3 /NOTHING TO CONVERT, TRY NEXT NUMBER TAD I TABPTR /USE CURRENT TAB STOP SETTING JMS RELQ DCA I TABPTR /AND SAVE IT TABG3, TAD I TABPTR /CHECK FOR LEGALITY OF ORDER SPA JMP TABG4 /NO TABS CAN BE < 0 CIA TAD TABCOL /CURRENT TAB COLUMN SMA CLA JMP TABG4 /TABS OUT OF ORDER TAD CHAR /GOOD TAB STOP, CHECK ENDING CHAR EOCQ JMP TABG5 /END OF COMMAND, RETURN TAD I TABPTR /CURRENT TAB STOP DCA TABCOL ISZ TABCTR /ALL TABS CHECKED? JMP TABG2 /NO, GET ANOTHER ONE TABG4, ERROR /TOO MANY TAB STOPS SIXBIT \TS\ DCA I TABPTR /CLEAR LAST ONE OUT TABG5, GARBAGE RETURN TABPTR, 0 TABCTR, 0 TABCOL, 0 / .AUTOCAPITALIZE / .NO AUTOCAPITALIZE NAUTOC, STA DCA NOFLG /SET "NO" FLAG AUTCAP, TAD NOFLG DCA SWCAP /SET AUTOCAP-NOAUTOCAP FLAG TAD SWCAP DCA CAPSW /SAVE THE FLAG, TOO GARBAGE RETURN CAPSW, 0 / .PERIOD SET PERIOD SWITCH; SET LAST AUTOCAP SWITCH / .NOPERIOD SET NOPERIOD SWITCH; SET NOAUTOCAPITALIZE, TOO NOPER, STA DCA NOFLG PERIOD, TAD NOFLG DCA SWPER /SET THE PERIOD SWITCH TAD SWPER /IS IT .PERIOD? SKIPYES JMP .+3 TAD CAPSW /YES, SET LAST AUTOCAPITALIZATION SKP STA /NO, SET "NO AUTOCAPITALIZE" DCA SWCAP /SET AUTOCAPITALIZATION SWITCH GARBAGE RETURN / SMALL SUBROUTINE TO OUTPUT A CHAR TO TTY TYPEIT, 0 TLS TSF JMP .-1 CLA CLL JMP I TYPEIT TSTPGL, TEXTZ "PAGE" CCHRS, TEXTZ "CHARACTERS" CMDLJ, COMMENT CMDEND GTCOM GETNOQ GETNOQ CMDEND /0 (EOL) = SPACE PAGE
/ SOME LEFTOVER SPACE FOR MISCELLANEOUS CMDLINE,ZBLOCK 20 /THE COMMAND LINE BUFFER VERMESS,ASCII "PRINTR V" VERSION; PATCH; 215; 212; 0 CENTW, TEXTZ "WIDTH" TEXTZ "MARGINS" 0 PAGEL, "P+40; "A+40; "G+40; "E+40; " ; 0 / DO NOT PUT A "PAGE" PSEUDO-OP HERE!!! EJECT CHLENGTH=20 /LENGTH OF CHAPTER BUFFER STLENGTH=100 /LENGTH OF SUB-TITLE BUFFER TLENGTH=100 /LENGTH OF TITLE BUFFER MAXWIDTH=204 /132(10) = WIDTH OF LONGEST OUTPUT LINE DOT=. TABS=DOT; DOT=DOT+40+1 /32 TAB STOPS SBTTLB=DOT; DOT=DOT+STLENGTH+1 /SUBTITLE BUFFER TITLEB=DOT; DOT=DOT+TLENGTH+1 /TITLE BUFFER CHBUFF=DOT; DOT=DOT+CHLENGTH+1 /CHAPTER BUFFER LINE=DOT; DOT=DOT+MAXWIDTH /MAX SIZE IS 132(10) STKEND=DOT STACK=6577 /THE STACK FOR THIS PROGRAM IFL STACK-STKEND-MAXWIDTH-30 < PRINTX STACK SPACE IS GETTING SHORT!! > INDEVH=6600 /INPUT DEVICE HANDLER ADDR OUDEVH=7200 /OUTPUT DEVICE HANDLER ADDR EJECT / THESE ARE THE PAGE ZERO LITERALS FOR FIELD 0 FIELD 1 FNBUFF=0 /THE FOOTNOTE BUFFER IS IN FIELD 1 FNBEND=1777 /BELOW THE GENERAL I/O ROUTINES
/ GENERALIZED I/O PACKAGE / BY: CLYDE G. ROBY, JR. / DEPARTMENT OF MEDICINE / WEST VIRGINIA UNIVERSITY / MORGANTOWN, WEST VIRGINIA / MARCH 24, 1972 FIELD 1 /EXECUTES IN FIELD 1 *2000
/ ENTRY POINT IN FIELD 1 CALLED FROM FIELD 0 SETIO, 0 CDF 10 /WE'RE WORKING IN FIELD 1 DCA USRSTAT /USR IS IN CORE TAD I (7604) /EXT FOR FIRST OUTPUT FILE SNA TAD (WU) /ASSUME .WU FOR WRITE-UP DCA I (7604) TAD I (7600) SZA CLA /IS THERE A MAIN OUTPUT FILE? JMP SETIO4 /YES, CHECK IF 2ND OUTPUT FILE DCA LPTDEV+1 /NO, TRY TO GET "LPT" JMS I (200) 12 /INQUIRE WITHOUT FETCH LPTDEV, LP+T0!4000 /COMPRESSED CODE FOR 'LPT' 0 /DEVICE NUMBER GOES HERE 0 /ADDR IF HANDLER IN CORE JMP TRYTTY /LPT: NOT AVAILABLE, TRY TTY: TAD LPTDEV+1 /GET THE DEVICE NUMBER JMP GOTDEV /WE HAVE THE DEVICE TRYTTY, DCA TTYDEV+1 /TRY TO GET "TTY" JMS I (200) 12 /INQUIRE WITHOUT FETCH TTYDEV, TT+Y0!4000 /COMPRESSED CODE FOR 'TTY' 0 0 HLT /WHAT!, NO TTY!!! TAD TTYDEV+1 /GET THE DEVICE NUMBER GOTDEV, DCA I (7600) /SAVE AS OUTPUT DEVICE NO. SETIO4, TAD (7600) DCA OFILE2 /USE MAIN OUTPUT FILE SETIO5, JMS I (OOPEN) /INITIALIZE OUTPUT ROUTINE SMA CLA /DID OUTPUT ENTER FAIL? JMP .+3 TAD (ERR5) /YES, GIVE ERROR MESSAGE JMP ERRPRT JMS I (IOPEN) /INITIALIZE INPUT ROUTINE JMS I (OTYPE) /GET "TYPE" OF OUTPUT DEVICE TAD (-PTP) /IS IT THE PAPER TAPE PUNCH? SZA CLA JMP SETIO6 /NO, GO RETURN TAD (-200) DCA SETIO9 JMS XXPUT /OUTPUT SOME NULL CHARS ISZ SETIO9 JMP .-2 SETIO6, JMS PUTUSR /OUTPUT THE USR CDF CIF 00 JMP I SETIO SETIO9, 0 OFILE2, 0 WU="W-300^100+"U-300 TT="T-300^100+"T-300 Y0="Y-300^100 LP="L-300^100+"P-300 T0="T-300^100 PAGE
/ 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 (177 TAD (-32 SNA /IS THE CHARACTER A ^Z? JMP GETNEW /YES - GET A NEW FILE TAD (232 /RESTORE THE CHARACTER TO 8 BITS 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 CLA IAC TAD OFILE2 DCA OFNMC /POINTS TO OUTPUT FILE NAME TAD OFILE2 DCA OOFILE /POINTS TO DEVICE NO. OF OUTPUT SPECS TAD OFNMC DCA OUBLK TAD (OUDEVH+1 DCA OUHNDL CDF 10 TAD I OOFILE /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 OOFILE JMS I (200 3 /ENTER OUTPUT FILE OUBLK, 0 /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, JMP I OOPEN OEFAIL, TAD I OOFILE AND (7760 /GET REQUESTED LENGTH SNA CLA /WAS IT AN INDEFINITE REQUEST JMP ONTERR /YES - CANNOT ENTER THE FILE TAD I OOFILE AND (17 /MAKE THE REQUESTED LENGTH ZERO DCA I OOFILE 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 OOFILE, 0 / OUTPUT A BUFFER LOAD OUTDMP, 0 DCA OUCTLW /STORE THE CONTROL WORD 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 CIF 00 /HANDLERS IN FIELD 0 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 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 OOFILE /GET THE DEVICE NUMBER JMS I (7700 /JUST A ONE-SHOT 4 /CLOSE THE OUTPUT FILE OFNMC, 0 /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
/ 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 9ZROS 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 / GET ROUTINE AS USER SEES IT XXGET, 0 CLA RDF TAD (CDF CIF) DCA XXGETR /SAVE FIELD FRO M WHENCE WE WERE CALLLED CDF 10 /WE'RE IN FIELD 1 XXGET1, JMS I (ICHAR) JMP XXGETX /ERROR RETURN AND (177) /STRIP TO 7 BIT ASCII SZA TAD (-177) SNA JMP XXGET1 /IGNORE NULL AND RUBOUT TAD (377) /GENERATE 8-BIT ASCII CHAR XXGETR, HLT /CHANGE FIELDS BACK TO USER JMP I XXGET /O.K., RETURN WITH CHAR IN AC XXGETX, 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 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, CDF CIF 00 JMP I .+1 /THEN EXECUTE E-O-F PROCEDURE EOFLOC, EOFILE /INITIALIZED FOR FIRST TIME / 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 EREOL /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 EREOL, TAD (215 JMS XXXTTY TAD (212 JMS XXXTTY CDF CIF 00 /PREPARE TO JMP I (7600) /RETURN TO THE 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
/ THE COMMANDS THAT ARE CURRENTLY IMPLEMENTED IN THIS VERSION CMDS, TEXTZ "AC" TEXTZ "AUTOCAPITALIZE" TEXTZ "AP" TEXTZ "AUTOPARAGRAPH" TEXTZ "B" TEXTZ "BLANK" TEXTZ "BR" TEXTZ "BREAK" TEXTZ "C" TEXTZ "CENTER" TEXTZ "CENTRE" TEXTZ "CH" TEXTZ "CHAPTER" TEXTZ "CM" TEXTZ "CW" TEXTZ "COMMENT" TEXTZ "CC" TEXTZ "CONTROL" TEXTZ "END" TEXTZ "ES" TEXTZ "FG" TEXTZ "FIGURE" TEXTZ "F" TEXTZ "FILL" TEXTZ "FL" TEXTZ "FLAG" TEXTZ "FLAGS" TEXTZ "FN" TEXTZ "FOOTNOTE" TEXTZ "HD" TEXTZ "HEADER" TEXTZ "I" TEXTZ "INDENT" TEXTZ "J" TEXTZ "JUSTIFY" TEXTZ "L" TEXTZ "LEFT" TEXTZ "LM" TEXTZ "LC" TEXTZ "LOWER" TEXTZ "MARGINS" TEXTZ "M" TEXTZ "NAC" TEXTZ "NAP" TEXTZ "NCC" TEXTZ "NF" TEXTZ "NFL" TEXTZ "NHD" TEXTZ "NJ" TEXTZ "NNM" TEXTZ "NPA" TEXTZ "NPR" TEXTZ "NM" TEXTZ "NUMBER" TEXTZ "PG" TEXTZ "PAGE" TEXTZ "PAPER" TEXTZ "PS" TEXTZ "PA" TEXTZ "PAGING" TEXTZ "P" TEXTZ "PARAGRAPH" TEXTZ "PR" TEXTZ "PERIOD" TEXTZ "R" TEXTZ "RIGHT" TEXTZ "RM" TEXTZ "S" TEXTZ "SKIP" TEXTZ "SP" TEXTZ "SPACING" TEXTZ "SPG" TEXTZ "SUBPAGE" TEXTZ "ST" TEXTZ "SUBTTL" TEXTZ "SUBTITLE" TEXTZ "TS" TEXTZ "TAB" TEXTZ "TA" TEXTZ "TR" TEXTZ "TABS" TEXTZ "TP" TEXTZ "TEST" TEXTZ "T" TEXTZ "TITLE" TEXTZ "UC" TEXTZ "UPPER" 0 / FLAG WORDS FOR .FLAG COMMANDS FLGWDS, TEXTZ "CONTROL" TEXTZ "ENDFOOTNOTE" TEXTZ "SPACE" TEXTZ "QUOTE" TEXTZ "UPPERCASE" TEXTZ "UNDERLINE" TEXTZ "FIRSTCAPITALIZE" TEXTZ "CAPITALIZE" TEXTZ "LOWERCASE" 0 / SECOND WORD FOR .TABS COMMANDS TABSLJ, TEXTZ "RELATIVE" TEXTZ "ABSOLUTE" 0 / COMMAND WORDS FOR .HEADER COMMAND HEADWD, TEXTZ "TOP" TEXTZ "BOTTOM" TEXTZ "LEFT" TEXTZ "RIGHT" TEXTZ "CENTER" TEXTZ "ALTER" TEXTZ "UPPER" TEXTZ "LOWER" TEXTZ "MIXED" TEXTZ "NUMBER" 0 / ARGUMENTS FOR "PAGE" COMMAND PAGCMD, TEXTZ "TOP" TEXTZ "BOTTOM" PAPERL, TEXTZ "SIZE" 0 PAGE
/ DEFINE SOME PARAMETERS FOR GENERAL I/O DOT=. OBUFL=1000 /LENGTH OF OUTPUT BUFFER AOBUFL=OBUFL^3%2 /NO. OF CHARS IN OUTPUT BUFFER IBUFL=1000 /INPUT BUFFER LENGTH OUBUF=DOT /MUST BE LOWER THAN INBUF OUCTL=OBUFL%2!4010 /OUTPUT BUFFER CTRL WORD INBUF=OUBUF+OBUFL INCTL=IBUFL%2!0010 /INPUT BUFFER CTRL WORD INRECS=INCTL%200 /NO. OF INPUT RECORDS INFLD=INCTL&70 /GET FIELD OF INPUT BUFFER OUFLD=OUCTL&70 /DITTO OUTPUT BUFFER /EQUIVALENCES NECESSARY TO INTERFACE WITH MONITOR DCB=7760 MPARAM=7643 /CD PARAMETER AREA NPARAM=MPARAM+3 /CD =N ARGUMENT PTP=20 /INTERNAL TYPE CODE: PAPER TAPE PUNCH DOT=INBUF+IBUFL IFG DOT-7600 <PRINTX FIELD 1 IS TOO LONG > $ * $ * $ * $
0 /NO. OF INPUT RECORDS INFLD=INCTL&70 /GET FIELD OF INPUT BUFFER OUFLD=OUCTL&70 /DITTO OUTPUT BUFFER /EQUIVALENCES NECESSARY TO INTERFACE WITH MONITOR DCB=7760 MP