/ PS/8 - IBM 9 TRACK TAPE / AND VICE VERSA / /C. G. ROBY AND D. J. DUFFY / / SPACEFOREWARD OPTION ADDED 1/22/73 / / JAMES H. DONNELLY PMODE FIXMRI INC=2000 /ISZ WHEN NOT EXPECTED TO SKIP *10 IBMXR, 0 /AUTOXR USED FOR IBM FETCH/PUT BUFFER CVXR, 0 /AUTOXR USED FOR ASCII TO EBCDIC CONVERSION *20 READ= JMS I .; READX TYPE= JMS I .; TYPEX CRLF= JMS I .; CRLFX MTWAIT= JMS I .; MTWATX TMESS= JMS I .; TMESSX MTCMD= JMS I .; MTCMDX MTWAIT= JMS I .; MTWATX MTERR= JMS I .; MTERRX OCTOUT= JMS I .; XOCT INPUT, 0 /LOCATION OF INPUT SUBROUTINE OUTPUT, 0 /LOCATION OF OUTPUT SUBROUTINE IOHAND, 0 /ADDR OF PS/8 I/O HANDLER PS8DEV, 0 /DEVICE NO. OF PS/8 DEVICE FNAME, ZBLOCK 4 /ROOM FOR PS/8 FILENAME LRECL, 0 /LOGICAL RECORD LENGTH FOR IBM MAGTAPE (-) BLKSIZE, 0 /BLOCK SIZE FOR IBM MAGTAPE (+) IBMWC, 0 /NO. OF WORDS LEFT IN BUFFER IBMCTR, 0 /NO. OF WORDS LEFT IN RECORD IBMCHAR, 0 /EBCDIC CHARACTER PS8WC, 0 /NO. OF 3/2 WORDS LEFT IN BUFFER PS8CA, 0 /CURRENT BUFFER ADDRESS PS8CHAR, 0 /ASCII CHARACTER GPS83, PPS83, 0 /TEMPROARY POINTER SAVE ERRCT, 0 /NO. OF PS/8 DEVICE ERRORS CSWIT, 0 /IGNORE TRAILING BLANKS ISWIT, 0 /IGNORE CHARS AFTER 72 PSWIT, 0 /CONVERT TO LPT FORMS CONTROL IN CC1 NSPACE, 0 /NO. OF TRAILING SPACES CHARNO, 0 /NO. OF CHAR ON CURRENT LINE CHAR, 0 /CURRENT I/O CHAR PAGE / / MAIN PROGRAM / ACCEPT COMMANDS FROM KEYBOARD / *200 CLA /INITIAL ENTRY TLS START, CRLF TMESS OPTP /PS/8 TO IBM MAGTAPE CRLF TMESS OPTI /IBM MAGTAPE TO PS/8 CRLF TMESS RWIPR /REWIND IBM MAGTAPE CRLF TMESS CCMESS /ALSO TELL ABOUT ^C CRLF TMESS QQQQQQ /? TO REPEAT COMMANDS CRLF KBM, CRLF TMESS DOQ /DO? : READ TAD [-203 /SYSTEM? SNA JMP SYSRTN TAD [203-"R SNA JMP DOREW /R, REWIND IBM MAGTAPE TAD ["R-"P SNA JMP PS8IBM /PS/8 CONVERSION TO MAGTAPE TAD ["P-"I] SNA JMP IBMPS8 /IBM TAPE TO PS/8 FILE TAD ["I-"?] SNA JMP START /?, REPEAT OPTIONS DECERR, CLA TMESS WHATQ /WHAT? CRLF JMP KBM / ^C, TYPE IT OUT, THEN RETURN TO PS/8 SYSRTN, TAD ["^ TYPE TAD ["C TYPE CRLF JMP I [7600] /RETURN TO PS/8 SYSTEM / R; REWIND IBM MAGTAPE DOREW, CRLF MTAF /CLEAR ALL FLAGS MTWAIT MTRS /TAPE IN REWIND STATE? AND [1000] SZA CLA JMP KBM /YES, RETURN TO KB MON TAD [RWND TRACK9] MTAF MTCR JMP .-1 MTLC /NO, GIVE REWIND COMMAND CLA MTGO /START REWIND TMESS RWING /TAPE IS REWINDING CRLF MTSF /WAIT FOR REWIND TO COMPLETE JMP .-1 MTERR /IGNORE BOT ERROR 0 SKP /NO SPECIAL ERRO CHKS 2776 JMP KBM PAGE / COPY IBM MAGTAPE TO PS/8 FILE IBMPS8, CRLF JMS SPACEF CRLF TMESS OUTPS8 /TELL HIM TO INPUT A PS/8 FILE NAME CRLF STA /INDICATE PS/8 IS OUTPUT JMS CD TMESS IBMIN /AND IBM MAGTAPE IS INPUT CRLF JMS GETLRL /GET LOGICAL RECORD SIZE JMS GETBLK /AND BLOCK SIZE /LEGAL OPTION ON THIS COPY ARE: /I, IGNORE INPUT PAST CHARACTER 72 /C, IGNORE TRAILING SPACES DCA CHARNO /NO CHARS ON LINE DCA NSPACE /NO SPACES YET IBMLOOP, JMS GETIBM /GET CHAR FROM IBM MAGTAPE JMP INEOF /INPUT END-OF-FILE AND [177] SNA JMP IBMLOOP /IGNORE ZERO CODE, LEADER/TRAILER TAD [200] /REGENERATE ASCII CHAR DCA CHAR /AND SAVE IT INC CHARNO /A CHAR ON LINE TAD CHAR TAD [-212] /LINE FEED COMES FROM IBM INPUT SUBR SNA JMP ELINE TAD [212-215] /CARRIAGE RETURN SZA CLA JMP IBMSAVE /GO SAVE CHAR ELINE, DCA CHARNO /LF OR CR, NO CHARS ON LINE TAD CSWIT /IGNORE THOSE TRAILING SPACES? SNA CLA JMP GSPACE /NO, GO GIVE 'EM TO OUTPUT ROUTINE DCA NSPACE /YES, ZERO THE CTR JMP IBMPUT /OUTPUT CR OR LF IBMSAVE, TAD ISWIT /IGNORE CHARS AFTER 72? SNA CLA JMP .+5 /NO, GIVE 'EM OUT TAD CHARNO /YES, ARE WE PAST 72? TAD [-110] SMA SZA CLA JMP IBMLOOP /YES, IGNORE CHARS TAD CHAR /SAVE THE CHAR TAD [-" ] SZA CLA JMP GSPACE /NOT A SPACE INC NSPACE /IF SPACE, JUST COUNT JMP IBMLOOP /GET MORE INPUT GSPACE, TAD NSPACE /ANY SPACES TO OUTPUT? SNA JMP IBMPUT /NO, JUST OUTPUT CHAR CIA DCA NSPACE /YES, MAKE A CTR TAD [" ] JMS PUTPS8 /OUTPUT THE SPACES JMP DEVFULL /IN CASE TAPE IS FULL ISZ NSPACE JMP .-4 /CONTINUE TO OUTPUT SPACES IBMPUT, TAD CHAR /OUTPUT CURRRENT CHAR JMS PUTPS8 /TO PS/8 FILE JMP DEVFULL JMP IBMLOOP /GO FOR MORE INPUT CHARS / END-OF-FILE ON INPUT, GIVE OUTPUT EOF INEOF, TAD [232] /CTRL/Z JMS PUTPS8 /TO CLOSE FILE JMP DEVFULL /NO ROOM FOR IT COPOUT, CRLF TMESS COPYX /INFORM USER COPY DONE CRLF JMP KBM /RETURN TO KEYBD MONITOR / END-OF-FILE ON PS/8 INPUT FILE INEOF8, JMS PS8PAD /FINISH CURRENT LINE TAD ["$] JMS PUTIBM /DOLLAR SIGN AS FIRST CHAR NOP /EOF FALLS THRU TAD [232] /CTRL/Z JMS PUTIBM /TO CLOSE FILE JMP DEVFULL /NO ROOM FOR IT JMP COPOUT /INFORM USER THAT COPY IS DONE / OUTPUT DEVICE OR FILE IS FULL, GIVE ERROR DEVFULL, TMESS DEVFMSG /INFORM USER THAT DEVICE IS FULL CRLF JMP KBM / SAVE PS8 CHAR IN IBM MAGTAPE ROUTINE SAVEPS8, 0 DCA CHAR8 /SAVE CHAR A SEC INC CHARNO /ONE MORE CHAR ON LINE TAD ISWIT /IGNORE PAST CHAR 72? SNA CLA JMP .+5 /NO TAD CHARNO /YES, MAKE THE CHECK TAD [-110] SMA SZA CLA JMP I SAVEPS8 /IS > 72, IGNORE AND RETURN STA TAD CHARNO /ARE WE AT FIRST CHAR ON LINE? SZA CLA JMP SAVE8 /NO, GO SAVE CURRENT CHAR TAD PSWIT /YES, IN PRT CTRL MODE? SNA CLA JMP SAVE8 /NO, GO SAVE CURRENT CHAR TAD CHAR1 /YES, GET ACTUAL ASCII CHAR TAD (TAD TABLE1) DCA .+1 TAD /GET THE ASCII CTRL CHAR JMS PUTIBM /SAVE CHAR ON IBM TAPE JMP DEVFULL /IN CASE TAPE IS FULL SAVE8, TAD CHAR8 /REGULAR CHAR JMS PUTIBM /SAVE CHAR IN IBM TAPE JMP DEVFULL /TAPE IS FULL JMP I SAVEPS8 CHAR8, 0 /HOLDS ASCII CHAR TABLE1, "+ /OVERPRINT " /SINGLE SPACE "0 /DOUBLE SPACE "- /TRIPLE SPACE "1 /TOP OF FORM PAGE / COPY PS/8 FILE TO IBM MAGTAPE PS8IBM, CRLF JMS SPACEF /FILE SKIPS TMESS INPS8 /TELL HIM TO GIVE PS8 INPUT FILE CRLF CLA /PS/8 IS INPUT JMS CD /CALL COMMAND DECODER (*) TMESS IBMOUT /IBM MAGTAPE IS OUTPUT CRLF JMS GETLRL /GET LOGICAL RECORD LENGTH JMS GETBLK /GET BLOCK SIZE /LEGAL OPTIONS ON THIS COPY ARE: /I, IGNORE PAST CHARACTER 72 /P, OUTPUT IS SPECIAL PRINT CONTROL DCA CHARNO /NO CHARS YET DCA NSPACE /NO SPACES, EITHER TAD [4] DCA CHAR1 /I /P, FIRST OUT IS FORM FEED '1' PS8LOOP, JMS GETPS8 /GET PS/8 ASCII CHAR JMP INEOF8 /END-OF-FILE ON PS/8 FILE AND [177] SNA JMP PS8LOOP /IGNORE ZERO CODE, LEADER/TRAILER TAD [200-377] SNA JMP PS8LOOP /IGNORE RUBOUT CHARACTERS TAD [377-211] SNA JMP PS8TAB /CONVERT TABS TO SPACES TAD [211-212] SNA JMP PS8LF /LINE FEED TAD [212-214] SNA JMP PS8FF /FORM FEED TAD [214-215] SZA JMP PS8SAVE /GO SAVE PS8 CHAR ON IBM MAGTAPE PS8CR, TAD PSWIT /SPECIAL PRINT CONTROL? SNA CLA JMP PS8CR3 /NO, IGNORE CR TAD CHARNO /YES, CHARS ON LINE? SNA CLA JMP PS8CR1 /NO, CHECK SPECIAL PRT CTRLS PS8CR0, JMS PS8PAD /PAD LINE AND OUTPUT IT PS8CR3, DCA CHARNO /NO CHARS ON LINE DCA CHAR1 /'+', OVERPRINT JMP PS8LOOP PS8CR1, TAD CHAR1 TAD (-4) /IF FIRST CHAR IS '1' SNA CLA JMP PS8CR0 /WE MUST PAD THE LINE JMP PS8LOOP /OTHERWISE, IGNORE CR PS8LF, TAD PSWIT /SPECIAL PRT CTRL MODE? SNA CLA JMP PS8LF3 /NO, BUT OUTPUT THE LINE TAD CHARNO /YES, ANY CHARS ON LINE SNA CLA JMP PS8LF1 /NO, CHANGE CHAR1 PS8LF3, JMS PS8PAD /PAD AND OUTPUT LINE PS8LF0, CLA IAC DCA CHAR1 /' ', SINGLE SPACE BEFORE PRINT DCA CHARNO /NO CHARS ON LINE JMP PS8LOOP PS8LF1, TAD CHAR1 TAD (JMP I LFTABLE) DCA .+1 JMP /TO CORRECT PLACE FOR LF PS8LF2, INC CHAR1 /' ' TO '0', DOUBLE SPACE, OR JMP PS8LOOP /'0' TO '-', TRIPLE SPACE PS8FF, TAD PSWIT /SPECIAL PRINT CTRLS? SNA CLA JMP PS8FF0 /NO, IGNORE FF TAD CHARNO SZA CLA /ANY CHARS ON LINE? JMS PS8PAD /YES, OUTPUT LINE FIRST PS8FF0, TAD (4) DCA CHAR1 /'1' FOR FORM FEED (TOP OF PAGE) DCA CHARNO /NO CHARS YET JMP PS8LOOP PS8TAB, TAD [" ] JMS SAVEPS8 /SAVE SPACES TAD CHARNO AND [7] /ARE WE AT NEXT TAB STOP? SZA CLA JMP PS8TAB /NO, MORE SPACES NEEDED JMP PS8LOOP /YES, GET NEXT CHAR PS8SAVE, TAD [215] /REGENERATE PS8 CHAR DCA CHAR TAD CHAR JMS SAVEPS8 /GO OUTPUT CHAR TO IBM TAPE JMP PS8LOOP PS8PAD, 0 /MAKE SURE THAT A CHAR IS ON LINE TAD [" ] JMS SAVEPS8 /OUTPUT A SPACE FOR SURE TAD [215] JMS PUTIBM /THIS OUTPUTS THE BUFFER JMP DEVFULL /MAGTAPE IS FULL JMP I PS8PAD CHAR1, 0 /HOLDS PRT CTRL CHAR NO. LFTABLE, PS8LF0 PS8LF2 PS8LF2 PS8LF3 PS8LF3 PAGE / / DECIMAL INPUT ROUTINE / DECIN, 0 DECIN0, CLA DECIN1, DCA DECNUM /CLEAR INPUT NUMBER READ DCA DECHAR /SAVE INPUT CHAR TAD DECHAR TAD [-"9] SMA SZA JMP DECEND /NOT DIGIT TAD ["9-"0] SPA JMP DECEND /NOT DIGIT DCA DECDIG /SAVE DIGIT TAD DECNUM CLL RTL TAD DECNUM CLL RAL /MULT NUM BY 10(10) TAD DECDIG /ADD IN NEW DIGIT JMP DECIN1 /GO SAVE UPDATED NUMBER DECEND, CLA /ENDED ON NON-DIGIT CHAR TAD DECHAR TAD [-377] SZA JMP DECEN1 TAD ["_] /RUBOUT, ECHO BACKARROW TYPE JMP DECIN0 /GET NEW INPUT NUMBER DECEN1, TAD [377-240] SNA JMP DECRET /SPACE ENDS THE NUMBER TAD [240-215] SZA CLA /EOL ALSO ENDS NUMBER JMP DECERR /ANYTHING ELSE CAUSES ERROR DECRET, TAD DECNUM /GET NUMBER TO AC JMP I DECIN /AND RETURN DECNUM, 0 DECHAR, 0 DECDIG, 0 WRIPS8, 0 /PS/8 WRITE ROUTINE CLL STA RTL /-3 TO AC DCA ERRCT /NO. OF TRIES WRI8, JMS I IOHAND /CALL DEVICE HANDLER 4200 /WRITE 2 PAGES PS8BUFF OBLOCK, 0 /TO THIS BLOCK NO. JMP WRIERR /DEVICE WRITE ERROR INC OBLOCK /NEXT BLOCK NO. INC OCOUNT /ACTUAL NO. OF BLKS WRITTEN ISZ OLENGTH /ALL BLOCKS OUT? JMP I WRIPS8 /NO, RETURN JMP PPS88 /YES, RETURN TO .+2 FROM PUTPS8 WRIERR, TMESS ERRDEV /DEVICE ERROR ON PS/8 CRLF ISZ ERRCT /TRIES 3 TIMES? JMP WRI8 /NO, TRY AGAIN ABORTD, TMESS FATALERR /YES, INDICATE FATAL DEVICE ERR CRLF JMP KBM / ASCII TO EBCDIC CHARACTER CONVERSION ASCEBC, 0 AND [177] /7-BIT ASCII TAD [ASCTAB] /ASCII TO EBCDIC TABLE DCA ASCPTR TAD I ASCPTR /GET EBCDIC CHARACTER JMP I ASCEBC /AND RETURN ASCPTR, 0 PAGE / / CALL THE COMMAND DECODER OF PS/8 / USE THE '*' MODE TO GET NAMES OF FILES / SO WE DO THE LOOKUP AND ENTER / CD, 0 DCA IOSWIT /SAVE WHETHER THIS IS I OR O CIF 10 JMS I [7700] /LOCK USR IN CORE 10 GETCD, CIF 10 JMS I [200] 5 /COMMAND DECODE TEXT "*" /SPECIAL MODE CDF 10 TAD I [7605] /INPUT/OUTPUT FILENAME DCA PS8DEV /SAVE PS/8 DEVICE TAD I [7606] DCA FNAME /MOVE FILENAME DOWN TAD I [7607] DCA FNAME+1 TAD I [7610] DCA FNAME+2 TAD I [7611] DCA FNAME+3 TAD I [7643] /CHECK FOR OPT CHAR 'C' AND [1000] DCA CSWIT /OGNORE TRAILING BLANKS TAD I [7643] /CHECK FOR OPT CHAR 'I' AND [0010] DCA ISWIT /IGNORE CHARS AFTER 72 TAD I [7644] /CHECK FOR OPT CHAR 'P' AND [0400] DCA PSWIT /OUTPUT PRINTER FORMS CONTRL CDF 00 TAD [7201] DCA DEVLOC /ALLOW 2 PAGE DEVICE HANDLER TAD PS8DEV SNA JMP GETCD /NO DEVICE, CALL CD AGAIN CIF 10 JMS I [200] 1 /FETCH DEVICE HANDLER DEVLOC, 7201 /LOAD AT 7200 JMP NODEV /BAD DEVICE TAD DEVLOC /NOW HAS ENTRY POINT DCA IOHAND /SAVE ON PAGE 0 ISZ IOSWIT /INPUT OR OUTPUT? JMP INPPS8 /INPUT FILE FOR PS/8 TAD [FNAME] DCA OSTART /OUTPUT STARTING BN TAD PS8DEV CIF 10 JMS I [200] /FIND SOME ROOM 3 /ENTER OUTPUT FILE OSTART, FNAME /OVERLAID WITH STARTING BN OLENGTH, 0 /NO. OF BLKS IN OUTPUT FILE HLT TAD OSTART DCA OBLOCK /INITIALIZE STARTING BN DCA OCOUNT /NO BLKS OUTPUT YET JMP RLSE /RELEASE USR INPPS8, TAD [FNAME] DCA ISTART TAD PS8DEV CIF 10 JMS I [200] 2 /LOOKUP NAME ON DEV ISTART, FNAME /OVERLAID WITH START BN ILENGTH, 0 /NO. OF BLKS IN INPUT FILE JMP NOTFOUND /FILE NOT FOUND TAD ISTART DCA IBLOCK /INITIALIZE STARTING BN TAD ILENGTH /GET INPUT LENGTH SNA STL CLA RTR /IF ZERO, ASSUME -6000(8) DCA ILENGTH /SAVE THE LENGTH RLSE, CIF 10 JMS I [200] /RELEASE USR FROM CORE 11 TAD [RDIBM] /INITIALIZE I/O COROUTINES DCA GIBM1 TAD [PIBM2] DCA PIBM1 TAD [GPS82] DCA GPS81 TAD [PPS82] DCA PPS81 TLS /START TTY UP AGAIN JMP I CD NODEV, TMESS BDEV /BAD DEVICE GIVEN ON INPUT CRLF JMP GETCD /TRY AGAIN NOTFOUND, TMESS NFMESS /NO FILE FOUND CRLF JMP GETCD /TRY CD AGAIN IOSWIT, 0 /7777 IF OUTPUT / GET LOGICAL RECORD LENGTH FOR IBM TAPE GETLRL, 0 TMESS LRLMSG /INDICATE LRL IS WHAT WE WANT JMS DECIN /GET THE NUMBER SNA TAD [120] /IF 0, ASSUME 80 CIA DCA LRECL /SAVE LOGICAL RECORD LEGNTH CRLF JMP I GETLRL / GET BLOCKSIZE IN CHARS GETBLK, 0 TMESS BLKMSG /TELL USER WHAT WE WANT JMS DECIN /GET THE BLKSIZE SNA TAD [120] /IF ZERO, ASSUME 80 DCA BLKSIZE /SAVE BLOCK SIZE CRLF JMP I GETBLK PAGE / / INPUT ROUTINE FOR IBM MAGTAPE DRIVE / RETURN WITH ASCII CHAR IN AC / RET TO .+1 IF END OF FILE / GETIBM, 0 CLA CLL JMP I .+1 /GO TO RIGHT PLACE IN SUBR GIBM1, RDIBM /READ FIRST BLOCK INC GETIBM /RETURN .+2 WITH ASCII CHAR GETEOF, JMP I GETIBM RDIBM, CLA MTAF /CLEAR ALL FLAGS MTWAIT TAD BLKSIZE CIA DCA I [WC] /SIZE OF PHYSICAL RECORD TAD [BUFFER-1] /PLACE TO READ IN BUFFER DCA I [CA] TAD [READTAPE TRACK9] MTCMD /GIVE THE COMMAND MTWAIT /WAIT FOR COMPLETION MTERR /ERRORS? 0100 /CHECK FOR END-OF-FILE JMP GETEOF /END-OF-FILE ON INPUT 0 /ANY OTHER ERROR STOPS IT TAD [BUFFER-1] /NO, NOW PROCESS BUFFER DCA IBMXR TAD BLKSIZE DCA IBMWC /NO. OF WORDS LEFT TO PROCESS GIBM3, TAD LRECL DCA IBMCTR /NO. OF CHARS IN RECORD GIBM2, CDF 10 /IBM BUFFER IN FIELD 1 TAD I IBMXR /GET A CHAR FROM BUFFER CDF 00 JMS EBCASC /CONVERT TO ASCII JMS GIBM1 /RETURN ISZ IBMCTR /RECORD EMPTY? JMP GIBM2 TAD [215] /YES, RETURN WITH CR JMS GIBM1 TAD [212] /FOLLOWED BY LINE FEED JMS GIBM1 CLL /CLEAR LINK BIT TAD LRECL TAD IBMWC /A FULL RECORD IN BUFFER? SNA JMP RDIBM /NO MORE ROOM IN BUFFER SNL JMP RDIBM /FULL RECORD WON'T FIT DCA IBMWC /YES, SAVE UPDATED COUNTER JMP GIBM3 /PROCESS NEW RECORD / / OUTPUT ASCII CHARS TO IBM MAGTAPE / FIRST CONVERT TO EBCDIC CHARS / RETURN TO .+1 IF NO MORE ROOM ON TAPE / PUTIBM, 0 AND [177] /ASCII CHAR TAD [-32] SNA JMP PUTEOF /IS END-OF-FILE CHAR TAD [32-15] SNA JMP PIBM9 /CARRIAGE RETURN TAD [15] /REGENERATE CHAR JMS ASCEBC /CONVERT TO EBCDIC DCA IBMCHAR /SAVE CHAR JMP I .+1 PIBM1, PIBM2 PIBM5, CLA CLL INC PUTIBM JMP I PUTIBM /RETURN TO .+2 PIBM7, CLA JMS WRIBM /OUTPUT CURRENT BUFFER PIBM2, TAD [BUFFER-1] DCA IBMXR /STORE CHARS THRU HERE TAD BLKSIZE DCA IBMWC /NO. OF CHARS LEFT IN BUFFER PIBM4, TAD LRECL DCA IBMCTR /NO. OF CHARS ON THIS RECORD SKP PIBM3, JMS PIBM1 /RETURN TAD IBMCHAR CDF 10 /IBM BUFFER IN FIELD 1 DCA I IBMXR /SAVE IN BUFFER CDF 00 ISZ IBMCTR /RECORD FULL? JMP PIBM3 /NO, SAVE MORE CHARS PIBM6, CLL /CLEAR LINK BIT TAD LRECL /YES TAD IBMWC /ROOM IN BUFFER FOR ANOTHER RECORD? SNA JMP PIBM7 /NO MORE ROOM IN BUFFER SNL JMP PIBM7 /RECORD WON'T FIT IN BUFFER DCA IBMWC /NEW WORKING ARE JMP PIBM4 /RESET RECORD SIZE WRIBM, 0 /OUTPUT CURRENT BUFFER MTAF /CLEAR ALL FLAGS MTWAIT TAD BLKSIZE CIA DCA I [WC] /SET UP LENGTH OF BLOCK SIZE TAD [BUFFER-1] /WHERE TO WRITE FROM DCA I [CA] TAD [WRITE TRACK9] MTCMD /GIVE TAPE COMMAND MTWAIT /WAIT ON COMPLETEION MTERR 0400 /CHECK FOR END OF TAPE JMP I PUTIBM /PHYSICAL TAPE IS FULL 0 /OTHERWISE, ANY ERROR IS BAD JMP I WRIBM PUTEOF, JMS WRIBM /OUTPUT LAST BUFFER MTAF MTWAIT TAD [EOF TRACK9] MTCMD /OUTPUT AN END-OF-FILE MTWAIT MTERR 0 SKP 3676 /IGNORE EOF ERROR JMP PIBM5 PIBM9, TAD IBMCTR /RECORD FULL? SNA CLA JMP PIBM11 /YES, IGNORE THE LINE FEED PIBM10, TAD [100] /SPACE CHAR (EBCDIC) CDF 10 /IBM BUFFER IN FIELD 1 DCA I IBMXR /SAVE SPACES IN BUFFER CDF 00 ISZ IBMCTR JMP PIBM10 PIBM11, JMS PIBM1 /RETURN, THEN GET JMP PIBM6 / NEW RECORD PAGE / / OUTPUT ASCII CHARS TO PS/8 FILE / RETURN TO .+1 IF NO MORE ROOM / PUTPS8, 0 AND [377] DCA PS8CHAR /SAVE PS/8 CHAR JMP I .+1 /GO TO RIGHT PLACE IN SUBR PPS81, PPS82 CLA CLL TAD PS8CHAR /WAS CHAR EOF? TAD [-232 SNA CLA JMP PS8EOF /YES, GO DO PS8 EOF PROCEDURE PPS85, INC PUTPS8 /RETURN TO .+2 PPS88, JMP I PUTPS8 /RETURN TO .+1 PPS82, TAD [-200] DCA PS8WC /NO. OF CHARS IN BUFFER TAD [PS8BUFF] /SET UP LOC TO PUT CHARS DCA PS8CA PPS84, TAD PS8CHAR DCA I PS8CA /SAVE CHAR 1 TAD PS8CA DCA PPS83 /TEMP POINTER SAVE JMS PPS81 /RETURN AFTER CHAR 1 INC PS8CA /INCREMENT POINTER TAD PS8CHAR DCA I PS8CA /AND SAVE CHAR NO. 2 JMS PPS81 /RETURN FOR NEXT CHAR TAD PS8CHAR /FOR CHAR 3 RTL RTL AND [7400] /TOP OF CHAR 3 TAD I PPS83 /ADD TO FIRST CHAR DCA I PPS83 /AND SAVE THEM TAD PS8CHAR RTR RTR RAR AND [7400] /LOW PART OF 3RD CHAR TAD I PS8CA /CHAR NO. 2 DCA I PS8CA /SAVE WITH SECOND CHAR INC PS8CA /INCREM CURRENT ADDR JMS PPS81 /RETURN ISZ PS8WC /BUFFER FULL? JMP PPS84 /NO, FILL THE BUFFER JMS WRIPS8 /YES, OUTPUT THE CURRENT BUFFER JMP PPS82 /THEN RESET PTRS, CTRS PS8EOF, JMS WRIPS8 /OUTPUT LAST BUFFER TAD PS8DEV CIF 10 JMS I [7700] /CALL THE USR 4 /CLOSE THE FILE FNAME OCOUNT, 0 /ACTUAL NO. OF BLKS WRITTEN HLT JMP PPS85 / / GET ASCII CHARS FROM PS/8 FILE / RETURN TO .+1 IF END-OF-FILE / GETPS8, 0 CLA CLL JMP I .+1 /GO TO CORRECT PLACE IN SUBR GPS81, GPS82 AND [377] /JUST WANT ASCII CHAR SNA JMP GETPS8+1 /IGNORE ZERO CODE TAD [-232] SZA TAD [232] /NOT EOF, RESTROE CHAR SZA INC GETPS8 /NOT EOF, RET TO .+2 JMP I GETPS8 /EOF, RET TO .+1 GPS82, CLL STA RTL /-3 TO AC DCA ERRCT /TRY 3 TIMES TAD ILENGTH SNA CLA JMP GPS86 /NO MORE BLKS IN FILE GPS85, JMS I IOHAND /READ INPUT HANDLER 0200 /READ 2 PAGES PS8BUFF IBLOCK, 0 /FROM THIS BLOCK NUM JMP DEVERR /DEVICE HANDLER ERROR INC IBLOCK /INCREMENT BN ISZ ILENGTH /NO. OF BLKS LEFT NOP TAD [PS8BUFF] DCA PS8CA /INITIALIZE BUFFER PTR TAD [-200] /AND COUNTER DCA PS8WC GPS84, TAD I PS8CA /GET CHAR 1 JMS GPS81 TAD I PS8CA INC PS8CA /INREM FOR CHAR 2 AND [7400] CLL RTR RTR DCA GPS83 /SAVE PART OF CHAR 3 TAD I PS8CA JMS GPS81 /RET WITH CHAR 2 TAD I PS8CA INC PS8CA AND [7400] /MORE OF CHAR 3 CLL RTL RTL RAL TAD GPS83 /FIRST PART OF CHAR 3 JMS GPS81 /RETURN WITH CHAR 3 ISZ PS8WC /BUFFER EMPTY? JMP GPS84 /NO, GET MORE FROM BUFFER JMP GPS82 /YES, GO READ NEW BLK DEVERR, TMESS ERRDEV /ERROR ON PS/8 DEVICE CRLF ISZ ERRCT JMP GPS85 /TRY AGAIN JMP ABORTD /REALLY BAD, ABORT OPERATION GPS86, TMESS BADIN /BAD INPUT FILE CRLF JMP I GETPS8 /SIMULATE END-OF-FILE PAGE / MTCMDX, 0 /ISSUE A TAPE COMMAND MTAF /CLEAR FLAGS MTCR /WAIT FOR CONTROL TO FINISH JMP .-1 MTLC /LOAD COMMAND CLA TAD [10] /FIELD IS 1, BITS 6-8 MTGO /GIVE GO SIGNAL MTWAIT /WAIT FOR COMMAND MTSF JMP .-1 JMP I MTCMDX MTWATX, 0 /WIAT ON MAGTAPE TO FINISH MTTR JMP .-1 MTCR JMP .-1 JMP I MTWATX MTERRX, 0 CLA MTRS /READ TAPE STATUS AND I MTERRX /CHECK FOR SPECIAL ERROR INC MTERRX SZA CLA JMP I MTERRX /IS SPECIAL ERROR, RTN INC MTERRX /SKIP OVER SPECIAL 'JMP' TAD I MTERRX /GET ERROR MASK INC MTERRX SNA JMP MTER2 DCA MTER1 MTRS AND MTER1 SZA JMP MTER3 JMP MTER4 MTER2, MTRS SMA CLA JMP MTER4 MTER3, CLA /PRINT THE ERROR STATUS MTRS OCTOUT CRLF MTAF JMP KBM /THEN GO TO KB MON MTER4, MTAF JMP I MTERRX MTER1, 0 TYPEX, 0 TSF JMP .-1 TLS CLA JMP I TYPEX READX, 0 KSF JMP .-1 KRB TSF JMP .-1 TLS JMP I READX CRLFX, 0 TAD [215 TYPE TAD [212 TYPE JMP I CRLFX TMESSX, 0 TAD I TMESSX INC TMESSX DCA TMESS2 /SAVE ADDRESS OF SIXBIT CODE TMESS1, TAD I TMESS2 RTR;RTR;RTR JMS TMESS3 TAD I TMESS2 JMS TMESS3 INC TMESS2 JMP TMESS1 TMESS2, 0 TMESS3, 0 AND [77] TAD [" -".] /. IS END OF STRING SNA JMP I TMESSX /IF SO, THEN RETURN TAD [".] /GENERATE ASCII CHAR TYPE JMP I TMESS3 XOCT, 0 CLL RAL DCA XOCT1 TAD [-4 DCA XOCT2 XOCT3, TAD XOCT1 RTL;RAL DCA XOCT1 TAD XOCT1 AND [7 TAD [260 TYPE ISZ XOCT2 JMP XOCT3 TAD [240 TYPE JMP I XOCT XOCT1, 0 XOCT2, 0 /CONVERT EBCDIC TO ASCII EBCASC, 0 AND [377] TAD [EBCTAB] DCA CVPTR TAD I CVPTR /GET ASCII CHAR JMP I EBCASC CVPTR, 0 PAGE / SEARCH FOR EOF AND SKIP THE INDICATED NUMBER OF FILES EOFCNT, 0 SFCMD, 0463 /SPACE FOREWARD SPACEF, 0 CRLF TMESS NEOF /ASK HOW MANY FILES CLA JMS DECIN SNA JMP SPACER /NONE TO SKIP CIA DCA EOFCNT CRLF REPEAT, TAD [0] /DUMMY RECORD COUNT DCA WC MTAF MTCR JMP .-1 CLA TAD SFCMD /SPACE FOREWARD COMMAND MTLC /LOAD COMMAND REGISTER CLA MTGO /SPACE MTWAIT CLA MTRS /READ STATUS AND [0100] /EOF MASK SNA SPA JMP REPEAT /NO EOF, TRY AGAIN ISZ EOFCNT /ONE EOF DOWN, ANY MORE? JMP REPEAT /YES SPACER, CRLF CLA JMP I SPACEF /NO NEOF, SIXBIT "NUMBER OF FILES TO SKIP= ." PAGE / / CHARACTER STRINGS USED IN PROGRAM / OPTP, SIXBIT "P---" COPYPI, SIXBIT "COPY PS/8 FILE TO IBM MAGTAPE." OPTI, SIXBIT "I---" COPYIP, SIXBIT "COPY IBM MAGTAPE TO PS/8 FILE." RWIPR, SIXBIT "R---REWIND IBM MAGTAPE." CCMESS, SIXBIT "^C--RETURN TO PS/8 SYSTEM." QQQQQQ, SIXBIT "?---REPEAT OPTION PRINTOUT." DOQ, SIXBIT "DO? :." WHATQ, SIXBIT " WHAT?." RWING, SIXBIT "IBM MAGTAPE NOW REWINDING." INPS8, SIXBIT "TYPE IN PS/8 INPUT FILE NAME." IBMOUT, SIXBIT "OUTPUT IS TO IBM MAGTAPE." OUTPS8, SIXBIT "TYPE IN PS/8 OUTPUT FILE NAME." IBMIN, SIXBIT "INPUT IS FROM IBM MAGTAPE." COPYX, SIXBIT "COPY AND CONVERSION COMPLETE." DEVFMSG, SIXBIT "OUTPUT DEVICE IS FULL." LRLMSG, SIXBIT "LOGICAL RECORD LENGTH = ." BLKMSG, SIXBIT "BLOCK SIZE = ." BDEV, SIXBIT "BAD DEVICE NAME." NFMESS, SIXBIT "FILENAME NO FOUND ON DEVICE." ERRDEV, SIXBIT "PS/8 DEVICE ERROR." FATALERR, SIXBIT "FATAL ERROR ON PS/8 DEVICE, ABORTING." BADIN, SIXBIT "BAD PS/8 INPUT FILE, SIMULATING EOF." PAGE /EBCDIC TO ASCII CONVERSION TABLE EBCTAB, ZBLOCK 100 / 240 ZBLOCK 11 0 ". "< "( "+ ": /IBM360 NOT USED / "& ZBLOCK 11 "! "$ "* ") "; /IBM360 DOES NOT USE 0 / "- /EBCDIC NOT USED "/ ZBLOCK 11 ", "% "_ /IBM360 DOES NOT USE "> "? / ZBLOCK 12 ": "# "@ "' "= "" / ZBLOCK 1 SMALL "A SMALL "B SMALL "C SMALL "D SMALL "E SMALL "F SMALL "G SMALL "H SMALL "I ZBLOCK 6 / ZBLOCK 1 SMALL "J SMALL "K SMALL "L SMALL "M SMALL "N SMALL "O SMALL "P SMALL "Q SMALL "R ZBLOCK 6 / ZBLOCK 2 SMALL "S SMALL "T SMALL "U SMALL "V SMALL "W SMALL "X SMALL "Y SMALL "Z ZBLOCK 6 / ZBLOCK 20 / ZBLOCK 1 "A "B "C "D "E "F "G "H "I ZBLOCK 6 / ZBLOCK 1 "J "K "L "M "N "O "P "Q "R ZBLOCK 6 / ZBLOCK 2 "S "T "U "V "W "X "Y "Z ZBLOCK 6 / "0 "1 "2 "3 "4 "5 "6 "7 "8 "9 ZBLOCK 6 SMALL=40 /TO SET SMALL CHARS /END OF EBCDIC TO ASCII CONVERSION TABLE PAGE EJECT / ASCII TO EBCDIC CONVERSION TABLE ASCTAB, ZBLOCK 40 / 100 /SPACE 132 /! 177 /" 173 /# 133 /$ 154 /% 120 /& 175 /' 115 /( 135 /) 134 /* 116 /+ 153 /, 140 /- 113 /. 141 // 360 /0 361 /1 362 /2 363 /3 364 /4 365 /5 366 /6 367 /7 370 /8 371 /9 172 /: 136 /; 114 /< 176 /= 156 /> 157 /? / 174 /@ 301 /A 302 /B 303 /C 304 /D 305 /E 306 /F 307 /G 310 /H 311 /I 321 /J 322 /K 323 /L 324 /M 325 /N 326 /O 327 /P 330 /Q 331 /R 342 /S 343 /T 344 /U 345 /V 346 /W 347 /X 350 /Y 351 /Z 255 /[ 237 /\, PRINTS AS BOX 275 /] 217 /^, PRINTS AS DAGGER 214 /_, PRINTS AS LESS THAN OR EQUAL / 112 /BACK ', PRINTS AS CENT SIGN 201 /SMALL A 202 /SMALL B 203 /SMALL C 204 /SMALL D 205 /SMALL E 206 /SMALL F 207 /SMALL G 210 /SMALL H 211 /SMALL I 221 /SMALL J 222 /SMALL K 223 /SMALL L 224 /SMALL M 225 /SMALL N 226 /SMALL O 227 /SMALL P 230 /SMALL Q 231 /SMALL R 242 /SMALL S 243 /SMALL T 244 /SMALL U 245 /SMALL V 246 /SMALL W 247 /SMALL X 250 /SMALL Y 251 /SMALL Z 213 /LEFT BRACE 157 /--, ? 223 /ALTMODE (ALSO RIGHT BRACE) 157 /--, ? 157 /RUBOUT, ? / END OF ASCII TO EBCDIC CONVERSION TABLE PAGE EJECT TRACK9=0403 /NON-CORE DUMP MODE RWND=0010 EOF=50 READTAPE=20 WRITE=40 CA=7753 WC=7752 MTGO=6722 MTRS=6706 MTLC=6716 MTAF=6712 MTTR=6721 MTCR=6711 MTSF=6701 PS8BUFF=. BUFFER=0 /IN FIELD 1 EJECT $-$-$ /DUMP PAGE ZERO LITERALS