Directory of image this file is from
This file as a plain text file
/ LISTING PROGRAM FOR OS/8 / WRITTEN BY: / CLYDE G. ROBY, JR. / DEPARTMENT OF MEDICINE / WEST VIRGINIA UNIVERSITY / MORGANTOWN, WEST VIRGINIA / OCTOBER, 1970 / MODIFIED BY HAROLD L. PEARSON, JR. / APRIL 7, 1971 / AUGUST 1, 1972 / DEPT. OF SURGERY / MODIFIED BY CGR 4/9/71 / MODIFIED BY CGR 1/21/74 (VERSION 2) / ADDED IN LARGE LETTERS / CLEANED UP PAGE BREAKS / MODIFIED BY CGR 4/3/74 (VERSION 3) / CAPABILITY FOR MULTIPLE COPIES (=N OPTION) / MODIFIED BY CGR 5/15/74 (V4) / PAGE BREAK ACROSS ENTIRE PAGE IF TTY VERSION="4 /CURRENT VERSION OF LIST FIXMRI INC= 2000 /ISZ WHEN NOT EXPECTED TO SKIP FIXTAB *20 PAGEB, 0 /0 TO TYPE OUT PAGE BREAK ENDQ, 0 /END OF INPUT QUESTION LINE IF NON-ZERO TITLEQ, 0 /0 IF TO PRINT OUT TITLE CRSWIT, 7777 /0 IF NOT TO PRINT CR OPTWD1, 0 /1ST OPTION WORD FROM CD OPTWD2, 0 /2ND OPTION WORD FROM CD DECIMAL MARTP1= 2 /# LINES FROM TOP OF PAGE TO TITLE MARTP2= 3 /# LINES FROM TITLE LINE TO BODY PAGSIZ= 66 /# LINES PER PAGE MARBOT= 5 /# LINES FROM END OF BODY TO BOTTOM OF PAGE BODY= PAGSIZ-MARTP1-MARTP2-MARBOT TP1, -MARTP1 TP2, -MARTP2 BDY, -BODY BOT, -MARBOT OCTAL LINSIZ, 0 COUNT, 0 TEMP, 0 NUMBER, 0 NUM1, 0 CTR, 0 UASCII, 0 TOPSW, 0 PAGEN, 0 PAGEP, 0 POINT, 0 CHARCT, 0 LINECT, 0 CHAR, 0 NSPACE, 0 ODNUM, 0 LZERO, 0 DIGCTR, 0 DIGIT, 0 OCTEMP, 0 LSWIT, 0 /1 IF NO LARGE LETTERS LEFTAB, 0 /INITIAL LEFT MARGIN NCOPY, 0 /NO. OF COPIES (=N OPTION) DIGTAB, -1750 -144 -12 GET= JMS I .; INPUT PUT= JMS I .; OUTPUT TYPE= JMS I .; TYPEIT PUTC= JMS I .; XPUTC TCRLF= JMS . 0 TAD [215] TYPE TAD [212] TYPE JMP I .-5 DEVCHK, 0 /CHECK OUTPUT DEVICE FOR TTY: CLA IAC DCA TTYSWT /SET FOR NON-TTY: TAD M81 DCA LINSIZ CDF 10 TAD I [7600] AND C17 TAD PDCBM1 DCA TEMP TAD I TEMP CDF 00 SZA CLA JMP I DEVCHK DCA TTYSWT /CLEAR FOR TTY: JMP I DEVCHK C17, 17 PDCBM1, 7760-1 TTYSWT, 0 /=0 FOR TTY: M73, -111 M81, -121 GETIT= JMS . 0 CIF 10 JMS I (XXGET) JMP I .-3 PUTIT= JMS . 0 CIF 10 JMS I (XXPUT) JMP I .-3 CLOSE= JMS . 0 CIF 10 JMS I (XXCLOSE) JMP I .-3 PAGE
/ LIST STARTS HERE AT 00200 JMS WHOQ /OUTPUT CURRENT VERSION BEGIN, CLA CLL TAD (-MARTP1 DCA TP1 TAD (-MARTP2 DCA TP2 TAD (-BODY DCA BDY TAD (-MARBOT DCA BOT JMS SETUPL /CALL COMMAND DECODER AND SET UP I/O JMS DEVCHK /SET BREAK OPTIONS FOR DEVICE TYPE CDF 10 TAD I (7643) DCA OPTWD1 /SAVE FIRST OPTION WORD TAD I (7644) DCA OPTWD2 /SAVE SECOND OPTION WORD TAD I (7646) /=N OPTION SNA IAC /IF ZERO, ASSUME 1 COPY CIA DCA NCOPY /NO. OF COPIES CDF 00 TAD OPTWD2 /LOOK FOR /X OPTION SWITCH CLL RAR /PUT IT IN LINK BIT SNL CLA /IS THERE A /X ? JMP BEGIN2 /NO TAD OPTWD1 /YES, SET THE /A SWITCH, CLL RAL /WHICH ALSO SETS /N SWITCH STL RAR DCA OPTWD1 BEGIN2, TAD OPTWD1 /LOOK FOR OPTION CHAR "A" SMA CLA JMP .+5 /NOT "A" TAD OPTWD2 /IF "A", THEN RTL /GET OPTION CHAR "N" TO LINK STL RTR /SET "N", PUT IT BACK DCA OPTWD2 STL RTR /SET PAGEB IF /B AND OPTWD1 DCA PAGEB /IF /B, DO NOT TYPE PAGE BREAK TAD OPTWD2 /CHECK FOR "M" TO SET MARGINS SPA CLA /FOR ADH LIST JMS ADHSET TAD (PAGTAB-1) DCA 10 TAD (-30) DCA COUNT TAD OPTWD2 AND (400) /LOOK FOR OPTION CHAR "P" SZA CLA JMP PPAGES /IF /P, ASK FOR PAGES TO PRINT CLA IAC DCA I 10 /SET UP PAGE TABLE TO PRINT ALL STL CLA RTR /2000 TO ACC DCA I 10 DCA I 10 /0 TO END THE TABLE JMP OPTV /GO CHECK FOR /V PPAGES, JMS GETMESS /ASK FOR PARTIAL PAGES ENTPAG /TYPE OUT THIS MESSAGE FIRST TAD [TITLEM-1] DCA 10 TAD (PAGTAB-1) DCA 11 DCA ENDQ /NOT END OF LINE YET PPAGE0, DCA NUM1 /NOT AN A-B TYPE NXTNUM, JMS ASCBIN /CONVERT ASCII TO BINARY SZA JMP PPAGE1 STA DCA ENDQ /END OF LINE JMP PPAGE2 /GET LAST PAGE OR PAGES PPAGE1, TAD (-255) /IS IT A MINUS SIGN? SZA CLA JMP PPAGE2 /NOT MINUS TAD NUMBER /A MINUS, SET UP FOR CONSECUTIVE PAGES DCA NUM1 JMP NXTNUM PPAGE2, TAD NUM1 /CHECK FOR CONSECUTIVE SNA JMP SET1 /NO, JUST SET 1 PAGE CIA /CONSECUTIVE FROM NUM1 TO NUMBER TAD NUMBER SPA CLA JMP PPAGES /ASK AGAIN, BAD ARGS TAD NUM1 PPAGE3, DCA I 11 /FIRST PAGE OF CONSECUTIVE TAD NUMBER DCA I 11 /SECOND PAGE OF CONSECUTIVE ISZ COUNT /PAGE TABLE FULL? SKP JMP PPAGE4 /YES, PREPARE TO CHECK /V TAD ENDQ /END OF INPUT LINE? SNA CLA JMP PPAGE0 /NOT END OF LINE, CHECK FOR MORE PAGES PPAGE4, DCA I 11 /0 ENDS THE TABLE JMP OPTV /CHECK OPTION "V" SET1, TAD NUMBER /SET 1 PAGE, USE NUMBER BOTH TIMES JMP PPAGE3 BREAK, 0 TAD [215] PUT TAD [-106] DCA COUNT TAD ("-) /OUTPUT 6 "-" PUT ISZ COUNT JMP .-3 TAD [215] /THEN A CARRIAGE RETURN PUT JMP I BREAK PAGE
OPTV, TAD OPTWD2 AND (4) /LOOK FOR OPTION CHAR "V" SZA CLA JMP OPTVT /YES, SET UP VARIABLE TABS TAD OPTWD1 AND (100) /NO, LOOK FOR OPTION CHAR "F" SZA CLA JMP OPTF /YES, SET UP FIXED TABS TAD (TABTAB) /NO, SET UP FIXED TABS AT 8 COLUMNS DCA POINT TAD (-204) /132 DECIMAL DCA COUNT STA DCA I POINT /START IN COLUMN 1 STDTAB, TAD [-10] DCA NUMBER /SET TABS EVERY 8 COLUMNS TLOOP, TAD NUMBER TAD I POINT INC POINT DCA I POINT /SAVE NEXT TAB POSITION ISZ COUNT JMP TLOOP JMP OPTT /GO LOOK FOR "T" OPTF, JMS GETMESS /GET INPUT LINE FOR FIXED TABS ENTABF /MESSAGE TO PRINT TAD [TITLEM-1] DCA 10 TAD (TABTAB) DCA POINT /SET UP POINTER AND COUNTER TAD (-204) DCA COUNT STA DCA I POINT JMS ASCBIN /GET FIXED TAB NUMBER CLA /DON'T CARE WHAT ENDED IT TAD NUMBER CIA JMP STDTAB+1 /GO FILL TABLE OPTVT, JMS GETMESS /GET INPUT LINE FOR TABS ENTABV /MESSAGE TO PRINT OUT TAD [TITLEM-1] DCA 10 TAD (TABTAB) DCA POINT TAD (-204) /132 DECIMAL DCA COUNT /DO NOT OVERFLOW TABLE DCA ENDQ /NOT END OF LINE YET STA DCA I POINT /SAVE TAB POSITION GETTAB, JMS ASCBIN /GET A TAB POSITION DCA ENDQ /END OF LINE ENCOUNTERED TAD I POINT CIA TAD NUMBER SPA JMP OPTV /ERROR IN INPUT LINE SZA CLA INC POINT /NOT EQUAL TO LAST TAB TAD NUMBER CIA DCA I POINT /SAVE TAB IN TABLE ISZ COUNT /ALL TAB POSITIONS FILLED? SKP JMP OPTT /YES, GET OPTION "T" TAD ENDQ SZA CLA JMP GETTAB /GET NEXT TAB JMP STDTAB /GO FILL REST OF TABLE OPTT, DCA LEFTAB /INIT LEFT TAB TO 0 TAD OPTWD2 /LOOK FOR /T AND (20) SNA CLA JMP OPTL /NO /T, CHECK /L OPTION JMS GETMESS /GET THE TAB ENTABT /USE THIS MESSAGE TAD [TITLEM-1] /FROM TITLE BUFFER DCA 10 JMS ASCBIN /GET THE NUMBER CLA /IGNORE CHAR THAT ENDED IT TAD NUMBER DCA LEFTAB /INITIALIZE LEFT MARGIN TAB OPTL, CLA IAC AND OPTWD1 /IS /L OPTION GIVEN? DCA LSWIT /IF 1, NO LARGE LETTERS TAD TTYSWT SZA CLA /OUTPUT TO TELETYPE? JMP OPTN /NO CLA IAC /YES, NO LARGE LETTERS DCA LSWIT OPTN, STL RTR /TEST FOR /N AND OPTWD2 /LOOK FOR OPTION CHAR "N" DCA TITLEQ /0 IF TO PRINT TITLE TAD TITLEQ SZA CLA JMP START /IF /N, DO NOT ASK FOR TITLE JMS GETMESS /ASK FOR TITLE ENTITL /USE THIS MESSAGE JMP START /GO START MAIN PROGRAM / OUTPUT LINE FEEDS FROM "LARGE" SUBRS LFOUT, 0 DCA LFOCTR /SAVE NO. OF LINE FEEDS TO OUTPUT LFOUT1, TAD [212] PUTC ISZ LFOCTR JMP LFOUT1 JMP I LFOUT LFOCTR, 0 PAGE
/ SUBROUTINE TO OUTPUT CHARS / CHECK FOR SPECIAL CHARACTERS AND SPEED UP THE OUTPUT XPUTC, 0 DCA UASCII /SAVE ASCII CHAR TAD TOPSW /MUST WE DO TOP OF PAGE BREAK? SZA CLA XPUTC1, JMS TBREAK /YES, GO DO IT TAD UASCII /GET ASCII CHAR BACK TAD [-212] SNA JMP LFEED /LINE FEED TAD [212-215] SNA JMP CARRET /CARRIAGE RETURN TAD [215-240] SNA JMP SPACE /SPACES TAD [240-211] SNA JMP OUTTAB /TAB TAD [211-214] SNA CLA JMP FFEED /FORM FEED TAD NSPACE /ANY SPACES YET? SNA JMP TYPOUT /NO, GO TYPE OUT CHAR CIA DCA NSPACE /YES, MAKE A COUNTER TAD [" ] PUT ISZ NSPACE /OUTPUT N SPACES JMP .-3 TYPOUT, STA DCA CRSWIT /PRINT CARRIAGE RETURN TAD UASCII /OUTPUT ASCII CHAR PUT JMS LCHECK /CHECK LINE OVERFLOW XPUTCR, DCA NSPACE /NO SPACES JMP I XPUTC LFEED, TAD [212] /OUTPUT A LINE FEED PUT ISZ LINECT /AT BOTTOM OF PAGE JMP LFEED3 TAD PAGEN SPA SNA CLA /GET NEXT CHAR ON PAGE? JMP LFEED4 /NO GET TAD [-214] /CHAR AFTER LINE FEED A FORM FEED? SNA JMP FFEED /YES, GO TO FORM FEED ROUTINE TAD [214] /NO, RESTORE CHAR TO ACC DCA UASCII JMS BBREAK /OUTPUT PAGE BREAK TAD OPTWD1 AND [10] /LOOK FOR OPTION CHAR "I" SZA CLA INC PAGEN /IF /I, INCREMENT PAGE# JMP XPUTC1 /GO OUTPUT TITLE AND CHECK CHAR LFEED4, JMS BBREAK /DO BOTTOM OF PAGE BREAK LFEED3, CLA IAC DCA CHARCT /INITIALIZE CHAR COUNTER TO 1 TAD (TABTAB) DCA POINT /TAB TABLE POINTER TAD OPTWD2 AND (20) /CHECK FOR OPTION /T SNA CLA JMP XPUTCR /NO SPACES EITHER TAD PAGEN /OUTPUTTING LARGE LETTERS? SPA SNA CLA JMP XPUTCR /NO, NO LEADING SPACES TAD LEFTAB /YES, /T SPECIFIED DCA NSPACE /USE AS LEFT MARGIN JMP I XPUTC /RETURN TO CALLER FFEED1, TAD TOPSW /AT TOP OF PAGE? SZA CLA JMP LFEED3 /YES, RESET SOM E PARMS DCA PAGEP /RESET PARTIAL PAGE# TO 0 JMS BBREAK /OUTPUT BOTTOM OF PAGE BREAK INC PAGEN /INCREMENT PAGE# NOP STA DCA TOPSW /MUST OUTPUT TOP OF PAGE BREAK DCA CRSWIT JMP LFEED3 CARRET, ISZ CRSWIT /OUTPUT THE CARRIAGE RETURN? JMP LFEED3 /NO, GO START NEW LINE TAD [215] /YES, OUTPUT IT PUT JMP LFEED3 SPACE, INC NSPACE /INCREMENT NO. OF SPACES JMS LCHECK /CHECK LINE OVERFLOW JMP I XPUTC INCTAB, CLA INC POINT /POINT TO NEXT TAB POSITION OUTTAB, TAD CHARCT TAD I POINT SMA JMP INCTAB /NOT YET TO TAB POSITION DCA COUNT /SAVE COUNT TO TAB POSITION INC NSPACE /"OUTPUT" A SPACE JMS LCHECK /CHECK LINE OVERFLOW ISZ COUNT JMP .-3 JMP I XPUTC / SUBROUTINE TO BOTTOM OF PAGE BREAK BBREAK, 0 TAD PAGEB /OUTPUT "BOTTOM OF PAGE" BREAK? TAD TTYSWT SZA CLA JMP PUTFF /NO, JUST OUTPUT A FORM FEED TAD LINECT JMS PUTLF /GO TO BOTTOM OF PAGE TAD BOT JMS PUTLF /OUTPUT "BOT" LINE FEEDS JMS BREAK /OUTPUT 6 "-" PUTFF, TAD [214] /OUTPUT FORM FEED PUT DCA LINECT /CLEAR LINECT JMP I BBREAK PAGE
GETMESS, 0 CLA CLL TAD (TYPE) DCA OUTIT /OUTPUT TO TELETYPE IN SUBR. "TYPMESS" TCRLF TAD I GETMESS INC GETMESS DCA .+2 JMS TYPMESS /OUTPUT THE MESSAGE TO USER 0 TAD (TITLEM) DCA POINT /POINT TO CURRENT CHAR POISITION DCA I POINT TAD (-77) DCA COUNT /NO. OF CHARS IN BUFFER DCA RUBFLG /NO RUBOUT YET TITLIN, JMS KBDIN /GET A KEYBOARD CHAR TAD (-377) SNA JMP RUBOUT /RUBOUT, DELETE ONE CHAR TAD (377-215) SNA JMP ENDTIT /CARRIAGE RETURN, END THE TITLE TAD (215-212) SNA JMP ECHOIT /LINE FEED, ECHO THE TITLE TAD (212-225) SNA JMP CTRLU /CTRL/U, DELETE ENTIRE LINE TAD (225) /REGENERATE THE CHAR DCA I POINT TAD RUBFLG /PROCESSING A RUBOUT? SNA CLA JMP TITL2 /NO TAD ("\) /YES, FIRST OUTPUT A BACKSLASH TYPE DCA RUBFLG /NO RUBOUTS NOW TITL2, TAD I POINT TYPE INC POINT /INCREMENT POINTER FOR NEXT CHAR DCA I POINT /A ZERO INDICATES EOM ISZ COUNT /IS BUFFER FULL? JMP TITLIN /NO, GET NEXT CHAR ENDTIT, TCRLF TAD (PUT) /RESET FOR SYSTEM PUT DCA OUTIT JMP I GETMESS CTRLU, TAD ("^) /ECHO "^U" TYPE TAD ("U) TYPE JMP GETMESS+1 /GET NEW LINE TYPEIT, 0 TLS TSF JMP .-1 TCF CLA CLL JMP I TYPEIT RUBOUT, TAD POINT TAD (-TITLEM) /AT START OF BUFFER? SNA CLA JMP TITLIN /YES, DO NOT ECHO TAD RUBFLG /FIRST RUBOUT? SZA CLA JMP .+3 /NO TAD ("\) /YES, ECHO A BACKSLASH TYPE STA DCA RUBFLG /NOW PROCESSING A RUBOUT STA TAD POINT DCA POINT /DECREMENT BUFFER POINTER BY ONE TAD I POINT /ECHO CHAR JUST DELETED TYPE DCA I POINT /ZERO TO INDICATE EOM STA TAD COUNT DCA COUNT /DECREMENT COUNTER, TOO JMP TITLIN /GET CHARS FOR TITLE RUBFLG, 0 ECHOIT, TCRLF JMS TYPMESS TITLEM JMP TITLIN KBDIN, 0 KSF JMP .-1 KRS TAD (-203) SNA CLA JMP I [7600] /CTRL/C, RETURN TO SYSTEM KRB /RESTORE CHAR TO ACC JMP I KBDIN /RETURN WITH CHAR IN ACC TYPMESS, 0 STA TAD I TYPMESS INC TYPMESS DCA 11 TAD I 11 SNA JMP I TYPMESS OUTIT, PUT JMP .-4 EXTBUF, ZBLOCK 7 PAGE
/ SUBROUTINE TO OUTPUT A CHAR TO OUTPUT FILE / CHECK TO SEE IF WE ARE LISTING THIS PAGE OUTPUT, 0 DCA CHAR /SAVE THE CHAR KSF JMP OUTQ /KEY NOT STRUCK, GO OUTPUT PAGE KRS /READ IN CHAR TAD (-203) SNA CLA JMP I [7600] /CTRL/C, RETURN TO SYSTEM KCC /CLEAR FLAG OUTQ, TAD PAGEN /IS PAGE # <= 0 ? SPA SNA CLA JMP OUTQIT /YES, GO OUTPUT CHAR TAD (PAGTAB-1) /NO, CHECK PAGE TABLE DCA 17 TAD (-30) DCA OUTQCT /SET UP COUNTER OUTQ1, TAD I 17 /FIRST OF PAIR OF PAGE NUMBERS SNA JMP I OUTPUT /END OF TABLE, NOT PRINTING THIS PAGE CIA TAD PAGEN SPA CLA /PAGE # < FIRST NUM? JMP I OUTPUT /YES, NOT PRINTING THIS PAGE TAD I 17 /2ND OF PAIR CIA TAD PAGEN SMA SZA CLA /PAGE # > SECOND NUM? JMP OUTQ1 /YES, MAYBE ANOTHER PAIR TO CHECK OUTQIT, TAD CHAR /O.K. TO OUTPUT THE CHAR PUTIT /YES, OUTPUT THE CHAR JMP I OUTPUT OUTQCT, 0 / SUBROUTINE TO OUTPUT TOP OF PAGE BREAK TBREAK, 0 TAD PAGEB /OUTPUT A PAGE BREAK? SZA CLA JMP NOBREAK /NO, GO RESET LINE COUNTER TAD OPTWD1 /ARE WE DOING AN ASM LISTING (/A) ? SPA CLA JMP ASMBRK /YES TAD TP1 /GET MARGIN FROM TOP JMS PUTLF /OUTPUT "TOPM" LINE FEEDS TAD PAGEN SPA SNA CLA /IS PAGE # <= 0 ? JMP FBRK2 /YES, NO TITLE TAD TITLEQ /OUTPUT TITLE LINE? SZA CLA JMP FBREAK /NO, GO FINISH THE BREAK TAD LEFTAB /YES DCA NSPACE /INITIALIZE NO. OF SPACES ON LINE TAD NSPACE SNA JMP TBRK2 /NO LEFT MARGIN CIA DCA STARCT /USE CTR FOR NO. OF LEADING SPACES TAD [" ] PUT ISZ STARCT JMP .-3 TBRK2, JMS TYPMESS /YES, OUTPUT PAGE# PAGEM TAD PAGEN JMS OCTDEC /OUTPUT PAGE NUMBER TAD OPTWD1 AND [10] /LOOK FOR OPTION CHAR "I" SZA CLA JMP NOPART /IF /I, ONLY LIST PAGE NO. (INTEGER) TAD [".] /OTHERWISE, WANT PARTIAL PAGE, TOO PUT INC PAGEP /INCREMENT PARTIAL PAGE# TAD PAGEP JMS OCTDEC /OUTPUT THE PARTIAL PAGE# NOPART, JMS TYPMESS /OUTPUT 2 SPACES SPACE2 JMS TYPMESS /OUTPUT THE TITLE TITLEM TAD [DATBUF-2-1] /NO, PREPARE TO OUTPUT DATE DCA 10 FBRK1, TAD I 10 SNA JMP FBRK2 PUT JMP FBRK1 FBRK2, TAD [215] PUT FBREAK, TAD OPTWD1 SPA CLA /SKIP IF NOT /A CLL STA RAL /SET AC = -2 TAD BDY DCA LINECT TAD OPTWD1 /SKIP IF NOT /A SPA CLA STL RTL /SET AC=2 TAD TP2 JMS PUTLF /OUTPUT THE LINE FEEDS FBRK4, DCA TOPSW /NO LONGER AT TOP OF PAGE JMP I TBREAK ASMBRK, CLL STA RAL /-2 TO ACC NOBREAK, TAD BDY DCA LINECT /RESET LINE COUNT JMP FBRK4 STARSV, 0 DCA 10 /ADDR OF BUFFER TO SAVE STARS TAD [-6] /NO. OF ASTERISKS TO SAVE DCA STARCT TAD ["*] DCA I 10 /SAVE IN APPROPRIATE BUFFER ISZ STARCT JMP .-3 DCA I 10 /0 ENDS THE BUFFER JMP I STARSV STARCT, 0 NAMBUF, ZBLOCK 7 PAGE
/ / FORM FEED HAS BEEN INPUT / IF IT IS AN ASSEMBLY LISTING, / THEN "READ" THE PAL-8 OR PAL-12 / PAGE NUMBER FROM THE HEADING / FFEED, TAD OPTWD1 /IS THIS AN ASSEMBLY LISTING? SMA CLA JMP FFEED1 /NO, REGULAR FORM FEED TAD PAGEN SPA SNA CLA /PRINTING REGULAR LISTING? JMP FFEED1 /NO JMS BBREAK /OUTPUT BOTTOM OF PAGE BREAK STA DCA TOPSW /TOP OF PAGE BREAK TAD (-73) DCA COUNT /NO. OF CHARS TO PAL8 OR PAL12 PAGE# TAD (ASMBUF-1) /LOC TO SAVE THEM DCA 10 GET DCA I 10 /SAVE CHARS IN BUFFER ISZ COUNT JMP .-3 GET /NOW HUNT FOR EOL TAD [-215] SNA JMP .+4 TAD [215] DCA I 10 /OTHERWISE SAVE CHARS JMP .-6 /AND GET SOME MORE DCA I 10 /IF EOL, END BUFFER WITH 0 TAD (ASMBUF+73-1) DCA 10 JMS ASCBIN /GET THE PAGE NUMBER CLA /IGNORE CHAR THAT ENDED IT TAD NUMBER DCA PAGEN /SAVE THE PAGE NUMBER DCA CRSWIT TAD TTYSWT /OUTPUTTING TO TTY? SZA CLA JMP .+5 /NO TAD [212] /YES, OUTPUT A COUPLE OF LINE FEEDS PUT TAD [212] PUT TAD (ASMBUF-1) DCA 10 /PREPARE TO OUTPUT THE TITLE LINE TAD I 10 SNA JMP .+3 /0, END OF LINE; CONTINUE WITH CR/LF PUT JMP .-4 /CONTINUE TO OUTPUT HEADING ISZ LINECT /DOES NOT SKIP OUT JMP CARRET+2 /OUTPUT CR, THEN GET LINE FEED ASCBIN, 0 CLA CLL GETNUM, DCA NUMBER /UPDATE THE NUMBER TAD I 10 /GET AN ASCII CHAR FROM BUFFER SNA JMP I ASCBIN /ZERO INDICATES END OF INPUT LINE TAD (-272) SPA JMP .+3 TAD (272) JMP I ASCBIN /NOT DIGIT, RET WITH CHAR IN ACC TAD (272-260) SMA JMP .+3 TAD ["0] JMP I ASCBIN /NOT DIGIT, RET WITH CHAR IN ACC DCA TEMP /SAVE DIGIT TAD NUMBER /10X = (4X + X) * 2 CLL RTL TAD NUMBER CLL RAL TAD TEMP /ADD IN CURRENT DIGIT JMP GETNUM /UPDATE NUMBER SETUPL, 0 CIF 10 JMS I (SETUP) 0 /NO EXTENSION ENDATA /END-OF-FILE ROUTINE TAD [DATBUF-1] DCA 10 CDF 10 TAD I (MDATE) /GET SYSTEM DATE CDF 00 SNA JMP SETUP3 /NO, DATE GIVEN, FILL WITH "***" DCA SETUPT /SAVE THE DATE TAD SETUPT CLL RTL; RTL; RAL JMS DATECV TAD SETUPT RTR; RAR JMS DATECV /SAVE DAY PART TAD ["7] DCA I 10 TAD SETUPT AND [7] TAD ["0] DCA I 10 /SAVE YEAR JMP SETUP5 SETUP3, TAD [-10] DCA SETUPC TAD ["*] DCA I 10 /FILL BUFFER WITH STARS ISZ SETUPC JMP .-3 SETUP5, DCA I 10 /0 ENDS THE BUFFER JMS SETNAM /FIX UP FILENAME AND EXTENSION JMP I SETUPL SETUPT, 0 SETUPC, 0 PAGE
INPUT, 0 GETIT /GET AN INPUT CHAR AND (177) /CHECK 7 BIT ASCII SZA TAD (-177) /CHECK FOR RUBOUT SNA JMP INPUT+1 /IGNORE ZERO AND RUBOUT CODES TAD (177+200) /RESTORE CHAR TO ACC JMP I INPUT DECIMAL ADHSET, 0 /RESET MARGINS FOR ADH TAD (-6-MARTP1) DCA TP1 TAD (-0-MARTP2) DCA TP2 TAD (+6+0-BODY) DCA BDY JMP I ADHSET OCTAL / ASCII STRINGS FOR TYPOUTS ENTITL, ASCII "ENTER TITLE" 215; 212; 0 ENTPAG, ASCII "ENTER PAGES" 215; 212; 0 ENTABV, ASCII "ENTER VARIABLE TABS" 215; 212; 0 ENTABF, ASCII "ENTER FIXED TAB" 215; 212; 0 ENTABT, ASCII "ENTER LEFT TAB" 215; 212; 0 PAGEM, ASCIIZ "PAGE " SPACE2, 240;240;0 LISTM, ASCII "LIST V" VERSION; 215; 212; 0 PAGE
/ SUBROUTINE TO PRINT OUT THE FILE NAME AND EXTENSION / IN LARGE LETTERS, ALSO THE SYSTEM DATE LARGE, 0 TAD [-10] JMS LFOUT /OUTPUT 8 LINE FEEDS JMS LARGEO /OUTPUT THE NAME NAMBUF 7777 TAD I (EXTBUF) SNA CLA /ANYTHING IN EXTENSION BUFFER? JMP LARGE2 /NO TAD (-4) /YES JMS LFOUT /FIRST, OUTPUT 4 LINE FEEDS JMS LARGEO /THEN OUTPUT THE ENTENSION EXTBUF 7777 LARGE2, TAD [-6] JMS LFOUT /OUTPUT SOME MORE BLANK LINES JMS LARGEO /THEN OUTPUT THE DATE DATBUF 0000 JMP I LARGE /RETURN TO CALLER / MAIN SUBROUTINE TO USE PATTERN WORDS TO OUTPUT LARGE CHARS LARGEO, 0 TAD I LARGEO INC LARGEO DCA LARGPT /POINTS TO OUTPUT BUFFER TAD I LARGEO INC LARGEO DCA LARGSW /THE SWITCH FOR EXTRA LARGE OR LARGE TAD [-6] DCA LGCTR1 /NO. OF LINES PER CHAR DCA LGWORD /1ST OF 3 PATTERN WORDS DCA LGHALF /START IN LEFT HALF LARGA, TAD LARGSW /EXTRA LARGE LETTERS? CLL RAL /MAKE 7777 A 7776 (-2) SNL /ANSWER IN LINK BIT STA /NO, JUST 1 LINE DCA LARGCT /SAVE THE CTR LARG0, TAD LARGPT DCA LGPTR1 /POINTS TO CHARS TO OUTPUT LARG1, TAD I LGPTR1 /GET A CHAR SNA JMP LARG5 /END OF LINE TAD [-240] DCA LGTMP /FOR INDEX INTO TABLE TAD LGTMP CLL RAL TAD LGTMP TAD (PWORDS) /PATTERNS IN FIELD 1 TAD LGWORD /CURRENT WORD OF 3-WORD GROUP DCA LGPTR2 TAD LGHALF /WHICH HALF TO DO? SNA CLA JMP LGLEFT /0, LEFT HALF CDF 10 /7777, RIGHT HALF TAD I LGPTR2 /GET A PATTERN WORD FROM FIELD 1 CDF 00 CLL RTL; RTL; RTL JMP LARG2 LGLEFT, CDF 10 TAD I LGPTR2 CDF 00 LARG2, AND (7700) /JUST WANT GOOD PART DCA LGTMP TAD [-6] /NO. OF BITS TO PROCESS DCA LGCTR2 LARG3, TAD LGTMP CLL RAL DCA LGTMP SNL /PRINT THE CHAR? JMP .+3 /NO, PRINT A SPACE TAD I LGPTR1 /YES, GET THE CHAR TO PRINT SKP TAD [" ] DCA LGCHAR /SAVE CHAR TO PRINT TAD LGCHAR PUTC TAD LARGSW /EXTRA LARGE CHARS? SNA CLA JMP .+3 /NO TAD LGCHAR /YES, OUTPUT IT AGAIN PUTC ISZ LGCTR2 /ALL CHARS ACROSS FOR THIS ONE? JMP LARG3 /NO, GET NEXT BIT TAD [" ] PUTC /OUTPUT A SPACE TAD LARGSW /ARE WE DOING REGULAR LARGE? SZA CLA JMP LARG4 /NO, EXTRA LARGE, NO MORE SPACES TAD [" ] PUTC TAD [" ] PUTC LARG4, INC LGPTR1 /NEXT CHAR ON LINE JMP LARG1 LARG5, TAD [215] /OUTPUT CR/LF COMBO PUTC TAD [212] PUTC ISZ LARGCT /ENOUGH LINES OUT? JMP LARG0 /NO, GO DO NEXT LINE TAD LGHALF /END OF LINE CMA DCA LGHALF /COMPLEMENT HALF SWITCH TAD LGHALF /ARE WE ON A NEW WORD? SNA CLA INC LGWORD /YES, POINT TO LEFT HALF OF NEXT WORD ISZ LGCTR1 /6 LINES DONE? JMP LARGA /NO, DO ANOTHER LINE JMP I LARGEO /YES, RETURN LARGPT, 0 LARGSW, 0 LGCTR1, 0 LGCTR2, 0 LGHALF, 0 LGPTR1, 0 LGPTR2, 0 LGTMP, 0 LGCHAR, 0 LGWORD, 0 LARGCT, 0 PAGE
/ SUBROUTINE TO GET FILENAME AND EXTENSION / AND PUT IN BUFFERS FOR LARGE CHARACTER OUTPUT SETNAM, 0 CLA CLL DCA I [NAMBUF] DCA I [EXTBUF] TAD [TITLEM-1] /USED AS TEMP FOR SAVING CHARS DCA 10 TAD (7601) DCA SETPTR /POINTS TO CURRENT NAME DCA SETHLF /START IN LEFT HALF STA CLL RTL /-3 TO ACC DCA SETCTR /3 WORDS TO NAME DCA SETCNT /NO. OF CHARS IN NAME AND EXT SETN2, CDF 10 TAD I SETPTR /GET 2 CHARS CDF 00 ISZ SETHLF /WHICH HALF? JMP SETLFT /LEFT HALF FIRST JMS SETSAV /RIGHT HALF, SAVE IN LINE BUFFER INC SETPTR /POINT TO NEXT CHARS ISZ SETCTR /NAME DONE? JMP SETN2 /YES CDF 10 TAD I SETPTR /NOW CHECK EXTENSION CDF 00 SNA JMP SETN4 /NO EXTENSION DCA SETEMP /SAVE THE EXTENSION TAD [".] DCA I 10 /. COMES BEFORE EXTENSION INC SETCNT /ANOTHER CHAR IN LINE BUFFER TAD SETEMP CLL RTR; RTR; RTR JMS SETSAV /SAVE LEFT CHAR TAD SETEMP JMS SETSAV /AND RIGHT CHAR SETN4, DCA I 10 /0 ENDS THE BUFFER TAD I (TITLEM) SNA CLA JMP SETN5 /NOTHING IN FILE NAME TAD [NAMBUF-1] DCA 10 /SAVE IN NAME BUFFER, FIRST TAD SETCNT TAD [-6] /<= 6 CHARS IN NAME BUFFER? SMA SZA JMP SETN7 /> 6, SOMETHING SPECIAL SMA JMP SETN6 /=6, JUST SAVE ALL CHARS STL RAR SZL IAC SNA JMP SETN6 /NO LEADING SPACES DCA SETCNT /SAVE THE COUNTER TAD [" ] DCA I 10 ISZ SETCNT /ENOUGH SPACES YET? JMP .-3 SETN6, TAD [TITLEM-1] DCA 11 TAD I 11 SNA JMP .+3 DCA I 10 /MOVE CHARS TO NAME BUFFER JMP .-4 DCA I 10 /AGAIN, 0 ENDS THE BUFFER SETNMR, JMP I SETNAM /RETURN TO CALLER SETLFT, CLL RTR; RTR; RTR JMS SETSAV /SAVE THE LEFT HALF STA DCA SETHLF /RIGHT HALF NEXT TIME JMP SETN2 SETN5, TAD [NAMBUF-1] JMS STARSV /FILL NAME BUFFER WITH STARS TAD [EXTBUF-1] /DITTO EXTENSION BUFFER JMS STARSV JMP I SETNAM SETHLF, 0 SETCTR, 0 SETCNT, 0 SETPTR, 0 SETEMP, 0 / SUBROUTINE TO CHECK FOR SPECIAL ASSEMBLER LISTING FLAGS ASMSET, 0 CLA CLL TAD OPTWD1 /A OPTION GIVEN? SMA CLA JMP I ASMSET /NO, RETURN TO CALLER CLA IAC AND OPTWD2 /CHECK FOR /X OPTION SNA CLA JMP I ASMSET /NO, JUST RETURN TAD (TABTAB) /YES, USE PRESET TABS DCA POINT TAD (-204) /132 DECIMAL DCA COUNT TAD (-6) DCA I POINT /START AS IF COL 3 ASMST1, TAD [-10] /AND EVERY 10TH (8TH) COL AFTER TAD I POINT INC POINT DCA I POINT ISZ COUNT JMP ASMST1 JMP I ASMSET /RETURN TO CALLER PUTLF, 0 SNA JMP I PUTLF /IF ZERO, RETURN DCA COUNT /SAVE COUNTER TAD [212] PUT ISZ COUNT JMP .-3 JMP I PUTLF PAGE
/ CONTINUATION OF SETNAM SUBROUTINE SETN7, CLA DCA SETCNT /CTR FOR NO. OF CHARS AS WE LOOK TAD [TITLEM-1] DCA 11 /LOOK AT THE BUFFER LINE AGAIN SETN8, TAD I 11 INC SETCNT /COUNT THE CHAR SNA HLT /SHOULD NEVER HALF TAD [-".] SZA CLA JMP SETN8 /NOT PERIOD, LOOK AGAIN TAD SETCNT /IS PERIOD, IN 5TH POSITION? TAD (-5) SZA CLA JMP .+3 TAD [" ] /YES, OUTPUT A LEADING SPACE DCA I 10 TAD [TITLEM-1] DCA 11 /PREPARE TO MOVE THE NAME SETN81, TAD I 11 SNA HLT /SHOULD NEVER HAPPEN TAD [-".] /IS CHAR A PERIOD? SNA JMP SETN9 /YES TAD [".] /NO, REGENERATE CHAR DCA I 10 /AND SAVE IT JMP SETN81 SETN9, DCA I 10 /0 ENDS THE NAME BUFFER TAD [EXTBUF-1] DCA 10 /NOW TO MOVE EXTENSION TAD [" ] /ALWAYS 2 LEADING SPACES DCA I 10 TAD [" ] DCA I 10 TAD I 11 /MOVE THE CHARS INTO EXTENSION DCA I 10 TAD I 11 DCA I 10 TAD I 11 DCA I 10 JMP SETNMR /RETURN TO CALLER / SAVE A CHAR IN A BUFFER AND COUNT IT SETSAV, 0 AND [77] SNA JMP I SETSAV /IGNORE 0 CODE TAD [" ] AND [77] TAD [" ] DCA I 10 INC SETCNT JMP I SETSAV / SUBROUTINE USED IN DATE CONVERSION DATECV, 0 AND (37) DCA DATET1 DCA DATET2 JMP .+3 ISZ DATET2 DCA DATET1 TAD DATET1 TAD (-12) SMA JMP .-5 CLA TAD DATET2 SNA JMP .+3 TAD ["0] DCA I 10 TAD DATET1 TAD ["0] DCA I 10 TAD ("/) DCA I 10 JMP I DATECV DATET1, 0 DATET2, 0 240; 240 /THESE SPACES MUST BE BEFORE 'DATBUF' DATBUF, ZBLOCK 12 LCHECK, 0 INC CHARCT /INCREMENT CHARACTER CTR TAD CHARCT TAD LINSIZ /END OF OUTPUT LINE? SPA CLA JMP I LCHECK /NO, RETURN TAD OPTWD1 /YES, END THE LINE HERE? RTL /CHECK FOR /C OPTION CHAR SMA CLA JMP I LCHECK /NO, RETURN TAD [215] /YES, OUTPUT CARRIAGE RETURN PUT JMP LFEED /THEN OUTPUT LINE FEED / TELL USER WHO WE ARE WHOQ, 0 CLA CLL TAD (TYPE) DCA OUTIT /OUTPUT DEV IS TELETYPE JMS TYPMESS /OUTPUT THE MESSAGE LISTM /"LIST VN" TAD (PUT) DCA OUTIT /RESET OUTPUT ROUTINE JMP I WHOQ PAGE
/ START OF PS/8 LISTING PROGRAM / ACTUAL LISTING PART OF LISTER START, STA DCA LINECT /INTIIALIZE LINES/PAGE CTR DCA TOPSW /ZAP TOP OF PAGE SWITCH DCA PAGEN /PAGE # = 0000 DCA PAGEP /PARTIAL PAGE # = 0, TOO TAD [214] /YES, OUTPUT TO TOP OF PAGE PUTC STARTL, CLA IAC DCA PAGEN /INITIALIZE PAGE # DCA PAGEP /AND PART PAGE JMS ASMSET /SET UP FOR ASSEMBLY OUTPUT (MAYBE) TAD OPTWD1 DCA ASMTMP /SAVE /A SWITCH A SEC TAD TTYSWT /OUTPUT TO TELETYPE? SNA CLA JMP START1 /YES CLL STA RAR /3777 TO ACC AND OPTWD1 DCA OPTWD1 /GET RID OF /A OPTION FOR NOW TAD LSWIT /OUTPUT LARGE LETTERS? SZA CLA JMP START1 /NO DCA PAGEN /YES, SO ZAP PAGE # JMS LARGE /OUTPUT NAME IN LARGE LETTERS TAD [214] /OUTPUT TO BOTTOM OF PAGE PUTC START1, TAD ASMTMP /RESET /A OPTION DCA OPTWD1 TAD OPTWD1 /CHECK FOR /A OPTION SMA CLA JMP START2 /NOT, GO START LIST TAD TTYSWT //A, NOW SET PAGE # SZA CLA /OUTPUT TO TTY? CLL STA RAR /NO, SET PAGE # = 3777 DCA PAGEN /YES, SET PAGE # TO 0 START2, GET /GET AN INPUT CHAR PUTC /OUTPUT THE CHAR JMP START2 /KEEP IN LOOP ASMTMP, 0 / END OF DATA PROCEDURE ENDATA, STA DCA PAGEN /ALLOW NO HEADING ON LAST PAGES TAD OPTWD1 DCA OPTWDE /SAVE OPT WD 1 A SEC CLL STA RAR /3777 TO ACC AND OPTWD1 /GET RID OF /A OPTION DCA OPTWD1 TAD TOPSW /ARE WE AT TOP OF PAGE? SZA CLA JMP .+3 /YES TAD [214] /LAST PAGE BREAK PUTC DCA PAGEN /NO TOP OF PAGE TITLE HEADING ENDAT1, TAD LSWIT /OUTPUT LARGE LETTERS? SZA CLA JMP ENDAT2 /NO JMS LARGE /OUTPUT END LARGE LETTERS TAD [214] PUTC ENDAT2, TAD OPTWDE /RESET OPTWD1 DCA OPTWD1 ISZ NCOPY /ALL COPIES OUT? JMP ENDAT3 /NO TAD TTYSWT /OUTPUT TO TELETYPE? SZA CLA JMP ENDAT4 /NO, CLOSE FINAL OUTPUT TAD [212] /OUTPUT A COUPLE MORE LINE FEEDS PUTC TAD [212] PUTC ENDAT4, CLOSE /CLOSE OUTPUT FILE JMP BEGIN /ASK FOR MORE INPUT ENDAT3, CIF 10 /WE WANT MORE COPIES, SO JMS I (IOPEN) /REOPEN INPUT FILES JMP STARTL /AND GO AGAIN OPTWDE, 0 / CONVERT NUMBER IN AC TO DECIMAL OCTDEC, 0 DCA ODNUM /SAVE NUM TO CONVERT STA DCA LZERO /SET LEADING ZERO SWITCH TAD (DIGTAB-1) DCA OCTEMP CLL STA RTL /-3 TO ACC DCA DIGCTR /NO. OF DIGITS BEFORE PRINTING LAST OD1, INC OCTEMP DCA DIGIT /CLEAR OUT DIGIT OD2, TAD ODNUM TAD I OCTEMP /CHECK WITH POWER OF TEN SPA JMP OD3 INC DIGIT /INCREMENT DIGIT IF POSITIVE DCA ODNUM /SAVE DIFFERENCE JMP OD2 OD3, CLA TAD DIGIT SNA JMP LEADZ /IS IT A LEADING ZERO? OD4, TAD ["0] /NO, CONVERT TO ASCII CHAR PUT /OUTPUT THE CHAR DCA LZERO /NO MORE LEADING ZEROES OD5, ISZ DIGCTR /3 DIGITS OUT? JMP OD1 TAD ODNUM /YES, OUTPUT LAST DIGIT TAD ["0] PUT JMP I OCTDEC /RETURN TO CALLER LEADZ, TAD LZERO SZA CLA JMP OD5 JMP OD4 PAGE
TITLEM=. TABTAB=TITLEM+100 PAGTAB=TABTAB+206 DOT=PAGTAB+100 ASMBUF=3400 OUBUF=3600 /OUTPUT BUFFER IN FIELD 0 OUCTL=1400!4000 /6 RECORDS IN BUFFER (3000 WORDS) OUDEVH=7200 /2-PAGE OUTPUT HANDLER INBUF=0000 /INPUT BUFFER IN FIELD 1 INCTL=2010 /8 RECORDS IN BUFFER (4000 WORDS) INRECS=INCTL%200 INDEVH=6600 /2-PAGE INPUT HANDLER MDATE=7666 /IN FIELD 1 FIELD 1 /DUMP PAGE ZERO LITERALS
/ PATTERN WORDS FOR 6X6 CHARACTER MATRIX *7300 PWORDS, 0000; 0000; 0000 /40: SPACE 1010; 1010; 0010 /41: ! 2424; 0000; 0000 /42: " 2476; 2424; 7624 /43: # 3744; 3611; 1176 /44: $ 6162; 0410; 2343 /45: % 1422; 1421; 4235 /46: & 1010; 0000; 0000 /47: ' 1420; 2020; 2014 /50: ( 1402; 0202; 0214 /51: ) 4224; 7624; 4200 /52: * 0010; 1076; 1010 /53: + 0000; 0014; 0410 /54: , 0000; 0076; 0000 /55: - 0000; 0000; 1414 /56: . 0102; 0410; 2040 /57: / 3643; 4551; 6136 /60: 0 0414; 0404; 0437 /61: 1 3442; 0410; 2076 /62: 2 3442; 0402; 4234 /63: 3 0414; 2477; 0404 /64: 4 7640; 7601; 4136 /65: 5 0204; 1034; 4234 /66: 6 7702; 0410; 2040 /67: 7 1422; 1422; 4136 /70: 8 1621; 1604; 1020 /71: 9 0014; 1400; 1414 /72: : 1414; 0014; 0410 /73: ; 0410; 2010; 0400 /74: < 0000; 7600; 7600 /75: = 1004; 0204; 1000 /76: > 3442; 0410; 0010 /77: ? 3641; 5556; 4037 /100: @ 3641; 7741; 4141 /101: A 7641; 7641; 4176 /102: B 3641; 4040; 4136 /103: C 7641; 4141; 4176 /104: D 7740; 7640; 4077 /105: E 7740; 7640; 4040 /106: F 3641; 4047; 4136 /107: G 4141; 7741; 4141 /110: H 3410; 1010; 1034 /111: I 0702; 0202; 2214 /112: J 4450; 6050; 4442 /113: K 4040; 4040; 4077 /114: L 4163; 5541; 4141 /115: M 4161; 5145; 4341 /116: N 7741; 4141; 4177 /117: O 7641; 7640; 4040 /120: P 3641; 4145; 4337 /121: Q 7641; 7644; 4241 /122: R 3640; 3601; 4136 /123: S 7610; 1010; 1010 /124: T 4141; 4141; 4136 /125: U 4141; 4142; 2410 /126: V 4141; 4155; 6341 /127: W 4122; 1414; 2241 /130: X 4122; 1410; 2040 /131: Y 7702; 0410; 2077 /132: Z 1410; 1010; 1014 /133: [ 4020; 1004; 0201 /134: \ 1404; 0404; 0414 /135: ] 3452; 1010; 1010 /136: ^ 0010; 2077; 2010 /137: _ / END OF PATTERN WORDS PAUSE /FOR IOPACK TO BE ASSEMBLED