Trailing-Edge
-
PDP-10 Archives
-
FORTRAN-10_Alpha_31-jul-86
-
foropn.mac
There are 27 other files named foropn.mac in the archive. Click here to see a list.
SEARCH MTHPRM,FORPRM
TV FOROPN OPEN & CLOSE ,11(5016)
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1981, 1986
;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>.
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.
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.
4211 JLC 2-May-85
Deallocate channels allocated by accident by TOPS-10 on FILOPs
which fail, thus preventing undeserved "out of channels" errors
for programs which open a few files many times. Also, don't
return path information if the path block wasn't filled in,
such as for protection failures.
4212 JLC 2-May-85
Fix yet another DATE75 bug, this one due to the fact that TOPS-10
deposits the rename error code in the right half of .RBEXT, where
the low-order 15 bits of the creation date reside. This happened
only on a rename failure after DIALOG.
4213 JLC 9-May-85
Make sure BLOCKSIZE is an integral multiple of RECL for
fixed-length records on industry magtape; issue fatal error
if not.
4220 JLC 22-July-85
Fix initial TTY output, which was throwing away all vertical
motion control, instead of reducing the number of LFs by 1,
as in V7.
4225 RJD 23-Sep-85
Add check for FTDSK being set non-zero.
4244 MRB 7-Feb-86
Files are always written in .IODMP mode. They must have the
user selected mode recorded in the FDB. When closing a file
(on a TOPS-10 system) we should look at the I/O mode specified
by the user and perform a rename FILOP. to set the proper
I/O mode in the FDB.
4246 MRB 11-Mar-86
CORRECTION TO EDIT 4244! When closing a non-disk unit we should
NOT do a rename FILOP.
4247 RJD 11-Mar-86
Make the error "FRSOPN Can't open file: Too many open units"
a fatal error.
4250 MRB 17-Mar-86
Add an additional check to the routine that checks to see if this
is the controling terminal. This new check will see if the job
is detached. If the job is detached we shouldn't to a DEVST JSYS
because, this JSYS will wait until a controling attaches to the
job to return. If the job is detached just jump to NOTTTY
because a detached job cannot have a controling terminal.
4251 MRB 1-APR-86
Yet another CORRECTION TO EDIT 4244! When closing a disk unit
which is opened for input only we should NOT do a rename FILOP.
Also,problems with renaming the dates&time fixed.
4253 MRB 5-MAY-86
Remove the test for Ascii-only devices in OTHOPN. Was causing
plotter output to be wrong mode.
4254 MRB 6-May-86
<CRLF> before error message was lost after installing edit 4250.
4256 MRB 20-JUN-86
Set Blocksize for magtape {record size to the monitor}.
***** End Revision History *****
***** Begin Version 11 *****
5000 TGS 1-Jul-85
Implement RMS OPEN.
5001 TGS 1-Aug-85
Implement RMS INQUIRE.
5002 TGS 1-Sep-85
Implement RMS CLOSE.
5004 TGS 10-Nov-85
RMS WRITE.
MRB 2-Dec-85
5005 Added routine MTGTJF and called it by code in MTAOPN.
5006 MRB 18-Dec-85
Disallow append mode for labeled magtapes, disallow
Input and output switching for labeled tapes.
Removed routine MTGTJF (incompatible with Tops-10).
5007 TGS 4-Jan-86
Add %RMECK call to cleanup after failing FOROPN OPEN for RMS
files.
5016 MRB 16-Jun-86
Implement MAXREC keyword in open statements.
\
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
IF20,< INTERN %OLDDB,CLSDDB,DSKREN,TXTBF2,SWDISC,%SOCNT,JFNBLK ;[5002]>
IF20,< INTERN OPNSWT,KEYVAL,FNDSWT,SWRECT,D.KEY,OPCNF ;[5000]>
IF20,< INTERN FNSCLR,FNSPNT,%GNPNT,FNOJFN,ASCFNS,RELJFN ;[5000]>
IF20,< INTERN %DOJFNS,RANALC,CHKBSZ,BSTAB,%RSEOF,FDB ;[5000]>
IF20,< INTERN UNKXST ;[5001]>
IF20,< INTERN ILLOUT ;[5004]>
INTERN O.KEY,O.DIAL ;[5000]
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
IF20,< EXTERN %RMISW,%RSISW,%RMOSW,%RMCLS,%RMOPN,%RMLKP ;[5000]>
IF20,< EXTERN %RMRFS,%RMDSP,%RMREN ;[5000]>
IF20,< EXTERN %RMGXF,%CHKBD,FNDRMS ;[5000]>
IF20,< EXTERN %RMEFN,%RMCSY ;[5002]>
EXTERN %RMKOP,%RMDAB,%RMDKB,%RMCKF,%RMDFA ;[5000]
EXTERN %RSOSW ;[5000]
EXTERN %RMECK ;[5007]
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.KEY ;[5000] KEY= SEEN?
PUSHJ P,%RMKOP ;[5000] Yes, do it (must precede DIALOG=)
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: PUSHJ P,%RMDKB ;[5000] DEALLOCATE DIALOG KEY=
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,O.KEY ;[5000] SAVE NEW KEY= PNTR
MOVEM T1,SAVKEY ;[5000]
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 T1,SAVKEY ;[5000] RESTORE O.KEY
MOVEM T1,O.KEY ;[5000]
MOVE D,SAVED
POPJ P,
SEGMENT DATA
SAVEU: BLOCK 1 ;SAVED UNIT BLOCK
SAVED: BLOCK 1 ;SAVED DEVICE BLOCK
SAVKEY: BLOCK 1 ;[5000] O.KEY POINTER
;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
LOAD T2,ACC(D) ;[5000] GET ACCESS
MOVEI T3,OK.STAT ;[5000] AND STATUS KEYWORD VALUE
MOVEI T4,OK.ACC ;[5000] AND ACCESS KEYWORD VALUE
PUSHJ P,OPCNF ;[5000] 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.
PUSHJ P,%RMDAB ;[5000] DEALLOCATE RMS STUFF IF THERE
SETZM O.KEY ;[5000] CLEAR KEY PNTR
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
LOAD T2,DISP(D) ;[5000]
MOVEI T3,OK.STAT
MOVEI T4,OK.DISP
PUSHJ P,OPCNF ;[5000] REPORT ERROR
POPJ P,
;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
;[5000] Rewritten
CKCONF:
;Check /MODE and /FORM conflict
CKCNFM: LOAD T2,FORM(D) ;T2= form
JUMPE T2,CKCNAC ;If not specified, no conflict
LOAD T1,MODE(D) ;T1= mode
JUMPE T1,CKCNAC ;If not specified, no conflict
CAIL T1,MD.ASC ;ASCII or greater implies /FORM:F
JRST CKFMF ;Go check that
;Must be /FORM:UNFORMATTED
CKFMU: CAIN T2,FM.UNF ;UNFORMATTED?
JRST CKCNAC ;Yes, ok
CKFMUE: MOVEI T3,OK.MOD ;MODE switch number
MOVEI T4,OK.FORM ;FORM switch number
PUSHJ P,OPCNF ;Setup and issue error
JRST CKCNAC ;Continue
;Here if /FORM must be "FORMATTED"
CKFMF: CAIE T2,FM.FORM ;FORMATTED?
JRST CKFMUE ;No, give error
;Check conflict of /ACCESS and /READONLY
CKCNAC: LOAD T2,RO(D) ;T2= "Readonly" bit
JUMPE T2,CKCSRO ;If not specified, no conflict
LOAD T1,ACC(D) ;T1= ACCESS
CAIE T1,AC.SOU ;SEQOUT?
CAIN T1,AC.APP ; or APPEND?
JRST .+2 ;Yes, can't have READONLY
JRST CKCSRO ;Otherwise it's ok
SETZ T2, ;READONLY has no value
MOVEI T3,OK.ACC ;ACCESS switch number
MOVEI T4,OK.RO ;READONLY switch number
CALL OPCNF ;Setup and issue error
;Check conflict of /STATUS and /READONLY
CKCSRO: LOAD T2,RO(D) ;Get value of /READONLY
JUMPE T2,CKCSAC ;[4205] Not specified, no conflict
LOAD T1,STAT(D) ;Get /STATUS
CAIE T1,ST.NEW
CAIN T1,ST.SCR ;New and scratch don't make sense
JRST .+2
JRST CKCSAC ;Otherwise OK
SETZ T2, ;READONLY has no value
MOVEI T3,OK.STAT
MOVEI T4,OK.RO
CALL OPCNF ;Setup and issue error
;Check conflict of /STATUS and /ACCESS
CKCSAC: LOAD T1,ACC(D)
JUMPE T1,CKCACM ;If no ACCESS specified, no conflict
LOAD T2,STAT(D) ;Get STATUS
JUMPE T2,CKCACM ;If not specified, no conflict
CAILE T2,ST.DISP ;Any kind of DISPOSE is ok
JRST CKCACM
CAIE T2,ST.OLD ;STATUS='old'
CAIN T2,ST.UNK ;STATUS='unknown'
JRST CKCACM ;No conflict
;STATUS= 'NEW' or 'SCRATCH' - can't happen if file is read-only
CAIE T1,AC.SIN ;SEQIN
CAIN T1,AC.RIN ;RANDIN
JRST CKCSC1 ;?Conflict
CAIE T2,ST.SCR ;STATUS='SCRATCH'?
JRST CKCACM ;No, no conflict
CAIE T1,AC.SIO ;Yes, only SEQINOUT
CAIN T1,AC.RIO ; and RANDOM allowed
JRST CKCACM ;No conflict
;/ACCESS vs. /STATUS
CKCSC1: MOVEI T3,OK.ACC
MOVEI T4,OK.STAT
CALL OPCNF ;Setup and issue 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 CHKRMS ;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 CHKRMS ;Not /MODE:DUMP, go on.
MOVEI T3,OK.ACC
MOVEI T4,OK.MODE
CALL OPCNF
CHKRMS: PUSHJ P,%RMCKF ;Check for RMS keyword conflicts
JRST CKRETN ;Was RMS, all done
;Not RMS, check for RECORDSIZE
CHKRSZ: LOAD T1,ACC(D) ;GET /ACCESS
CAIE T1,AC.RIN ;RANDOM?
CAIN T1,AC.RIO
TRNA ;YES
JRST CKRETN ;[4205] RETURN FROM CHECKING CONFLICTS
MOVE T1,RSIZE(D) ;GET /RECORDSIZE
JUMPN T1,CKRETN ;[4205] NONZERO, OK
PUSHJ P,[$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]
;OPCNF - Setup for a call to OPCONF
;++ [5000] New
;
; FUNCTIONAL DESCRIPTION:
;
; Sets up OPEN keyword switch numbers and values for an "Incompatible
; attributes" call to OPCONF
;
; CALLING SEQUENCE:
;
; PUSHJ P,OPCNF
;
; INPUT PARAMETERS:
;
; T1 - Switch value for %OPNV1
; T2 - Switch value for %OPNV2
; T3 - Switch number for %OPNK1
; T4 - Switch number for %OPNK2
;
; IMPLICIT INPUTS:
;
; None
;
; OUTPUT PARAMETERS:
;
; %OPNV1
; %OPNV2
; %OPNK1
; %OPNK2
;
; IMPLICIT OUTPUTS:
;
; None
;
; FUNCTION VALUE:
;
; None
;
; SIDE EFFECTS:
;
; Uses T1-T4.
;
;--
OPCNF: MOVEM T1,%OPNV1 ;Setup values for OPCONF
MOVEM T2,%OPNV2
MOVEM T3,%OPNK1
MOVEM T4,%OPNK2
PUSHJ P,OPCONF ;Report the error
POPJ P,
;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.RMS ;[5000] If RMS...
CAIN T2,DI.RSF ;[5000] or RSF
MOVEI T2,DI.DSK ;[5000] pretend it's disk
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,CNFBLR ;[4213] Jump if it is specified
; "/RECORDSIZE required for FIXED-LENGTH records"
$DCALL FRR ;None specified.
CNFBLR: LOAD T1,BLKSZ(D) ;[4213] GET BLOCKSIZE
CAIN T1,0 ;[4213] IF NOT SPECIFIED FOR FIXED RECORDS
$DCALL BLZ ;[4213] IT IS A FATAL ERROR
MOVE T2,RSIZE(D) ;[4213] GET RECORDSIZE
IDIV T1,T2 ;[4213] DIVIDE BLOCKSIZE BY RECORDSIZE
JUMPE T2,CNFMT5 ;[4213] IF NO REMAINDER, IT'S OK
$DCALL FBR ;[4213] RECORDS MUST FIT EXACTLY INTO BLOCK
;+
; Magtape Check - Carriage Control specified for Fixed-Length and
; Delimited records (Can't be translated)
;-
CNFMT3:LOAD T1,RECTP(D) ;[4213] 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
JRST %POPJ ;[5004] KEYED
;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
JRST %POPJ ;[5004] KEYED
;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
IF20,< JRST %RSISW ;[5000] REMOTE STREAM FILE
JRST %RMISW ;[5000] RMS FILE
> ;End IF20
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
IF20,< JRST DSKOSW ;[5000] REMOTE STREAM FILE (GOES TO %RSOSW)
JRST %RMOSW ;[5000] RMS FILE
> ; End IF20
;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
LOAD T1,INDX(D) ;[5004] GET FILE TYPE
CAIN T1,DI.RSF ;[5004] RSF?
PJRST %RSOSW ;[5004] YES, MUST TRUNCATE (MAYBE) NOW
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
LOAD T1,LTYP(D) ;[5006]Get label type
CAIE T1,LT.UNL ;[5006] If its' labeled give error
$ACALL SLT ;[5006] Labeled tapes can't
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
SETZM UNKXST ;[5001] CLEAR "UNKNOWN EXISTENCE" FLAG
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 T2,OPNSWT ;[5000] 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 THERE 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: SKIPE NODNAM(D) ;[5000] REMOTE FILESPEC?
JRST SETRDV ;[5000] YES, DON'T QUERY REMOTE DEVICES
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
;[4250] Check to see if this job is detached. If this job is detached
;[4250] we cannot do a DEVST JSYS (cause it will wait for a terminal
;[4250] to attach to it).
SETO T1,T1 ;[4250]Current Job
MOVE T2,[-1,,T1] ;[4250]Return result in T1
XMOVEI T3,1 ;[4250]we only want word 1
GETJI ;[4250]Get the job info
$SNH ;[4250]Shouldn't happen!
SKIPG T1 ;[4254]Is this job detached?
JRST NOTTTY ;[4250]Yes,Device cant be controling TTY
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
JRST SETIND ;[5000]
;[5000] Here when file is remote to set DVTYP to .DVDSK and DVBTS.
SETRDV: MOVEI T1,.DVDSK ;[5000] Disk
STORE T1,DVTYP(D) ;[5000] Set it as device type
MOVE T2,DVBTS(D) ;[5000] Get device bits
TXO T2,DV%IN!DV%OUT ;[5000] Allow access
MOVEM T2,DVBTS(D) ;[5000] Save
;Figure out appropriate INDX(D) -- device type index
SETIND: MOVEI T2,DI.OTHR ;[5000] 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
LOAD T3,RECTP(D) ;[5000] Check RECORDTYPE
CAIN T3,RT.UND ;[5000] If STREAM
MOVEI T2,DI.DSK ;[5000] assume it's local disk
SKIPE NODNAM(D) ;[5000] Remote file?
MOVEI T2,DI.RSF ;[5000] Yes, assume remote stream
LOAD T3,ORGAN(D) ;[5000] Get ORGANIZATION
SKIPE T3 ;[5000] If any given, assume RMS
MOVEI T2,DI.RMS ;[5000]
CAIN T1,.DVMTA ;[5000] Unless it's a magtape
MOVEI T2,DI.MTA ;[5000]
STORE T2,INDX(D) ; . .
CAIE T2,DI.RMS ;[5000] IF RMS IS TO BE INVOKED...
CAIN T2,DI.RSF ;[5000]
PUSHJ P,FNDRMS ;[5000] MAKE SURE IT'S AVAILABLE
LOAD T2,INDX(D) ;[5000] GET INDEX BACK
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: PUSHJ P,%RMDFA ;[5000] Set RMS defaults
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,UBUFCT(D) ;[5000] GET USER'S BUFFER COUNT
STORE T1,BUFCT(D) ;[5000] STORE
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: MOVE T1,RECTP(D) ;[5000] GET RECORDTYPE
CAIN T1,RT.UNS ;[5000] ANY USER VALUE?
JRST NORCTP ;[5000] NONE GIVEN, USE DEFAULT
;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
SKIPN MRSIZE(D) ;[5000] UNLESS ALREADY SET BY RMS
MOVEM T1,MRSIZE(D) ;[5000]
SETZM RSIZE(D) ;CLEAR THE FIXED RECORDSIZE
JRST TTWSET
NORCTP: MOVEI T1,RT.UND ;[5000] DEFAULT RECORDTYPE TO STREAM
MOVEM T1,RECTP(D) ;[5000]
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: SKIPN T1,MRSIZE(D) ;[5000] IF MRS ALREADY SET, USE IT
MOVE T1,RSIZE(D) ;[5000] ELSE USE RECORDSIZE
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
MOVE T1,RECTP(D) ;[5000] GET RECORDTYP
CAIE T1,RT.UND ;[5000] STREAM FILE?
JRST TTWSET ;[5000] 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
SKIPN T1,RECTP(D) ;[5000] GET RECORDTYP
JRST CTTYCC ;[5000] NONE GIVEN, SO IT'S STREAM
CAIE T1,RT.UND ;[5000] NOT STREAM?
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
DFINQ: PUSHJ P,INQCTX ;[5001] INQUIRE DEFAULTFILE=
JRST DFCOM ;[5001] JOIN COMMON CODE
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: SKIPN O.FILE ;[5001] ALREADY SEEN DEFAULTFILE?
POPJ P, ;[5001] YES
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
SUBTTL DIAKEY - Parse /KEY: in DIALOG mode
;++
; FUNCTIONAL DESCRIPTION:
;
; Parses /KEY: arguments and allocates and/or constructs a
; secondary argument list for XAB allocation. If D.KEY is non-
; zero, reuses a previously allocated arglist. If D.KEY is zero,
; allocates MAXKEY*KSPLEN+1 words for the arglist. Parses arguments
; until a right paren is encountered, checks that total arguments
; are equal to or less than MAXKEY. Calls %RMKOP to allocate a
; XAB chain and deallocates the arglist.
;
; Format of /KEY arguments:
;
; /KEY:{NONE}(LB:UB{:type}{,LB:UB{:type}...})
;
; where
; NONE terminates the parse and clears O.KEY
; LB is a decimal integer for lower bound
; UB is a decimal integer for upper bound
; type is either the word INTEGER or CHARACTER
;
; Format of secondary argument list:
;
; -N,,0 ;N is KSPLEN*number_keys
; xM: IFIW TP%UDF,LB ;primary key first char
; IFIW TP%UDF,UB ;primary key last char
; IFIW type,0 ;type is TP%INT or TP%CHR
; .....
; IFIW TP%UDF,LB ;last key first char
; IFIW TP%UDF,UB ;last key last char
; IFIW type,0 ;type is integer or character
;
; Note that LB and UB are immediate arguments, unlike a compiler-
; generated secondary arglist.
;
;
; CALLING SEQUENCE:
;
; JRST DIAKEY
; [Called from DIASWG only, JRSTs to DIASWT]
;
;
; INPUT PARAMETERS:
;
; None
;
; IMPLICIT INPUTS:
;
; D.KEY - Address of DIALOG secondary arglist if one already
; exists
;
; OUTPUT PARAMETERS:
;
; None
;
; IMPLICIT OUTPUTS:
;
; D.KEY - Address DIALOG secondary arglist
; O.KEY - Address of OPEN secondary arglist, set to D.KEY
;
; FUNCTION VALUE:
;
; None
;
; SIDE EFFECTS:
;
; May allocate/deallocate MAXKEY*KSPLEN+1 words of memory and
; call %RMKOP to allocate a XAB chain.
;
;--
;[5000] New
DIAKEY: SKIPN T1,D.KEY ;Any previous arglist?
JRST DKYALC ;No, allocate one
SETZM -1(T1) ;Yes. Clear the count
SETZM (T1) ;Clear out arglist
HRL T2,T1 ;address,,address+1
HRRI T2,1(T1)
BLT T2,MAXKEY*KSPLEN-1(T1)
JRST GETLP ;Go re-use
DKYALC: MOVEI T1,MAXKEY*KSPLEN+1 ;Maximum size
PUSHJ P,%GTBLK ;Get it
$ACALL MFU ;Can't
ADDI T1,1 ;Point past count word
MOVEM T1,D.KEY ;Store it
GETLP: MOVE P1,T1 ;Get arglist pointer
SETZ T2,
PUSHJ P,DKDLB ;Initialize lower bound default
SETZM K.KCT ;Initialize specifier count
;Parse opening left paren
MOVEI T1,CSB ;Point to Command State Block
MOVEI T2,DKLP ;Look for "("
PUSHJ P,COMAND ;Parse it
HRRZ T3,T3 ;Get FDB actually used
CAIN T3,DKNO ;"NONE"?
JRST NOKEY ;Yes, quit right now
;Top of LB:UB{:type} loop
KEYLP: AOS T2,K.KCT ;Increment specifier count
CAILE T2,MAXKEY ;Beyond max?
$DCALL TKS
;Here to parse lower bound
MOVEI T2,DKLB ;Parse lower bound
PUSHJ P,COMAND
PUSHJ P,%CHKBD ;Check validity
JRST BADKEY ;Bad
HRRZM T2,LBO(P1) ;Store in arglist
MOVEI T2,DKCOL ;Look for ":"
PUSHJ P,COMAND
;Here to parse upper bound
MOVEI T2,DKUB ;Parse upper bound
PUSHJ P,COMAND
PUSHJ P,%CHKBD ;Check validity
JRST BADKEY ;Bad
HRRZM T2,UBO(P1) ;Store in arglist
PUSHJ P,DKDLB ;Set LB default to last UB+1
MOVEI T1,CSB ;Restore State Block pointer
;Here to parse optional data type
MOVEI T2,TP%CHR ;Default data type to TP%CHR
DPB T2,[POINTR (DTO(P1),ARGTYP)]
MOVEI T2,DKCCP ;Look for ":", ",", or ")"
PUSHJ P,COMAND
HRRZ T3,T3 ;Get FDB actually used
CAIE T3,DKCCP ;":" found?
JRST CHKCOM ;No
;Here to parse key data type.
MOVEI T2,DKTYP ;Parse keyword for type
PUSHJ P,COMAND
HRRZ T2,(T2) ;Get data type for keyword
DPB T2,[POINTR (DTO(P1),ARGTYP)] ;Set in arglist
MOVEI T2,DKCOM ;Look for "," or ")"
PUSHJ P,COMAND
HRRZ T3,T3 ;Get FDB actually used
;Bottom of LB:UB{:type} loop
CHKCOM: ADDI P1,KSPLEN ;Point to next arglist section
CAIN T3,DKCOM ;Comma found?
JRST KEYLP ;Yes, back for more
;No, must be closing paren
;Here on right paren. Calculate arglist count, setup O.KEY, chain the XAB(s),
;deallocate the temporary arglist, and go do more DIALOG.
MOVE T1,K.KCT ;Get count of specifiers
IMULI T1,KSPLEN ;Calculate actual arglist length
MOVN T1,T1 ;Make negative
MOVSI T1,(T1) ;Get arglist count -n,,0
MOVE T2,D.KEY ;Get arglist address
MOVEM T1,-1(T2) ;Set in count word
MOVEM T2,O.KEY ;Set O.KEY to this arglist
PUSHJ P,%RMKOP ;Go setup XAB(s)
PUSHJ P,%RMDKB ;Deallocate the temporary arglist
JRST DIASWT ;Continue parsing DIALOG
;Here on bad LB/UB values. There are 2 possibilities: a value greater
;than 17 bits ("Number too large"), or a value .LE. zero ("Number too
;small").
BADKEY: MOVEI T1,FLINX2 ;Assume too small (.LE. zero)
SKIPLE T2 ;Was it?
MOVEI T1,FLINX3 ;No, too big
MOVEI T2,(T1) ;Get error code in T2
MOVEI T1,.FHSLF ;This fork
SETER% ;Make it current
SETZM O.KEY ;Clear pointer
PUSHJ P,%RMDKB ;Deallocate arglist
PUSHJ P,COL1 ;Get to column 1
XMOVEI T5,ATMBUF ;Point at what was typed
$DCALL EDA ;Report error
;Here on KEY=NONE. Clear O.KEY and deallocate the arglist
NOKEY: SETZM O.KEY
PUSHJ P,%RMDKB
JRST DIASWT
;++ DKDLB - Default Lower Bound
;
; T2/ Number (from .CMNUM COMND%) to increment for defaulting
; Returns +1 with DLBBUF containing default string
;
;--
;[5000] New
DKDLB: HRROI T1,DLBBUF ;Point at default buffer
MOVEI T2,1(T2) ;Increment number
MOVEI T3,^D10 ;Radix 10
NOUT%
ERJMP .+1 ;Should not fail
POPJ P, ;Return
;COMND% functions for /KEY
;Parse a "(" token
DKLP: FLDDB. (.CMTOK,CM%SDH,<POINT 7,[ASCIZ /(/]>,
<"(" followed by a list of KEY specifiers>,<(>,DKNO)
DKNO: FLDDB. (.CMKEY,0,DKNOT,,)
;Parse Lower Bound number
DKLB: FLD(.CMNUM,CM%FNC)+CM%DPP+CM%HPP+CM%SDH
^D10
POINT 7,[ASCIZ /decimal starting byte position of Key/]
POINT 7,DLBBUF ;Default string (previous UB+1)
;Parse a ":" token
DKCOL: FLDDB. (.CMTOK,CM%SDH,<POINT 7,[ASCIZ /:/]>,
<":" followed by upper bound>,<:>)
;Parse Upper Bound number
DKUB: FLDDB. (.CMNUM,CM%SDH,^D10,
<decimal ending byte position of Key>)
;Parse either ":", "," or ")" tokens
DKCCP: FLDDB. (.CMTOK,CM%SDH,<POINT 7,[ASCIZ /:/]>,
<":" followed by Key data type>,<:>,DKCOM)
;Parse either "," or ")" tokens
DKCOM: FLDDB. (.CMCMA,CM%SDH,,
<"," followed by more KEY specifiers>,,DKRP)
;Parse a ")" token
DKRP: FLDDB. (.CMTOK,CM%SDH,<POINT 7,[ASCIZ /)/]>,
<")" to terminate list of specifiers>)
;Parse key data type keyword
DKTYP: FLDDB. (.CMKEY,0,DKDTB,<Key data type,>,<CHARACTER>)
DEFINE X(KEYWORD,TYPE<TP%CHR>)<
XWD [ASCIZ /KEYWORD/],TYPE
> ;End X
;Keyword table for key data types
DKDTB: XWD DTBL,DTBL
X CHARACTER ;Default is TP%CHR
X INTEGER,TP%INT
DTBL==.-DKDTB-1
DKNOT: XWD DNTBL,DNTBL
X NONE,0
DNTBL==.-DKNOT-1
SEGMENT DATA
D.KEY: BLOCK 1 ;ADDRESS OF USER 2NDARY ARGLIST FOR /KEY:
K.KCT: BLOCK 1 ;COUNT OF SPECIFIERS
DLBBUF: BLOCK 2 ;DEFAULT LOWER BOUND BUFFER
SEGMENT CODE
RELJFN: SKIPN T1,IJFN(D) ;GET JFN
POPJ P, ;NOTHING TO DO IF NO JFN
CAMN T1,[-1] ;[5000] RMS "JFN"?
JRST SETJF0 ;[5000] YES, DON'T RELEASE IT
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 .GJNOD+1 ;[5000] GTJFN ARG BLOCK
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
;[5000] Re-written
SETJFN: SKIPLE 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,<.GJNOD-.GJF2> ;No flags,,# words to follow ext 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
SKIPN NODNAM(D) ;NODENAME?
JRST SETRAT ;NO. ALL SET
HRROI T1,NODNAM(D) ;YES
MOVEM T1,JFNBLK+.GJNOD
SETRAT: MOVE T1,FNSPNT ;GET FNS POINTER
MOVEM T1,FNSPNS ;SAVE
SETZM FNSPNT ;CLEAR PNTR
SKIPN USERID(D) ;ANY USERID?
JRST SPASS ;NO
MOVE T1,[ASCIZ/USER:/] ;KEYWORD PREFIX
MOVEM T1,RATUSR ;STORE
MOVE T1,[POINT 7,RATUSR+1] ;POINT AT ARG STRING
MOVEM T1,FNSPNT
MOVEI T1,USERID(D) ;GET SOURCE PNTR
PUSHJ P,ASCFNS ;OUTPUT IT
SPASS: SKIPN PASWRD(D) ;ANY PASSWORD?
JRST SATR ;NO, CHECK ATTRIBUTES
MOVE T1,[ASCIZ/PASS:/] ;KEYWORD PREFIX
MOVEM T1,RATPAS
MOVE T1,[POINT 7,RATPAS+1] ;ARG STRING
MOVEM T1,FNSPNT
MOVEI T1,PASWRD(D) ;GET SOURCE PNTR
PUSHJ P,ASCFNS ;OUTPUT IT
SATR: XMOVEI T1,RATBLK ;GET ADDRESS OF REMOTE ATTRIBUTE BLK
SKIPE FNSPNT ;ANY ATTRIBUTES FOUND?
MOVEM T1,JFNBLK+.GJATR ;YES, STORE ADDRESS
MOVE T1,FNSPNS ;GET SAVED PNTR
MOVEM T1,FNSPNT ;RESTORE
POPJ P,
RATBLK: EXP RATLEN ;COUNT OF WORDS ATTRIBUTE BLOCK.
POINT 7,RATUSR ;PNTR TO USERID STRING
POINT 7,RATPAS ;PNTR TO PASSWORD STRING
RATLEN==.-RATBLK
SEGMENT DATA
RATUSR: BLOCK LUIDW+1 ;USER:userid
RATPAS: BLOCK LPWDW+1 ;PASS:password
FNSPNS: BLOCK 1 ;SAVED FNS PNTR
SEGMENT CODE
; 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 ATRLEN ;[5002] 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.
ATRLEN==.-ATRBLK ;[5002]
RECASC: ASCIZ /U/ ;UNSPECIFIED
ASCIZ /U/ ;UNDEFINED
ASCIZ /F/ ;FIXED
ASCIZ /D/ ;DELIMITED
ASCIZ /S/ ;SEGMENTED
ASCIZ /U/ ;STREAM_CR
ASCIZ /U/ ;STREAM_LF
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
;[5000] Re-written
DOJFNS: SKIPE T1,IJFN(D) ;GET JFN
CAIN T1,.PRIIN ;IS IT AN OPEN CONTROLLING TTY:?
POPJ P, ;NO JFN OR CONTROLLING TTY
%DOJFNS:
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%
SETZM TATBLK ;CLEAR THE TEMP ATRIBUTE BLOCK
MOVE T1,[TATBLK,,TATBLK+1]
BLT T1,TATBLK+TATMAX
HRROI T1,TNODE ;STORE NODE IN TEMP BLOCK
MOVE T2,IJFN(D) ;GET JFN AGAIN
MOVX T3,JS%NOD ;JUST THE NODE NAME, PLEASE
JFNS%
ERJMP .+1 ;CAN'T. NO PROBLEM
HRROI T1,TPASWD ;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,TACCT ;STORE ACCOUNT STRING
MOVE T2,IJFN(D) ;GET JFN AGAIN
MOVX T3,FLD(.JSAOF,JS%ACT)
JFNS%
ERJMP .+1 ;CAN'T. NO PROBLEM
HRROI T1,TUSID ;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
;NOW CHECK ATTRIBUTES AND, IF NON-ZERO, RETURN THEM TO DDB
SKIPN TNODE ;ANY NODE?
JRST WPASW ;NO, CHECK PASSWORD
MOVE T1,[POINT 7,NODNAM(D)]
MOVEM T1,FNSPNT ;DEST PNTR
XMOVEI T1,TNODE ;SOURCE
PUSHJ P,ASCFNS
WPASW: SKIPN TPASWD ;ANY PASSWORD?
JRST WACCT ;NO, CHECK ACCOUNT
MOVE T1,[POINT 7,PASWRD(D)]
MOVEM T1,FNSPNT
XMOVEI T1,TPASWD
PUSHJ P,ASCFNS
WACCT: SKIPN TACCT ;ACCOUNT?
JRST WUSID ;NO, CHECK USERID
MOVE T1,[POINT 7,ACCNT(D)]
MOVEM T1,FNSPNT
XMOVEI T1,TACCT
PUSHJ P,ASCFNS
WUSID: SKIPN TUSID ;ANY USERID?
POPJ P, ;NO, ALL DONE
MOVE T1,[POINT 7,USERID(D)]
MOVEM T1,FNSPNT
XMOVEI T1,TUSID
PUSHJ P,ASCFNS
POPJ P,
SEGMENT DATA
;Temporary block for attributes
TATBLK:
TNODE: BLOCK LNODW ;NODE
TPASWD: BLOCK LPWDW ;PASSWORD
TACCT: BLOCK LACTW ;ACCOUNT
TUSID: BLOCK LUIDW ;USERID
TATMAX==.-TATBLK-1
SEGMENT CODE
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) ;NO. 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
MOVE T2,FNSPNT ;[5000] SAVE GENERATION PNTR
MOVEM T2,%GNPNT ;[5000]
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 ;[5000] 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 ;[5000] 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 ;[5000] 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 ;[5000] 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
LOOKOK: AOS (P) ;[4211] FOUND. SKIP RETURN
PJRST SETPPB ;[4134] POINT BACK TO PATH BLOCK AGAIN
DLERR: CAIN T1,ERPRT% ;PROTECTION FAILURE?
JRST LOOKOK ;[4211] YES. WE REALLY FOUND THE FILE
PUSH P,T1 ;[4211] SAVE ERROR CODE
PUSHJ P,RELJFN ;[4211] RELEASE THE CHANNEL (IT'S USELESS)
POP P,T1 ;[4211] RESTORE ERROR CODE
PJRST SETPPB ;[4134] POINT BACK 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
MOVEM T1,PTHB(D) ;[4211] ALSO IN PATH BLOCK IF FILOP FAILS
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
SKIPE PTHB+.PTSTR(D) ;[4211] ANY RETURNED DEVICE?
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
TRN ;[4211] IT WAS ALREADY GONE!
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,FNSPNT
PUSHJ P,SIXASC ;PUT INTO STRING BUFFER
MOVE T1,PTHPNT ;[4134]GET POINTER AGAIN
AOBJN T1,GPTHLP ;[4134] LOOP FOR ALL SFDS
POPJ P,
LHASC: MOVE T2,[POINT 6,T1] ;POINT TO T1
MOVEI T3,3 ;ONLY 3 CHARS
JRST SIXLP ;JOIN COMMON CODE
SIXASC: MOVE T2,[POINT 6,T1] ;POINT TO T1
MOVEI T3,6 ;MAX OF 6 CHARACTERS
SIXLP: ILDB T0,T2 ;GET A CHAR
JUMPE T0,%POPJ ;DONE IF ZERO
ADDI T0,40 ;CONVERT TO ASCII
IDPB T0,FNSPNT ;DEPOSIT IN BUFFER
SOJG T3,SIXLP ;LOOP
POPJ P,
ASCASC: ILDB T3,T1 ;GET A CHAR
CAIE T3,40 ;SKIP SPACES
IDPB T3,FNSPNT ;DEPOSIT IN BUFFER
SOJG T2,ASCASC ;LOOP FOR CHAR COUNT
POPJ P,
XWDASC: MOVE T2,[POINT 3,T1] ;POINT TO T1
MOVEI T3,6 ;6 OCTAL DIGITS
XWDLP1: ILDB T0,T2 ;GET A DIGIT
JUMPN T0,XWDGT1 ;IF NON-ZERO, GO PRINT IT
SOJG T3,XWDLP1 ;IF ZERO, SKIP IT
JRST XWDRH ;SHOULDN'T HAPPEN, BUT GO ON TO RH OF WORD
XWDLP2: ILDB T0,T2 ;GET A DIGIT
XWDGT1: ADDI T0,60 ;CONVERT TO ASCII
IDPB T0,FNSPNT ;DEPOSIT IN TEXT BUFFER
SOJG T3,XWDLP2 ;LOOP
XWDRH: MOVEI T0,<","> ;PUT COMMA IN BUFFER
IDPB T0,FNSPNT
MOVEI T3,6 ;SIX DIGITS AGAIN
XWDLP3: ILDB T0,T2 ;GET A DIGIT
JUMPN T0,XWDGT4 ;IF NON-ZERO, GO DEPOSIT IT
SOJG T3,XWDLP3 ;IF ZERO, SKIP IT
POPJ P, ;NO DIGITS ENCODED
XWDLP4: ILDB T0,T2 ;GET A DIGIT
XWDGT4: ADDI T0,60 ;CONVERT TO ASCII
IDPB T0,FNSPNT ;DEPOSIT IN TEXT BUFFER
SOJG T3,XWDLP4 ;LOOP
POPJ P,
DIALOG: XMOVEI T1,[ASCIZ/DIALOG/]
MOVEM T1,%ARGNM ;Store arg name incase errors
PUSHJ P,SAVERR ;DIVERT ERR MSGS TO TTY
SKIPN EFSFLG ;SKIP IF ALREADY TYPED ONCE
$ECALL EFS ;ENTER CORRECT FILE SPECS
SETOM EFSFLG ;SUPPRESS NEXT TIME
OUTCHR ["*"] ;PROMPT
SETZM SRCLEN ;CLEAR TRANSFERRED SOURCE LENGTH
MOVE P3,[POINT 7,%TXTBF] ;POINT TO TEXT DESTINATION
MOVEI P4,LTEXTC-1
DIAINP: INCHWL T1 ;READ CHAR
CAIE T1," " ;SPACE?
CAIN T1,15 ;CR?
JRST DIAINP ;YES, SKIP IT
CAIN T1,11 ;TAB TOO
JRST DIAINP
CAIN T1,33 ;ALT?
JRST DIAALT ;YES
CAIN T1,12 ;LF?
JRST DIALF ;YES
IDPB T1,P3 ;ELSE STORE IN BUFFER
AOS SRCLEN ;INCREMENT TRANSFERRED SOURCE LENGTH
SOJG P4,DIAINP ;READ WHOLE STRING
$DCALL DTL ;DIALOG STRING TOO LONG
;STILL IF10
DIAALT: OUTSTR %CRLF ;TYPE CRLF AFTER ALT
DIALF: LDB T1,P3 ;CHECK LAST CHAR IN BUFFER
CAIE T1,"-" ;CONTINUATION?
JRST DIASC1 ;NO, GO PARSE DIALOG STRING
SETO T1, ;DECR P3 TO OVERWRITE "-"
ADJBP T1,P3
MOVE P3,T1
JRST DIAINP ;KEEP READING
DIASC1: SETZ T1, ;FLAG END OF ASCIZ STRING
IDPB T1,P3
MOVE P3,[POINT 7,%TXTBF] ;POINT TO TEXT BUFFER
MOVEM P3,SRCBP
PJRST DIACOM ;JOIN COMMON CODE
;Now string has been stored in %TXTBF.
;SRCBP = current bp to source string.
COMSTR: PUSHJ P,SAVERR ;DIVERT ERR MSGS TO TTY
PUSHJ P,DIABLT ;COPY THE STRING
DIACOM: PUSHJ P,DPRS1 ;Parse filename or device ...
POPJ P, ;ERROR. GO TO DIALOG
CAIN T1,":" ;Colon terminator?
JRST DIADEV ;Yes, we just got a device
DIASN1: SKIPN ATMBUF ;Filename?
JRST DIANFN ;NO
SETOM FILPRS(D) ;SET FILESPEC PARSED
MOVEI T1,FILNAM(D) ;TRANSFER TO FILENAME
HRLI T1,ATMBUF
BLT T1,FILNAM+LFILW-1(D)
DIANFN: LDB T1,SRCBP ;GET LAST CHARACTER PARSED
CAIN T1,"." ;Extension coming?
JRST DIAEXT ;Yes
PJRST DIACHK
;Got a device (":" was delimiter)
DIADEV: SKIPN ATMBUF ;DEV
$DCALL NDI ;?Null device
MOVSI T1,ATMBUF ;TRANSFER TO TEMP BUFFER
HRRI T1,TMPBUF ;SO WE CAN CHECK FOR A NODE NAME
BLT T1,TMPBUF+LATOMW-1
SETOM FILPRS(D) ;SET FILESPEC PARSED
PUSHJ P,DPRS1 ;Parse filename..
POPJ P, ;ERROR. GO TO DIALOG
CAIE T1,":" ;COLON?
JRST DIADV1 ;No, ok
SKIPE ATMBUF ;ANY CHARS INTERVENING?
$DCALL IDD ;YES. DOUBLE DEVICE NAME ILLEGAL
REPEAT 0,< ;[5000]
MOVEI T1,NODNAM(D) ;NO. WE GOT A NODE NAME
HRLI T1,TMPBUF
BLT T1,NODNAM+LNODW-1(D)
> ;End REPEAT 0 [5000]
$ECALL NNI ;[5000] "%Node name ignored"
PUSHJ P,DPRS1 ;TRY AGAIN
POPJ P, ;ERROR. GO TO DIALOG
CAIE T1,":" ;ANOTHER COLON?
JRST DIASN1 ;NO. ASSUME IT WAS A FILESPEC
SKIPN ATMBUF ;YES. ANY CHARS INTERVENING?
$DCALL IDD ;NO. ILLEGAL CHAR
MOVEI T1,DEV(D) ;YES. RECORD DEVICE NAME
HRLI T1,ATMBUF
BLT T1,DEV+LDEVW-1(D)
PUSHJ P,DPRS1 ;NOW PARSE YET AGAIN
POPJ P, ;ERROR. GO TO DIALOG
JRST DIASN1 ;AND ASSUME IT'S A FILESPEC
;THE FIRST ATOM REALLY WAS A DEVICE AND NOT A NODE NAME. MOVE
;THE TEMP BUFFER INTO DEV(D) AND ASSUME THE NEXT THING IS A FILENAME.
DIADV1: MOVEI T1,DEV(D) ;RECORD DEVICE NAME
HRLI T1,TMPBUF
BLT T1,DEV+LDEVW-1(D)
JRST DIASN1 ;BACK TO FILENAME PARSER
;Next thing is extension ("." seen)
DIAEXT: PUSHJ P,DPRS2 ;Parse extension
POPJ P, ;ERROR. GO TO DIALOG
SETOM FILPRS(D) ;SET FILESPEC PARSED
MOVEI T1,EXT(D) ;TRANSFER EXTENSION
HRLI T1,ATMBUF
BLT T1,EXT+LEXTW-1(D)
LDB T1,SRCBP ;GET LAST CHARACTER PARSED
CAIN T1,"." ;GENERATION COMING?
JRST DIAGEN ;YES
PJRST DIACHK ;GO CHECK END CHAR
DIAGEN: PUSHJ P,DPRS2 ;PARSE GENERATION
POPJ P, ;ERROR. GO TO DIALOG
MOVEI T1,GEN(D) ;TRANSFER GENERATION
HRLI T1,ATMBUF
BLT T1,GEN+LGENW-1(D)
DIACHK: LDB T1,SRCBP ;GET LAST CHARACTER PARSED
JUMPE T1,%POPJ ;RETURN IF AT END
CAIN T1,"[" ;Path coming?
JRST DIAPTH ;Yes
CAIN T1,.CHLAB ;Start of protection
JRST DIAPRO
CAIE T1,"/" ;Switch coming?
$DCALL IDD ;?Illegal character
SKIPE SWTPNT ;ANY SWITCHES ALLOWED?
JRST DIASW1 ;YES. GO PROCESS IT
$DCALL IDD ;No. Illegal character
;STILL IF10
;Parse a protection (Left angle bracket seen).
DIAPRO: PUSHJ P,DOCT ;Read protection
DPB T2,[POINTR (LKPB+.RBPRV(D),RB.PRV)] ;STORE IN DDB
CAIE T1,.CHRAB ;End of field?
$DCALL IDD ;NO. ILLEGAL CHAR
PUSHJ P,DPRCHR ;GET NEXT CHAR
JUMPE T1,%POPJ ;Leave if null delimiter
CAIN T1,"/" ;Switch coming?
JRST DIASW1 ;Yes
CAIE T1,"[" ;Start of PPN?
$DCALL IDD ;OR IT IS A BAD CHAR
DIAPTH: SETOM FILPRS(D) ;SET FILE PARSED
MOVEI T1,DIRNAM(D) ;MOVE PATH TO DDB
HRLI T1,(POINT 7)
MOVEM T1,DSTBP
MOVEI T1,LDIRC
MOVEM T1,DSTLEN
MOVEI T2,"]" ;STOP ON RIGHT SQUARE BRACKET
SETZM DIARRY ;NOT AN ARRAY
PUSHJ P,MOVARG
JUMPE T1,%POPJ ;Return if at end
PUSHJ P,DPRS1 ;GET NEXT ATOM
POPJ P, ;ERROR. GO TO DIALOG
JRST DIASN1 ;GO TRY FOR POSSIBLE FILENAME
;Routine to parse a path
;Reads from SRCBP
;Puts path in DDB.
;If errors, returns .+1 ($ECALL given)
; if ok, returns .+2
DPTH: PUSHJ P,DOCT ;READ PPN
JUMPN T2,DPTH2 ;GOT PROJECT IF NON-ZERO
HLRZ T2,%JIBLK+.PTPPN ;IF ZERO, MIGHT BE NULL PROJECT NUMBER
CAIN T1,"," ;COMMA?
JRST DPTH2 ;YES. SUBSTITUTE THE USER'S PROJECT #
JUMPE T1,STOPPN ;IF NULL DELIMITER, STORE ZERO PPN
$DCALL IPP ;ILLEGAL PPN CHARACTER
DPTH2: CAIE T1,","
$DCALL IPP ;ILLEGAL DELIMITER FOR PPN
PUSH P,T2
PUSHJ P,DOCT
CAIN T2,0
HRRZ T2,%JIBLK+.PTPPN
HRLM T2,(P)
POP P,T2
STOPPN: MOVSM T2,PTHB+.PTPPN(D)
MOVEI P2,PTHB+.PTPPN+1(D) ;POINT TO SFD BLOCK
DIASFD: SETZM (P2) ;FLAG END OF SFD LIST
JUMPE T1,%POPJ1 ;CHECK DELIMITER. END OF STRING IS OK
CAIE T1,"," ;COMMA MEANS SFDS COMING
$DCALL IPP ;ELSE ILL DELIMITER IN DIALOG
CAIL P2,PTHB+.PTPPN+6(D) ;CHECK SFD COUNT
$DCALL TMF ;TOO MANY SFDS
PUSHJ P,ASCSIX ;READ SFD NAME
$DCALL IDD ;ILLEGAL CHAR
SKIPN T2,ATMBUF ;GET SFD
$DCALL NSI ;NULL SFD
MOVEM T2,(P2) ;STORE IN PATH BLOCK
AOJA P2,DIASFD ;KEEP GOING
;STILL IF10
;Parsing routines for DIALOG mode
;Read DEV or FILESPEC or delimiter
DPRS1: MOVE T3,[POINT 7,ATMBUF]
SETZM ATMBUF ;SET FIRST CHARS NULL
MOVE T1,[ATMBUF,,ATMBUF+1] ;NOW CLEAR THE REST
BLT T1,ATMBUF+LATOMW-1
DPRS1A: PUSHJ P,DPRCHR ;Get next char, ignore spaces
JUMPE T1,SWVNUL ;0 ok
CAIE T1,":" ;COLON
CAIN T1,"." ;Dot
JRST SWVNUL ;Are ok
CAIE T1,"[" ;Start of PPN
CAIN T1,"/" ;Start of switch
JRST SWVNUL ;Are ok
CAIN T1,.CHLAB ;And start of protection
JRST SWVNUL
PUSHJ P,DPRCHK ;CHECK FOR VALIDITY
POPJ P, ;Problem, return
IDPB T1,T3 ;Yes, store in BP
JRST DPRS1A ;Loop
;Same as DPRS1 except ":" is not legal delimiters
DPRS2: MOVE T3,[POINT 7,ATMBUF]
SETZM ATMBUF ;SET FIRST CHARS NULL
MOVE T1,[ATMBUF,,ATMBUF+1] ;NOW CLEAR THE REST
BLT T1,ATMBUF+LATOMW-1
DPRS2A: PUSHJ P,DPRCHR ;Get next char, ignore spaces
JUMPE T1,SWVNUL ;Return if done
CAIE T1,"[" ;Start of PPN
CAIN T1,"/" ;Start of switch
JRST SWVNUL ;Are ok
CAIE T1,"." ;Start of generation
CAIN T1,.CHLAB ;Start of protection
JRST SWVNUL
PUSHJ P,DPRCHK ;CHECK FOR VALIDITY
POPJ P, ;Problem, return
IDPB T1,T3 ;Yes, store in BP
JRST DPRS2A ;Loop
;Parse a switch
DPRSWT: MOVE T3,[POINT 7,ATMBUF]
DPRSW1: PUSHJ P,DPRCHR ;Get char
JUMPE T1,SWVNUL ;End ok
CAIE T1,"=" ;Delimiters for switch value ok
CAIN T1,":"
JRST SWVNUL
CAIN T1,"/" ;Another switch ok
JRST SWVNUL
PUSHJ P,DPRCHK ;CHECK FOR VALIDITY
POPJ P, ;Error
IDPB T1,T3 ;Store in BP
JRST DPRSW1 ;Loop
;Parse a switch value
DPRSWV: MOVE T3,[POINT 7,ATMBUF]
DPRSV1: PUSHJ P,DPRCHR ;Get char
JUMPE T1,SWVNUL ;END ok
CAIN T1,"/" ;Another switch ok
JRST SWVNUL
PUSHJ P,DPRCHK ;CHECK FOR VALIDITY
POPJ P, ;?Error
IDPB T1,T3 ;Store char
JRST DPRSV1 ;Loop
SWVNUL: SETZ T2, ;DEPOSIT A NULL
IDPB T2,T3 ;WITHOUT DISTURBING T1
JRST %POPJ1 ;SKIP RETURN
DPRCHK: 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"
$DCALL IDD ;NO. GIVE ERROR
JRST %POPJ1 ;YES. SKIP RETURN
;STILL IF10
DIASWT: PUSHJ P,DPRCHR ;Get next non-space char.
DIASW1: LDB T1,SRCBP ;NOW GET IT
JUMPE T1,%POPJ ;NONE, DONE
CAIE T1,"/" ;BEGINNING OF SWITCH?
$DCALL IDD ;NO, BAD
PUSHJ P,DPRSWT ;Parse a switch
POPJ P, ;ERROR
DSWOK: MOVE T1,SWTPNT ;GET APPROPRIATE SWITCH TABLE ADDRESS
MOVEI T2,ATMBUF
HRLI T2,(POINT 7)
MOVEI T5,ATMBUF ;Get string to type incase error
PUSHJ P,TABLK
$DCALL USW ;UNKNOWN
$DCALL ASW ;AMBIGUOUS
HRRZ T1,(T1) ;GET ADDRESS OF FLAGS,,KEYWORD NUMBER
HRRZ T1,(T1) ;GET KEYWORD NUMBER
MOVEM T1,KEYVAL ;SAVE IT
ADD T1,DSPPNT ;POINT TO DISPATCH TABLE ENTRY
HRRZ T1,(T1) ;GET DISPATCH TABLE ENTRY
MOVEM T1,KWTADR ;SAVE KWD TABLE ADDRESS
MOVE T3,(T1) ;GET ROUTINE ADDRESS OR KEYWORD TABLE
TLNN T3,-1 ;SEE WHICH
JRST (T3) ;ROUTINE, GO TO IT
SETZM ATMBUF ;Clear buffer
LDB T1,SRCBP ;See if last char was end of switch
JUMPE T1,DIAKWW ;Yes, no switch value (gets "?Ambigous")
PUSHJ P,DPRSWV ;Parse switch value
POPJ P, ;ERROR. GO AWAY
DIAKWW: MOVE T1,KWTADR ;GET KWD TABLE ADDRESS
MOVEI T2,ATMBUF
PUSHJ P,TABLK
JRST KWDUNK ;UNKNOWN
JRST KWDAMB ;AMBIGUOUS
HRRZ T2,(T1) ;GET ADDRESS OF FLAGS,,VALUE
HRRZ T2,(T2) ;GET VALUE
MOVE T1,KEYVAL ;GET KEYWORD NUMBER
XCT OPSTOR(T1) ;STORE IN TABLE
JRST DIASW1 ;READ ON
;STILL IF10
DIAOCT: PUSHJ P,DOCT ;READ NUMBER, THEN RETURN TO LOOP
MOVE T1,KEYVAL ;GET KEYWORD NUMBER
XCT OPSTOR(T1)
JRST DIASW1
DIAINT: PUSHJ P,DINT
MOVE T1,KEYVAL ;GET KEYWORD NUMBER
XCT OPSTOR(T1)
JRST DIASW1
DOCT: SKIPA T5,[^D8] ;RADIX 8
DINT: MOVEI T5,^D10 ;RADIX 10
SETZ T2, ;CLEAR RESULT
DINT1: ILDB T1,SRCBP ;GET CHAR
CAIL T1,"0" ;DIGIT?
CAIL T1,"0"(T5)
POPJ P, ;NO, RETURN
IMULI T2,(T5) ;ADD THIS DIGIT IN
ADDI T2,-"0"(T1)
JRST DINT1 ;LOOP
DIACHR: PUSHJ P,DPRCHR ;Get char
CAIE T1,"""" ;STARTING QUOTE?
EENQS: $DCALL NQS ;PADCHAR MUST BE QUOTED SINGLE CHAR
PUSHJ P,DPRCHR ;Get PAD char
CAIN T1,"" ;QUOTING CHAR?
PUSHJ P,DPRCHR ;YES, GET CHAR IT QUOTES
JUMPE T1,EENQS ;END OF STRING HERE IS AN ERROR
MOVE T1,KEYVAL ;GET KEYWORD NUMBER
XCT OPSTOR(T1) ;STORE IN DDB
PUSHJ P,DPRCHR ;Get closing quote
CAIE T1,"""" ;CLOSING QUOTE?
$DCALL NQS ;No, complain
JRST DIASWT
DIASET: MOVEI T2,1 ;SET BIT TO 1
MOVE T1,KEYVAL ;GET KEYWORD NUMBER
XCT OPSTOR(T1)
JRST DIASWT ;RETURN
;IGNORE THE ARGUMENT
DIAIGN: PUSHJ P,CLIGN ;Say "%ignoring.."
PUSHJ P,DPRSWT ;Parse switch
POPJ P, ;ERROR. LEAVE
CAIE T1,"=" ;If there is a switch value,
CAIN T1,":"
JRST DIAIG1 ;Ignore that too
JRST DIASW1
DIAIG1: PUSHJ P,DPRSWV ;Parse switch value
POPJ P, ;ERROR. LEAVE
JRST DIASW1 ;Go on
SEGMENT DATA
PTHPNT: BLOCK 1 ;PATH POINTER
TMPBUF: BLOCK LATOMW ;TEMP BUFFER FOR DIALOG
TABADD: BLOCK 1 ;TABLK TABLE ADDRESS
TABCNT: BLOCK 1 ;TABLK TABLE COUNT
STRADD: BLOCK 1 ;TABLK STRING ADDRESS
SEGMENT CODE
> ;IF10
;ROUTINE TO PUSH U.ERR SO DIALOG IS WITH TTY, NOT FILE
SAVERR: SKIPN U.ERR ;ERR UNIT SET?
POPJ P, ;NO, NOTHING TO DO
POP P,RETA ;GET RETURN ADDRESS
PUSH P,U.ERR ;SAVE ERROR UNIT
SETZM U.ERR ;CLEAR IT SO WE USE TTY
PUSHJ P,@RETA ;CALL CALLER
POP P,U.ERR ;RESTORE U.ERR
POPJ P, ;DONE
SATAB: SA.UR ;UNKNOWN, SEQINOUT
SA.OR ;UNKNOWN, SEQIN
SA.UW ;UNKNOWN, SEQOUT
SA.OR ;UNKNOWN, RANDIN
SA.URW ;UNKNOWN, RANDOM
SA.UA ;UNKNOWN, APPEND
SA.URW ;UNKNOWN, KEYED [5000]
SA.OR ;OLD, SEQINOUT
SA.OR ;OLD, SEQIN
SA.OW ;OLD, SEQOUT
SA.OR ;OLD, RANDIN
SA.ORW ;OLD, RANDOM
SA.OA ;OLD, APPEND
SA.ORW ;OLD, KEYED [5000]
SA.NW ;NEW, SEQINOUT
SA.ILL ;NEW, SEQIN
SA.NW ;NEW, SEQOUT
SA.ILL ;NEW, RANDIN
SA.NW ;NEW, RANDOM
SA.NW ;NEW, APPEND
SA.NW ;NEW, KEYED [5000]
SA.SW ;SCRATCH, SEQINOUT
SA.ILL ;SCRATCH, SEQIN
SA.SW ;SCRATCH, SEQOUT
SA.ILL ;SCRATCH, RANDIN
SA.SW ;SCRATCH, RANDOM
SA.ILL ;SCRATCH, APPEND
SA.SW ;SCRATCH, KEYED [5000]
;DISPOSE & STATUS
DSTAB: SD.NOU ;NOTHING, UNKNOWN
SD.NOU ;NOTHING, OLD
SD.NOU ;NOTHING, NEW
SD.NOX ;NOTHING, SCRATCH
SD.NOS ;NOTHING, SAVE
SD.NOD ;NOTHING, DELETE
SD.NOX ;NOTHING, EXPUNGE
SD.NOS ;SAVE, UNKNOWN
SD.NOS ;SAVE, OLD
SD.NOS ;SAVE, NEW
SD.ILL ;SAVE, SCRATCH
SD.NOS ;SAVE, SAVE
SD.ILL ;SAVE, DELETE
SD.ILL ;SAVE, EXPUNGE
SD.NOD ;DELETE, UNKNOWN
SD.NOD ;DELETE, OLD
SD.NOD ;DELETE, NEW
SD.NOD ;DELETE, SCRATCH
SD.ILL ;DELETE, SAVE
SD.NOD ;DELETE, DELETE
SD.NOX ;DELETE, EXPUNGE
SD.NOX ;EXPUNGE, UNKNOWN
SD.NOX ;EXPUNGE, OLD
SD.NOX ;EXPUNGE, NEW
SD.NOX ;EXPUNGE, SCRATCH
SD.ILL ;EXPUNGE, SAVE
SD.NOX ;EXPUNGE, DELETE
SD.NOX ;EXPUNGE, EXPUNGE
SD.PRU ;PRINT, UNKNOWN
SD.PRU ;PRINT, OLD
SD.PRU ;PRINT, NEW
SD.PRX ;PRINT, SCRATCH
SD.PRS ;PRINT, SAVE
SD.PRD ;PRINT, DELETE
SD.PRX ;PRINT, EXPUNGE
SD.PRX ;LIST, UNKNOWN
SD.PRX ;LIST, OLD
SD.PRX ;LIST, NEW
SD.PRX ;LIST, SCRATCH
SD.PRS ;LIST, SAVE
SD.PRD ;LIST, DELETE
SD.PRX ;LIST, EXPUNGE
SD.PUU ;PUNCH, UNKNOWN
SD.PUU ;PUNCH, OLD
SD.PUU ;PUNCH, NEW
SD.PUX ;PUNCH, SCRATCH
SD.PUS ;PUNCH, SAVE
SD.PUD ;PUNCH, DELETE
SD.PUX ;PUNCH, EXPUNGE
SD.SUU ;SUBMIT, UNKNOWN
SD.SUU ;SUBMIT, OLD
SD.SUU ;SUBMIT, NEW
SD.SUX ;SUBMIT, SCRATCH
SD.SUS ;SUBMIT, SAVE
SD.SUD ;SUBMIT, DELETE
SD.SUX ;SUBMIT, EXPUNGE
SD.PLU ;PLOT, UNKNOWN
SD.PLU ;PLOT, OLD
SD.PLU ;PLOT, NEW
SD.PLX ;PLOT, SCRATCH
SD.PLS ;PLOT, SAVE
SD.PLD ;PLOT, DELETE
SD.PLX ;PLOT, EXPUNGE
NEWDSP: XWD OD.NOT,OS.UNK ;NOTHING, UNKNOWN
XWD OD.NOT,OS.SAV ;NOTHING, SAVE
XWD OD.NOT,OS.DEL ;NOTHING, DELETE
XWD OD.NOT,OS.EXP ;NOTHING, EXPUNGE
XWD OD.PRI,OS.UNK ;PRINT, UNKNOWN
XWD OD.PRI,OS.SAV ;PRINT, SAVE
XWD OD.PRI,OS.DEL ;PRINT, DELETE
XWD OD.PRI,OS.EXP ;PRINT, EXPUNGE
XWD OD.PUN,OS.UNK ;PUNCH, UNKNOWN
XWD OD.PUN,OS.SAV ;PUNCH, SAVE
XWD OD.PUN,OS.DEL ;PUNCH, DELETE
XWD OD.PUN,OS.EXP ;PUNCH, EXPUNGE
XWD OD.SUB,OS.UNK ;SUBMIT, UNKNOWN
XWD OD.SUB,OS.SAV ;SUBMIT, SAVE
XWD OD.SUB,OS.DEL ;SUBMIT, DELETE
XWD OD.SUB,OS.EXP ;SUBMIT, EXPUNGE
XWD OD.PLT,OS.UNK ;PLOT, UNKNOWN
XWD OD.PLT,OS.SAV ;PLOT, SAVE
XWD OD.PLT,OS.DEL ;PLOT, DELETE
XWD OD.PLT,OS.EXP ;PLOT, EXPUNGE
DOPFLG: D%IN ;UNKNOWN, READ
D%OUT+D%MOD+D%WRT ;UNKNOWN, WRITE
D%IN+D%OUT+D%MOD+D%WRT ;UNKNOWN, READ, WRITE
D%OUT+D%MOD+D%WRT ;UNKNOWN, APPEND
D%IN ;OLD, READ
D%OUT+D%MOD+D%WRT ;OLD, WRITE
D%IN+D%OUT+D%MOD+D%WRT ;OLD, READ, WRITE
D%OUT+D%MOD+D%WRT ;OLD, APPEND
D%OUT+D%MOD+D%WRT ;NEW, WRITE
D%OUT+D%MOD+D%WRT ;SCRATCH, WRITE
SUBTTL DO OPEN
;Call:
; MOVX T1,D%IN or D%OUT
; MOVX T1,GTJFN bits GJ%NEW or GJ%FOU or 0
; PUSHJ P,DOOPEN
; <return here if error, O.DIAL set>
; <return here if ok>
DOOPEN: PUSHJ P,SETMAF ;DO LAST MINUTE MODE AND FORM
PUSHJ P,CNFDEV ;CHECK FOR DEVICE CONFLICTS
POPJ P, ;ERROR, GO DO DIALOG
LOAD T1,INDX(D) ;GET DEVICE INDEX
PUSHJ P,OPNTAB(T1) ;OPEN DEVICE BY TYPE
PJRST %RMECK ;[5007] ERROR, SEE IF RMS CLEANUP REQUIRED
LOAD T1,INDX(D) ;GET DEVICE INDEX
PUSHJ P,RFSTAB(T1) ;RETURN UPDATED FILESTRINGS TO DDB
PUSHJ P,FIXDEF ;Defaults after everything is in place.
PUSHJ P,DOCONS ;Do consolidation of DDB's if necessary
MOVE T1,DVICE(D) ;GET DEVICE DESIGNATOR
CAME T1,[.CTTRM] ;CONTROLLING TTY?
JRST %POPJ1 ;No. Skip return
MOVEM D,D.TTY ;Yes, store the TTY's DDB address
MOVEM U,U.TTY ;And unit block
JRST %POPJ1 ;SKIP RETURN
OPNTAB: JRST TTYOPN ;TTY
JRST DSKOPN ;DSK
JRST MTAOPN ;MTA
JRST OTHOPN ;OTHER LOCAL DEVICE
IF20,< JRST %RMOPN ;[5000] REMOTE STREAM FILE
JRST %RMOPN ;[5000] RMS FILE
> ;End IF20
RFSTAB: POPJ P, ;TTY DOESN'T RETURN ANYTHING
JRST DOJFNS ;DISK DOES JFNS
JRST DOJFNS ;MTA DOES JFNS
JRST DOJFNS ;OTHER DOES JFNS
IF20,< JRST %RMRFS ;[5000] REMOTE STREAM FILE
JRST %RMRFS ;[5000] RMS FILE
> ;End IF20
;COMMON DISK BUFFER SETUP
DSKSET: LOAD T1,MODE(D) ;GET MODE
CAIN T1,MD.DMP ;DUMP?
JRST DSKDMP ;YES. DON'T NEED BUFFERS
PUSHJ P,EOFSET ;SETUP EOFN
LOAD T1,BUFCT(D) ;GET BUFFERCOUNT
PUSHJ P,%GTPGS
$ACALL MFU ;CAN'T. MEMORY FULL
MOVEM T1,WPTR(D) ;SAVE PAGE ADDR
LOAD T1,ACC(D) ;GET ACCESS
CAIE T1,AC.RIO ;RANDOM
CAIN T1,AC.RIN ;OR RANDIN?
JRST RANALC ;YES. ALLOCATE PAGES FOR WINDOWS
MOVE T1,WPTR(D) ;GET PAGE ADDR
LSH T1,9 ;GET CORE ADDR
HRRZM T1,WADR(D) ;SAVE ADDR
HRRZM T1,BUFADR(D) ;AND AGAIN
LOAD T1,BUFCT(D) ;GET BUFFERCOUNT AGAIN
LSH T1,9 ;GET # WORDS
IMUL T1,BPW(D) ;GET # BYTES IN IT
MOVEM T1,WSIZ(D) ;SAVE WINDOW SIZE
LOAD T1,ACC(D) ;GET ACCESS TYPE
CAIE T1,AC.APP ;APPEND?
POPJ P, ;NO
MOVEI T1,AC.SOU ;YES. NOW IT'S SEQUENTIAL OUTPUT!
STORE T1,ACC(D)
MOVE T1,EOFN(D) ;GET # BYTES IN FILE
MOVEM T1,BYTN(D) ;SAVE AS BYTE NUMBER ALSO
PJRST %OSMAP ;GO MAP THE LAST PAGES
RANALC: MOVE T1,BPW(D) ;GET BYTES/WORD
LSH T1,9 ;GET BYTES/PAGE
MOVEM T1,WSIZ(D) ;SAVE AS WINDOW SIZE
LOAD T1,BUFCT(D) ;GET BUFFERCOUNT AGAIN
PUSHJ P,%GTBLK ;ALLOCATE PAGE TABLE
$ACALL MFU ;CAN'T
MOVEM T1,WTAB(D) ;SAVE IT
LOAD T2,BUFCT(D) ;GET BUFFERCOUNT YET AGAIN
DSETL: SETOM (T1) ;SET FILE BLOCK TO NG ONE
ADDI T1,1
SOJG T2,DSETL ;LOOP
LOAD T1,BUFCT(D) ;GET BUFFERCOUNT AGAIN!
PUSHJ P,%GTBLK ;ALLOCATE PAGE FLAG TABLE
$ACALL MFU ;CAN'T
MOVEM T1,PFTAB(D) ;SAVE ADDR
POPJ P,
;[4146] NEW
;COMMON MAGTAPE APPEND CHECK
CHKAPP: LOAD T2,ACC(D) ;GET ACCESS
CAIE T2,AC.APP ;APPEND?
JRST %POPJ1 ;NO
LOAD T1,LTYP(D) ;[5006]Get label type
CAIE T1,LT.UNL ;[5006] If its' labeled give error
$ACALL ALT ;[5006] Labeled tapes can't
MOVEI T1,AC.SIO ;IF APPEND, SUBSTITUTE SEQINOUT
STORE T1,ACC(D)
PUSHJ P,%ISBUF ;READ THE FIRST BLOCK
MOVE T1,FLAGS(D) ;GET FLAGS
TXZN T1,D%END ;END OF FILE (TAPE MARK)?
JRST DATSKP ;NO. GO SKIP OVER DATA
MOVEM T1,FLAGS(D) ;SAVE FLAGS WITH NO EOF
PUSHJ P,%MTBSB ;BACK OVER THE TAPE MARK
PUSHJ P,MTAOSW ;SWITCH TO OUTPUT
PJRST %POPJ1
DATSKP: PUSHJ P,%MTFSF ;SKIP OVER THE TAPE MARK
PUSHJ P,%MTBSA ;NOW BACK OVER IT AND READ PREVIOUS BLOCK
PUSHJ P,MTAOSW ;SWITCH TO OUTPUT
PJRST %POPJ1
;COMMON ROUTINE TO GET BPW, ETC., FOR ALL DEVICES.
MTABSZ: LOAD T2,UBSIZ(D) ;[4203] GET USER-SUPPLIED BYTESIZE
STORE T2,BSIZ(D) ;[4203] STORE IT
JUMPN T2,CHKBSZ ;[4203] GOT ONE
LOAD T1,TAPM(D) ;GET TAPEMODE
MOVE T2,IMPBS(T1) ;GET IMPLIED BYTESIZE
STORE T2,BSIZ(D) ;SAVE IT
JRST CHKBSZ ;[4203] GO CHECK FOR 36-BIT MODE
;IF THE DEVICE IS NOT A MAGTAPE, WE MUST DERIVE THE BYTESIZE
;FROM THE MODE.
GETBSZ: LOAD T2,UBSIZ(D) ;[4203] GET USER-SUPPLIED BYTESIZE
STORE T2,BSIZ(D) ;[4203] STORE IT
JUMPN T2,CHKBSZ ;[4203] GOT ONE
LOAD T1,MODE(D) ;GET /MODE
MOVE T2,BSTAB(T1) ;GET BYTE SIZE
STORE T2,BSIZ(D) ;[4203] SAVE IT
CHKBSZ: LOAD T2,BSIZ(D) ;[4203] GET BYTESIZE AGAIN
CAIE T2,^D36 ;IS IT 36?
JRST GOTBSZ ;NO. GO DEFAULT OTHER PARAMS
SETOM B36FLG(D) ;YES. SET 36-BIT MODE FLAG
MOVEI T2,IBSZ ;GET DEFAULT INTERNAL BYTESIZE
GOTBSZ: MOVE T1,BPTAB(T2) ;GET A RIGHT-JUSTIFIED BP
STORE T1,BYTPT(D) ;SAVE IT FOR FORIO
MOVE T1,SPCTAB(T2) ;GET A WORD OF SPACES
MOVEM T1,SPCWD(D) ;SAVE IT FOR RECORD FILL
MOVEI T1,^D36 ;GET 36 BITS
IDIVI T1,(T2) ;GET BYTES/WORD
MOVEM T1,BPW(D) ;SAVE IT
POPJ P, ;Return
SUBTTL DEVICE-DEPENDENT OPEN ROUTINES
IF20,<
DSKDMP: POPJ P, ;NO DUMP MODE ON TOPS-20
;[4161] GET THE TAPEFORMAT SPECIFIED (IF ANY)
;IF NO TAPEFORMAT SPECIFIED, GET THE JOB'S DEFAULT TAPE FORMAT
;IF ANSI-ASCII OR INDUSTRY, SET IMGFLG TO PREVENT LSCWS.
MTADEF: LOAD T1,TAPM(D) ;GET TAPEFORMAT
JUMPN T1,GOTTF ;GOT ONE. GO STORE IMPLIED BYTESIZE
MOVE T1,RECTP(D) ;[5000] GET RECORDTYPE
CAIE T1,RT.UNS ;[5000] ANY GIVEN?
SKIPA T1,[TM.IND] ;YES. DEFAULT TAPEFORMAT=INDUSTRY
MOVE T1,%JIBLK+.JIDM ;NO. GET DEFAULT DATA MODE FOR THIS JOB
STORE T1,TAPM(D) ;SAVE DEFAULT TAPEFORMAT
GOTTF: CAIE T1,TM.ANS ;ANSI-ASCII?
CAIN T1,TM.IND ;OR INDUSTRY-COMPATIBLE?
SETOM IMGFLG(D) ;YES. ASCII-ONLY DEVICE
POPJ P,
DOPENF: MOVE T2,OPNBTS ;GET OPEN BITS
OR T2,DMABS(D) ;SET DATA MODE, BYTE SIZE
MOVE T1,IJFN(D) ;GET JFN
OPENF% ;OPEN file
ERJMP RELJFN ;Can't
AOS (P) ;SKIP RETURN FOR SUCCESS
POPJ P,
DOGTJF: MOVE T1,GJBTS ;Get JFN bits to set
TXO T1,GJ%XTN ;Extended GTJFN
TXNE T1,GJ%OLD ;[4135] IS IT FOR AN EXISTING FILE?
TXO T1,GJ%IFG ;[4135] YES. ALLOW WILD-CARDS
SKIPE TMPFIL(D) ;[4135] TEMPORARY FILE?
TXO T1,GJ%TMP ;[4135] YES. SETUP FOR IT
HLLM T1,JFNBLK+.GJGEN ;Store away
MOVEI T1,JFNBLK ;Get a JFN
SETZ T2, ;NO STRING
GTJFN%
ERJMP %POPJ ;Failure return
GTJOK: HRRZM T1,IJFN(D) ;STORE WITH NO FLAGS
HRRZM T1,OJFN(D)
JRST %POPJ1 ;[5000]
;ROUTINE TO SET UP TERMINAL
TTYOPN: PUSHJ P,GETBSZ ;ESTABLISH BYTESIZE, BPW
MOVE T1,DVICE(D) ;GET DEVICE DESIGNATOR
CAIE T1,.CTTRM ;CONTROLLING TTY?
JRST NCTRM ;NO
MOVEI T1,.PRIIN ;SETUP PRIIN AS INPUT
MOVEM T1,IJFN(D)
MOVEI T1,.PRIOU ;SETUP PRIOU AS OUTPUT
MOVEM T1,OJFN(D)
JRST TTYSET ;GO DO REST OF SETUP
NCTRM: PUSHJ P,SETJFN ;Setup JFN info
SETZM GJBTS ;NO GTJFN BITS
PUSHJ P,DOGTJF ;GET JFN
$DCALL OPN ;REQUEST DIALOG
MOVX T1,OF%RD+OF%WR ;ALLOW READ AND WRITE ACCESS
MOVEM T1,OPNBTS ;SAVE FOR GTJFN
PUSHJ P,DOPENF ;OPEN TTY
$DCALL OPN ;REQUEST DIALOG
TTYSET: MOVX T1,D%SEOL+D%IN+D%OUT ;[4220] No initial CRLF for terminals
IORM T1,FLAGS(D) ; . .
SKIPE T1,RSIZE(D) ;RECORD SIZE SPECIFIED?
JRST STOTTW ;YES. GO STORE AS TTYW
MOVE T1,OJFN(D) ;GET JFN
MOVEI T2,.MORLW ;READ LINE WIDTH
MTOPR%
ERJMP TTY72 ;CAN'T. USE 72
CAIN T3,0 ;LINE WIDTH SET?
TTY72: MOVEI T3,^D72 ;NO, GUESS 72
STOTTW: LOAD T2,CC(U) ;[3400] GET CARRIAGE CONTROL
CAIE T2,CC.LST ;[3400] CC=FORTRAN OR TRANS?
CAIN T2,CC.NON
JRST NOEXSP ;NO
ADDI T3,1 ;[3400] YES, BUMP TTY WIDTH
NOEXSP: STORE T3,TTYW(D) ;STORE LINE SIZE FOR NAMELIST AND LIST-DIRECTED
JRST %POPJ1 ;DONE
;ROUTINE TO OPEN DISK
;OPEN THE DISK FILE, THEN
;READ THE FDB, THEN CALCULATE EOFN, THE NUMBER OF
;FORTRAN CHARACTER BYTES IN THE FILE.
DSKOPN: PUSHJ P,GETBSZ ;GET BYTESIZE, BPW
PUSHJ P,SETJFN ;Setup JFN info
LOAD T1,SAIDX(D) ;GET STATUS/ACCESS INDEX
PUSHJ P,DOPTAB(T1) ;GO DO GTJFN, OPENF
$DCALL OPN ;REQUEST DIALOG
PUSHJ P,RMSCHK ;[5000] SEE IF ACTUALLY AN RMS FILE
$DCALL RMS ;[5000] YES, REQUEST DIALOG
MOVE T1,OPNBTS ;[5000] NO. GET BITS USED FOR OPENF
TXNE T1,OF%APP ;APPEND-ONLY ACCESS?
JRST XXXSET ;YES. CAN'T TREAT IT LIKE A DISK
TXNN T1,OF%WR ;WRITE?
JRST NOUFP ;NO. CAN'T UPDATE DIRECTORY ENTRY
MOVE T1,IJFN(D) ;GET JFN
MOVSI T1,(T1) ;IN LEFT HALF ONLY
SETZ T2, ;NO PAGES TO UPDATE
UFPGS% ;MAKE FILE APPEAR IF NOT THERE ALREADY
JSHALT ;SHOULDN'T FAIL
NOUFP: PUSHJ P,DSKSET ;DO COMMON DISK SETUP
JRST %POPJ1 ;RETURN SUCCESS
;[5000] New
;[5000] See if file we opened was actually an RMS file
RMSCHK: HRRZ T1,IJFN(D) ;[5000] GET JFN
MOVE T2,[XWD 1,.FBCTL] ;[5000] GET .FBCTL WORD
MOVEI T3,FDB+.FBCTL ;[5000]
GTFDB% ;[5000]
ERJMP %POPJ1 ;[5000] CAN'T, WE TRIED.
LDB T1,[POINTR (FDB+.FBCTL,FB%FCF)] ;[5000] GET FILE CLASS FIELD
CAIN T1,.FBRMS ;[5000] RMS FILE?
PJRST FICLOS ;[5000] YES. CLOSE FILE, RELEASE JFN, +1 RET
JRST %POPJ1 ;[5000] NO, OK
EOFSET: PUSHJ P,FDBGET ;[5000] GET FDB
JSHALT ;[5000] FAILED
%RSEOF: LDB T1,[POINTR (FDB+.FBBYV,FB%BSZ)] ;GET FILE BYTE SIZE
CAIE T1,^D36 ;36 BITS?
JUMPN T1,DSKBSZ ;NO. GO STORE IT IF NONZERO
MOVE T3,FDB+.FBSIZ ;GET NUMBER OF WORDS IN THE FILE
IMUL T3,BPW(D) ;GET # INTERNAL BYTES
MOVEM T3,EOFN(D) ;SAVE # BYTES IN FILE
POPJ P,
DSKBSZ: LOAD T2,BSIZ(D) ;GET USER-SUPPLIED BYTESIZE
CAIN T2,^D36 ;36 GIVEN OR IMPLIED BY MODE?
JRST BSIZOK ;YES. ANYTHING IN FDB IS OK
CAIE T1,(T2) ;SAME AS ONE IN FDB?
$ECALL BSC ;GIVE CONFLICT WARNING
BSIZOK: STORE T1,BSIZ(D) ;STORE NEW BYTE SIZE
MOVE T2,SPCTAB(T1) ;GET A WORD OF SPACES
MOVEM T2,SPCWD(D) ;SAVE IT
MOVE T2,BPTAB(T1) ;GET A RIGHT-JUSTIFIED BYTE POINTER
STORE T2,BYTPT(D) ;SAVE IT
MOVEI T2,^D36 ;GET 36 BITS
IDIVI T2,(T1) ;GET # BYTES/WORD
MOVEM T2,BPW(D) ;SAVE IT
MOVE T3,FDB+.FBSIZ ;GET NUMBER OF BYTES IN THE FILE
MOVEM T3,EOFN(D) ;SAVE IT
LOAD T1,FORM(D) ;GET FORMAT OF FILE
CAIE T1,FM.UNF ;UNFORMATTED?
POPJ P, ;NO. DONE
ADD T3,BPW(D) ;YES. ROUND UP TO NEAREST WORD
SUBI T3,1
IDIV T3,BPW(D)
IMUL T3,BPW(D)
MOVEM T3,EOFN(D) ;STORE ROUNDED # BYTES
POPJ P,
GTEOFN: PUSHJ P,FDBGET ;[5000] GET FDB
POPJ P, ;[5000] COULDN'T
LDB T1,[POINTR (FDB+.FBBYV,FB%BSZ)] ;GET FILE BYTE SIZE
JUMPE T1,%POPJ ;IF NO SIZE, CAN'T CALCULATE ANYTHING
MOVEI T2,^D36 ;DIVIDE 36 BY IT
IDIVI T2,(T1) ;TO GET BPW
MOVEM T2,BPW(D) ;AND SAVE IT
MOVE T1,FDB+.FBSIZ ;GET # BYTES
MOVEM T1,EOFN(D) ;SAVE IT
POPJ P,
FDBGET: MOVE T1,IJFN(D) ;[5000] GET JFN
MOVSI T2,1+.FBSIZ ;[5000] READ UP THROUGH FILE SIZE
MOVEI T3,FDB ;[5000] POINT TO DEST BUFFER
GTFDB% ;[5000] READ FDB
ERJMP %POPJ ;[5000] CAN'T
JRST %POPJ1 ;[5000] OK
DOPTAB: JRST DOPUNK ;UNKNOWN, READ
JRST DOPSTN ;UNKNOWN, WRITE
JRST DOPSTN ;UNKNOWN, READ, WRITE
JRST DOPAPP ;UNKNOWN, APPEND
JRST DOPSTN ;OLD, READ
JRST DOPSTN ;OLD, WRITE
JRST DOPSTN ;OLD, READ, WRITE
JRST DOPAPP ;OLD, APPEND
JRST DOPSTN ;NEW, WRITE
JRST DOPSTN ;SCRATCH, WRITE
DOPSTN: LOAD T1,SAIDX(D) ;GET STATUS/ACCESS INDEX
MOVE T1,DGTBTS(T1) ;GET APPROPRIATE GTJFN BITS
MOVEM T1,GJBTS ;SAVE FOR GTJFN
PUSHJ P,DOGTJF ;GO DO GTJFN
POPJ P, ;FAILED
LOAD T1,SAIDX(D) ;GET INDEX AGAIN
MOVE T1,DOPBTS(T1) ;GET APPROPRIATE OPENF BITS
MOVEM T1,OPNBTS ;SAVE FOR OPENF
PUSHJ P,DOPENF ;DO OPENF
POPJ P, ;FAILED
AOS (P) ;SKIP RETURN FOR SUCCESS
POPJ P,
DGTBTS: GJ%OLD ;UNKNOWN, READ
GJ%FOU ;UNKNOWN, WRITE
0 ;UNKNOWN, READ, WRITE
0 ;UNKNOWN, APPEND
GJ%OLD ;OLD, READ
GJ%OLD ;OLD, WRITE
GJ%OLD ;OLD, READ, WRITE
GJ%OLD ;OLD, APPEND
GJ%NEW+GJ%FOU ;NEW, WRITE
GJ%FOU ;SCRATCH, WRITE
DOPBTS: OF%RD ;UNKNOWN, READ
OF%RD!OF%WR ;UNKNOWN, WRITE
OF%RD+OF%WR ;UNKNOWN, READ, WRITE
OF%RD+OF%WR ;UNKNOWN, APPEND (1ST TRY)
OF%RD ;OLD, READ
OF%RD+OF%WR ;OLD, WRITE
OF%RD+OF%WR ;OLD, READ, WRITE
OF%RD+OF%WR ;OLD, APPEND (1ST TRY)
OF%RD+OF%WR ;NEW, WRITE
OF%RD+OF%WR ;SCRATCH, WRITE
;[4135]
MOPBTS: OF%RD ;UNKNOWN, READ
OF%WR ;UNKNOWN, WRITE
OF%WR ;UNKNOWN, READ, WRITE
OF%APP ;UNKNOWN, APPEND
OF%RD ;OLD, READ
OF%WR ;OLD, WRITE
OF%WR ;OLD, READ, WRITE
OF%APP ;OLD, APPEND
OF%WR ;NEW, WRITE
OF%WR ;SCRATCH, WRITE
DOPUNK: MOVE T1,DGTBTS+SA.UR ;GET GTJFN BITS FOR UNKNOWN, READ
MOVEM T1,GJBTS ;SAVE FOR GTJFN
PUSHJ P,DOGTJF ;DO GTJFN
JRST TRYCRE ;CAN'T. MIGHT HAVE TO CREATE IT
MOVE T1,DOPBTS+SA.UR ;GET OPENF BITS FOR READ
MOVEM T1,OPNBTS ;SAVE FOR OPENF
PUSHJ P,DOPENF ;DO OPENF
POPJ P, ;FAILED FOR SOME OTHER REASON
AOS (P) ;SKIP RETURN FOR SUCCESS
POPJ P,
;IF THE GTJFN FAILS FOR ANY REASON (E.G. FILE NOT FOUND, NON-EXISTENT
;DEVICE) WE SET THE GTJFN BITS TO [UNKNOWN, WRITE], AND TRY AGAIN.
TRYCRE: MOVE T0,FLAGS(D) ;GET DDB FLAGS
TXNN T0,D%OPEN ;FILE PREVIOUSLY OPENED?
POPJ P, ;NO. REPORT FAILURE
MOVE T1,DGTBTS+SA.UW ;TRY FOR UNKNOWN, WRITE
MOVEM T1,GJBTS ;SAVE FOR GTJFN
PUSHJ P,DOGTJF ;DO GTJFN AGAIN
POPJ P, ;FAILED FOR SOME OTHER REASON
MOVE T1,DOPBTS+SA.UW ;TREAT AS IF IT'S UNKNOWN, WRITE
MOVEM T1,OPNBTS ;SAVE FOR OPENF
PUSHJ P,DOPENF ;DO OPENF
POPJ P, ;FAILED FOR SOME OTHER REASON
AOS (P) ;SKIP RETURN FOR SUCCESS
POPJ P,
;DOPAPP - ACCESS=APPEND. TRY FIRST THE STANDARD
;BITS FOR READ, WRITE. IF THIS SUCCEEDS, MAP THE FILE AT EOF,
;AND SET THE ACCESS TO SEQOUT. IF IT FAILS, OPEN THE FILE FOR
;APPEND ACCESS, WHICH IS MUCH SLOWER.
DOPAPP: LOAD T1,SAIDX(D) ;GET STATUS/ACCESS INDEX
MOVE T1,DGTBTS(T1) ;GET GTJFN BITS
MOVEM T1,GJBTS ;SAVE FOR GTJFN
PUSHJ P,DOGTJF ;DO GTJFN
POPJ P, ;FAILED
LOAD T1,SAIDX(D) ;GET STATUS/ACCESS INDEX AGAIN
MOVE T1,DOPBTS(T1) ;GET OPENF BITS
MOVEM T1,OPNBTS ;SAVE FOR OPENF
PUSHJ P,DOPENF ;DO OPENF
JRST TRYAPP ;FAILED. GO TRY APPEND ACCESS
AOS (P)
POPJ P,
TRYAPP: LOAD T1,SAIDX(D) ;GET STATUS/ACCESS INDEX
MOVE T1,DGTBTS(T1) ;GET GTJFN BITS
MOVEM T1,GJBTS ;SAVE FOR GTJFN
PUSHJ P,DOGTJF ;DO GTJFN
POPJ P, ;FAILED
MOVX T1,OF%APP ;TRY APPEND ACCESS
MOVEM T1,OPNBTS ;SAVE FOR OPENF
PUSHJ P,DOPENF ;DO OPENF
POPJ P, ;FAILED
AOS (P) ;SKIP RETURN FOR SUCCESS
POPJ P,
;ROUTINE TO OPEN MTA
MTAOPN: PUSHJ P,MTABSZ ;GET BYTESIZE, BPW
PUSHJ P,SETJFN ;Setup JFN info
PUSHJ P,MTAJFN ;SETUP LABELED TAPE ATTRIBUTES
LOAD T1,SAIDX(D) ;GET STATUS/ACCESS INDEX
MOVE T1,DGTBTS(T1) ;GET GTJFN BITS
MOVEM T1,GJBTS ;SAVE FOR GTJFN
PUSHJ P,DOGTJF ;[5006]GO DO GTJFN
$DCALL OPN ;FAILED. GIVE MESSAGE, GO TO DIALOG
LOAD T1,SAIDX(D) ;GET STATUS/ACCESS INDEX AGAIN
CAIE T1,SA.UA ;UNKNOWN, APPEND?
CAIN T1,SA.OA ;OR OLD, APPEND?
MOVX T1,SA.UR ;YES. PRETEND IT'S READ
MOVE T1,MOPBTS(T1) ;GET OPENF BITS
MOVEM T1,OPNBTS ;SAVE FOR OPENF
PUSHJ P,DOPENF ;GO DO OPENF
$DCALL OPN ;FAILED. GIVE MESSAGE, GO TO DIALOG
HRLOI T1,377777 ;MARK FILE NOT AT EOF YET
MOVEM T1,EOFN(D)
PUSHJ P,%LABCK ;CHECK LABEL TYPE
PUSHJ P,%MTPRM ;SET MTA PARAMETERS
PUSHJ P,TFCHK ;CHECK TAPE FORMAT AGAINST USER'S
PUSHJ P,MTABLK ;SETUP MTA BLOCK
PJRST CHKAPP ;GO CHECK FOR APPEND
%LABCK: MOVE T1,IJFN(D) ;GET LABEL TYPE OF TAPE
MOVEI T2,.MORLI ;READ LABEL INFO
MOVEI T3,15 ;SET ARG BLOCK LENGTH
MOVEM T3,LABINF
XMOVEI T3,LABINF ;POINT TO ARG BLOCK
MTOPR% ;READ LABEL INFO
ERCAL [MOVEI T3,.LTUNL ;CAN'T, ASSUME UNLABELED
MOVEM T3,LABINF+1
POPJ P,]
MOVE T1,LABINF+1 ;GET LABEL TYPE
STORE T1,LTYP(D) ;STORE FOR LATER
POPJ P,
%MTPRM: LOAD T1,LTYP(D) ;GET LABEL TYPE
CAIE T1,.LTUNL ;UNLABELED?
POPJ P, ;NO. CAN'T SETUP PARAMATERS!
MOVE T1,IJFN(D) ;GET JFN OF TAPE
MOVEI T2,.MOSDN ;SET DENSITY
LOAD T3,DEN(D) ;GET /DENSITY
JUMPE T3,SETPAR ;NONE. GO TRY PARITY
MOVEI T4,[ASCIZ /density/] ;GET TEXT FOR ERR MESSAGE
MTOPR% ;SET IT
$EJCAL UMO
SETPAR: MOVEI T2,.MOSPR ;SET PARITY
LOAD T3,PAR(D) ;GET /PARITY
JUMPE T3,SETTM ;NONE. TRY TAPEMODE
MOVEI T4,[ASCIZ /parity/]
MTOPR% ;SET IT
$EJCAL UMO
SETTM: LOAD T3,TAPM(D) ;GET /TAPEFORMAT
JUMPE T3,SETBS ;[4256]NO EXPLICIT MODE
MOVEI T2,.MOSDM ;SET HARDWARE DATA MODE
MOVEI T4,[ASCIZ /data mode/]
MTOPR% ;SET IT
$EJCAL UMO
SETBS: LOAD T3,BLKSZ(D) ;[4256]GET /BLOCKSIZE
JUMPE T3,%POPJ ;[4256]NO EXPLICIT RECORD-SIZE
MOVEI T2,.MOSRS ;[4256]SET RECORD SIZE
MOVEI T4,[ASCIZ /block size/] ;[4256]
MTOPR% ;[4256]SET IT
$EJCAL UMO ;[4256]
POPJ P,
;
;SET UP THE FOROTS MAGTAPE BLOCK BASED ON THE TAPE FORMAT
;AND THE BLOCKSIZE SPECIFIED BY THE USER (OR SYSTEM DEFAULT).
MTABLK: LOAD T1,BLKSZ(D) ;GET THE BLOCK SIZE IN BYTES
JUMPN T1,GOTBLS ;IF SET, SKIP GETTING IT FROM MONITOR
MOVE T1,%JIBLK+.JIRS ;GET BLOCKSIZE FROM JOB INFO
STORE T1,BLKSZ(D) ;STORE IT
GOTBLS: SKIPE B36FLG(D) ;36-BIT MODE?
IMUL T1,BPW(D) ;YES. BLOCKSIZE IS IN WORDS. MAKE IT BYTES
MOVEM T1,WSIZ(D) ;SAVE AS WINDOW SIZE
ADD T1,BPW(D) ;ROUND UP TO WORDS FOR BUFFER SIZE
SUBI T1,1
IDIV T1,BPW(D) ;GET # WORDS
PUSHJ P,%GTBLK ;ALLOCATE A BLOCK
$ACALL MFU ;CAN'T
HRRZM T1,WADR(D) ;SAVE THE LOCAL ADDRESS OF THE BUFFER
POPJ P,
TFCHK: MOVE T1,IJFN(D) ;GET JFN
MOVEI T2,.MORDM ;GET DATA MODE
MTOPR%
$EJCAL UMO
LOAD T1,TAPM(D) ;GET USER-SPECIFIED OR IMPLIED TAPEMODE
CAIE T1,(T3) ;ONE THERE. SAME AS ACTUAL TAPE?
$ACALL TFM ;TAPE FORMAT MISMATCH. TOO BAD
POPJ P,
; Open for all other devices
OTHOPN: PUSHJ P,GETBSZ ;SETUP BYTESIZE, BPW
PUSHJ P,SETJFN ;Setup JFN info
LOAD T1,SAIDX(D) ;GET STATUS/ACCESS INDEX
MOVE T1,DGTBTS(T1) ;GET GTJFN BITS
MOVEM T1,GJBTS ;SAVE THEM
PUSHJ P,DOGTJF ;GO DO GTJFN
$DCALL OPN ;FAILED. GIVE MESSAGE, GO TO DIALOG
LOAD T1,SAIDX(D) ;GET STATUS/ACCESS INDEX AGAIN
MOVE T1,DOPBTS(T1) ;GET OPENF BITS
MOVEM T1,OPNBTS ;SAVE FOR OPENF
PUSHJ P,DOPENF ;GO DO OPENF
$DCALL OPN ;FAILED. GIVE MESSAGE, GO TO DIALOG
XXXSET: HRLOI T1,377777 ;SET FILE VERY LARGE
MOVEM T1,EOFN(D)
MOVEI T1,1 ;GET A BUFFER PAGE
STORE T1,BUFCT(D) ;STORE BUFFER COUNT
LSH T1,9 ;MAKE # WORDS
MOVEI T2,(T1) ;COPY IT
IMUL T2,BPW(D) ;GET # BYTES/BUFFER
MOVEM T2,WSIZ(D) ;STORE AS WINDOW SIZE
PUSHJ P,%GTBLK
$ACALL MFU ;CAN'T
HRRZM T1,WADR(D) ;STORE ADDRESS OF BUFFER
JRST %POPJ1 ;ALL SET
SEGMENT DATA
LABINF: BLOCK 15 ;LABEL INFO
SEGMENT CODE
>;END IF20
IF10,<
;THIS IS THE SPECIAL DUMP-MODE OPEN CODE.
DSKDMP: MOVE T1,LKPB+.RBSIZ(D) ;GET # WORDS IN FILE
ADDI T1,177 ;ROUND TO BLOCKS
IDIVI T1,200 ;GET # BLOCKS
IMULI T1,200 ;GET # WORDS ROUNDED
IMUL T1,BPW(D) ;GET # BYTES ROUNDED
MOVEM T1,EOFN(D) ;SAVE IT AS EOF
LOAD T1,ACC(D) ;GET ACCESS
CAIE T1,AC.APP ;APPEND?
POPJ P, ;NO. DONE
MOVEI T1,AC.SOU ;YES. NOW IT'S SEQUENTIAL OUTPUT!
STORE T1,ACC(D)
MOVE T1,EOFN(D) ;GET # BYTES IN FILE
MOVEM T1,BYTN(D) ;SET CURRENT BYTE NUMBER
MOVE T2,FBLK(D) ;GET CHANNEL WORD
HRRI T2,.FOUSO ;SETUP FOR USETO
MOVE T3,LKPB+.RBSIZ(D) ;GET # WORDS IN FILE
ADDI T3,177 ;ROUND TO # BLOCKS
IDIVI T3,200
ADDI T3,1 ;POINT TO THE FIRST UNWRITTEN BLOCK
MOVE T1,[2,,T2]
FILOP. T1,
$ACALL IOE
POPJ P,
;Routine to clean up from OPEN error (deallocate buffers, channel)
; This is called prior to IOERR call incase the ERR= branch is taken,
;therefore it doesn't need to be called above if CALOF returns .+1.
OFCLNU: SKIPE T1,BUFADR(D) ;IF ANY BUFFER ALLOCATED
PUSHJ P,%FREBLK ;DEALLOCATE IT
SETZM BUFADR(D) ;AND CLEAR ADDR
SETZM FBLK+.FONBF(D) ;Clear buffer counts
SETZM FBLK+.FOBRH(D) ;Clear buffer headers
;Deallocate stuff gotten by DSKSET
MOVE T1,WPTR(D) ;GET PAGE ADDR OF WINDOW PAGES
JUMPE T1,OFCLN2 ;NONE
LOAD T2,BUFCT(D) ;YES. GET BUFFERCOUNT
PUSHJ P,%FREPGS ;FREE THEM
SKIPE T1,WTAB(D) ;Now free the page table
PUSHJ P,%FREBLK ; . .
SKIPE T1,PFTAB(D) ;AND FREE THE PAGE FLAG TABLE
PUSHJ P,%FREBLK
SETZM WPTR(D) ;Clear all indication that we had memory
OFCLN2: SETZM FBLK(D) ; Forget file was opened
POPJ P, ;Return
SETFB: MOVEI T2,LKPB(D) ;Set pointers
MOVEM T2,.FOLEB+FBLK(D)
MOVEI T2,.RBMAX
MOVEM T2,LKPB+.RBCNT(D)
MOVEI T2,PTHB(D)
HRLI T2,9
MOVEM T2,.FOPAT+FBLK(D)
PJRST SETPPB ;Set ptr to path block
;Routine to call the appropriate OPEN routine based on
; ACCESS and STATUS.
;Returns .+1 if error, O.DIAL set (unless ERR= taken)
;Returns .+2 if success, DDB flags set.
CALOF: LOAD T1,SAIDX(D) ;GET STATUS/ACCESS INDEX
LOAD T2,INDX(D) ;GET DEVICE INDEX
CAIN T2,DI.TTY ;TTY:?
MOVX T1,SA.UW ;YES. USE UNKNOWN, SEQOUT
PUSHJ P,DOPTAB(T1) ;OPEN FILE
POPJ P, ;FAILED. NON-SKIP RETURN
JRST %POPJ1 ;Return success
DOPTAB: JRST OPUNK ;UNKNOWN, READ
JRST OPSW ;UNKNOWN, WRITE
JRST OPRU ;UNKNOWN, READ, WRITE
JRST OPAU ;UNKNOWN, APPEND
JRST OPRD ;OLD, READ
JRST OPSO ;OLD, WRITE
JRST OPRO ;OLD, READ, WRITE
JRST OPAO ;OLD, APPEND
JRST OPSWN ;NEW, WRITE
JRST OPRS ;SCRATCH, WRITE
;OPEN file that must exist for READ.
OPRD: MOVX T1,FO.ASC+FO.PRV+.FORED ;Simple READ function
MOVEM T1,FBLK(D) ;Set it
PUSHJ P,DOFLP ;Do the FILOP.
JRST FLPFL ;Failed, go restore stuff and give error
JRST %POPJ1 ;Success, done.
;OPEN file that must exist for WRITE (it will be superseded!)
OPSO: MOVX T1,FO.ASC+FO.PRV+.FOCRE ;CREATE function
MOVEM T1,FBLK(D)
PUSHJ P,DOFLP ;Do the FILOP.
JRST OPRD1 ;Failed, check out error code
PUSHJ P,CLDISC ;OOPS, create succeeded!
; CLOSE file and discard it.
MOVEI T1,ERFNF% ;Pretend he got FILOP. error "File not found"
JRST FLPFL ;Go process the error
;The CREATE FILOP. failed. See if the error code = 'FILE ALREADY EXISTS'
OPRD1: CAIE T1,ERAEF% ;Already exists?
JRST FLPFL ;No, unexpected error
MOVX T1,FO.ASC+FO.PRV+.FOWRT ;OK, plain WRITE
MOVEM T1,FBLK(D) ;Set function
PUSHJ P,DOFLP
JRST FLPFL ;?failed
JRST CLSSAU ;CLOSE, OPEN FOR RANDOM
;OPEN file that must not exist for WRITE
OPSWN: MOVX T1,FO.ASC+FO.PRV+.FOCRE ;Create function
MOVEM T1,FBLK(D) ;Set function
PUSHJ P,DOFLP
JRST FLPFL ;?failed
JRST CLSSAU ;CLOSE FILE, OPEN FOR RANDOM
;OPEN file for WRITE. If it exists, it is superseded.
OPSW: MOVX T1,FO.ASC+FO.PRV+.FOWRT ;[4205] WRITE function
MOVEM T1,FBLK(D) ;Set it
PUSHJ P,DOFLP
JRST FLPFL ;[4205] FAILED
PJRST CLSSAU ;CLOSE FILE, OPEN FOR RANDOM
;OPEN SEQINOUT (SEQUENTIAL) file with UNKNOWN status.
;See if file exists.
; If it exists, it will be opened for input.
; If it doesn't exist, and an OPEN statement has been done,
; it will be created and opened for input.
OPUNK: MOVX T1,FO.ASC+FO.PRV+.FORED ;Try to read file
MOVEM T1,FBLK(D)
PUSHJ P,DOFLP ;If succeeds, set file opened for input
JRST OPSIC1 ;Failed, maybe file not found?
JRST %POPJ1 ;Return
;Note: If the directory is protected WRITE-ONLY, then he will get
; an error from READ or CLOSE because the file could not be created!
OPSIC1: MOVE T2,FLAGS(D) ;GET DDB FLAGS
TXNE T2,D%OPEN ;OPEN STATEMENT DONE?
CAIE T1,ERFNF% ;File not found?
JRST FLPFL ;No, bad error
MOVX T1,FO.ASC+FO.PRV+.FOWRT ;Create file
MOVEM T1,FBLK(D)
PUSHJ P,DOFLP ;** Do FILOP. **
JRST FLPFL ;All errors are fatal
JRST CLSSAU ;CLOSE, OPEN FOR RANDOM
;OPEN APPEND file that must exist.
OPAO: LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIE T1,DI.MTA ;MAGTAPE?
JRST OPRO ;NO.
MOVX T1,FO.ASC+FO.PRV+.FORED ;YES. SET READ MODE
MOVEM T1,FBLK(D)
PUSHJ P,DOFLP
JRST FLPFL ;?failed
JRST %POPJ1 ;Succeeded, return
;OPEN RANDOM file that must exist.
OPRO: PUSHJ P,CHKEXI ;Make sure file exists
POPJ P, ;It doesn't
OPRGO: MOVX T1,FO.ASC+FO.PRV+.FOSAU ;OK, do an update
MOVEM T1,FBLK(D)
PUSHJ P,DOFLP
JRST FLPFL ;?failed
JRST %POPJ1 ;Succeeded, return
;CLOSE and OPEN file again for updating.
CLSSAU: LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIE T1,DI.DSK ;DISK?
JRST %POPJ1 ;NO. SHOULDN'T CLOSE/OPEN
MOVEI T2,.FOCLS
HLL T2,CHAN(D)
MOVE T1,[1,,T2]
FILOP. T1,
$ACALL CLS ;FAILED. TYPE MSG AND DIE
MOVEI T1,.FOSAU ;NOW OPEN FOR RANDOM I/O
HRRM T1,FBLK(D)
PUSHJ P,DOFLP
JRST FLPFL
JRST %POPJ1 ;SUCCESS
;OPEN APPEND file, STATUS='UNKNOWN'
;OPEN RANDOM file, STATUS='UNKNOWN'
OPAU: MOVX T1,FO.ASC+FO.PRV+.FORED ;SET READ FUNCTION
LOAD T2,INDX(D) ;GET DEVICE INDEX
CAIE T2,DI.MTA ;MAGTAPE?
OPRU: MOVX T1,FO.ASC+FO.PRV+.FOCRE ;Set CREATE Function
MOVEM T1,FBLK(D)
PUSHJ P,DOFLP
JRST OPRUCF ;Failed, go check error
JRST CLSSAU ;CLOSE, OPEN FOR RANDOM
;Here if OPEN For RANDOM, STATUS='UNKNOWN' and FILOP. CREATE failed.
OPRUCF: CAIE T1,ERAEF% ;Already exists?
JRST FLPFL ;No, funny failure
JRST OPRGO ;Go open for updating now
;OPEN SCRATCH RANDOM file
OPRS: PUSHJ P,SETSCN ;Set scratch name
SETZ T3, ;Count # of tries
OPRS1: MOVX T1,FO.ASC+FO.PRV+.FOCRE ;Set CREATE function
MOVEM T1,FBLK(D)
PUSHJ P,DOFLP
JRST OPRS2 ;Maybe file does exist already
JRST CLSSAU ;CLOSE, OPEN FOR RANDOM
OPRS2: CAIE T1,ERAEF% ;File already exists error?
JRST FLPFL ;No, the OPEN fails.
ADDI T3,1 ;Count # attempts
CAILE T3,^D10 ;Too many?
JRST FLPFL ;Yes, just give FILOP error
PUSHJ P,SETSCN ;Get another name for SCRATCH
JRST OPRS1 ;Try again
;Routine to set a name for a SCRATCH file
;Uses T1,T2 only
SETSCN: PUSHJ P,GTMWRD ;Get random ASCII
DMOVE T1,ATMBUF
DMOVEM T1,FILNAM(D)
MOVE T1,[ASCIZ /TMP/] ;EXTENSION .TMP
MOVEM T1,EXT(D)
MOVEI T1,FILNAM(D) ;GET ASCIZ FILENAME POINTER
HRLI T1,(POINT 7)
MOVEM T1,SRCBP
MOVEI T1,LFILC ;AND COUNT
MOVEM T1,SRCLEN
PUSHJ P,ASCSIX ;CONVERT TO SIXBIT
$SNH ;SHOULD NOT FAIL
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
PUSHJ P,ASCSIX ;CONVERT TO SIXBIT
$SNH ;SHOULD NOT FAIL
MOVE T1,ATMBUF ;GET EXTENSION
HLLM T1,LKPB+.RBEXT(D) ;SAVE IT
POPJ P, ;Return
;Routine to get random ASCII name in ATMBUF
GTMWRD: MOVE T1,[POINT 7,ATMBUF] ;SETUP POINTER TO ATMBUF
MOVEM T1,FNSPNT
SKIPE SEED ;Already have a random seed?
JRST GTMWR1 ;Yes
MSTIME T1, ;Get time of day in milliseconds
HRRM T1,SEED ;Save random-number seed
HRLM T1,SEED ;. .
GTMWR1: MOVE T1,I.JOB ;Get job number in RH
MOVEI T2,3 ;ENCODE 3 DIGITS
PUSHJ P,DECNAS ;TO ASCII
MOVEI T4,3 ;# chars to get
GTMWR2: PUSHJ P,GTMCHR ;Get random char
IDPB T2,FNSPNT ;DEPOSIT IN FILENAME
SOJG T4,GTMWR2 ;Loop
SETZ T1, ;END WITH A NULL
IDPB T1,FNSPNT
POPJ P, ;And return
;Routine to get random ASCII letter in T2
;Uses t3
GTMCHR: MOVE T3,SEED ;Get current seed
ANDI T3,17 ;Just save last 4 bits
MOVEI T2,"A"(T3) ;Get letter
MOVE T3,SEED ;Get current seed
ROT T3,7 ;Rotate
ADD T3,T2 ;Add in value of letter
MOVEM T3,SEED ;Store new seed
POPJ P, ;Return
SEGMENT DATA
GTMSV3: BLOCK 2 ;Saved acs for GTMWRD
SEED: BLOCK 1 ;Random-number seed
SEGMENT CODE
;Routine to make sure file exists.
; If it doesn't, return .+1, error given (or ERR= taken)
; If it does, return .+2
CHKEXI: LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIE T1,DI.DSK ;DISK?
JRST %POPJ1 ;NO. FILE ALWAYS EXISTS
MOVEI T1,.FOCRE ;Try to create file
HRRM T1,FBLK(D) ;Set function
PUSHJ P,DOFLP
JRST CHKEX2 ;Failed, make sure error is correct
PUSHJ P,CLDISC ;OOPS, create succeeded!
; CLOSE file and discard it.
;Give error message
MOVEI T1,ERFNF% ;Pretend we got "file not found" error
PJRST FLPFL
;The CREATE FILOP. failed. See if the error code = 'FILE ALREADY EXISTS'
CHKEX2: CAIE T1,ERAEF% ;Already exists?
PJRST FLPFL ;No, unexpected error
PJRST %POPJ1 ;Return ok
;Routine to do some kind of OPEN FILOP.
;Clears .RBALC word after a successful OPEN
; (so further FILOP's don't set it by mistake).
;Uses T1, T2 only
DOFLP: PUSH P,.JBFF
MOVE T1,BUFADR(D) ;Point .JBFF at buffers
MOVEM T1,.JBFF
MOVEI T1,FBLK(D) ;Point to FILOP. block
HRLI T1,.FOMAX ;Set length
FILOP. T1, ;** Do FILOP. **
JRST DOFLP1 ;Failed
POP P,.JBFF ;RESTORE .JBFF
AOS (P) ;SUCCESS. SKIP RETURN LATER
SETZM LKPB+.RBALC(D) ; so it won't be an arg to further FILOP's
PJRST SETPPB ;SETUP PATH STUFF
DOFLP1: POP P,.JBFF ;Restore .JBFF
PUSH P,T1 ;[4211] SAVE ERROR CODE
PUSHJ P,RELJFN ;[4211] RELEASE THE CHANNEL (IT'S USELESS)
POP P,T1 ;[4211]
SETZM LKPB+.RBALC(D) ; so it won't be an arg to further FILOP's
SETZM FBLK(D) ;SO ERROR HANDLER KNOWS FILE ISN'T OPEN
;Routine to setup correct path stuff
; If there is a specified path, point to it.
; Else store zero in the PPN word of the lookup block.
;Uses T2 only
SETPPB: MOVEI T2,PTHB(D)
SKIPN PTHB+.PTPPN(D) ;If PATH set, put PATH dir in LOOKUP block
SETZ T2, ; Else store zero
HRRZM T2,LKPB+.RBPPN(D)
POPJ P, ;Return
;Routine to CLOSE file and discard old stuff
; If errors, the program is aborted.
CLDISC: MOVE T1,[2,,T2] ;Setup for CLOSE
MOVEI T2,.FOCLS
HLL T2,CHAN(D)
MOVX T3,CL.RST ; Discard new file
FILOP. T1,
$ACALL CLS ;FAILED. TYPE MSG AND DIE
POPJ P, ;Return
;Come here if the FILOP. failed and this means that the operation failed.
; Clean up, give standard FILOP. error, and if the ERR= branch is not
; taken, return .+1 to go to request dialog
FLPFL: PUSH P,T1 ;Save FILOP. error code
PUSHJ P,OFCLNU ;Cleanup (deallocate buffers, etc.)
POP P,T1 ;Re-get FILOP. error
CAIN T1,57 ;[4247]Check for too many open units
$ACALL OPN ;[4247]Yes,Don't call Dialog
$DCALL OPN ;FILOP. error - reason
;DEVICE-DEPENDENT OPEN ROUTINES
OTHOPN: PUSHJ P,GETBSZ ;GET BYTESIZE, BPW
LOAD T1,MODE(D) ;Get /MODE
MOVE T1,MODTAB(T1) ;AND DATA MODE
;[4253]
MOVEM T1,FBLK+.FOIOS(D)
MOVEI T1,1 ;BUFFERCOUNT IS ONE NO MATTER WHAT
STORE T1,BUFCT(D)
MOVEI T1,FBLK+.FOIOS(D) ;POINT TO DATA MODE
DEVSIZ T1, ;GET SIZE OF A BUFFER
$SNH ;SHOULD NEVER FAIL
MOVEI T1,(T1) ;GET BUFFER SIZE
PUSHJ P,%GTBLK ;ALLOCATE IT
$ACALL MFU ;CAN'T
MOVEM T1,BUFADR(D) ;SAVE ITS ADDR
ADDI T1,3 ;AND POINT TO 1ST DATA WORD
MOVEM T1,WADR(D) ;SAVE IT
PUSHJ P,SETFB ;SETUP FILOP BLOCK
LOAD T1,SAIDX(D) ;GET STATUS/ACCESS INDEX
MOVE T1,DOPFLG(T1) ;GET D%IN OR D%OUT
MOVEI T2,IBCB(D) ;SETUP FOR INPUT BUFFER ONLY
LOAD T3,BUFCT(D) ;GET BUFFERCOUNT ALSO
TXNN T1,D%OUT ;OPEN FOR OUTPUT?
JRST STOBUF ;NO. STORE INFO AS IS
MOVSI T2,IBCB(D) ;YES. SETUP FOR OUTPUT BUFFER
MOVSI T3,(T3) ;AND PUT # BUFFERS IN CORRECT PLACE
STOBUF: MOVEM T2,FBLK+.FOBRH(D)
MOVEM T3,FBLK+.FONBF(D) ;SAVE # BUFFERS
HXLZ T1,BYTPT(D) ;GET BYTE POINTER
MOVEM T1,IPTR(D) ;SAVE IT
PUSHJ P,CALOF ;OPEN FILE
POPJ P, ;error, return .+1
JRST %POPJ1
TTYOPN: PUSHJ P,GETBSZ ;SETUP BYTESIZE, ETC.
MOVX T1,D%SEOL+D%IN+D%OUT ;[4220] No initial CRLF for terminals
IORM T1,FLAGS(D)
MOVEI T1,1 ;SET BUFFERCOUNT TO 1
STORE T1,BUFCT(D)
MOVEI T1,FBLK+.FOIOS(D) ;POINT TO DATA MODE
DEVSIZ T1, ;GET SIZE OF A BUFFER
$SNH ;SHOULD NEVER FAIL
MOVEI T1,(T1) ;GET BUFFER SIZE
LSH T1,1 ;2 BUFFERS
PUSHJ P,%GTBLK ;ALLOCATE THEM
$ACALL MFU ;CAN'T
HRRZM T1,BUFADR(D) ;SAVE THEIR ADDR
ADDI T1,3 ;AND POINT TO 1ST DATA WORD IN OUTPUT BUFFER
HRRZM T1,WADR(D) ;SAVE IT
SKIPE T1,RSIZE(D) ;RECORD SIZE SPECIFIED?
JRST STOTTW ;YES. STORE AS TTYW
MOVE T1,[2,,T2] ;LEN,,ADDRESS OF TRMOP BLOCK
MOVEI T2,.TOWID ;LINE WIDTH
MOVE T3,DVICE(D) ;GET DEVICE NAME
IONDX. T3, ;CONVERT TO TERMINAL UDX
JRST TTY72 ;CAN'T. GUESS 72 COLS
TRMOP. T1, ;READ LINE WIDTH
JRST TTY72 ;CAN'T
CAIN T1,0 ;IS IT SET?
TTY72: MOVEI T1,^D72 ;GUESS 72 COLS
STOTTW: LOAD T2,CC(U) ;[3400] GET CARRIAGE CONTROL
CAIE T2,CC.LST ;[3400] CC=FORTRAN OR TRANS?
CAIN T2,CC.NON
JRST NOEXSP ;NO
ADDI T1,1 ;[3400] YES, BUMP TTY WIDTH
NOEXSP: STORE T1,TTYW(D) ;STORE LINE SIZE FOR NAMELIST/LIST-DIRECTED
PUSHJ P,SETFB ;SETUP FILOP BLOCK
MOVEI T1,TBCB(D) ;SETUP FOR INPUT AND OUTPUT
HRLI T1,IBCB(D)
MOVEM T1,FBLK+.FOBRH(D)
MOVE T1,[1,,1] ;1 BUFFER FOR EACH DIRECTION
MOVEM T1,FBLK+.FONBF(D)
HXLZ T1,BYTPT(D) ;GET BYTE POINTER
MOVEM T1,IPTR(D) ;SAVE IT FOR OUTPUT
MOVEM T1,TPTR(D) ;AND FOR INPUT
PUSHJ P,CALOF ;OPEN FILE
POPJ P, ;error, return .+1
JRST %POPJ1 ;DONE
DSKOPN: PUSHJ P,GETBSZ ;GET BYTESIZE, BPW
MOVEI T1,.IODMP ;DISK I/O IS ALWAYS DUMP MODE
MOVEM T1,FBLK+.FOIOS(D) ;STORE IN FILOP BLOCK
PUSHJ P,SETFB ;SETUP FILOP BLOCK
PUSHJ P,CALOF ;OPEN FILE
POPJ P, ;error, return .+1
PUSHJ P,DSKSET ;DO COMMON DISK SETUP
JRST %POPJ1 ;RETURN SUCCESS
GTEOFN: MOVE T1,LKPB+.RBSIZ(D) ;GET # WORDS
MOVEM T1,EOFN(D) ;SAVE IT AS EOFN
MOVEI T1,1 ;AND USE 1
MOVEM T1,BPW(D) ;AS THE NUMBER OF BYTES/WORD
POPJ P,
EOFSET: MOVE T1,LKPB+.RBSIZ(D) ;GET # WORDS
IMUL T1,BPW(D) ;GET # BYTES IN FILE
MOVEM T1,EOFN(D) ;SAVE IT
POPJ P,
MTAOPN: PUSHJ P,MTABSZ ;[4161] GET BYTESIZE, BPW
PUSHJ P,MTASET ;[4161] SETUP TAPE PARAMETERS (PERMANENTLY)
MOVEI T1,1 ;BUFFERCOUNT IS ALWAYS 1
STORE T1,BUFCT(D)
MOVX T1,UU.IBC ;NO ZEROING OF BUFFER
IORM T1,FBLK+.FOIOS(D) ;SAVE IN FILOP BLOCK
PUSHJ P,MTABLK ;[4161] SETUP MTA BLOCK
PUSHJ P,SETFB ;SETUP FILOP BLOCK
LOAD T1,SAIDX(D) ;GET STATUS/ACCESS INDEX
MOVEI T2,IBCB(D) ;SETUP FOR INPUT BUFFER ONLY
MOVEI T3,1 ;1 BUFFER ONLY
CAIE T1,SA.UA ;UNKNOWN, APPEND
CAIN T1,SA.OA ;OR OLD, APPEND
JRST STOBF2 ;YES. TREAT AS IF INPUT
MOVE T1,DOPFLG(T1) ;GET D%IN OR D%OUT
TXNN T1,D%OUT ;OPEN FOR OUTPUT?
JRST STOBF2 ;NO. STORE INFO AS IS
MOVSI T2,IBCB(D) ;YES. SETUP FOR OUTPUT BUFFER
MOVSI T3,1 ;AND PUT # BUFFERS IN CORRECT PLACE
STOBF2: MOVEM T2,FBLK+.FOBRH(D) ;SAVE BUFFER POINTER ADDRESSES
MOVEM T3,FBLK+.FONBF(D) ;SAVE # BUFFERS
PUSHJ P,CALOF ;OPEN FILE
POPJ P, ;error, return .+1
HXLZ T1,BYTPT(D) ;GET BYTE POINTER
MOVEM T1,IPTR(D) ;SAVE IT
MOVX T1,BF.IBC ;PREVENT ZEROING OF THE BUFFER
IORM T1,IBCB(D)
PJRST CHKAPP ;GO CHECK FOR APPEND
;SETUP MAGTAPE BLOCK
MTABLK: LOAD T3,BLKSZ(D) ;GET /BLOCKSIZE, BYTES
JUMPE T3,MTAGB ;IF SET
LOAD T1,TAPM(D) ;GET TAPE MODE
MOVE T1,IMPBS(T1) ;GET IMPLIED BYTESIZE
CAIN T1,^D36 ;36 BITS?
JRST MTAGW ;YES. WE'VE GOT # WORDS ALREADY
ADD T3,BPW(D) ;NO. DIVIDE BY BYTES/WORD
SUBI T3,1 ;TO GET # WORDS
IDIV T3,BPW(D)
MTAGW: ADDI T3,1 ;ADD ONE, AS UUO WANTS IT THAT WAY
MOVEI T1,.TFBSZ+.TFSET ;SET BLOCK SIZE
MOVE T2,DVICE(D) ;GET DEVICE NAME AGAIN
MOVEI P1,[ASCIZ /block size/]
MOVE T0,[3,,T1] ;SET POINTER FOR TAPOP
TAPOP. T0, ;SET IT
JRST TOPERR ;?Shouldn't fail
MTAGB: MOVEI T1,FBLK+.FOIOS(D) ;POINT TO DATA MODE
DEVSIZ T1, ;GET SIZE OF A BUFFER
POPJ P, ;UNBUFFERED
MOVEI T1,(T1) ;GET BUFFER SIZE
MOVEI T2,(T1) ;COPY IT
SUBI T2,3 ;SUBTRACT BUFFER HEADER WORDS
IMUL T2,BPW(D) ;GET # BYTES IN IT
LOAD T3,BLKSZ(D) ;GET ONE THERE ALREADY
CAIN T3,0 ;AND IF IT ZERO
STORE T2,BLKSZ(D) ;STORE A NEW ONE
LOAD T2,BLKSZ(D) ;GET IT AGAIN, POSSIBLY UPDATED
MOVEM T2,WSIZ(D) ;SAVE WINDOW SIZE
PUSHJ P,%GTBLK ;ALLOCATE IT
$ACALL MFU ;CAN'T
MOVEM T1,BUFADR(D) ;SAVE ITS ADDR
ADDI T1,3 ;AND POINT TO 1ST DATA WORD
MOVEM T1,WADR(D) ;SAVE IT
POPJ P,
;Error on TAPOP. from a device that we haven't OPENED yet.
; This could be caused by someone else assigning the device
; and we don't have privs to set the functions.
TOPERR: CAIN T0,TPPRV% ;Not enough privs?
JRST TOPERP ;Yes
$DCALL UTO ;"? Unexpected TAPOP. error.."
TOPERP: MOVEI T1,ERDAJ% ;Pretend it was a FILOP. error
; "Device allocated to another job"
$DCALL OPN ;Give error and return
%MTPRM:
%LABCK: POPJ P,
;[4161] SETUP TAPE FORMAT, DENSITY, ETC. IF ANSI-ASCII OR INDUSTRY,
;SET IMGFLG TO PREVENT LSCWS. IF INDUSTRY, SET THE BYTESIZE TO 8.
MTADEF: LOAD T0,TAPM(D) ;GET TAPE FORMAT
JUMPN T0,GOTTF ;GOT IT
MOVEI T1,.TFMOD ;GET DATA MODE
MOVE T2,DVICE(D) ;GET DEVICE NAME
MOVE T0,[2,,T1] ;[4141] SET POINTER FOR TAPOP
TAPOP. T0,
JFCL
STORE T0,TAPM(D) ;STORE IT
GOTTF: CAIE T0,TM.IND ;INDUSTRY?
CAIN T0,TM.ANS ;OR ANSI-ASCII?
SETOM IMGFLG(D) ;YES. SET IMAGE FLAG (NO LSCWS)
POPJ P,
MTASET: MOVE T2,DVICE(D) ;GET DEVICE NAME
LOAD T3,DEN(D) ;GET /DENSITY
JUMPE T3,NODEN ;IF UNIT DEFAULT, LEAVE ALONE
CAIN T3,DN.SYS ;SYSTEM DEFAULT?
MOVEI T3,.TFD00 ;YES, SET THAT
MOVEI T1,.TFDEN+.TFSET ;SET DENSITY
MOVEI P1,[ASCIZ /density/]
MOVE T0,[3,,T1] ;SET POINTER FOR TAPOP
TAPOP. T0, ;SET IT
$ECALL UTO ;CAN'T
NODEN: LOAD T0,PAR(D) ;GET /PARITY
JUMPE T0,NOPAR ;NO PARITY GIVEN
SETZ T3, ;ASSUME ODD
CAIN T0,PR.EVEN ;EVEN?
MOVEI T3,1 ;YES. SET TO EVEN PARITY
MOVEI T1,.TFPAR+.TFSET ;SET PARITY
MOVEI P1,[ASCIZ /parity/]
MOVE T0,[3,,T1] ;SET POINTER FOR TAPOP
TAPOP. T0, ;SET IT
$ECALL UTO ;CAN'T
NOPAR: LOAD T3,TAPM(D) ;GET /TAPEFORMAT
JUMPE T3,NOMODE ;NONE GIVEN. DON'T DO IT!
MOVEI T1,.TFMOD+.TFSET ;SET HARDWARE DATA MODE
MOVEI P1,[ASCIZ /data mode/]
MOVE T0,[3,,T1] ;SET POINTER FOR TAPOP
TAPOP. T0, ;SET IT
$ECALL UTO ;CAN'T
NOMODE: LOAD T0,TAPM(D) ;GET TAPEFORMAT
CAIE T0,TM.IND ;INDUSTRY?
POPJ P, ;NO. DONE
MOVX T1,.IOBYT ;YES. SET BYTE I/O MODE
MOVEM T1,FBLK+.FOIOS(D) ;SAVE IN FILOP BLOCK
POPJ P, ;DONE
>;END IF10
;TABLES
IF20,<
IMPBS: ^D36 ;(0) SYSTEM DEFAULT
^D36 ;(1) CORE-DUMP (36-BIT BYTES)
^D36 ;(2) SIXBIT (7-TRACK)
7 ;(3) ANSI-ASCII
^D8 ;(4) INDUSTRY COMPATIBLE
^D36 ;(5) HIGH-DENSITY
> ;END IF20
IF10,<
IMPBS: ^D36 ;(0) SYSTEM DEFAULT
^D36 ;(1) 9-TRACK CORE-DUMP
^D8 ;(2) INDUSTRY-COMPATIBLE
^D36 ;(3) 9-TRACK SIXBIT
7 ;(4) ANSI-ASCII
^D36 ;(5) SIXBIT (7-TRACK)
> ;END IF10
;BYTE SIZE, DATA MODE
BSTAB: 7 ;NO MODE (ASSUME ASCII)
^D36 ;IMAGE
^D36 ;BINARY
^D36 ;DUMP
7 ;ASCII 7-BIT
7 ;LINED
9 ;ASCII 9-BIT
MODTAB: 0 ;NO MODE (ASSUME ASCII)
10 ;IMAGE
14 ;BINARY
17 ;DUMP
0 ;ASCII 7-BIT
0 ;LINED
0 ;ASCII 9-BIT
SPCTAB: 0 ;BYTESIZE=0
0 ;1
0 ;2
0 ;3
0 ;4
0 ;5
0 ;SIXBIT
ASCII / / ;7-BIT ASCII
BYTE (8)" "," "," "," " ;8-BIT ASCII
BYTE (9)" "," "," "," " ;9-BIT ASCII
BYTE (10)" "," "," " ;10
BYTE (11)" "," "," " ;11
BYTE (12)" "," "," " ;12
BYTE (13)" "," " ;13
BYTE (14)" "," " ;14
BYTE (15)" "," " ;15
BYTE (16)" "," " ;16
BYTE (17)" "," " ;17
BYTE (18)" "," " ;18
BYTE (19)" " ;19
BYTE (20)" " ;20
BYTE (21)" " ;21
BYTE (22)" " ;22
BYTE (23)" " ;23
BYTE (24)" " ;24
BYTE (25)" " ;25
BYTE (26)" " ;26
BYTE (27)" " ;27
BYTE (28)" " ;28
BYTE (29)" " ;29
BYTE (30)" " ;30
BYTE (31)" " ;31
BYTE (32)" " ;32
BYTE (33)" " ;33
BYTE (34)" " ;34
BYTE (35)" " ;35
BYTE (36)" " ;36
BPTAB: (POINT 36,0,35)
(POINT 1,0,35)
(POINT 2,0,35)
(POINT 3,0,35)
(POINT 4,0,35)
(POINT 5,0,34)
(POINT 6,0,35)
(POINT 7,0,34)
(POINT 8,0,31)
(POINT 9,0,35)
(POINT 10,0,29)
(POINT 11,0,32)
(POINT 12,0,35)
(POINT 13,0,25)
(POINT 14,0,27)
(POINT 15,0,29)
(POINT 16,0,31)
(POINT 17,0,33)
(POINT 18,0,35)
(POINT 19,0,18)
(POINT 20,0,19)
(POINT 21,0,20)
(POINT 22,0,21)
(POINT 23,0,22)
(POINT 24,0,23)
(POINT 25,0,24)
(POINT 26,0,25)
(POINT 27,0,26)
(POINT 28,0,27)
(POINT 29,0,28)
(POINT 30,0,29)
(POINT 31,0,30)
(POINT 32,0,31)
(POINT 33,0,32)
(POINT 34,0,33)
(POINT 35,0,34)
(POINT 36,0,35)
%OWGBT: 0 ;0
0 ;1
0 ;2
0 ;3
0 ;4
0 ;5
530000,,0 ;6
660000,,0 ;7
600000,,0 ;8
730000,,0 ;9
0 ;10
0 ;11
0 ;12
0 ;13
0 ;14
0 ;15
0 ;16
0 ;17
760000,,0 ;18
0 ;19
0 ;20
0 ;21
0 ;22
0 ;23
0 ;24
0 ;25
0 ;26
0 ;27
0 ;28
0 ;29
0 ;30
0 ;31
0 ;32
0 ;33
0 ;34
0 ;35
0 ;36
SUBTTL SWITCH TABLES
DEFINE X (NAME,VAL,FLG) <
XWD [ASCIZ \NAME\],[FLG,,VAL]
> ;END X
DEFINE Y (NAME,ADR) <
XWD [CM%FW!CM%INV!CM%ABR
ASCIZ \NAME\],ADR
> ;END Y
OPNSWT: XWD LSWT,LSWT
X ACCESS:,OK.ACC
X BLANK:,OK.BLNK
X BLOCKSIZE:,OK.BLK,ANSIDX
X BUFFERCOUNT:,OK.BFC,ANSIDX
X BYTESIZE:,OK.BYT,ANSIDX!VAXIDX
X CARRIAGECONTROL:,OK.CC,ANSIDX
X DENSITY:,OK.DEN,ANSIDX!VAXIDX
X DISPOSE:,OK.DISP,ANSIDX
X FILESIZE:,OK.FLS,ANSIDX!VAXIDX
X FORM:,OK.FORM
IF20,< X KEY:,OK.KEY,ANSIDX ;[5000]>
X LIMIT:,OK.LIM,ANSIDX!VAXIDX
IF20,< X MAXREC:,OK.MRN,ANSIDX ;[5016]>
X MODE:,OK.MOD,ANSIDX!VAXIDX
IF20,< X NOSPANBLOCKS,OK.SPN,ANSIDX ;[5000]>
IF20,< X ORGANIZATION:,OK.ORG,ANSIDX ;[5000]>
X PADCHAR:,OK.PAD,ANSIDX!VAXIDX
X PARITY:,OK.PAR,ANSIDX!VAXIDX
X PROTECTION:,OK.PROT,ANSIDX!VAXIDX
X READONLY,OK.RO,ANSIDX
X RECL:,OK.REC
Y RECORD,OPNREC
OPNREC: X RECORDSIZE:,OK.REC,ANSIDX
X RECORDTYPE:,OK.RTP,ANSIDX
IF20,< X SHARED,OK.SHR,ANSIDX ;[5000]>
X STATUS:,OK.STAT
X TAPEFORMAT:,OK.TAPM,ANSIDX!VAXIDX
X VERSION:,OK.VER,ANSIDX!VAXIDX
LSWT==.-OPNSWT-1
;Legal DIALOG CLOSE switches
CLSSWT: XWD CSWT,CSWT
X DISPOSE:,OK.DISP,ANSIDX
X PROTECTION:,OK.PROT,ANSIDX!VAXIDX
X STATUS:,OK.STAT
CSWT==.-CLSSWT-1
SWACC: XWD LACC,LACC
X APPEND,AC.APP,ANSIDX
X DIRECT,AC.RIO
IF20,< X KEYED,AC.KEY,ANSIDX> ;[5000]
X RANDIN,AC.RIN,ANSIDX!VAXIDX
X RANDOM,AC.RIO,ANSIDX!VAXIDX
X SEQIN,AC.SIN,ANSIDX!VAXIDX
X SEQINOUT,AC.SIO,ANSIDX!VAXIDX
X SEQOUT,AC.SOU,ANSIDX!VAXIDX
X SEQUENTIAL,AC.SIO
LACC==.-SWACC-1
SWBLNK: XWD LBLNK,LBLNK
X NULL,BL.NULL
X ZERO,BL.ZERO
LBLNK==.-SWBLNK-1
SWCC: XWD LCC,LCC
X DEVICE,CC.DEV,ANSIDX!VAXIDX
X FORTRAN,CC.FOR,ANSIDX
X LIST,CC.LST,ANSIDX
X NONE,CC.NON,ANSIDX
X TRANSLATED,CC.TRN,ANSIDX!VAXIDX
LCC==.-SWCC-1
SWDEN: XWD LDEN,LDEN
X 1600,DN.1600
X 200,DN.200
X 556,DN.556
X 6250,DN.6250
X 800,DN.800
X SYSTEM,DN.SYS
LDEN==.-SWDEN-1
;OPEN DISPOSE values
SWDSPO: XWD LDISPO,LDISPO
X DELETE,DS.DEL
X EXPUNGE,DS.EXP,ANSIDX!VAXIDX
X KEEP,DS.SAVE
X LIST,DS.LIST,ANSIDX!VAXIDX
X PLOT,DS.PLT
X PRINT,DS.PRNT
X PUNCH,DS.PNCH,ANSIDX!VAXIDX
X SAVE,DS.SAVE
X SUBMIT,DS.SUB
LDISPO==.-SWDSPO-1
;CLOSE dispose values
SWDISC: XWD LDISPC,LDISPC
X DELETE,DS.DEL
X EXPUNGE,DS.EXP
X KEEP,DS.SAVE
X LIST,DS.LIST
X PLOT,DS.PLT
X PRINT,DS.PRNT
X PUNCH,DS.PNCH
X RENAME,DS.NOT
X SAVE,DS.SAVE
X SUBMIT,DS.SUB
LDISPC==.-SWDISC-1
SWFORM: XWD LFORM,LFORM
X FORMATTED,FM.FORM
X UNFORMATTED,FM.UNF
LFORM==.-SWFORM-1
SWMODE: XWD LMODE,LMODE
X ANSI,MD.AS9
X ASCII,MD.ASC
X BINARY,MD.BIN
IF10,< X DUMP,MD.DMP >
X IMAGE,MD.IMG
X LINED,MD.ASL
LMODE==.-SWMODE-1
IF20,<
SWORG: XWD LORG,LORG
X INDEXED,OR.IDX ;[5000]
X RELATIVE,OR.REL ;[5000]
X SEQUENTIAL,OR.SEQ ;[5000]
X UNKNOWN,OR.UNK,VAXIDX ;[5000]
LORG==.-SWORG-1
> ;End IF20
SWPAR: XWD LPAR,LPAR
X EVEN,PR.EVEN
X ODD,PR.ODD
LPAR==.-SWPAR-1
DEFINE Z (NAME,VAL,FLG) <
XWD [CM%FW!CM%INV
ASCIZ \NAME\],[FLG,,VAL]
> ;END Z
SWRECT: XWD LRECT,LRECT
Z DELIMITED,RT.DEL,VAXIDX
X FIXED,RT.FIX
X STREAM,RT.UND
Z UNDEFINED,RT.UND,VAXIDX
X UNKNOWN,RT.UNS,VAXIDX ;[5000]
X VARIABLE,RT.DEL
LRECT==.-SWRECT-1
;OPEN STATUS values
SWSTAT: XWD LSTAT,LSTAT
X DELETE,ST.DEL,ANSIDX!VAXIDX
X EXPUNGE,ST.EXP,ANSIDX!VAXIDX
X KEEP,ST.SAV,ANSIDX!VAXIDX
X NEW,ST.NEW
X OLD,ST.OLD
X SAVE,ST.SAV,ANSIDX!VAXIDX
X SCRATCH,ST.SCR
X UNKNOWN,ST.UNK
LSTAT==.-SWSTAT-1
;LEGAL STATUS VALUES FOR CLOSE
SWSTTC: XWD LSTTC,LSTTC
X DELETE,ST.DEL
X EXPUNGE,ST.EXP,ANSIDX!VAXIDX
X KEEP,ST.SAV
X SAVE,ST.SAV,ANSIDX!VAXIDX
LSTTC==.-SWSTTC-1
;/TAPEFORMAT
SWTAPM: XWD LTAPM,LTAPM
X CORE-DUMP,TM.DMP
X INDUSTRY,TM.IND
LTAPM==.-SWTAPM-1
;DISPATCH TABLES FOR OPEN SWITCHES, INDEXED BY SWITCH NUMBER
;
;OPNDSP:
; LH = ROUTINE TO CONVERT PROGRAM-SUPPLIED ARGUMENT TO INTERNAL FORMAT
; RH = ROUTINE TO PARSE DIALOG-MODE ARGUMENT
; OR ADDRESS OF SWITCH-VALUE TABLE IF SWITCH TAKES ASCII KEYWORDS
;
;OPSTOR:
; INSTRUCTION TO STORE SWITCH VALUE IN T2 INTO DDB
OPNDSP: XWD %POPJ, ;(0) IGNORED
XWD OPNDIA, ;(1) DIALOG
XWD OPNKWD,SWACC ;(2) ACCESS=
XWD OPNDEV, ;(3) DEVICE=
XWD OPNINT,[DIAINT] ;(4) BUFFERCOUNT=
XWD OPNINT,[DIAINT] ;(5) BLOCKSIZE=
XWD ARGNOP, ;(6) FILE=
XWD OPNINT,[DIAOCT] ;(7) PROTECTION=
XWD OPNDIR, ;(10) DIRECTORY=
XWD OPNINT,[DIAINT] ;(11) LIMIT=
XWD OPNKWD,SWMODE ;(12) MODE=
XWD OPNINT,[DIAINT] ;(13) FILESIZE=
XWD OPNINT,[DIAINT] ;(14) RECORDSIZE=
XWD OPNKWD,SWDSPO ;(15) DISPOSE=
XWD OPNINT,[DIAOCT] ;(16) VERSION=
IF10,< XWD OPNERR, ;(17) ORGANIZATION= [5000]>
IF20,< XWD OPNKWD,SWORG ;(17) ORGANIZATION= [5000]>
IF10,< XWD OPNERR, ;(20) SHARED [5000]>
IF20,< XWD OPNSET,[DIASET] ;(20) SHARED [5000]>
XWD ARGNOP, ;(21) IOSTAT=
XWD OPNADR, ;(22) ASSOCIATEVARIABLE=
XWD OPNKWD,SWPAR ;(23) PARITY=
XWD OPNKWD,SWDEN ;(24) DENSITY=
XWD OPNKWD,SWBLNK ;(25) BLANK=
XWD OPNKWD,SWCC ;(26) CARRIAGECONTROL=
XWD OPNKWD,SWFORM ;(27) FORM=
XWD OPNINT,[DIAINT] ;(30) BYTESIZE=
XWD PADCHR,[DIACHR] ;(31) PADCHAR=
XWD OPNKWD,SWRECT ;(32) RECORDTYPE=
XWD OPNKWD,SWSTAT ;(33) STATUS=
XWD OPNKWD,SWTAPM ;(34) TAPEFORMAT=
XWD OPNSET,[DIASET] ;(35) READONLY
XWD ARGNOP, ;(36) UNIT=
XWD ARGNOP, ;(37) ERR=
XWD OPNERR, ;(40) EXIST=
XWD OPNERR, ;(41) FORMATTED=
XWD OPNERR, ;(42) NAMED=
XWD OPNERR, ;(43) NEXTREC=
XWD OPNERR, ;(44) NUMBER=
XWD OPNERR, ;(45) OPENED=
XWD OPNERR, ;(46) SEQUENTIAL=
XWD OPNERR, ;(47) UNFORMATTED=
XWD ARGNOP, ;(50) NAME=
IF10,< XWD OPNERR, ;(51) KEY= [5000]>
IF20,< XWD ARGNOP,[DIAKEY] ;(51) KEY= [5000]>
IF10,< XWD OPNERR, ;(52) USEROPEN= [5000]>
IF20,< XWD OPNADR, ;(52) USEROPEN= [5000]>
XWD ARGNOP, ;(53) DIALOG=
IF10,< XWD OPNERR, ;(54) DEFAULTFILE= [5000]>
IF20,< XWD ARGNOP, ;(54) DEFAULTFILE= [5000]>
XWD OPNERR, ;(55) KEYED= [5000]
IF10,< XWD OPNERR, ;(56) NOSPANBLOCKS [5000]>
IF20,< XWD OPNSET,[DIASET] ;(56) NOSPANBLOCKS [5000]>
IF10,< XWD OPNERR, ;(57) MAXREC [5016]>
IF20,< XWD OPNINT,[DIAINT] ;(57) MAXREC [5016]>
OPNMAX==.-OPNDSP-1
;The list for CLOSE
CLSDSP: XWD %POPJ, ;(0) IGNORED
XWD OPNDIA, ;(1) DIALOG
XWD CLIGN,[DIAIGN] ;(2) ACCESS=
XWD OPNDEV, ;(3) DEVICE=
XWD CLIGN,[DIAIGN] ;(4) BUFFERCOUNT=
XWD CLIGN,[DIAIGN] ;(5) BLOCKSIZE=
XWD ARGNOP, ;(6) FILE=
XWD OPNINT,[DIAOCT] ;(7) PROTECTION=
XWD OPNDIR, ;(10) DIRECTORY=
XWD OPNINT,[DIAINT] ;(11) LIMIT=
XWD CLIGN,[DIAIGN] ;(12) MODE=
XWD CLIGN,[DIAIGN] ;(13) FILESIZE=
XWD CLIGN,[DIAIGN] ;(14) RECORDSIZE=
XWD OPNKWD,SWDISC ;(15) DISPOSE=
XWD CLIGN,[DIAIGN] ;(16) VERSION=
IF10,< XWD OPNERR, ;(17) ORGANIZATION= [5000]>
IF20,< XWD CLIGN,[DIAIGN] ;(17) ORGANIZATION= [5000]>
IF10,< XWD OPNERR, ;(20) SHARED [5000]>
IF20,< XWD CLIGN,[DIAIGN] ;(20) SHARED [5000]>
XWD ARGNOP, ;(21) IOSTAT=
XWD OPNADR, ;(22) ASSOCIATEVARIABLE=
XWD CLIGN,[DIAIGN] ;(23) PARITY=
XWD CLIGN,[DIAIGN] ;(24) DENSITY=
XWD CLIGN,[DIAIGN] ;(25) BLANK=
XWD CLIGN,[DIAIGN] ;(26) CARRIAGECONTROL=
XWD CLIGN,[DIAIGN] ;(27) FORM=
XWD CLIGN,[DIAIGN] ;(30) BYTESIZE=
XWD CLIGN,[DIAIGN] ;(31) PADCHAR=
XWD CLIGN,[DIAIGN] ;(32) RECORDTYPE=
XWD OPNKWD,SWSTTC ;(33) STATUS=
XWD CLIGN,[DIAIGN] ;(34) TAPEFORMAT=
XWD CLIGN,[DIAIGN] ;(35) READONLY
XWD ARGNOP, ;(36) UNIT=
XWD ARGNOP, ;(37) ERR=
XWD OPNERR, ;
XWD OPNERR, ;
XWD OPNERR, ;
XWD OPNERR, ;
XWD OPNERR, ;
XWD OPNERR, ;
XWD OPNERR, ;
XWD OPNERR, ;
XWD ARGNOP, ;(50) NAME=
IF10,< XWD OPNERR, ;(51) KEY= [5000]>
IF20,< XWD CLIGN,[DIAIGN] ;(51) KEY= [5000]>
IF10,< XWD OPNERR, ;(52) USEROPEN= [5000]>
IF20,< XWD CLIGN,[DIAIGN] ;(52) USEROPEN= [5000]>
XWD ARGNOP, ;(53) DIALOG=
XWD OPNERR, ;(54) DEFAULTFILE= [5000]
XWD OPNERR, ;(55) KEYED= [5000]
IF10,< XWD OPNERR, ;(56) NOSPANBLOCKS [5000]>
IF20,< XWD CLIGN,[DIAIGN] ;(56) NOSPANBLOCKS [5000]>
XWD OPNERR, ;(57) MAXREC [5016]
CLSMAX==.-CLSDSP-1
;Guard against developer errors
IFN <OPNMAX-CLSMAX>,<PRINTX ?OPNMAX .NE. CLSMAX>
OPSTOR: $SNH ;(0)
$SNH ;(1) DIALOG
STORE T2,ACC(D) ;(2) ACCESS=
$SNH ;(3) DEVICE=
STORE T2,UBUFCT(D) ;(4) BUFFERCOUNT= [5000]
STORE T2,BLKSZ(D) ;(5) BLOCKSIZE=
$SNH ;(6) FILE=
PUSHJ P,SETPROT ;(7) PROTECTION=
$SNH ;(10) DIRECTORY=
STORE T2,LIMIT(D) ;(11) LIMIT=
STORE T2,MODE(D) ;(12) MODE=
PUSHJ P,SETFSZ ;(13) FILESIZE=
MOVEM T2,RSIZE(D) ;(14) RECORDSIZE=
STORE T2,DISP(D) ;(15) DISPOSE=
MOVEM T2,VERN(D) ;(16) VERSION=
IF10,< $SNH ;(17) ORGANIZATION= [5000]>
IF20,< STORE T2,ORGAN(D) ;(17) ORGANIZATION= [5000]>
IF10,< $SNH ;(20) SHARED [5000]>
IF20,< STORE T2,SHARE(D) ;(20) SHARED [5000]>
$SNH ;(21) IOSTAT=
MOVEM T2,AVAR(D) ;(22) ASSOCIATEVARIABLE=
STORE T2,PAR(D) ;(23) PARITY=
STORE T2,DEN(D) ;(24) DENSITY=
STORE T2,BLNK(U) ;(25) BLANK=
STORE T2,CC(U) ;(26) CARRIAGECONTROL=
STORE T2,FORM(D) ;(27) FORM=
STORE T2,UBSIZ(D) ;(30) BYTESIZE=
STORE T2,PADCH(U) ;(31) PADCHAR=
STORE T2,RECTP(D) ;(32) RECORDTYPE=
STORE T2,STAT(D) ;(33) STATUS=
STORE T2,TAPM(D) ;(34) TAPEFORMAT=
STORE T2,RO(D) ;(35) READONLY
$SNH ;(36) UNIT=
$SNH ;(37) ERR=
$SNH ;(40) EXIST=
$SNH ;(41) FORMATTED=
$SNH ;(42) NAMED=
$SNH ;(43) NEXTREC=
$SNH ;(44) NUMBER=
$SNH ;(45) OPENED=
$SNH ;(46) SEQUENTIAL=
$SNH ;(47) UNFORMATTED=
$SNH ;(50) NAME=
$SNH ;(51) KEY= [5000]
IF10,< $SNH ;(52) USEROPEN= [5000]>
IF20,< MOVEM T2,UOPN(D) ;(52) USEROPEN= [5000]>
$SNH ;(53) DIALOG=
$SNH ;(54) DEFAULTFILE= [5000]
$SNH ;(55) KEYED= [5000]
IF10,< $SNH ;(56) NOSPANBLOCKS [5000]>
IF20,< STORE T2,SPAN(D) ;(56) NOSPANBLOCKS [5000]>
IF10,< $SNH ;(57) MAXREC [5016]>
IF20,< MOVEM T2,MAXREC(D) ;(57) MAXREC [5016]>
OPSTMX==.-OPSTOR-1
;Guard against developer errors
IFN <OPNMAX-OPSTMX>,<PRINTX ?OPNMAX .NE. OPSTMX>
INQDSP: XWD OPNERR, ;(0)
XWD OPNERR, ;(1) DIALOG=
XWD INQACC, ;(2) ACCESS=
XWD OPNERR, ;(3) DEVICE=
XWD OPNERR, ;(4) BUFFER COUNT=
XWD OPNERR, ;(5) BLOCK SIZE=
XWD ARGNOP, ;(6) FILE=
XWD OPNERR, ;(7) PROTECTION=
XWD INQDIR, ;(10) DIRECT=
XWD OPNERR, ;(11) LIMIT=
XWD OPNERR, ;(12) MODE=
XWD OPNERR, ;(13) FILE SIZE=
XWD INQRSZ, ;(14) RECORDSIZE=
XWD OPNERR, ;(15) DISPOSE=
XWD OPNERR, ;(16) VERSION=
IF10,< XWD OPNERR, ;(17) ORGANIZATION= [5001]>
IF20,< XWD INQORG, ;(17) ORGANIZATION= [5001]>
XWD OPNERR, ;(20) SHARED
XWD ARGNOP, ;(21) IOSTAT=
XWD OPNERR, ;(22) ASSOCIATEVARIABLE=
XWD OPNERR, ;(23) PARITY=
XWD OPNERR, ;(24) DENSITY=
XWD INQBLK, ;(25) BLANK=
XWD INQCC, ;(26) CARRIAGECONTROL=
XWD INQFRM, ;(27) FORM=
XWD INQBSZ, ;(30) BYTESIZE= [5001]
XWD OPNERR, ;(31) PADCHAR=
XWD INQRTP, ;(32) RECORDTYPE=
XWD OPNERR, ;(33) STATUS=
XWD OPNERR, ;(34) TAPEFORMAT=
XWD OPNERR, ;(35) READONLY
XWD ARGNOP, ;(36) UNIT=
XWD ARGNOP, ;(37) ERR=
XWD INQXST, ;(40) EXIST=
XWD INQFMT, ;(41) FORMATTED=
XWD INQNMD, ;(42) NAMED=
XWD INQNRC, ;(43) NEXTREC=
XWD INQNBR, ;(44) NUMBER=
XWD INQOPN, ;(45) OPENED=
XWD INQSEQ, ;(46) SEQUENTIAL=
XWD INQUNF, ;(47) UNFORMATTED=
XWD INQNAM, ;(50) NAME=
XWD OPNERR, ;(51) KEY= [5001]
XWD OPNERR, ;(52) USEROPEN= [5001]
XWD OPNERR, ;(53) DIALOG=
IF10,< XWD OPNERR, ;(54) DEFAULTFILE= [5001]>
IF20,< XWD ARGNOP, ;(54) DEFAULTFILE= [5001]>
IF10,< XWD OPNERR, ;(55) KEYED= [5001]>
IF20,< XWD INQKEY, ;(55) KEYED= [5001]>
XWD OPNERR, ;(56) NOSPANBLOCKS [5001]
XWD OPNERR, ;(57) MAXREC [5016]
INQMAX==.-INQDSP-1
;Guard against developer errors
IFN <OPNMAX-INQMAX>,<PRINTX ?OPNMAX .NE. INQMAX>
SEGMENT DATA
OICBLK:
O.IGNO: BLOCK 1 ;(0) IGNORED
O.DIAL: BLOCK 1 ;(1) DIALOG
O.ACCE: BLOCK 1 ;(2) ACCESS=
O.DEVI: BLOCK 1 ;(3) DEVICE=
O.BUFF: BLOCK 1 ;(4) BUFFERCOUNT=
O.BLOC: BLOCK 1 ;(5) BLOCKSIZE=
O.FILE: BLOCK 1 ;(6) FILE=
O.PROT: BLOCK 1 ;(7) PROTECTION=
O.DIRE: BLOCK 1 ;(10) DIRECTORY=
O.LIMI: BLOCK 1 ;(11) LIMIT=
O.MODE: BLOCK 1 ;(12) MODE=
O.FILS: BLOCK 1 ;(13) FILESIZE=
O.RECS: BLOCK 1 ;(14) RECORDSIZE=
O.DISP: BLOCK 1 ;(15) DISPOSE=
O.VERS: BLOCK 1 ;(16) VERSION=
O.ORGA: BLOCK 1 ;(17) ORGANIZATION=
O.SHAR: BLOCK 1 ;(20) SHARED
O.IOS: BLOCK 1 ;(21) IOSTAT=
O.ASSO: BLOCK 1 ;(22) ASSOCIATEVARIABLE=
O.PARI: BLOCK 1 ;(23) PARITY=
O.DENS: BLOCK 1 ;(24) DENSITY=
O.BLAN: BLOCK 1 ;(25) BLANK=
O.CARR: BLOCK 1 ;(26) CARRIAGECONTROL=
O.FORM: BLOCK 1 ;(27) FORM=
O.BYTE: BLOCK 1 ;(30) BYTESIZE=
O.PADC: BLOCK 1 ;(31) PADCHAR=
O.RECT: BLOCK 1 ;(32) RECORDTYPE=
O.STAT: BLOCK 1 ;(33) STATUS=
O.TAPE: BLOCK 1 ;(34) TAPEFORMAT=
O.READ: BLOCK 1 ;(35) READONLY
O.UNIT: BLOCK 1 ;(36) UNIT=
O.ERR: BLOCK 1 ;(37) ERR=
O.EXIS: BLOCK 1 ;(40) EXIST=
O.FRMD: BLOCK 1 ;(41) FORMATTED=
O.NMED: BLOCK 1 ;(42) NAMED=
O.NEXT: BLOCK 1 ;(43) NEXTREC=
O.NUMB: BLOCK 1 ;(44) NUMBER=
O.OPEN: BLOCK 1 ;(45) OPENED=
O.SEQU: BLOCK 1 ;(46) SEQUENTIAL=
O.UNFO: BLOCK 1 ;(47) UNFORMATTED=
O.NAME: BLOCK 1 ;(50) NAME=
O.KEY: BLOCK 1 ;(51) KEY= [5000]
O.UOPN: BLOCK 1 ;(52) USEROPEN= [5000]
O.DIAS: BLOCK 1 ;(53) DIALOG=
O.DFLT: BLOCK 1 ;(54) DEFAULTFILE= [5000]
O.KYD: BLOCK 1 ;(55) KEYED= [5000]
O.SPAN: BLOCK 1 ;(56) NOSPANBLOCKS [5000]
O.MRN: BLOCK 1 ;(57) MAXREC= [5016]
OICMAX==.-OICBLK-1
IFN <OPNMAX-OICMAX>,<PRINTX ?OPNMAX .NE. OICMAX>
SEGMENT CODE
;DEFAULT EXTENSION AND DEVICE NAME
DATEXT: ASCIZ /DAT/
DSKDEF: ASCIZ /DSK/
;DEFAULT DEVICE TABLE
[ASCIZ /PLOT/] ;-7
[ASCIZ /REREAD/] ;-6
[ASCIZ /READ/] ;-5: CDR
[ASCIZ /ACCEPT/] ;-4
[ASCIZ /PRINT/] ;-3
[ASCIZ /PUNCH/] ;-2
[ASCIZ /TYPE/] ;-1
%UNNAM=.
DEFINE X (A) <EXP ASCII /A/>
X PLT ;-7 FOR USE BY FORPLT
X REREAD ;-6 REREAD
X CDR ;-5 READ
X TTY ;-4 ACCEPT
X LPT ;-3 PRINT
X PTP ;-2 PUNCH
X TTY ;-1 TYPE
DEVTAB:
IFE FTDSK!FTVAX,<
X DSK ;00 DISK
X DSK ;01 DISK
X CDR ;02 CARD READER
X LPT ;03 LINE PRINTER
X CTY ;04 CONSOLE TELETYPE
X TTY ;05 USER'S TELETYPE
X PTR ;06 PAPER TAPE READER
X PTP ;07 PAPER TAPE PUNCH
X DIS ;08 DISPLAY
X DTA1 ;09 DECTAPE
X DTA2 ;10
X DTA3 ;11
X DTA4 ;12
X DTA5 ;13
X DTA6 ;14
X DTA7 ;15
X MTA0 ;16 MAG TAPE
X MTA1 ;17
X MTA2 ;18
X FORTR ;19
X DSK ;20
X DSK ;21
X DSK ;22
X DSK ;23
X DSK ;24
X DEV1 ;25 ASSIGNABLE DEVICES
X DEV2 ;26
X DEV3 ;27
X DEV4 ;28
X DEV5 ;29
> ;END IFE FTDSK!FTVAX
IFN FTDSK,<
X PLT ;-7 FOR USE BY FORPLT
X REREAD ;-6 REREAD
X CDR ;-5 READ
X TTY ;-4 ACCEPT
X LPT ;-3 PRINT
X PTP ;-2 PUNCH
X TTY ;-1 TYPE
DEVTAB:
> ;[4225] END IFN FTDSK
IFN FTVAX,< ;ALL BUT UNIT=5 AND 6 IS DSK:
X DSK ;00 DISK
X DSK ;01 DISK
X DSK ;02 DISK
X DSK ;03 DISK
X DSK ;04 DISK
X TTY ;05 USER'S TTY (INPUT)
X TTY ;06 USER'S TTY (OUTPUT)
> ;END IFN FTVAX
MAXDEV==.-DEVTAB ;MAXDEV & UP DISK
SUBTTL DDB CONSOLIDATION ROUTINES
;Routine to mark DDB for consolidation if the device is the
; same. If there is an error, the program is aborted.
;Called for all generic OPEN's.
MARKCS: MOVEI T1,1 ;Set use count to 1
MOVEM T1,USCNT(D) ; (Probably won't be consolidated)
LOAD T1,DVTYP(D) ;Get device type
CAIE T1,DT.NUL ;NUL: doesn't get consolidated
CAIN T1,DT.DSK ;DSK: doesn't get consolidated
JRST %POPJ1 ;SKIP RETURN
;See if we can find another DDB with same device.
MOVE T1,DVICE(D) ;Get device info to compare
MOVE T2,[MINUNIT-MAXUNIT-1,,MINUNIT] ;Loop thru all units
MRKSC1: MOVE T3,%DDBTAB(T2) ;Get a unit block address
JUMPE T3,MRKSC2 ;None, skip
MOVE T4,DDBAD(T3) ;Get DDB addr.
CAMN T1,DVICE(T4) ;Same device?
JRST MRKSCS ;Yes
MRKSC2: AOBJN T2,MRKSC1 ;Not the same, loop
JRST %POPJ1 ;SKIP RETURN
MRKSCS: CAMN U,T3 ;Same unit?
JRST MRKSC2 ;Yes, skip it
;We found the device in another DDB
;T3= new unit address
;T4= DDB address for it
MOVEM T3,CNSUNT ;Save unit address
PUSHJ P,CNSCHK ;Make sure something isn't incompatible
POPJ P, ;SOMETHING NOT COMPATIBLE. NON-SKIP RETURN
MOVE T3,CNSUNT ;T3= address of unit to consolidate
MOVE T2,DDBAD(T3) ;T2= DDB address of it
MOVE T1,FLAGS(T2) ;Get DDB flags
TXNE T1,D%IN+D%OUT ;OPEN already?
JRST MRKCNS ;Yes, consolidate now
;Can't really consolidate yet (since an OPEN failure might get us to DIALOG
; mode where the guy might change some DDB parameters, including the
; device). So we have to "mark" the DDB for consolidation, which will
; happen for all unopened DDB's when any one of them is really OPENed.
;This is done by inserting this DDB in a doublyinked list.
;T3= unit address
MOVE T1,CNSL1(T3) ;See if any consolidated yet..
JUMPE T1,NOTCYT ;No
MOVEM U,CNSL1(T3) ;Store new "next" link in old previous
; unit block
MOVEM T3,CNSL2(U) ;Store new "previous" link in added unit block
MOVEM T1,CNSL1(U) ;Store new "next" link in added unit block
MOVEM U,CNSL2(T1) ;Store new "previous" link in old next
; unit block
JRST %POPJ1 ;SKIP RETURN
;Set up initial doubly-linked list (two items in it)
;Next and previous links are the same for each item - they just point
;to the other one.
NOTCYT: MOVEM T3,CNSL1(U)
MOVEM T3,CNSL2(U)
MOVEM U,CNSL1(T3)
MOVEM U,CNSL2(T3)
JRST %POPJ1 ;SKIP RETURN
;The device is already OPEN on another DDB
MRKCNS: MOVEI T1,(D) ;Throw away this DDB
PUSHJ P,%FREBLK
MOVE T1,CNSUNT ;Get unit address that points to common DDB
MOVE D,DDBAD(T1) ;Get DDB
MOVEM D,DDBAD(U) ;SAVE NEW DDB ADDRESS IN UDB
AOS USCNT(D) ;Increment use count
JRST %POPJ1 ;AND SKIP RETURN
SEGMENT DATA
GJBTS: BLOCK 1 ;GTJFN bits for DOOPEN
OPNBTS: BLOCK 1 ;OPENF BITS FOR DOOPEN
CNSUNT: BLOCK 1 ;Address of the unit that might point
RETA: BLOCK 1 ;RETURN ADDRESS FOR SAVERR
SEGMENT CODE
;DOCONS: Routine to do consolidation of DDB's (when an OPEN was successful)
; If any DDB's are linked in the "consolidation" chain (waiting for
; one of the units to actually get "OPEN'ed"), they are thrown away
; and the use count of the one that is opened reflects the number
; that are attached.
; This routine returns .+1 always.
DOCONS: MOVE T1,CNSL1(U) ;Get "next" unit in chain, if any
JUMPE T1,%POPJ ;Return if none -- nothing to do.
MOVE P1,T1 ;Get unit block address
;P1= address of unit block to consolidate with this one
DOCNS1: MOVE T1,DDBAD(P1) ;Throw away it's DDB
PUSHJ P,%FREBLK
MOVEM D,DDBAD(P1) ;Store consolidated DDB address
AOS USCNT(D) ;Increment use count
MOVE T1,CNSL1(P1) ;Get "next" unit in chain
CAMN T1,U ;Wrapped around to beginning?
JRST DOCNS2 ;Yes
SETZM CNSL1(P1) ;CLEAR THE LINKS
SETZM CNSL2(P1) ; . .
MOVE P1,T1 ;P1= next unit
JRST DOCNS1 ;Loop
;Clear links in the current unit block also.
DOCNS2: SETZM CNSL1(U)
SETZM CNSL2(U)
POPJ P, ;Return
;Routine to see if we can successfully consolidate a DDB.
; The parameters must match in the DDB.
;If they don't, the program takes ERR= branch or is aborted.
;Call:
; CNSUNT/ address of unit that points to DDB to check
; D/ current (set-up) DDB
; PUSHJ P,CNSCHK
; <return here if ok>
;
CNSCHK: MOVE T1,CNSUNT ;Point to unit block
HXRE T2,UNUM(T1) ;T2= unit number for error message [3111]
MOVE T1,DDBAD(T1) ;T1= DDB address to check
MOVE T3,RSIZE(T1) ;GET RECORDSIZE OF OLD DDB
CAME T3,RSIZE(D) ;MUST BE THE SAME AS THE NEW ONE
$DCALL SDO ;NO. GIVE ERROR
MOVE T1,IMGFLG(T1) ;[4161] GET IMAGE-MODE FLAG OF ONE
CAME T1,IMGFLG(D) ;[4161] SAME AS THE OTHER?
$DCALL SDO ;[4161] NO. GIVE ERROR
JUMPN T1,%POPJ1 ;DON'T CHECK MODES IF MODE=IMAGE
LOAD T3,MODE(T1) ;Get old mode
LOAD T4,MODE(D) ;Get new mode
JUMPE T4,%POPJ1 ;NOT SET UP IS OK
CAME T3,T4 ;The same?
$DCALL SDO ;?No, give error
JRST %POPJ1 ;SKIP RETURN
;Routine to clear consolidation pointers for this DDB (if any).
;If a DDB has consolidation pointers, it is because there
; are other DDB's that refer to the same device, although they
; have not yet been OPEN'ed.
CLRCNS: MOVE T1,CNSL1(U) ;Get "next" link
JUMPE T1,%POPJ ;Return if none
MOVE T2,CNSL2(U) ;Get "previous" link
CAMN T1,T2 ;The same? (just two unit blocks in link)
JRST CLRCN1 ;Yes, delete all ptrs.
MOVEM T1,CNSL1(T2) ;Store new "next" link in old previous
MOVEM T2,CNSL2(T1) ;Store new "previous" link in old next
JRST CLRCN2 ;Delete links of this DDB
;Delete all ptrs.
CLRCN1: SETZM CNSL1(T1) ;
SETZM CNSL2(T1) ;
;Delete ptrs in this unit block.
CLRCN2: SETZM CNSL1(U)
SETZM CNSL2(U)
POPJ P, ;Return
SUBTTL CLOSE
FENTRY (CLOSE)
PUSHJ P,%SAVAC ;SAVE USER'S ACS
PUSHJ P,%CPARG ;AND COPY ARGS
XMOVEI T1,[ASCIZ /CLOSE/] ;SET STATEMENT NAME FOR ERR MESSAGES
MOVEM T1,%IONAM
PUSHJ P,CLCVAR ;CLEAR COMMON OPEN/CLOSE VARIABLES
PUSHJ P,CLSCNV ;CONVERT OLD ARG BLOCK FORMAT
PUSHJ P,OICCPY ;COPY ARGS TO KEYWORD BLOCK
PUSHJ P,UNRNGE ;Check for unit out of range
MOVE T1,%CUNIT ;GET THE UNIT
SKIPN U,%DDBTAB(T1) ;Get ptr to unit block
JRST %SETAV ;NO FILE OPEN. CLOSE IS NOP. CLEAR %UDBAD
MOVEM U,%UDBAD ;SAVE FOR ERROR MESSAGES
MOVEM U,%OLUDB ;SAVE FOR LATER
MOVE D,DDBAD(U) ;GET DDB ADDR
MOVEM D,%OLDDB ;SAVE FOR LATER
PUSHJ P,CLOSE1 ;CHECK IF FILE WAS OPENED
JRST CLSCLN ;IT WAS NOT
PUSHJ P,GTRDDB ;GET NEW UDB/DDB, SAVE ADDRESSES
SETZM O.DIAL ;KLUDGE - FILLED IN BY OPNARG
PUSHJ P,CLSARG ;MOVE ARGS TO DDB
SKIPE O.FILE ;FILE=STRING SEEN?
PUSHJ P,FILCLS ;YES. PROCESS IT
SKIPE O.NAME ;NAME=STRING SEEN?
PUSHJ P,NAMCLS ;YES. PROCESS IT
SKIPE O.DIAS ;DIALOG=STRING SEEN?
PUSHJ P,DLSCLS ;Yes, do it
CLOS.1: SKIPN %RNAMU ;ANY RENAME UDB?
PUSHJ P,GTRDDB ;NO. GET ONE
MOVE U,%RNAMU ;SETUP U AND D
MOVE D,%RNAMD
PUSHJ P,CLSDLG ;Do DIALOG mode if necessary
PUSHJ P,CKCARG ;Check CLOSE args for problems,
JRST CLOS.1 ; (user has to fix stuff)
MOVE U,%OLUDB ;GET ORIGINAL UNIT BLOCK ADDR
MOVE D,%OLDDB ;AND ORIGINAL DEVICE BLOCK ADDR
PJRST CLSITA ;Go close an opened unit and return
SUBTTL %CLOSX: GENERIC CLOSE ROUTINE
;Routine to close an opened unit
;Call:
; D/ ptr to DDB block
; U/ ptr to unit block
;
%CLOSX: PUSHJ P,CLCVAR ;CLEAR COMMON OPEN/CLOSE VARIABLES
MOVEM U,%UDBAD ;TELL ERROR HANDLER WE HAVE A DDB
MOVEM U,%OLUDB ;SAVE OLD UDB
MOVEM D,%OLDDB ;AND DDB
MOVEM D,CLSDDB ;[4155] USE THIS ONE FOR DISPOSE AND STATUS
SETZM %RNAMU ;NO RENAME UDB OR DDB
SETZM %RNAMD
SETZM %NAMLN ;[4155] CLEAR THE "MESSAGE ALREADY OUT" FLAG
PUSHJ P,CLOSE1 ;SEE IF UNIT HAS BEEN OPENED
JRST CLSCLN ;HAS NOT. JUST CLEAN UP
;Here when file is open, to close it.
CLSITA: MOVE T1,USCNT(D) ;GET DDB USE COUNT
CAILE T1,1 ;MORE THAN 1?
JRST XCLSDN ;YES. DON'T DO ANYTHING NOW!
LOAD T1,INDX(D) ;GET DEV INDEX
PUSHJ P,CLSTAB(T1) ;CLOSE BY DEVICE
PUSHJ P,CHKREN ;CHECK ON RENAME
JRST CLOS.1 ;RENAME FAILED. TRY AGAIN
LOAD T1,INDX(D) ;GET DEVICE INDEX AGAIN
PUSHJ P,DPTAB(T1) ;AND DISPOSE OF FILE
JRST CLOS.1 ;FAILED. TRY AGAIN
XCLSDN: HXRE T1,UNUM(U) ;Get unit number
MOVE T2,[RRUNIT] ;GET FLAG FOR NO REREAD UNIT
CAMN T1,U.RERD ;Is it the last successful READ unit?
MOVEM T2,U.RERD ;Yes, save flag so REREAD fails.
PJRST CLSCLN ;CLEANUP AND RETURN
;CLOSE1 - Entry from CLOSE statement
;We have to open the file if an explicit OPEN statement
; has been done.
;If the file is on Disk or DECtape, and
;an OPEN was done but the file is not open now,
;actually get the file opened.
;If file already exists, open for input.
;Else open for output.
CLOSE1: MOVE T1,FLAGS(D) ;Get DDB flags
TXNE T1,D%IN!D%OUT ;Was file ever opened?
JRST %POPJ1 ;YES. SKIP RETURN FOR REAL CLOSE
TXNN T1,D%OPEN ;Was explicit OPEN done?
POPJ P, ;NO. NON-SKIP RETURN
LOAD T1,DVTYP(D) ;Not disk, but for DECtape have to do it too
CAIE T1,DT.DSK ;DISK?
CAIN T1,DT.DTA ;DECTAPE?
JRST CLSITY ;Yes, must do it.
POPJ P, ;NO. NON-SKIP RETURN FOR CLEANUP ONLY
CLSITY: LOAD T1,INDX(D) ;[5002] GET DEVICE TYPE
PJRST CLSYTB(T1) ;[5002] DO THINGS BY DEVICE
CLSYTB: JRST CLYNRM ;[5002] TTY
JRST CLYNRM ;[5002] DISK
JRST CLYNRM ;[5002] MAGTAPE
JRST CLYNRM ;[5002] OTHER. CAN'T SWITCH TO INPUT
IF20,< JRST RMSITY ;[5002] REMOTE STREAM FILE
JRST RMSITY ;[5002] RMS FILE
> ;End IF20
CLYNRM: PUSHJ P,LOOKF ;[5002] LOOKUP THE FILE
JRST DOPNY ;[4137] NOT THERE. GO OPEN IT
PUSHJ P,DOJFNS ;[4137] THERE. RETURN EXPANDED FILESPEC TO DDB
PUSHJ P,GTEOFN ;GET EOFN, BPW FOR DISPOSE=
JRST %POPJ1 ;[4137] SKIP RETURN
DOPNY: PUSHJ P,OPENY ;[4137] NOT THERE. DO A FULL OPEN
JRST %POPJ1 ;FILE IS NOW OPEN. SKIP RETURN TO CLOSE IT
IF20,< ;[5002]
RMSITY: SKIPE %ABFLG ;[5002] ARE WE ABORTING?
POPJ P, ;[5002] YES, CLEANUP ONLY
PUSHJ P,%RMCSY ;[5002] LOOKUP THE FILE
JRST DOPNY ;[5002] NOT THERE, GO OPEN IT
PUSHJ P,%RMRFS ;[5002] RETURN FILESPEC TO DDB
JRST %POPJ1 ;[5002] SKIP RETURN
> ;End IF20
;GET A NEW DDB FOR A (POSSIBLE) RENAME FILESPEC, AND COPY
;THE FILE INFORMATION FROM THE OLD DDB.
GTRDDB: MOVEI T1,ULEN ;Allocate a blank unit
PUSHJ P,%GTBLK
$ACALL MFU ;CAN'T
MOVE U,T1 ;GET UDB ADDRESS
MOVEM U,%RNAMU
MOVEI T1,DLEN ; and DDB
PUSHJ P,%GTBLK
$ACALL MFU ;CAN'T
MOVE D,T1 ;GET DDB ADDRESS
MOVEM D,%RNAMD ;SAVE ADDRESS
MOVEM D,CLSDDB ;[4155] SETUP THIS DDB FOR STATUS AND DISPOSE
MOVEM D,DDBAD(U) ;SAVE IN UDB
PUSHJ P,COPFDD ;Copy file-spec info from old DDB
SETZM GEN(D) ;EXCEPT GENERATION NUMBER IS NOT DEFAULTED
POPJ P,
CLSTAB: JRST TTYCLS ;TTY
JRST DSKCLS ;DISK
JRST OTHCLS ;MTA
JRST OTHCLS ;OTHER LOCAL DEVICE
IF20,< JRST %RMCLS ;[5002] REMOTE STREAM FILE
JRST %RMCLS ;[5002] RMS FILE
> ;End IF20
DPTAB: JRST %POPJ1 ;TTY - NO DISPOSITION
JRST DSKDSP ;DISK
JRST %POPJ1 ;MTA - NO DISPOSITION
JRST OTHDSP ;OTHER
IF20,< JRST %RMDSP ;[5002] REMOTE STREAM FILE
JRST %RMDSP ;[5002] RMS FILE
> ;End IF20
TTYCLS: LOAD T1,CC(U) ;GET CARRIAGECONTROL
CAIE T1,CC.TRN ;TRANSLATED?
JRST FICLOS ;NO. DONE
MOVE T1,FLAGS(D) ;GET FLAGS
TXNN T1,D%SEOL ;SUPPRESS CR/LF?
PUSHJ P,%OCRLF ;NO. OUTPUT ENDING CRLF
PJRST FICLOS ;DONE
DSKCLS: LOAD T0,ACC(D) ;GET ACCESS
CAIE T0,AC.APP ;APPEND?
JRST NOTAPP ;NO. GO FREE UP PAGES
MOVE T1,FLAGS(D) ;Get DDB flags
TXNE T1,D%OUT ;Was file open for output?
PUSHJ P,%LSTBF ;YES. GO WRITE LAST BUFFER
PJRST FICLOS ;GO CLOSE FILE
NOTAPP: PUSHJ P,DSKFRE ;UNMAP FILE, FREE BUFFERS
PJRST FICLOS ;GO CLOSE FILE
OTHCLS: MOVE T1,FLAGS(D) ;Get DDB flags
TXNE T1,D%OUT ;Was file open for output?
PUSHJ P,%LSTBF ;YES. GO WRITE LAST BUFFER
PJRST FICLOS ;GO CLOSE FILE
DSKDSP: MOVE T1,CLSDDB ;[4155] GET THE PROPER DDB FOR DISPOSE VALUE
LOAD T1,ODISP(T1) ;[4155] GET ORTHOGONAL DISPOSE VALUE
JUMPN T1,CLSQ ;IF NON-ZERO VALUE, MEANS QUEUED
JRST CLNOT ;OTHERWISE NO QUEUEING
OTHDSP: LOAD T1,DVTYP(D) ;GET DEVICE TYPE
CAIE T1,DT.DTA ;DECTAPE?
JRST %POPJ1 ;NO. DONE
CLNOT: MOVE T1,CLSDDB ;[4155] GET THE PROPER DDB FOR STATUS VALUE
LOAD T1,OSTAT(T1) ;[4155] GET ORTHOGONAL CLOSE STATUS VALUE
PUSHJ P,CLNSTA(T1) ;CLOSE FILE
POPJ P, ;FAILED. NON-SKIP RETURN
JRST %POPJ1 ;SUCCESS. WE'RE DONE
CLNSTA: JRST %POPJ1 ;UNKNOWN (DEFAULT IS SAVE)
JRST %POPJ1 ;SAVE
JRST CLDEL ;DELETE
JRST CLEXP ;EXPUNGE
CHKREN: SKIPE T1,%RNAMD ;RENAME DDB?
SKIPN FILPRS(T1) ;FILESPEC PARSED IN IT?
JRST %POPJ1 ;NO
PUSHJ P,CHKWLD ;[4137] CHECK WILCARD SPECS
LOAD T1,INDX(D) ;YES. GET DEVICE INDEX
PUSHJ P,RENTAB(T1) ;AND RENAME THE FILE NOW
POPJ P, ;FAILED. GO GET NEW RENAME FILESPEC
MOVE T1,%RNAMD ;GET RENAME DDB AGAIN
SETZM FILPRS(T1) ;FILE IS RENAMED. NO TURNING BACK
JRST %POPJ1 ;SKIP RETURN FOR SUCCESS
RENTAB: JRST %POPJ1 ;CAN'T RENAME THE TTY
JRST DSKREN ;DISK
JRST %POPJ1 ;CAN'T RENAME A MAGTAPE
JRST OTHREN ;OTHER - MIGHT BE A DECTAPE
IF20,< JRST %RMREN ;[5002] REMOTE STREAM FILE
JRST %RMREN ;[5002] RMS FILE
> ;End IF20
;[4137] new
;++
; FUNCTIONAL DESCRIPTION:
;
; This routine checks the rename filespec for wildcards.
; If filename, extension, or directory are
; specified exactly as '*', the corresponding part of the
; old (previously OPENed) filespec is copied into the
; rename DDB.
;
; CALLING SEQUENCE:
;
; PUSHJ P,CHKWLD
;
; INPUT PARAMETERS:
;
; None
;
; IMPLICIT INPUTS:
;
; D DDB of currently OPENed file
; %UDBAD DDB of rename DDB
;
; OUTPUT PARAMETERS:
;
; None
;
; IMPLICIT OUTPUTS:
;
; DDB variables FILNAM, EXT, and DIRNAM in rename DDB.
;
; SIDE EFFECTS:
;
; None
;
;--
CHKWLD: MOVE T4,%RNAMD ;GET RENAME DDB ADDR
HLLZ T1,DIRNAM(T4) ;GET DIRECTORY
TLZ T1,17 ;CLEAR ALL EXCEPT 2 FIRST CHARACTERS
CAME T1,[ASCIZ /*/] ;IS IT A FULL WILDCARD?
JRST WLDFIL ;NO. GO CHECK FILENAME
HRLI T1,DIRNAM(D) ;YES. COPY OLD ONE
HRRI T1,DIRNAM(T4)
BLT T1,DIRNAM+LDIRW-1(T4)
WLDFIL: HLLZ T1,FILNAM(T4) ;GET 1ST WORD OF FILENAME
TLZ T1,17 ;CLEAR ALL EXCEPT 2 FIRST CHARACTERS
CAME T1,[ASCIZ /*/] ;IS IT A FULL WILDCARD?
JRST WLDEXT ;NO. GO CHECK EXTENSION
HRLI T1,FILNAM(D) ;YES. COPY OLD ONE
HRRI T1,FILNAM(T4)
BLT T1,FILNAM+LFILW-1(T4)
WLDEXT: HLLZ T1,EXT(T4) ;GET EXTENSION
TLZ T1,17 ;CLEAR ALL EXCEPT 2 FIRST CHARACTERS
CAME T1,[ASCIZ /*/] ;IS IT A FULL WILDCARD?
POPJ P, ;NO. DONE
HRLI T1,EXT(D) ;YES. COPY OLD ONE
HRRI T1,EXT(T4)
BLT T1,EXT+LEXTW-1(T4)
POPJ P,
;Routine to clean up after CLOSE (successfully) done.
; Throws away core not used, DDB and unit blocks.
CLSCLN: CAMN U,U.ERR ;ERROR MESSAGE UNIT?
SETZM U.ERR ;YES, NO MORE ERR MESSAGE UNIT
PUSHJ P,CLRCNS ;Clear consolidation ptrs if any
; (for un-opened units on same device)
SOSGE T1,USCNT(D) ;This DDB no longer in use
$SNH ;??USE count went negative
JUMPN T1,CLSCL1 ;DDB still in use, don't deallocate it
CAME D,D.TTY ;Is this the TTY DDB?
JRST NOTETT ;NO
SETZM D.TTY ;Yes, no more.
SETZM U.TTY ;CLEAR UNIT BLOCK ADDR ALSO
NOTETT: HRRZ T1,IRBUF(D) ;GET INPUT REC ADDR-1
JUMPE T1,NOIRB ;NONE
ADDI T1,1 ;CORRECT IT
PUSHJ P,%FREBLK ;DEALLOCATE BUFFER
NOIRB: HRRZ T1,ORBUF(D) ;GET OUTPUT REC ADDR-1
JUMPE T1,NOORB ;NONE
ADDI T1,1 ;CORRECT IT
PUSHJ P,%FREBLK ;DEALLOCATE BUFFER
%CLSCL:
NOORB: PUSHJ P,%RMDAB ;[5000] Deallocate any RMS arg blocks
SKIPE T1,BUFADR(D) ;ANY BUFFER TO DEALLOCATE?
PUSHJ P,%FREBLK ;YES. DO IT
SETZM BUFADR(D) ;Clear core pointer
MOVEI T1,(D) ;Throw away DDB
PUSHJ P,%FREBLK
;Unit is now closed. Throw away the unit block and ptr in DDBTAB.
CLSCL1: HXRE T2,UNUM(U) ;Get unit number
SETZM %DDBTAB(T2) ;Clear entry in DDBTAB
MOVEI T1,(U) ;Throw away unit block
PUSHJ P,%FREBLK
SETZM %UDBAD ;NO MORE DDB FOR THIS STATEMENT
SKIPE T1,%RNAMD
PUSHJ P,%FREBLK ;Throw away blocks
SKIPE T1,%RNAMU
PUSHJ P,%FREBLK
SETZM %RNAMD ;Clear ptrs
SETZM %RNAMU ; . .
PJRST %SETAV ;GO SET IOSTAT
;Routine to copy filespec info from old DDB to new one.
; (as defaults for DIALOG, etc.)
;Inputs:
; U & D/ new unit & DDB blocks
;Call:
; PUSHJ P,COPFDD
; <return here always>
COPFDD: MOVE P1,%OLUDB ;GET OLD UDB ADDR
MOVE P2,%OLDDB ;AND OLD DDB ADDR
LOAD T1,INDX(P2) ;Device index is copied
STORE T1,INDX(D)
LOAD T1,UNUM(P1) ;Unit number is copied
STORE T1,UNUM(U)
HRLI T1,FILSPC(P2) ;Copy a bunch of stuff
HRRI T1,FILSPC(D)
BLT T1,FILSPC+.FSSLN-1(D) ;. .
IF20,<
LOAD T1,ORGAN(P2) ;[5002] Copy organization
STORE T1,ORGAN(D) ;[5002]
> ;End IF20
IF10,<
HRRZ T1,LKPB+.RBEXT(P2) ;High bits of creation date
TXZ T1,RB.ACD ;Clear out access date
MOVEM T1,LKPB+.RBEXT(D)
MOVE T1,LKPB+.RBPRV(P2) ;PROTECTION, MODE, 12-BIT CREATION DATE
MOVEM T1,LKPB+.RBPRV(D)
>;END IF10
POPJ P, ;Return
;Reconcile CLOSE args with the OPEN unit info.
; Errors and warnings are issued (possibly ERR= branch taken).
;If DISPOSE='RENAME', the new filespec is remembered.
; Possibly set O.DIAL to get him to DIALOG mode.
;Inputs:
; U and D point to new ones.
; PUSHJ P,CKCARG
; <return here> (or take ERR=).
CKCARG: PUSHJ P,DFDEV1 ;Get device info, skip if ok
POPJ P, ;No, error
PUSHJ P,DSCALC ;CALCULATE DISPOSE/STATUS INDEX
POPJ P, ;Error, return immediately
LOAD T1,OSTAT(D) ;GET ORTHOGONAL STATUS VALUE
JUMPN T1,NRSTAT ;IF ONE THERE, NONE IMPLIED
MOVEI T1,OS.SAV ;RENAME IMPILES STATUS=SAVE
SKIPE FILPRS(D) ;DID WE GET A RENAME?
STORE T1,OSTAT(D) ;YES. SET ORTHOGONAL STATUS TO 'SAVE'
;[4155] NEW CODE - TRANSFER VALUES FROM OLD DDB TO NEW DDB
NRSTAT: MOVE T2,%OLDDB ;GET OLD DDB
LOAD T0,ODISP(T2) ;GET OLD ORTHOGONAL DISP
LOAD T1,ODISP(D) ;GET NEW ORTHOGONAL DISP
CAIN T1,0 ;OVERLAY OLD OVER NEW IF NEW IS ZERO
STORE T0,ODISP(D) ;SAVE IN NEW DDB
LOAD T0,OSTAT(T2) ;GET OLD ORTHOGONAL STATUS
LOAD T1,OSTAT(D) ;GET NEW ORTHOGONAL STATUS
CAIN T1,0 ;OVERLAY OLD OVER NEW IF NEW IS ZERO
STORE T0,OSTAT(D) ;SAVE IN NEW DDB
LOAD T0,LIMIT(T2) ;GET OLD LIMIT VALUE
LOAD T1,LIMIT(D) ;GET NEW LIMIT VALUE
CAIN T1,0 ;OVERLAY OLD OVER NEW IF NEW IS ZERO
STORE T0,LIMIT(D)
JRST %POPJ1 ;SKIP RETURN FOR SUCCESS
SEGMENT DATA
EFSFLG: BLOCK 1 ;FLAG FOR [Enter correct file specs]
%RNAMD: BLOCK 1 ;Address of DDB with rename filespec
%RNAMU: BLOCK 1 ;Address of UDB with rename filespec
%OLUDB: BLOCK 1 ;ADDRESS OF OLD UDB FOR CLOSE
%OLDDB: BLOCK 1 ;ADDRESS OF OLD DDB FOR CLOSE
CLSDDB: BLOCK 1 ;ADDRESS OF RENAME DDB, OR OLD DDB IF NONE
SEGMENT CODE
IF20,<
FICLOS: MOVE T1,IJFN(D) ;Get JFN
GTSTS%
JUMPGE T2,RELJFN ;IF NOT OPEN, DON'T CLOSE IT
MOVE T1,IJFN(D) ;CLOSE FILE, TOSS JFN
CLOSF%
$AJCAL CLS ;SHOULD NOT FAIL
SETZM IJFN(D) ;SHOW WE TOSSED JFN
SETZM OJFN(D)
MOVX T1,D%IN+D%OUT+D%WRT+D%MOD ;[4155] TURN OFF THE I/O BITS
ANDCAM T1,FLAGS(D)
POPJ P,
; TOPS-20 /DISPOSE:DELETE and EXPUNGE
CLDEL: PUSHJ P,DLOOK ;LOOKUP FILE AGAIN
$DCALL DEL ;CAN'T, SO WE CAN'T DELETE IT!
MOVE T1,IJFN(D) ;GET JFN
DELF% ;DELETE FILE
ERJMP RELDEL ;[4155] FAILED. GO RELEASE JFN, GIVE MSG
JRST %POPJ1 ;OK. FILE DELETED
CLEXP: PUSHJ P,DLOOK ;LOOKUP FILE AGAIN
$DCALL DEL ;CAN'T, SO WE CAN'T DELETE IT!
MOVX T1,DF%EXP ;SET TO EXPUNGE
HRR T1,IJFN(D) ;GET JFN
DELF% ;DELETE FILE, MAYBE EXPUNGE
ERJMP RELDEL ;[4155] FAILED. GO RELEASE JFN, GIVE MSG
JRST %POPJ1 ;Ok, file deleted
RELDEL: PUSHJ P,RELJFN ;[4155] RELEASE JFN
$DCALL DEL ;[4155] GIVE MSG AND LEAVE
;Routine to RENAME file after close.
;D/ U/ old DDB block.
;%RNAMD/ %RNAMU/ new DDB block.
OTHREN: JRST %POPJ1 ;RENAME IS NOP FOR NON-DISK DEVICES
DSKREN: PUSHJ P,DLOOK ;LOOKUP FILE AGAIN
$DCALL RNM ;CAN'T, SO WE CAN'T RENAME IT
MOVE D,%RNAMD ;SWITCH TO DATA SPECIFIED IN CLOSE STMT
PUSHJ P,SETJFN ;SET UP JFNBLK WITH FILENAME
MOVE D,%OLDDB
MOVX T1,GJ%FOU ;NEXT HIGHER GENERATION NUMBER ON
HLLM T1,JFNBLK+.GJGEN
MOVEI T1,JFNBLK ;GET JFN ON DESTINATION FILE
SETZ T2, ;NO STRING
GTJFN%
ERJMP RELRNM ;[4155] CAN'T. GO RELEASE JFN, GIVE ERROR
MOVEI T2,(T1) ;COPY DESTINATION JFN
MOVE T1,IJFN(D) ;GET SOURCE JFN
RNAMF% ;RENAME THE FILE
ERJMP RELRNB ;[4155] CAN'T. GO RELEASE BOTH JFNS, GIVE ERROR
HRRZM T2,IJFN(D) ;Store new JFN in old DDB
HRRZM T2,OJFN(D) ; The JFN is CLOSE'd.
PUSHJ P,DOJFNS ;RETURN FILESPEC TO DDB
PUSHJ P,RELJFN ;RELEASE THE JFN
JRST %POPJ1 ;SKIP RETURN
;[4155] NEW CODE - RELEASE JFN(S), THEN ISSUE MESSAGE
RELRNB: MOVEI T1,(T2) ;GET NEW JFN BACK AGAIN
RLJFN% ;RELEASE IT
JSHALT ;CAN'T. FOROTS BUG
RELRNM: PUSHJ P,RELJFN ;NOW RELEASE OLD FILE JFN
$DCALL RNM ;GIVE ERROR MSG, LEAVE
;TOPS-20 routine to prepare for disk close.
; It un-maps any mapped pages and throws away the core.
DSKFRE: SKIPN WPTR(D) ;ANYTHING TO DO HERE?
POPJ P, ;NO
SKIPE WTAB(D) ;RANDOM FILE?
JRST DSKUMP ;YES. GO UNMAP IT
MOVE T1,FLAGS(D) ;GET DDB FLAGS
TXNE T1,D%OUT ;LAST I/O OUTPUT?
PUSHJ P,%OCLR ;YES. CLEAR UNUSED CHARS OF LAST WORD
DSKUMP: MOVE T2,WPTR(D) ;GET PAGE NUMBER OF 1ST PAGE
HRLI T2,.FHSLF ;PUT FORK HANDLE IN LH
LOAD T3,BUFCT(D) ;GET LENGTH OF WINDOW, PAGES
HRLI T3,(PM%CNT) ;THAT'S THE REPEAT COUNT
SETO T1, ;SET TO UNMAP
PMAP% ;UNMAP THE FILE PAGES
MOVE T1,WPTR(D)
LOAD T2,BUFCT(D) ;GET PAGE COUNT OF WINDOW
PUSHJ P,%FREPGS ;DEALLOCATE IT
SETZM WPTR(D) ;Note we threw it away
SETZM WADR(D) ;CLEAR LOCAL WINDOW ADDR
SKIPE T1,WTAB(D) ;FREE THE MAP TABLE, IF ANY
PUSHJ P,%FREBLK
SKIPE T1,PFTAB(D) ;AND THE PAGE FLAG TABLE, IF ANY
PUSHJ P,%FREBLK
MOVE T1,FLAGS(D) ;Get DDB flags
TXNN T1,D%MOD ;WAS FILE MODIFIED?
POPJ P, ;NO, DONE
LOAD T1,CC(U) ;GET CARRIAGECONTROL
CAIE T1,CC.FOR ;FORTRAN?
JRST NOTFRT ;NO. DON'T SET ATTRIBUTE
MOVE T1,IJFN(D) ;GET FILE JFN
HRLI T1,.FBCTL+<(CF%NUD)> ;SET TO CHANGE FLAG WORD
MOVEI T2,FB%FOR ;GET THE FORTRAN BIT FOR MASK
MOVEI T3,FB%FOR ;GET THE FORTRAN BIT FOR VALUE
CHFDB% ;CHANGE FDB
$EJCAL CSF ;OH, WELL, MONITOR NOT UPDATED
NOTFRT: MOVE T1,IJFN(D) ;GET FILE JFN
HRLI T1,.FBBYV+<(CF%NUD)> ;SET TO CHANGE BYTE SIZE
MOVX T2,FB%BSZ ;SET FILE BYTE SIZE
LOAD T3,BSIZ(D) ;GET BYTE SIZE WE USED
LSH T3,^D24 ;PUT IN POSITION
CHFDB% ;CHANGE FDB
JSHALT
MOVE T1,IJFN(D) ;GET FILE JFN
HRLI T1,.FBBYV+<(CF%NUD)> ;SET TO CHANGE DATA MODE
MOVX T2,FB%MOD ;SET DATA MODE
LOAD T3,DMODE(D) ;GET DATA MODE
MOVSI T3,(T3) ;IN POSITION
CHFDB% ;CHANGE FDB
JSHALT
MOVE T3,EOFN(D) ;GET FILE SIZE, BYTES
LOAD T1,BSIZ(D) ;GET BYTESIZE
CAIE T1,^D36 ;36 BITS?
JRST CLDFRM ;NO. USE EOFN AS IS
ADD T3,BPW(D) ;YES. ROUND UP
SUBI T3,1
IDIV T3,BPW(D) ;GET # WORDS
CLDFRM: MOVE T1,IJFN(D) ;GET FILE JFN
HRLI T1,.FBSIZ+<(CF%NUD)> ;SET FILE SIZE
SETO T2, ;WHOLE WORD
CHFDB% ;CHANGE FDB
MOVE T1,BPW(D) ;GET BYTES PER WORD
LSH T1,^D9 ;CONVERT TO BYTES PER PAGE
MOVE T2,EOFN(D) ;GET FILE SIZE IN BYTES AGAIN
ADDI T2,-1(T1) ;GET # PAGES IN FILE
IDIVI T2,(T1) ;IN T2
SUBI T2,1 ;CALC TOP PAGE #
MOVE T1,IJFN(D) ;GET JFN
HRLI T1,(T1) ;IN LEFT HALF
HRRI T1,1(T2) ;START AT TOP PAGE+1
UNMPLP: FFUFP% ;GET NEXT USED PAGE
POPJ P, ;DONE. NO MORE USED PAGES
PUSH P,T1 ;SAVE FOR NEXT CALL
MOVE T2,IJFN(D) ;GET JFN
HRLI T2,(T2) ;SETUP PMAP CALL
HRRI T2,(T1) ;PAGE # IN RH
SETZ T3, ;NO REPEAT COUNT
SETO T1, ;SETUP FOR UNMAP FUNCTION
PMAP%
JSHALT ;SHOULD NOT FAIL
POP P,T1 ;GET JFN,,PAGE BACK
JRST UNMPLP ;BACK FOR MORE
> ;IF20
IF10,<
;ROUTINE TO CLOSE THE FILE AND RELEASE THE CHANNEL
FICLOS: SKIPN T2,FBLK(D) ;IF FILE WAS NEVER OPENED
POPJ P, ;RETURN NOW
FICLS0: LOAD T1,DVTYP(D) ;[4246]GET THE DEVICE TYPE
CAIE T1,DT.DSK ;[4246]IS IT A DISK
JRST FICLS2 ;[4246]NO, JUST CLOSE DON'T RENAME
;[4246]YES IT IS!
MOVE T1,FLAGS(D) ;[4251]IS IT OPENED FOR OUTPUT?
TXNN T1,D%OUT ;[4251]
JRST FICLS2 ;[4251]NO, JUST CLOSE DON'T RENAME
FICLS1: XMOVEI T1,4 ;[4251]Set arg block length
MOVEM T1,RNMBLK ;[4251]
DMOVE T1,LKPB+.RBPPN(D);[4251]Get the ppn and file name
DMOVEM T1,RNMBLK+.RBPPN ;[4251]Store it into the Rename block
HLLZ T2,LKPB+.RBEXT(D);[4251]Get the extention
MOVEM T2,RNMBLK+.RBEXT ;[4251]Store it into the Rename block
SETZM RNMBLK+.RBPRV ;[4251]Clear out old junk
LDB T2,[POINT 9,LKPB+.RBPRV(D),8] ;[4251]Get protection
DPB T2,[POINT 9,RNMBLK+.RBPRV,8];[42511]Store it
LOAD T2,MODE(D) ;[4244]Get data_mode in rename block
MOVE T2,MODTAB(T2) ;[4244]Lookup TOPS-10 equivalence
DPB T2,[POINT 4,RNMBLK+.RBPRV,12];[4244]Store it
MOVEI T1,FBLK(D) ;[4244]Get Address of FILOP. block
MOVE T2,.FOFNC(T1) ;[4244]Get function word
HRRI T2,.FORNM ;[4244]Setup the function code
TXO T2,FO.UOC ;[4244]Specify file is open
MOVEM T2,.FOFNC(T1) ;[4244]and store it back again
HRLZI T2,RNMBLK ;[4251]get rename block address
HLLM T2,.FOLEB(T1) ;[4251]store into the lookup/enter block
PUSH P,.FOPAT(T1) ;[4251]Save for later.
SETZM .FOPAT(T1) ;[4251]Clear path-Don't return default.
HRLI T1,.FOMAX ;[4244]Set the argument count
FILOP. T1, ;[4244]and do the RENAME
JRST [MOVEI T1,FBLK(D) ;[4251]Get Address of FILOP. block
MOVE T2,.FOLEB(T1) ;[4251]Get the lookup/enter block
HRRZM T2,.FOLEB(T1) ;[4251]Convert it back to lookup block
POP P,.FOPAT(T1) ;[4251]Restore path pointer
JRST FICLS2] ;[4251]and try to close it
MOVE T2,.FOLEB(T1) ;[4251]Get the lookup/enter block
HRRZM T2,.FOLEB(T1) ;[4251]Convert it back to lookup block
POP P,.FOPAT(T1) ;[4251]Restore path pointer
JRST FICLS3 ;[4246]GO JOIN COMMON CODE
FICLS2: MOVE T2,FBLK(D) ;[4246]GET CHANNEL STUFF
HRRI T2,.FOCLS ;[4246]CLOSE THE FILE
MOVE T1,[1,,T2] ;[4246]WITH A FILOP
FILOP. T1, ;[4246]
$ACALL CLS ;[4246]FAILED. TYPE MSG AND DIE
; JRST FICLS3 ;[4246]GO JOIN COMMON CODE
FICLS3: MOVE T2,FBLK(D)
HRRI T2,.FOREL ; AND RELEASE THE FILE
MOVE T1,[1,,T2] ;WITH A FILOP
FILOP. T1,
$ACALL CLS ;FAILED. TYPE MSG AND DIE
SETZM FBLK(D) ;[4155] CLEAR EVIDENCE OF FILE BEING OPENED
MOVX T1,D%IN+D%OUT+D%WRT+D%MOD ;[4155] TURN OFF THE I/O BITS
ANDCAM T1,FLAGS(D) ;[4155]
POPJ P,
SEGMENT DATA
RNMBLK: BLOCK 5 ;[4251]Rename block
SEGMENT CODE
;"EXPUNGE" and "DELETE" are the same on TOPS-10
CLEXP:
CLDEL: ;[4211]
;[4211]
MOVE T1,[FO.PRV+FO.ASC+.FODLT] ;[4211] DELETE THE FILE
MOVEM T1,FBLK(D) ;[4211]
MOVEI T1,FBLK(D)
HRLI T1,.FOMAX
FILOP. T1,
JRST DFAIL ;[4211] FAILED. GO RELEASE CHANNEL
MOVEI T2,.FOREL ;Now release the channel
HLL T2,CHAN(D)
MOVE T1,[1,,T2]
FILOP. T1,
$ACALL CLS ;FAILED. TYPE MSG AND DIE
JRST %POPJ1 ;Ok, return
DFAIL: PUSH P,T1 ;[4211] SAVE ERROR CODE
PUSHJ P,RELJFN ;[4211] RELEASE CHANNEL
POP P,T1 ;[4211] RESTORE ERROR CODE
$DCALL DEL ;[4211] ISSUE ERROR MESSAGE AND RETURN
;TOPS-10 routine to RENAME after CLOSE.
;D/ U/ old DDB block.
;%RNAMD/ %RNAMU/ new DDB block
OTHREN: LOAD T1,DVTYP(D) ;GET DEVICE TYPE
CAIE T1,DT.DTA ;DECTAPE?
POPJ P, ;NO. FOR OTHER DEVICES RENAME IS NOP
DSKREN: MOVE T1,%RNAMD ;Point to new DDB
MOVEI T1,LKPB(T1) ;POINT TO LOOKUP BLOCK IN NEW DDB
HRLM T1,FBLK+.FOLEB(D) ;STORE IN OLD DDB
MOVEI T2,.RBMAX ;SET LENGTH OF RENAME BLOCK
MOVEM T2,.RBCNT(T1)
MOVE D,%RNAMD ;[2112] POINT TO NEW DDB
PUSHJ P,SETPPB ;[2112] RESET THE PATH BLOCK
MOVE D,%OLDDB ;GET OLD DDB AGAIN
MOVX T1,FO.ASC+FO.PRV+.FORNM ;SET TO RENAME FILE
MOVEM T1,FBLK(D)
MOVEI T1,FBLK(D) ;DO THE RENAME
HRLI T1,.FOMAX
FILOP. T1, ;** Do RENAME, closes file **
JRST RNFAIL ;[4155] FAILED
MOVE T1,%RNAMD ;T1 points to new DDB.
HRLI T2,LKPB(T1) ;Copy RENAME block
HRRI T2,LKPB(D) ; To LOOKUP block (so subsequent LOOKUP's
BLT T2,LKPB+.RBMAX-1(D) ;Find the file)!
HRLI T2,PTHB+.PTPPN(T1) ;Copy PATH. block From new DDB
HRRI T2,PTHB+.PTPPN(D) ;[4203] To old DDB
BLT T2,PTHB+.PTMAX-1(D) ; . .
PUSHJ P,SETPPB ;Reset path block
HRRZS FBLK+.FOLEB(D) ;CLEAR RENAME BLOCK POINTER
PUSHJ P,DOJFNS ;RETURN INFO TO DDB
PUSHJ P,RELJFN ;RELEASE CHANNEL
JRST %POPJ1 ;SKIP RETURN
RNFAIL: PUSH P,T1 ;[4174] SAVE THE ERROR CODE
PUSHJ P,RELJFN ;[4155] RELEASE CHANNEL
POP P,T1 ;[4174] RESTORE ERROR CODE
MOVE T2,%RNAMD ;[4212] GET RENAME DDB ADDRESS
MOVE T3,LKPB+.RBEXT(D) ;[4212] RESTORE OLD DATE BITS
HRRM T3,LKPB+.RBEXT(T2) ;[4212] RENAME FAILURE BLEW THEM AWAY
$DCALL RNM ;[4155] AND GIVE ERROR MSG
;STILL IF10
;TOPS-10 routine to prepare for CLOSE of disk file.
;If file is random, it writes out altered pages and throws away
; the core used by WTAB.
DSKFRE: SKIPN WPTR(D) ;ANYTHING TO DO HERE?
POPJ P, ;NO
SKIPN WTAB(D) ;RANDOM FILE?
JRST SEQCLS ;NO. OUTPUT LAST BUFFER
PUSHJ P,%RANWR ;WRITE ALTERED PAGES
MOVE T1,WPTR(D) ;GET PAGE POINTER
LOAD T2,BUFCT(D) ;GET LENGTH IN PAGES
PUSHJ P,%FREPGS
MOVE T1,WTAB(D) ;POINT TO TABLE
PUSHJ P,%FREBLK ;FREE IT
SKIPN T1,PFTAB(D) ;FREE PAGE FLAG TABLE
PUSHJ P,%FREBLK
SETZM WPTR(D) ;Note we threw it away
SETZM WADR(D) ;CLEAR BOOT PNTR
POPJ P,
SEQCLS: MOVE T1,FLAGS(D) ;GET DDB FLAGS
TXNN T1,D%OUT ;LAST I/O OUTPUT?
JRST SEQFRE ;NO. GO FREE UP MEMORY
PUSHJ P,%OCLR ;YES. CLEAR UNUSED CHARS IN LAST WORD
PUSHJ P,%OSDSK ;OUTPUT LAST BUFFER
SEQFRE: MOVE T1,WPTR(D) ;GET PAGE ADDRESS
LOAD T2,BUFCT(D) ;GET COUNT
PUSHJ P,%FREPGS ;FREE THE PAGES
SETZM WPTR(D) ;CLEAR THE MARKERS
SETZM WADR(D)
SETZM BUFADR(D)
POPJ P,
> ;END IF10
SUBTTL QUASAR INTERFACE
;ROUTINE TO SEND A QUEUE REQUEST OFF TO QUASAR
;ARGS: JFN, QUEUE NUMBER
;RETURN: PACKET SENT
IF10,<
CLSQ:
;See if GALAXY V4 is running.
MOVX T1,%SIOPR ;Look for ORION's PID
GETTAB T1, ; (only present if GALAXY R4)
JRST OLDGLX ;Gettab failed, assume R2
JUMPE T1,OLDGLX ;If 0 returned, R2.
;GALAXY V4 - try to do a QUEUE. UUO.
MOVEI P2,QBLK-1 ;POINT TO QUEUE. ARG BLOCK
MOVE T1,CLSDDB ;[4155] GET PROPER DDB FOR DISPOSE
LOAD T1,ODISP(T1) ;[4155] GET ORTHOGONAL DISPOSE VALUE
PUSH P2,QFNC(T1) ;[4155] PUSH FUNCTION CODE
MOVSI T1,(QF.RSP) ;REQUEST RESPONSE
IORM T1,(P2)
PUSH P2,[-1] ;NODE ID
PUSH P2,[LRESP,,%RESP] ;RESPONSE BLOCK LENGTH,,ADDRESS
MOVEI T1,FD-1 ;FILL IN FILE DESCRIPTOR
PUSH T1,PTHB(D) ;STRUCTURE NAME
PUSH T1,LKPB+.RBNAM(D) ;FILE NAME
PUSH T1,LKPB+.RBEXT(D) ;EXTENSION
HLLZS (T1)
PUSH T1,PTHB+.PTPPN(D) ;PPN
MOVEI T2,PTHB+.PTPPN+1(D)
Q1SFD: SKIPN (T2) ;SFDS, IF ANY
JRST Q1SFDE
PUSH T1,(T2)
AOJA T2,Q1SFD
Q1SFDE: SUBI T1,FD-1 ;GET FD LENGTH
PUSH P2,[.QBFIL] ;ARG IS AN FD
HRLM T1,(P2) ;SET LENGTH
PUSH P2,[FD] ;AND ADDRESS
MOVE T1,EXT(D) ;[2062] GET EXTENSION
CAME T1,[ASCIZ /DAT/] ;[2062] IS IT ".DAT"
JRST Q1NDAT ;[2062] NO
PUSH P2,[QA.IMM+.QBPTP] ;[2062] ARG IS FILE FORMAT
PUSH P2,[.QBPFR] ;[2062] SET /FILE:FORTRAN
Q1NDAT: MOVE T2,CLSDDB ;[4155] GET PROPER DDB FOR DISPOSE AND LIMIT
LOAD T1,LIMIT(T2) ;[4155] GET LIMIT VALUE FROM OPEN
JUMPN T1,QLIM ;GO SET IT
LOAD T1,ODISP(T2) ;[4155] GET ORTHOGONAL DISPOSE VALUE
CAIE T1,OD.PRI ;PRINT?
JRST NOCLIM ;NO. DON'T GIVE LIMIT VALUE
MOVE T1,EOFN(D) ;[3453] GET # BYTES IN FILE
JUMPE T1,NOCLIM ;[3453] IF NO SIZE, CAN'T SET LIMIT
IDIV T1,BPW(D) ;[3453] GET APPROX # WORDS
ADDI T1,177 ;ROUND UP TO BLOCKS
LSH T1,-7 ;CALC # BLOCKS
ADDI T1,10 ;USE # BLOCKS + 8
QLIM: PUSH P2,[QA.IMM+.QBLIM] ;SET LIMIT
PUSH P2,T1
NOCLIM: MOVE T1,CLSDDB ;[4155] GET PROPER DDB FOR STATUS VALUE
LOAD T1,OSTAT(T1) ;[4155] GET ORTHOGONAL STATUS VALUE
CAIE T1,OS.DEL ;DELETE OR EXPUNGE?
CAIN T1,OS.EXP
JRST QDEL ;YES. SET QUEUE ENTRY FOR DELETE
JRST Q1NLST ;NO
QDEL: PUSH P2,[QA.IMM+.QBODP] ;ARG IS DISPOSITION
PUSH P2,[1] ;DISP IS DELETE
Q1NLST: SUBI P2,QBLK-1 ;GET LENGTH OF QUEUE. ARG BLOCK
MOVEI T1,QBLK ;GET LENGTH,,ADDRESS
HRLI T1,(P2)
QUEUE. T1, ;DO IT
$ECALL CQF,%POPJ1 ;CAN'T. GIVE ERROR AND LEAVE
XMOVEI T1,%RESP ;GET ADDR OF RESPONSE MESSAGE
MOVEI T2,"[" ;INFO ONLY
MOVE T3,%RESP ;GET FIRST WORD OF RESPONSE
TLNE T3,774000 ;SEE IF ANY TEXT IS PRESENT
$ECALL QUE
JRST %POPJ1 ;Done
OLDGLX: $ECALL OGX ;GALAXY V2 NOT SUPPORTED
POPJ P,
QFNC: 0 ;NOTHING
EXP .QUPRT ;PRINT
EXP .QUPTP ;PUNCH
EXP .QUBAT ;SUBMIT
EXP .QUPLT ;PLOT
> ;END IF10
;MAKE PACKET
IF20,< ;GALAXY RELEASE 4 PACKET FORMAT
CLSQ: MOVEI T1,1 ;GET A PAGE TO SEND TO QUASAR
PUSHJ P,%GTPGS
POPJ P, ;CAN'T
MOVEI P1,(T1) ;COPY PAGE NUMBER
LSH P1,9 ;MAKE INTO ADDRESS
;Clear out the page (%GTPGS doesn't do it automatically).
SETZM (P1) ;Clear out the page
HRLZ T1,P1 ;Starting addr,,
HRRI T1,1(P1) ; .+1
BLT T1,777(P1) ;** Clear one page **
XMOVEI P2,-1(P1) ;COPY ADDRESS
;The format of a Release 4 packet is the standard GALAXY header
;(3 words), a flag word, a count word, and then argument-type/argument-data
;pairs.
PUSH P2,[.QOCQE] ;CREATE QUEUE ENTRY
PUSH P2,[MF.ACK] ;REQUEST ACK
PUSH P2,[0] ;SET UNIQUE ID TO 0 SINCE WE SEND
;ONE MESSAGE AT A TIME
PUSH P2,[0] ;FLAGS, 0
PUSH P2,[0] ;COUNT IS 0 FOR NOW
AOS .OARGC(P1) ;COUNT ARG
PUSH P2,[2,,.QCQUE] ;ARG IS QUEUE TYPE
MOVE T1,CLSDDB ;[4155] GET PROPER DDB FOR DISPOSE
LOAD T1,ODISP(T1) ;[4155] GET ORTHOGONAL DISPOSE VALUE
PUSH P2,QOT(T1) ;QUEUE TYPE DEPENDS ON DISPOSITION
MOVE T1,EXT(D) ;GET EXTENSION
CAME T1,[ASCIZ /DAT/] ;[2062] IS TYPE "DAT"
JRST QNDAT ;[2062] NO
AOS .OARGC(P1) ;[2062] COUNT ARG
PUSH P2,[2,,.QCPTP] ;[2062] ARG IS FILE FORMAT
PUSH P2,[.FPFFO] ;[2062] SET /FILE:FORTRAN
QNDAT: ;[2062]
AOS .OARGC(P1) ;COUNT ARG
PUSH P2,[.QCFIL] ;ARG IS FILE DESCRIPTOR (FD)
MOVEI T1,.FDFIL(P2) ;POINT TO FILE SPEC DESTINATION
HRLI T1,(POINT 7)
MOVEM T1,FNSPNT
PUSHJ P,GENFNS ;GET A FILE STRING
SETZ T2, ;FOLLOW WITH A NULL
IDPB T2,FNSPNT
MOVE T1,FNSPNT ;GET POINTER TO THE NULL
SUBI T1,-1(P2) ;GET LENGTH OF FD
HRLM T1,.FDLEN(P2) ;STORE IN LENGTH WORD
ADDI P2,-1(T1) ;BUMP POINTER PAST FD
MOVE T1,CLSDDB ;[4155] GET PROPER DDB FOR DISPOSE
LOAD T1,OSTAT(T1) ;[4155] GET ORTHOGONAL STATUS VALUE
CAIE T1,OS.DEL ;DELETE OR EXPUNGE?
CAIN T1,OS.EXP
JRST SETQD ;YES. SET QUEUE ENTRY FOR DELETE
JRST QNLST ;NO
SETQD: AOS .OARGC(P1) ;COUNT ARG
PUSH P2,[2,,.QCODP] ;ARG IS DISPOSITION
PUSH P2,[1] ;DISP IS DELETE
QNLST: MOVE T2,CLSDDB ;[4155] GET PROPER DDB FOR LIMIT VALUE
LOAD T1,LIMIT(T2) ;[4155] GET LIMIT FROM OPEN STATEMENT
JUMPN T1,SETLIM ;AND GO SET IT
LOAD T1,ODISP(T2) ;[4155] GET ORTHOGONAL DISPOSE VALUE
CAIE T1,OD.PRI ;PRINT?
JRST NOCLIM ;NO. DON'T CALCULATE LIMIT
MOVE T1,EOFN(D) ;GET FILE SIZE IN BYTES
JUMPE T1,NOCLIM ;CAN'T SET LIMIT IF WE DON'T KNOW SIZE
IDIV T1,BPW(D) ;GET APPROX # WORDS
ADDI T1,777 ;ROUND UP TO PAGES
LSH T1,-9 ;CALC # PAGES
IMULI T1,G.LPTM ;DO QUEUE MAGIC TO GET LIMIT
IDIVI T1,G.LPTD
SETLIM: AOS .OARGC(P1) ;COUNT ARG
PUSH P2,[2,,.QCLIM] ;SET OUTPUT LIMIT
PUSH P2,T1
NOCLIM: SUBI P2,-1(P1) ;GET LENGTH OF MESSAGE
HRLM P2,(P1) ;STORE IN HEADER
PUSHJ P,QSND ;SEND PACKET TO QUASAR
JRST %POPJ1 ;Failed, but just return "successfully"
PUSHJ P,QACK ;WAIT FOR ACK AND TYPE RESPONSE
MOVEI T1,(P1) ;GET ADDRESS OF PAGE WE ALLOCATED
LSH T1,-9 ;MAKE PAGE NUMBER
MOVEI T2,1 ;SET LENGTH, 1 PAGE
PUSHJ P,%FREPGS ;Free page
JRST %POPJ1 ; and return
QOT: 0 ;NOTHING
EXP .OTLPT ;PRINT
EXP .OTPTP ;PUNCH
EXP .OTBAT ;SUBMIT
EXP .OTPLT ;PLOT
;ROUTINE TO SEND PAGE TO QUASAR
;ARGS: P1 = ADDRESS (ON PAGE BOUNDARY) OF MESSAGE
;SKIP RETURN IF SUCCESSFUL
;WHETHER SUCCESSFUL OR NOT, MESSAGE IS GONE ON RETURN
QSND: SKIPE T1,QSRPID ;GET QUASAR'S PID, IF WE KNOW IT ALREADY
JRST GOTQSR ;GOT IT, SKIP
MOVEI T1,3 ;SET LENGTH, ADDRESS OF BLOCK
MOVEI T2,IPCBLK
MOVEI T3,.MURSP ;READ SYSTEM PID
MOVEM T3,(T2)
MOVEI T3,.SPQSR ;OF <SYSTEM>QUASAR
MOVEM T3,1(T2)
MUTIL%
JSHALT
MOVE T1,IPCBLK+2 ;GET PID
MOVEM T1,QSRPID
GOTQSR: MOVEM T1,IPCBLK+.IPCFR ;SET RECIEVER PID
MOVE T1,I.PID ;GET MY PID
MOVEM T1,IPCBLK+.IPCFS ;SET SENDER PID
MOVEI T1,(P1)
LSH T1,-9
HRLI T1,1000 ;SET LENGTH,,ADDRESS OF PACKET
MOVEM T1,IPCBLK+.IPCFP
QTRY: MOVX T1,IP%CFV ;PAGE MODE
SKIPN IPCBLK+.IPCFS ;IF WE DON'T HAVE A PID,
TXO T1,IP%CPD ; CREATE ONE
MOVEM T1,IPCBLK+.IPCFL
MOVEI T1,4 ;SEND PAGE TO QUASAR
MOVEI T2,IPCBLK
MSEND%
ERJMP QSNDF ;FAILED, SEE WHY
SKIPE T1,IPCBLK+.IPCFS ;GET RETURNED PID
MOVEM T1,I.PID ;SAVE IT
JRST %POPJ1
QSNDF: CAIL T1,IPCFX6 ;CHECK ERROR CODE
CAILE T1,IPCFX8
$ECALL IJE
SKIPE T1,IPCBLK+.IPCFS ;GET RETURNED PID
MOVEM T1,I.PID ;SAVE IT
MOVEI T1,^D3000 ;WAIT 3 SECONDS
DISMS%
JRST QTRY ;TRY AGAIN
;ROUTINE TO WAIT FOR ACK FROM QUASAR AND TYPE RESPONSE
;IF QUASAR SENDS BACK AN ERROR, BUILD A FOROTS ERROR MESSAGE
;AND ENTER DIALOG MODE (??)
QACK: XMOVEI T1,IPCBLK-1
PUSH T1,[0] ;CLEAR FLAGS
PUSH T1,[0] ;CLEAR SENDER
PUSH T1,I.PID ;RECIEVE MESSAGE TO ME ONLY
MOVEI T2,(P1) ;POINT TO PAGE WE USED FOR SENDING
HRLI T2,1000 ;LENGTH IS 1000
PUSH T1,T2
RCVAGN: MOVEI T1,4 ;GET RESPONSE FROM QUASAR
MOVEI T2,IPCBLK
MRECV%
JSHALT
MOVE T1,IPCBLK+.IPCFS ;GET SENDER
CAME T1,QSRPID ;QUASAR?
JRST RCVAGN ;NO, DISCARD JUNK
HRRZ P1,IPCBLK+.IPCFP ;POINT TO MESSAGE
MOVE P2,.MSFLG(P1) ;GET MESSAGE FLAGS
TXNE P2,MF.NOM ;ACK TEXT PRESENT?
JRST NOMSG ;NO, DON'T TYPE ANYTHING
XMOVEI T1,.OHDRS+ARG.DA(P1) ;GET ADDR OF ACTUAL MESSAGE
MOVEI T2,"[" ;ASSUME INFO MESSAGE
TXNE P2,MF.FAT+MF.WRN ;ERROR?
MOVEI T2,"%" ;YES, CHANGE PREFIX CHAR
$ECALL QUE ;OUTPUT MESSAGE
NOMSG: TXNE P2,MF.MOR ;MORE COMING?
JRST RCVAGN ;YES, GO GET IT
POPJ P, ;NO, RETURN
> ;IF20
SEGMENT DATA
LRESP==20 ;LENGTH OF RESPONSE BLOCK
%RESP:: BLOCK LRESP ;RESPONSE BLOCK
QSRPID: BLOCK 1 ;QUASAR PID
IPCBLK: BLOCK 4 ;CONTROL BLOCK FOR IPCF FUNCTIONS
UNIPNT: BLOCK 1 ;UNIT POINTER/COUNT
EXITP: BLOCK 1 ;SAVED EXIT STACK POINTER
QBLK: BLOCK 17 ;QUEUE. BLOCK, LENGTH 3 + 2 MAX-POSSIBLE-ARGS
FD: BLOCK 10 ;FILE DESCRIPTOR
SEGMENT CODE
;ROUTINE TO CLOSE ALL FILES
FENTRY (EXIT1)
SETZM %UDBAD ;NO I/O IN PROGRESS
PUSHJ P,%SAVAC ;SAVE USER'S ACS
%EXIT1: SETZ F, ;CLEAR FLAG AC
XMOVEI T1,[ASCIZ /CLOSE/] ;FOR ERROR MESSAGES, WE'RE A CLOSE STMT
MOVEM T1,%IONAM
SETZM A.ERR ;[5004] NO ERR= ON EXIT
MOVE T1,[MINUNIT-MAXUNIT-1,,MINUNIT] ;LOOP THROUGH ALL UNITS
EX1L: MOVEM T1,UNIPNT ;SAVE IT
MOVE U,%DDBTAB(T1) ;GET A Unit block ADDRESS
JUMPE U,EX1E ;NONE, SKIP
MOVE D,DDBAD(U) ;Get DDB address
HXRE T1,UNUM(U) ;GET UNIT NUMBER
MOVEM T1,%CUNIT ;SAVE FOR ERROR MSGS
MOVEM P,EXITP ;SAVE STACK POINTER
PUSHJ P,%CLOSX ;Close the DDB
%EX1N: MOVE P,EXITP ;GET STACK POINTER AGAIN
EX1E: MOVE T1,UNIPNT ;GET UNIT POINTER/COUNT AGAIN
AOBJN T1,EX1L ;DO THEM ALL
IF20,<
SKIPE D.BSTP ;[3360] Skip if no DBMS loaded with FORLIB.
PUSHJ P,@D.BSTP ;[3360] If DBMS around, leave databases in
> ;END IF20
POPJ P, ;DONE
SUBTTL INQUIRE BY UNIT
COMMENT \
INQUIRE by unit is extremely straightforward - the code
merely looks at %DDBTA indexed by the unit provided to find
out if a DDB exists. If it doesn't, there is no connection.
If it does, the code must determine whether an OPEN
statement has been performed (D%OPEN set in the flag word)
or any I/O has been done (D%IN or D%OUT set in flag word).
If not, there is no connection yet (a REWIND or other MTOP
has been performed, but no file connection has been made).
If so, the file attributes are all lying around in the DDB
and they are merely returned in all the proper places (the
Page 2
V7 OPEN code establishes ALL attributes at the time of the
OPEN statement necessary for INQUIRE). If the INQUIRE is
issued between the time when an OPEN with STATUS='UNKNOWN'
is executed and the first data transfer statement, the data
returned will merely be all the data that we have so far
about the file (no generation number if wild-card
specified). If the STATUS is explicit or I/O has been done,
then the information returned will be more complete. Since
the file is open, INQUIRE will return the full, expanded
filespec. The only ambiguity in INQUIRE by unit is the
return value of EXISTS. The Standard says to return 'YES'
if the unit (!) exists. In our implementation, units ALWAYS
exist, and we will return 'YES'. (Unit existence is
different than file existence).
\
FENTRY (INQU)
PUSHJ P,%SAVAC ;SAVE USER'S ACS, COPY ARG LIST
PUSHJ P,%CPARG
XMOVEI T1,[ASCIZ /INQUIRE/] ;SETUP FOR ERROR MSGS
MOVEM T1,%IONAM
PUSHJ P,CLCVAR ;CLEAR COMMON OPEN/CLOSE VARIABLES
PUSHJ P,OICCPY ;COPY ARGS TO KEYWORD BLOCK
PUSHJ P,UNRNGE ;CHECK UNIT IN RANGE
SETZM INQPNT ;CLEAR RETURN FILENAME PNTR
HLRE T1,-1(L) ;GET ARG COUNT
MOVEM T1,ARGCNT ;SAVE IT
SETOM XSTFLG ;UNITS ALWAYS EXIST!
MOVE T1,%CUNIT ;GET UNIT NUMBER
SKIPN U,%DDBTA(T1) ;GET UDB ADDR
JRST INQCRE ;NONE. GO PROCESS OTHER ARGS
MOVE D,DDBAD(U) ;GOT ONE. GET DDB ADDR
MOVE T1,[POINT 7,%TXTBF] ;POINT TO A BUFFER
MOVEM T1,INQPNT ;SET UP INQUIRE POINTER
PUSHJ P,%GTFNS ;GET FILE STRING
PUSHJ P,INQARG ;CHECK AND STORE ARGUMENTS
PJRST %SETAV ;GO SET IOSTAT, ETC.
INQCRE: MOVEI T1,ULEN ;CREATE UDB
PUSHJ P,%GTBLK
$ACALL MFU ;CAN'T
MOVEM T1,INQUDB ;SAVE UDB ADDR FOR DEALLOCATION
MOVE U,T1 ;GET ITS ADDR
MOVEI T1,DLEN ;CREATE DDB
PUSHJ P,%GTBLK
$ACALL MFU ;CAN'T
MOVE D,T1 ;GET ITS ADDR
MOVEM D,DDBAD(U) ;SAVE DDB ADDR IN UDB
MOVE T1,%CUNIT ;GET UNIT NUMBER
STORE T1,UNUM(U) ;SAVE IN UDB
PUSHJ P,DFFILE ;GET FILENAME
PUSHJ P,DFDEV ;GET DEFAULT DEVICE
PUSHJ P,DFDEV1 ;GET DEVICE INFO
JRST %ABORT ;BAD DEVICE
MOVE T1,[POINT 7,%TXTBF] ;POINT TO A BUFFER
MOVEM T1,INQPNT ;SET UP INQUIRE POINTER
PUSHJ P,%GTFNS ;GET FILE STRING
PUSHJ P,INQARG ;PROCESS INQUIRE ARGS
PJRST INQXIT ;TOSS UDB, DDB
SUBTTL INQUIRE BY FILE
COMMENT \
INQUIRE by file is quite a bit more complex:
1. The functionality of FORTRAN OPEN is changed so that
disk files OPEN for write are established (via UFPGS%
so that the file system can see them.
2. If no device is given in the FILE= , use a default of
DSK:. Do NOT default anything else!
3. Determine if the device specified is a disk. If it is:
a. Find out if a file exists given the INQUIRE
filespec.
b. Look at all the open FORTRAN logical units in
ascending order, starting with zero. If an OPEN
statement has been executed and STATUS='UNKNOWN' (so
file is not yet actually opened), compare the
parse-only file string associated with that DDB with
the parse-only file string associated with the INQUIRE
statement. If a file exists on disk which matches the
(expanded) INQUIRE filespec, and the file associated
with the DDB has actually been opened, compare the full
file string associated with the file with the full
(expanded) file string associated with the INQUIRE
statement. If either of these two comparisons are
successful, return using the current unit number.
4. If the INQUIRE is for a non-disk device and is not
device TTY:, do the same as step 3b (above), but only
compare the device names.
5. If the INQUIRE is for device TTY:, only check to see if
the device in the DDB is the user's TTY:.
\
FENTRY (INQF)
PUSHJ P,%SAVAC ;SAVE USER'S ACS, COPY ARG LIST
PUSHJ P,%CPARG
XMOVEI T1,[ASCIZ /INQUIRE/] ;SETUP FOR ERROR MSGS
MOVEM T1,%IONAM
PUSHJ P,CLCVAR ;CLEAR COMMON OPEN/CLOSE VARIABLES
PUSHJ P,OICCPY ;COPY ARGS TO KEYWORD BLOCK
HRREI T1,INQUNT ;MAKE IT SO NO UNIT NUMBER COMES OUT
MOVEM T1,%CUNIT
SETZM INQPNT ;CLEAR RETURN FILENAME POINTER
SETZM XSTFLG ;FILE DOESN'T EXIST YET
SETZM UNKXST ;[5001] CLEAR "EXIST=AMBIGUOUS" FLAG
HLRE T1,-1(L) ;GET ARG COUNT
MOVEM T1,ARGCNT ;SAVE IT
PUSHJ P,INQFIL ;EAT FILESPEC, SEARCH DDBS
PUSHJ P,INQARG ;PROCESS INQUIRE ARGS
INQXIT: MOVE T1,INQUDB ;GET UDB USED FOR INQUIRE
MOVE T1,DDBAD(T1) ;GET DDB
PUSHJ P,%FREBL ;FREE DDB
MOVE T1,INQUDB ;GET UDB ADDR
PUSHJ P,%FREBL ;FREE IT
PJRST %SETAV ;GO SET IOSTAT, ETC.
INQFIL: MOVEI T1,ULEN ;SETUP A UDB
PUSHJ P,%GTBLK
$ACALL MFU ;CAN'T
MOVE U,T1 ;PUT IT IN U
MOVEI T1,DLEN ;SETUP A DDB
PUSHJ P,%GTBLK
$ACALL MFU ;CAN'T
MOVE D,T1 ;PUT ADDR IN D
MOVEM D,DDBAD(U) ;AND IN U
MOVEM U,INQUDB ;SAVE INQUIRE UDB ADDRESS
MOVEM U,%UDBAD ;SAVE FOR MSGS
MOVE T1,DSKDEF ;SET DEFAULT DEVICE TO "DSK"
MOVEM T1,DEV(D)
MOVE T1,DATEXT ;SET DEFAULT EXTENSION TO "DAT"
MOVEM T1,EXT(D)
SKIPE O.DFLT ;[5001] DEFAULTFILE= seen?
PUSHJ P,DFINQ ;[5001] Yes, process it first
PUSHJ P,FILINQ ;PARSE THE FILESPEC
INQFLP: PUSHJ P,INQDLG ;CHECK FOR ERRORS, USE DIALOG
PUSHJ P,DFDEV1 ;GET DEVICE INDEX
JRST INQFLP ;NO GOOD DEVICE
MOVE T1,[POINT 7,%TXTBF] ;POINT TO BUFFER FOR STRING
PUSHJ P,%GTFNS ;GET FULL FILESPEC STRING
;NOW TAKE THE RESULTANT PARSE-ONLY FILESPEC AND DO A LOOKUP
;TO SEE IF THE FILE EXISTS ON THE DISK.
PUSHJ P,LOOKF ;LOOKUP FILE
JRST INQNO ;FILE NOT FOUND
SETOM XSTFLG ;YES. FLAG FILE EXISTENT
MOVE T1,[POINT 7,TXTBF1] ;POINT TO EXPANDED INQUIRE FILESPEC BUFFER
PUSHJ P,%GTFNS ;GET FULL EXPANDED FILESPEC
PUSHJ P,RELJFN ;RELEASE THE JFN. WE HAVE A FULL STRING
;NOW WE HAVE THE INQUIRE FILE= STRING IN %TXTBF AND THE
;FULL, EXPANDED FILESPEC (IF LOOKUP WAS SUCCESSFUL)
;IN TXTBF1.. IT'S TIME TO
;SCAN ALL THE DDBs FOR AN IDENTICAL STRING. FOR EACH DDB,
;FOR THOSE FILES WHICH ARE
;NOT YET OPEN, BUT WHICH HAVE D%OPEN SET (AN OPEN STATEMENT
;HAS BEEN DONE), CALL %GTFNS TO SET UP THE JFN BLOCK, DO
;AN UNEXPANDED FILE PARSE, AND PUT THE FILESPEC
;INTO TXTBF2 AND RELEASE THE JFN. COMPARE THE STRINGS IN
;%TXTBF AND TXTBF2. FOR THOSE FILES WHICH
;ARE ACTUALLY OPEN, CALL %GTFNS TO GET AN EXPANDED FILESTRING.
;DO A CMPSTR BETWEEN TXTBF1
;AND TXTBF2. RECORD THE LOWEST UNIT NUMBER FOR MATCH (POSITIVE
;UNITS ONLY!), IF ANY.
INQNO: MOVSI T1,-MAXUNIT ;[4134] GET NEGATIVE COUNT OF UNITS
INQL1: MOVEM T1,UNIPNT ;[4134] SAVE IT
SKIPN U,%DDBTA(T1) ;ANY FILE?
JRST INQE1 ;NO
MOVE D,DDBAD(U) ;GET DDB ADDR
MOVE T1,[POINT 7,TXTBF2] ;POINT TO DDB FILE BUFFER
PUSHJ P,%GTFNS ;GET FULL FILE STRING
MOVE T1,[POINT 7,TXTBF1] ;POINT TO EXPANDED INQUIRE FILESPEC
SKIPN XSTFLG ;DOES THE FILE EXIST ON DISK?
MOVE T1,[POINT 7,%TXTBF] ;NO. POINT TO PARSE-ONLY INQUIRE FILESPEC
INQCMP: MOVEI T3,LTEXTC ;GET LENGTH OF TEXT BLOCKS
MOVEI T0,(T3)
MOVE T4,[POINT 7,TXTBF2]
EXTEND T0,[EXP <CMPSE>,0,0] ;COMPARE THE FILESPECS
JRST INQE1 ;THEY DON'T MATCH
SKIPN UNKXST ;[5001] EXISTENCE UNAMBIGUOUS?
SETOM XSTFLG ;[5001] NO. FLAG FILE EXISTENT
MOVE T1,[POINT 7,TXTBF2] ;POINT TO DDB FILESPEC
MOVEM T1,INQPNT ;FOR RETURNING FILESPEC
POPJ P, ;WE'RE DONE!
INQE1: MOVE T1,UNIPNT ;[4134] GET RELATIVE UNIT TABLE POINTER AGAIN
AOBJN T1,INQL1 ;[4134] LOOP
MOVE U,INQUDB ;NO MATCH. POINT TO INQUIRE DDB
MOVE D,DDBAD(U)
MOVE T1,[POINT 7,TXTBF1] ;POINT TO EXPANDED FILESPEC, IF ANY
SKIPN XSTFLG ;DOES FILE EXIST?
MOVE T1,[POINT 7,%TXTBF] ;NO. POINT TO UNEXPANDED SPEC
MOVEM T1,INQPNT
POPJ P,
%ERFNS: PUSHJ P,FNSCLR ;SETUP POINTER, CLEAR BUFFER
SKIPE DVICE(D) ;[4134] IF DEVICE NOT FOUND YET
SKIPN IJFN(D) ;OR IF NO JFN YET
JRST FNOJFN ;USE INFO IN DDB
LOAD T1,INDX(D) ;GET DEVICE INDEX
PJRST ERFTAB(T1) ;GET APPROPRIATE STRING
ERFTAB: JRST GETTY ;TTY - NAME ONLY
JRST ERGEN ;DSK - INCLUDE FILENAME
JRST GTNAM ;MTA - DEVICE ONLY
JRST GTNAM ;OTHER - DEVICE ONLY
IF20,< JRST %RMEFN ;[5002] REMOTE STREAM FILE
JRST %RMEFN ;[5002] RMS FILE
> ;End IF20
%GTFNS: PUSHJ P,FNSCLR ;SETUP POINTER, CLEAR BUFFER
LOAD T1,INDX(D) ;GET DEVICE INDEX
PJRST GFTAB(T1) ;GET APPROPRIATE STRING
GFTAB: JRST GETTY ;TTY - NAME ONLY
JRST GENFNS ;DSK - INCLUDE FILENAME
JRST GTNAM ;MTA - DEVICE ONLY
JRST GTNAM ;OTHER - DEVICE ONLY
IF20,< JRST %RMGXF ;[5000] REMOTE STREAM FILE
JRST %RMGXF ;[5000] RMS FILE
> ;End IF20
FNSCLR: MOVEM T1,FNSPNT ;SAVE POINTER
MOVEI T1,(T1) ;GET LOCAL ADDR
SETZM (T1) ;CLEAR BUFFER
HRLZI T2,(T1) ;GET BEG ADDR
HRRI T2,1(T1) ;GET BEG ADDR+1
BLT T2,LTEXTW-1(T1)
POPJ P,
LOOKF: LOAD T1,INDX(D) ;GET DEVICE INDEX
PJRST LOOKTB(T1) ;GO DO FILE LOOKUP BY DEVICE TYPE
LOOKTB: JRST TTLOOK ;TTY
JRST DLOOK ;DSK
JRST NDLOOK ;MTA
JRST NDLOOK ;OTHER
IF20,< JRST %RMLKP ;[5000] REMOTE STREAM FILE
JRST %RMLKP ;[5000] RMS FILE
> ;End IF20
TTLOOK: MOVE T1,DVICE(D) ;GET ACTUAL DEVICE
CAME T1,[.CTTRM] ;CONTROLLING TERMINAL?
JRST NDLOOK ;NO
AOS (P) ;YES. JUST RETURN SUCCESS, DON'T OPEN IT
POPJ P,
GETTY: MOVE T1,DVICE(D) ;GET ACTUAL DEVICE
CAME T1,[.CTTRM] ;CONTROLLING TERMINAL?
JRST GTNAM ;NO. GO GET A DEVICE NAME
MOVE T1,[POINT 7,[ASCIZ /TTY:/]] ;MAKE IT "TTY"
MOVEI T2,5 ;IT HAS 4 CHARS IN IT PLUS A NULL
GTTYLP: ILDB T3,T1 ;GET A CHAR
IDPB T3,FNSPNT ;DEPOSIT IN BUFFER
SOJG T2,GTTYLP ;DO IT 4 TIMES
POPJ P,
INQDIR: SKIPN INQPNT ;ANY NAME RETURNED?
JRST RETUNK ;NO. RETURN "UNKNOWN"
LOAD T2,INDX(D) ;GET DEVICE INDEX
CAIE T2,DI.RMS ;[5001] IF RMS,
CAIN T2,DI.RSF ;[5001] OR RSF,
MOVEI T2,DI.DSK ;[5001] TREAT LIKE DISK
DMOVE T0,[EXP 2,<POINT 7,[ASCII /NO/]>] ;MAKE IT 'NO'
CAIN T2,DI.DSK ;DISK FILE?
RETYES: DMOVE T0,[EXP 3,<POINT 7,[ASCII /YES/]>] ;MAKE IT 'YES'
JRST RETSTR ;GO RETURN STRING
RETNUL: SETZB T0,T1 ;NO SOURCE PNTR
JRST RETSTR ;FILL WITH SPACES
RETVS: HRLI T1,(POINT 7) ;MAKE T1 AN ASCII POINTER
MOVE T2,T1 ;COPY IT
SETZ T0, ;CLEAR THE COUNT
RVSLP: ILDB T3,T2 ;GET A CHAR
CAIE T3,0 ;IF NON-ZERO
AOJA T0,RVSLP ;INCREMENT THE COUNT
JUMPN T0,RETSTR ;IF NO CHARS, RETURN UNKNOWN
RETUNK: DMOVE T0,[EXP 7,<POINT 7,[ASCIZ /UNKNOWN/]>] ;RETURN 'UNKNOWN'
RETSTR: DMOVE T3,@(L) ;GET PNTR/COUNT
EXCH T3,T4 ;MAKE IT COUNT/PNTR
EXTEND T0,[EXP <MOVSLJ>," "] ;TRANSFER THE ANSWER
NOP
POPJ P,
;INQSEQ, INQUNF, AND INQFMT - RETURN 'YES',
;SINCE WE CAN ALWAYS ACCESS ALL FILES SEQUENTIALLY, AND
;EITHER UNFORMATTED OR FORMATTED
INQUNF:
INQSEQ:
INQFMT: DMOVE T3,@(L) ;YES. GET POINTER/COUNT
EXCH T3,T4 ;MAKE IT COUNT/POINTER
JRST RETYES ;RETURN "YES"
;INQACC - RETURN EITHER 'SEQUENTIAL', 'DIRECT' OR 'KEYED' IF THERE IS
;A CONNECTION; DON'T TOUCH THE VARIABLE IF NO CONNECTION
INQACC: PUSHJ P,CHKOPN ;CHECK IF CONNECTION
JRST RETUNK ;RETURN "UNKNOWN"
DMOVE T0,[EXP ^D10,<POINT 7,[ASCII /SEQUENTIAL/]>]
SKIPE WTAB(D) ;RANDOM FILE?
DMOVE T0,[EXP 6,<POINT 7,[ASCII /DIRECT/]>] ;YES
IF20,< LOAD T2,ORGAN(D) ;[5001] GET ORGANIZATION
CAIN T2,OR.IDX ;[5001] INDEXED?
DMOVE T0,[EXP ^D5,<POINT 7,[ASCII /KEYED/]>] ;[5001] YES
> ;End IF20
JRST RETSTR ;RETURN IT
;INQRTP - RETURN RECORDTYPE IF THERE IS A CONNECTION;
;OTHERWISE RETURN 'UNKNOWN'
INQRTP: PUSHJ P,CHKOPN ;CHECK IF CONNECTION
JRST RETUNK ;NOT. RETURN UNKNOWN
MOVE T1,RECTP(D) ;GET RECORDTYPE
MOVEI T2,SWRECT ;GET SWITCH TABLE ADDRESS
PUSHJ P,FNDSWT ;GET ADDRESS OF STRING
JRST RETVS ;GET COUNT, RETURN STRING
;INQRSZ - RETURN RECORDSIZE IF THERE IS A CONNECTION;
;OTHERWISE RETURN ZERO
INQRSZ:
IF20,<
LOAD T1,INDX(D) ;[5001] GET FILE TYPE
CAIN T1,DI.RMS ;[5001] RMS?
JRST IRSZRM ;[5001] YES
> ;End IF20
MOVE T1,RSIZE(D) ;[5001] GET RECORDSIZE
MOVEM T1,@(L) ;RETURN IT
POPJ P,
IF20,<
IRSZRM: SETZ T1, ;[5001] ASSUME FILE NOT OPEN
PUSHJ P,CHKOPN ;[5001] FILE OPEN?
JRST RETRSZ ;[5001] NO. RETURN ZERO
LOAD T1,MRSIZE(D) ;[5001] YES. GET MRS VALUE
LOAD T2,FORM(D) ;[5001] GET FORM
CAIN T2,FM.FORM ;[5001] FORMATTED?
JRST RETRSZ ;[5001] YES, RETURN IN BYTES
ADD T1,BPW(D) ;[5001] NO, ROUND UP TO WORDS
SUBI T1,1 ;[5001]
IDIV T1,BPW(D) ;[5001]
RETRSZ: MOVEM T1,@(L) ;[5001] RETURN IT
POPJ P, ;[5001]
> ;End IF20
INQCC: PUSHJ P,CHKOPN ;CHECK IF OPEN
JRST RETUNK ;NOT. RETURN 'UNKNOWN'
LOAD T1,CC(U) ;GET CARRIAGECONTROL
MOVEI T2,SWCC ;GET ADDRESS OF CC SWITCH TABLE
PUSHJ P,FNDSWT ;GET STRING ADDRESS
JRST RETVS ;GO COMPUTE STRING LENGTH, RETURN STRING
INQBLK: PUSHJ P,CHKOPN ;CHECK IF OPEN
JRST RETUNK ;NOT. RETURN 'UNKNOWN'
DMOVE T0,[EXP 4,<POINT 7,[ASCII /NULL/]>] ;ASSUME NULL
LOAD T2,BLNK(U) ;GET BLANK=
CAIN T2,BL.ZERO ;BLANK='ZERO'?
DMOVE T0,[EXP 4,<POINT 7,[ASCII /ZERO/]>] ;YES
JRST RETSTR ;RETURN IT
INQFRM: PUSHJ P,CHKOPN ;CHECK IF OPEN
JRST RETUNK ;RETURN "UNKNOWN"
DMOVE T0,[EXP ^D9,<POINT 7,[ASCII /FORMATTED/]>]
LOAD T2,FORM(D) ;GET FORM=
CAIN T2,FM.UNF ;UNFORMATTED?
DMOVE T0,[EXP ^D11,<POINT 7,[ASCII /UNFORMATTED/]>]
JRST RETSTR ;RETURN IT
INQNMD: SETZM @(L) ;SET FALSE
PUSHJ P,CHKOPN ;FILE OPEN?
POPJ P, ;NO. RETURN FALSE
LOAD T1,STAT(D) ;GET STATUS
CAIE T1,ST.SCR ;SCRATCH?
SETOM @(L) ;NO. SET TRUE
POPJ P,
;INQNRC - RETURN NEXT RECORD NUMBER. IF FILE IS NOT OPEN, CREC(D)
;WILL BE ZERO, SO WE WILL RETURN 1.
INQNRC: MOVE T1,CREC(D) ;GET CURRENT RECORD NUMBER
ADDI T1,1 ;GET NEXT RECORD NUMBER
MOVEM T1,@(L) ;RETURN IT
POPJ P,
;INQNBR - RETURN UNIT NUMBER ASSOCIATED WITH THIS FILE
INQNBR: PUSHJ P,CHKOPN ;FILE OPEN?
POPJ P, ;NO. DON'T TOUCH VARIABLE
LOAD T1,UNUM(U) ;RETURN UNIT NUMBER
MOVEM T1,@(L)
POPJ P,
;INQOPN - RETURN TRUE IF FILE IS OPEN, FALSE IF NOT
INQOPN: PUSHJ P,CHKOPN ;IS FILE OPEN?
JRST OPNFAL ;NO
SETOM @(L) ;YES. RETURN TRUE
POPJ P,
OPNFAL: SETZM @(L) ;NO. RETURN FALSE
POPJ P,
;EXIST= IF OPEN BY UNIT, RETURN TRUE. IF OPEN BY FILE,
;RETURN TRUE IF INQUIRE WAS SUCCESSFUL
INQXST: SETOM @(L) ;INITIALLY SET TRUE
SKIPN XSTFLG ;SUCCESSFUL?
SETZM @(L) ;NO. RETURN FALSE
POPJ P,
INQNAM: LOAD T1,STAT(D) ;GET STATUS
CAIN T1,ST.SCR ;SCRATCH?
JRST RETNUL ;YES. RETURN SPACES
SKIPN T1,INQPNT ;DID INQUIRE FIND AN OPEN OR EXISTENT FILE?
JRST RETNUL ;NO. RETURN SPACES
SETZ T0, ;CLEAR CHAR COUNT
INQRLP: ILDB T3,T1 ;GET A CHAR
JUMPE T3,INQR ;DONE. CHAR COUNT IN T0
AOJA T0,INQRLP
INQR: MOVE T1,INQPNT ;SETUP PNTR YET AGAIN
DMOVE T3,@(L) ;GET DEST
EXCH T3,T4 ;GET COUNT/PNTR
EXTEND [EXP <MOVSLJ>," "] ;MOVE IT
NOP
POPJ P,
;[5001] New
;KEYED=. CHECK IF THE FILE IS OPENED FOR KEYED ACCESS (I.E. ORGANIZATION=
;INDEXED). IF YES, RETURN 'YES'; IF NO CONNECTION, RETURN 'UNKNOWN'; IF
;CONNECTED BUT NOT INDEXED, RETURN 'NO'.
IF20,<
INQKEY: PUSHJ P,CHKOPN ;[5001] FILE OPEN?
JRST RETUNK ;[5001] NO, RETURN 'UNKNOWN'
LOAD T2,ORGAN(D) ;[5001] GET ORGANIZATION
CAIN T2,OR.IDX ;[5001] INDEXED?
JRST RETYES ;[5001] YES, RETURN 'YES'
DMOVE T0,[EXP 2,<POINT 7,[ASCII /NO/]>] ;[5001] NO
JRST RETSTR ;[5001] RETURN STRING
;[5001] New
;ORGANIZATION=. RETURN THE ORGANIZATION OF THE FILE. IF NO ORGANIZATION
;WAS SPECIFIED (THE FILE IS NOT AN RMS FILE), OR THE FILE IS NOT CONNECTED,
;RETURN 'UNKNOWN'. OTHERWISE RETURN 'SEQUENTIAL','RELATIVE',OR 'INDEXED'.
INQORG: PUSHJ P,CHKOPN ;[5001] FILE OPEN?
JRST RETUNK ;[5001] NO, RETURN 'UNKNOWN'
LOAD T1,ORGAN(D) ;[5001] GET ORGANIZATION
JUMPE T1,RETUNK ;[5001] NONE GIVEN, RETURN 'UNKNOWN'
MOVEI T2,SWORG ;[5001] GET SWITCH TABLE ADDRESS
PUSHJ P,FNDSWT ;[5001] GET ADDRESS OF STRING
JRST RETVS ;GET COUNT, RETURN STRING
> ;End IF20
;[5001] New
;BYTESIZE=. RETURN THE BYTESIZE TO USER'S VARIABLE.
INQBSZ: LOAD T1,BSIZ(D) ;[5001] RETURN BYTESIZE
MOVEM T1,@(L) ;[5001] TO USER
POPJ P, ;[5001]
;CHECK IF THERE IS A CONNECTION, I.E., IF FILE IS OPEN
CHKOPN: SKIPE UNKXST ;[5001] COULDN'T DETERMINE EXISTENCE?
POPJ P, ;[5001] YES, CAN'T RETURN ANYTHING USEFUL
MOVE T1,FLAGS(D) ;GET DDB FLAGS
TXNE T1,D%IN+D%OUT+D%OPEN ;IS FILE OPEN?
AOS (P) ;YES. SKIP RETURN
POPJ P,
SEGMENT DATA
SWTPNT: BLOCK 1 ;SWITCH TABLE POINTER
DSPPNT: BLOCK 1 ;DISPATCH TABLE POINTER
XSTFLG: BLOCK 1 ;INQUIRE FILE EXISTENCE FLAG
UNKXST: BLOCK 1 ;[5001] INQUIRE FILE AMBIGUOUS EXISTENCE FLAG
INQPNT: BLOCK 1 ;POINTER TO APPROPRIATE INQUIRE FILESPEC
INQUDB: BLOCK 1 ;INQUIRE UDB ADDR
ARGCNT: BLOCK 1 ;FOROTS ARGUMENT COUNT
KWTADR: BLOCK 1 ;KEYWORD TABLE ADDRESS
KEYVAL: BLOCK 1 ;KEYWORD NUMBER
KEYADR: BLOCK 1 ;Keyword table_entry_address for KEYVAL.
FNSPNT: BLOCK 1 ;LOCAL POINTER FOR %GTFNS
%GNPNT: BLOCK 1 ;[5000] POINTER TO GENERATION IN FILESPEC
%TXTBF: BLOCK LTEXTW ;TEXT BUFFER
TXTBF1: BLOCK LTEXTW ;2ND TEXT BUFFER FOR INQUIRE
TXTBF2: BLOCK LTEXTW ;3RD TEXT BUFFER FOR INQUIRE
ATMBUF: BLOCK LATOMW ;ATOM BUFFER
%IONAM:: BLOCK 1 ;ADDRESS OF ASCIZ STATEMENT NAME
%OPNK1:: BLOCK 1 ;FIRST CONFLICTING SWITCH NUMBER
%OPNV1:: BLOCK 1 ;FIRST CONFLICTING SWITCH VALUE
%OPNK2:: BLOCK 1 ;SECOND CONFLICTING SWITCH NUMBER
%OPNV2:: BLOCK 1 ;SECOND CONFLICTING SWITCH VALUE
SEGMENT CODE
FORPRG
END