/ PRINT PROGRAM FOR P?S/8 / LAST EDIT: 03-JUL-1987 02:00:00 CJL / MUST BE ASSEMBLED WITH '/J' SWITCH SET. / PRINT PROGRAM FOR P?S/8 FIXED AND VARIABLE-LENGTH ASCII FILES. / USAGE: / .[R ]PRINT FILE1,FILE2, ... FILEN (OPTIONS) / OPTIONS: / /E DON'T EJECT ON "EJECT"; CHANGES DEFAULT NUMBER OF LINES PER / PAGE TO 55; SEE /L. / /F USE INSTEAD OF HASHED PAGE SEPARATOR ON CONSOLE. / /H NO HEADERS ON OUTPUT. DEFAULT IS A HEADER ON EACH PAGE. SEE /I, /R. / /I INITIAL FILE'S FIRST LINE USED AS HEADER THROUGHOUT LISTING. DEFAULT / IS TO OBTAIN A NEW HEADER FROM EITHER THE NAME AND UNIT, OR THE / FIRST LINE OF EACH FILE. SEE /R. / /K NO LINE OR SEQUENCE NUMBERS ON OUTPUT. / /L USE EQUALS PARAMETER AS NUMBER OF LINES PER PAGE; DEFAULT IS 56; / SEE /E. / /N NO PAGINATION ON OUTPUT. / /O OCTAL LINE NUMBERS ON LINE NUMBERED FILES. THE DEFAULT IS DECIMAL / LINE NUMBERS. SEE /K, /S. / /P PAUSE BETWEEN OUTPUT PAGES. THREE CHARACTERS WILL BE SENT / TO THE CONSOLE TERMINAL TO INDICATE THE PAUSE. HITTING ON THE / CONSOLE KEYBOARD WILL RESUME THE OUTPUT. / /R THE HEADER IS TAKEN FROM THE CONTENTS OF THE FIRST LINE OF THE FILE / IF IT IS A LINE NUMBERED FILE. (THE HEADER IS TAKEN FROM THE CONTENTS / OF THE FIRST LINE OF VARIABLE-LENGTH FILES REGARDLESS OF THIS SWITCH.) / THE DEFAULT IS TO USE THE FILE NAME AND UNIT IN THE HEADER. SEE /H, /I. / /S USE SEQUENTIAL NUMBERS ON ENTIRE OUTPUT. LINE NUMBERS IN LINE NUMBERED / FILES WILL BE IGNORED. DEFAULT FOR VARIABLE-LENGTH FILES. SEE /K. / /T USE CONSOLE FOR OUTPUT; DON'T CHECK FOR LPT:. / /U OUTPUT IN UPPER CASE ONLY. DEFAULT IS UPPER/LOWER CASE OUTPUT. / =NNNN NNNN LINES PER PAGE USED IF /L IS PASSED. IGNORED IF OUTSIDE OF / RANGE 1-60. / ERROR MESSAGES. / THERE IS ONE FATAL ERROR, WHICH EXITS TO THE MONITOR AFTER PRINTING THE / FOLLOWING MESSAGE: / NO INPUT FILES! / NO INPUT FILES WERE PASSED TO PRINT FOR PROCESSING. INPUT FILES / MUST BE PRESENT WHEN INVOKING THE PRINT UTILITY. / IMPLEMENTATION NOTES AND CUSTOMIZATION. / IT MAY BE DESIRABLE TO CUSTOMIZE ANY PARTICULAR COPY OF PRINT TO THE USER'S / OWN PREFERENCE REGARDING CERTAIN SWITCHES. FOR EXAMPLE, A USER MAY PREFER / A PERMANENT TITLE ON ALL OUTPUT TAKEN FROM THE FIRST LINE OF THE FIRST FILE. / OPTION SWITCHES CONTROLLING THIS AND OTHER ASPECTS OF PRINT ARE AVAILABLE / TO CUSTOMIZE THE OPERATIONS OF THE PROGRAM, BUT THESE REQUIRE THE USER TO / INVOKE FAVORED OPTIONS REPEATEDLY. / SEVERAL KNOWN OPERATING SYSTEMS SUPPORT "PATCHED" VERSIONS OF SYSTEM PROGRAMS / WHICH EFFECTIVELY FORCE THE EFFECT OF OPTION SWITCHES WHETHER EXPLICITLY / GIVEN OR NOT. THIS PREVENTS THE POSSIBILITY OF USING THE PROGRAM IN THE / ORIGINAL WAY AS THERE IS NO METHOD TO REVERT THE ENFORCED OPTION. / TO OVERCOME THIS LIMITATION, THE USER CAN PATCH THE FIRST THREE WORDS OF / THE CORE IMAGE OF PRINT ITSELF WITH A "MASK" (EACH BIT CORRESPONDS TO AN / OPTION SWITCH SERIALLY FROM /A-/Z FOLLOWED BY /0-/9). THIS MASKING VALUE / WILL BE USED TO "REVERSE" THE EFFECT OF THE SPECIFIED SWITCH. FOR EXAMPLE: / SETTING RELATIVE WORD ZERO OF THE CORE IMAGE OF PRINT TO 0010 WILL REVERSE / THE /I OPTION. THIS WOULD REQUIRE THE USER TO INVOKE /I IF THE TITLE SHOULD / BE TAKEN FROM EACH FILE AS IN THE UNMODIFIED VERSION, OPPOSITE TO NORMAL / CONVENTION. ALL SWITCHES CAN BE "REVERSED" ACCORDINGLY (INCLUDING OPTION / SWITCHES IGNORED BY PRINT!). THE RESULTANT CUSTOMIZED COPY OF PRINT OPERATES / IN A TOTALLY CONVENTIONAL MANNER; ONLY THE METHOD OF PASSING SWITCH OPTIONS / CHANGES. / EQUATED SYMBOLS. BINADR= 0020 /% BLOCK BLBMAX= 30 /48 CHARACTERS MAXIMUM IN USER FILE BLURB BSGRP= 0003 /BASE GROUP NUMBER FOR SYSTEM DATE WORD CATADR= 7000 /LOADING ADDRESS FOR CATALOG DIR= 0015 /CATALOG BLOCK DOLBLK= 0040 /$ BLOCK FILBEG= 3000 /FILE LOADING ADDRESS FILBUFF=3000 /FILES READ INTO 3000 FILCORE=3000 /FILES WERE CREATED IN 3000 HT= 37 / CHARACTER IN SIX-BIT INCON= 0031 /EQUATED FROM CONSOLE! JMSC= JMS . /CURRENT PAGE "JMS" INSTRUCTION LPMODE= 0004 /LPT: BUFFERING MODE LPT= 66 /BASE DEVICE OF HARDWARE LPT: NL0001= CLA IAC /LOAD AC WITH 0001 NL0002= CLA CLL CML RTL /LOAD AC WITH 0002 NL2000= CLA CLL CML RTR /LOAD AC WITH 2000 NL4000= CLA CLL CML RAR /LOAD AC WITH 4000 NL7775= CLA CLL CMA RTL /LOAD AC WITH 7775 NL7776= CLA CLL CMA RAL /LOAD AC WITH 7776 NL7777= CLA CMA /LOAD AC WITH 7777 OUTCON= 0033 /EQUATED FROM CONSOLE! OUTLPT= 0035 /EQUATED FROM CONSOLE! REVISIO="C&77 /REVISION LETTER SBOOT= 7600 /SYSTEM BOOTSTRAP ADDRESS SCRSIZE=7611 /SYSTEM CORE SIZE WORD SDATE= 7610 /SYSTEM DATE WORD SFILES= 7757 /SYSTEM FILE ARGUMENTS ADDRESS SOUTFLS=7607 /SYSTEM OUTPUT FILE COUNT SPARM= 7756 /SYSTEM EQUALS PARAMETER ADDRESS SWAL= 7604 /SWITCHES /A-/L PASSED HERE SWMX= 7605 /SWITCHES /M-/X PASSED HERE SYSIO= 7640 /I/O ENTRY POINT TTY= 03 /BASE DEVICE OF HARDWARE CONSOLE VERSION=12 /VERSION NUMBER / DEPENDENT DEFINITIONS. JMSSYSI=SYSIO&177+JMSC /CALL TO "SYSIO" FROM ITS OWN PAGE KCCIOT= TTY^10+6002 /CLEAR AC, CLEAR INPUT FLAG, SET READER RUN KRBIOT= TTY^10+6006 /CLEAR FLAG, LOAD INPUT INTO AC, SET READER RUN KRSIOT= TTY^10+6004 /OR INPUT INTO AC, DON'T CLEAR FLAG KSFIOT= TTY^10+6001 /SKIP ON KEYBOARD FLAG (MIGHT CLEAR IF DECMATE) LLSIOT= LPT^10+6006 /LOAD PRINTER FROM AC, CLEAR FLAG LSFIOT= LPT^10+6001 /SKIP ON PRINTER FLAG TLSIOT= TTY+1^10+6006 /LOAD OUTPUT FROM AC, CLEAR FLAG TSFIOT= TTY+1^10+6001 /SKIP ON OUTPUT FLAG (MIGHT CLEAR IF DECMATE) *0 /START AT THE BEGINNING XORSWS= . /XOR VALUES FOR OPTION SWITCHES HERE PUTNDX, 0/.-. /OUTPUT INDEX TEMP1, 0/.-. /TEMPORARY TEMP2, 0/.-. /TEMPORARY COLUMN, 10 /COLUMN COUNTER ECHOSW, 0 /ECHO SWITCH FILNUMB,1 /FILE NUMBER LSEP, "-&177 /**** **** OUTPUT, P7CH /OUTPUT ROUTINE POINTER *10 /DEFINE AUTO-INDEX AREA XR1, .-. /AUTO-INDEX NUMBER ONE XR2, .-. /AUTO-INDEX NUMBER TWO CTEMP, .-. /CONSOLE PRINT ROUTINE TEMPORARY EJECTSW,.-. /EJECT NEEDED SWITCH FILPAGE,0 /PAGE NUMBER WITHIN FILE INCHAR, .-. /LATEST INPUT CHARACTER LINCNT, .-. /LINE COUNTER P7TEMP, .-. /OUTPUT ROUTINE TEMPORARY *20 /GET PAST AUTO-INDEX AREA DECCONV,0 /LEADING ZERO CONVERTER DECOFFS,0 /DECIMAL-OCTAL OFFSET DECPTR, .-. /POINTER TO CURRENTLY USED POWER OF TEN DECQUO, .-. /DIGIT QUOTIENT DIGPTR, .-. /DIGIT POINTER FILPTR, .-. /FILE POINTER FRSTSW, -1 /FIRST TIME SWITCH GETBASE,.-. /INPUT BASE GETNDX, .-. /INPUT INDEX GIVPTR, .-. /FILE UNPACKING POINTER GPTEMP, .-. /GETHAF/PUTHAF TEMPORARY LATEST, .-. /LATEST UNPACKED CHARACTER LATLINE,.-. /LATEST LINE POINTER LATNUMB,.-. /LATEST LINE NUMBER LINESW, .-. /LINE NUMBERS POSSIBLE SWITCH LRESET, -70 /LINES PER PAGE RESET COUNT NPEXTRA,.-. /EXTRA COUNT NUMPTR, .-. /TEMPORARY FOR ASCII VALIDATION PAIR, .-. /LATEST PAIR OF CHARACTERS FOR TITLES PARLMT, .-. /PAIR LIMIT PUTBASE,.-. /OUTPUT BASE QUO, .-. /QUOTIENT FOR DIVIDE ROUTINE REM, .-. /REMAINDER FOR DIVIDE ROUTINE SCRCASE,100 /ALPHABETIC CASE SCRCHAR,.-. /LATEST OUTPUT CHARACTER SCRPTR, .-. /MESSAGE POINTER TXTPTR, .-. /TEXT UNPACKING POINTER UNIT, -1 /LATEST CATALOG UNIT CTLCTST,.-. /<^C> TEST, ETC. ROUTINE L7600, CLA!400 /CLEAN UP CHKKSF, KSFIOT /**** CONSOLE: **** CIF MCS+10 CHKJMP, JMP I CTLCTST /**** CONSOLE: **** JMS INCON CHKKRS, KRSIOT/OR KRBIOT /**** CONSOLE: **** JMP I CTLCTST AND [177] /JUST SEVEN BITS DCA INCHAR /SAVE IT NL7775 /-3 TAD INCHAR /COMPARE TO LATEST CHARACTER SNA /SKIP IF NOT <^C> ISZ I [SCRSIZE] /ELSE SET SOFT INDICATOR L7750, SPA SNA CLA /SKIP IF <^D> OR GREATER JMP I L7600/[SBOOT] /ELSE GO BACK TO THE MONITOR CHKKCC, KCCIOT/OR 0000 /**** CONSOLE: **** 0000 TAD INCHAR /GET THE INPUT CHARACTER JMP I CTLCTST /RETURN TO CALLER CONOUT, .-. /CONSOLE-ONLY OUTPUT ROUTINE CONTSF, TSFIOT /**** CONSOLE: **** CIF MCS+10 CONJMP, JMP I CONOUT /**** CONSOLE: **** JMS OUTCON CONTLS, TLSIOT /**** CONSOLE: **** JMP I CONOUT L7700, SMA CLA /CONSTANT 7700; THIS CLEARS THE AC L200, 200 /CONSTANT 0200; THIS CAN BE SKIPPED ISZ CONOUT /BUMP RETURN ADDRESS JMP I CONOUT /TAKE SKIP RETURN TO CALLER P7OUT, .-. /BEST DEVICE AVAILABLE OUTPUT ROUTINE P7TSF, TSFIOT /**** LPT: **** LSFIOT /**** CONSOLE: **** CIF MCS+10 /**** LOG-LPT: **** CIF MCS+10 P7JMP, JMP I P7OUT /**** LPT: **** JMP I P7OUT /**** CONSOLE: **** JMS OUTCON /**** LOGLPT: **** JMS OUTLPT P7TLS, TLSIOT /**** LPT: **** LLSIOT /**** CONSOLE: **** JMP I P7OUT /**** LOG-LPT: **** JMP I P7OUT L7640, SZA CLA /CONSTANT 7640; THIS CLEARS THE AC L12, 12 /CONSTANT 0012; THIS CAN BE SKIPPED ISZ P7OUT /BUMP RETURN ADDRESS JMP I P7OUT /TAKE SKIP RETURN TO CALLER READ, .-. /FILE READ ROUTINE NL2000/TAD (20^100)/GET READ FUNCTION TAD UNIT /ADD ON UNIT BITS DCA READFUN /STORE IN-LINE JMS I L7640/[SYSIO] /CALL I/O ROUTINES FILBEG /READ INTO BUFFER READFUN,20^100+.-. /UNIT BITS WILL BE FILLED IN BLOCK, .-. /BLOCK NUMBER JMP I READ /RETURN PAGE PRINT= . /PRINT PROGRAM STARTS HERE IFNZRO .&177 PRINT, NOP /HERE IN CASE CHAINED TO JMP I (INITIALIZE) /CONTINUE THERE / COMES HERE TO PROCESS NEXT FILE. DONEXT, DCA FILPAGE /CLEAR PAGE NUMBER FOR NEW FILE ISZ FILNUMBER /BUMP FILE NUMBER ISZ FILPTR /BUMP TO NEXT FILE ARGUMENT NXTFILE,TAD I FILPTR /GET THE FILE ARGUMENT SZA /SKIP IF END OF LIST JMP DOFILE /JUMP IF NOT LPZAP2, SKP /**** **** 0000 DCA I (LPZAP3) /PREVENT ADDITIONAL CHARACTERS AFTER LAST NPZAP1, JMS I [NEWPAGE] /**** /N **** 0000 BUFZP3, SKP /**** LOG-LPT: AND BUFFERING AND /N **** 0000 JMS I OUTPUT /OUTPUT A ISZ NULCNT /DONE YET? JMP BUFZP3 /NO, KEEP GOING JMP I L7600/[SBOOT] /GOODBYE! DOFILE, JMS I (LODCAT) /LOAD LATEST CATALOG TAD (USRMSG-1) /POINT AT DCA XR2 /MESSAGE BUFFER DCA LINESW /ASSUME NO LINE NUMBERS TAD I FILPTR /GET THE FILE ARGUMENT AND (7770) /JUST BLOCK BITS DCA BLOCK /STORE THE BLOCK NUMBER JMS READ /READ IN (THE FIRST PART OF) THE FILE TAD I (CATADR+376) /GET UPPER BLOCK LIMIT OF CATALOG CLL CIA /INVERT IT TAD BLOCK /COMPARE TO FILE BLOCK SZL CLA /SKIP IF IN CATALOG JMP I (USELINE) /JUMP IF NOT JMS I (VALASCII) /VALIDATE THE FILE JMP I (USELINE) /FORGET IT ISZ LINESW /LINE NUMBERS ARE POSSIBLE TAD I [SWAL] /GET SWITCHES /A-/L AND [10] /JUST /I BIT SZA CLA /SKIP IF OFF JMP I (USELINE) /JUMP IF ON TAD I [SWMX] /GET SWITCHES /M-/X AND [100] /JUST /R BIT SZA CLA /SKIP IF OFF JMP I (USELINE) /JUMP IF ON TAD (JMS I [SCRIBE]) /RESET THE DCA I [USLNZAP] /TITLE ROUTINE TAD (FILBLB-1) /POINT AT DCA XR1 /FILE NAME BLURB TAD (FILBLB-FILBEND) /SETUP THE DCA TEMP1 /MOVE COUNT TAD I XR1 /GET A WORD DCA I XR2 /PUT A WORD ISZ TEMP1 /DONE ENOUGH? JMP .-3 /NO, GO BACK TAD BLOCK /GET THE BLOCK TAD [-BINADR] /COMPARE TO % SNA /SKIP IF OTHER JMP USEPERCENT /JUMP IF IT MATCHES TAD [-DOLBLK+BINADR] /COMPARE TO $ SNA CLA /SKIP IF OTHER JMP USEDOLLAR /JUMP IF IT MATCHES TAD I (CATADR+377) /GET STARTING BLOCK OF CATALOG CIA /INVERT TAD BLOCK /NOW HAVE RELATIVE BLOCK CLL RTR;RTR /%20 DCA TEMP1 /SAVE RELATIVE FILE NUMBER TAD TEMP1 /GET IT BACK CLL RAL /*2 TAD TEMP1 /*3 TAD [CATADR-1] /POINT AT FILE ENTRY DCA XR1 /STASH THE POINTER TAD I XR1 /GET A WORD DCA I XR2 /PUT A WORD TAD I XR1 /GET A WORD DCA I XR2 /PUT A WORD TAD I XR1 /GET A WORD DCA I XR2 /PUT A WORD USEDPEN,DCA I XR2 /ENSURE A DELIMITER TAD (USRMSG) /POINT AT STRING DCA GETBASE /FOR SEARCHING TAD (USRMSG) /LIKEWISE DCA PUTBASE /FOR STORING DCA GETNDX /CLEAR INPUT INDEX DCA PUTNDX /CLEAR OUTPUT INDEX LUKLUP, JMS I [GETHAF] /GET A CHARACTER SNA CLA /END OF MESSAGE? JMP FNDEOM /YES ISZ GETNDX /NO, BUMP TO NEXT ISZ PUTNDX /TRACK OUTPUT ALSO JMP LUKLUP /KEEP GOING FNDEOM, TAD (":&77) /GET A ":" JMS I [PUTHAF] /STORE OVER FORMER ISZ PUTNDX /BUMP TO NEXT TAD UNIT /GET CURRENT UNIT TAD ["0&77] /MAKE IT ASCII JMS I [PUTHAF] /PUT INTO MESSAGE ISZ PUTNDX /BUMP TO NEXT TAD [HT] /GET JMS I [PUTHAF] /PUT INTO MESSAGE ISZ PUTNDX /BUMP TO NEXT JMS I [PUTHAF] /DELIMIT MESSAGE JMP I (GOTTITLE) /CONTINUE THERE USEPERC,TAD ("%^100) /GET % STRING JMP USEDPENTRY /CONTINUE THERE USEDOLL,TAD ("$^100) /GET $ STRING JMP USEDPENTRY /CONTINUE THERE NULCNT, 0 / OUTPUT COUNTER PAGE USELINE,TAD I [SWAL] /GET /A-/L SWITCHES AND [10] /JUST /I SNA CLA /SKIP IF SET JMP GETTITLE /JUMP IF NOT ISZ FRSTSW /FIRST FILE? JMP GOTTITLE /NO, WE GOT A TITLE EARLIER GETTITL,TAD (JMS I [USCRIBE]) /MAKE IT USE DCA I [USLNZAP] /UPPER-CASE TITLES TAD L7750/[-BLBMAX] /SETUP THE DCA TEMP1 /TITLE LIMIT COUNT TAD (FILBEG-1) /POINT AT DCA XR1 /FILE CONTENTS GETLUP, TAD I XR1 /GET A PAIR DCA PAIR /STASH IT TAD PAIR /GET IT BACK AND L7700/[7700] /JUST HIGH-ORDER HALF SNA CLA /SKIP IF NOT JMP GETEND /JUMP IF AT TAD PAIR /GET PAIR DCA I XR2 /STORE IN MESSAGE BUFFER TAD PAIR /GET IT AGAIN AND [77] /IS LOW-ORDER HALF ? SNA CLA /SKIP IF NOT JMP GETEND /JUMP IF SO ISZ TEMP1 /TOO MANY CHARACTERS? JMP GETLUP /NO, KEEP GOING GETEND, DCA I XR2 /SET MESSAGE DELIMITER GOTTITL,TAD (GIVUPDATE) /SETUP DCA GIVTRIM /CO-ROUTINE JMS I [DEJECT] /DO OPENING EJECT JMS I (PROCFILE) /GO DO LATEST FILE FILDONE,TAD PUTNDX /GET OUTPUT INDEX SNA CLA /SKIP IF MORE TO DO JMP I (DONEXT) /ELSE GO DO NEXT FILE JMS I [PUTHAF] /DELIMIT THE LINE JMS I [PUTLINE] /OUTPUT IT JMP I (DONEXT) /GO DO NEXT FILE DECPRT, .-. /DECIMAL PRINTOUT ROUTINE DCA TEMP1 /SAVE THE NON-ZERO NUMBER TAD DECOFF /GET POSSIBLE OFFSET TAD (TENS) /POINT AT POWER TABLE DCA DECPTR /STASH THE POINTER DECLUP, DCA DECQUO /CLEAR THE QUOTIENT JMP .+3 /START THE DIVIDE OPERATION NOW DECLOP, DCA TEMP1 /RESTORE UPDATED QUOTIENT ISZ DECQUO /BUMP DIGIT QUOTIENT TAD I DECPTR /GET NEXT POWER OF TEN SNA /END OF LIST? JMP I DECPRT /YES, WE'RE DONE CLL /CLEAR LINK NEEDED FOR TESTING TAD TEMP1 /GET QUOTIENT SZL /SKIP IF WE DIDN'T UNDERFLOW JMP DECLOP /BUMP UP QUOTIENT CLA /ALL DONE WITH THIS ONE ISZ DECPTR /BUMP POINTER TO NEXT POWER OF TEN TAD DECQUO /GET DIGIT SNA /IS IT ZERO? TAD DECCONVERT /YES, MIGHT CONVERT IT TO SNA /IS IT ZERO? JMP DECLUP /YES, DON'T PRINT IT TAD ["0&77] /MAKE INTO ASCII DIGIT JMS I OUTPUT /PRINT IT TAD DECQUO /GET DIGIT AGAIN SZA CLA /SKIP IF ZERO NL4000 /FORCE SIGNIFICENCE OF REMAINING DIGITS JMP DECLUP /DO IT AGAIN / FILE UNPACKING ROUTINE. GIVCHR, .-. /GIVE A CHARACTER ROUTINE JMP I GIVTRIM /GO WHERE YOU'RE SUPPOSED TO GO GIVTRIM,GIVUPDATE /TRIM AND EXIT ROUTINE AND [77] /JUST SIX-BIT SNA /? JMP GIVEOLINE /YES GIVELEN,DCA LATEST /SAVE LATEST CHARACTER TAD LATEST /GET IT BACK JMP I GIVCHR /RETURN TO MAIN CALLER GIVEOL, TAD (GVRSET) /RESET THE CO-ROUTINE DCA GIVTRIM /FOR NEXT CALLER JMP GIVELENTRY /CONTINUE THERE GIVLUP, TAD I GIVPTR /GET A PAIR SNA /END OF FILE? JMP I (FILDONE) /YES RTR;RTR;RTR /NO, MOVE OVER JMS GIVTRIM /GIVE THEM HIGH-ORDER HALF TAD I GIVPTR /GET IT AGAIN JMS GIVTRIM /GIVE THEM LOW-ORDER HALF GVRSET, ISZ GIVPTR /BUMP TO NEXT PAIR TAD GIVPTR /GET THE POINTER TAD [-CATADR] /COMPARE TO LIMIT SZA CLA /SKIP IF AT LIMIT JMP GIVLUP /ELSE KEEP GOING JMS READ /READ IN NEXT BUFFER GIVUPDA,TAD BLOCK /GET CURRENT BLOCK TAD [20] /UPDATE FOR NEXT TIME DCA BLOCK /STORE BACK TAD [FILBEG] /RESET THE DCA GIVPTR /UNPACKING POINTER JMP GIVLUP /KEEP GOING PAGE CHKUP, .-. /CHECK FOR <^C>, ETC. ROUTINE JMS CTLCTST /CHECK FOR <^C> TAD (-"O!300) /IS IT <^O>? SNA /SKIP IF NOT JMP DOUO /JUMP IF IT MATCHES TAD [-"S+"O] /COMPARE TO <^S> SZA CLA /SKIP IF IT MATCHES JMP I CHKUP /ELSE JUST RETURN JMS CTLCTST /CHECK FOR <^C> TAD [-"Q!300] /IS IT <^Q>? SZA CLA /SKIP IF IT MATCHES JMP .-3 /JUMP BACK IF NOT JMP I CHKUP /RETURN DOUO, TAD ("^&177) /GET AN "^" JMS CONOUT /PRINT IT JMP .-1 /WAIT FOR IT TAD ("O&177) /GET AN "O" JMS CONOUT /PRINT IT JMP .-1 /WAIT FOR IT NL4000 /SET INVERSION BIT TAD ECHOSW /INVERT ECHO STATUS DCA ECHOSW /STORE BACK JMP I CHKUP /RETURN CPRINT, .-. /CONSOLE PRINT ROUTINE DCA CTEMP /SAVE PASSED VALUE CPRAGN, JMS CHKUP /CHECK FOR <^C>, ETC. TAD CTEMP /GET THE PASSED VALUE JMS CONOUT /TRY TO OUTPUT IT JMP CPRAGN /TRY INPUT WHILE WAITING JMS CHKUP /TRY INPUT WHILE LEAVING JMP I CPRINT /RETURN P7CH, .-. /BEST DEVICE OUTPUT ROUTINE DCA P7TEMP /SAVE PASSED VALUE ISZ COLUMN /BUMP TO NEXT COLUMN P7AGN, JMS CHKUP /CHECK FOR <^C>, ETC. TAD ECHOSW /GET ECHO SWITCH SPA CLA /SKIP IF ECHO ON JMP P7OFF /JUMP IF ECHO OFF TAD P7TEMP /GET THE PASSED VALUE JMS P7OUT /TRY TO OUTPUT IT JMP P7AGN /TRY INPUT WHILE WAITING P7OFF, JMS CHKUP /CHECK FOR <^C>, ETC. JMP I P7CH /RETURN / MESSAGE PRINTING ROUTINES. USCRIBE,.-. /UPPER-CASE ONLY SCRIBE ROUTINE TAD I USCRIBE /GET PASSED ARGUMENT DCA USCRARG /STORE IN-LINE ISZ USCRIBE /BUMP PAST ARGUMENT DCA UPZAP /MAKE SCRIBE DO UPPER-CASE ONLY JMS I [SCRIBE] /CALL SCRIBE ROUTINE USCRARG,.-. /WILL BE PASSED ARGUMENT TAD LSKP/(SKP) /RESET SCRIBE DCA UPZAP /FOR OTHER CALLERS JMP I USCRIBE /RETURN TO OUR CALLER CSCRIBE,.-. /CONSOLE-ORIENTED PRINT ROUTINE TAD (CPRINT) /POINT TO THE DCA OUTPUT /CONSOLE OUTPUT ROUTINE TAD I CSCRIBE /GET OUR PASSED ARGUMENT DCA I (SBOOT-1) /STORE IN CURIOUS PLACE TAD (SBOOT-1) /POINT TO CURIOUS PLACE DCA I [SCRIBE] /SO IT WILL USE IT LSKP, SKP /SKIP OVER HEADER SCRIBE, .-. /MESSAGE PRINT ROUTINE CLA /JUST IN CASE TAD I SCRIBE /GET MESSAGE POINTER DCA SCRPTR /STASH IT ISZ SCRIBE /BUMP PAST ARGUMENT TAD (140) /INITIALIZE TO LOWER-CASE CASZP1, DCA SCRCASE /**** /U **** CLA!400 SCRLUP, TAD I SCRPTR /GET LEFT HALF-WORD RTR;RTR;RTR /MOVE OVER JMS SCRPRNT /PRINT IT TAD I SCRPTR /GET RIGHT HALF-WORD JMS SCRPRNT /PRINT IT ISZ SCRPTR /BUMP TO NEXT PAIR JMP SCRLUP /KEEP GOING SCRPRNT,.-. /CHARACTER PRINT ROUTINE AND [77] /JUST SIX-BIT SNA /END OF MESSAGE? JMP I SCRIBE /YES, RETURN TO ORIGINAL CALLER DCA SCRCHAR /SAVE FOR NOW UPZAP, SKP /**** UPPER-CASE **** 0000 JMP TABOUT /PRINT UPPER-CASE OUTPUT THERE TAD SCRCHAR /GET IT BACK TAD (-"%!200) /IS IT "%"? SNA /SKIP IF NOT JMP SCRCRLF /JUMP IF IT MATCHES TAD [-"^+100+"%] /IS IT "^" SNA /SKIP IF NOT JMP SCRFLIP /JUMP IF IT MATCHES TAD (-HT+"^-300) /IS IT ? SNA CLA /SKIP IF NOT JMP TABOUT /JUMP IF IT MATCHES TAD SCRCHAR /GET THE CHARACTER AND [40] /DOES CASE MATTER? SNA CLA /SKIP IF NOT TAD SCRCASE /ELSE GET PREVAILING CASE TAD SCRCHAR /GET THE CHARACTER JMS I OUTPUT /PRINT THE CHARACTER JMP I SCRPRNT /RETURN TABOUT, TAD SCRCHAR /GET THE CHARACTER BACK JMS I [P6CH] /PRINT IT JMP I SCRPRNT /RETURN SCRCRLF,JMS I [CRLF] /DO A , JMP I SCRPRNT /RETURN SCRFLIP,TAD SCRCASE /GET CURRENT CASE CIA /INVERT IT TAD (140+100) /ADD SUM OF POSSIBLE VALUES CASZP2, DCA SCRCASE /**** /U **** CLA!400 JMP I SCRPRNT /RETURN PRNLFS, .-. /PRINT 'S ROUTINE JMS I [CRLF] /DO A (POSSIBLE) , TAD LINCNT /GET LINE COUNTER SZA CLA /SKIP IF IT OVERFLOWED JMP .-3 /JUMP IF NOT JMP I PRNLFS /RETURN PAGE CRLF, .-. /, ROUTINE CLA /CLEAN UP TAD COLUMN /GET CURRENT COLUMN SNA CLA /SKIP IF NEEDED JMP NOCR /ELSE FORGET IT TAD ["M&37] /GET A JMS I OUTPUT /PRINT IT NOCR, TAD L12/["J&37] /GET A JMS I OUTPUT /PRINT IT ISZ LINCNT /BUMP LINE COUNTER NOP /IN CASE IT SKIPS DCA COLUMN /CLEAR COLUMN COUNT JMP I CRLF /RETURN DEJECT, .-. /DO AN EJECT ROUTINE NPZAP2, JMS I [NEWPAGE] /**** /N **** 0000 NHDZAP, SKP /**** /H **** 0000 JMP NOHEAD /DON'T PRINT HEADER USLNZAP,JMS I [SCRIBE] /**** FILE CONTENTS TITLES **** JMS I [USCRIBE] USRMSG /GIVE THE USER BLURB JMS I [SCRIBE] /GIVE THE HDRMSG /FIXED BLURB JMS I [SCRIBE] /GIVE THE DATMSG /DATE BLURB ONEFZAP,SKP /**** ONE FILE **** 0000 JMP ONEFILE /JUMP IF ONLY ONE FILE ARGUMENT TAD FILNUMBER /GET FILE NUMBER JMS I [DECPRT] /PRINT IT TAD ("-&177) /GET "-" JMS I OUTPUT /PRINT IT ONEFILE,ISZ FILPAGE /BUMP TO NEXT PAGE TAD FILPAGE /GET PAGE NUMBER JMS I [DECPRT] /PRINT IT NOHEAD, JMS I [CRLF] /DO A , JMS I [CRLF] /DO EXTRA , TAD LRESET /RESET THE DCA LINCNT /LINES PER PAGE COUNTER DCA EJECTSW /CLEAR EJECT SWITCH JMP I DEJECT /RETURN NEWPAGE,.-. /PRINT ROUTINE TAD LINCNT /GET CURRENT COUNT TAD NPEXTRA /ADD ON EXTRA COUNT DCA LINCNT /STORE BACK DOFF, JMS I (PRNLFS) /**** **** 0000 LPZAP1, TAD [-6] /**** **** NL7777 DCA LINCNT /STASH THE COUNT TAD LSEP /GET "-" OR JMS I OUTPUT /PRINT IT ISZ LINCNT /DONE ENOUGH? JMP .-3 /NO, GO DO ANOTHER ONE LPZAP3, SKP /**** LAST **** 0000 JMP I NEWPAGE /RETURN NOW IF LAST FFWAT1, SKP /**** 0000 JMS PWAIT /WAIT FOR NEXT PAGE NOW IF USING JMS I [CRLF] /DO A , FFWAT2, JMS PWAIT /**** **** 0000 NL7775 /SETUP FOR DCA LINCNT /3 'S LPZAP4, JMS I (PRNLFS) /**** **** 0000 JMP I NEWPAGE /RETURN PWAIT, .-. /PAGE WAIT SUBROUTINE PZAP, SKP /**** NOT /P **** 0000 JMP I PWAIT /RETURN IF NOT /P NL7775 /SETUP THE DCA QUO /BEEP COUNT PWATLUP,TAD (-42) /SETUP THE DCA TEMP2 /WASTE COUNTER ISZ TEMP1 /WASTE JMP .-1 /SOME TIME ISZ TEMP2 /DONE ENOUGH? JMP .-3 /NO, GO BACK TAD ["G&37] /GET A JMS CONOUT /RING IT JMP .-1 /'TIL IT CHIMES ISZ QUO /DONE ENOUGH? JMP PWATLUP /NO, GO BACK AND DO IT ALL AGAIN INWAIT, JMS CTLCTST /GET A CHARACTER SNA /SKIP IF WE GOT SOMETHING JMP INWAIT /ELSE KEEP WAITING TAD (-"M!300) /COMPARE TO SNA CLA /SKIP IF DIFFERENT JMP I PWAIT /RETURN IF IT MATCHES TAD ["G&37] /GET A JMS CONOUT /RING IT JMP .-1 /'TIL IT CHIMES JMP INWAIT /TRY AGAIN P6CH, .-. /SIX-BIT PRINT ROUTINE SNA /? TAD [" &77] /YES, MAKE IT AND [77] /JUST SIX-BIT SNA /WAS IT 4000? JMP P6EOL /YES, PRINT , TAD [-HT] /? SNA /SKIP IF NOT JMP P6TAB /JUMP IF SO AND [77] /REMOVE EXCESS TAD [HT] /RESTORE INVERTED CHARACTER JMS I OUTPUT /PRINT IT JMP I P6CH /RETURN P6EOL, JMS I [CRLF] /DO A , JMP I P6CH /RETURN P6TAB, TAD [" &177] /GET A JMS I OUTPUT /PRINT IT TAD COLUMN /GET COLUMN COUNT AND [7] /JUST RELATIVE BITS SZA CLA /SKIP IF AT TAB STOP JMP P6TAB /GO BACK 'TIL IT IS JMP I P6CH /RETURN PAGE / P?S/8 ASCII FILE VALIDATOR. / CHECKS FOR VALID POINTERS. / CHECKS FOR VALID LINE NUMBERS. / CHECKS FOR AND DUMMY POINTERS. / CHECKS FOR VALID SEQUENCES. / TAKES SKIP RETURN IF AND ONLY IF FILE IS VALID SIX-BIT ASCII. VALASC, .-. /VALIDATE ASCII TAD I [FILBUFFER+3776]/GET FREE TEXT POINTER JMS RNGCHK /VALIDATE VALUE TAD I [FILBUFFER+3777]/GET FREE LINE NUMBER PAIR POINTER JMS RNGCHK /VALIDATE ITS VALUE ALSO TAD I [FILBUFFER+3776]/GET TEXT POINTER CIA /INVERT FOR TEST TAD I [FILBUFFER+3777]/COMPARE TO LINE NUMBER VALUE SPA CLA /SKIP IF POSSIBLE JMP I VALASC /BARF TAD I [FILBUFFER+3776]/GET TEXT POINTER AGAIN / TAD [FILBUF-FILCORE]/ADJUST FOR LOADING OFFSET DCA TEMP1 /STASH IT TAD I TEMP1 /GET WORD SZA CLA /SKIP IF ACTUALLY JMP I VALASC /BARF TAD I [FILBUFFER+3777]/GET PAIR POINTER / TAD [FILBUF-FILCORE]/ADJUST FOR LOADING OFFSET DCA TEMP1 /STASH IT TAD I TEMP1 /GET PAIR'S FREE TEXT POINTER CIA /INVERT FOR TEST TAD I [FILBUFFER+3776]/COMPARE TO ALREADY VERIFIED VALUE SZA CLA /SKIP IF THEY MATCH JMP I VALASC /BARF IF THEY DON'T ISZ TEMP1 /BUMP TO LINE NUMBER TAD I TEMP1 /GET THE DUMMY LINE NUMBER CLL IAC /SEE IF 7777 SNL CLA /SKIP IF SO JMP I VALASC /BARF IF NOT TAD I [FILBUFFER+3777]/GET DUMMY PAIR POINTER ADDRESS CIA /INVERT NOW, SAVE TIME LATER DCA PARLMT /SAVE FOR TESTING TAD [FILCORE+3774+2]/SETUP THE DCA NUMPTR /INITIAL REVERSE POINTER NUMLUP, NL7776 /\ TAD NUMPTR / >BACKUP TO PREVIOUS PAIR DCA NUMPTR // TAD NUMPTR /GET THE POINTER VALUE JMS RNGCHK /PREVENT DEVIOUS PROBLEMS! TAD NUMPTR /GET IT AGAIN TAD PARLMT /COMPARE TO LIMIT SNA /SKIP IF NOT AT END OF FILE JMP FILOK /JUMP IF SO SPA CLA /SKIP IF POSSIBLE VALUE JMP I VALASC /IMPOSSIBLE VALUE OF POINTER IN THIS FILE TAD NUMPTR /GET LATEST PAIR POINTER / TAD [FILBUF-FILCORE]/ADJUST FOR LOADING OFFSET DCA TEMP1 /SAVE ADJUSTED POINTER TAD I TEMP1 /GET THE TEXT POINTER JMS RNGCHK /VALIDATE IT TAD TEMP1 /GET THE POINTER TO TEXT POINTER IAC /BUMP TO LINE NUMBER POINTER DCA TEMP2 /SAVE FOR LATER TAD NUMPTR /GET THE POINTER AGAIN TAD (-FILCORE-3774) /IS IT THE FIRST PAIR? SNA CLA /SKIP IF NOT JMP SPCCHK /JUMP IF SO TAD I TEMP1 /GET THE TEXT POINTER CLL CIA /INVERT FOR TEST TAD LATLINE /COMPARE TO PREVIOUS TEXT POINTER SZL CLA /SKIP IF HIGHER JMP I VALASC /COMPLAIN OF NON-SEQUENCED TEXT TAD I TEMP2 /GET OUR LINE NUMBER CLL CIA /INVERT FOR TEST TAD LATNUMBER /COMPARE TO PREVIOUS LINE NUMBER SZL CLA /SKIP IF OURS IS LARGER JMP I VALASC /BARF ON OUT OF SEQUENCE NUMBERS SPECIN, TAD I TEMP1 /GET OUR TEXT POINTER CIA /INVERT IT FOR TEST TAD TXTPTR /COMPARE TO UNPACKING POINTER / TAD [FILCORE-FILBUF]/ADJUST FOR LOADING OFFSET SZA CLA /SKIP IF THEY MATCH JMP I VALASC /BARF IF EXTRA LINES IN FILE! SRCHZER,TAD I TXTPTR /GET A PAIR FROM OUR TEXT LINE SNA /? JMP I VALASC /YES, BUT IN THE WRONG PLACE! AND L7700/[7700] /JUST LEFT HALF SNA CLA /? JMP FNDZERO /YES TAD I TXTPTR /NO, GET IT AGAIN AND [77] /JUST RIGHT HALF SNA CLA /? JMP FNDZERO /YES ISZ TXTPTR /NO, BUMP TO NEXT PAIR JMP SRCHZERO /TRY AGAIN FNDZERO,ISZ TXTPTR /BUMP TO BEGINNING OF NEXT LINE TAD I TEMP1 /GET OUR TEXT POINTER DCA LATLINE /SAVE FOR NEXT ROUND OF TESTS TAD I TEMP2 /GET OUR LINE NUMBER DCA LATNUMBER /SAVE IT FOR NEXT TIME ALSO JMP NUMLUP /GO CHECK ANOTHER LINE SPCCHK, TAD I TEMP1 /GET THE TEXT POINTER TAD (-FILCORE) /IS IT THE BEGINNING? SZA CLA /SKIP IF SO JMP I VALASC /BARF TAD [FILBUFFER] /SETUP THE DCA TXTPTR /UNPACKING POINTER JMP SPECIN /CONTINUE THERE FILOK, ISZ VALASC /BUMP TO GOOD RETURN JMP I VALASC /AND CELEBRATE RNGCHK, .-. /VALID RANGE CHECK ROUTINE TAD (-FILCORE-3775) /SUBTRACT BASE CLL /CLEAR LINK FOR TEST TAD (3775) /ADD ON VALID RANGE SNL CLA /SKIP IF IN RANGE JMP I VALASC /COMPLAIN IF NOT JMP I RNGCHK /OK TO GO ON / POWERS OF EIGHT FOR OCTAL PRINT EIGHTS, -1000 /-1000 -100 /-100 -10 /-10 -1 /-1 0 /THIS ENDS THE LIST DECIMAL /POWERS OF TEN FOR DECIMAL PRINT TENS, -1000 /-1750 -100 /-144 -10 /-12 -1 /-1 0 /THIS ENDS THE LIST OCTAL /BACK TO NORMAL PAGE GETHAF, .-. /GET A HALF WORD ROUTINE TAD GETNDX /GET INDEX CLL RAR /MOVE OVER TAD GETBASE /ADD ON BASE DCA GPTEMP /STASH THE POINTER TAD I GPTEMP /GET THE PAIR SZL /LEAVE IT ALONE? JMP .+4 /YES RTR;RTR;RTR /NO, WANT LEFT HALF AND [77] /JUST SIX-BIT JMP I GETHAF /RETURN PUTHAF, .-. /PUT A HALF WORD ROUTINE AND [77] /ENSURE SIX-BIT DCA GETHAF /SAVE IT TAD PUTNDX /GET INDEX CLL RAR /MOVE OVER TAD PUTBASE /ADD ON BASE DCA GPTEMP /STASH THE POINTER TAD I GPTEMP /GET THE PAIR AND L7700/[7700] /KEEP CURRENT LEFT HALF TAD GETHAF /ADD ON NEW RIGHT HALF SZL /LEAVE IT THAT WAY? JMP .+4 /YES STL RTL;STL RTL;STL RTL /NO, MOVE OVER WITH GARBAGE DCA I GPTEMP /STORE IT BACK JMP I PUTHAF /RETURN LODCAT, .-. /LOAD A CATALOG ROUTINE AND [7] /JUST UNIT BITS CIA /INVERT TAD UNIT /COMPARE TO CURRENT UNIT SNA /SKIP IF THEY DON'T MATCH JMP I LODCAT /JUST RETURN IF THEY DO MATCH CIA /INVERT AGAIN TAD UNIT /REMOVE OLD UNIT DCA UNIT /STORE NEW UNIT TAD UNIT /GET IT BACK TAD L200/[2^100] /ADD ON READ FUNCTION DCA CATFUN /STORE IN-LINE JMS I L7640/[SYSIO] /CALL I/O ROUTINES CATADR /READ IN CATALOG CATFUN, 2^100+.-. /UNIT BITS WILL BE FILLED IN DIR /CATALOG BLOCK JMP I LODCAT /RETURN PROCFIL,.-. /PROCESS A FILE ROUTINE TAD I [SWMX] /GET /M-/X SWITCHES AND [40] /JUST /S SZA CLA /SKIP IF OFF JMP LEVSEQ /JUMP IF ON DCA DIGS /CLEAR HIGHEST DIGIT DCA DIGS+1 /CLEAR NEXT DIGIT DCA DIGS+2 /CLEAR NEXT DIGIT DCA DIGS+3 /CLEAR NEXT DIGIT TAD ["0&77] /GET INITIAL VALUE DCA DIGS+4 /STORE LOWEST DIGIT LEVSEQ, TAD [FILBEG+3775+2] /SETUP THE INITIAL DCA NUMPTR /LINE NUMBER POINTER LINLUP, NL7776 /SET BACKUP FACTOR TAD NUMPTR /POINT TO PREVIOUS PAIR DCA NUMPTR /STORE BACK TAD (PRTBUFFER) /POINT AT DCA PUTBASE /PRINT BUFFER DCA PUTNDX /CLEAR OUTPUT INDEX LINAGN, JMS I (GIVCHR) /GET A CHARACTER JMS I [PUTHAF] /OUTPUT IT ISZ PUTNDX /BUMP OUTPUT INDEX TAD LATEST /GET LATEST CHARACTER SZA CLA /? JMP LINAGN /NO, KEEP GOING JMS I [PUTLINE] /YES, OUTPUT ENTIRE LINE TAD (PRTBUFFER) /POINT AT DCA GETBASE /PRINT BUFFER DCA GETNDX /CLEAR INPUT INDEX TAD I [SWAL] /GET SWITCHES /A-/L AND L200/[200] /JUST /E SZA CLA /SKIP IF OFF JMP LINLUP /JUST GO DO ANOTHER LINE SRCHLUP,JMS I [GETHAF] /GET A CHARACTER ISZ GETNDX /BUMP INDEX SNA /? JMP LINLUP /YES, FORGET THE SEARCH TAD [-HT] /COMPARE TO SZA CLA /SKIP IF IT MATCHES JMP SRCHLUP /ELSE FORGET IT TAD (EJECTLST-1) /POINT TO DCA XR1 /SEARCH STRING SRCH2LP,TAD I XR1 /GET A SEARCH CHARACTER SNA /END OF STRING? JMP FNDEJECT /YES, WE FOUND IT! CIA /INVERT FOR TESTING DCA PAIR /SAVE IT JMS I [GETHAF] /GET NEXT CHARACTER TAD PAIR /COMPARE TO LATEST STRING CHARACTER AND [77] /JUST SIX BITS SZA CLA /SKIP IF IT MATCHES JMP SRCHLUP /ELSE START ALL OVER ISZ GETNDX /BUMP TO NEXT JMP SRCH2LP /KEEP GOING FNDEJEC,ISZ EJECTSW /INDICATE EJECT NEEDED NEXT TIME JMP LINLUP /KEEP GOING / SEQUENCE NUMBER DIGITS. DIGS, 0 /FIRST DIGIT 0 /SECOND DIGIT 0 /THIRD DIGIT 0 /FOURTH DIGIT "0&77 /FIFTH DIGIT -1 /THIS ENDS THE LIST / EJECT SEARCH STRING. EJECTLS,"E&77 /E "J&77 /J "E&77 /E "C&77 /C "T&77 /T 4000 / 0 /THIS ENDS THE LIST PAGE PUTLINE,.-. /OUTPUT A LINE ROUTINE TAD LINCNT /GET CURRENT LINE COUNT SNA CLA /SKIP IF NOT AT END OF PAGE JMP DOEJECT /JUMP IF IT IS TAD EJECTSW /EJECT OUTSTANDING? SZA CLA /SKIP IF NOT DOEJECT,JMS I [DEJECT] /DO AN EJECT NOW NL0002 /SETUP /K MASK AND I [SWAL] /GET THE /K SWITCH SZA CLA /SKIP IF OFF JMP NONUMBERS /JUMP IF ON TAD I [SWMX] /GET /M-/X SWITCHES AND [40] /JUST /S SWITCH SNA CLA /SKIP IF SET JMP TRYLINE /JUMP IF NOT DODIGS, TAD (DIGS+4) /POINT TO DCA DIGPTR /LOWEST DIGIT DIGLUP, ISZ I DIGPTR /BUMP LATEST DIGIT TAD I DIGPTR /GET THE DIGIT TAD (-":!200) /WENT TOO FAR? SZA CLA /SKIP IF SO JMP DIGSOK /JUMP IF NOT TAD ["0&77] /GET A ZERO DCA I DIGPTR /RESET THE DIGIT NL7777 /BACKUP TAD DIGPTR /TO DCA DIGPTR /PREVIOUS TAD I DIGPTR /GET PREVIOUS DIGIT SNA /SKIP IF ASCII ALREADY TAD ["0&77] /ELSE MAKE IT SO DCA I DIGPTR /STORE EITHER WAY JMP DIGLUP /KEEP GOING DIGSOK, TAD (DIGS-1) /POINT TO DCA XR1 /DIGIT STRING OUTDIG, TAD I XR1 /GET A DIGIT SPA /END OF LIST? JMP DIGDONE /YES JMS I [P6CH] /NO, PRINT IT JMP OUTDIG /KEEP GOING DIGDONE,AND [HT] /GET JMS I [P6CH] /PRINT IT JMP NONUMBERS /CONTINUE THERE TRYLINE,TAD LINESW /LINE NUMBERS VALID? SNA CLA /SKIP IF SO JMP DODIGS /ELSE USE SEQUENCE NUMBERS TAD I [SWMX] /GET /M-/X SWITCHES AND [1000] /JUST /O SZA CLA /SKIP IF OFF TAD (EIGHTS-TENS) /ELSE USE OFFSET DCA DECOFFSET /STORE IT TAD [" -"0] /MAKE IT USE DCA DECCONVERT /LEADING CHARACTERS TAD [" &177] /GET A JMS I OUTPUT /PRINT IT TAD I NUMPTR /GET LATEST LINE NUMBER JMS I [DECPRT] /PRINT IT DCA DECOFFSET /CLEAR OFFSET FOR OTHERS DCA DECCONVERT /MAKE IT DO LEADING ZEROES AGAIN TAD [HT] /GET JMS I [P6CH] /PRINT IT NONUMBE,JMS I [USCRIBE] /NOW PRINT PRTBUFFER /THE OUTPUT LINE JMS I [CRLF] /DO A , JMP I PUTLINE /RETURN / FILE NAME MESSAGE. FILBLB, TEXT " ^F^ILE ^N^AME: ^" FILBEND=. /END OF FILE NAME MESSAGE / FIXED HEADER MESSAGE. HDRMSG, " ^100+HT / TEXT "^PRINT V" /REST OF TEXT VERSION%12^66+VERSION+6060 /VERSION NUMBER "^^100+REVISION /REVISION TEXT " " /FILLER DAYBLB, TEXT "^W^HATDAY? " ;0 /DAY TEXT GOES HERE DATMSG, TEXT "DD-^M^MM-YY ^P^AGE ^" /DATE GOES HERE / USER PORTION OF HEADER MESSAGE. USRMSG, ZBLOCK BLBMAX;0 /USER MESSAGE STORED HERE PAGE PRTBUFF=. /PRINT BUFFER / COMES HERE FOR ONCE-ONLY CODE; THIS AREA AVAILABLE FOR BUFFER SPACE LATER. INITIAL,TAD I SWPTR /GET A SWITCH WORD AND I OPTPTR /AND AGAINST OPTION WORD CIA /INVERT CLL RAL /*2 TAD I SWPTR /ADD ON SWITCH WORD TAD I OPTPTR /ADD ON OPTION WORD DCA I SWPTR /STORE XOR-ED VALUE ISZ SWPTR /BUMP TO NEXT ISZ OPTPTR /BUMP TO NEXT ISZ XORCNT /DONE ALL YET? JMP INITIAL /NO, KEEP GOING / CHECK FOR CONSOLE OVERLAY. TAD I L7600/[SBOOT] /GET BOOTSTRAP INSTRUCTION TAD (-JMSSYSIO) /COMPARE TO POSSIBLE VALUE SNA CLA /SKIP IF DIFFERENT JMP CHKCOVRLAY /JUMP IF IT MATCHES ISZ CHKKRS /TURN "KRSIOT" ISZ CHKKRS /INTO "KRBIOT" DCA CHKKCC /DESTROY "KCCIOT" CHKCOVR,NL0002 /SET "C" BIT MASK AND I [SCRSIZE] /GET THE "C" BIT SNA CLA /SKIP IF SET JMP I (OUTREMOVE) /JUMP IF NOT TAD I [SCRSIZE] /GET CORE SIZE WORD AGAIN RTR;RAR /MOVE OVER AND AND (70) /ISOLATE MCS BITS TAD (CDF 10) /FORM "CDF MCS+10" DCA CONCDF /STORE IN-LINE TAD CONCDF /GET IT BACK IAC /TAD (CIF-CDF) /FORM "CIF MCS+10" DCA P7TSF /STORE OVER "TSFIOT" TAD P7JMP /GET "JMP I P7OUT" DCA P7TLS /STORE OVER "TLSIOT" TAD (JMS OUTCON) /GET OUTPUT CALL DCA P7JMP /STORE OVER "JMP I P7OUT" TAD P7TSF /GET "CIF MCS+10" DCA CONTSF /STORE OVER "TSFIOT" TAD CONJMP /GET "JMP I CONOUT" DCA CONTLS /STORE OVER "TLSIOT" TAD (JMS OUTCON) /GET OUTPUT CALL DCA CONJMP /STORE OVER "JMP I CONOUT" TAD P7TSF /GET "CIF MCS+10" DCA CHKKSF /STORE OVER "KSFIOT" TAD CHKJMP /GET "JMP I CTLCTST" DCA CHKKRS /STORE OVER "KRSIOT" OR "KRBIOT" TAD (JMS INCON) /GET INPUT CALL DCA CHKJMP /STORE OVER "JMP I CTLCTST" DCA CHKKCC /DESTROY "KCCIOT" CONCDF, 0000 /WILL BE CDF MCS+10 TAD I (LPMODE) /GET BUFFERING MODE CDF 00 /BACK TO OUR FIELD SPA SNA CLA /SKIP IF NO BUFFERING DCA I (BUFZP1) /ENABLE BUFFERING CHECK IN /N CODE TAD P7TSF /GET "CIF MCS+10" JMP I (CONMORE) /CONTINUE THERE DIVIDE, .-. /DIVIDE ROUTINE DCA REM /SAVE IN REMAINDER DCA QUO /CLEAR QUOTIENT TAD REM /GET IT BACK STL CIA /INVERT SKP /DON'T FIRST TIME DVLOOP, ISZ QUO /BUMP UP QUOTIENT TAD I DIVIDE /ADD ON ARGUMENT SNA SZL /UNDERFLOW? JMP DVLOOP /NO, KEEP GOING CIA /YES, INVERT IT BACK TAD I DIVIDE /RESTORE LOST VALUE DCA REM /SAVE AS REMAINDER TAD QUO /GET THE QUOTIENT ISZ DIVIDE /BUMP PAST ARGUMENT JMP I DIVIDE /RETURN OPTPTR, XORSWS /OPTION WORD POINTER SWPTR, SWAL /PASSED SWITCHES POINTER XORCNT, -3 /OPTION WORD COUNTER NOFLMSG,TEXT "%^N^O ^I^NPUT ^F^ILES!^" PAGE CONMORE,/TAD P7TSF /GET "CIF MCS+10" DCA LPCHK /STORE OVER "LSFIOT" TAD LPJMP /GET "JMP LPTIME" DCA LPRNT /STORE OVER "LLSIOT" TAD (JMS OUTLPT) /GET LPT: OUTPUT CALL DCA LPJMP /STORE OVER "JMP LPTIME" TAD LPTJMS/(JMS LPWAIT) /GET LPT: TEST CALL DCA OUTINIT /MAKE IT TEST FOR LOGICAL LPT: CORRECTLY DCA LOGZAP /ENABLE LOGICAL LPT: ZAPS OUTREMO,TAD I (SOUTFLS) /GET OUTPUT FILE COUNT TAD [SFILES] /POINT TO FIRST INPUT FILE DCA FILPTR /STORE FILE POINTER TAD I [SWMX] /GET SWITCHES /M-/X LPTEMP, AND [10] /JUST /U BIT LPTMOUT,SNA CLA /SKIP IF SET JMP TESTN /JUMP IF NOT TAD L7600/[CLA!400] /GET CLA INSTRUCTION DCA I (CASZP1) /PREVENT LOWER-CASE TAD L7600/[CLA!400] /GET CLA INSTRUCTION DCA I (CASZP2) /PREVENT LOWER-CASE TESTN, NL2000 /SETUP /N MASK AND I [SWMX] /GET /N BIT SNA CLA /SKIP IF SET JMP TSTFILES /JUMP IF NOT DCA I (NPZAP1) /PREVENT LAST PAGINATION DCA I (NPZAP2) /PREVENT EVERY OTHER PAGINATION TAD L7600/[CLA!400] /PREVENT OPENING DCA NPZAP3 / ON LPT: BUFZP1, SKP /**** CONSOLE: AND LOG-LPT: BUFFERING **** 0000 DCA BUFZP2 /ENABLE LOG-LPT: ZAP TSTFILE,TAD I FILPTR /GET FIRST INPUT FILE ARGUMENT SNA CLA /SKIP IF VIABLE JMP NOFILES /JUMP IF NOT TAD I [SWMX] /GET SWITCHES /M-/X AND [20] /JUST /T SZA CLA /SKIP IF NOT SET JMP LPFAIL /DON'T TEST FOR LPT: LNL7777,NL7777 /SET SPECIAL VALUE OUTINIT,LLSIOT /**** CONSOLE: **** JMS LPWAIT CLA /CLEAN UP TAD [" &177] /GET A LPTJMS, JMS LPWAIT /TRY TO PRINT IT TAD [" &177] /GET A JMS LPWAIT /TRY TO PRINT IT TAD ["M&37] /GET A JMS LPWAIT /TRY TO PRINT IT DCA LPTMZAP /WAIT FROM NOW ON TAD [" &177] /GET A JMS LPWAIT /PRINT IT TAD ["M&37] /GET A JMS LPWAIT /PRINT IT TAD L12/["J&37] /GET A JMS LPWAIT /PRINT IT TAD ("L&37) /GET A NPZAP3, JMS LPWAIT /**** /N **** CLA!400 JMS ZAPFF /DO ZAPS LOGZAP, SKP /**** CONSOLE: **** 0000 JMP LLZAPS /DO LOGICAL LPT: ZAPS TAD LPCHK/(LSFIOT) /GET "LSFIOT" DCA P7TSF /STORE OVER "TSFIOT" TAD LPRNT/(LLSIOT) /GET "LLSIOT" DCA P7TLS /STORE OVER "TLSIOT" LPFAIL, TAD I [SWAL] /GET SWITCHES /A-/L AND [100] /JUST /F SZA CLA /SKIP IF OFF JMS ZAPFF /MAKE ZAPS REGARDLESS OF OUTPUT DEVICE JMP I (GETDATE) /CONTINUE THERE LLZAPS, TAD (JMS OUTLPT) /GET LPT: OUTPUT CALL DCA P7JMP /STORE OVER "JMS OUTCON" BUFZP2, SKP /**** LOG-LPT: AND BUFFERING AND /N **** 0000 DCA I (BUFZP3) /ENABLE OUTPUT AT END OF PRINTOUT JMP LPFAIL /CONTINUE THERE LPWAIT, .-. /LPT: TIME-OUT ROUTINE DCA LPTEMP /SAVE PASSED VALUE LPAGN, TAD LPTEMP /GET IT BACK LPCHK, LSFIOT /**** CONSOLE: **** CIF MCS+10 LPJMP, JMP LPTIME /**** CONSOLE: **** JMS OUTLPT LPRNT, LLSIOT /**** CONSOLE: **** JMP LPTIME TAD L7700/[7700] /RESET THE DCA LPTMOUT /TIME-OUT COUNTER JMP I LPWAIT /RETURN LPTIME, ISZ I [GETHAF] /WASTE JMP LPTIME /SOME TIME CLA /CLEAN UP LPTMZAP,ISZ LPTMOUT /**** ZAPPED **** 0000 JMP LPAGN /TRY AGAIN JMP LPFAIL /GIVE UP AND JUST USE CONSOLE ZAPFF, .-. /-ORIENTED ZAP ROUTINE DCA I (DOFF) /PREVENT 'S AT TRAILING END OF PAGE TAD LNL7777/(NL7777)/SETUP FOR DCA I (LPZAP1) /ONE SEPARATOR DCA I (LPZAP2) /NO EXTRA CHARACTERS AFTER LAST DCA I (LPZAP4) /PREVENT EXTRA 'S AFTER DCA I (FFWAT1) /ENABLE PAGE WAIT DCA I (FFWAT2) /PREVENT NORMAL PAGE WAIT TAD ("L&37) /GET A DCA LSEP /USE INSTEAD OF "-" AS PAGE SEPARATOR JMP I ZAPFF /RETURN NOFILES,JMS I [CSCRIBE] /TELL THEM NOFLMSG /THEY GOOFED PAGE BSGROUP,BSGRP /BASE GROUP VALUE FOR DATE WORD GETDATE,TAD I (SDATE) /GET SYSTEM DATE WORD JMS I (DIVIDE);564 /DIVIDE BY 372 YEAR, DCA YEAR /SAVE QUOTIENT AS YEAR TAD REM /GET DAYS LEFT IN YEAR JMS I (DIVIDE);37 /DIVIDE BY 31 MONTH, DCA MONTH /SAVE MONTH (ORIGIN ZERO) NL0001 /MAKE ORIGIN ONE TAD REM /GET DAY OF THE MONTH DAY, DCA DAY /SAVE IT TAD YEAR /GET THE YEAR TAD (3) /ROUND UP FOR LEAP YEARS CLL RAR /DIVIDE CLL RAR /BY FOUR LPYRCT, DCA LPYRCT /SAVE AS EXTRA LEAP DAYS COUNT TAD YEAR /GET THE YEAR AGAIN AND (3) /JUST LEAP BITS SNA CLA /SKIP IF NOT A LEAP YEAR ISZ FEBENT /BUMP FEBRUARY IF IT IS TAD MONTH /GET THE MONTH CMA /INVERT FOR COUNTING MONCNT, DCA MONCNT /SAVE IT JMP .+3 /JUMP INTO IT TAD I ENTPTR /GET A PREVIOUS MONTH'S COUNT ISZ ENTPTR /BUMP TO NEXT ISZ MONCNT /DONE ENOUGH MONTHS? JMP .-3 /NO, GO DO ANOTHER ONE TAD DAY /ADD ON DAY TAD YEAR /ADD ON YEAR TAD LPYRCT /ADD ON EXTRA LEAP DAYS TAD BSGROUP /\ TAD BSGROUP / >ADD ON BASE INFLUENCE TAD BSGROUP // JMS I (DIVIDE);7 /DIVIDE BY 7 TO GET DAY OF THE WEEK CLA /THROW QUOTIENT AWAY TAD REM /GET THE REMAINDER CLL RAL /*2 TAD REM /*3 RAL /*6 TAD (DAYS-1) /POINT TO PROPER DAY BLURB DCA XR1 /STASH THE POINTER TAD (DAYBLB-1) /POINT TO DCA XR2 /DAY STORAGE TAD [-6] /SETUP THE CNT, DCA CNT /MOVE COUNTER TAD I XR1 /GET A WORD DCA I XR2 /PUT A WORD ISZ CNT /DONE YET? JMP .-3 /NO, GO BACK TAD (DATMSG-1) /POINT TO DCA XR2 /DATE MESSAGE TAD DAY /GET DAY OF THE MONTH JMS I (DIVIDE);12 /DIVIDE BY 10 TO GET TEN'S DIGIT TAD ["0&77] /MAKE IT ASCII CLL RTL;RTL;RTL /MOVE UP TAD REM /ADD ON UNIT'S DIGIT TAD ["0&77] /MAKE IT ASCII ALSO DCA I XR2 /STORE INTO THE MESSAGE ISZ XR2 /BUMP PAST STATIC WORD TAD MONTH /GET THE MONTH CLL RAL /*2 FOR DOUBLE-WORDS TAD (MONLST-1) /ADD ON LIST POINTER DCA XR1 /STASH IT TAD I XR1 /GET A MONTH PAIR DCA I XR2 /STORE INTO MESSAGE TAD I XR1 /GET THE OTHER PAIR DCA I XR2 /STORE INTO MESSAGE TAD BSGROUP /GET GROUP CLL RTL;RAL /*8 TAD YEAR /ADD ON RELATIVE YEAR TAD (74) /ADD ON (19)60 JMS I (DIVIDE);144 /DIVIDE BY 100 CLA /THROW AWAY QUOTIENT TAD REM /GET THE REMAINDER 60-99 OR 00-59 JMS I (DIVIDE);12 /DIVIDE BY 10 TO GET THE TEN'S DIGIT TAD ("-^100+"0-200) /GET "-" AND MAKE IT ASCII DCA I XR2 /STORE INTO MESSAGE TAD REM /GET THE UNIT'S DIGIT CLL RTL;RTL;RTL /MOVE UP TAD ("0^100+" -200) /MAKE IT ASCII DCA I XR2 /STORE INTO MESSAGE TAD I [SWAL] /GET SWITCHES /A-/L AND [20] /JUST /H BIT SZA CLA /SKIP IF NOT SET DCA I (NHDZAP) /PREVENT HEADER BLURB IF SET TAD I [SWMX] /GET SWITCHES /M-/X AND (400) /JUST /P BIT SNA CLA /SKIP IF SET DCA I (PZAP) /PREVENT PAUSES IF NOT SET JMP I (MORINIT) /KEEP GOING ENTPTR, JANENT /POINTER TO MONTH LENGTH TABLES DECIMAL /MAKE IT EASIER JANENT, 31 /31 DAYS IN JANUARY FEBENT, 28 /29 IN LEAP YEAR! 31 /31 DAYS IN MARCH 30 /30 DAYS IN APRIL 31 /31 DAYS IN MAY 30 /30 DAYS IN JUNE 31 /31 DAYS IN JULY 31 /31 DAYS IN AUGUST 30 /30 DAYS IN SEPTEMBER 31 /31 DAYS IN OCTOBER 30 /30 DAYS IN NOVEMBER / 31 /31 DAYS IN DECEMBER OCTAL /BACK TO NORMAL PAGE MORINIT,TAD FILPTR /POINT TO SECOND FILE ARGUMENT DCA XR1 /STASH THE POINTER TAD I XR1 /GET THE SECOND FILE ARGUMENT SNA CLA /SKIP IF PRESENT DCA I (ONEFZAP) /ELSE DO ONE FILE VERSION TAD I [SWAL] /GET /A-/L SWITCHES AND L200/[200] /JUST /E BIT SZA CLA /SKIP IF NOT SET ISZ LRESET /CHANGE DEFAULT RESET VALUE TO 55 LINES/PAGE NL0001 /SET /L MASK AND I [SWAL] /GET /L BIT SNA CLA /SKIP IF SET JMP SETLINCNT /JUMP IF NOT TAD I (SPARM) /GET EQUALS PARAMETER TAD (-74-1) /SUBTRACT UPPER LIMIT CLL /CLEAR LINK FOR TEST TAD (74) /ADD ON RANGE SNL /SKIP IF IN RANGE JMP SETLINCNT /JUMP IF NOT CMA /NOW HAVE -(EQUALS PARAMETER) DCA LRESET /STORE RESET VALUE SETLINC,CLA /CLEAN UP TAD LRESET /GET RESET VALUE TAD (74) /SUBTRACT FROM 60 CIA /WANT NEGATIVE FORM DCA NPEXTRA /STORE EXTRA COUNT (-5 IF 55 LINES/PAGE) TAD NPEXTRA /GET EXTRA COUNT CIA /WANT POSITIVE FORM TAD [-4] /ADD ON INITIAL PARTIAL EJECT COUNT DCA LINCNT /STORE INITIAL EJECT COUNT JMP I (NXTFILE) /GO START IT UP / DAYS TEXT LIST. DAYS, TEXT "^T^HURSDAY " /THURSDAY TEXT "^F^RIDAY ";0 /FRIDAY TEXT "^S^ATURDAY " /SATURDAY TEXT "^S^UNDAY ";0 /SUNDAY TEXT "^M^ONDAY ";0 /MONDAY TEXT "^T^UESDAY ";0 /TUESDAY TEXT "^W^EDNESDAY " /WEDNESDAY / MONTHS TEXT LIST. MONLST, TEXT "J^AN" /JANUARY TEXT "F^EB" /FEBRUARY TEXT "M^AR" /MARCH TEXT "A^PR" /APRIL TEXT "M^AY" /MAY TEXT "J^UN" /JUNE TEXT "J^UL" /JULY TEXT "A^UG" /AUGUST TEXT "S^EP" /SEPTEMBER TEXT "O^CT" /OCTOBER TEXT "N^OV" /NOVEMBER TEXT "D^EC" /DECEMBER PAGE / HERE COME THE LITERALS! $ /THAT'S ALL FOLK!