Trailing-Edge
-
PDP-10 Archives
-
BB-D480F-BB_1985_short
-
foropn.mac
Click foropn.mac to
see without markup as text/plain
There are 20 other files named foropn.mac in the archive. Click here to see a list.
SEARCH MTHPRM,FORPRM
TV FOROPN OPEN & CLOSE ,10(4205)
;COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1981, 1985
;ALL RIGHTS RESERVED.
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
COMMENT \
***** Begin Revision History *****
1100 CKS 5-Jun-79
New
1272 DAW 19-Feb-81
A few low-risk changes to support extended addressing.
1273 EDS 19-Feb-81 Q10-04732
Add /RECL to dialog keyword table.
1274 EDS 19-Feb-81 Q10-04574
Add support code for TAPEMODE='ANSI-ASCII'.
1277 JLC 23-Feb-81
Added code to calculate bytes/word (BPW) on -10,
plus used it to calculate rounded record size (RSIZR)
for use in %IREC.
1305 JLC 26-Feb-81
Moved the RSIZR code to its correct resting place in FIXDEF.
1306 DAW 26-Feb-81
New arg list format passed by %SAVE.
1307 EDS 26-Feb-81
Put ACCESS back in list of valid switches for DIALOG.
1310 DAW 26-Feb-81
Full words in DDB for ERR=, END=, IOST=, AVAR= addresses.
1312 EDS 27-Feb-81
Remove edit 1307 as it causes generation number skew on TOPS-20
with certain combinations of ACCESS in DIALOG different from
the ACCESS that was specified in the OPEN.
1313 JLC 3-Mar-81
Added code to handle magtape op's better
1316 JLC 5-Mar-81
Changed refs to D%LIO to D%LOUT. Major code changes
for magtape i/o and proper direction switching.
1325 JLC 9-Mar-81
Yet more changes for magtape I/O for the -10
1326 JLC 10-Mar-81
Minor bug fix in -10 open.
1333 JLC 11-Mar-81
Magtape patches (mostly typos) for the -10
1336 JLC 12-Mar-81
Fix more typos; change name of CLOSE to CLOSE0.
1353 JLC 18-Mar-81
More magtape op fixes. Set I/O direction flags after
calling routine. Install backing over EOF if program
reads to EOF then writes. Fix empty buffer problem
for OSWTCH.
1354 JLC 18-Mar-81
OSWTCH fix. Must truncate file at previous block to
get the monitor to not round word count up to blocksize.
1356 JLC 18-Mar-81
Add dump mode write to oswtch.
1361 JLC 20-Mar-81
Put -20 null file prevention code in IF20.
1363 JLC 24-Mar-81
Commented out code for common tty ddbs.
1364 CKS 24-Mar-81
Don't do RLJFN if the GTJFN failed
1365 JLC 25-Mar-81
Move code to set device index for -10 up slightly in DOOPEN
so magtapes will know about it after half-open (seqinout).
Typo in dump mode output FILOP.
1370 EDS 26-Mar-81 Q10-04566
Make IMAGE and BINARY mode I/O illegal on TTYs.
1375 EDS 31-Mar-81 Q10-05002
Fix FILOP. for CLOSE DISPOSE='RENAME', remove monitor
version dependent code.
1376 JLC 31-Mar-81
Fix more code in -10 OSWTCH, did not do correct thing for
null files or pointer at beginning of buffer.
1400 JLC 02-Apr-81
Typo - PUSHJ should use P as reg and not 0.
1401 JLC 03-Apr-81
Make sure block number never goes negative in OSWTCH.
1402 JLC 06-Apr-81
Avoid doing dump-mode truncation for magtape - not necessary.
Move turning on CRLF suppression from OSW to %IREC.
1407 JLC 07-Apr-81
Move device-dependent I/O so it gets called before buffers
are set up, so BLOCKSIZE will work.
1410 JLC 07-Apr-81
Move setup of record buffer to FORIO in preparation for
input/output separation of record buffer.
1411 DAW 08-Apr-81
Use IJFN and OJFN instead of JFN field in DDB.
1412 JLC 09-Apr-81
Uncomment the commented-out tying of TTYs to 1 DDB,
as multiple channels to the same DDB doesn't work on
the -10.
1416 JLC 10-Apr-81
Removed RSIZR code, was unnecessary.
1417 DAW 10-Apr-81
Type traceback info if OPEN arg error caused user to
get to DIALOG mode.
1420 JLC 10-Apr-81
Deallocation of separate record buffers.
1421 JLC 10-Apr-81
Typo in edit 1407. DF was not set up
when DSKSET was called.
1422 JLC 13-Apr-81
External symbol %TRACE.
1423 DAW 13-Apr-81
Put %SETD in FORIO (was in FOROPN).
1426 JLC 14-Apr-81
Changed error reporting in OSWTCH-10 to fatal errors.
Restore .JBFF in DOOPEN upon FILOP failure, caused
problems with SORT.
1427 JLC 15-Apr-81
Changed RSIZ to be a word (RSIZE) in the DDB.
1433 DAW 16-Apr-81
Show possible switches user can type when he gets to DIALOG
mode on the -20 and types a question mark.
1434 DAW 16-Apr-81
Check for READONLY set and if so, change ACCESS=
'RANDOM' to 'RANDIN', 'SEQINOUT' to 'SEQIN'.
1441 JLC 17-Apr-81
Remove all refs to D%RSIZ, no longer needed.
1442 DAW 17-Apr-81
Remove /LABELS and /TAPEMODE from OPEN and DIALOG options.
1451 JLC 23-Apr-81
Special handling of dump mode I/O in OSWTCH. Removal of
BAKEOF call in OSWTCH for magtape (reading to EOF, followed
by write, will leave the tape mark).
1453 JLC 24-Apr-81
Move -10 code to set up BPW, so that BLOCKSIZE setup will work.
1463 JLC 7-May-81
Many major changes. See revhist in FOROTS.MAC.
1464 DAW 11-May-81
Error messages.
1465 JLC 15-May-81
Major changes to -20 I/O.
1473 CKS 21-May-81 Qvarious
Add flags to IOERR macro, I%REC to print current input record with
arrow under current position, I%FMT to do same for current format.
Add I%REC and I%FMT to appropriate messages.
1474 JLC 22-May-81
Fix bug in new -20 open code, can't look at DF before it's set up.
1475 JLC 22-May-81
Minor bug in XXXSET, %GTBLK has no error return.
1476 JLC 26-May-81
Fix bug in non-disk opens, was setting BYTN to large
number which then overflowed.
1477 JLC 27-May-81
In OSWTCH-10, must clear BLKN for magtape if writing after
EOF, since it's a new file.
1502 JLC 28-May-81
Install defensive WAIT operations in magtape code.
1503 JLC 28-May-81
SINR and SOUTR are asymmetric - tape I/O rounds up to
words, so that SINR fails with default (1000 bytes).
Fix: force rounding to words in OPEN.
1505 JLC 01-Jun-81
Don't do extra backspace in MTAISW; data is still there.
1512 BL 5-JUN-81 Q10-05829
Fix omission of <crlf> when output assigned from DSK to TTY.
1513 BL 8-Jun-81 Q10-06193
Fix no error message writing small file to write-locked tape.
1514 JLC 8-Jun-81
Change default "width" of disk output lines from 132 to 72 chars
for NAMELIST and list-directed output.
1515 BL 9-Jun-81
Change JRST to CLSERR in EDIT 1513 to PUSHJ.
1532 DAW 14-Jul-81
OPEN rewrite: Base level 1
1534 DAW 14-Jul-81
Code for TOPS-20 "STATUS='SCRATCH'". Also fix infinite
loop if errors in DIALOG='string'.
1537 DAW 16-Jul-81
Finish TOPS-20 SCRATCH file handling. Fixup TOPS-20
CLOSE code so it works again.
1540 DAW 17-Jul-81
Delete IS from DDB, use IOSTAT variable directly.
Set IOSTAT variable to zero at the start of each IO statement.
Set D%ERR if "?" error in IOERR.
1541 DAW 17-Jul-81
Get rid of D%LIN and D%LOUT.
1542 JLC 17-Jul-81
Delete D%EOF, hopefully forever.
1543 DAW 17-Jul-81
Allow SCRATCH files for devices besides DSK:
1544 DAW 20-Jul-81
Invent "FIXU" to solve problem with /CARRAIGECONTROL.
1545 DAW 20-jul-81
Remove call to %OCRLF at CLOSE time.
1546 JLC 20-Jul-81
Don't suppress initial CRLF in files.
1547 DAW 20-Jul-81
Provide the functionality that %AUXBF used to.
1554 DAW 22-Jul-81
Fix CLOSE /DISPOSE actions; CLOSE keywords different from OPEN.
1556 DAW 22-Jul-81
CLOSE from EXIT.
1560 DAW 28-Jul-81
OPEN rewrite base level 2.
1563 DAW 29-Jul-81
DIALOG='string' lost track of its arg type.
1564 DAW 29-Jul-81
Check conflicts in CLOSE args; use STATUS value if DISPOSE not given.
1565 DAW 29-Jul-81
Default BLANK= correctly.
1570 DAW 30-Jul-81
Don't clear %IONAM in %IOERR anymore - it is used at end of OPEN.
1573 DAW 31-Jul-81
Better error handling for RENAME.
1575 JLC 05-Aug-81
Fixed half-hearted attempt to make DIRECTORY=array work,
implemented separate access bit-setting by device type
in DOOPEN, eliminating need for MTACRK and making
SEQINOUT work in general.
1576 DAW 11-Aug-81
OSWTCH for disk.
1602 JLC 12-Aug-81
Reinserted suppression of initial CRLF for terminals only.
1610 DAW 17-Aug-81
CLOSE /default rename didn't work on the -10
1616 DAW 19-Aug-81
Infinite loop on TOPS-10 if non-disk OPEN failed.
1617 DAW 19-Aug-81 Q10-5204
Problem with DISPOSE='SUBMIT'
1620 DAW 20-Aug-81
Fix TOPS-20 generation skew problem in DIALOG mode
1621 DAW 20-Aug-81
CLOSE/ RENAME/ DELETE on the -10.
1625 DAW 21-Aug-81
Get rid of "DF".
1640 DAW 26-Aug-81
Always use EXTENDED GTJFN to get ";FORMAT:F"
This edit for future use for magtape format specifier.
Part of edit (actual format specifier) is REPEAT 0'd
until we allow magtape format to be specified in OPEN
statement.
1641 DAW 26-Aug-81
OPEN STATUS='NEW' FAILED ON TOPS-20
1642 JLC 27-Aug-81
Replace %FILOP calls with FILOPs.
1643 JLC 27-Aug-81
Change IRBUF & ORBUF into full word byte pntrs, so
releasing them must use only right half addr.
1650 BL 31-Aug-81
Fix RECORDSIZE applied to NAMELIST & LIST directed output.
1652 DAW 1-Sep-81
Fix DUMP MODE I/O on TOPS-10.
1654 BL 1-Sep-81
Typo in EDIT 1650.
1655 DAW 1-Sep-81
Clear .RBALC after OPEN FILOP.
1660 DAW 3-Sep-81
Use low channels if all extended ones are taken.
1663 JLC 8-Sep-81
Write out last buffer for magtape on -10. Normally done
by monitor, but if no data, no tape mark gets written unless
the initial OUT is done.
1664 DAW 8-Sep-81
Don't call DOOPEN twice if DDB's get consolidated at OPENX.
1665 DAW 8-Sep-81
D.TTY = DDB address of the controlling TTY: (if OPEN yet..)
1666 DAW 8-Sep-81
/MODE:IMAGE implies /FORM:F. /FORM:U is a conflict.
1670 DAW 9-Sep-81
Two DSK: files open for append no longer get same DDB.
1672 DAW 9-Sep-81
Was bypassing conflict check for RANDOM and no RECORDSIZE.
1674 DAW 9-Sep-81
Couldn't WRITE to LPT: on the -10 ("IO" bits toggled).
1675 DAW 9-Sep-81
Added code for device conflicts with MODE.
1677 JLC 10-Sep-81
Fixed unmapping of unused pages.
1701 JLC 10-Sep-81
Added SETO for setup to unmap pages
1706 DAW 11-Sep-81
Lots of changes to errors.
1711 DAW 15-Sep-81
Set D%ERR if IOERR, even if message not typed.
1712 JLC/DAW 15-Sep-81
Got rid of D%ERR, use DDBADR instead.
1715 DAW 15-Sep-81
If user specified FORM='FORMATTED' but not MODE, he got
an "?Internal FOROTS error".
1717 DAW 16-Sep-81
Implement D%NCLS - set if CLOSE error happened,
to avoid the "infinite loop" of CLOSE - %ABORT - CLOSE - %ABORT ...
1723 DAW 17-Sep-81
Fix problem with sticky ERR= from OPEN.
1725 DAW 17-Sep-81
DIALOG parsing on TOPS-10.
1732 DAW 22-Sep-81
Fix -20 STATUS='NEW'.
1734 DAW 22-Sep-81
STATUS='SCRATCH', ACCESS='RANDOM' on TOPS-20.
1740 DAW 23-Sep-81
More REREAD code - clear U.RERD in %CLOSE.
1742 JLC 23-Sep-81
Fix OSWTCH to do the right thing to N.REC: decrement it
for disk, as we are backing over the ENDFILE record, set
it to 1 for magtape, as we are writing a new file. All this
because BACKSPACE checks the record number and leaves
if zero.
1743 DAW 24-Sep-81
Fix obscure bug in DIALOG scanning, caused "?Bad source/dest designator"
on TOPS-20 if a switch was mis-typed and then typed correctly.
1744 DAW 24-Sep-81
Allow user to OPEN the special negative units (note: not documented.)
1750 DAW 28-Sep-81
Stop after reading in 5 SFD's in DIRECTORY=array.
1751 JLC 28-Sep-81
Fix unformatted backspace again. A bug in DSKOSW-20 was causing
attempts to PMAP page -1. If either IPTR is zero or the file
position is negative, clear IPTR/ICNT so we'll just start
writing at the start of the file.
1752 DAW 29-Sep-81
Minor fixes to DIALOG processing.
1753 DAW 29-Sep-81
IOERR's to type the PC. %TRACE call no longer needed.
1754 DAW 29-Sep-81
Allow negative generation numbers on TOPS-20. (For example,
-1 means the next generation number).
1755 DAW 1-Oct-81
Allow protections <111> in TOPS-10 DIALOG mode, as per V5a.
They can be either before or after PPN's.
1757 DAW 2-Oct-81
Conflict with /READONLY caused "?Ill mem ref".
1763 DAW 7-Oct-81
Fatal error if user tries to write to a LINED file.
1764 DAW 7-Oct-81
TOPS-10 MTASET got "Integer divide check", "TAPOP. error" trying
to set BLOCKSIZE.
1765 DAW 7-Oct-81
Make TOPS-10 OPEN error type the non-printing character
that caused the problem.
1770 DAW 8-Oct-81
TOPS-10 progs hang in EW state at the QUEUE. UUO if GALAXY
version 2 is running.
1771 DAW 8-Oct-81
Missing /LIMIT code for TOPS-10 GALAXY V2 packet.
1772 DAW 8-Oct-81
TOPS-10 DISPOSE='DELETE' didn't release the channel.
1774 DAW 8-Oct-81
Avoid getting "?Unexpected TAPOP. error" for typical errors.
1775 JLC 9-Oct-81
Prevent doing tapops if program didn't specify anything.
1776 DAW 9-Oct-81
Allow BINARY,DUMP,IMAGE mode to be used with TOPS-10 NUL: device.
1777 DAW 9-Oct-81
FILOP. CLOSE before RELEASE when appropriate.
2000 DAW 9-Oct-81
Fix typo that caused PLOT routines to stop working because
unit -7 couldn't be opened.
Get rid of extraneous, unreachable TOPS-10 code.
2002 DAW 13-Oct-81
OPEN 'TTY', ACCESS='SEQIN', followed by "TYPE" didn't work.
2004 DAW 14-Oct-81
Before consolidating DDB's, check to make sure MODE is the same.
2005 JLC 15-Oct-81
Add unmapping of unused pages for random files also.
2011 DAW 19-Oct-81
At DOOPEN store EOFN from .RBSIZ info. Use that to compute blocks
when queueing file. Also get rid of "FSIZE".
2014 JLC 19-Oct-81
Fix unmapping of unused pages not to unmap holes in the file.
2016 JLC 20-Oct-81
Fix minor bug in QUEUE acknowledge, error msgs.
2023 DAW 23-Oct-81
With GALAXY R2, DISPOSE='LIST' didn't make the file be
deleted after it was printed.
2026 JLC 27-Oct-81
Fixed RSIZW for LINED files so backspace will work.
2027 DAW 27-Oct-81
Rework GALAXY v2 code to use symbolic names, so sites who
have modified QSRMAC can just reassemble FOROTS to make it
handle /DISPOSE:<queue> at their site.
2033 DAW 30-Nov-81
In CLSQ, zero out the page returned by GTPGS.
***** Begin Version 6A *****
2041 DAW 21-Dec-81
Correct deficiency in TOPS-20 logical name handling that
caused unexpected "?File not found" errors for OPEN/READ
sequence.
2042 TGS 2-Feb-82 20-17208
Change NREC(D) to NREC(U) at end-of-file routines so record
counts get correctly updated.
2043 ERD 9-Feb-82 10-32099
Change in DPRFN1 to allow leading spaces in file names on
TOPS-10.
2050 ERD 20-Apr-82 10-32326
Code addition in %LSTBF so that DUMP mode output on magtape
will skip over the initial output.
2062 EDS 7-Jun-82
Files with extension of "DAT" when sent to the printer via
DISPOSE = 'LIST' or 'PRINT' do not have the first character
of each line used for carriage control.
2064 EDS 10-Jun-82
Create files for STATUS='SCRATCH' using the standard naming
convention for TOPS-10. File names will now be nnnccc.TMP,
where nnn is the job number and ccc are random letters.
2112 TGS 29-Sep-82 10-32830
Set up the path pointer in the RENAME block before executing the
rename FILOP. so CLOSE/DISPOSE=RENAME can rename a file to a
different SFD or directory.
***** Begin Version 7 *****
3012 JLC 4-Nov-81
Rework FOROTS call arg copier. No more LTYPE.
Rework of OPNDIR, which modified the arg list.
3015 AHM 7-Nov-81
DIALOG with zero address comes out as 1,,0 when produced by the XMOVEI
at OPNDIA and was thus not seen as zero.
3016 JLC 9-Nov-81
Fix OPNDIA for new arg block - checks if immediate-mode arg
to decide if it has a string.
3023 JLC 15-Nov-81
Various V6 patches: non-consolidation of NUL:, correct call
to %FREPGS in disk close, leading blanks in OPEN parameters,
quickie patch to turn off D%IO for TTY input after DIALOG.
3035 JLC 5-Feb-82
Rework of OPEN code that decides default MODE and FORM
parameters. Set byte size to 7 and BPW to 5 for all files.
Fix APPEND bug - was not setting BLKN to end of file.
3051 JLC 26-Feb-82
Set BUFFERCOUNT to 1 for magtapes on the -10, ignoring the
user's specification, since PULSAR does not return the magtape
EOF bit in a consistent place (sometimes the active buffer,
sometimes the EOF buffer), so BACKSPACE, WRITE cannot work
because the active buffer count, and therefore the number of
blocks to backspace, is sometimes off by 1.
3056 JLC 23-Mar-82
Catch illegal OPEN arguments (such as RECORDSIZE=0) and
illegal options for binary files (such as BLANK=).
3072 JLC 30-Mar-82
Fix CLOSE of image mode files with character data, was rounding
incorrectly (wrong AC).
3111 JLC 15-Apr-82
Fix SDO error message, was getting unit number with LOAD, which
does not sign-extend.
3114 BL 29-Apr-82
Make character expressions work in OPEN statements (FOROPN.MAC).
3115 BL 13-May-82
Continue above(3114). Fix OPNCHR & DIABLT to check ARGTYP and
get the character descriptor if appropriate.
3116 BL 14-May-82
Move label DIANST up one line(typo).
3117 BL 14-May-82
Changed HLRE to HXRE in CNSCHK to get correct unit number
in SDO error. (Note: Same edit as 3111!)
3122 JLC 28-May-82
Make FILE= fully qualified string work. Fix some extended
addressing bugs for character args.
3123 JLC 29-May-82
Fix bug in SMBA, was not paying attention to FORM=.
3125 JLC 3-Jun-82
Moved the AC save routine back to the hiseg.
3126 JLC 7-Jun-82
Installed OPEN on a "connected unit". Fixed some code
which flowed across SEGMENT macros.
3136 JLC 26-Jun-82
Support work for I/O performance. Install some TSG patches.
3140 JLC 2-Jul-82
Put in missing external %EXCHN.
3150 JLC 12-Jul-82
Day 1 bug - DIALOG in close set up GTJFN flag word with
junk from T0 (HLLOM instead of HLLOS). Fix bug in -10 OPNDIR,
did not recognize character string args.
3153 JLC 20-Jul-82
Fixed problem caused by new EOF-handling code for random files.
3161 JLC 19-Aug-82
Installed modified TSG patch regarding setting and restoring
of CCOC words. Fixed TPAGE on the -20 so it won't leave
a null file with 1 page allocated. Changed NREC(U) to CREC(D).
3165 JLC 28-Aug-82
Fix random I/O so it can handle files larger than 256K blocks.
3166 JLC 30-Aug-82
Fix XXXSET so it sets WSIZ to a page rather than 15 bytes.
Search QSRMC2 instead of QSRMAC on the -10, since QSRMAC is
now for GALAXY 4.1. Change APPEND so it uses PMAP again.
3174 JLC 4-Sep-82
Fix FOROPN on the -10 so TPAGE is calculated in pages, not
blocks.
3175 JLC 8-Sep-82
Change OPEN on "connected unit" to only do this if the
OPEN in progress specifies STATUS='OLD'.
3200 JLC 24-Sep-82
Install 6A patch to supercede on TOPS-10 rather than
deleting the file in OSWTCH. This avoids failures for
protection code 2 and accidently creating the file in
a different SFD than the original file. Fix DSKCLS on
the -20 to free the page tables, which caused eventual
memory full if many random files were opened and closed
repeatedly.
3202 JLC 26-Oct-82
Install code to provide base support for ANSI tapes for
TOPS-20, since most of the work is done by the monitor.
3203 JLC 31-Oct-82
Store a word of spaces (SPCWD) in DDB for each type
of file.
3212 JLC 11-Nov-82
Update and consolidate -20 magtape code so that B36FLG(D) controls
whether formatted or unformatted I/O is done.
3213 JLC 12-Nov-82
Fix FILOP close in OSWCRE, didn't expect a skip (normal) return.
3214 BL 12-Nov-82
Merge in EDIT 2124 from V6A...
This edit supersedes edit 2063. Ensure that calls to FRSISW errors
always pass SIXBIT strings for keywords and key values on TOPS10 only.
3215 JLC 15-Nov-82
Fix magtape bugs, typos.
3216 JLC 16-Nov-82
Fix bytesize on CLOSE. Also store the data mode, which heretofore
was discarded.
3221 JLC 21-Nov-82
Fix %LSTBF call so it doesn't setup the buffer (changed call
to %OBUF).
3223 JLC 22-Nov-82
Do not allow modes on OPEN after all, as most of the devices
don't allow them anyhow. Fix DEVICE=' '.
3225 JLC 24-Nov-82
Remove extraneous (and deadly) multiplication of # bytes by BPW.
3226 JLC 29-Nov-82
Fix various little bugs, magtape bugs, etc.
3227 JLC 8-Dec-82
Fix EOFN problem at OSWTCH.
3230 RJD 8-Dec-82
Fix CLOSE STATUS and DISPOSE problems.
3231 JLC 14-Dec-82
Remove warning given for CLOSE on units that are not OPENed.
Fix EOFN problems regarding null files (REWIND, ENDFILE)
and files which have data to page bounds (REWIND, WRITE).
3250 JLC 7-Jan-83
Fix GTJFN in DOOPEN do try GJ%OLD, then no flags if correct
type of failure. In CLOSE, save UDB of file to be renamed
in %RNOLD.
3252 JLC 12-Jan-83
Fix RENAME error msg reporting.
3253 JLC 13-Jan-83
Fix EXIT1 so it doesn't fall over with I/O within I/O.
3256 JLC 14-Jan-83
Fix CLOSE so it puts DDB addr in UDB so $F can find it.
***** End V7 Development *****
3265 JLC 10-Feb-83
Clear the buffer pointers and buffer count so that .JBFF
is correct. This corrects the problem of overlayed programs
failing with a ?Can't create page nnn when several REWIND
WRITE sequences are executed.
3274 JLC 23-Feb-83
Allow BLANK= to be specified in the OPEN statement for
either formatted or unformatted files then use only if
a formatted WRITE is executed. Also, store the space
for PADCHAR for all types of files.
3340 RJD 8-AUG-83 SPR:10-34053
Calculate the number of blocks to be stored in EST(D) from the
value provided in words for FILESIZE.
3360 TGS 17-OCT-83 SPR:20-19540
Since both FORLIB and LIBOL define DBSTP. as a global symbol
for DBMS calls, producing a LNKMDS error, change it to D.BSTP.
3371 RJD 6-DEC-83 SPR:10-34318
Allow the CLOSE to accept a zero in the PROTECTION specifier
in order that files may be protected <000>.
3417 MRB 24-FEB-84 SPR:10-34503
Implement the LIMIT= keyword in the OTS. It was always there
except nobody ever looked at it. When specifing a LIMIT= switch
in the OPEN statement it will be passed to GALAXY.
3420 TGS 24-FEB-84 SPR:10-34523
Allow a blank string in DIRECTORY= for TOPS10.
{No code changes for V10}
3421 RJD 27-FEB-84 SPR:10-34529
Clear the PPN including the SFD's before entering the
information specified in the DIRECTORY= into the path block.
3422 RJD 2-MAR-84 SPR:none
When RENAMing a file, make sure all the creation date bits
are saved.
3427 MRB 24-APR-84 SPR:10-34503A
Correction to edit 3417; The CLOSE statement would not allow
the LIMIT= specifier.
3453 TGS 12-Nov-84 SPR:10-34969
When calculating the QUEUE limit value for DISPOSE='PRINT',
don't use SIZ(D) to retrieve filesize in words, since this
will be accurate only for existing files to which no I/O
has been performed. Use EOFN(D) instead.
***** Begin Version 10 *****
4000 JLC 22-Feb-83
Clear # buffers before doing FOWRT in OSWCRE (-10 autopatch).
Remove code which checks for extraneous args for unformatted
OPEN. Do changes necessary for I/O performance enhancements.
4010 JLC 19-Apr-83
Fix unlabeled tape bug - the monitor does NOT change the
internal bytesize for industry tapes to 8 for unlabeled
tapes, so they must be treated separately. Install some
more keyword values for INQUIRE. Move around some code
in %SETOUT for performanace improvements.
4014 JLC 14-Jun-83
INQUIRE. Minor changes for RMS/tape support.
4016 JLC 22-Jun-83
Make TTYs consistent with other devices (removed useless
special code). Add a SEGMENT CODE so literals will be in
the high segment.
4023 JLC 29-Jun-83
Fix new magtape feature: if the record format is 'D',
the recordsize specified by the user must have 4 added
to it for the maximum recordsize on the label.
4024 JLC 30-Jun-83
INQUIRE code review changes. Also remove some useless code.
4027 JLC 6-Jul-83
Fix misunderstanding about "D" format records: the RECL
specifier includes the 4 bytes for the control word.
4032 JLC 12-Jul-83
Reinstate a last-minute mode/form setting routine for DOOPEN,
needed only by ENDFILE.
4033 JLC 18-Jul-83
Fix bugs in INQUIRE - typos.
4035 JLC 22-Jul-83
Fix BLANK= in INQUIRE.
4036 JLC 3-Aug-83
Add one-word-global-byte-pointer table. Remove most of
the "illegal data mode for this device" code, replaced
with setting ASCII-only device flag, to allow binary
(image) I/O to those devices.
4040 JLC 6-Sep-83
Finally make CARRIAGECONTROL='FORTRAN' VAX-compatible, that
is, set the bit in the FDB. If the CHFDB fails, issue a warning
message. Change CC='FORTRAN' to CC='TRANSLATED' for TTYs and
LPTs. Fix a bug in DIALOG whereby it was looping in DIALOG
mode on command errors even though running under batch.
4041 JLC 7-Sep-83
Fix typo in GMODBY. Caused all files to be 36-bit.
4044 JLC 23-Sep-83
Modify magtape code slightly. Calculate bytesize
before doing GTJFN.
4047 JLC 5-Oct-83
Fix EOFSET, another typo. Caused bogus warning message.
4052 JLC 12-Oct-83
Clear magtape attributes for assigned magtapes, as they
are illegal as GTJFN args. Fix OPNCON to leave via %SETAV.
Fix reparse on COMND%, still had JFN, so was getting
internal FOROTS error.
4053 JLC 18-Oct-83
Fixed OPNARG, CLSARG, and OPNCNV/CLSCNV to use separate
arg pointer and count (no AOBJN).
4054 JLC 25-Oct-83
Fix DFDEV1, was not storing correct AC for DVCHR bits.
4055 JLC 27-Oct-83
Fix GMODBY to set ANSI-ASCII and INDUSTRY tapes to
ASCII-only devices, so that unformatted I/O will
not read/write LSCWs.
4057 JLC 31-Oct-83
Fix FIXDEF so it adds LSCWs to the unformatted record
size of ASCII files.
4064 JLC 14-Nov-83
Add new keywords for RMS. Fix flaw in INQUIRE regarding
ERR= and IOSTAT= processing by adding arg copying routine,
which also simplifies OPEN/CLOSE processing.
4065 JLC 6-Dec-83
More preparation for RMS.
4066 JLC 11-Jan-84
Major restructuring of OPEN code to prepare for RMS interface.
4067 JLC 13-Jan-84
Fix APPEND bug, TOPS-10 filespec bug.
4071 JLC 18-Jan-84
Fix bugs in INQUIRE.
4072 JLC 24-Jan-84
Fix more bugs in INQUIRE, and prepare INQUIRE for RMS.
4073 JLC 26-Jan-84
Fix a bug in RMS INQUIRE functionality: don't rely on
IJFN(D) being non-zero to tell if the file is open. RMS
files have no JFN assigned by FOROTS.
4100 MRB 9-Feb-84
Added code to do compatibility flagging in FOROTS. Outputs
a warning message for usage of non compatible language features
like incompatible Keywords in Open/Close statement. KWDFND
4102 JLC 17-Feb-84
Massive changes to OPEN and CLOSE to establish orthogonal
STATUS and DISPOSE values.
4103 JLC 21-Feb-84
Fix bugs introduced by edit 4102. Insert V7A patch for
DIRECTORY= for TOPS-10.
4104 JLC 23-Feb-84
Fix DATE75 bug introduced by allowing PROTECTION=<000>.
4105 JLC 28-Feb-84
Modify the error handling routines, and fix a whole pile
of latent and real bugs in error handling.
4107 JLC 5-Mar-84
Fix bugs introduced into DIALOG by edit 4105.
4111 JLC 16-Mar-84
Modify the error calling sequence again. Fixed some DDB
consolidation problems introduced by the restructuring
of STATUS/DISPOSE.
4112 JLC 19-Mar-84
Renamed FIXU to FIXCC, and moved the call to it to DFDEV1, so
CARRIAGECONTROL would be set up for deferred-open files.
4114 JLC 28-Mar-84
Remove I%TCH on TOPS-10, as it is almost useless
and didn't work anyhow.
4115 JLC 2-Apr-84
Fixes to OSWTCH and ISWTCH.
4116 JLC 4-Apr-84
More fixes to OPEN, ISWTCH, and OSWTCH
4122 JLC 2-May-84
A whole raft of changes to make the TOPS-10 and TOPS-20
DDB databases the same.
4123 JLC 5-May-84
Add more code to TOPS-10 TABLK to make it more like TOPS-20.
4124 JLC 8-May-84
Stop copying generation number for CLOSE with rename. Move
the default open code within CLOSE before the CLOSE arguments
are processed, and notably before the filespec is copied to
the rename DDB. Fix OPNDEV so it accepts a blank string again.
4125 JLC 11-May-84
Fix PROTECTION= and DIRECTORY=.
4127 JLC 15-May-84
Fix TOPS-10 append. Fix OPEN/CLOSE specifiers so they take
hollerith arguments again.
4131 JLC 12-Jun-84
Disallow DUMP mode for magtape, as magtape code is totally
reworked to handle industry tapes, etc. Move alot of code
around, clean it up, consolidate the OPEN/CLOSE/INQUIRE
argument processor. Remove most of the flags of F, replace
them with global context variables DSPPNT and SWTPNT and
with better top-down coding practices.
4134 JLC 3-Jul-84
Made some changes in error messages and changed around
the order of the tables for COMND% in DIALOG so that
you get a reasonable error message for a bad character.
Fixed DUMP mode again.
4135 JLC 9-Jul-84
Fix GTJFN and COMND% interfaces so the entire JFN, including
flags, is saved so JFNS will return the exact string given.
Add MOPBTS, since magtape does not allow both OF%RD and OF%WR
at the same time. At %SETOUT, set the access to SEQOUT so that
successive calculations of SAIDX will yield the same results.
Allow temporary files and wild-cards in filespecs. For TOPS-20,
translate TOPS-10 style PPN to directory after all arguments
and defaults are processed.
4137 JLC 17-Jul-84
Fix magtape ISWTCH and OSWTCH problems for TOPS-20 - they
were not resetting the magtape parameters, which go away
when you close the file. Allow wildcard specs in the
filespec in CLOSE.
4141 JLC 3-Aug-84
Fix magtape code for TOPS-10.
4144 JLC 29-Aug-84
Fix magtape code again, this time for null file at BOT.
Add DISPOSE='PLOT' for John Edgecombe's edification.
4145 JLC 7-Sep-84
Fix DISPOSE=. If it failed, it would leave around
a JFN/channel. Fix handling of no such device. Setup the
file size of files not actually opened for DISPOSE='PRINT'.
4150 JLC 13-Sep-84
Fix magtape append code yet again, since edit 4144 broke it
for the normal append case.
4151 MRB 19-Sep-84
Magtape stuff, re-write CNFDEV.
4153 JLC 27-Sep-84
Default TAPEFORMAT='INDUSTRY' if it is not set and RECORDTYPE
is set to anything but STREAM.
4155 JLC 11-Oct-84
Fix CLOSE so that dispose and status values in a CLOSE
statement do not get imported into the original DDB.
4157 MRB 25-Oct-84
Add code in CNVDEV to call error messages for the magtape
specifiers conflicts.
4161 JLC 1-Nov-84
Change ASCFLG to IMGFLG. Rearrange some magtape code to
make the -10 and -20 magtape handling similar. Set IMGFLG
for INDUSTRY tapes in MTADEF, called in DFDEV1.
4164 JLC 15-Nov-84
Fix edit 4161: IMGFLG was getting cleared/set in more than one
place.
4170 JLC 19-Nov-84
Fix CMPACC in OPNCON: the ACCESS= was not being compared if
ACCESS= on the consecutive OPEN statement was not given or,
for V10, was 'SEQUENTIAL'.
4171 JLC 27-Nov-84
Fix edit 4170: OPEN on a connected unit should succeed if
SEQINOUT (or no access) is specified in the second access
and the first access was either SEQOUT or SEQINOUT.
Implement CARRIAGECONTROL='FORTRAN' for TOPS-10 - if it
is requested in the OPEN statement, set it in the LOOKUP/ENTER
block (expanded to be 7.03 size), so that it will begin to work
when customers receive 7.03.
4174 JLC 9-Jan-85
Fix FTVAX code so that the units are aligned correctly.
Fix code in DSKRNM so that the FILOP error will be preserved
in T1.
4177 JLC 28-Jan-85
Do not set the bytesize of non-magtape IMAGE devices
to the default bytesize, as that makes IMAGE files
have 7-bit bytes instead of 36-bit bytes.
4202 JLC 15-Feb-85
Move ALCHN. and DECHN. to FORMEM, so the call to %SAVAC can be
changed the SAVAC routine local to FORMEM.
4203 JLC 13-Mar-85
Set D%IN and D%OUT for TTY to avoid going to OSWTCH code.
Fix DSKREN so that the path block is copied correctly.
Store user-supplied bytesize separately from actual bytesize
used, so that going through the code again will not do
weird things.
4205 JLC 19-Mar-85
Allow *.* for filename for TOPS-10 magtapes, clearing
the filename and extension field so that the TOPS-10 labeled tape
processor gets the "next file" on the tape. Make some of the
pseudonyms for RECORDTYPE invisible for DIALOG, and modify FNDSWT
so that it does not return those strings for INQUIRE.
Make PRINT, READ *, and WRITE * go to TTY for FTVAX.
***** End V10 Development *****
***** End Revision History *****
\
FSRCH
IF20,< SEARCH QSRMAC,GLXMAC >
INTERN %EXIT1
INTERN %SETIN,%SETOUT,%CLSOP,%CLSCL
INTERN %MTPRM,%LABCK
INTERN %UNNAM,%ERFNS
INTERN %OPENX,%LSTBF
INTERN %ARGNM,%EX1N,%OWGBT
INTERN %TXTBF,%GTFNS
INTERN %RNAMU,%RNAMD
INTERN O.DIAL
EXTERN %FLIDX
EXTERN A.END,A.ERR,A.IOS,%CUNIT,%OCCOC,%CCMSK,%OCLR
EXTERN %POPJ,%POPJ1,%POPJ2
EXTERN %SAVE1,%SAVE2,%SAVE3,%SAVE4,%SAVAC,%CPARG,%PUSHT,%POPT
EXTERN %GTBLK,%FREBLK,%GTPGS,%FREPGS
EXTERN %OCRLF,%PTOF
EXTERN %JIBLK,D.BSTP,%NAMLN
EXTERN %CRLF,%SMAPW,%OSDSK,%OSMAP,%OBUF,%ISBUF
EXTERN %MTBSB,%MTEOF,%MTFSF,%MTBSA
EXTERN %ABORT,%ABFLG
EXTERN %DDBTAB,%UDBAD,I.PID,%SIZTB
EXTERN D.TTY,U.TTY,U.ERR,AU.ACS
IF10,< EXTERN %RANWR,I.JOB >
EXTERN %SETAV
EXTERN %RMISW,%RMOSW,%RMCLS,%RMOPN,%RMLKP,%RMRFS,%RMDSP,%RMREN
EXTERN U.RERD
SEGMENT CODE
SUBTTL OPEN
FENTRY (OPEN)
PUSHJ P,%SAVAC ;SAVE USER'S ACS, COPY ARG LIST
PUSHJ P,%CPARG
XMOVEI T1,[ASCIZ /OPEN/] ;SET STATEMENT NAME FOR ERROR MESSAGES
MOVEM T1,%IONAM
PUSHJ P,CLCVAR ;CLEAR COMMON OPEN/CLOSE VARIABLES
PUSHJ P,OPNCNV ;CONVERT OLD ARG BLOCK FORMAT
PUSHJ P,OICCPY ;COPY ARG LIST TO KEYWORD BLOCK
PUSHJ P,UNRNGE ;Check unit range
;Unit may not be closed yet. In an case,
;get a new one.
MOVEI T1,ULEN ;Length of a unit block
PUSHJ P,%GTBLK ;Allocate it
$ACALL MFU ;CAN'T
MOVE U,T1 ;Point to empty unit block
MOVE T2,%CUNIT ;Stick unit number in block
STORE T2,UNUM(U)
MOVEI T1,DLEN ;Length of a DDB block
PUSHJ P,%GTBLK ;Allocate it
$ACALL MFU ;CAN'T
MOVE D,T1 ;Point to empty DDB block
MOVEM U,%UDBAD ;FLAG THAT WE HAVE A PROPER DDB
MOVEM D,DDBAD(U) ;SAVE DDB ADDR
;Setup the U and D blocks with information from the arg list.
;Possibly dialog mode will be flagged.
;PAST VERSIONS OF THE FORTRAN COMPILER ALLOWED BOTH DIALOG
;AND DIALOG= TO BE SPECIFIED IN THE SAME OPEN STATEMENT,
;AND NAME= HAD THE SAME KEYWORD NUMBER AS DIALOG. TO ALLOW
;FOR MOST OF THE BOGUS (BUT WORKING) COMBINATIONS IN THESE
;OLD PROGRAMS' REL FILES, WE CLEAR O.DIAL AND LET OPNARG
;SET UP POSSIBLY BOTH O.DIAS (FOR A DIALOG= STRING) AND
;O.DIAL (FOR DIALOG WITH NO STRING).
SETZM O.DIAL ;KLUDGE - FILLED IN BY OPNARG
PUSHJ P,OPNARG ;Copy arguments from arg list
PUSHJ P,DFDEV ;Setup default device
PUSHJ P,DFFILE ;SETUP DEFAULT FILENAME
PUSHJ P,PPNDIR ;[4135] TRANSLATE PPN TO DIRECTORY IF NECESSARY
SKIPE O.DFLT ;DEFAULTFILE= SEEN?
PUSHJ P,DFOPN ;YES. PROCESS IT
SKIPE O.FILE ;FILE='string' SEEN?
PUSHJ P,FILOPN ;YES. PROCESS IT
SKIPE O.NAME ;NAME= SEEN?
PUSHJ P,NAMOPN ;YES. DO IT
SKIPE O.DIAS ;DIALOG= SEEN?
PUSHJ P,DLSOPN ;Yes, do it
PUSHJ P,OPNDLG ;GO DO DIALOG IF NECESSARY
;OPEN args all read in (including "DIALOG" if specified).
PUSHJ P,SMBA ;SET MODE BY ACCESS
MOVX T1,D%OPEN ;"Explicit OPEN statement has been done"
IORM T1,FLAGS(D) ; Set DDB flag
PUSHJ P,OPENZ ;OPEN FILE IF NOT DEFERRED
HXRE T1,UNUM(U) ; Get unit number
MOVEM U,%DDBTAB(T1) ;Store unit block address in DDBTAB.
PJRST %SETAV ;Set AVAR if given, return from OPEN
OPNCON: MOVE P1,%CUNIT ;GET UNIT # AGAIN
SKIPN P1,%DDBTA(P1) ;GET UDB ADDR
POPJ P, ;NONE. JUST PROCEED WITH OPEN
MOVE P2,DDBAD(P1) ;GET DDB ADDR
;IF THE USER DID NOT SPECIFY FILE= IN THE SUCCEEDING OPEN, THE FILENAME
;COMPARISON IS SKIPPED, SINCE IT IS OBVIOUS THAT THE USER WANTS US TO
;REMEMBER THE FILENAME USED FOR THE ORIGINAL OPEN, BUT FOROTS HAS
;SUBSTITUTED FORnn.DAT.
SKIPN FILPRS(D) ;IF USER DID NOT SPECIFY FILE=
JRST NOCFIL ;DO NOT COMPARE FILESPECS
PUSHJ P,CMPFIL ;CHECK FILE STRING
JRST CLZUNT ;BAD
NOCFIL: PUSHJ P,CMPSTA ;CHECK STATUS
JRST CLZUNT ;BAD
PUSHJ P,CMPMOD ;CHECK MODE
JRST CLZUNT ;BAD
PUSHJ P,CMPFRM ;CHECK FORM
JRST CLZUNT ;BAD
PUSHJ P,CMPACC ;CHECK ACCESS
JRST CLZUNT ;BAD
LOAD T1,BLNK(U) ;GET BLANK=
STORE T1,BLNK(P1) ;STORE IN OLD FILE DDB
LOAD T1,CC(U) ;GET CARRIAGE=
STORE T1,CC(P1) ;STORE IN OLD FILE DDB
LOAD T1,PADCH(U) ;GET PADCHAR
STORE T1,PADCH(P1) ;STORE IN OLD FILE DDB
AOS (P) ;SKIP RETURN
POPJ P,
;CLZUNT-- Routine to do an implicit "CLOSE (UNIT=un)"
;U points to unit block
; The ERR= and IOSTAT= args are copied from the OPEN parameters.
CLZUNT: MOVEM U,SAVEU ;SAVE NEW DDB
MOVEM D,SAVED
MOVE T1,%CUNIT ;GET UNIT #
MOVE U,%DDBTAB(T1) ;GET UDB
MOVE D,DDBAD(U) ;Get old DDB block
PUSHJ P,%CLOSX ;Go close it.
MOVE U,SAVEU ;RESTORE NEW DDB
MOVEM U,%UDBAD ;[4135] SAVE AGAIN - %CLOSX CLOBBERED IT
MOVE D,SAVED
POPJ P,
SEGMENT DATA
SAVEU: BLOCK 1 ;SAVED UNIT BLOCK
SAVED: BLOCK 1 ;SAVED DEVICE BLOCK
;COMPARE ROUTINES FOR OPEN ON A CONNECTED UNIT
SEGMENT CODE
CMPFIL: MOVEM U,INQUDB ;SAVE UDB ADDR
MOVE T1,FLAGS(P2) ;GET DDB FLAGS OF OLD FILE
TXNN T1,D%OPEN+D%IN+D%OUT ;FILE OPEN?
POPJ P, ;NO
TXNN T1,D%IN+D%OUT ;IS FILE ACTUALLY OPEN?
JRST OPCNJ ;NO. GO DO PARSE-ONLY COMPARISON
MOVE U,P1 ;GET OLD UDB ADDR
MOVE D,P2 ;GET OLD DDB ADDR
MOVE T1,[POINT 7,TXTBF2] ;GET FULL FILE STRING
PUSHJ P,%GTFNS
;NOW WE TAKE THE INFORMATION GLEANED FROM THE FILE= SPEC OF THE
;NEW OPEN STATEMENT AND TRY TO LOOKUP THE FILE IN ORDER TO EXPAND
;THE FILE STRING.
MOVE U,INQUDB ;GET NEW UDB AGAIN
MOVE D,DDBAD(U) ;GET DDB ADDR
PUSHJ P,LOOKF ;LOOKUP FILE
POPJ P, ;FILE NOT FOUND
MOVE T1,[POINT 7,%TXTBF] ;GET FILE STRING
PUSHJ P,%GTFNS
PUSHJ P,RELJFN ;RELEASE THE JFN
JRST OPCCOM ;GO COMPARE FILE STRINGS
OPCNJ: MOVE U,P1 ;GET OLD UDB ADDR
MOVE D,P2 ;GET OLD DDB ADDR
MOVE T1,[POINT 7,TXTBF2] ;POINT TO DDB FILESTRING BLOCK
PUSHJ P,%GTFNS ;DO PARSE-ONLY GTJFN, JFNS
MOVE U,INQUDB ;GET NEW UDB AGAIN
MOVE D,DDBAD(U) ;GET DDB ADDR
MOVE T1,[POINT 7,%TXTBF] ;POINT TO OPEN FILESTRING BLOCK
PUSHJ P,%GTFNS ;DO PARSE-ONLY GTJFN, JFNS
OPCCOM: MOVEI T3,LTEXTC ;SETUP FOR COMPARE
MOVEI T0,(T3)
MOVE T1,[POINT 7,%TXTBF] ;NEW OPEN FILESTRING
MOVE T4,[POINT 7,TXTBF2] ;OLD OPEN FILESTRING
EXTEND T0,[EXP <CMPSN>,0,0] ;SKIP IF NOT EQUAL
AOS (P) ;EQUAL. SKIP RETURN
POPJ P,
CMPMOD: LOAD T1,MODE(D) ;GET NEW MODE
JUMPE T1,%POPJ1 ;OK IF NONE
LOAD T2,MODE(P2) ;GET OLD MODE
CAIN T1,(T2) ;EQUAL?
AOS (P) ;YES. SKIP RETURN
POPJ P,
;CMPSTA - IN ORDER TO MAINTAIN COMPATIBILITY WITH V6, ONLY FILES
;OPENED WITH STATUS='OLD' ARE CONSIDERED TO BE CANDIDATES FOR
;A "CONNECTED OPEN". OTHERWISE, CMPSTA WILL NON-SKIP RETURN, FORCING
;THE CURRENTLY OPEN FILE TO BE CLOSED FIRST.
CMPSTA: LOAD T1,STAT(D) ;GET STATUS OF NEW ONE
CAIN T1,ST.OLD ;IS IT OLD?
AOS (P) ;YES. SKIP RETURN
POPJ P,
CMPFRM: LOAD T1,FORM(D) ;GET FORMAT OF NEW FILE
JUMPE T1,%POPJ1 ;OK IF NONE
LOAD T2,FORM(P2) ;GET OLD ONE
CAIN T1,(T2) ;EQUAL?
AOS (P) ;YES. SKIP RETURN
POPJ P,
CMPACC: LOAD T1,ACC(D) ;GET ACCESS OF NEW FILE
CAIE T1,AC.SIO ;[4171] SEQINOUT (OR NONE SPECIFIED?)
JRST NOTSIO ;[4171] NO
LOAD T2,ACC(P2) ;[4171] GET OLD ONE
CAIE T2,AC.SOU ;[4171] SEQOUT?
CAIN T2,AC.SIO ;[4171] OR SEQINOUT?
JRST %POPJ1 ;[4171] YES. SKIP RETURN
NOTSIO: LOAD T2,ACC(P2) ;[4171] GET OLD ONE
CAIN T1,(T2) ;EQUAL?
AOS (P) ;YES. SKIP RETURN
POPJ P,
;%OPENX - Routine to do implicit open
;This routine is used by all I/O statements that do
;an implicit OPEN.
;This routine must only be called when the arguments given
;so far do not conflict.
; D and U are setup with the implicit args.
; Errors go to ERR= or call DIALOG.
;If no errors, DDBTAB entry is set up.
; ** Implicit OPEN routine starts here **
%OPENX: PUSHJ P,CLCVAR ;CLEAR COMMON OPEN/CLOSE VARIABLES
PUSHJ P,DFDEV ;Set default device
PUSHJ P,DFFILE ;Set default filespec info based on STATUS
MOVEI T1,BL.ZERO ;BLANK=ZERO IF NO OPEN STATEMENT
LOAD T2,INDX(D) ;GET DEVICE INDEX
CAIN T2,DI.TTY ;TTY?
MOVEI T1,BL.NULL ;YES. SET BLANK=NULL
STORE T1,BLNK(U) ;Store the value
PUSHJ P,OPENZ ;OPEN FILE
HXRE T1,UNUM(U) ; Get unit number
MOVEM U,%DDBTAB(T1) ;Store unit block address in DDBTAB.
POPJ P,
;HERE IF FILE WAS NOT ACTUALLY OPENED PREVIOUSLY,
;BUT DID HAVE MOST OF THE (DEFERRED) OPEN CODE EXECUTED.
;DOOPEN IS CALLED, BUT THE CODE REVERTS TO OPENX IF
;AN ERROR OCCURS. THIS IS ALSO CALLED BY CLOSE.
OPNLP: PUSHJ P,OPENX ;SETUP THE DDB WITH PROPER DEFAULTS
PUSHJ P,MARKCS ;Mark for consolidation if we can
JRST OPNLP ;CONFLICT FOUND. TRY AGAIN
MOVE T1,FLAGS(D) ;SEE IF FILE IS OPEN ALREADY
TXNE T1,D%IN+D%OUT ;AND IF IT IS
POPJ P, ;DON'T OPEN IT AGAIN
OPENY: PUSHJ P,DOOPEN ;Do the OPEN
JRST OPNLP ;FAILED
OPNDN: LOAD T1,SAIDX(D) ;GET STATUS/ACCESS INDEX
MOVE T1,DOPFLG(T1) ;GET FLAGS
IORM T1,FLAGS(D) ;RECORD THE FACT THAT THE FILE IS OPEN
POPJ P,
;HERE TO OPEN A FILE WHICH HAS NOT BEEN TOUCHED BEFORE.
;IF STATUS/ACCESS INDEX IS SA.UR (UNKNOWN, READ), IT IS
;A "DEFERRED OPEN" AND THE FINAL OPEN AWAITS THE FIRST
;READ OR WRITE OR CLOSE.
OPENZ: PUSHJ P,OPENX ;SETUP THE DDB WITH PROPER DEFAULTS
PUSHJ P,OPENC ;CHECK FOR OPEN ON A CONNECTED UNIT
POPJ P, ;IT IS. WE'RE DONE
PUSHJ P,MARKCS ;Mark for consolidation if we can
JRST OPENZ ;CONFLICT FOUND. TRY AGAIN
MOVE T1,FLAGS(D) ;SEE IF FILE IS OPEN ALREADY
TXNE T1,D%IN+D%OUT ;AND IF IT IS
POPJ P, ;DON'T OPEN IT AGAIN
LOAD T1,SAIDX(D) ;GET STATUS/ACCESS INDEX
CAIN T1,SA.UR ;UNKNOWN, READ?
POPJ P, ;YES. DON'T OPEN THE FILE YET
PUSHJ P,DOOPEN ;NO. OPEN THE FILE NOW
JRST OPENZ ;FAILED. TRY AGAIN
LOAD T1,SAIDX(D) ;GET STATUS/ACCESS INDEX
MOVE T1,DOPFLG(T1) ;GET OPEN FLAGS FOR IT
IORM T1,FLAGS(D) ;SAVE THEM
POPJ P,
;Here if we either know or suspect that there are conflicts
; in the args given.
OPENX: PUSHJ P,OPNDLG ;Do DIALOG mode if necessary
PUSHJ P,CKCONF ;Check conflicts in OPEN switches now
JRST OPENX ;Conflicts, go fix
PUSHJ P,OPDFLT ;Set other defaults
PUSHJ P,DFDEV1 ;Get real device info
JRST OPENX ;Fix problem
PUSHJ P,DSCALC ;CALCULATE DISPOSE/STATUS INDEX
JRST OPENX ;CONFLICT. TRY AGAIN
LOAD T1,STAT(D) ;Get status
CAIL T1,ST.DISP ;IS IT A CLOSE DISPOSITION?
MOVEI T1,ST.UNK ;YES. USE STATUS=UNKNOWN
IMULI T1,AC.NUM ;POINT TO CORRECT SECTION IN TABLE
LOAD T2,ACC(D) ;GET ACCESS
ADDI T1,(T2) ;POINT TO CORRECT ENTRY IN TABLE
SKIPGE T1,SATAB(T1) ;GET STATUS/ACCESS INDEX
JRST SAILL ;ILLEGAL. REPORT AND GO TO OPENX
STORE T1,SAIDX(D) ;SAVE IT
POPJ P,
SAILL: LOAD T1,STAT(D) ;GET STATUS
MOVEM T1,%OPNV1
MOVEI T1,OK.STAT ;AND STATUS KEYWORD VALUE
MOVEM T1,%OPNK1
LOAD T1,ACC(D) ;GET ACCESS
MOVEM T1,%OPNV2
MOVEI T1,OK.ACC ;AND ACCESS KEYWORD VALUE
MOVEM T1,%OPNK2 ;[4205]
PUSHJ P,OPCONF ;REPORT ERROR
JRST OPENX ;AND TRY AGAIN
OPENC: PUSHJ P,OPNCON ;CHECK FOR OPEN ON A CONNECTED UNIT
JRST %POPJ1 ;IT IS NOT. SKIP RETURN
;WE HAVE AN OPEN ON A CONNECTED UNIT. DEALLOCATE THE UDB AND DDB,
;AND SET U AND D TO THE OLD UDB AND DDB AND GO SET THE ASSOCIATE
;VARIABLE, IF ONE IS GIVEN.
MOVE T1,U ;DEALLOCATE U
PUSHJ P,%FREBLK
MOVE T1,D ;DEALLOCATE D
PUSHJ P,%FREBLK
MOVE U,%CUNIT ;GET UNIT NUMBER AGAIN
MOVE U,%DDBTAB(U) ;GET UDB ADDR
MOVEM U,%UDBAD ;POINT TO CORRECT UDB
MOVE D,DDBAD(U) ;GET DDB ADDR
POPJ P, ;NON-SKIP RETURN
DSCALC: LOAD T1,DISP(D) ;GET DISPOSE VALUE
IMULI T1,ST.NUM ;GET CORRECT PART OF TABLE
LOAD T2,STAT(D) ;GET STATUS
ADDI T1,(T2) ;GET INDEX INTO TABLE
SKIPGE T1,DSTAB(T1) ;GET DISPOSE/STATUS INDEX
JRST DSILL ;ILLEGAL COMBINATION
HLRZ T2,NEWDSP(T1) ;GET ORTHOGONAL DISPOSE VALUE
STORE T2,ODISP(D) ;SAVE IT
HRRZ T2,NEWDSP(T1) ;GET ORTHOGONAL STATUS VALUE
STORE T2,OSTAT(D) ;SAVE IT
JRST %POPJ1 ;SKIP RETURN
DSILL: LOAD T1,STAT(D) ;GET STATUS
MOVEM T1,%OPNV1
MOVEI T1,OK.STAT ;AND STATUS KEYWORD VALUE
MOVEM T1,%OPNK1
LOAD T1,DISP(D) ;GET DISPOSE
MOVEM T1,%OPNV2
MOVEI T1,OK.DISP ;AND DISPOSE KEYWORD VALUE
MOVEM T1,%OPNK2
PJRST OPCONF ;REPORT ERROR, REQUEST DIALOG
;Routine to check for unit out of range
;Input:
; O.UNIT/ unit number argument from OPEN or CLOSE arg list
; PUSHJ P,UNRNGE
; <return here if unit in range>
; If unit is not in range for OPEN or CLOSE,
; the program takes ERR= path or aborts.
UNRNGE: SKIPN T1,O.UNIT ;UNIT SPECIFIED?
$ACALL UNS ;NO. FATAL
MOVE T2,@T1 ;YES. GET IT
MOVEM T2,%CUNIT ;SAVE IT
CAML T2,[MINUNIT] ;Skip if less than the minimum
CAILE T2,MAXUNIT ;Skip if .LE. the maximum
$ACALL IUN ;?UNIT out of range
POPJ P, ;Ok, unit in range
;CKCONF - Routine to check for conflicts in OPEN args.
;Called after each DIALOG to check for bad arguments,
; inconsistancies, etc.
; This routine gives error messages (possibly takes ERR= branch),
; or sets O.DIAL if there are errors.
;It must be called in OPEN after OPNARG, and after each
; DIALOG.
;If no errors, returns .+2
CKCONF:
;Check /MODE and /FORM conflict
CKCNFM: LOAD T1,FORM(D) ;T1= form
JUMPE T1,CKCNAC ;If not specified, no conflict
LOAD T2,MODE(D) ;T2= mode
JUMPE T2,CKCNAC ;If not specified, no conflict
CAIL T2,MD.ASC ;ASCII or greater implies /FORM:F
JRST CKFMF ;Go check that
;Must be /FORM:UNFORMATTED
CKFMU: CAIN T1,FM.UNF ;UNFORMATTED?
JRST CKCNAC ;Yes, ok
CKFMUE: MOVEM T1,%OPNV2 ;Store value for error message
MOVEI T1,OK.MOD ;Store switch numbers
MOVEM T1,%OPNK1
MOVEI T1,OK.FORM
MOVEM T1,%OPNK2
MOVEM T2,%OPNV1 ;Value of /MODE
PUSHJ P,OPCONF ;Give error
JRST CKCNAC ;Go on
;Here if /FORM must be "FORMATTED"
CKFMF: CAIE T1,FM.FORM ;FORMATTED?
JRST CKFMUE ;No, give error
;Check conflict of /ACCESS and /READONLY
CKCNAC: LOAD T1,RO(D) ;T1= "Readonly" bit
JUMPE T1,CKCSRO ;If not specified, no conflict
LOAD T2,ACC(D) ;T2= ACCESS
CAIE T2,AC.SOU ;SEQOUT?
CAIN T2,AC.APP ; or APPEND?
JRST .+2 ;Yes, can't have READONLY
JRST CKCSRO ;Otherwise it's ok
MOVEM T2,%OPNV1 ;Store value of ACCESS
SETZM %OPNV2 ;READONLY has no value
MOVEI T1,OK.ACC
MOVEM T1,%OPNK1
MOVEI T1,OK.RO
MOVEM T1,%OPNK2
PUSHJ P,OPCONF ;Give error
;Check conflict of /STATUS and /READONLY
CKCSRO: LOAD T1,RO(D) ;Get value of /READONLY
JUMPE T1,CKCACM ;[4205] Not specified, no conflict
LOAD T2,STAT(D) ;Get /STATUS
CAIE T2,ST.NEW
CAIN T2,ST.SCR ;New and scratch don't make sense
JRST .+2
JRST CKCACM ;[4205] Otherwise OK
MOVEM T2,%OPNV1
SETZM %OPNV2 ;READONLY has no value
MOVEI T1,OK.STAT
MOVEM T1,%OPNK1
MOVEI T1,OK.RO
MOVEM T1,%OPNK2
PUSHJ P,OPCONF ;Give error
;Check /ACCESS conflict with /MODE
CKCACM: LOAD T1,ACC(D) ;Get /ACCESS
LOAD T2,MODE(D) ;Get /MODE
CAIE T1,AC.RIN ;Random?
CAIN T1,AC.RIO
JRST .+2 ;Yes
JRST CHKRSZ ;No, -- next check
;Random (DIRECT) access.
CAIE T2,MD.DMP ;/MODE:DUMP illegal (not hard to make
; it legal at some future date.. if so
; each record would be a block and /RECORDSIZE
; could not also be specified (??).).
JRST CHKRSZ ;Not /MODE:DUMP, go on.
MOVEM T1,%OPNV1 ;Value of ACCESS
MOVEM T2,%OPNV2 ;Value of MODE
MOVEI T1,OK.ACC
MOVEM T1,%OPNK1
MOVEI T1,OK.MODE
MOVEM T1,%OPNK2
PUSHJ P,OPCONF ;Give error
;Make sure he specified "RECORDSIZE" if random access requested
CHKRSZ: LOAD T1,ACC(D) ;GET /ACCESS
CAIE T1,AC.RIN ;RANDOM?
CAIN T1,AC.RIO
JRST .+2 ;YES
JRST CKRETN ;[4205] RETURN FROM CHECKING CONFLICTS
MOVE T1,RSIZE(D) ;GET /RECORDSIZE
JUMPN T1,CKRETN ;[4205] NONZERO, OK
$DCALL RRR ;"?Random IO requires /RECORDSIZE"
CKRETN: SKIPN O.DIAL ;[4205] DID WE REPORT A BAD ERROR?
AOS (P) ;[4205] NO. SKIP RETURN
POPJ P, ;[4205]
;ROUTINE TO TYPE ERROR MESSAGE FOR CONFLICTING OPEN SWITCHES
;ARGS: %OPNK1 = KEYWORD NUMBER OF FIRST CONFLICTING SWITCH
; %OPNV1 = KEYWORD-VALUE NUMBER OF SWITCH
; %OPNK2 = KEYWORD NUMBER OF OTHER CONFLICTING SWITCH
; %OPNV2 = KEYWORD-VALUE NUMBER, OR -1 IF SWITCH DOESN'T TAKE VALUE
OPCONF: MOVE T1,%OPNK1 ;GET FIRST SWITCH NUMBER
MOVEI T2,OPNSWT ;POINT TO SWITCH TABLE
PUSHJ P,FNDSWT ;FIND CORRESPONDING STRING IN OPNSWT
EXCH T1,%OPNK1 ;SAVE STRING ADDRESS, GET SWITCH NUMBER
HRRZ T2,OPNDSP(T1) ;GET SWITCH VALUE TABLE ADDRESS
MOVE T1,%OPNV1 ;GET SWITCH VALUE NUMBER
PUSHJ P,FNDSWT ;FIND SWITCH VALUE STRING IN ITS TABLE
MOVEM T1,%OPNV1 ;STORE STRING ADDRESS
MOVE T1,%OPNK2 ;SAME FOR SECOND SWITCH
MOVEI T2,OPNSWT
PUSHJ P,FNDSWT
EXCH T1,%OPNK2
HRRZ T2,OPNDSP(T1)
MOVE T1,%OPNV2
PUSHJ P,FNDSWT
MOVEM T1,%OPNV2
$DCALL ICA ;INCOMPATIBLE ATTRIBUTES
SUBTTL CNFDEV - Check for conflicts for OPEN device
;++ ;[4151]re-write
; FUNCTIONAL DESCRIPTION:
;
; Check the OPEN statement keywords (including default settings)
; to see if there is a conflict in them. This routine is called
; after we have determined the actual type of device by performing
; a DVCHR jsys on the device name string. This routine will check
; for conflicts in MODE and ACCESS specifiers with the type of
; device. For instance a card reader (CDR:) cannot be opened for
; Access='SEQOUT'. If there is a conflict, either ERR= is taken
; or an error message is typed and O.DIAL is set.
;
; CALLING SEQUENCE:
;
; Called ONLY by routine DOOPEN
;
; PUSHJ P,CNFDEV ;CHECK FOR DEVICE CONFLICTS
; <error return>
; <good return>
;
; INPUT PARAMETERS:
;
; None
;
; IMPLICIT INPUTS:
;
; DVBTS(D) - Device characteristics (from the DVCHR JSYS)
; ACC(D) - File Access type specified in open statement
; INDX(D) - Device index (from the DVCHR JSYS)
; BLKSZ(D) - Block Size specified in open statement
; RSIZE(D) - Record size specified in open statement
; RECTP(D) - Record type specified in open statement
; MODE(D) - Hardware data mode specified in open statement
;
; OUTPUT PARAMETERS:
;
; None
;
; IMPLICIT OUTPUTS:
;
; None
;
; SIDE EFFECTS:
;
; If a conflict is detected the routine will not return to the
; caller, but, will perform the error processing (described above).
;
;--
;+
; Readonly devices cannot do output
;-
CNFDEV: MOVE T1,DVBTS(D) ;Get device charactistics (DEVCHR) bits
TXNE T1,DV%OUT ;Can this device do output?
JRST CNFDV1 ;Yes, No further checking required
LOAD T1,ACC(D) ;No, Get type of access specified
CAIE T1,AC.SOU ;Is Access = SEQOUT
CAIN T1,AC.APP ;or Access = APPEND ?
JRST CNFDAC ;Yes, Conflict "device cannot do output"
CAIE T1,AC.RIO ;Is Access = RANDOM (DIRECT)
CAIN T1,AC.RIN ;or Access = RANDIN ?
JRST CNFDAC ;Yes, Conflict "device cannot do output"
; JRST CNFDV1 ;No Conflict
;+
; WriteOnly devices cannot do input
;-
CNFDV1: MOVE T1,DVBTS(D) ;Get device characistics (DEVCHR) bits
TXNE T1,DV%IN ;Can this device do input?
JRST CNFDV2 ;Yes, No further cheching required
LOAD T1,ACC(D) ;Get type of ACCESS specified
CAIE T1,AC.RIN ;Is Access = RANDOM
CAIN T1,AC.RIO ;or Access = RANDIN ?
JRST CNFDAC ;Yes, Conflict "device cannot do input"
CAIN T1,AC.SIN ;Is Access = SEQIN ?
JRST CNFDAC ;Yes, Conflict "device cannot do input"
; JRST CNFDV2 ;No Conflict
;+
; Check for DIRECT access specified for a sequential device
;-
CNFDV2: LOAD T1,ACC(D) ;Get type of ACCESS specified
CAIE T1,AC.RIN ;Is Access = RANDOM
CAIN T1,AC.RIO ;or Access = RANDIN ?
JRST .+2 ;Yes, check to see if device allows this
JRST CNFDV3 ;Not RANDOM access
LOAD T2,INDX(D) ;Get device index
CAIE T2,DI.DSK ;The only random access device is disk!
JRST CNFDAC ;Random access not allowed !
JRST CNFDV3 ;No Conflict
;
; Access type Conflicts with type of device
;
CNFDAC: MOVEI T2,SWACC ;Get switch value table address
PUSHJ P,FNDSWT ;Find switch value string in its table
; IOERR (IAC,30,248,/ACCESS:$Z is illegal for this device)
$DCALL IAC ;Set O.DIAL if ERR= not taken
;+
; /BLOCKSIZE only allowed with magtape.
;-
CNFDV3: LOAD T1,INDX(D) ;Get device type
CAIN T1,DI.MTA ;Is it a Magtape?
JRST CNFMT1 ;Yes, Go do Magtape checks
;No, Do Blocksize check
LOAD T1,BLKSZ(D) ;Get /BLOCKSIZE
JUMPE T1,CNFDV4 ;Jump if not specified
$ECALL BSI ;BLOCKSIZE IGNORED FOR NON-MAGTAPE
JRST CNFDV4 ;No conflict (and NOT a magtape).
;+ ;[4157]<
; /RECORDSIZE must be specified for a fixed length record.
;-
CNFMT1: LOAD T1,RECTP(D) ;Get /RECORDTYPE
CAIE T1,RT.FIX ;Is it Fixed-Length?
JRST CNFMT3 ;No, not fixed.
LOAD T1,RSIZE(D) ;Yes, Get /RECL
JUMPN T1,CNFMT5 ;Jump if it is specified
; "/RECORDSIZE required for FIXED-LENGTH records"
$DCALL FRR ;None specified.
;+
; Magtape Check - Carriage Control specified for Fixed-Length and
; Delimited records (Can't be translated)
;-
CNFMT3:;LOAD T1,RECT(D) ;Get /RECORDTYPE
CAIE T1,RT.DEL ;Is it DELIMITED
JRST CNFMT7 ;No
CNFMT5: LOAD T2,CC(U) ;Get /CARRIAGECONTROL
CAIN T2,CC.TRN ;Is it translated?
; "/CARRIAGECONTROL:TRANSLATED illegal with this RECORDTYPE"
$DCALL CIR ;/CARRIAGECONTROL illegal with /RECTYPE:
;+
; Magtape Check - See if RECORDSIZE larger than BLOCKSIZE
;-
CNFMT7: LOAD T1,BLKSZ(D) ;Get BLOCKSIZE
JUMPE T1,CNFDV4 ;No BLOCKSIZE specified?
LOAD T2,RSIZE(D) ;Get RECORDSIZE
JUMPE T2,CNFDV4 ;No RECORDSIZE specified?
CAMGE T1,T2 ;BLOCKSIZE .GE. RECORDSIZE
$DCALL RLB ;Nope, Thats an error.
; JRST CNFDV4 ;It's OK! >[4157]
;+
; Check to see that the device can be opened in the requested mode
;-
CNFDV4: LOAD T1,INDX(D) ;Get device type
LOAD T2,MODE(D) ;Get mode
JUMPE T2,CNFDV5 ;Jump if no mode specified (no conflict, then)
CAIN T2,MD.ASC ;Everything likes ASCII
JRST CNFDV5
;
; Not ASCII mode
;
CAIN T1,DI.DSK ;Is it a DSK: ?
JRST CNFDV5 ;Yes, everything allowed, No conflict
;No, Not a DSK: device
CAIE T2,MD.DMP ;Is it Dump mode ?
JRST CNFDV5 ;No (it's not dump mode). No conflict
;
; Mode is DUMP and device is not a disk. Mode conflicts with device
;
CNFD4X: MOVE T1,T2 ;Get /MODE value
MOVEI T2,SWMODE
PUSHJ P,FNDSWT ;Find switch value string in its table
; IOERR (IDM,n1,n2,/MODE:$A illegal for this device,T1)
$DCALL IDM ;Request DIALOG mode
;
; No conflicts have been detected
;
CNFDV5: JRST %POPJ1 ;No error-- skip return
;End of routine CNFDEV
SUBTTL OPEN
;
;OPNDLG and CLSDLG - routines to check for dialog needed and do it
;Called from OPEN and CLOSE routines
;Returns when everything cleared up.
;
OPNDLG: SKIPN O.DIAL ;DIALOG REQUESTED?
POPJ P, ;NO
SETZM O.DIAL ;TURN IT OFF
PUSHJ P,OPNCTX ;ENTER OPEN CONTEXT
PUSHJ P,CLRCNS ;Clear DDB consolidation pointers, if any
PUSHJ P,DIALOG ;Do DIALOG (could set O.DIAL again)
JRST OPNDLG ; Loop until no errors.
CLSDLG: SKIPN O.DIAL ;DIALOG REQUESTED?
POPJ P, ;NO
SETZM O.DIAL ;TURN IT OFF
PUSHJ P,CLSCTX ;ENTER CLOSE CONTEXT
PUSHJ P,CLRCNS ;Clear DDB consolidation pointers, if any
PUSHJ P,DIALOG ;Do DIALOG (could set O.DIAL again)
JRST CLSDLG ; Loop until no errors.
INQDLG: SKIPN O.DIAL ;DIALOG REQUESTED?
POPJ P, ;NO
SETZM O.DIAL ;TURN IT OFF
PUSHJ P,INQCTX ;ENTER INQUIRE CONTEXT
PUSHJ P,CLRCNS ;Clear DDB consolidation pointers, if any
PUSHJ P,DIALOG ;Do DIALOG (could set O.DIAL again)
JRST INQDLG ; Loop until no errors.
OPNCTX: XMOVEI T1,OPNSWT ;POINT TO OPEN SWITCHES
MOVEM T1,SWTPNT
XMOVEI T1,OPNDSP ;AND KEYWORD PROCESSOR TABLE
MOVEM T1,DSPPNT
POPJ P,
CLSCTX: XMOVEI T1,CLSSWT ;POINT TO CLOSE SWITCHES
MOVEM T1,SWTPNT
XMOVEI T1,CLSDSP ;AND KEYWORD PROCESSOR TABLE
MOVEM T1,DSPPNT
POPJ P,
INQCTX: SETZM SWTPNT ;NO SWITCHES
XMOVEI T1,INQDSP ;POINT TO INQUIRE KEYWORD PROCESSOR
MOVEM T1,DSPPNT
POPJ P,
CLCVAR: SETZM EFSFLG ;FLAG FOR [ENTER CORRECT FILE SPECS]
POPJ P,
;OICCPY - COPIES THE ARGUMENTS INTO THEIR RESPECTIVE KEYWORD
;BLOCK ENTRIES, THEN PUTS ERR= AND IOSTAT= INTO A.ERR AND A.IOS
;WHERE THEY CAN BE USED BY THE ERROR PROCESSOR
OICCPY: SETZM OICBLK ;CLEAR THE KEYWORD BLOCK
MOVE T1,[OICBLK,,OICBLK+1]
BLT T1,OICBLK+OICMAX
HLRE T2,-1(L) ;GET NEG ARG COUNT
MOVE T3,L ;COPY ARG POINTER
OPNCLP: MOVE T1,(T3) ;GET AN ARG
LDB T4,[POINTR ((T3),ARGKWD)] ;GET ITS KEYWORD NUMBER
CAIG T4,OICMAX ;WITHIN RANGE
MOVEM T1,OICBLK(T4) ;YES. SAVE THE ARG
ADDI T3,1 ;INCR THE POINTER
AOJL T2,OPNCLP ;LOOP FOR ALL
MOVE T1,O.ERR ;GET ERR=
MOVEM T1,A.ERR ;SAVE FOR ERROR PROCESSOR
MOVE T1,O.IOS ;GET IOSTAT=
MOVEM T1,A.IOS ;SAVE FOR %SETAV
POPJ P,
;%SETIN-- Get file opened for input
; If already open for input, just returns.
; If file has been opened for output, closes it.
%SETIN: MOVE T1,FLAGS(D) ;Get DDB flags
TXNE T1,D%IN ;File already opened for input?
POPJ P, ;Yes, nothing to do
TXNE T1,D%OUT ;Skip if file opened for output
JRST SWIN ;YES. SWITCH TO INPUT
PUSHJ P,CLCVAR ;CLEAR COMMON OPEN/CLOSE VARIABLES
MOVX T1,SA.UR ;SET STATUS/ACCESS INDEX TO UNKNOWN, READ
STORE T1,SAIDX(D)
PUSHJ P,OPENY ;OPEN FOR SEQUENTIAL INPUT
MOVE T1,FLAGS(D) ;GET FLAGS
TXNE T1,D%IN ;DID WE ACTUALLY OPEN IT FOR INPUT?
POPJ P, ;YES. WE'RE DONE
;File is now opened for output.
SWIN: LOAD T1,ACC(D) ;Get access
PUSHJ P,LOUTIN(T1) ;SWITCH DIRECTION TO INPUT
MOVE T1,FLAGS(D) ;Get DDB flags
TXZ T1,D%OUT ;Clear old direction flag
TXO T1,D%IN ;Set new direction flag
MOVEM T1,FLAGS(D) ;Set in DDB
POPJ P, ;Return
;%SETOUT-- Get file opened for output
; If already open for output, just return.
; If file is read-only, give error (%ABORT).
; If file is open for input, closes it and opens for output.
; (What happens in this case depends on the device).
;Returns .+1
%SETOUT: MOVE T1,FLAGS(D) ;Get DDB flags now
TXNE T1,D%OUT ;File already opened for output?
POPJ P, ;Yes, nothing to do
LOAD T0,MODE(D) ;Get MODE
CAIN T0,MD.ASL ;'LINED'?
$ACALL CWL ;Yes, can't do it.
TXNE T1,D%IN ;IS FILE OPENED FOR INPUT?
JRST SWOUT ;YES. SWITCH TO OUTPUT
PUSHJ P,CLCVAR ;CLEAR COMMON OPEN/CLOSE VARIABLES
MOVEI T1,AC.SOU ;[4135] SET ACCESS TO SEQOUT
STORE T1,ACC(D) ;[4135]
MOVX T1,SA.UW ;SET STATUS/ACCESS TO UNKNOWN, WRITE
STORE T1,SAIDX(D)
PUSHJ P,OPENY ;OPEN THE FILE
MOVE T1,FLAGS(D) ;GET DDB FLAGS
TXNE T1,D%OUT ;DID FILE GET OPENED FOR OUTPUT
POPJ P, ;YES. DONE
;File was open for input, switch to output
SWOUT: LOAD T1,ACC(D) ;Get access mode
PUSHJ P,LINOUT(T1) ;SET NEW DIRECTION
MOVE T1,FLAGS(D) ;Get DDB flags to change
TXZ T1,D%IN ;Clear input
TXO T1,D%OUT+D%MOD+D%WRT ;Set output
MOVEM T1,FLAGS(D) ;Set new flags
POPJ P, ;Done, return
ILLIN: DMOVE T1,[EXP [ASCIZ /read/],[ASCIZ /output/]]
JRST CDT
ILLOUT: DMOVE T1,[EXP [ASCIZ /write/],[ASCIZ /input/]]
CDT: XMOVEI T1,(T1) ;Section number in LH
XMOVEI T2,(T2) ;. .
$ACALL CDT
;HERE TO FIND OUT WHAT TO DO IF LAST OPERATION WAS INPUT
;AND NEXT OPERATION IS OUTPUT, BY ACCESS TYPE
LINOUT: JRST OSWTCH ;SEQINOUT
JRST ILLOUT ;SEQIN
JRST OSWTCH ;SEQOUT
JRST ILLOUT ;RANDIN
JRST %POPJ ;RANDOM
JRST ILLOUT ;APPEND
;HERE TO FIND OUT WHAT TO DO IF LAST OPERATION WAS OUTPUT
;AND NEXT OPERATION IS INPUT, BY ACCESS TYPE
LOUTIN: JRST ISWTCH ;SEQINOUT
JRST ISWTCH ;SEQIN
JRST ISWTCH ;SEQOUT
JRST %POPJ ;RANDIN
JRST %POPJ ;RANDOM
JRST ILLIN ;APPEND
;HERE FOR SEQUENTIAL FILES ON INPUT FOLLOWING OUTPUT.
;-20: JUST CLEAR THE BYTE COUNT, SPECIFYING EOF.
;
;-10: WRITE THE CURRENT WINDOW, CLEAR THE BYTE COUNT.
;
ISWTCH: LOAD T1,INDX(D) ;GET DEVICE INDEX
PJRST ISWTAB(T1) ;GO TO APPROPRIATE ROUTINE
ISWTAB: POPJ P, ;TTY
JRST DSKISW ;DISK
JRST MTAISW ;MAGTAPE
JRST ILLIN ;OTHER. CAN'T SWITCH TO INPUT
JRST %RMISW ;REMOTE STREAM FILE
JRST %RMISW ;RMS FILE
DSKISW: LOAD T1,ACC(D) ;GET ACCESS
CAIN T1,AC.APP ;APPEND?
JRST ILLIN ;YES. CAN'T DO INPUT TO OUTPUT-ONLY FILE
PUSHJ P,%OCLR ;CLEAR UNUSED BYTES IN LAST WORD
PUSHJ P,%OSDSK ;OUTPUT CURRENT OUTPUT WINDOW
SETZM ICNT(D) ;TELL DIREC WE'RE AT EOF!
POPJ P,
MTAISW: PUSHJ P,%CLSOP ;CLOSE FILE, OPEN FOR INPUT
PUSHJ P,%MTPRM ;[4137] SET TAPE PARAMETERS
PUSHJ P,%MTBSB ;BACKSPACE OVER EOF
SETZM ICNT(D) ;BUFFER HAS NO MORE BYTES IN IT
POPJ P, ;DONE
;HERE FOR OUTPUT FOLLOWING INPUT FOR ALL DEVICES.
OSWTCH: LOAD T1,INDX(D) ;GET DEVICE INDEX
PJRST OSWTAB(T1) ;GO TO APPROPRIATE ROUTINE
OSWTAB: POPJ P, ;TTY
JRST DSKOSW ;DISK
JRST MTAOSW ;MAGTAPE
JRST ILLOUT ;OTHER. CAN'T SWITCH TO OUTPUT
JRST %RMOSW ;REMOTE STREAM FILE
JRST %RMOSW ;RMS FILE
;DISK OUTPUT SWITCH. IF THE FILE IS INPUT-ONLY, CLOSE
;AND OPEN IT FOR OUTPUT. OTHERWISE JUST USE THE CURRENT
;BUFFER AND BYTE POINTER. IN ANY CASE, WE HAVE TO SET
;THE BYTE COUNT (ICNT) TO THE NUMBER OF BYTES FROM THE
;CURRENT POINTER TO THE END OF A FULL WINDOW. THIS IS CALCULATED
;BY GETTING THE NUMBER OF WORDS FROM THE BEGINNING OF THE WINDOW,
;THEN MULTIPLYING BY BPW(D) TO GET BYTES, THEN SUBTRACTING THIS
;FROM THE FULL WINDOW SIZE, AND ADDING THE NUMBER OF BYTES LEFT
;IN THE CURRENT WORD. THIS LAST QUANTITY IS CALCULATED BY A BIT
;OF "MAGIC" ARITHMETIC: A MULTIPLY OF THE LEFT-HAND OF THE BYTE
;POINTER BY BPW(D); THE HIGH-ORDER WORD OF THE MULTIPLY YIELDS
;THE NUMBER OF LEFTOVER BYTES. THE ARITHMETIC IS, IN FACT,
;MULTIPLYING THE NUMBER OF BITS TO THE RIGHT OF THE CURRENT BYTE
;BY BPW AND THEN DIVIDING BY 32 (BY DINT OF THE
;POSITION WITHIN THE BYTE POINTER OF THE NUMBER OF BITS TO THE
;RIGHT OF THE CURRENT BYTE). THE FORMULAE FOR 6, 7, 8, AND 9-BIT
;BYTES ARE THEN:
;
;6-BIT (N*6)*6/32
;
;7-BIT (N*7+1)*5/32
;
;8-BIT (N*8+4)*4/32
;
;9-BIT (N*9)*4/32
;
;WHERE N IS THE NUMBER OF LEFTOVER BYTES. AS YOU CAN SEE, THE
;QUOTIENT OF ALL OF THESE FORMULAE IS N. SOME OTHER BYTE SIZES WORK
;AS WELL. WE SHALL NOT PRESENT HERE THE THEORETICAL BASIS FOR THE
;ARITHMETIC.
DSKOSW: PUSHJ P,%PTOF ;CALC CURRENT BYTE NUMBER
MOVEM T1,EOFN(D) ;SAVE AS EOF PNTR
MOVE T1,FLAGS(D) ;GET FLAGS
TXZE T1,D%END ;END OF FILE?
SOS CREC(D) ;[2042] YES. DECR THE RECORD COUNT
MOVEM T1,FLAGS(D) ;SAVE FLAGS WITHOUT EOF
PUSHJ P,CLSOUT ;CLOSE FILE, OPEN FOR WRITE
PJRST %SOCNT ;SET OUTPUT COUNT
;MAGTAPE OSWTCH
;BACK OVER ACTIVE BUFFER, OPEN FOR OUTPUT
MTAOSW: PUSHJ P,OSWBAK ;BACKUP TAPE, SET PNTR/COUNT
PUSHJ P,MTACLO ;CLOSE FILE, OPEN FOR OUTPUT
PJRST %MTPRM ;[4137] AND SETUP TAPE PARAMETERS
OSWBAK: MOVE T2,FLAGS(D) ;Get DDB flags
TXZN T2,D%END ;Clear EOF, skip if it was on.
JRST BACKUP ;NOT EOF. GO BACK OVER ACTIVE BUFFER
MOVEM T2,FLAGS(D) ;Remember we cleared EOF
HXLZ T1,BYTPT(D) ;GET BYTE POINTER
MOVEM T1,IPTR(D) ;SAVE IT
SETZM ICNT(D)
SETZM BYTN(D) ;WRITING A NEW FILE
SETZM EOFN(D)
SETZM CREC(D) ;CLEAR RECORD COUNT
POPJ P,
BACKUP: HRRZ T1,IPTR(D) ;GET ADDRESS OF DATA
JUMPE T1,%POPJ ;IF NO DATA, LEAVE
PUSHJ P,%MTBSB ;BACKSPACE OVER ACTIVE BUFFER
%SOCNT: HRRZ T1,IPTR(D) ;GET CURRENT WORD
JUMPE T1,%POPJ ;IF NONE, LEAVE
SUB T1,WADR(D) ;GET OFFSET WITHIN WINDOW
ADDI T1,1 ;GET # WORDS USED
IMUL T1,BPW(D) ;GET # BYTES USED
MOVE T2,IPTR(D) ;GET LEFT HALF OF BP
MUL T2,BPW(D) ;CALC # BYTES LEFT IN WORD
SUBI T1,(T2) ;SUBTRACT THE LEFTOVER BYTES
MOVE T2,WSIZ(D) ;GET THE WINDOW SIZE
SUBI T2,(T1) ;GET # AVAILABLE BYTES
MOVEM T2,ICNT(D) ;SAVE IT FOR I/O
POPJ P,
IF20,<
%LSTBF: PUSHJ P,%OCLR ;CLEAR UNUSED CHARS IN LAST WORD
PUSHJ P,%OBUF ;OUTPUT BUFFER
LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIN T1,DI.MTA ;MAGTAPE?
PUSHJ P,%MTEOF ;YES. WRITE AN EOF MARK
POPJ P,
;CLOSE FILE FOR OUTPUT, OPEN FOR INPUT
%CLSOP: MOVE T1,FLAGS(D) ;GET DDB FLAGS
TXNE T1,D%OUT ;WAS FILE OPEN FOR OUTPUT?
PUSHJ P,%LSTBF ;YES. OUTPUT LAST BUFFERFUL
MOVE T1,IJFN(D) ;CLOSE FILE
HRLI T1,(CO%NRJ) ;KEEP JFN
CLOSF%
$ACALL ISW
MOVE T1,IJFN(D) ;GET JFN AGAIN (WITHOUT BITS IN LH)
MOVE T2,DMABS(D) ;GET DATA MODE & BYTE SIZE FOR OPENF
TRO T2,OF%RD ;SET FOR INPUT
OPENF% ;REOPEN FILE
$ACALL ISW
MOVE T1,FLAGS(D) ;GET DDB FLAGS
TXZ T1,D%END+D%OUT ;NOT DOING OUTPUT ANY MORE, NOR AT EOF
TXO T1,D%IN ;NOW WE ARE DOING INPUT
MOVEM T1,FLAGS(D) ;SAVE UPDATED FLAGS
POPJ P,
;CLOSE MAGTAPE FOR INPUT, OPEN FOR OUTPUT
MTACLO: MOVE T1,IJFN(D) ;REOPEN FILE FOR OUTPUT
HRLI T1,(CO%NRJ)
CLOSF%
$ACALL OSW
MOVE T1,IJFN(D)
MOVE T2,DMABS(D)
TRO T2,OF%WR
OPENF%
$ACALL OSW
POPJ P,
;CLOSE FILE, OPEN FOR OUTPUT
CLSOUT: MOVE T1,FLAGS(D) ;GET DDB FLAGS
TXNE T1,D%WRT ;DO WE HAVE WRITE ACCESS ALREADY?
POPJ P, ;YES. DON'T HAVE TO CLOSE/OPEN
MOVX T1,D%WRT ;We have WRITE access now
IORM T1,FLAGS(D)
SETO T1, ;SET TO UNMAP FILE FOR CLOSING
MOVE T2,WPTR(D) ;GET PAGE ID OF FILE WINDOW
HRLI T2,.FHSLF
LOAD T3,BUFCT(D) ;GET PAGE COUNT
HRLI T3,(PM%CNT)
PMAP%
MOVE T1,IJFN(D) ;CLOSE FILE, KEEP JFN
HRLI T1,(CO%NRJ)
CLOSF%
$ACALL OSW
MOVE T1,IJFN(D) ;GET JFN BACK
MOVE T2,DMABS(D) ;GET DATA MODE AND BYTE SIZE
TRO T2,OF%RD!OF%WR ;GET READ/WRITE ACCESS
OPENF% ;REOPEN FILE
$ACALL OSW
HRRZ T1,IPTR(D) ;GET ADDRESS OF DATA
JUMPE T1,%POPJ ;IF NO DATA, LEAVE
MOVN T1,WSIZ(D) ;SET TO MAP CURRENT WINDOW
ADDM T1,BYTN(D)
PUSHJ P,%SMAPW ;MAP THE PAGES
MOVE T1,WSIZ(D) ;SET NEXT WINDOW BYTE NUMBER
ADDM T1,BYTN(D)
POPJ P,
> ;END IF20
IF10,<
MTACLO: DMOVE T1,IPTR(D) ;SAVE POINTER/COUNT
DMOVEM T1,TPTR(D) ;IN UNUSED HEADER IN DDB
PUSHJ P,FICLOS ;CLOSE FILE, RELEASE CHANNEL
MOVE T1,[FO.PRV+FO.ASC+.FOWRT] ;USE SUPERCEDE
MOVEM T1,FBLK(D) ;STORE IN FILOP BLOCK
PUSHJ P,SETFB ;SETUP FILOP BLOCK
MOVX T1,SA.UW ;SETUP FOR WRITE ACCESS
STORE T1,SAIDX(D)
MOVSI T1,IBCB(D) ;SETUP FOR OUTPUT BUFFER ONLY
MOVEM T1,FBLK+.FOBRH(D)
MOVSI T1,1 ;1 BUFFER ONLY
MOVEM T1,FBLK+.FONBF(D)
PUSHJ P,DOFLP ;Now do the FILOP.
$ACALL OSW ;CAN'T FOR SOME REASON
MOVX T1,BF.IBC ;PREVENT ZEROING OF THE BUFFER
IORM T1,IBCB(D)
MOVE T2,FBLK(D) ;DO INITIAL OUTPUT
HRRI T2,.FOOUT
MOVE T1,[1,,T2]
FILOP. T1,
$ACALL OSW
DMOVE T1,TPTR(D) ;RESTORE POINTER/COUNT
DMOVEM T1,IPTR(D)
POPJ P,
CLSOUT: PUSHJ P,FICLOS ;CLOSE FILE, RELEASE CHANNEL
SKIPE EOFN(D) ;ANYTHING IN FILE?
JRST OSWOPN ;YES. JUST GO OPEN IT
MOVE T1,[FO.PRV+FO.ASC+.FOWRT] ;NO. USE SUPERCEDE FOR NULL FILE
MOVEM T1,FBLK(D) ;STORE IN FILOP BLOCK
PUSHJ P,DOFLP ;OPEN THE FILE
$ACALL OSW ;CAN'T. REPORT IT AND DIE
PUSHJ P,FICLOS ;CLOSE FILE, RELEASE CHANNEL
OSWOPN: MOVE T1,[FO.PRV+FO.ASC+.FOSAU] ;UPDATE MODE
MOVEM T1,FBLK(D) ;STORE IN FILOP BLOCK
MOVE T1,EOFN(D) ;GET # BYTES IN FILE
MOVE T2,BPW(D) ;GET # BYTES/WORD
IMULI T2,200 ;GET # BYTES/BLOCK
ADDI T1,-1(T2)
IDIVI T1,(T2) ;GET # BLOCKS IN FILE
MOVEM T1,BLKN(D) ;[4134] SAVE IT
MOVEM T1,.RBALC+LKPB(D) ;SETUP TO TRUNCATE FILE
PUSHJ P,DOFLP ;Now do the FILOP.
$ACALL OSW ;CAN'T FOR SOME REASON
LOAD T1,MODE(D) ;GET MODE
CAIN T1,MD.DMP ;DUMP?
JRST CLODMP ;YES, UNFORTUNATELY
SKIPN T3,BYTN(D) ;GET BYTE # OF NEXT WINDOW
POPJ P, ;DON'T PROCEED IF NO DATA!
SUB T3,WSIZ(D) ;GET BYTE NUMBER OF THIS WINDOW
MOVE T2,BPW(D) ;GET # BYTES/WORD
LSH T2,9 ;GET # BYTES/PAGE
IDIVI T3,(T2) ;GET PAGE #, # BYTES LEFTOVER
IMULI T3,4 ;GET BLOCK #
ADDI T3,1 ;FIRST BLOCK IS 1
MOVE T2,FBLK(D) ;GET CHANNEL STUFF
HRRI T2,.FOUSO ;DO USETO TO POINT TO CORRECT PAGE
MOVE T1,[2,,T2] ;DO FILOP
FILOP. T1,
$ACALL OSW
POPJ P,
CLODMP: MOVE T3,BLKN(D) ;[4134] GET # BLOCKS IN FILE AGAIN
ADDI T3,1 ;POINT TO NEXT BLOCK
MOVE T2,FBLK(D) ;GET CHANNEL STUFF
HRRI T2,.FOUSO ;DO USETO TO NEXT BLOCK IN FILE
MOVE T1,[2,,T2] ;SETUP FOR FILOP
FILOP. T1, ;SETUP FOR APPENDING
$ACALL OSW
POPJ P,
;Routine to CLOSE and then re-OPEN a file for input.
;This will have the effect of clearing the EOF status if set.
%CLSOP: DMOVE T1,IPTR(D) ;[4141] GET PNTR/COUNT
DMOVEM T1,TPTR(D) ;[4141] SAVE IT
MOVE T1,FLAGS(D) ;GET DDB FLAGS
TXNE T1,D%OUT ;WAS FILE OPEN FOR OUTPUT?
PUSHJ P,%LSTBF ;YES. OUTPUT LAST BUFFERFUL
MOVE T2,FBLK(D) ;GET CHANNEL STUFF
HRRI T2,.FOCLS ;CLOSE THE FILE
MOVE T1,[1,,T2]
FILOP. T1,
$ACALL CLS ;FAILED. TYPE MSG AND DIE
MOVE T2,FBLK(D)
HRRI T2,.FOREL ;RELEASE THE CHANNEL
MOVE T1,[1,,T2]
FILOP. T1,
$ACALL CLS ;FAILED. TYPE MSG AND DIE
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%OUT
ANDCAM T0,FLAGS(D) ;Clear flags
PUSHJ P,SETFB ;SETUP FILOP BLOCK
MOVX T1,SA.UR ;SETUP FOR READ
STORE T1,SAIDX(D)
MOVEI T1,IBCB(D) ;SETUP FOR INPUT BUFFER
MOVEM T1,FBLK+.FOBRH(D)
LOAD T1,BUFCT(D) ;SET BUFFERCOUNT
MOVEM T1,FBLK+.FONBF(D)
PUSHJ P,DOFLP ;Try re-opening the file
$ACALL ISW ;CAN'T FOR SOME OBSCURE REASON
MOVX T1,BF.IBC ;[4141] PREVENT ZEROING OF THE BUFFER
IORM T1,IBCB(D) ;[4141]
DMOVE T1,TPTR(D) ;[4141] RESTORE PNTR/COUNT
DMOVEM T1,IPTR(D) ;[4141]
MOVX T1,D%IN ;SET FILE TO INPUT
IORM T1,FLAGS(D)
POPJ P, ;Done, return
%LSTBF: LOAD T1,MODE(D) ;GET MODE
CAIN T1,MD.DMP ;DUMP?
POPJ P, ;YES. DON'T DO ANYTHING!
PUSHJ P,%OCLR ;CLEAR UNUSED CHARS IN LAST WORD
PJRST %OBUF ;NO. OUTPUT LAST BUFFERFUL
>;END IF10
SUBTTL MOVE ARGUMENTS TO DDB
INQARG: PUSHJ P,INQCTX ;ENTER INQUIRE CONTEXT
JRST COMARG ;JOIN COMMON ARG COPIER
CLSARG: PUSHJ P,CLSCTX ;ENTER CLOSE CONTEXT
JRST COMARG ;JOIN COMMON ARG COPIER
OPNARG: PUSHJ P,OPNCTX ;ENTER OPEN CONTEXT
COMARG: HLRE T1,-1(L) ;GET ARG COUNT
MOVEM T1,ARGCNT ;SAVE IT
OARGLP: LDB T1,[POINTR ((L),ARGKWD)] ;GET NEXT ARG KEYWORD
MOVEM T1,KEYVAL ;SAVE IT
MOVEI T2,(T1) ;COPY IT
ADD T2,DSPPNT ;POINT TO DISPATCH TABLE ENTRY
CAILE T1,OPNMAX ;RANGE CHECK
SKIPA T2,[OPNERR] ;OUT OF BOUNDS, ERROR
HLRZ T2,(T2) ;POINT TO ROUTINE FOR THIS ARG
PUSHJ P,(T2) ;PUT ARG INTO DDB
ADDI L,1 ;INCR ARG POINTER
AOSGE ARGCNT ;DECR COUNT
JRST OARGLP
POPJ P, ;ALL DONE, RETURN
;Routine to call when an OPEN arg is used in CLOSE but it is meaningless.
CLIGN: MOVE T1,KEYVAL ;Get switch number
MOVEI T2,OPNSWT ;Switch table
PUSHJ P,FNDSWT ;Get t1= addr of ASCII arg.
$ECALL NCK ;%Not a CLOSE keyword, ignored
ARGNOP: POPJ P,
;+
; Keyword recognizer for OPEN/CLOSE keywords
;-
OPNKWD:
MOVEI T1,ATMBUF ;MOVE ARG TO ATMBUF
HRLI T1,(POINT 7)
MOVEM T1,DSTBP
MOVEI T1,LATOMC
MOVEM T1,DSTLEN
PUSHJ P,MVARG
MOVE T1,KEYVAL ;GET KEY NUMBER
ADD T1,DSPPNT ;POINT TO OPEN/CLOSE KEYWORD TABLE ENTRY
HRRZ T1,(T1) ;POINT TO SELECTED KEYWORD TABLE
MOVEI T2,ATMBUF ;POINT TO KEYWORD
HRLI T2,(POINT 7)
PUSHJ P,TABLK ;LOOK UP KEYWORD IN TABLE
JRST KWDUNK ;NOT THERE
JRST KWDAMB ;AMBIGUOUS
JRST KWDFND ;FOUND - ADDRESS OF TABLE ENTRY IN T1
;+
; Keyword was found
;-
;
; Get Incompatibility_Flag and display message (if necessary).
;
KWDFND: MOVEM T1,KEYADR ;Save the table_entry_address.
SKIPN %FLIDX ;Any flagging being done?
JRST KWDFN1 ;No. Skip this slow stuff
MOVE T1,KEYVAL ;SetUp pointer to keyword number
MOVE T2,[OPNSWT] ;SetUp pointer to keyword table
PUSHJ P,FNDSWT ;Return address of keyword string (in t1)
MOVE T3,KEYADR ;Fetch the table_entry_address.
HLRZ T2,(T3) ;Get the address of Keyword value String.
HRRZ T3,(T3) ;Get address of Flags,,Value
HLRZ T3,(T3) ;Get (only) the Incompat_Flags
TDNE T3,%FLIDX ;Any flags the same?
$ECALL CFK ;Yes, Go display appropriate message.
;
; Get the DDB_Keyword_value, then go store it into the ddb
;
KWDFN1: MOVE T1,KEYADR ;Fetch the keyword table entry address.
HRRZ T2,(T1) ;Get address of [Flags,,Value]
HRRZ T2,(T2) ;Get Keyword_Value from RH
JRST OPNDPB ;Go store it in DDB
;+
; Keyword is Unknown
;-
KWDUNK: XMOVEI P2,[ASCIZ /Unknown/]
TRNA
;+
; Keyword is Ambiguous
;-
KWDAMB: XMOVEI P2,[ASCIZ /Ambiguous/]
MOVE T1,KEYVAL ;GET KEYWORD NUMBER
MOVEI T2,OPNSWT ;POINT TO SWITCH TABLE
PUSHJ P,FNDSWT ;FIND ASCII NAME OF SWITCH
XMOVEI T5,ATMBUF ;Point to atom buffer
$DCALL ESV ;UNKNOWN OR AMBIGUOUS KEYWORD
;+
; Open error
;-
OPNERR: $ECALL UOA ;UNKNOWN $A KEYWORD
POPJ P,
OPNINT: SKIPL T2,@(L) ;GET ARG
JRST OPNDPB ;Go store it in DDB
MOVE T1,KEYVAL ;GET KEYWORD NUMBER
MOVEI T1,OPNSWT ;POINT TO SWITCH TABLE
PUSHJ P,FNDSWT ;FIND ASCII NAME OF SWITCH
MOVEM T1,%ARGNM ;SAVE IT FOR ERROR
$DCALL IAV ;MUST BE POSITIVE OR ZERO
OPNADR: XMOVEI T2,@0(L) ;Get arg address
JRST OPNDPB ;GO STORE IT IN DDB
OPNSET: MOVEI T2,1 ;[3115]Get a turned-on-bit
OPNDPB: MOVE T1,KEYVAL ;GET KEYWORD NUMBER into t1
;T2 usually contains keyword value
XCT OPSTOR(T1) ;STORE IN DDB
POPJ P,
PADCHR: LDB T2,[POINT 7,@(L),6] ;GET FIRST CHAR OF STRING
LDB T1,[POINTR ((L),ARGTYP)] ;[3115]Get arg type
CAIE T1,TP%CHR ;[3115]Character string?
JRST STOPAD ;[3115]NO.
MOVE T2,@(L) ;[3115]Load descriptor
ILDB T2,T2 ;[3115]Load the character
STOPAD: STORE T2,PADCH(U) ;STORE IN DDB
MOVEI T1,1 ;AND FLAG WE GOT ONE
STORE T1,PADSP(U)
POPJ P, ;RETURN
;Get next char from source string
;Returns char in T1
;SRCLEN= # chars possibly left to parse
DPRCHR: SOSGE SRCLEN ;DECR COUNT
JRST DPRNUL ;RETURN NULL IF STRING RAN OUT
ILDB T1,SRCBP
POPJ P, ;Return
DPRNUL: IBP SRCBP ;POINT TO NEXT CHAR
SETZ T1, ;RETURN NULL
POPJ P,
OPNDEV: SETOM FILPRS(D) ;SET FILESPEC PARSED
MOVEI T1,DEV(D) ;POINT TO DEVICE FIELD
HRLI T1,(POINT 7)
MOVEM T1,DSTBP
MOVEI T1,LDEVC ;AND GET ITS LENGTH
MOVEM T1,DSTLEN
MOVEI T2,":" ;STOP ON COLON
PJRST MVAWD ;MOVE DEVICE NAME
IF20,<
OPNDIR: SETOM FILPRS(D) ;SET FILESPEC PARSED
MOVE T1,@(L) ;GET FIRST WORD OF ARG
TLNN T1,(177B6) ;LEADING ASCII CHAR NULL?
JRST OPNPPN ;YES, IT'S A PPN
MOVEI T1,DIRNAM(D) ;MOVE ARG TO DIRNAM
HRLI T1,(POINT 7)
MOVEM T1,DSTBP
MOVEI T1,LDIRC
MOVEM T1,DSTLEN
PJRST MVARRY ;MOVE ARGUMENT
OPNPPN: TLNE T1,-1 ;PROJECT NUMBER IN LH?
JRST OPNPP1 ;YES, XWD FORMAT
HRLZ T1,T1 ;No, doubleword format
XMOVEI T2,@(L) ;GET ADDR OF ARRAY
HRR T1,1(T2) ;GET PROGRAMMER NUMBER
OPNPP1: MOVEM T1,PPNSTR(D) ;[4135] SAVE IT
POPJ P, ;[4135]
PPNDIR: SKIPN T2,PPNSTR(D) ;[4135] PUT IT IN PROPER PLACE FOR TRANSLATION
POPJ P, ;[4135] NONE THERE
HRROI T1,ATMBUF ;TRANSLATE PPN TO DIRECTORY STRING
HRROI T3,DEV(D) ;POINT TO DEVICE NAME
PPNST% ;TRANSLATE IT
$DJCAL PPN ;CAN'T
MOVE T1,[POINT 7,ATMBUF] ;INITIALIZE STRING POINTER
MOVEM T1,SRCBP
MOVEM T1,DSTBP ;MOVE STRING TO SELF
MOVEI T1,LATOMC ;AND COUNT
MOVEM T1,SRCLEN
MOVEM T1,DSTLEN
MOVEI T2,.CHLAB ;UNTIL START OF DIRECTORY NAME
SETZM DIARRY ;NOT AN ARRAY
PUSHJ P,MOVARG ;SKIP TO LEFT ANGLE BRACKET
MOVEI T1,DIRNAM(D) ;NOW POINT TO REAL DESTINATION
HRLI T1,(POINT 7)
MOVEM T1,DSTBP
MOVEI T1,LDIRC ;AND GET DEST SIZE
MOVEM T1,DSTLEN
MOVEI T2,.CHRAB ;TERMINATE ON END OF DIRECTORY NAME
SETZM DIARRY ;NOT AN ARRAY
PJRST MOVARG ;MOVE DIRECTORY TO DDB, RETURN
SETPRO: SETOM FILPRS(D) ;SET FILESPEC PARSED
LSH T2,<<^D12-PRTDIG>*3> ;LEFT-JUSTIFY THE PROTECTION CODE
MOVEI T0,PRTDIG ;GET DIGIT COUNT
MOVEI T3,PROT(D) ;POINT TO PROTECTION BUFFER
HRLI T3,(POINT 7,) ; FOR CONVERSION TO ASCIZ
PRTLP: SETZ T1, ;CLEAR THE AC
LSHC T1,3 ;MOVE A DIGIT TO T1
ADDI T1,"0" ;CONVERT TO ASCII
IDPB T1,T3 ;STORE IN BUFFER
SOJG T0,PRTLP ;DO 6 DIGITS
SETZ T2, ;TERMINATE WITH NULL
IDPB T2,T3
POPJ P,
SETFSZ: POPJ P, ;[3340] FILESIZE not applicable
>;END IF20
IF10,<
OPNDIR: SETOM FILPRS(D) ;SET FILESPEC PARSED
LDB T1,[POINTR ((L),ARGTYP)] ;GET ARG TYPE
CAIE T1,TP%CHR ;[3150] CHARACTER?
CAIN T1,TP%LIT ;ASCIZ LITERAL?
JRST OPPNST ;YES
MOVEI T1,DIRNAM(D) ;POINT TO DIRECTORY NAME BUFFER
HRLI T1,(POINT 7) ;MAKE IT A BYTE POINTER
MOVEM T1,FNSPNT ;SAVE FOR TRANSLATION ROUTINES
LDB T1,[POINTR ((L),ARGTYP)] ;GET ARG TYPE AGAIN
MOVE P1,%SIZTB(T1) ;GET ELEMENT SIZE IN WORDS
XMOVEI P3,@(L) ;GET ARRAY ADDR
MOVE T1,(P3) ;GET FIRST WORD OF ARG
JUMPE T1,%POPJ ;ZERO MEANS DEFAULT PATH
TLNN T1,-1 ;PROJECT NUMBER IN LH?
JRST GETPRG ;NO. GET PROGRAMMER NUMBER
ADDI P3,(P1) ;POINT TO PATHS
JRST OPNPP1 ;SKIP GETTING PROG #
GETPRG: HRLZ T1,T1 ;NO, DOUBLEWORD FORMAT
HRR T1,1(P3) ;PUT IN PROGRAMMER NUMBER
ADDI P3,2 ;POINT TO PATHS
OPNPP1: PUSHJ P,XWDASC ;OUTPUT AS A STRING
MOVEI P2,5 ;5 SFD'S
OPPNLP: SKIPN (P3) ;END OF LIST?
JRST OPPNUL ;YES. GO DEPOSIT A NULL
MOVEI T1,"," ;PUT IN A COMMA
IDPB T1,FNSPNT
MOVEI T1,(P3) ;GET AN SFD POINTER
HRLI T1,(POINT 7)
MOVEI T2,5 ;5 CHARS/WORD
IMULI T2,(P1) ;GET # CHARS/SFD
PUSHJ P,ASCASC ;TRANSLATE TO ASCII
ADDI P3,(P1) ;POINT TO NEXT PATH
SOJG P2,OPPNLP ;COPY WHOLE THING
OPPNUL: SETZ T1, ;DEPOSIT A NULL AT END
IDPB T1,FNSPNT
POPJ P, ;DONE
OPPNST: MOVEI T1,DIRNAM(D) ;MOVE ARG TO DIRNAM
HRLI T1,(POINT 7)
MOVEM T1,DSTBP
MOVEI T1,LDIRC
MOVEM T1,DSTLEN
PJRST MVARRY ;MOVE ARGUMENT
PPNDIR: POPJ P, ;[4135] PPN IS THE FORMAT ON TOPS-10
SETPRO: SETOM FILPRS(D) ;SET FILESPEC PARSED
DPB T2,[POINTR (LKPB+.RBPRV(D),RB.PRV)] ;STORE IN DDB
POPJ P,
SETFSZ: IDIVI T2,^D128 ;[3340] Convert FILESIZE to blocks
SKIPE T3 ;[3340] Round up
ADDI T2,1 ;[3340]
MOVEM T2,LKPB+.RBEST(D) ;[3340] Store in DDB
POPJ P, ;[3340]
>;END IF10
OPNDIA: LDB T1,[POINTR ((L),ARGTYP)] ;ANY ARGTYPE?
JUMPE T1,RQDIAX ;NO. SET TO DO TTY DIALOG
MOVE T1,(L) ;YES. GET IT
MOVEM T1,O.DIAS ;SAVE IT FOR LATER
POPJ P,
RQDIAX: SETOM O.DIAL ;SET FLAG FOR DIALOG REQUESTED
POPJ P, ;RETURN FROM ROUTINE CONTAINING ERROR
;HERE TO MOVE FILE= OR DIALOG= STRING TO TEXT BUFFER
DIABLT: LDB T3,[POINTR STRARG,ARGTYP] ;GET ARG TYPE
CAIE T3,TP%CHR ;[3115]Character string?
JRST DIANST ;[3115]NO.
DMOVE P3,@STRARG ;[3115]Load byte pointer & length
MOVEM P3,SRCBP ;[3115]Store pointer
JRST DIAFC ;[3115]Go move string
DIANST: XMOVEI P3,@STRARG ;GET ADDRESS OF LITSTRING
$BLDBP P3 ;BUILD A BYTE POINTER
MOVEM P3,SRCBP ;SAVE IT
MOVE P4,%SIZTB(T3) ;GET SIZE OF VARIABLE IN WORDS
IMULI P4,IBPW ;GET IT IN CHARS
SKIPN DIARRY ;CAN IT BE AN ARRAY?
CAIN T3,TP%LIT ;OR IS IT A LITSTRING?
MOVEI P4,-1 ;YES. USE 2**18-1
DIAFC: MOVE T2,[POINT 7,%TXTBF] ;POINT TO BUFFER
SETZ T4, ;CLEAR COUNT OF CHARS TRANSFERRED
DIAFCL: ILDB T1,SRCBP ;GET A BYTE
JUMPE T1,DIAEFC ;SKIP IT IF NULL
CAIE T1," " ;OR SPACE
JRST DIABL2 ;DEPOSIT IF ANYTHING ELSE
DIAEFC: SOJG P4,DIAFCL ;GO SKIP MORE LEADING NULLS OR SPACES
JRST DIAEND ;NULL STRING
DIABL1: ILDB T1,SRCBP ;GET BYTE FROM ARG
JUMPE T1,DIAEND ;NULL, DONE
CAIE T1," " ;SPACE?
JRST DIABL2 ;NO. GO STORE IT
CAIE T3,TP%CHR ;TYPE CHARACTER?
CAIN T3,TP%LIT ;OR LITERAL?
JRST DIASKB ;YES. SKIP IT
SKIPN DIARRY ;CAN IT BE AN ARRAY?
JRST DIASKB ;NO. SKIP IT (MIGHT BE FILE .EXT)
JRST DIAEND ;YES. SPACE ENDS DIALOG STRING
DIABL2: CAILE T4,LTEXTC-1 ;CHECK LENGTH BEFORE MOVING CHAR
$DCALL DTL ;DIALOG STRING TOO LONG
IDPB T1,T2 ;STORE CHAR
ADDI T4,1 ;INCR # CHARS ACTUALLY TRANSFERRED
DIASKB: SOJG P4,DIABL1 ;LOOP
IF20,<
DIAEND: MOVEM T4,SRCLEN ;SAVE # CHARACTERS TRANSFERRED
MOVEI T1,12 ;TERMINATE WITH LF
IDPB T1,T2
ADDI T4,2 ;COUNT IT AND ADD 1
MOVEM T4,CSB+.CMINC ;STORE IN CSB AS IF TEXTI HAD READ THE STRING
POPJ P, ;RETURN TO DIALOG SCANNER
> ;END IF20
IF10,<
DIAEND: MOVEM T4,SRCLEN ;SAVE # CHARACTERS TRANSFERRED
SETZ T1, ;TERMINATE WITH NULL
IDPB T1,T2
MOVE T1,[POINT 7,%TXTBF] ;POINT TO BEG OF BUFFER AGAIN
MOVEM T1,SRCBP
POPJ P, ;DONE
> ;END IF10
;ROUTINE TO LOOK UP STRING IN TABLE
;FINDS UNIQUE ABBREVIATIONS
;ARGS: T1 = ADDRESS OF TBLUK-FORMAT TABLE
; T2 = POINTER TO STRING TO FIND IN TABLE
;RETURN: T1 = ADDRESS OF TABLE ENTRY THAT MATCHES STRING
;NONSKIP RETURN IF NO MATCH
;1 SKIP IF AMBIGUOUS
;2 SKIPS IF OK
IF20,<
TABLK: TBLUK% ;LOOK UP STRING IN TABLE
TXNN T2,TL%NOM ;NO MATCH?
AOS (P) ;NO, ONE SKIP
TXNN T2,TL%NOM+TL%AMB ;AMBIGUOUS?
AOS (P) ;NO, ONE MORE SKIP
POPJ P, ;RETURN
> ;END IF20
IF10,<
TABLK: MOVEM T2,STRADD ;SAVE STRING ADDRESS
XMOVEI T1,(T1) ;EXTEND TABLE ADDRESS
HRRZ T2,(T1) ;GET TABLE COUNT
MOVEM T2,TABCNT ;SAVE IT
ADDI T1,1 ;POINT TO FIRST ENTRY
MOVEM T1,TABADD ;SAVE TABLE ADDRESS
TABLP: HLRZ T1,@TABADD ;GET ADDRESS OF A VALUE STRING
MOVE T1,(T1) ;GET 1ST WORD OF STRING
TLNN T1,774000 ;ANY CHAR IN FIRST POSITION?
TXNN T1,CM%FW ;NO. FLAG WORD?
JRST CHKAMB ;CHAR THERE OR NO FLAG WORD. GO ON
TXNE T1,CM%ABR ;[4205] IS THIS AN "UNAMBIGUOUS" ENTRY?
JRST TABUNA ;[4205] YES. GO SEE IF IT'S A MATCH!
CHKAMB: PUSHJ P,TABCMP ;NO. TRY THE REGULAR GRIND
JRST TABNXT ;DOES NOT MATCH. GO ON
JRST TABEXA ;EXACT MATCH
AOS TABADD ;NON-EXACT MATCH. GO TO NEXT ONE
SOSG TABCNT ;DECR TABLE COUNT
JRST TABMAT ;NONE LEFT. WE HAVE A MATCH
PUSHJ P,TABCMP ;COMPARE AGAIN
JRST TABMAT ;NEXT ONE DOES NOT MATCH, SO WE'VE GOT IT
$SNH ;SHOULDN'T GET 2 EXACT MATCHES!
JRST %POPJ1 ;AMBIGUOUS
TABUNA: PUSHJ P,TABCMP ;COMPARE THE STRINGS
JRST TABNXT ;TOO BAD, NOT A MATCH
NOP ;EXACT MATCH IS OK TOO
HRRZ T1,@TABADD ;GET ADDRESS OF MATCHING ENTRY
XMOVEI T1,(T1) ;EXTEND THE ADDRESS
JRST %POPJ2 ;RETURN SUCCESS
TABEXA: MOVE T1,TABADD ;GET MATCHING ADDRESS
JRST %POPJ2 ;RETURN SUCCESS
TABMAT: SOS T1,TABADD ;GET MATCHING ADDRESS
JRST %POPJ2 ;RETURN SUCCESS
TABNXT: AOS TABADD ;INCREMENT TABLE ADDRESS
SOSLE TABCNT ;DECR COUNT
JRST TABLP ;LOOP
POPJ P, ;RETURN NOT FOUND
TABCMP: HLRZ T1,@TABADD ;GET VALUE ADDRESS
MOVE T2,(T1) ;GET THE FIRST WORD OF IT
TLNN T2,774000 ;ANY CHAR IN FIRST POSITION?
TLNN T2,(CM%FW) ;NO. FLAG WORD?
JRST TABAMB ;CHAR THERE OR NO FLAG WORD. GO ON
ADDI T1,1 ;YES. UNAMBIGUOUS TABLE ENTRY
TABAMB: HRLI T1,(POINT 7) ;MAKE IT A POINTER
MOVE T3,STRADD ;POINT TO STRING
HRLI T3,(POINT 7) ;MAKE IT A POINTER TOO
TABCLP: ILDB T2,T1 ;GET A CHAR
JUMPE T2,ENDMAT ;IF NULL, WE MATCHED UP TO HERE
ILDB T4,T3 ;GET A STRING CHAR
JUMPE T4,%POPJ2 ;IF NULL, WE MATCHED NON-EXACTLY
CAIN T2,(T4) ;CHARS EQUAL?
JRST TABCLP ;YES. LOOP UNTIL ONE IS NULL
POPJ P, ;NO. NON-MATCH RETURN
ENDMAT: ILDB T4,T3 ;GET NEXT CHAR FROM STRING
JUMPE T4,%POPJ1 ;IF NULL, WE MATCH EXACTLY
POPJ P, ;IF NOT, WE DID NOT MATCH AT ALL!
> ;END IF10
;ROUTINE TO MOVE AN ASCII ARGUMENT TO SOME LOCAL BUFFER
;ARGS: T1 = ADDRESS OF 16-WORD BUFFER TO PUT ARG IN
; L = ADDRESS OF FORTRAN ARGUMENT POINTER
;RETURNS WITH ARGUMENT MOVED
;MVARG SETS NO DELIMITER. MVAWD EXPECTS A DELIMITER IN T2.
MVARRY: SETZ T2, ;NO DELIMITER - TRANSFER ENTIRE STRING
SETOM DIARRY ;INPUT CAN BE AN ARRAY
PUSHJ P,MAKEBP ;SETUP SOURCE BYTE POINTER
PJRST MOVARG ;GO MOVE THE STRING
MVARG: SETZ T2, ;NO DELIMITER - TRANSFER ENTIRE STRING
MVAWD: SETZM DIARRY ;INPUT CANNOT BE AN ARRAY
PUSHJ P,MAKEBP ;GET SRCBP = BYTE POINTER TO ARG STRING
PJRST MOVARG ;GO MOVE THE STRING
;ROUTINE TO SET UP BYTE POINTER AND COUNT TO AN ARGUMENT STRING
;ARGS: L = ADDRESS OF FORTRAN ARGUMENT POINTER
;RETURN: SRCBP = BYTE POINTER TO STRING
; SRCLEN = NUMBER OF CHARS IN STRING
MAKEBP: LDB T4,[POINTR ((L),ARGTYP)] ;GET ARG TYPE
CAIN T4,TP%CHR ;character string?
JRST BPCHAR ;YES. GO GET IT FROM DESCRIPTOR
XMOVEI T3,@0(L) ;Point to arg
$BLDBP T3 ;Build a byte ptr.
MOVEM T3,SRCBP ;Store in SRCBP.
CAIN T4,TP%LIT ;LITERAL?
JRST MBPLIT ;YES. GO SET MAX COUNT
MOVE T1,%SIZTB(T4) ;GET # WORDS/ENTRY
IMULI T1,IBPW ;GET # CHARS/ENTRY
SKIPE DIARRY ;BUT IF IT IS AN ARRAY
MOVEI T1,-1 ;SETUP FOR SEMI-INFINITE COUNT
MOVEM T1,SRCLEN ;SAVE IT
POPJ P, ;DONE
MBPLIT: SETZM DIARRY ;IT IS NOT AN ARRAY
MOVEI T1,-1 ;SETUP FOR MAX COUNT
MOVEM T1,SRCLEN ;SAVE IT
POPJ P,
BPCHAR: SETZM DIARRY ;IT IS NOT AN ARRAY
DMOVE T3,@0(L) ;GET DESCRIPTOR
MOVEM T3,SRCBP ;SAVE BYTE POINTER
MOVEM T4,SRCLEN ;SAVE IT
POPJ P,
;ROUTINE TO MOVE ARG TO LOCAL AREA, STANDARDIZING IT
;CONVERTS TO UPPER CASE, REMOVES SPACES, PUTS IN ASCIZ NULL AT END
;COPIES ARG UNTIL IT ENDS OR UNTIL A BREAK CHAR
;
;ARGS: DSTBP = 30-BIT ADDRESS OF BLOCK TO PUT STRING INTO
; DSTLEN = DESTINATION CHAR COUNT
; SRCBP = Ptr to arg.
; SRCLEN = SOURCE CHAR COUNT
; T2 = BREAK CHARACTER
;
;RETURN: T1 = CHAR THAT TERMINATED ARG, OR LAST CHAR IF SOURCE STRING EXHAUSTED
; SRCBP, SRCLEN UPDATED
MOVARG:
BMVALP: SOSGE SRCLEN ;DECR COUNT
JRST MVAEND ;COUNT EXHAUSTED
ILDB T1,SRCBP ;GET A BYTE
JUMPE T1,MVAEND ;DONE IF NULL
CAIE T1,' ' ;SKIP LEADING BLANKS
JRST MVAL1 ;NON-BLANK CHAR
JRST BMVALP ;SKIP IT
MVALP: SOSGE SRCLEN ;DECR COUNT
JRST MVAEND ;STRING EXHAUSTED
ILDB T1,SRCBP ;GET A BYTE
JUMPE T1,MVAEND ;NULL, DONE
MVAL1: CAIN T1,(T2) ;BREAK CHAR?
JRST MVAEND ;BREAK CHAR. DONE
CAIE T1," " ;SPACE?
JRST MVACVT ;NO
SKIPE DIARRY ;INPUT FROM ARRAY?
JRST MVAEND ;YES. END ON SPACE CHAR
JRST MVALP ;NO. IGNORE IT
MVACVT: CAIL T1,"a" ;CONVERT LOWER CASE TO UPPER CASE
CAILE T1,"z"
JRST .+2 ;NOT LC
SUBI T1,40 ;LC, CONVERT
SOSLE DSTLEN ;DECR DEST COUNT
IDPB T1,DSTBP ;IF ROOM, STORE CHAR IN DEST STRING
JRST MVALP ;COPY ENTIRE STRING
MVAEND: SETZ T0, ;TERMINATE DEST STRING WITH A NULL
IDPB T0,DSTBP
POPJ P, ;ALL DONE
SEGMENT DATA
SRCBP: BLOCK 1 ;Source byte ptr
SRCLEN: BLOCK 1 ;LENGTH
DSTBP: BLOCK 1 ;Destination byte ptr
DSTLEN: BLOCK 1 ;LENGTH
%ARGNM: BLOCK 1 ;Addr of ASCII name of arg.
STRARG: BLOCK 1 ;COMMON STRING ARG POINTER
DIARRY: BLOCK 1 ;0=CANNOT BE AN ARRAY
SEGMENT CODE
DECNAS: MOVEI T3,(T2) ;SAVE # DIGITS TO GET FROM NUMBER
DECNA1: IDIVI T1,12
PUSH P,T2
SOJLE T3,DECNA2
PUSHJ P,DECNA1 ;GO ENCODE NEXT DIGIT
DECNA2: POP P,T1 ;GET A DIGIT
ADDI T1,"0" ;CONVERT TO ASCII
IDPB T1,FNSPNT ;PUT IN BUFFER
POPJ P, ;BACK FOR MORE OR RETURN
;T1=DEC #
;T2=BP
DECASC: MOVE T3,T2
PUSHJ P,DECAS1
SETZ T1,
IDPB T1,T3
POPJ P,
DECAS1: IDIVI T1,12
JUMPE T1,DECAS2
PUSH P,T2
PUSHJ P,DECAS1
POP P,T2
DECAS2: ADDI T2,60
IDPB T2,T3
POPJ P,
;ASCDEC -- ASCII to DECIMAL conversion routine.
;Input:
; T1/ 18-bit address.
;Call:
; PUSHJ P,ASCDEC
; <here if parse error, no message typed>
; <here if ok>
;Output:
; T1/ number (could be negative).
ASCDEC: MOVSI T4,(POINT 7,)
HRR T4,T1
SETZB T1,T3 ;Start with 0 result, not negated
ILDB T2,T4 ;Get digit or "-"
CAIE T2,"-" ;Minus?
JRST ADECL1 ;No
SETO T3, ;Yes, remember to negate answer
ADECLP: ILDB T2,T4 ;Get next digit
ADECL1: JUMPE T2,ADECL2
CAIL T2,"0"
CAILE T2,"9"
POPJ P, ;?not numeric
IMULI T1,^D10
ADDI T1,-"0"(T2)
JRST ADECLP
ADECL2: SKIPE T3 ;Negative?
MOVN T1,T1 ;Yes, negate
JRST %POPJ1 ;Return ok
;CONVERT ASCII TO SIXBIT. NON-SKIP RETURN IF BAD CHAR
ASCSIX: MOVE T3,[POINT 6,ATMBUF]
SETZM ATMBUF
DPRS3A: PUSHJ P,DPRCHR ;Get next char
JUMPE T1,%POPJ1 ;Return if done
CAIN T1,"," ;Comma ok
JRST %POPJ1
PUSHJ P,DPRCSX ;Convert char to sixbit
POPJ P, ;Problem, return
TLNE T3,770000 ;Room?
IDPB T1,T3 ;Yes, store in BP
JRST DPRS3A ;Loop
;Translate char in T1 to sixbit
;Must be a letter or number
;Returns .+1 if problem, .+2 if ok
DPRCSX: CAIL T1,140 ;LOWER CASE CHAR?
SUBI T1,40 ;YES. CONVERT TO UPPER CASE
CAIG T1,"Z" ;ALPHANUMERIC?
CAIGE T1,"A"
CAIG T1,"9"
CAIGE T1,"0"
POPJ P, ;NO. NON-SKIP RETURN
SUBI T1,40 ;CONVERT TO SIXBIT
JRST %POPJ1 ;AND SKIP RETURN
;ROUTINE TO CONVERT OLD-STYLE CALL TO NEW-STYLE CALL
;OLD STYLE HAS POSITIONAL ARGS FOR UNIT, END, ERR.
;RECOGNIZED BY FIRST ARG HAVING KEYWORD FIELD 0. PUT IN
;RIGHT KEYWORDS FOR THE POSITIONAL ARGS.
OPNCNV:
CLSCNV: LDB T1,[POINTR ((L),ARGKWD)] ;GET KWD FIELD OF FIRST ARG
JUMPN T1,%POPJ ;NONZERO, NEW-STYLE CALL
MOVEI T1,OK.UNIT ;GET KWD VALUE FOR /UNIT
DPB T1,[POINTR ((L),ARGKWD)] ;STORE IN LOCAL ARG LIST
HLRE T2,-1(L) ;GET NEGATIVE # ARGS
MOVEI T1,OK.ERR ;GET KWD VALUE FOR /ERR
CAMLE T2,[-3] ;AT LEAST 3 ARGS PRESENT?
POPJ P, ;No, done
DPB T1,[POINTR (2(L),ARGKWD)] ;Store /ERR keyword
POPJ P, ;Return
SUBTTL FILL IN DEFAULTS & CHECK FOR CONFLICTS
COMMENT &
Trivial defaults are handled by clearing the DDB to zero initially,
then defining the default value for a field to be zero. Unless set to
something else, the zero will be used as the value of the keyword.
Defaults which cannot be handled that way and defaults which interact
with each other are handled here.
&
;OPDFLT - POST-ARG DEFAULT PROCESSING
;THE NEED FOR A DEFAULT IS RECOGNIZED BY A FIELD STILL BEING ZERO.
; HENCE ALL VALUES FOR A DEFAULTED FIELD MUST BE NONZERO. THE ORDER
; OF THESE CALLS IS IMPORTANT.
OPDFLT: PUSHJ P,DFBUF ;BUFFER COUNT
PUSHJ P,DFACC ;ACCESS [INTERACTS WITH /READONLY]
PUSHJ P,CHKFRM ;FORM [IF SET, SETS DEFAULT MODE]
PUSHJ P,CHKMOD ;MODE [IF SET, SETS DEFAULT FORM]
PJRST DFPAD ;IF NO PADCHAR, SETUP DEFAULT
DFFILE: LOAD T1,STAT(D) ;GET STATUS
CAIN T1,ST.SCR ;SCRATCH?
JRST SCRDEF ;YES. GET SCRATCH FILENAME DEFAULT
MOVE T1,[ASCII "FOR0"] ;GET PART OF DEFAULT FILENAME
MOVEM T1,FILNAM(D) ;STORE IN DDB
HXRE T1,UNUM(U) ;GET UNIT NUMBER
JUMPL T1,DFFILX ;NEGATIVE UNITS ARE SPECIAL
MOVE T2,[POINT 7,FILNAM(D),27] ;POINT TO AFTER "FOR0"
CAIL T1,^D10 ;UNLESS UNIT NUMBER IS OVER 10
MOVE T2,[POINT 7,FILNAM(D),20] ;THEN POINT AFTER "FOR"
PUSHJ P,DECASC ;CONVERT UNIT NUMBER TO ASCIZ
JRST DFEXT ;GO DO EXTENSION
DFFILX: MOVE T1,DEVTAB(T1) ;GET DEV NAME FOR NEGATIVE UNIT
SETZ T2, ;CLEAR JUNK
LSHC T1,-^D22 ;MOVE OVER 3 CHARS
LSH T1,1 ;PUT IN EXTRA BIT BETWEEN WORDS
OR T1,["FOR"B20] ;PUT FIRST PART OF FILENAME IN
DMOVEM T1,FILNAM(D) ;SAVE IN DDB
DFEXT: MOVE T1,DATEXT ;SET DEFAULT EXTENSION
MOVEM T1,EXT(D)
MOVE T1,DATGEN ;SET DEFAULT GENERATION
MOVEM T1,GEN(D)
POPJ P,
IF20,<
DATGEN: ASCIZ /0/ ;ZERO IS GENERATION DEFAULT
;*** SPOOLED LPT HAS DVTYP(D)=.DVLPT
DFDEV: SKIPE DEV(D) ;DEVICE SET?
POPJ P, ;Yes, return
HXRE T1,UNUM(U) ;GET UNIT NUMBER
JUMPL T1,DFDEV0 ;NEGATIVE, NO CHECK FOR LOGICAL NAME
MOVE T2,[POINT 7,DEV(D)] ;POINT TO DESTINATION FOR DEVICE
PUSHJ P,DECASC ;CONVERT UNIT TO DECIMAL ASCIZ STRING
HRROI T1,DEV(D) ;POINT TO DEVICE NAME
STDEV% ;GET DEVICE DESIGNATOR
ERJMP .+2 ;NO SUCH DEVICE
POPJ P, ;Got it, return
HXRE T1,UNUM(U) ;GET UNIT NUMBER AGAIN
DFDEV0: CAIL T1,0 ;NEGATIVE UNIT?
CAIGE T1,MAXDEV ;OR POSITIVE AND IN TABLE?
SKIPA T1,DEVTAB(T1) ;YES, GET DEVICE NAME FROM TABLE
MOVE T1,DSKDEF ;NO, USE DEFAULT
MOVEM T1,DEV(D) ;STORE DEVICE NAME
POPJ P, ;Return
;Routine to check out device and get information about it
DFDEV1: HRRI T1,DEV(D) ;POINT TO DEVICE NAME
HRLI T1,(POINT 7)
STDEV% ;GET DEVICE DESIGNATOR
ERJMP NSDCHK ;CHECK FOR GOOD DEVICE AFTER BAD ONE
DEVOK: MOVEM T2,DVICE(D) ;SAVE IT
MOVX T2,.CTTRM ;CHECK AGAINST CONTROLLING TERMINAL
HRROI T1,ATMBUF ;TRANSLATE CONTROLLING TTY TO STRING
DEVST%
JSHALT ;SHOULDN'T FAIL
HRROI T1,ATMBUF ;POINT TO STRING
STDEV% ;GET DEVICE DESIGNATOR
JSHALT
CAME T2,DVICE(D) ;SAME AS DEV(D)?
JRST NOTTTY ;NO
MOVX T1,.CTTRM ;YES. SET DVICE TO CONTROLLING TTY
MOVEM T1,DVICE(D)
NOTTTY: MOVE T1,DVICE(D) ;GET DEVICE DESIGNATOR
DVCHR% ;GET DEVCHR WORD
MOVEM T2,DVBTS(D) ;SAVE IT
;HERE FIGURE OUT IF DEVICE IS "ASCII-ONLY". IF IT IS,
;SET IMGFLG(D), WHICH WILL PREVENT UNFORMATTED (BINARY)
;I/O FROM READING/WRITING LSCW'S.
SETZM IMGFLG(D) ;[4164] CLEAR THE ASCII-ONLY (IMAGE) FLAG
LOAD T1,MODE(D) ;[4164] GET FORTRAN DATA MODE
CAIN T1,MD.IMG ;[4164] IMAGE?
SETOM IMGFLG(D) ;[4164] YES. SET FLAG
LOAD T1,DVTYP(D) ;Get device type
CAIE T1,.DVLPT ;LINE PRINTER?
CAIN T1,.DVTTY ;OR TERMINAL?
SETOM IMGFLG(D) ;YES. SET ASCII-ONLY
CAIE T1,.DVPLT ;PLOTTER?
CAIN T1,.DVPTY ;OR PTY?
SETOM IMGFLG(D) ;YES. SET ASCII-ONLY
;Figure out appropriate INDX(D) -- device type index
MOVEI T2,DI.OTHR ;Guess type "other"
CAIN T1,.DVDSK ;Disk?
MOVEI T2,DI.DSK ;Yes
CAIN T1,.DVMTA ;Tape?
MOVEI T2,DI.MTA ;Yes
CAIE T1,.DVPTY ;PTY?
CAIN T1,.DVTTY ;TTY?
MOVEI T2,DI.TTY
STORE T2,INDX(D) ; . .
CAIN T2,DI.MTA ;[4161] MAGTAPE?
PUSHJ P,MTADEF ;[4161] YES. SETUP CERTAIN DEFAULTS
PUSHJ P,FIXCC ;SETUP CARRIAGECONTROL
JRST %POPJ1 ;No error--Skip return
SCRDEF: MOVEI T1,FILNAM(D) ;GET POINTER TO FILENAME ENTRY
HRLI T1,(POINT 7)
MOVEM T1,FNSPNT
XMOVEI T1,[ASCIZ/FOROTS-JOB-/]
PUSHJ P,ASCFNS ;PUT INTO STRING
MOVE T1,%JIBLK+.JIJNO ;GET JOB NUMBER
PUSHJ P,DNFNS ;PUT INTO STRING
XMOVEI T1,[ASCIZ /-UNIT-/]
PUSHJ P,ASCFNS ;PUT INTO STRING
MOVE T1,%CUNIT ;GET UNIT NUMBER
PUSHJ P,DNFNS ;PUT INTO STRING
XMOVEI T1,[ASCIZ/-SCRATCH-FILE/]
PUSHJ P,ASCFNS ;PUT INTO STRING
SETZ T1,
IDPB T1,FNSPNT ;END WITH NULL
MOVE T1,[ASCIZ /TMP/] ;TEMP FILE
MOVEM T1,EXT(D)
MOVE T1,DATGEN ;SET DEFAULT GENERATION
MOVEM T1,GEN(D)
POPJ P,
;HERE DO A LOOKUP TO STEP PAST THE BAD DEVICE
;ONTO A GOOD DEVICE, AND DO AN STDEV% JSYS ON IT AND RETURN. IF
NSDCHK: PUSHJ P,DLOOK ;LOOKUP FILE
JRST BADNSD ;LOOKUP ALSO FAILED, GIVE MSG AND DIE
HRROI T1,ATMBUF ;GET DEVICE FROM OPEN JFN
MOVE T2,IJFN(D) ;GET JFN
MOVX T3,FLD(.JSAOF,JS%DEV)
JFNS%
JSHALT ;CAN'T FAIL
PUSHJ P,RELJFN ;NOW RELEASE THE JFN
HRROI T1,ATMBUF ;POINT BACK AT DEVICE NAME
STDEV% ;GET A VALID DEVICE DESIGNATOR
JSHALT ;SHOULD NOT FAIL NOW
JRST DEVOK ;GO BACK TO COMMON CODE
BADNSD: PUSHJ P,RELJFN ;[4135] RELEASE THE JFN
XMOVEI T1,DEV(D) ;POINT TO BAD DEVICE NAME
$DCALL NSD ;NO SUCH DEVICE
> ;END IF20
;***TY.SPL & TY.VAR
IF10,<
DATGEN: 0 ;NULL GENERATION NUMBER FOR TOPS-10
SCRDEF: POPJ P, ;SCRATCH DOES NOTHING HERE ON TOPS-10
DFDEV: SKIPE T1,DEV(D) ;DEVICE SET?
POPJ P, ;Yes, return
HXRE T1,UNUM(U) ;GET UNIT NUMBER
JUMPL T1,DFDEV0 ;NEGATIVE, NO LOGICAL NAME CHECK
MOVE T2,[POINT 7,DEV(D)] ;POINT TO DESTINATION FOR DEVICE
PUSHJ P,DECASC ;CONVERT UNIT TO DECIMAL ASCIZ STRING
MOVEI T1,DEV(D) ;NOW GET IT AGAIN
HRLI T1,(POINT 7)
MOVEM T1,SRCBP
MOVEI T1,LDEVC
MOVEM T1,SRCLEN
PUSHJ P,ASCSIX ;AND CONVERT IT TO SIXBIT
$SNH ;CAN'T FAIL!
MOVE T1,ATMBUF ;GET THE SIXBIT DEVICE NAME
DEVCHR T1, ;SEE IF DEVICE EXISTS
JUMPN T1,%POPJ ;Yes, use unit number as device name
HXRE T1,UNUM(U) ;GET UNIT NUMBER BACK
DFDEV0: CAIL T1,0 ;NEGATIVE UNIT?
CAIGE T1,MAXDEV ;OR POSITIVE AND IN TABLE?
SKIPA T1,DEVTAB(T1) ;YES, GET TABLE ENTRY
MOVE T1,DSKDEF ;NOT IN TABLE, USE DEFAULT
MOVEM T1,DEV(D) ;SAVE IN DDB
POPJ P, ;Return, default device set.
;Routine to check out device and get information about it
DFDEV1: PUSHJ P,SETFI ;SETUP FILE BLOCKS WITH FILESTRING INFO
POPJ P, ;ERROR IN FILESTRING
MOVE T1,FBLK+.FODEV(D) ;GET DEVICE NAME
DEVCHR T1, ;GET DEVCHR WORD
MOVEM T1,DVBTS(D) ;SAVE DEVCHR WORD
JUMPE T1,DFNSD ;NO SUCH DEVICE IF ZERO
MOVE T1,FBLK+.FODEV(D) ;GET DEVICE NAME
DEVNAM T1, ;GET PHYSICAL DEVICE NAME
$SNH ;SHOULDN'T FAIL
MOVE T2,DVBTS(D) ;GET THE DEVCHR BITS AGAIN
TXNE T2,DV.TTA ;CONTROLLING TERMINAL?
MOVX T1,.CTTRM ;YES. SUBSTITUTE JUST TTY
MOVEM T1,DVICE(D) ;SAVE IT
MOVE T1,FBLK+.FODEV(D) ;GET DEVICE NAME
DEVTYP T1, ;GET DEVTYP BITS
$SNH ;?Should not fail
MOVEM T1,DVTW(D) ;SAVE ENTIRE DEVTYP WORD
;HERE FIGURE OUT IF DEVICE IS "ASCII-ONLY". IF IT IS,
;SET IMGFLG(D), WHICH WILL PREVENT UNFORMATTED (BINARY)
;I/O FROM READING/WRITING LSCW'S.
SETZM IMGFLG(D) ;[4164] CLEAR THE ASCII-ONLY (IMAGE) FLAG
LOAD T1,MODE(D) ;[4164] GET FORTRAN DATA MODE
CAIN T1,MD.IMG ;[4164] IMAGE?
SETOM IMGFLG(D) ;[4164] YES. SET FLAG
LOAD T1,DVTYP(D) ;GET THE DEVICE TYPE
CAIE T1,.TYLPT ;LINE PRINTER?
CAIN T1,.TYTTY ;OR TERMINAL?
SETOM IMGFLG(D) ;YES. SET ASCII-ONLY
CAIE T1,.TYPLT ;PLOTTER?
CAIN T1,.TYPTY ;OR PTY?
SETOM IMGFLG(D) ;YES. SET ASCII-ONLY
;Find appropriate INDX(D)
MOVEI T2,DI.OTHR ;Guess type OTHER
CAIN T1,.TYDSK ;DISK?
MOVEI T2,DI.DSK ;Yes
CAIN T1,.TYMTA ;TAPE?
MOVEI T2,DI.MTA ;Yes
CAIE T1,.TYPTY ;PTY?
CAIN T1,.TYTTY ;TTY?
MOVEI T2,DI.TTY ;Yes
TXNE T1,TY.SPL ;SPOOLED DEVICE?
MOVEI T2,DI.OTHR ;YES. USE TYPE OTHER
MOVE T1,DVBTS(D) ;[4205] GET THE DEVCHR BITS AGAIN
TXNE T1,DV.MTA ;[4205] IF IT IS A MAGTAPE
TXNN T1,DV.DSK ;[4205] AND IT IS A DISK
CAIA ;[4205]
MOVEI T2,DI.OTHR ;[4205] THEN IT IS THE NULL DEVICE!
STORE T2,INDX(D) ;Store dev index for dev-dependent code
CAIN T2,DI.MTA ;[4161] MAGTAPE?
PUSHJ P,MTADEF ;[4161] YES. SETUP PARAMETERS
PUSHJ P,FIXCC ;SETUP CARRIAGECONTROL
JRST %POPJ1 ;No error--skip return
DFNSD: XMOVEI T1,DEV(D) ;GET IT AGAIN FOR ERROR
$DCALL NSD ;NO SUCH DEVICE
>;END IF10
DFACC: LOAD T2,RO(D) ;GET /READONLY
JUMPE T2,%POPJ ;Not set, leave ACCESS alone
;/READONLY set. Change ACCESS of 'RANDOM' to 'RANDIN',
; change ACCESS of 'SEQINOUT' to 'SEQIN'.
LOAD T1,ACC(D) ;DEFAULT IS /ACCESS:SEQINOUT
CAIE T1,AC.SIO ;SEQINOUT?
CAIN T1,AC.RIO ;RANDOM?
CAIA ;Yes, change them
POPJ P, ;Don't change /ACCESS
CAIN T1,AC.SIO
SKIPA T1,[AC.SIN] ;SEQINOUT to SEQIN
MOVEI T1,AC.RIN ;RANDOM to RANDIN
STORE T1,ACC(D) ;Store in DDB
POPJ P,
DFBUF: LOAD T1,BUFCT(D) ;GET BUFFER COUNT
JUMPN T1,%POPJ ;IF ALREADY SET, DON'T SET DEFAULT
MOVEI T1,BUFNM ;LOAD DEFAULT
STORE T1,BUFCT(D)
POPJ P,
;CHKFRM - IF THE FORM IS SET AND THE MODE IS NOT, SET THE MODE
CHKFRM: LOAD T1,FORM(D) ;GET FORM
JUMPE T1,%POPJ ;NOT DEFAULTED UNTIL LATER
SETMOD: LOAD T2,MODE(D) ;FORM IS SET. GET MODE
JUMPN T2,%POPJ ;ALREADY SET BY OPEN
MOVEI T3,MD.ASC ;ASSUME ASCII
CAIE T1,FM.FORM ;FORM=FORMATTED?
MOVEI T3,MD.BIN ;NO. USE MODE=BINARY
STORE T3,MODE(D) ;STORE IT
POPJ P,
;SET MODE AND FORM - DONE JUST BEFORE THE FILE IS OPENED
;IF THE UNIT HAS NOT BEEN OPENED PREVIOUSLY. THE ONLY CASE
;KNOWN IS ENDFILE, WHICH ENDS UP WRITING A NULL FILE, BUT
;WHOSE MODE IS ASCII.
SETMAF: LOAD T1,MODE(D) ;MODE SET YET?
JUMPN T1,SETFRM ;YES. GO SET FORM
MOVEI T1,MD.ASC ;NO. SET MODE TO ASCII
STORE T1,MODE(D)
MOVEI T1,FM.FORM ;AND SET FORM=FORMATTED
STORE T1,FORM(D)
POPJ P, ;WE'RE DONE
;IF MODE SET, SETUP DEFAULT FORM.
CHKMOD: LOAD T1,MODE(D) ;GET FILE MODE
JUMPE T1,%POPJ ;NONE. DON'T DEFAULT IT NOW
SETFRM: LOAD T1,FORM(D) ;FORM SET YET?
JUMPN T1,%POPJ ;ALREADY SET
MOVEI T1,FM.FORM ;ASSUME FORMATTED
LOAD T2,MODE(D) ;GET MODE
CAIE T2,MD.BIN ;BINARY?
CAIN T2,MD.IMG ;OR IMAGE?
MOVEI T1,FM.UNF ;YES. SET UNFORMATTED
CAIN T2,MD.DMP ;OR DUMP
MOVEI T1,FM.UNF ;YES. SET UNFORMATTED
STORE T1,FORM(D)
POPJ P,
;SET MODE BY ACCESS TYPE. IF NEITHER MODE NOR FORM HAVE BEEN SET UP,
;SET MODE AND FORM BY ACCESS TYPE - FORMATTED AND ASCII IF SEQUENTIAL,
;UNFORMATTED AND BINARY IF RANDOM.
SMBA: LOAD T1,MODE(D) ;GET MODE
JUMPN T1,SETFRM ;IF SET, GO SET FORM
LOAD T1,FORM(D) ;GET FORM
JUMPN T1,SETMOD ;IF SET, GO SET MODE
LOAD T1,ACC(D) ;GET ACCESS
MOVEI T2,MD.ASC ;ASSUME ASCII
CAIE T1,AC.RIO ;RANDOM?
CAIN T1,AC.RIN ;OR RANDIN?
MOVEI T2,MD.BIN ;YES. SET TO BINARY
STORE T2,MODE(D) ;STORE MODE
JRST SETFRM ;GO SET FORM
DFPAD: LOAD T1,PADSP(U) ;WAS A PADCHAR SPECIFIED?
JUMPN T1,%POPJ ;YES. DON'T DEFAULT IT
MOVEI T1,40 ;SPACE IS DEFAULT PADCHAR
STORE T1,PADCH(U)
POPJ P,
;FIXDEF DOES FINAL DEFAULT PROCESSING AFTER EVERYTHING IS IN PLACE
;INITIALIZES TTYW TO 72 OR RECORD SIZE, IF NOT YET SET UP
FIXDEF: SKIPN T1,RECTP(D) ;GET RECORD TYPE VALUE
JRST NORCTP ;NONE. WE HAVE A STREAM FILE
;IF THE RECORDTYPE KEYWORD IS GIVEN, IT MEANS THAT THE NORMAL
;DEFAULTS OF CRLF TERMINATOR AND WORD-ALIGNED FIXED-LENGTH RECORDS
;ARE NO LONGER OPERATIVE. IF THE RECORDS ARE VARIABLE-LENGTH,
;EITHER THEY ARE BEING GIVEN TO US BY RMS, OR THEY HAVE A RECORD CONTROL
;WORD (RCW) AT THEIR BEGINNING (SUCH AS FOR INDUSTRY "D" FORMAT MAGTAPE)
;IF THEY ARE FIXED-LENGTH, THEY ARE RMS FIXED-LENGTH RECORDS
;OR ARE "F" FORMAT RECORDS ON A MAGTAPE.
CAIN T1,RT.FIX ;FIXED-LENGTH?
JRST RECFIX ;YES. LEAVE RSIZE SET
MOVE T1,RSIZE(D) ;NO. SET MAXIMUM RECORDSIZE
MOVEM T1,MRSIZE(D)
SETZM RSIZE(D) ;CLEAR THE FIXED RECORDSIZE
JRST TTWSET
NORCTP: SKIPN RSIZE(D) ;FIXED-LENGTH RECORDS?
JRST TTWSET ;NO. NOTHING MORE TO DO HERE
RECFIX: MOVE T1,RSIZE(D) ;GET RECORDSIZE
LOAD T2,MODE(D) ;GET FILE MODE
CAIE T2,MD.ASL ;LINE-SEQUENCED ASCII?
JRST NOTLSN ;NO
ADDI T1,6 ;YES. ADD 6 FOR LSN AND TAB
MOVEI T3,6 ;SAVE FOR RECORD OFFSET
MOVEM T3,ROFSET(D)
NOTLSN: MOVEM T1,FRSIZB(D) ;SAVE FORMATTED RECORDSIZE IN BYTES
MOVE T2,RSIZE(D) ;GET THE RECORDSIZE AGAIN
SKIPN IMGFLG(D) ;ASCII-ONLY DEVICE?
ADDI T2,2 ;NO. ADD 2 FOR LSCW'S
NOTBIN: MOVEM T2,URSIZW(D) ;SAVE UNFORMATTED RECSIZ IN WORDS
IMUL T2,BPW(D) ;GET UNFORMATTED RECSIZ IN BYTES
MOVEM T2,URSIZB(D) ;SAVE IT
SKIPE RECTP(D) ;STREAM FILE?
JRST TTWSET ;NO
MOVE T1,FRSIZB(D) ;GET STORED RECORDSIZE AGAIN
ADDI T1,2 ;YES. ADD 2 FOR CRLF
ADD T1,BPW(D) ;NOW ADD BPW-1 TO ROUND UP TO WORDS
SUBI T1,1
IDIV T1,BPW(D) ;GET # WORDS
MOVEM T1,FRSIZW(D) ;STORE RECORD SIZE IN WORDS
IMUL T1,BPW(D) ;GET IT IN BYTES
MOVEM T1,FRSIZB(D) ;SAVE ROUNDED-UP RECORD SIZE IN BYTES
TTWSET: LOAD T1,TTYW(D) ;GET LINE WIDTH
JUMPN T1,%POPJ ;GOT ONE ALREADY. LEAVE
SKIPN T1,RSIZE(D) ;USE RECSIZ IF SPECIFIED
MOVEI T1,^D72 ;OR 72 IF NOT
STORE T1,TTYW(D) ;SAVE LINE WIDTH FOR LIST-DIRECTED OUTPUT
POPJ P,
;
; FIXCC - Routine to fixup U after OPEN is done.
; Called with FIXDEF, for every "U" that applies.
; SETS /CARRIAGE:DEVICE TO APPROPRIATE DEVICE DEFAULT
;
; NAMELY, SETS IT TO: CC=LIST for stream files,
; CC=FORTRAN for non-stream files
; CC=TRANSLATED for TTY: and LPT:.
;
; Also changes CC=FORTRAN to CC=TRANSLATED for TTY and LPT.
;
FIXCC: LOAD T2,CC(U) ;GET CC
CAIN T2,CC.FOR ;FORTRAN?
JRST CTTYCC ;YES. CHECK IF TTY OR LPT
CAIE T2,CC.DEV ;DEVICE DEFAULT?
POPJ P, ;NO, DONE
MOVEI T2,CC.LST ;FOR STREAM FILES, LIST IS THE DEFAULT
SKIPE RECTP(D) ;ANY RECORDTYPE
MOVEI T2,CC.FOR ;YES. FORTRAN IS THE DEFAULT
CTTYCC: LOAD T1,DVTYP(D) ;GET DEVICE TYPE
CAIE T1,DT.TTY ;TERMINAL?
CAIN T1,DT.LPT ;OR PRINTER?
MOVEI T2,CC.TRN ;YES. TRANSLATED IS THE DEFAULT
STORE T2,CC(U) ;STORE DEFAULT CC
POPJ P, ;Return
SUBTTL FNDSWT - Look up switch in table
;++
; FUNCTIONAL DESCRIPTION:
;
; This routine will search the switch table to find a DDB_key_value
; which matches the one given as an input parameter. If a match is
; found the address of the string (for the switch) will be returned.
; Else, the address of a null string will be returned.
;
; Format of the TBLUK table:
; TABLE: Number of entries in table,,Number of entries in table
; Addr of switch name string,,Address of OTS flags
; Addr of switch name string,,Address of OTS flags
; " " " " " " " " "
; / \
; / \
; / \
; [SIXBIT /Switch/] [XWD Compatibility_Flag,,DDB_key_value]
;
; The DDB_key_value are defined in FORPRM (DDB structure).
;
; CALLING SEQUENCE:
;
; PUSHJ P,FNDSWT
;
; INPUT PARAMETERS:
;
; None
;
; IMPLICIT INPUTS:
;
; T1 DDB_key_value to find a match for.
; T2 Address of table in TBLUK JSYS Format (18-bits).
;
; OUTPUT PARAMETERS:
;
; None
;
; IMPLICIT OUTPUTS:
;
; T1 ADDRESS of the switch string (from RH of table entry).
;
; SIDE EFFECTS:
;
; Uses T1 thru T4.
;
;--
FNDSWT: HLRZ T3,(T2) ;Get length of Switch_Table
JUMPE T3,FNDNUL ;If no entries, It's not a Switch_Table
HRLI T2,(IFIW (T3)) ;Put T3 index in LH of T2
FSWLP: HRRZ T4,@T2 ;Get address of flag word
HRRZ T4,(T4) ;Get the DDB_key_value (RH).
CAIE T4,(T1) ;Does it match the one we want?
SOJG T3,FSWLP ;No, Keep looking
HLRZ T4,@T2 ;[4205] Yes, Get pointer to string
MOVE T4,(T4) ;[4205] GET STRING OR FLAG WORD
TLNN T4,774000 ;[4205] ANY CHAR THERE?
SOJG T3,FSWLP ;[4205] NO. THIS ENTRY IS NG
HLRZ T1,@T2 ;Yes, Get pointer to string
XMOVEI T1,(T1) ;Make it a global address
POPJ P, ;Return to caller.
FNDNUL: XMOVEI T1,[0] ;Point to a NULL string
POPJ P, ;End of routine FNDSWT
SUBTTL DIALOG SCANNER
DFOPN: PUSHJ P,OPNCTX ;ENTER OPEN CONTEXT
DFCOM: MOVE T1,O.DFLT ;GET ARG POINTER
MOVEM T1,STRARG ;SAVE IT
SETZM DIARRY ;CANNOT BE AN ARRAY
XMOVEI T1,[ASCIZ /DEFAULTFILE=/] ;SAVE NAME FOR ERRORS
MOVEM T1,%ARGNM ;SAVE NAME FOR ERRORS
PUSHJ P,COMSTR ;CALL COMMON STRING PARSER
PJRST RELJFN ;RELEASE THE JFN
FILINQ: PUSHJ P,INQCTX ;ENTER INQUIRE CONTEXT
JRST FILCOM ;JOIN COMMON FILE= PARSER
FILCLS: PUSHJ P,CLSCTX ;ENTER CLOSE CONTEXT
JRST FILCOM ;JOIN COMMON FILE= PARSER
FILOPN: PUSHJ P,OPNCTX ;ENTER OPEN CONTEXT
FILCOM: MOVE T1,O.FILE ;GET ARG POINTER
MOVEM T1,STRARG ;SAVE IT
SETZM DIARRY ;CANNOT BE AN ARRAY
XMOVEI T1,[ASCIZ /FILE=/] ;SAVE NAME FOR ERRORS
MOVEM T1,%ARGNM ;SAVE NAME FOR ERRORS
PUSHJ P,COMSTR ;CALL COMMON STRING PARSER
PJRST RELJFN ;RELEASE THE JFN
NAMCLS: PUSHJ P,CLSCTX ;ENTER CLOSE CONTEXT
JRST NAMCOM ;JOIN COMMON NAME= PARSER
NAMOPN: PUSHJ P,OPNCTX ;ENTER OPEN CONTEXT
NAMCOM: MOVE T1,O.NAME ;GET NAME=STRING ARG POINTER
MOVEM T1,STRARG ;SAVE IT
SETOM DIARRY ;CAN BE AN ARRAY
XMOVEI T1,[ASCIZ /NAME=/] ;SAVE NAME FOR ERRORS
MOVEM T1,%ARGNM ;SAVE NAME FOR ERRORS
PUSHJ P,COMSTR ;CALL COMMON STRING PARSER
PJRST RELJFN ;RELEASE THE JFN
DLSCLS: PUSHJ P,CLSCTX ;ENTER CLOSE CONTEXT
JRST DLSCOM ;JOIN COMMON DIALOG= PARSER
DLSOPN: PUSHJ P,OPNCTX ;ENTER OPEN CONTEXT
DLSCOM: MOVE T1,O.DIAS ;GET DIALOG=STRING ARG POINTER
MOVEM T1,STRARG ;SAVE IT
SETOM DIARRY ;CAN BE AN ARRAY
XMOVEI T1,[ASCIZ /DIALOG=/] ;SAVE NAME FOR ERRORS
MOVEM T1,%ARGNM ;SAVE NAME FOR ERRORS
PUSHJ P,COMSTR ;CALL COMMON STRING PARSER
PJRST RELJFN ;RELEASE THE JFN
ASCFNS: HRLI T1,(POINT 7) ;MAKE IT A LOCAL BYTE POINTER
ASCFLP: ILDB T2,T1 ;GET A CHAR
JUMPE T2,%POPJ ;LOOP UNTIL NULL
IDPB T2,FNSPNT ;DEPOSIT IN FILESTRING
JRST ASCFLP ;LOOP UNTIL NULL
DNFNS: IDIVI T1,^D10 ;DIVIDE BY 10
PUSH P,T2 ;PUSH REMAINDER
JUMPE T1,DNFNS1 ;IF NO MORE DIGITS, GO DEPOSIT THEM
PUSHJ P,DNFNS ;RECURSIVE START
DNFNS1: POP P,T1 ;GET A DIGIT
ADDI T1,60 ;CONVERT TO ASCII
IDPB T1,FNSPNT ;DEPOSIT IN FILESTRING
POPJ P, ;LEAVE OR DO NEXT DIGIT
IF20,<
DIALOG: XMOVEI T1,[ASCIZ /DIALOG/]
MOVEM T1,%ARGNM ;SAVE NAME FOR ERRORS
PUSHJ P,SAVERR ;DIVERT ERR MSGS TO TTY
SKIPN EFSFLG ;SKIP IF PREFIX ALREADY TYPED
$ECALL EFS ;ENTER CORRECT FILE SPECS
SETOM EFSFLG ;SUPPRESS PROMPT NEXT TIME
MOVE T1,[.PRIIN,,.PRIOU] ;USE NORMAL JFNS
MOVEM T1,CSB+.CMIOJ
PUSHJ P,COMINT ;INITIALIZE COMMAND SCANNER
PUSHJ P,DIACOM ;DO COMMON DIALOG CODE
PJRST RELJFN ;RELEASE THE JFN
COMSTR: PUSHJ P,SAVERR ;DIVERT ERR MSGS TO TTY
MOVE T1,[.NULIO,,.NULIO] ;USE NO JFNS
MOVEM T1,CSB+.CMIOJ
PUSHJ P,COMINT ;INITIALIZE COMMAND SCANNER
PUSHJ P,DIABLT ;FAKE A TEXTI
DIACOM: MOVEM P,SAVEP ;SAVE P FOR REPARSE
JRST GOPARS ;AND GO PARSE FILESPEC OR SWITCHES
REPARS: MOVE P,SAVEP ;RESTORE P
PUSHJ P,RELJFN ;RELEASE JFN IF ANY
GOPARS: PUSHJ P,SETJFN ;FILL IN GTJFN BLOCK
MOVX T1,GJ%OFG ;DIALOG IS PARSE-ONLY FOR ALL DEVICES
IORM T1,JFNBLK+.GJGEN ;(Incase he changes /ACCESS after typing
; the filespec).
MOVX T1,G1%SLN ;[2041] Don't expand logical names either
IORM T1,JFNBLK+.GJF2 ;[2041] because file might be down under
MOVEI T1,CSB ;POINT TO CSB
MOVEI T2,FLDFNS ;Parse file name or switches
SKIPN SWTPNT ;ANY SWITCHES ALLOWED?
MOVEI T2,FLDFN ;NO. PARSE ONLY FILE NAME
PUSHJ P,COMAND ;** Go do parse **
HRRZ T1,T3 ;See what it was
CAIE T1,FLDCFS ;[4134] CONFIRM?
CAIN T1,FLDCFM ;[4134] OR THE OTHER CONFIRM?
POPJ P, ;Yes, just return
CAIN T1,FLDSWT ;Switch?
JRST DIASWG ;Yes, go process
;Filename was parsed
DIAFNM: MOVEM T2,IJFN(D) ;[4135] STORE JFN IN DDB
MOVEM T2,OJFN(D) ;[4135] . .
SETOM FILPRS(D) ;SET FLAG FOR FILENAME PARSED
PUSHJ P,DOJFNS ;STORE NEW DEVICE, FILENAME, ... IN DDB
DIASWT: MOVEI T1,CSB ;POINT TO CSB
MOVEI T2,FLDCFS ;CONFIRM OR SWITCH
SKIPN SWTPNT ;[4134] UNLESS NO SWITCHES ALLOWED
MOVEI T2,FLDCFM ;[4134] THEN ALLOW ONLY CONFIRM
PUSHJ P,COMAND ;PARSE A SWITCH OR A CRLF
TSC T3,T3 ;SEE WHAT WAS ACTUALLY PARSED
JUMPE T3,%POPJ ;CRLF, DONE WITH DIALOG
DIASWG: HRRZ T1,(T2) ;GET ADDRESS OF FLAGS,,KEYWORD NUMBER
HRRZ T1,(T1) ;GET KEYWORD NUMBER OF SWITCH
MOVEM T1,KEYVAL ;SAVE IT
ADD T1,DSPPNT ;POINT TO DISPATCH TABLE ENTRY
HRRZ T1,(T1) ;GET DISPATCH TABLE ENTRY
MOVEM T1,KWTADR ;SAVE IT
MOVE T3,(T1) ;GET ROUTINE ADDRESS OR TOP OF KEYWORD TABLE
TLNN T3,-1 ;SEE WHICH IT IS
JRST (T3) ;SUBROUTINE, GO TO IT
MOVE T1,KWTADR ;GET KEYWORD TABLE ENTRY
MOVEM T1,SWTDDB+.CMDAT ;STORE ADDRESS
MOVEI T1,CSB ;Point to COMND block
MOVEI T2,SWTDDB ;POINT TO KEYWORD FLDDB
PUSHJ P,COMAND ;PARSE SWITCH KEYWORD
HRRZ T2,(T2) ;GET ADDRESS OF FLAGS,,VALUE
HRRZ T2,(T2) ;GET VALUE
MOVE T1,KEYVAL ;GET KEYWORD NUMBER
XCT OPSTOR(T1) ;STORE IN DDB
JRST DIASWT ;LOOP
;ROUTINE TO INITIALIZE THE COMMAND SCANNER
COMINT: MOVEI T1,REPARSE ;FILL IN CSB
MOVEM T1,CSB+.CMFLG
HRROI T1,[ASCIZ /*/] ;PROMPT STRING
MOVEM T1,CSB+.CMRTY
HRROI T1,%TXTBF ;TEXT BUFFER
MOVEM T1,CSB+.CMBFP
MOVEM T1,CSB+.CMPTR
MOVEI T1,LTEXTC ;CHARS IN TEXT BUFFER
MOVEM T1,CSB+.CMCNT
HRROI T1,ATMBUF ;ATOM BUFFER
MOVEM T1,CSB+.CMABP
MOVEI T1,LATOMC-1 ;CHARS IN ATOM BUFFER
MOVEM T1,CSB+.CMABC ; (-1 BECAUSE OF COMND JSYS BUG)
MOVEI T1,JFNBLK ;GTJFN BLOCK
MOVEM T1,CSB+.CMGJB
MOVX T1,<<.CMKEY>B8> ;FILL IN SWITCH-KEYWORD FLDDB BLOCK
MOVEM T1,SWTDDB+.CMFNP
MOVX T1,<<.CMSWI>B8> ;Fill in FLDDB block for switches
MOVEM T1,FLDSWT+.CMFNP
MOVE T1,SWTPNT ;GET APPROPRATE SWITCH TABLE ADDRESS
MOVEM T1,FLDSWT+.CMDAT ;Store in block
MOVEI T1,CSB ;POINT TO CSB
MOVEI T2,[FLDDB.(.CMINI)] ;INITIALIZE IT
PJRST COMAND
;Routine to ignore the next keyword
;KEYVAL = Switch number
DIAIGN: PUSHJ P,CLIGN ;Type "%Ignoring <KEYWORD>"
MOVEI T2,SWACC ;Get a random switch table
MOVEM T2,SWTDDB+.CMDAT ;Store address
MOVEI T1,CSB
MOVEI T2,SWTDDB
COMND%
ERJMP CMDER1 ;?Funny error
JRST DIASWT ;Don't care whether it parsed or not
DIAINT: SKIPA T2,[[FLDDB.(.CMNUM,,^D10)]] ;GET A DECIMAL NUMBER
DIAOCT: MOVEI T2,[FLDDB.(.CMNUM,,^D8)] ;GET AN OCTAL NUMBER
MOVEI T1,CSB ;POINT TO COMMAND STATE BLOCK
PUSHJ P,COMAND
MOVE T1,KEYVAL ;GET KEY NUMBER
XCT OPSTOR(T1) ;STORE IN DDB
JRST DIASWT
DIACHR: MOVEI T1,CSB ;POINT TO COMMAND STATE BLOCK
MOVEI T2,[FLDDB.(.CMQST,,,single character)] ;GET A SINGLE CHAR
PUSHJ P,COMAND
LDB T2,[POINT 7,ATMBUF,6] ;GET CHAR FROM ATOM BUFFER
CAIN T2,"" ;QUOTING CHAR?
LDB T2,[POINT 7,ATMBUF,13] ;YES, GET CHAR IT QUOTED
MOVE T1,KEYVAL ;GET KEY NUMBER
XCT OPSTOR(T1) ;STORE IN DDB
JRST DIASWT
DIASET: MOVEI T2,1 ;SET BIT TO 1
MOVE T1,KEYVAL ;GET KEY NUMBER
XCT OPSTOR(T1)
JRST DIASWT
RELJFN: SKIPN T1,IJFN(D) ;GET JFN
POPJ P, ;NOTHING TO DO IF NO JFN
CAIE T1,.PRIIN ;If not real JFN,
CAIN T1,.PRIOU ;. .
JRST SETJF0 ;Don't release it
RLJFN%
JSHALT ;SHOULD NOT FAIL
SETJF0: SETZM IJFN(D) ;CLEAR JFNS
SETZM OJFN(D)
POPJ P,
;Filespec or CRLF or switch for OPEN and CLOSE
;Filespec or CRLF for INQUIRE
FLDFN: FLDDB. (.CMFIL,CM%SDH,,<file name>,,FLDCFM)
FLDCFM: FLDDB. (.CMCFM,CM%SDH,,,,)
FLDFNS: FLDDB. (.CMFIL,CM%SDH,,<file name>,,FLDCFS)
FLDCFS: FLDDB. (.CMCFM,CM%SDH,,,,FLDSWT)
SEGMENT DATA
FLDSWT: BLOCK .CMDAT+1 ;Allocate space for FLDDB. block
CSB: BLOCK 12 ;COMMAND STATE BLOCK
JFNBLK: BLOCK .GJATR+1 ;GTJFN ARG BLOCK
JFNEND==.-1
FDB: BLOCK 1+.FBSIZ ;FDB, UP THROUGH FILE SIZE
SWTDDB: BLOCK 2 ;FLDDB FOR SWITCHES
SAVEP: BLOCK 1 ;TEMP FOR STACK POINTER
SEGMENT CODE
COMAND: COMND% ;PARSE THE WHATEVER-IT-IS
ERJMP CMDERR ;ERROR IN COMND
TXNE T1,CM%NOP ;DID IT PARSE CORRECTLY?
JRST CMDERR ;NO
POPJ P, ;YES
CMDERR: ADJSP P,-1 ;DISCARD RETURN ADDRESS
CMDER1: PUSHJ P,COL1 ;GET TO COLUMN 1
MOVEI T1,.FHSLF ;SEE WHAT ERROR WE GOT
GETER% ;GET LAST ERROR
MOVEI T1,(T2) ;DISCARD JUNK IN LH
CAIN T1,IOX4 ;END OF COMMAND FILE?
$ACALL CEF ;YES. CANNOT RECOVER.
XMOVEI T5,ATMBUF ;POINT TO ATMBUF FOR ERROR MSGS
CAIE T1,NPXNOM ;"Does not match switch or keyword"?
CAIN T1,NPXAMB ; or "Ambiguous"?
$DCALL EDA ;YES. PRINT MSG AND GO TO DIALOG
$DCALL EDS ;NEITHER. PRINT JSYS ERROR
;Routine to get termiinal to column 1
COL1: MOVE T1,CSB+.CMINC ;GET CHAR COUNT FROM CSB
MOVE T2,CSB+.CMPTR ;GET BYTE POINTER
C1LP: SOJL T1,C1CRLF ;IF NO CHARS LEFT, GO TYPE CRLF
ILDB T3,T2 ;GET A CHAR FROM TEXTI BUFFER
CAIN T3,12 ;A LF?
POPJ P, ;YES, TERMINAL IS ALREADY AT COL 1
JRST C1LP ;NO, SEARCH SOME MORE
C1CRLF: HRRZ T1,CSB+.CMIOJ ;GET OUTPUT JFN
HRROI T2,%CRLF ;GET TO COLUMN 1 BY TYPING CRLF
MOVNI T3,2 ;2 CHARACTERS
SOUTR%
JSHALT
POPJ P, ;RETURN
;ROUTINE TO FILL IN GTJFN BLOCK FROM DDB
;POINTS DEFAULTS AT THE STRINGS STORED IN THE DDB
SETJFN: SKIPE IJFN(D) ;IF ANY JFN ALREADY
$SNH ;IT'S A BUG!
SETZM JFNBLK+.GJATR ;CLEAR ADDRESS OF ATTRIBUTE BLOCK
HLLZ T1,GEN(D) ;[4137] GET GENERATION
TLZ T1,17 ;[4137] CLEAR ALL EXCEPT 2 FIRST CHARACTERS
CAME T1,[ASCIZ /*/] ;[4137] IS IT A FULL WILDCARD?
JRST GENDEC ;[4137] NOT WILD-CARD. GO CONVERT TO BINARY
MOVX T1,.GJALL ;[4137] YES. USE WILD-CARD GENERATION NUMBER
JRST GOTGEN ;[4137] GO STORE IT
GENDEC: XMOVEI T1,GEN(D) ;[4137] POINT TO ASCIZ GENERATION NUMBER
PUSHJ P,ASCDEC ;CONVERT TO BINARY
$SNH ;SHOULDN'T GET ILLEGAL GENERATION HERE
GOTGEN: MOVEI T1,(T1) ;[4137] RIGHT HALF ONLY
TXO T1,GJ%MSG!GJ%XTN ;ALWAYS TYPE CONFIRMATION MESSAGE
; and use extended GTJFN block
SKIPE TMPFIL(D) ;[4135] IS IT A TEMPORARY FILE?
TXO T1,GJ%TMP ;[4135] YES. IT IS STICKY!
MOVEM T1,JFNBLK+.GJGEN ;STORE IN FLAG WORD
MOVEI T1,<.GJATR-.GJF2> ;No flags,,# of words to follow extended word
MOVEM T1,JFNBLK+.GJF2
MOVE T1,[.NULIO,,.NULIO] ;NO JFNS
MOVEM T1,JFNBLK+.GJSRC
SKIPE T1,DEV(D) ;DEVICE
HRROI T1,DEV(D)
MOVEM T1,JFNBLK+.GJDEV
SKIPE T1,DIRNAM(D) ;DIRECTORY
HRROI T1,DIRNAM(D)
MOVEM T1,JFNBLK+.GJDIR
SKIPE T1,FILNAM(D) ;FILENAME
HRROI T1,FILNAM(D)
MOVEM T1,JFNBLK+.GJNAM
SKIPE T1,EXT(D) ;EXT
HRROI T1,EXT(D)
MOVEM T1,JFNBLK+.GJEXT
SKIPE T1,PROT(D) ;PROT
HRROI T1,PROT(D)
MOVEM T1,JFNBLK+.GJPRO
POPJ P, ;ALL SET
; MTAJFN checks type type of device; if it's a MAGTAPE unit then lets
; assume it's a labeled MAGTAPE. When doing a GTJFN on a labeled
; MAGTAPE we have to include the file specification attributes
; like the BLOCK-SIZE, RECORD-LENGTH & Tape FORMAT. If is a
; MAGTAPE but not a labeled MAGTAPE tape these file attributes
; will be ignored.
;
MTAJFN: LOAD T2,INDX(D) ;GET THE DEVICE TYPE
CAIE T2,DI.MTA ;IS IT A MAGTAPE
POPJ P, ;NO. RETURN.
MOVE T1,DVBTS(D) ;GET DEVICE BITS
TXNN T1,DV%MNT ;IS IT MOUNTED?
POPJ P, ;NO. CAN'T SET ATTRIBUTES
;
; Move the address of the GTJFN_Attributes_Block into the
; GTJFN_Argument_Block and clear out the old numbers if any.
;
XMOVEI T1,ATRBLK ;GET ADDRESS OF ATTRIBUTE BLOCK
MOVEM T1,JFNBLK+.GJATR ;STORE ADDRESS OF ATTRIBUTE BLOCK
MOVE T1,[ASCII /BLOC:/] ;SETUP BLOCK-LENGTH ATTRIBUTE STRING
MOVEM T1,ATRBKZ
SETZM ATRBKZ+1 ;CLEAR THE BLOCK-SIZE ATTRIBUTE
MOVE T1,[ASCII /RECO:/] ;SETUP RECORD-LENGTH ATTRIBUTE STRING
MOVEM T1,ATRREC
SETZM ATRREC+1 ;CLEAR THE RECORD-SIZE ATTRIBUTE
MOVE T1,[ASCII /FORM:/] ;SETUP FORMAT ATTRIBUTE STRING
MOVEM T1,ATRFMT
;
; Set up the Block_Size
;
LOAD T1,BLKSZ(D) ;GET BLOCKSIZE
MOVE T2,[POINT 7,ATRBKZ+1] ;POINTER TO BLOCK SIZE ARG STRING
PUSHJ P,DECASC ;CONVERT BLOCK SIZE TO STRING
;
; Set up the Record_Length
;
SKIPN T1,RSIZE(D) ;GET RECORDSIZE
LOAD T1,BLKSZ(D) ;NONE. USE BLOCKSIZE
MOVE T2,[POINT 7,ATRREC+1] ;POINTER TO RECL ARG STRING
PUSHJ P,DECASC ;CONVERT RECORD LENGTH TO STRING
;
; Set up the Tape_Format
;
LOAD T1,RECTP(D) ;GET THE RECORD FORMAT
MOVE T1,RECASC(T1) ;GET IT'S ASCIZ EQUIVALENT
MOVEM T1,ATRFMT+1 ;SAVE AFTER "FORM:"
POPJ P, ;RETURN TO CALLER
ATRBLK: EXP 4 ;COUNT OF WORDS ATTRIBUTE BLOCK.
POINT 7,ATRBKZ ;BYTE POINTER TO BLOCK-LENGTH STRING.
POINT 7,ATRREC ;BYTE POINTER TO RECORD-LENGTH STRING.
POINT 7,ATRFMT ;BYTE POINTER TO FORMAT STRING.
RECASC: ASCIZ /U/ ;UNDEFINED
ASCIZ /F/ ;FIXED
ASCIZ /D/ ;DELIMITED
ASCIZ /S/ ;SEGMENTED
SEGMENT DATA
ATRBKZ: BLOCK 2 ;BLOCK-LENGTH
ATRREC: BLOCK 2 ;RECORD-LENGTH
ATRFMT: BLOCK 2 ;FORMAT
ATRDEF: BLOCK 1 ;DEFAULT BLOCK-LENGTH FROM GETJI
SEGMENT CODE
;Routine to get the ASCII filespec fields back out of the JFN
;Call:
; IJFN/ JFN
; PUSHJ P,DOJFNS
; <return here, ASCII strings in DDB set up>
; Uses T1, T3
DOJFNS: SKIPE T1,IJFN(D) ;GET JFN
CAIN T1,.PRIIN ;IS IT AN OPEN CONTROLLING TTY:?
POPJ P, ;NO JFN OR CONTROLLING TTY
SETZM TMPFIL(D) ;[4135] ASSUME NOT A TEMPORARY FILE
MOVE T2,IJFN(D) ;[4135] GET JFN BITS
TXNE T2,GJ%TFS ;[4135] IS IT A TEMPORARY FILE?
SETOM TMPFIL(D) ;[4135] YES. SAVE INFO FOR LATER
HRROI T1,DEV(D) ;STORE DEVICE AS SUBSEQUENT DEFAULT
MOVE T2,IJFN(D) ;GET JFN
MOVX T3,FLD(.JSAOF,JS%DEV)
JFNS%
HRROI T1,DIRNAM(D) ;STORE DIRECTORY
MOVE T2,IJFN(D) ;GET JFN
MOVX T3,FLD(.JSAOF,JS%DIR)
JFNS%
HRROI T1,FILNAM(D) ;STORE FILENAME
MOVE T2,IJFN(D) ;GET JFN
MOVX T3,FLD(.JSAOF,JS%NAM)
JFNS%
HRROI T1,EXT(D) ;STORE EXTENSION
MOVE T2,IJFN(D) ;GET JFN
MOVX T3,FLD(.JSAOF,JS%TYP)
JFNS%
SETZM PROT(D) ;Clear old protection, if set.
HRROI T1,PROT(D) ;STORE PROTECTION
MOVE T2,IJFN(D) ;GET JFN
MOVX T3,FLD(.JSAOF,JS%PRO)
JFNS%
HRROI T1,GEN(D) ;STORE GENERATION NUMBER IN ASCIZ
MOVE T2,IJFN(D) ;GET JFN
MOVX T3,FLD(.JSAOF,JS%GEN)
JFNS%
REPEAT 0,< ;DOESN'T WORK WITH REL 5.1
HRROI T1,NODNAM(D) ;STORE NODE
MOVE T2,IJFN(D) ;GET JFN AGAIN
MOVX T3,JS%NOD ;JUST THE NODE NAME, PLEASE
JFNS%
ERJMP .+1 ;CAN'T. NO PROBLEM
> ;END REPEAT 0
HRROI T1,PASWRD(D) ;STORE PASSWORD
MOVE T2,IJFN(D) ;GET JFN AGAIN
MOVX T3,FLD(.JSAOF,JS%AT1)
MOVE T4,[POINT 7,[ASCIZ /PASSWORD/]]
JFNS%
ERJMP .+1 ;CAN'T. NO PROBLEM
HRROI T1,ACCNT(D) ;STORE ACCOUNT STRING
MOVE T2,IJFN(D) ;GET JFN AGAIN
MOVX T3,FLD(.JSAOF,JS%AT1)
MOVE T4,[POINT 7,[ASCIZ /A/]]
JFNS%
ERJMP .+1 ;CAN'T. NO PROBLEM
HRROI T1,USERID(D) ;STORE USERID
MOVE T2,IJFN(D) ;GET JFN AGAIN
MOVX T3,FLD(.JSAOF,JS%AT1)
MOVE T4,[POINT 7,[ASCIZ /USERID/]]
JFNS%
ERJMP .+1 ;CAN'T. NO PROBLEM
POPJ P,
ERGEN: MOVE T1,FNSPNT ;PUT JFNS STRING IN BLOCK
MOVE T2,IJFN(D) ;GET JFN
LOAD T4,INDX(D) ;GET DEVICE INDEX
MOVE T3,NDFBTS(T4) ;USE AN ALTERNATE SET OF BITS
SKIPE NODNAM(D) ;ANY NODE NAME IN DDB?
TXO T3,JS%NOD ;YES. GET A NODE NAME TOO!
JFNS%
JSHALT ;SHOULDN'T FAIL
MOVEM T1,FNSPNT ;UPDATE POINTER
POPJ P, ;DONE
GENFNS:
GTNAM: SKIPE IJFN(D) ;IS THERE A JFN ALREADY?
JRST GTJFNS ;YES. GO GET FILE STRING
PUSHJ P,SETJFN ;SETUP JFN BLOCK
MOVX T1,GJ%OFG ;DEFERRED-OPEN FILES ARE PARSE-ONLY
IORM T1,JFNBLK+.GJGEN ;
MOVX T1,G1%SLN ;Don't expand logical names either
IORM T1,JFNBLK+.GJF2
MOVEI T1,JFNBLK ;POINT TO GTJFN BLOCK
SETZ T2, ;NO STRING
GTJFN% ;GET A JFN
ERJMP FNOJFN ;FOR SOME REASON, CAN'T GET ONE
MOVEM T1,IJFN(D) ;[4135] STORE JFN WITH FLAGS
PUSHJ P,GTJFNS ;GET JFNS STRING
PJRST RELJFN ;RELEASE JFN
FNOJFN: SKIPN DEV(D) ;ANY DEVICE?
POPJ P, ;NO. NOTHING ELSE, EITHER
SKIPN NODNAM(D) ;ANY NODE NAME?
JRST FNJDEV ;NO. GO OUTPUT DEVICE
XMOVEI T1,NODNAM(D) ;YES. OUTPUT NODE NAME
PUSHJ P,ASCFNS
MOVEI T1,":" ;DEPOSIT 2 COLONS
IDPB T1,FNSPNT
IDPB T1,FNSPNT
FNJDEV: XMOVEI T1,DEV(D) ;Put device
PUSHJ P,ASCFNS ;into buffer
MOVEI T1,":"
IDPB T1,FNSPNT ;DEPOSIT IN BUFFER
SKIPN DIRNAM(D) ;Directory known yet?
JRST FLEXGN ;No
MOVEI T1,"<" ;OUTPUT FILESTRING LEFT BRACKET
IDPB T1,FNSPNT
XMOVEI T1,DIRNAM(D)
PUSHJ P,ASCFNS ;DIRECTORY
MOVEI T1,">"
IDPB T1,FNSPNT
;Here to finish putting out FILE.EXT.GEN
FLEXGN: SKIPN FILNAM(D) ;ANY FILE GIVEN?
POPJ P, ;NO. NOTHING MORE TO PRINT
XMOVEI T1,FILNAM(D) ;OUTPUT FILENAME
PUSHJ P,ASCFNS
MOVEI T1,"."
IDPB T1,FNSPNT
XMOVEI T1,EXT(D) ;OUTPUT EXTENSION
PUSHJ P,ASCFNS
MOVEI T1,"."
IDPB T1,FNSPNT
XMOVEI T1,GEN(D) ;OUTPUT GENERATION
PJRST ASCFNS
GTJFNS: MOVE T1,FNSPNT ;PUT JFNS STRING IN BLOCK
MOVE T2,IJFN(D) ;GET JFN
LOAD T4,INDX(D) ;GET DEVICE INDEX
MOVE T3,FNSBTS(T4) ;GET PROPER BITS FOR THIS DEVICE
SKIPE NODNAM(D) ;ANY NODE NAME IN DDB?
TXO T3,JS%NOD ;YES. GET A NODE NAME TOO!
JFNS%
JSHALT ;SHOULDN'T FAIL
MOVEM T1,FNSPNT ;UPDATE POINTER
POPJ P, ;DONE
FNSBTS: FLD(.JSAOF,JS%DEV)+JS%PAF ;TTY - DEVICE ONLY
FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF ;DISK
FLD(.JSAOF,JS%DEV)+JS%PAF ;MTA - DEVICE ONLY
FLD(.JSAOF,JS%DEV)+JS%PAF ;OTHER - DEVICE ONLY
FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF ;REMOTE STREAM FILE
FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF ;RMS FILE
NDFBTS: FLD(.JSAOF,JS%DEV)+JS%PAF ;TTY - DEVICE ONLY
0 ;DISK - NOTHING FOR DEFAULTS
FLD(.JSAOF,JS%DEV)+JS%PAF ;MTA - DEVICE ONLY
FLD(.JSAOF,JS%DEV)+JS%PAF ;OTHER - DEVICE ONLY
FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF ;REMOTE STREAM FILE
FLD(.JSAOF,JS%DEV)+FLD(.JSAOF,JS%DIR)+FLD(.JSAOF,JS%NAM)+FLD(.JSAOF,JS%TYP)+FLD(.JSAOF,JS%GEN)+JS%PAF ;RMS FILE
NDLOOK:
DLOOK: PUSHJ P,SETJFN ;SETUP FOR GTJFN
MOVX T1,GJ%OLD+GJ%IFG ;[4135] LOOKUP FILE
IORM T1,JFNBLK+.GJGEN
MOVEI T1,JFNBLK ;POINT TO JFN BLOCK
SETZ T2,
GTJFN% ;SEE IF FILE EXISTS
ERJMP %POPJ ;IT DOES NOT.
MOVEI T1,(T1) ;GET JUST THE JFN
HRRZM T1,IJFN(D) ;SAVE IT WITH NO FLAGS
JRST %POPJ1 ;SKIP RETURN
> ;IF20
IF10,<
DMSK==1_':' + 1_'.' + 1_'/' + 1_'=' ;BREAKS
.CTTRM=<SIXBIT /TTY/>
;DLOOK AND NDLOOK - LOOKUP FILE
NDLOOK: JRST %POPJ1 ;DEVICE MUST BE THERE
DLOOK: MOVE T1,[FO.PRV+FO.ASC+.FORED] ;SETUP FOR LOOKUP
MOVEM T1,FBLK(D)
MOVEI T1,.IODMP ;DUMP MODE, SO NO BUFFERS
MOVEM T1,FBLK+.FOIOS(D)
SETZM FBLK+.FONBF(D) ;DON'T LEAVE JUNK AROUND FOR HEADERS
SETZM FBLK+.FOBRH(D)
PUSHJ P,SETFB ;SETUP FILOP BLOCK
MOVEI T1,FBLK(D) ;POINT TO FILOP BLOCK
HRLI T1,.FOMAX ;SETUP FOR FILOP
FILOP. T1, ;LOOKUP FILE
JRST DLERR ;NOT FOUND
AOS (P) ;FOUND. SKIP RETURN
PJRST SETPPB ;[4134] POINT BACK TO PATH BLOCK AGAIN
DLERR: SETZM FBLK(D) ;CLEAR CHANNEL INFO
CAIN T1,ERPRT% ;PROTECTION FAILURE?
AOS (P) ;YES. WE REALLY FOUND THE FILE
PJRST SETPPB ;[4134] POINT TO PATH BLOCK AGAIN
;SETFI - MOVE THE DDB INFO TO THE FILE BLOCKS
SETFI: MOVEI T1,DEV(D) ;GET ASCIZ DEVICE NAME POINTER
HRLI T1,(POINT 7)
MOVEM T1,SRCBP
MOVEI T1,LDEVC ;AND COUNT
MOVEM T1,SRCLEN
XMOVEI T1,[ASCIZ /device/]
MOVEM T1,%ARGNM
PUSHJ P,ASCSIX ;CONVERT TO SIXBIT
$DCALL IDD ;ILLEGAL CHAR IN DEVICE
MOVE T1,ATMBUF ;GET DEVICE NAME
MOVEM T1,FBLK+.FODEV(D) ;SAVE IT
SETZM LKPB+.RBNAM(D) ;[4205] CLEAR FILENAME
HRRZS LKPB+.RBEXT(D) ;[4205] AND EXTENSION
MOVE T1,FILNAM(D) ;[4205] GET FILE NAME
MOVE T2,EXT(D) ;[4205] AND EXTENSION
CAME T1,[ASCIZ /*/] ;[4205] IS IT *.*?
CAMN T2,[ASCIZ /*/] ;[4205]
JRST SETDIR ;[4205] YES. DON'T SETUP FILENAME/EXT
MOVEI T1,FILNAM(D) ;GET ASCIZ FILENAME POINTER
HRLI T1,(POINT 7)
MOVEM T1,SRCBP
MOVEI T1,LFILC ;AND COUNT
MOVEM T1,SRCLEN
XMOVEI T1,[ASCIZ /filename/]
MOVEM T1,%ARGNM
PUSHJ P,ASCSIX ;CONVERT TO SIXBIT
$DCALL IDD ;ILLEGAL CHAR IN FILENAME
MOVE T1,ATMBUF ;GET FILENAME
MOVEM T1,LKPB+.RBNAM(D) ;SAVE IT
MOVEI T1,EXT(D) ;GET ASCIZ EXTENSION STRING
HRLI T1,(POINT 7)
MOVEM T1,SRCBP
MOVEI T1,3 ;ONLY 3 CHARS ALLOWED FOR EXTENSION
MOVEM T1,SRCLEN
XMOVEI T1,[ASCIZ /extension/]
MOVEM T1,%ARGNM
PUSHJ P,ASCSIX ;CONVERT TO SIXBIT
$DCALL IDD ;ILLEGAL CHAR IN EXTENSION
MOVE T1,ATMBUF ;GET EXTENSION
HLLM T1,LKPB+.RBEXT(D) ;SAVE IT
SETDIR: SKIPN DIRNAM(D) ;[4205] ANY DIRECTORY PATH SET?
JRST SETCC ;[4174] NO. GO SET CARRIAGECONTROL
MOVEI T1,DIRNAM(D) ;GET ASCIZ DIRECTORY STRING
HRLI T1,(POINT 7)
MOVEM T1,SRCBP
MOVEI T1,LDIRC ;AND LENGTH
MOVEM T1,SRCLEN
PUSHJ P,DPTH ;TRANSLATE TO PATH
POPJ P, ;ILLEGAL PATH
SETCC: LOAD T1,CC(U) ;[4171] GET CARRIAGE CONTROL VALUE
CAIE T1,CC.FOR ;[4171] FORTRAN?
JRST %POPJ1 ;[4171] NO. DONE
MOVX T1,RB.DEC ;[4171] TELL TOPS-10 TO PAY ATTENTION
IORM T1,LKPB+.RBTYP(D) ;[4171]
MOVEI T1,.RBCFO ;[4171] AND SET FORTRAN CARRIAGE CONTROL
DPB T1,[POINTR (LKPB+.RBTYP(D),RB.DCC)] ;[4171]
JRST %POPJ1 ;DONE
;DOJFNS - PUT CERTAIN FILE INFORMATION FROM THE FILE BLOCKS
;BACK INTO THE DDB
DOJFNS: LOAD T1,INDX(D) ;[4141] GET DEVICE INDEX
CAIE T1,DI.DSK ;[4141] DISK?
POPJ P, ;[4141] NO. NOTHING TO DO
MOVEI T1,DEV(D) ;PUT DEVICE BACK
HRLI T1,(POINT 7)
MOVEM T1,FNSPNT
MOVE T1,PTHB+.PTSTR(D) ;GET RETURNED DEVICE
PUSHJ P,SIXASC ;CONVERT TO ASCII
SETZ T1,
IDPB T1,FNSPNT ;END WITH NULL
MOVEI T1,FILNAM(D) ;PUT FILENAME BACK
HRLI T1,(POINT 7)
MOVEM T1,FNSPNT
MOVE T1,LKPB+.RBNAM(D) ;GET FILENAME
PUSHJ P,SIXASC ;CONVERT TO ASCII
SETZ T1,
IDPB T1,FNSPNT ;END WITH NULL
MOVEI T1,EXT(D) ;PUT EXTENSION BACK
HRLI T1,(POINT 7)
MOVEM T1,FNSPNT
HLLZ T1,LKPB+.RBEXT(D) ;GET EXTENSION
PUSHJ P,LHASC ;CONVERT TO ASCII
SETZ T1,
IDPB T1,FNSPNT ;END WITH NULL
MOVEI T1,DIRNAM(D) ;PUT DIRECTORY BACK
HRLI T1,(POINT 7)
MOVEM T1,FNSPNT
PUSHJ P,PTHASC
SETZ T1, ;END WITH NULL
IDPB T1,FNSPNT
SETZM GEN(D) ;NO GENERATIONS ON TOPS-10
POPJ P, ;DONE
;GENFNS & GTNAM - GET A FULL FILENAME STRING. IF THE FILE IS OPEN
;(I.E. FBLK(D).NE.0), RETURNS AN "EXPANDED" STRING, USING THE
;EXPANDED DEVICE NAME AND PATH. IF THE DEVICE IS
;NOT A DISK, JUST GETS THE EXPANDED DEVICE NAME.
FNOJFN: SKIPN DEV(D) ;ANY DEVICE?
POPJ P, ;NO. NOTHING ELSE, EITHER
SKIPN NODNAM(D) ;ANY NODE NAME?
JRST FNJDEV ;NO. GO OUTPUT DEVICE
XMOVEI T1,NODNAM(D) ;YES. OUTPUT NODE NAME
PUSHJ P,ASCFNS
MOVEI T1,":" ;DEPOSIT 2 COLONS
IDPB T1,FNSPNT
IDPB T1,FNSPNT
FNJDEV: XMOVEI T1,DEV(D) ;Put device
PUSHJ P,ASCFNS ;into buffer
MOVEI T1,":"
IDPB T1,FNSPNT ;DEPOSIT IN BUFFER
SKIPE NODNAM(D) ;ANY NODENAME?
PUSHJ P,DIROUT ;YES. OUTPUT DIRECTORY HERE
SKIPN FILNAM(D) ;ANY FILE GIVEN?
POPJ P, ;NO. NOTHING MORE TO PRINT
XMOVEI T1,FILNAM(D)
PUSHJ P,ASCFNS
MOVEI T1,"."
IDPB T1,FNSPNT
XMOVEI T1,EXT(D) ;OUTPUT EXTENSION
PUSHJ P,ASCFNS
SKIPN GEN(D) ;ANY GENERATION?
JRST NOGEN ;NO. SKIP IT
MOVEI T1,"."
IDPB T1,FNSPNT
XMOVEI T1,GEN(D) ;OUTPUT GENERATION NUMBER
PUSHJ P,ASCFNS
NOGEN: SKIPE NODNAM(D) ;IS THERE A NODENAME?
POPJ P, ;YES. DIRECTORY IS ALREADY OUT
DIROUT: SKIPN DIRNAM(D) ;ANY DIRECTORY SPECIFIED?
POPJ P, ;NO. DONE
MOVEI T1,"[" ;OUTPUT FILESTRING LEFT BRACKET
IDPB T1,FNSPNT
XMOVEI T1,DIRNAM(D)
PUSHJ P,ASCFNS ;DIRECTORY
MOVEI T1,"]"
IDPB T1,FNSPNT
POPJ P, ;DONE
ERGEN: SKIPE NODNAM(D) ;ANY NODE NAME?
JRST FNOJFN ;YES. GIVE FULL FILESPEC FROM DDB
MOVE T1,PTHB+.PTSTR(D) ;GET DISK WHERE FILE WAS FOUND
CAMN T1,%JIBLK+.PTSTR ;SAME AS 'DSK' TOP DISK?
JRST ERFIL ;YES. SKIP IT
PUSHJ P,SIXASC ;NO. OUTPUT IT
MOVEI T1,":" ;WITH A COLON
IDPB T1,FNSPNT
ERFIL: MOVE T1,LKPB+.RBNAM(D) ;GET FILENAME
PUSHJ P,SIXASC ;OUTPUT IT
MOVEI T1,"." ;OUTPUT PERIOD
IDPB T1,FNSPNT
MOVE T1,LKPB+.RBEXT(D) ;GET EXTENSION
PUSHJ P,LHASC ;OUTPUT IT
XMOVEI T2,PTHB+.PTPPN(D) ;POINT TO PATH BLOCK
MOVEI T3,%JIBLK+.PTPPN ;AND TO DEFAULT PATH BLOCK
HRLI T3,.PTPPN-.PTMAX ;GET # SFDS + PPN
ERFLP: MOVE T1,(T2) ;GET FILE PATH ELEMENT
CAME T1,(T3) ;SAME AS DEFAULT PATH?
JRST GENPPN ;NO. GIVE ENTIRE PATH
ADDI T2,1 ;INCR PATH BLOCK PNTR
AOBJN T3,ERFLP ;AND DEFAULT PATH POINTER
POPJ P, ;ALL THE SAME. NO PPN OUTPUT
GENFNS: SKIPN FBLK(D) ;IS FILE OPEN?
JRST FNOJFN ;NO. USE DDB INFO
SKIPN NODNAM(D) ;ANY NODE NAME?
JRST FNSNN ;NO
XMOVEI T1,NODNAM(D) ;YES. OUTPUT IT
PUSHJ P,ASCFNS
MOVEI T1,":" ;AND 2 COLONS
IDPB T1,FNSPNT
IDPB T1,FNSPNT
FNSNN: MOVE T1,PTHB+.PTSTR(D) ;YES. GET DEVICE FROM PATH BLOCK
PUSHJ P,SIXASC ;PUT INTO STRING BUFFER
MOVEI T1,":" ;PUT IN COLON
IDPB T1,FNSPNT
MOVE T1,LKPB+.RBNAM(D) ;GET FILENAME
PUSHJ P,SIXASC ;PUT INTO STRING BUFFER
MOVEI T1,"." ;PUT IN DOT
IDPB T1,FNSPNT
MOVE T1,LKPB+.RBEXT(D) ;GET EXTENSION
PUSHJ P,LHASC ;PUT INTO STRING BUFFER
GENPPN: SKIPN PTHB+.PTPPN(D) ;ANY PPN?
POPJ P, ;NO. DONE
MOVEI T1,"[" ;BRACKET THE PPN
IDPB T1,FNSPNT
PUSHJ P,PTHASC ;CONVERT PATH TO ASCII
MOVEI T1,"]" ;FINISH DIRECTORY
IDPB T1,FNSPNT
POPJ P,
GTNAM: MOVEI T1,DEV(D) ;GET DEVICE
HRLI T1,(POINT 7)
MOVEM T1,SRCBP
MOVEI T1,LDEVC ;AND ITS LENGTH
MOVEM T1,SRCLEN
PUSHJ P,ASCSIX ;CONVERT TO SIXBIT
$SNH ;SHOULD HAVE CAUGHT ILLEGAL CHAR BEFORE
MOVE T1,ATMBUF ;GET SIXBIT DEVICE NAME
DEVNAM T1, ;GET ITS EXPANDED NAME
$SNH ;SHOULD HAVE CAUGHT THIS BEFORE
PJRST SIXASC ;PUT INTO STRING BUFFER AND LEAVE
;RELJFN - IF FILE IS OPEN (FBLK(D).NE.0), RELEASE THE CHANNEL
RELJFN: SKIPN T2,FBLK(D) ;IS FILE OPEN?
POPJ P, ;NO
HRRI T2,.FOREL ;GET RELEASE FUNCTION
MOVE T1,[1,,T2] ;SETUP FOR FILOP
FILOP. T1, ;RELEASE THE CHANNEL
$ACALL CLS ;FAILED. TYPE MSG AND DIE
SETZM FBLK(D) ;CLEAR EVIDENCE OF CHANNEL WORD
POPJ P,
PTHASC: MOVE T1,PTHB+.PTPPN(D) ;GET THE PPN
PUSHJ P,XWDASC ;PUT INTO STRING BUFFER
MOVEI T1,PTHB+.PTSFD(D) ;[4134] POINT TO SFDS
HRLI T1,-5 ;[4134]MAX 5 OF THEM
GPTHLP: MOVEM T1,PTHPNT ;[4134] SAVE COUNT/POINTER
SKIPN T1,(T1) ;ANY SFD THERE?
POPJ P, ;NONE LEFT
MOVEI T0,<","> ;YES. OUTPUT A COMMA
IDPB T0,FNS