Trailing-Edge
-
PDP-10 Archives
-
bb-4157j-bm_fortran20_v11_16mt9
-
fortran-ots-debugger/forio.mac
There are 25 other files named forio.mac in the archive. Click here to see a list.
SEARCH MTHPRM,FORPRM
TV FORIO I/O ROUTINES,11(5014)
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1987
;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 <ESC> - 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 *****
4215 TGS 4-Jun-85
Don't clear RECLEN flag for unformatted character data input. This
fixes an undeserved "?Bad format binary file" error when FORIO
looks for a nonexistent LSCW 3.
4217 RJD 16-Jul-85 SPR:10-35226
When BACKSPACing a very large record, a half word calculation
for the file pointer is insufficient.
4220 JLC 22-July-85
Fix initial TTY output, which was throwing away all vertical
motion control, instead of reducing the number of LFs by 1,
as in V7.
***** Begin V11 Development *****
5003 TGS 24-Oct-85
Implement RMS READ.
5004 TGS 10-Nov-85
Implement RMS WRITE
MRB 2-Dec-85
5005 Initial cleanup of MTOP code in FORIO. Moved routine UNFSKP closer
to it's caller. Inserted code to do non-opened rewind for tapes.
MRB 16-DEC-85
5006 Disallow file positoning statements that don't work for labeled
tapes. (endfile,skipfile,backfile,backspace)
5014 MRB 4-JUNE-1986
Implement RMS UNLOCK statement.
***** 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
IF20,< INTERN GETIRB,EXPIRB,SETPTR,PAGNUM ;[5003]>
IF20,< INTERN A.REC,A.KVL,A.KRL,A.KID,RECLEN ;[5003]>
IF20,< INTERN GETORB,BYTUSD,ORINI,A.FMT ;[5004]>
INTERN %BAKEF ;[5013]
IF20,< INTERN A.IOS ;[5014]>
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>
EXTERN %MTPRM,%LABCK
EXTERN %OPENX,%LSTBF,%OWGBT
EXTERN %UNNAM
EXTERN IO.ADR,IO.NUM,IO.SIZ,IO.INC,IO.TYP,IO.INS
EXTERN %ALCHF,%DECHF
IF20,< EXTERN %IRMS,%ORMS,%UORMS,%RMREW,%RMBSR,%RMEND ;[5000]>
IF20,< EXTERN %RMRDW,%RMSIN,%RMSOU ;[5000]>
EXTERN %RMASV,%RMFND,O.KEY ;[5000]
IF20,< EXTERN %RMCRW,%FREBLK ;[5004]>
IF20,< EXTERN %RMCDL,%RMDEL ;[5013]>
IF20,< EXTERN %RMUNL,%RMCUL ;[5014]>
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 ;(0) ZERO KEYWORD - SKIPPED ARG
A.UNIT: BLOCK 1 ;(1) UNIT= [ADDRESS OF VALUE]
A.FMT:: BLOCK 1 ;(2) FMT= [ADDRESS]
A.FMS:: BLOCK 1 ;(3) FORMAT SIZE [ADDRESS OF VALUE]
A.END:: BLOCK 1 ;(4) END= [ADDRESS]
A.ERR:: BLOCK 1 ;(5) ERR= [ADDRESS]
A.IOS:: BLOCK 1 ;(6) IOSTAT= [ADDRESS]
A.REC:: BLOCK 1 ;(7) REC= [ADDRESS]
A.NML:: BLOCK 1 ;(10) NAMELIST ADDRESS [ADDRESS]
A.MTOP: BLOCK 1 ;(11) REL OP OR MTA OP CODE [ADDRESS OF VALUE]
A.HSA:: BLOCK 1 ;(12) ENCODE/DECODE ARRAY ADDRESS [ADDRESS]
A.HSL:: BLOCK 1 ;(13) ENCODE/DECODE RECORD LENGTH [ADDRESS OF VALUE]
A.KRL: BLOCK 1 ;(14) KEY RELATIONAL [ADDRESS] ;[5003]
A.KID: BLOCK 1 ;(15) KEY ID [ADDRESS OF VALUE] ;[5003]
A.KVL: BLOCK 1 ;(16) KEY VALUE [ADDRESS OF VALUE] ;[5003]
BLOCK 1 ;MORE ROOM IN RWKWD IF NEEDED
MRWKWD==.-IOARGS-1 ;MAX LEGAL READ/WRITE ARG KWD NUMBER
IFN <<MRWKWD>B8-RWKWD>,<PRINTX ?READ/WRITE KEYWORD TABLE WRONG SIZE>
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
; <return here if ok>
;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
LOAD T1,INDX(D) ;[5003] GET DEVICE TYPE
CAIN T1,DI.RMS ;[5003] RMS FILE?
PJRST %RMASV ;[5003] YES, GO HANDLE ASSOCVAR
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: SETZM O.KEY ;[5000]
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 <CVTDBO>,-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 <CVTDBO>,-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 <CVTBDO "0">,"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 <CVTBDO "0">,"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
IF20,< JRST XIREC ;[5003] REMOTE STREAM FILE
JRST %IRMS ;[5003] RMS FILE
> ;End IF20
IDSPS: JRST TIRECS ;TTY
JRST XIREC ;DISK
JRST XIREC ;MTA
JRST XIREC ;OTHER
IF20,< JRST XIREC ;[5003] REMOTE STREAM FILE
JRST %IRMS ;[5003] RMS RECORD INPUT
> ;End IF20
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
MOVE T1,RECTP(D) ;[5000] GET RECORDTYPE
CAIE T1,RT.UND ;[5000] 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 <MOVST ASCTAB>," "] ;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 <MOVSLJ>,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,[<CVTDBO 777720>] ;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
IF20,< JRST DOSTR ;[5004] REMOTE STREAM FILE
$SNH ;[5004] RMS FILE - SHOULD NEVER GET HERE,
;[5004] SINCE CC=TRANSLATED IS NOT SUPPORTED
;[5004] FOR RMS FILES
> ;End IF20
;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
IF20,< JRST COREC ;[5004] REMOTE STREAM FILE
JRST %ORMS ;[5004] RMS FILE
> ; End IF20
ODSPS: JRST TORECS ;TTY
JRST CORECS ;DISK
JRST MORECS ;MTA
JRST CORECS ;OTHER
IF20,< JRST CORECS ;[5004] REMOTE STREAM FILE
JRST %ORMS ;[5004] RMS FILE
> ; End IF20
;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 <CVTBDO "0">,"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
NOSCC: MOVE T1,CCCTAB-" "(T3) ;[4100]GET COMPATIBILITY FLAGS
TDNE T1,%FLIDX ;[4100]ANY FLAGS THE SAME?
$ECALL CFC ;[4100]YES. OUTPUT MESSAGE IF INCOMPATIBLE
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
TXNN T1,D%SEOL ;[4220] CRLF PRECEDING THIS RECORD?
JRST NOALTC ;[4220] NO
MOVE T4,CCALTP-" "(T3) ;[4220] GET ALT PNTR TO CC STRING
MOVE T5,CCALTL-" "(T3) ;[4220] AND ALT COUNT
NOALTC: JUMPE T5,%POPJ ;[4220] 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: MOVE T1,RECTP(D) ;[5000] GET RECORDTYPE
CAIE T1,RT.UND ;[5000] 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: MOVE T1,RECTP(D) ;[5000] GET RECORDTYPE
CAIE T1,RT.UND ;[5000] 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
;[4220] THE FOLLOWING POINTERS AND COUNTS ARE USED IF DOLLAR FORMAT
;[4220] HAS BEEN SPECIFIED. THE CR AND ONE LF (IF ANY) IS REMOVED FROM
;[4220] EACH STRING.
CCALTP: 0 ;[4220] SPACE :
0 ;[4220] ! :
0 ;[4220] " :
0 ;[4220] # :
0 ;[4220] $ :
0 ;[4220] % :
0 ;[4220] & :
0 ;[4220] ' :
0 ;[4220] ( :
0 ;[4220] ) :
POINT 7,[BYTE(7)%DC3] ;[4220] * : DC3
0 ;[4220] + :
POINT 7,[BYTE(7)%DC1] ;[4220] , : DC1
POINT 7,[BYTE(7)%LF,%LF] ;[4220] - : LF,LF
POINT 7,[BYTE(7)%DC2] ;[4220] . : DC2
POINT 7,[BYTE(7)%DC4] ;[4220] / : DC4
POINT 7,[BYTE(7)%LF] ;[4220] 0 : LF
POINT 7,[BYTE(7)%FF] ;[4220] 1 : FF
POINT 7,[BYTE(7)%DC0] ;[4220] 2 : DC0
POINT 7,[BYTE(7)%VT] ;[4220] 3 : VT
0 ;[4220] SPACE :
CCALTL: 0 ;[4220] SPACE :
0 ;[4220] ! :
0 ;[4220] " :
0 ;[4220] # :
0 ;[4220] $ :
0 ;[4220] % :
0 ;[4220] & :
0 ;[4220] ' :
0 ;[4220] ( :
0 ;[4220] ) :
1 ;[4220] * : DC3
0 ;[4220] + :
1 ;[4220] , : DC1
2 ;[4220] - : LF,LF
1 ;[4220] . : DC2
1 ;[4220] / : DC4
1 ;[4220] 0 : LF
1 ;[4220] 1 : FF
1 ;[4220] 2 : DC0
1 ;[4220] 3 : VT
0 ;[4220] SPACE : LF
;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 <MOVSLJ>,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: MOVE T1,RECTP(D) ;[5000] GET RECORDTYPE
CAIN T1,RT.UND ;[5000] 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: MOVE T1,RECTP(D) ;[5000] GET RECORDTYPE
CAIN T1,RT.UND ;[5000] 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 <MOVSLJ>," "];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 <MOVSLJ>,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 <MOVSLJ>," "] ;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
;[4215]
SETZ RECREM ;[4215] CLEAR 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
IF20,< LOAD T1,INDX(D) ;[5003] GET DEVICE INDEX
CAIN T1,DI.RMS ;[5003] RMS FILE?
PUSHJ P,%IRMS ;[5003] YES, READ THE RECORD NOW
> ;End IF20
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,
;[5005]
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 <MOVSLJ>,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:
IF20,< ;[5004]
LOAD T1,INDX(D) ;[5004] GET FILE TYPE
CAIN T1,DI.RMS ;[5004] RMS?
PJRST OLSCWR ;[5004] YES, GO OUTPUT RECORD
> ;END IF20
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?
JRST OLSCWB ;[5004] YES. ALMOST DONE
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,
OLSCWB: LOAD T1,INDX(D) ;[5004] GET FILE TYPE
CAIE T1,DI.RMS ;[5004] RMS FILE?
POPJ P, ;[5004] NO. DONE
SETZM ICNT(D) ;[5004] YES, SAY WE NEED AN OUTPUT BUFFER
SETZM IPTR(D) ;[5004]
POPJ P, ;[5004]
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,
IF20,<
;[5004] New
OLSCWR: PUSHJ P,%OCLR ;CLEAR CHARS AT END OF LAST WD
SKIPE T1,FRSIZB(D) ;IF FIXED-LENGTH, USE IT
JRST UOTRMS ;HAVE ONE
MOVE T2,ORBUF(D) ;GET BUFFER START
HRRZ T1,IPTR(D) ;GET ADR OF LAST WORD WRITTEN
SUBI T1,(T2) ;GET TOTAL WORDS IN RECORD
IMUL T1,BPW(D) ;NOW BYTES
UOTRMS: MOVMM T1,ORLEN(D)
PUSHJ P,%ORMS ;AND GO OUTPUT THE RECORD
SETZM BYTUSD ;CLEAR BYTES USED COUNT
SETZM ICNT(D) ;SAY WE NEED A NEW "WINDOW"
SETZM BYTN(D)
PJRST %SETAV
> ;End IF20
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 MASK
ANDCAM T3,(T2) ;CLEAR THE BITS
ADJBP T1,IPTR(D) ;ALIGN THE POINTER
MOVEM T1,IPTR(D) ;SAVE IT
POPJ P,
;%OCLR - AT END OF EACH WRITE TO CLEAR THE REMAINING CHARACTERS IN
;THE CURRENT WORD, IF ANY.
%OCLR: MOVE T1,IPTR(D) ;GET BUFFER POINTER
MUL T1,BPW(D) ;GET # BYTES LEFT IN WORD
JUMPE T1,%POPJ ;ALREADY ALIGNED IF ZERO
HRRZ T1,IPTR(D) ;GET LOCAL PNTR
LDB T3,[POINT 6,IPTR(D),5] ;GET # BITS TO RIGHT
MOVE T3,RGTMSK(T3) ;GET A MASK
ANDCAM T3,(T1) ;CLEAR THE BITS
POPJ P,
;OAWORD - TO OUTPUT A WORD TO THE FILE, WITH THE ASSUMPTION THAT
;THE BYTE POINTER/COUNT HAVE ALREADY BEEN WORD-ALIGNED.
OANXT: MOVEM T1,TOWORD ;SAVE WORD TO OUTPUT
PUSHJ P,ONXTW ;NOTHING LEFT, GO MAP NEXT WINDOW
MOVE T1,TOWORD ;GET WORD BACK AGAIN
OAWORD: SKIPG ICNT(D) ;ANY WORDS LEFT?
JRST OANXT ;NO. OUTPUT A WINDOW
MOVN T2,BPW(D) ;REDUCE BY BYTES
ADDM T2,ICNT(D)
AOS T2,IPTR(D) ;INCR PNTR BY A WORD
MOVEI T2,(T2) ;GET JUST LOCAL ADDR
MOVEM T1,(T2) ;OUTPUT THE DATA
POPJ P,
ONXT: SETZM ICNT(D) ;CLEAR THE COUNT
PUSHJ P,ONXTW ;NOTHING LEFT, GO MAP NEXT WINDOW
JRST OWORD1 ;GO OUTPUT THE WORD
OWORD: MOVEM T1,TOWORD ;SAVE WORD TO OUTPUT
PUSHJ P,UOALIN ;ALIGN THE PNTR/COUNT
OWORD1: MOVE T1,ICNT(D) ;GET THE COUNT
CAMGE T1,BPW(D) ;IS THERE ROOM FOR A WORD?
JRST ONXT ;NO. GET A BUFFERFUL
SUB T1,BPW(D) ;DECREMENT COUNT
MOVEM T1,ICNT(D) ;SAVE IT
AOS T1,IPTR(D) ;INCREMENT POINTER
MOVEI T1,(T1) ;MAKE IT A LOCAL POINTER
MOVE T2,TOWORD ;GET WORD BACK AGAIN
MOVEM T2,(T1) ;PUT WORD IN BUFFER
POPJ P,
%RTMSK:
RGTMSK: 0
1
3
7
17
37
77
177
377
777
1777
3777
7777
17777
37777
77777
177777
377777
777777
1,,-1
3,,-1
7,,-1
17,,-1
37,,-1
77,,-1
177,,-1
377,,-1
777,,-1
1777,,-1
3777,,-1
7777,,-1
17777,,-1
37777,,-1
77777,,-1
177777,,-1
377777,,-1
777777,,-1
SEGMENT DATA
RECLEN: BLOCK 1 ;RECORD OR SEGMENT LENGTH IN WORDS
RECREM: BLOCK 1 ;CHARACTER REMAINDER
LOCREC: BLOCK 1 ;RECORD OR SEGMENT LENGTH IN CHARACTERS
LOCNUM: BLOCK 1 ;LOCAL # WORDS OR CHARS TO TRANSFER
LOCSIZ: BLOCK 1 ;LOCAL CHARACTER SIZE
LOCPTR: BLOCK 1 ;LOCAL POINTER FOR TEXTI
CWADR: BLOCK 1 ;ADDRESS OF START LSCW
SEGCNT: BLOCK 1 ;COUNT OF WORDS OUT IN FILE IN PREVIOUS SEGMENTS
TOWORD: BLOCK 1 ;TEMP FOR OUTPUT WORD
SUBTTL DUMP MODE I/O
SEGMENT CODE
IF20,<
RDUMP:
WDUMP: POPJ P,
>;END IF20
IF10,<
DMPIN: HRRZ T1,DMPNTR ;GET PNTR TO LIST
SETZM (T1) ;CLEAR LAST WORD
MOVEI T2,.FOINP ;SET FOR INPUT
HLL T2,FBLK(D) ;Get channel stuff
MOVEI T3,DMPLST
MOVE T1,[2,,T2]
FILOP. T1, ;Do the INPUT
PUSHJ P,EOFCHK ;Set D%END if EOF; else give error
MOVE T1,FLAGS(D) ;Get flags
TXNE T1,D%END ;End of file?
$ACALL EOF ;Yes, give error
JRST %SETAV ;NO. RETURN
DMPOUT: HRRZ T1,DMPNTR ;GET PNTR TO LIST
SETZM (T1) ;CLEAR LAST WORD
MOVEI T2,.FOOUT ;SET FOR OUTPUT
HLL T2,FBLK(D) ;GET CHANNEL STUFF
MOVEI T3,DMPLST
MOVE T1,[2,,T2]
FILOP. T1, ;DO THE OUTPUT
$ACALL IOE ;Error
JRST %SETAV ;RETURN PROPERLY
RDUMP: XMOVEI T1,LSTDMP ;SETUP FOR IOLST CALL
MOVEM T1,IOSUB(D)
XMOVEI T1,DMPIN ;SETUP FOR DUMP MODE INPUT
MOVEM T1,IOFIN(D)
MOVE T1,[-MAXARG,,DMPLST] ;SETUP DUMP MODE LIST PNTR
MOVEM T1,DMPNTR
POPJ P,
WDUMP: XMOVEI T1,LSTDMP ;SETUP FOR IOLST CALL
MOVEM T1,IOSUB(D)
XMOVEI T1,DMPOUT ;SETUP FOR DUMP MODE OUTPUT
MOVEM T1,IOFIN(D)
MOVE T1,[-MAXARG,,DMPLST] ;SETUP DUMP MODE LIST PNTR
MOVEM T1,DMPNTR
POPJ P,
LSTDMP: MOVE T1,IO.ADR ;GET I/O ADDR
SUBI T1,1 ;GET ADDR-1
SKIPN T2,IO.INC ;GET INCREMENT
JRST INCOK ;ZERO IS OK
CAME T2,IO.SIZ ;SAME AS SIZE?
$ACALL IDI ;ILLEGAL DUMP-MODE I/O LIST
INCOK: MOVE T3,IO.SIZ ;GET SIZE
IMUL T3,IO.NUM ;GET # WORDS
MOVNI T2,(T3) ;NEGATIVE
HRLI T1,(T2) ;IN LEFT HALF
MOVE T2,DMPNTR ;GET THE PNTR
MOVEM T1,(T2) ;SAVE IN DUMP MODE LIST
AOBJN T2,.+2 ;INCR
$ACALL DLL ;DUMP I/O LIST TOO LONG
MOVEM T2,DMPNTR ;SAVE INCREMENTED PNTR
ADDI T3,177 ;GET # BLOCKS
IDIVI T3,200 ;ROUNDED UP
IMULI T3,200 ;GET # WORDS ROUNDED UP
IMUL T3,BPW(D) ;GET # BYTES
ADDM T3,BYTN(D) ;ADD TO BYTE COUNT
POPJ P,
>;END IF10
SUBTTL DISK POSITIONING
COMMENT &
TOPS-20 sequential disk files are read with PMAPs by moving a n-page window
through the file. The file window always starts on a n-page boundary and is
moved only when the desired byte is not in the window. The first process page
number of the window is in WPTR(D). (The window size can be set to something
besides 4 pages with BUFFERCOUNT=).
TOPS-20 and TOPS-10 random files are similar, but there are n independent
one-page windows. If references to the file are well localized, the
windows will often contain the desired records. For random files WTAB
contains a pointer to a n-word table, with each word giving the corresponding
file page number of a window. The number of pages
can be set with BUFFERCOUNT=. On TOPS-10, PFTAB is an n-word table
of flags of whether the page has been modified.
TOPS-10 sequential disk files are like any other TOPS-10 sequential file.
&
;ROUTINE TO MAP NEXT WINDOW OF FILE
;ARGS: BYTN = FILE BYTE NUMBER OF START OF WINDOW
;RETURN: P1 = BYTE POINTER TO FIRST MAPPED BYTE
; P2 = COUNT OF BYTES IN WINDOW
; BYTN = FILE BYTE NUMBER+1 OF END OF WINDOW
; I.E., STARTING BYTE OF FOLLOWING WINDOW
INXTW: SKIPE WTAB(D) ;RANDOM FILE?
JRST IMAPW ;YES
MOVE T0,FLAGS(D) ;GET DDB FLAGS
TXNE T0,D%END ;END OF FILE ALREADY?
POPJ P, ;YES. JUST LEAVE
LOAD T1,INDX(D) ;GET DEVICE INDEX
PJRST ISTAB(T1) ;GO GET A WINDOW OR BUFFERFUL
ISTAB: JRST %ISBUF ;TTY
JRST %ISMAP ;DSK
JRST %ISBUF ;MTA
JRST %ISBUF ;OTHER LOCAL DEVICE
IF20,< JRST %RMSIN ;[5003] REMOTE STREAM FILE
JRST %IRMS ;[5003] RMS FILE
> ;End IF20
ONXTW: MOVE T1,BYTN(D) ;GET # BYTES WRITTEN SO FAR
CAMLE T1,EOFN(D) ;UPDATE EOF PNTR IF GREATER
MOVEM T1,EOFN(D)
SKIPE WTAB(D) ;RANDOM FILE?
JRST OMAPW ;YES
LOAD T1,INDX(D) ;GET DEVICE INDEX
LOAD T0,ACC(D) ;GET ACCESS
CAIE T0,AC.APP ;APPEND?
JRST OSTAB(T1) ;NO. GO MAP NEXT WINDOW OR OUTPUT BUFFERFUL
CAIN T1,DI.DSK ;YES. DISK FILE?
MOVX T1,DI.OTH ;YES. SUBSTITUTE 'OTHER'
PJRST OSTAB(T1) ;MAP OR WRITE NEXT BUFFERFUL
OSTAB: JRST OSBUF ;TTY
JRST %OSMAP ;DSK
JRST OSBUF ;MTA
JRST OSBUF ;OTHER LOCAL DEVICE
IF20,< JRST %RMSOU ;[5004] REMOTE STREAM FILE
JRST %UORMS ;[5004]
> ;End IF20
;ROUTINE TO GET NEXT BUFFER OF NON-DISK FILE
IF20,<
TISBUF:
%ISBUF: SKIPE B36FLG(D) ;OPENED IN 36-BIT MODE?
JRST BISBUF ;YES. DO BINARY INPUT
MOVE T1,IJFN(D) ;GET FILE JFN
MOVE T2,WADR(D) ;GET POINTER TO BUFFER
SUBI T2,1 ;POINT TO WORD-1
HXL T2,BYTPT(D) ;GET END-OF-WORD BYTE PNTR
MOVN T3,WSIZ(D) ;GET WINDOW SIZE IN BYTES
SINR% ;READ STRING
ERCAL EOFCHK ;ERROR, POSSIBLE EOF
MOVE T2,WADR(D) ;MAKE BYTE POINTER TO BUFFER
SUBI T2,1 ;POINT TO BEG-1
HXL T2,BYTPT(D)
ADD T3,WSIZ(D) ;CALC # BYTES WE GOT
ADDM T3,BYTN(D) ;ADD TO # BYTES READ IN FILE
DMOVEM T2,IPTR(D) ;SAVE PNTR/COUNT
POPJ P,
BISBUF: MOVE T0,FLAGS(D) ;GET DDB FLAGS
TXNE T0,D%END ;END FILE ALREADY?
POPJ P, ;YES. NOTHING TO DO
MOVE T1,IJFN(D) ;GET JFN
MOVE T2,WADR(D) ;GET ADDRESS OF BUFFER
HRLI T2,(POINT 36) ;GET BINARY POINTER
MOVN T3,WSIZ(D) ;GET WINDOW SIZE
IDIV T3,BPW(D) ;GET # WORDS
SINR% ;READ
ERCAL EOFCHK ;EOF OR ERROR
IMUL T3,BPW(D) ;GET LEFTOVERS IN BYTES
MOVE T2,WADR(D) ;POINT TO DATA
SUBI T2,1 ;POINT TO WORD-1
HXL T2,BYTPT(D) ;ALIGN THE PNTR
ADD T3,WSIZ(D) ;CALC # BYTES WE GOT
ADDM T3,BYTN(D) ;ADD TO # BYTES WE'VE READ IN FILE
DMOVEM T2,IPTR(D) ;SAVE PNTR/COUNT
POPJ P, ;DONE
EOFCHK: MOVE T1,IJFN(D) ;[3343] GET THE STATUS
GTSTS% ;[3343]
TXNE T2,GS%EOF ;[3343] EOF?
JRST EOFCK1 ;[3343] YES
TXZ T2,GS%ERR ;[3343] NO, CLEAR ERROR BIT
STSTS% ;[3343]
$SNH ;[3343]
$ACALL IOE ;NO. REPORT ERROR
EOFCK1: MOVX T0,D%END ;[3343] EOF, tell caller
IORM T0,FLAGS(D)
POPJ P,
;NON-DISK OUTPUT
OSBUF: PUSHJ P,%OBUF ;OUTPUT BUFFERFUL
JRST OSKP ;AND SETUP BUFFER PNTR/COUNT
%OBUF: SKIPE B36FLG(D) ;OPENED IN 36-BIT MODE?
JRST BOSBUF ;YES. DO BINARY OUTPUT
HRRZ T1,IPTR(D) ;[4131] GET ADDRESS OF DATA
JUMPE T1,%POPJ ;[4131] IF NO DATA, LEAVE
MOVE T1,OJFN(D) ;GET JFN
MOVE T2,WADR(D) ;GET WINDOW ADDR
SUBI T2,1 ;POINT TO WORD-1
HXL T2,BYTPT(D) ;GET END-OF-WORD BYTE PNTR
MOVE T3,WSIZ(D) ;GET WINDOW SIZE IN BYTES
SUB T3,ICNT(D) ;DECREMENT ACTIVE BYTE COUNT
ADDM T3,BYTN(D) ;UPDATE # BYTES WRITTEN IN FILE
MOVN T3,T3 ;GET NEGATIVE
SOUTR% ;OUTPUT THE BLOCK
ERJMP OUTERR ;ERROR, GO TELL USER
POPJ P,
BOSBUF: MOVE T3,WSIZ(D) ;GET WINDOW SIZE IN BYTES
SUB T3,ICNT(D) ;CALC # BYTES USED
ADDM T3,BYTN(D) ;UPDATE # BYTES WRITTEN IN FILE
HRRZ T1,IPTR(D) ;[4131] GET ADDRESS OF DATA
JUMPE T1,%POPJ ;[4131] IF NO DATA, LEAVE
MOVE T1,IJFN(D) ;GET JFN
MOVE T2,WADR(D) ;GET ADDRESS OF BUFFER
HRLI T2,(POINT 36) ;GET BINARY BYTE POINTER
HRRZ T3,IPTR(D) ;GET CURRENT PNTR
SUB T3,WADR(D) ;GET WORD OFFSET
ADDI T3,1 ;GET # WORDS USED
MOVN T3,T3 ;GET NEGATIVE
SOUTR% ;WRITE BUFFER
ERJMP OUTERR ;ERROR, TYPE MESSAGE
POPJ P,
OSKP: MOVE T1,WADR(D) ;POINT TO EMPTY BUFFER
SUBI T1,1 ;POINT TO WORD-1
HXL T1,BYTPT(D) ;CREATE PNTR
MOVE T2,WSIZ(D) ;GET FULL WINDOW SIZE
DMOVEM T1,IPTR(D) ;SAVE PNTR/COUNT
POPJ P,
OUTERR: MOVE T1,IJFN(D) ;[3343] GET THE STATUS
GTSTS% ;[3343]
TXZ T2,GS%ERR ;[3343] CLEAR ERROR BIT
STSTS% ;[3343]
$SNH ;[3343]
$ACALL IOE ;GENERAL I/O ERROR
> ;END IF20
;ROUTINE TO MAP WINDOW CONTAINING FIRST BYTE OF RANDOM RECORD
;THINGS ARE LEFT SET UP FOR NXTW IN CASE RECORD SPANS WINDOWS
;ARGS: A.REC = RECORD NUMBER TO SET TO
;RETURN: IPTR = POINTER TO FIRST BYTE OF RECORD
; ICNT = BYTES IN WINDOW
; BYTN = NUMBER OF FIRST BYTE IN FOLLOWING WINDOW
FIRMPW: SKIPG WTAB(D) ;LOCAL RANDOM FILE
POPJ P, ;NO, LET RMS HANDLE IT
PUSHJ P,FRMAPW ;SETUP DESIRED BYTE NUMBER
JRST IRMPW ;GO CHECK IF EOF
FORMPW: SKIPG WTAB(D) ;LOCAL RANDOM FILE?
POPJ P, ;NO, LET RMS HANDLE IT
PUSHJ P,FRMAPW ;SETUP DESIRED BYTE NUMBER
PJRST OMAPW ;AND MAP IT
UIRMPW: PUSHJ P,URMAPW ;SETUP DESIRED BYTE NUMBER
IRMPW: MOVE T1,BYTN(D) ;GET BYTE NUMBER OF RECORD START
CAMGE T1,EOFN(D) ;PAST EOF?
PJRST IMAPW ;NO. MAP IT
AOS CREC(D) ;INCR RECORD NUMBER FOR MSG
$ACALL RNR ;YES. RECORD NOT WRITTEN
UORMPW: PUSHJ P,URMAPW ;SETUP DESIRED BYTE NUMBER
PJRST OMAPW ;AND MAP IT
FRMAPW: SKIPA T2,FRSIZB(D) ;GET FORMATTED RECORD SIZE
URMAPW: MOVE T2,URSIZB(D) ;GET UNFORMATTED RECORD SIZE
RMAPW: SKIPN T1,A.REC ;GET ADDRESS OF RECORD NUMBER
$ACALL CDS ;CAN'T DO SEQUENTIAL I/O TO DIRECT FILE
SKIPG T1,@T1 ;GET RECORD NUMBER
$ACALL IRN ;ILLEGAL RECORD NUMBER
SUBI T1,1 ;GET # RECS BEFORE THIS ONE
MOVEM T1,CREC(D) ;STORE PREVIOUS RECORD NUMBER
IMUL T1,T2 ;GET # BYTES BEFORE THIS ONE
MOVEM T1,BYTN(D) ;WHICH IS THE BYTE NUMBER OF REC BEG
POPJ P,
;ROUTINE TO MAP A FILE WINDOW FOR A RANDOM FILE
;ARGS: BYTN = FILE ADDRESS
;RETURN: IPTR = PROCESS BYTE POINTER
; ICNT = NUMBER OF BYTES LEFT IN WINDOW
LWSIZ==9 ;A PAGE IS
PSIZ==1000 ;A PAGE IS A PAGE IS A PAGE
IMAPW: LOAD T1,INDX(D) ;[5003] GET DEVICE INDEX
JRST IMPTAB(T1) ;[5003]
IMPTAB: $SNH ;[5003] TTY - NO RANDOM I/O
JRST IMAPWD ;[5003] DSK
$SNH ;[5003] MTA - NO RANDOM I/O
$SNH ;[5003] OTHER - NO RANDOM I/O
IF20,< JRST IMAPWD ;[5003] REMOTE STREAM FILE
JRST %IRMS ;[5003] RMS FILE
> ;End IF20
IMAPWD: PUSHJ P,%SAVE2 ;[5003] SAVE P1,P2
PUSHJ P,GETPAG ;GET PAGE, SETUP PNTR/COUNT
DMOVEM P1,IPTR(D) ;SAVE PNTR/COUNT
PUSHJ P,PAGCHK ;CHECK THE PAGE
PUSHJ P,MAPUPD ;UPDATE NEXT PAGE TO CHANGE
POPJ P,
OMAPW: LOAD T1,INDX(D) ;[5004] GET DEVICE INDEX
JRST OMPTAB(T1) ;[5004] DO DEVICE-DEPENDENT OUTPUT
OMPTAB: $SNH ;[5004] TTY - NO RANDOM I/O
JRST OMAPWD ;[5004] DSK
$SNH ;[5004] MTA - NO RANDOM I/O
$SNH ;[5004] OTHER - NO RANDOM I/O
IF20,< JRST OMAPWD ;[5004] REMOTE STREAM FILE
JRST %UORMS ;[5004] RMS FILE
> ;End IF20
OMAPWD: PUSHJ P,%SAVE2 ;[5004] SAVE P1,P2
PUSHJ P,GETPAG ;GET PAGE, SETUP PNTR/COUNT
DMOVEM P1,IPTR(D) ;SAVE PNTR/COUNT
PUSHJ P,SETWRT ;FLAG PAGE IS WRITTEN
PUSHJ P,MAPUPD ;UPDATE NEXT PAGE TO CHANGE
POPJ P,
GETPAG: MOVE P1,BYTN(D) ;GET BYTE NUMBER
IDIV P1,WSIZ(D) ;GET PAGE #
MOVE T1,WTAB(D) ;GET POINTER TO WINDOW TABLE
LOAD T2,BUFCT(D)
FINDW: CAMN P1,(T1) ;MATCH?
JRST PAGMAT ;YES
ADDI T1,1 ;INCR TABLE PNTR
SOJG T2,FINDW ;LOOP
LOAD T1,INDX(D) ;NOT IN CORE. GET DEVICE INDEX
PUSHJ P,RDWTAB(T1) ;GET THE PAGE INTO CORE
PAGMAT: MOVE P1,T1 ;GET PNTR TO CORRECT ENTRY IN LIST
SUB P1,WTAB(D) ;GET PAGE OFFSET
MOVEM P1,WPAGE ;SAVE IT
ADD P1,WPTR(D) ;GET CORRESPONDING CORE PAGE #
LSH P1,LWSIZ ;MAKE IT A WORD ADDR
SUBI P1,1 ;SHOULD POINT AT DESIRED WORD -1
HXL P1,BYTPT(D) ;MAKE IT A BYTE PNTR
MOVE T2,WSIZ(D) ;GET # BYTES IN WINDOW
SUBI T2,(P2) ;GET # BYTES AVAILABLE
EXCH P1,P2 ;PUT THE BYTE REMAINDER IN P1
ADJBP P1,P2 ;UPDATE THE BYTE PNTR
MOVEI P2,(T2) ;GET BYTES AVAILABLE WHERE IT SHOULD BE
ADDM P2,BYTN(D) ;SET BYTE NUMBER TO AFTER THIS WINDOW
POPJ P,
RDWTAB: $SNH ;[5003] TTY - NO RANDOM I/O
JRST RDW ;[5003] DSK
$SNH ;[5003] MTA - NO RANDOM I/O
$SNH ;[5003] OTHER - NO RANDOM I/O
IF20,< JRST %RMRDW ;[5003] REMOTE STREAM FILE
$SNH ;[5003] RMS FILE
> ;End IF20
MAPUPD: MOVE T2,WADR(D) ;GET REFILL POINTER TO WINDOW TABLE
CAME T2,WPAGE ;IS IT POINTING TO PAGE WE JUST USED?
POPJ P, ;NO. LEAVE IT WHERE IT IS
SOJGE T2,PTRRET ;YES. POINT IT 1 BEHIND THIS ONE
LOAD T2,BUFCT(D) ;PASSED BEGINNING OF TABLE. POINT TO END
SUBI T2,1
PTRRET: MOVEM T2,WADR(D) ;RESET REFILL POINTER
POPJ P,
SEGMENT DATA
WPAGE: BLOCK 1 ;OFFSET INTO WTAB FOR MATCHED PAGE #
;**** DO NOT SEPARATE THESE WORDS *****
PAGNUM: BLOCK 1 ;PAGE NUMBER OF DESIRED BYTE
BYTUSD: BLOCK 1 ;# BYTES USED WITHIN THE PAGE
SEGMENT CODE
SETWRT: MOVE T2,WPAGE ;GET PAGE OFFSET
ADD T2,PFTAB(D) ;POINT TO MODIFIED PAGE TABLE
SETOM (T2) ;SET PAGE MODIFIED
POPJ P,
IF10,<
CHKPGS:
PAGCHK: POPJ P,
>;END IF10
IF20,<
PAGCHK: LOAD T3,ACC(D) ;GET ACCESS
CAIE T3,AC.RIN ;RANDIN?
POPJ P, ;NO. DON'T MIND IF IT'S CREATED
MOVE T2,WPAGE ;GET PAGE # IN QUESTION
ADD T2,WPTR(D)
LSH T2,LWSIZ ;MAKE IT AN ADDRESS
SKIP (T2) ;REFERENCE A WORD IN THE PAGE
ERJMP UNMAPR ;UNMAP THE PAGE IF NON-EXISTENT
POPJ P,
UNMAPR: LSH T2,-LWSIZ ;MAKE IT A PAGE AGAIN
HRLI T2,.FHSLF ;THIS FORK
SETO T1, ;SETUP UNMAP FUNCTION
SETZ T3, ;WITH NO REPEAT COUNT
PMAP% ;UNMAP IT, SO IT WILL BE 0
POPJ P,
RDW: MOVE T2,WADR(D) ;GET PROCESS PAGE NUMBER
ADD T2,WPTR(D)
HRLI T2,.FHSLF ;FORK HANDLE
HRLZ T1,IJFN(D) ;JFN
HRRI T1,(P1) ;FILE PAGE NUMBER
MOVSI T3,(PM%PLD+PM%RD+PM%WR) ;ACCESS BITS
PMAP% ;MAP PAGE IN
ERJMP PGERR ;[3247]
MOVE T1,WADR(D) ;GET PAGE TABLE OFFSET AGAIN
ADD T1,WTAB(D) ;POINT INTO PAGE TABLE
MOVEM P1,(T1) ;STORE NEW FILE PAGE NUMBER
POPJ P, ;LEAVE WITH TABLE PNTR IN T1
>;END IF20
IF10,<
RDW: PUSHJ P,WRTPG ;WRITE PAGE BACK IF MODIFIED
MOVE T4,WADR(D) ;GET PAGE TABLE OFFSET
ADD T4,WPTR(D) ;GET CORE PAGE NUMBER
LSH T4,LWSIZ ;CONVERT TO ADDRESS
MOVE T5,P1 ;GET FILE PAGE NUMBER AGAIN
ADDI T5,1 ;GET # PAGES
LSH T5,LWSIZ ;GET # WORDS IN THESE PAGES
CAMG T5,LKPB+.RBSIZ(D) ;BEYOND WRITTEN WORDS?
JRST RDWRP ;NO. NOTHING TO CLEAR
SUB T5,LKPB+.RBSIZ(D) ;GET # WORDS BEYOND THOSE WRITTEN
CAILE T5,PSIZ ;MORE THAN A PAGE?
MOVEI T5,PSIZ ;YES. JUST CLEAR A PAGE
MOVEI T1,(T4) ;COPY PAGE ADDRESS
ADDI T1,PSIZ ;POINT TO LAST ADDR OF PAGE + 1
SUBI T1,(T5) ;POINT TO 1ST WORD TO CLEAR
SETZM (T1) ;CLEAR IT
CAIG T5,1 ;MORE TO CLEAR?
JRST RDWNC ;NO
HRLI T1,(T1) ;MAKE IT A BLT PNTR
ADDI T1,1
BLT T1,PSIZ-1(T4) ;CLEAR THE REST OF THE BLOCK
RDWNC: SUBI T5,PSIZ ;SET NEGATIVE # WORDS TO READ
JUMPE T5,RDWNW ;NO INPUT IF NO WORDS TO READ
HRLI T4,(T5) ;GET INTO IOWD FORMAT
JRST RDWCOM
RDWRP: HRLI T4,-PSIZ ;READ AN ENTIRE PAGE
RDWCOM: SUBI T4,1 ;ADDR-1 FOR IOWD
MOVEM T4,DMPLST ;SAVE FOR DUMP INPUT
SETZM DMPLST+1
MOVE T2,CHAN(D) ;SET CHANNEL NUMBER
HRRI T2,.FOUSI ;SET USETI FUNCTION
MOVE T3,P1 ;GET PAGE NUMBER
IMULI T3,4 ;4 BLOCKS/PAGE
ADDI T3,1 ;MAKE IT A BLOCK NUMBER
MOVE T1,[2,,T2] ;SET TO DESIRED BLOCK
FILOP. T1,
$ACALL IOE
MOVEI T3,DMPLST ;SET ADDRESS OF COMMAND LIST
MOVE T2,CHAN(D) ;SET CHANNEL NUMBER
HRRI T2,.FOINP ;SET INPUT FUNCTION
MOVE T1,[2,,T2] ;SET ARG BLOCK POINTER
FILOP. T1, ;DO FILOP
$ACALL IOE
RDWNW: MOVE T1,WADR(D) ;RELOAD WTAB POINTER
ADD T1,WTAB(D)
MOVEM P1,(T1) ;STORE NEW FILE PAGE NUMBER
POPJ P, ;LEAVE WITH TABLE PNTR IN T1
WRTPG: MOVE T1,WADR(D) ;GET PAGE TABLE OFFSET
ADD T1,PFTAB(D) ;POINT TO PAGE FLAG TABLE
SKIPL (T1) ;MODIFIED?
POPJ P, ;NOT MODIFIED, NO NEED TO WRITE
SETZM (T1) ;TURN OFF PAGE MODIFIED FLAG
MOVE T2,CHAN(D) ;GET CHANNEL NUMBER
HRRI T2,.FOUSO ;SET USETO FUNCTION
MOVE T4,WADR(D) ;GET PAGE TABLE OFFSET TO THIS PAGE
ADD T4,WTAB(D) ;POINT INTO PAGE TABLE
MOVE T3,(T4) ;GET PAGE NUMBER
IMULI T3,4 ;4 BLOCKS/PAGE
ADDI T3,1 ;SET TO BLOCK #
MOVE T1,[2,,T2] ;SET ARG BLOCK POINTER
FILOP. T1, ;SET TO DESIRED BLOCK
$ACALL IOE
MOVE T3,(T4) ;GET PAGE NUMBER AGAIN
ADDI T3,1 ;GET # PAGES
IMUL T3,WSIZ(D) ;GET # BYTES TO END OF THIS PAGE
CAMLE T3,EOFN(D) ;BEYOND EOF?
MOVE T3,EOFN(D) ;YES. USE EOF
ADD T3,BPW(D) ;ROUND UP TO # WORDS
SUBI T3,1
IDIV T3,BPW(D) ;GET # WORDS TO EOF
CAMLE T3,LKPB+.RBSIZ(D) ;BEYOND RECORDED LENGTH?
MOVEM T3,LKPB+.RBSIZ(D) ;YES. SAVE IN LOOKUP/ENTER BLOCK
ANDI T3,PSIZ-1 ;GET # WORDS TO WRITE
JUMPE T3,WRSBLK ;IF NO REMAINDER, WRITE FULL PAGE
MOVNI T3,(T3) ;GET NEGATIVE
JRST DOBWRT ;GO WRITE THE PAGE
WRSBLK: MOVNI T3,PSIZ ;STANDARD SIZE PAGE
DOBWRT: MOVE T2,CHAN(D) ;GET CHANNEL NUMBER AGAIN
HRRI T2,.FOOUT ;SET OUTPUT FUNCTION
MOVE T4,WADR(D) ;POINT TO WTAB ENTRY AGAIN
ADD T4,WPTR(D) ;GET CORE PAGE ADDR
LSH T4,LWSIZ ;MAKE INTO WORD ADDRESS
SUBI T4,1 ;-1 FOR IOWD
HRLI T4,(T3) ;PUT COUNT IN LH
SETZ T5, ;ZERO TO END COMMAND LIST
MOVEI T3,T4 ;POINT TO COMMAND LIST
MOVE T1,[2,,T2] ;SET ARG BLOCK POINTER
FILOP. T1, ;DO FILOP OR OUT UUO
$ACALL IOE
POPJ P, ;DONE
;HERE AT CLOSE TO WRITE MODIFIED PAGES
%RANWR: PUSHJ P,%SAVE1 ;SAVE P1
SETZM WADR(D) ;POINT TO BEG OF PAGE TABLE
LOAD P1,BUFCT(D) ;GET # PAGES
RWLP: PUSHJ P,WRTPG ;WRITE IT IF MODIFIED
AOS WADR(D) ;POINT TO NEXT PAGE
SOJG P1,RWLP ;DO ALL PAGES
POPJ P, ;DONE
> ;IF10
;SEQUENTIAL CASE, ONE N-PAGE WINDOW
;ARGS: BYTN = BYTE NUMBER IN FILE
; BUFCT = LENGTH OF WINDOW, PAGES
%OSMAP: PUSHJ P,%OSDSK ;OUTPUT THE CURRENT WINDOW
PUSHJ P,%SMAPW ;MAP THE DESIRED WINDOW
PJRST SETPTR ;GO SETUP PNTR/COUNT
%ISMAP: MOVE T1,BYTN(D) ;GET DESIRED BYTE #
CAML T1,EOFN(D) ;PAST EOF?
JRST SMEOF ;YES. GO SET EOF FLAG
PUSHJ P,%SMAPW ;MAP THE DESIRED WINDOW
PUSHJ P,CHKPGS ;CHECK PAGE EXISTENCE
PUSHJ P,SETPTR ;SETUP PNTR/COUNT
MOVE T2,BYTN(D) ;GET BYTE # OF NEXT WINDOW
CAMG T2,EOFN(D) ;PAST EOF?
POPJ P, ;NO. DONE
SUB T2,EOFN(D) ;GET DIFF
MOVNI T2,(T2) ;GET NEGATIVE
ADDM T2,ICNT(D) ;DECR COUNT APPROPRIATELY
POPJ P,
SMEOF: MOVX T1,D%END ;SET EOF
IORM T1,FLAGS(D)
POPJ P,
IF20,<
;%OSDSK - OUTPUT THE CURRENT OUTPUT WINDOW. NOTHING TO
;DO ON TOPS-20, AS UNMAPPING THE FILE IN CLOSE CODE WILL
;WRITE IT.
%OSDSK==%POPJ ;NO NEED TO OUTPUT DISK PAGES
%SMAPW: MOVE T2,BYTN(D) ;GET BYTE # IN FILE
MOVE T1,BPW(D) ;GET # BYTES/WORD
LSH T1,LWSIZ ;GET # BYTES/PAGE
IDIV T2,T1 ;GET PAGE #
DMOVEM T2,PAGNUM ;SAVE PAGE #, BYTES USED IN PAGE
MOVSI T2,.FHSLF ;THIS FORK
HRR T2,WPTR(D) ;PAGE NUMBER IN FORK
MOVE T1,PAGNUM ;PAGE NUMBER IN FILE
HRL T1,IJFN(D)
LOAD T3,BUFCT(D) ;PAGE COUNT
HRLI T3,(PM%CNT+PM%PLD+PM%RD+PM%WR) ;ACCESS BITS, READ PAGES NOW
PMAP% ;MAP WINDOW INTO FILE
ERJMP PGERR ;[3247]
POPJ P,
PGERR: HLRZ T1,T2 ;[3247] GET PROCESS HANDLE
GETER% ;[3247]
HRRZ T1,T2 ;[3247] GET ERROR NUMBER
CAIE T1,LNGFX1 ;[3247] PAGE TABLE ERROR?
$ECALL IJE ;[3247] NO
$ACALL RNR ;RECORD NOT WRITTEN
CHKPGS: LOAD T4,BUFCT(D) ;GET BUFFER COUNT
MOVNI T4,(T4) ;NEGATIVE
MOVSI T4,(T4) ;IN LEFT HALF
HRR T4,WPTR(D) ;GET PAGE # OF BOTTOM PAGE
CHPLP: MOVEI T1,(T4) ;GET CORE ADDR
LSH T1,LWSIZ
SKIP (T1)
ERJMP UNMPG ;IF NOT THERE, GO UNMAP
AOBJN T4,CHPLP ;BACK FOR MORE
POPJ P, ;DONE
UNMPG: SETO T1, ;SET TO UNMAP IT
MOVSI T2,.FHSLF ;THIS FORK
HRRI T2,(T4) ;GET THE CORRECT PAGE TO TOSS
SETZ T3, ;NO REPEAT COUNT
PMAP% ;UNMAP THE PAGE
AOBJN T4,CHPLP ;BACK FOR MORE
POPJ P, ;DONE
> ;END IF20
;SETPTR - SETS UP BYTE POINTER/COUNT FOR THE WINDOW
SETPTR: MOVE T2,WSIZ(D) ;GET # BYTES IN WINDOW
SUB T2,BYTUSD ;GET # BYTES AVAILABLE
ADDM T2,BYTN(D) ;SET BYTE NUMBER TO AFTER THIS WINDOW
MOVE T3,WADR(D) ;GET WINDOW ADDRESS
SUBI T3,1 ;POINT TO WORD ADDR-1
HXL T3,BYTPT(D) ;MAKE IT A BYTE PNTR
MOVE T1,BYTUSD ;GET # BYTES USED
ADJBP T1,T3 ;UPDATE THE BYTE POINTER
DMOVEM T1,IPTR(D) ;SAVE PNTR/COUNT
POPJ P,
IF10,<
;%OSDSK - OUTPUT THE CURRENT OUTPUT WINDOW TO THE DISK
%OSDSK: HRRZ T1,IPTR(D) ;[4131] GET ADDRESS OF DATA
JUMPE T1,%POPJ ;[4131] IF NO DATA, LEAVE
SUB T1,WADR(D) ;GET # WORDS TO WRITE -1
AOJE T1,%POPJ ;IF NONE TO WRITE, LEAVE
MOVE T3,BYTN(D) ;GET BYTE NUMBER OF NEXT WINDOW
SUB T3,WSIZ(D) ;GET BYTE NUMBER OF CURRENT WINDOW
;WHICH IS # BYTES PREVIOUS TO THIS ONE
MOVE T2,BPW(D) ;GET # BYTES/WORD
LSH T2,7 ;GET # BYTES/BLOCK
IDIVI T3,(T2) ;GET BLOCK # OF PREVIOUS BLOCK
CAMN T3,BLKN(D) ;IS IT THE LAST BLOCK WRITTEN?
JRST OSNUS ;YES. NO NEED FOR USETO
MOVE T2,CHAN(D) ;NO. SETUP FOR USETO
HRRI T2,.FOUSO
ADDI T3,1 ;SET BLOCK # FOR CURRENT WINDOW
MOVE T1,[2,,T2]
FILOP. T1, ;DO USETO
$ACALL IOE ;FAILED
OSNUS: MOVE T1,EOFN(D) ;GET HIGHEST BYTE TO WRITE
MOVE T2,BPW(D) ;GET # BYTES/WORD
LSH T2,7 ;GET # BYTES/BLOCK
ADDI T1,-1(T2) ;GET # BLOCKS WRITTEN
IDIVI T1,(T2) ;ROUNDED
MOVEM T1,BLKN(D) ;AND RECORD THE LAST BLOCK # WRITTEN
HRRZ T1,IPTR(D) ;GET CURRENT PNTR
SUB T1,WADR(D) ;GET WORD OFFSET
ADDI T1,1 ;GET # WORDS USED
MOVNI T1,(T1) ;NEGATIVE
HRLZI T1,(T1) ;IN LEFT HALF
HRR T1,WADR(D) ;GET ADDR
SUBI T1,1 ;IOWD FORMAT
MOVEM T1,DMPLST ;SAVE IT
SETZM DMPLST+1 ;END THE LIST
MOVE T2,FBLK(D) ;GET CHANNEL STUFF
HRRI T2,.FOOUT
MOVEI T3,DMPLST ;POINT TO IOWD
MOVE T1,[2,,T2] ;DO FILOP
FILOP. T1,
JRST ERRCHK
POPJ P,
%OBUF:
OSBUF: MOVE T1,WSIZ(D) ;INCREMENT BYTE COUNT
SUB T1,ICNT(D) ;WITH # BYTES USED IN THIS BUFFER
ADDM T1,BYTN(D)
MOVE T2,CHAN(D) ;WRITE CURRENT BLOCK
HRRI T2,.FOOUT
MOVE T1,[1,,T2]
FILOP. T1,
JRST ERRCHK ;[3343] REPORT ERROR AND DIE
MOVE T1,WADR(D) ;[4141] SETUP POINTER CORRECTLY
SUBI T1,1 ;[4141]
HXL T1,BYTPT(D) ;[4141]
MOVEM T1,IPTR(D) ;[4141] SAVE IT
POPJ P, ;DONE
%SMAPW: MOVE T3,BYTN(D) ;GET BYTE # DESIRED
MOVE T2,BPW(D) ;GET # BYTES/WORD
LSH T2,LWSIZ ;GET # BYTES/PAGE
IDIVI T3,(T2) ;GET PAGE #, # BYTES LEFTOVER
DMOVEM T3,PAGNUM ;SAVE THEM
MOVE T1,WSIZ(D) ;GET WINDOW SIZE AGAIN
MOVEI T2,(T1) ;COPY IT
SUB T2,BYTUSD ;DECR BY # BYTES USED
ADD T2,BYTN(D) ;CALC TOTAL # BYTES IF WINDOW IS FULL
CAMG T2,EOFN(D) ;PAST EOF?
JRST GOTWS ;NO. READ ENTIRE WINDOW
SUB T2,EOFN(D) ;YES. GET DIFFERENCE
SUBI T1,(T2) ;DECR # BYTES TO BE READ
JUMPE T1,%POPJ ;IF NONE TO READ, LEAVE NOW
ADD T1,BPW(D)
SUBI T1,1 ;ROUND TO WORDS
IDIV T1,BPW(D) ;GET # WORDS TO READ
MOVE T3,EOFN(D) ;GET # BYTES IN FILE
MOVE T4,BPW(D) ;GET # BYTES/WORD
LSH T4,7 ;GET # BYTES/BLOCK
ADDI T3,-1(T4) ;GET ROUNDED # BLOCKS IN FILE
IDIVI T3,(T4)
MOVEM T3,BLKN(D) ;SAVE LAST BLOCK # READ
JRST ISDMP ;JOIN COMMON CODE
GOTWS: MOVE T3,BPW(D) ;GET # BYTES/WORD
LSH T3,7 ;GET # BYTES/BLOCK
IDIVI T2,(T3) ;CALC LAST BLOCK # READ
MOVEM T2,BLKN(D) ;SAVE IT
MOVE T1,WSIZ(D) ;GET WINDOW SIZE
IDIV T1,BPW(D) ;GET # WORDS
ISDMP: MOVNI T1,(T1) ;GET NEGATIVE # WORDS TO READ
HRLZI T1,(T1) ;IN IOWD FORMAT
HRR T1,WADR(D)
SUBI T1,1
MOVEM T1,DMPLST ;SAVE FOR INPUT
SETZM DMPLST+1 ;END THE LIST
MOVE T3,PAGNUM ;GET THE PAGE NUMBER AGAIN
IMULI T3,4 ;GET BLOCK # OF PREVIOUS BLOCK
CAMN T3,BLKN(D) ;SAME AS PREVIOUS BLOCK READ OR WRITTEN?
JRST %SNXTW ;YES. NO NEED FOR USETI
ADDI T3,1 ;FIRST BLOCK IS 1
MOVE T2,FBLK(D) ;GET CHANNEL STUFF
HRRI T2,.FOUSI ;DO USETI TO POINT TO CORRECT PAGE
MOVE T1,[2,,T2] ;DO FILOP
FILOP. T1,
JRST ERRCHK ;SHOULD NOT FAIL
%SNXTW:
MOVE T2,FBLK(D) ;GET CHANNEL STUFF
HRRI T2,.FOINP
MOVEI T3,DMPLST ;POINT TO IOWD
MOVE T1,[2,,T2] ;DO FILOP
FILOP. T1,
JRST ERRCHK ;SHOULD NOT GET EOF!
POPJ P,
%ISBUF: MOVE T1,WSIZ(D) ;INCREMENT BYTE COUNT
ADDM T1,BYTN(D)
MOVE T2,CHAN(D) ;GET CHANNEL STUFF
HRRI T2,.FOINP ;READ NEXT BLOCK
MOVE T1,[1,,T2]
FILOP. T1,
PUSHJ P,EOFCHK
MOVE T1,WADR(D) ;[4141] SETUP POINTER/COUNT
SUBI T1,1 ;[4141]
HXL T1,BYTPT(D) ;[4141]
MOVEM T1,IPTR(D) ;[4141] SAVE IT
POPJ P,
EOFCHK: TXNN T1,IO.EOF ;[3343] CHECK FOR EOF
JRST ERRCHK ;[3343] NO
LOAD T2,INDX(D) ;GET DEV INDEX
CAIE T2,DI.TTY ;[3343] TERMINAL?
JRST SETEOF ;[3343] YES
MOVE T2,[1,,T3] ;SET UP FOR CLOSE
MOVEI T3,.FOCLS
HLL T3,CHAN(D)
FILOP. T2, ;CLEAR EOF BIT, LEAVE TTY OPEN
$ACALL IOE
SETEOF: MOVX T0,D%END ;[3343] Get EOF flag
IORM T0,FLAGS(D) ;Yes, this file is ended
POPJ P, ;[3343]
ERRCHK: MOVE T2,CHAN(D) ;[3343] Set up for getting
HRRI T2,.FOGET ;[3343] status bits
MOVE T1,[1,,T2] ;[3343]
FILOP. T1, ;[3343]
$SNH ;[3343]
MOVE T4,T1 ;[3343] Save the status
TXZ T1,IO.ERR ;[3343] Clear error bits
MOVE T3,T1 ;[3343] Set up for setting
HRRI T2,.FOSET ;[3343] status
MOVE T1,[2,,T2] ;[3343]
FILOP. T1, ;[3343]
$SNH ;[3343]
MOVE T1,T4 ;[3343] Set up for abort
$ACALL IOE
SEGMENT DATA
DMPNTR: BLOCK 1 ;DUMP LIST PNTR
DMPLST: BLOCK MAXARG+1 ;DUMP I/O LIST
BLOCK 1 ;THE ZERO WORD (JUST IN CASE)
SEGMENT CODE
> ;IF10
SUBTTL MTOP - Tape Positioning
;++
; FUNCTIONAL DESCRIPTION:
;
; These routines handle the positioning for the FORTRAN statements
; REWIND, UNLOAD, BACKSPACE, BACKFILE, ENDFILE and SKIPRECORD.
; They are mostly used for magnetic tape; However they may (and are)
; used for Disk operations.
;
; CALLING SEQUENCE:
;
; MOVEI 16,ARGADR ;Address of standard format arg list
; PUSHJ P,MTOP
;
; INPUT PARAMETERS:
;
; Unknown
;
; IMPLICIT INPUTS:
;
; Unknown
;
; OUTPUT PARAMETERS:
;
; Unknown
;
; IMPLICIT OUTPUTS:
;
; Unknown
;
; SIDE EFFECTS:
;
; May issue fatal error messages. Also, may truncate existing files.
;
;--
FENTRY (MTOP) ;FORTRAN entry point
PUSHJ P,%SAVAC ;Save Accumulators
PUSHJ P,%CPARG ;Make copy of argument list
PUSHJ P,MTCNV ;Convert argument list (if necessary)
;
; We don't know the name of the statement yet so make it a null
;
XMOVEI T1,[0] ;Make a pointer to a null string
MOVEM T1,%IONAM ;Save it as the statement name.
PUSHJ P,IOARG ;Move args to A.XXX
PUSHJ P,CHKUNT ;Check for unit number in range
;(Goes to ABORT% if unit is bad)
;
; Check the Operation Code Argument; Issue error if illegal.
;
SKIPL T1,@A.MTOP ;GET OPERATION CODE
CAILE T1,MOPMAX ;NEGATIVE OR TOO BIG?
$ACALL IMV ;ILLEGAL MTOP VALUE
;
; Set statement name from operation code. The statement name
; is used for the error message traceback.
;
XMOVEI T2,. ;Current section number in LH
HRR T2,MOPNAM(T1) ;Get global address of ASCIZ name
MOVEM T2,%IONAM ;Set statement name for error messages
;
; Set up "U" and "D". These are pointers to the UDB (unit Device Block)
; and the DDB (Device Data Block) which hold information about the unit
; See FORPRM for a description of these structures.
;
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
;
; Check to see if this is a RANDOM access file; File positioning
; operations are ILLEGAL on a random file.
;
SKIPE WTAB(D) ;Random File?
$ACALL POI ;Yes; Issue an error.
;
; Dispatch each positioning operation by its "Operation Code" and
; when finished performing the specific operation set the IOSTAT
; and the ASSOCIATEVARIABLE (ect...) and return
;
MOVE T1,@A.MTOP ;Get back MTOP number
PUSHJ P,@MOPDSP(T1) ;GO DO OPERATION
PJRST %SETAV ;RETURN (possibly doing ERR=, etc.)
;
; Table of statement names for each operation code
;
MOPNAM: [ASCIZ /REWIND/] ;(0)
[ASCIZ /UNLOAD/] ;(1)
[ASCIZ /BACKSPACE/] ;(2)
[ASCIZ /BACK FILE/] ;(3)
[ASCIZ /ENDFILE/] ;(4)
[ASCIZ /SKIP RECORD/] ;(5)
[0] ;(6)
[ASCIZ /SKIP FILE/] ;(7)
MOPMAX==.-MOPNAM
;
; Dispatch table for each specific operation code
;
MOPDSP: IFIW MOPREW
IFIW MOPUNL
IFIW MOPBSR
IFIW MOPBSF
IFIW MOPEND
IFIW MOPSKR
IFIW %POPJ
IFIW MOPSKF ;End of routine MTOP
SUBTTL MOPREW - REWIND Tape Positioning
;++
; When used for Disk files causes the specified file to be positioned
; at its initial point.
; For magnetic tape, positions the magtape unit at the Physical Begining
; of Tape.
;-
;
; Perform the REWIND based on the type of device.
;
MOPREW: LOAD T1,INDX(D) ;GET DEV INDEX
PJRST REWTAB(T1) ;DO REWIND BY DEVICE
;
; Dispatch table for device specific rewind code
;
REWTAB: POPJ P, ;(0) TTY:
JRST DSKREW ;(1) DSK:
JRST MTAREW ;(2) MTA:
POPJ P, ;(3) Anything Else
IF20,< JRST DSKREW ;(4) Remote Stream File
JRST %RMREW ;(5) RMS File
> ;End IF20
;
; REWIND for DISK devices
;
; If the device was opened for OUTPUT we need to close the file and
; re-open the file for input. Now we're at the begining of the file.
;
DSKREW: MOVX T1,D%END ;SET NO EOF
ANDCAB T1,FLAGS(D) ;AND GET THEM
TXNE T1,D%OUT ;WAS IT OPEN FOR OUTPUT?
PUSHJ P,%SETIN ;YES. SWITCH TO INPUT
;
; Reset the pointers used by the I/O to the begining.
;
SETZM CREC(D) ;CLEAR RECORD NUMBER
SETZM IPTR(D) ;PRETEND NO I/O DONE
SETZM ICNT(D) ;NO BYTES IN BUFFER
SETZM BYTN(D) ;SET CURRENT BYTE NUMBER TO 0
POPJ P, ;End of DSKREW
;
; REWIND for MAGTAPE devices.
;
MTAREW: MOVE T1,FLAGS(D) ;Get DDB flags
TXNN T1,D%IN+D%OUT ;If the unit is not open,
JRST JSTREW ;DON'T CLOSE, OPEN FILE
TXNE T1,D%OUT+D%END ;is the unit OPEN FOR OUTPUT OR AT EOF?
PUSHJ P,%MTCLI ;YES. CLOSE FILE, OPEN FOR INPUT
SETZM CREC(D) ;CLEAR RECORD NUMBER
HXLZ T1,BYTPT(D) ;[4131] GET BYTE POINTER
MOVEM T1,IPTR(D) ;[4131] SAVE IT
SETZM ICNT(D) ;NO BYTES IN BUFFER
SETZM BYTN(D) ;SET CURRENT BYTE NUMBER TO 0
LOAD T1,LTYP(D) ;GET LABEL TYPE
CAIE T1,LT.UNL ;is it an UNLABELED tape?
JRST %MTBSF ;No, its labeled; Backspace 1 file.
JRST %MTREW ;YES. Go back to physical BOT
;
; Rewind a device which is not OPENed. If this a Labeled tape
; then just go back to begining of current file.
;
JSTREW: PUSHJ P,MTAOJF ;Open JFN, aborts if fails
PUSHJ P,%MTREW ;NO. GO BACK 1 FILE INSTEAD
PJRST MTACJF ;Close file, release JFN, return
;End of routine MOPREW
SUBTTL MOPUNL - UNLOAD Tape Positioning
;++
; Rewind and unloads a magnetic tape on the specified unit.
;--
MOPUNL: LOAD T1,INDX(D) ;GET DEV INDEX
PJRST UNLTAB(T1) ;UNLOAD BY DEVICE TYPE
UNLTAB: POPJ P, ;TTY. UNLOAD THE RIBBON?
JRST DSKREW ;DSK. JUST LIKE A REWIND
JRST MTAUNL ;MTA
POPJ P, ;NO OTHER DEVICE CAN BE UNLOADED
IF20,< JRST DSKREW ;[5004] REMOTE STREAM FILE
JRST %RMREW ;[5004] RMS FILE
> ;End IF20
;
; UNLOAD for MAGTAPE devices
;
MTAUNL: MOVE T1,FLAGS(D) ;Get DDB flags
TXNN T1,D%IN+D%OUT ;If not opened yet,
JRST JSTUNL ;Don't call "SETIN"
TXNE T1,D%OUT+D%END ;OPEN FOR OUTPUT OR AT EOF?
PUSHJ P,%MTCLI ;CLOSE FILE, OPEN FOR INPUT
HXLZ T1,BYTPT(D) ;[4131] GET BYTE POINTER
MOVEM T1,IPTR(D) ;[4131] SAVE IT
SETZM ICNT(D) ;NO BYTES IN BUFFER
SETZM BYTN(D) ;SET CURRENT BYTE NUMBER TO 0
SETZM CREC(D) ;CLEAR RECORD COUNT
PJRST %MTUNL ;UNLOAD THE TAPE
;
; Just UNLOAD (for a device which isn't OPENed).
; TOPS-20 needs a JFN for the device. TOPS-10 doesn't.
;
JSTUNL: PUSHJ P,MTAOJF ;Get a JFN with no filename
PUSHJ P,%MTUNL ;UNLOAD it
PJRST MTACJF ;Close, release JFN and return
;End of routine MOPUNL
SUBTTL MOPBSR - BACKSPACE Tape Positioning
;++
; BACKSPACE Statement
;
; Execution of the BACKSPACE statement causes the file connected to
; the specified unit to be positioned before the precedeing record.
; If there is no preceeding record, the position of the file is not
; changed. If the preceeding record is an ENDFILE record, the file
; is positioned before the ENDFILE record.
;
; The backspace statement cannot be used for direct-access files,
; append-access or for list-directed files.
;--
MOPBSR: SKIPE FUMXD(D) ;MIXED-MODE FILE?
$ACALL CDF ;YES. CAN'T DETERMINE FORM=
LOAD T1,INDX(D) ;GET DEVICE INDEX
PJRST BSRTAB(T1) ;DO BACKSPACE BY DEVICE TYPE
BSRTAB: POPJ P, ;TTY
JRST DSKBSR ;DISK
JRST MTABSR ;MAGTAPE
POPJ P, ;OTHER
IF20,< JRST DSKBSR ;[5013] REMOTE STREAM FILE
JRST %RMBSR ;[5013] RMS FILE
> ;End IF20
;[4156] SEPARATE (AND COPY) THIS FROM DISK CODE
MTABSR:
;
; [5006] Labeled tapes can't perform a backspace record
;
LOAD T1,LTYP(D) ;[5006]Get label type
CAIE T1,LT.UNL ;[5006] If its' labeled give error
$ACALL NLT ;[5006] Not allowed with Labeled Mag tape
PUSHJ P,%SETIN ;Switch to input if necessary
SKIPG CREC(D) ;ARE WE AT BEG OF FILE?
POPJ P, ;YES. CAN'T GO BACKWARDS
MOVE T0,FLAGS(D)
TXNE T0,D%END ;FILE AT END?
JRST BAKEOF ;YES. JUST BACK OVER IT
HRRZ T1,IPTR(D) ;[4131] GET ADDRESS OF DATA
JUMPE T1,%POPJ ;[4131] IF NO DATA, LEAVE
SOS CREC(D) ;DECR RECORD COUNT
;
; [4151] Is this a labeled tape?
;
LOAD T1,LTYP(D) ;Get label type
CAIE T1,LT.UNL ;[4156] Is it an unlabeled tape?
JRST BSRLAB ;No, it's labeled
;
; [4151] Is this tape using delimited records?
;
LOAD T1,RECTP(D) ;Get record type
CAIN T1,RT.DEL ;Is it delimited?
JRST BSRDEL ;Yes, go do a delimited backspace!
JRST COMBSR ;JOIN COMMON CODE
DSKBSR: PUSHJ P,%SETIN ;Switch to input if necessary
SKIPG CREC(D) ;ARE WE AT BEG OF FILE?
POPJ P, ;YES. CAN'T GO BACKWARDS
LOAD T1,MODE(D) ;GET MODE
CAIN T1,MD.DMP ;DUMP?
POPJ P, ;YES. A NOP
MOVE T0,FLAGS(D)
TXNE T0,D%END ;FILE AT END?
JRST BAKEOF ;YES. JUST BACK OVER IT
HRRZ T1,IPTR(D) ;[4131] GET ADDRESS OF DATA
JUMPE T1,%POPJ ;[4131] IF NO DATA, LEAVE
SOS CREC(D) ;DECR RECORD COUNT
COMBSR: LOAD T0,FORM(D) ;GET FORM=
CAIN T0,FM.UNF ;UNFORMATTED?
JRST UNFBSR ;YES.
SKIPE P3,FRSIZB(D) ;FIXED-LENGTH RECORDS?
JRST BFCOM ;YES. JOIN COMMON CODE
BSRVAR: PUSHJ P,FBTST ;FIND CURRENT EOL
HRRZ T1,IPTR(D)
CAMGE T1,WADR(D) ;BEG OF WINDOW?
POPJ P, ;BACKSPACED TO BEG OF FILE
FBSLP: AOS ICNT(D) ;INCR COUNT
MOVNI T1,1 ;BACK 1 CHAR
ADJBP T1,IPTR(D) ;GET NEW PNTR
MOVEM T1,IPTR(D) ;SAVE IT BACK
FBTST: HRRZ T1,IPTR(D) ;GET ADDR PART OF PNTR
CAMGE T1,WADR(D) ;BEG OF WINDOW?
PUSHJ P,PRVWIN ;YES. GET PREVIOUS ONE
HRRZ T1,IPTR(D)
CAMGE T1,WADR(D) ;STILL BEG OF WINDOW?
POPJ P, ;BACKSPACED TO BEG OF FILE
LDB T1,IPTR(D) ;GET BYTE
CAIL T1,12 ;LF, VT, FF?
CAILE T1,14
JRST FBSLP ;NO
POPJ P,
;+ ;[4151]
; Routine to perform a backspace for delimited records
; See if we're already at the begining of the window (or file)
;-
BSRDEL: HRRZ T1,IPTR(D) ;Get address of current Pointer
CAMGE T1,WADR(D) ;Is it the begining of the window?
PUSHJ P,PRVWIN ;Yes. Get previous window.
HRRZ T1,IPTR(D) ;Get address of current Pointer, again
CAMGE T1,WADR(D) ;Are we still at the begining of window?
POPJ P, ;Yes, must be at the begining of file.
MOVE T1,WADR(D) ;Make byte pointer to buffer
SUBI T1,1 ;Point to begining -1
HXL T1,BYTPT(D) ;
; Read out the RCW and convert it to binary
; T0=Length of string, T1=Source string byte pointer, T4=Result
BSRDLP: PUSH P,T1 ;Save the origional byte pointer
MOVEI T0,4 ;GET # BYTES IN DELIMITER (RCW)
EXTEND T0,[<CVTDBO 777720>] ;Convert the RCW to binary
$ACALL ICD ;Illegal character in delimiter
POP P,T1 ;Restore the origional byte pointer
; Advance the pointer by the number of characters in this record.
; And check to see if we're back to the starting position.
MOVE T2,T4 ;Preserve record size in T4 (for later)
ADJBP T2,T1 ;Adjust pointer to begining of next record.
CAMN T2,IPTR(D) ;Same place as before?
JRST BSRDOK ;Yes. We're back to the begining, again
MOVE T1,T2 ;No. Use this new byte pointer this time!
SETZ T2, ;For good clean fun!
JRST BSRDLP ;GO TRY NEXT RECORD.
; Well we did all this to get the pointer to the previous record,
; So, let's save all this info.
BSRDOK: MOVEM T1,IPTR(D) ;Save previous record position
MOVEM T4,ICNT(D) ;Save the record size (excluding RCW)
POPJ P, ;End of routine BSRDEL
;+ ;[4151]
; Backspace for labeled tapes
;-
BSRLAB: SETZB T1,IPTR(D) ;Zero the pointer.
MOVEM T1,ICNT(D) ;zero the count.
PJRST %MTBSB ;Go tell the monitor to do it
;+
; Get the previous window.
;-
PRVWIN: LOAD T1,INDX(D) ;GET DEV INDEX
CAIN T1,DI.MTA ;TAPE?
JRST MTABSA ;YES
PUSHJ P,%PTOF ;GET FILE BYTE NUMBER OF CURRENT BYTE
SUB T1,BPW(D) ;GET BYTE NUMBER OF PREVIOUS WORD
JUMPLE T1,%POPJ ;SHOULD NEVER BE NEGATIVE IN FILE
MOVEM T1,BYTN(D) ;STORE FOR MAPPING
LOAD T1,INDX(D) ;GET DEVICE INDEX
PUSHJ P,ISTAB(T1) ;GET THE DESIRED WINDOW
AOS IPTR(D) ;INCR THE POINTER
MOVN T1,BPW(D) ;AND DECR THE COUNT
ADDM T1,ICNT(D)
POPJ P,
%MTBSA:
MTABSA: PUSHJ P,%MTBSB ;BACKSPACE OVER THE CURRENT BLOCK
MTABS1: PUSHJ P,%MTBSB ;BACKSPACE OVER THE PREVIOUS BLOCK
PUSHJ P,%ISBUF ;READ IT
MOVE T1,ICNT(D) ;GET THE NUMBER OF BYTES FOUND
MOVEM T1,BYTUSD ;SAVE IT
ADJBP T1,IPTR(D) ;POINT TO THE END OF THE BUFFER
MOVEM T1,IPTR(D) ;AND SAVE IT
SETZM ICNT(D) ;CLEAR THE COUNT
POPJ P,
UNFBSR: SKIPN IMGFLG(D) ;[4161] IMAGE?
JRST BINBSR ;NO. GO LOOK FOR LCSW TYPE 3
;IMAGE MODE. GET RECORDSIZE IN BYTES, GO TO COMMON CODE
SKIPN P3,URSIZB(D) ;RECORDSIZE SPECIFIED?
$ACALL CBI ;CAN'T BACKSPACE IF NO RECSIZ
JRST BFCOM ;JOIN COMMON CODE
BINBSR: HRRZ T1,IPTR(D) ;GET ADDR IN CURRENT PNTR
CAMGE T1,WADR(D) ;AT BEG OF WINDOW?
PUSHJ P,PRVWIN ;YES. MOVE BACK TO PREVIOUS WORD
HRRZ P3,IPTR(D) ;GET LOCAL ADDR
MOVE P3,(P3) ;GET END LSCW
TLZ P3,777000 ;GET LENGTH IN WORDS
IMUL P3,BPW(D) ;GET # BYTES IN RECORD
;NOW WE CALCULATE THE NUMBER OF BYTES TO THE CURRENT BYTE POINTER IN THIS
;BUFFER. COMPARE IT WITH THE RECORDSIZE. IF BACKSPACE WILL STILL BE IN
;THIS BUFFER, WE CAN JUST DO AN ADJBP AND MODIFY THE COUNT. OTHERWISE
;WE HAVE TO REMAP (DISK) OR BACKSPACE ITERATIVELY (MTA).
BFCOM: HRRZ T1,IPTR(D) ;GET CURRENT ADDR
SUB T1,WADR(D) ;GET OFFSET FROM BEG
ADDI T1,1 ;ADD THE CURRENT WORD
IMUL T1,BPW(D) ;GET BYTE OFFSET
MOVE T2,IPTR(D) ;GET POINTER PART
MUL T2,BPW(D) ;GET # BYTES LEFT IN CURRENT WORD
SUBI T1,(T2) ;GET # BYTES USED
MOVEM T1,BYTUSD ;SAVE IT
CAIGE T1,(P3) ;BACKSPACE WITHIN THIS WINDOW?
JRST COMBAK ;NO. MAP DISK OR LOOP MAGTAPE
ADDM P3,ICNT(D) ;UPDATE COUNT
MOVNI P3,(P3) ;GET NEG BYTE DIFF
ADJBP P3,IPTR(D) ;UPDATE PNTR
MOVEM P3,IPTR(D) ;SAVE IT
POPJ P,
COMBAK: LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIN T1,DI.MTA ;MAGTAPE?
JRST MTABSW ;YES
PUSHJ P,%PTOF ;CALC FILE POINTER
SUB T1,P3 ;[4217] CALC DESIRED FILE POINTER
MOVEM T1,BYTN(D) ;SAVE FOR MAPPING
LOAD T1,INDX(D) ;GET DEVICE INDEX AGAIN
PJRST ISTAB(T1) ;GO MAP THE WINDOW DESIRED
MTABSW: SUB P3,BYTUSD ;REDUCE # BYTES TO BACKSPACE
PUSHJ P,MTABSA ;BACKSPACE OVER CURRENT AND PREVIOUS, READ
MOVE T1,BYTUSD ;GET # BYTES IN THE BUFFER
CAIGE T1,(P3) ;BACKSPACE WITHIN THIS BLOCK?
JRST MTABSW ;NO. TRY AGAIN
ADDM P3,ICNT(D) ;YES. ADJUST COUNT
MOVNI P3,(P3) ;AND POINTER
ADJBP P3,IPTR(D)
MOVEM P3,IPTR(D) ;SAVE UPDATED POINTER
POPJ P,
SUBTTL MOPBSF - BACKFILE Tape Positioning
;+
; This statement is used only for magnetic tape operations. If an
; end-of-file has been detected the tape will be positioned to the
; begining of that file. Otherwise, the tape will be positioned to
; the begining of the previous file on the tape.
;-
MOPBSF: LOAD T1,INDX(D) ;GET DEV INDEX
CAIE T1,DI.MTA ;IS THIS A MAGTAPE?
POPJ P, ;NO, BACKFILE IS NOP
PUSHJ P,%SETIN ;Make sure we're open for input
HXLZ T1,BYTPT(D) ;[4131] GET BYTE POINTER
MOVEM T1,IPTR(D) ;[4131] SAVE IT
SETZM ICNT(D) ;NO BYTES IN BUFFER
SETZM BYTN(D) ;SET CURRENT BYTE NUMBER TO 0
SETZM CREC(D) ;CLEAR RECORD COUNT
MOVX T1,D%END ;WE ARE NOW NOT AT EOF
ANDCAM T1,FLAGS(D)
PUSHJ P,%MTBSF ;BACKSPACE A FILE
PUSHJ P,%MTBSF ;AND ANOTHER
PUSHJ P,BOTCHK ;ARE WE AT BOT?
PUSHJ P,%MTFSF ;NO. SKIP PAST A TAPE MARK
PJRST %MTCLI ;CLEAR EOF STATUS IF ANY
;End of routine MOPBSF
SUBTTL MOPEND - ENDFILE Tape positioning
;+
; Closes the file on the specified unit.
; For disk and magtape units an 'endfile' record is written and
; positioned after the end of file mark.
;-
MOPEND: AOS CREC(D) ;INCR REC #
LOAD T1,INDX(D) ;GET DEV INDEX
PJRST ENDTAB(T1) ;ENDFILE BY DEVICE TYPE
ENDTAB: POPJ P, ;TTY
JRST DSKEND ;DSK
JRST MTAEND ;MTA
POPJ P, ;OTHER DEVICE
IF20,< JRST DSKEND ;[5004] REMOTE STREAM FILE
JRST %RMEND ;[5004] RMS FILE
> ;End IF20
;
; ENDFILE for MAGTAPE devices
;
MTAEND:
;
; [5006] Labeled tapes can't do an ENDFILE
;
LOAD T1,LTYP(D) ;[5006]Get label type
CAIE T1,LT.UNL ;[5006] If its' labeled give error
$ACALL NLT ;[5006] Not allowed with Labeled Mag tape
PUSHJ P,%SETOUT ;Set to output
PUSHJ P,%MTCLI ;CLOSE FILE, OPEN FOR INPUT AGAIN
MOVE T1,FLAGS(D)
TXO T1,D%IN+D%END ;WE ARE OPEN FOR INPUT, AT EOF
TXZ T1,D%OUT ;NO LONGER DOING OUTPUT
MOVEM T1,FLAGS(D)
POPJ P,
;
; ENDFILE for DISK devices
;
DSKEND: PUSHJ P,%SETOUT ;SET TO OUTPUT
PUSHJ P,%SETIN ;AND THEN TO INPUT AGAIN
MOVX T1,D%END ;AT EOF
IORM T1,FLAGS(D)
POPJ P, ;DONE
SUBTTL MOPSKR - SKIPRECORD statement
;+
; Skips the next record in the file. Cannot be used on
; direct access files.
;-
MOPSKR: SKIPE FUMXD(D) ;MIXED-MODE FILE?
$ACALL CDF ;YES. CAN'T DETERMINE FORM=
PUSHJ P,%SETIN ;Switch to input
LOAD T1,INDX(D) ;GET DEVICE INDEX
PJRST SKRTAB(T1) ;SKIP RECORD BY DEVICE
SKRTAB: JRST %IREC ;TTY
JRST GSKR ;DSK
JRST GSKR ;MTA
JRST GSKR ;OTHER
IF20,< JRST GSKR ;REMOTE STREAM FILE
JRST %IREC ;RMS FILE
> ;End IF20
GSKR: LOAD T1,MODE(D)
CAIN T1,MD.DMP ;DUMP MODE?
POPJ P, ;YES. A NOP
LOAD T0,FORM(D) ;GET FORM=
CAIE T0,FM.FORM ;FORMATTED?
JRST UNFSKP ;NO. UNFORMATTED SKIP
PJRST %IREC ;YES. JUST READ A RECORD
; ;[4160]
; 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
SUBTTL MOPSKF - tape positioning for SKIPFILE statement
;++
; Check to see if the device is a magtape unit, if not just return because
; no other types of devices can perform a skipfile.
;
; Check to see if the unit is NOT opened, then jet a temporary JFN (ignored
; on TOPS-10) and have the monitor do the .TAPOP or MTOPR, give back the
; JFN and return to user code.
;
; If there's a file opened, and it's opened for output, closing and re-opening
; the unit will cause an EOF to be put down (thus positioning us after the
; file). If it's opened for input, then do a skip file monitor call and close
; open the unit.
;-
MOPSKF: LOAD T1,INDX(D) ;GET DEV INDEX
CAIE T1,DI.MTA ;TAPE?
POPJ P, ;NO, SKIP FILE IS NOP
MOVE T0,FLAGS(D) ;GET FLAGS
TXNN T0,D%IN+D%OUT ;FILE OPEN?
JRST JSTSKF ;NO. JUST SKIP A FILE
;
; Skip File on an Opened Unit
;
TXNN T0,D%OUT ;OPEN FOR OUTPUT?
PUSHJ P,%MTFSF ;NO. SKIP A FILE
PUSHJ P,%MTCLI ;MAKE SURE NO STUPID EOF BIT LEFT ON
SETZM CREC(D) ;CLEAR RECORD NUMBER
HXLZ T1,BYTPT(D) ;[4131] GET BYTE POINTER
MOVEM T1,IPTR(D) ;[4131] SAVE IT
SETZM ICNT(D) ;NO BYTES IN BUFFER
SETZM BYTN(D) ;SET CURRENT BYTE NUMBER TO 0
POPJ P,
;
; Skip File on a Non-Opened Unit
;
JSTSKF: PUSHJ P,MTAOJF ;GET A JFN, OPEN MTA
PUSHJ P,%LABCK ;CHECK LABEL TYPE
PUSHJ P,%MTPRM ;SETUP TAPE PARAMETERS
PUSHJ P,%MTFSF ;DO A SKIP FILE MTOPR
PJRST MTACJF ;GO CLOSE FILE, RELEASE JFN, LEAVE
SUBTTL General subroutines for tape positioning
;+
; Routine to back-up over the End-Of-File mark.
;-
%BAKEF:
BAKEOF: MOVX T0,D%END ;Clear EOF bit
ANDCAM T0,FLAGS(D)
SETZM ICNT(D) ;CLEAR INPUT COUNT
LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIE T1,DI.MTA ;MTA?
POPJ P, ;NO. NOTHING MORE TO DO
PUSHJ P,%MTBSF ;[4144] BACK OVER EOF MARK
PUSHJ P,%MTCLI ;[4144] CLEAR THE EOF STATUS
SOSLE CREC(D) ;[4144] DECR RECORD COUNT FOR EOF MARK
JRST MTABS1 ;[4144] DATA LEFT. GO READ PREVIOUS BLOCK
POPJ P, ;[4144] NO DATA LEFT. NOTHING MORE TO DO
;+
; Close/Open for input and set-up tape parameters
;-
%MTCLI: PUSHJ P,%CLSOP ;[4141] CLOSE FILE, OPEN FOR INPUT
PJRST %MTPRM ;[4141] SETUP TAPE PARAMETERS
;+
;ROUTINES TO CONVERT BETWEEN FILE ADDRESSES AND PROCESS ADDRESSES
;
;%PTOF - CONVERT PROCESS ADDRESS TO FILE ADDRESS
;ARGS: P1 = ADDRESS, MUST BE IN THE MEMORY MAPPED TO THE FILE OPEN
; ON THE DDB POINTED TO BY D
;RETURN: P1 = CORRESPONDING BYTE NUMBER IN THE FILE
;-
%PTOF: HRRZ T1,IPTR(D) ;GET CURRENT ADDRESS
JUMPE T1,RBYTN ;[4131] IF NONE, RETURN BYTN FOR DUMP MODE
SUB T1,WADR(D) ;GET WORD OFFSET WITHIN WINDOW
ADDI T1,1 ;GET # WORDS USED
IMUL T1,BPW(D) ;GET # BYTES USED
MOVE T2,IPTR(D) ;GET THE BP
MUL T2,BPW(D) ;GET # BYTES LEFT
SUBI T1,(T2) ;[4131] SUBTRACT UNUSED BYTES IN CURRENT WORD
SUB T1,WSIZ(D) ;[4131] SUBTRACT # BYTES IN CURRENT WINDOW
RBYTN: ADD T1,BYTN(D) ;[4131] ADD FILE OFFSET OF NEXT WINDOW
POPJ P,
SUBTTL TOPS-20 Tape Positioning Utilities
IF20,<
;+
; Routine to check if tape is at Phyisical Begining_Of_Tape.
; Does a skip return if the tape IS at the begining.
;-
BOTCHK: MOVE T1,IJFN(D) ;GET JFN
GDSTS% ;GET STATUS
TXNE T2,MT%BOT ;BEG TAPE?
AOS (P) ;YES. SKIP RETURN
POPJ P,
;+
; Routine to create a JFN to be used for magtape operations
; Returns .+1 if ok, JFN in IJFN(D). The JFN is opened for input.
; If fails, goes to %ABORT.
;-
MTAOJF: SETZM TMDEV ;[4144] CLEAR THE TEMP DEVICE NAME
MOVE T1,[TMDEV,,TMDEV+1] ;[4144]
BLT T1,TMEND ;[4144]
MOVE T1,[POINT 7,TMDEV] ;Get device name with ":"
MOVEI T2,DEV(D) ;From the DDB
HRLI T2,(POINT 7,)
MTAOJ1: ILDB T3,T2 ;Get a byte
JUMPE T3,MTAOJ2 ;Null, done
IDPB T3,T1 ;Store
JRST MTAOJ1 ;Loop until null found
MTAOJ2: MOVEI T3,":" ;Append a colon
IDPB T3,T1 ;Now have DEV: in "TMDEV"
;Do our own GTJFN.
MOVX T1,GJ%SHT
HRROI T2,TMDEV
GTJFN%
ERJMP E.SNH ;?Dev must exist: OPENX was done!
HRRZM T1,IJFN(D) ;SAVE JFN
;Have to OPENF the file to do a MTOPR.
MOVX T2,OF%RD ;Read ACCESS, nothing else.
OPENF% ;Get READ access to file
ERJMP MTARWO ;?OPENF failed, give error
POPJ P, ;OK, return
;Here if OPENF failed
MTARWO: MOVE T1,IJFN(D) ;GET JFN
RLJFN% ;RELEASE IT
ERJMP .+1 ;?Too bad
SETZM IJFN(D) ;CLEAR JFN
$ACALL OPN ;Give JSYS error and abort program
;+
;Routine to close and release JFN gotten by MTAOJF
;-
MTACJF: MOVE T1,IJFN(D) ;GET JFN
CLOSF%
JSHALT ;?CLOSF failed, abort program
SETZM IJFN(D) ;CLEAR JFN
POPJ P, ;All worked, return
SEGMENT DATA
TMDEV: BLOCK 20 ;Device name with ":"
TMEND==.-1
SEGMENT CODE
;+
; Some commonly used magnetic tape functions. Use these shorthand
; functions to setup the operation code and perform the tape operation.
;-
%MTEOF: MOVEI T2,.MOEOF ;WRITE A TAPE MARK
JRST DOMTOP
%MTUNL: MOVEI T2,.MORUL ;UNLOAD TAPE
JRST DOMTOP
%MTREW: MOVEI T2,.MOREW ;REWIND TAPE
JRST DOMTOP
%MTBSF: MOVEI T2,.MOBKF ;BACKSPACE A FILE
JRST DOMTOP
%MTFSF: MOVEI T2,.MOFWF ;SKIP FILE
JRST DOMTOP
%MTBSB: MOVEI T2,.MOBKR ;BACKSPACE A RECORD
JRST DOMTOP
;+
; Performs various device-dependant control functions. For TOPS-20
; This routine requires that the device and a JFN assigned to your job.
; The function code is specified in T2. See the MTOPR monitor call for
; a description of the function code.
;-
DOMTOP: MOVE T1,IJFN(D) ;GET JFN
MTOPR% ;DO OPERATION
$AJCAL ILM
POPJ P, ;DONE
> ;END IF20
SUBTTL TOPS-10 Tape Positioning Utilities
IF10,<
;+
; Routine to check if tape is at Phyisical Begining_Of_Tape.
; Does a skip return if the tape IS at the begining.
;-
BOTCHK: MOVEI T2,.TFSTS ;GET STATUS OF TAPE UNIT
PUSHJ P,DOMTOP
TXNE T1,TF.BOT ;BEG TAPE?
AOS (P) ;YES. SKIP RETURN
POPJ P,
;+
; Dummy functions for getting and returning a JFN.
;-
MTAOJF:
MTACJF: POPJ P, ;No JFN'S on TOPS-10
;+
; Some commonly used magnetic tape functions. Use these shorthand
; functions to setup the operation code and perform the tape operation.
;-
%MTEOF: MOVEI T2,.TFWTM ;WRITE A TAPE MARK
PJRST DOMTOP
%MTUNL: MOVEI T2,.TFUNL ;UNLOAD TAPE
PJRST DOMTOP
%MTREW: MOVEI T2,.TFREW ;REWIND TAPE
PJRST DOMTOP
%MTFSB: MOVEI T2,.TFFSB ;SKIP A BLOCK
PJRST DOMTOP
%MTBSB: MOVEI T2,.TFBSB ;BACKSPACE BLOCK
PJRST DOMTOP
%MTFSF: MOVEI T2,.TFFSF ;SKIP FILE
PJRST DOMTOP
%MTBSF: MOVEI T2,.TFBSF ;BACKSPACE FILE
;+
; Perform various device-dependant control functions. The function
; code is specified in T2. See the TAPOP. monitor call call for a
; description of the function code.
;-
DOMTOP: MOVE T3,DVICE(D) ;GET DEVICE NAME
MOVE T1,[2,,T2] ;DO TAPOP
TAPOP. T1,
JRST TAPERR ;GOT AN ERROR. ANALYZE IT
MOVEI T2,.TFWAT ;THEN A WAIT
MOVE T4,[2,,T2]
TAPOP. T4,
$ACALL UTE
POPJ P,
;
; The TAPOP call returned an error, Analyze the error and
; issue an error message.
;
TAPERR: CAIE T1,TPNIA% ;NOT INITIALIZED?
CAIN T1,TPIJN% ;OR DOESN'T BELONG TO ME?
$ACALL ITE ;YES. REPORT ONE OR THE OTHER
$ACALL UTE ;OTHERWISE IT IS UNEXPECTED
COMMENT &
OTHREW: LOAD T1,DVTYP(D) ;GET DEVICE TYPE
CAIE T1,.TYDTA ;DECTAPE?
POPJ P, ;NO. NO OTHER DEVICE CAN REWIND
MOVE T1,FLAGS(D) ;Get DDB flags
TXNN T1,D%IN+D%OUT ;Is the DECTAPE open?
JRST RWDEVO ;Yes, don't use filename
PUSHJ P,%SETIN ;OPEN for input.
SETZM BYTN(D) ;CLEAR BYTE NUMBER
MOVE T2,CHAN(D) ;LH= chan #
HRRI T2,.FOMTP ;MTAPE FILOP
MOVX T3,MTREW. ;REWIND
MOVE T1,[2,,T2]
FILOP. T1,
$ACALL IOE
POPJ P,
;Here to REWIND a non-directory device that is not opened yet.
; Can't use FILOP.'s because you need a filename for them.
RWDEVO: PUSHJ P,OPDEVO ;Open the device only
MOVE T1,ASCHN ;Get channel #
LSH T1,^D23 ;Shift to ac field
IOR T1,[MTREW.] ;Make instruction
XCT T1 ;** REWIND the device **
PJRST CLDEVO ;Close device and return
;Routine to OPEN the device only, (on a low channel).
; FILOP. is not done, because no file can be specified.
;The assigned channel is stored in ASCHN.
;Returns .+1 or takes ERR= or goes to %ABORT (if errors)
OPDEVO: SETZ T1, ;Get a free channel
PUSHJ P,%ALCHF ;Get a channel
$ACALL NFC ;?Too many OPEN units
MOVEM T1,ASCHN ;Save it
LSH T1,^D23 ;Shift into AC position
IOR T1,[OPEN T2] ;Get instruction to XCT
MOVEI T2,.IODMP ;Set dump mode
SETZ T4, ;No buffers
MOVE T3,DEV(D) ;Get device
XCT T1 ;** OPEN the device **
JRST OPDVFL ;?Failed
POPJ P, ;OK, return
;The OPEN UUO failed. Either "No such device"
;or "Assigned to another job".
OPDVFL: MOVE T1,DEV(D) ;See if this device exists
DEVTYP T1,
JRST OPDVNS ;?no such device
JUMPE T1,OPDVNS ;Or if 0 returned.
SKIPA T1,[ERDAJ%] ;"Device allocated to another job"
OPDVNS: MOVEI T1,ERNSD% ;"No such device"
$ACALL OPN ;Give error, abort if no ERR=
SEGMENT DATA
ASCHN: BLOCK 1 ;Assigned channel for non-FILOP. I/O
SEGMENT CODE
;Routine to CLOSE the device OPEN'ed by OPDEVO.
;Returns .+1 always
CLDEVO: MOVE T1,ASCHN ;Get assigned channel #
LSH T1,^D23 ;Shift into ac position
IOR T1,[RELEAS 0] ;Get a RELEASE instruction
XCT T1 ;Do it
MOVE T1,ASCHN ;Get channel #
PUSHJ P,%DECHF ;Deallocate it
$SNH ;?Not assigned, "can't happen"
POPJ P, ;Ok, return
;UNLOAD FOR DECTAPES
OTHUNL: LOAD T1,DVTYP(D) ;GET DEVICE TYPE
CAIE T1,.TYDTA ;DECTAPE?
POPJ P, ;NO. NO OTHER DEVICE CAN UNLOAD
MOVE T1,FLAGS(D) ;Get DDB flags
TXNN T1,D%IN+D%OUT ;Is the DECTAPE open?
JRST ULDEVO ;Yes, don't use filename
TXNE T1,D%OUT+D%END ;OUTPUT OR EOF?
PUSHJ P,%CLSOP ;Open the dectape
SETZM CREC(D) ;CLEAR RECORD NUMBER
HXLZ T1,BYTPT(D) ;[4131] GET BYTE POINTER
MOVEM T1,IPTR(D) ;[4131] SAVE IT
SETZM ICNT(D) ;NO BYTES IN BUFFER
SETZM BYTN(D) ;SET CURRENT BYTE NUMBER TO 0
MOVE T2,CHAN(D) ;LH= chann #
HRRI T2,.FOMTP ;MTAPE FILOP
MOVX T3,MTUNL. ;UNLOAD
MOVE T1,[2,,T2]
FILOP. T1,
$ACALL IOE
POPJ P,
;Here to UNLOAD a DECtape or magtape that is not opened yet.
; Can't use FILOP.'s because you need a filename for them.
ULDEVO: PUSHJ P,OPDEVO ;Open the device only
MOVE T1,ASCHN ;Get channel #
LSH T1,^D23 ;Shift to ac field
IOR T1,[MTUNL.] ;Make instruction
XCT T1 ;** UNLOAD the device **
PJRST CLDEVO ;Close device and return
END COMMENT &
> ;IF10
SUBTTL FIND
;FIND STATEMENT
;
;DOES NOT POSITION A RANDOM-ACCESS DISK FILE SO THAT SUBSEQUENT I/O
;WILL TAKE LESS TIME IF SUFFICIENT COMPUTATION INTERVENES BETWEEN
;THE FIND AND THE I/O.
;
;10: A TIME-CONSUMING NOP
;
;20: DITTO
;
;[5004] THIS STATEMENT IS ALMOST WORTHLESS.
;
;[5004] FOR RMS DIRECT-ACCESS RELATIVE FILES, ESTABLISHES THE CURRENT
;[5004] RECORD.
FENTRY (FIND)
PUSHJ P,%SAVAC ;SAVE USER'S ACS
PUSHJ P,%CPARG ;AND COPY ARGS
PUSHJ P,FMTCNV ;CONVERT OLD-STYLE ARG LIST
XMOVEI T1,[ASCIZ /FIND/] ;SET STATEMENT NAME FOR ERROR MESSAGES
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).
MOVE T1,%CUNIT ;GET UNIT NUMBER
SKIPN U,%DDBTA(T1) ;GET UDB ADDR
$ACALL RR1 ;NONE. MUST SETUP RECORDSIZE IN OPEN!
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
SKIPE A.REC ;MAKE SURE THERE IS A RECORD NUMBER
SKIPG T1,@A.REC ;GET RECORD NUMBER
$ACALL IRN ;ILLEGAL IF .LE. ZERO OR NO RECORD NUMBER
MOVEM T1,CREC(D) ;STORE IN DDB FOR ASSOCIATE VARIABLE
LOAD T1,INDX(D) ;[5004] GET DEVICE INDEX
CAIN T1,DI.RMS ;[5004] RMS FILE?
PJRST %RMFND ;[5004] YES, MAYBE DO $FIND
PJRST %SETAV ;GO SET ASSOCIATE VARIABLE AND RETURN
SUBTTL IOLST
FENTRY (IOLST)
PUSHJ P,%SAVIO ;SAVE ACS
PUSHJ P,%ISAVE ;AND COPY ARGS
SKIPN U,%UDBAD ;RESTORE UDB ADDRESS
POPJ P, ;NONE. I/O ABORTED
MOVE D,DDBAD(U) ;GET DDB ADDR
IOLP: LDB T2,[POINTR ((L),IOKWD)] ;GET TYPE OF ENTRY
XCT DATSUB(T2) ;GO TO APPROPRIATE DATA HANDLER
JRST IOLP ;CONTINUE UNTIL END OF LIST
;XCT TABLE
DATSUB: JRST ZKWD ;ZERO KEYWORD
PUSHJ P,FDATA
PUSHJ P,SLIST
PUSHJ P,ELIST
JRST @IOFIN(D)
PUSHJ P,SLST77
PUSHJ P,ELST77
PUSHJ P,NSLIST ;NEW SLIST ENTRY
PUSHJ P,NELIST ;NEW ELIST ENTRY
PUSHJ P,NSL77 ;NEW SLIST-77 ENTRY
PUSHJ P,NEL77 ;NEW ELIST-77 ENTRY
$ACALL IOL ;REPORT ERROR FOR ARGS OUT OF RANGE
$ACALL IOL ;REPORT ERROR FOR ARGS OUT OF RANGE
$ACALL IOL ;REPORT ERROR FOR ARGS OUT OF RANGE
$ACALL IOL ;REPORT ERROR FOR ARGS OUT OF RANGE
$ACALL IOL ;REPORT ERROR FOR ARGS OUT OF RANGE
ZKWD: SKIPN (L) ;IS ENTRY ZERO?
POPJ P, ;0 IS END OF LIST
$ACALL IOL ;NON-ZERO ARG, ZERO KWD - BAD I/O LIST
FDATA: XMOVEI T1,@(L) ;GET ADDR
MOVEM T1,IO.ADR ;SAVE THE DATA ADDR
SETZM IO.INC ;ZERO INCREMENT
LDB T2,[POINTR ((L),ARGTYP)] ;GET DATATYPE
MOVEM T2,IO.TYP ;SAVE IT
MOVEI T3,1 ;1 ENTRY
MOVEM T3,IO.NUM
CAIN T2,TP%CHR ;CHARACTER?
JRST DCHAR ;YES. GO HANDLE SEPARATELY
MOVE T3,%SIZTB(T2) ;SET "ARRAY" LENGTH TO DATUM SIZE
MOVEM T3,IO.SIZ ;SAVE IT
AOJA L,@IOSUB(D) ;DO I/O
DCHAR: SKIPG T3,1(T1) ;GET VARIABLE SIZE
$ACALL ICE ;ZERO OR NEGATIVE SIZE (BAD SUBSTRING BOUNDS)
MOVEM T3,IO.SIZ ;SAVE IT
MOVE T1,(T1) ;GET PNTR
MOVEM T1,IO.ADR ;SAVE AS ADDR
AOJA L,@IOSUB(D) ;PROCESS SINGLE DATUM
;EXPLICIT FIN CALL
FENTRY (FIN)
PUSHJ P,%SAVIO ;SAVE USER'S ACS
SKIPN U,%UDBAD ;GET UDB
POPJ P, ;NONE. I/O WAS ABORTED
MOVE D,DDBAD(U) ;GET DDB
JRST @IOFIN(D) ;GO FINISH UP
;[5004] New
;[5004] FORMATTED REWRITE
IF20,<
FENTRY (REWRF)
PUSHJ P,%SAVAC ;SAVE ACS
PUSHJ P,%CPARG ;COPY ARGS
XMOVEI T1,[ASCIZ/REWRITE/]
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,%RMCRW ;CHECK IF REWRITE LEGAL
MOVX T0,D%RWI ;SET REWRITE FLAG
IORM T0,FLAGS(D)
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
JRST %OFSET
;[5004] New
;[5004] UNFORMATTED REWRITE
FENTRY (REWRU)
PUSHJ P,%SAVAC ;SAVE ACS
PUSHJ P,%CPARG ;COPY ARGS
XMOVEI T1,[ASCIZ/REWRITE/]
MOVEM T1,%IONAM
PUSHJ P,IOARG ;MOVE ARGS TO A.XXX
PUSHJ P,CHKUNT ;CHECK UNIT NUMBER IN RANGE
PUSHJ P,SETUNF ;SET MODE
PUSHJ P,%RMCRW ;SEE IF REWRITE LEGAL
PUSHJ P,%SETOUT ;GET FILE OPENED FOR OUTPUT.
MOVX T0,D%RWI ;SET REWRITE FLAG
IORM T0,FLAGS(D)
PJRST UOSET ;GO DO UNFORMATTED I/O
;[5013] New
;[5013] DELETE an RMS relative or indexed record.
FENTRY (DELTR)
PUSHJ P,%SAVAC ;SAVE ACS
PUSHJ P,%CPARG ;COPY ARGS
XMOVEI T1,[ASCIZ/DELETE/]
MOVEM T1,%IONAM
PUSHJ P,IOARG ;MOVE ARGS TO A.XXX
PUSHJ P,CHKUNT ;CHECK UNIT NUMBER IN RANGE
PUSHJ P,%RMCDL ;SEE IF DELETE IS LEGAL
PUSHJ P,%SETOUT ;GET FILE OPENED FOR OUTPUT.
PJRST %RMDEL ;GO DELETE RECORD
;[5014] New
;[5014] UNLOCK an RMS relative or indexed record.
FENTRY (UNLOC)
PUSHJ P,%SAVAC ;SAVE ACS
PUSHJ P,%CPARG ;COPY ARGS
XMOVEI T1,[ASCIZ/UNLOCK/]
MOVEM T1,%IONAM
PUSHJ P,IOARG ;MOVE ARGS TO A.XXX
PUSHJ P,CHKUNT ;CHECK UNIT NUMBER IN RANGE
PUSHJ P,%RMCUL ;SEE IF UNLOCK IS LEGAL
PUSHJ P,%SETIN ;GET FILE OPENED FOR INPUT.
PJRST %RMUNL ;GO UNLOCK THE RECORD
> ;End IF20
;[4140] REWRITTEN
NSL77: SETOM INCFLG ;[4132] INCREMENT IS IN WORDS OR CHARACTERS
SKIPG T1,@(L) ;IF COUNT IS ZERO OR NEGATIVE
JRST SLZTRP ;IT IS ZERO TRIP
MOVEM T1,IO.NUM ;SAVE COUNT
MOVE T1,@1(L) ;GET A FULLWORD INCREMENT
MOVEM T1,IO.INC ;SAVE IT
JRST SLCOM ;JOIN COMMON CODE
;[4140] REWRITTEN
SLST77: SETZM INCFLG ;[4132] INCREMENT IS IN ENTRIES
SKIPG T1,@(L) ;GET THE COUNT
MOVEI T1,(T1) ;NEG OR ZERO. TOSS AOBJN COUNT
MOVEM T1,IO.NUM ;SAVE COUNT
HRRE T1,@1(L) ;GET INCREMENT, WHICH MIGHT BE IMMEDIATE
MOVEM T1,IO.INC ;ASSUME IT'S AN OK INCR
SKIPLE IO.NUM ;ANY COUNT?
JRST SLCOM ;YES. NOT ZERO-TRIP
;ZERO-TRIP SLIST. SKIP TO THE END OF THE LIST, WHICH IS
;A WORD WITH A NON-ZERO KEYWORD.
SLZTRP: ADDI L,1 ;POINT TO NEXT WORD
SLZTLP: MOVE T1,(L) ;GET IT
TXNE T1,ARGKWD ;NON-ZERO KEYWORD?
POPJ P, ;YES. END OF LIST
JUMPE T1,%POPJ ;ZERO IS OLD STYLE END
AOJA L,SLZTLP ;TRY AGAIN
POPJ P, ;AND LEAVE
;[4140] REWRITTEN
NSLIST: SETOM INCFLG ;[4132] INCREMENT IS IN CHARS OR WORDS
SKIPG T1,@(L) ;GET THE COUNT
MOVEI T1,1 ;ZERO-TRIP. USE 1-TRIP DO COUNT
MOVEM T1,IO.NUM ;SAVE COUNT
MOVE T1,@1(L) ;GET A FULLWORD INCREMENT
MOVEM T1,IO.INC ;SAVE IT
JRST SLCOM ;JOIN COMMON CODE
;[4140] REWRITTEN
SLIST: SETZM INCFLG ;[4132] INCREMENT IS IN ENTRIES
SKIPG T1,@(L) ;GET THE COUNT
MOVEI T1,(T1) ;NEG OR ZERO. TOSS AOBJN COUNT
CAIN T1,0 ;ZERO-TRIP?
MOVEI T1,1 ;ZERO-TRIP. USE 1-TRIP DO COUNT
MOVEM T1,IO.NUM ;STORE COUNT
HRRE T1,@1(L) ;GET INCREMENT
MOVEM T1,IO.INC ;ASSUME IT'S AN OK INCR
SLCOM: MOVE T1,3(L) ;GET WORD AFTER ARRAY ADDRESS
TXNN T1,ARGKWD ;IS IT ANOTHER ARRAY?
JUMPN T1,SLP0 ;YES, MUST DO ONE-BY-ONE THING
LDB T2,[POINTR (2(L),ARGTYP)] ;GET DATATYPE
MOVEM T2,IO.TYP ;SAVE IT
CAIN T2,TP%CHR ;CHARACTER?
JRST SLCHR ;YES
MOVE T1,%SIZTB(T2) ;GET ENTRY SIZE
MOVEM T1,IO.SIZ ;SAVE IT
SKIPN INCFLG ;[4132] IF INCREMENT IS IN ENTRIES
IMULM T1,IO.INC ;MAKE INCR IN WORDS
XMOVEI T1,@2(L) ;GET ADDRESS
MOVEM T1,IO.ADR ;SAVE IT
MOVE T1,[ADD T1,IO.ADR] ;DO NOTHING WITH ZERO INCREMENT
MOVEM T1,IO.INS ;INSTRUCTION FOR FORMATTED I/O
ADDI L,3 ;SKIP OVER SLIST
PJRST @IOSUB(D) ;GO DO WHOLE ARRAY
SLCHR: XMOVEI T1,@2(L) ;GET ADDR OF DESCRIPTOR
SKIPG T2,1(T1) ;GET SIZE
$ACALL ICE ;ZERO OR NEGATIVE SIZE (BAD SUBSTRING BOUNDS)
MOVEM T2,IO.SIZ ;SAVE IT
SKIPN INCFLG ;[4132] IF INCREMENT IS IN ENTRIES
IMULM T2,IO.INC ;MAKE INCR IN BYTES
MOVE T1,(T1) ;GET PNTR
MOVEM T1,IO.ADR ;SUBSTITUTE THE BYTE PNTR
MOVE T1,[ADJBP T1,IO.ADR] ;GET INCREMENT INST
MOVEM T1,IO.INS ;SAVE FOR FORMATTED I/O
ADDI L,3 ;SKIP OVER SLIST
PJRST @IOSUB(D) ;DO WHOLE ARRAY
SLP0: MOVE T1,IO.NUM ;GET COUNT AGAIN
MOVEM T1,LISCNT ;STORE IT LOCALLY
MOVE T1,IO.INC ;GET INCREMENT AGAIN
MOVEM T1,LINCR ;STORE LOCALLY
SETZM OFFS ;INITIALIZE OFFSET
ADDI L,2 ;POINT TO FIRST ARRAY ADDRESS
MOVEM L,SAVEL ;SAVE FOR LOOP THROUGH ALL ARRAYS
SLP1: MOVE L,SAVEL ;RESET L TO START OF SLIST
SLP: XMOVEI T1,@(L) ;GET AN ARRAY BASE ADDRESS
MOVE T3,(L)
TXNE T3,ARGKWD ;IS IT AN ARRAY ADDRESS?
JRST SLPE ;NO, END OF LOOP
JUMPE T3,SLPE ;ZERO IS END OF LIST, NOT VALID ADDRESS
LDB T2,[POINTR ((L),ARGTYP)] ;GET DATA TYPE OF ARRAY
MOVEM T2,IO.TYP ;SAVE IT
MOVE T3,OFFS ;GET OFFSET INTO ARRAY
CAIN T2,TP%CHR ;CHARACTER?
JRST SCHAR ;YES. DO IT SEPARATELY
MOVE T4,%SIZTB(T2) ;GET ELEMENT SIZE
MOVEM T4,IO.SIZ ;SAVE IT
SKIPN INCFLG ;IF INCREMENT IS IN ENTRIES
IMULI T3,(T4) ;TURN ELEMENTS INTO WORDS
ADDI T1,(T3) ;ADD OFFSET TO BASE ADDRESS
JRST NSCHAR ;JOIN COMMON CODE
SCHAR: SKIPN INCFLG ;IF INCREMENT IS IN ENTRIES
IMUL T3,1(T1) ;GET CHARACTER OFFSET
ADJBP T3,(T1) ;CREATE NEW PNTR
SKIPG T5,1(T1) ;GET VAR SIZE
$ACALL ICE ;ZERO OR NEGATIVE SIZE (BAD SUBSTRING BOUNDS)
MOVEM T5,IO.SIZ ;SAVE IT
MOVE T1,T3 ;GET PNTR INTO T1
NSCHAR: MOVEM T1,IO.ADR ;SAVE IT
MOVEI T3,1 ;SET # ELEMENTS TO 1
MOVEM T3,IO.NUM ;SAVE NUM ELEMENTS
SETZM IO.INC ;NO INCREMENT
PUSHJ P,@IOSUB(D) ;I/O THE ARRAY ELEMENT
AOJA L,SLP ;BUMP TO NEXT ARRAY ADDRESS, CONTINUE
SLPE: MOVE T1,LINCR ;GET INCREMENT
ADDM T1,OFFS ;BUMP OFFSET
SOSLE LISCNT ;DECREMENT COUNT
JRST SLP1 ;NOT YET ZERO, CONTINUE I/O
POPJ P, ;END OF SLIST
NEL77: SETOM INCFLG ;[4132] INCREMENT IS IN WORDS OR CHARACTERS
SKIPG T1,@(L) ;[4132] GET COUNT
JRST ELZTLP ;[4132] IF ZERO OR NEGATIVE, IT IS ZERO TRIP
JRST ELNZ ;[4132] JOIN COMMON CODE
ELST77: SETZM INCFLG ;[4132] INCREMENT IS IN ENTRIES
SKIPLE T1,@(L) ;POSITIVE?
JRST ELNZ ;YES. JOIN COMMON CODE
MOVEI T1,(T1) ;NO. AVOID AOBJN COUNTS (BUG IN COMPILER)
JUMPG T1,ELNZ ;IF NON-ZERO, ASSUME POSITIVE COUNT
;ZERO-TRIP ELIST. JUST GO TO THE END, WHICH IS A ZERO WORD (V5A) OR
;WORD WITH A NON-ZERO KEYWORD (POST-V5A) FOR AN "INCREMENT" WORD.
ELZTLP: ADDI L,1 ;POINT TO INCR/ADDR PAIR
MOVE T1,(L) ;GET NEXT INCREMENT
TXNE T1,ARGKWD ;ANY KEYWORD?
POPJ P, ;YES. END OF LIST
JUMPE T1,%POPJ ;ZERO IS ALSO END OF LIST
AOJA L,ELZTLP ;TRY AGAIN
NELIST: SETOM INCFLG ;[4132] INCREMENT IS IN WORDS OR CHARS
SKIPG T1,@(L) ;[4132] GET THE COUNT
MOVEI T1,1 ;[4132] IF ZERO-TRIP, MAKE IT 1-TRIP
JRST ELNZ ;[4132] JOIN COMMON CODE
ELIST: SETZM INCFLG ;[4132] INCREMENT IS IN ENTRIES
SKIPLE T1,@(L) ;GET THE COUNT
JRST ELNZ ;OK
MOVEI T1,(T1) ;NEG OR ZERO. TOSS AOBJN COUNT
JUMPG T1,ELNZ ;PRODUCED BY BUG IN COMPILER
MOVEI T1,1 ;NO. 1-TRIP DO COUNT
ELNZ: MOVEM T1,LISCNT ;STORE COUNT
SETZM OFFS ;CLEAR OFFSET
ADDI L,1 ;POINT TO FIRST INCR/ADDR PAIR
MOVEM L,SAVEL ;SAVE FOR LOOP
ELP1: MOVE L,SAVEL ;RESET L
ELP: MOVE T3,(L) ;Get arg type bits
TXNE T3,ARGKWD ;CHECK FOR 0 KEYWORD FIELD
JRST ELPE ;NONZERO KEYWORD, END OF LOOP
JUMPE T3,ELPE ;ZERO IS END OF LIST
MOVE T1,@(L) ;[4140] GET AN INCREMENT
LDB T2,[POINTR ((L),ARGTYP)] ;[4140] GET ARG TYPE
CAIN T2,0 ;[4140] IF NOT IMMEDIATE, USE FULLWORD INCREMENT
HRRE T1,@(L) ;[4140] IMMEDIATE. EXTEND SIGN
IMUL T1,OFFS ;GET OFFSET INTO ARRAY
LDB T2,[POINTR (1(L),ARGTYP)] ;GET ARG TYPE OF ARRAY
MOVEM T2,IO.TYP ;SAVE IT
CAIE T2,TP%CHR ;CHARACTER?
JRST ELNC ;NO
XMOVEI T3,@1(L) ;GET ADDR OF DESCRIPTOR
SKIPG T2,1(T3) ;GET SIZE OF VARIABLE
$ACALL ICE ;ZERO OR NEGATIVE SIZE (BAD SUBSTRING BOUNDS)
MOVEM T2,IO.SIZ ;SAVE IT
SKIPN INCFLG ;[4132] IF INCREMENT IS IN ENTRIES
IMUL T1,T2 ;GET OFFSET IN CHARACTERS
ADJBP T1,(T3) ;INCR BYTE POINTER
MOVEM T1,IO.ADR ;SAVE FOR I/O ROUTINE
JRST ECOM2 ;JOIN COMMON CODE
ELNC: MOVE T3,%SIZTB(T2) ;GET SIZE
MOVEM T3,IO.SIZ ;STORE IT
SKIPN INCFLG ;[4132] IF INCREMENT IS IN ENTRIES
IMULI T1,(T3) ;MULTIPLY OFFSET BY ELEMENT SIZE
XMOVEI T3,@1(L) ;GET BASE ADDR
ADD T1,T3 ;ADD BASE ADDRESS TO OFFSET
MOVEM T1,IO.ADR ;SAVE FOR FORMATTED I/O
ECOM2: MOVEI T3,1 ;1 ENTRY
MOVEM T3,IO.NUM ;SAVE IT
SETZM IO.INC ;NO INCREMENT
PUSHJ P,@IOSUB(D) ;CALL I/O ROUTINE
ADDI L,2 ;BUMP TO NEXT INCREMENT/ADDRESS PAIR, CONTINUE
JRST ELP
ELPE: AOS OFFS ;INCREMENT OFFSET
SOSLE LISCNT ;DECREMENT COUNT
JRST ELP1 ;IF NOT YET ZERO, CONTINUE
POPJ P, ;END OF ELIST
SEGMENT DATA
INCFLG: BLOCK 1 ;0=INCR IN ENTRIES, -1=INCR IN WORDS/CHARS
LINCR: BLOCK 1 ;LOCAL INCREMENT
LISCNT: BLOCK 1 ;LOCAL COUNT
OFFS: BLOCK 1 ;LOCAL OFFSET
SAVEL: BLOCK 1 ;FOROTS ARG LIST PNTR LOCAL
SEGMENT CODE
FORPRG
END