Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_V7wLink_Feb83
-
forio.mac
There are 25 other files named forio.mac in the archive. Click here to see a list.
SEARCH FORPRM
TV FORIO I/O ROUTINES,7(3252)
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1983
;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 Revision History *****
\
ENTRY IN%,OUT%,RTB%,WTB%,NLI%,NLO%,ENC%,DEC%,FIND%,MTOP%
ENTRY IOLST%,FIN%,IFI%,IFO%
INTERN %IBYTE,%OBYTE,%IBYTC,%OMBYT,%OMSPC,%IMBYT
INTERN %IRECS,%OREC,%EOREC,%ORECS,%OCRLF
INTERN %IBACK,%OSMAP,%OBUF,%SETAV,%RTMSK,%CUNIT
INTERN %RIPOS,%SIPOS,%ROPOS,%SOPOS,%CIPOS,%COPOS
IF10,< INTERN %RANWR,%BACKB,%CLRBC,%BAKEF,%ISET >
EXTERN %UDBAD,%MSPAD,%MSLJ,%NAMLN
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,%ABORT,%IONAM
EXTERN %SETIN,%SETOUT,%CHKNR,%CRLF
EXTERN %GTBLK,%MVSPC,%GTSPC
EXTERN %ISAVE,%SIZTB,%DDBTA
EXTERN %EDDB,U.RERD,U.ERR,D.TTY,U.TTY,G.PRP
IF20,< EXTERN %CLSOP,%OCCOC,%CCMSK >
IF10,< EXTERN %ST10B,%CALOF,%CLSER,%FREBLK >
EXTERN %OPENX,%LSTBF
EXTERN %UNNAM
EXTERN IO.ADR,IO.NUM,IO.SIZ,IO.INC,IO.TYP,IO.INS
EXTERN %ALCHF,%DECHF
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
SKIPN T.FMT ;IS THERE A FORMAT ADDR?
JRST LDI% ;NO. IT'S LIST-DIRECTED INPUT
XMOVEI T1,%IFORM ;SETUP FOR FORMAT EXECUTION
MOVEM T1,IOSUB(D)
PJRST %IFSET ;GO ENCODE FORMAT
;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
SKIPN T.FMT ;IS THERE A FORMAT ADDR?
JRST LDO% ;NO. IT'S LIST-DIRECTED OUTPUT
XMOVEI T1,%OFORM ;SETUP FOR FORMAT EXECUTION
MOVEM T1,IOSUB(D)
PJRST %OFSET ;GO ENCODE FORMAT
;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
XMOVEI T1,UNFI ;SETUP FOR IOLST CALLS
MOVEM T1,IOSUB(D)
PJRST UISET ;GO DO INITIAL SETUP
RDUMP: XMOVEI T1,DMPIN ;SETUP FOR DUMP MODE INPUT
MOVEM T1,IOSUB(D)
PJRST DMPSET
;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
XMOVEI T1,UNFO ;SETUP FOR IOLST CALLS
MOVEM T1,IOSUB(D)
PJRST UOSET ;GO DO INITIAL SETUP
WDUMP: XMOVEI T1,DMPOUT ;SETUP FOR DUMP MODE OUTPUT
MOVEM T1,IOSUB(D)
PJRST DMPSET
;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"
STORE T1,UNUM(U)
MOVEI T1,DI.ENC ;SET "DEVICE" TYPE TO INTERNAL FILE
STORE T1,INDX(D) ;STORE IN DDB
MOVEM U,%UDBAD ;SAVE DDB ADDRESS FOR IOLST
PUSHJ P,DECINI ;INIT BUFFER PNTR
XMOVEI T1,%IFORM ;SETUP FOR IOLST CALLS
MOVEM T1,IOSUB(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"
STORE T1,UNUM(U)
MOVEI T1,DI.ENC ;SET "DEVICE" TYPE TO INTERNAL FILE
STORE T1,INDX(D) ;STORE IN DDB
MOVEM U,%UDBAD ;SAVE DDB ADDRESS FOR IOLST
PUSHJ P,ENCINI ;Init for ENCODE
XMOVEI T1,%OFORM ;SETUP FOR IOLST CALLS
MOVEM T1,IOSUB(D)
PJRST %OFSET ;GO ENCODE THE FORMAT
FENTRY (MTOP)
PUSHJ P,%SAVAC ;SAVE ACS
PUSHJ P,%CPARG ;AND COPY ARGS
PUSHJ P,MTCNV ;CONVERT ARG LIST
XMOVEI T1,[0] ;DON'T KNOW STATEMENT NAME YET
MOVEM T1,%IONAM
PUSHJ P,IOARG ;Move args to A.XXX
PUSHJ P,CHKUNT ;Check for unit number in range
;(Goes to ABORT% if unit is bad)
PJRST MTOP ;OK, Go do it and return.
FENTRY (LDI)
XMOVEI T1,%LDI ;SETUP FOR IOLST CALLS
MOVEM T1,IOSUB(D)
PJRST %LDIST ;DO LIST-DIRECTED INPUT SETUP
FENTRY (LDO)
XMOVEI T1,%LDO ;SETUP FOR IOLST CALLS
MOVEM T1,IOSUB(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"
STORE T1,UNUM(U)
MOVEI T1,DI.INT ;SET "DEVICE" TYPE TO INTERNAL FILE
STORE T1,INDX(D) ;STORE IN DDB
MOVEM U,%UDBAD ;SAVE DDB ADDRESS FOR IOLST
PUSHJ P,IFINI ;INIT BUFFER PNTR
XMOVEI T1,%IFORM ;SETUP FOR IOLST CALLS
MOVEM T1,IOSUB(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"
STORE T1,UNUM(U)
MOVEI T1,DI.INT ;SET "DEVICE" TYPE TO INTERNAL FILE
STORE T1,INDX(D) ;STORE IN DDB
MOVEM U,%UDBAD ;SAVE DDB ADDRESS FOR IOLST
PUSHJ P,IFOINI ;INIT FOR INTERNAL FILE OUTPUT
XMOVEI T1,%OFORM ;SETUP FOR IOLST CALLS
MOVEM T1,IOSUB(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+MAXKWD-1
HLRE T3,-1(L) ;GET NEGATIVE COUNT
ARGLP: LDB T1,[POINTR ((L),ARGKWD)] ;GET KWD OF ARGUMENT
CAILE T1,MAXKWD ;WITHIN RANGE?
$ECALL IKV,%ABORT ;NO. ILLEGAL KEYWORD VALUE
XMOVEI T2,@0(L) ;Get arg address
MOVEM T2,IOARGS(T1) ;STORE ARG IN BLOCK
LDB T2,[POINTR ((L),ARGTYP)] ;GET TYPE
MOVEM T2,IOTYPS(T1) ;STORE TYPE
ADDI L,1 ;INCR ARG PNTR
AOJL T3,ARGLP ;TRANSFER ENTIRE ARG BLOCK
SKIPE T1,A.IOS ;IOSTAT VARIABLE?
SETZM (T1) ;YES. CLEAR IT
POPJ P, ;DONE
SEGMENT DATA
;COPIED ARGS, MUST BE CONSECUTIVE, IN ORDER ON KEYWORD NUMBER (IK.XXX)
IOARGS: BLOCK 1 ;ZERO KEYWORD - SKIPPED ARG
A.UNIT: BLOCK 1 ;UNIT= [ADDRESS OF VALUE]
A.FMT:: BLOCK 1 ;FMT= [ADDRESS]
A.FMS:: BLOCK 1 ;FORMAT SIZE [ADDRESS OF VALUE]
A.END:: BLOCK 1 ;END= [ADDRESS]
A.ERR:: BLOCK 1 ;ERR= [ADDRESS]
A.IOS:: BLOCK 1 ;IOSTAT= [ADDRESS]
A.REC:: BLOCK 1 ;REC= [ADDRESS]
A.NML:: BLOCK 1 ;NAMELIST ADDRESS [ADDRESS]
A.MTOP: BLOCK 1 ;MTA OP CODE [ADDRESS OF VALUE]
A.HSA:: BLOCK 1 ;ENCODE/DECODE ARRAY ADDRESS [ADDRESS]
A.HSL:: BLOCK 1 ;ENCODE/DECODE RECORD LENGTH [ADDRESS OF VALUE]
MAXKWD==.-IOARGS ;MAX LEGAL IO ARG KWD NUMBER
;NOW FOR THE DATA TYPES
IOTYPS: BLOCK 1 ;ZERO KEYWORD - SKIPPED ARG
T.UNIT:: BLOCK 1 ;UNIT= [ADDRESS OF VALUE]
T.FMT:: BLOCK 1 ;FMT= [ADDRESS]
T.FMS:: BLOCK 1 ;FORMAT SIZE [ADDRESS OF VALUE]
T.END:: BLOCK 1 ;END= [ADDRESS]
T.ERR:: BLOCK 1 ;ERR= [ADDRESS]
T.IOS:: BLOCK 1 ;IOSTAT= [ADDRESS]
T.REC:: BLOCK 1 ;REC= [ADDRESS]
T.NML:: BLOCK 1 ;NAMELIST ADDRESS [ADDRESS]
T.MTOP:: BLOCK 1 ;MTA OP CODE [ADDRESS OF VALUE]
T.HSA:: BLOCK 1 ;ENCODE/DECODE STRING ADDRESS [ADDRESS]
T.HSL:: BLOCK 1 ;ENCODE/DECODE STRING LENGTH [ADDRESS OF VALUE]
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
; (Goes to ABORT% or ERR= if not).
PUSHJ P,SETD ;Setup D and U
PUSHJ P,SETASC ;SET MODE TO ASCII IF ZERO
PUSHJ P,OPNDDB ;OPEN DDB IF NECESSARY
PUSHJ P,%SETOUT ;Get file opened for output.
PUSHJ P,CHKFRM ;CHECK IF FORMATTED I/O OK
SKIPE A.REC ;RANDOM I/O?
PUSHJ P,FORMPW ;YES. MAP THE DESIRED RECORD
SKIPN ORBUF(D) ;ANY RECORD BUFFER YET?
PUSHJ P,GETORB ;NO. CREATE ONE
PJRST ORINI ;GO INIT OUTPUT RECORD
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,SETD ;Setup D and U
PUSHJ P,SETBIN ;SET MODE TO BINARY IF ZERO
PUSHJ P,OPNDDB ;OPEN DDB IF NECESSARY
PUSHJ P,%SETOUT ;Get file opened for output.
PUSHJ P,CHKUNF ;CHECK IF UNFORMATTED I/O OK
SKIPE A.REC ;RANDOM I/O?
PUSHJ P,UORMPW ;YES. MAP THE DESIRED RECORD
POPJ P,
FINGO: 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).
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?
$ECALL RBR,%ABORT ;NO. ?REREAD not preceded by READ
MOVEM T1,%CUNIT ;YES. USE IT
PUSHJ P,SETD ;SETUP D AND U
PUSHJ P,%SETIN ;Get file opened for input.
PUSHJ P,CHKFRM ;CHECK IF FORMATTED I/O IS CORRECT
PJRST REREAD ;POINT TO LAST RECORD
INGO1: PUSHJ P,SETD ;Do implicit OPEN if necessary
PUSHJ P,SETASC ;SET MODE TO ASCII IF ZERO
PUSHJ P,OPNDDB ;OPEN DDB IF NECESSARY
PUSHJ P,%SETIN ;Get file opened for input.
PUSHJ P,CHKFRM ;CHECK IF FORMATTED I/O IS CORRECT
LOAD T1,UNUM(U) ;Get unit number
HRREM T1,U.RERD ;Store REREAD unit
SKIPE A.REC ;RANDOM I/O?
PUSHJ P,FIRMPW ;YES. MAP THE DESIRED RECORD
PJRST %IREC ;READ A RECORD
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,SETD ;SETUP DDB
PUSHJ P,SETBIN ;SET MODE TO BINARY IF ZERO
PUSHJ P,OPNDDB ;OPEN DDB IF NECESSARY
PUSHJ P,%SETIN ;Get file opened for input.
PUSHJ P,CHKUNF ;CHECK IF UNFORMATTED I/O IS CORRECT
SKIPE A.REC ;RANDOM I/O?
PUSHJ P,UIRMPW ;YES. MAP THE DESIRED RECORD
POPJ P,
;CHKxxx checks for conflicts between the current READ or WRITE
;statement and the previous OPEN statement, if any.
;For instance, doing RANDOM I/O (i.e., specifying a record number)
;for a sequential file is illegal, and an unformatted READ or WRITE
;with a file opened for FORMATTED I/O is illegal. FOROTS does not
;try to switch the mode of the file.
CHKFRM: LOAD T1,FORM(D) ;GET FORM=
CAIE T1,FM.FORM ;FORMATTED?
SETOM FUMXD(D) ;NO. SET MIXED-MODE FLAG
JRST CHKRAN ;GO CHECK RANDOM
CHKUNF: LOAD T1,FORM(D) ;GET FORM=
CAIE T1,FM.UNF ;UNFORMATTED?
SETOM FUMXD(D) ;NO. SET MIXED-MODE FLAG
CHKRAN: MOVE T1,FLAGS(D) ;GET DDB FLAGS
SKIPN A.REC ;RANDOM I/O STATEMENT?
JRST CHKNR ;NO. GO MAKE SURE IT'S NOT RANDOM FILE
TXNE T1,D%RAN ;RANDOM FILE?
POPJ P, ;YES
DMOVE T2,[EXP [ASCIZ /direct/],[ASCIZ /sequential/]]
$ECALL CDI,%ABORT ;REPORT RANDOM I/O TO SEQ FILE
CHKNR: TXNN T1,D%RAN ;RANDOM FILE?
POPJ P, ;NO
DMOVE T2,[EXP [ASCIZ /sequential/],[ASCIZ /direct/]]
$ECALL CDI,%ABORT ;REPORT SEQ I/O TO RANDOM 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
CAML T2,[MINUNIT] ;RANGE CHECK. BELOW NEGATIVE UNITS
CAILE T2,MAXUNIT ; OR UNIT BEYOND RANGE OF DDBTAB
$ECALL IUN,%ABORT ;ILLEGAL UNIT NUMBER
JUMPGE T2,CHKUDB ;IF POSITIVE, NAME IS CORRECT
HRRZ T3,%UNNAM(T2) ;NEGATIVE, GET THE REAL NAME
XMOVEI T3,(T3) ;GET EXTENDED ADDR
MOVEM T3,%IONAM ;SAVE IT
CHKUDB: SKIPE %UDBAD ;IS I/O IN PROGRESS?
$ECALL IWI,%ABORT ;YES. THAT'S FATAL!
POPJ P, ;Ok, return
;HERE FROM IOLST% OR FIN% WHEN I/O IS COMPLETE
%SETAV: SETZM %UDBAD ;CLEAR THE UDB PNTR
MOVE T1,CREC(D) ;GET CURRENT RECORD NUMBER
ADDI T1,1 ;POINT TO NEXT ONE
SKIPE T2,AVAR(D) ;Get address of ASSOCIATE VARIABLE
MOVEM T1,(T2) ;There is one, store next record number
SETZM %NAMLN ;TELL ERROR PROCESSOR STATEMENT DONE
POPJ P, ;DONE. RETURN TO USER PROG
;ROUTINE TO SET UP A DDB FOR ENCODE/DECODE
SETDE: SKIPE U,%EDDB ;DDB ALREADY CREATED?
JRST CLRDE ;YES. USE IT
MOVEI T1,ULEN ;Get length of unit block
PUSHJ P,%GTBLK
MOVE U,T1 ;Point U to it
MOVEM U,%EDDB ;Save for use on next ENCODE/DECODE
MOVEI T1,DLEN ;GET LENGTH OF DDB
PUSHJ P,%GTBLK ;GET AN EMPTY DDB
MOVEI D,(T1) ;POINT D TO IT
MOVEM D,DDBAD(U) ;Remember it in the unit block
MOVEI T1," " ;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
MOVX T1,D%CLR ;CLEAR ALL TEMP FLAGS
ANDCAM T1,FLAGS(D)
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
CAMLE L,[-4,,-1] ;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 L,[-5,,-1] ;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 L,[-6,,-1] ;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 L,[-2,,-1] ;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 L,[-3,,-1] ;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
JRST IOCNV1
NMLCNV: LDB T1,[POINTR ((L),ARGKWD)] ;GET KWD FIELD OF FIRST ARG
JUMPN T1,%POPJ ;NONZERO, NEW-STYLE CALL
CAMLE L,[-4,,-1] ;AT LEAST 4 ARGS?
JRST IOCNV2 ;NO, NO NAMELIST ADDRESS
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
CAMLE L,[-4,,-1] ;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 L,[-5,,-1] ;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 L,[-6,,-1] ;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
CAMLE L,[-4,,-1] ;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
;SETD IS CALLED TO SET UP D FOR ALL I/O STATEMENTS.
;OPENS UNIT IF NECESSARY
;CHECKS RANDOM VS. SEQUENTIAL, FORMATTED VS. UNFORMATTED
;ARGS: A.UNIT = ADDR OF UNIT NUMBER
;RETURN: D = DDB ADDRESS
SETD: MOVE T1,%CUNIT ;GET UNIT NUMBER
MOVE U,%DDBTAB(T1) ;Get address of unit block
JUMPN U,GOTD ;ALREADY OPEN, GO CHECK STUFF
SKIPE A.REC ;TRYING TO DO RANDOM I/O?
$ECALL RR1,%ABORT ;YES. MUST SETUP RECORDSIZE IN OPEN!
MOVEI T1,ULEN ;Get length of unit block
PUSHJ P,%GTBLK ;Allocate it
MOVE U,T1
MOVEI T1,DLEN ;GET LENGTH OF DDB
PUSHJ P,%GTBLK ;ALLOCATE IT
MOVEM T1,DDBAD(U) ;SAVE DDB ADDR
MOVE T1,%CUNIT ;GET UNIT BACK
STORE T1,UNUM(U) ;SAVE UNIT NUMBER
GOTD: MOVEM U,%UDBAD ;NOW WE HAVE D AND U
MOVE D,DDBAD(U) ;Get DDB address
POPJ P,
SETBIN: LOAD T1,MODE(D) ;GET DATA MODE
JUMPN T1,%POPJ ;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,
SETASC: LOAD T1,MODE(D) ;GET DATA MODE
JUMPN T1,%POPJ ;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,
OPNDDB: MOVE T1,%CUNIT ;GET UNIT NUMBER
SKIPE %DDBTAB(T1) ;DDBTAB ENTRY SET UP?
JRST TFCLR ;YES. GO CLEAR TEMP FLAGS
PUSHJ P,%OPENX ;NO. OPEN THE DDB
MOVE T1,%CUNIT ;GET UNIT NUMBER AGAIN
MOVEM U,%DDBTAB(T1) ;Store address of unit block
TFCLR: MOVX T1,D%CLR ;CLEAR ALL TEMP FLAGS
ANDCAM T1,FLAGS(D)
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
MOVN T2,T0 ;GET NEG COUNT OF CHARS TO READ
ADDB T2,IRCNT(D) ;UPDATE RECORD BYTE COUNT
JUMPL T2,IMTRUN ;PAST RECORD END, TRUNCATE INPUT
MOVE T1,T0 ;GET COUNT AGAIN
ADJBP T1,IRPTR(D) ;GET UPDATED BYTE POINTER
EXCH T1,IRPTR(D) ;SAVE UPDATED ONE, GET OLD ONE AGAIN
EXTEND T0,[EXP MOVSLJ," "] ;MOVE STRING, PAD WITH SPACES
$SNH
POPJ P,
IMTRUN: MOVE T1,T0 ;COPY # CHARS TO READ
ADJBP T1,IRPTR(D) ;UPDATE POINTER
EXCH T1,IRPTR(D) ;SAVE UPDATED ONE, GET CURRENT ONE
ADD T0,IRCNT(D) ;SHORTEN # BYTES WE GET BY COUNT BEYOND RECORD
CAIG T0,0 ;IF COUNT IS .LE. 0
DMOVE T0,[EXP 1,<POINT 7,[ASCIZ / /]>] ;USE SPACES
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,
;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
; IOERR (ETL,60,509,%,Attempt to WRITE beyond fixed-length record)
$ECALL ETL
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: CAIN T1,1 ;ONE SPACE?
JRST OSONE ;YES. DO IT WITH %OBYTE
MOVEI T3,(T1) ;GET # SPACES TO PAD
DMOVE T0,[EXP 1,<POINT 7,[ASCIZ / /]>] ;USE SPACES
JRST OMCOM ;JOIN COMMON CODE
%OMBYT: CAIN T0,1 ;ONE BYTE?
JRST OMONE ;YES. DO IT WITH %OBYTE
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?
SKIPE RSIZE(D) ;RECORDSIZE?
JRST OMFRS ;YES. GIVE WARNING, MOVE PARTIAL STRING
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,[MOVSLJ
" "] ;move string
$SNH ;TRUNCATION SHOULD NOT HAPPEN
SETZM ORPOS(D) ;FLAG WE HAVE PUT CHARS AT CURRENT POSITION
POPJ P, ;we are done, return
OMFRS: MOVE T4,ORPTR(D) ;GET THE BUFFER POINTER
MOVEI T5,(T3) ;COPY THE OFFSET
ADJBP T5,ORPTR(D) ;POINT BEYOND RECORD
MOVEM T5,ORPTR(D) ;AND SAVE THE POINTER
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
MOVEI T0,(T3) ;SET SOURCE=DEST
EXTEND T0,[EXP MOVSLJ," "] ;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,
OMONE: ILDB T1,T1 ;GET THE CHAR
PJRST %OBYTE ;OUTPUT IT
OSONE: MOVEI T1," " ;OUTPUT 1 SPACE
PJRST %OBYTE
EXPIRB: HRRZ T1,IRBUF(D) ;GET OLD BUFFER PNTR-1
ADDI T1,1 ;CORRECT IT
MOVE T2,IRBLN(D) ;GET OLD LENGTH IN BYTES
SETZ T3, ;NO MINIMUM SIZE
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
SUBI 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
SUBI 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: MOVEI 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
MOVEI T3,(T4) ;COPY NEW SIZE
IDIV T3,BPW(D) ;GET # WORDS IN NEW BUFFER
PUSHJ P,%MVSPC ;MOVE TO BIGGER BUFFER, FILL WITH SPACES
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
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: 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 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?
$ECALL EOF,%ABORT ;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?
$ECALL EOF,%ABORT ;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 DIREC ;DISK
JRST XIREC ;MTA
JRST XIREC ;OTHER
JRST DECODE ;DECODE
JRST IFIN ;INTERNAL FILE INPUT
IDSPS: JRST TIRECS ;TTY
JRST DIREC ;DISK
JRST XIREC ;MTA
JRST XIREC ;OTHER
JRST DECODE ;DECODE
JRST IFIN ;INTERNAL FILE INPUT
IF20,<
;TTY
;TIREC - FOR INITIAL INPUT, EOF IS ALWAYS CLEARED FOR TTY, SINCE IT
;IS DEFINED AS A LINE-BY-LINE EOF (IS NOT "STICKY").
;TIRECS - FOR "/" FORMAT, INDEFINITE REPEAT, AND MULTIRECORD INPUT,
;EOF (CONTROL-Z) IS STICKY, AND WILL GET AN EOF RETURN.
TIREC: MOVX T0,D%END ;CLEAR EOF FOR TTY'S
ANDCAM T0,FLAGS(D)
TIRECS: PUSHJ P,T20INP ;END= STAYS ON
PJRST IRSET ;AND RETURNS IMMEDIATELY IF EOF
T20INP: SETZM IRCNT(D) ;CLEAR CHAR COUNT IN CASE EOF
SETZM IRLEN(D) ;AND RECORD LENGTH
MOVE T0,FLAGS(D) ;JUST LEAVE IF EOF
TXNE T0,D%END
POPJ P,
TXNN T0,D%SEOL ;SUPPRESS CR OR LF?
PUSHJ P,%OCRLF ;NO. OUTPUT CRLF
MOVEI T1,.RDBRK ;SET TEXTI BLOCK LENGTH
MOVEM T1,TXIBLK+.RDCWB
MOVX T1,RD%CRF+RD%JFN+RD%BBG ;SUPPRESS CR, READ FROM JFNS, BFP GIVEN
MOVEM T1,TXIBLK+.RDFLG ;STORE FLAGS
LOAD T1,IJFN(D) ;GET JFN
HRLI T1,(T1) ;IN BOTH HALVES
MOVEM T1,TXIBLK+.RDIOJ ;STORE IT
MOVE T1,IRBEG(D) ;GET RECORD BUFFER PNTR
MOVEM T1,TXIBLK+.RDDBP ;STORE DEST BYTE POINTER
MOVEM T1,TXIBLK+.RDBFP ;AND BEGINNING-OF-BUFFER 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 ;NO. SUPPRESS NEXT LEADING EOL
IORM T0,FLAGS(D) ;Yes, set end-of-file
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
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 ;SUPPRESS CRLF?
PUSHJ P,%OCRLF ;NO. OUTPUT CRLF
MOVX T0,D%SEOL ;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 ICNT(D) ;ANY MORE BYTES?
JRST TLPX1 ;NO. GET MORE
PUSHJ P,IMAP
JRST DIEOR ;GOT EOF
JRST TLP0 ;KEEP IN SYNCH
TLPX1: ILDB T1,IPTR(D) ;GET A CHAR
JUMPE T1,TLP0 ;SKIP IT IF NULL
JRST TLPGTC ;USE IT IF NOT NULL
TLP: SOSL ICNT(D) ;ANY MORE BYTES?
JRST TLPX2 ;YES
PUSHJ P,IMAP ;NO
JRST DIEOR ;GOT EOF
JRST TLP ;KEEP IN SYNCH!
TLPX2: ILDB T1,IPTR(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
PUSHJ P,EXPIRB ;NO. EXPAND RECORD BUFFER
LDB T1,IPTR(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 GOTCR ;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
>;END IF10
DIREC:
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,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: SOS ICNT(D) ;DECR COUNT
ILDB T1,IPTR(D) ;GET A 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
$ECALL EOF,%ABORT ;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)
MOVE T1,FLAGS(D) ;GET DDB FLAGS
TXNN T1,D%RAN ;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
$ECALL RNR,%ABORT ;IF NOT, RECORD NOT WRITTEN
;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,IRBLN(D) ;GET RECORD BUFFER LENGTH
MOVEM T1,IRCNT(D)
MOVE T1,IRBUF(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
$ECALL EOF,%ABORT ;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,RSIZE(D) ;SETUP RECORD LENGTH AND COUNT
MOVEM T1,IRLEN(D)
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
;DECODE
DECINI: MOVE T1,A.HSA ;GET STRING ADDR
$BLDBP T1 ;Build 7-bit byte ptr.
MOVE T2,T.HSA ;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
$ECALL SLN,%ABORT ;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: MOVE 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
$ECALL ICE,%ABORT ;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?
$ECALL EOF,%ABORT ;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,INDX(D) ;GET DEVICE INDEX
PJRST ODSPS(T1) ;OUTPUT THE RECORD, CHECK INT FILE OVERRUN
%OREC: AOS CREC(D) ;COUNT RECORD
LOAD T1,INDX(D) ;GET DEV INDEX
PJRST ODSP(T1) ;OUTPUT THE RECORD, AS APPROPRIATE FOR DEV
PUTSTR: LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIE T1,DI.TTY ;TTY?
JRST DOSTR ;NO. OTHER DEVICE
JRST TOSTR ;YES.
;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
JRST DOREC
JRST XOREC
JRST XOREC
POPJ P,
POPJ P,
ODSPS: JRST TORECS ;TTY
JRST DORECS ;DISK
JRST XORECS ;MTA
JRST XORECS ;OTHER
JRST ENCODE ;DECODE
JRST IFOUT ;INTERNAL FILE OUTPUT
;ERROR MESSAGE OUTPUT
;ARGS: T1 = ADDRESS OF ASCIZ MESSAGE STRING
%EOREC: MOVEM T1,ERPTR ;SAVE MESSAGE POINTER
SKIPN U.ERR ;POINT TO ERR DDB
JRST ETTY ;NONE, USE PSOUT
PUSH P,U ;SAVE U AND D
PUSH P,D
SETZ F, ;NO FLAGS, PLEASE
MOVE U,U.ERR ;GET UNIT BLOCK ADDR
PUSH P,U.ERR ;RECURSIVE ERRS GO TO TTY
SETZM U.ERR
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
SETZ T2, ;CLEAR CHAR COUNT
MOVE T3,ERPTR ;GET ERROR POINTER
EOLP: ILDB T1,T3 ;GET BYTE OF MSG
JUMPE T1,EOEND ;QUIT WHEN NULL
AOJA T2,EOLP ;INCR CHAR COUNT
EOEND: MOVEM T2,CHRCNT ;SAVE COUNT
MOVE T1,ERPTR ;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
MOVE T1,BYTN(D) ;UPDATE EOFN
SUB T1,OCNT(D)
MOVEM T1,EOFN(D)
MOVX T1,D%MOD ;Remember file modified
IORM T1,FLAGS(D)
POP P,U.ERR ;AND ORIGINAL ERROR UNIT #
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,ERPTR ;GET POINTER TO MESSAGE
PSOUT%
HRROI T1,%CRLF ;END WITH CRLF
PSOUT%
> ;END IF20
IF10,<
OUTSTR %CRLF
EPSOUT: MOVE T1,ERPTR ;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
;
;RETURN: ORPTR = BYTE POINTER TO FIRST CHAR OF RECORD
; ORLEN = NUMBER OF BYTES IN RECORD
FIXREC: SETZM G.PRP ;ASSUME NO PROMPTING
SKIPN RSIZE(D) ;FIXED-LENGTH RECORD?
JRST RECVAR ;NO
PUSHJ P,SFLEN ;UPDATE LENGTH, PAD
SKIPE FRSIZW(D) ;WORD-ALIGNED RECORDS?
PUSHJ P,FIXEOL ;HANDLE CRLF, CLEAR UNUSED PART OF LAST WORD
MOVE T1,FRSIZB(D) ;GET FULL RECORDSIZE
MOVEM T1,ORLEN(D) ;SAVE RECORD LENGTH
MOVEM T1,ORCNT(D) ;AND SAVE FOR OUTPUT ROUTINE
MOVE T1,ORBUF(D) ;SETUP PNTR/COUNT
MOVEM T1,ORPTR(D)
POPJ P,
RECVAR: LOAD T1,CC(U) ;GET CARRIAGE CONTROL DESIRED
CAIN T1,CC.FORT ;FORTRAN?
JRST CCFORT ;YES. OH, WELL
PUSHJ P,SVLEN ;SET PNTR/COUNT TO END OF RECORD
PUSHJ P,LISCOM ;GO HANDLE $ FORMAT, PROMPTING, CRLF
MOVE T1,ORBUF(D) ;SETUP PNTR/COUNT
MOVEM T1,ORPTR(D)
MOVE T1,ORLEN(D)
MOVEM T1,ORCNT(D)
POPJ P,
CCFORT: PUSHJ P,CHKDOL ;CHECK FOR $ CARRIAGE CONTROL
PUSHJ P,SVLEN ;UPDATE RECORD LENGTH
PUSHJ P,CCOUT ;OUTPUT CC CHARS
PUSHJ P,SETNUL ;AND END RECORD WITH NULLS
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,
;ROUTINES CALLED BY FIXREC
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
MOVEM T1,ORLEN(D) ;YES. RECORD NEW ONE
POPJ P,
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,
;CHKDOL - CHECK IF $ CARRIAGE CONTROL, WHICH IS SPACE CARRIAGE CONTROL
;AND $ FORMAT, I.E., SUPPRESS THE NEXT CRLF.
CHKDOL: 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 T2,ORBEG(D) ;GET POINTER TO RECORD
ILDB T3,T2 ;GET THE 1ST CHARACTER
CAIG T3,"3" ;IF OUT OF RANGE, TREAT AS SPACE
CAIGE T3,"*"
MOVEI T3,"4" ;SPACE IS JUST BEYOND LEGAL TABLE
MOVE T4,CCPTR-"*"(T3) ;GET POINTER TO LAST BYTE OF CC WORD
MOVE T5,CCLEN-"*"(T3) ;GET # CHARS IN CC SUBSTITUTION
MOVE T1,FLAGS(D) ;GET FLAG REG
TXZN T1,D%SEOL ;SUPPRESS LEADING CRLF?
JRST DOCC ;NO. JUST PROCEED
MOVE T4,CCALTP-"*"(T3) ;YES. GET ALTERNATE POINTER
MOVE T5,CCALTL-"*"(T3) ;AND COUNT
DOCC: TXZE T1,D%STCR ;DOLLAR FORMAT OR CC?
TXO T1,D%SEOL ;YES. SET FOR SUPPRESSING CRLF NEXT TIME
MOVEM T1,FLAGS(D) ;SAVE UPDATED FLAGS
JUMPE T5,%POPJ ;NO OUTPUT IF NO CHARS
MOVEM T5,CHRCNT ;SAVE PNTR/COUNT
MOVEM T4,CHRPTR
PJRST PUTSTR ;OUTPUT THE STRING
;FIXEOL - FOR FIXED-LENGTH RECORDS,
;OUTPUTS CRLF, CLEARS THE UNUSED BITS IN
;THE LAST DATA WORD.
FIXEOL: PUSHJ P,LISCOM ;OUTPUT CRLF, DEAL WITH $ FORMAT
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,
LISCOM: MOVE T1,FLAGS(D) ;SEE IF $ FORMAT
TXZN T1,D%STCR
JRST LISTCR ;NO. GO OUTPUT CRLF, ADD 2 TO LENGTH
TXZ T1,D%SEOL ;DON'T SUPPRESS LEADING CRLF ON INPUT
MOVEM T1,FLAGS(D) ;SAVE FLAGS WITHOUT IT
MOVE T1,ORBEG(D) ;GET RECORD POINTER
MOVEM T1,G.PRP ;SAVE FOR PROMPT
SETNUL: SETZ T1, ;APPEND 2 NULLS TO THE RECORD FOR PROMPTING
PUSHJ P,%OBYTE
PJRST %OBYTE
;LISTCR - FOR CC=LIST, OUTPUT A CRLF AT THE END OF THE RECORD.
LISTCR: TXO T1,D%SEOL ;SUPPRESS LEADING CRLF FOR INPUT
MOVEM 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,
CCPTR: 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
POINT 7,[BYTE(7)%CR,%LF] ;SPACE : CR,LF
CCLEN: 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
2 ;SPACE : CR,LF
;THE FOLLOWING POINTERS AND COUNTS ARE USED IF DOLLAR FORMAT
;HAS BEEN SPECIFIED. THE CR AND ONE LF (IF ANY) IS REMOVED FROM
;EACH STRING.
CCALTP: POINT 7,[BYTE(7)%DC3] ;* : DC3
0 ;+ :
POINT 7,[BYTE(7)%DC1] ;, : DC1
POINT 7,[BYTE(7)%LF,%LF] ;- : LF,LF
POINT 7,[BYTE(7)%DC2] ;. : DC2
POINT 7,[BYTE(7)%DC4] ;/ : DC4
POINT 7,[BYTE(7)%LF] ;0 : LF
POINT 7,[BYTE(7)%FF] ;1 : FF
POINT 7,[BYTE(7)%DC0] ;2 : DC0
POINT 7,[BYTE(7)%VT] ;3 : VT
0 ;SPACE :
CCALTL: 1 ;* : DC3
0 ;+ :
1 ;, : DC1
2 ;- : LF,LF
1 ;. : DC2
1 ;/ : DC4
1 ;0 : LF
1 ;1 : FF
1 ;2 : DC0
1 ;3 : VT
0 ;SPACE : LF
;ROUTINE TO NORMALIZE CRLF POSITION, BY TYPING PENDING CRLF, IF ANY
;
;WHEN WRITING A FILE WITH CC=FORTRAN, THE CRLFS COME BEFORE THE
;RECORDS INSTEAD OF AFTER THEM. THE REST OF THE WORLD PUTS CRLFS
;AFTER THEIR RECORDS. THIS ROUTINE IS CALLED TO GET IN SYNC WITH THE
;OUTSIDE WORLD WHEN NECESSARY.
;
;CALLED:
; WHEN SWITCHING FROM OUTPUT TO INPUT ON TTY.
; 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
IF10,<
TORECS:
>;END IF10
DORECS:
XORECS: PUSHJ P,COREC ;DO IT
PJRST ORINI ;AND INITIALIZE THE POINTER/COUNT
IF10,<
TOREC:
>;END IF10
DOREC:
XOREC:
COREC: PUSHJ P,FIXREC ;SETUP FOR OUTPUT
MOVX T0,D%MOD ;Set file modified
IORM T0,FLAGS(D)
SKIPE RSIZE(D) ;FIXED-LENGTH RECORDS?
JRST OUTBLT ;YES. BLT THE RECORD OUT
SKIPG ORCNT(D) ;ANYTHING IN RECORD?
POPJ P, ;NO. LEAVE
JRST COCONT ;SKIP BUFFER PNTR UPDATE
COUTLP: MOVEM T0,ORCNT(D) ;SAVE UPDATED REC COUNT
MOVEM T1,ORPTR(D) ;AND POINTER
MOVEM T4,OPTR(D) ;SAVE UPDATED BUFFER PNTR
COCONT: SKIPG OCNT(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,OCNT(D) ;GET WINDOW PNTR/COUNT
MOVE T4,OPTR(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,OCNT(D)
EXTEND T0,[EXP MOVSLJ,0] ;MOVE RECORD
JRST COUTLP ;LOOP IF TRUNCATED
MOVEM T4,OPTR(D)
IF10,<
MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%INT ;INTERACTIVE DEVICE?
PUSHJ P,OSBUF ;YES. OUTPUT BUFFER
>;END IF10
MOVE T1,BYTN(D) ;GET BYTE # OF NEXT WINDOW
SUB T1,OCNT(D) ;GET LAST BYTE IN USE
MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%RAN ;RANDOM FILE?
CAMLE T1,EOFN(D) ;YES. ONLY STORE LARGER EOFN
MOVEM T1,EOFN(D) ;SAVE AS EOF PNTR
POPJ P, ;DONE
OUTBLT: MOVE T1,FRSIZW(D) ;GET RECORDSIZE
MOVEM T1,LOCSIZ ;SAVE FOR TRANSFER
MOVE T1,ORBUF(D) ;INIT RECORD POINTER
MOVEM T1,ORPTR(D)
OUTBLP: MOVE T4,OCNT(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,OCNT(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,OPTR(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,OPTR(D) ;AND BUFFER POINTER
SUBI T4,(T3) ;AND BUFFER WORD COUNT
IMUL T4,BPW(D) ;UPDATE COUNT
MOVEM T4,OCNT(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,OCNT(D) ;GET LAST BYTE IN USE
MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%RAN ;RANDOM FILE?
CAMLE T1,EOFN(D) ;YES. ONLY STORE LARGER EOFN
MOVEM T1,EOFN(D) ;SAVE AS EOF PNTR
POPJ P,
IF10,<
TOSTR: PUSHJ P,DOSTR ;PUT THE CHARS IN THE BUFFER
PJRST OSBUF ;GO OUTPUT BUFFER
> ;END IF10
DOSTR:
DSTRLP: SKIPG OCNT(D) ;ANY ROOM LEFT IN BUFFER?
PUSHJ P,ONXTW ;NO. GET NEW WINDOW
SOS OCNT(D) ;DECR COUNT
ILDB T1,CHRPTR ;GET A CHAR
IDPB T1,OPTR(D) ;DEPOSIT IN FILE BUFFER
SOSLE CHRCNT ;DECR COUNT
JRST DSTRLP ;BACK FOR MORE
POPJ P,
IF20,<
;TOPS-20 TTY OUTPUT
TORECS: PUSHJ P,TOREC ;OUTPUT THE RECORD
PJRST ORINI ;GO INIT THE POINTER/COUNT
TOREC: PUSHJ P,FIXREC ;SETUP FOR OUTPUT
SKIPG ORCNT(D) ;ANY DATA IN RECORD?
POPJ P, ;NO. NOTHING TO DO
LOAD 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%
LOAD T1,OJFN(D) ;GET JFN
MOVE T2,ORPTR(D) ;GET POINTER TO START OF RECORD
MOVN T3,ORCNT(D) ;GET NEGATIVE OF BYTE COUNT
LOAD T1,OJFN(D) ;GET JFN
SOUTR% ;OUTPUT THE STRING
ERJMP OUTERR ;ERROR, GO TELL USER
LOAD T1,OJFN(D) ;GET JFN AGAIN
DMOVE T2,TCCOC ;GET ORIGINAL CONTENTS
SFCOC% ;RESTORE CCOC WORDS
POPJ P, ;DONE
TOSTR: LOAD 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%
LOAD 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
LOAD T1,OJFN(D) ;GET JFN AGAIN
DMOVE T2,TCCOC ;GET ORIGINAL CONTENTS
SFCOC% ;RESTORE CCOC WORDS
POPJ P,
>;END IF20
;ENCODE
ENCINI: MOVE T1,A.HSA ;GET STRING ADDR
$BLDBP T1 ;Build 7-bit byte ptr.
MOVE T2,T.HSA ;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
$ECALL SLN,%ABORT ;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: MOVE 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
$ECALL ICE,%ABORT ;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?
$ECALL WBA,%ABORT ;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: DMOVE T0,[EXP 1,<POINT 7,[ASCIZ / /]>] ;USE SPACES
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
;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 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: AOS CREC(D) ;UPDATE RECORD COUNT
PUSHJ P,ILSCW1 ;READ START LSCW
$ECALL EOF,%ABORT ;EOF.
SETZM RECREM ;CLEAR CHAR REMAINDER
POPJ P,
UNFI: SKIPN IO.ADR ;FIN CALL?
JRST UIEND ;YES
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: DMOVE P1,IPTR(D) ;GET 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
$ECALL EOF,%ABORT ;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: ADDI P1,(T2) ;INCREMENT ADDRESS OF DATA IN WINDOW
HXL P1,BYTPT(D) ;WORD-ALIGN IT
SUBI P2,(T2) ;DECREMENT COUNT OF DATA LEFT IN WINDOW
IMUL P2,BPW(D) ;GET # CHARS
DMOVEM P1,IPTR(D) ;SAVE THEM BOTH
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
$ECALL EOF,%ABORT ;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,IO.ADR ;GET DEST PNTR
EXTEND T0,[EXP MOVSLJ,0] ;MOVE STRING LEFT-JUSTIFIED, ZERO FILL
$SNH ;SHOULD SKIP RETURN
MOVEM T1,IPTR(D) ;SAVE UPDATED BUFFER PNTR
MOVE T4,LOCNUM ;GET # CHARS TRANSFERRED
ADJBP T4,IO.ADR ;ADJUST - UPDATED PNTR IS 2-WORD!
MOVEM T4,IO.ADR ;SAVE IT
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: DMOVE T0,[EXP 1,<POINT 7,[ASCIZ / /]>] ;USE SPACES
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
SETZM RECLEN ;CLEAR THE RECORD LENGTH
SETZM RECREM ;AND THE BYTE REMAINDER
POPJ P,
UIEND: PUSHJ P,ILSCW3 ;SKIP TO END LSCW
MOVE T0,FLAGS(D) ;Get DDB flags
TXNN T0,D%END ;REACH EOF?
PJRST %SETAV ;NO. RETURN TO USER PROG
LOAD T0,MODE(D) ;GET DATA MODE
CAIE T0,MD.IMG ;BINARY?
$ECALL BBF,%ABORT ;YES. BAD FORMAT
$ECALL EOF,%ABORT ;NO. 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
;HERE AT START OF RECORD
;READ START LSCW
;0 MEANS RANDOM RECORD WAS NEVER WRITTEN
ILSCW1: LOAD T0,MODE(D) ;GET DATA MODE
CAIN T0,MD.IMG ;BINARY?
JRST IMG1 ;NO, IMAGE, NO LSCWS
PUSHJ P,IWORD ;GET WORD FROM BINARY FILE
POPJ P, ;EOF. NON-SKIP RETURN
JUMPE T1,RNRERR ;ZERO, RECORD WASN'T WRITTEN
LDB T2,[POINT 9,T1,8] ;GET SEGMENT CONTROL WORD
CAIE T2,1 ;START LSCW?
; IOERR (BBF,25,302,?,Bad format binary file,,%ABORT)
$ECALL BBF,%ABORT ;?Bad format binary file
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?
$ECALL RSM,%ABORT ;NO. RECORD SIZE MISMATCH
SLSCW1: MOVEM T1,RECLEN ;SAVE COUNT
JRST %POPJ1 ;RETURN
IF20,<
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,%ABORT ;[3247] NO
> ;END IF20
RNRERR: $ECALL RNR,%ABORT ;RECORD NOT WRITTEN
IMG1: SKIPN T1,RSIZE(D) ;GET RECORD SIZE IN WORDS
HRLOI T1,37777 ;HUGE RECORD IF NO RECSIZ
MOVEM T1,RECLEN ;SAVE IT
JRST %POPJ1 ;DONE
;HERE WHEN START OR CONTINUE SEGMENT ENDS
;MUST SEE CONTINUATION OR END LSCW
ILSCWX: LOAD T0,MODE(D) ;GET DATA MODE
CAIN T0,MD.IMG ;BINARY MODE?
JRST IMG2 ;NO, IMAGE, 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
$ECALL BBF,%ABORT ;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?
$ECALL BBF,%ABORT ;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?
$ECALL FCL,%ABORT ;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: LOAD T0,MODE(D) ;GET DATA MODE
CAIN T0,MD.IMG ;BINARY?
JRST IMG3 ;NO, 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
$ECALL BBF,%ABORT ;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?
$ECALL BBF,%ABORT ;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: DMOVE T1,IPTR(D) ;GET PNTR/COUNT
HXL T1,BYTPT(D) ;ALIGN THE PNTR
IDIV T2,BPW(D) ;ALIGN THE COUNT
IMUL T2,BPW(D)
DMOVEM T1,IPTR(D)
POPJ P,
IANXT: PUSHJ P,UINXTW ;NOTHING LEFT, GO MAP NEXT WINDOW
POPJ P, ;EOF. NON-SKIP RETURN
IAWORD: SKIPG ICNT(D) ;ANY WORDS LEFT?
JRST IANXT ;NO
MOVN T1,BPW(D) ;REDUCE BY 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: MOVE P2,ICNT(D) ;GET THE COUNT
IDIV P2,BPW(D) ;ALIGN THE COUNT
SOJL P2,INXT ;CHECK IF WORD LEFT, DO INPUT IF NOT
HRRZ P1,IPTR(D) ;GET JUST THE RH OF THE PNTR
ADDI P1,1 ;INCREMENT POINTER
MOVE T1,(P1) ;GET WORD
HXL P1,BYTPT(D) ;MAKE IT A CHARACTER BYTE PNTR AGAIN
IMUL P2,BPW(D) ;AND MAKE THE COUNT IN BYTES
DMOVEM P1,IPTR(D) ;SAVE THEM BOTH
AOS (P) ;SKIP RETURN
POPJ P,
;UNFORMATTED SKIP RECORD
UNFSKP: AOS CREC(D) ;UPDATE RECORD COUNT
PUSHJ P,ILSCW1 ;READ START LSCW, P3 = SEGMENT LENGTH
$ECALL EOF,%ABORT ;EOF
JRST UIEND ;GO SKIP TO END OF RECORD
UOSET: MOVX T0,D%MOD ;Set "file modified"
IORM T0,FLAGS(D)
AOS CREC(D) ;UPDATE RECORD COUNT
LOAD T0,MODE(D) ;GET DATA MODE
CAIE T0,MD.IMG ;BINARY?
PUSHJ P,OLSCW1 ;YES. 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: SKIPN IO.ADR ;FIN CALL?
JRST UOEND ;YES. FINISH RECORD
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
DMOVE P1,OPTR(D) ;GET PNTR/COUNT
IDIV P2,BPW(D) ;GET # WORDS LEFT
JUMPG P2,UOBLT ;OK IF WE HAVE ROOM IN WINDOW
PUSHJ P,UOALIN ;NO ROOM. ALIGN THE PNTR/COUNT
LOAD T0,MODE(D) ;GET MODE
CAIE T0,MD.IMG ;BINARY?
PUSHJ P,OLSCWX ;YES. FINISH START OR CONTINUE LSCW
PUSHJ P,ONXTW ;OUTPUT CURRENT WINDOW, GET NEXT
LOAD T0,MODE(D) ;GET DATA MODE
CAIE T0,MD.IMG ;BINARY?
PUSHJ P,OLSCW2 ;YES. OUTPUT TYPE 2 LSCW
DMOVE P1,OPTR(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: ADDI P1,(T2) ;INCREMENT ADDRESS OF DATA IN WINDOW
HXL P1,BYTPT(D) ;WORD-ALIGN IT
SUBI P2,(T2) ;DECREMENT COUNT OF DATA LEFT IN WINDOW
IMUL P2,BPW(D) ;GET # CHARS
DMOVEM P1,OPTR(D) ;SAVE THEM BOTH
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
SKIPLE OCNT(D) ;ANY CHARS IN WINDOW
JRST UOCBLT ;YES. GO TRANSFER SOME
LOAD T0,MODE(D) ;GET DATA MODE
CAIE T0,MD.IMG ;BINARY?
PUSHJ P,OLSCWX ;YES. FINISH START OR CONTINUE LSCW
PUSHJ P,ONXTW ;OUTPUT CURRENT WINDOW, GET NEXT
LOAD T0,MODE(D) ;GET DATA MODE
CAIE T0,MD.IMG ;BINARY?
PUSHJ P,OLSCW2 ;YES. OUTPUT TYPE 2 LSCW
UOCBLT: MOVE T0,OCNT(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,IO.ADR ;GET THE DATA PNTR
MOVE T3,T0 ;COPY THE COUNT
MOVE T4,OPTR(D) ;GET DEST PNTR
EXTEND T0,[EXP MOVSLJ,0] ;MOVE STRING LEFT-JUSTIFIED, ZERO FILL
$SNH ;SHOULD SKIP RETURN
MOVEM T4,OPTR(D) ;UPDATE BUFFER PNTR
MOVE T1,LOCNUM ;GET # CHARS TRANSFERRED
ADJBP T1,IO.ADR ;ADJUST - UPDATED PNTR IS 2-WORD!
MOVEM T1,IO.ADR ;SAVE UPDATED PNTR
MOVN T1,LOCNUM ;GET NEGATIVE CHARS TRANSFERRED
ADDM T1,LOCREC ;UPDATE # CHARS LEFT IN RECORD
ADDM T1,OCNT(D) ;UPDATE # CHARS LEFT IN WINDOW
ADDB T1,LOCSIZ ;UPDATE # CHARS TO TRANSFER
JUMPG T1,UOCBL1 ;LOOP IF MORE TO TRANSFER
SKIPN T1,IO.INC ;GET INCREMENT
JRST UOCNI ;NONE
ADJBP T1,IO.ADR ;UPDATE PNTR
MOVEM T1,IO.ADR ;AND SAVE IT
UOCNI: SOSLE IO.NUM ;ANY MORE ENTRIES?
JRST UOCBLP ;YES. GO DO THEM
MOVE T1,LOCREC ;GET LOCAL RECORD LENGTH LEFT
IDIV T1,BPW(D) ;GET WORDS AND BYTES
DMOVEM T1,RECLEN ;SAVE FOR NEXT CALL
POPJ P,
;HERE IF NO ROOM LEFT IN RECORD BUT THE IOLST HAS SPECIFIED
;MORE OUTPUT. GIVE THE USER AN WARNING MESSAGE AND CLEAR THE
;RECORD COUNTS.
UOCZER: $ECALL ETL ;ATTEMPT TO WRITE BEYOND FIXED-LENGTH RECORD
SETZM RECLEN ;CLEAR ALL LENGTHS
SETZM RECREM
POPJ P,
UOEND: SKIPN RSIZE(D) ;RECORD SIZE?
JRST UOXYZ ;NO, FINE
PUSHJ P,UOALIN ;WORD-ALIGN THE PNTR/COUNT
MOVE P3,RECLEN ;GET ROOM LEFT IN RECORD
JUMPLE P3,UOXYZ ;NO ZEROS NECESSARY, FINE
SETZ T1, ;GET A ZERO
PUSHJ P,OAWORD ;PUT IN FILE
SOJG P3,.-1 ;PAD WHOLE RECORD
UOXYZ: PUSHJ P,OLSCW3 ;OUTPUT END LSCW OR CLEAR END OF WORD
MOVE T1,BYTN(D) ;GET BYTE # OF NEXT WINDOW
SUB T1,OCNT(D) ;GET LAST BYTE IN USE
MOVE T0,FLAGS(D) ;Fetch DDB flags
TXNE T0,D%RAN ;RANDOM FILE?
CAMLE T1,EOFN(D) ;YES. ONLY STORE LARGER EOFN
MOVEM T1,EOFN(D) ;SAVE AS EOF PNTR
PJRST %SETAV ;RETURN TO USER PROG
;LSCW ROUTINES
;FORMAT OF BINARY RECORD: (FORMAT OF BINARY RECORD)
;THERE IS NO NECESSARY RELATIONSHIP BETWEEN SEGMENT SIZE AND BUFFER SIZE
OLSCW1: SKIPE RSIZE(D) ;IS RECORD SIZE SPECIFIED?
JRST O1FIX ;YES - SET TYPE 1 LSCW NOW
SETZM SEGCNT ;CLEAR WORD COUNT OF SEGMENTS ALREADY IN FILE
MOVSI T1,(1B8) ;GET START LSCW
JRST O2FIX ;SKIP TYPE 2 PROCESSING
OLSCW2: SKIPE RSIZE(D) ;IS RECORD SIZE SPECIFIED?
POPJ P, ;YES - NO NEED FOR TYPE 2 LSCW
MOVSI T1,(2B8) ;GET CONTINUE LSCW
O2FIX: PUSHJ P,OWORD ;PUT WORD INTO FILE WINDOW
HRRZM P1,CWADR ;STORE IN-CORE ADDRESS OF CONTROL WORD
POPJ P,
O1FIX: MOVE T1,RSIZE(D) ;GET RECORD SIZE, WORDS
ADD T1,[1B8+1] ;SET START LSCW
SETZM CWADR ;REMEMBER WE'VE ALREADY FILLED IN START LSCW
PJRST OWORD ;AND PUT WORD INTO FILE WINDOW
OLSCWX: SKIPE RSIZE(D) ;WAS RECORD SIZE SPECIFIED?
POPJ P, ;YES - START LSCW WAS ALREADY FILLED IN
SKIPN T2,CWADR ;GET ADDRESS OF TYPE 1 OR 2 CONTROL WORD
$SNH ;Already out in file, bug
HRRZ T1,OPTR(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
SETZM CWADR ;NOW NO CONTROL WORD WAITING TO BE FINISHED
POPJ P, ;DONE
OLSCW3: LOAD T0,MODE(D) ;GET DATA MODE
CAIN T0,MD.IMG ;BINARY?
JRST OCLR ;NO. 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,OPTR(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
ADDI T1,1 ;ADD IN END LSCW TOO
ADD T1,[3B8] ;PUT IN TYPE-3 LSCW HEADER
SETZM CWADR ;NOW NO CONTROL WORD WAITING TO BE FINISHED
PJRST OWORD ;PUT INTO FILE
O3FIX: MOVE T1,RSIZE(D) ;GET USER SPECIFIED RECORD SIZE
ADD T1,[3B8+2] ;SET UP END LSCW
PJRST OWORD ;PUT INTO FILE
UOALIN: HRRZ T1,OPTR(D) ;GET LOCAL PNTR
MOVE T2,OCNT(D) ;GET COUNT
IDIV T2,BPW(D) ;ALIGN THE COUNT
JUMPE T3,%POPJ ;PNTR/COUNT ALREADY ALIGNED
IMUL T2,BPW(D)
LDB T3,[POINT 6,OPTR(D),5] ;GET # BITS TO RIGHT
MOVE T3,RGTMSK(T3) ;GET A MASK
ANDCAM T3,(T1) ;CLEAR THE BITS
HXL T1,BYTPT(D) ;ALIGN THE PNTR
DMOVEM T1,OPTR(D)
POPJ P,
;OCLR - AT END OF EACH WRITE TO CLEAR THE REMAINING CHARACTERS IN
;THE CURRENT WORD, IF ANY.
OCLR: HRRZ T1,OPTR(D) ;GET LOCAL PNTR
MOVE T2,OCNT(D) ;GET COUNT
IDIV T2,BPW(D) ;ALIGN THE COUNT
JUMPE T3,%POPJ ;PNTR/COUNT ALREADY ALIGNED
LDB T3,[POINT 6,OPTR(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 OCNT(D) ;ANY WORDS LEFT?
JRST OANXT ;NO. OUTPUT A WINDOW
MOVN P2,BPW(D) ;REDUCE BY BYTES
ADDM P2,OCNT(D)
AOS P1,OPTR(D) ;INCR PNTR BY A WORD
MOVEI P1,(P1) ;GET JUST LOCAL ADDR
MOVEM T1,(P1) ;OUTPUT THE DATA
POPJ P,
ONXT: MOVEM T1,TOWORD ;SAVE WORD TO OUTPUT
PUSHJ P,ONXTW ;NOTHING LEFT, GO MAP NEXT WINDOW
MOVE T1,TOWORD ;GET WORD BACK AGAIN
OWORD: SKIPG P2,OCNT(D) ;GET THE COUNT
JRST ONXT ;NO ROOM. OUTPUT A BUFFERFUL
HRRZ P1,OPTR(D) ;GET THE LOCAL PNTR
IDIV P2,BPW(D) ;ALIGN THE COUNT
JUMPE P3,OWNC ;NOTHING TO CLEAR IF NO REMAINDER
LDB P3,[POINT 6,OPTR(D),5] ;GET # BITS TO THE RIGHT
MOVE P3,RGTMSK(P3) ;GET A MASK
ANDCAM P3,(P1) ;CLEAR THE BITS
JUMPN P2,OWNC ;CHECK IF WORD LEFT
SETZM OCNT(D) ;CLEAR COUNT, DO OUTPUT IF NOT
JRST ONXT
OWNC: SUBI P2,1 ;DECR WORD COUNT
ADDI P1,1 ;INCR THE PNTR
MOVEM T1,(P1) ;OUTPUT THE WORD
HXL P1,BYTPT(D) ;MAKE IT A CHARACTER BYTE PNTR AGAIN
IMUL P2,BPW(D) ;AND MAKE THE COUNT IN BYTES
DMOVEM P1,OPTR(D) ;SAVE THEM BOTH
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
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,<
DMPIN: POPJ P,
DMPOUT: POPJ P,
DMPSET: POPJ P,
>;END IF20
IF10,<
DMPIN: SKIPE IO.ADR ;ANY I/O ADDR?
JRST LSTDMP ;YES. ACCUMULATE IT
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?
$ECALL EOF,%ABORT ;Yes, give error
JRST %SETAV ;NO. RETURN
DMPOUT: SKIPE IO.ADR ;ANY I/O ADDR?
JRST LSTDMP ;YES. ACCUMULATE IT
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
$ECALL IOE,%ABORT ;Error
JRST %SETAV ;RETURN PROPERLY
DMPSET: 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?
$ECALL 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
$ECALL DLL ;DUMP I/O LIST TOO LONG
MOVEM T2,DMPNTR ;SAVE INCREMENTED PNTR
ADDI T3,177 ;GET # BLOCKS
IDIVI T3,200 ;ROUNDED UP
ADDM T3,BLKN(D) ;ADD TO BLOCK 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: MOVE T0,FLAGS(D) ;GET DDB FLAGS
TXNE T0,D%RAN ;RANDOM?
JRST IMAPW ;YES
ISNXTW: TXNE T0,D%END ;END OF FILE ALREADY?
POPJ P, ;YES. JUST LEAVE
LOAD T0,INDX(D) ;GET DEVICE INDEX
CAIE T0,DI.DSK ;DISK?
JRST ISBUF ;NO
PJRST %ISMAP ;MAP NEXT WINDOW OF SEQUENTIAL FILE
ONXTW: MOVE T1,BYTN(D) ;GET # BYTES WRITTEN SO FAR
CAMLE T1,EOFN(D) ;UPDATE EOF PNTR IF GREATER
MOVEM T1,EOFN(D)
MOVE T0,FLAGS(D) ;GET DDB FLAGS
TXNE T0,D%RAN ;RANDOM?
JRST OMAPW ;YES
OSNXTW: LOAD T0,INDX(D) ;GET DEVICE INDEX
LOAD T1,ACC(D) ;GET ACCESS
CAIE T1,AC.APP ;APPEND?
CAIE T0,DI.DSK ;DISK?
JRST OSBUF ;APPEND OR NON-DISK
PJRST %OSMAP ;MAP NEXT WINDOW
;ROUTINE TO GET NEXT BUFFER OF NON-DISK FILE
IF20,<
ISBUF: SKIPE B36FLG(D) ;OPENED IN 36-BIT MODE?
JRST BISBUF ;YES. DO BINARY INPUT
LOAD 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
LOAD 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: MOVEI T1,.FHSLF ;THIS FORK
GETER% ;GET LAST ERROR
MOVEI T2,(T2) ;TOSS THE HANDLE
CAIE T2,IOX4 ;EOF?
$ECALL IOE,%ABORT ;NO. REPORT ERROR
MOVX T0,D%END ;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
SKIPN OPTR(D) ;IF NO CHARS, JUST PREPARE WINDOW
POPJ P,
LOAD 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,OCNT(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: SKIPN OPTR(D) ;IF FIRST BUFFER
POPJ P, ;DON'T DO OUTPUT
LOAD T1,IJFN(D) ;GET JFN
MOVE T2,WADR(D) ;GET ADDRESS OF BUFFER
HRLI T2,(POINT 36) ;GET BINARY BYTE POINTER
MOVE T3,WSIZ(D) ;GET WINDOW SIZE IN BYTES
SUB T3,OCNT(D) ;CALC # BYTES USED
ADDM T3,BYTN(D) ;UPDATE # BYTES WRITTEN IN FILE
IDIV T3,BPW(D) ;GET IT IN WORDS
JUMPE T4,BOSOUT ;IF WORD-ALIGNED, JUST DO SOUTR
ADDI T3,1 ;ELSE ADD 1 TO WORD COUNT
HRRZ T4,OPTR(D) ;GET LOCAL PNTR
LDB T5,[POINT 6,OPTR(D),5] ;GET # BITS TO CLEAR
MOVE T5,%RTMSK(T5) ;GET THE MASK
ANDCAM T5,(T4) ;CLEAR THE BITS
BOSOUT: MOVN T3,T3 ;GET COUNT 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,OPTR(D) ;SAVE PNTR/COUNT
ADD T2,BPW(D) ;ROUND WINDOW SIZE UP TO WORDS
SUBI T2,1
IDIV T2,BPW(D) ;GET # WORDS IN WINDOW
ADD T2,WADR(D) ;POINT TO END OF WINDOW+1
MOVE T1,WADR(D) ;GET WINDOW ADDR
SETZM (T1) ;CLEAR 1ST WORD
HRLI T1,(T1) ;MAKE IT BLT PNTR
ADDI T1,1
BLT T1,-1(T2) ;CLEAR BUFFER
POPJ P, ;DONE
OUTERR: $ECALL IOE,%ABORT ;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/OPTR = POINTER TO FIRST BYTE OF RECORD
; ICNT/OCNT = BYTES IN WINDOW
; BYTN = NUMBER OF FIRST BYTE IN FOLLOWING WINDOW
FIRMPW: PUSHJ P,FRMAPW ;SETUP DESIRED BYTE NUMBER
JRST IRMPW ;GO CHECK IF EOF
FORMPW: 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
$ECALL RNR,%ABORT ;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: SKIPG T1,@A.REC ;GET RECORD NUMBER
; IOERR (IRN,25,512,?,Illegal record number $D,<T1>,%ABORT)
$ECALL IRN,%ABORT
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/OPTR = PROCESS BYTE POINTER
; ICNT/OCNT = NUMBER OF BYTES LEFT IN WINDOW
LWSIZ==9 ;A PAGE IS
PSIZ==1000 ;A PAGE IS A PAGE IS A PAGE
IMAPW: PUSHJ P,%SAVE2 ;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: PUSHJ P,%SAVE2 ;SAVE P1,P2
PUSHJ P,GETPAG ;GET PAGE, SETUP PNTR/COUNT
DMOVEM P1,OPTR(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
PUSHJ P,RDW ;NOT IN 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,
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 #
SEGMENT CODE
IF10,<
SETWRT: MOVE T2,WPAGE ;GET PAGE OFFSET
ADD T2,PFTAB(D) ;POINT TO MODIFIED PAGE TABLE
SETOM (T2) ;SET PAGE MODIFIED
POPJ P,
PAGCHK: POPJ P,
>;END IF10
IF20,<
PAGCHK: LOAD T3,ACC(D) ;GET ACCESS
CAIE T3,AC.RIN ;RANDIN?
JRST RECTPG ;NO. RANDOM. RECORD TOP PAGE
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,
SETWRT:
RECTPG: MOVE T1,WPAGE ;[3170] Get page offset in table
ADD T1,WTAB(D) ;POINT INTO TABLE
MOVE T2,(T1) ;GET FILE PAGE #
CAMLE T2,TPAGE(D) ;GREATER THAN ANY PAGE REFERENCED BEFORE?
MOVEM T2,TPAGE(D) ;YES. SAVE IT
POPJ P,
RDW: MOVE T2,WADR(D) ;GET PROCESS PAGE NUMBER
ADD T2,WPTR(D)
HRLI T2,.FHSLF ;FORK HANDLE
LOAD T1,IJFN(D) ;JFN
MOVSI T1,(T1)
HRRI T1,(P1) ;FILE PAGE NUMBER
MOVSI T3,(PM%PLD+PM%RD+PM%WR) ;ACCESS BITS
PMAP% ;MAP PAGE IN
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
CAMLE P1,TPAGE(D) ;WITHIN WRITTEN FILE?
JRST CLRPAG ;NO. CREATE ZEROS, ACT AS IF IT IS
HLLZ 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,
$ECALL IOE,%ABORT
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,SIZ(D) ;BEYOND WRITTEN WORDS?
MOVE T5,SIZ(D) ;NO
SUB T5,SIZ(D) ;GET # WORDS BEYOND THOSE WRITTEN
JUMPE T5,RDWNC ;NOTHING TO CLEAR IF WITHIN FILE
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: ADDI T5,-PSIZ ;SET NEGATIVE # WORDS TO READ
HRLI T4,(T5) ;IN IOWD
SUBI T4,1 ;ADDR-1 FOR IOWD
SETZ T5, ;ZERO TO END COMMAND LIST
MOVEI T3,T4 ;SET ADDRESS OF COMMAND LIST
HLLZ T2,CHAN(D) ;SET CHANNEL NUMBER
HRRI T2,.FOINP ;SET INPUT FUNCTION
MOVE T1,[2,,T2] ;SET ARG BLOCK POINTER
FILOP. T1, ;DO FILOP
$ECALL IOE,%ABORT
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
HLLZ 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
CAMLE T3,TPAGE(D) ;LARGER THAN TOP PAGE WRITTEN?
MOVEM T3,TPAGE(D) ;YES. RECORD IT
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
$ECALL IOE,%ABORT
MOVE T3,(T4) ;GET PAGE NUMBER AGAIN
ADDI T3,1 ;GET # BLOCKS
IMUL T3,WSIZ(D) ;GET # BYTES TO END OF THIS BLOCK
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,SIZ(D) ;BEYOND RECORDED LENGTH?
MOVEM T3,SIZ(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: HLLZ 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
$ECALL IOE,%ABORT
POPJ P, ;DONE
CLRPAG: MOVE T1,WADR(D) ;GET OFFSET
ADD T1,WTAB(D) ;POINT INTO TABLE
MOVEM P1,(T1) ;STORE NEW FILE PAGE NUMBER
MOVE T2,WADR(D) ;GET PAGE OFFSET AGAIN
ADD T2,WPTR(D) ;GET CORE PAGE NUMBER
LSH T2,LWSIZ ;CONVERT TO AN ADDRESS
SETZM (T2) ;CLEAR THE 1ST WORD
MOVSI T3,(T2)
HRRI T3,1(T2)
BLT T3,PSIZ-1(T2) ;CLEAR THE REST
POPJ P, ;RETURN AS IF IT HAD RETURNED ZEROS
;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
IF20,<
%OSMAP: PUSHJ P,%SAVE2 ;SAVE P1,P2
PUSHJ P,SMAPW ;MAP THE PAGE
PUSHJ P,SETPTR ;SETUP PNTR/COUNT
DMOVEM P1,OPTR(D) ;SAVE THE PNTR/COUNT
POPJ P,
%ISMAP: PUSHJ P,%SAVE2 ;SAVE P1,P2
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 PAGE
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?
JRST STCNT ;NO. GO STORE ACTIVE COUNT
SUB T2,EOFN(D) ;GET DIFF
SUBI P2,(T2) ;REDUCE # BYTES AVAIL
STCNT: DMOVEM P1,IPTR(D) ;SAVE PNTR/COUNT
POPJ P,
SMEOF: MOVX T1,D%END ;SET EOF
IORM T1,FLAGS(D)
POPJ P,
SMAPW: MOVE P1,BYTN(D) ;GET BYTE # IN FILE
MOVE T1,BPW(D) ;GET # BYTES/WORD
LSH T1,LWSIZ ;GET # BYTES/PAGE
IDIV P1,T1 ;GET PAGE #
MOVE T1,WPTR(D) ;GET PAGE ADDR OF BUFFER
MOVSI T2,.FHSLF ;THIS FORK
HRRI T2,(T1) ;PAGE NUMBER IN FORK
EXCH T1,P1 ;PAGE NUMBER IN FILE
LOAD T3,IJFN(D) ;JFN
HRLI T1,(T3)
LOAD T3,BUFCT(D) ;PAGE COUNT
HRLI T3,(PM%CNT+PM%PLD+PM%RD+PM%WR) ;ACCESS BITS, READ PAGES NOW
PMAP% ;MAP WINDOW INTO FILE
ERJMP PGERR ;[3247]
POPJ P,
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
SETPTR: LSH P1,LWSIZ ;MAKE IT A WORD ADDRESS
SUBI P1,1 ;POINT TO WORD ADDR-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,
> ;END IF20
IF10,<
%OBUF:
OSBUF:
%OSMAP: AOS T1,BLKN(D) ;INCR BLOCK #
IMULI T1,200 ;GET WORD # OF NEXT BLOCK
IMUL T1,BPW(D) ;AND GET BYTE #
MOVEM T1,BYTN(D) ;STORE FOR EOFN CALC
MOVE T2,CHAN(D) ;WRITE CURRENT BLOCK
HRRI T2,.FOOUT
MOVE T1,[1,,T2]
FILOP. T1,
$ECALL IOE,%ABORT ;REPORT ERROR AND DIE
POPJ P, ;DONE
ISBUF:
%ISMAP: AOS T1,BLKN(D) ;INCR BLOCK #
IMULI T1,200 ;GET WORD # OF NEXT BLOCK
IMUL T1,BPW(D) ;GET BYTE #
MOVEM T1,BYTN(D) ;SAVE FOR EOFN CALC
MOVE T2,CHAN(D) ;GET CHANNEL STUFF
HRRI T2,.FOINP ;READ NEXT BLOCK
MOVE T1,[1,,T2]
FILOP. T1,
PUSHJ P,EOFCHK
POPJ P,
EOFCHK: LOAD T2,INDX(D) ;GET DEV INDEX
CAIN T2,DI.TTY ;TERMINAL?
TRNN T1,IO.EOF ;YES. EOF?
JRST ERRCHK ;NO, NOTHING SPECIAL
MOVE T2,[1,,T3] ;SET UP FOR CLOSE
MOVEI T3,.FOCLS
HLL T3,CHAN(D)
FILOP. T2, ;CLEAR EOF BIT, LEAVE TTY OPEN
$ECALL IOE,%ABORT
ERRCHK: MOVX T0,D%END ;Get EOF flag
TRNE T1,IO.EOF ;EOF?
IORM T0,FLAGS(D) ;Yes, this file is ended
TRNE T1,IO.EOF ;EOF OFF?
TRNE T1,IO.ERR+IO.EOT ;NO, ANY REAL ERR BITS?
$ECALL IOE,%ABORT
POPJ P,
> ;IF10
SUBTTL TAPE POSITIONING
;Come here from MTOP% after the unit number has been checked.
;IO args have been set up in A.xxx
;A POPJ will return from the MTOP% call.
MTOP: SKIPL T1,@A.MTOP ;GET OPERATION CODE
CAILE T1,MOPMAX ;NEGATIVE OR TOO BIG?
$ECALL IMV,%ABORT ;ILLEGAL MTOP VALUE
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
PUSHJ P,SETD ;SET UP D
PUSHJ P,OPNDDB ;OPEN DDB IF NECESSARY
MOVE T1,FLAGS(D) ;GET FLAGS
TXNE T1,D%RAN ;RANDOM FILE?
$ECALL POI,%ABORT ;FILE POSITIONING OPERATIONS ILLEGAL
MOVE T1,@A.MTOP ;Get back MTOP number
PUSHJ P,@MOPDSP(T1) ;GO DO OPERATION
PJRST %SETAV ;RETURN (possibly doing ERR=, etc.)
MOPNAM: [ASCIZ /REWIND/] ;(0)
[ASCIZ /UNLOAD/] ;(1)
[ASCIZ /BACKSPACE/] ;(2)
[ASCIZ /BACK FILE/] ;(3)
[ASCIZ /ENDFILE/] ;(4)
[ASCIZ /SKIP RECORD/] ;(5)
[0] ;(6)
[ASCIZ /SKIP FILE/] ;(7)
MOPMAX==.-MOPNAM
MOPDSP: IFIW MOPREW
IFIW MOPUNL
IFIW MOPBSR
IFIW MOPBSF
IFIW MOPEND
IFIW MOPSKR
IFIW %POPJ
IFIW MOPSKF
IF20,<
;REWIND
MOPREW:
MOVE T0,FLAGS(D)
TXNE T0,D%END ;EOF?
PUSHJ P,BAKEOF ;YES. CLEAR IT
SETZM CREC(D) ;CLEAR RECORD NUMBER
MOVX T0,D%END ;File is now not at end
ANDCAM T0,FLAGS(D)
LOAD T1,INDX(D) ;GET DEV INDEX
CAIN T1,DI.DSK ;DISK?
JRST DSKREW ;CAN DO
CAIN T1,DI.MTA ;TAPE?
JRST MTAREW ;CAN DO
POPJ P, ;ELSE NOP
DSKREW: MOVE T0,FLAGS(D) ;Get DDB flags for this file
TXNE T0,D%OUT ;WAS IT OPEN FOR OUTPUT?
PUSHJ P,%SETIN ;Yes. Switch to input
SETZM IPTR(D) ;PRETEND NO I/O DONE
SETZM ICNT(D) ;NO BYTES IN BUFFER
SETZM BYTN(D) ;SET CURRENT BYTE NUMBER TO 0
POPJ P, ;DONE
MTAREW: MOVE T1,FLAGS(D) ;Get DDB flags
TXNN T1,D%IN+D%OUT ;If not open,
JRST JSTREW ;Don't call %SETIN
PUSHJ P,%SETIN ;Get file opened for INPUT
SETZM IPTR(D) ;PRETEND NO I/O DONE
SETZM ICNT(D) ;NO BYTES IN BUFFER
MOVEI T2,.MOREW ;SET TO REWIND TAPE
JRST DOMTOP ;GO DO MTOPR
JSTREW: PUSHJ P,MTAOJF ;Open JFN, aborts if fails
MOVEI T2,.MOREW ;Get function
PUSHJ P,DOMTP1 ;Do it
PJRST MTACJF ;Close file, release JFN, return.
;Routine to create a JFN to be used for magtape operations
;Returns .+1 if ok, JFN in "RWJFN"
;The JFN is opened for input.
;If fails, goes to %ABORT.
MTAOJF: MOVE T1,[POINT 7,TMDEV] ;Get device name with ":"
MOVEI T2,DEV(D) ;From the DDB
HRLI T2,(POINT 7,)
MTAOJ1: ILDB T3,T2 ;Get a byte
JUMPE T3,MTAOJ2 ;Null, done
IDPB T3,T1 ;Store
JRST MTAOJ1 ;Loop until null found
MTAOJ2: MOVEI T3,":" ;Append a colon
IDPB T3,T1 ;Now have DEV: in "TMDEV"
;Do our own GTJFN.
MOVX T1,GJ%SHT
HRROI T2,TMDEV
GTJFN%
ERJMP E.SNH ;?Dev must exist: OPENX was done!
HRRZM T1,RWJFN ;Save JFN
;Have to OPENF the file to do a TAPOP.
MOVX T2,OF%RD ;Read ACCESS, nothing else.
OPENF% ;Get READ access to file
ERJMP MTARWO ;?OPENF failed, give error
POPJ P, ;OK, return
;Here if OPENF failed
MTARWO: MOVE T1,RWJFN ;Release JFN
RLJFN%
ERJMP .+1 ;?Too bad
$ECALL OPE,%ABORT ;Give JSYS error and abort program
SEGMENT DATA
TMDEV: BLOCK 20 ;Device name with ":"
RWJFN: BLOCK 1 ;Temp JFN used for REWIND, UNLOAD
SEGMENT CODE
;Routine to close and release JFN gotten by MTAOJF
MTACJF: MOVE T1,RWJFN ;Get saved JFN
CLOSF%
$ECALL IJE,%ABORT ;?CLOSF failed, abort program
POPJ P, ;All worked, return
;BACKSPACE
MOPBSR: SKIPE FUMXD(D) ;MIXED-MODE FILE?
$ECALL CDF,%ABORT ;YES. CAN'T DETERMINE FORM=
PUSHJ P,%SETIN ;Switch to input if necessary
SKIPG CREC(D) ;ARE WE AT BEG OF FILE?
POPJ P, ;YES. CAN'T GO BACKWARDS
SOS CREC(D) ;NO. DECR RECORD COUNT
MOVE T0,FLAGS(D)
TXNE T0,D%END ;FILE AT END?
JRST BAKEOF ;YES. JUST BACK OVER IT
SKIPN IPTR(D) ;ANY I/O DONE YET?
POPJ P, ;NO. CAN'T BACKSPACE
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,SUBP1X ;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,
SUBP1X: LOAD T1,INDX(D) ;GET DEV INDEX
CAIN T1,DI.MTA ;TAPE?
JRST MTABSA ;YES
MOVE P1,IPTR(D) ;GET CURRENT PNTR
SUBI P1,1 ;BACK UP 1 WORD
PUSHJ P,%PTOF ;GET BYTE NUMBER OF THAT BYTE
JUMPLE P1,%POPJ ;SHOULD NEVER BE NEGATIVE IN FILE
MOVEM P1,BYTN(D) ;STORE FOR MAPPING
PUSHJ P,%ISMAP ;MAP IT BACK AGAIN
AOS IPTR(D) ;INCR THE POINTER
MOVN T1,BPW(D) ;AND DECR THE COUNT
ADDM T1,ICNT(D)
POPJ P,
MTABSA: MOVEI T2,.MOBKR ;BACKSPACE RECORD
PUSHJ P,DOMTOP ;BACK UP TO BEGINNING OF THIS RECORD
PJRST BAKMTA ;BACK 1 MORE, READ IT
UNFBSR: LOAD T0,MODE(D) ;GET DATA MODE
CAIE T0,MD.IMG ;BINARY?
JRST BINBSR ;YES. GO THERE
;IMAGE MODE. GET RECORDSIZE IN BYTES, GO TO COMMON CODE
SKIPN P3,URSIZB(D) ;RECORDSIZE SPECIFIED?
$ECALL CBI,%ABORT ;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,SUBP1X ;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 T3,IPTR(D) ;GET CURRENT ADDR
SUB T3,WADR(D) ;GET OFFSET FROM BEG
ADDI T3,1 ;ADD THE CURRENT WORD
IMUL T3,BPW(D) ;GET BYTE OFFSET
HLLZ T1,IPTR(D) ;GET POINTER PART
MUL T1,BPW(D) ;GET # BYTES LEFT IN CURRENT WORD
SUBI T3,(T1) ;CALC REAL BYTE OFFSET
CAIGE T3,(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
CAIE T1,DI.DSK ;DISK?
JRST COMMTA ;NO. MAGTAPE
MOVE P1,IPTR(D) ;GET CURRENT POINTER AGAIN
PUSHJ P,%PTOF ;CALC FILE POINTER
SUBI P1,(P3) ;CALC DESIRED FILE POINTER
MOVEM P1,BYTN(D) ;SAVE FOR MAPPING
PJRST %ISMAP ;MAP IT
COMMTA: SUBI P3,(T3) ;REDUCE # BYTES TO BACKSPACE
MOVEI T2,.MOBKR ;BACKSPACE TO BEG OF THIS BLOCK
PUSHJ P,DOMTOP
PUSHJ P,BAKMTA ;BACKSPACE TO PREV BLOCK, READ IT
CAIGE T3,(P3) ;BACKSPACE WITHIN THIS BLOCK?
JRST COMMTA ;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,
BAKMTA: MOVEI T2,.MOBKR
PUSHJ P,DOMTOP ;BACK UP TO BEGINNING OF PREV RECORD
SKIPE B36FLG(D) ;OPENED IN 36-BIT MODE?
JRST BACKU ;YES. USE A DIFFERENT PNTR FOR SINR
LOAD T1,IJFN(D) ;READ THE RECORD
MOVE T2,WADR(D) ;POINT TO BUFFER
SUBI T2,1 ;POINT TO LAST BYTE IN PREV WORD
HXL T2,BYTPT(D)
MOVN T3,WSIZ(D) ;GET LENGTH OF WINDOW
SINR% ;READ BLOCK
ERCAL EOFCHK ;ERROR, GO TYPE MESSAGE
ADD T3,WSIZ(D) ;RETURN # BYTES IN T3
MOVEM T2,IPTR(D) ;SAVE PNTR TO LAST BYTE
SETZM ICNT(D) ;WITH COUNT=0
POPJ P,
BACKU: LOAD T1,IJFN(D) ;READ THE RECORD
MOVE T2,WADR(D) ;POINT TO BUFFER
HRLI T2,(POINT 36) ;GET BINARY BYTE POINTER
MOVN T3,WSIZ(D)
IDIV T3,BPW(D) ;GET # WORDS
SINR%
ERCAL EOFCHK ;ERROR, GO TYPE MESSAGE
IMULI T3,(T4) ;GET NEG # BYTES LEFT IN BUFFER
ADD T3,WSIZ(D) ;RETURN # BYTES IN BUFFER IN T3
HXL T2,BYTPT(D) ;WORD-ALIGN BYTE PNTR
MOVEM T2,IPTR(D) ;SAVE IT
SETZM ICNT(D) ;CLEAR COUNT
POPJ P,
BAKEOF: MOVX T0,D%END ;Clear EOF bit
ANDCAM T0,FLAGS(D)
SETZM ICNT(D) ;CLEAR BYTE COUNT
LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIE T1,DI.MTA ;MAGTAPE?
POPJ P, ;NO
PUSHJ P,%CLSOP ;CLOSE, OPEN FILE
MOVEI T2,.MOBKR ;BACK OVER THE EOF MARK
PUSHJ P,DOMTOP
SKIPG CREC(D) ;ANY RECORDS BEHIND IT?
POPJ P, ;NO. NULL FILE
JRST BAKMTA ;YES. BACKSPACE, READ PREVIOUS BLOCK
;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:: JUMPE P1,%POPJ ;ADDRESS=0 MEANS FILE PAGE 0
MOVEI T1,(P1) ;GET ADDR ONLY
SUB T1,WADR(D) ;GET WORD OFFSET WITHIN WINDOW
IMUL T1,BPW(D) ;GET OFFSET IN BYTES
HLLZ T2,P1 ;GET THE LEFT HALF OF THE BP
MUL T2,BPW(D) ;GET # BYTES LEFT
ADD T1,BPW(D) ;ADD THE CURRENT WORD
SUBI T1,(T2) ;MINUS # CHARS LEFT
ADD T1,BYTN(D) ;ADD FILE OFFSET OF NEXT WINDOW
SUB T1,WSIZ(D) ;CALC FILE OFFSET
MOVE P1,T1 ;RETURN IN P1
POPJ P,
;UNLOAD
MOPUNL: LOAD T1,INDX(D) ;GET DEV INDEX
CAIE T1,DI.MTA ;TAPE?
JRST MOPREW ;NO, UNLOAD IS REWIND
SETZM CREC(D) ;CLEAR RECORD COUNT
MOVX T0,D%END ;File is now not at end
ANDCAM T0,FLAGS(D)
MOVE T1,FLAGS(D) ;Get DDB flags
TXNN T1,D%IN+D%OUT ;If not opened yet,
JRST JSTUNL ;Don't call "SETIN"
PUSHJ P,%SETIN ;Get file opened for input.
MOVEI T2,.MORUL ;SET FOR UNLOAD OPR
JRST DOMTOP ;GO DO IT
JSTUNL: PUSHJ P,MTAOJF ;Get a JFN with no filename
MOVEI T2,.MORUL ;UNLOAD it
PUSHJ P,DOMTP1
PJRST MTACJF ;Close, release JFN and return
;TOPS-20 BACKFILE
MOPBSF: LOAD T1,INDX(D) ;GET DEV INDEX
CAIE T1,DI.MTA ;TAPE?
POPJ P, ;NO, BACKFILE IS NOP
PUSHJ P,%SETIN ;Make sure we're open for input
PUSHJ P,ENDOUT ;SETUP PROPERLY
SETZM CREC(D) ;CLEAR RECORD COUNT
MOVX T0,D%END ;File is now not at end
ANDCAM T0,FLAGS(D)
MOVEI T2,.MOBKF ;SET FOR BACKSPACE FILE
PUSHJ P,DOMTOP ;GO DO IT
MOVEI T2,.MOBKF ;AND A 2ND TIME
PUSHJ P,DOMTOP
LOAD T1,IJFN(D) ;GET JFN
GDSTS% ;GET STATUS
TXNN T2,MT%BOT ;UNLESS BEG TAPE
PUSHJ P,FORWF
PJRST %CLSOP ;MAKE SURE NO STUPID EOF STATUS
;END FILE
MOPEND: AOS CREC(D) ;INCR REC #
LOAD T1,INDX(D) ;GET DEV INDEX
CAIN T1,DI.DSK ;DISK?
JRST DSKEND ;YES
CAIE T1,DI.MTA ;TAPE?
POPJ P, ;NO. ENDFILE IS A NOP
PUSHJ P,%SETOUT ;Set to output
PUSHJ P,%LSTBF ;OUTPUT LAST BUFFER, IF ANY
PUSHJ P,%CLSOP ;CLOSE FILE, OPEN FOR INPUT AGAIN
ENDOUT: SETZM IPTR(D) ;CLEAR THE PNTR/COUNT
SETZM ICNT(D)
MOVE T1,FLAGS(D)
TXO T1,D%IN+D%END ;WE ARE OPEN FOR INPUT, AT EOF
TXZ T1,D%OUT ;NO LONGER DOING OUTPUT
MOVEM T1,FLAGS(D)
POPJ P,
DSKEND: PUSHJ P,%SETOUT ;SET TO OUTPUT
PUSHJ P,%SETIN ;AND THEN TO INPUT AGAIN
MOVX T1,D%END+D%MOD ;AT EOF
IORM T1,FLAGS(D)
POPJ P, ;DONE
;TOPS-20 SKIP RECORD
MOPSKR: SKIPE FUMXD(D) ;MIXED-MODE FILE?
$ECALL CDF,%ABORT ;YES. CAN'T DETERMINE FORM=
PUSHJ P,%SETIN ;Switch to input
LOAD T0,FORM(D) ;GET FORM=
CAIE T0,FM.FORM ;FORMATTED?
JRST UNFSKP ;NO. UNFORMATTED SKIP
PJRST %IREC ;YES. JUST READ A RECORD
;SKIP FILE
MOPSKF: LOAD T1,INDX(D) ;GET DEV INDEX
CAIE T1,DI.MTA ;TAPE?
POPJ P, ;NO, SKIP IS NOP
MOVE T0,FLAGS(D) ;GET FLAGS
TXNN T0,D%IN+D%OUT ;FILE OPEN?
JRST JSTSKF ;NO. JUST SKIP A FILE
PUSHJ P,%SETIN ;Make sure file is open for input
PUSHJ P,ENDOUT ;SETUP PROPERLY
SETZM CREC(D) ;CLEAR RECORD COUNT
MOVX T0,D%END ;Clear EOF bit
ANDCAM T0,FLAGS(D)
MOVEI T2,.MOFWF ;SET FOR SKIP FILE
PUSHJ P,DOMTOP ;BUT IF WE WERE, DON'T GO ANYWHERE
PJRST %CLSOP ;MAKE SURE NO STUPID EOF BIT LEFT ON
JSTSKF: PUSHJ P,MTAOJF ;GET A JFN, OPEN MTA
MOVEI T2,.MOFWF ;DO A SKIP FILE MTOPR
PUSHJ P,DOMTP1
PJRST MTACJF ;GO CLOSE FILE, RELEASE JFN, LEAVE
FORWF: MOVEI T2,.MOFWF ;SKIP FILE
;DOMTOP - Routine to do the MTOP specified in T2. (does appropriate
; WAIT's etc.)
DOMTOP: LOAD T1,IJFN(D) ;GET JFN
;Enter at DOMTP1 if you want to use the JFN in T1.
DOMTP1: PUSH P,T2 ;SAVE THE OPERATION TO DO
MOVEI T2,.MONOP ;DO A WAIT
MTOPR%
ERJMP MTOPER
POP P,T2 ;GET THE OPERATION
MTOPR% ;DO OPERATION
ERJMP MTOPER
MOVEI T2,.MONOP ;AND DO A WAIT
MTOPR%
ERJMP MTOPER
POPJ P, ;DONE
MTOPER: ;IOERR (ILM,23,,?,$J,,%POPJ)
$ECALL ILM,%ABORT
> ;IF20
IF10,<
MOPREW: SETZM CREC(D) ;CLEAR RECORD COUNT
SETZM BLKN(D) ;AND BLOCK #
MOVX T0,D%END ;Clear EOF bit
ANDCAM T0,FLAGS(D)
LOAD T1,DVTYP(D) ;GET DEVICE INDEX
CAIN T1,.TYDTA ;DECTAPE?
JRST DTAREW ;YES
CAIN T1,.TYDSK ;DISK?
JRST DSKREW ;Yes
CAIN T1,.TYMTA ;Magtape?
JRST MTAREW ;Yes
POPJ P, ;OTHERWISE IT'S A NOP
.FOMTP==30
DTAREW: MOVE T1,FLAGS(D) ;Get DDB flags
TXNN T1,D%IN+D%OUT ;Is the DECTAPE open?
JRST RWDEVO ;Yes, don't use filename
PUSHJ P,%SETIN ;OPEN for input.
SETZM BLKN(D) ;CLEAR BLOCK NUMBER
MOVE T2,CHAN(D) ;LH= chan #
HRRI T2,.FOMTP ;MTAPE FILOP
MOVX T3,MTREW. ;REWIND
MOVE T1,[2,,T2]
FILOP. T1,
$ECALL IOE,%ABORT
POPJ P,
DSKREW: MOVE T1,FLAGS(D) ;Is file really OPEN?
TXNE T1,D%IN+D%OUT
PUSHJ P,CLSOPN ;Yes, CLOSE the file, open for input
POPJ P, ;Return
MTAREW: MOVE T1,FLAGS(D) ;Get flags
TXNN T1,D%IN+D%OUT ;Is file really OPEN
JRST RWDEVO ;No
PUSHJ P,CLSOPN ;CLOSE THE FILE, OPEN FOR INPUT
MOVEI T2,.TFREW ;Go do REWIND
PJRST DOMTOP
;Here to REWIND a non-directory device that is not opened yet.
; Can't use FILOP.'s because you need a filename for them.
RWDEVO: PUSHJ P,OPDEVO ;Open the device only
MOVE T1,ASCHN ;Get channel #
LSH T1,^D23 ;Shift to ac field
IOR T1,[MTREW.] ;Make instruction
XCT T1 ;** REWIND the device **
PJRST CLDEVO ;Close device and return
;Routine to OPEN the device only, (on a low channel).
; FILOP. is not done, because no file can be specified.
;The assigned channel is stored in ASCHN.
;Returns .+1 or takes ERR= or goes to %ABORT (if errors)
OPDEVO: SETZ T1, ;Get a free channel
PUSHJ P,%ALCHF ;Get a channel
$ECALL NFC,%ABORT ;?Too many OPEN units
MOVEM T1,ASCHN ;Save it
LSH T1,^D23 ;Shift into AC position
IOR T1,[OPEN T2] ;Get instruction to XCT
MOVEI T2,.IODMP ;Set dump mode
SETZ T4, ;No buffers
MOVE T3,DEV(D) ;Get device
XCT T1 ;** OPEN the device **
JRST OPDVFL ;?Failed
POPJ P, ;OK, return
;The OPEN UUO failed. Either "No such device"
;or "Assigned to another job".
OPDVFL: MOVE T1,DEV(D) ;See if this device exists
DEVTYP T1,
JRST OPDVNS ;?no such device
JUMPE T1,OPDVNS ;Or if 0 returned.
SKIPA T1,[ERDAJ%] ;"Device allocated to another job"
OPDVNS: MOVEI T1,ERNSD% ;"No such device"
$ECALL OPN,%ABORT ;Give error, abort if no ERR=
SEGMENT DATA
ASCHN: BLOCK 1 ;Assigned channel for non-FILOP. I/O
SEGMENT CODE
;Routine to CLOSE the device OPEN'ed by OPDEVO.
;Returns .+1 always
CLDEVO: MOVE T1,ASCHN ;Get assigned channel #
LSH T1,^D23 ;Shift into ac position
IOR T1,[RELEAS 0] ;Get a RELEASE instruction
XCT T1 ;Do it
MOVE T1,ASCHN ;Get channel #
PUSHJ P,%DECHF ;Deallocate it
$SNH ;?Not assigned, "can't happen"
POPJ P, ;Ok, return
;Still IF10
MOPBSR: SKIPE FUMXD(D) ;MIXED-MODE FILE?
$ECALL CDF,%ABORT ;YES. CAN'T DETERMINE FORM=
PUSHJ P,%SETIN ;Get file open for input
LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIE T1,DI.DSK ;DISK?
CAIN T1,DI.MTA ;OR MAGTAPE?
JRST BSROK ;YES
POPJ P, ;NO. BSR IS NOP
BSROK: SKIPG BLKN(D) ;HAVE WE READ ANYTHING?
POPJ P, ;NO. BACKSPACE IS A NOP
SKIPG CREC(D) ;BEG OF FILE?
POPJ P, ;YES. CAN'T GO BACKWARDS
SOS CREC(D) ;NO. DECR RECORD COUNT
MOVE T0,FLAGS(D)
TXNE T0,D%END ;ARE WE AT EOF?
JRST BAKEOF ;YES. BACK UP AND GET PREV BLK
LOAD T1,MODE(D) ;GET FILE MODE
CAIN T1,MD.DMP ;DUMP MODE?
JRST BSRDMP ;YES. VERY SPECIAL
CAIN T1,MD.BIN ;IS IT BINARY?
JRST BSRBIN ;YES
CAIE T1,MD.ASC ;IS IT ASCII?
CAIN T1,MD.ASL
JRST BSRASC ;YES. GO LOOK BACKWARDS FOR LF
SKIPE URSIZW(D) ;NO. FIXED-LENGTH RECORDS?
JRST IMGFIX ;YES
$ECALL CBI,%ABORT ;NO. ERROR
BSRASC: SKIPE FRSIZB(D) ;FIXED-LENGTH RECORDS?
JRST ASCFIX ;YES. EASY TREATMENT
PUSHJ P,BACKUP ;BACK UP TO LF
HRRZ T4,IBCB(D) ;GET BUFFER ADDR
HRRZ T1,IPTR(D) ;GET ADDR OF PNTR
CAIGE T1,2(T4) ;AT BEG OF BUFFER?
POPJ P,
BACK1: MOVNI T1,1 ;DECR POINTER
ADJBP T1,IPTR(D)
MOVEM T1,IPTR(D) ;SAVE UPDATED POINTER
AOS ICNT(D) ;INCR COUNT
BACKUP: HRRZ T4,IBCB(D) ;GET BUFFER ADDR
HRRZ T1,IPTR(D) ;GET ADDR OF PNTR
CAIL T1,2(T4) ;AT BEG OF BUFFER?
JRST BACKOK ;NO
PUSHJ P,PRVBUF ;YES. GET ANOTHER
POPJ P, ;BEG OF FILE
HRRZ T4,IBCB(D) ;GET BUFFER ADDRESS
HRRZ T1,IPTR(D) ;CHECK IF STILL AT BEG OF BUFFER
CAIGE T1,2(T4) ;IS IT?
POPJ P, ;YES. AT BEG OF FILE
BACKOK: LDB T1,IPTR(D) ;GET CHAR
CAIG T1,14 ;EOL CHAR?
CAIGE T1,12
JRST BACK1 ;NO
POPJ P, ;YES. WE'RE DONE
%BAKEF:
BAKEOF: SOS BLKN(D) ;DECR BLOCK FOR THE EOF
%ISET: PUSHJ P,CLSOPN ;CLEAR THE EOF STATUS
LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIN T1,DI.DSK ;DISK?
JRST DSKEOF ;YES. GO DO USETI
CAIE T1,DI.MTA ;MAGTAPE?
POPJ P, ;NO. CAN'T DO ANYTHING ELSE
MOVEI T2,.TFBSB ;YES. BACKSPACE A FILEMARK
PUSHJ P,DOMTOP
LOAD T1,MODE(D) ;GET DATA MODE
CAIE T1,MD.DMP ;DUMP?
SKIPG BLKN(D) ;NO. ANY DATA?
POPJ P, ;LEAVE IF NO DATA OR DUMP MODE
MOVEI T2,.TFBSB ;BACK OVER THE RECORD WE WANT
PUSHJ P,DOMTOP
JRST COMEOF ;JOIN COMMON CODE
DSKEOF: MOVE T2,FBLK(D) ;GET CHANNEL STUFF
HRRI T2,.FOUSI ;DO USETI
SKIPG T3,BLKN(D) ;TO CURRENT BLOCK
POPJ P, ;LEAVE IF NULL FILE
MOVE T1,[2,,T2]
FILOP. T1,
$ECALL IOE,%ABORT
LOAD T1,MODE(D) ;GET DATA MODE
CAIN T1,MD.DMP ;DUMP?
POPJ P, ;YES. DON'T READ ANYTHING
COMEOF: MOVE T2,FBLK(D) ;GET CHANNEL STUFF
HRRI T2,.FOINP ;READ THE BLOCK
MOVE T1,[1,,T2]
FILOP. T1,
$ECALL IOE,%ABORT ;Should not fail with "EOF"
DMOVE T1,IPTR(D) ;GET PNTR/COUNT
HXL T1,BYTPT(D) ;GET PROPER BP (MON RETURNS 000700)
ADJBP T2,T1 ;POINT TO END OF DATA
MOVEM T2,IPTR(D) ;SAVE UPDATED BYTE POINTER
MOVE T1,ICNT(D) ;GET COUNT
SETZM ICNT(D) ;CLEAR COUNT
POPJ P,
BSRDMP: SKIPN T1,BLKN(D) ;GET BLOCK #
POPJ P, ;HAVEN'T DONE ANY INPUT YET
SOS BLKN(D) ;DECR THE BLOCK #
LOAD T2,INDX(D) ;GET DEVICE INDEX
CAIE T2,DI.DSK ;DISK?
JRST %BACKB ;NO. BACKSPACE AN MTA BLOCK
PJRST USET ;SET NEXT BLOCK TO CURRENT ONE
;HERE IF BINARY RECORD
BSRBIN: HRRZ T2,IBCB(D) ;GET BUFFER HEADER ADDR
HRRZ T1,IPTR(D) ;GET JUST ADDR IN PNTR
CAIGE T1,2(T2) ;BEFORE BUFFER?
JRST BBACK ;YES. MUST GET PREV BUFFER
MOVE P3,(T1) ;GET THE TYPE 3 LSCW
TLZ P3,777000 ;GET THE WORD COUNT OF LAST REC
IMUL P3,BPW(D) ;GET THE BYTE COUNT
JRST BCOM ;JOIN COMMON CODE
BBACK: PUSHJ P,PRVBUF ;GET THE PREVIOUS BUFFER
POPJ P, ;NON-SKIP MEANS BEGINNING OF FILE
HRRZ P3,IPTR(D) ;GET CURRENT ADDRESS
MOVE P3,(P3) ;GET TYPE 3 LSCW
TLZ P3,777000 ;GET WORD COUNT OF RECORD
IMUL P3,BPW(D) ;GET THE BYTE COUNT
JRST BCOM ;JOIN COMMON CODE
;HERE FOR ASCII OR IMAGE FIXED-LENGTH RECORDS
ASCFIX: MOVE P3,FRSIZB(D) ;GET RECORDSIZE IN BYTES
JRST BCOM ;JOIN COMMON CODE
IMGFIX: SKIPN P3,URSIZB(D) ;GET RECORDSIZE IN BYTES
$ECALL CBI,%ABORT ;CAN'T BACKSPACE IF NO RECSIZ
BCOM: HRRZ T2,IBCB(D) ;GET BUFFER HEADER ADDR
HRRZ T1,IPTR(D) ;GET CURRENT PNTR ADDR
SUBI T1,1(T2) ;GET OFFSET FROM 1 BEFORE BEG BUFFER
IMUL T1,BPW(D) ;GET BYTE OFFSET
HLLZ T2,IPTR(D) ;GET POINTER PART OF BP
MUL T2,BPW(D) ;GET # BYTES LEFT INTO T2
SUBI T1,(T2) ;CALC BYTE OFFSET FROM BEG BUFFER
JRST BPRVT ;GO TEST IF WITHIN BUFFER
BPREV: SUBI P3,(T1) ;UPDATE # BYTES TO BACKSPACE
PUSHJ P,PRVBUF ;GET PREV BUFFER
JRST BBEG ;AT BEG OF FILE
BPRVT: CAIGE T1,(P3) ;BACKSPACE WITHIN THIS BUFFER?
JRST BPREV ;NO. GO BACK SOME MORE
ADDM P3,ICNT(D) ;YES. UPDATE BYTE COUNT
MOVNI P3,(P3) ;GET NEGATIVE BYTE OFFSET
ADJBP P3,IPTR(D) ;UPDATE PNTR
MOVEM P3,IPTR(D) ;SAVE UPDATED PNTR
POPJ P,
BBEG: MOVE T1,IBCB(D) ;BEG FILE. GET ADDR OF BUFFER
MOVE T2,1(T1) ;GET # WORDS IN BUFFER
IMUL T2,BPW(D) ;GET # BYTES
MOVEM T2,ICNT(D) ;SAVE IT
ADDI T1,1 ;POINT TO BEG BUFFER-1
HXL T1,BYTPT(D) ;POINT TO BEG BUFFER
MOVEM T1,IPTR(D)
POPJ P,
;
;HERE WE MUST DIVERT THE POINTER TO THE PREVIOUS BLOCK
;AND RESET THE CHAR COUNT
PRVBUF: MOVE T1,BLKN(D) ;GET CURRENT BLOCK #
SOJLE T1,%POPJ ;CAN'T GO BACKWARDS
MOVEM T1,BLKN(D) ;SAVE IT BACK
PUSHJ P,REDBLK ;READ THE BLOCK
AOS (P) ;SKIP RETURN
POPJ P,
REDBLK: LOAD T2,INDX(D) ;GET DEVICE INDEX
CAIE T2,DI.MTA ;MAGTAPE?
JRST DSKRED ;NO. DISK
PUSHJ P,CLRBCB ;COUNT ACTIVES
PUSH P,P4 ;Get a spare perm ac
MOVEI P4,1(T1) ;Must back over current one too
MTABLP: MOVEI T2,.TFBSB ;SETUP FOR BACKSPACE
PUSHJ P,DOMTOP ;DO IT
SOJG P4,MTABLP ;BACKSPACE FOR ALL ACTIVES
POP P,P4 ;Restore P4
JRST GOREAD ;GO READ THE BLOCK
DSKRED: PUSHJ P,USET ;POINT TO PREVIOUS BLOCK
PUSHJ P,CLRBCB ;CLEAR THE USE BITS
GOREAD: MOVSI T1,(BF.VBR) ;TURN ON VIRGIN BUFFER RING
IORM T1,IBCB(D) ;IN THE BUFFER HEADER
MOVE T2,CHAN(D) ;GET CHANNEL
HRRI T2,.FOINP ;SETUP FOR INPUT
HRRZ T3,IBCB(D) ;POINT TO CURRENT BUFFER
MOVE T1,[2,,T2] ;2-WORD FILOP
FILOP. T1,
$ECALL IOE,%ABORT ;Should not fail with EOF
DMOVE T1,IPTR(D) ;GET PNTR/COUNT
HXL T1,BYTPT(D) ;GET PROPER BP (MON RETURNS 000700)
ADJBP T2,T1 ;POINT TO END OF DATA
MOVEM T2,IPTR(D) ;SAVE UPDATED BYTE POINTER
MOVE T1,ICNT(D) ;RETURN FULL COUNT IN T1
SETZM ICNT(D) ;AND CLEAR COUNT
POPJ P,
USET: MOVE T2,FBLK(D) ;GET FILOP WORD 0
HRRI T2,.FOUSI ;GET USETI CODE
MOVEI T3,(T1) ;GET THE BLOCK #
MOVE T1,[2,,T2] ;DO THE USETI
FILOP. T1,
$ECALL IOE,%ABORT
POPJ P,
;Routine to clear the "use" bits of all active buffers, and
; return how many there were in T1.
%CLRBC:
CLRBCB: SETZM ICNT(D) ;CLEAR BUFFER CONTROL BLOCK
HRLOI T1,7700 ;EXCEPT BYTE SIZE IN PNTR
ANDM T1,IPTR(D)
MOVE T2,CHAN(D) ;GET CHANNEL
HRRI T2,.FOWAT ;SETUP FOR WAIT
MOVE T1,[1,,T2] ;DO FILOP
FILOP. T1,
$ECALL IOE,%ABORT
SETZ T1, ;CLEAR ACTIVE BUFFER COUNT
HRRZ T3,IBCB(D) ;GET PNTR TO BUFFER
MOVEI T2,(T3) ;COPY IT
FNDUSE: MOVE T4,-1(T3) ;GET STATUS WORD
TLNE T4,40 ;TAPE EOF?
AOJA T1,USEDON ;YES. WE'RE DONE
MOVE T4,(T3) ;GET THE USE WORD
TLZE T4,(1B0) ;TURN OFF. WAS IT ON?
ADDI T1,1 ;YES. ADD TO ACTIVE COUNTER
MOVEM T4,(T3) ;PUT IT BACK
HRRZ T3,(T3) ;GET WHAT IT POINTS TO
CAIN T2,(T3) ;POINTING TO CURRENT BUFFER?
POPJ P, ;YES. WE'VE DONE IT
JRST FNDUSE ;AND TRY AGAIN
USEDON: HRLOI T4,377777 ;TURN OFF USE BIT JUST IN CASE
ANDM T4,(T3)
POPJ P,
;UNLOAD
MOPUNL: SETZM CREC(D) ;CLEAR RECORD COUNT
SETZM BLKN(D) ;CLEAR BLOCK #
MOVX T0,D%END ;File is now not at end
ANDCAM T0,FLAGS(D)
LOAD T1,DVTYP(D) ;GET DEVICE TYPE
CAIN T1,.TYDTA ;DECTAPE?
JRST DTAUNL ;YES
CAIN T1,.TYDSK ;DISK
JRST DSKUNL
CAIN T1,.TYMTA ;Or magtape
JRST MTAUNL
POPJ P, ;OTHERWISE IT'S A NOP
DSKUNL: SKIPN FBLK(D) ;IS FILE REALLY OPEN?
POPJ P, ;No, no-op.
PJRST CLSOPN ;Close file, leave OPEN for input.
MTAUNL: SKIPN FBLK(D) ;Is file really OPEN?
JRST ULDEVO ;No, just UNLOAD.
PUSHJ P,CLSOPN ;Close file, leav OPEN for input.
MOVEI T2,.TFUNL ;Setup for UNLOAD
JRST DOMTOP ;Go do it
DTAUNL: MOVE T1,FLAGS(D) ;Get DDB flags
TXNN T1,D%IN+D%OUT ;Is the DECTAPE open?
JRST ULDEVO ;Yes, don't use filename
PUSHJ P,%SETIN ;Open the dectape
MOVE T2,CHAN(D) ;LH= chann #
HRRI T2,.FOMTP ;MTAPE FILOP
MOVX T3,MTUNL. ;UNLOAD
MOVE T1,[2,,T2]
FILOP. T1,
$ECALL IOE,%ABORT
POPJ P,
;Here to UNLOAD a DECtape or magtape that is not opened yet.
; Can't use FILOP.'s because you need a filename for them.
ULDEVO: PUSHJ P,OPDEVO ;Open the device only
MOVE T1,ASCHN ;Get channel #
LSH T1,^D23 ;Shift to ac field
IOR T1,[MTUNL.] ;Make instruction
XCT T1 ;** UNLOAD the device **
PJRST CLDEVO ;Close device and return
;TOPS-10 BACKFILE
MOPBSF: LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIE T1,DI.MTA ;MAGTAPE?
POPJ P, ;OTHERWISE IT'S A NOP
SETZM CREC(D) ;CLEAR RECORD COUNT
SETZM BLKN(D) ;CLEAR BLOCK #
MOVE T0,FLAGS(D)
TXNE T0,D%END+D%OUT ;EOF OR DOING OUTPUT?
PUSHJ P,CLREOF ;YES. CLOSE/OPEN THE FILE
MOVE T0,FLAGS(D)
TXNE T0,D%IN+D%OUT ;Is file not open?
PJRST DOBKFU ;OPEN already, just do the UUO's and return.
;The MTA is not open.
PUSHJ P,OPDEVO ;OPEN the device
PUSHJ P,DOBKFU ;Do the BACKFILE UUO's.
PJRST CLDEVO ;Close device and return.
;Subroutine to do the UUO's necessary for BACKFILE.
;The device is OPEN.
DOBKFU: PUSHJ P,BACKF ;NOW BACKSPACE OVER 2 EOF MARKS
PUSHJ P,BACKF
MOVEI T2,.TFSTS ;GET STATUS OF TAPE UNIT
PUSHJ P,DOMTOP
TXNE T1,TF.BOT ;BEG TAPE?
POPJ P, ;YES. JUST LEAVE
MOVEI T2,.TFFSF ;NO. MUST FORWARD AGAIN
PJRST DOMTOP
;TOPS-10 ENDFILE
MOPEND: AOS CREC(D) ;INCR REC #
PUSHJ P,%SETOUT ;Get file opened for output
LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIE T1,DI.DSK ;DISK
CAIN T1,DI.MTA ;OR MTA
JRST .+2 ;YES
POPJ P, ;NO. END FILE IS NOP
PUSHJ P,CLSOPN ;CLOSE, THEN OPEN FOR INPUT
MOVX T0,D%END ;Set fake end if necessary
IORM T0,FLAGS(D)
AOS BLKN(D) ;SIMULATE READING THE EOF RECORD
POPJ P,
;TOPS-10 SKIP RECORD
MOPSKR: SKIPE FUMXD(D) ;MIXED-MODE FILE?
$ECALL CDF,%ABORT ;YES. CAN'T DETERMINE FORM=
PUSHJ P,%SETIN ;Set file open for input
LOAD T1,MODE(D)
CAIN T1,MD.DMP ;DUMP MODE?
JRST SKRDMP ;YES. VERY SPECIAL
LOAD T0,FORM(D) ;GET FORM=
CAIN T0,FM.UNF ;UNFORMATTED?
JRST UNFSKP ;YES. DO UNFORMATTED SKIP
JRST %IREC ;TO SKIP RECORD, JUST READ AND IGNORE
SKRDMP: AOS T3,BLKN(D) ;GET THE INCREMENTED BLOCK #
ADDI T3,1 ;WANT THE NEXT ONE
LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIE T1,DI.DSK ;DISK?
JRST %SKIPB ;NO. SKIP AN MTA BLOCK
MOVE T2,FBLK(D) ;GET FILOP WORD 0
HRRI T2,.FOUSO ;GET USETO CODE
MOVE T1,[2,,T2] ;DO THE USETI
FILOP. T1,
PUSHJ P,%CLSER ;JUST RETURN ON EOF
POPJ P,
;TOPS-10 SKIP FILE
MOPSKF: LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIE T1,DI.MTA ;MAGTAPE?
POPJ P, ;NO. SKF IS NOP
SETZM CREC(D) ;CLEAR RECORD COUNT
SETZM BLKN(D) ;CLEAR BLOCK #
MOVE T0,FLAGS(D)
TXNN T0,D%OUT ;WERE WE DOING OUTPUT?
JRST SKFIN ;NO
PUSHJ P,%SETIN ;Yes. Close file, open again
JRST SKFCOM
;File not opened for output.
SKFIN: MOVE T1,FLAGS(D)
TXNE T1,D%IN ;Is file OPEN?
JRST SKFINN ;Yes
PUSHJ P,OPDEVO ;OPEN device
MOVEI T2,.TFFSF ;Skip a file
PUSHJ P,DOMTOP
PJRST CLDEVO ;Close again, and return.
SKFINN: PUSHJ P,CLREOF ;Clear EOF for input file
SKFCOM: MOVEI T2,.TFFSF ;SKIP A FILE
JRST DOMTOP
%SKIPB: MOVEI T2,.TFFSB ;SKIP A BLOCK
PJRST DOMTOP
%BACKB: MOVEI T2,.TFBSB ;BACKSPACE BLOCK
PJRST DOMTOP
BACKF: MOVEI T2,.TFBSF ;BACKSPACE FILE
;DOMTOP - DOES MAGTAPE OP, RETURNS FLAGS IN T1
DOMTOP: MOVE T3,DEV(D) ;GET DEVICE NAME
MOVE T1,[2,,T2] ;DO TAPOP
TAPOP. T1,
$ECALL UTE,%ABORT ;?Unexpected TAPOP error $O,<T1>
MOVEI T2,.TFWAT ;THEN A WAIT
MOVE T4,[2,,T2]
TAPOP. T4,
$ECALL UTE,%ABORT
POPJ P,
CHKEF: MOVE T1,DEV(D) ;GET THE DEVICE NAME
MOVEM T1,MTCBLK ;SETUP FOR MTCHR
MOVE T1,[MTCLEN,,MTCBLK]
MTCHR. T1, ;GET CHARACTERISTICS
; IOERR (UME,,,?,Unexpected MTCHR error $O,<T1>,%ABORT)
$ECALL UME,%ABORT
SKIPE MTCBLK+.MTREC ;ANY RECS AFTER LAST EOF?
AOS (P) ;YES. NOT AT EOF THEN. SKIP RETURN
POPJ P,
;Clear EOF by CLOSE'ing and re-OPENing the file.
;If it was opened for output, leave it that way.
; If it was opened for input, leave it that way.
CLREOF: MOVE T2,FBLK(D) ;GET THE CHANNEL STUFF
HRRI T2,.FOREL ;CLOSE THE FILE
MOVE T1,[1,,T2]
FILOP. T1,
PUSHJ P,%CLSER
MOVSI T1,(FO.PRV+FO.ASC)
HLLM T1,FBLK(D) ;AND NOW REOPEN IT
MOVX T5,D%IN ;Get flag to set
MOVE T0,FLAGS(D) ;Get current DDB flags
TXNE T0,D%OUT ;If file is now OPEN for output,
MOVX T5,D%OUT ;Leave it that way
TXZ T0,D%IN+D%OUT+D%END ;Clear current flags
MOVEM T0,FLAGS(D) ;Store new DDB flags
PUSH P,T5 ;Save flags
PUSHJ P,%ST10B ;Setup .FOBRH, .FONBF
POP P,T5 ;Restore flags to set on OPEN
PUSHJ P,%CALOF ;Try re-opening the file
JRST %ABORT ;?Failed
POPJ P, ;Worked, return
SEGMENT DATA
BSRCNT: BLOCK 1 ;# WORDS FOR BACKSPACE
DMPNTR: BLOCK 1 ;DUMP LIST PNTR
DMPLST: BLOCK MAXARG+1 ;DUMP I/O LIST
BLOCK 1 ;THE ZERO WORD (JUST IN CASE)
MTCLEN==20
MTCBLK: BLOCK MTCLEN
SEGMENT CODE
;Routine to CLOSE and then re-OPEN a file for input.
;This will have the effect of clearing the EOF status if set.
CLSOPN: MOVE T1,FLAGS(D) ;GET FLAGS
TXNE T1,D%OUT ;FILE OPEN FOR OUTPUT?
PUSHJ P,%LSTBF ;YES. OUTPUT LAST BUFFER IF MTA
MOVE T2,FBLK(D) ;GET CHANNEL STUFF
HRRI T2,.FOCLS ;CLOSE THE FILE
MOVE T1,[1,,T2]
FILOP. T1,
PUSHJ P,%CLSER
MOVE T2,FBLK(D)
HRRI T2,.FOREL ;RELEASE THE CHANNEL
MOVE T1,[1,,T2]
FILOP. T1,
PUSHJ P,%CLSER
MOVE T1,[FO.PRV+FO.ASC+.FORED] ;OPEN IT FOR INPUT
MOVEM T1,FBLK(D)
SETZM LKPB+.RBALC(D) ;PREVENT TRUNCATION
MOVX T0,D%END+D%IO+D%OUT
ANDCAM T0,FLAGS(D) ;Clear flags
MOVX T5,D%IN ;Set this flag if OPEN works
PUSHJ P,%ST10B ;Setup .FOBRH, .FONBF
MOVX T5,D%IN ;Get flag again
PUSHJ P,%CALOF ;Try re-opening the file
JRST %ABORT ;Failed
POPJ P, ;Done, return
> ;IF10
SUBTTL FIND
;FIND STATEMENT
;
;POSITIONS A RANDOM-ACCESS DISK FILE SO THAT SUBSEQUENT I/O WILL TAKE LESS TIME
;IF SUFFICIENT COMPUTATION INTERVENES BETWEEN THE FIND AND THE I/O.
;
;10: IF THE UNIT IS IDLE, NOT TRANSFERRING DATA FOR THIS JOB OR ANY
; OTHER JOB, POSITIONS THE ACCESS ARMS TO THE CORRECT CYLINDER
;
;20: CAN'T BE DONE
;
;THIS STATEMENT IS ALMOST ENTIRELY WORTHLESS.
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).
PUSHJ P,SETD ;SET D AND U
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
$ECALL IRN,%ABORT ;ILLEGAL IF .LE. ZERO OR NO RECORD NUMBER
MOVEM T1,CREC(D) ;STORE IN DDB FOR ASSOCIATE VARIABLE
IF10,<
MOVE T3,FRSIZW(D) ;GET FORMATTED RECORD SIZE, WORDS
LOAD T1,FORM(D) ;GET FORM=
CAIE T1,FM.FORM ;FORMATTED?
MOVE T3,URSIZB(D) ;NO. GET UNFORMATTED RECORDSIZE IN WORDS
IMULI T3,-1(T1) ;GET WORD # IN FILE OF BEG OF REC
LSH T3,-7 ;CONVERT TO BLOCK NUMBER
ADDI T3,1
HLLZ T2,CHAN(D) ;GET CHANNEL NUMBER
HRRI T2,.FOSEK ;SET SEEK FUNCTION
MOVE T1,[2,,T2] ;POINT TO FILOP BLOCK
FILOP. T1, ;DO THE "SEEK" FILOP
$ECALL IOE,%ABORT
>;END IF10
PJRST %SETAV ;GO SET ASSOCIATE VARIABLE AND RETURN
SUBTTL IOLST
FENTRY (IOLST)
SKIPN %UDBAD ;DO WE HAVE A UDB?
POPJ P, ;NO. RETURN
PUSHJ P,%SAVIO ;SAVE ACS
PUSHJ P,%ISAVE ;AND COPY ARGS
MOVE U,%UDBAD ;RESTORE DDB ADDRESS
MOVE D,DDBAD(U)
IOLP: MOVE T1,(L) ;GET NEXT I/O LIST ENTRY
JUMPE T1,%POPJ ;0 IS END OF LIST, RETURN TO USER
LDB T2,[POINTR T1,ARGKWD] ;GET TYPE OF ENTRY
CAILE T2,6 ;IN RANGE?
SETZ T2, ;NO, ILLEGAL
XMOVEI T1,@(L) ;GET ADDR
XCT DATSUB(T2) ;GO TO APPROPRIATE DATA HANDLER
JRST IOLP ;CONTINUE UNTIL END OF LIST
;XCT TABLE
DATSUB: JRST ILL
PUSHJ P,FDATA
PUSHJ P,SLIST
PUSHJ P,ELIST
JRST FIN
PUSHJ P,SLST77
PUSHJ P,ELST77
ILL: ADDI L,1 ;INCR PAST ARG
JUMPE T1,%POPJ ;0 ARG IS OK
$ECALL IOL,%ABORT ;NON-ZERO ARG, ZERO KWD - BAD I/O LIST
FDATA: 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
$ECALL ICE,%ABORT ;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)
SKIPN %UDBAD ;ANY UDB PNTR?
POPJ P, ;NO. JUST RETURN
PUSHJ P,%SAVIO ;SAVE USER'S ACS
MOVE U,%UDBAD
MOVE D,DDBAD(U)
FIN: SETZM IO.ADR ;NO DATA ADDR
JRST @IOSUB(D) ;GO FINISH UP
SLST77: SKIPLE T1,(T1) ;GET THE COUNT
JRST SLCOM ;JOIN COMMON CODE
MOVEI T1,(T1) ;NEG OR ZERO. TOSS AOBJN COUNT
JUMPG T1,SLCOM ;PRODUCED BY BUG IN COMPILER
;ZERO-TRIP SLIST. SKIP TO THE END OF THE LIST, WHICH IS
;ANY ZERO WORD (V5A) OR WORD WITH NON-ZERO KEYWORD.
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
SLIST: SKIPLE T1,(T1) ;GET THE COUNT
JRST SLCOM ;OK
MOVEI T1,(T1) ;NEG OR ZERO. TOSS AOBJN COUNT
JUMPG T1,SLCOM ;PRODUCED BY BUG IN COMPILER
MOVEI T1,1 ;ZERO-TRIP. USE 1-TRIP DO COUNT
SLCOM: MOVEM T1,IO.NUM ;STORE COUNT
MOVEM T1,LISCNT ;TWICE
HRRE T1,@1(L) ;GET INCREMENT
MOVEM T1,LINCR ;STORE INCREMENT
MOVEM T1,IO.INC ;ASSUME IT'S AN OK INCR
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
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
$ECALL ICE,%ABORT ;ZERO OR NEGATIVE SIZE (BAD SUBSTRING BOUNDS)
MOVEM T2,IO.SIZ ;SAVE IT
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: 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
IMULI T3,(T4) ;TURN ELEMENTS INTO WORDS
ADDI T1,(T3) ;ADD OFFSET TO BASE ADDRESS
JRST NSCHAR ;JOIN COMMON CODE
SCHAR: IMUL T3,1(T1) ;GET CHARACTER OFFSET
ADJBP T3,(T1) ;CREATE NEW PNTR
SKIPG T5,1(T1) ;GET VAR SIZE
$ECALL ICE,%ABORT ;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
ELST77: SKIPLE T1,(T1) ;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
ELIST: SKIPLE T1,(T1) ;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 T1,@(L) ;GET AN INCREMENT
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
IMUL T1,OFFS ;GET OFFSET INTO ARRAY
LDB T2,[POINTR (1(L),ARGTYP)] ;GET ARG TYPE
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
$ECALL ICE,%ABORT ;ZERO OR NEGATIVE SIZE (BAD SUBSTRING BOUNDS)
MOVEM T2,IO.SIZ ;SAVE IT
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
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
LINCR: BLOCK 1 ;LOCAL INCREMENT
LISCNT: BLOCK 1 ;LOCAL COUNT
OFFS: BLOCK 1 ;LOCAL OFFSET
SAVEL: BLOCK 1 ;FOROTS ARG LIST PNTR LOCAL
FORPRG
END