SEARCH FORPRM TV FORIO I/O ROUTINES,6(2033) ;COPYRIGHT (C) 1981 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE ;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER ;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY ;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ;TRANSFERRED. ;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ;CORPORATION. ;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. COMMENT \ ***** Begin Revision History ***** 1100 CKS 5-Jun-79 New 1263 JLC 09-Feb-81 QAR 10-05487 Fix -10 backspace. SOJLE should be SOJGE. 1272 DAW 19-Feb-81 A few low-risk changes to support extended addressing. 1303 JLC 25-Feb-81 Folded -10 code for %irec into the -20 code for DIREC, made it call %SAVE4 instead of %SAVE3 as it was clobbering P4. Save line sequence number in the DDB. 1306 DAW 26-Feb-81 New arg-list format from %SAVE. 1310 DAW 26-Feb-81 Full words in DDB for END=, ERR=, IOST=, AVAR= addresses. 1316 JLC 5-Mar-81 Major changes for magtape handling, switching i/o direction. 1325 JLC 9-Mar-81 Yet more changes to magtape I/O on the -10 1332 JLC 11-Mar-81 Installed dump mode I/O for the -10. 1333 JLC 11-Mar-81 Fix to backspace over eof. 1336 JLC 12-Mar-81 Fix to dump mode I/O, removed extraneous saves of pntr/count for the -10, added one where crucial (just before FILOP in binary I/O). 1341 JLC 13-Mar-81 Add code to handle rewind of file that hasn't been opened yet for the -10. 1343 DAW 16-Mar-81 A few changes for extended addressing. 1346 JLC 16-Mar-81 Fixes to -10 backspace file, skip file, and rewind. 1353 JLC 18-Mar-81 More fixes for -10 magtape ops. BAKEOF was not backspacing over the last block of the file. 1357 JLC 19-Mar-81 More fixes to magtape ops. BAKEOF was not handling null files correctly. Installed code to prevent creation of null file for rewind, skip file, backfile, or unload with no OPEN. 1360 EDS 19-Mar-81 Q10-05866 Range check UNIT numbers used in I/O statements. 1361 JLC 20-Mar-81 Fix some typos in code to prevent null file creation. 1363 JLC 24-Mar-81 Minor fixes to magtape and error typout, added missing global (%iset) called from foropn. 1365 JLC 25-Mar-81 Typo in WAIT FILOP. 1366 JLC 26-Mar-81 Still more typos, plus BAKEOF bug, plus END FILE was not incrementing the block #. 1374 JLC 31-Mar-81 Replace code to turn off D%END for terminals. Previous code was wiping T1, which contained valuable data. 1376 JLC 31-Mar-81 Fix -10 backspace code to eliminate cache-sweep bugs for SMP (removed clearing of use-bits). 1377 JLC 01-Apr-81 Change load/store FLGS to move/movem FLAGS, since it was a full word. Minor fix to -10 backspace. Minor changes to UNFO, moved check for empty window from end of loop to beginning of BLT code. 1401 JLC 30-Apr-81 Put back code to clear use-bits, was merely masking another bug. 1402 JLC 06-Apr-81 Transplant input record initialization to where it belongs, new subroutine called %IRINI. Move setting of CRLF suppression to %IREC. 1406 JLC 06-Apr-81 Minor bug in backspace for -10, backspace beyond block 1 sometimes would not work. 1410 JLC 07-Apr-81 Move record buffer setup to %IRINI and %ORINI in preparation for separation of record buffer. Modify and separate EXPRB for same preparation. 1411 DAW 08-Apr-81 Use IJFN and OJFN instead of JFN. 1412 JLC 09-Apr-81 Fix minor problem reading fixed-length record files. Fix backspace for the -20 for fixed-length record files. 1413 DAW 10-Apr-81 Get rid of flag D%MTOP. FOROTS doesn't need to check whether or not its doing a magtape operation on every IO statement. 1414 DAW 10-Apr-81 MTOP operations were ignoring ERR=. 1416 JLC 10-Apr-81 Separate record buffers. Install DTA rewind and unload. 1422 JLC 13-Apr-81 Typo in separate record buffers. 1423 DAW 13-Apr-81 Put %SETD in FORIO (was in FOROPN). 1424 JLC 14-Apr-81 Typo in %IRINI made DECODE non-existent. 1427 JLC 15-Apr-81 Changed RSIZ to be a word in the DDB. Make FORIO ignore MODE=DUMP if ACCESS=RANDOM. 1430 JLC 15-Apr-81 Typo in -20 backspace broke it. 1432 JLC 16-Apr-81 Was trashing returned AC T3 in DIREC. Changed code to return result in IRCNT(D) instead. 1433 JLC/CKS 16-Apr-81 Fix for binary backspace. 1435 CKS 16-Apr-81 More binary backspace fixes. 1436 JLC 16-Apr-81 More of edit 1432. Return result in IRCNT for DECODE also. 1443 JLC 17-Apr-81 Make EOFN(D) represent fixed number of bytes in file. EOF detected by comparing BYTN with EOFN. 1444 JLC 21-Apr-81 Fix bug caused by edit 1443; it was smashing T1. 1445 DAW 21-Apr-81 Rework code around UNFSW to make it more understandable. 1450 JLC 22-Apr-81 Fix DECODE new record code. 1451 JLC 23-Apr-81 Special code for dump mode I/O in mtops. 1453 JLC 24-Apr-81 Make dump mode backspace and skiprecord work for magtape. Insert if20 end after EOFN setup code. 1454 JLC 24-Apr-81 QAR 20-01364 Change EOFN if we switch from formatted to unformatted. 1455 JLC 27-Apr-81 Fix bug from edit 1452. Must not set D%LIN/D%LOUT on the way out of magtape operations. 1460 JLC 28-Apr-81 Fix typo in edit 1453. It thought most files were dump mode. 1463 JLC 7-May-81 Many major changes. See FOROTS.MAC revhist. 1464 DAW 21-May-81 Error messages. 1465 JLC 15-May-81 Major changes to -20 I/O. 1474 JLC 22-May-81 Bug in %PTOF, thought WSIZ was in words, was in bytes. 1476 JLC 26-May-81 Bug in unformatted I/O, was looking at EOFN for non-disk files. 1501 JLC 27-May-81 More bugs, this time in random I/O, caused by changed calling sequence for MAPW. 1502 JLC 28-May-81 Install defensive WAIT operations in magtape code. 1505 JLC 01-Jun-81 Many bug fixes in disk and magtape backspace operations. Turn off EOF and initialize things for BACKFILE and SKIPFILE. 1506 CKS 2-Jun-81 Add SLST77 and ELST77, temporarily equated to F-66 equivalents, SLIST and ELIST. 1511 JLC 5-Jun-81 More edits to magtape code, for SKIPFILE and BACKFILE. 1516 JLC 10-Jun-81 Yet another bug, this time in disk backspace. WSIZ is not in words! Fix end-of-record handling for unformatted I/O. 1532 DAW 14-Jul-81 OPEN rewrite: Base level 1 1535 JLC 14-Jul-81 EOF handling correction, both to zero arrays correctly and to handle IOSTAT correctly. 1536 JLC 15-Jul-81 Minor edits. 1542 JLC 17-Jul-81 Fix ERR and END processing and %MVBLK. 1546 JLC 20-Jul-81 Fix DEC% to call DECINI. Fix TIREC for -20 to allocate record buffer if none there yet. 1547 DAW 20-Jul-81 Replacement for old %CHKDR routine. 1550 JLC 20-Jul-81 Fix DECODE, it had off-by-one error. Fix X format, it referenced stuff in DDB without D. Fix setup of record buffers - make sure it happens in %ORINI or %IRINI. 1553 JLC 23-Jul-81 Fix ENCODE and DECODE again. Setup IRPTR properly in TIREC. Eliminate useless routine ENCINX. 1560 DAW 28-Jul-81 OPEN rewrite: Base level 2 1567 JLC 30-Jul-81 More fixes to ENCODE/DECODE, output buffer setup, prompting. 1572 JLC 31-Jul-81 ENCODE - setup entire string with blanks for initialization. 1574 BL 3-Aug-81 Missing IF20 conditional around G.PRP 1575 JLC 05-Aug-81 Fix record zeroing again. 1577 DAW 11-Aug-81 Create "ENDNUL" routine to make the "drop a null at EOR" hack work correctly. 1601 DAW 12-Aug-81 ENDFILE to a disk file was trying to open it for input on the -20. 1604 DAW 12-Aug-81 More of 1601-type stuff, for DIVERT. 1607 DAW 13-Aug-81 Fix bug in FIND code. 1613 JLC 19-Aug-81 Q10-6390 Use a character count, not a word count, in backspace of ASCII files. 1614 JLC 19-Aug-81 Move setting of D%MOD into DOREC. Remove END= branching for end-of-record for files with no crlf at end, thus EOF becomes a valid record terminator, and the program will get END= at the next read. 1622 JLC 21-Aug-81 Rewrite ENCODE/DECODE again, rework record positioning subroutines for output, so that X, T format reaaly work. 1625 DAW 21-Aug-81 Get rid of "DF". 1627 DAW 24-Aug-81 On TOPS-20, UNLOAD and REWIND no longer need a filename 1630 JLC 24-Aug-81 Make illegal operations on magtape a fatal error. 1631 DAW 24-Aug-81 Set D%MOD in UNFO. 1632 JLC 24-Aug-81 Fixed OPAD to output spaces instead of random trash for X and T format. 1633 JLC 25-Aug-81 On TOPS-20, SKIPFILE and BACKFILE no longer need a filename. 1634 JLC 25-Aug-81 ORPOS was left set at FIXREC, caused records to be too large. 1635 JLC 25-Aug-81 Fix for edit 1633, plus ENDFILE can't work that way. 1637 JLC 26-Aug-81 DECODE bug. IRCNT was not getting set up properly. 1642 JLC 27-Aug-81 Replace %FILOP calls with FILOPs. 1643 JLC 27-Aug-81 More code for faster EOL handling. Modify IRBUF/ORBUF to be full words so ENCODE/DECODE will work with extended addressing. 1645 DAW 28-Aug-81 Column 1 before errors in DIVERT'ed file. 1646 DAW 28-Aug-81 DTA REWIND and UNLOAD used wrong channel. 1647 DAW 28-Aug-81 DTA REWIND and UNLOAD to not require an existing file. 1652 DAW 1-Sep-81 Fix DUMP mode I/O on TOPS-10; make "IOE" a "?" error. 1653 JLC 1-Sep-81 Return -1 (illegal LSN) for non-LINED files and LINED files with no LSN. 1663 JLC 8-Sep-81 Fixed ill mem read for non-existent pages in read-only file. Added code to record top page number, so unused pages can be unmapped. 1665 DAW 8-Sep-81 Make a D.TTY hack to get error messages right; delete refs to U.TTY. 1676 DAW 9-Sep-81 %OCRLF to always output a CRLF, and not use "U". 1702 JLC 10-Sep-81 More fix to non-existent page stuff, unmapping unused pages. Add code to prevent expansion of random files on -10 by merely touching the page (not possible on -20). 1703 DAW 11-Sep-81 Fix printing of too many CRLF's in errors when a TTY file is open. 1704 JLC 11-Sep-81 Fix SETPOS not to pad a blank when we are at desired position. Also typo in RDW for -10 in edit 1702. 1705 JLC 11-Sep-81 Fix more serious T-format bug. T1 was not working on output, as it got stored as position 0. Now ORPOS contains desired position of NEXT character. 1706 DAW 11-Sep-81 Lots of changes to errors. 1707 JLC 14-Sep-81 Edit 1705 broke %IBACK. 1712 JLC 15-Sep-81 Fixed more bugs in t-format, created IRPOS. Eliminated D%ERR! 1716 JLC 16-Sep-81 Changed the names of ISPOS, OSPOS, etc., to make things less confusing. Fixed typo due to confusion. 1722 JLC 16-Sep-81 Code for IRPOS more complicated than originally envisaged. 1730 JLC 18-Sep-81 More fixes for T-format. 1735 DAW 22-Sep-81 -20 DISK APPEND files now get EOF for READ. 1737 DAW 23-Sep-81 Fix processing of REREAD error "RBR". 1740 DAW 23-Sep-81 More REREAD code. 1745 JLC 24-Sep-81 Made IRBLN, ORBLN, and IRLEN full words. Removed all refs to IRPOS, now unnecessary. 1761 JLC 5-Oct-81 Fixed ENDFILE on disk, did not open file for output before. 1774 DAW 8-Oct-81 Avoid "?Unexpected TAPOP. error" for typical errors. 1775 JLC 9-Oct-81 Fix ^Z handling. 1777 DAW 9-Oct-81 FILOP. CLOSE before RELEASE where appropriate. 2005 JLC 15-Oct-81 Fix unmapping of unused pages so it does it for random files. On -10, update .RBSIZ so we don't return zeroes for data that's there. 2006 JLC 15-Oct-81 Control-Z change broke DECODE by meddling with IRCNT, which should be inviolate before the "device-dependent" call. 2010 JLC 19-Oct-81 Make EOFN and BYTN live for the -10. 2016 JLC 20-Oct-81 Fix SLISTs and ELISTs to differentiate between -66 and -77 programs and give 1-trip (i.e., 1 entry) for zero-trip lists. 2030 JLC 27-Oct-81 Fix SLISTs and ELISTs to substitute 1 for zero or negative supplied counts. 2033 DAW 19-Nov-81 Change symbol "LTYPE" to "%LTYPE" to avoid conflict with user symbol. Give error if user tries to do random I/O without an OPEN statement with a RECORDSIZE specifier. Pay attention to ERR= and IOSTAT= for ENCODE and DECODE. Fix dollar format to make T and X format have some effect at end of record. ***** End Revision History ***** \ ENTRY IN%,OUT%,RTB%,WTB%,NLI%,NLO%,ENC%,DEC%,FIND%,MTOP% ENTRY IOLST%,FIN% INTERN %IBYTE,%OBYTE,%IBYTC INTERN %IREC,%OREC,%EOREC,%OCRLF,%ORECS INTERN %IBACK,%OVNUM,%GETIO,%MAPW,%SETAV INTERN %RPOS,%SPOS IF10,< INTERN %RANWR,%BACKB,%CLRBC,%BAKEF,%ISET > INTERN %SETD INTERN %UDBAD EXTERN %POPJ,%POPJ1,%SAVE1,%SAVE2,%SAVE3,%SAVE4,%SAVE,%PUSHT,%POPT,%JPOPT EXTERN %FORMT,%LDI,%LDO,%NLI,%NLO EXTERN %IOERR,%ABORT,%IONAM EXTERN %SETIN,%SETOUT,%CHKNR,%CRLF EXTERN %GTBLK,%MVBLK EXTERN %ISAVE,%FSAVE,%SIZTB,%DDBTA EXTERN %EDDB,U.RERD,U.ERR,D.TTY IF20,< EXTERN G.PRP,G.PRMPT,%OCCOC,%CCMSK,%CLSOP > IF10,< EXTERN %ST10B,%CALOF,%CLSER,%FREBLK > EXTERN %LTYPE EXTERN %OPENX,%LSTBF EXTERN %TERR,%TIOS EXTERN %ALCHN,%DECHN SEGMENT CODE SUBTTL I/O SETUP ;Formatted read -- READ (u,1) SIXBIT /IN./ IN%: PUSHJ P,%SAVE ;SAVE ACS PUSHJ P,FMTCNV ;CONVERT ARG LIST MOVX P1,0 ;SET FORMATTED INPUT JRST INGO ;GO DO I/O ;Formatted write -- WRITE (u,1) SIXBIT /OUT./ OUT%: PUSHJ P,%SAVE ;SAVE ACS PUSHJ P,FMTCNV ;CONVERT ARG LIST MOVX P1,D%IO ;SET FORMATTED OUTPUT JRST OUTGO ;GO DO I/O ;Unformatted read SIXBIT /RTB./ RTB%: PUSHJ P,%SAVE ;SAVE ACS PUSHJ P,UNFCNV ;CONVERT ARG LIST MOVX P1,D%UNF ;SET UNFORMATTED INPUT JRST INGO ;GO DO I/O ;Unformatted write SIXBIT /WTB./ WTB%: PUSHJ P,%SAVE ;SAVE ACS PUSHJ P,UNFCNV ;CONVERT ARG LIST MOVX P1,D%UNF+D%IO ;SET UNFORMATTED OUTPUT JRST OUTGO ;GO DO I/O ;Namelist input SIXBIT /NLI./ NLI%: PUSHJ P,%SAVE ;SAVE ACS PUSHJ P,NMLCNV ;CONVERT ARG LIST MOVX P1,D%NML ;SET NAMELIST INPUT JRST INGO ;GO DO I/O ;Namelist output SIXBIT /NLO./ NLO%: PUSHJ P,%SAVE ;SAVE ACS PUSHJ P,NMLCNV ;CONVERT ARG LIST MOVX P1,D%NML+D%IO ;SET NAMELIST OUTPUT JRST OUTGO ;GO DO I/O ;DECODE SIXBIT /DEC./ DEC%: PUSHJ P,%SAVE ;SAVE ACS PUSHJ P,ENCCNV ;CONVERT ARG LIST XMOVEI T1,[ASCIZ /DECODE/] MOVEM T1,%IONAM ;Set statement name PUSHJ P,IOARG ;Move args to A.XXX PUSHJ P,SETDE ;SET UP DDB POINTING TO STRING MOVX T1,D%ENC ;Set ENCODE/DECODE input MOVEM T1,FLAGS(D) MOVEM U,%UDBAD ;SAVE DDB ADDRESS FOR IOLST PUSHJ P,DECINI ;INIT BUFFER PNTR PUSHJ P,%IREC ;Read record MOVE T1,[%FORMT,,%FORMT] ;Set for formatted I/O JRST %SIO ;Start I/O ;ENCODE SIXBIT /ENC./ ENC%: PUSHJ P,%SAVE ;SAVE ACS PUSHJ P,ENCCNV ;CONVERT ARG LIST XMOVEI T1,[ASCIZ /ENCODE/] MOVEM T1,%IONAM ;Set statement name PUSHJ P,IOARG ;Move args to A.XXX PUSHJ P,SETDE ;SET UP DDB POINTING TO STRING MOVX T1,D%ENC+D%IO ;Set ENCODE/DECODE output MOVEM T1,FLAGS(D) MOVEM U,%UDBAD ;SAVE DDB ADDRESS FOR IOLST PUSHJ P,ENCINI ;Init for ENCODE MOVE T1,[%FORMT,,%FORMT] ;Set for formatted I/O JRST %SIO ;Start I/O SIXBIT /MTOP./ MTOP%: PUSHJ P,%SAVE ;SAVE ACS PUSHJ P,MTCNV ;CONVERT ARG LIST XMOVEI T1,[0] ;DON'T KNOW STATEMENT NAME YET MOVEM T1,%IONAM PUSHJ P,IOARG ;Move args to A.XXX PUSHJ P,CHKUNT ;Check for unit number in range ;(Goes to ABORT% if unit is bad) PJRST MTOP ;OK, Go do it and return. IOARG: SETZM A.UNIT ;CLEAR BLOCK SO UNSPECIFIED ARGS ARE 0 MOVE T1,[A.UNIT,,A.UNIT+1] BLT T1,IOARGS+MAXKWD-1 ARGLP: LDB T1,[POINTR @%LTYPE,ARGKWD] ;GET KWD OF ARGUMENT JUMPE T1,ARGN ;POSITIONAL ARG NOT SPECIFIED, SKIP IT XMOVEI T2,@0(L) ;Get arg address CAIE T1,IK.UNIT ;VALUE-TYPE ARG? CAIN T1,IK.FMS JRST ARGV ;YES, GO GET VALUE CAIE T1,IK.MTOP CAIN T1,IK.HSL JRST ARGV JRST ARGS ;NOT VALUE ARG, GO STORE TYPE & ADDRESS ARGV: HRRZ T2,(L) ;Get value MOVE T3,@%LTYPE ;Get arg bits. TXNE T3,ARGTYP ;IMMEDIATE MODE? MOVE T2,@(L) ;NO, GET VALUE ARGS: MOVEM T2,IOARGS(T1) ;STORE ARG IN BLOCK LDB T2,[POINTR @%LTYPE,ARGTYP] ;GET TYPE MOVEM T2,IOTYPS(T1) ;STORE TYPE ARGN: AOBJN L,ARGLP ;TRANSFER WHOLE ARG BLOCK SKIPE T1,A.IOS ;IOSTAT VARIABLE? SETZM (T1) ;YES. CLEAR IT POPJ P, ;DONE SEGMENT DATA ;COPIED ARGS, MUST BE CONSECUTIVE, IN ORDER ON KEYWORD NUMBER (IK.XXX) IOARGS==.-1 ;ARGS START AT UNIT A.UNIT:: BLOCK 1 ;UNIT= [VALUE] A.FMT:: BLOCK 1 ;FMT= [ADDRESS] A.FMS:: BLOCK 1 ;FORMAT SIZE [VALUE] A.END:: BLOCK 1 ;END= [ADDRESS] A.ERR:: BLOCK 1 ;ERR= [ADDRESS] A.IOS:: BLOCK 1 ;IOSTAT= [ADDRESS] A.REC:: BLOCK 1 ;REC= [ADDRESS] A.NML:: BLOCK 1 ;NAMELIST ADDRESS [ADDRESS] A.MTOP:: BLOCK 1 ;MTA OP CODE [VALUE] A.HSA:: BLOCK 1 ;ENCODE/DECODE HOL STRING ADDRESS [ADDRESS] A.HSL:: BLOCK 1 ;ENCODE/DECODE HOL STRING LENGTH [VALUE] MAXKWD==.-IOARGS ;MAX LEGAL IO ARG KWD NUMBER ;NOW FOR THE DATA TYPES IOTYPS=.-1 T.UNIT:: BLOCK 1 ;UNIT= [VALUE] T.FMT:: BLOCK 1 ;FMT= [ADDRESS] T.FMS:: BLOCK 1 ;FORMAT SIZE [VALUE] T.END:: BLOCK 1 ;END= [ADDRESS] T.ERR:: BLOCK 1 ;ERR= [ADDRESS] T.IOS:: BLOCK 1 ;IOSTAT= [ADDRESS] T.REC:: BLOCK 1 ;REC= [ADDRESS] T.NML:: BLOCK 1 ;NAMELIST ADDRESS [ADDRESS] T.MTOP:: BLOCK 1 ;MTA OP CODE [VALUE] T.HSA:: BLOCK 1 ;ENCODE/DECODE HOL STRING ADDRESS [ADDRESS] T.HSL:: BLOCK 1 ;ENCODE/DECODE HOL STRING LENGTH [VALUE] SEGMENT CODE OUTGO: XMOVEI T1,[ASCIZ /WRITE/] ;Set statement name MOVEM T1,%IONAM PUSHJ P,STIO ;Do common start functions PUSHJ P,%SETD ;Setup D and U, do implicit ; OPEN if necessary. PUSHJ P,%SETOUT ;Get file opened for output. JRST EFIO1C ;Go to common code INGO: XMOVEI T1,[ASCIZ /READ/] MOVEM T1,%IONAM PUSHJ P,STIO ;Do common start functions ; (returns t1= unit number) CAME T1,[-6] ;REREAD? JRST INGO1 ;No SKIPN T1,U.RERD ;GET REREAD UNIT JRST DORBR ;?REREAD not preceeded by READ TXO F,F%NINP ;SUPPRESS FIRST INPUT INGO1: PUSHJ P,%SETD ;Do implicit OPEN if necessary PUSHJ P,%SETIN ;Get file opened for input. JRST EFIO1C ;Go rejoin common code ;Process error "REREAD not preceeded by READ" SEGMENT ERR DORBR: PUSHJ P,SETERI ;Setup %TERR and %TIOS $ECALL RBR,%ABORT SETERI: MOVE T1,A.ERR ;Setup ERR= if specified MOVEM T1,%TERR MOVE T1,A.IOS ; and IOSTAT= MOVEM T1,%TIOS POPJ P, ;Return SEGMENT CODE ;Common READ/WRITE I-O start-up functions ;Copy IO args to A.xxx ;Check unit number in range. ;If REC= specified, sets D%RAN in P1 ;Returns T1= unit number STIO: PUSHJ P,IOARG ;MOVE ARGS TO A.XXX PUSHJ P,CHKUNT ;Check unit number in range ; (Goes to ABORT% or ERR= if not). SKIPE A.REC ;REC= SPECIFIED? TXO P1,D%RAN ;YES, IMPLIES RANDOM I/O HRRE T1,A.UNIT ;GET UNIT POPJ P, ;Return EFIO1C: XOR P1,OLDFLG ;CHECK THAT I/O STATEMENT MATCHES FILE TXNN P1,D%RAN+D%UNF JRST IOGO ;MATCHES, FINE TXNE P1,D%RAN ;MISMATCH ON RANDOM/SEQUENTIAL? PUSHJ P,RNSMIS ;Yes, print error and return ; (we might also have UNF/FORM error) TXNN P1,D%UNF ;Mismatch on UNF? JRST %ABORT ;No, just abort because of the RAN error. ;This mismatch can only occur if the file had previously been open ;assuming FORMATTED I/O and the user just did an UNFORMATTED operation. ; ;If no I/O has been done (only the OPEN statement), and the /MODE was not ; specified, this is ok-- the file is changed to be UNFORMATTED. Otherwise, ; it is a fatal error, and the program is aborted. LOAD T1,XMODE(D) ;GET 1 IFF WE DIDN'T SEE /MODE IN OPEN SKIPN BLKN(D) ;AT START OF FILE? JUMPN T1,CUNFSW ;YES, CAN SWITCH IF NO /MODE IN OPEN JRST MISFUF ;Fatal mismatch of FORMATTED/UNFORMATTED ;Here if it is possible for us to switch FORMATTED to UNFORMATTED CUNFSW: TXNE P1,D%RAN ;But did we also get a mismatch of ; RANDOM and SEQUENTIAL? JRST %ABORT ;Yeah, just quit. PUSHJ P,UNFSW ;Otherwise-- switch file to UNFORMATTED. JRST IOGO ; and go on. ;Come here if there is a fatal mismatch of FORMATTED/UNFORMATTED ;I/O. Type error message and abort the program. MISFUF: DMOVE T2,[EXP [ASCIZ /formatted/],[ASCIZ /unformatted/]] MOVE T1,FLAGS(D) ;Get DDB flags TXNN T1,D%UNF ;DID HE TRY UNFORMATTED I/O? EXCH T2,T3 ;YES PUSHJ P,CDI ;TELL HIM HE CAN'T DO IT PJRST %ABORT ;GO DIE CDI: ;IOERR (CDI,31,315,?,Can't do $A I/O to $A file,,%POPJ) $ECALL CDI,%POPJ ;Routine to print fatal error message for user because ; he tried to mix and match random and sequential access. ; After the error is typed, it returns so FOROTS can type ;still more errors if necessary. RNSMIS: DMOVE T2,[EXP [ASCIZ /direct/],[ASCIZ /sequential/]] MOVE T1,FLAGS(D) ;Get DDB flags TXNE T1,D%RAN ;DID USER TRY RANDOM I/O? EXCH T2,T3 ;NO, HE TRIED SEQUENTIAL PJRST CDI ;Tell user he can't do it; return ;Routine to switch file from FORMATTED to UNFORMATTED. ;POPJ's when done. UNFSW: MOVX T1,D%UNF!D%BIN ;Set UNFORMATTED and BINARY IORM T1,FLAGS(D) MOVEI T2,^D36 ;Set byte size to 36 IF10,< STORE T2,IBSIZ(D) STORE T2,OBSIZ(D) > IF20,< STORE T2,BSIZ(D) > IF20,< LOAD T1,INDX(D) ;NONDISK? CAIN T1,DI.DSK JRST UNSW1 ;NO LOAD T1,IJFN(D) ;YES, RESET MONITOR BYTE SIZE ALSO SFBSZ% PUSHJ P,SETBSZ ;EASY WAY FAILED, REOPEN FILE UNSW1: LOAD T2,BPW(D) ;GET BYTES/WORD MOVE T1,WSIZ(D) ;GET WINDOW SIZE ADDI T1,-1(T2) ;ROUND UP IDIVI T1,(T2) ;GET WINDOW SIZE IN WORDS MOVEM T1,WSIZ(D) ;STORE IT > ;IF20 MOVE T1,EOFN(D) ;GET FILE SIZE IN BYTES CAMGE T1,[377777,,777774] ;PREVENT OVERFLOW ADDI T1,4 ;CONVERT TO WORDS IDIVI T1,5 MOVEM T1,EOFN(D) MOVEI T1,MD.BIN ;Set /MODE to binary STORE T1,MODE(D) IF10,< MOVE T1,FLAGS(D) ;Get DDB flags TXNE T1,D%RAN ;Is this a RANDOM file? JRST NODM ;YES, DON'T CHANGE DATA MODE MOVEI T1,.IOBIN ;Binary STORE T1,DMODE(D) PUSHJ P,%CHKNR ;CHECK THAT MODE IS LEGAL FOR THIS DEVICE JRST %ABORT ;NOT LEGAL, MESSAGE ALREADY TYPED; GO DIE HLLZ T2,CHAN(D) ;DO SETSTS FILOP TO TELL MONITOR ABOUT NEW MODE HRRI T2,.FOSET LOAD T3,DMODE(D) MOVE T1,[2,,T2] FILOP. T1, $SNH ;SETSTS shouldn't fail NODM: > ;IF10 MOVEI T1,1 ;SET BYTES PER WORD STORE T1,BPW(D) POPJ P, ;Return IF20,< ;This routine gets called for DISK files ; when the SFBSZ% JSYS has failed. ;If the file has not been opened yet, the routine just POPJ's since ;the byte size will be set correctly when the OPENF is done. ; ;If the OPENF has already been done, the routine tries to do a CLOSF ; and another OPENF with the correct byte size. If this fails the ; program is aborted. ; ;Inputs: ; T2/ byte size we want. ; D/ pointer to the DDB. ;Call: ; PUSHJ P,SETBSZ ; ;Goes to %ABORT if something is wrong ;Smashes ac T1 only SETBSZ: PUSH P,T2 ;Save the byte size we want LOAD T1,IJFN(D) ;GET FILE STATUS GTSTS% JUMPGE T2,T2POPJ ;FILE NOT OPEN YET, REAL OPEN WILL BE OK SETZ T1, ;INIT OPENF BITS TXNE T2,GS%RDF ;FILE OPEN FOR READ? TXO T1,OF%RD ;YES, RE-OPEN FOR READ TXNE T2,GS%WRF ;WRITE? TXO T1,OF%WR POP P,T2 ;Restore byte size LSH T2,^D30 ;POSITION BYTE SIZE FOR OPENF IOR T2,T1 ;Put more OPENF% bits into the arg. LOAD T1,IJFN(D) ;CLOSE FILE HRLI T1,(CO%NRJ) ;KEEP JFN CLOSF% ; (This does not affect T2) ; IOERR (UFS,34,,?,$J,,%ABORT) $ECALL UFS,%ABORT LOAD T1,IJFN(D) ;REOPEN FILE WITH MODIFIED BYTE SIZE OPENF% ; IOERR (UFS,30,,?,$J,%ABORT) ;CAN'T $ECALL UFS,%ABORT POPJ P, ;NEW BYTE SIZE SET ;Restore T2 and POPJ. T2POPJ: POP P,T2 POPJ P, ;Return > ;IF20 ;Routine to check UNIT= to see if unit number is in range ;Call: ; PUSHJ P,CHKUNT ; ;If unit is out of range and ERR= or IOSTAT= was specified, ; the program returns to the appropriate place. ;Otherwise, the error message is typed and the program is aborted. ;Uses T1,T2 CHKUNT: HRRE T2,A.UNIT ;GET UNIT CAML T2,[-7] ;RANGE CHECK. NEGATIVE ARGS ILLEGAL CAILE T2,MAXUNIT ; OR UNIT BEYOND RANGE OF DDBTAB JRST .+2 ;Out of range. POPJ P, ;Ok, return ;Prepare to call error routine ;T2= unit number (IUN error uses it) PUSHJ P,SETERI ;Set %TERR and %TIOS $ECALL IUN,%ABORT ;Give error IOGO: MOVEM U,%UDBAD ;SAVE DDB ADDRESS FOR IOLST MOVE T2,FLAGS(D) ;T2:= DDB flags IF10,< LOAD T1,MODE(D) ;GET THE /MODE TXNN T2,D%RAN ;RANDOM IS SPECIAL DUMP CAIE T1,MD.DMP ;DUMP? JRST NOTDMP ;NO MOVE T1,[DMPIN,,DMPOUT] ;YES. JRST %SIO ;GO DO IT NOTDMP: >;END IF10 TXNE T2,D%RAN ;RANDOM I/O? PUSHJ P,RMAPW ;YES, SET TO START OF RECORD MOVE T2,FLAGS(D) ;Reget flags TXNE T2,D%UNF ;Unformatted? JRST [MOVE T1,[UNFI,,UNFO] ;Yes JRST %SIO] TXNN T2,D%IO ;GET A RECORD IF INPUT PUSHJ P,%IREC MOVE T1,[%FORMT,,%FORMT] ;ASSUME FORMATTED SKIPE T2,A.FMT ;GET FORMAT ADDR CAMN T2,[IK.FMT_^D27] ;Compiler kludge-- keyword+0 address MOVE T1,[%LDI,,%LDO] ;NO, ASSUME LIST-DIRECTED SKIPE A.NML ;UNLESS NAMELIST SPECIFIED MOVE T1,[%NLI,,%NLO] ;THEN SET NAMELIST ADDRESSES JRST %SIO ;GO DO I/O ;HERE FROM IOLST% OR FIN% WHEN I/O IS COMPLETE %FIO: SETZM %UDBAD ;CLEAR THE UDB PNTR MOVE T1,FLAGS(D) ;Get DDB flags TXNE T1,D%IO ;OUTPUT? TXNE T1,D%UNF ;YES, FORMATTED? JRST %SETAV ;NO PUSHJ P,%OREC ;OUTPUT RECORD %SETAV: MOVE T1,NREC(U) ;GET CURRENT RECORD NUMBER SKIPE T2,AVAR(U) ;Get address of ASSOCIATE VARIABLE MOVEM T1,(T2) ;There is one, store record number SETZM ENDAD(U) ;Clear END=, SETZM ERRAD(U) ; ERR=, SETZM IOSAD(U) ; IOSTAT=. POPJ P, ;DONE ;ROUTINE TO SET UP A DDB FOR ENCODE/DECODE SETDE: SETZ P1, ;No funny IO flags. SKIPE U,%EDDB ;DDB ALREADY CREATED? JRST GOTD ;Yes, use it. MOVEI T1,ULEN ;Get length of unit block PUSHJ P,%GTBLK MOVE U,T1 ;Point U to it MOVEM U,%EDDB ;Save for use on next ENCODE/DECODE MOVEI T1,DLEN ;GET LENGTH OF DDB PUSHJ P,%GTBLK ;GET AN EMPTY DDB MOVEI D,(T1) ;POINT D TO IT MOVEM D,DDBAD(U) ;Remember it in the unit block MOVEI T1,DI.INT ;SET "DEVICE" TYPE TO INTERNAL FILE STORE T1,INDX(D) ;STORE IN DDB MOVEI T1," " ;PAD WITH SPACES STORE T1,PADCH(U) JRST GOTD ;Done ;ROUTINES TO CONVERT POSITIONAL ARG BLOCKS TO KEYWORD ARG BLOCKS FMTCNV: LDB T1,[POINTR @%LTYPE,ARGKWD] ;GET KWD FIELD OF FIRST ARG JUMPN T1,%POPJ ;NONZERO, NEW-STYLE CALL CAMLE L,[-4,,-1] ;AT LEAST 4 ARGS? JRST IOCNV1 ;NO, SKIP /FMT PUSH P,L ADD L,[3,,3] MOVEI T1,IK.FMT ;GET KWD NUMBER FOR /FMT DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST POP P,L CAMLE L,[-5,,-1] ;AT LEAST 5 ARGS? JRST IOCNV1 ;NO, SKIP FORMAT SIZE PUSH P,L ADD L,[4,,4] MOVEI T1,IK.FMS ;GET KWD NUMBER FOR FORMAT SIZE DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST POP P,L IOCNV1: CAMLE L,[-6,,-1] ;AT LEAST 6 ARGS? JRST IOCNV2 ;NO, SKIP /REC PUSH P,L ADD L,[5,,5] MOVEI T1,IK.REC ;GET KWD NUMBER FOR /REC DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST POP P,L IOCNV2: MOVEI T1,IK.UNIT ;GET KWD NUMBER FOR /UNIT DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST IOCNV3: CAMLE L,[-2,,-1] ;AT LEAST 2 ARGS? POPJ P, ;NO, DONE MOVEI T1,IK.END ;GET KWD NUMBER FOR /END PUSH P,L ADDI L,1 DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST POP P,L CAMLE L,[-3,,-1] ;AT LEAST 3 ARGS? POPJ P, ;NO, DONE PUSH P,L ADDI L,2 MOVEI T1,IK.ERR ;GET KWD NUMBER FOR /ERR DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST POP P,L POPJ P, ;DONE UNFCNV: LDB T1,[POINTR @%LTYPE,ARGKWD] ;GET KWD FIELD OF FIRST ARG JUMPN T1,%POPJ ;NONZERO, NEW-STYLE CALL JRST IOCNV1 NMLCNV: LDB T1,[POINTR @%LTYPE,ARGKWD] ;GET KWD FIELD OF FIRST ARG JUMPN T1,%POPJ ;NONZERO, NEW-STYLE CALL CAMLE L,[-4,,-1] ;AT LEAST 4 ARGS? JRST IOCNV2 ;NO, NO NAMELIST ADDRESS PUSH P,L MOVEI T1,IK.NML ;GET KWD NUMBER FOR NAMELIST ADDI L,3 DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST POP P,L JRST IOCNV2 ;GO DO STANDARD ARGS ENCCNV: LDB T1,[POINTR @%LTYPE,ARGKWD] ;GET KWD FIELD OF FIRST ARG JUMPN T1,%POPJ ;NONZERO, NEW-STYLE CALL MOVEI T1,IK.HSL ;GET KWD NUMBER FOR STRING LENGTH DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST CAMLE L,[-4,,-1] ;AT LEAST 4 ARGS? JRST IOCNV3 ;NO, SKIP /FMT PUSH P,L ADDI L,3 MOVEI T1,IK.FMT ;GET KWD NUMBER FOR /FMT DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST POP P,L CAMLE L,[-5,,-1] ;AT LEAST 5 ARGS? JRST IOCNV3 ;NO, SKIP FORMAT SIZE PUSH P,L ADDI L,4 MOVEI T1,IK.FMS ;GET KWD NUMBER FOR FORMAT SIZE DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST POP P,L CAMLE L,[-6,,-1] ;AT LEAST 6 ARGS? JRST IOCNV3 ;NO, SKIP STRING ADDRESS PUSH P,L ADDI L,5 MOVEI T1,IK.HSA ;GET KWD NUMBER FOR STRING ADDRESS DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST POP P,L JRST IOCNV3 ;GO DO STANDARD ARGS MTCNV: LDB T1,[POINTR @%LTYPE,ARGKWD] ;GET KWD FIELD OF FIRST ARG JUMPN T1,%POPJ ;NONZERO, NEW-STYLE CALL CAMLE L,[-4,,-1] ;AT LEAST 4 ARGS? JRST IOCNV2 ;NO PUSH P,L ADDI L,3 MOVEI T1,IK.MTOP ;GET KWD NUMBER FOR MT OP CODE DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST POP P,L JRST IOCNV2 ;GO CONVERT UNIT, ERR, END ;SETD IS CALLED TO SET UP D FOR ALL I/O STATEMENTS. ;OPENS UNIT IF NECESSARY ;CHECKS RANDOM VS. SEQUENTIAL, FORMATTED VS. UNFORMATTED ;ARGS: T1 = UNIT NUMBER ; P1 = DF BITS D%RAN AND D%UNF ; USED FOR DEFAULT OPEN IF NECESSARY ;RETURN: D = DDB ADDRESS %SETD: MOVE U,%DDBTAB(T1) ;Get address of unit block JUMPN U,GOTD ;ALREADY OPEN, GO CHECK STUFF TXNE P1,D%RAN ;Trying to do RANDOM I/O? JRST RIOERR ;?Have to use OPEN statement to specify ; RECORDSIZE. PUSH P,T1 ;SAVE UNIT NUMBER MOVEI T1,DLEN ;GET LENGTH OF DDB PUSHJ P,%GTBLK ;ALLOCATE IT MOVE D,T1 ;POINT TO EMPTY DDB MOVEI T1,ULEN ;Get length of unit block PUSHJ P,%GTBLK ;Allocate it MOVE U,T1 HRRZM P1,FLAGS(D) ;Clear LH flags, set default RH ones MOVE T1,(P) ;GET UNIT BACK STORE T1,UNUM(U) ;SAVE UNIT NUMBER SKIPE T1,A.ERR ;ERR= MOVEM T1,ERRAD(U) ; Set in Unit block SKIPE T1,A.IOS ;IOSTAT= MOVEM T1,IOSAD(U) ; Set in Unit block MOVEI T1,FM.UNF ;GET /FORM:UNFORMATTED TXNE P1,D%UNF ;UNFORMATTED I/O STATEMENT? STORE T1,FORM(D) ;YES, OPEN FILE FOR UNFORMATTED I/O PUSHJ P,%OPENX ;OPEN THE DDB POP P,T1 ;GET UNIT NUMBER BACK MOVEM U,%DDBTAB(T1) ;Store address of unit block ;Here with U pointing to the unit block and DDBAD(U) is the ; DDB block address. P1 contains flags pertinent to the IO statement. GOTD: PUSHJ P,STREEI ;Store ERR=, END=, IOSTAT= in the unit block. MOVE D,DDBAD(U) ;Get DDB address MOVE T1,FLAGS(D) ;PUT IN PERM FLGS MOVEM T1,OLDFLG ;Save old flags for UNFSW test TXZ T1,D%CLR ;Clear temp flags TDO T1,P1 ;Set beginning flags for statement MOVEM T1,FLAGS(D) ;Store updated flags POPJ P, SEGMENT ERR ;Here if RANDOM I/O was attempted before an OPEN statement was done. ; This is a fatal error since RECORDSIZE parameter is needed ;for random I/O. RIOERR: PUSHJ P,SETERI ;Take note of ERR=, IOSTAT=. $ECALL RR1,%ABORT ; Go give error, abort or jump. SEGMENT CODE SEGMENT DATA OLDFLG: BLOCK 1 SEGMENT CODE ;Routine to store END=, ERR=, and IOSTAT= args in the unit block. ;The args will stay in the DDB until IO returns via %SETAV. ; ;Inputs: ; U/ address of unit block ; A.ERR/ ; A.END/ ; A.IOS/ ;Call: ; PUSHJ P,STREEI ; STREEI: MOVE T1,A.END ;Get END= MOVEM T1,ENDAD(U) ;Store in unit block for later MOVE T1,A.ERR ;Get ERR= MOVEM T1,ERRAD(U) ;Store in unit block for later MOVE T1,A.IOS ;Get IOSTAT= MOVEM T1,IOSAD(U) ;Store in unit block for later POPJ P, ;Return SUBTTL BYTE I/O COMMENT & IBYTE and OBYTE are the basic routines for formatted I/O; they read or write one byte in the current record. RPOS returns the current position (column number) within a record. SPOS sets the current position. IREC reads the next record from the file. OREC writes a record into the file. Each open file has a record buffer which holds the current record. (This makes T format work and makes REREAD easier.) There is one record buffer per open file since function calls can cause simultaneous I/O on multiple units. Record buffer format: Input: IRBUF IRPTR v v -------------------------------------------------------------------- ! !///////////////////////////!///////////////! ! -------------------------------------------------------------------- <--- IRCNT ----> <---------------- IRLEN -------------------> <-------------------------- IRBLN --------------------------> Output: ORBUF ORPTR v v -------------------------------------------------------------------- ! !///////////////////////////!///////////////! ! -------------------------------------------------------------------- <------------ ORCNT ------------> <---------------- ORLEN* ------------------> <-------------------------- ORBLN --------------------------> (*note: on output, ORLEN is not kept up to date by OBYTE, since normally ORPTR is at the end of the record so ORLEN changes every character. ORLEN is correct immediately after a leftward T format.) The -1 word of the record buffer is used for carriage control. The record is altered by replacing the first character (the carriage control character) with 0 to 4 characters. & ;ROUTINE TO READ SINGLE BYTE ;RETURN: T1 = NEXT BYTE FROM FILE ;DESTROYS NO ACS EXCEPT T1 ;NOTE: IRCNT GOING NEGATIVE IS A LEGAL CONDITION. IT MERELY ;MEANS THAT WE ARE BEYOND THE END OF THE RECORD. T-FORMAT AND ;X-FORMAT WILL SET IT NEGATIVE IF THEY GO BEYOND THE END OF ;THE RECORD. %IBYTE: SOSGE IRCNT(D) ;DECREMENT BYTE COUNT JRST EOR ;NONE LEFT, END OF BUFFER ILDB T1,IRPTR(D) ;GET BYTE FROM BUFFER POPJ P, ;DONE EOR: MOVX T1,D%EOR ;Tell caller record has ended (if it cares) IORM T1,FLAGS(D) ; . . MOVEI T1," " ;EXTEND SHORT RECORDS WITH TRAILING SPACES POPJ P, ;RETURN ;ROUTINE TO REREAD CURRENT BYTE ;RETURN: T1 = BYTE THAT IBYTE RETURNED ON MOST RECENT CALL ;DESTROYS NO ACS EXCEPT T1 %IBYTC: MOVE T1,FLAGS(D) ;Get DDB flags TXNE T1,D%EOR ;Has record ended? SKIPA T1,[" "] ;YES, RETURN SPACE LDB T1,IRPTR(D) ;NO, RETURN CHAR UNDER BYTE POINTER POPJ P, ;RETURN ;ROUTINE TO BACK UP INPUT BYTE POINTER ;NO ARGS ;ON RETURN, IBYTE WILL BE BACKSPACED ONE CHARACTER ;CAN BE CALLED REPEATEDLY %IBACK: PUSHJ P,RIPOS ;GET CURRENT COLUMN NUMBER SOJA T1,SIPOS ;SET TO THAT COLUMN ;ROUTINE TO PUT SINGLE BYTE IN FILE ;ARGS: T1 = BYTE ;DESTROYS NO ACS %OBYTE: SKIPE ORPOS(D) ;VIRTUAL POSITION SET? PUSHJ P,SETPOS ;YES. SET NEW POSITION BEFORE DEPOSIT LOBYTE: SOSGE ORCNT(D) ;DECREMENT BYTE COUNT JRST OEXP ;BUFFER FULL, GO EXPAND IT IDPB T1,ORPTR(D) ;STORE BYTE IN BUFFER POPJ P, ;DONE OEXP: MOVE T0,FLAGS(D) ;Get flags TXNE T0,D%ENC ;ENCODE/DECODE? JRST TRUNC ;YES, TRUNCATE RECORD INSTEAD OF EXPANDING PUSHJ P,%PUSHT ;SAVE T0-T5 PUSHJ P,EXPORB ;EXPAND RECORD BUFFER PUSHJ P,%POPT ;RESTORE T0-T5 JRST LOBYTE ;GO STORE BYTE IN EXPANDED BUFFER TRUNC: TXOE T0,D%TRNC ;Only say this once POPJ P, IORM T0,FLAGS(D) ;(Remember D%TRUC was set) AOSN ORCNT(D) ;ONLY COMPLAIN ON FIRST CHAR (CNT = -1) ; IOERR (ETL,60,509,%,Record length exceeds string length) $ECALL ETL SOS ORCNT(D) ;RESTORE COUNT POPJ P, ;ROUTINE TO EXPAND THE RECORD BUFFER ;RETURN: T1 = BYTE POINTER TO START OF MOVED RECORD BUFFER ; T2 = BYTE POINTER TO FIRST FREE BYTE IN MOVED RECORD BUFFER ; T3 = NUMBER OF NEW BYTES IN MOVED RECORD BUFFER ; RBUF, RBLN, RPTR SET UP FOR NEW BUFFER EXPIRB: MOVE T2,IRBLN(D) ;GET OLD LENGTH IN BYTES HRRZ T1,IRBUF(D) ;AND OLD BUFFER ADDR SETZ T3, ;NO MINIMUM SIZE PUSHJ P,EXPRB ;EXPAND AND MOVE MOVEM T1,IRBUF(D) ;STORE NEW BUFFER ADDR MOVEM T1,IRPTR(D) ;STORE PNTR TO NEW BUFFER MOVE T4,IRBLN(D) ;GET OLD SIZE AGAIN MOVEM T3,IRBLN(D) ;STORE NEW SIZE SUBI T3,(T4) ;RETURN SIZE LEFT IN T3 POPJ P, EXPORB: MOVE T2,ORBLN(D) ;GET OLD LENGTH IN BYTES HRRZ T1,ORBUF(D) ;AND OLD BUFFER ADDR MOVE T3,ORPOS(D) ;VIRTUAL POSITION AS MINIMUM PUSHJ P,EXPRB ;EXPAND AND MOVE MOVEM T1,ORBUF(D) ;STORE NEW BUFFER ADDR MOVE T4,ORBLN(D) ;GET OLD SIZE AGAIN MOVEM T3,ORBLN(D) ;STORE NEW SIZE SUBI T3,(T4) ;RETURN SIZE LEFT IN T3 DMOVEM T2,ORPTR(D) ;STORE PNTR/COUNT TO MIDDLE OF NEW BUFFER POPJ P, EXPRB: JUMPE T1,GETRB ;IF NONE YET, GET ONE MOVEI T4,(T2) ;COPY OLD SIZE LSH T4,1 ;DOUBLE IT ADDI T4,(T3) ;ADD MINIMUM SIZE IDIVI T2,5 ;GET # WORDS IN OLD BUFFER MOVEI T3,(T4) ;COPY NEW SIZE IDIVI T3,5 ;GET # WORDS IN NEW BUFFER ADDI T3,1 ;ACCOUNT FOR CARRIAGE CONTROL WORD ADDI T2,1 ; JUST BEFORE REC BUFFER SUBI T1,1 PUSHJ P,%MVBLK ;MOVE TO BIGGER BUFFER ADDI T1,1 ;PUT CARRIAGE CONTROL WORD BACK SUBI T3,1 ;DON'T INCLUDE IN RECSIZ IMULI T3,5 ;CONVERT TO CHARS HRLI T1,(POINT 7) ;MAKE BYTE PNTR TO BEG BUFFER HRLI T2,(POINT 7,) ;MAKE BYTE POINTER TO END OF OLD STRING POPJ P, ;RETURN GETRB: ADDI T3,LRECBF*5 ;MINIMUM SIZE + STANDARD SIZE ADDI T3,4 ;ROUND UP IDIVI T3,5 ;GET # WORDS MOVEI T1,(T3) ;COPY IT IMULI T3,5 ;GET EXACT # CHARS ADDI T1,1 ;ADD 1 FOR CARRIAGE WORD PUSH P,T3 ;DESTROYED BY %GTBLK PUSHJ P,%GTBLK POP P,T3 ;GET THE NUMBER OF CHARS BACK ADDI T1,1 ;POINT PAST CARRIAGE WORD HRLI T1,(POINT 7) ;CREATE PNTR MOVE T2,T1 ;OLD AND NEW PNTR ARE THE SAME POPJ P, ;Routine to drop a null at EOR ; Does not affect the byte count ;Uses T1 ENDNUL: SETZ T1, ;Get a null char. PUSHJ P,%OBYTE ; Put in record AOS ORCNT(D) ;Don't count it as a character. POPJ P, ;Return SUBTTL INPUT %IREC: TXZE F,F%NINP ;REREAD? JRST REREAD ;YES. GO DO SETUP ONLY SETOM LSNUM(D) ;SET UP ILLEGAL LINE SEQUENCE NUMBER SKIPN IRBUF(D) ;ANY BUFFER YET? PUSHJ P,EXPIRB ;NO. ALLOCATE THE BUFFER AOS NREC(U) ;INCREMENT RECORD NUMBER LOAD T1,INDX(D) ;GET DEV INDEX PUSHJ P,@IDSP(T1) ;DO DEVICE-DEPENDENT INPUT LOAD T1,UNUM(U) ;Get unit number LOAD T2,FLAGS(D) ;Get flags TXNN T2,D%ENC ;Unless this is DECODE.. HRREM T1,U.RERD ;Store REREAD unit MOVE T1,IRBUF(D) ;GET RECORD BUFFER PNTR MOVEM T1,IRPTR(D) ;STORE INITIALIZED BYTE PTR MOVE T1,IRBLN(D) ;GET NUMBER OF BYTES IN RECORD BUFFER SUB T1,IRCNT(D) ;SUBTRACT NUMBER OF REMAINING BYTES MOVEM T1,IRCNT(D) ;STORE COUNT OF BYTES READ IN MOVEM T1,IRLEN(D) MOVE T0,FLAGS(D) ;Get current DDB flags TXZ T0,D%EOR ;RECORD HAS NOT ENDED YET TXO T0,D%SICR+D%SILF ;SUPPRESS NEXT CRLF MOVEM T0,FLAGS(D) ;Store updated DDB flags JUMPN T1,%POPJ ;NO MORE CHECKING IF CHARS IN RECORD TXNN T0,D%END ;ZERO CHARS. EOF ALSO? POPJ P, ;NO. JUST A NULL RECORD IREOF: SETZM IRCNT(D) ;EOF, RETURN A ZERO-CHARACTER RECORD ; IOERR (EOF,899,404,?,End of file,,%ABORT) $ECALL EOF,%ABORT ;HANDLE EOF RETURN IN IOERR POPJ P, REREAD: MOVE T1,IRLEN(D) ;REREAD. SETUP PNTR/COUNT WITH OLD DATA MOVEM T1,IRCNT(D) MOVE T1,IRBUF(D) MOVEM T1,IRPTR(D) MOVX T1,D%EOR ANDCAM T1,FLAGS(D) ;Clear "end of record" flag POPJ P, ;Return ;ALL DEVICE-DEPENDENT INPUT ROUTINES HAVE THE SAME CALLING SEQUENCE: ;ARGS: IRPTR = BYTE POINTER TO START OF RECORD BUFFER ; IRBLN = NUMBER OF BYTES IN RECORD BUFFER ;RETURN: NEXT RECORD FROM FILE READ INTO RECORD BUFFER ; T3 = NUMBER OF UNUSED BYTES LEFT IN RECORD BUFFER IDSP: IFIW TIREC IFIW DIREC IFIW XIREC IFIW XIREC IFIW DECODE IF20,< ;TTY TIREC: MOVE T0,FLAGS(D) TXZ T0,D%END ;CLEAR EOF FOR TTY'S MOVEM T0,FLAGS(D) TXNN T0,D%SICR+D%SILF ;SUPPRESS CR OR LF? PUSHJ P,%OCRLF ;NO. OUTPUT CRLF MOVEI T1,.RDBRK ;SET TEXTI BLOCK LENGTH MOVEM T1,TXIBLK+.RDCWB MOVX T1,RD%CRF+RD%JFN+RD%BBG ;SUPPRESS CR, READ FROM JFNS, BFP GIVEN MOVEM T1,TXIBLK+.RDFLG ;STORE FLAGS LOAD T1,IJFN(D) ;GET JFN HRLI T1,(T1) ;IN BOTH HALVES MOVEM T1,TXIBLK+.RDIOJ ;STORE IT MOVE T1,IRBUF(D) ;GET RECORD BUFFER PNTR MOVEM T1,TXIBLK+.RDDBP ;STORE DEST BYTE POINTER MOVEM T1,TXIBLK+.RDBFP ;AND BEGINNING-OF-BUFFER POINTER MOVE T1,IRBLN(D) ;GET RECORD BUFFER LENGTH MOVEM T1,TXIBLK+.RDDBC ;STORE DEST BYTE COUNT SETZM TXIBLK+.RDBFP ;NO WAKEUP ON ^U, ^W EDITING MOVE T1,G.PRP ;SET POINTER TO PROMPT STRING MOVEM T1,TXIBLK+.RDRTY MOVEI T1,TXIBRK ;POINT TO BREAK MASK MOVEM T1,TXIBLK+.RDBRK ;STORE IT LOAD T1,IJFN(D) ;SET CCOC WORDS FOR INPUT DMOVE T2,CCOC(D) SFCOC% TCONT: MOVEI T1,TXIBLK ;POINT TO BLOCK TEXTI% ;READ A LINE JSHALT ;SHOULD NOT FAIL MOVE T1,TXIBLK+.RDFLG ;GET TEXTI FLAGS TXNN T1,RD%BTM ;INPUT TERMINATED BY BREAK CHAR? JRST TEXP ;NO, EXPAND BUFFER AND CONTINUE MOVX T0,D%END ;Get flag to set if CTRL-Z seen. LDB T1,TXIBLK+.RDDBP ;GET TERMINATING CHAR CAIN T1,32 ;^Z? IORM T0,FLAGS(D) ;Yes, set end-of-file LOAD T1,IJFN(D) ;SET CCOC WORDS FOR OUTPUT MOVE T2,CCOC(D) ;SET ALL CHARS TO SEND LITERALLY AND T2,%CCMSK ; EXCEPT ^I AND ^L, WHICH BEHAVE THE SAME OR T2,%OCCOC ; AS ON INPUT MOVE T3,%OCCOC+1 SFCOC% SETZM G.PRP ;CLEAR PROMPT STRING FOR NEXT TIME AOS T3,TXIBLK+.RDDBC ;RETURN COUNT OF LEFTOVER BYTES IN BUFFER MOVEM T3,IRCNT(D) ; DISCARDING TERMINATING BREAK CHAR POPJ P, ;DONE TEXP: PUSHJ P,EXPIRB ;EXPAND RECORD BUFFER MOVEM T1,TXIBLK+.RDBFP ;SET NEW POINTER TO START OF BUFFER MOVEM T2,TXIBLK+.RDDBP ;SET POINTER TO DEST STRING MOVEM T3,TXIBLK+.RDDBC ;SET BYTE COUNT OF DEST STRING JRST TCONT ;DO ANOTHER TEXTI TO CONTINUE INPUT ;STILL IF20 ;TEXTI BREAK TABLE FOR STANDARD FORTRAN CHAR SET TXIBRK: 1B<^O12>+1B<^O13>+1B<^O14>+1B<^O32> ;BREAK ON LF, VT, FF, ^Z 0 ;AND NOTHING ELSE 0 0 SEGMENT DATA TXIBLK: BLOCK 1+.RDBRK ;TEXTI ARG BLOCK SEGMENT CODE ;STILL IF20 ;DISK DIREC: XIREC: >;END IF20 IF10,< TIREC: MOVE T0,FLAGS(D) ;Get current DDB flags TXZ T0,D%END ;CLEAR EOF FOR TTY'S MOVEM T0,FLAGS(D) ;Store updated flags TXNN T0,D%SICR+D%SILF ;SUPPRESS CR OR LF? PUSHJ P,%OCRLF ;NO. OUTPUT CRLF DIREC: XIREC: >;END IF10 MOVE T1,IRBLN(D) ;GET # BYTES IN RECORD BUFFER MOVEM T1,IRCNT(D) ;SETUP INITIAL COUNT MOVE T1,FLAGS(D) ;ARE WE AT EOF? TXNE T1,D%END POPJ P, ;YES. GO NO FURTHER PUSHJ P,%SAVE4 ;SAVE SOME P ACS DMOVE P1,IPTR(D) ;GET FILE WINDOW BYTE POINTER/COUNT MOVE P3,RSIZE(D) ;GET RECORD SIZE, 0 IF NONE MOVE T2,IRBUF(D) ;GET RECORD BUFFER PNTR MOVE T3,IRBLN(D) ;GET REC BUFFER LENGTH LOAD T1,MODE(D) ;GET MODE OF FILE CAIE T1,MD.ASL ;LINE-SEQUENCE ASCII? JRST DLP ;NO ILNLP: SOJGE P2,ILNOK ;DECR COUNT PUSHJ P,IMAP ;COUNT RAN OUT. GET ANOTHER BUF JRST ILNLP ;AND TRY AGAIN JRST DIEOR ;GOT EOF ILNOK: ILDB P4,P1 ;GET A CHAR JUMPE P4,ILNLP ;SKIP IT IF NULL MOVEI T1,(P1) ;GET A PROPER INDEX, (In-section address) ; Note: Don't use XMOVEI above-- ; (P1 is a byte ptr) MOVE T0,(T1) ;GET THE WORD CHAR CAME FROM TRNN T0,1 ;LOW BIT ON? JRST INOLN ;NO. NOT A LINE # MOVEM T0,LSNUM(D) ;SAVE THE LSN ADDI P1,1 ;YES. PROCEED TO NEXT WORD SUBI P2,5 ;DECR CHAR COUNT FOR WORD LDB P4,P1 ;GET THE BYTE AFTER WORD CAIE P4,11 ;IS IT A TAB? JRST INOLN ;NO. USE THE CHAR DLP: SOJGE P2,DLPX2 ;IF OUT OF MAPPED BYTES, GO GET MORE PUSHJ P,IMAP JRST DLP ;KEEP IN SYNCH! JRST DIEOR ;GOT EOF DLPX2: ILDB P4,P1 ;GET A BYTE INOLN: CAIGE P4,40 ;CHECK FOR SPECIAL BYTE JRST CHKEOL ;SPECIAL DDPB: SOJGE T3,DDPB2 ;DECR RECORD BUFFER COUNT, EXPAND IF NEEDED PUSHJ P,EXPIRB ;USES T1 JRST DDPB ;KEEP IN SYNCH DDPB2: IDPB P4,T2 ;DEPOSIT BYTE IN RECORD BUFFER DDPB3: SOJL P3,DLP ;DECR THE RECSIZ COUNT JUMPG P3,DLP ;OK IF NEG JRST DIEOR ;END OF RECORD IF ZERO CHKEOL: JUMPE P4,DDPB3 ;SKIP NULLS CAIN P4,15 ;CARRIAGE RETURN? JRST GOTCR ;YES CAIG P4,14 ;STANDARD EOF CHARS ARE 12-14 (LF,VT,FF) CAIGE P4,12 ;EOL CHAR? JRST NOTEOL ;NO. CHECK FOR TTY CONTROL-Z SOJA P3,DIEOR ;YES. DECR COUNT AND END IT ALL NOTEOL: CAIE P4,32 ;^Z? JRST DDPB ;NO. PASS IT THROUGH LOAD T1,INDX(D) ;YES. GET DEVICE INDEX CAIE T1,DI.TTY ;TTY? JRST DDPB ;NO. PASS IT THROUGH JRST DDPB3 ;YES. SKIP IT GOTCR: CRLP: DMOVEM P1,IPTR(D) ;SAVE AWAY THE CURRENT PNTR/COUNT SOJGE P2,CRX2 ;ANY CHARS IN BUFFER? PUSHJ P,IMAP ;NO. GET A BUFFERFUL JRST CRLP ;KEEP IN SYNCH JRST DIEOR ;GOT EOF CRX2: ILDB P4,P1 ;GET A CHAR JUMPE P4,CRX3 ;SKIP NULLS CAIN P4,15 ;ANOTHER CARRIAGE RETURN? JRST CRX3 ;YES. IGNORE IT CAIG P4,14 ;VERT MOTION CHAR? CAIGE P4,12 JRST CRONLY ;NO. DATA SOJA P3,DIEOR ;YES. REAL END OF LINE CRX3: SOJG P3,CRLP ;DECR RECSIZ COUNT JUMPL P3,CRLP ;IF NEG, VARIABLE SIZE JRST DIEOR ;IF ZERO, EOL CRONLY: DMOVE P1,IPTR(D) ;GET PNTR/COUNT BEFORE NEW DATA DIEOR: MOVEM T3,IRCNT(D) ;SAVE THE REDUCED REC COUNT SKIPE RSIZE(D) ;RECORDSIZE? PUSHJ P,IALIGN ;YES. ALIGN THE PNTR/COUNT DMOVEM P1,IPTR(D) ;STORE UPDATED FILE BYTE POINTER MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%RAN ;RANDOM I/O? CAME T2,IRBUF(D) ;YES, DID WE FIND A NONZERO BYTE? POPJ P, ;YES, DONE JRST RNRERR ;NO, REC NOT WRITTEN IALIGN: MOVE T3,RSIZE(D) ;GET THE RECORDSIZE ADDI T3,6 ;2 FOR CRLF, 4 FOR ROUNDING IDIVI T3,5 ;GET # WORDS IMULI T3,5 ;AND # CHARS AGAIN SUB T3,RSIZE(D) ;GET DIFF ADDI P3,(T3) ;ADD TO # CHARS TO SKIP JUMPE P3,IRNOSK ;NO CHARS TO SKIP IALGLP: PUSHJ P,GETBYT ;SKIP THE CRLF SOJG P3,IALGLP IRNOSK: HRLI P1,(POINT 7,0,34) ;POINT TO END OF WORD IDIVI P2,5 ;CORRECT COUNT IMULI P2,5 POPJ P, GETBYT: MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%END ;DID WE GET EOF ALREADY? POPJ P, ;YES. DON'T TRY AGAIN SOJGE P2,GOTBYT ;STILL SOME THERE PUSHJ P,IMAP ;NO JRST GETBYT ;Keep in synch POPJ P, ;EOF GOTBYT: ILDB P4,P1 ;GET A CHAR POPJ P, IF20,< IMAP: LOAD T1,INDX(D) ;GET DEVICE INDEX CAIE T1,DI.DSK ;DISK? JRST XSIN ;NO. MUST DO SINR'S MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%RAN ;RANDOM? JRST FNXTW ;YES. DO SEPARATELY MOVE T1,BYTN(D) ;GET DESIRED BYTE # CAML T1,EOFN(D) ;PAST EOF? JRST DPEOF ;YES. GO SET EOF FLAG IMAPX: PUSHJ P,FNXTW ;MAP NEXT WINDOW MOVEM P2,WCNT(D) ;SAVE ACTIVE BYTE COUNT MOVE T1,BYTN(D) ;GET BYTE # OF NEXT WINDOW CAMG T1,EOFN(D) ;PAST EOF? POPJ P, ;NO SUB T1,EOFN(D) ;GET DIFF SUBI P2,(T1) ;REDUCE # BYTES AVAIL MOVEM P2,WCNT(D) ;SAVE ACTIVE BYTE COUNT POPJ P, DPEOF: AOS (P) ;SKIP RETURN MEANS EOF MOVX T0,D%END ;Set EOF flag IORM T0,FLAGS(D) POPJ P, >;END IF20 IF10,< ;GENERAL-PURPOSE IO ERROR MESSAGE ; IOERR (IOE,899,400,%,$I,) IMAP: MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%RAN ;RANDOM? JRST FNXTW ;YES DMOVEM P1,IPTR(D) ;STORE POINTER, COUNT FOR MONITOR PUSH P,T2 PUSH P,T3 AOS T1,BLKN(D) ;INCREMENT BLOCK # IMULI T1,1200 ;GET NEXT BLOCK FIRST BYTE # MOVEM T1,BYTN(D) ;SAVE FOR EOFN CALC HLLZ T2,CHAN(D) ;GET CHANNEL NUMBER FOR FILOP HRRI T2,.FOINP ;SET FILOP FUNCTION MOVE T1,[1,,T2] ;SET LENGTH,,ADDRESS FILOP. T1, ;INPUT NEXT BUFFER PUSHJ P,TEOFCHK ;ERROR, COULD BE EOF POP P,T3 POP P,T2 DMOVE P1,IPTR(D) ;GET NEW BYTE POINTER, COUNT MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%END ;IF FILE ENDED, AOS (P) ;SKIP RETURN POPJ P, ;ELSE DONE TEOFCHK: LOAD T2,INDX(D) ;GET DEV INDEX CAIN T2,DI.TTY ;TERMINAL? TRNN T1,IO.EOF ;YES, EOF? JRST EOFCHK ;NO, NOTHING SPECIAL MOVE T2,[1,,T3] ;SET UP FOR CLOSE MOVEI T3,.FOCLS HLL T3,CHAN(D) FILOP. T2, ;CLEAR EOF BIT, LEAVE TTY OPEN $ECALL IOE,%ABORT EOFCHK: MOVX T0,D%END ;Get EOF flag TRNE T1,IO.EOF ;EOF? IORM T0,FLAGS(D) ;Yes, this file is ended TRNE T1,IO.EOF ;EOF OFF? TRNE T1,IO.ERR+IO.EOT ;NO, ANY REAL ERR BITS? $ECALL IOE,%ABORT POPJ P, ;RETURN FROM XIREC WITH T3 SET >;END IF10 IF20,< XSIN: MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%END ;EOF ALREADY FOUND? JRST %POPJ1 ;YES. SKIP RETURN LOAD T0,DVTYP(D) ;Is this a DISK append file? CAIN T0,.DVDSK ; (If DVTYP is disk and we are here, JRST EOFGET ;it is, so get EOF). PUSH P,T2 ;SAVE CRITICAL ACS PUSH P,T3 AOS BLKN(D) ;INCR BLOCK # LOAD T1,IJFN(D) ;GET FILE JFN HRRO T2,WADR(D) ;GET POINTER TO BUFFER MOVN T3,WSIZ(D) ;GET WINDOW SIZE IN BYTES SINR% ;READ STRING ERCAL EOFCHK ;ERROR, POSSIBLE EOF MOVE P1,WADR(D) ;MAKE BYTE POINTER TO BUFFER SUBI P1,1 ;POINT TO BEG-1 HRLI P1,(POINT 7,0,34) MOVE P2,WSIZ(D) ;GET FULL WINDOW SIZE ADD P2,T3 ;GET # BYTES WE GOT MOVEM P2,WCNT(D) ;SAVE FOR DIRECTION SWITCHING POP P,T3 ;RESTORE T ACS POP P,T2 JUMPG P2,%POPJ ;RETURN TO COPY LOOP AOS (P) ;OTHERWISE EOF POPJ P, ;Here to return EOF because DISK APPEND file wanted to READ. EOFGET: MOVX T0,D%END ;EOF IORM T0,FLAGS(D) JRST %POPJ1 ;Skip return for EOF ;Routine to get ERROR or set D%END if EOF. ;Returns .+1 unless ERR= branch taken. EOFCHK: GTSTS% ;GET FILE STATUS TXNN T2,GS%EOF ;EOF? [*** err+eof??] JRST INPERR ;NO, INPUT ERROR MOVX T0,D%END ;EOF, tell caller IORM T0,FLAGS(D) POPJ P, ;CONTINUE INPERR: AOS T2,ERRN(D) ;BUMP ERROR COUNT CAILE T2,^D10 ;TOO MANY? ; IOERR (INX,899,401,?,$J,,%ABORT) ;YES ; IOERR (INP,899,401,%,$J,,%POPJ) ;NO $ECALL INX,%ABORT ;Yes $ECALL INP,%POPJ ;No > ;END IF20 RNRER1: MOVE T1,NREC(D) ;GET RECORD NUMBER $ECALL RNR,%ABORT ;HAVEN'T INCR REC # YET RNRERR: MOVE T1,NREC(U) ;GET RECORD NUMBER SUBI T1,1 ;POINT BACK TO CURRENT RECORD ; IOERR (RNR,25,510,?,Record $D has not been written,,%ABORT) $ECALL RNR,%ABORT ;DECODE DECINI: MOVE T1,A.HSA ;GET STRING ADDR $BLDBP T1 ;Make byte ptr to start of string MOVEM T1,IRBUF(D) ;STORE RECORD BUFFER POINTER SKIPGE T1,A.HSL ;GET STRING LENGTH SETZ T1, ;NEGATIVE, SET TO 0 MOVEM T1,IRBLN(D) ;STORE AS RECORD BUFFER LENGTH MOVEM T1,IRCNT(D) ;RETURN ZERO EMPTY CHARS IN REC BUFFER POPJ P, ;RETURN DECODE: MOVE T1,IRBLN(D) ;GET STRING LENGTH SKIPLE IRCNT(D) ;IF 0 OR NEG, WE'RE AT END OF STRING SUB T1,IRCNT(D) ;GET CURRENT CHAR POSITION ADDI T1,4 ;GET # WORDS TAKEN IDIVI T1,5 ADDM T1,IRBUF(D) ;SAVE NEW BUFFER PNTR IMULI T1,5 ;GET # CHARS USED UP MOVE T2,IRBLN(D) ;DECR # CHARS IN STRING SUBI T2,(T1) MOVEM T2,IRBLN(D) ;SAVE NEW COUNT SETZM IRCNT(D) ;SETUP FOR REST OF IREC POPJ P, SUBTTL OUTPUT ;%OREC IS CALLED FROM INSIDE FORIO ONLY, AT THE FIN CALL AT THE END ;OF ALL FORMATTED I/O WRITES. ;%ORECS IS CALLED FROM FORFMT (FOR "/" FORMAT) AND NMLST/LDIO (TO ;OUTPUT A RECORD). IT CALLS %OREC AND THEN SETS ;UP THE OUTPUT RECORD BUFFER AGAIN EXCEPT FOR ENCODE/DECODE %ORECS: %OREC: MOVE T0,FLAGS(D) ;Get DDB flags TXNN T0,D%ENC ;ENCODE? PUSHJ P,FIXREC ;NO. DO CC SUBSTITUTION, /RECORDSIZE PADDING ORECX: LOAD T1,INDX(D) ;GET DEV INDEX PUSHJ P,@ODSP(T1) ;OUTPUT THE RECORD, AS APPROPRIATE FOR DEV AOS NREC(U) ;COUNT RECORD ORINI: MOVE T1,ORBUF(D) ;RESET BYTE POINTER MOVEM T1,ORPTR(D) MOVE T1,ORBLN(D) ;RESET BYTE COUNT MOVEM T1,ORCNT(D) SETZM ORLEN(D) ;CLEAR RECORD LENGTH SETZM ORPOS(D) ;CLEAR VIRTUAL POS POPJ P, ;DONE, READY FOR NEXT OUTPUT ODSP: IFIW TOREC IFIW DOREC IFIW XOREC IFIW XOREC IFIW ENCODE ;ERROR MESSAGE OUTPUT ;ARGS: T1 = ADDRESS OF ASCIZ MESSAGE STRING %EOREC: PUSH P,D PUSH P,U SKIPN U,U.ERR ;POINT TO ERR DDB JRST ETTY ;NONE, USE PSOUT PUSH P,U.ERR ;RECURSIVE ERRS GO TO TTY SETZM U.ERR MOVE D,DDBAD(U) ;Set up D STKVAR ;ALLOCATE STACK VARS HRLI T1,(POINT 7,) ;STORE POINTER TO MSG MOVEM T1,ERPTR PUSHJ P,%SETOUT ;Set file open for output PUSHJ P,ROPOS ;Get output position CAIE T1,1 ;If not at column 1, PUSHJ P,%OCRLF ;Get to column 1 MOVEI T1," " ;GET A SPACE LOAD T2,CC(U) ;GET /CC CAIN T2,CC.FORT ;/CC:FORTRAN? PUSHJ P,%OBYTE ;YES, SPACE CARRIAGE CONTROL FOR ERRORS EOLP: ILDB T1,ERPTR ;GET BYTE OF MSG JUMPE T1,EOEND ;QUIT WHEN NULL PUSHJ P,%OBYTE ;TYPE CHAR JRST EOLP EOEND: PUSHJ P,%OREC ;WRITE MESSAGE MOVX T1,D%MOD ;Remember file modified IORM T1,FLAGS(D) UNSTK ;CLEAN UP AND RETURN POP P,U.ERR POP P,U POP P,D POPJ P, EOCRLF: MOVEI T1,15 ;CRLF PUSHJ P,%OBYTE MOVEI T1,12 PJRST %OBYTE ETTY: SKIPN D,D.TTY ;POINT TO TTY DDB IF OPEN JRST EPSOUT ;NO, NO COMPLICATIONS MOVE T0,FLAGS(D) ;GET FLAGS TXNN T0,D%OUT ;DOING OUTPUT? JRST EPSOUT ;NO, FINE PUSH P,T1 ;SAVE MESSAGE ADDRESS PUSHJ P,ROPOS ;Get column position CAIE T1,1 ;Is last line out yet? PUSHJ P,%OREC ;No, write it MOVE T0,FLAGS(D) ;Re-get flags TXNN T0,D%SICR+D%SILF ;Suppress CRLF? PUSHJ P,%OCRLF ;No, get to column 1 POP P,T1 ;RESTORE MSG ADDRESS EPSOUT: POP P,U ;Restore pushed ACs ; POP P,DF POP P,D IF10,< OUTSTR (T1) ;TYPE MESSAGE OUTSTR %CRLF## > IF20,< HRROI T1,(T1) PSOUT% HRROI T1,%CRLF## PSOUT% > POPJ P, ;DONE ;OUTPUT CARRIAGE CONTROL ;IF CARRIAGE CONTROL IS BEING DONE, SUBSTITUTES FOR FIRST CHAR ;IF FIXED-LENGTH RECORDS, PADS OR TRUNCATES RECORD TO CORRECT LENGTH ; ;RETURN: ORPTR = BYTE POINTER TO FIRST CHAR OF RECORD ; ORCNT = NUMBER OF BYTES IN RECORD FIXREC: MOVE T0,FLAGS(D) ;GET DDB FLAGS TXNN T0,D%STCR ;DOLLAR FORMAT? JRST NODOL ;NO SKIPE ORPOS(D) ;ANY VIRTUAL POSITION? PUSHJ P,SETPOS ;YES. SET IT UP NODOL: SETZM ORPOS(D) ;DON'T LET TRAILING TABBING FOOL US! SKIPN ORPTR(D) ;ANY RECORD BUFFER YET? PUSHJ P,EXPORB ;NO. SET ONE UP! MOVE T1,ORBLN(D) ;GET BUFFER LENGTH SUB T1,ORCNT(D) ;GET CURRENT POSITION CAML T1,ORLEN(D) ;ARE WE SOMEWHERE INSIDE RECORD? JRST NSPOS ;NO. ALREADY AT END MOVE T1,ORLEN(D) ;GET IT AGAIN PUSHJ P,SPOS1 ;SET TO END OF RECORD JRST GOTPOS ;ORLEN OK AS IS NSPOS: MOVEM T1,ORLEN(D) ;SAVE NEW LENGTH GOTPOS: SKIPE T2,RSIZE(D) ;FIXED-LENGTH RECORDS? CAMN T2,ORLEN(D) ;YES. PERFECT FIT? JRST NPAD ;VARIABLE LENGTH OR PERFECT FIT. SKIP PADDING SUB T2,ORLEN(D) ;CHECK AGAINST CHARS ALREADY WRITTEN JUMPG T2,NTRUNC ;RECORD SHORTER THAN RECORDSIZE, FINE MOVE T1,RSIZE(D) ;GET RECORDSIZE PUSHJ P,SPOS1 ;TRUNCATE RECORD TO ITS MAXIMUM SIZE JRST NPAD ;DON'T PAD NTRUNC: PUSHJ P,CHRPAD ;APPEND PAD CHARS TO GET RECORD TO RIGHT SIZE NPAD: LOAD T1,CC(U) ;GET /CARRIAGECONTROL CAIN T1,CC.FORT ;/CC:FORTRAN? JRST FIXCC ;YES, GO HANDLE ;HERE WHEN CC=LIST, IE DO NOT SUBSTITUTE CARRIAGE CONTROL CHAR ;APPEND TRAILING CRLF TO RECORD UNLESS $ FORMAT, IN WHICH CASE DON'T APPEND ;ANYTHING. IF WRITING FIXED-LENGTH RECORDS, SKIP TO WORD BOUNDARY SO DISK ;FILES LOOK THE SAME AS V5, WITH ALL RECORDS STARTING IN A NEW WORD. MOVE T0,FLAGS(D) TXZ T0,D%SICR+D%SILF ;Turn off "suppress CRLF" flags MOVEM T0,FLAGS(D) ;Make sure flags are in reasonable state TXZE T0,D%STCR ;$ format in this record? JRST NCRLF ;Yes, skip CRLF MOVEI T1,15 ;CRLF PUSHJ P,%OBYTE MOVEI T1,12 PUSHJ P,%OBYTE MOVX T1,D%SICR+D%SILF ;Set flags that say we already got a CRLF IORM T1,FLAGS(D) JRST NLPAD ;GO APPEND NULLS IF NECESSARY ;Updated DDB flags are in T0. NCRLF: TXO T0,D%SICR ;SET FLAG SO TTY INPUT WILL FIND PROMPT MOVEM T0,FLAGS(D) ;Store updated flags SKIPN RSIZE(D) ;FIXED-LENGTH RECORDS? JRST NLPAD ;NO, SKIP MOVEI T1,0 ;PUT IN 2 NULLS TO ALIGN AS IF CRLF WERE THERE PUSHJ P,%OBYTE PUSHJ P,%OBYTE NLPAD: PUSHJ P,NULPAD ;PAD TO WORD BOUNDARY IF NECESSARY MOVE T1,ORBLN(D) ;SET RCNT TO NUMBER OF BYTES IN RECORD SUBB T1,ORCNT(D) MOVE T1,ORBUF(D) ;GET REC BUFFER ADDRESS MOVEM T1,ORPTR(D) ;STORE IT IF20,< MOVEM T1,G.PRP > ;SAVE POINTER TO PROMPT STRING, MIGHT NEED IT POPJ P, ;HERE WHEN CC=FORTRAN, IE SUBSTITUTE CARRIAGE CONTROL CHAR ;REPLACE FIRST CHAR WITH CARRIAGE CONTROL SEQUENCE. THE CARRIAGE CONTROL ;SEQUENCE STARTS WITH UNLESS THE PREVIOUS LINE ENDED WITH $ FORMAT. ;THEN COME 0-3 CHARACTERS, DEPENDING ON THE CARRIAGE CONTROL CHAR. IF ;THIS LINE HAS A $ FORMAT, SET A FLAG TO PREVENT THE NEXT TIME. FIXCC: PUSHJ P,ENDNUL ;Drop a null at EOR MOVE T2,ORBLN(D) ;SET RCNT TO LENGTH OF RECORD NOW, SUBB T2,ORCNT(D) ; BEFORE CC SUBSTITUTION MOVE T1,ORBUF(D) ;POINT TO REC BUFFER JUMPE T2,[AOS ORCNT(D) ;IF ZERO-LENGTH RECORD, MOVSI T2,(" "B6) ;MAKE INTO A RECORD CONTAINING ONE SPACE MOVEM T2,(T1) JRST .+1] HRLI T1,(POINT 7,,6) ;MAKE POINTER TO FIRST CHAR OF RECORD MOVEM T1,ORPTR(D) ;STORE POINTER IF20,< MOVEM T1,G.PRP > ;STORE POINTER TO PROMPT STRING, MIGHT NEED IT MOVX T0,D%STCR ;Flag to set (maybe) LDB T1,T1 ;GET CC CHARACTER CAIN T1,"$" ;DOLLAR CARRIAGE CONTROL? IORM T0,FLAGS(D) ;Yes, same as $ FORMAT and space CC CAIL T1,"*" ;RANGE CHECK CC CHAR CAILE T1,"3" MOVEI T1,"*"-1 ;OUT OF RANGE, TREAT AS SPACE HLRZ T2,CCTAB-"*"(T1) ;GET REPEAT COUNT HRRZ T1,CCTAB-"*"(T1) ;GET CONTROL CHAR WHICH DOES THE CC MOVE T4,FLAGS(D) ;T4:= DDB flags TXZN T4,D%SILF ;SUPPRESS INITIAL LF? JRST NSUP ;NO CAIN T1,12 ;YES, DO WE HAVE A LF TO SUPPRESS? SUBI T2,1 ;YES, DECREMENT LF COUNT NSUP: JUMPLE T2,NLF ;IF NO CC CHARS LEFT, SKIP PUSHJ P,DPBD ;STORE CHAR AND DECREMENT RPTR SOJG T2,.-1 ;REPEAT UNTIL DONE NLF: MOVEI T1,15 ;GET CR TXZN T4,D%SICR ;SUPPRESS INITIAL CR? PUSHJ P,DPBD ;NO, APPEND CR TO FRONT SOS ORCNT(D) ;CORRECT COUNT, CC CHAR IS NOW GONE TXZE T4,D%STCR ;SUPPRESS TRAILING CR ON THIS LINE? TXO T4,D%SICR+D%SILF ;YES, SUPPRESS INITIAL CRLF OF NEXT LINE MOVEM T4,FLAGS(D) ;Store updated DDB flags POPJ P, ;ALL DONE ;ROUTINE TO NORMALIZE CRLF POSITION, BY TYPING PENDING CRLF, IF ANY ; ;WHEN WRITING A FILE WITH CC=FORTRAN, THE CRLFS COME BEFORE THE ;RECORDS INSTEAD OF AFTER THEM. THE REST OF THE WORLD PUTS CRLFS ;AFTER THEIR RECORDS. THIS ROUTINE IS CALLED TO GET IN SYNC WITH THE ;OUTSIDE WORLD WHEN NECESSARY. ; ;CALLED: ; BEFORE AN ERROR MESSAGE IS TYPED ; WHEN SWITCHING FROM OUTPUT TO INPUT ON TTY %OCRLF: MOVX T0,D%SILF+D%SICR ;Suppress next CRLF IORM T0,FLAGS(D) MOVEI T1,2 ;SET BYTE COUNT, PTR MOVEM T1,ORCNT(D) MOVE T1,ORBUF(D) MOVEM T1,ORPTR(D) MOVE T2,%CRLF ;GET A CRLF MOVEM T2,(T1) ;PUT IT IN THE RECORD BUFFER IF20,< SETZM G.PRP > ;SET NO PROMPT STRING AVAILABLE PJRST ORECX ;FORCE THE CRLF OUT ;DEPOSIT BYTE AND DECREMENT (THE OPPOSITE OF ILDB) ;T1 = BYTE, RPTR = 7-BIT BYTE POINTER ;Uses T1 and T3 only DPBD: AOS ORCNT(D) ;BUMP BYTE COUNT DPB T1,ORPTR(D) ;DEPOSIT BYTE MOVSI T3,(47B5) ;DECREMENT RPTR ADD T3,ORPTR(D) TLCN T3,(1B0) SUB T3,[430000,,1] MOVEM T3,ORPTR(D) POPJ P, ;ROUTINES TO PAD RECORD ;NULPAD APPENDS 0-4 NULLS TO RECORD TO BRING IT TO WORD BOUNDARY ;CHRPAD APPENDS (T2) PAD CHARACTERS TO RECORD NULPAD: SKIPN RSIZE(D) ;/REC SIZE? POPJ P, ;NO, NO NULL PADDING IS NECESSARY MOVE T1,ORBLN(D) ;GET REC BUF SIZE SUB T1,ORCNT(D) ;GET # CHARS WRITTEN MOVNI T1,(T1) ;GET -SIZE IDIVI T1,5 ;GET T2 = -SIZE MOD 5 = NUMBER OF NULLS JUMPE T2,%POPJ ;LEAVE ZERO REMAINDER ALONE ADDI T2,5 ;OTHERWISE CONVERT TO POSITIVE TDZA T1,T1 ;GET A NULL AND SKIP INTO LOOP CHRPAD: LOAD T1,PADCH(U) ;GET PAD CHAR PUSHJ P,%OBYTE ;OUTPUT A PAD CHAR SOJG T2,.-1 ;KEEP PADDING UNTIL RECORD IS RIGHT SIZE POPJ P, ;Return when done ;CARRIAGE CONTROL TABLE ;(LH) REPEAT COUNT, (RH) CONTROL CHAR TO SUBSTITUTE ;CHAR CC SEQ ACTION ON PRINTER XWD 1,12 ;SPACE NEXT LINE CCTAB: XWD 1,23 ;* <^S> NEXT LINE, NO PAGE SKIP XWD 0, ;+ OVERWRITE CURRENT LINE XWD 1,21 ;, <^Q> NEXT EVEN LINE XWD 3,12 ;- SKIP 2 LINES XWD 1,22 ;. <^R> NEXT THIRD LINE XWD 1,24 ;/ <^T> NEXT 10TH LINE XWD 2,12 ;0 SKIP 1 LINE XWD 1,14 ;1 PAGE SKIP XWD 1,20 ;2 <^P> NEXT 30TH LINE XWD 1,13 ;3 NEXT 20TH LINE ;DISK OUTPUT IF20,< DOREC: MOVX T0,D%MOD ;Set file modified IORM T0,FLAGS(D) XOREC: >;END IF20 IF10,< ;ARBITRARY DEVICE DOREC: TOREC: XOREC: >;END IF10 PUSHJ P,%SAVE2 ;Save P1 and P2 DMOVE P1,OPTR(D) ;GET FILE POINTER/COUNT DMOVE T2,ORPTR(D) ;GET RECORD BYTE POINTER AND RECORD LENGTH JUMPE T3,DOFIN ;IF NO BYTES LEFT IN RECORD, DONE DOLP: SOJL P2,DOFULL ;IF FILE WINDOW FULL, GO MOVE WINDOW ILDB T1,T2 ;GET BYTE FROM RECORD IDPB T1,P1 ;STORE BYTE IN FILE SOJG T3,DOLP ;COPY WHOLE RECORD ;ALL DONE, FALL INTO DOFIN DOFIN: DMOVEM P1,OPTR(D) ;STORE UPDATED POINTER/COUNT IF10,< MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%INT ;INTERACTIVE DEVICE? PUSHJ P,NOTRAN ;YES. OUTPUT BUFFER >;END IF10 MOVE T1,BYTN(D) ;GET BYTE # OF NEXT WINDOW SUBI T1,(P2) ;GET LAST BYTE IN USE MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%RAN ;RANDOM FILE? CAMLE T1,EOFN(D) ;YES. ONLY STORE LARGER EOFN MOVEM T1,EOFN(D) ;SAVE AS EOF PNTR POPJ P, ;DONE DOFULL: PUSHJ P,OMAP ;OUTPUT A WINDOWFUL JRST DOLP ;STAY IN SYNCH IF20,< OMAP: LOAD T1,INDX(D) ;GET DEVICE INDEX CAIN T1,DI.DSK ;DISK? JRST FNXTW ;YES. JUST MAP NEXT WINDOW ; JRST XSOUT ;NO. OTHER ;OUTPUT ROUTINES ;ARBITRARY DEVICE XSOUT: JUMPE P1,XSKP ;IF NO CHARS, JUST PREPARE WINDOW PUSHJ P,%PUSHT ;SAVE T ACS LOAD T1,OJFN(D) ;GET JFN HRRO T2,WADR(D) ;GET WINDOW ADDR MOVN T3,WSIZ(D) ;GET WINDOW SIZE IN BYTES JUMPLE P2,.+2 ;IF IN MIDDLE OF WINDOW ADD T3,P2 ;DECREMENT ACTIVE BYTE COUNT SOUTR% ;OUTPUT THE STRING ERJMP OUTERR ;ERROR, GO TELL USER PUSHJ P,%POPT ;RESTORE T ACS XSKP: AOS BLKN(D) ;INCR BLOCK # MOVE P1,WADR(D) ;SETUP BYTE PNTR SUBI P1,1 ;POINT TO BEG-1 HRLI P1,(POINT 7,0,34) MOVE P2,WSIZ(D) ;FULL WINDOW AVAILABLE POPJ P, ;DONE OUTERR: AOS T2,ERRN(D) ;BUMP ERROR COUNT CAIG T2,^D10 ;TOO MANY? ; IOERR (OUX,899,401,?,$J,,%ABORT) ;YES ; IOERR (OUT,899,401,%,$J,,%POPJ) ;NO $ECALL OUX,%ABORT ;Yes $ECALL OUT,%POPJ ;No ;TTY OUTPUT TOREC: LOAD T1,OJFN(D) ;GET JFN MOVE T2,ORPTR(D) ;GET POINTER TO START OF RECORD MOVN T3,ORCNT(D) ;GET NEGATIVE OF BYTE COUNT JUMPGE T3,%POPJ ;LEAVE NOW IF 0-BYTE STRING SOUTR% ;OUTPUT THE STRING ERJMP OUTERR ;ERROR, GO TELL USER POPJ P, ;DONE >;END IF20 IF10,< OMAP: MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%RAN ;RANDOM? JRST FNXTW ;WRITE RANDOM BUFFER NOTRAN: PUSHJ P,%PUSHT DMOVEM P1,OPTR(D) ;STORE POINTER, COUNT FOR MONITOR AOS T1,BLKN(D) ;INCR BLOCK # IMULI T1,1200 ;GET BYTE # OF NEXT BLOCK MOVEM T1,BYTN(D) ;SAVE FOR EOFN CALC HLLZ T2,CHAN(D) ;GET CHANNEL NUMBER FOR FILOP HRRI T2,.FOOUT ;SET FILOP FUNCTION MOVE T1,[1,,T2] ;SET LENGTH,,ADDRESS FILOP. T1, ;OUTPUT A BUFFER $ECALL IOE,%ABORT DMOVE P1,OPTR(D) ;GET NEW BYTE POINTER, COUNT PJRST %JPOPT >;END IF10 ;ENCODE ENCINI: MOVE T1,A.HSA ;GET STRING ADDR $BLDBP T1 ;Build 7-bit byte ptr. MOVEM T1,ORPTR(D) MOVEM T1,ORBUF(D) SKIPG T2,A.HSL ;GET STRING LENGTH SETZB T2,A.HSL ;IF ZERO OR NEG, SET TO ZERO JUMPE T2,NENCFL ;NO FILL IF NO CHARS MOVEI T3," " ;SETUP WITH BLANKS ENCLP: IDPB T3,T1 SOJG T2,ENCLP NENCFL: MOVE T1,A.HSL ;RESET BYTE COUNT MOVEM T1,ORCNT(D) MOVEM T1,RSIZE(D) ;AND RECORD SIZE MOVEM T1,ORBLN(D) ;AND REC BUFFER LENGTH SETZM T1,ORLEN(D) ;AND RECORD LENGTH POPJ P, ;DONE, READY FOR OUTPUT ENCODE: MOVE T1,ORBLN(D) ;GET # CHARS IN STRING SUB T1,ORCNT(D) ;GET CURRENT CHAR POS SKIPE ORPOS(D) ;WAITING ON POSITIONING FORMAT? MOVE T1,ORPOS(D) ;YES. SUBSTITUTE IT ADDI T1,4 ;GET # WORDS IDIVI T1,5 ADDM T1,ORBUF(D) ;SAVE NEW BUFFER ADDR IMULI T1,5 ;GET # CHARS IN THOSE WORDS MOVE T2,ORBLN(D) ;GET # CHARS IN STRING SUBI T2,(T1) ;DECR # CHARS MOVEM T2,ORBLN(D) ;SAVE IT POPJ P, SUBTTL T FORMAT ;ROUTINE TO READ RECORD POSITION ;RETURN: T1 = BYTE NUMBER OF NEXT BYTE TO/FROM RECORD ; I.E., NUMBER OF BYTES ALREADY READ FROM RECORD OR STORED IN IT ;PRESERVES T2-T5 %RPOS: MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%IO ;INPUT OR OUTPUT? JRST ROPOS ;OUTPUT, GO HANDLE RIPOS: MOVE T1,IRLEN(D) ;GET RECORD LENGTH SUB T1,IRCNT(D) ;SUBTRACT # CHARS LEFT IN IT ADDI T1,1 ;BEG OF RECORD IS COL 1 POPJ P, ROPOS: MOVE T1,ORBLN(D) ;GET RECORD BUFFER LENGTH SUB T1,ORCNT(D) ;SUBTRACT EMPTY SPACE ADDI T1,1 ;BEG OF RECORD IS COL 1 SKIPE ORPOS(D) ;IS THERE A VIRTUAL POSITION? MOVE T1,ORPOS(D) ;YES. USE IT AS CURRENT POSITION POPJ P, ;RETURN WITH BYTE NUMBER ;ROUTINE TO SET RECORD POSITION ;ARG: T1 = BYTE NUMBER ;SETS SO THAT NEXT IBYTE/OBYTE CALL GETS OR STORES THE GIVEN BYTE %SPOS: JUMPG T1,.+2 ;OK IF .GT. 0 MOVEI T1,1 ;SET TO 1 IF NOT MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%IO ;INPUT? JRST SOPOS ;NO, OUTPUT SIPOS: SUBI T1,1 ;SET POSITION TO ONE BEFORE IT MOVE T2,IRLEN(D) ;GET LENGTH OF RECORD SUBI T2,(T1) ;COMPUTE NEW EMPTY-BYTE COUNT MOVEM T2,IRCNT(D) ;SET TO DESIRED COLUMN JUMPL T2,ISEOR ;NO BP SETUP IF BEYOND RECORD IDIVI T1,5 ;BREAK BYTE # INTO WORD NUMBER AND BYTE OFFSET LDB T3,[POINT 6,IRBUF(D),5] ;Get "P"-field of byte ptr. CAILE T3,44 ;Skip if a local byte ptr. JRST SIPOS1 ;No MOVE T2,BPTAB(T2) ;GET LH OF BYTE POINTER HRR T2,IRBUF(D) ;PUT IN RH POINTING TO RECORD BUFFER ADDI T2,(T1) ;ADD IN WORD OFFSET MOVEM T2,IRPTR(D) ;STORE NEW BYTE POINTER POPJ P, ;The ENCODE/DECODE extended addressing version. SIPOS1: MOVE T3,IRBUF(D) ;Get starting BP TXZ T3,77B5 ;Clear "P" field TDO T3,BPTABE(T2) ;Get new "P" field ADDI T3,(T1) ;Add in word offset MOVEM T3,IRPTR(D) ;Store new byte ptr. POPJ P, ;Return ISEOR: MOVX T0,D%EOR ;Set END-OF-RECORD flag IORM T0,FLAGS(D) POPJ P, ;DONE SOPOS: MOVEM T1,ORPOS(D) ;STORE NEXT CHARACTER POSITION POPJ P, ;SETPOS - SET OUTPUT POSITION ROUTINE. T FORMAT AND X FORMAT ;JUST SET ORPOS(D), THE VIRTUAL POSITION. SETPOS IS CALLED IF ;A CHARACTER IS ACTUALLY OUTPUT IN THAT POSITION. FIRST, THE ;CURRENT POSITION IS CHECKED AGAINST THE LAST RECORDED LENGTH. ;IF THE CURRENT POSITION IS GREATER THAN THE LENGTH, A NEW ;LENGTH IS RECORDED. IF ORPOS (THE DESIRED POSITION) IS ;WITHIN THE NEW LENGTH, WE JUST GO AND SETUP THE PNTR/COUNT ;APPROPRIATELY. IF IT IS NOT, WE PAD THE CURRENT RECORD WITH ;BLANKS. IF THE CURRENT POSITION WAS LESS THAN THE LAST ;RECORDED LENGTH, THEN WE JUST CHECK THIS LENGTH AGAINST ;ORPOS. IF ORPOS IS WITHIN THE LENGTH, WE GO AND SETUP THE ;PNTR/COUNT APPROPRIATELY. OTHERWISE, WE SETUP THE PNTR/COUNT ;TO THE OLD LENGTH AND PAD THE RECORD WITH BLANKS TO ORPOS. SETPOS: PUSHJ P,%PUSHT ;SAVE T ACS SOS ORPOS(D) ;DESIRED POSITION IS ONE LESS THAN SPECIFIED SKIPN ORBUF(D) ;ANY BUFFER ALLOCATED YET? PUSHJ P,EXPORB ;NO. ALLOCATE ONE MOVE T1,ORBLN(D) ;GET RECORD BUFFER LENGTH SUB T1,ORCNT(D) ;GET CURRENT CHARACTER POSITION CAMGE T1,ORLEN(D) ;NEW ONE BIGGER OR SAME? JRST LENGOK ;NO. SETUP WITHIN RECORD MOVEM T1,ORLEN(D) ;YES. STORE NEW ONE CAMN T1,ORPOS(D) ;ARE WE WHERE WE WANT TO BE PRECISELY? JRST CLRVIR ;YES. TIME TO DO NOTHING CAMLE T1,ORPOS(D) ;SMALLER THAN DESIRED POSITION? JRST SPOSV ;NO. JUST SETUP PNTR/COUNT JRST OPAD ;YES. PAD WITH SPACES LENGOK: MOVE T1,ORLEN(D) ;GET BUFFER LENGTH AGAIN CAML T1,ORPOS(D) ;IS LENGTH SMALLER THAN DESIRED POSITION? JRST SPOSV ;NO. JUST SETUP PNTR/COUNT PUSHJ P,SPOS1 ;YES. SET CURRENT POSITION TO END OF RECORD ;AND PAD WITH BLANKS OPAD: MOVE T1,ORBLN(D) ;GET BUFFER LENGTH SUB T1,ORCNT(D) ;GET CURRENT POSITION MOVE T2,ORPOS(D) ;GET DESIRED POSITION SUBI T2,(T1) ;GET # BLANKS TO PAD OPADLP: MOVEI T1," " ;GET A BLANK PUSHJ P,LOBYTE ;DON'T HAVE TO CHECK ORPOS EACH TIME SOJG T2,OPADLP CLRVIR: SETZM ORPOS(D) ;PREVENT REPEAT OF ABOVE PUSHJ P,%POPT ;RESTORE T ACS POPJ P, SPOSV: MOVE T1,ORPOS(D) ;GET DESIRED POSITION SETZM ORPOS(D) ;PREVENT REPEAT OF ABOVE PUSHJ P,SPOS1 ;SET THE POSITION PUSHJ P,%POPT ;RESTORE T ACS POPJ P, SPOS1: MOVE T2,ORBLN(D) ;GET BUFFER LENGTH SUBI T2,(T1) ;GET NEW EMPTY-BYTE COUNT MOVEM T2,ORCNT(D) ;SET NEW COUNT IDIVI T1,5 ;BREAK BYTE # INTO WORD NUMBER AND BYTE OFFSET LDB T3,[POINT 6,ORBUF(D),5] ;Get P-field of byte ptr. CAILE T3,44 ;Skip if regular, local byte ptr. JRST SPOS2 ;No, use other BP table MOVE T2,BPTAB(T2) ;Get LH of byte ptr. HRR T2,ORBUF(D) ;Put in RH of byte ptr. ADDI T2,(T1) ;Add in word offset. MOVEM T2,ORPTR(D) ;STORE NEW BYTE POINTER POPJ P, ;DONE ;The ENCODE/DECODE extended addressing version. SPOS2: MOVE T3,ORBUF(D) ;Get starting BP of buffer TXZ T3,77B5 ;Clear BP bits TDO T3,BPTABE(T2) ;Get new BP bits. ADDI T3,(T1) ;Add in word offset MOVEM T3,ORPTR(D) ;Store new byte pointer. POPJ P, ;Done BPTAB: POINT 7, ;BYTE 0 POINT 7,,6 ;BYTE 1 POINT 7,,13 ;BYTE 2 POINT 7,,20 ;BYTE 3 POINT 7,,27 ;BYTE 4 BPTABE: 610000,,0 ;BYTE 0 620000,,0 ;BYTE 1 630000,,0 ;BYTE 2 640000,,0 ;BYTE 3 650000,,0 ;BYTE 4 SUBTTL UNFORMATTED I/O UNFI: AOS NREC(U) ;UPDATE RECORD COUNT DMOVE P1,IPTR(D) ;GET FILE PNTR/COUNT SKIPN P4,RSIZE(D) ;REC SIZE SPECIFIED? HRLOI P4,377777 ;NO, USE BIG RECORDS PUSHJ P,ILSCW1 ;READ START LSCW $ECALL EOF,%ABORT ;EOF. GO START READING THE I/O LIST ;WHICH WILL FLUSH ITSELF OUT SETZ T3, ;SET NO ARRAY IN PROGRESS YET UILP: JUMPG T3,UIWIN ;IF WE HAVE AN ARRAY ADDRESS, CONTINUE WITH IT PUSHJ P,%GTIOX ;GET NEXT ARRAY FROM IO LIST JUMPE T3,UIEND ;IF NONE, GO FINISH UP UIWIN: JUMPLE P4,UIZERO ;RECORDSIZE WORDS READ, GO SKIP TO END LSCW JUMPG P2,UISEG ;IF DATA LEFT IN WINDOW, CONTINUE WITH IT PUSHJ P,UINXTW ;READ NEXT WINDOW JRST UIEND ;GO CHECK IF EOF OK UISEG: JUMPG P3,UIBLT ;IF DATA LEFT IN SEGMENT, CONTINUE WITH IT UISEGX: PUSHJ P,ILSCWX ;READ LSCW OF NEXT SEGMENT JUMPLE P3,UIZERO ;FOUND NULL TYPE 2 OR TYPE 3, GO STORE ZEROES UIBLT: MOVEI T2,(T3) ;GET MIN OF ARRAY LENGTH CAILE T2,(P2) ; AND WINDOW LENGTH MOVEI T2,(P2) CAILE T2,(P3) ; AND SEGMENT LENGTH MOVEI T2,(P3) CAILE T2,(P4) ; AND RECORD LENGTH MOVEI T2,(P4) JUMPE T2,UILP ;DON'T LOSE ON BOUNDARY ;T1/ address of user's array ;P1/ local FOROTS address of data ;T2/ number of words to copy IF20,< TLNN T1,-1 ;Extended addressing? JRST UIBLT1 ;No, normal BLT ;Use XBLT PUSH P,T2 ;Save acs PUSH P,T3 ; Used by XBLT ;T2/ # words to copy XMOVEI T3,1(P1) ;T3/ "From" -- get FOROTS address of data MOVE T4,T1 ;T4/ "To"-- user's array. EXTEND T2,[XBLT] ;** Copy the data ** POP P,T3 ;Restore acs POP P,T2 ADDI T1,(T2) ;Point to END+1 of BLT. JRST UIBLT2 ;Skip normal BLT >;END IF20 UIBLT1: MOVSI T4,1(P1) ;GET BLT-FROM ADDRESS HRRI T4,(T1) ;AND BLT-TO ADDRESS ADDI T1,(T2) ;POINT TO END+1 OF BLT BLT T4,-1(T1) ;MOVE DATA INTO ARRAY UIBLT2: ADDI P1,(T2) ;INCREMENT ADDRESS OF DATA IN WINDOW SUBI P2,(T2) ;DECREMENT COUNT OF DATA LEFT IN WINDOW SUBI P3,(T2) ;DECREMENT COUNT OF DATA LEFT IN SEGMENT SUBI P4,(T2) ;DECREMENT COUNT OF DATA LEFT IN RECORD SUBI T3,(T2) ;DECREMENT COUNT OF DATA LEFT IN ARRAY JRST UILP ;CONTINUE UIZERO: SETZM (T1) ;CLEAR FIRST WORD CAIG T3,1 ;MORE THAN 1 WORD? JRST UZSKP2 ;NO IF20,< TLNN T1,-1 ;Extended addressing? JRST UZSKP1 ;No, normal BLT ;Use XBLT PUSH P,T2 ;Save acs PUSH P,T3 PUSH P,T4 MOVE T2,T3 ;T2/ # words to copy MOVE T3,T1 ;t3/ "from" the array XMOVEI T4,1(T1) ;T4/ "to" array+1 EXTEND T2,[XBLT] ;** Zero array ** POP P,T4 ;Restore saved acs POP P,T3 POP P,T2 JRST UZSKP2 >;END IF20 UZSKP1: MOVSI T4,(T1) ;SET BLT-FROM ADDRESS HRRI T4,1(T1) ;AND BLT-TO ADDRESS ADDI T1,(T3) ;POINT TO END+1 OF BLT BLT T4,-1(T1) ;CLEAR WHOLE ARRAY ;Here when BLT (or XBLT) has been done to clear array UZSKP2: PUSHJ P,%GTIOX ;GET NEXT ARRAY FROM IO LIST JUMPN T3,UIZERO ;IF THERE IS ONE, ZERO IT TOO UIEND: PUSHJ P,ILSCW3 ;SKIP TO END LSCW UIRET: DMOVEM P1,IPTR(D) ;STORE FILE POINTER/COUNT MOVE T0,FLAGS(D) ;Get DDB flags TXNN T0,D%END ;REACH EOF? POPJ P, ;NO TXNE T0,D%BIN ;BINARY FILE? $ECALL BBF,%ABORT ;YES. BAD FORMAT $ECALL EOF,%ABORT ;NO. JUST EOF IF10,< UINXTW: MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%END ;AT EOF? JRST UIEOF ;YES. REPORT OR JRST AWAY PUSHJ P,UNXTW ;MAP NEXT WINDOW MOVE T0,FLAGS(D) TXNE T0,D%END ;SEQUENTIAL FILE AND EOF? JRST UIEOF ;YES. REPORT OR JRST AWAY JRST %POPJ1 ;NO > ;IF10 IF20,< UINXTW: MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%END ;IN FILE? JRST UIEOF ;NO. REPORT OR JRST AWAY TXNE T0,D%RAN ;RANDOM? JRST UIRAN ;YES. HANDLE SEPARATELY LOAD T0,INDX(D) ;GET DEVICE INDEX CAIE T0,DI.DSK ;DISK? JRST UTNXTW ;NO. DON'T PROCESS EOFN MOVE T0,BYTN(D) ;GET DESIRED WORD # CAML T0,EOFN(D) ;WITHIN FILE? JRST UIEOF ;NO. EOF RETURN PUSHJ P,UNXTW ;READ NEXT WINDOW MOVE T0,BYTN(D) ;GET WORD # OF NEXT WINDOW CAMG T0,EOFN(D) ;PAST EOF? JRST UINEOF ;NO SUB T0,EOFN(D) ;GET DIFF SUB P2,T0 ;SET COUNT TO WHAT'S THERE UINEOF: MOVEM P2,WCNT(D) ;SAVE ACTIVE WORD COUNT JRST %POPJ1 UTNXTW: PUSHJ P,UNXTW ;JUST GET A NEW WINDOW MOVE T0,FLAGS(D) ;Get DDB flags TXNN T0,D%END ;EOF? AOS (P) ;NO. SKIP RETURN POPJ P, UIRAN: PUSHJ P,UNXTW ;GET NEXT WINDOW JRST %POPJ1 > ;IF20 UIEOF: MOVX T0,D%END ;Set EOF flag IORM T0,FLAGS(D) POPJ P, ;HERE AT START OF RECORD ;READ START LSCW ;0 MEANS RANDOM RECORD WAS NEVER WRITTEN ILSCW1: MOVE T0,FLAGS(D) ;Get DDB flags TXNN T0,D%BIN ;BINARY MODE? JRST IMG1 ;NO, IMAGE, NO LSCWS PUSHJ P,IWORD ;GET WORD FROM BINARY FILE POPJ P, ;EOF, MEANS END OF WHOLE FILE JUMPE T1,RNRERR ;ZERO, RECORD WASN'T WRITTEN LDB T2,[POINT 9,T1,8] ;GET SEGMENT CONTROL WORD CAIE T2,1 ;START LSCW? ; IOERR (BBF,25,302,?,Bad format binary file,,%ABORT) $ECALL BBF,%ABORT ;?Bad format binary file MOVEI P3,(T1) ;GET SEGMENT LENGTH FROM RH SOJA P3,%POPJ1 ;REMOVE LSCW FROM COUNT, RETURN IMG1: MOVEI P3,-1 ;SET LARGE SEGMENT JRST %POPJ1 ;DONE ;HERE WHEN START OR CONTINUE SEGMENT ENDS ;MUST SEE CONTINUATION OR END LSCW ILSCWX: MOVE T0,FLAGS(D) ;Get DDB flags TXNN T0,D%BIN ;BINARY MODE? JRST IMG2 ;NO, IMAGE, FAKE A CONTINUATION LSCW PUSHJ P,%PUSHT ;SAVE T ACS ILX1: PUSHJ P,IWORD ;GET WORD FROM BINARY FILE $ECALL BBF,%ABORT ;IOERR: ?"Bad format binary file" SETO P3, ;ASSUME 0 SEGMENT LENGTH LDB T2,[POINT 9,T1,8] ;GET SEGMENT CONTROL WORD CAIN T2,3 ;END LSCW? JRST ILXEND ;YES, END OF LOGICAL RECORD CAIE T2,2 ;CONTINUATION LSCW? $ECALL BBF,%ABORT ;NO. BAD LSCW, BAD BINARY FILE MOVEI P3,(T1) ;GET SEGMENT LENGTH FROM RH SUBI P3,1 ;REMOVE LSCW FROM COUNT ILXEND: PJRST %JPOPT ;RESTORE T ACS AND RETURN IMG2: MOVEI P3,-1 ;SET LARGE SEGMENT POPJ P, ;HERE AT END OF IO LIST ;POSITION FILE JUST AFTER END LSCW ;NUMBER OF WORDS TO DISCARD IS .GE. 0 IN P3 ILSCW3: MOVE T0,FLAGS(D) ;Get DDB flags TXNN T0,D%BIN ;BINARY? JRST IMG3 ;NO, NO LSCW JUMPL P3,%POPJ ;IF ALREADY READ TYPE 3, LEAVE PUSHJ P,IWORD ;GET WORD FROM BINARY FILE $ECALL BBF,%ABORT ;EOF. FILE IN ERROR SOJGE P3,.-2 ;SKIP TILL LSCW LDB T2,[POINT 9,T1,8] ;GET SEGMENT CONTROL WORD CAIN T2,2 ;CONTINUE LSCW? JRST [MOVEI P3,(T1) ;YES, GET SEGMENT LENGTH SOJA P3,ILSCW3] ;CONTINUE CAIE T2,3 ;END LSCW? $ECALL BBF,%ABORT ;No, file in error. POPJ P, ;DONE IMG3: SKIPN RSIZE(D) ;RECORD SIZE SPECIFIED? POPJ P, ;NO - WE HAVE NO CLEANUP JUMPLE P4,%POPJ ;SKIP TO END OF RECORD PUSHJ P,IWORD ;READ A WORD SETZ P4, ;EOF, OK SOJG P4,.-2 ;LOOP BACK IMG4: POPJ P, ;RETURN INXT: MOVE T0,FLAGS(D) ;Get DDB flags TXNN T0,D%END ;SKIP IF AT END PUSHJ P,UINXTW ;NOTHING LEFT, GO MAP NEXT WINDOW POPJ P, ;EOF ; JRST IWORD ;DONE IWORD: SOJL P2,INXT ;IF NO WORDS, GET SOME ADDI P1,1 ;INCREMENT POINTER MOVE T1,(P1) ;GET WORD PJRST %POPJ1 ;SKIP RETURN ;UNFORMATTED SKIP RECORD UNFSKP: AOS NREC(U) ;UPDATE RECORD COUNT DMOVE P1,IPTR(D) ;GET FILE PNTR/COUNT MOVE P4,RSIZE(D) ;GET RECORD SIZE PUSHJ P,ILSCW1 ;READ START LSCW, P3 = SEGMENT LENGTH POPJ P, ;EOF. JUST RETURN SETZ T3, ;NO ARRAY IN PROGRESS JRST UIEND ;GO SKIP TO END OF RECORD UNFO: MOVX T0,D%MOD ;Set "file modified" IORM T0,FLAGS(D) MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%RAN ;RANDOM? PUSHJ P,RMAPW ;YES, MAP CORRECT WINDOW AOS NREC(U) ;UPDATE RECORD COUNT DMOVE P1,OPTR(D) ;GET FILE POINTER/COUNT MOVE T0,FLAGS(D) TXNE T0,D%BIN ;BINARY? PUSHJ P,OLSCW1 ;YES, OUTPUT START LSCW SKIPN P3,RSIZE(D) ;RECORD SIZE SPECIFIED? HRLOI P3,377777 ;NO, SET BIG RECORDS UOLP: PUSHJ P,%GTIOX ;GET ADDRESS AND LENGTH OF AN ARRAY TO OUTPUT JUMPE T3,UOEND ;END OF IOLST, DONE UOBLT: JUMPG P2,WINDOK ;OK IF WE HAVE ROOM IN WINDOW PUSHJ P,%PUSHT ;GET NEW ONE IF WE DON'T MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%BIN ;BINARY? PUSHJ P,OLSCWX ;YES. FINISH START OR CONTINUE LSCW PUSHJ P,UNXTW ;OUTPUT CURRENT WINDOW, GET NEXT MOVE T0,FLAGS(D) TXNE T0,D%BIN ;BINARY PUSHJ P,OLSCW2 ;YES. OUTPUT TYPE 2 LSCW PUSHJ P,%POPT WINDOK: JUMPLE P3,UOTRNC ;IF NONE, GO TRUNCATE RECORD MOVEI T2,(T3) ;GET ARRAY LENGTH CAILE T2,(P2) ;UNLESS LESS THAN WINDOW LENGTH MOVEI T2,(P2) ;GET MIN CAMLE T2,P3 ;UNLESS LESS THAN RECORD SIZE MOVE T2,P3 ;GET MIN JUMPE T2,UOSKP ;AVOID 0-WORD BLT ;T1/ addr. of user's array. ;p1/ local FOROTS address of data. ;T2/ # words to copy IF20,< TLNN T1,-1 ;User's array in a non-zero section? JRST UOBLT2 ;No, normal BLT ;Use XBLT PUSH P,T2 ;Save acs PUSH P,T3 ;T2/ # words to copy MOVE T3,T1 ;T3/ "from" -- user's array XMOVEI T4,1(P1) ;T4/ "to"-- get Global FOROTS' address. EXTEND T2,[XBLT] ;** COPY array ** POP P,T3 ;Restore T3 POP P,T2 ; and T2 ADDI P1,(T2) ;Point to end+1 of XBLT JRST UOSKP >;END IF20 ;Use BLT UOBLT2: MOVSI T4,(T1) ;GET BLT-FROM ADDRESS HRRI T4,1(P1) ;AND BLT-TO ADDRESS ADDI P1,(T2) ;POINT TO END+1 OF BLT BLT T4,(P1) ;MOVE DATA INTO WINDOW UOSKP: SUBI P3,(T2) ;DECREMENT COUNT OF WORDS LEFT IN RECORD SUBI P2,(T2) ;DECREMENT COUNT OF EMPTY SPACE IN WINDOW SUBI T3,(T2) ;DECREMENT COUNT OF WORDS LEFT IN ARRAY JUMPLE T3,UOLP ;IF ARRAY DONE, GO DO NEXT ARRAY ADDI T1,(T2) ;BUMP ARRAY ADDRESS JRST UOBLT ;GO DO NEXT PIECE UOTRNC: PUSHJ P,%GTIOX JUMPN T3,UOTRNC UOEND: SKIPN RSIZE(D) ;RECORD SIZE? JRST UOXYZ ;NO, FINE JUMPLE P3,UOXYZ ;NO ZEROS NECESSARY, FINE SETZ T1, ;GET A ZERO PUSHJ P,OWORD ;PUT IN FILE SOJG P3,.-1 ;PAD WHOLE RECORD UOXYZ: MOVE T0,FLAGS(D) TXNE T0,D%BIN ;BINARY? PUSHJ P,OLSCW3 ;YES, OUTPUT END LSCW DMOVEM P1,OPTR(D) ;STORE FILE POINTER/COUNT MOVE T1,BYTN(D) ;GET BYTE # OF NEXT WINDOW SUBI T1,(P2) ;GET LAST BYTE IN USE MOVE T0,FLAGS(D) ;Fetch DDB flags TXNE T0,D%RAN ;RANDOM FILE? CAMLE T1,EOFN(D) ;YES. ONLY STORE LARGER EOFN MOVEM T1,EOFN(D) ;SAVE AS EOF PNTR POPJ P, ;DONE ;LSCW ROUTINES ;FORMAT OF BINARY RECORD: (FORMAT OF BINARY RECORD) ;THERE IS NO NECESSARY RELATIONSHIP BETWEEN SEGMENT SIZE AND BUFFER SIZE OLSCW1: SKIPE RSIZE(D) ;IS RECORD SIZE SPECIFIED? JRST O1FIX ;YES - SET TYPE 1 LSCW NOW SETZM SEGCNT ;CLEAR WORD COUNT OF SEGMENTS ALREADY IN FILE MOVSI T1,(1B8) ;GET START LSCW JRST O2FIX ;SKIP TYPE 2 PROCESSING OLSCW2: SKIPE RSIZE(D) ;IS RECORD SIZE SPECIFIED? POPJ P, ;YES - NO NEED FOR TYPE 2 LSCW MOVSI T1,(2B8) ;GET CONTINUE LSCW O2FIX: PUSHJ P,OWORD ;PUT WORD INTO FILE WINDOW MOVEM P1,CWADR ;STORE IN-CORE ADDRESS OF CONTROL WORD POPJ P, O1FIX: MOVE T1,RSIZE(D) ;GET RECORD SIZE ADD T1,[1B8+1] ;SET START LSCW SETZM CWADR ;REMEMBER WE'VE ALREADY FILLED IN START LSCW PJRST OWORD ;AND PUT WORD INTO FILE WINDOW OLSCWX: SKIPE RSIZE(D) ;WAS RECORD SIZE SPECIFIED? POPJ P, ;YES - START LSCW WAS ALREADY FILLED IN SKIPN T2,CWADR ;GET ADDRESS OF TYPE 1 OR 2 CONTROL WORD $SNH ;Already out in file, bug MOVEI T1,1(P1) ;POINT TO END+1 OF WINDOW SUBI T1,(T2) ;GET DISTANCE FROM CONTROL WORD = SEG LENGTH HRRM T1,(T2) ;STORE LENGTH IN CONTROL WORD ADDM T1,SEGCNT ;ADD INTO TOTAL RECORD LENGTH SETZM CWADR ;NOW NO CONTROL WORD WAITING TO BE FINISHED POPJ P, ;DONE OLSCW3: SKIPE RSIZE(D) ;WAS RECORD SIZE SPECIFIED? JRST O3FIX ;YES - START LSCW ALL DONE - DO TYPE 3 ONLY SKIPN T2,CWADR ;GET ADDRESS OF TYPE 1 OR 2 CONTROL WORD $SNH ;Already out in file, bug MOVEI T1,1(P1) ;POINT TO END+1 OF RECORD SUBI T1,(T2) ;GET DISTANCE FROM CONTROL WORD = SEG LENGTH HRRM T1,(T2) ;STORE LENGTH IN START CONTROL WORD ADD T1,SEGCNT ;ADD IN WORDS FROM OTHER SEGMENTS ADDI T1,1 ;ADD IN END LSCW TOO HRLI T1,(3B8) ;PUT IN TYPE-3 LSCW HEADER SETZM CWADR ;NOW NO CONTROL WORD WAITING TO BE FINISHED PJRST OWORD ;PUT INTO FILE O3FIX: MOVE T1,RSIZE(D) ;GET USER SPECIFIED RECORD SIZE ADD T1,[3B8+2] ;SET UP END LSCW ; PJRST OWORD ;PUT INTO FILE OWORD: SOJL P2,OWFULL ;IF NO ROOM LEFT, GET SOME ADDI P1,1 ;INCREMENT POINTER MOVEM T1,(P1) ;STORE WORD POPJ P, OWFULL: PUSHJ P,UNXTW ;NO ROOM, MAP NEXT WINDOW JRST OWORD ;KEEP IN SYNCH SEGMENT DATA CWADR: BLOCK 1 ;ADDRESS OF START LSCW SEGCNT: BLOCK 1 ;COUNT OF WORDS OUT IN FILE IN PREVIOUS SEGMENTS SEGMENT CODE SUBTTL DUMP MODE I/O IF10,< DMPIN: PUSHJ P,DMPSET ;SETUP FOR THE DUMP MODE I/O MOVEI T2,.FOINP ;SET FOR INPUT HLL T2,FBLK(D) ;Get channel stuff MOVEI T3,DMPLST MOVE T1,[2,,T2] FILOP. T1, ;Do the INPUT PUSHJ P,EOFCHK ;Set D%END if EOF; else give error MOVE T1,FLAGS(D) ;Get flags TXNE T1,D%END ;End of file? $ECALL EOF,%ABORT ;Yes, give error POPJ P, ;No, return DMPOUT: PUSHJ P,DMPSET ;SETUP FOR THE DUMP MODE I/O MOVEI T2,.FOOUT ;SET FOR OUTPUT HLL T2,FBLK(D) ;GET CHANNEL STUFF MOVEI T3,DMPLST MOVE T1,[2,,T2] FILOP. T1, ;DO THE INPUT $ECALL IOE,%ABORT ;Error POPJ P, DMPSET: PUSHJ P,%SAVE2 ;SAVE P1 & P2 XMOVEI P1,DMPLST ;SETUP DUMP MODE LIST PNTR DMPLP: PUSHJ P,%GTIOX ;GET AN I/O LIST ITEM JUMPE T1,DMPDON ;DONE WITH SETUP IF NO ADDR SUBI T1,1 ;GET ADDR-1 MOVNI T2,(T3) ;GET NEG # WORDS HRLI T1,(T2) ;IN LEFT HALF MOVEM T1,(P1) ;SAVE IN DUMP MODE LIST ADDI T3,177 ;GET # BLOCKS IDIVI T3,200 ;ROUNDED UP ADDM T3,BLKN(D) ;ADD TO BLOCK COUNT AOJA P1,DMPLP DMPDON: SETZM (P1) ;CLEAR LAST WORD POPJ P, >;END IF10 SUBTTL DISK POSITIONING COMMENT & TOPS-20 sequential disk files are read with PMAPs by moving a n-page window through the file. The file window always starts on a n-page boundary and is moved only when the desired byte is not in the window. The first process page number of the window is in WTAB(D). (The window size can be set to something besides 4 pages with BUFFERCOUNT=). TOPS-20 random files are similar, but there are n independent one-page windows. If references to the file are well localized, the windows will often contain the desired records. For random files WTAB contains an AOBJN pointer to a n-word table, with each word giving the process page number and corresponding file page number of a window, process page in the left half and file page in the right half. The number of windows can be set with BUFFERCOUNT=. TOPS-10 random files are the same, but the windows are a block long instead of a page. WTAB uses the sign bit to remember if a block has been modified and needs to be written back. The BUFFERCOUNT parameter is rounded up to a multiple of 4 blocks so that an integral number of process pages are used. TOPS-10 sequential disk files are like any other TOPS-10 sequential file. & ;ROUTINE TO MAP NEXT WINDOW OF FILE ;ARGS: BYTN = FILE BYTE NUMBER OF START OF WINDOW ;RETURN: P1 = BYTE POINTER TO FIRST MAPPED BYTE ; P2 = COUNT OF BYTES IN WINDOW ; BYTN = FILE BYTE NUMBER+1 OF END OF WINDOW ; I.E., STARTING BYTE OF FOLLOWING WINDOW FNXTW: PUSHJ P,%PUSHT ;SAVE T ACS MOVE T1,BYTN(D) ;GET BYTE NUMBER IDIVI T1,5 ;CONVERT TO WORD NUMBER CAIE T2,0 ;BYTE # MUST BE MULT OF 5 $SNH ;If not, halt. MOVE T0,FLAGS(D) TXNE T0,D%RAN ;RANDOM? PUSHJ P,MAPW ;MAP THAT BYTE INTO CORE MOVE T0,FLAGS(D) TXNN T0,D%RAN ;CHECK AGAIN PUSHJ P,SMAPW ;IT'S SEQUENTIAL IMULI P2,5 ;CONVERT WORD COUNT TO BYTE COUNT ADDM P2,BYTN(D) ;INCREMENT BYTE NUMBER TO AFTER THIS WINDOW HRLI P1,(POINT 7,0,34) ;MAKE POINTER TO FIRST MAPPED BYTE PJRST %JPOPT ;RESTORE T ACS AND RETURN UNXTW: PUSHJ P,%PUSHT ;SAVE T ACS MOVE T1,BYTN(D) ;DISK, GET WORD NUMBER MOVE T0,FLAGS(D) TXNE T0,D%RAN ;RANDOM? PUSHJ P,MAPW ;MAP THAT WORD INTO CORE MOVE T0,FLAGS(D) TXNN T0,D%RAN ;CHECK AGAIN PUSHJ P,SMAPW ;IT'S SEQUENTIAL ADDM P2,BYTN(D) ;INCREMENT WORD NUMBER FOR NEXT CALL PJRST %JPOPT ;RESTORE T ACS AND RETURN ;ROUTINE TO GET NEXT BUFFER OF NON-DISK FILE IF20,< TNXTW: MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%END ;END FILE ALREADY? POPJ P, ;YES. NOTHING TO DO LOAD T1,IJFN(D) ;GET JFN MOVE T2,WADR(D) ;GET ADDRESS OF BUFFER HRLI T2,(POINT 36,) ;POINT TO FIRST WORD MOVN T3,WSIZ(D) ;GET WINDOW SIZE IN WORDS TXNE T0,D%IO ;INPUT OR OUTPUT? JRST TONXTW ;OUTPUT AOS BLKN(D) ;INCR BLOCK # SINR% ;READ ERJMP UEOFCHK ;EOF OR ERROR UEOFRET: MOVE P1,WADR(D) ;POINT TO DATA SUBI P1,1 ;POINT TO WORD-1 MOVE P2,WSIZ(D) ;GET FULL WINDOW SIZE ADD P2,T3 ;GET # WORDS WE ACTUALLY GOT MOVEM P2,WCNT(D) ;SAVE FOR DIRECTION SWITCH POPJ P, ;DONE UEOFCHK: PUSH P,T2 ;SAVE POINTER TO END OF DATA GTSTS% ;GET FILE STATUS TXNN T2,GS%EOF ;EOF? JRST UINERR ;NO, INPUT ERROR MOVX T0,D%END ;EOF, tell caller IORM T0,FLAGS(D) POP P,T2 ;RESTORE T2 JRST UEOFRET ;CONTINUE UINERR: POP P,T2 ;RESTORE T2 ; IOERR (INY,899,401,?,$J,%ABORT) ;TYPE MESSAGE AND ABORT STATEMENT $ECALL INY,%ABORT TONXTW: JUMPE P1,TOSKP ;IF FIRST BUFFER, DON'T WRITE IT JUMPL P2,.+2 ;IF MIDDLE OF WINDOW ADD T3,P2 ;WRITE PARTIAL WINDOW SOUTR% ;WRITE BUFFER ERJMP UOUTERR ;ERROR, TYPE MESSAGE TOSKP: AOS BLKN(D) ;INCR BLOCK # MOVE P1,WADR(D) ;POINT TO EMPTY BUFFER SUBI P1,1 ;POINT TO WORD-1 MOVE P2,WSIZ(D) ;GET FULL WINDOW SIZE POPJ P, ;DONE UOUTERR: ; IOERR (OUY,899,401,?,$J,%ABORT) ;ERROR, TYPE MONITOR MESSAGE $ECALL OUY,%ABORT > ;IF20 ;ROUTINE TO MAP WINDOW CONTAINING FIRST BYTE OF RANDOM RECORD ;THINGS ARE LEFT SET UP FOR NXTW IN CASE RECORD SPANS WINDOWS ;ARGS: A.REC = RECORD NUMBER TO SET TO ;RETURN: IPTR/OPTR = POINTER TO FIRST BYTE OF RECORD ; ICNT/OCNT = BYTES IN WINDOW ; BYTN = NUMBER OF FIRST BYTE IN FOLLOWING WINDOW RMAPW: PUSHJ P,%SAVE2 ;SAVE P ACS SKIPG T3,@A.REC ;GET RECORD NUMBER ; IOERR (IRN,25,512,?,Illegal record number $D,,%ABORT) $ECALL IRN,%ABORT MOVEM T3,NREC(U) ;STORE IN UNIT BLOCK IRMAP: MOVE T1,RSIZE(D) ;GET RECORD SIZE, BYTES MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%UNF ;UNFORMATTED? JRST URMAP ;YES, GO DO THAT FRMAP: ADDI T1,2+4 ;ADD 2 FOR CRLF, 4 TO ROUND UP TO WORD IDIVI T1,5 ;GET RECORD SIZE IN WORDS IMULI T1,-1(T3) ;GET WORD NUMBER OF START OF RECORD MOVEI T2,5 ;GET BYTES PER WORD IMUL T2,T1 ;GET BYTE NUMBER OF RECORD START MOVEM T2,BYTN(D) ;STORE IT PUSHJ P,MAPW ;MAP RECORD INTO CORE HRLI P1,(POINT 7,0,34) ;POINT TO FIRST BYTE OF RECORD IMULI P2,5 ;CONVERT WINDOW LENGTH TO BYTES JRST RMAPX ;GO FINISH UP URMAP: MOVE T0,FLAGS(D) TXNE T0,D%BIN ;BINARY FILE? ADDI T1,2 ;YES, ADD 2 LSCWS IMULI T1,-1(T3) ;GET WORD NUMBER OF RECORD START MOVEM T1,BYTN(D) ;STORE CURRENT WORD NUMBER PUSHJ P,MAPW ;MAP RECORD START INTO CORE RMAPX: ADDM P2,BYTN(D) ;INCREMENT WORD NUMBER FOR NXTW DMOVEM P1,IPTR(D) ;STORE BYTE POINTER AND COUNT DMOVEM P1,OPTR(D) ;IN BOTH PLACES POPJ P, ;DONE ;ROUTINE TO MAP A FILE WINDOW ;ARGS: P1 = FILE ADDRESS ;RETURN: P1 = PROCESS ADDRESS ; P2 = NUMBER OF WORDS MAPPED IN WINDOW IF10, ;ON 10, WINDOW SIZE IS 2**7 IF20, ;ON 20, WINDOW SIZE IS 2**9 PSIZ==1_LWSIZ %MAPW: MAPW: MOVE P1,T1 ;GET WORD ADDRESS IN FILE LSHC P1,-LWSIZ ;GET PAGE NUMBER, SAVE OFFSET WITHIN PAGE CAMLE P1,TPAGE(D) ;GREATER THAN ANY PAGE REFERENCED BEFORE? MOVEM P1,TPAGE(D) ;YES. SAVE IT MOVE T1,WTAB(D) ;GET AOBJN POINTER TO WINDOW TABLE FINDW: HRRZ T2,(T1) ;GET PAGE NUMBER OF A MAPPED PAGE CAIE T2,(P1) ;IS IT THE ONE WE WANT? AOBJN T1,FINDW ;NO, LOOK ON JUMPL T1,PTRBMP ;IN CORE PUSHJ P,RDW ;NOT IN CORE PTRBMP: HLRZ P1,(T1) ;GET IN-CORE PAGE NUMBER OF FILE PAGE LSHC P1,LWSIZ ;COMBINE WITH WITHIN-PAGE OFFSET PUSHJ P,PAGCHK ;MACHINE-DEPENDENT PAGE (BLOCK) CODE MOVE T2,WPTR(D) ;GET REFILL POINTER TO WINDOW TABLE CAIE T2,(T1) ;IS IT POINTING TO PAGE WE JUST USED? JRST MAPRET ;NO, LEAVE IT WHERE IT IS SUBI T2,1 ;YES, POINT IT SOMEPLACE ELSE MOVE T3,WTAB(D) ;GET POINTER TO START OF TABLE CAIL T2,(T3) ;DID WE PASS BEGINNING OF TABLE? JRST PTRRET ;NO, FINE HLRE T3,T3 ;YES, GET -TABLE LENGTH SUB T2,T3 ;RESET POINTER TO TOP OF TABLE PTRRET: MOVEM T2,WPTR(D) ;RESET REFILL POINTER MAPRET: SETCM P2,P1 ;GET 777777777777 - OFFSET INTO WINDOW ANDI P2,PSIZ-1 ;GET WSIZ - 1 - OFFSET INTO WINDOW ADDI P2,1 ;GET WSIZ - OFFSET = WORDS MAPPED IN WINDOW SOJA P1,%POPJ ;RETURN CORRECT ADDR-1 IF10,< PAGCHK: MOVSI T2,(1B0) ;GET PAGE-WRITTEN BIT MOVE T0,FLAGS(D) TXNE T0,D%IO ;ARE WE WRITING? IORM T2,(T1) ;YES, FLAG PAGE AS MODIFIED POPJ P, >;END IF10 IF20,< PAGCHK: LOAD T3,ACC(D) ;GET ACCESS CAIE T3,AC.RIN ;RANDIN? POPJ P, ;NO. RANDOM. LEAVE PAGE ALONE SKIP (P1) ;REFERENCE A WORD IN THE PAGE ERJMP UNMAPR ;UNMAP THE PAGE IF NON-EXISTENT POPJ P, UNMAPR: PUSHJ P,%PUSHT ;SAVE T ACS MOVEI T2,(P1) ;GET CORE ADDR LSH T2,-LWSIZ ;MAKE IT A PAGE AGAIN HRLI T2,.FHSLF ;THIS FORK SETO T1, ;SETUP UNMAP FUNCTION SETZ T3, ;WITH NO REPEAT COUNT PMAP% ;UNMAP IT, SO IT WILL BE 0 PUSHJ P,%POPT ;RESTORE T ACS POPJ P, >;END IF20 IF20,< RDW: MOVE T1,WPTR(D) ;GET POINTER TO PAGE TO BOOT FROM CORE HRRM P1,(T1) ;STORE NEW FILE PAGE NUMBER HLRZ T2,(T1) ;GET PROCESS PAGE NUMBER HRLI T2,.FHSLF ;FORK HANDLE LOAD T1,IJFN(D) ;JFN MOVSI T1,(T1) HRRI T1,(P1) ;FILE PAGE NUMBER MOVSI T3,(PM%PLD+PM%RD+PM%WR) ;ACCESS BITS PMAP% ;MAP PAGE IN MOVE T1,WPTR(D) ;POINT TO WINDOW TABLE ENTRY POPJ P, ;GO MOVE WINDOW POINTER TO SOMEPLACE ELSE >;END IF20 IF10,< RDW: PUSHJ P,WRTPG ;WRITE PAGE BACK IF MODIFIED MOVE T1,LKPB+.RBSIZ(D) ;GET REAL FILE SIZE ADDI T1,PSIZ-1 ;ROUND UP TO GET # BLOCKS LSH T1,-LWSIZ CAIGE T1,1(P1) ;BLOCK EXIST? JRST CLRPAG ;NO. CREATE ZEROS, ACT AS IF IT DID HLLZ T2,CHAN(D) ;SET CHANNEL NUMBER HRRI T2,.FOUSI ;SET USETI FUNCTION MOVEI T3,1(P1) ;GET PAGE NUMBER TO READ IN MOVE T1,[2,,T2] ;SET TO DESIRED BLOCK FILOP. T1, $ECALL IOE,%ABORT HLLZ T2,CHAN(D) ;SET CHANNEL NUMBER HRRI T2,.FOINP ;SET INPUT FUNCTION MOVEI T3,T4 ;SET ADDRESS OF COMMAND LIST MOVE T1,WPTR(D) ;POINT TO WTAB ENTRY HLRZ T4,(T1) ;GET CORE "PAGE NUMBER" TO READ INTO LSH T4,LWSIZ ;CONVERT TO ADDRESS SUBI T4,1 ;-1 FOR IOWD HRLI T4,-PSIZ ;SET LENGTH SETZ T5, ;ZERO TO END COMMAND LIST MOVE T1,[2,,T2] ;SET ARG BLOCK POINTER FILOP. T1, ;DO FILOP $ECALL IOE,%ABORT MOVE T1,WPTR(D) ;RELOAD WTAB POINTER HRRM P1,(T1) ;STORE NEW FILE PAGE NUMBER POPJ P, ;GO BUMP POINTER TO SOMEPLACE ELSE WRTPG: MOVE T1,WPTR(D) ;GET POINTER TO PAGE TO BOOT FROM CORE SKIPL T3,(T1) ;GET FILE PAGE NUMBER AND SKIP IF MODIFIED POPJ P, ;NOT MODIFIED, NO NEED TO WRITE HLLZ T2,CHAN(D) ;GET CHANNEL NUMBER HRRI T2,.FOUSO ;SET USETO FUNCTION MOVEI T3,1(T3) ;GET JUST BLOCK NUMBER MOVE T1,[2,,T2] ;SET ARG BLOCK POINTER FILOP. T1, ;SET TO DESIRED BLOCK $ECALL IOE,%ABORT IMULI T3,PSIZ ;GET # WORDS TO END OF THIS PAGE CAMLE T3,LKPB+.RBSIZ(D) ;LARGER THAN WHAT'S THERE? MOVEM T3,LKPB+.RBSIZ(D) ;YES. UPDATE IT HLLZ T2,CHAN(D) ;GET CHANNEL NUMBER AGAIN HRRI T2,.FOOUT ;SET OUTPUT FUNCTION MOVEI T3,T4 ;SET ADDRESS OF COMMAND LIST MOVE T1,WPTR(D) ;POINT TO WTAB ENTRY AGAIN HLRZ T4,(T1) ;GET "PAGE NUMBER" OF WINDOW LSH T4,LWSIZ ;MAKE INTO ADDRESS SUBI T4,1 ;-1 FOR IOWD HRLI T4,-PSIZ ;PUT COUNT IN LH SETZ T5, ;ZERO TO END COMMAND LIST MOVE T1,[2,,T2] ;SET ARG BLOCK POINTER FILOP. T1, ;DO FILOP OR OUT UUO $ECALL IOE,%ABORT POPJ P, ;DONE REPEAT 0,< EOFOK: MOVEI T2,(T1) ;COPY BITS ANDI T2,760000 ;CLEAR ALL BUT ERR BITS CAIE T2,IO.EOF ;JUST EOF? $ECALL IOE,%ABORT ;NO, TYPE MESSAGE MOVEI T3,(T1) ;COPY BITS AGAIN TRZ T3,760000 ;CLEAR ERR BITS HLLZ T2,CHAN(D) ;SETSTS HRRI T2,.FOSET MOVE T1,[2,,T2] FILOP. T1, $SNH >;END REPEAT 0 CLRPAG: MOVE T1,WPTR(D) ;CLEAR BLOCK HLRZ T2,(T1) LSH T2,LWSIZ SETZM (T2) MOVSI T3,(T2) HRRI T3,1(T2) BLT T3,PSIZ-1(T2) HRRM P1,(T1) ;STORE NEW FILE PAGE NUMBER POPJ P, ;RETURN AS IF IT HAD RETURNED ZEROS ;HERE AT CLOSE TO WRITE MODIFIED PAGES %RANWR: PUSHJ P,%SAVE1 ;SAVE P ACS MOVE P1,WTAB(D) ;GET AOBJN POINTER TO TABLE RWLP: MOVEM P1,WPTR(D) ;POINT TO A PAGE PUSHJ P,WRTPG ;WRITE IT IF MODIFIED AOBJN P1,RWLP ;DO ALL PAGES POPJ P, ;DONE > ;IF10 ;SEQUENTIAL CASE, ONE N-PAGE WINDOW ;ARGS: T1 = WORD NUMBER IN FILE ; BUFCT = LENGTH OF WINDOW, PAGES IF20,< SMAPW: LOAD T2,INDX(D) ;GET DEVICE INDEX CAIE T2,DI.DSK ;DISK? JRST TNXTW ;NO. MOVE P1,T1 ;GET WORD # IN FILE LSHC P1,-LWSIZ ;CALC PAGE # LOAD T2,BUFCT(D) ;GET # PAGES WE ARE READING/WRITING ADDI T2,(P1) ;GET HIGHEST PAGE # CAMLE T2,TPAGE(D) ;HIGHER PAGE THAN RECORDED? MOVEM T2,TPAGE(D) ;YES. RECORD IT AOS BLKN(D) ;INCREMENT "BLOCK" NUMBER MOVE T1,WTAB(D) ;GET PAGE ADDR OF BUFFER MOVSI T2,.FHSLF ;THIS FORK HRRI T2,(T1) ;PAGE NUMBER IN FORK EXCH T1,P1 ;PAGE NUMBER IN FILE LOAD T3,IJFN(D) ;JFN HRLI T1,(T3) LOAD T3,BUFCT(D) ;PAGE COUNT HRLI T3,(PM%CNT+PM%PLD+PM%RD+PM%WR) ;ACCESS BITS, READ PAGES NOW PMAP% ;MAP WINDOW INTO FILE MOVE T1,FLAGS(D) ;CHECK IF INPUT OPERATION TXNN T1,D%IN ;IS IT? JRST NOPCH2 ;NO. DON'T CHECK PAGE EXISTENCE LOAD T4,BUFCT(D) ;GET BUFFER COUNT MOVNI T4,(T4) ;NEGATIVE MOVSI T4,(T4) ;IN LEFT HALF HRR T4,WTAB(D) ;GET PAGE # OF BOTTOM PAGE CHPLP: MOVEI T1,(T4) ;GET CORE ADDR LSH T1,LWSIZ SKIP (T1) ERJMP UNMPG ;IF NOT THERE, GO UNMAP AOBJN T4,CHPLP ;BACK FOR MORE JRST NOPCH2 ;DONE UNMPG: SETO T1, ;SET TO UNMAP IT MOVSI T2,.FHSLF ;THIS FORK HRRI T2,(T4) ;GET THE CORRECT PAGE TO TOSS SETZ T3, ;NO REPEAT COUNT PMAP% ;UNMAP THE PAGE AOBJN T4,CHPLP ;BACK FOR MORE NOPCH2: LSHC P1,LWSIZ ;COMBINE PAGE WITH WITHIN-PAGE OFFSET MOVE T1,P1 ;GET WITHIN-PAGE OFFSET ANDI T1,PSIZ-1 LOAD P2,BUFCT(D) ;GET WINDOW SIZE IN PAGES LSH P2,9 ;CONVERT TO WORDS SUBI P2,(T1) ;GET WORDS LEFT IN WINDOW SOJA P1,%POPJ ;POINT TO CORRECT ADDR-1 > ;END IF20 IF10,< SMAPW: MOVE T0,FLAGS(D) ;Get DDB flags TXNN T0,D%IO ;INPUT OPERATION? JRST SMWIN ;YES. GO DO IT AOS T1,BLKN(D) ;INCR BLOCK # IMULI T1,200 ;GET BYTE # OF NEXT BLOCK MOVEM T1,BYTN(D) ;STORE FOR EOFN CALC DMOVEM P1,OPTR(D) ;OUTPUT. SETUP OUTPUT PNTR/COUNT MOVE T2,CHAN(D) ;WRITE CURRENT BLOCK HRRI T2,.FOOUT MOVE T1,[1,,T2] FILOP. T1, PUSHJ P,EOFCHK DMOVE P1,OPTR(D) ;GET POINTER TO NEXT BUFFER POPJ P, ;DONE SMWIN: AOS T1,BLKN(D) ;INCR BLOCK # IMULI T1,200 ;GET BYTE # OF NEXT BLOCK MOVEM T1,BYTN(D) ;SAVE FOR EOFN CALC DMOVEM P1,IPTR(D) ;SETUP INPUT PNTR/COUNT MOVE T2,CHAN(D) ;GET CHANNEL STUFF HRRI T2,.FOINP ;READ NEXT BLOCK MOVE T1,[1,,T2] FILOP. T1, PUSHJ P,EOFCHK DMOVE P1,IPTR(D) ;GET PNTR/COUNT OF BUFFER JUST READ POPJ P, > ;IF10 SUBTTL TAPE POSITIONING ;Come here from MTOP% after the unit number has been checked. ;IO args have been set up in A.xxx ;A POPJ will return from the MTOP% call. MTOP: SKIPL T1,A.MTOP ;GET OPERATION CODE CAILE T1,MOPMAX ;NEGATIVE OR TOO BIG? POPJ P, ;YES, NOP XMOVEI T2,. ;Current section number in LH HRR T2,MOPNAM(T1) ;Get global address of ASCIZ name MOVEM T2,%IONAM ;SET STATEMENT NAME FOR ERROR MESSAGES MOVE T1,A.UNIT ;GET UNIT NUMBER SETZ P1, ;Clear D%UNF and D%RAN for default OPEN PUSHJ P,%SETD ;SET UP D DMOVE T2,[EXP [ASCIZ /direct/],[ASCIZ /sequential/]] MOVE T1,FLAGS(D) ;GET FLAGS TXNE T1,D%RAN ;RANDOM FILE? $ECALL CDI ;CAN'T DO THIS UNTIL VERSION 7 MOVE T1,A.MTOP ;Get back MTOP number PUSHJ P,@MOPDSP(T1) ;GO DO OPERATION PJRST %SETAV ;RETURN (possibly doing ERR=, etc.) MOPNAM: [ASCIZ /REWIND/] ;(0) [ASCIZ /UNLOAD/] ;(1) [ASCIZ /BACKSPACE/] ;(2) [ASCIZ /BACK FILE/] ;(3) [ASCIZ /ENDFILE/] ;(4) [ASCIZ /SKIP RECORD/] ;(5) [0] ;(6) [ASCIZ /SKIP FILE/] ;(7) MOPMAX==.-MOPNAM MOPDSP: IFIW MOPREW IFIW MOPUNL IFIW MOPBSR IFIW MOPBSF IFIW MOPEND IFIW MOPSKR IFIW %POPJ IFIW MOPSKF IF20,< ;REWIND MOPREW: MOVE T0,FLAGS(D) TXNE T0,D%END ;EOF? PUSHJ P,BAKEOF ;YES. CLEAR IT MOVEI T1,1 ;SET NEXT RECORD TO 1 MOVEM T1,NREC(U) SETZM BLKN(D) ;AND BLOCK # MOVX T0,D%END ;File is now not at end ANDCAM T0,FLAGS(D) LOAD T1,INDX(D) ;GET DEV INDEX CAIN T1,DI.DSK ;DISK? JRST DSKREW ;CAN DO CAIN T1,DI.MTA ;TAPE? JRST MTAREW ;CAN DO POPJ P, ;ELSE NOP DSKREW: MOVE T0,FLAGS(D) ;Get DDB flags for this file TXNE T0,D%OUT ;WAS IT OPEN FOR OUTPUT? PUSHJ P,%SETIN ;Yes. Switch to input SETZM IPTR(D) ;PRETEND NO I/O DONE SETZM ICNT(D) ;NO BYTES IN BUFFER SETZM BYTN(D) ;SET CURRENT BYTE NUMBER TO 0 POPJ P, ;DONE MTAREW: MOVE T1,FLAGS(D) ;Get DDB flags TXNN T1,D%IN+D%OUT ;If not open, JRST JSTREW ;Don't call %SETIN PUSHJ P,%SETIN ;Get file opened for INPUT SETZM IPTR(D) ;PRETEND NO I/O DONE SETZM ICNT(D) ;NO BYTES IN BUFFER MOVEI T2,.MOREW ;SET TO REWIND TAPE JRST DOMTOP ;GO DO MTOPR JSTREW: PUSHJ P,MTAOJF ;Open JFN, aborts if fails MOVEI T2,.MOREW ;Get function PUSHJ P,DOMTP1 ;Do it PJRST MTACJF ;Close file, release JFN, return. ;Routine to create a JFN to be used for magtape operations ;Returns .+1 if ok, JFN in "RWJFN" ;The JFN is opened for input. ;If fails, goes to %ABORT. MTAOJF: MOVE T1,[POINT 7,TMDEV] ;Get device name with ":" MOVEI T2,DEV(D) ;From the DDB HRLI T2,(POINT 7,) MTAOJ1: ILDB T3,T2 ;Get a byte JUMPE T3,MTAOJ2 ;Null, done IDPB T3,T1 ;Store JRST MTAOJ1 ;Loop until null found MTAOJ2: MOVEI T3,":" ;Append a colon IDPB T3,T1 ;Now have DEV: in "TMDEV" ;Do our own GTJFN. MOVX T1,GJ%SHT HRROI T2,TMDEV GTJFN% ERJMP E..SNH ;?Dev must exist: OPENX was done! HRRZM T1,RWJFN ;Save JFN ;Have to OPENF the file to do a TAPOP. MOVX T2,OF%RD ;Read ACCESS, nothing else. OPENF% ;Get READ access to file ERJMP MTARWO ;?OPENF failed, give error POPJ P, ;OK, return ;Here if OPENF failed MTARWO: MOVE T1,RWJFN ;Release JFN RLJFN% ERJMP .+1 ;?Too bad $ECALL OPE,%ABORT ;Give JSYS error and abort program SEGMENT DATA TMDEV: BLOCK 20 ;Device name with ":" RWJFN: BLOCK 1 ;Temp JFN used for REWIND, UNLOAD SEGMENT CODE ;Routine to close and release JFN gotten by MTAOJF MTACJF: MOVE T1,RWJFN ;Get saved JFN CLOSF% $ECALL CLF,%ABORT ;?CLOSF failed, abort program POPJ P, ;All worked, return ;BACKSPACE MOPBSR: PUSHJ P,%SETIN ;Switch to input if necessary MOVE T1,NREC(U) ;GET RECORD # SOJLE T1,%POPJ ;CAN'T GO BEFORE BEG FILE MOVEM T1,NREC(U) ;SAVE NEW RECORD NUMBER MOVE T0,FLAGS(D) TXNE T0,D%END ;FILE AT END? JRST BAKEOF ;YES. JUST BACK OVER IT TXNE T0,D%UNF ;FORMATTED? JRST UNFBSR ;NO, UNFORMATTED DMOVE P1,IPTR(D) ;GET POINTER JUMPE P1,%POPJ ;IF NO I/O YET, WE'RE DONE MOVEI T1,(P1) ;GET JUST ADDR CAML T1,WADR(D) ;BEG OF WINDOW? JRST BSROK ;NO PUSHJ P,SUBP1X ;YES. GET PREVIOUS WINDOW POPJ P, ;NONE. JUST RETURN BSROK: PUSHJ P,FBTST ;FIND CURRENT EOL JRST NORSZ ;GOT TO BEG FILE PUSHJ P,FBSLP ;AND PREVIOUS ONE JRST NORSZ ;GOT TO BEG FILE SKIPN RSIZE(D) ;FIXED-LENGTH RECORDS? JRST NORSZ ;NO HRLI P1,(POINT 7,0,34) ;YES. POINT TO END OF WORD IDIVI P2,5 ;AND CORRECT COUNT IMULI P2,5 NORSZ: DMOVEM P1,IPTR(D) ;STORE POINTER/COUNT POPJ P, FBTST: LDB T1,P1 ;GET BYTE CAIL T1,12 ;LF, VT, FF? CAILE T1,14 JRST FBSLP ;NO JRST %POPJ1 ;DONE. SKIP RETURN FBSLP: ADDI P2,1 ;ADJUST COUNT ADD P1,[47B5] ;DECREMENT P1 TLCE P1,(1B0) JRST FBTST ;PNTR IS OK SUBP1: SUB P1,[430000,,1] ;DECREMENT TO PREV WORD MOVEI T1,(P1) ;GET JUST ADDR CAML T1,WADR(D) ;AT BEG OF WINDOW? JRST FBTST ;NO. BACK TO TEST PUSHJ P,SUBP1X ;YES. GET PREVIOUS WINDOW POPJ P, ;NONE THERE JRST FBTST ;GOT IT. BACK TO GET CHARS SUBP1X: LOAD T1,INDX(D) ;GET DEV INDEX CAIN T1,DI.MTA ;TAPE? JRST MTABSA ;YES MOVE T1,BYTN(D) ;GET BYTE # OF NEXT WINDOW SUB T1,WSIZ(D) ;GET BYTE # OF THIS WINDOW JUMPLE T1,%POPJ ;BEG OF FILE. NON-SKIP RETURN SUB T1,WSIZ(D) ;GET BYTE # OF PREVIOUS WINDOW MOVEM T1,BYTN(D) ;SAVE IT PUSHJ P,FNXTW ;GO MAP THE WINDOW MOVE T1,WSIZ(D) ;GET WINDOW SIZE IN BYTES LOAD T2,BPW(D) ;GET BYTES/WORD IDIVI T1,(T2) ;GET WINDOW SIZE IN WORDS ADD P1,T1 ;POINT TO END OF WINDOW HRLI P1,(POINT 7,,34) SETZ P2, ;AND CLEAR COUNT JRST %POPJ1 ;SKIP RETURN MTABSA: MOVE T1,BLKN(D) ;GET CURRENT BLOCK # SOJLE T1,%POPJ ;LEAVE IF NONE THERE AFTER DECR MOVEM T1,BLKN(D) ;SAVE DECREMENTED AMOUNT MOVEI T2,.MOBKR ;BACKSPACE RECORD PUSHJ P,DOMTOP ;BACK UP TO BEGINNING OF THIS RECORD PUSHJ P,BACKA ;BACKSPACE, READ A BLOCK JRST %POPJ1 ;AND SKIP RETURN BACKA: MOVEI T2,.MOBKR PUSHJ P,DOMTOP ;BACK UP TO BEGINNING OF PREV RECORD LOAD T1,IJFN(D) ;READ THE RECORD MOVE T2,WADR(D) ;POINT TO BUFFER SUBI T2,1 ;POINT TO LAST BYTE IN PREV WORD HRLI T2,(POINT 7,0,34) MOVN T3,WSIZ(D) ;GET LENGTH OF WINDOW SINR% ;READ STRING ERCAL EOFCHK ;ERROR, GO TYPE MESSAGE MOVE T1,WSIZ(D) ;GET WINDOW SIZE ADD T1,T3 ;GET # BYTES ACTUALLY READ MOVEM T1,WCNT(D) ;SAVE FOR DIRECTION SWITCH MOVE P1,T2 ;POINT AT LAST BYTE READ SETZ P2, ;CLEAR COUNT DMOVEM P1,IPTR(D) ;SAVE PNTR/COUNT POPJ P, UNFBSR: LOAD T1,INDX(D) ;CHECK DEVICE CAIN T1,DI.MTA ;TAPE? JRST MTABSU ;YES DMOVE P1,IPTR(D) ;GET POINTER MOVE T0,FLAGS(D) TXNN T0,D%BIN ;BINARY? JRST IBSLP ;NO, IMAGE UBSLP: MOVEI T1,(P1) ;GET ADDR ONLY CAML T1,WADR(D) ;AT BEG OF WINDOW? JRST BINOK ;NO MOVE T1,BYTN(D) ;YES. GET WORD # OF NEXT WINDOW SUB T1,WSIZ(D) ;GET WORD # OF THIS WINDOW JUMPLE T1,%POPJ ;IF BEG OF THIS WINDOW IS 0, LEAVE SUB T1,WSIZ(D) ;GET WORD # OF PREVIOUS WINDOW MOVEM T1,BYTN(D) ;SAVE IT PUSHJ P,UNXTW ;GET PREVIOUS WINDOW ADD P1,WSIZ(D) ;POINT TO END OF WINDOW SETZ P2, ;AND CLEAR COUNT BINOK: HRRZ T1,(P1) ;GET LENGTH FROM END LSCW SUBI P1,(T1) ;GET ADDR OF BEG OF RECORD ADDI P2,(T1) ;AND INCR WORD COUNT LEFT MOVEI T1,(P1) ;GET ADDR ONLY SUB T1,WADR(D) ;GET WINDOW OFFSET CAML T1,[-1] ;BEFORE BEG OF WINDOW? JRST UBSRET ;NO. WE'RE DONE ADDI P1,1 ;POINT TO WORD WE WANT TO MAP PUSHJ P,%PTOF ;GET THE FILE POSITION JUMPGE P1,BINOK2 ;OK IF ZERO SETZ P1, ;ELSE MAP PAGE 0 BINOK2: PUSHJ P,%FTOP ;MAP THE BEG OF RECORD MOVE T1,BYTN(D) ;GET BYTE # OF NEXT WINDOW CAMG T1,EOFN(D) ;PAST EOF? JRST UBSRET ;NO SUB T1,EOFN(D) ;YES. GET DIFF SUBI P2,(T1) ;SUBTRACT FROM AVAILABLE CHARS MOVE T2,WSIZ(D) ;GET WINDOW SIZE SUBI T2,(T1) ;GET # ACTIVE CHARS MOVEM T2,WCNT(D) ;SAVE IT UBSRET: DMOVEM P1,IPTR(D) ;STORE POINTER POPJ P, ;DONE IBSLP: SKIPN T1,RSIZE(D) ;RECORDSIZE SPECIFIED? ; IOERR (CBI,25,536,?,Can't backspace image file with no RECORDSIZE,,%ABORT) $ECALL CBI,%ABORT SUBI P1,(T1) ;DECR PNTR ADDI P2,(T1) ;INCR WORD COUNT MOVEI T1,(P1) ;GET ADDR ONLY SUB T1,WADR(D) ;GET WINDOW OFFSET CAML T1,[-1] ;BEFORE BEG WINDOW? JRST UBSRET ;NO. WE'RE DONE ADDI P1,1 ;POINT TO WORD WE REALLY WANT PUSHJ P,%PTOF ;CONVERT P1 FROM CORE ADDRESS TO FILE ADDRESS JUMPG P1,IMGOK2 ;OK IF .GT. 0 SETZ P1, ;ELSE MAP PAGE 0 IMGOK2: JRST BINOK2 ;GO MAP PAGE, SETUP PNTR/COUNT MTABSU: DMOVE P1,IPTR(D) ;GET BUFFER POINTER/COUNT MOVE T0,FLAGS(D) TXNE T0,D%BIN ;BINARY? JRST MTABSB ;YES SKIPN T1,RSIZE(D) ;NO, IMAGE; MUST HAVE RECORD SIZE $ECALL CBI,%ABORT JRST MTABSI ;GO BACK OVER THAT MANY WORDS MTABSB: MOVEI T1,(P1) ;GET PNTR CAML T1,WADR(D) ;AT BEG OF BUFFER? JRST BSUOK ;NO. CAN JUST GRAB PREV RECSIZ MOVE T1,BLKN(D) ;GET BLOCK SOJLE T1,%POPJ ;BEG OF FILE. BACKSPACE IS NOP MOVEM T1,BLKN(D) ;STORE AS NEW BLOCK # MOVEI T2,.MOBKR ;BACKSPACE TO BEG OF CURRENT BLOCK PUSHJ P,DOMTOP PUSHJ P,BACKU ;BACKSPACE 1 RECORD, READ 1 BSUOK: HRRZ T1,(P1) ;GET RECSIZ FROM TYPE 3 LSCW MTABSI: SUBI P1,(T1) ;DECR PNTR ADDI P2,(T1) ;INCR COUNT MOVEI P3,(P1) ;GET NEW PNTR SUB P3,WADR(D) ;GET WINDOW OFFSET CAML P3,[-1] ;BEFORE BEG OF WINDOW? JRST GOTBF ;NO. WE'RE OK MOVE T1,BLKN(D) ;GET BLOCK # SOJLE T1,BEGBF ;IF BLOCK 1, JUST SET TO BEG BUFFER MOVEM T1,BLKN(D) ;NOT. STORE NEW BLOCK # MOVEI T2,.MOBKR ;BACKSPACE TO BEG OF CURRENT BLOCK PUSHJ P,DOMTOP PUSHJ P,BACKU ;BACKSPACE 1 REC, READ 1 MOVM T1,P3 ;GET NEW DECREMENT SOJA T1,MTABSI ;BACKU POINTS 1 BACK, SO DECR THE DECR ;LOOP UNTIL DONE OR BEG FILE BEGBF: MOVE P1,WADR(D) ;SET PNTR/COUNT TO BEG BUFFER SUBI P1,1 MOVE P2,WCNT(D) GOTBF: DMOVEM P1,IPTR(D) ;STORE PNTR/COUNT POPJ P, ;DONE BACKU: MOVEI T2,.MOBKR ;BACKSPACE RECORD PUSHJ P,DOMTOP LOAD T1,IJFN(D) ;READ THE RECORD MOVE T2,WADR(D) ;POINT TO BUFFER SUBI T2,1 ;POINT TO LAST BYTE OF WORD-1 HRLI T2,(POINT 36,0,35) MOVN T3,WSIZ(D) SINR% ERCAL EOFCHK ;ERROR, GO TYPE MESSAGE MOVEI P1,(T2) ;GET PNTR TO END OF ACTIVE BYTES SETZ P2, DMOVEM P1,IPTR(D) ;SAVE PNTR/COUNT MOVE T1,WSIZ(D) ;GET WINDOW SIZE ADD T1,T3 ;GET # ACTIVE BYTES MOVEM T1,WCNT(D) ;SAVE IT POPJ P, BAKEOF: MOVX T0,D%END ;Clear EOF bit ANDCAM T0,FLAGS(D) LOAD T1,INDX(D) ;GET DEVICE INDEX CAIE T1,DI.MTA ;MAGTAPE? POPJ P, ;NO PUSHJ P,%CLSOP ;CLOSE, OPEN FILE SOS BLKN(D) ;EOF MARK IS A BLOCK MOVEI T2,.MOBKR ;BACK OVER THE EOF MARK PUSHJ P,DOMTOP SKIPN BLKN(D) ;ANY BLOCKS LEFT? POPJ P, ;NO. JUST LEAVE MOVE T0,FLAGS(D) TXNE T0,D%UNF ;YES. UNFORMMATED? JRST BACKU ;YES. BACKSPACE, UNFORMATTED READ JRST BACKA ;NO. BACKSPACE, FORMATTED READ ;ROUTINES TO CONVERT BETWEEN FILE ADDRESSES AND PROCESS ADDRESSES ; ;%PTOF - CONVERT PROCESS ADDRESS TO FILE ADDRESS ;ARGS: P1 = ADDRESS, MUST BE IN THE MEMORY MAPPED TO THE FILE OPEN ; ON THE DDB POINTED TO BY D ;RETURN: P1 = CORRESPONDING WORD NUMBER IN THE FILE ; ;%FTOP - CONVERT FILE ADDRESS TO PROCESS ADDRESS ;ARGS: P1 = FILE ADDRESS ;RETURN: P1 = PROCESS ADDRESS WITH THAT WORD OF FILE MAPPED TO IT ; P2 = COUNT OF WORDS FOLLOWING MAPPED WORD IN WINDOW %PTOF:: MOVEI P1,(P1) ;DISCARD LH(P1) JUMPE P1,%POPJ ;ADDRESS=0 MEANS FILE PAGE 0 SUB P1,WADR(D) ;GET OFFSET IN WINDOW MOVE T2,BYTN(D) ;GET FILE OFFSET OF NEXT WINDOW SUB T2,WSIZ(D) ;GET FILE OFFSET OF CURRENT WINDOW LOAD T4,BPW(D) ;GET BYTES/WORD IDIVI T2,(T4) ;CONVERT BYTES TO WORDS ADD P1,T2 ;ADD TO OFFSET IN THIS WINDOW POPJ P, %FTOP:: MOVEM P1,BYTN(D) ;STORE BYTE NUMBER MOVE T1,P1 ;ARG IS IN T1 PUSHJ P,SMAPW ;GO MAP THE FILE, RETURN PROCESS ADDRESS ADDM P2,BYTN(D) ;SET BYTN UP FOR NXTW POPJ P, ;UNLOAD MOPUNL: LOAD T1,INDX(D) ;GET DEV INDEX CAIE T1,DI.MTA ;TAPE? JRST MOPREW ;NO, UNLOAD IS REWIND MOVEI T1,1 ;SET NEXT RECORD TO 1 MOVEM T1,NREC(U) SETZM BLKN(D) ;CLEAR BLOCK # MOVX T0,D%END ;File is now not at end ANDCAM T0,FLAGS(D) MOVE T1,FLAGS(D) ;Get DDB flags TXNN T1,D%IN+D%OUT ;If not opened yet, JRST JSTUNL ;Don't call "SETIN" PUSHJ P,%SETIN ;Get file opened for input. MOVEI T2,.MORUL ;SET FOR UNLOAD OPR JRST DOMTOP ;GO DO IT JSTUNL: PUSHJ P,MTAOJF ;Get a JFN with no filename MOVEI T2,.MORUL ;UNLOAD it PUSHJ P,DOMTP1 PJRST MTACJF ;Close, release JFN and return ;TOPS-20 BACKFILE MOPBSF: LOAD T1,INDX(D) ;GET DEV INDEX CAIE T1,DI.MTA ;TAPE? POPJ P, ;NO, BACKFILE IS NOP PUSHJ P,%SETIN ;Make sure we're open for input PUSHJ P,ENDOUT ;SETUP PROPERLY MOVEI T1,1 ;SET NEXT RECORD TO 1 MOVEM T1,NREC(U) SETZM BLKN(D) ;CLEAR BLOCK # MOVX T0,D%END ;File is now not at end ANDCAM T0,FLAGS(D) MOVEI T2,.MOBKF ;SET FOR BACKSPACE FILE PUSHJ P,DOMTOP ;GO DO IT MOVEI T2,.MOBKF ;AND A 2ND TIME PUSHJ P,DOMTOP LOAD T1,IJFN(D) ;GET JFN GDSTS% ;GET STATUS TXNN T2,MT%BOT ;UNLESS BEG TAPE PUSHJ P,FORWF PJRST %CLSOP ;MAKE SURE NO STUPID EOF STATUS ;END FILE MOPEND: AOS NREC(D) ;INCR REC # LOAD T1,INDX(D) ;GET DEV INDEX CAIN T1,DI.DSK ;DISK? JRST DSKEND ;YES CAIE T1,DI.MTA ;TAPE? POPJ P, ;NO. ENDFILE IS A NOP PUSHJ P,%SETOUT ;Set to output PUSHJ P,%LSTBF ;OUTPUT LAST BUFFER, IF ANY PUSHJ P,%CLSOP ;CLOSE FILE, OPEN FOR INPUT AGAIN ENDOUT: SETZM IPTR(D) ;CLEAR THE PNTR/COUNT SETZM ICNT(D) MOVE T1,FLAGS(D) TXO T1,D%IN+D%END ;WE ARE OPEN FOR INPUT, AT EOF TXZ T1,D%OUT ;NO LONGER DOING OUTPUT MOVEM T1,FLAGS(D) AOS BLKN(D) ;INCR BLOCK # POPJ P, DSKEND: PUSHJ P,%SETOUT ;SET TO OUTPUT PUSHJ P,%SETIN ;AND THEN TO INPUT AGAIN MOVX T1,D%END+D%MOD ;AT EOF IORM T1,FLAGS(D) POPJ P, ;DONE ;TOPS-20 SKIP RECORD MOPSKR: PUSHJ P,%SETIN ;Switch to input MOVE T0,FLAGS(D) TXNN T0,D%UNF ;READ AND IGNORE 1 RECORD JRST %IREC JRST UNFSKP ;SKIP FILE MOPSKF: LOAD T1,INDX(D) ;GET DEV INDEX CAIE T1,DI.MTA ;TAPE? POPJ P, ;NO, SKIP IS NOP MOVE T0,FLAGS(D) ;GET FLAGS TXNN T0,D%IN+D%OUT ;FILE OPEN? JRST JSTSKF ;NO. JUST SKIP A FILE PUSHJ P,%SETIN ;Make sure file is open for input PUSHJ P,ENDOUT ;SETUP PROPERLY MOVEI T1,1 ;SET NEXT RECORD TO 1 MOVEM T1,NREC(U) SETZM BLKN(D) ;CLEAR BLOCK # MOVX T0,D%END ;Clear EOF bit ANDCAM T0,FLAGS(D) MOVEI T2,.MOFWF ;SET FOR SKIP FILE PUSHJ P,DOMTOP ;BUT IF WE WERE, DON'T GO ANYWHERE PJRST %CLSOP ;MAKE SURE NO STUPID EOF BIT LEFT ON JSTSKF: PUSHJ P,MTAOJF ;GET A JFN, OPEN MTA MOVEI T2,.MOFWF ;DO A SKIP FILE MTOPR PUSHJ P,DOMTP1 PJRST MTACJF ;GO CLOSE FILE, RELEASE JFN, LEAVE FORWF: MOVEI T2,.MOFWF ;SKIP FILE ;DOMTOP - Routine to do the MTOP specified in T2. (does appropriate ; WAIT's etc.) DOMTOP: LOAD T1,IJFN(D) ;GET JFN ;Enter at DOMTP1 if you want to use the JFN in T1. DOMTP1: PUSH P,T2 ;SAVE THE OPERATION TO DO MOVEI T2,.MONOP ;DO A WAIT MTOPR% ERJMP MTOPER POP P,T2 ;GET THE OPERATION MTOPR% ;DO OPERATION ERJMP MTOPER MOVEI T2,.MONOP ;AND DO A WAIT MTOPR% ERJMP MTOPER POPJ P, ;DONE MTOPER: ;IOERR (ILM,23,,?,$J,,%POPJ) $ECALL ILM,%ABORT > ;IF20 IF10,< MOPREW: MOVEI T1,1 ;SET NEXT RECORD TO 1 MOVEM T1,NREC(U) SETZM BLKN(D) ;AND BLOCK # MOVX T0,D%END ;Clear EOF bit ANDCAM T0,FLAGS(D) LOAD T1,DVTYP(D) ;GET DEVICE INDEX CAIN T1,.TYDTA ;DECTAPE? JRST DTAREW ;YES CAIN T1,.TYDSK ;DISK? JRST DSKREW ;Yes CAIN T1,.TYMTA ;Magtape? JRST MTAREW ;Yes POPJ P, ;OTHERWISE IT'S A NOP .FOMTP==30 DTAREW: MOVE T1,FLAGS(D) ;Get DDB flags TXNN T1,D%IN+D%OUT ;Is the DECTAPE open? JRST RWDEVO ;Yes, don't use filename PUSHJ P,%SETIN ;OPEN for input. SETZM BLKN(D) ;CLEAR BLOCK NUMBER MOVE T2,CHAN(D) ;LH= chan # HRRI T2,.FOMTP ;MTAPE FILOP MOVX T3,MTREW. ;REWIND MOVE T1,[2,,T2] FILOP. T1, $ECALL IOE,%ABORT POPJ P, DSKREW: MOVE T1,FLAGS(D) ;Is file really OPEN? TXNE T1,D%IN+D%OUT PUSHJ P,CLSOPN ;Yes, CLOSE the file, open for input POPJ P, ;Return MTAREW: MOVE T1,FLAGS(D) ;Get flags TXNN T1,D%IN+D%OUT ;Is file really OPEN JRST RWDEVO ;No PUSHJ P,CLSOPN ;CLOSE THE FILE, OPEN FOR INPUT MOVEI T2,.TFREW ;Go do REWIND PJRST DOMTOP ;Here to REWIND a non-directory device that is not opened yet. ; Can't use FILOP.'s because you need a filename for them. RWDEVO: PUSHJ P,OPDEVO ;Open the device only MOVE T1,ASCHN ;Get channel # LSH T1,^D23 ;Shift to ac field IOR T1,[MTREW.] ;Make instruction XCT T1 ;** REWIND the device ** PJRST CLDEVO ;Close device and return ;Routine to OPEN the device only, (on a low channel). ; FILOP. is not done, because no file can be specified. ;The assigned channel is stored in ASCHN. ;Returns .+1 or takes ERR= or goes to %ABORT (if errors) OPDEVO: SETZ T1, ;Get a free channel PUSHJ P,%ALCHN ;Get a channel $ECALL NFC,%ABORT ;?Too many OPEN units MOVEM T1,ASCHN ;Save it LSH T1,^D23 ;Shift into AC position IOR T1,[OPEN T2] ;Get instruction to XCT MOVEI T2,.IODMP ;Set dump mode SETZ T4, ;No buffers MOVE T3,DEV(D) ;Get device XCT T1 ;** OPEN the device ** JRST OPDVFL ;?Failed POPJ P, ;OK, return ;The OPEN UUO failed. Either "No such device" ;or "Assigned to another job". OPDVFL: MOVE T1,DEV(D) ;See if this device exists DEVTYP T1, JRST OPDVNS ;?no such device JUMPE T1,OPDVNS ;Or if 0 returned. SKIPA T1,[ERDAJ%] ;"Device allocated to another job" OPDVNS: MOVEI T1,ERNSD% ;"No such device" $ECALL OPN,%ABORT ;Give error, abort if no ERR= SEGMENT DATA ASCHN: BLOCK 1 ;Assigned channel for non-FILOP. I/O SEGMENT CODE ;Routine to CLOSE the device OPEN'ed by OPDEVO. ;Returns .+1 always CLDEVO: MOVE T1,ASCHN ;Get assigned channel # LSH T1,^D23 ;Shift into ac position IOR T1,[RELEAS 0] ;Get a RELEASE instruction XCT T1 ;Do it MOVE T1,ASCHN ;Get channel # PUSHJ P,%DECHN ;Deallocate it $SNH ;?Not assigned, "can't happen" POPJ P, ;Ok, return ;Still IF10 MOPBSR: PUSHJ P,%SETIN ;Get file open for input LOAD T1,INDX(D) ;GET DEVICE INDEX CAIE T1,DI.DSK ;DISK? CAIN T1,DI.MTA ;OR MAGTAPE? JRST BSROK ;YES POPJ P, ;NO. BSR IS NOP BSROK: SKIPG BLKN(D) ;HAVE WE READ ANYTHING? POPJ P, ;NO. BACKSPACE IS A NOP MOVE T1,NREC(U) ;GET RECORD NUMBER SOJLE T1,%POPJ ;CAN'T GO BACK MOVEM T1,NREC(U) ;STORE UPDATED ONE LOAD T1,MODE(D) ;GET FILE MODE CAIN T1,MD.DMP ;DUMP MODE? JRST BSRDMP ;YES. VERY SPECIAL CAIN T1,MD.BIN ;IS IT BINARY? JRST BSRBIN ;YES CAIE T1,MD.ASC ;IS IT ASCII? CAIN T1,MD.ASL JRST BSRASC ;YES. GO LOOK BACKWARDS FOR LF SKIPE RSIZE(D) ;NO. FIXED-LENGTH RECORDS? JRST IMGFIX ;YES JRST NOBSR ;NO. DO NOTHING! BSRASC: SKIPE RSIZE(D) ;FIXED-LENGTH RECORDS? JRST ASCFIX ;YES. EASY TREATMENT MOVE T0,FLAGS(D) TXNN T0,D%END ;ARE WE AT EOF? JRST ASCNEF ;NO PUSHJ P,BAKEOF ;YES. BACK UP AND GET PREVIOUS BLOCK SKIPN BLKN(D) ;NULL FILE? POPJ P, ;YES. WE'RE DONE MOVE T1,IBCB(D) ;GET BUFFER HEADER ADDR MOVE P2,1(T1) ;RETURN THE WORD COUNT OF THE BUFFER IMULI P2,5 ;TURN INTO CHARS HRRZ P1,IPTR(D) ;GET END BUFFER PNTR MOVE T3,ICNT(D) ;AND COUNT (SHOULD BE ZERO) MOVEI T2,4 ;SET INDEX TO END OF WORD JRST BIDXOK ;GO BACK TO PREVIOUS EOL CHAR ASCNEF: MOVE P1,IBCB(D) ;GET ADDR OF BUFFER HRRZ P2,1(P1) ;GET WORD COUNT IMULI P2,5 ;GET CHAR COUNT OF BUFFER HRRZ P1,IPTR(D) ;GET CURRENT WORD PNTR LDB T2,[POINT 6,IPTR(D),5] ;GET BYTE OFFSET IDIVI T2,7 ;CALCULATE INDEX SUBI T2,4 ;SUBTRACT FROM 4 MOVM T2,T2 ;TO GET INDEX IN RIGHT DIRECTION MOVE T3,ICNT(D) ;GET CURRENT COUNT PUSHJ P,BACKUP ;BACKUP TO LAST LF ADDI T3,1 ;NOW TO PREVIOUS CHAR SOJGE T2,BIDXOK MOVEI T2,4 SUBI P1,1 BIDXOK: PUSHJ P,BACKUP ;AND TO PREVIOUS LF MOVE T2,PNTABL(T2) ;CREATE PNTR TO IT TLZ T2,17 ;THROW OUT INDEX HRRI T2,(P1) MOVEM T2,IPTR(D) ;SAVE IT MOVEM T3,ICNT(D) ;AND COUNT NOBSR: POPJ P, %BAKEF: BAKEOF: SOS BLKN(D) ;DECR BLOCK FOR THE EOF %ISET: PUSHJ P,CLSOPN ;CLEAR THE EOF STATUS LOAD T1,INDX(D) ;GET DEVICE INDEX CAIN T1,DI.DSK ;DISK? JRST DSKEOF ;YES. GO DO USETI CAIE T1,DI.MTA ;MAGTAPE? POPJ P, ;NO. CAN'T DO ANYTHING ELSE MOVEI T2,.TFBSB ;YES. BACKSPACE A FILEMARK PUSHJ P,DOMTOP LOAD T1,MODE(D) ;GET DATA MODE CAIE T1,MD.DMP ;DUMP? SKIPG BLKN(D) ;NO. ANY DATA? POPJ P, ;LEAVE IF NO DATA OR DUMP MODE MOVEI T2,.TFBSB ;BACK OVER THE RECORD WE WANT PUSHJ P,DOMTOP JRST COMEOF ;JOIN COMMON CODE DSKEOF: MOVE T2,FBLK(D) ;GET CHANNEL STUFF HRRI T2,.FOUSI ;DO USETI SKIPG T3,BLKN(D) ;TO CURRENT BLOCK POPJ P, ;LEAVE IF NULL FILE MOVE T1,[2,,T2] FILOP. T1, $ECALL IOE,%ABORT LOAD T1,MODE(D) ;GET DATA MODE CAIN T1,MD.DMP ;DUMP? POPJ P, ;YES. DON'T READ ANYTHING COMEOF: MOVE T2,FBLK(D) ;GET CHANNEL STUFF HRRI T2,.FOINP ;READ THE BLOCK MOVE T1,[1,,T2] FILOP. T1, $ECALL IOE,%ABORT ;Should not fail with "EOF" MOVE T1,IBCB(D) ;GET BUFFER HEADER ADDR HRRZ T1,1(T1) ;GET THE WORD COUNT ADDM T1,IPTR(D) ;POINT TO END OF BUFFER SETZM ICNT(D) ;CLEAR COUNT POPJ P, BSRDMP: SKIPN T1,BLKN(D) ;GET BLOCK # POPJ P, ;HAVEN'T DONE ANY INPUT YET SOS BLKN(D) ;DECR THE BLOCK # LOAD T2,INDX(D) ;GET DEVICE INDEX CAIE T2,DI.DSK ;DISK? JRST %BACKB ;NO. BACKSPACE AN MTA BLOCK PJRST USET ;SET NEXT BLOCK TO CURRENT ONE ;HERE IF BINARY RECORD BSRBIN: MOVE T0,FLAGS(D) TXNE T0,D%END ;ARE WE AFTER AN EOF? PJRST BAKEOF ;YES. GET PREV BLOCK, POINT TO END MOVE P1,IBCB(D) ;GET ADDR OF BUFFER HRRZ P2,1(P1) ;GET WORD COUNT MOVEI P3,(P2) ;COPY IT CAMN P2,ICNT(D) ;ARE WE POINTING TO BEG BLK? JRST BBACK ;YES. MUST GET PREV BUFFER MOVE P1,IPTR(D) ;GET THE CURRENT PNTR MOVE T1,ICNT(D) ;GET COUNT LEFT MOVEM T1,BSRCNT ;SAVE FOR BACKSPACE HRRZ T1,(P1) ;GET THE WORD COUNT OF LAST REC JRST GTBPTR ;NOW GO BACK UP THE FILE BBACK: PUSHJ P,PRVBUF ;GET THE PREVIOUS BUFFER JRST BBOK ;NON-SKIP MEANS NOT BEG OF FILE POPJ P, ;SKIP MEANS BEGINNING OF FILE BBOK: MOVEM T3,BSRCNT ;SAVE ALSO FOR BACKSPACE MOVEI P3,(P2) ;COPY THE WORD COUNT HRRZ T1,(P1) ;GET THE LAST REC WORD SIZE GTBPTR: PUSHJ P,BCOM ;DO THE BACKSPACE MOVE T1,BSRCNT ;RESTORE NEW COUNT MOVEM T1,ICNT(D) POPJ P, ;HERE FOR ASCII OR IMAGE FIXED-LENGTH RECORDS ASCFIX: MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%END ;ARE WE AFTER AN EOF? PJRST BAKEOF ;YES. GET PREV BLOCK, POINT TO END MOVE T1,ICNT(D) ;GET COUNT IDIVI T1,5 ;GET # WORDS MOVEM T1,BSRCNT ;SAVE WORD COUNT PUSHJ P,BSRFIX ;GO BACK MOVE T1,BSRCNT ;GET WORDS AGAIN IMULI T1,5 ;CONVERT TO CHARS MOVEM T1,ICNT(D) ;SAVE IT HRLOI T1,7777 ;AND RIGHT JUSTIFY THE PNTR ANDM T1,IPTR(D) ;BY CLEARING THE POSITION POPJ P, IMGFIX: MOVE T0,FLAGS(D) TXNE T0,D%END ;ARE WE AFTER AN EOF? PJRST BAKEOF ;YES. GET PREV BLOCK, POINT TO END MOVE T1,ICNT(D) ;GET WORD COUNT MOVEM T1,BSRCNT ;SAVE IT PUSHJ P,BSRFIX ;GO BACK MOVE T1,BSRCNT ;GET WORDS AGAIN MOVEM T1,ICNT(D) ;SAVE IT POPJ P, BSRFIX: MOVE P1,IBCB(D) ;GET THE BUFFER ADDR HRRZ P2,1(P1) ;GET THE WORD COUNT MOVEI P3,(P2) ;COPY IT LOAD T1,RSIZW(D) ;GET # WORDS IN RECORD BCOM: SUB P3,BSRCNT ;GET # WORDS USED SUBI P3,(T1) JUMPL P3,BPREV ;HAVE TO GO TO PREV BUFFER SUBI P2,(P3) ;GET NEW # WORDS MOVEM P2,BSRCNT ;SAVE NEW COUNT MOVNI T1,(T1) ;GET NEG REC SIZE ADDM T1,IPTR(D) ;DECR THE PNTR POPJ P, ;AND LEAVE BPREV: PUSHJ P,PRVBUF ;GET PREV BUFFER JRST NOTBEG ;NOT AT BEG OF FILE MOVE P1,IBCB(D) ;BEG FILE. GET ADDR OF BUFFER MOVE P2,1(P1) ;GET # WORDS IN BUFFER MOVEM P2,BSRCNT ;BUFFER IS FULL MOVEI T1,1(P1) ;SETUP BEG PNTR HRRM T1,IPTR(D) POPJ P, NOTBEG: MOVM T1,P3 ;FIND POS DIFF NECESSARY CAIG T1,(P2) ;.GT. BUFFER SIZE? JRST BINOK ;NO ADD P3,P2 ;YES. DECREASE THE NEG DIFF JRST BPREV ;AND GO GET ANOTHER BUFFER BINOK: ADD P1,P3 ;DECR THE PNTR HRRM P1,IPTR(D) MOVEM T1,BSRCNT ;AND SETUP THE COUNT POPJ P, AFTPRV: IMULI P2,5 ;GET BYTE COUNT RCLP0: MOVEI T2,4 ;LOAD MAX INDEX BACKUP: RCLP1: CAIL T3,(P2) ;COUNT AT BUFFER MAX? JRST BEGBUF ;YES. GO GET PREVIOUS BLOCK LDB T1,PNTABL(T2) ;GET A CHAR CAIG T1,14 ;EOL CHAR? CAIGE T1,12 JRST NEOL ;NO POPJ P, ;YES. WE'RE DONE NEOL: ADDI T3,1 ;INCR BUFFER COUNT SOJGE T2,RCLP1 ;LOOP FOR 5 CHARS/WORD SOJA P1,RCLP0 ;THEN DECR THE WORD PNTR PNTABL: POINT 7,(P1),6 POINT 7,(P1),13 POINT 7,(P1),20 POINT 7,(P1),27 POINT 7,(P1),34 ; ;HERE WE MUST DIVERT THE POINTER TO THE PREVIOUS BLOCK ;AND RESET THE CHAR COUNT BEGBUF: PUSHJ P,PRVBUF ;GET PREVIOUS BLOCK JRST AFTPRV ;NON-SKIP MEANS WE'RE OK MOVEI T2,4 ;RIGHT JUSTIFY THE INDEX, BECAUSE POPJ P, ;OTHERWISE WE'RE AT FILE START PRVBUF: MOVE T1,BLKN(D) ;GET CURRENT BLOCK # SOJLE T1,%POPJ1 ;CAN'T GO BACKWARDS MOVEM T1,BLKN(D) ;SAVE IT BACK PUSHJ P,REDBLK ;READ THE BLOCK MOVEI P2,(T1) ;RETURN THE WORD COUNT OF THE BUFFER HRRZ P1,IPTR(D) ;GET THE WORD PNTR MOVE T3,ICNT(D) ;AND THE COUNT POPJ P, REDBLK: LOAD T2,INDX(D) ;GET DEVICE INDEX CAIE T2,DI.MTA ;MAGTAPE? JRST DSKRED ;NO. DISK PUSHJ P,CLRBCB ;COUNT ACTIVES PUSH P,P4 ;Get a spare perm ac MOVEI P4,1(T1) ;Must back over current one too MTABLP: MOVEI T2,.TFBSB ;SETUP FOR BACKSPACE PUSHJ P,DOMTOP ;DO IT SOJG P4,MTABLP ;BACKSPACE FOR ALL ACTIVES POP P,P4 ;Restore P4 JRST GOREAD ;GO READ THE BLOCK DSKRED: PUSHJ P,USET ;POINT TO PREVIOUS BLOCK PUSHJ P,CLRBCB ;CLEAR THE USE BITS GOREAD: MOVSI T1,(BF.VBR) ;TURN ON VIRGIN BUFFER RING IORM T1,IBCB(D) ;IN THE BUFFER HEADER MOVE T2,CHAN(D) ;GET CHANNEL HRRI T2,.FOINP ;SETUP FOR INPUT HRRZ T3,IBCB(D) ;POINT TO CURRENT BUFFER MOVE T1,[2,,T2] ;2-WORD FILOP FILOP. T1, $ECALL IOE,%ABORT ;Should not fail with EOF MOVE T1,IBCB(D) ;GET BUFFER ADDR HRRZ T1,1(T1) ;GET WORD COUNT ADDM T1,IPTR(D) ;POINT TO END OF BUFFER SETZM ICNT(D) ;AND CLEAR COUNT POPJ P, USET: MOVE T2,FBLK(D) ;GET FILOP WORD 0 HRRI T2,.FOUSI ;GET USETI CODE MOVEI T3,(T1) ;GET THE BLOCK # MOVE T1,[2,,T2] ;DO THE USETI FILOP. T1, $ECALL IOE,%ABORT POPJ P, ;Routine to clear the "use" bits of all active buffers, and ; return how many there were in T1. %CLRBC: CLRBCB: SETZM ICNT(D) ;CLEAR BUFFER CONTROL BLOCK HRLOI T1,7700 ;EXCEPT BYTE SIZE IN PNTR ANDM T1,IPTR(D) MOVE T2,CHAN(D) ;GET CHANNEL HRRI T2,.FOWAT ;SETUP FOR WAIT MOVE T1,[1,,T2] ;DO FILOP FILOP. T1, $ECALL IOE,%ABORT SETZ T1, ;CLEAR ACTIVE BUFFER COUNT HRRZ T3,IBCB(D) ;GET PNTR TO BUFFER MOVEI T2,(T3) ;COPY IT FNDUSE: MOVE T4,-1(T3) ;GET STATUS WORD TLNE T4,40 ;TAPE EOF? AOJA T1,USEDON ;YES. WE'RE DONE MOVE T4,(T3) ;GET THE USE WORD TLZE T4,(1B0) ;TURN OFF. WAS IT ON? ADDI T1,1 ;YES. ADD TO ACTIVE COUNTER MOVEM T4,(T3) ;PUT IT BACK HRRZ T3,(T3) ;GET WHAT IT POINTS TO CAIN T2,(T3) ;POINTING TO CURRENT BUFFER? POPJ P, ;YES. WE'VE DONE IT JRST FNDUSE ;AND TRY AGAIN USEDON: HRLOI T4,377777 ;TURN OFF USE BIT JUST IN CASE ANDM T4,(T3) POPJ P, ;UNLOAD MOPUNL: MOVEI T1,1 ;SET NEXT RECORD TO 1 MOVEM T1,NREC(U) SETZM BLKN(D) ;CLEAR BLOCK # MOVX T0,D%END ;File is now not at end ANDCAM T0,FLAGS(D) LOAD T1,DVTYP(D) ;GET DEVICE TYPE CAIN T1,.TYDTA ;DECTAPE? JRST DTAUNL ;YES CAIN T1,.TYDSK ;DISK JRST DSKUNL CAIN T1,.TYMTA ;Or magtape JRST MTAUNL POPJ P, ;OTHERWISE IT'S A NOP DSKUNL: SKIPN FBLK(D) ;IS FILE REALLY OPEN? POPJ P, ;No, no-op. PJRST CLSOPN ;Close file, leave OPEN for input. MTAUNL: SKIPN FBLK(D) ;Is file really OPEN? JRST ULDEVO ;No, just UNLOAD. PUSHJ P,CLSOPN ;Close file, leav OPEN for input. MOVEI T2,.TFUNL ;Setup for UNLOAD JRST DOMTOP ;Go do it DTAUNL: MOVE T1,FLAGS(D) ;Get DDB flags TXNN T1,D%IN+D%OUT ;Is the DECTAPE open? JRST ULDEVO ;Yes, don't use filename PUSHJ P,%SETIN ;Open the dectape MOVE T2,CHAN(D) ;LH= chann # HRRI T2,.FOMTP ;MTAPE FILOP MOVX T3,MTUNL. ;UNLOAD MOVE T1,[2,,T2] FILOP. T1, $ECALL IOE,%ABORT POPJ P, ;Here to UNLOAD a DECtape or magtape that is not opened yet. ; Can't use FILOP.'s because you need a filename for them. ULDEVO: PUSHJ P,OPDEVO ;Open the device only MOVE T1,ASCHN ;Get channel # LSH T1,^D23 ;Shift to ac field IOR T1,[MTUNL.] ;Make instruction XCT T1 ;** UNLOAD the device ** PJRST CLDEVO ;Close device and return ;TOPS-10 BACKFILE MOPBSF: LOAD T1,INDX(D) ;GET DEVICE INDEX CAIE T1,DI.MTA ;MAGTAPE? POPJ P, ;OTHERWISE IT'S A NOP MOVEI T1,1 ;SET NEXT RECORD TO 1 MOVEM T1,NREC(U) SETZM BLKN(D) ;CLEAR BLOCK # MOVE T0,FLAGS(D) TXNE T0,D%END+D%OUT ;EOF OR DOING OUTPUT? PUSHJ P,CLREOF ;YES. CLOSE/OPEN THE FILE MOVE T0,FLAGS(D) TXNE T0,D%IN+D%OUT ;Is file not open? PJRST DOBKFU ;OPEN already, just do the UUO's and return. ;The MTA is not open. PUSHJ P,OPDEVO ;OPEN the device PUSHJ P,DOBKFU ;Do the BACKFILE UUO's. PJRST CLDEVO ;Close device and return. ;Subroutine to do the UUO's necessary for BACKFILE. ;The device is OPEN. DOBKFU: PUSHJ P,BACKF ;NOW BACKSPACE OVER 2 EOF MARKS PUSHJ P,BACKF MOVEI T2,.TFSTS ;GET STATUS OF TAPE UNIT PUSHJ P,DOMTOP TXNE T1,TF.BOT ;BEG TAPE? POPJ P, ;YES. JUST LEAVE MOVEI T2,.TFFSF ;NO. MUST FORWARD AGAIN PJRST DOMTOP ;TOPS-10 ENDFILE MOPEND: AOS NREC(D) ;INCR REC # PUSHJ P,%SETOUT ;Get file opened for output LOAD T1,INDX(D) ;GET DEVICE INDEX CAIE T1,DI.DSK ;DISK CAIN T1,DI.MTA ;OR MTA JRST .+2 ;YES POPJ P, ;NO. END FILE IS NOP PUSHJ P,CLSOPN ;CLOSE, THEN OPEN FOR INPUT MOVX T0,D%END ;Set fake end if necessary IORM T0,FLAGS(D) AOS BLKN(D) ;SIMULATE READING THE EOF RECORD POPJ P, ;TOPS-10 SKIP RECORD MOPSKR: PUSHJ P,%SETIN ;Set file open for input LOAD T1,MODE(D) CAIN T1,MD.DMP ;DUMP MODE? JRST SKRDMP ;YES. VERY SPECIAL MOVE T0,FLAGS(D) TXNE T0,D%UNF ;UNFORMATTED? JRST UNFSKP ;YES. DO UNFORMATTED SKIP JRST %IREC ;TO SKIP RECORD, JUST READ AND IGNORE SKRDMP: AOS T3,BLKN(D) ;GET THE INCREMENTED BLOCK # ADDI T3,1 ;WANT THE NEXT ONE LOAD T1,INDX(D) ;GET DEVICE INDEX CAIE T1,DI.DSK ;DISK? JRST %SKIPB ;NO. SKIP AN MTA BLOCK MOVE T2,FBLK(D) ;GET FILOP WORD 0 HRRI T2,.FOUSO ;GET USETO CODE MOVE T1,[2,,T2] ;DO THE USETI FILOP. T1, PUSHJ P,%CLSER ;JUST RETURN ON EOF POPJ P, ;TOPS-10 SKIP FILE MOPSKF: LOAD T1,INDX(D) ;GET DEVICE INDEX CAIE T1,DI.MTA ;MAGTAPE? POPJ P, ;NO. SKF IS NOP MOVEI T1,1 ;SET NEXT RECORD TO 1 MOVEM T1,NREC(U) SETZM BLKN(D) ;CLEAR BLOCK # MOVE T0,FLAGS(D) TXNN T0,D%OUT ;WERE WE DOING OUTPUT? JRST SKFIN ;NO PUSHJ P,%SETIN ;Yes. Close file, open again JRST SKFCOM ;File not opened for output. SKFIN: MOVE T1,FLAGS(D) TXNE T1,D%IN ;Is file OPEN? JRST SKFINN ;Yes PUSHJ P,OPDEVO ;OPEN device MOVEI T2,.TFFSF ;Skip a file PUSHJ P,DOMTOP PJRST CLDEVO ;Close again, and return. SKFINN: PUSHJ P,CLREOF ;Clear EOF for input file SKFCOM: MOVEI T2,.TFFSF ;SKIP A FILE JRST DOMTOP %SKIPB: MOVEI T2,.TFFSB ;SKIP A BLOCK PJRST DOMTOP %BACKB: MOVEI T2,.TFBSB ;BACKSPACE BLOCK PJRST DOMTOP BACKF: MOVEI T2,.TFBSF ;BACKSPACE FILE ;DOMTOP - DOES MAGTAPE OP, RETURNS FLAGS IN T1 DOMTOP: MOVE T3,DEV(D) ;GET DEVICE NAME MOVE T1,[2,,T2] ;DO TAPOP TAPOP. T1, $ECALL UTE,%ABORT ;?Unexpected TAPOP error $O, MOVEI T2,.TFWAT ;THEN A WAIT MOVE T4,[2,,T2] TAPOP. T4, $ECALL UTE,%ABORT POPJ P, CHKEF: MOVE T1,DEV(D) ;GET THE DEVICE NAME MOVEM T1,MTCBLK ;SETUP FOR MTCHR MOVE T1,[MTCLEN,,MTCBLK] MTCHR. T1, ;GET CHARACTERISTICS ; IOERR (UME,,,?,Unexpected MTCHR error $O,,%ABORT) $ECALL UME,%ABORT SKIPE MTCBLK+.MTREC ;ANY RECS AFTER LAST EOF? AOS (P) ;YES. NOT AT EOF THEN. SKIP RETURN POPJ P, ;Clear EOF by CLOSE'ing and re-OPENing the file. ;If it was opened for output, leave it that way. ; If it was opened for input, leave it that way. CLREOF: MOVE T2,FBLK(D) ;GET THE CHANNEL STUFF HRRI T2,.FOREL ;CLOSE THE FILE MOVE T1,[1,,T2] FILOP. T1, PUSHJ P,%CLSER MOVSI T1,(FO.PRV+FO.ASC) HLLM T1,FBLK(D) ;AND NOW REOPEN IT MOVX T5,D%IN ;Get flag to set MOVE T0,FLAGS(D) ;Get current DDB flags TXNE T0,D%OUT ;If file is now OPEN for output, MOVX T5,D%OUT ;Leave it that way TXZ T0,D%IN+D%OUT+D%END ;Clear current flags MOVEM T0,FLAGS(D) ;Store new DDB flags PUSH P,T5 ;Save flags PUSHJ P,%ST10B ;Setup .FOBRH, .FONBF POP P,T5 ;Restore flags to set on OPEN PUSHJ P,%CALOF ;Try re-opening the file JRST %ABORT ;?Failed POPJ P, ;Worked, return SEGMENT DATA BSRCNT: BLOCK 1 ;# WORDS FOR BACKSPACE DMPLST: BLOCK MAXARG+1 ;DUMP I/O LIST BLOCK 1 ;THE ZERO WORD (JUST IN CASE) MTCLEN==20 MTCBLK: BLOCK MTCLEN SEGMENT CODE ;Routine to CLOSE and then re-OPEN a file for input. ;This will have the effect of clearing the EOF status if set. CLSOPN: MOVE T1,FLAGS(D) ;GET FLAGS TXNE T1,D%OUT ;FILE OPEN FOR OUTPUT? PUSHJ P,%LSTBF ;YES. OUTPUT LAST BUFFER IF MTA MOVE T2,FBLK(D) ;GET CHANNEL STUFF HRRI T2,.FOCLS ;CLOSE THE FILE MOVE T1,[1,,T2] FILOP. T1, PUSHJ P,%CLSER MOVE T2,FBLK(D) HRRI T2,.FOREL ;RELEASE THE CHANNEL MOVE T1,[1,,T2] FILOP. T1, PUSHJ P,%CLSER MOVE T1,[FO.PRV+FO.ASC+.FORED] ;OPEN IT FOR INPUT MOVEM T1,FBLK(D) SETZM LKPB+.RBALC(D) ;PREVENT TRUNCATION MOVX T0,D%END+D%IO+D%OUT ANDCAM T0,FLAGS(D) ;Clear flags MOVX T5,D%IN ;Set this flag if OPEN works PUSHJ P,%ST10B ;Setup .FOBRH, .FONBF MOVX T5,D%IN ;Get flag again PUSHJ P,%CALOF ;Try re-opening the file JRST %ABORT ;Failed POPJ P, ;Done, return > ;IF10 SUBTTL FIND ;FIND STATEMENT ; ;POSITIONS A RANDOM-ACCESS DISK FILE SO THAT SUBSEQUENT I/O WILL TAKE LESS TIME ;IF SUFFICIENT COMPUTATION INTERVENES BETWEEN