SEARCH MTHPRM,FORPRM TV FORIO I/O ROUTINES,10(4161) ;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1985 ;ALL RIGHTS RESERVED. ; ;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. 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. ***** Begin Version 6A ***** 2042 TGS 2-FEB-82 20-17208 Change NREC(D) to NREC(U) at RNRER1, MOPEND (inside IF20 conditional), and MOPEND (inside IF10 conditional) end-of-file routines so record counts are correctly incremented/decremented. Note: this was really done here by JLC during rework. ***** Begin Version 7 ***** 3003 JLC 26-Oct-81 Add error msg for character I/O to unformatted file - not supported yet. 3012 JLC 4-Nov-81 Rework FOROTS call arg copier. No more LTYPE. Small extended addressing change in SMAP - get extended address for page reference. 3014 JLC 5-Nov-81 Fixed more bugs in SLIST. 3035 JLC 5-Feb-82 Rework of binary I/O with characters. 3036 BL 10-Feb-82 Inserted %OMBYT, routine to put out character strings. 3037 JLC 11-Feb-82 Fixed dump mode I/O. Made all errors on magtape fatal. 3041 JLC 11-Feb-82 Fixed character/binary I/O word-alignment bit-clearing; table was set up wrong (missing commas). 3042 JLC 12-Feb-82 Fix ordinary binary I/O, broken by char/binary patch. Was calling UOALIN with pntr/count=0, which set 010700 lh in bp. 3043 JLC 18-Feb-82 Fix internal files. Was getting address of descriptor for length (left out @), then stored wrong AC anyway. 3056 JLC 23-Mar-82 Catch I/O within I/O. Give warning for attempt to write too much data in binary or image files with fixed-length records. Fix TTY EOF for multi-line input. 3104 JLC 8-Apr-82 IALIGN had IDIV/IMUL backwards. 3105 JLC 9-Apr-82 Fix dump-mode I/O to return properly via %SETAV. 3113 JLC 22-Apr-82 Fix IWORD so it never calls ONXTW with a non-zero byte count. 3122 JLC 28-May-82 Moved place where %UDBAD was getting set up. Changed some global refs. Moved POSEFL into FORIO. 3125 JLC 3-Jun-82 Moved AC save routine back to hiseg again. 3136 JLC 26-Jun-82 Extensive rework of record output for improved performance. 3140 JLC 2-Jul-82 Fix IMAP for -10 and -20 - EOF return was changed to non-skip. Fix %OMBYT so it doesn't try to MOVSLJ with 0 or negative byte counts. 3141 JLC 2-Jul-82 Code at end of %EOREC was not restoring things properly. Fix ^Z in -20 code, was not appearing on its own line. Remove two-direction code from IRSET, move it to TIREC. 3150 JLC 12-Jul-82 Fix input of fixed-length random records so it checks for record not written. Moved code that checks for EOF - it would not detect a second occurrence for fixed-length record files. Save P1 and P2 in sequential and random window routines. Fix -10 random write bug, was comparing something to EOFN with CAIG. 3152 JLC 14-Jul-82 Reload P1/P2 in multiple places after calls to IMAP. 3153 JLC 20-Jul-82 Fixed -10 problem caused by new EOF handling of RANDOM files. 3157 BL 9-Aug-82 Fix backspace bug. When backspacing to beginning of binary sequential file, if the desired record was entirely within the previous window, UNFBSR attempted to PMAP the previous BUFCNT pages, whether or not they were in fact real pages within the file. 3161 JLC 16-Aug-82 Fixed some extended addressing bugs for ENCODE/DECODE by adjusting the byte pointer separately rather than relying on the updated one provided by MOVSLJ, which ends up being 2-word on the KL. Installed V7 version of TSG patch for record numbers bigger than a half-word. Coded around microcode bug with MOVSLJ and padding with 0 byte count. Fixed %IBYTC so it doesn't do LDB on null record. Flush buffer for TOSTR on -10. 3165 JLC 28-Aug-82 Recode part of random I/O handling so it can process files larger than 256K blocks long. 3166 JLC 31-Aug-82 Eliminate multiply-defined symbol CHKEOL in -10 code. 3167 JLC 31-Aug-82 Removed %SPEOL, as it accomplished nothing. 3170 AHM 1-Sep-82 Fix bug in edit 3165. Remove index field from reference to WPAGE at RECTPG to avoid ?Illegal memory READs in section 1. Module: FORIO 3171 JLC 1-Sep-82 Fix random I/O on the -10, wrong AC used (typo). 3172 JLC 2-Sep-82 Fix random I/O on the -10. CLRPAG was clearing the ACs instead of the proper pages. 3173 JLC 3-Sep-82 Another fix to -10 random I/O, was not calculating when to truncate block correctly, was not saving .RBSIZ when it should have been. 3174 JLC 4-Sep-82 Fix TTY input on the -10, checked the wrong char for EOL, did not do record expansion correctly. 3200 JLC 24-Sep-82 Store LSN for variable-length records. Fix -20 TTY input of large records. Use BPW calcs rather than assuming 1200 bytes/block on the -10. 3201 JLC 4-Oct-82 Move unit range check to before I/O within I/O check. 3202 JLC 26-Oct-82 Fix many bugs, and provide basic support for ANSI (8-bit) tapes for TOPS-20, since most of the work is done by the monitor. Install new code to read and backspace fixed- length, non-word-aligned records. 3203 JLC 31-Oct-82 Fix SPCWD problem. 3212 JLC 11-Nov-82 Update and consolidate -20 magtape code so that B36FLG(D) controls whether formatted or unformatted I/O is done. Fix unformatted I/O routines for mixed-mode files. Fix CCOC handling logic - only change CCOC words when we are about to do TTY output, then restore them to just previous to the output. 3213 JLC 12-Nov-82 More consolidation, minor bug fixes - OWORD was assuming T1 was preserved, and it wasn't. 3215 JLC 15-Nov-82 Fix magtape bugs, typos in FORIO and FOROPN. 3221 JLC 18-Nov-82 Fix magtape bugs. 3222 JLC 19-Nov-82 Fix more magtape bugs, plus binary backspace on the -10. 3223 JLC 22-Nov-82 Fix more backspace bugs, EOFN for error output. 3225 JLC 24-Nov-82 Fix yet more magtape bugs (namely, characters left at the end of the last word needed to be cleared). Type nulls as nulls, since they are more likely to appear more in V7. 3226 JLC 29-Nov-82 Make BZ the default for ENCODE/DECODE and internal files. 3231 JLC 14-Dec-82 Change error message for illegal length internal files to a valid error, since they can be user-initiated. For READ, simumulate TOPS-10 EXEC handling of - output a CRLF, and treat it as an EOL character. 3237 JLC 18-Dec-82 Fixed yet another bug in ENFILL. 3240 JLC 20-Dec-82 Removed ENFILL, caused too many bugs and could not work in extended addressing. 3247 RJD 7-Jan-83 Add ERJMPs after PMAP calls used to set up the file windows for sequential and random files. 3250 JLC 7-Jan-83 Fix TOREC, was changing CCOC words and not changing them back if nothing in record. 3251 JLC 9-Jan-83 In edit 3250, check ORCNT, not IRCNT. 3252 JLC 12-Jan-83 Insert FORPRG macro call, to purge MONSYM-created global symbols which don't have "%" or ".". ***** End V7 Development ***** 3270 JLC 11-Feb-83 When executing DIVERT code, check the character count before writing a message string to enusre that nulls are not output. 3341 TGS 16-Aug-83 SPR:10-34074 Internal file READ/WRITE errors erroneously reference a bogus current unit number. IFI and IFO should store the internal unit number in %CUNIT for possible error processing. 3343 RJD 17-Aug-83 SPR:10-30961 Error bit not being cleared after a READ ERROR has been detected with a card reader which results in the ERR= branch being taken for all subsequent reads. 3346 JLC 30-Aug-83 SPR:20-19447 FOROTS attempted to read the character after the 5-digit line number and got the 1st character of data instead. 3401 RJD 16-Jan-84 SPR:20-19862 When writing records which consist only of a CRLF and using CARRIAGECONTROL='FORTRAN', be sure the EOFN is updated for each CRLF record. ***** Begin Version 10 ***** 4000 JLC 22-Feb-82 Enhance performance of all I/O some more. 4004 JLC 24-Feb-83 Fix some bugs in the above enhancements. 4005 JLC 28-Feb-83 More code enhancements. 4010 JLC 19-Apr-83 Some performance enhancements, plus hooks for fast FLOUT. 4014 JLC 14-Jun-83 CC='TRANSLATED' instead of CC='FORTRAN'. Implement image-mode TTY. Implement much of proper tape handling. 4016 JLC 22-Jun-83 Fixed image mode to TTY to be consistent - now does word I/O for numeric variables regardless of how TTY is opened. 4023 JLC 29-Jun-83 Fix some new magtape code. Add new routine OMBWP, to output multiple bytes with a specified fill character and possibly different source and destination sizes. 4036 JLC 3-Aug-83 Allow binary (image) I/O to ASCII-only devices. Allow user "fixup" of asterisk output for field width too small by providing a pointer to the FOROTS record buffer. 4044 JLC 27-Sep-83 Install a skeleton for RMS I/O. Fix a bug in %GOPTR, part of output field width overflow for extended addressing. 4052 JLC 12-Oct-83 Fix magtape rewind, was clearing OCNT/OPTR, so data did not get written by OSWTCH. Minor performance enhancements. 4053 JLC 18-Oct-83 Fix CC=FORTRAN for non-stream files, was not changing carriage-control character of next line for dollar format. 4054 JLC 25-Oct-83 Code movement for RMS was no good. Move it back. Store U.RERD only after successful %IREC call. 4055 JLC 27-Oct-83 Fix image-mode I/O for odd-size magtape blocks. Code previously assumed (and forced) word-aligned blocks. 4056 JLC 30-Oct-83 Fix CC='NONE', was getting ignored. For STREAM files, now suppresses normal CRLF record terminator, simulating its effect on RMS files. 4060 JLC 2-Nov-83 Fix magtape code, was not setting label type for REWIND. SKIPFILE for unopened units. 4061 JLC 4-Nov-83 Fix IOSTAT bug, set %ERIOS instead of IOSTAT variable, set IOSTAT variable in %SETAV at end of I/O. 4063 JLC 8-Nov-83 Fix OWG bug in returning "fixed-up" record pointer. 4064 JLC 14-Nov-83 Fix IOSTAT processing. Modify names for new RMS keyword locations. 4065 JLC 6-Dec-83 Prepare for RMS. Cleanup backspace code. 4066 JLC 11-Jan-84 More cleanup of magtape code. More preparation for RMS interface. 4067 JLC 13-Jan-84 Fix SKIP RECORD bug. 4070 JLC 16-Jan-84 Clear D%STCR in CHKDOL, so that it is not sticky across records. Fix CCNON, which had misplaced code. Fix random I/O, which by a typo had an infinite loop. 4100 MRB 9-Feb-84 Added code to do compatibility flagging in FOROTS. Outputs a warning message for usage of non compatible language features like Carriage control characters & Trailing spaces at end of rec. 4102 JLC 17-Feb-83 TOPS-10 image mode I/O code. 4104 JLC 22-Feb-84 Slight mods to compatibility flagging code. Catch TTY output incompatibilities. 4105 JLC 28-Feb-84 Modify the calling sequence for error calls. 4111 JLC 16-Mar-84 Modify the calling sequence for error calls again. 4115 JLC 2-Apr-84 Fix disk and magtape code for TOPS-10. 4116 JLC 4-Apr-84 More fixes for TOPS-10. Fix common ENDFILE code. 4122 JLC 2-May-84 A whole raft of changes to make the TOPS-10 and TOPS-20 DDB databases the same. 4124 JLC 8-May-84 Fix IOARG to calculate effective address of "delayed" args (ERR=, END=, IOSTAT=) immediately, as their pointers can reside in the copied arg block with /EXTEND. 4125 JLC 11-May-84 Remove a subroutine CHKEF which is never called. 4127 JLC 15-May-84 Fix TOPS-10 mapping code. 4131 JLC 12-Jun-84 Modify %GTBLK, %MVBLK, %GTSPC, and %MVSPC calls to have a memory full non-skip return. Check only right half of IPTR to see if I/O has been done, since TOPS-10 puts stuff in the left half. If there is an error on a DIVERTed unit, type it on the TTY, avoiding really recursive errors. 4132 JLC 15-Jun-84 Added entries in the IOLST processor for "new-style" SLISTs and ELISTs which have their increments in words and characters rather than in "entries". 4136 MRB 11-Jul-84 Fix GETDEL to handle RCW's for magtape correctly. FORIO.MAC 4140 JLC 24-Jul-84 Fix ELISTs and SLISTs so they get the right increment for the right situation. 4141 JLC 3-Aug-84 Fix magtape code for TOPS-10. 4144 JLC 29-Aug-84 Fix magtapes again, this time for null file at BOT. 4150 JLC 13-Sep-84 Fix magtape append code yet again, since edit 4144 broke it for the normal append case. 4151 MRB 19-Sep-84 Magtape stuff, added BSRDEL & BSRLAB, and modified COMBSR. 4156 JLC 23-Oct-84 Fix %EOREC to save and set %UDBAD so that error messages deriving from errors writing to the DIVERT unit will be reported correctly. Separate disk and magtape backspace. Fix unformatted I/O to TTY for the -10. 4160 MRB 25-Oct-84 Disallow an unformatted, image device to do backspaces or skip records. (Give an error message.) 4161 JLC 1-Nov-84 Change ASCFLG to IMGFLG, indicating that the device in question is an image-mode device which cannot have LSCWs. This will then include the ASCII-only devices. Remove all tests of MODE(D)=MD.IMG, since this test is not general enough; instead just check IMGFLG. ***** End V10 Development ***** ***** End Revision History ***** \ INTERN %IBYTE,%OBYTE,%IBYTC,%OMBYT,%OMSPC,%IMBYT,%CBDO,%OMPAD,%OMBWP INTERN %IRECS,%OREC,%EOREC,%ORECS,%OCRLF,%GOPTR,%CDBO,%OCLR,%PTOF INTERN %IBACK,%OSMAP,%OBUF,%ISBUF,%OSDSK,%SMAPW INTERN %SETAV,%OFIN,%RTMSK,%CUNIT INTERN %RIPOS,%SIPOS,%ROPOS,%SOPOS,%CIPOS,%COPOS INTERN %MTFSF,%MTBSB,%MTEOF,%MTBSA IF10,< INTERN %RANWR > EXTERN %FLIDX EXTERN %UDBAD,%MSPAD,%MSLJ,%NAMLN,%ERIOS,%EOPTR,%EOCNT EXTERN %POPJ,%POPJ1,%SAVE1,%SAVE2,%SAVE3,%SAVE4,%CPARG,%SAVAC,%SAVIO EXTERN %PUSHT,%POPT,%JPOPT EXTERN %IFSET,%OFSET,%IFORM,%OFORM,%LDI,%LDO,%NLI,%NLO,%LDIST,%LDOST EXTERN %IOERR,%IONAM,%FSECT EXTERN %SETIN,%SETOUT,%CRLF EXTERN %GTBLK,%MVSPC,%GTSPC EXTERN %ISAVE,%SIZTB,%HIINT,%LOINT,%DDBTA,%CLSOP,%MTPRM EXTERN %EDDB,U.RERD,U.ERR,D.TTY,U.TTY,G.PRP IF20,< EXTERN %OCCOC,%OCLIT,%CCMSK,%MTPRM,%LABCK > EXTERN %OPENX,%LSTBF,%OWGBT EXTERN %UNNAM EXTERN IO.ADR,IO.NUM,IO.SIZ,IO.INC,IO.TYP,IO.INS EXTERN %ALCHF,%DECHF EXTERN %IRMS,%ORMS,%RMREW,%RMBSR,%RMEND EXTERN %RMRDW,%RMSIN,%RMSOU,%RMSKR,%RMSTR SEGMENT CODE SUBTTL I/O SETUP ;Formatted read -- READ (u,f) FENTRY (IN) PUSHJ P,%SAVAC ;SAVE ACS PUSHJ P,%CPARG ;AND COPY ARGS PUSHJ P,FMTCNV ;CONVERT ARG LIST PUSHJ P,FINGO ;GO DO I/O SETUP LDB T1,[POINTR A.FMT,ARGTYP] ;GET FORMAT TYPE JUMPN T1,%IFSET ;IF NON-ZERO, IT'S FORMATTED INPUT JRST LDI. ;ZERO. IT'S LIST-DIRECTED INPUT ;Formatted write -- WRITE (u,f) FENTRY (OUT) PUSHJ P,%SAVAC ;SAVE ACS PUSHJ P,%CPARG ;AND COPY ARGS PUSHJ P,FMTCNV ;CONVERT ARG LIST PUSHJ P,FOUTGO ;GO DO I/O SETUP LDB T1,[POINTR A.FMT,ARGTYP] ;GET FORMAT TYPE JUMPN T1,%OFSET ;IF NON-ZERO, IT'S FORMATTED OUTPUT JRST LDO. ;ZERO. IT'S LIST-DIRECTED OUTPUT ;Unformatted read FENTRY (RTB) PUSHJ P,%SAVAC ;SAVE ACS PUSHJ P,%CPARG ;AND COPY ARGS PUSHJ P,UNFCNV ;CONVERT ARG LIST PUSHJ P,UINGO ;GO DO I/O SETUP LOAD T1,MODE(D) ;GET MODE CAIN T1,MD.DMP ;DUMP? JRST RDUMP ;YES. GO SET IT UP LOAD T1,INDX(D) ;GET DEVICE INDEX CAIN T1,DI.TTY ;TTY? JRST UISTTY ;YES. SETUP IS SPECIAL PJRST UISET ;GO DO INITIAL SETUP ;Unformatted write FENTRY (WTB) PUSHJ P,%SAVAC ;SAVE ACS PUSHJ P,%CPARG ;AND COPY ARGS PUSHJ P,UNFCNV ;CONVERT ARG LIST PUSHJ P,UOUTGO ;GO DO I/O SETUP LOAD T1,MODE(D) ;GET MODE CAIN T1,MD.DMP ;DUMP? JRST WDUMP ;YES. GO DO DUMP OUTPUT LOAD T1,INDX(D) ;GET DEVICE INDEX CAIN T1,DI.TTY ;TTY? JRST UOSTTY ;YES. SETUP IS SPECIAL PJRST UOSET ;GO DO INITIAL SETUP ;Namelist input FENTRY (NLI) PUSHJ P,%SAVAC ;SAVE ACS PUSHJ P,%CPARG ;AND COPY ARGS PUSHJ P,NMLCNV ;CONVERT ARG LIST PUSHJ P,FINGO ;GO DO I/O SETUP PJRST %NLI ;AND DO I/O ;Namelist output FENTRY (NLO) PUSHJ P,%SAVAC ;SAVE ACS PUSHJ P,%CPARG ;AND COPY ARGS PUSHJ P,NMLCNV ;CONVERT ARG LIST PUSHJ P,FOUTGO ;GO DO I/O SETUP PJRST %NLO ;AND THE I/O ;DECODE FENTRY (DEC) PUSHJ P,%SAVAC ;SAVE ACS PUSHJ P,%CPARG ;AND COPY ARGS 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,DECUNI ;STORE "UNIT" MOVEM T1,%CUNIT ;FOR ERROR MSGS PUSHJ P,DECINI ;INIT BUFFER PNTR XMOVEI T1,DECODE ;SETUP DECODE FOR INPUT RECORDS MOVEM T1,IOREC(D) PJRST %IFSET ;GO ENCODE THE FORMAT ;ENCODE FENTRY (ENC) PUSHJ P,%SAVAC ;SAVE ACS PUSHJ P,%CPARG ;AND COPY ARGS 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,ENCUNI ;STORE "UNIT" MOVEM T1,%CUNIT ;FOR ERROR MSGS PUSHJ P,ENCINI ;Init for ENCODE XMOVEI T1,ENCODE ;SETUP FOR ENCODE FOR OUTPUT RECORDS MOVEM T1,IOREC(D) XMOVEI T1,%SETAV ;AND NOTHING MUCH FOR THE FIN CALL MOVEM T1,IOFIN(D) PJRST %OFSET ;GO ENCODE THE FORMAT FENTRY (LDI) XMOVEI T1,%LDI ;SETUP FOR IOLST CALLS MOVEM T1,IOSUB(D) XMOVEI T1,%SETAV ;SETUP FOR FIN CALL MOVEM T1,IOFIN(D) PJRST %LDIST ;DO LIST-DIRECTED INPUT SETUP FENTRY (LDO) XMOVEI T1,%LDO ;SETUP FOR IOLST CALLS MOVEM T1,IOSUB(D) XMOVEI T1,%OFIN ;SETUP FOR FIN CALL MOVEM T1,IOFIN(D) PJRST %LDOST ;DO LIST-DIRECTED OUTPUT SETUP ;INTERNAL FILE INPUT ;INTERNAL FILES ARE NOT REALLY FILES AT ALL - THEIR "RECORDS" ;ARE THE ELEMENT(S) OF A CHARACTER EXPRESSION, VARIABLE, OR ARRAY, ;GIVEN AS THE UNIT ARGUMENT IN A READ OR WRITE STATEMENT. ;THE FOLLOWING CODE SETS UP A FAKE DDB (OR USES ONE IF IT EXISTS ;ALREADY), SETS THE "DEVICE TYPE" TO INTERNAL FILE FOR %IREC ;CALLS, SETS THE FOROTS RECORD BUFFER POINTER/COUNT TO THE ;SPECIFIED CHARACTER VARIABLE OR ARRAY, AND STARTS UP FORMATTED I/O. FENTRY (IFI) PUSHJ P,%SAVAC ;SAVE ACS PUSHJ P,%CPARG ;AND COPY ARGS XMOVEI T1,[ASCIZ /READ/] 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,IFIUNI ;STORE "UNIT" MOVEM T1,%CUNIT ;[3341] FOR ERROR MSGS PUSHJ P,IFINI ;INIT BUFFER PNTR XMOVEI T1,IFIN ;SETUP FOR INTERNAL FILE FOR INPUT RECORDS MOVEM T1,IOREC(D) PJRST %IFSET ;GO ENCODE THE FORMAT ;INTERNAL FILE OUTPUT ;SAME AS INTERNAL FILE OUTPUT, BUT SETS UP FOR OUTPUT CALLS FENTRY (IFO) PUSHJ P,%SAVAC ;SAVE ACS PUSHJ P,%CPARG ;AND COPY ARGS XMOVEI T1,[ASCIZ /WRITE/] 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,IFOUNI ;STORE "UNIT" MOVEM T1,%CUNIT ;[3341] FOR ERROR MSGS PUSHJ P,IFOINI ;INIT FOR INTERNAL FILE OUTPUT XMOVEI T1,IFOUT ;SETUP FOR INTERNAL FILE FOR RECORD OUTPUT MOVEM T1,IOREC(D) XMOVEI T1,%SETAV ;AND NOTHING MUCH FOR FIN CALL MOVEM T1,IOFIN(D) PJRST %OFSET ;GO ENCODE THE FORMAT IOARG: SETZM A.UNIT ;CLEAR BLOCK SO UNSPECIFIED ARGS ARE 0 MOVE T1,[A.UNIT,,A.UNIT+1] BLT T1,IOARGS+MRWKWD HLRE T3,-1(L) ;GET NEGATIVE COUNT ARGLP: LDB T1,[POINTR ((L),RWKWD)] ;GET KWD OF ARGUMENT MOVE T2,(L) ;GET ARG MOVEM T2,IOARGS(T1) ;STORE ARG IN BLOCK ADDI L,1 ;INCR ARG PNTR AOJL T3,ARGLP ;TRANSFER ENTIRE ARG BLOCK XMOVEI T1,@A.END ;DO THE EA CALC FOR THE DELAYED ARGS MOVEM T1,A.END ;END= XMOVEI T1,@A.ERR MOVEM T1,A.ERR ;ERR= XMOVEI T1,@A.IOS MOVEM T1,A.IOS ;IOSTAT= POPJ P, ;DONE SEGMENT DATA ;COPIED ARGS, MUST BE CONSECUTIVE, IN ORDER ON KEYWORD NUMBER (IK.XXX) IOARGS: BLOCK 1 ;ZERO KEYWORD - SKIPPED ARG A.UNIT: BLOCK 1 ;UNIT= [ADDRESS OF VALUE] A.FMT:: BLOCK 1 ;FMT= [ADDRESS] A.FMS:: BLOCK 1 ;FORMAT SIZE [ADDRESS OF 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 ;REL OP OR MTA OP CODE [ADDRESS OF VALUE] A.HSA:: BLOCK 1 ;ENCODE/DECODE ARRAY ADDRESS [ADDRESS] A.HSL:: BLOCK 1 ;ENCODE/DECODE RECORD LENGTH [ADDRESS OF VALUE] A.KVL: BLOCK 1 ;KEY VALUE [ADDRESS OF VALUE] A.KID: BLOCK 1 ;KEY ID [ADDRESS OF VALUE] BLOCK 2 ;MORE ROOM IN RWKWD IF NEEDED MRWKWD==.-IOARGS-1 ;MAX LEGAL READ/WRITE ARG KWD NUMBER IFN <B8-RWKWD>, SEGMENT CODE FOUTGO: XMOVEI T1,[ASCIZ /WRITE/] ;Set statement name MOVEM T1,%IONAM PUSHJ P,IOARG ;MOVE ARGS TO A.XXX PUSHJ P,CHKUNT ;Check unit number in range PUSHJ P,SETFRM ;SET MODE TO ASCII IF ZERO PUSHJ P,%SETOUT ;Get file opened for output. XMOVEI T1,%OFIN ;AND SET OUTPUT OF FINAL RECORD MOVEM T1,IOFIN(D) ;FOR FIN CALL XMOVEI T1,%ORECS ;USE EXTERNAL I/O FOR RECORD OUTPUT MOVEM T1,IOREC(D) SKIPN ORBUF(D) ;ANY RECORD BUFFER YET? PUSHJ P,GETORB ;NO. CREATE ONE PUSHJ P,ORINI ;INIT OUTPUT RECORD SKIPE WTAB(D) ;RANDOM I/O? JRST FORMPW ;YES. MAP THE DESIRED RECORD SKIPN A.REC ;NO. ILLEGAL IF RECORD NUMBER GIVEN POPJ P, $ACALL CDR ;REPORT RANDOM I/O TO SEQ FILE UOUTGO: XMOVEI T1,[ASCIZ /WRITE/] ;Set statement name MOVEM T1,%IONAM PUSHJ P,IOARG ;MOVE ARGS TO A.XXX PUSHJ P,CHKUNT ;Check unit number in range ; (Goes to ABORT% or ERR= if not). PUSHJ P,SETUNF ;SET MODE TO BINARY IF ZERO PUSHJ P,%SETOUT ;Get file opened for output. SKIPE WTAB(D) ;RANDOM I/O? PJRST UORMPW ;YES. MAP THE DESIRED RECORD SKIPN A.REC ;ILLEGAL IF RECORD NUMBER SPECIFIED POPJ P, $ACALL CDR ;REPORT RANDOM I/O TO SEQ FILE FINGO: XMOVEI T1,[ASCIZ /READ/] MOVEM T1,%IONAM PUSHJ P,IOARG ;MOVE ARGS TO A.XXX PUSHJ P,CHKUNT ;Check unit number in range MOVE T1,%CUNIT ;GET UNIT # CAME T1,[RRUNIT] ;REREAD? JRST INGO1 ;No MOVE T1,U.RERD ;GET REREAD UNIT CAMN T1,[RRUNIT] ;IS THERE ONE? $ACALL RBR ;NO. ?REREAD not preceded by READ MOVEM T1,%CUNIT ;YES. USE IT MOVE U,%DDBTA(T1) ;GET UDB ADDR MOVEM U,%UDBAD ;WE HAVE STARTED AN I/O STATEMENT MOVE D,DDBAD(U) ;GET DDB ADDR PUSHJ P,%SETIN ;Get file opened for input. XMOVEI T1,%IRECS ;USE EXTERNAL I/O FOR INPUT RECORDS MOVEM T1,IOREC(D) PJRST REREAD ;YES. POINT TO LAST RECORD INGO1: PUSHJ P,SETFRM ;SET MODE TO ASCII IF ZERO PUSHJ P,%SETIN ;Get file opened for input XMOVEI T1,%IRECS ;USE EXTERNAL I/O FOR INPUT RECORDS MOVEM T1,IOREC(D) SKIPE WTAB(D) ;RANDOM I/O? JRST CHKRAN ;YES. GO MAP THE RECORD SKIPN A.REC ;ILLEGAL IF ANY RECORD NUMBER GIVEN JRST INSEQ ;OK. GO READ A RECORD $ACALL CDR ;REPORT RANDOM I/O TO SEQ FILE CHKRAN: PUSHJ P,FIRMPW ;MAP THE DESIRED RECORD INSEQ: PUSHJ P,%IREC ;GO READ A RECORD MOVE T1,%CUNIT ;SAVE UNIT NUMBER FOR REREAD MOVEM T1,U.RERD POPJ P, UINGO: XMOVEI T1,[ASCIZ /READ/] MOVEM T1,%IONAM PUSHJ P,IOARG ;MOVE ARGS TO A.XXX PUSHJ P,CHKUNT ;Check unit number in range ; (Goes to ABORT% or ERR= if not). PUSHJ P,SETUNF ;SET MODE TO BINARY IF ZERO PUSHJ P,%SETIN ;Get file opened for input. SKIPE WTAB(D) ;RANDOM I/O? JRST UIRMPW ;YES. MAP THE DESIRED RECORD SKIPN A.REC ;ILLEGAL IF RECORD NUMBER GIVEN POPJ P, $ACALL CDR ;REPORT RANDOM I/O TO SEQ FILE ;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 MOVEM T2,%CUNIT ;SAVE AS CURRENT UNIT JUMPL T2,NEGUNT ;GO CHECK IF NEGATIVE CAILE T2,MAXUNIT ;IF UNIT BEYOND RANGE OF DDBTAB $ACALL IUN ;ILLEGAL UNIT NUMBER POPJ P, ;OK NEGUNT: CAMGE T2,[MINUNIT] ;RANGE CHECK. BELOW NEGATIVE UNITS $ACALL IUN ;ILLEGAL UNIT NUMBER HRRZ T3,%UNNAM(T2) ;NEGATIVE, GET THE REAL NAME XMOVEI T3,(T3) ;GET EXTENDED ADDR MOVEM T3,%IONAM ;SAVE IT POPJ P, ;Ok, return ;HERE FROM IOLST% OR FIN% WHEN I/O IS COMPLETE %OFIN:: PUSHJ P,%OREC ;OUTPUT THE RECORD %SETAV: MOVE T1,%ERIOS ;GET 2ND ERROR NUMBER OR ZERO SKIPE T2,A.IOS ;IOSTAT VARIABLE TO DEFINE? MOVEM T1,@T2 ;YES. DEFINE IT MOVE T1,%UDBAD ;[4161] GET UDB ADDRESS SETZM %UDBAD ;[4161] NOW NO I/O IN PROGRESS JUMPL T1,%POPJ ;[4161] IF IT WAS NEG, NOT A REAL UDB POINTER SKIPN T2,AVAR(D) ;IS THERE AN ASSOCIATE VARIABLE? POPJ P, ;NO MOVE T1,CREC(D) ;GET CURRENT RECORD NUMBER ADDI T1,1 ;POINT TO NEXT ONE MOVEM T1,(T2) ;There is one, store next record number POPJ P, ;DONE. RETURN TO USER PROG ;ROUTINE TO SET UP A DDB FOR ENCODE/DECODE/IFI/IFO SETDE: SKIPE U,%EDDB ;DDB ALREADY CREATED? JRST CLRDE ;YES. USE IT MOVEI T1,ULEN ;Get length of unit block PUSHJ P,%GTBLK $ACALL MFU ;[4131] CAN'T 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 $ACALL MFU ;[4131] CAN'T MOVEI D,(T1) ;POINT D TO IT MOVEM D,DDBAD(U) ;Remember it in the unit block MOVX T1,ENCUNI ;[4131] GET ENCODE UNIT NUMBER STORE T1,UNUM(U) ;[4131] SAVE IN UDB SO IT WON'T BE TOSSED MOVEI T1," " ;PAD WITH SPACES STORE T1,PADCH(U) MOVEI T1,IBPW ;GET BYTES/WORD MOVEM T1,BPW(D) ;SAVE IT IN DDB MOVE T1,[ASCII / /] ;GET A WORD OF SPACES MOVEM T1,SPCWD(D) ;SAVE IT ALSO MOVEI T1,(POINT 7,0,34) ;7-BIT BYTE POINTER STORE T1,BYTPT(D) ;SAVE IT MOVEI T1,BL.ZERO ;BZ FOR DECODE AND IFI STORE T1,BLNK(U) CLRDE: MOVEM U,%UDBAD ;FLAG WE'VE STARTED I/O MOVE D,DDBAD(U) ;GET DDB ADDR POPJ P, ;ROUTINES TO CONVERT POSITIONAL ARG BLOCKS TO KEYWORD ARG BLOCKS FMTCNV: LDB T1,[POINTR ((L),ARGKWD)] ;GET KWD FIELD OF FIRST ARG JUMPN T1,%POPJ ;NONZERO, NEW-STYLE CALL HLRE T2,-1(L) ;GET ARG COUNT CAMLE T2,[-4] ;AT LEAST 4 ARGS? JRST IOCNV1 ;NO, SKIP /FMT MOVEI T1,IK.FMT ;GET KWD NUMBER FOR /FMT DPB T1,[POINTR (3(L),ARGKWD)] ;STORE IN LOCAL ARG LIST CAMLE T2,[-5] ;AT LEAST 5 ARGS? JRST IOCNV1 ;NO, SKIP FORMAT SIZE MOVEI T1,IK.FMS ;GET KWD NUMBER FOR FORMAT SIZE DPB T1,[POINTR (4(L),ARGKWD)] ;STORE IN LOCAL ARG LIST IOCNV1: CAMLE T2,[-6] ;AT LEAST 6 ARGS? JRST IOCNV2 ;NO, SKIP /REC MOVEI T1,IK.REC ;GET KWD NUMBER FOR /REC DPB T1,[POINTR (5(L),ARGKWD)] ;STORE IN LOCAL ARG LIST IOCNV2: MOVEI T1,IK.UNIT ;GET KWD NUMBER FOR /UNIT DPB T1,[POINTR ((L),ARGKWD)] ;STORE IN LOCAL ARG LIST IOCNV3: CAMLE T2,[-2] ;AT LEAST 2 ARGS? POPJ P, ;NO, DONE MOVEI T1,IK.END ;GET KWD NUMBER FOR /END DPB T1,[POINTR (1(L),ARGKWD)] ;STORE IN LOCAL ARG LIST CAMLE T2,[-3] ;AT LEAST 3 ARGS? POPJ P, ;NO, DONE MOVEI T1,IK.ERR ;GET KWD NUMBER FOR /ERR DPB T1,[POINTR (2(L),ARGKWD)] ;STORE IN LOCAL ARG LIST POPJ P, ;DONE UNFCNV: LDB T1,[POINTR ((L),ARGKWD)] ;GET KWD FIELD OF FIRST ARG JUMPN T1,%POPJ ;NONZERO, NEW-STYLE CALL HLRE T2,-1(L) ;GET ARG COUNT JRST IOCNV1 NMLCNV: LDB T1,[POINTR ((L),ARGKWD)] ;GET KWD FIELD OF FIRST ARG JUMPN T1,%POPJ ;NONZERO, NEW-STYLE CALL HLRE T2,-1(L) ;GET ARG COUNT CAMLE T2,[-4] ;AT LEAST 4 ARGS? JRST IOCNV2 ;NO, NO NAMELIST ADDRESS MOVEI T1,IK.NML ;GET KWD NUMBER FOR NAMELIST DPB T1,[POINTR (3(L),ARGKWD)] ;STORE IN LOCAL ARG LIST JRST IOCNV2 ;GO DO STANDARD ARGS ENCCNV: LDB T1,[POINTR ((L),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 ((L),ARGKWD)] ;STORE IN LOCAL ARG LIST HLRE T2,-1(L) ;GET ARG COUNT CAMLE T2,[-4] ;AT LEAST 4 ARGS? JRST IOCNV3 ;NO, SKIP /FMT MOVEI T1,IK.FMT ;GET KWD NUMBER FOR /FMT DPB T1,[POINTR (3(L),ARGKWD)] ;STORE IN LOCAL ARG LIST CAMLE T2,[-5] ;AT LEAST 5 ARGS? JRST IOCNV3 ;NO, SKIP FORMAT SIZE MOVEI T1,IK.FMS ;GET KWD NUMBER FOR FORMAT SIZE DPB T1,[POINTR (4(L),ARGKWD)] ;STORE IN LOCAL ARG LIST CAMLE T2,[-6] ;AT LEAST 6 ARGS? JRST IOCNV3 ;NO, SKIP STRING ADDRESS MOVEI T1,IK.HSA ;GET KWD NUMBER FOR STRING ADDRESS DPB T1,[POINTR (5(L),ARGKWD)] ;STORE IN LOCAL ARG LIST JRST IOCNV3 ;GO DO STANDARD ARGS MTCNV: LDB T1,[POINTR ((L),ARGKWD)] ;GET KWD FIELD OF FIRST ARG JUMPN T1,%POPJ ;NONZERO, NEW-STYLE CALL HLRE T2,-1(L) ;GET ARG COUNT CAMLE T2,[-4] ;AT LEAST 4 ARGS? JRST IOCNV2 ;NO MOVEI T1,IK.MTOP ;GET KWD NUMBER FOR MT OP CODE DPB T1,[POINTR (3(L),ARGKWD)] ;STORE IN LOCAL ARG LIST JRST IOCNV2 ;GO CONVERT UNIT, ERR, END ;GETS A FRESH UDB AND DDB IF ONE DOESN'T ALREADY EXIST. ;IF RANDOM I/O, COMPLAINS, SINCE IT'S NECESSARY TO DO ;AN OPEN STATEMENT TO ESTABLISH RECORDSIZE. GETD: SKIPE A.REC ;TRYING TO DO RANDOM I/O? $ACALL RR1 ;YES. MUST SETUP RECORDSIZE IN OPEN! MOVEI T1,ULEN ;Get length of unit block PUSHJ P,%GTBLK ;Allocate it $ACALL MFU ;[4131] CAN'T MOVE U,T1 MOVEI T1,DLEN ;GET LENGTH OF DDB PUSHJ P,%GTBLK ;ALLOCATE IT $ACALL MFU ;[4131] CAN'T MOVE D,T1 ;SAVE IN D MOVEM T1,DDBAD(U) ;SAVE DDB ADDR MOVE T1,%CUNIT ;GET UNIT BACK STORE T1,UNUM(U) ;SAVE UNIT NUMBER PJRST %OPENX ;OPEN THE DDB SETUNF: MOVE T1,%CUNIT ;GET UNIT NUMBER SKIPN U,%DDBTA(T1) ;GET UDB ADDR PUSHJ P,GETD ;NONE. ESTABLISH A NEW ONE MOVEM U,%UDBAD ;WE HAVE STARTED AN I/O STATEMENT MOVE D,DDBAD(U) ;GET DDB ADDR LOAD T1,FORM(D) ;GET FORM= JUMPN T1,CHKUNF ;GOT ONE ALREADY MOVEI T1,MD.BIN ;BINARY IS DEFAULT FOR UNFORMATTED STORE T1,MODE(D) ;SAVE IT MOVEI T1,FM.UNF ;SET FORM='UNFORMATTED' STORE T1,FORM(D) POPJ P, CHKUNF: CAIE T1,FM.UNF ;UNFORMATTED? SETOM FUMXD(D) ;NO. SET MIXED-FORM FLAG POPJ P, SETFRM: MOVE T1,%CUNIT ;GET UNIT NUMBER SKIPN U,%DDBTA(T1) ;GET UDB ADDR PUSHJ P,GETD ;NONE. ESTABLISH A NEW ONE MOVEM U,%UDBAD ;WE HAVE STARTED AN I/O STATEMENT MOVE D,DDBAD(U) ;GET DDB ADDR LOAD T1,FORM(D) ;GET FORM= JUMPN T1,CHKFRM ;GOT ONE ALREADY MOVEI T1,MD.ASC ;DEFAULT IS ASCII STORE T1,MODE(D) ;SAVE IT MOVEI T1,FM.FORM ;SET FORM='FORMATTED' STORE T1,FORM(D) POPJ P, CHKFRM: CAIE T1,FM.FORM ;FORMATTED? SETOM FUMXD(D) ;NO. SET MIXED-FORM FLAG POPJ P, 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. %RxPOS returns the current position (column number) within a record. %SxPOS 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 per direction. Record buffer format: Input: IRBEG IRPTR v v -------------------------------------------------------------------- ! !///////////////////////////!///////////////! ! -------------------------------------------------------------------- <--- IRCNT ----> <---------------- IRLEN -------------------> <-------------------------- IRSIZ --------------------------> Output: ORBEG ORPTR v v -------------------------------------------------------------------- ! !///////////////////////////!///////////////! ! -------------------------------------------------------------------- <------------ ORCNT ------------> <---------------- ORLEN* ------------------> <-------------------------- ORSIZ --------------------------> (*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 any positioning format.) & ;ROUTINE TO READ SINGLE BYTE ;RETURN: T1 = NEXT BYTE FROM INPUT RECORD ;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: IBP IRPTR(D) ;KEEP THE PNTR IN SYNCH FOR ADJBP MOVEI T1," " ;EXTEND SHORT RECORDS WITH TRAILING SPACES POPJ P, ;RETURN ;%IMBYT - READS MULTIPLE BYTES FROM THE RECORD BUFFER ;ARGS: T0 = # CHARS TO READ, MUST BE .LE. DESTINATION SIZE ; T3 = SIZE OF DESTINATION IN BYTES ; T4 = BYTE POINTER OF DESTINATION %IMBYT: CAIN T3,1 ;ONE BYTE? JRST IMONE ;YES. DO IT WITH %IBYTE MOVE T1,T0 ;GET COUNT ADJBP T1,IRPTR(D) ;GET UPDATED BYTE POINTER EXCH T1,IRPTR(D) ;SAVE UPDATED ONE, GET OLD ONE AGAIN MOVN T2,T0 ;GET NEG COUNT OF CHARS TO READ ADDB T2,IRCNT(D) ;UPDATE RECORD BYTE COUNT JUMPGE T2,IMOK ;IF CHARS LEFT .GE. # TO READ, OK ADD T0,IRCNT(D) ;SHORTEN # BYTES WE GET BY COUNT BEYOND RECORD CAIG T0,0 ;IF COUNT IS .LE. 0 SETZB T0,T1 ;NO SOURCE IMOK: EXTEND T0,[EXP MOVSLJ," "] ;FILL WITH SPACES $SNH ;SHOULD NEVER TRUNCATE POPJ P, IMONE: PUSHJ P,%IBYTE ;GET A BYTE IDPB T1,T4 ;STORE IT POPJ P, ;%CDBO - CONVERT DECIMAL TO BINARY OFFSET ;READS CHARACTERS FROM THE RECORD BUFFER AND CONVERTS THEM TO BINARY ; ;ARGS: T0 = NUMBER OF CHARACTERS TO READ (MAX=^D21) ; ;SKIP RETURNS IF ALL CHARACTERS WERE DIGITS. ;NON-SKIP RETURNS IF A NON-DIGIT WAS ENCOUNTERED, ;RECORD POINTER/COUNT LEFT AT OFFENDING CHARACTER. ; ;RETURN: T0 = NUMBER OF CHARACTERS LEFT ; T1 = OFFENDING CHARACTER, IF NON-SKIP RETURN ; T3,T4 = 2-WORD BINARY INTEGER %CDBO: CAIE T0,1 ;ONE CHARACTER? JRST CDBONE ;YES. GO READ IT WITH %IBYTE CAILE T1,IRCNT(D) ;ENOUGH CHARS IN RECORD? JRST CDBTRC ;NO. TRUNCATE INPUT MOVE T1,T0 ;COPY THE COUNT ADJBP T1,IRPTR(D) ;GET UPDATED POINTER EXCH T1,IRPTR(D) ;STORE UPDATED POINTER, GET OLD ONE BACK MOVN T2,T0 ;GET NEGATIVE COUNT ADDM T2,IRCNT(D) ;UPDATE THE COUNT EXTEND T0,[EXP ,-60] ;CONVERT TO BINARY JRST CDBBC ;BAD CHAR. GO POINT TO IT AOS (P) ;SUCCESS. SKIP RETURN POPJ P, CDBBC: MOVE T1,T0 ;COPY LEFTOVER COUNT ADDM T1,IRCNT(D) ;MODIFY THE RECORD COUNT ADJBP T1,IRPTR(D) ;AND THE POINTER MOVEM T1,IRPTR(D) ;SAVE UPDATED POINTER LDB T1,T1 ;GET THE OFFENDING CHARACTER POPJ P, ;NON-SKIP RETURN CDBTRC: SKIPG IRCNT(D) ;ANY CHARS LEFT IN RECORD? SOJA T1,%IBYTE ;NO. JUST RETURN A SPACE SUB T0,IRCNT(D) ;GET # CHARS LEFT MOVE T5,T0 ;SAVE IT FOR LATER MOVE T0,IRCNT(D) ;USE RECORD COUNT AS INPUT COUNT SETZM IRCNT(D) ;AND SET RECORD COUNT TO ZERO MOVE T1,T0 ;COPY COUNT ADJBP T1,IRPTR(D) ;UPDATE RECORD POINTER EXCH T1,IRPTR(D) ;SVAE UPDATED ONE, GET ORIGINAL POINTER EXTEND T0,[EXP ,-60] ;CONVERT THE STRING TO BINARY PUSHJ P,CDBBC ;BAD CHARACTER. POINT TO IT ADD T0,T5 ;ADD LEFTOVER COUNT BEYOND RECORD POPJ P, ;NON-SKIP RETURN CDBONE: PUSHJ P,%IBYTE ;GET A BYTE FROM THE RECORD CAIG T1,"9" ;IS IT A DIGIT? CAIGE T1,"0" POPJ P, ;NO. NON-SKIP RETURN SUBI T1,60 ;YES. CONVERT TO BINARY SETZ T3, ;CLEAR HIGH WORD MOVE T4,T1 ;PUT IT IN THE CORRECT AC SETZ T0, ;SET COUNT TO 0 AOS (P) ;SKIP RETURN POPJ P, ;ROUTINE TO REREAD CURRENT BYTE ;RETURN: T1 = BYTE THAT IBYTE RETURNED ON MOST RECENT CALL ;DESTROYS NO ACS EXCEPT T1 %IBYTC: SKIPE IRLEN(D) ;NULL RECORD? SKIPGE IRCNT(D) ;NO. PAST RECORD END? SKIPA T1,[" "] ;YES, RETURN SPACE LDB T1,IRPTR(D) ;NO, RETURN CURRENT CHAR 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: MOVNI T1,1 ;ADJUST POINTER ADJBP T1,IRPTR(D) ;BACK 1 MOVEM T1,IRPTR(D) ;SAVE IT AOS IRCNT(D) ;INCREMENT COUNT OF CHARS LEFT POPJ P, ;ROUTINE TO PUT SINGLE BYTE IN FILE ;ARGS: T1 = BYTE ;DESTROYS NO ACS %OBYTE: LOBYTE: SETZM ORPOS(D) ;FLAG THAT WE HAVE DEPOSITED CHARS HERE 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: SKIPE RSIZE(D) ;ANY RECORDSIZE TO LIMIT RECORD? JRST TRUNC ;YES, TRUNCATE RECORD INSTEAD OF EXPANDING AOS ORCNT(D) ;NO. CLEAR -1 FROM %OBYTE PUSHJ P,%PUSHT ;SAVE T ACS MOVM T3,ORCNT(D) ;USE DISTANCE FROM RECORD AS MINIMUM PUSHJ P,EXPORB ;EXPAND RECORD BUFFER PUSHJ P,%POPT ;RESTORE T ACS JRST LOBYTE ;GO STORE BYTE IN EXPANDED BUFFER TRUNC: IBP ORPTR(D) ;KEEP POINTER IN SYNCH FOR POSITIONING MOVE T0,ORCNT(D) ;GET THE COUNT CAMN T0,[-1] ;ONLY COMPLAIN THE FIRST OVERRUN $ECALL ETL ;Attempt to WRITE beyond fixed-length record POPJ P, ;%OMBYT - ROUTINE TO PUT A STRING OF BYTES TO THE BUFFER ;ARGS: ; T0=source count ; T1/T2=source string byte-pointer ; ;RETURNS: ; ; T1/T2=byte-pointer to last byte moved ; T3/T4/T5=trash %OMSPC: MOVEI T1," " ;LOAD A SPACE %OMPAD: CAIN T3,1 ;ONE SPACE? JRST %OBYTE ;YES. DO IT WITH %OBYTE MOVEM T1,%MSPAD ;SAVE PADDING CHARACTER SETZB T0,T1 ;NO SOURCE (PAD ONLY) JRST OMCOM ;JOIN COMMON CODE %OMBWP: CAIN T0,1 ;ONE BYTE? CAIE T3,1 ;AND ONE BYTE DESTINATION? JRST OMCOM ;NO. DO MOVSLJ JRST OMONE ;YES. DO IT WITH %OBYTE %OMBYT: CAIN T0,1 ;ONE BYTE? JRST OMONE ;YES. DO IT WITH %OBYTE MOVEI T5," " ;USE SPACE FOR PAD MOVEM T5,%MSPAD MOVE T3,T0 ;SET DESTINATION COUNT=SOURCE COUNT OMCOM: MOVN T5,T3 ;MODIFY COUNT BEFORE ANYTHING ELSE ADDB T5,ORCNT(D) ;SINCE T3 WILL BE ZERO AFTER MOVSLJ JUMPGE T5,OMOK ;ENOUGH ROOM? SKIPN RSIZE(D) ;RECORDSIZE? JRST OMEXP ;NO. EXPAND BUFFER, MOVE STRING OMFRS: MOVE T4,T3 ;COPY THE OFFSET ADJBP T4,ORPTR(D) ;POINT BEYOND RECORD EXCH T4,ORPTR(D) ;SAVE THE UPDATED POINTER, GET OLD ONE ADD T3,ORCNT(D) ;SHORTEN DEST COUNT BY COUNT PAST RECORD JUMPE T3,OMRE ;IF EXACTLY 0 CHARS LEFT, JUST REPORT ERROR JUMPL T3,OMNCHR ;NOTHING TO TRANSFER IF .LE. 0 MOVE T0,T3 ;SET SOURCE=DEST EXTEND T0,%MSLJ ;MOVE THE STRING $SNH ;SHOULD NEVER TRUNCATE OMRE: $ECALL ETL ;ATTEMPT TO WRITE BEYOND FIXED-LENGTH RECORD OMNCHR: SETOM ORPOS(D) ;FLAG WE HAVE NOT PUT CHARS HERE POPJ P, OMEXP: PUSHJ P,%PUSHT ;SAVE T ACS PUSHJ P,EXPORB ;EXPAND BUFFER PUSHJ P,%POPT ;RESTORE T ACS OMOK: MOVE T4,T3 ;GET COUNT AGAIN ADJBP T4,ORPTR(D) ;GET UPDATED POINTER EXCH T4,ORPTR(D) ;SAVE UPDATED ONE, GET OLD ONE BACK EXTEND T0,%MSLJ ;MOVE THE STRING $SNH ;TRUNCATION SHOULD NOT HAPPEN SETZM ORPOS(D) ;FLAG WE HAVE PUT CHARS AT CURRENT POSITION POPJ P, ;we are done, return OMONE: ILDB T1,T1 ;GET THE CHAR PJRST %OBYTE ;OUTPUT IT ;%CBDO - CONVERT BINARY TO DECIMAL STRING, OUTPUT DIRECTLY ;INTO OUTPUT BUFFER. USES THE SAME TECHNIQUE AND RULES AS ;%OMBYT. ;ARGS: ; T0/T1 = 2-word binary integer ; T3 = destination byte count ; ;RETURNS: ; ; T1-T5 = trash %CBDO: CAIN T3,1 ;ONE BYTE? JRST CBONE ;YES. DO IT WITH %OBYTE MOVN T5,T3 ;MODIFY COUNT BEFORE ANYTHING ELSE ADDB T5,ORCNT(D) ;SINCE T3 WILL BE ZERO AFTER MOVSLJ JUMPGE T5,CBOK ;ENOUGH ROOM? SKIPN RSIZE(D) ;RECORDSIZE? JRST CBEXP ;NO. EXPAND BUFFER, MOVE STRING MOVE T4,T3 ;COPY THE OFFSET ADJBP T4,ORPTR(D) ;POINT BEYOND RECORD EXCH T4,ORPTR(D) ;SAVE THE UPDATED POINTER, GET OLD ONE ADD T3,ORCNT(D) ;SHORTEN DEST COUNT BY COUNT PAST RECORD JUMPE T3,CBRE ;IF EXACTLY 0 CHARS LEFT, JUST REPORT ERROR JUMPL T3,CBNCHR ;NOTHING TO TRANSFER IF .LE. 0 DMOVEM T3,SAVE3 ;SAVE # CHARS, BP MOVM T5,ORCNT(D) ;GET # CHARS TRUNCATED DMOVE T2,T0 ;COPY INTEGER SETZB T0,T1 ;CLEAR HIGH WORDS MOVE T4,%HIINT(T5) ;GET 2-WORD POWER OF TEN MOVE T5,%LOINT(T5) DDIV T0,T4 ;TRUNCATE INTEGER DMOVE T3,SAVE3 ;GET BYTE COUNT, POINTER AGAIN TLO T3,400000 ;TURN ON LEADING PAD FLAG EXTEND T0,[EXP ,"0"] ;OUTPUT INTEGER, LEADING ZEROES $SNH ;SHOULD ALWAYS SKIP CBRE: $ECALL ETL ;ATTEMPT TO WRITE BEYOND FIXED-LENGTH RECORD CBNCHR: SETOM ORPOS(D) ;FLAG WE HAVE NOT PUT CHARS HERE POPJ P, CBEXP: PUSHJ P,%PUSHT ;SAVE T ACS PUSHJ P,EXPORB ;EXPAND BUFFER PUSHJ P,%POPT ;RESTORE T ACS CBOK: MOVE T4,T3 ;GET COUNT AGAIN ADJBP T4,ORPTR(D) ;GET UPDATED POINTER EXCH T4,ORPTR(D) ;SAVE UPDATED ONE, GET OLD ONE BACK TLO T3,400000 ;TURN ON LEADING PAD FLAG EXTEND T0,[EXP ,"0"] ;OUTPUT INTEGER, LEADING ZEROES $SNH ;TRUNCATION SHOULD NOT HAPPEN SETZM ORPOS(D) ;FLAG WE HAVE PUT CHARS AT CURRENT POSITION POPJ P, ;we are done, return CBONE: ADDI T1,"0" ;CONVERT DIGIT TO ASCII PJRST %OBYTE ;OUTPUT IT SEGMENT DATA SAVE3: BLOCK 1 ;TEMP FOR SAVING CHAR COUNT SEGMENT CODE EXPIRB: HRRZ T1,IRBUF(D) ;GET OLD BUFFER PNTR-1 ADDI T1,1 ;CORRECT IT MOVE T2,IRBLN(D) ;GET OLD LENGTH IN BYTES PUSHJ P,EXPRB ;EXPAND AND MOVE HRRZ T2,IRBUF(D) ;GET OLD BUFFER ADDR-1 SUBI T2,-1(T1) ;GET OLD-NEW MOVN T2,T2 ;GET NEW-OLD ADDM T2,IRPTR(D) ;MOVE PNTR TO NEW BUFFER SUBI T1,1 ;POINT AT PREVIOUS WORD HXL T1,BYTPT(D) ;MAKE BYTE PNTR TO BEG BUFFER MOVEM T1,IRBUF(D) ;STORE NEW BUFFER ADDR MOVE T4,IRBLN(D) ;GET OLD SIZE AGAIN MOVEM T3,IRBLN(D) ;STORE NEW SIZE SUB T3,T4 ;RETURN SIZE LEFT IN T3 ADDM T3,IRCNT(D) ;ADD TO CURRENT COUNT MOVE T1,ROFSET(D) ;GET OFFSET TO REAL DATA BEG ADJBP T1,IRBUF(D) ;CALC NEW PNTR MOVEM T1,IRBEG(D) ;SAVE IT MOVE T1,IRBLN(D) ;GET RECORD BUFFER SIZE SUB T1,ROFSET(D) ;AND REDUCE IT MOVEM T1,IRSIZ(D) ;AND SAVE IT POPJ P, GETIRB: PUSHJ P,GETRB ;GET A NEW BUFFER SUBI T1,1 ;POINT TO PREVIOUS WORD HXL T1,BYTPT(D) ;MAKE BYTE PNTR TO BEG BUFFER MOVEM T1,IRBUF(D) ;SAVE BUFFER PNTR MOVEM T3,IRBLN(D) ;SAVE FIXED COUNT MOVE T1,ROFSET(D) ;GET OFFSET TO REAL DATA BEG ADJBP T1,IRBUF(D) ;CALC NEW PNTR MOVEM T1,IRBEG(D) ;SAVE IT MOVE T1,IRBLN(D) ;GET RECORD BUFFER SIZE SUB T1,ROFSET(D) ;AND REDUCE IT MOVEM T1,IRSIZ(D) ;AND SAVE IT POPJ P, EXPORB: HRRZ T1,ORBUF(D) ;GET OLD BUFFER PNTR-1 ADDI T1,1 ;CORRECT IT MOVE T2,ORBLN(D) ;GET OLD LENGTH IN BYTES PUSHJ P,EXPRB ;EXPAND AND MOVE HRRZ T2,ORBUF(D) ;GET OLD BUFFER ADDR SUBI T2,-1(T1) ;GET OLD-NEW MOVN T2,T2 ;GET NEW-OLD ADDM T2,ORPTR(D) ;MOVE PNTR TO NEW BUFFER SUBI T1,1 ;POINT TO PREVIOUS WORD HXL T1,BYTPT(D) ;MAKE BYTE PNTR TO BEG BUFFER MOVEM T1,ORBUF(D) ;STORE NEW BUFFER ADDR MOVE T4,ORBLN(D) ;GET OLD SIZE AGAIN MOVEM T3,ORBLN(D) ;STORE NEW SIZE SUB T3,T4 ;GET DIFF ADDM T3,ORCNT(D) ;ADD TO CURRENT COUNT MOVE T1,ROFSET(D) ;GET OFFSET TO REAL DATA BEG ADJBP T1,ORBUF(D) ;CALC NEW PNTR MOVEM T1,ORBEG(D) ;SAVE IT MOVE T1,ORBLN(D) ;GET RECORD BUFFER SIZE SUB T1,ROFSET(D) ;AND REDUCE IT MOVEM T1,ORSIZ(D) ;AND SAVE IT POPJ P, GETORB: PUSHJ P,GETRB ;GET A NEW BUFFER SUBI T1,1 ;POINT TO PREVIOUS WORD HXL T1,BYTPT(D) ;MAKE IT A BYTE PNTR MOVEM T1,ORBUF(D) ;SAVE BUFFER PNTR MOVEM T3,ORBLN(D) ;SAVE COUNT MOVE T1,ROFSET(D) ;GET OFFSET TO REAL DATA BEG ADJBP T1,ORBUF(D) ;CALC NEW PNTR MOVEM T1,ORBEG(D) ;SAVE IT MOVE T1,ORBLN(D) ;GET RECORD BUFFER SIZE SUB T1,ROFSET(D) ;AND REDUCE IT MOVEM T1,ORSIZ(D) ;AND SAVE IT POPJ P, ;EXPRB - ROUTINE TO EXPAND A RECORD BUFFER ;CALL: ; T1 = ADDR OF OLD BUFFER ; T2 = OLD LENGTH IN BYTES ; T3 = MINIMUM ADDITIONAL SIZE IN BYTES ;RETURN: ; T1 = ADDR OF START OF MOVED RECORD BUFFER ; T2 = ADDR OF FIRST FREE WORD IN MOVED RECORD BUFFER ; T3 = NUMBER OF BYTES IN MOVED RECORD BUFFER EXPRB: MOVE T4,T2 ;COPY OLD SIZE LSH T4,1 ;DOUBLE IT ADD T4,T3 ;ADD MINIMUM SIZE IDIV T2,BPW(D) ;GET # WORDS IN OLD BUFFER MOVE T3,T4 ;COPY NEW SIZE IDIV T3,BPW(D) ;GET # WORDS IN NEW BUFFER PUSHJ P,%MVSPC ;MOVE TO BIGGER BUFFER, FILL WITH SPACES $ACALL RTL ;[4131] CAN'T MOVEI T1,(T1) ;LOCAL ADDR IMUL T3,BPW(D) ;CONVERT NEW # WORDS TO CHARS POPJ P, ;RETURN ;GETRB - GET A RECORD BUFFER ;RETURN: ; T1 = ADDR OF RECORD BUFFER ; T2 = COPY OF T1 ; T3 = SIZE IN BYTES GETRB: SKIPN T1,FRSIZB(D) ;IF FIXED-LENGTH, USE IT MOVEI T1,LRECBF ;VARIABLE, USE MINIMUM SIZE ADD T1,BPW(D) ;ROUND UP TO WORDS SUBI T1,1 IDIV T1,BPW(D) ;GET # WORDS PUSHJ P,%GTSPC ;GET BLOCK, FILL WITH SPACES $ACALL MFU ;[4131] CAN'T MOVE T2,T1 ;COPY ADDR SKIPN T3,FRSIZB(D) ;GET LENGTH AGAIN MOVEI T3,LRECBF POPJ P, SUBTTL INPUT ;%IREC - INITIAL RECORD INPUT. SETS UP THE BUFFER (IF NECESSARY) AND ;GOES TO THE APPROPRIATE ROUTINE. CALLED ONLY FROM FINGO. %IREC: SKIPN IRBUF(D) ;ANY BUFFER YET? PUSHJ P,GETIRB ;NO. ALLOCATE THE BUFFER SETOM LSNUM(D) ;SET UP ILLEGAL LINE SEQUENCE NUMBER AOS CREC(D) ;INCREMENT RECORD NUMBER LOAD T1,INDX(D) ;GET DEV INDEX PJRST IDSP(T1) ;DO DEVICE-DEPENDENT INPUT ;%IRECS IS THE SAME AS %IREC, EXCEPT IT IS ONLY CALLED FROM WITHIN ;A FORMAT (FOR "/" AND INDEFINITE REPEAT) AND FOR MULTIRECORD INPUT ;IN NAMELIST AND LIST-DIRECTED I/O. %IRECS: SETOM LSNUM(D) ;SET UP ILLEGAL LINE SEQUENCE NUMBER AOS CREC(D) ;INCREMENT RECORD NUMBER LOAD T1,INDX(D) ;GET DEV INDEX PJRST IDSPS(T1) ;DO DEVICE-DEPENDENT INPUT ;IRSET - CALLED AFTER READING THE DATA FOR ALL "EXTERNAL" DEVICES ;TO SET UP THE POINTER AND COUNT FOR READING WITH %IBYTE. IRSET: MOVE T1,IRBEG(D) ;GET RECORD BUFFER PNTR MOVEM T1,IRPTR(D) ;STORE INITIALIZED BYTE PTR SKIPE IRCNT(D) ;ANY CHARS IN RECORD? POPJ P, ;YES. WE'RE DONE MOVE T0,FLAGS(D) ;Get current DDB flags TXNE T0,D%END ;ZERO CHARS. EOF ALSO? $ACALL EOF ;YES. REPORT IT AND DIE POPJ P, ;NO. JUST A NULL RECORD REREAD: MOVE T1,IRBEG(D) MOVEM T1,IRPTR(D) MOVE T1,IRLEN(D) ;REREAD. SETUP PNTR/COUNT WITH OLD DATA MOVEM T1,IRCNT(D) JUMPN T1,%POPJ ;NOT EOF IF WE HAVE CHARS MOVE T0,FLAGS(D) TXNE T0,D%END ;END OF FILE? $ACALL EOF ;YES. REPORT IT AND DIE POPJ P, ;Return ;ALL DEVICE-DEPENDENT INPUT ROUTINES HAVE THE SAME CALLING SEQUENCE: ;ARGS: IRBEG = BYTE POINTER TO START OF RECORD BUFFER ; IRSIZ = NUMBER OF BYTES IN RECORD BUFFER ;RETURN: NEXT RECORD FROM FILE READ INTO RECORD BUFFER ; IRCNT = NUMBER OF BYTES FOUND IN RECORD BUFFER IDSP: JRST TIREC ;TTY JRST XIREC ;DISK JRST XIREC ;MTA JRST XIREC ;OTHER JRST XIREC ;REMOTE STREAM FILE JRST %IRMS ;RMS FILE IDSPS: JRST TIRECS ;TTY JRST XIREC ;DISK JRST XIREC ;MTA JRST XIREC ;OTHER JRST XIREC ;REMOTE STREAM FILE JRST %IRMS ;RMS RECORD INPUT IF20,< ;TTY ;TIREC - FOR INITIAL INPUT, EOF IS ALWAYS CLEARED FOR TTY, SINCE IT ;IS DEFINED AS A LINE-BY-LINE EOF (IS NOT "STICKY"). ;TIRECS - FOR "/" FORMAT, INDEFINITE REPEAT, AND MULTIRECORD INPUT, ;EOF (CONTROL-Z) IS STICKY, AND WILL GET AN EOF RETURN. TIREC: MOVX T0,D%END ;CLEAR EOF FOR TTY'S ANDCAM T0,FLAGS(D) TIRECS: PUSHJ P,T20INP ;END= STAYS ON PJRST IRSET ;AND RETURNS IMMEDIATELY IF EOF T20INP: SETZM IRCNT(D) ;CLEAR CHAR COUNT IN CASE EOF SETZM IRLEN(D) ;AND RECORD LENGTH MOVE T0,FLAGS(D) ;JUST LEAVE IF EOF TXNE T0,D%END POPJ P, TXNN T0,D%SEOL+D%PDOL ;PREV CRLF OR DOLLAR FORMAT? PUSHJ P,%OCRLF ;NO. OUTPUT CRLF MOVX T0,D%SEOL+D%PDOL ;NOW CLEAR THEM ANDCAM T0,FLAGS(D) 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 MOVE T1,IJFN(D) ;GET JFN HRLI T1,(T1) ;IN BOTH HALVES MOVEM T1,TXIBLK+.RDIOJ ;STORE IT MOVE T1,IRBEG(D) ;GET RECORD BUFFER PNTR MOVEM T1,TXIBLK+.RDDBP ;STORE DEST BYTE POINTER MOVE T1,IRSIZ(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 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 CAIE T1,32 ;^Z? MOVX T0,D%SEOL+D%PDOL ;NO. INSTEAD SUPPRESS NEXT LEADING EOL IORM T0,FLAGS(D) SETZM G.PRP ;CLEAR PROMPT STRING FOR NEXT TIME AOS T3,TXIBLK+.RDDBC ;RETURN COUNT OF LEFTOVER BYTES IN BUFFER ;DISCARDING BREAK CHARACTER MOVE T1,IRSIZ(D) ;GET SIZE OF RECORD BUFFER SUBI T1,(T3) ;CALC # CHARS IN RECORD MOVEM T1,IRCNT(D) ;SAVE FOR INPUT MOVEM T1,IRLEN(D) ;SAVE LENGTH POPJ P, ;DONE TEXP: MOVE T1,TXIBLK+.RDDBP ;GET UPDATED POINTER MOVEM T1,IRPTR(D) ;SAVE FOR EXPANSION MOVE T1,TXIBLK+.RDDBC ;GET UPDATED COUNT MOVEM T1,IRCNT(D) ;SAVE FOR EXPANSION SETZ T3, ;NO MINIMUM EXPANSION PUSHJ P,EXPIRB ;EXPAND RECORD BUFFER MOVE T1,IRBEG(D) MOVEM T1,TXIBLK+.RDBFP ;SET NEW POINTER TO START OF BUFFER MOVE T1,IRPTR(D) MOVEM T1,TXIBLK+.RDDBP ;SET POINTER TO DEST STRING MOVE T1,IRCNT(D) MOVEM T1,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 >;END IF20 IF10,< TIREC: MOVX T0,D%END ;CLEAR EOF FOR TTY'S ANDCAM T0,FLAGS(D) ;Store updated flags TIRECS: PUSHJ P,T10INP ;DO TOPS-10 TTY INPUT PJRST IRSET ;AND GO DO SETUP T10INP: SETZM IRCNT(D) ;CLEAR CHAR COUNT IN CASE EOF SETZM IRLEN(D) ;AND RECORD LENGTH MOVE T0,FLAGS(D) ;ARE WE AT EOF? TXNE T0,D%END POPJ P, ;YES. GO NO FURTHER TXNN T0,D%SEOL+D%PDOL ;PREV CRLF OR DOLLAR FORMAT? PUSHJ P,%OCRLF ;NO. OUTPUT CRLF MOVX T0,D%SEOL+D%PDOL ;SUPPRESS NEXT CRLF IORM T0,FLAGS(D) MOVE T1,IRBEG(D) ;GET POINTER MOVEM T1,IRPTR(D) ;SAVE FOR TRANSFER MOVE T1,IRSIZ(D) ;AND COUNT MOVEM T1,IRCNT(D) TLP0: SOSL TCNT(D) ;ANY MORE BYTES? JRST TLPX1 ;NO. GET MORE PUSHJ P,IMAP JRST DIEOR ;GOT EOF JRST TLP0 ;KEEP IN SYNCH TLPX1: ILDB T1,TPTR(D) ;GET A CHAR JUMPE T1,TLP0 ;SKIP IT IF NULL JRST TLPGTC ;USE IT IF NOT NULL TLP: SOSL TCNT(D) ;ANY MORE BYTES? JRST TLPX2 ;YES PUSHJ P,IMAP ;NO JRST DIEOR ;GOT EOF JRST TLP ;KEEP IN SYNCH! TLPX2: ILDB T1,TPTR(D) ;GET A BYTE TLPGTC: CAIGE T1," " ;CHECK FOR SPECIAL BYTE JRST TCHKEL ;SPECIAL TDPB: SKIPE IRCNT(D) ;ROOM IN RECORD BUFFER? JRST TDPB2 ;YES SETZ T3, ;NO MINIMUM EXPANSION PUSHJ P,EXPIRB ;NO. EXPAND RECORD BUFFER LDB T1,TPTR(D) ;AND GET THE CHAR AGAIN TDPB2: SOS IRCNT(D) ;DECR RECORD BYTE COUNT IDPB T1,IRPTR(D) ;DEPOSIT BYTE IN RECORD BUFFER JRST TLP ;BACK FOR MORE TCHKEL: CAIN T1,15 ;CARRIAGE RETURN? JRST TGOTCR ;YES CAIG T1,14 ;STANDARD EOF CHARS ARE 12-14 (LF,VT,FF) CAIGE T1,12 ;EOL CHAR? JRST NOTEOL ;NO. CHECK FOR TTY CONTROL-Z JRST DIEOR ;YES. DECR COUNT AND END IT ALL NOTEOL: CAIE T1,33 ;ESCAPE? JRST NOTESC ;NO OUTSTR %CRLF ;YES. OUTPUT A CRLF JRST DIEOR ;AND END THE LINE NOTESC: CAIE T1,32 ;^Z? JRST TDPB ;NO. PASS IT THROUGH PUSHJ P,IMAP ;YES. GET ANOTHER BUFFER JRST DIEOR ;SHOULD GET EOF $SNH ;UNLESS TOPS-10 CHANGES TGOTCR: DMOVE T1,TPTR(D) ;GET PNTR/COUNT TCRLP: DMOVEM T1,TPTR(D) ;SAVE PNTR/COUNT SOJGE T2,TCRX2 ;DECR COUNT. OK IF CHARS LEFT PUSHJ P,IMAP ;NO. GET A BUFFERFUL JRST DIEOR ;GOT EOF JRST TGOTCR ;KEEP IN SYNCH TCRX2: ILDB T3,T1 ;GET A CHAR JUMPE T3,TCRLP ;SKIP NULLS CAIN T3,15 ;ANOTHER CARRIAGE RETURN? JRST TCRLP ;YES. IGNORE IT CAIG T3,14 ;VERT MOTION CHAR? CAIGE T3,12 JRST DIEOR ;NO. DATA DMOVEM T1,TPTR(D) ;YES. SAVE UPDATED PNTR/COUNT JRST DIEOR ;AND END THE LINE >;END IF10 XIREC: PUSHJ P,CIREC ;DO COMMON INPUT RECORD CODE PJRST IRSET ;AND SETUP FOR GETTING BYTES FROM IT CIREC: SETZM IRCNT(D) ;CLEAR CHAR COUNT IN CASE EOF SETZM IRLEN(D) ;AND RECORD LENGTH MOVE T1,FLAGS(D) ;ARE WE AT EOF? TXNE T1,D%END POPJ P, ;YES. GO NO FURTHER SKIPE FRSIZW(D) ;FIXED-LENGTH, WORD-ALIGNED RECORDS? JRST INBLT ;YES. READ WITH BLT SKIPE FRSIZB(D) ;FIXED-LENGTH, NON-WORD-ALIGNED RECORDS? JRST INMSLJ ;YES. READ WITH MOVSLJ SKIPE RECTP(D) ;STREAM FILE? JRST INDELR ;NO. GO FIND OUT WHAT IT IS MOVE T1,IRBEG(D) ;GET POINTER MOVEM T1,IRPTR(D) ;SAVE FOR TRANSFER MOVE T1,IRSIZ(D) ;AND COUNT MOVEM T1,IRCNT(D) NULP: SOSL ICNT(D) ;ANY CHARS IN BUFFER? JRST NULCHK ;YES PUSHJ P,IMAP ;NO JRST DIEOR ;GOT EOF JRST NULP ;KEEP IN SYNCH! NULCHK: ILDB T1,IPTR(D) ;GET A CHAR JUMPE T1,NULP ;SKIP NULLS LOAD T2,MODE(D) ;GET FILE MODE CAIE T2,MD.ASL ;LINED? JRST NULDEP ;NO. GO DEPOSIT CHAR HRRZ T2,IPTR(D) ;YES. GET LOCAL ADDR OF BUFFER MOVE T2,(T2) ;GET WORD TRNN T2,1 ;LINE NUMBER? JRST NULDEP ;NO. GO DEPOSIT CHAR MOVEM T2,LSNUM(D) ;SAVE IT AOS IPTR(D) ;YES. INCR BUFFER PNTR PAST IT MOVNI T2,5 ;AND DECR THE CHAR COUNT ADDB T2,ICNT(D) JUMPG T2,CHKTAB ;GO CHECK FOR TAB IF STILL CHARS PUSHJ P,IMAP ;GET NEW BUFFER IF NOT JRST DIEOR ;GOT EOF CHKTAB: LDB T1,IPTR(D) ;[3346] GET THE CHAR CAIN T1," " ;TAB? JRST INSLP ;YES. SKIP IT NULDEP: CAIG T1,15 ;TERMINATOR? CAIGE T1,12 JRST .+2 ;NO. GO DEPOSIT CHAR JRST CHKEOL ;YES. GO CHECK IT IDPB T1,IRPTR(D) ;SAVE THE FIRST CHAR SOS IRCNT(D) ;DECR THE COUNT INSLP: MOVE T0,ICNT(D) ;GET BUFFER COUNT JUMPG T0,INSOK ;IF SOME CHARS, CONTINUE PUSHJ P,IMAP ;IF NOT, GET SOME JRST DIEOR ;GOT EOF MOVE T0,ICNT(D) ;GET COUNT AGAIN INSOK: MOVE T1,IPTR(D) ;GET PNTR MOVE T3,IRCNT(D) ;GET RECORD ROOM AVAILABLE MOVE T4,IRPTR(D) ;GET RECORD PNTR CAMGE T0,T3 ;SOURCE .GE. DEST? MOVE T3,T0 ;NO. RESTRICT DEST TO SOURCE TO PREVENT FILL MOVEM T3,LOCSIZ ;SAVE IT TLO T0,(1B0) ;TURN ON TRANSLATION EXTEND T0,[EXP ," "] ;MOVE THE STRING NOP ;DON'T TREAT TRUNCATION SPECIAL TLZ T0,777000 ;TURN OFF ALL BUT # CHARS MOVEM T0,ICNT(D) ;STORE NEW COUNT MOVEM T1,IPTR(D) ;SAVE UPDATED PNTR MOVEM T4,IRPTR(D) ;AND RECORD PNTR MOVN T2,LOCSIZ ;GET # CHARS WE WANTED TO TRANSFER ADD T2,T3 ;CALC ACTUAL # CHARS TRANSFERRED ADDB T2,IRCNT(D) ;AND RECORD COUNT JUMPG T3,CHKEOL ;IF WE TERMINATED, CHECK THE EOL CHAR JUMPG T2,INSLP ;IF WE TRUNCATED, WE NEED MORE INPUT PUSHJ P,EXPIRB ;RECORD COUNT NOW ZERO - EXPAND THE BUFFER JRST INSLP ;AND CONTINUE CHKEOL: LDB T1,IPTR(D) ;GET THE TERMINATOR CHARACTER CAIE T1,15 ;CR? JRST DIEOR ;NO. END OF RECORD GOTCR: DMOVE T1,IPTR(D) ;GET PNTR/COUNT CRLP: DMOVEM T1,IPTR(D) ;SAVE PNTR/COUNT SOJGE T2,CRX2 ;DECR COUNT. OK IF CHARS LEFT PUSHJ P,IMAP ;NO. GET A BUFFERFUL JRST DIEOR ;GOT EOF JRST GOTCR ;KEEP IN SYNCH CRX2: ILDB T3,T1 ;GET A CHAR JUMPE T3,CRLP ;SKIP NULLS CAIN T3,15 ;ANOTHER CARRIAGE RETURN? JRST CRLP ;YES. IGNORE IT CAIG T3,14 ;VERT MOTION CHAR? CAIGE T3,12 JRST DIEOR ;NO. DATA DMOVEM T1,IPTR(D) ;YES. SAVE UPDATED PNTR/COUNT DIEOR: MOVE T1,IRSIZ(D) ;GET RECORD BUFFER SIZE SUBB T1,IRCNT(D) ;GET # CHARS IN RECORD MOVEM T1,IRLEN(D) ;SAVE LENGTH POPJ P, ASCTAB: BYTE (18)0,1,2,3,4,5,6,7 BYTE (18)10,11,100012,100013,100014,100015,16,17 BYTE (18)20,21,22,23,24,25,26,27,30,31,32,33,34,35,36,37 BYTE (18)40,41,42,43,44,45,46,47,50,51,52,53,54,55,56,57 BYTE (18)60,61,62,63,64,65,66,67,70,71,72,73,74,75,76,77 BYTE (18)100,101,102,103,104,105,106,107 BYTE (18)110,111,112,113,114,115,116,117 BYTE (18)120,121,122,123,124,125,126,127 BYTE (18)130,131,132,133,134,135,136,137 BYTE (18)140,141,142,143,144,145,146,147 BYTE (18)150,151,152,153,154,155,156,157 BYTE (18)160,161,162,163,164,165,166,167 BYTE (18)170,171,172,173,174,175,176,177 ;INPUT OF FIXED-LENGTH, WORD-ALIGNED RECORDS IS ACCOMPLISHED ;BY READING WORDS DIRECTLY FROM THE FILE, REGARDLESS OF CONTENT. ;THE RECORD SIZE PARAMETERS ARE THEN SET FROM THE PRESET RECORDSIZE. INBLT: MOVE T1,FRSIZW(D) ;GET RECORDSIZE MOVEM T1,LOCSIZ ;SAVE FOR TRANSFER MOVE T1,IRBUF(D) ;INIT RECORD POINTER MOVEM T1,IRPTR(D) INBLP: MOVE T4,ICNT(D) ;GET BUFFER COUNT IDIV T4,BPW(D) ;GET # WORDS JUMPG T4,INBOK ;OK IF SOME PUSHJ P,IMAP ;GET MORE IF NONE $ACALL EOF ;EOF. REPORT IT IMMEDIATELY! MOVE T4,ICNT(D) ;GET NEW COUNT IDIV T4,BPW(D) ;GET # WORDS INBOK: MOVE T3,LOCSIZ ;GET # WORDS TO TRANSFER CAILE T3,(T4) ;.GT. NUMBER OF WORDS IN BUFFER MOVEI T3,(T4) ;YES. USE THE SMALLER ONE HRRZ T5,IRPTR(D) ;GET RECORD ADDR-1 ADDI T5,1 ;CORRECT IT HRRZ T1,IPTR(D) ;GET INPUT BUFFER ADDR-1 HRLZI T1,1(T1) ;NOW GET ITS ADDRESS AS SOURCE HRRI T1,(T5) ;DESTINATION IS RECORD BUFFER ADDI T5,-1(T3) ;GET FINAL DEST BLT T1,(T5) ;TRANSFER THE WORDS ADDM T3,IRPTR(D) ;UPDATE RECORD PNTR ADDM T3,IPTR(D) ;AND BUFFER POINTER SUBI T4,(T3) ;AND BUFFER WORD COUNT IMUL T4,BPW(D) ;GET BYTES LEFT MOVEM T4,ICNT(D) ;SAVE IT MOVNI T3,(T3) ;GET NEG # WORDS TRANSFERRED ADDB T3,LOCSIZ ;UPDATE TOTAL WORD COUNT JUMPG T3,INBLP ;IF MORE, TRY FOR MORE MOVE T1,RSIZE(D) ;SETUP COUNT AND LENGTH MOVEM T1,IRCNT(D) MOVEM T1,IRLEN(D) SKIPN WTAB(D) ;RANDOM FILE? POPJ P, ;NO. DON'T CHECK CONTENTS MOVN T1,FRSIZW(D) ;GET NEG # WORDS IN RECORD HRLZI T1,(T1) ;IN LEFT HALF HRR T1,IRBUF(D) ;CREATE AOBJN POINTER TO RECORD-1 ADDI T1,1 ;CORRECT IT MOVE T3,(T1) ;GET 1ST WORD LOAD T2,MODE(D) ;GET DATA MODE CAIN T2,MD.ASL ;LINED? MOVEM T3,LSNUM(D) ;YES. SAVE LSN INBCHK: SKIPN (T1) ;WORD NON-ZERO? AOBJN T1,INBCHK ;ZERO. TRY ANOTHER JUMPL T1,%POPJ ;IF STILL IN RECORD, WE'RE OK $ACALL RNR ;IF NOT, RECORD NOT WRITTEN ;INPUT OF NON-STREAM, VARIABLE-LENGTH FILES. IF IT IS ;AN UNLABELED MAGTAPE, GO READ THE DELIMITER AS THE RECORD LENGTH. ;IF IT IS A LABELED MAGTAPE, THE CURRENT ENTIRE BUFFER IS THE RECORD. ;INPUT OF DELIMITED (VARIABLE-LENGTH) RECORDS IS DONE ;BY READING THE DELIMITER TO DETERMINE THE RECORD LENGTH. IF ;NECESSARY, THE INPUT RECORD BUFFER IS EXPANDED. INDELR: PUSHJ P,GETDEL ;GET DELIMITER MOVE T3,IRLEN(D) ;GET LENGTH FROM DELIMITER CAMLE T3,IRSIZ(D) ;BIGGER THAN CURRENT RECORD BUFFER? PUSHJ P,EXPIRB ;YES. EXPAND IT MOVE T1,IRLEN(D) ;GET RECORD LENGTH AGAIN MOVEM T1,IRCNT(D) ;SAVE THE RECORD SIZE JRST INMCOM ;JOIN COMMON CODE ;INPUT OF FIXED-LENGTH NON-WORD-ALIGNED RECORDS IS READ WITHOUT ;REGARD TO DATA CONTENT WITH MOVSLJ. EXACTLY RSIZE CHARACTERS ARE ;READ INTO THE RECORD BUFFER. THE RECORD LENGTH PARAMETERS ARE ;SET TO THE PRESET RECORDSIZE. ;FOR NOW, RANDOM RECORDS ARE ALWAYS WORD-ALIGNED, AND THEREFORE ;ARE NOT READ HERE. IF THEY EVER ARE, WE MUST ADD A CHECK AT THE ;END FOR RECORD NOT WRITTEN (ALL CHARACTERS NULL). FOR EFFICIENCY, ;THIS WOULD PROBABLY REQUIRE THAT THE INITIAL RECORD BE NULLS, ;RATHER THAN SPACES, SO THAT WE CAN CHECK WITH AOBJN. INMSLJ: MOVE T1,FRSIZB(D) ;GET RECORD LENGTH MOVEM T1,IRCNT(D) MOVEM T1,IRLEN(D) INMCOM: MOVE T1,IRBEG(D) ;AND PNTR MOVEM T1,IRPTR(D) INMSLP: MOVE T0,ICNT(D) ;GET COUNT JUMPG T0,INMSOK ;OK IF NON-ZERO PUSHJ P,IMAP ;NO CHARS. GET A BUFFERFUL $ACALL EOF ;EOF. REPORT IT IMMEDIATELY! MOVE T0,ICNT(D) ;GET UPDATED COUNT INMSOK: MOVE T1,IPTR(D) ;GET BUFFER PNTR MOVE T3,IRCNT(D) ;GET RECORD PNTR/COUNT MOVE T4,IRPTR(D) CAIGE T0,(T3) ;SOURCE .GE. DEST? MOVE T3,T0 ;NO. RESTRICT DEST TO PREVENT FILL MOVNI T2,(T3) ;UPDATE RECORD COUNT, AS MOVSLJ CLEARS IT ADDM T2,IRCNT(D) EXTEND T0,[EXP ,0] ;MOVE RECORD NOP ;TRUNCATION HAPPENS MOST OF THE TIME MOVEM T0,ICNT(D) ;SAVE UPDATED WINDOW COUNT MOVEM T1,IPTR(D) ;AND POINTER MOVEM T4,IRPTR(D) SKIPE IRCNT(D) ;DID WE FINISH? JRST INMSLP ;NO. TRY AGAIN MOVE T1,IRLEN(D) ;SETUP INPUT BYTE COUNT MOVEM T1,IRCNT(D) POPJ P, IMAP: MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%END ;EOF ALREADY? POPJ P, ;YES. NON-SKIP RETURN PUSHJ P,INXTW ;NO. GET NEXT WINDOW MOVE T0,FLAGS(D) ;Get DDB flags TXNN T0,D%END ;IF FILE DID NOT END, AOS (P) ;SKIP RETURN POPJ P, ;ELSE DONE GETDEL: LOAD T1,LTYP(D) ;GET LABEL TYPE CAIN T1,LT.UNL ;LABELED? JRST INGDEL ;NO. GO DO FURTHER CHECKING PUSHJ P,IMAP ;YES (it's labeled). GET A RECORD $ACALL EOF ;REPORT EOF IMMEDIATELY MOVE T1,ICNT(D) ;USE THE BUFFER COUNT MOVEM T1,IRLEN(D) ;FOR THE RECORD LENGTH POPJ P, INGDEL: LOAD T1,INDX(D) ;GET DEVICE INDEX CAIE T1,DI.MTA ;MAGTAPE? JRST DELDSK ;NO. MUST BE A DISK ;+ [4136] ; Get the delimiter for Magnetic Tape devices ;- DELMTA: MOVE T1,ICNT(D) ;GET number of CHARS LEFT IN BUFFER CAILE T1,4 ;[4136]More than 4 Chars(for Control Word)? JRST INGD ;YES PUSHJ P,IMAP ;NO. GET ANOTHER BUFFERFUL $ACALL EOF ;REPORT EOF IMMEDIATELY ;+ [4136] ; Get the RCW ("Record Control Word" or "Delimiter") from the record. ; Update the record pointer (IPTR) to point to the first (real) character ; in the record (just after the 4 character RCW). Update the record length ; (IRLEN) to be the size specified in the RCW less the size of the RCW. ;- INGD: MOVEI T0,4 ;GET # BYTES IN DELIMITER (RCW) MOVEI T1,4 ;[4136]Update record pointer - ADJBP T1,IPTR(D) ;to point to (just) after the delimiter. EXCH T1,IPTR(D) ;SAVE UPDATED ONE, GET ORIGINAL ONE EXTEND T0,[] ;Convert the RCW to binary $ACALL ICD ;ILLEGAL CHARACTER IN DELIMITER SUBI T4,4 ;[4136]Subtract size of delimiter MOVEM T4,IRLEN(D) ;Save actual length of record (Not RCW) MOVNI T1,4 ;Update Count (not to include size of the RCW) ADDM T1,ICNT(D) ;Free byte count POPJ P, ; ;+ [4136] ; Get the delimiter for Disk devices ;- DELDSK: PUSHJ P,IWORD ;GET A WORD QUANTITY $ACALL EOF ;REPORT EOF IMMEDIATELY MOVEM T1,IRLEN(D) ;SAVE AS LENGTH OF RECORD MOVN T1,BPW(D) ;UPDATE COUNT ADDM T1,ICNT(D) MOVE T1,BPW(D) ;AND POINTER ADJBP T1,IPTR(D) MOVEM T1,IPTR(D) ;SAVE UPDATED ONE POPJ P, ;DECODE DECINI: XMOVEI T1,@A.HSA ;GET STRING ADDR $BLDBP T1 ;Build 7-bit byte ptr. LDB T2,[POINTR A.HSA,ARGTYP] ;GET ARRAY TYPE CAIN T2,TP%CHR ;CHARACTER? MOVE T1,@A.HSA ;YES. GET THE POINTER MOVEM T1,IRPTR(D) MOVEM T1,IRBUF(D) MOVEM T1,IRBEG(D) SKIPG T1,@A.HSL ;GET RECORD LENGTH $ACALL SLN ;RECORD LENGTH NOT POSITIVE MOVEM T1,IRCNT(D) ;SAVE CHAR COUNT MOVEM T1,RSIZE(D) ;AND RECORD SIZE MOVEM T1,IRBLN(D) ;AND REC BUFFER LENGTH MOVEM T1,IRSIZ(D) MOVEM T1,BYTN(D) ;SET NEXT RECORD START MOVEM T1,IRLEN(D) ;AND RECORD LENGTH POPJ P, ;RETURN DECODE: MOVE T1,BYTN(D) ;GET NEXT RECORD START ADJBP T1,IRBUF(D) ;MOVE POINTER TO NEXT ENTRY MOVEM T1,IRBEG(D) ;SAVE PNTR TO BEG OF RECORD MOVEM T1,IRPTR(D) ;SAVE MOVING POINTER MOVE T1,IRSIZ(D) ;GET ENTRY SIZE MOVEM T1,IRCNT(D) ;SAVE IT ADDM T1,BYTN(D) ;SET TO POINT TO NEXT RECORD POPJ P, ;INTERNAL FILES - INPUT SETUP ;SETUP THE FOROTS INTERNAL BUFFER POINTER/COUNT TO ;THE CHARACTER VARIABLE/ARRAY. IRBUF(D) ALWAYS CONTAINS ;A POINTER TO THE BEGINNING OF THE ENTIRE VARIABLE/ARRAY. ;BYTN IS UPDATED AT THE INITIALIZATION AND EACH READ ;TO POINT TO THE RELATIVE POSITION (IN BYTES) OF THE ;NEXT RECORD. IFINI: XMOVEI T1,@A.UNIT ;GET ADDRESS OF DESCRIPTOR MOVE T2,(T1) ;GET BYTE POINTER MOVEM T2,IRBUF(D) ;SAVE AS RECORD BUFFER POINTER MOVEM T2,IRBEG(D) MOVEM T2,IRPTR(D) ;AND MOVING POINTER MOVE T2,1(T1) ;GET VARIABLE ENTRY SIZE MOVEM T2,IRBLN(D) ;SAVE AS BUFFER LENGTH MOVEM T2,IRSIZ(D) MOVEM T2,IRCNT(D) ;AND MOVING COUNT MOVEM T2,IRLEN(D) ;AND RECORD LENGTH MOVEM T2,RSIZE(D) ;AND RECORDSIZE MOVEM T2,BYTN(D) ;AND START OF NEXT RECORD MOVE T3,@A.HSL ;GET TOTAL # CHARS IN ARRAY SKIPN A.HSL ;UNLESS THERE IS NO KEYWORD MOVE T3,1(T1) ;NONE. GET IT FROM THE DESCRIPTOR MOVEM T3,EOFN(D) ;SAVE IT JUMPG T3,%POPJ ;NON-ZERO IS OK $ACALL ICE ;ILLEGAL CHARACTER EXPRESSION ;INPUT ;UPDATE THE POINTER TO POINT TO THE NEXT ARRAY ENTRY. ;IF MORE THAN ONE RECORD FOR A SCALAR OR EXPRESSION, OR ;BEYOND THE END OF AN ARRAY, REPORT END-OF-FILE. IFIN: MOVE T1,BYTN(D) ;GET NEXT RECORD START CAML T1,EOFN(D) ;END OF ARRAY? $ACALL EOF ;YES. REPORT END OF FILE ADJBP T1,IRBUF(D) ;MOVE POINTER TO NEXT ENTRY MOVEM T1,IRBEG(D) ;SAVE POINTER TO BEG OF RECORD MOVEM T1,IRPTR(D) ;SAVE MOVING POINTER MOVE T1,IRSIZ(D) ;GET ENTRY SIZE MOVEM T1,IRCNT(D) ;SAVE IT ADDM T1,BYTN(D) ;SET TO POINT TO NEXT RECORD POPJ P, SUBTTL OUTPUT ;%OREC IS CALLED 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 AN INTERMEDIATE RECORD). %ORECS USES CODSP FOR ITS DISPATCH ;TABLE, WHICH, FOR ENCODE AND INTERNAL FILE OUTPUT, ;CALLS ENCODE OR IFOUT TO UPDATE THE RECORD POINTER/COUNT. %ORECS: AOS CREC(D) ;COUNT RECORD LOAD T1,CC(U) ;GET CARRIAGECONTROL PUSHJ P,CCTAB(T1) ;GO PREPARE OUTPUT RECORD BY CC TYPE LOAD T1,INDX(D) ;GET DEVICE INDEX PJRST ODSPS(T1) ;OUTPUT THE RECORD, CHECK INT FILE OVERRUN %OREC: AOS CREC(D) ;COUNT RECORD LOAD T1,CC(U) ;GET CARRIAGECONTROL PUSHJ P,CCTAB(T1) ;GO PREPARE OUTPUT RECORD BY CC TYPE LOAD T1,INDX(D) ;GET DEV INDEX PJRST ODSP(T1) ;OUTPUT THE RECORD, AS APPROPRIATE FOR DEV PUTSTR: SKIPG CHRCNT ;ANY CHARS TO GO? POPJ P, ;NO. NOTHING TO DO LOAD T1,INDX(D) ;GET DEVICE INDEX PUSHJ P,OSTR(T1) ;OUTPUT CHARS PJRST SEOFN ;GO SET EOFN OSTR: JRST TOSTR ;TTY JRST DOSTR ;DISK JRST DOSTR ;MAGTAPE JRST DOSTR ;OTHER JRST DOSTR ;REMOTE STREAM FILE JRST %RMSTR ;RMS FILE ;ORINI - RESETS THE POINTER/COUNT TO THE BEGINNING OF THE ;BUFFER FOR ALL "EXTERNAL" DEVICES (E.G. DISK, TTY) ORINI: SETZM ORLEN(D) ;CLEAR RECORD LENGTH SETZM ORPOS(D) ;CLEAR VIRTUAL POS MOVE T1,ORBEG(D) ;RESET BYTE POINTER MOVEM T1,ORPTR(D) MOVE T2,ORSIZ(D) ;RESET BYTE COUNT MOVEM T2,ORCNT(D) HRRZ T1,ORBUF(D) ;POINT TO RECORD BUFFER-1 ADDI T1,1 ;CORRECT IT MOVE T3,SPCWD(D) ;GET A WORD OF SPACES MOVEM T3,(T1) ;SET THE 1ST WORD MOVE T2,ORBLN(D) ;GET FULL BUFFER SIZE ADD T2,BPW(D) ;ROUND UP TO WORDS SUBI T2,1 IDIV T2,BPW(D) ;GET # WORDS IN RECORD CAIG T2,1 ;MORE THAN 1? POPJ P, ;NO. WE'RE DONE ADDI T2,-1(T1) ;GET END WORD ADDR HRLI T1,(T1) ;SETUP FOR BLT ADDI T1,1 BLT T1,(T2) ;FILL ENTIRE RECORD WITH SPACES POPJ P, ;DONE, READY FOR NEXT OUTPUT ODSP: JRST TOREC ;TTY JRST COREC ;DISK JRST MOREC ;MAGTAPE JRST COREC ;OTHER JRST COREC ;REMOTE STREAM FILE JRST %ORMS ;RMS FILE ODSPS: JRST TORECS ;TTY JRST CORECS ;DISK JRST MORECS ;MTA JRST CORECS ;OTHER JRST CORECS ;REMOTE STREAM FILE JRST %ORMS ;RMS FILE ;ERROR MESSAGE OUTPUT ;ARGS: T1 = ADDRESS OF ASCIZ MESSAGE STRING ;IF THE ERROR OUTPUT IS TO A FILE (U.ERR .NE. 0), THE ;ERROR MESSAGE IS OUTPUT DIRECTLY TO THE FILE, WITHOUT ;ATTENTION PAID TO THE FORMAT OF THE FILE. ;THUS IT PAYS NO ATTENTION TO WHETHER THE RECORDS ARE FIXED-LENGTH, ;WHETHER THE RECORDS REALLY WANT CRLFS AT THEIR END, ETC. %EOREC: SKIPE T1,U.ERR ;[4131] POINT TO ERR DDB CAMN T1,%UDBAD ;[4131] IF THE SAME AS UNIT WITH ERROR, USE TTY JRST ETTY ;USE PSOUT/OUTSTR PUSH P,U ;SAVE U AND D PUSH P,D PUSH P,%UDBAD ;[4156] SAVE CURRENT UDB ADDRESS SETZ F, ;NO FLAGS, PLEASE MOVE U,U.ERR ;GET UNIT BLOCK ADDR MOVEM U,%UDBAD ;SETUP FOR ERROR MSGS MOVE D,DDBAD(U) ;Set up D PUSHJ P,%SETOUT ;Set file open for output MOVE T1,FLAGS(D) ;GET DDB FLAGS TXNN T1,D%SEOL ;SUPPRESS LEADING CRLF? PUSHJ P,%OCRLF ;NO. MUST WANT ONE MOVE T1,%EOCNT ;GET COUNT MOVEM T1,CHRCNT ;SAVE COUNT MOVE T1,%EOPTR ;GET ERROR POINTER MOVEM T1,CHRPTR ;SAVE IT FOR PUTSTR PUSHJ P,PUTSTR ;OUTPUT THE ERROR STRING DIRECTLY PUSHJ P,%OCRLF ;END WITH CRLF, SUPPRESS NEXT LEADING ONE POP P,%UDBAD ;[4156] RESTORE UDB ADDRESS POP P,D ;RESTORE U AND D POP P,U POPJ P, ETTY: SKIPN T1,D.TTY ;ANY TTY DDB? JRST EPSOUT ;NO. JUST GO OUTPUT MESSAGE MOVE T0,FLAGS(T1) ;YES. GET FLAGS TXNE T0,D%SEOL ;Suppress CRLF? JRST EPSOUT ;YES. JUST GO OUTPUT MESSAGE IF20,< HRROI T1,%CRLF PSOUT% EPSOUT: MOVE T1,%EOPTR ;GET POINTER TO MESSAGE PSOUT% HRROI T1,%CRLF ;END WITH CRLF PSOUT% > ;END IF20 IF10,< OUTSTR %CRLF EPSOUT: MOVE T1,%EOPTR ;GET POINTER TO MESSAGE OUTSTR (T1) ;TYPE MESSAGE OUTSTR %CRLF ;END WITH CRLF > ;END IF10 SKIPN T1,D.TTY ;AGAIN, ANY TTY DDB? POPJ P, ;NO. DONE MOVX T2,D%SEOL ;SUPPRESS NEXT LEADING CRLF IORM T2,FLAGS(T1) POPJ P, ;DONE SEGMENT DATA %CUNIT: BLOCK 1 ;CURRENT UNIT IN USE ERPTR: BLOCK 1 ;ERROR MESSAGE POINTER SEGMENT CODE ;OUTPUT CARRIAGE CONTROL ;IF CARRIAGE CONTROL IS BEING DONE, SUBSTITUTES FOR FIRST CHAR ;IF FIXED-LENGTH RECORDS, PADS OR TRUNCATES RECORD TO CORRECT LENGTH ;THE CODE HERE IS REQUIRED TO SET OR CLEAR TWO FLAGS: D%SEOL, ;WHICH CONTROLS WHETHER ERROR MESSAGES ARE TO BE PRECEDED ;WITH A CRLF, AND D%PDOL, WHICH TELLS THIS ROUTINE ON THE ;NEXT RECORD WHETHER DOLLAR FORMAT WAS SPECIFIED IN THE ;CURRENT RECORD. CCTAB: $SNH ;CAN'T WAIT TILL NOW FOR CC JRST CCFOR ;FORTRAN JRST CCLST ;LIST JRST CCNON ;NONE JRST CCTRN ;TRANSLATED ;CC=NONE DOES EXACTLY THE SAME THING AS CC=LIST EXCEPT THAT ;FOR VARIABLE-LENGTH RECORDS THE CRLF IS NOT OUTPUT AND ;FOR FIXED-LENGTH RECORDS 2 NULLS ARE WRITTEN. CCNON: SETZM G.PRP ;ASSUME NO PROMPTING MOVX T1,D%SEOL ;DO NOT SUPPRESS NEXT CRLF ANDCAM T1,FLAGS(D) SKIPN RSIZE(D) ;FIXED-LENGTH RECORD? JRST VARNON ;NO PUSHJ P,SFLEN ;UPDATE LENGTH, PAD PUSHJ P,CHKDOL ;CHECK FOR DOLLAR FORMAT PUSHJ P,SETNUL ;WRITE 2 NULLS WHERE CRLF WOULD BE PUSHJ P,FIXEOL ;CLEAR UNUSED PART OF LAST WORD MOVE T1,FRSIZB(D) ;GET FULL RECORDSIZE MOVEM T1,ORLEN(D) ;SAVE RECORD LENGTH MOVEM T1,ORCNT(D) ;SAVE FOR OUTPUT MOVE T1,ORBUF(D) ;SETUP PNTR MOVEM T1,ORPTR(D) POPJ P, VARNON: PUSHJ P,SVLEN ;SET PNTR/COUNT TO END OF RECORD PUSHJ P,CHKDOL ;CHECK FOR $ FORMAT MOVE T1,ORBUF(D) ;SETUP PNTR/COUNT MOVEM T1,ORPTR(D) MOVE T1,ORLEN(D) MOVEM T1,ORCNT(D) POPJ P, ;CC=FORTRAN IS SIMILAR TO CC=LIST, EXCEPT THAT ;A NULL IS SUBSTITUTED FOR THE CHAR IN COLUMN 1 IF ;THE PREVIOUS RECORD HAD DOLLAR FORMAT. CCFOR: MOVE T1,FLAGS(D) ;GET DDB FLAGS TXNN T1,D%PDOL ;PREVIOUS RECORD HAVE DOLLAR FORMAT? JRST CCFORL ;NO SETZ T1, ;GET A NULL CHAR MOVE T2,ORBEG(D) ;GET BEGINNING OF RECORD IDPB T1,T2 ;SUBSTITUTE NULL FOR 1ST CHAR CCFORL: SKIPE %FLIDX ;[4100]FLAGGING ON? PUSHJ P,FLGCC ;[4100]YES. HANDLE COMPATIBILITY FLAGGING CCLST: SETZM G.PRP ;ASSUME NO PROMPTING SKIPN RSIZE(D) ;FIXED-LENGTH RECORD? JRST VARLST ;NO PUSHJ P,SFLEN ;UPDATE LENGTH, PAD PUSHJ P,STRCOM ;OUTPUT CRLF, HANDLE $ FORMAT PUSHJ P,CHKDOL ;CHECK FOR DOLLAR FORMAT PUSHJ P,FIXEOL ;CLEAR UNUSED PART OF LAST WORD MOVE T1,FRSIZB(D) ;GET FULL RECORDSIZE MOVEM T1,ORLEN(D) ;SAVE RECORD LENGTH MOVEM T1,ORCNT(D) ;SAVE FOR OUTPUT MOVE T1,ORBUF(D) ;SETUP PNTR MOVEM T1,ORPTR(D) POPJ P, VARLST: PUSHJ P,SVLEN ;SET PNTR/COUNT TO END OF RECORD PUSHJ P,STRCOM ;GO HANDLE $ FORMAT, PROMPTING, CRLF PUSHJ P,CHKDOL ;CHECK FOR $ FORMAT MOVE T1,ORBUF(D) ;SETUP PNTR/COUNT MOVEM T1,ORPTR(D) MOVE T1,ORLEN(D) MOVEM T1,ORCNT(D) POPJ P, ;CC=TRANSLATED. THE CHARACTER IN COLUMN 1 IS ACTUALLY TRANSLATED INTO ;THE CORRESPONDING CARRIAGE CONTROL CHARACTERS BEFORE OUTPUT. ;THIS IS HERE PRIMARILY FOR TTY'S, BUT CAN BE USED FOR OTHER ;DEVICES AS WELL. ;NOTE: THE CODE HERE ASSUMES THAT THE RECORDS ARE VARIABLE-LENGTH. ;FIXED-LENGTH RECORDS CANNOT BE SUPPORTED FOR CC=TRANSLATED, SINCE ;THE NUMBER OF CHARACTERS GENERATED BY THE CARRIAGE CONTROL TRANSLATION ;VARIES WIDELY. CCTRN: PUSHJ P,CCDOL ;CHECK FOR $ CARRIAGE CONTROL PUSHJ P,SVLEN ;UPDATE RECORD LENGTH PUSHJ P,CCOUT ;OUTPUT CC CHARS PUSHJ P,SETNUL ;AND END RECORD WITH NULLS PUSHJ P,CHKDOL ;CHECK FOR DOLLAR FORMAT MOVX T1,D%SEOL ;SETUP FOR LEADING CRLF ON ERROR MSGS ANDCAM T1,FLAGS(D) MOVE T1,ORBEG(D) ;GET POINTER TO RECORD IBP T1 ;INCR TO FIRST DATA CHARACTER MOVEM T1,G.PRP ;SAVE FOR PROMPT MOVEM T1,ORPTR(D) ;AND FOR OUTPUT ROUTINE MOVE T1,ORLEN(D) ;GET RECORD LENGTH SUBI T1,1 ;REDUCE 1 FOR CC CHAR MOVEM T1,ORCNT(D) ;SAVE FOR OUTPUT ROUTINE POPJ P, SVLEN: SKIPN ORPOS(D) ;CHARS DEPOSITED HERE? JRST SVOK ;YES. GO CHECK LENGTH MOVE T1,FLAGS(D) ;NO. $ FORMAT? TXNN T1,D%STCR JRST ENDSET ;NO. SET POINTER/COUNT TO PREVIOUS LENGTH SKIPL ORCNT(D) ;YES. BEYOND PHYSICAL RECORD? JRST SVOK ;NO. JUST RESET LENGTH MOVM T3,ORCNT(D) ;YES. EXPAND BUFFER PUSHJ P,EXPORB SVOK: MOVE T1,ORSIZ(D) ;CALCULATE CURRENT POSITION SUB T1,ORCNT(D) CAMGE T1,ORLEN(D) ;BEYOND OR AT PREVIOUSLY RECORDED LENGTH? JRST ENDSET ;NO. GO SET PNTR/COUNT TO END OF RECORD CAMG T1,ORLEN(D) ;BEYOND RECORDED LENGTH? POPJ P, ;NO. RIGHT AT END. NOTHING TO DO MOVEM T1,ORLEN(D) ;YES. RECORD NEW LENGTH SKIPE ORPOS(D) ;[4100]ARE THERE TRAILING SPACES PUSHJ P,FLGTS ;[4100]YES. DO COMPATIBILITY FLAGGING POPJ P, ; ; [4100] Compatibility flagging for "Trailing Spaces in output record" ; FLGTS: MOVEI T1,VAXIDX+ANSIDX;Flag this as an incompatibility for both. TDNE T1,%FLIDX ;Any flags the same? $ECALL CFT ;Yes. Display the error message POPJ P, ;End of Routine FLGTS SFLEN: SKIPN ORPOS(D) ;CHARS DEPOSITED HERE? JRST SFOK ;YES. GO CHECK LENGTH MOVE T1,FLAGS(D) ;NO. $ FORMAT? TXNN T1,D%STCR JRST ORPAD ;NO. PAD AT PREVIOUSLY RECORDED END SKIPL ORCNT(D) ;BEYOND PHYSICAL RECORD END? JRST SFOK ;NO. JUST CHECK LENGTH MOVE T1,RSIZE(D) ;YES. SET TO FIXED RECORDSIZE MOVEM T1,ORLEN(D) PJRST %SOPOS SFOK: MOVE T1,ORSIZ(D) ;CALCULATE CURRENT POSITION SUB T1,ORCNT(D) CAMGE T1,ORLEN(D) ;BEYOND OR AT PREVIOUSLY RECORDED LENGTH? JRST ORPAD ;NO. GO PAD IT THERE MOVEM T1,ORLEN(D) ;YES. SAVE NEW ONE CAMN T1,RSIZE(D) ;RECORD FILLED ALREADY? POPJ P, ;YES. NO NEED FOR PADDING! ORPAD: MOVE T4,ORLEN(D) ;GET RECORDED LENGTH MOVE T3,RSIZE(D) ;GET RECORD SIZE MOVEM T3,ORLEN(D) ;SAVE AS UPDATED LENGTH SUB T3,T4 ;GET AMOUNT OF PAD NEEDED JUMPLE T3,ENDSET ;IF NONE, LEAVE ADJBP T4,ORBEG(D) ;GET BYTE POINTER TO CURRENT LENGTH POINT SETZB T0,T1 ;NO SOURCE LOAD T2,PADCH(U) ;GET PAD CHAR MOVEM T2,%MSPAD ;SAVE FOR MOVSLJ EXTEND T0,%MSLJ ;PAD THE RECORD $SNH ENDSET: MOVE T1,ORLEN(D) ;GET LENGTH ADJBP T1,ORBEG(D) ;GET POINTER TO END OF RECORD MOVEM T1,ORPTR(D) ;SAVE IT MOVE T1,ORSIZ(D) ;GET BUFFER LENGTH SUB T1,ORLEN(D) ;GET # CHARS LEFT MOVEM T1,ORCNT(D) ;SAVE IT POPJ P, FIXDEL: LOAD T1,LTYP(D) ;GET LABEL TYPE CAIE T1,LT.UNL ;UNLABELED? POPJ P, ;NO. DON'T OUTPUT A DELIMITER CWOUT: MOVE T1,ORCNT(D) ;GET OUTPUT RECORD SIZE ADDI T1,4 ;PLUS DELIMITER SIZE CAMLE T1,ICNT(D) ;ROOM IN BUFFER FOR RECORD? PUSHJ P,OSBUF ;NO. OUTPUT CURRENT ONE, GET EMPTY ONE SETZ T0, ;1ST WORD OF INTEGER IS ZERO MOVE T1,ORCNT(D) ;2ND WORD IS RECORD SIZE ADDI T1,4 ;INCLUDE SIZE OF HEADER MOVEI T3,4 ;NUMBER OF BYTES TO CONVERT MOVE T4,IPTR(D) ;BEG OF RECORD TLO T3,400000 ;TURN ON LEADING PAD FLAG EXTEND T0,[EXP ,"0"] ;TRANSLATE TO ASCII CHARS $SNH ;SHOULDN'T HAPPEN MOVEM T4,IPTR(D) ;SAVE UPDATED POINTER MOVNI T1,4 ;DECREMENT BUFFER COUNT FOR DELIMITER ADDM T1,ICNT(D) POPJ P, CHKDOL: MOVE T1,FLAGS(D) ;GET DDB FLAGS TXZ T1,D%PDOL ;CLEAR PREV DOLLAR FORMAT TXZE T1,D%STCR ;DOLLAR FORMAT IN THIS RECORD? TXO T1,D%PDOL ;YES. SET FLAG FOR NEXT RECORD MOVEM T1,FLAGS(D) ;SAVE UPDATED FLAGS POPJ P, ;CCDOL - CHECK IF $ CARRIAGE CONTROL, WHICH IS SPACE CARRIAGE CONTROL ;AND $ FORMAT, I.E., SUPPRESS THE NEXT CRLF. CCDOL: MOVE T2,ORBEG(D) ;GET POINTER TO RECORD ILDB T3,T2 ;GET THE 1ST CHARACTER MOVX T1,D%STCR ;GET DOLLAR FORMAT BIT CAIN T3,"$" ;DOLLAR CARRIAGE CONTROL? IORM T1,FLAGS(D) ;YES. PRETEND WE GOT DOLLAR FORMAT POPJ P, ;CCOUT - TO GET CARRIAGE CONTROL CHARACTERS OUT BEFORE THE RECORD ;GOES OUT. FOR VARIABLE-LENGTH RECORDS, WE ONLY OUTPUT ;THE NUMBER OF CHARACTERS NECESSARY FOR THE CC CHARS. CCOUT: MOVE T1,FLAGS(D) ;GET DDB FLAGS TXNE T1,D%PDOL ;DOLLAR FORMAT IN PREVIOUS RECORD? POPJ P, ;YES. NO CARRIAGE CONTROL MOVE T2,ORBEG(D) ;GET POINTER TO RECORD ILDB T3,T2 ;GET THE 1ST CHARACTER JUMPE T3,%POPJ ;IF NULL, NO CARRIAGE CONTROL LOAD T1,INDX(D) ;GET DEVICE CAIE T1,DI.TTY ;TERMINAL? JRST NOSCC ;NO. NOTHING TO WORRY ABOUT CAIN T3,"*" ;YES. IS CC CHAR AN ASTERISK? MOVEI T3," " ;YES. SUBSTITUTE A SPACE MOVE T1,CCCTAB-" "(T3) ;[4100]GET COMPATIBILITY FLAGS TDNE T1,%FLIDX ;[4100]ANY FLAGS THE SAME? $ECALL CFC ;[4100]YES. OUTPUT MESSAGE IF INCOMPATIBLE NOSCC: CAIG T3,"3" ;IF OUT OF RANGE, TREAT AS SPACE CAIGE T3," " MOVEI T3," " ;SPACE IS JUST BEYOND LEGAL TABLE MOVE T4,CCPTR-" "(T3) ;GET POINTER TO CARRIAGE CONTROL STRING MOVE T5,CCLEN-" "(T3) ;GET # CHARS IN CC SUBSTITUTION MOVE T1,FLAGS(D) ;GET FLAG REG JUMPE T5,%POPJ ;NO OUTPUT IF NO CHARS MOVEM T5,CHRCNT ;SAVE PNTR/COUNT MOVEM T4,CHRPTR PJRST PUTSTR ;OUTPUT THE STRING ;FIXEOL - FOR FIXED-LENGTH STREAM RECORDS, ;OUTPUTS CRLF, CLEARS THE UNUSED BITS IN ;THE LAST DATA WORD. FIXEOL: LDB T1,[POINT 6,ORPTR(D),5] ;GET # BITS TO RIGHT OF DATA MOVE T1,RGTMSK(T1) ;GET MASK HRRZ T2,ORPTR(D) ;GET LOCAL ADDR ANDCAM T1,(T2) ;CLEAR BITS TO RIGHT OF DATA POPJ P, STRCOM: SKIPE RECTP(D) ;STREAM FILE? POPJ P, ;NO. DON'T OUTPUT CARRIAGE CONTROL MOVE T1,FLAGS(D) ;SEE IF $ FORMAT TXNN T1,D%STCR JRST LISTCR ;NO. GO OUTPUT CRLF, ADD 2 TO LENGTH MOVX T1,D%SEOL ;YES. NEED CRLF FOR INPUT, ERROR MSGS ANDCAM T1,FLAGS(D) ;SO CLEAR THE "SUPPRESS EOL" FLAG MOVE T1,ORBEG(D) ;GET RECORD POINTER MOVEM T1,G.PRP ;SAVE FOR PROMPT SETZ T1, ;APPEND 2 NULLS TO THE RECORD FOR PROMPTING PUSHJ P,%OBYTE PJRST %OBYTE ;[4156] MOVE SETNUL OUT OF THE STRCOM CODE AND DON'T OUTPUT THE NULLS ;IF RECORDTYPE IS NOT STREAM SETNUL: SKIPE RECTP(D) ;STREAM FILE? POPJ P, ;NO. DON'T OUTPUT THE DAMN NULLS SETZ T1, ;APPEND 2 NULLS TO THE RECORD FOR PROMPTING PUSHJ P,%OBYTE ;OR TO TAKE THE PLACE OF THE CRLF PJRST %OBYTE ;LISTCR - FOR CC=LIST, OUTPUT A CRLF AT THE END OF THE RECORD. LISTCR: MOVX T1,D%SEOL ;SUPPRESS CRLF FOR INPUT AND ERROR MSGS IORM T1,FLAGS(D) MOVEI T1,15 ;OUTPUT CR/LF PUSHJ P,%OBYTE MOVEI T1,12 PUSHJ P,%OBYTE MOVEI T1,2 ;INCREMENT LENGTH ADDM T1,ORLEN(D) POPJ P, ; [4100] ; FLGCC - Compatibility flagging for incompatible CarriageControl Characters. ; Check for Incompatibilities with the Carriage Control Character between the ; 20 and the VAX (and also extentions to the ANSI standard). ; FLGCC: MOVE T1,ORBEG(D) ;Get Byte Pointer to beginning of record ILDB T1,T1 ;Get the Carriage Control Character CAIG T1,"3" ;Is it a valid CC char? CAIGE T1," " ; MOVEI T1,"!" ;No, treat as an Ansi incompatibility MOVE T1,CCCTAB-" "(T1);Get the flags for this CC char. TDNE T1,%FLIDX ;Any flags the same? $ECALL CFC ;Yes. Display the error message POPJ P, ;End of routine FLGCC ; ; The carriage control character lookup table. The table contains two flags. ; Flags are VAXFLG(incompatible with VAX) and F77FLG(incompatible with ANSI). CCCTAB: 0 ;SPACE Compatible with Both ANSIDX ;! Not really a CC Char ANSIDX ;" Not really a CC Char ANSIDX ;# Not really a CC Char ANSIDX ;$ Not compatible with ANSI ANSIDX ;% Not really a CC Char ANSIDX ;& Not really a CC Char ANSIDX ;' Not really a CC Char ANSIDX ;( Not really a CC Char ANSIDX ;) Not really a CC Char ANSIDX ;* Not compatible with ANSI 0 ;+ Compatible both VAXIDX+ANSIDX ;, Not compatible either VAXIDX+ANSIDX ;- Not compatible either VAXIDX+ANSIDX ;. Not compatible either VAXIDX+ANSIDX ;/ Not compatible either 0 ;0 Compatible Both 0 ;1 Compatible Both VAXIDX+ANSIDX ;2 Not compatible either VAXIDX+ANSIDX ;3 Not compatible either CCPTR: POINT 7,[BYTE(7)%CR,%LF] ;SPACE : CR,LF POINT 7,[BYTE(7)%CR,%LF] ;! : CR,LF POINT 7,[BYTE(7)%CR,%LF] ;" : CR,LF POINT 7,[BYTE(7)%CR,%LF] ;# : CR,LF POINT 7,[BYTE(7)%CR,%LF] ;$ : CR,LF POINT 7,[BYTE(7)%CR,%LF] ;% : CR,LF POINT 7,[BYTE(7)%CR,%LF] ;& : CR,LF POINT 7,[BYTE(7)%CR,%LF] ;' : CR,LF POINT 7,[BYTE(7)%CR,%LF] ;( : CR,LF POINT 7,[BYTE(7)%CR,%LF] ;) : CR,LF POINT 7,[BYTE(7)%CR,%DC3] ;* : CR,DC3 POINT 7,[BYTE(7)%CR] ;+ : CR POINT 7,[BYTE(7)%CR,%DC1] ;, : CR,DC1 POINT 7,[BYTE(7)%CR,%LF,%LF,%LF] ;- : CR,LF,LF,LF POINT 7,[BYTE(7)%CR,%DC2] ;. : CR,DC2 POINT 7,[BYTE(7)%CR,%DC4] ;/ : CR,DC4 POINT 7,[BYTE(7)%CR,%LF,%LF] ;0 : CR,LF,LF POINT 7,[BYTE(7)%CR,%FF] ;1 : CR,FF POINT 7,[BYTE(7)%CR,%DC0] ;2 : CR,DC0 POINT 7,[BYTE(7)%CR,%VT] ;3 : CR,VT CCLEN: 2 ;SPACE : CR,LF 2 ;! : CR,LF 2 ;" : CR,LF 2 ;# : CR,LF 2 ;$ : CR,LF 2 ;% : CR,LF 2 ;& : CR,LF 2 ;' : CR,LF 2 ;( : CR,LF 2 ;) : CR,LF 2 ;* : CR,DC3 1 ;+ : CR 2 ;, : CR,DC1 4 ;- : CR,LF,LF,LF 2 ;. : CR,DC2 2 ;/ : CR,DC4 3 ;0 : CR,LF,LF 2 ;1 : CR,FF 2 ;2 : CR,DC0 2 ;3 : CR,VT ;ROUTINE TO NORMALIZE CRLF POSITION, BY TYPING PENDING CRLF, IF ANY ; ;WHEN WRITING A FILE WITH CC=TRANSLATED, 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: ; WHEN SWITCHING FROM OUTPUT TO INPUT ON TTY IF $ FORMAT NOT SPECIFIED. ; WHEN CLOSING THE TTY. ; WHEN DIVERTING ERROR MESSAGES TO A FILE %OCRLF: MOVX T0,D%SEOL ;Suppress next CRLF IORM T0,FLAGS(D) MOVEI T1,2 ;SET BYTE COUNT, PTR MOVEM T1,CHRCNT MOVE T1,[POINT 7,%CRLF] ;POINT TO CRLF MOVEM T1,CHRPTR SETZM G.PRP ;SET NO PROMPT STRING AVAILABLE PJRST PUTSTR ;OUTPUT THE CRLF CORECS: PUSHJ P,COREC ;DO IT PJRST ORINI ;AND INITIALIZE THE POINTER/COUNT COREC: SKIPE FRSIZW(D) ;STREAM FIXED-LENGTH RECORDS? JRST OUTBLT ;YES. BLT THE RECORD OUT SKIPG ORCNT(D) ;ANYTHING IN RECORD? POPJ P, ;NO. LEAVE JRST COCONT ;SKIP UPDATING CODE COUTLP: MOVEM T0,ORCNT(D) ;SAVE UPDATED REC COUNT MOVEM T1,ORPTR(D) ;AND POINTER MOVEM T4,IPTR(D) ;SAVE UPDATED BUFFER PNTR COCONT: SKIPG ICNT(D) ;ANY ROOM IN WINDOW? PUSHJ P,ONXTW ;NO ROOM, OUTPUT A BUFFERFUL MOVE T0,ORCNT(D) ;GET RECORD PNTR/COUNT MOVE T1,ORPTR(D) MOVE T3,ICNT(D) ;GET WINDOW PNTR/COUNT MOVE T4,IPTR(D) CAIGE T0,(T3) ;SOURCE .GE. DEST? MOVE T3,T0 ;NO. RESTRICT DEST TO PREVENT FILL MOVNI T2,(T3) ;UPDATE COUNT NOW, AS MOVSLJ CLEARS IT ADDM T2,ICNT(D) EXTEND T0,[EXP ,0] ;MOVE RECORD JRST COUTLP ;LOOP IF TRUNCATED MOVEM T4,IPTR(D) SEOFN: MOVE T1,BYTN(D) ;GET BYTE # OF NEXT WINDOW SUB T1,ICNT(D) ;GET LAST BYTE IN USE SKIPE WTAB(D) ;RANDOM FILE? CAMLE T1,EOFN(D) ;YES. ONLY STORE LARGER EOFN MOVEM T1,EOFN(D) ;SAVE AS EOF PNTR POPJ P, ;DONE OUTBLT: MOVE T1,FRSIZW(D) ;GET RECORDSIZE MOVEM T1,LOCSIZ ;SAVE FOR TRANSFER OUTBLP: MOVE T4,ICNT(D) ;GET BUFFER COUNT IDIV T4,BPW(D) ;GET # WORDS LEFT JUMPG T4,OUTBOK ;OK IF SOME PUSHJ P,ONXTW ;GET MORE IF NONE MOVE T4,ICNT(D) ;GET NEW COUNT IDIV T4,BPW(D) ;IN WORDS OUTBOK: MOVE T3,LOCSIZ ;GET # WORDS TO TRANSFER CAILE T3,(T4) ;.GT. NUMBER OF WORDS IN BUFFER MOVEI T3,(T4) ;YES. USE THE SMALLER ONE HRRZ T5,IPTR(D) ;GET OUTPUT BUFFER ADDR-1 ADDI T5,1 ;CORRECT IT HRRZ T1,ORPTR(D) ;GET RECORD ADDR-1 HRLZI T1,1(T1) ;GET ITS ADDRESS AS SOURCE HRRI T1,(T5) ;DESTINATION IS OUTPUT BUFFER ADDI T5,-1(T3) ;GET FINAL DEST BLT T1,(T5) ;TRANSFER THE WORDS ADDM T3,ORPTR(D) ;UPDATE RECORD PNTR ADDM T3,IPTR(D) ;AND BUFFER POINTER SUBI T4,(T3) ;AND BUFFER WORD COUNT IMUL T4,BPW(D) ;UPDATE COUNT MOVEM T4,ICNT(D) MOVNI T3,(T3) ;GET NEG # WORDS TRANSFERRED ADDB T3,LOCSIZ ;UPDATE TOTAL NUMBER JUMPG T3,OUTBLP ;IF MORE, TRY FOR MORE MOVE T1,BYTN(D) ;GET BYTE # OF NEXT WINDOW SUB T1,ICNT(D) ;GET LAST BYTE IN USE SKIPE WTAB(D) ;RANDOM FILE? CAMLE T1,EOFN(D) ;YES. ONLY STORE LARGER EOFN MOVEM T1,EOFN(D) ;SAVE AS EOF PNTR POPJ P, IF10,< TOSTR: PUSHJ P,DOSTR ;PUT THE CHARS IN THE BUFFER PJRST OSBUF ;GO OUTPUT BUFFER > ;END IF10 DOSTR: DSTRLP: SKIPG ICNT(D) ;ANY ROOM LEFT IN BUFFER? PUSHJ P,ONXTW ;NO. GET NEW WINDOW SOS ICNT(D) ;DECR COUNT ILDB T1,CHRPTR ;GET A CHAR IDPB T1,IPTR(D) ;DEPOSIT IN FILE BUFFER SOSLE CHRCNT ;DECR COUNT JRST DSTRLP ;BACK FOR MORE MOVE T1,BYTN(D) ;UPDATE EOFN SUB T1,ICNT(D) MOVEM T1,EOFN(D) POPJ P, ;MTA OUTPUT ROUTINES MORECS: PUSHJ P,MOREC ;OUTPUT RECORD PJRST ORINI ;INITIALIZE THE POINTER/COUNT IF10,< MOREC: SKIPN T1,RECTP(D) ;STREAM FILE? JRST COREC ;YES. JUST OUTPUT THE DATA CAIN T1,RT.DEL ;DELIMITED? PUSHJ P,CWOUT ;YES. PUT CONTROL WORD INTO BUFFER PJRST COREC ;NOW PUT DATA INTO BUFFER > ;END IF10 IF20,< MOREC: SKIPN T1,RECTP(D) ;STREAM FILE? JRST COREC ;YES. JUST OUTPUT THE DATA CAIN T1,RT.DEL ;DELIMITED? PUSHJ P,FIXDEL ;YES. PUT CONTROL WORD INTO BUFFER PUSHJ P,COREC ;NOW PUT DATA INTO BUFFER LOAD T1,LTYP(D) ;GET LABEL TYPE CAIE T1,LT.UNL ;LABELED TAPE? PUSHJ P,OSBUF ;YES. OUTPUT SINGLE RECORD POPJ P, > ;END IF20 ;TTY OUTPUT ROUTINES IF10,< TORECS: PUSHJ P,COREC ;PUT RECORD INTO BUFFER PUSHJ P,OSBUF ;OUTPUT RECORD PJRST ORINI ;INITIALIZE THE POINTER/COUNT TOREC: PUSHJ P,COREC ;PUT THE RECORD INTO THE OUTPUT BUFFER PJRST OSBUF ;OUTPUT THE RECORD >;END IF10 IF20,< TORECS: PUSHJ P,TOREC ;OUTPUT THE RECORD PJRST ORINI ;GO INIT THE POINTER/COUNT TOREC: SKIPG ORCNT(D) ;ANY DATA IN RECORD? POPJ P, ;NO. NOTHING TO DO MOVE T1,OJFN(D) ;GET JFN RFCOC% ;SAVE CCOC WORDS FOR USE DURING TEXTI DMOVEM T2,TCCOC ;SAVE TEMPORARILY AND T2,%CCMSK ;SET CCOC FOR CORRECT OUTPUT IOR T2,%OCCOC ;LEAVE ^I AND ^L AS THEY WERE, SET OTHERS MOVE T3,%OCCOC+1 ; TO SEND LITERALLY SFCOC% MOVE T1,OJFN(D) ;GET JFN MOVE T2,ORPTR(D) ;GET POINTER TO START OF RECORD MOVN T3,ORCNT(D) ;GET NEGATIVE OF BYTE COUNT MOVE T1,OJFN(D) ;GET JFN SOUTR% ;OUTPUT THE STRING ERJMP OUTERR ;ERROR, GO TELL USER MOVE T1,OJFN(D) ;GET JFN AGAIN DMOVE T2,TCCOC ;GET ORIGINAL CONTENTS SFCOC% ;RESTORE CCOC WORDS POPJ P, ;DONE TOSTR: MOVE T1,OJFN(D) ;GET JFN RFCOC% ;SAVE CCOC WORDS FOR USE DURING TEXTI DMOVEM T2,TCCOC ;SAVE TEMPORARILY AND T2,%CCMSK ;SET CCOC FOR CORRECT OUTPUT IOR T2,%OCCOC ;LEAVE ^I AND ^L AS THEY WERE, SET OTHERS MOVE T3,%OCCOC+1 ; TO SEND LITERALLY SFCOC% MOVE T1,OJFN(D) ;GET JFN MOVE T2,CHRPTR ;GET POINTER MOVN T3,CHRCNT ;AND COUNT SOUTR% ;OUTPUT THE STRING ERJMP OUTERR ;ERROR, GO TELL USER MOVE T1,OJFN(D) ;GET JFN AGAIN DMOVE T2,TCCOC ;GET ORIGINAL CONTENTS SFCOC% ;RESTORE CCOC WORDS POPJ P, >;END IF20 ;ENCODE ENCINI: XMOVEI T1,@A.HSA ;GET STRING ADDR $BLDBP T1 ;Build 7-bit byte ptr. LDB T2,[POINTR A.HSA,ARGTYP] ;GET ARRAY TYPE CAIN T2,TP%CHR ;CHARACTER? MOVE T1,@A.HSA ;YES. GET THE POINTER MOVEM T1,ORPTR(D) MOVEM T1,ORBUF(D) MOVEM T1,ORBEG(D) SKIPG T1,@A.HSL ;GET STRING LENGTH $ACALL SLN ;RECORD LENGTH NOT POSITIVE MOVEM T1,ORCNT(D) MOVEM T1,RSIZE(D) ;AND RECORD SIZE MOVEM T1,ORBLN(D) ;AND REC BUFFER LENGTH MOVEM T1,ORSIZ(D) MOVEM T1,BYTN(D) ;SET NEXT RECORD START MOVEM T1,ORLEN(D) ;AND RECORD LENGTH PJRST EFILL ;GO FILL WITH BLANKS ENCODE: MOVE T1,BYTN(D) ;GET NEXT RECORD START ADJBP T1,ORBUF(D) ;MOVE THE POINTER MOVEM T1,ORBEG(D) ;SAVE PNTR TO BEG OF RECORD MOVEM T1,ORPTR(D) ;AND MOVING POINTER MOVE T1,ORSIZ(D) ;GET RECORD LENGTH MOVEM T1,ORCNT(D) ;SAVE IN MOVING LENGTH ADDM T1,BYTN(D) ;UPDATE NEXT RECORD START PJRST EFILL ;GO FILL WITH BLANKS ;INTERNAL FILE OUTPUT INITIALIZATION. SIMILAR TO INPUT. ;SETUP THE POINTER/COUNT TO THE BEGINNING OF THE CHARACTER ;VARIABLE OR ARRAY. IFOINI: XMOVEI T1,@A.UNIT ;GET DESCRIPTOR ADDRESS MOVE T2,(T1) ;GET BYTE POINTER MOVEM T2,ORBUF(D) ;SAVE AS BASE POINTER MOVEM T2,ORBEG(D) MOVEM T2,ORPTR(D) ;AND MOVING POINTER MOVE T2,1(T1) ;GET SIZE MOVEM T2,ORBLN(D) ;SAVE AS BUFFER SIZE MOVEM T2,ORSIZ(D) MOVEM T2,ORCNT(D) ;AND MOVING SIZE MOVEM T2,ORLEN(D) ;AND RECORD LENGTH MOVEM T2,RSIZE(D) ;AND RECORD SIZE MOVEM T2,BYTN(D) ;SET NEXT RECORD START MOVE T3,@A.HSL ;GET TOTAL # CHARS IN ARRAY SKIPN A.HSL ;UNLESS THERE IS NO KEYWORD MOVE T3,1(T1) ;NONE. GET IT FROM THE DESCRIPTOR MOVEM T3,EOFN(D) ;SAVE TO PREVENT OVERRUN JUMPG T3,EFILL ;GO SPACE-FILL IF NON-ZERO $ACALL ICE ;ILLEGAL CHARACTER EXPRESSION ;INTERNAL FILE OUTPUT - MOVES THE POINTERS AND RESETS THE COUNT ;ONLY CALLED BY FORMATS WITH "/" OR INDEFINITE REPEAT. ;FILLS THE NEXT RECORD WITH SPACES. ;IF THE NEW RECORD IS BEYOND THE BOUNDS OF THE VARIABLE ;OR ARRAY, REPORT A FATAL ERROR. IFOUT: MOVE T1,BYTN(D) ;GET NEXT RECORD START CAML T1,EOFN(D) ;PAST END OF ARRAY? $ACALL WBA ;YES. WRITING BEYOND END OF ARRAY ADJBP T1,ORBUF(D) ;MOVE THE POINTER MOVEM T1,ORBEG(D) ;SAVE POINTER TO BEG OF RECORD MOVEM T1,ORPTR(D) ;AND MOVING POINTER MOVE T1,ORSIZ(D) ;GET RECORD LENGTH MOVEM T1,ORCNT(D) ;SAVE IN MOVING LENGTH ADDM T1,BYTN(D) ;UPDATE NEXT RECORD START EFILL: SETZB T0,T1 ;NO SOURCE MOVE T3,ORSIZ(D) ;GET LENGTH OF ENTRY MOVE T4,ORPTR(D) ;AND POINTER EXTEND T0,[EXP ," "];FILL WITH BLANKS $SNH ;SHOULD SKIP RETURN ALWAYS POPJ P, SUBTTL T FORMAT AND POSITIONING ROUTINES ;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 %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,ORSIZ(D) ;GET RECORD BUFFER LENGTH SUB T1,ORCNT(D) ;SUBTRACT EMPTY SPACE ADDI T1,1 ;BEG OF RECORD IS COL 1 POPJ P, ;RETURN WITH BYTE NUMBER ;ROUTINE TO GET THE BYTE POINTER/COUNT FOR THE OUTPUT RECORD BUFFER. ;IF IT IS A VARIABLE-LENGTH RECORD, RETURNS INFINITY FOR COUNT. ;RETURN: T0 = BYTE POINTER TO NEXT CHARACTER IN RECORD ; T1 = COUNT OF BYTES LEFT IN RECORD %GOPTR: HLRZ T1,ORPTR(D) ;GET POINTER TO NEXT CHAR SKIPE %FSECT ;RUNNING IN NON-ZERO SECTION? CAILE T1,444400 ;LOCAL? JRST BPOK ;NO. OK AS IS LDB T1,[POINT 6,ORPTR(D),11] ;GET BYTESIZE MOVE T2,%OWGBT(T1) ;GET END OF WORD BYTE POINTER LDB T3,[POINT 6,ORPTR(D),5] ;GET POSITION IDIVI T3,(T1) ;GET # BYTES LEFT IN WORD LSH T3,^D30 ;SHIFT TO ADD TO OWG BASE SUB T2,T3 ;ADD IT HRRZ T3,ORPTR(D) ;GET JUST THE LOCAL ADDRESS XMOVEI T3,(T3) ;GET EXTENDED ADDR IOR T2,T3 ;CREATE THE OWGBP MOVE T0,T2 ;PUT IT WHERE IT BELONGS JRST GOTBP ;SKIP LOADING POINTER BPOK: MOVE T0,ORPTR(D) ;GET BYTE POINTER GOTBP: MOVE T1,ORCNT(D) ;GET COUNT LEFT SKIPN RSIZE(D) ;FIXED-LENGTH RECORDS? HRLOI T1,377777 ;NO. RETURN INFINITY POPJ P, ;ROUTINE TO SET RECORD POSITION ;ARG: T1 = BYTE NUMBER ;SETS SO THAT NEXT IBYTE/OBYTE CALL GETS OR STORES THE GIVEN BYTE %CIPOS: MOVE T2,IRLEN(D) ;GET BUFFER SIZE SUB T2,IRCNT(D) ;CALC CURRENT POSITION ADD T1,T2 ;CALC DESIRED POSITION JUMPGE T1,SIPOK ;OK IF POS OR ZERO SETZ T1, ;ELSE SET IT TO ZERO JRST SIPOK %SIPOS: SOJGE T1,SIPOK ;OK IF POSITIVE, DECR TO 1 BEFORE IT SETZ T1, ;ELSE USE ZERO SIPOK: MOVE T2,IRLEN(D) ;GET BUFFER SIZE SUB T2,T1 ;CALC # CHARS LEFT IN RECORD MOVEM T2,IRCNT(D) ;SAVE IT ADJBP T1,IRBEG(D) ;FIX POINTER MOVEM T1,IRPTR(D) ;SAVE IT POPJ P, %COPOS: MOVE T2,ORSIZ(D) ;CALC CURRENT POSITION SUB T2,ORCNT(D) ADD T1,T2 ;CALC DESIRED DESTINATION JUMPGE T1,CHKPOS ;OK IF POS OR ZERO SETZ T1, ;MAKE IT ZERO IF NOT JRST CHKPOS %SOPOS: SOJGE T1,SOPOK ;OK IF POS, DECR TO 1 BEFORE IT SETZ T1, ;ELSE USE BEG OF RECORD SOPOK: MOVE T2,ORSIZ(D) ;GET BUFFER SIZE SUB T2,ORCNT(D) ;GET CURRENT POSITION CHKPOS: SKIPE ORPOS(D) ;CHARS DEPOSITED HERE? JRST NOULEN ;NO. DON'T UPDATE RECORDED LENGTH CAMLE T2,ORLEN(D) ;YES. BEYOND LAST RECORDED LENGTH? MOVEM T2,ORLEN(D) ;YES. SAVE NEW ONE NOULEN: SETOM ORPOS(D) ;FLAG CHARS NOT DEPOSITED HERE MOVE T2,ORSIZ(D) ;GET DATA BUFFER SIZE SUBI T2,(T1) ;CALC COUNT OF CHARS LEFT MOVEM T2,ORCNT(D) ;AND SAVE IT ADJBP T1,ORBEG(D) ;FIX POINTER MOVEM T1,ORPTR(D) ;SAVE IT POPJ P, SEGMENT DATA TCCOC: BLOCK 2 ;CURRENT CCOC WORDS CHRPTR: BLOCK 1 ;STRING BYTE POINTER CHRCNT: BLOCK 1 ;COUNT SEGMENT CODE SUBTTL UNFORMATTED I/O UISET: XMOVEI T1,UNFI ;SETUP FOR IOLST CALLS MOVEM T1,IOSUB(D) XMOVEI T1,UIEND ;SETUP FOR FIN CALL MOVEM T1,IOFIN(D) AOS CREC(D) ;UPDATE RECORD COUNT PUSHJ P,ILSCW1 ;READ START LSCW $ACALL EOF ;EOF. SETZM RECREM ;CLEAR CHAR REMAINDER POPJ P, UIASC: XMOVEI T1,UNFI ;SETUP FOR IOLST CALLS MOVEM T1,IOSUB(D) XMOVEI T1,%SETAV ;AND FOR FIN CALL MOVEM T1,IOFIN(D) POPJ P, UNFI: MOVE T1,IO.TYP ;GET TYPE CAIN T1,TP%CHR ;CHARACTER? JRST UICHR ;YES. GO DO IT SETZM RECREM ;CLEAR CHAR REMAINDER MOVE T1,IO.SIZ ;GET DATA SIZE CAME T1,IO.INC ;IS IT THE SIMPLE CASE? JRST UIWRD ;NO. MUST BE DONE WORD BY WORD IMUL T1,IO.NUM ;CALC # WORDS MOVEM T1,IO.SIZ ;SAVE AS DATA SIZE MOVEI T1,1 ;SET DATA COUNT TO 1 MOVEM T1,IO.NUM SETZM IO.INC ;WITH NO INCREMENT JRST UIBLP ;GO DO THE BLT UIWRD: MOVN T1,IO.SIZ ;ACCOUNT FOR THE INCREMENT ADDM T1,IO.INC ;DONE FOR EACH ENTRY AUTOMATICALLY UIBLP: MOVE T1,IO.SIZ ;GET DATA SIZE MOVEM T1,LOCSIZ ;SET LOCAL SIZE UIBLP1: SKIPLE RECLEN ;ANY WORDS LEFT IN SEGMENT? JRST UIWIN ;YES. GO DO BLT PUSHJ P,ILSCWX ;NO. READ A NEW SEGMENT JUMPLE T1,UIZERO ;NO DATA LEFT IF .LE. ZERO UIWIN: PUSHJ P,UIALIN ;ALIGN THE PNTR/COUNT DMOVE P1,IPTR(D) ;GET THE PNTR/COUNT IDIV P2,BPW(D) ;GET # WORDS LEFT JUMPG P2,UIBLT ;IF DATA LEFT IN WINDOW, CONTINUE WITH IT PUSHJ P,UINXTW ;READ NEXT WINDOW $ACALL EOF ;REPORT EOF IMMEDIATELY DMOVE P1,IPTR(D) ;GET PNTR/COUNT AGAIN IDIV P2,BPW(D) ;GET # WORDS LEFT UIBLT: MOVE T2,LOCSIZ ;GET MIN OF ARRAY LENGTH CAILE T2,(P2) ; AND WINDOW LENGTH MOVEI T2,(P2) CAMLE T2,RECLEN ; AND RECORD LENGTH MOVE T2,RECLEN ;IO.ADR/ Address of data ;P1/ local FOROTS address of data ;T2/ number of words to copy MOVE T1,IO.ADR ;GET USER'S ARRAY ADDR TLNN T1,-1 ;Extended addressing? JRST UIBLT1 ;No, normal BLT MOVE T3,T2 ;COPY # WORDS TO BLT MOVEI T4,(P1) ;GET LOCAL ADDR XMOVEI T4,1(T4) ;T4/ "From" -- get FOROTS address of data MOVE T5,IO.ADR ;T5/ "To"-- user's array. EXTEND T3,[XBLT] ;** Copy the data ** JRST UIBLT2 ;Skip normal BLT UIBLT1: MOVE T1,IO.ADR ;GET ARRAY ADDRESS 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: MOVNI P2,(T2) ;GET NEGATIVE # WORDS TRANSFERED IMUL P2,BPW(D) ;GET # CHARS ADDM P2,ICNT(D) ;DECREMENT COUNT ADDM T2,IPTR(D) ;INCREMENT BUFFER POINTER ADDM T2,IO.ADR ;INCR DATA ADDR MOVNI T2,(T2) ;GET NEG # WORDS TRANSFERRED ADDM T2,RECLEN ;AND RECORD LENGTH ADDB T2,LOCSIZ ;AND NUMBER OF WORDS OF DATA JUMPG T2,UIBLP1 ;IF SOME LEFT, CONTINUE MOVE T1,IO.INC ;GET INCREMENT ADDM T1,IO.ADR ;ADD TO DATA ADDRESS SOSLE T1,IO.NUM ;DECR COUNT JRST UIBLP ;MORE TO DO POPJ P, ;ELSE RETURN UIZLP: MOVE T1,IO.SIZ ;GET DATA SIZE MOVEM T1,LOCSIZ ;SAVE IT LOCALLY UIZERO: MOVE T1,IO.ADR ;GET DATA ADDRESS SETZM (T1) ;CLEAR FIRST WORD MOVE T2,LOCSIZ ;GET # WORDS TO CLEAR CAIG T2,1 ;MORE THAN 1 WORD? POPJ P, ;NO. DONE TLNN T1,-1 ;Extended addressing? JRST UZSKP1 ;No, normal BLT MOVE T3,T2 ;T2/ # words to copy SUBI T3,1 ;ALREADY CLEARED ONE MOVE T4,T1 ;t3/ "from" the array XMOVEI T5,1(T1) ;T4/ "to" array+1 EXTEND T3,[XBLT] ;** Zero array ** JRST UIZINC ;DONE WITH THIS BATCH UZSKP1: MOVSI T4,(T1) ;SET BLT-FROM ADDRESS HRRI T4,1(T1) ;AND BLT-TO ADDRESS ADDI T1,(T2) ;POINT TO END+1 OF BLT BLT T4,-1(T1) ;CLEAR WHOLE ARRAY UIZINC: MOVE T1,IO.INC ;GET INCREMENT ADDM T1,IO.ADR ;INCR DATA ADDR SOSLE IO.NUM ;DECR DATA COUNT JRST UIZLP ;MORE TO DO POPJ P, ;DONE UICHR: MOVE T1,RECLEN ;GET # WORDS LEFT IN RECORD IMUL T1,BPW(D) ;GET # CHARS ADD T1,RECREM ;ADD PREVIOUS REMAINDER MOVEM T1,LOCREC ;SAVE LOCAL RECORD LENGTH MOVE T1,IO.SIZ ;GET SIZE CAME T1,IO.INC ;SIMPLE CASE? JRST UICHR1 ;NO. DO IT CHAR BY CHAR IMUL T1,IO.NUM ;GET TOTAL # CHARS MOVEM T1,IO.SIZ ;MAKE IT LOOK LIKE 1 BIG VARIABLE MOVEI T1,1 ;DATA COUNT OF 1 MOVEM T1,IO.NUM SETZM IO.INC ;NO INCREMENT NECESSARY JRST UICBLP ;GO DO THE BLT UICHR1: MOVN T1,IO.SIZ ;ACCOUNT FOR THE INCREMENT DONE ADDM T1,IO.INC ;DONE FOR EACH ENTRY AUTOMATICALLY UICBLP: MOVE T1,IO.SIZ ;GET ENTRY SIZE MOVEM T1,LOCSIZ ;SET UP LOCAL ONE UICBL1: SKIPLE LOCREC ;ANY DATA LEFT IN SEGMENT? JRST UICWIN ;YES. GO TRANSFER A CHAR PUSHJ P,ILSCWX ;NO. GET A NEW SEGMENT JUMPLE T1,UICBZ ;NO NEW DATA FOUND IF .LE. ZERO IMUL T1,BPW(D) ;GET # CHARS MOVEM T1,LOCREC ;SAVE IT UICWIN: SKIPLE ICNT(D) ;ANY CHARS IN WINDOW JRST UICBLT ;YES. GO TRANSFER SOME PUSHJ P,UINXTW ;NO. GET A NEW WINDOW $ACALL EOF ;EOF. REPORT IT IMMEDIATELY UICBLT: MOVE T0,ICNT(D) ;GET MINIMUM OF WINDOW COUNT CAMLE T0,LOCREC ;AND CHARS IN RECORD MOVE T0,LOCREC CAMLE T0,LOCSIZ ;AND NUMBER OF CHARS TO TRANSFER MOVE T0,LOCSIZ MOVEM T0,LOCNUM ;SAVE IT MOVE T1,IPTR(D) ;GET THE INPUT PNTR MOVE T3,T0 ;COPY THE COUNT MOVE T4,T0 ;AND AGAIN ADJBP T4,IO.ADR ;GET UPDATED POINTER EXCH T4,IO.ADR ;SAVE UPDATED POINTER, GET ORIGINAL ONE EXTEND T0,[EXP ,0] ;MOVE STRING LEFT-JUSTIFIED, ZERO FILL $SNH ;SHOULD SKIP RETURN MOVEM T1,IPTR(D) ;SAVE UPDATED BUFFER PNTR MOVN T1,LOCNUM ;GET NEGATIVE CHARS TRANSFERRED ADDM T1,LOCREC ;UPDATE # CHARS LEFT IN RECORD ADDM T1,ICNT(D) ;UPDATE # CHARS LEFT IN WINDOW ADDB T1,LOCSIZ ;UPDATE TOTAL # CHARS TO TRANSFER JUMPG T1,UICBL1 ;LOOP IF MORE TO TRANSFER SKIPN T1,IO.INC ;GET INCREMENT JRST UICNI ;NONE ADJBP T1,IO.ADR ;UPDATE PNTR MOVEM T1,IO.ADR ;AND SAVE IT UICNI: SOSLE IO.NUM ;ANY MORE ENTRIES? JRST UICBLP ;YES. GO DO THEM MOVE T1,LOCREC ;GET LOCAL RECORD LENGTH LEFT IDIV T1,BPW(D) ;GET WORDS AND BYTES DMOVEM T1,RECLEN ;SAVE FOR NEXT CALL POPJ P, ;NO. DONE WITH IOLST CALL UICBZL: MOVE T1,IO.SIZ ;GET ENTRY SIZE MOVEM T1,LOCSIZ ;SAVE LOCALLY UICBZ: SETZB T0,T1 ;NO SOURCE MOVE T3,LOCSIZ ;DESTINATION # CHARS MOVE T4,IO.ADR ;DEST PNTR EXTEND [EXP ," "] ;FILL WITH SPACES $SNH ;SHOULD SKIP RETURN SKIPN T1,IO.INC ;GET INCREMENT JRST UICZNI ;NONE ADJBP T1,IO.ADR ;UPDATE THE PNTR MOVEM T1,IO.ADR ;SAVE IT BACK UICZNI: SOSLE IO.NUM ;ANY MORE ENTRIES? JRST UICBZL ;YES. GO FILL THEM SETZM RECLEN ;CLEAR THE RECORD LENGTH SETZM RECREM ;AND THE BYTE REMAINDER POPJ P, UIEND: PUSHJ P,ILSCW3 ;SKIP TO END LSCW MOVE T0,FLAGS(D) ;Get DDB flags TXNN T0,D%END ;REACH EOF? PJRST %SETAV ;NO. RETURN TO USER PROG SKIPN IMGFLG(D) ;[4161] IS IT IMAGE MODE? $ACALL BBF ;NO. BAD FORMAT $ACALL EOF ;YES. JUST EOF UINXTW: PUSHJ P,INXTW ;MAP NEXT WINDOW MOVE T0,FLAGS(D) TXNN T0,D%END ;SEQUENTIAL FILE AND EOF? AOS (P) ;NO. SKIP RETURN POPJ P, ;YES. JUST RETURN NON-SKIP ;IMAGE-MODE TTY UISTTY: XMOVEI T1,UITTY ;DO TEXTI DIRECTLY TO VARIABLES MOVEM T1,IOSUB(D) XMOVEI T1,%SETAV ;DO NOTHING ON FIN CALL MOVEM T1,IOFIN(D) POPJ P, UITTY: PUSHJ P,UOSCC ;SETUP CCOC WORDS FOR LITERAL ECHO MOVE T1,IO.TYP ;GET DATA TYPE CAIN T1,TP%CHR ;CHARACTER? JRST UITCHR ;YES MOVE T1,IO.SIZ ;GET DATA SIZE CAME T1,IO.INC ;IS IT THE SIMPLE CASE? JRST UITWRD ;NO. MUST BE DONE WORD BY WORD IMUL T1,IO.NUM ;CALC # WORDS MOVEM T1,IO.SIZ ;SAVE AS DATA SIZE MOVEI T1,1 ;SET DATA COUNT TO 1 MOVEM T1,IO.NUM SETZM IO.INC ;WITH NO INCREMENT UITWRD: MOVE T1,IO.ADR ;GET DATA ADDR MOVEM T1,LOCPTR ;SAVE IT MOVE T1,IO.SIZ ;GET # WORDS MOVEM T1,LOCSIZ ;SAVE IT PUSHJ P,UITBIN ;DO ONE CHARACTER PER WORD MOVE T1,IO.INC ;GET INCREMENT ADDM T1,IO.ADR ;INCR DATA ADDR SOSLE IO.NUM ;DECR COUNT JRST UITWRD ;LOOP PJRST UORCC ;GO RESTORE CCOC WORDS UITCHR: MOVE T1,IO.SIZ ;GET SIZE CAME T1,IO.INC ;SIMPLE CASE? JRST UITCH1 ;NO. DO IT CHAR BY CHAR IMUL T1,IO.NUM ;GET TOTAL # CHARS MOVEM T1,IO.SIZ ;MAKE IT LOOK LIKE 1 BIG VARIABLE MOVEI T1,1 ;DATA COUNT OF 1 MOVEM T1,IO.NUM SETZM IO.INC ;NO INCREMENT NECESSARY UITCH1: MOVE T1,IO.SIZ ;GET SIZE MOVEM T1,LOCSIZ ;SAVE IT LOCALLY MOVE T1,IO.ADR ;GET POINTER MOVEM T1,LOCPTR ;SAVE IT PUSHJ P,UITXTI ;DO TEXTI MOVE T1,IO.INC ;GET INCREMENT ADJBP T1,IO.ADR ;UPDATE POINTER MOVEM T1,IO.ADR SOSLE IO.NUM ;DECR COUNT JRST UITCH1 PJRST UORCC ;GO RESTORE CCOC WORDS IF20,< UITBIN: MOVE T1,IJFN(D) ;GET JFN UIBINL: BIN% ;GET A BYTE $AJCAL IOE MOVEM T2,@LOCPTR ;DEPOSIT THE BYTE AOS LOCPTR ;INCR DATA ADDR SOSLE LOCSIZ ;DECR # WORDS JRST UIBINL ;LOOP POPJ P, UITXTI: MOVEI T1,.RDDBC ;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 MOVE T1,IJFN(D) ;GET JFN HRLI T1,(T1) ;IN BOTH HALVES MOVEM T1,TXIBLK+.RDIOJ ;STORE IT MOVE T1,LOCPTR ;GET RECORD BUFFER PNTR MOVEM T1,TXIBLK+.RDDBP ;STORE DEST BYTE POINTER MOVE T1,LOCSIZ ;GET RECORD BUFFER LENGTH MOVEM T1,TXIBLK+.RDDBC ;STORE DEST BYTE COUNT MOVEI T1,TXIBLK ;POINT TO BLOCK TEXTI% ;READ A LINE JSHALT ;SHOULD NOT FAIL POPJ P, > ;END IF20 IF10,< UITBIN: INCHRW @LOCPTR ;GET A CHAR AOS LOCPTR ;[4156] INCR POINTER SOSLE LOCSIZ ;DECR COUNT JRST UITBIN ;LOOP POPJ P, UITXTI: INCHRW T1 ;GET A CHAR IDPB T1,LOCPTR ;STORE IT SOSLE LOCSIZ ;DECR COUNT JRST UITXTI ;LOOP POPJ P, > ;END IF10 ;HERE AT START OF RECORD ;READ START LSCW ;0 MEANS RANDOM RECORD WAS NEVER WRITTEN ILSCW1: SKIPE IMGFLG(D) ;[4161] IMAGE? JRST IMG1 ;YES. NO LSCWS PUSHJ P,IWORD ;GET WORD FROM BINARY FILE POPJ P, ;EOF. NON-SKIP RETURN CAIN T1,0 ;LSCW NON-ZERO? $ACALL RNR ;RECORD NOT WRITTEN LDB T2,[POINT 9,T1,8] ;GET SEGMENT CONTROL WORD CAIE T2,1 ;START LSCW? $ACALL BBF ;?Bad format binary file TLZ T1,777000 ;GET SEGMENT LENGTH SUBI T1,1 ;REMOVE LSCW FROM COUNT SKIPN T2,RSIZE(D) ;RECORD SIZE SPECIFIED? JRST SLSCW1 ;NO CAIE T2,(T1) ;EQUAL TO SIZE FOUND? $ACALL RSM ;NO. RECORD SIZE MISMATCH SLSCW1: MOVEM T1,RECLEN ;SAVE COUNT JRST %POPJ1 ;RETURN IMG1: SKIPN T1,RSIZE(D) ;GET RECORD SIZE IN WORDS HRLOI T1,37777 ;HUGE RECORD IF NO RECSIZ MOVEM T1,RECLEN ;SAVE IT JRST %POPJ1 ;DONE ;HERE WHEN START OR CONTINUE SEGMENT ENDS ;MUST SEE CONTINUATION OR END LSCW ILSCWX: SKIPE IMGFLG(D) ;[4161] IMAGE? JRST IMG2 ;YES. FAKE A CONTINUATION LSCW SKIPGE T1,RECLEN ;IF SEG LEN NEG, THEN LCSW 3 POPJ P, ;AREADY SEEN. RETURN NEGATIVE PUSHJ P,IWORD ;GET WORD FROM BINARY FILE $ACALL BBF ;EOF: ?"Bad format binary file" SETO T3, ;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? $ACALL BBF ;NO. BAD LSCW, BAD BINARY FILE MOVE T3,T1 ;GET THE LSCW TLZ T3,777000 ;GET THE SEGMENT LENGTH SUBI T3,1 ;REMOVE LSCW FROM COUNT SKIPE RSIZE(D) ;ANY RECORDSIZE SPECIFIED? $ACALL FCL ;FOUND UNEXPECTED CONTINUATION LSCW ILXEND: MOVE T1,T3 ;RETURN LENGTH IN T1 MOVEM T1,RECLEN ;STORE SEGMENT LENGTH POPJ P, IMG2: SETZ T1, ;NO RECORD LENGTH LEFT MOVEM T1,RECLEN POPJ P, ;HERE AT END OF IO LIST ;POSITION FILE JUST AFTER END LSCW ;NUMBER OF WORDS TO DISCARD IS .GE. 0 IN RECLEN ILSCW3: SKIPE IMGFLG(D) ;[4161] IMAGE? JRST IMG3 ;YES. NO LSCW PUSHJ P,UIALIN ;WORD-ALIGN THE PNTR/COUNT SKIPGE P3,RECLEN ;GET SEGMENT LENGTH LEFT POPJ P, ;IF NEG, ALREADY READ LSCW 3 ILS3LP: PUSHJ P,IAWORD ;GET WORD FROM BINARY FILE $ACALL BBF ;EOF. FILE IN ERROR SOJGE P3,ILS3LP ;SKIP TILL LSCW LDB T2,[POINT 9,T1,8] ;GET SEGMENT CONTROL WORD CAIE T2,2 ;CONTINUE LSCW? JRST NLSCW2 ;NO MOVE P3,T1 ;COPY THE LSCW TLZ P3,777000 ;GET THE SEGMENT LENGTH SOJA P3,ILS3LP ;CONTINUE NLSCW2: CAIE T2,3 ;END LSCW? $ACALL BBF ;No, file in error. POPJ P, ;DONE IMG3: SKIPN RSIZE(D) ;RECORD SIZE SPECIFIED? POPJ P, ;NO - WE HAVE NO CLEANUP PUSHJ P,UIALIN ;WORD-ALIGN THE PNTR/COUNT SKIPG P4,RECLEN ;GET RECORD LENGTH LEFT POPJ P, ;NONE LEFT - WE'RE DONE IMG3LP: PUSHJ P,IAWORD ;READ A WORD SETZ P4, ;EOF, OK SOJG P4,IMG3LP ;LOOP BACK POPJ P, ;RETURN UIALIN: HRRZ T1,IPTR(D) ;[4131] GET ADDRESS OF DATA JUMPE T1,%POPJ ;[4131] IF NO DATA, LEAVE MOVE T1,IPTR(D) ;GET BUFFER POINTER MUL T1,BPW(D) ;GET # BYTES LEFT IN WORD JUMPE T1,%POPJ ;ALREADY ALIGNED IF ZERO CAMLE T1,ICNT(D) ;GREATER THAN # BYTES LEFT? MOVE T1,ICNT(D) ;YES. USE # BYTES LEFT MOVNI T2,(T1) ;GET NEGATIVE ADDM T2,ICNT(D) ;ALIGN COUNT ADJBP T1,IPTR(D) ;ALIGN POINTER MOVEM T1,IPTR(D) ;SAVE IT POPJ P, IANXT: PUSHJ P,UINXTW ;NOTHING LEFT, GO MAP NEXT WINDOW POPJ P, ;EOF. NON-SKIP RETURN IAWORD: MOVE T1,ICNT(D) ;GET BYTES LEFT CAMGE T1,BPW(D) ;ANY WORDS LEFT? JRST IANXT ;NO MOVN T1,BPW(D) ;REDUCE # BYTES ADDM T1,ICNT(D) AOS T1,IPTR(D) ;INCR PNTR BY A WORD MOVEI T1,(T1) ;GET JUST ADDR MOVE T1,(T1) ;GET THE DATA AOS (P) ;SKIP RETURN POPJ P, INXT: PUSHJ P,UINXTW ;NOTHING LEFT, GO MAP NEXT WINDOW POPJ P, ;EOF. NON-SKIP RETURN IWORD: PUSHJ P,UIALIN ;ALIGN THE PNTR/COUNT MOVE T1,ICNT(D) ;GET COUNT CAMGE T1,BPW(D) ;IS THERE AT LEAST A WORD LEFT? JRST INXT ;NO. GET A NEW BUFFERFUL SUB T1,BPW(D) ;DECREMENT COUNT BY A WORD MOVEM T1,ICNT(D) ;SAVE IT AOS T1,IPTR(D) ;INCREMENT POINTER, GET IT MOVEI T1,(T1) ;GET LOCAL ADDRESS ONLY MOVE T1,(T1) ;GET THE WORD AOS (P) ;SKIP RETURN POPJ P, ;+ ;[4160] ; UNFSKP - UNFORMATTED SKIP RECORD ;- UNFSKP: SKIPN IMGFLG(D) ;Is it IMAGE mode? JRST BINSKP ;No (its binary). go look for LCSW's SKIPN P3,URSIZB(D) ;Yes, Was RECORDSIZE specified? $ACALL CSI ;No, Can't SKIPRECORD if no RECSIZ BINSKP: AOS CREC(D) ;UPDATE RECORD COUNT PUSHJ P,ILSCW1 ;READ START LSCW $ACALL EOF ;EOF PUSHJ P,ILSCW3 ;SKIP TO END LSCW MOVE T0,FLAGS(D) ;Get DDB flags TXNN T0,D%END ;REACH EOF? POPJ P, ;NO. DONE SKIPE IMGFLG(D) ;[4161] IMAGE? $ACALL BBF ;NO. BAD FORMAT $ACALL EOF ;YES. JUST EOF UOSET: XMOVEI T1,UNFO ;SETUP FOR IOLST CALLS MOVEM T1,IOSUB(D) XMOVEI T1,UOEND ;SETUP FOR FIN CALL MOVEM T1,IOFIN(D) AOS CREC(D) ;UPDATE RECORD COUNT PUSHJ P,OLSCW1 ;OUTPUT START LSCW SKIPN T1,RSIZE(D) ;RECORD SIZE SPECIFIED? HRLOI T1,37777 ;NO, SET BIG RECORDS MOVEM T1,RECLEN ;SAVE IT FOR IOLST CALLS SETZM RECREM ;CLEAR CHARACTER REMAINDER POPJ P, UNFO: MOVE T1,IO.TYP ;GET DATA TYPE CAIN T1,TP%CHR ;CHARACTER? JRST UOCHR ;YES SETZM RECREM ;CLEAR CHAR REMAINDER MOVE T1,IO.SIZ ;GET DATA SIZE CAME T1,IO.INC ;IS IT THE SIMPLE CASE? JRST UOWRD ;NO. MUST BE DONE WORD BY WORD IMUL T1,IO.NUM ;CALC # WORDS MOVEM T1,IO.SIZ ;SAVE AS DATA SIZE MOVEI T1,1 ;SET DATA COUNT TO 1 MOVEM T1,IO.NUM SETZM IO.INC ;WITH NO INCREMENT JRST UOBLP ;GO DO THE BLT UOWRD: MOVN T1,IO.SIZ ;ACCOUNT FOR THE INCREMENT ADDM T1,IO.INC ;DONE FOR EACH ENTRY AUTOMATICALLY UOBLP: MOVE T1,IO.SIZ ;GET ENTRY SIZE MOVEM T1,LOCSIZ ;SAVE LOCALLY UOBLP1: SKIPG RECLEN ;ANY ROOM LEFT IN RECORD? $ECALL ETL,%POPJ ;NO. WARN USER AND DON'T OUTPUT MORE PUSHJ P,UOALIN ;ALIGN THE POINTER/COUNT DMOVE P1,IPTR(D) ;GET THE POINTER/COUNT IDIV P2,BPW(D) ;GET # WORDS IN WINDOW JUMPG P2,UOBLT ;OK IF WE HAVE ROOM IN WINDOW PUSHJ P,OLSCWX ;FINISH LSCW, OUTPUT TYPE 2, GET NEW WINDOW DMOVE P1,IPTR(D) ;GET PNTR/COUNT AGAIN IDIV P2,BPW(D) ;GET # WORDS IN WINDOW UOBLT: MOVE T2,LOCSIZ ;GET MIN OF ARRAY LENGTH CAILE T2,(P2) ; AND WINDOW LENGTH MOVEI T2,(P2) CAMLE T2,RECLEN ; AND RECORD LENGTH MOVE T2,RECLEN ;IO.ADR/ addr. of user's array. ;p1/ local FOROTS address of data. ;T2/ # words to copy MOVE T1,IO.ADR ;GET USER'S ARRAY ADDRESS TLNN T1,-1 ;User's array in a non-zero section? JRST UOBLT2 ;No, normal BLT MOVE T3,T2 ;COPY # WORDS TO COPY MOVE T4,T1 ;T4/ "from" -- user's array MOVEI T5,(P1) ;GET LOCAL ADDR XMOVEI T5,1(T5) ;T5/ "to"-- get Global FOROTS' address. EXTEND T3,[XBLT] ;** COPY array ** JRST UOSKP ;Use BLT UOBLT2: MOVSI T4,(T1) ;GET BLT-FROM ADDRESS HRRI T4,1(P1) ;AND BLT-TO ADDRESS MOVEI T3,(P1) ;GET ADDR-1 OF 1ST WORD IN WINDOW ADDI T3,(T2) ;POINT TO END OF BLT BLT T4,(T3) ;MOVE DATA INTO WINDOW UOSKP: MOVNI P2,(T2) ;GET NEGATIVE # WORDS TRANSFERRED IMUL P2,BPW(D) ;GET # CHARS ADDM P2,ICNT(D) ;DECREMENT BUFFER COUNT ADDM T2,IPTR(D) ;INCREMENT BUFFER POINTER ADDM T2,IO.ADR ;INCREMENT DATA ADDRESS MOVNI T2,(T2) ;GET NEG # WORDS TRANSFERRED ADDM T2,RECLEN ;AND RECORD LENGTH ADDB T2,LOCSIZ ;AND NUMBER OF WORDS OF DATA JUMPG T2,UOBLP1 ;IF SOME LEFT, CONTINUE MOVE T1,IO.INC ;GET INCREMENT ADDM T1,IO.ADR ;ADD TO DATA ADDRESS SOSLE T1,IO.NUM ;DECR COUNT JRST UOBLP ;MORE TO DO POPJ P, ;ELSE, LEAVE UOCHR: MOVE T1,RECLEN ;GET # WORDS LEFT IN RECORD IMUL T1,BPW(D) ;GET # CHARS ADD T1,RECREM ;ADD PREVIOUS REMAINDER MOVEM T1,LOCREC ;SAVE LOCAL RECORD LENGTH JUMPE T1,UOCZER ;DONE IF NONE LEFT MOVE T1,IO.SIZ ;GET SIZE CAME T1,IO.INC ;SIMPLE CASE? JRST UOCHR1 ;NO. DO IT CHAR BY CHAR IMUL T1,IO.NUM ;GET TOTAL # CHARS MOVEM T1,IO.SIZ ;MAKE IT LOOK LIKE 1 BIG VARIABLE MOVEI T1,1 ;DATA COUNT OF 1 MOVEM T1,IO.NUM SETZM IO.INC ;NO INCREMENT NECESSARY JRST UOCBLP ;GO DO THE BLT UOCHR1: MOVN T1,IO.SIZ ;ACCOUNT FOR THE INCREMENT DONE ADDM T1,IO.INC ;DONE FOR EACH ENTRY AUTOMATICALLY UOCBLP: MOVE T1,IO.SIZ ;GET ENTRY SIZE MOVEM T1,LOCSIZ ;SET UP LOCAL ONE UOCBL1: SKIPG LOCREC ;ANY ROOM LEFT IN RECORD? JRST UOCZER ;NO. DONE SKIPG ICNT(D) ;ANY CHARS IN WINDOW? PUSHJ P,OLSCWX ;NO. FINISH LSCW, OUTPUT TYPE 2, GET NEW WINDOW UOCBLT: MOVE T0,ICNT(D) ;GET MINIMUM OF WINDOW COUNT CAMLE T0,LOCREC ;AND CHARS IN RECORD MOVE T0,LOCREC CAMLE T0,LOCSIZ ;AND NUMBER OF CHARS TO TRANSFER MOVE T0,LOCSIZ MOVEM T0,LOCNUM ;SAVE IT MOVE T1,T0 ;COPY THE COUNT ADJBP T1,IO.ADR ;GET UPDATED POINTER EXCH T1,IO.ADR ;SAVE UPDATED POINTER, GET ORIGINAL ONE MOVE T3,T0 ;COPY THE COUNT MOVE T4,IPTR(D) ;GET DEST PNTR EXTEND T0,[EXP ,0] ;MOVE STRING LEFT-JUSTIFIED, ZERO FILL $SNH ;SHOULD SKIP RETURN MOVEM T4,IPTR(D) ;UPDATE BUFFER PNTR MOVN T1,LOCNUM ;GET NEGATIVE CHARS TRANSFERRED ADDM T1,LOCREC ;UPDATE # CHARS LEFT IN RECORD ADDM T1,ICNT(D) ;UPDATE # CHARS LEFT IN WINDOW ADDB T1,LOCSIZ ;UPDATE # CHARS TO TRANSFER JUMPG T1,UOCBL1 ;LOOP IF MORE TO TRANSFER SKIPN T1,IO.INC ;GET INCREMENT JRST UOCNI ;NONE ADJBP T1,IO.ADR ;UPDATE PNTR MOVEM T1,IO.ADR ;AND SAVE IT UOCNI: SOSLE IO.NUM ;ANY MORE ENTRIES? JRST UOCBLP ;YES. GO DO THEM MOVE T1,LOCREC ;GET LOCAL RECORD LENGTH LEFT IDIV T1,BPW(D) ;GET WORDS AND BYTES DMOVEM T1,RECLEN ;SAVE FOR NEXT CALL POPJ P, ;HERE IF NO ROOM LEFT IN RECORD BUT THE IOLST HAS SPECIFIED ;MORE OUTPUT. GIVE THE USER AN WARNING MESSAGE AND CLEAR THE ;RECORD COUNTS. UOCZER: $ECALL ETL ;ATTEMPT TO WRITE BEYOND FIXED-LENGTH RECORD SETZM RECLEN ;CLEAR ALL LENGTHS SETZM RECREM POPJ P, UOEND: SKIPN RSIZE(D) ;RECORD SIZE? JRST UOXYZ ;NO, FINE PUSHJ P,UOALIN ;WORD-ALIGN THE PNTR/COUNT MOVE P3,RECLEN ;GET ROOM LEFT IN RECORD JUMPLE P3,UOXYZ ;NO ZEROS NECESSARY, FINE SETZ T1, ;GET A ZERO PUSHJ P,OAWORD ;PUT IN FILE SOJG P3,.-1 ;PAD WHOLE RECORD UOXYZ: PUSHJ P,OLSCW3 ;OUTPUT END LSCW OR CLEAR END OF WORD MOVE T1,BYTN(D) ;GET BYTE # OF NEXT WINDOW SUB T1,ICNT(D) ;GET LAST BYTE IN USE SKIPE WTAB(D) ;RANDOM FILE? CAMLE T1,EOFN(D) ;YES. ONLY STORE LARGER EOFN MOVEM T1,EOFN(D) ;SAVE AS EOF PNTR PJRST %SETAV ;RETURN TO USER PROG UOSTTY: XMOVEI T1,UOTTY ;SETUP FOR TTY IMAGE OUTPUT MOVEM T1,IOSUB(D) XMOVEI T1,UOTFIN ;OUTPUT BUFFER ON FIN CALL MOVEM T1,IOFIN(D) POPJ P, UOTTY: PUSHJ P,UOSCC ;SET CCOC WORDS FOR IMAGE OUTPUT MOVE T1,IO.TYP ;GET DATA TYPE CAIN T1,TP%CHR ;CHARACTER? JRST UOTCHR ;YES MOVE T1,IO.SIZ ;GET DATA SIZE CAME T1,IO.INC ;IS IT THE SIMPLE CASE? JRST UOTWRD ;NO. MUST BE DONE WORD BY WORD IMUL T1,IO.NUM ;CALC # WORDS MOVEM T1,IO.SIZ ;SAVE AS DATA SIZE MOVEI T1,1 ;SET DATA COUNT TO 1 MOVEM T1,IO.NUM SETZM IO.INC ;WITH NO INCREMENT UOTWRD: MOVE T1,IO.ADR ;GET DATA ADDR MOVEM T1,LOCPTR ;SAVE IT MOVE T1,IO.SIZ ;GET # WORDS MOVEM T1,LOCSIZ ;SAVE IT PUSHJ P,UOTBOU ;OUTPUT 1 CHARACTER PER WORD MOVE T1,IO.INC ;GET INCREMENT ADDM T1,IO.ADR ;INCR DATA ADDR SOSLE IO.NUM ;DECR COUNT JRST UOTWRD ;LOOP PJRST UORCC ;GO RESTORE CCOC WORDS UOTCHR: MOVE T1,IO.SIZ ;GET SIZE CAME T1,IO.INC ;SIMPLE CASE? JRST UOTCH1 ;NO. DO IT CHAR BY CHAR IMUL T1,IO.NUM ;GET TOTAL # CHARS MOVEM T1,IO.SIZ ;MAKE IT LOOK LIKE 1 BIG VARIABLE MOVEI T1,1 ;DATA COUNT OF 1 MOVEM T1,IO.NUM SETZM IO.INC ;NO INCREMENT NECESSARY UOTCH1: MOVE T1,IO.SIZ ;GET SIZE MOVEM T1,LOCSIZ ;SAVE IT LOCALLY MOVE T1,IO.ADR ;GET POINTER MOVEM T1,LOCPTR ;SAVE IT PUSHJ P,UOSOUT ;DO SOUTR MOVE T1,IO.INC ;GET INCREMENT ADJBP T1,IO.ADR ;UPDATE POINTER MOVEM T1,IO.ADR SOSLE IO.NUM ;DECR COUNT JRST UOTCH1 PJRST UORCC ;RESTORE OLD CCOC WORDS IF20,< UORCC: MOVE T1,IJFN(D) ;GET JFN DMOVE T2,TCCOC ;GET OLD CCOC WORDS RFCOC% ;RESTORE THEM POPJ P, UOSCC: MOVE T1,OJFN(D) ;GET JFN RFCOC% ;SAVE CCOC WORDS FOR USE DURING TEXTI DMOVEM T2,TCCOC ;SAVE TEMPORARILY DMOVE T2,%OCLIT ;DO EVERYTHING LITERALLY SFCOC% POPJ P, UOTBOU: MOVE T1,OJFN(D) ;GET JFN UOTBLP: MOVE T2,@LOCPTR ;GET WORD BOUT% ;OUTPUT IT $AJCAL IOE AOS LOCPTR ;INCR POINTER SOSLE LOCSIZ ;DECR COUNT JRST UOTBLP ;LOOP POPJ P, UOSOUT: MOVE T1,OJFN(D) ;GET JFN MOVE T2,LOCPTR ;GET POINTER MOVN T3,LOCSIZ ;GET DATA SIZE SOUTR% ;OUTPUT THEM $AJCAL IOE POPJ P, UOTFIN: PJRST %SETAV ;FINISH OUTPUT CALL > ;END IF20 IF10,< UOSCC: MOVE T1,[2,,T2] ;[3414] READ TTY CHARACTERISTIC MOVEI T2,.TONFC ;[3414] FOR FREE CRLF'S MOVE T3,DVICE(D) ;GET DEVICE NAME IONDX. T3, ;GET UDX $SNH ;SHOULD NOT FAIL TRMOP. T1, ;[3414] SETZ T1, ;[3414] FAILED, SET TO FREE CRLF'S MOVEM T1,TCCOC ;[3414] SAVE IT FOR LATER RESTORE MOVE T1,[3,,T2] ;[3414] SETUP TO SET NFC OFF ADDI T2,.TOSET ;[3414] MAKE IT A "SET" CALL MOVEI T4,1 ;[3414] TURN OFF NFC BIT TRMOP. T1, ;[3414] JFCL ;[3414] FAILED POPJ P, ;[3414] UORCC: MOVE T1,[3,,T2] ;[3414] SETUP TO RESTORE TTY NFC MOVEI T2,.TONFC+.TOSET ;[3414] MOVE T3,DVICE(D) ;GET DEVICE NAME IONDX. T3, ;GET UDX $SNH ;SHOULD NOT FAIL MOVE T4,TCCOC ;[3414] GET STORED TTY BIT TRMOP. T1, ;[3414] JFCL ;[3414] FAILED, DON'T CARE POPJ P, ;[3414] UOTBOU: SKIPG ICNT(D) ;ANY ROOM? PUSHJ P,OSBUF ;NO. OUTPUT BUFFERFUL MOVE T1,@LOCPTR ;GET A CHAR IDPB T1,IPTR(D) ;PUT INTO BUFFER AOS LOCPTR ;[4156] INCR POINTER SOS ICNT(D) ;DECREMENT COUNT SOSLE LOCSIZ ;DECR COUNT JRST UOTBOU ;LOOP POPJ P, UOSOUT: SKIPG ICNT(D) ;ANY ROOM? PUSHJ P,OSBUF ;NO. OUTPUT BUFFERFUL ILDB T1,LOCPTR ;GET A CHAR SOS ICNT(D) ;DECREMENT COUNT IDPB T1,IPTR(D) ;PUT INTO BUFFER SOSLE LOCSIZ ;DECR SIZE JRST UOSOUT ;LOOP POPJ P, UOTFIN: PUSHJ P,OSBUF ;OUTPUT THE BUFFER PJRST %SETAV ;AND FINISH OUTPUT CALL > ;END IF10 ;LSCW ROUTINES ;FORMAT OF BINARY RECORD: (FORMAT OF BINARY RECORD) ;THERE IS NO NECESSARY RELATIONSHIP BETWEEN SEGMENT SIZE AND BUFFER SIZE OLSCW1: SKIPE IMGFLG(D) ;[4161] IMAGE? POPJ P, ;YES. NOTHING TO DO SKIPE T1,RSIZE(D) ;IS RECORD SIZE SPECIFIED? ADDI T1,1 ;YES. ADD 1 FOR LSCW SETZM SEGCNT ;CLEAR WORD COUNT OF SEGMENTS ALREADY IN FILE ADD T1,[1B8] ;GET START LSCW PUSHJ P,OWORD ;PUT WORD INTO FILE WINDOW HRRZ T1,IPTR(D) ;GET BUFFER POINTER MOVEM T1,CWADR ;STORE IN-CORE ADDRESS OF CONTROL WORD POPJ P, OLSCWX: SKIPN IMGFLG(D) ;[4161] IMAGE? SKIPE RSIZE(D) ;NO. WAS RECORD SIZE SPECIFIED? JRST ONXTW ;YES. JUST GO WRITE WINDOW, GET NEW ONE SKIPN T2,CWADR ;GET ADDRESS OF TYPE 1 OR 2 CONTROL WORD $SNH ;Already out in file, bug HRRZ T1,IPTR(D) ;POINT TO LAST WORD WRITTEN SUBI T1,-1(T2) ;GET DISTANCE FROM CONTROL WORD = SEG LENGTH HRRM T1,(T2) ;STORE LENGTH IN CONTROL WORD ADDM T1,SEGCNT ;ADD INTO TOTAL RECORD LENGTH MOVSI T1,(2B8) ;GET CONTINUE LSCW PUSHJ P,OAWORD ;PUT WORD INTO NEW FILE WINDOW HRRZ T1,IPTR(D) ;GET BUFFER POINTER MOVEM T1,CWADR ;STORE IN-CORE ADDRESS OF CONTROL WORD POPJ P, OLSCW3: SKIPE IMGFLG(D) ;[4161] IMAGE? JRST %OCLR ;YES. JUST CLEAR CHARS IN END OF CURRENT WORD 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 HRRZ T1,IPTR(D) ;POINT TO LAST WORD WRITTEN SUBI T1,-1(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 ADD T1,[3B8+1] ;PUT IN TYPE-3 LSCW HEADER 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 UOALIN: SKIPN T1,IPTR(D) ;GET BUFFER POINTER POPJ P, ;NONE. NOTHING TO ALIGN MUL T1,BPW(D) ;GET # BYTES LEFT IN WORD JUMPE T1,%POPJ ;ALREADY ALIGNED IF ZERO CAMLE T1,ICNT(D) ;MORE THAN LEFT IN BUFFER? MOVE T1,ICNT(D) ;YES. USE AMOUNT LEFT IN BUFFER MOVNI T2,(T1) ;GET NEGATIVE ADDM T2,ICNT(D) ;ALIGN THE COUNT HRRZ T2,IPTR(D) ;GET LOCAL PNTR LDB T3,[POINT 6,IPTR(D),5] ;GET # BITS TO RIGHT MOVE T3,RGTMSK(T3) ;GET A