File FORMCV.12

Directory of image this file is from
This file as a plain text file

/ FORM TO PRINTER CONVERSION

/ WRITTEN BY:
/ CLYDE G. ROBY, JR.
/ DEPARTMENT OF PHYSIOLOGY AND BIOPHYSICS
/ WEST VIRGINIA UNIVERSITY MEDICAL CENTER
/ MORGANTOWN, WEST VIRGINIA
/ SEPTEMBER, 1974

FIXMRI	INC=2000	/ISZ WHEN NOT EXPECTED TO SKIP

FIXTAB

	OBUFL=2000	/OUTPUT BUFFER LENGTH
	IBUFL=2000	/INPUT BUFFER LENGTH

*20 CTR1, 0 PTR1, 0 CURCOL, 0 SIGN, 0 RELFLG, 0 CVRTQ, 0 TEMP, 0 CPTR, 0 NUMBER, 0 ASWITCH,0 CSWITCH,0 ASCIIC, 0 /UNINITIALIZED VALUES GO BELOW HERE PAGPFG, 0 TABCOL, 0 INCHAR, 0 CSPACE, -1 PAGEN, -1 /VALUES INITIALIZED TO -1 END HERE FCOLUM, 1 LCOLUM, OLENGTH /INITIALIZATION ENDS HERE DECIMAL DTABLE, -1000 -100 -10 OCTAL OLENGTH=120 MXLENGTH=226
/ DOCUMENT DEFINITION PARAMETERS DECIMAL PWIDTH, OLENGTH /WIDTH OF PAGE PLENGTH, 66 /LENGTH OF PAGE FORMAT, 0 /FORMAT OF TITLES NLINE1, 3 /NO. OF LINES FROM PAGE BREAK TO 'TOP TITLE' NLINE2, 3 /NO. OF LINES FROM 'TOP TITLE' TO BODY NLINE3, 3 /NO. OF LINES FROM BODY TO 'BOTTOM TITLE' NLINE4, 3 /NO. OF LINES FROM 'BOTTOM TITLE' TO PAGE BREAK OCTAL GET= JMS I . XGET PUTC= JMS I . XPUT GETC= JMS I . XGETC BACKUP= JMS I . XPOPC SORTJ= JMS I . CCHECK OUTMESS=JMS I . OMESSX OUTNUM= JMS I . BINASC OUTCOM= JMS I . OCOMX CRLF= JMS I . CRLFX RETURN= JMP I . RETRNX PAGE
/ THIS IS WHERE FORM STARTS (LOC 00200) SKP CLA /THIS IS STARTING ADDRESS JMP NOVER /CHAINED TO STA NOVER, CIF 10 /CALL GEN I/O PACKAGE SETUP JMS I (SETUP) TEXT \DC\ /ASSUME .DC EXTENSION EOFILE /END-OF-FILE ROUTINE CDF 10 STL CLA RAR /4000 TO ACC AND I (MPARAM) /CHECK /A OPTION DCA ASWITCH /INDICATES ABBREVIATED COMMANDS TAD I (MPARAM) /CHECK /C OPTION AND (1000) DCA CSWITCH /OUTPUT FORM COMMANDS AS COMMENTS CDF 00 STA OUTMESS /DON'T OUTPUT CR/LF FLAGM FLAGM STA OUTMESS /DON'T OUTPUT CR/LF TRELL TRELS CRLF /OUTPUT AFTER FIRST LINE NCHAR, GETC TAD INCHAR /GET AN INPUT CHAR SNA RETURN /EOL, GET NEW LINE TAD (-"^) SNA CLA JMP CONTROL SCHAR, TAD INCHAR /GET CHAR BACK PUTC JMP NCHAR CONTROL, GETC TAD INCHAR /CHAR FOLLOWING "^" SNA JMP CONEOL /CONTROL EOL, FORCE IT SORTJ /CHECK AGAINST OTHER CHARS CLIST-1 CJMPS-CLIST TAD INCHAR /GET INPUT CHAR AND (337) /MAKE IT CAP SORTJ /CHECK IT AGAINST CONTROL CHARS AGAIN CLIST-1 CJMPS-CLIST OUTCOM 0 JMS ASCBIN /TRY TO CONVERT TO BINARY TAD CVRTQ /DID CONVERSION TAKE PLACE? SNA CLA RETURN /NO CONVERSION EOL2, TAD NUMBER /MAKES NO. OF LINES TO SKIP SPA SNA CLA /MUST BE POSITIVE RETURN /IGNORE IF CAN'T DO IT ON PAGE OUTMESS BLANKL BLANKS TAD NUMBER OUTNUM RETURN CONEOL, OUTMESS BREAKL BREAKS RETURN EOFILE, CIF 10 JMS I (XXCLOSE) JMP I (7600) / SUBROUTINE TO OUTPUT A PRINTR COMMAND MESSAGE OMESSX, 0 SNA CLA /IF NON-ZERO, DON'T OUTPUT CR/LF CRLF TAD (".) PUTC TAD I OMESSX INC OMESSX DCA OUTMPT TAD ASWITCH SNA CLA JMP .+3 TAD I OMESSX DCA OUTMPT INC OMESSX OMESS1, TAD I OUTMPT INC OUTMPT SNA JMP I OMESSX PUTC JMP OMESS1 OUTMPT, 0 / SUBROUTINE TO OUTPUT A PRINTR COMMENT / FOLLOWED BY FORM COMMAND OCOMX, 0 CLA CLL TAD CSWITCH /OUTPUT COMMENTS? SNA CLA JMP OCOMX2 /NO, JUST RETURN OUTMESS COMMENT COMMENT TAD I OCOMX SZA PUTC OCOMX2, INC OCOMX JMP I OCOMX COMMENT,ASCIIZ "!^" PAGE
/ ^- OR ^#, START A NEW PARAGRAPH BY INDENTING / TO APPROPRIATE COLUMN NPARA, TAD INCHAR /GET THE COMMAND CHAR DCA .+2 OUTCOM /COMMENT THE APPROPRIATE CHAR 0 OUTMESS PARAGL PARAGS RETURN /GET NEXT PARAGRAPH / ^"..." OR ^"...(CR) / INPUT A NEW TITLE FOR TOP OF PAGE NTITLE, OUTCOM ""+400 OUTMESS TITLL TITLS NTITL1, GETC TAD INCHAR /GET AN INPUT CHAR SNA JMP ETITLE /EOL, END OF TITLE TAD (-"") SNA JMP ETITLE /", END OF TITLE TAD (""-""-400) SNA CLA JMP ETITLE /"+400, END OF TITLE TAD INCHAR PUTC JMP NTITL1 /NO, GET MORE CHARS ETITLE, RETURN / ^/N SPACE FORWARD OR BACKWARD TO THE APPROPRIATE COLUMN COLUMN, OUTCOM "/ GETC /GET CHAR AFTER '/' JMS ASCBIN /CONVERT NUMBER TAD CURCOL /FIX UP FOR CURRENT COLUMN JMS RELQ /USE SUPPLIED ARGUMENT (REL OR ABS) DCA NUMBER /SAVE FOR TEMP TAD LCOLUM CIA TAD NUMBER SPA CLA /NEW COLUMN > LAST COLUMN? JMP .+3 /NOPE, OK TAD LCOLUM /YES, RESET TO LAST COLUMN DCA NUMBER COLUM4, OUTMESS INDENL INDENS TAD NUMBER OUTNUM RETURN / ^TN1+N2,N3,N4+N5,0 / GET A NEW SET OF TAB STOPS FOR "TYPWRITER" MODE / IF NO TAB STOPS ARE PRESENT, USE WHAT WE HAVE TABTAB, OUTCOM "T TAD (TTABLE) DCA PTR1 /SET UP POINTER FOR SAVE TAD (-20) DCA CTR1 /JUST 16 TAB STOPS DCA TABCOL /ZERO THE TAB COLUMN NTTAB, GETC JMS ASCBIN /GET A COLUMN TAD TABCOL SZA CLA /ARE WE JUST STARTING? JMP NTTAB1 /NOPE TAD CVRTQ /DID CONVERSION TAKE PLACE? SNA CLA JMP TABGO /NO, JUST OUTPUT "NOFILL" NTTAB1, TAD RELFLG /RELATIVE OR ABSOLUTE? SZA CLA JMP NTTAB2 /RELATIVE, GO ADD OR SUBTRACT TAD NUMBER /ABSOLUTE, GET THE NUMBER SNA JMP TABX /ZERO, START OF TYPEWRITER MODE GOADD, DCA I PTR1 /SAVE TAB IN TABLE TAD I PTR1 /GET CURRENT TAB COLUMN INC PTR1 /POINT TO NEXT TABLE ENTRY DCA TABCOL /SAVE CURRENT TAB COLUMN DCA I PTR1 /ZAP NEXT LOC IN TABLE ISZ CTR1 /ALL DONE? JMP NTTAB /GET NEXT TAB JMP TABX /YES, END OF TAB STOPS NTTAB2, TAD TABCOL /RELATIVE, GET CURRENT TAB COLUMN TAD NUMBER /ADD OR SUBTRACT RELATIVE VALUE JMP GOADD /AND GO SAVE IT TABX, OUTMESS TABSL TABSS TAD (TTABLE) DCA PTR1 TABX1, TAD I PTR1 INC PTR1 SNA JMP TABX2 OUTNUM TAD I PTR1 /ANYTHING AFTER THIS ONE? SNA CLA JMP TABX1 /NOPE TAD (",) /YES, OUTPUT A COMMA PUTC JMP TABX1 TABX2, TAD (";) PUTC STA /DON'T OUTPUT CR/LF TABGO, OUTMESS NOFILL NOFILS TAD (";) PUTC STA /DON'T OUTPUT CR/LF OUTMESS /OUTPUT "BLANK 1" BLANKL BLANKS CLA IAC OUTNUM RETURN PAGE
/ CENTER A LINE COMMAND CENTER, OUTCOM "C OUTMESS CENTL CENTS TAD (";) PUTC CENT1, GETC TAD INCHAR /GET AN INPUT CHAR SNA RETURN PUTC JMP CENT1 /NO, KEEP GETTING CHARS / OUTPUT A CR/LF COMBINATION CRLFX, 0 CLA CLL TAD CRLFSW SZA CLA JMP I CRLFX /JUST DID A CR/LF COMBO TAD [215] PUTC TAD [212] PUTC STA DCA CRLFSW /WE JUST DID A CR/LF JMP I CRLFX CRLFSW, 0 / SORTJ ROUTINE CCHECK, 0 SNA TAD INCHAR /IF ZERO, ASSUME INPUT CHAR DCA CCHAR /SAVE CHAR IN LOC "CCHAR" TAD I CCHECK /GET CHARLIST-1 INC CCHECK DCA CPTR /SAVE IN CHAR POINTER INC CPTR TAD I CPTR /GET NEXT CHAR SNA JMP CHKNO /ZERO, END OF LIST, RETURN CIA TAD CCHAR /COMPARE WITH OBJECT CHAR SZA CLA JMP .-7 /NOT THE CHAR, TRY NEXT TAD CPTR TAD I CCHECK DCA CCHECK /SAVE LOC TO GET JMP TAD I CCHECK /GET JMP LOC DCA CCHECK /SAVE IT JMP I CCHECK /JMP TO CHAR ROUTINE CHKNO, INC CCHECK /CHAR NOT IN TABLE, INCREMENT JMP I CCHECK /AND THEN RETURN CCHAR, 0 UPCHAR, "U "L "% "! "[ "K "W "] "N " /THAT'S A SPACE FOLKS "^ 0 / GENERALIZED RETURN / DEPENDING UPON CURRENT MODE (TYPEWRITER OR NOT) / RETURN TO CORRECT LOC TO GET NEXT CHAR RETRNX, CRLF JMP NCHAR /"NOTAB" / ^SPACE FORCE A SPACE DON'T PAD IT FORSPC, TAD ("#) /EXTRA BIT TO PASS FORM DCA XGCHAR JMP XGETC1 / ^!CHARS^! => QUOTE,UPPER CASE CHARS,QUOTE UQUOTE, TAD UQCASE CMA DCA UQCASE /COMPLEMENT THE SWITCH TAD UQCASE SNA CLA JMP UQUOT2 TAD ("^) PUTC TAD ("^) PUTC UQUOT1, TAD ("'+400) DCA XGCHAR JMP XGETC1 UQUOT2, TAD ("\) PUTC TAD ("\) PUTC JMP UQUOT1 UQCASE, 0 CLIST, "- "# "#+400 "S "P "C "/ "" ""+400 "M "T "E "R "F "J "H "D 0 PAGE
/ ^E, END OF "TYPEWRITER" MODE / IF NUMBER FOLLOWS, USE IT AS ASSUMED TAB FOR PARAGRAPHS ENDTAB, OUTCOM "E GETC JMS ASCBIN /GET A BINARY NUMBER, IGNORE IT OUTMESS FILLL FILLS RETURN / ^M; GET NEW MARGINS NMARGS, OUTCOM "M GETC /GET NEXT CHAR JMS ASCBIN /GET A NEW MARGIN TAD INCHAR TAD (-",) SZA CLA JMP STMARG /CHAR NOT A COMMA TAD FCOLUM JMS RELQ DCA ASCIIC /SAVE FIRST COLUMN IN "ASCIIC" GETC /SKIP OVER COMMA JMS ASCBIN /GET SECOND COLUMN TAD LCOLUM JMS RELQ DCA TEMP /AND SAVE IT "TEMP" NMARG2, TAD TEMP CIA TAD ASCIIC /IS MARG2 <= MARG1? SMA CLA JMP MRET /YES, IGNORE MARGINS TAD ASCIIC /LEGAL, RESET FIRST, LAST COLS DCA FCOLUM /FIRST COLUMN TAD TEMP DCA LCOLUM /LAST COLUMN MRET, OUTMESS MARGL MARGS TAD FCOLUM OUTNUM TAD (",) PUTC TAD LCOLUM OUTNUM RETURN STMARG, TAD CVRTQ /DID CONVERSION TAKE PLACE? SZA CLA JMP LMARG /YES, GET NEW LAST MARGIN DOMARG, TAD PWIDTH /NO, ASSUME A STANDARD MARGIN DCA LCOLUMN /LAST COLUMN = PAGE WIDTH JMP LMARG2 LMARG, TAD LCOLUM /CHECK OUT LAST COLUMN JMS RELQ DCA LCOLUM /AND SAVE IT LMARG2, CLA IAC DCA FCOLUM /SET FIRST COLUMN = 1 JMP MRET / CONVERT A NUMBER IN AC FROM BINARY / TO DECIMAL ASCII CHAR FOR OUTPUT FILE BINASC, 0 DCA BINNUM /SAVE THE BINARY NUMBER TAD (" ) PUTC STA DCA LZERO /LEADING ZERO SWITCH TAD (DTABLE-1) DCA DTABPT /TEMPORARY POINTER CLL STA RTL /-3 TO ACC DCA DIGCTR TAD BINNUM /IS NUMBER < 0? SMA CLA JMP BINEXT /NOPE TAD ("-) /YES, OUTPUT A MINUS SIGN PUTC TAD BINNUM CIA DCA BINNUM /MAKE POSITIVE COUNTER BINEXT, INC DTABPT /POINT TO NEXT POWER OF 10 DCA DIGIT /ZERO DIGIT TAD BINNUM TAD I DTABPT /POWER OF 10 SPA JMP .+4 INC DIGIT /INCREMENT DIGIT DCA BINNUM JMP .-6 CLA TAD DIGIT SNA JMP LEADZ /IS IT A LEADING ZERO? TAD ("0) PUTC /SAVE DIGIT IN OUTPUT BUFFER DCA LZERO /CLEAR LEAD ZERO SWITCH BINLAST, ISZ DIGCTR /ALL DIGITS? JMP BINEXT TAD BINNUM TAD ("0) /LAST DIGIT PUTC JMP I BINASC /RETURN LEADZ, TAD LZERO SNA CLA JMP BINLAST-3 /NOT LEADING ZERO JMP BINLAST /IGNORE LEADING ZERO BINNUM, 0 LZERO, 0 LZSWIT, 0 DIGIT, 0 DIGCTR, 0 DTABPT, 0 / SPECIAL EDIT COMMAND CHARS AND JUMP TABLE UPJUMP, UCASE /^U LCASE /^L ENTCHR /^% UQUOTE /^! UPPER /^[ CAPLET /^K CAPWD /^W CAPFST /^] LOWLET /^N FORSPC /^ - A FORCED SPACE UPARROW /^^ PAGE
/ INPUT A CHARACTER FROM INPUT FILE AND / CHECK FOR SPECIAL EDITING COMMANDS XGETC, 0 CLA CLL /CLEAR GARBAGE FROM AC TAD XGCARX /IS OLD CHAR GOOD? SMA JMP XGETC9 /YES, GO RETURN IT CLA CLL JMP I .+1 /NO, GET ANOTHER ONE XGETCR, XGETC3 /GO TO RIGHT PLACE IN COROUTINE XGETC9, DCA INCHAR /SAVE THE CHAR STA DCA XGCARX /CLEAR OUT OLD CHAR JMP I XGETC XGETC1, CLA CLL TAD XGCHAR /RETURN WITH CURRENT CHAR XGETC0, JMS XGETCR XGETC3, GET /GET ANOTHER CHAR FROM INPUT FILE DCA XGCHAR XGETC7, TAD XGCHAR /CHECK LEGALITY OF CHAR TAD [-215] /END OF LINE? SNA JMP XGETC0 /YES, RETURN WITH ZERO CHAR IAC SNA JMP XGETC8 /FORM FEED, TREAT LIKE END-OF-LINE TAD (214-211) SNA JMP XGETC1 /TAB, LET IT PASS TAD (211-" ) SNA JMP XGETC1 SPA JMP XGETC3 /IGNORE CHARS < 240 TAD (" -377) SNA CLA JMP XGETC3 /IGNORE RUBOUT CHAR XGETC4, CLA /GOOD CHARS COME THRU HERE TAD XGCHAR TAD (-"^) /IS IT ^ (SPECIAL FORM COMMAND)? SZA CLA JMP XGETC5 /NO, GO SAVE THE GOOD CHAR GET /GET THE CHAR AFTER ^ DCA XGCHAR TAD XGCHAR SORTJ /CHECK FOR SPECIAL EDIT COMMANDS UPCHAR-1 UPJUMP-UPCHAR TAD XGCHAR AND (337) /MAKE UPPER CASE CHAR SORTJ /CHECK FOR SPECIAL EDIT COMMANDS AGAIN UPCHAR-1 UPJUMP-UPCHAR TAD ("^) /NOT A SPECIAL EDI COMMAND JMS XGETCR /RETURN WITH ^ FIRST JMP XGETC3+2 /RETURN WITH CAHR XGETC5, TAD XGCHAR SORTJ X5L-1 X5J-X5L JMP XGETC1 X5L, ASCIIZ Z"\#&'_Z X5J, XGET55 XGET55 XGET55 XGET55 XGET55 XGET55 XGETC8, TAD (214) PUTC JMP XGETC3 XGCHAR, 0 /INPUT CHAR FROM INPUT FILE XGCARX, -1 /PREVIOUS CHAR / GO BACKWARD 1 CHAR BY USING PREVIOUS INPUT CHAR XPOPC, 0 CLA CLL TAD INCHAR DCA XGCARX JMP I XPOPC / SPECIAL ROUTINES FOR SPECIAL EDIT CHARS XGET55, UPARROW,TAD XGCHAR TAD (400) /PUT IN EXTRA BIT DCA XGCHAR /THIS ALLOWS IT TO PASS FORM JMP XGETC1 / ^K, CAPITALIZE NEXT LETTER CAPLET, TAD ("^) PUTC JMP XGETC3 / ^W, CAPITALIZE ALL OF NEXT WORD CAPWD, TAD ("") PUTC JMP XGETC3 / ^]WORD.....WORDN^] CAPITALIZE FIRST CHAR / OF EACH WORD BETWEEN ^]....^] CAPFST, TAD UPFST CMA DCA UPFST /COMPLEMENT THE SWITCH TAD UPFST SNA CLA TAD ("\-"^) TAD ("^) PUTC TAD ("') PUTC JMP XGETC3 UPFST, 0 / LEFT JUSTIFY ONLY LJUST, OUTCOM "H OUTMESS NOJUSL NOJUSS RETURN PAGE
/ ^[CHARS^[ => UPPER CASE CHARS WITHOUT QUOTES UPPER, TAD UPCASE CMA DCA UPCASE /JUST COMPLEMENT THE SWITCH TAD UPCASE SNA CLA JMP UPPER2 UCASE, TAD ("^) PUTC JMP CAPLET LCASE, UPPER2, TAD ("\) PUTC JMP LOWLET UPCASE, 0 / ^%NUMBER, ENTER ASCII EQUIVALENT OF NUMBER IN STREAM / NOTE: IGNORE THE CHAR THAT ENDS THE NUMBER ENTCHR, ENTC2, DCA ENTCN /ZERO OUT NUMBER FOR CONVERSION GET /GET NEXT CHAR FROM INPUT FILE DCA XGCHAR TAD XGCHAR TAD (-"7) SMA SZA JMP ENTC1 /ILLEGAL NUMERIC CHAR TAD ("7-"0) SPA JMP ENTC1 /DITTO OTHER END DCA TEMP /SAVE THE OCTAL NUMBER TAD ENTCN CLL RTL RAL /MULTIPLY NUMBER BY 10(8) TAD TEMP /ADD IN NEW DIGIT JMP ENTC2 /GO UPDATE THE NUMBER ENTC1, CLA /IGNORE CHAR THAT ENDS NUM TAD ENTCN /GET THE CONVERTED NUMBER AND (7377) TAD (400) /SET IN QUOTED BIT DCA XGCHAR /SAVE AS ASCII CHAR JMP XGETC7 /CHECK LEGALITY OF CHAR ENTCN, 0 CJMPS, NPARA /-; NEW PARAGRAPH NPARA /#; NEW PARAGRAPH NPARA /#+400; NEW PARAGRAPH LSPACE /S; SINGLE, DOUBLE, TRIPLE SPACE NPAGE /P; TOP OF NEW PAGE CENTER /C; CENTER THE LINE COLUMN //; RESET THE COLUMN NTITLE /"; NEW TITLE NTITLE /"+400; NEW TITLE NMARGS /M; NEW MARGINS TABTAB /T; TABS FOR TYPEWRITER MODE ENDTAB /E; END OF TYPEWRITER MODE MRELS /R; RELEASE THE MARGIN IFLINE /F; CONDITIONAL TEST LRJUST /J; JUSTIFY LEFT AND RIGHT MARGINS LJUST /H; JUSTIFY LEFT MARGIN ONLY DEFDOC /D; DEFINE DOCUMENT PARAMETERS / ^R, RELEASE MARGIN TO ABSOLUTE COLUMN N MRELS, OUTCOM "R GETC JMS ASCBIN /GET COLUMN TO RELEASE TO TAD CVRTQ /DID CONVERSION TAKE PLACE? SZA CLA JMP .+3 /YES, USE FCOLUMN AS BASE CLA IAC /NO, ASSUME COL 1 SKP TAD FCOLUM JMS RELQ /FIX UP FOR ABS COLUMN SPA SNA CLA IAC /IF <= ZERO, ASSUME 1 DCA NUMBER OUTMESS /OUTPUT "INDENT" INDENL INDENS TAD FCOLUM CIA TAD NUMBER /N - LMARG OUTNUM /THE NUMBER TO INDENT TO CRLF NMREL, GETC TAD INCHAR /GET AN INPUT CHAR SNA JMP .+3 /0, EOL; END OF INPUT LINE PUTC JMP NMREL RETURN /SET 1 LEVEL CAPITAL INHIBIT LOWLET, TAD ("\) PUTC JMP XGETC3 /GO BACK AND PROCESS / ^S1, ^S2, ^S3, ^S GET THE SPACING NUM LSPACE, OUTCOM "S GETC JMS ASCBIN /GET THE NUMBER TAD NUMBER SNA IAC /IF ZERO, ASSUME 1 TAD (-4) /IN RANGE 1 - 3 ? SMA RETURN /NO, IGNORE IT TAD (4) /YES, REGENERATE NUMBER DCA CSPACE /AND SAVE THE COUNTER OUTMESS /OUTPUT "SPACING" SPACL SPACS TAD CSPACE OUTNUM /OUTPUT CURRENT SPACING RETURN / FULL JUSTIFY MODE LRJUST, OUTCOM "J OUTMESS JUSTL JUSTS RETURN PAGE
/ ^F; CONDITIONAL ON NO. OF LINES LEFT ON CURRENT PAGE IFLINE, OUTCOM "F GETC /GET CHAR JMS ASCBIN /CONVERT TO NUMBER OUTMESS /OUTPUT "TEST PAGE" TPAGEL TPAGES TAD NUMBER OUTNUM /OUTPUT THE ARG RETURN /YES, GO AHEAD AND PRINT / SUBROUTINE TO CONVERT ASCII CHARS TO / A DECIMAL NUMBER / SETS CERTAIN FLAGS FOR RELATIVE OR ABSOLUTE, TOO ASCBIN, 0 CLA CLL DCA NUMBER /CLEAR NUMBER DCA SIGN /ASSUME + NUMBER DCA RELFLG /ASSUME ABSOLUTE DCA CVRTQ /NO CONVERSION YET TAD INCHAR /CHECK FOR SIGN TAD (-"+) SNA JMP ASCBN8 /IS PLUS, SET RELATIVE FLAG ASCBN2, TAD ("+-"-) /CHECK FOR MINUS SIGN SZA CLA JMP ASCBN3 /NOT "+" OR "-" STA DCA SIGN /SET FOR NEGATIVE NUMBER ASCBN8, STA DCA RELFLG /RELATIVE NUM JMS ASCBPT JMP ASCBN6 ASCBN3, TAD INCHAR /CHECK FOR GOOD NUMERIC CHAR TAD (-"9) SMA SZA JMP ASCBN4 /NO, GO RETURN TAD ("9-"0) SMA JMP ASCBN7 /GOOD NUMBER, USE IT ASCBN4, CLA CLL /RETURN ON BAD CHAR TAD INCHAR TAD (-",) /WAS CHAR A COMMA? SNA CLA JMP .+3 BACKUP /BACKUP ONE CHAR IF NOT COMMA SKP JMS ASCBPT TAD SIGN /CHECK SIGN OF RESULT SMA CLA JMP I ASCBIN /+, JUST RETURN TAD NUMBER CIA DCA NUMBER /-, MAKE THE NUMBER NEGATIVE JMP I ASCBIN ASCBN6, GETC /GET NEXT CHAR ASCBN5, TAD INCHAR /CHECK THE CHAR OUT TAD (-"9) SMA SZA JMP ASCBN4 /ILLEGAL CHAR TAD ("9-"0) SPA JMP ASCBN4 /ILLEGAL CHAR, TOO ASCBN7, DCA DIGIT /SAVE THE DIGIT TAD NUMBER CLL RTL TAD NUMBER CLL RAL /MULTIPLY PREVIOUS BY 10(10) TAD DIGIT /ADD IN NEW DIGIT DCA NUMBER /AND UPDATE NUMBER STA DCA CVRTQ /CONVERSION HAS TAKEN PLACE JMS ASCBPT JMP ASCBN6 /GET NEXT CHAR ASCBPT, 0 TAD CSWITCH SNA CLA JMP I ASCBPT /DON'T OUTPUT IF NOT COMMENT TAD INCHAR PUTC JMP I ASCBPT /IF /C, O.K. TO PRINT IN COMMENT / SUBROUTINE TO DO RELATIVISTIC CALCULATION, IF NECESSARY RELQ, 0 DCA RELQTM /SAVE OUT BASE NUMBER TAD CVRTQ /DID CONVERSION TAKE PLACE? SNA CLA JMP RELQ2 /NO, GO RETURN WITH BASE NUM TAD RELFLG /YES, WAS RELATIVE OR ABSOLUTE? SZA CLA TAD RELQTM /RELATIVE, ADD BASE NUMBER IN TAD NUMBER /ABSOLUTE, JUST GET NUMBER JMP I RELQ RELQ2, TAD RELQTM /GET BASE NUMBER BACK JMP I RELQ /AND RETURN RELQTM, 0 / SUBROUTINE TO OUTPUT A CHAR TO OUTPUT FILE XPUT, 0 DCA XPUTCH /SAVE CHAR TAD XPUTCH AND (400) /QUOTED CHAR? SNA CLA JMP .+4 /NOPE TAD ("_) /YES, OUTPUT QUOTE CHAR FOR PRINTR CIF 10 JMS I (XXPUT) TAD XPUTCH /GET CHAR BACK CIF 10 JMS I (XXPUT) DCA CRLFSW /SOMETHING AFTER A CR/LF JMP I XPUT XPUTCH, 0 / ROUTINE TO GET A CHAR FROM INPUT FILE / USES GENERAL I/O PACKAGE XGET, 0 CLA CLL CIF 10 /CALL GEN I/O PACKAGE JMS I (XXGET) /IN FIELD 1 JMP I XGET PAGE
/ ^D; DEFINE DOCUMENT PARAMETERS / PAPER WIDTH, PAPER LENGTH, FORMAT / 4 NUMBERS GIVING LONGITUDUNAL MARGINS DEFDOC, OUTCOM /START OF COMMENT "D GETC JMS ASCBIN /GET A NUMBER TAD PWIDTH /SEE IF THER'S A NEW WIDTH JMS RELQ DCA TEMP /SAVE THE WIDTH TAD TEMP TAD (-MXLENGTH) /IS IT GREATER THEN MAX ALLOWED? SMA SZA CLA JMP .+3 /YES, KEEP WHAT WE HAVE TAD TEMP /NO, USE THE NEW PAPER WIDTH DCA PWIDTH JMS COMMAQ /ANY MORE ARGS? GETC JMS ASCBIN /YES, GET THE PAGE LENGTH TAD PLENGTH JMS RELQ DCA PLENGTH JMS COMMAQ GETC JMS ASCBIN /THEN THE FORMAT TAD FORMAT /FORMAT RANGE CURRENTLY 0-0 JMS RELQ DCA FORMAT JMS COMMAQ GETC JMS ASCBIN /NEXT NUMBER, IF PRESENT IS TAD NLINE1 /NUMBER OF LINES FROM PAGE BREAK JMS RELQ / TO 'TOP TITLE' LINE DCA NLINE1 JMS COMMAQ GETC JMS ASCBIN /THE FOLLOWING NUMBER IS TAD NLINE2 /NUMBER OF LINES FROM 'TOP TITLT' LINE JMS RELQ / TO BODY OF PAGE DCA NLINE2 JMS COMMAQ GETC JMS ASCBIN /THEN COMES TAD NLINE3 /NUMBER OF LINES FROM BODY JMS RELQ / TO 'BOTTOM TITLE' DCA NLINE3 JMS COMMAQ GETC JMS ASCBIN /FINALLY, TAD NLINE4 /NUMBER OF LINES FROM 'BOTTOM TITLE' JMS RELQ / TO PAGE BREAK DCA NLINE4 DEFDR, OUTMESS /OUTPUT "PAPER SIZE" PSIZEL PSIZES TAD PLENGTH OUTNUM /OUTPUT PAGE LENGTH TAD (",) PUTC TAD PWIDTH OUTNUM /FOLLOWED BY PAGE WIDTH RETURN / SUBROUTINE TO CHECK CURRENT CHAR FOR COMMA COMMAQ, 0 TAD INCHAR TAD (-",) SNA CLA JMP I COMMAQ /IF COMMA, RETURN FOR NEXT ARG JMP DEFDR /END OF ^D COMMAND, SET NEW LINE / ^P, SKIP TO TOP OF NEW PAGE / IF NUMBER IS PRESENT, THEN USE TO RENUMBER PAGES / ^P-0 COMPLEMENTS THE PAGE PRINT FLAG NPAGE, OUTCOM /OUTPUT A COMMENT "P GETC JMS ASCBIN /GET NEW NUMBER OUTMESS /OUTPUT "PAGE" PAGEL PAGES TAD NUMBER /WAS VALUE OF NUMBER ZERO? SNA JMP .+3 NPAGE1, OUTNUM /NO, NEW NUMBER RETURN TAD RELFLG /^P-0 MEANS RELATIVE TAD CVRTQ /CONVERSION TOOK PLACE TAD SIGN /NEGATIVE NUMBER TAD (3) /DID ALL 3 FLAGS GET SET? SZA CLA RETURN /NO, JUST RETURN TAD PAGPFG /YES, COMPLEMENT PAGE PRINT FLAG CMA DCA PAGPFG TAD PAGPFG SNA CLA /PRINTING PAGE NO.? JMP NPAGE2 /YES OUTMESS /NO, OUTPUT "NONUMBER" NONUML NONUMS RETURN NPAGE2, OUTMESS /OUTPUT "NUMBER" NUML NUMS RETURN TTABLE, ZBLOCK 20 PAGE
/ DEFINE THE COMMANDS FOR PRINTR BLANKL, ASCIIZ "BLANK" BLANKS, ASCIIZ "B" NOJUSL, ASCIIZ "NOJUSTIFY" NOJUSS, ASCIIZ "NJ" JUSTL=NOJUSL+2 JUSTS=NOJUSS+1 PARAGL, ASCIIZ "PARAGRAPH" PARAGS, ASCIIZ "P" TITLL, ASCIIZ "TITLE " TITLS, ASCIIZ "T " INDENL, ASCIIZ "INDENT" INDENS, ASCIIZ "I" TABSL, ASCIIZ "TAB STOPS" TABSS, ASCIIZ "TS" NOFILL, ASCIIZ "NOFILL" NOFILS, ASCIIZ "NF" FILLL=NOFILL+2 FILLS=NOFILS+1 CENTL, ASCIIZ "CENTER MARGINS" CENTS, ASCIIZ "CM" MARGL=CENTL+7 MARGS=CENTS+1 SPACL, ASCIIZ "SPACING" SPACS, ASCIIZ "SP" TPAGEL, ASCIIZ "TEST PAGE" TPAGES, ASCIIZ "TP" PAGEL=TPAGEL+5 PAGES, ASCIIZ "PG" PSIZEL, ASCIIZ "PAPER SIZE" PSIZES, ASCIIZ "PS" NONUML, ASCIIZ "NONUMBER" NONUMS, ASCIIZ "NNM" NUML=NONUML+2 NUMS=NONUMS+1 BREAKL, ASCIIZ "BREAK" BREAKS, ASCIIZ "BR" FLAGM, ASCIIZ "FLAG CAPITALIZE;.FLAG FIRSTCAPITALIZE;" TRELL, ASCIIZ "TABS RELATIVE" TRELS, ASCIIZ "TR" PAGE
/ DEFINE SOME BUFFERS FOR GEN I/O OUBUF=. /MUST BE LOWER THAN INBUF OUCTL=OBUFL%2!4000 /OUTPUT BUFFER OF OBUFL WORDS INBUF=OUBUF+OBUFL INCTL=IBUFL%2!0000 /INPUT BUFFER OF IBUFL WORDS INRECS=INCTL%200 /NO. OF INPUT RECORDS IFG INBUF+IBUFL-6600 <PRINTX NO ROOM FOR HANDLERS!! > /6600 IS LOC OF HANDLERS FIELD 1 /NOW OUTPUT PAGE 0 LITERALS
/ GENERALIZED I/O PACKAGE / A MODIFIED VERSION OF PIP'S I/O PACKAGE / MODIFIED BY: CLYDE G. ROBY, JR. / DEPARTMENT OF MEDICINE / WEST VIRGINIA UNIVERSITY / MORGANTOWN, WEST VIRGINIA / MARCH 24, 1972 /EQUIVALENCES FOR GENERAL CHARACTER I/O ROUTINES IFNDEF OUBUF <OUBUF=0 /MUST BE LOWER THAN INBUF> IFNDEF OUCTL <OUCTL=5400 /OUTPUT BUFFER OF 3000 WORDS> IFNDEF OUDEVH <OUDEVH=7200 /PROVIDE ROOM FOR TWO-PAGE HANDLERS> IFNDEF INBUF <INBUF=3000> IFNDEF INCTL <INCTL=1600 /INPUT BUFFER OF 3400 WORDS> IFNDEF INRECS <INRECS=7 /INCTL/128> IFNDEF INDEVH <INDEVH=6600> /EQUIVALENCES NECESSARY TO INTERFACE WITH MONITOR DCB=7760 MPARAM=7643 /CD PARAMETER AREA PTP=20 /INTERNAL TYPE CODE: PAPER TAPE PUNCH FIELD 1 /EXECUTES IN FIELD 1
/GENERAL CHARACTER I/O ROUTINES /CALLED AS FOLLOWS: /JMS I (IOPEN INITIALIZES THE INPUT ROUTINE /JMS I (ICHAR READS A CHARACTER /ERROR RETURN AC>0 IF EOF, AC<0 IF READ ERROR /JMS I (OOPEN INITIALIZES THE OUTPUT ROUTINE /ERROR RETURN AC>P IF NO OUT DEV/FILE, AC<0 IF ERR /JMS I (OCHAR OUTPUTS A CHARACTER /ERROR RETURN OUTPUT ERROR OR TOO MUCH OUTPUT /JMS I (OCLOSE CLOSES THE OUTPUT FILE /ERROR RETURN FILE TOO LARGE TO BE CLOSED OR OUTPUT ERR /JMS I (OTYPE RETURNS DCB WORD OF OUT DEVICE IN AC /PARAMETERS NEEDED: /INBUF= ADDRESS OF INPUT BUFFER /INCTL= INPUT BUFFER CONTROL WORD /OUBUF= ADDRESS OF OUTPUT BUFFER /OUCTL= OUTPUT BUFFER CONTROL WORD (MUST BE NEGATIVE) /INRECS= [INCTL/128] /INDEVH= ADDRESS OF PAGE FOR INPUT HANDLER /OUDEVH= ADDRESS OF PAGE FOR OUTPUT HANDLER /CAN BE CALLED FROM ANY FIELD WITH BUFFERS IN ANY FIELD.
INFLD=INCTL&70 /GET FIELD OF INPUT BUFFER OUFLD=OUCTL&70 /DITTO OUTPUT BUFFER *4000 / IOPEN: INITIALIZE INPUT FILES IN7400, 7400 /*****MUST BE FIRST LOC OF PAGE***** IOPEN, 0 CLA CMA DCA INCHCT /SET INCHCT TO FORCE A READ ISZ INEOF /SET E-O-F FLAG TO FORCE A NEW FILE TAD (7617 DCA INFPTR /RESET FILE POINTER RDF TAD INCDIF DCA .+1 INPTR, HLT /RESTORE CALLING FIELDS JMP I IOPEN / ICHAR: GET A CHAR FROM INPUT FILES / RETURN TO .+1 IF ERROR (<0) / OR IF END-OF-FILE (>0) / RETURN TO .+2 WITH CHAR IN ACC ICHAR, 0 IN7600, 7600 RDF TAD INCDIF DCA INRTRN /SAVE CALLING FIELDS INCHRX, CDF INFLD ISZ INJMP /BUMP THREE-WAY UNPACK SWITCH ISZ INCHCT INJMPP, JMP INJMP TAD INEOF SNA CLA /DID LAST READ YIELD END-OF-FILE? JMP INGBUF /NO - DO ANOTHER GETNEW, JMP INNEWF /OPEN A NEW INPUT FILE INGBUF, TAD INKTR CLL TAD (INRECS SNL DCA INKTR /RESTORE INKTR IF IT HASN'T OVERFLOWED SZL /IS THIS THE LAST READ? ISZ INEOF /YES - SET END-OF-FILE FLAG CLL CML CMA RTR /CONSTRUCT A CTRL WORD FOR THE READ RTR /FROM THE AMOUNT OF THE OVERFLOW RTR /(IF ANY) AND THE STANDARD CTRL WORD TAD (INCTL+1 DCA INCTLW INCDIF, CDF CIF 0 CDF 10 JMS I INHNDL /CALL THE DEVICE HANDLER INCTLW, 0 INBUFP, INBUF INREC, 0 JMP INERRX /INPUT HANDLER ERROR INBREC, TAD INREC TAD (INRECS DCA INREC /UPDATE THE RECORD NUMBER TAD INCTLW AND IN7600 CLL RAL TAD INCTLW AND IN7600 CMA DCA INCHCT /COMPUTE THE NEW CHARACTER COUNT TAD INJMPP DCA INJMP /RESET THE CHARACTER SWITCH TAD INBUFP DCA INPTR /AND THE WORD POINTER JMP INCHRX /GO BACK AND MAKE BELIEVE / THIS NEVER HAPPENED INERRX, ISZ INEOF /EITHER AN END-OF-FILE OR A BADDIE SMA CLA /WHICH TYPE WAS IT? JMP INBREC /END OF FILE - RESUME THY PROCESSING INERR, CLA CLL CML RAR /BADDIE - GIVE ERR RETURN WITH NEG AC EOFERR, JMP INRTRN INJMP, HLT /THIS IS THE 3 - WAY CHARACTER SWITCH JMP ICHAR1 JMP ICHAR2 ICHAR3, TAD INJMPP DCA INJMP TAD I INPTR IN200, AND IN7400 CLL RTR RTR /COMBINE THE HIGH-ORDER FOUR BITS OF TAD INCTLW RTR /THE TWO WORD TO FORM THE 3RD CHAR RTR ISZ INPTR JMP INCOMN ICHAR2, TAD I INPTR AND IN7400 DCA INCTLW /SAVE HI-ORDER BITS FOR THE 3RD CHAR ISZ INPTR /BUMP THE WORD POINTER ICHAR1, TAD I INPTR INCOMN, AND (377 TAD (-232 SNA /IS THE CHARACTER A ^Z? JMP GETNEW /YES - GET A NEW FILE TAD (232 /RESTORE THE CHARACTER ISZ ICHAR /BUMP RETURN TO NORMAL RETURN INRTRN, 0 /RESTORE CALLING FIELDS JMP I ICHAR /AND RETURN /IOPEN IS UNNECESSARY. INCHCT, -1 /INPUT CHARACTER COUNT INNEWF, CDF 10 /NEW INPUT FILE JMS CHKHND /IS IT THE SAME HANDLER DCA INHNDL /INITIALIZE HANDLER ADDRESS TAD I INFPTR /GET NEXT CD INPUT FILE ENTRY SNA /ANY MORE? JMP EOFERR /NO - OUT OF INPUT JMS FETCHH /FETCH DEVICE HANDLER INHNDL, 0 /WILL HOLD RETURN ADDR JMS PUTUSR /RESTORE CORE TAD I INFPTR AND (7760 /GET LENGTH PART OF WORD SZA /LENGTH OF 0 MEANS LENGTH >=256 TAD (17 /ADD HIGH-ORDER BITS CLL CML RTR RTR DCA INKTR /STORE LENGTH OF FILE ISZ INFPTR TAD I INFPTR DCA INREC /STORE STARTING RECORD NUMBER OF FILE ISZ INFPTR DCA INEOF /ZERO END-OF-FILE FLAG JMP INGBUF /GO READ INKTR=IOPEN INFPTR, 0 /INPUT FILE POINTER INEOF, 0 /INPUT END-OF-FILE INDICATOR PAGE
/ OOPEN: SET UP OUTPUT FILE OOPEN, 0 OU7600, 7600 / RDF / TAD OUCDIF / DCA OORETN TAD OU7601 DCA OUBLK TAD (OUDEVH+1 DCA OUHNDL CDF 10 TAD I OU7600 /GET DEV NUM WORD OF OUTPUT FILE ENTRY AND (17 /STRIP OFF ANY LENGTH INFO SNA /IS THERE AN OUTPUT DEVICE? JMP ONOFIL /NO - INHIBIT OUTPUT JMS FETCHH /FETCH DEVICE HANDLER OUHNDL, 0 /OUTPUT DEVICE HANDLER ENTRY OUENTR, TAD I OU7600 JMS I (200 3 /ENTER OUTPUT FILE OUBLK, 7601 /REPLACED WITH STARTING BLOCK OUELEN, 0 /REPLACED WITH LENGTH OF HOLE JMP OEFAIL /FAILED - MAYBE WE ASKED TOO MUCH DCA OUCCNT DCA I (OUTINH /ZERO OUTPUT INHIBIT FLAG JMS I (OUSETP ISZ OOPEN OORETN, CDF CIF 10 /RESTORE CALLING FIELDS JMP I OOPEN OEFAIL, TAD I OU7600 AND (7760 /GET REQUESTED LENGTH SNA CLA /WAS IT AN INDEFINITE REQUEST JMP ONTERR /YES - CANNOT ENTER THE FILE TAD I OU7600 AND (17 /MAKE THE REQUESTED LENGTH ZERO DCA I OU7600 JMP OUENTR /TRY, TRY AGAIN ONTERR, CLA CLL CML RAR JMP OORETN /TAKE THE ERROR RETURN WITH AC<0 ONOFIL, ISZ I (OUTINH JMP OORETN /TAKE THE ERROR RETURN WITH AC=0 OUTDMP, 0 DCA OUCTLW /STORE THE CONTROL WORD CDF 10 TAD I (OUTINH SZA CLA JMP OUNOWR TAD OUCCNT SNA ISZ OUCTLW TAD OUBLK DCA OUREC /COMPUTE START BN OF THIS TRANSFER TAD OUCTLW CLL RTL RTL RTL AND (17 /COMPUTE THE NUMBER OF RECORDS TAD OUCCNT /UPDATE NUMBER OF BLOCKS IN THE FILE DCA OUCCNT TAD OUCCNT CLL CML TAD OUELEN SNL SZA CLA /DOES LENGTH EXCEED GIVEN LENGTH? JMP I OUTDMP /YES - SIGNAL OUTPUT ERROR OUCDIF, CDF CIF 0 CDF 10 JMS I OUHNDL OUCTLW, 0 OUBUF OUREC, 0 JMP OUERRX /OUTPUT HANDLER ERROR OUNOWR, ISZ OUTDMP /BUMP OUTDMP TO NORMAL RETURN OUERRX, JMP I OUTDMP /.+1 IF ERROR RTN / OCLOSE: CLOSE THE OUTPUT FILE / RETURN TO .+1 IF ERROR / RETURN TO .+2 IF A.O.K. OCLOSE, 0 / RDF / TAD OUCDIF / DCA OCRET CDF 10 TAD I (OUTINH SZA CLA /IS OUTPUT INHIBITED? JMP OCISZ /YES - CLOSE IS A NOP JMS I (OTYPE AND (770 TAD (-PTP /CHECK FOR PAPER TAPE PUNCH OUTPUT SZA CLA /AND SKIP ^Z OUTPUT IF TRUE TAD (232 /OUTPUT A ^Z JMS I (OCHAR JMP OCRET JMS I (OCHAR JMP OCRET FILLLP, JMS I (OCHAR JMP OCRET JMS I (OTYPE /GET TYPE OF OUTPUT DEVICE SPA CLA TAD (100 /IF ITS A DIRECTORY DEV FORCE A RECORD TAD (77 /BOUNDARY - OTHERWISE A HALF-RECORD AND I (OUDWCT SZA CLA /UP TO THE BOUNDARY YET? JMP FILLLP /NO - FILL WITH ZEROS TAD I (OUDWCT /GET DOUBLEWORD COUNT LEFT TAD (OUCTL&3700 SNA /A FULL WRITE LEFT? JMP NODUMP /YES, DON'T DO IT; THE ^Z IS ALREADY OUT TAD (4000+OUFLD /PUT IN THE FIELD BITS AND THE WRITE BIT JMS OUTDMP JMP OCRET /AN ERROR OCCURRED WHILE DUMPING BUFFER NODUMP, NOP /CATCHES SOME PORNO FOR FORCED DMP TAD I OU7600 /GET THE DEVICE NUMBER JMS I (7700 /JUST A ONE-SHOT 4 /CLOSE THE OUTPUT FILE OU7601, 7601 /POINTER TO THE OUTPUT FILE NAME OUCCNT, 0 SKP /ERROR WHILE CLOSING THE FILE - BAD! OCISZ, ISZ OCLOSE OCRET, CDF CIF 10 /RESTORE CALLING FIELDS JMP I OCLOSE PAGE
OUSETP, 0 /ROUTINE TO INITIALIZE CHAR POINTERS TAD (OUCTL&3700 /GET SIZE OF BUFFER IN DOUBLEWORDS CIA /NEGATE IT (PAL10 BLOWS) DCA OUDWCT TAD (OUBUF DCA OUPTR /INITIALIZE WORD POINTER TAD OUJMPE DCA OUJMP /INITIALIZE THREE-WAY CHARACTER SWITCH JMP I OUSETP / OCHAR: OUTPUT A CHAR TO OUTPUT DEVICE / RETURN .+1 IF ERROR OR NO ROOM / RETURN TO .+2 IF CHAR WENT OUT O.K. OCHAR, 0 AND (377 DCA OUTEMP RDF TAD (CDF CIF 0 DCA OUCRET TAD OUTINH SZA CLA /IS THERE AN OUTPUT FILE? JMP OUCOMN /NO - EXIT OUCHAR, CDF OUFLD /SET DATA FIELD TO BUFFER'S FIELD ISZ OUJMP /BUMP THE CHARACTER SWITCH OUJMP, HLT /THREE WAY CHARACTER SWITCH JMP OCHAR1 JMP OCHAR2 OCHAR3, TAD OUTEMP CLL RTL RTL AND (7400 TAD I OUPOLD DCA I OUPOLD /UPDATE FIRST WORD OF TWO WITH HIGH /ORDER 4 BITS OF THIRD CHAR TAD OUTEMP CLL RTR RTR RAR AND (7400 TAD I OUPTR DCA I OUPTR /UPDATE 2ND WORD FROM LOW ORDER 4 BITS TAD OUJMPE DCA OUJMP /RESET SWITCH ISZ OUPTR ISZ OUDWCT /BUMP DOUBLEWORD COUNTER EVERY 3 CHARS JMP OUCOMN TAD (OUCTL /LOAD CONTROL WORD FOR A FULL WRITE JMS I (OUTDMP /DUMP THE BUFFER JMP OUCRET /OUTPUT ERROR - GIVE ERROR RETURN JMS OUSETP /RE-INITIALIZE THE POINTERS JMP OUCOMN OCHAR2, TAD OUPTR DCA OUPOLD /SAVE POINTER TO FIRST WORD OF TWO ISZ OUPTR /BUMP WORD POINTER TO 2ND WORD OCHAR1, TAD OUTEMP DCA I OUPTR OUCOMN, ISZ OCHAR OUCRET, HLT /RESTORE CALLING FIELDS JMP I OCHAR OUTEMP, 0 OUPOLD, 0 OUPTR, 0 OUJMPE, JMP OUJMP OUDWCT, 0 OUTINH, 0 / OTYPE: GET DEVICE TYPE OF OUTPUT DEVICE OTYPE, 0 RDF TAD (CDF CIF 0 DCA OTRTN CDF 10 TAD I (7600 AND (17 TAD (DCB-1 DCA OUTEMP TAD I OUTEMP OTRTN, HLT JMP I OTYPE / GET USR INTO CORE GETUSR, 0 TAD USRSTAT /IS USR ALREADY IN CORE? SNA CLA JMP I GETUSR /YES, JUST RETURN JMS I (7700 /NO, GET USR INTO CORE 10 DCA USRSTAT /USR NOW IN CORE JMP I GETUSR USRSTAT, 7777 /7777 NOT IN CORE; 0 IN CORE / PUT USR BACK OUT OF CORE FETCHD, /FETCH HANDLER DEVICE NUMBER PUTUSR, 0 /SAVES A LOC ON PAGE TAD USRSTAT /IS USR ALREADY OUT? SZA CLA JMP I PUTUSR /YES, JUST RETURN JMS I (200 /NO, PUT USR AWAY 11 STA DCA USRSTAT /NOW USR IS NOT IN CORE JMP I PUTUSR / FETCH DEVICE HANDLER FETCHH, 0 DCA FETCHD /SAVE DEVICE NUM TO FETCH JMS GETUSR /MAKE SURE USR IS IN CORE TAD I FETCHH /GET LOC TO LOAD HANDLER DCA FETCHA TAD FETCHD /GET DEVICE TO LOAD JMS I (200 1 /FETCH DEVICE HANDLER FETCHA, 0 /HANDLER ADDR GOES HERE HLT /HUH!! TAD FETCHA DCA I FETCHH /SAVE FOR ROUTINE TO USE ISZ FETCHH JMP I FETCHH /RETURN / CLOSE ROUTINE AS USER SEES IT XXCLOSE, 0 CLA RDF TAD (CDF CIF 0) DCA XXCLSR /SAVE USER CALLING FIELDS CDF 10 /WE'RE IN FIELD 1 JMS I (OCLOSE /CLOSE THE OUTPUT FILE JMP XXCLSE /CLOSE ERROR XXCLSR, HLT /RESET USER CALLING FIELDS JMP I XXCLOSE /RETURN IF NO ERROR PAGE
/ I/O PACK STARTS HERE / SETUP: SET UP AND CALL COMMAND DECODER / ARG1 IS USER END-OF-FILE ROUTINE / ARG2 IS ASSUMED COMMAND DECODER EXTENSION SETUP, 0 DCA CDFLAG /WHETHER WE CALL CD OR NOT RDF /GET USER FIELDS TAD (CDF CIF 00 DCA SETUPR /SAVE RETURN LOC TAD I SETUP /GET COMMAND DECODE EXTENSION ISZ SETUP DCA CDEXT /SAVE FOR CALL TO CD TAD I SETUP ISZ SETUP CDF 10 /NOW CHANGE TO THIS FIELD SNA JMP .+4 /GO SAVE ASSUMED LOCS DCA EOFRTN /SAVE USER RETURN LOC TAD SETUPR /ALSO SAVE HIS CALLING FIELD JMP .+4 TAD (XXXEOF /ASSUMED E-O-F PROCEDURE DCA EOFRTN TAD (CDF CIF 10) DCA EOFR /SAVE FIELD RETURN, TOO JMS GETUSR /GET USR IN CORE ISZ CDFLAG /DO WE CALL THE COMMAND DECODER? JMP NOCD /NOPE CIF 10 JMS I (200 5 /CALL COMMAND DECODER CDEXT, 0 /ASSUMED EXTENSION HERE NOCD, TAD I (7600) SZA CLA /IS THERE AN OUTPUT FILE? JMP SETOPN /YES, GO OPEN I/O FILES DCA LPTDEV+1 /NO, TRY 'LPT' FIRST JMS I (200) 12 /INQUIRE WITHOUT FETCH LPTDEV, LP+T0!4000 /COMPRESSED CODE FOR 'LPT' 0 /DEVICE NUM GOES HERE 0 /ADDR IF HANDLER ALREADY IN CORE JMP TRYTTY /LPT: NOT AVAILABLE, TRY 'TTY' TAD LPTDEV+1 /GET DEVICE NUMBER JMP GOTDEV /WE HAVE THE DEVICE TRYTTY, DCA TTYDEV+1 /NO, ASSUME TTY: AS OUTPUT JMS I (200 12 /INQUIRE WITHOUT FETCH TTYDEV, TT+Y0!4000 /COMPRESSED CODE FOR TTY 0 /DEVICE NUM GOES HERE 0 /ADDR IF IN CORE GOES HERE HLT /WHAT - NO TTY: !!! TAD TTYDEV+1 /GET DEVICE NO. GOTDEV, DCA I (7600) /SAVE AS OUTPUT DEVICE NO. SETOPN, TAD I (7604) /ANY OUTPUT EXTENSION? SNA TAD (RO) /NO, ASSUME .RO ON OUTPUT DCA I (7604) JMS I (OOPEN /INITIALIZE OUTPUT ROUTINE SMA CLA JMP .+3 TAD (ERR5) JMP ERRPRT /IS AN ERROR MESSAGE JMS I (IOPEN /INITIALIZE INPUT ROUTINE JMS I (OTYPE /GET OUTPUT DEV TYPE AND (770 /PHYSICAL DEVICE TYPE TAD (-PTP) /IS IT THE PAPER TAPE PUNCH? SZA CLA JMP SETUPX /NO, GO RETURN TAD (-200) DCA XXTEMP /YES, NOW OUTPUT SOME LEADER/TRAILER JMS XXPUT /OUTPUT IT ISZ XXTEMP JMP .-2 SETUPX, JMS PUTUSR /RELEASE USR FROM CORE SETUPR, CDF CIF 00 /CHANGE TO USER FIELDS JMP I SETUP /AND RETURN CDFLAG, 0 RO="R-300^100+"O-300 TT="T-300^100+"T-300 Y0="Y-300^100 LP="L-300^100+"P-300 T0="T-300^100 / GET ROUTINE AS USER SEES IT XXTEMP, XXGET, 0 CLA RDF TAD (CDF CIF) DCA XXGETR /SAVE FIELD FRO M WHENCE WE WERE CALLLED CDF 10 /WE'RE IN FIELD 1 JMS I (ICHAR) JMP .+3 /ERROR RETURN XXGETR, HLT /CHANGE FIELDS BACK TO USER JMP I XXGET /O.K., RETURN WITH CHAR IN AC SMA CLA /FINAL END-OF-FILE? JMP EOFGO /YES, GO TO USER EXIT ROUTINE XXGETE, TAD (ERR4) /NO, IS HARDWARE ERROR JMP ERRPRT PAGE
/ PUT AS USER SEES IT XXPUT, 0 AND (377) /JUST WANT ASCII CHAR DCA XXPUTC /SAVE OUTPUT CHAR RDF TAD (CDF CIF) DCA XXPUTR /SAVE CALLING FIELDS CDF 10 /WE'RE IN FIELD 1 TAD XXPUTC JMS I (OCHAR /OUTPUT THE CHAR JMP XXPUTE /ERROR ON OUTPUT TAD XXPUTC TAD (-214 /SPECIAL CHAR CHECKING SNA JMP XXPFF /FORM FEED IAC /213 SNA JMP XXPVT /VERTICAL TAB TAD (213-211 SNA CLA JMP XXPHT /HORIZONTAL TAB XXPUTR, HLT /RESET USER FIELDS JMP I XXPUT /RETURN O.K. XXPFF, TAD (11-5 /FORM FEED, OUTPUT 9 ZEROS XXPVT, TAD (5-2 /VERTICAL TAB, OUTPUT 5 RUBOUTS XXPHT, TAD (2 /HORIZONTAL TAB, OUTPUT 2 RUBOUTS CIA JMS XXRUB /OUTPUT RUBOUTS OR ZEROES JMP XXPUTR XXPUTC, 0 /SAVE CHAR HERE / SUBROUTINE TO DUMP THE CURRENT BUFFER OUT / OUTPUT DEVICE SHOULD BE NON-DIRECTORY IF THIS ROUTINE USED PORNO=OCRET&177+5200 XXDUMP, 0 /ROUTINE TO FORCE BUFFER OUT CLA /WITHOUT CLOSING FILE RDF TAD (CDF CIF 0 DCA XXDMPR CDF 10 TAD (PORNO /SET UP TO NOT CLOSE DCA NODUMP /REPLACES OUR NOP JMS OCLOSE /DOES EVERYTHING ELSE BUT TAD (NOP /RESTORE PORNO LOC DCA NODUMP JMS OUSETP /START OVER AT BEGINNING XXDMPR, HLT /IF DIRECTORY DEV. HE'S CRAZY ANYWAY JMP I XXDUMP /GO ON BACK CHKHND, 0 /CHECK IF NEW HANDLER IS NEEDED. TAD INFPTR /WE NEED THE POINTER DCA CHKPTR /GET IT HERE TAD I CHKPTR /NEXT FILE SNA /NO MORE FILES? JMP EOFERR AND (17 /JUST THE HANDLER CIA /TO COMPARE TAD OLDHND SNA CLA /IF ZERO, NO CHANGE JMP INHNDL+2 /JUST GET NEW BLK NUM TAD I CHKPTR /GET NEW HANDLER AND (17 /JUST THE HANDLER DCA OLDHND /AND SAVE FOR NEXT TIME TAD (INDEVH+1 /GET HIS HANDLER ADDR. JMP I CHKHND /GO ON BACK OLDHND, 0 CHKPTR, 0 PAGE
/ PUT OR CLOSE ERROR ROUTINE XXCLSE, XXPUTE, SMA CLA /HARD OR SOFT ERROR? TAD (ERR0-ERR2 /SOFT: ERR0 TAD (ERR2) /HARD: ERR2 JMP ERRPRT /PRINT ERROR MESSAGE / END-OF-FILE ROUTINE EOFGO, EOFR, HLT /CHANGE TO FIELD JMP I .+1 /THEN EXECUTE E-O-F PROCEDURE EOFRTN, XXXEOF XXXEOF, JMS XXCLOSE XXXSGO, CDF CIF 00 /PS/8 IN FIELD 0 JMP I XXXCLA /RETURN TO SYSTEM / OUTPUT NO. OF RUBOUTS OR NULLS IN AC / UNLESS OUTPUT IS TO A DIRECTORY DEVICE XXRUB, 0 DCA XXXTMP /SAVE COUNT JMS I (OTYPE /GET TYPE OF OUTPUT DEV SPA CLA JMP I XXRUB /DIRECTORY DEVICE - DON'T BOTHER XXRUBL, TAD XXPUTC /GET THE CHAR TAD (-214) SNA CLA /IS THE CTRL CHAR A FORM-FEED? IAC /YES - OUTPUT BLANK TAPE INSTEAD TAD (377 /OTHERWISE, OUTPUT RUBOUTS JMS I (OCHAR /OUTPUT THEM JMP XXPUTE /ERROR RETURN ISZ XXXTMP JMP XXRUBL /LOOP FOR THE REQUIRED COUNT JMP I XXRUB XXXTMP, 0 /USED AS COUNTER AND POINTER XXXTTY, 0 TLS TSF JMP .-1 XXXCLA, 7600 /LOC TO RETURN TO PS/8 SYSTEM JMP I XXXTTY /NOT DEVICE INDEPENDENT - TOUGH BLEEP /ERROR MESSAGE PRINTOUT ROUTINE ERRPRT, DCA XXXTMP /SAVE LOC OF ERROR MESSAGE ERLP, TAD I XXXTMP RTR RTR RTR JMS ERPCH /PRINT HIGH-ORDER CHARACTER TAD I XXXTMP JMS ERPCH /PRINT LOW-ORDER CHARACTER ISZ XXXTMP JMP ERLP ERPCH, 0 AND (77 SNA JMP ERCRLF /0 CHARACTER TERMINATES TAD (-37 SNA JMP FILENR /"_" CHARACTER IS SPECIAL SPA TAD (100 TAD (237 JMS XXXTTY /OUTPUT THE CHAR JMP I ERPCH FILENR, TAD ("# JMS XXXTTY TAD INFPTR /GET PTR TO CURRENT INPUT FILE TAD (321 /MAGIC NUMBER CLL RAR JMP FILENR-2 ERCRLF, TAD (215 JMS XXXTTY TAD (212 JMS XXXTTY JMP XXXSGO /RETURN TO PS/8 SYSTEM ERR2, TEXTZ /OUTPUT ERROR/ ERR0, TEXTZ /NO ROOM FOR OUTPUT FILE/ ERR4, TEXTZ /INPUT ERROR, FILE_/ ERR5, TEXTZ /CAN'T OPEN OUTPUT FILE/ PAGE OUTMBF=. /TEMPORARY OUTPUT BUFFER DOT=OUTMBF+MXLENGTH+1 IFG DOT-7600 <PRINTX FIELD 1 IS TOO LONG > $-$-$



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search