SEARCH FORPRM TV FOROPN OPEN & CLOSE ,6(2033) ;COPYRIGHT (C) 1981 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ;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 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: at their site. 2033 DAW 30-Nov-81 In CLSQ, zero out the page returned by GTPGS. ***** End Revision History ***** \ FSRCH SEARCH QSRMAC IF20,< SEARCH GLXMAC > ENTRY OPEN%,CLOSE%,RELEA%,ALCHN%,DECHN%,INQ% INTERN EXIT1%,%EXIT1 INTERN %ALCHN,%DECHN INTERN %SETIN,%SETOUT,%CHKNR IF10,< INTERN %CHMSK,%CLSER,%ST10B,%CALOF > IF20,< INTERN %OCCOC,%CCMSK,%CLSOP > INTERN %TERR,%TIOS,%TEND INTERN %OPENX,%LSTBF IF10,< INTERN %ARGNM > ;name of arg for ERROR EXTERN %POPJ,%POPJ1,%POPJ2 EXTERN %SAVE1,%SAVE2,%SAVE3,%SAVE4,%SAVE,%PUSHT,%POPT EXTERN %GTBLK,%FREBLK,%GTPGS,%FREPGS EXTERN %IREC,%OREC,%OCRLF IF20,< EXTERN %PTOF,%FTOP > EXTERN %CRLF,G.EFS,G.FERR EXTERN %ABORT EXTERN %DDBTAB,%UDBAD,I.PID,%SIZTB,I.FLAG EXTERN D.TTY,U.ERR,U.ACS,U.PDL IF10,< EXTERN G.PPN,%RANWR,I.MVER,%CLRBC,%BACKB,%BAKEF,%ISET > IF20,< EXTERN G.LJE > EXTERN %ERRST,%EMSGT,%FOREC,%ERSVV,%ERRRS EXTERN %LTYPE EXTERN %SETD,%SETAV EXTERN U.RERD IF20,< EXTERN DBSTP.> ;Close out DBMS databases SEGMENT CODE SUBTTL OPEN SIXBIT /OPEN./ OPEN%: PUSHJ P,%SAVE ;SAVE USER'S ACS, COPY ARG LIST XMOVEI T1,[ASCIZ /OPEN/] ;SET STATEMENT NAME FOR ERROR MESSAGES MOVEM T1,%IONAM PUSHJ P,OPNCNV ;CONVERT OLD ARG BLOCK FORMAT ;Get TUNIT= unit #, %TERR= "ERR=" address, %TIOS= "IOSTAT=" address PUSHJ P,FNDAGL ;Find UNIT=, ERR=, IOSTAT= ;If no UNIT= given, gets abortive error. PUSHJ P,UNRNGE ;Check unit range ; (returns if in range, unit # in T2). SKIPE T1,%TIOS ;Any IOSTAT variable? SETZM (T1) ;Yes, initialize to zero ; See if unit is already OPEN, if so do a CLOSE. OPENA0: SKIPE U,%DDBTAB(T2) ;Get unit block, skip if not OPEN PUSHJ P,CLZUNT ;Close it ;(Errors take ERR= branch) ;Unit is now closed and deallocated. ;Get a new one. OPENA1: MOVEI T1,ULEN ;Length of a unit block PUSHJ P,%GTBLK ;Allocate it MOVE U,T1 ;Point to empty unit block MOVE T2,TUNIT ;Stick unit number in block STORE T2,UNUM(U) MOVEI T1,DLEN ;Length of a DDB block PUSHJ P,%GTBLK ;Allocate it MOVE D,T1 ;Point to empty DDB block ;Set ERR= and IOSTAT= in the unit block MOVE T1,%TERR ;Set ERR= MOVEM T1,ERRAD(U) MOVE T1,%TIOS ;Set IOSTAT= MOVEM T1,IOSAD(U) TXO F,F%DCU ;Set flag that tells IOERR ; to deallocate U and D ;Setup the U and D blocks with information from the arg list. ;Possibly dialog mode will be flagged. PUSHJ P,OPNARG ;Copy arguments from arg list ;(Possibly take ERR= branch) PUSHJ P,CKSCRT ;See if he specified STATUS='SCRATCH' ;if so, filename is not allowed. PUSHJ P,DFBSTS ;Set defaults based on STATUS ; (probably FORnn.DAT) TXNN F,F%DSTRG ;"DIALOG='string'" seen? JRST OPENA2 ;No PUSHJ P,DLGSTR ;Yes, do it ; (possibly take ERR= branch) TXZ F,F%DSTRG!F%INDST ;Clear flag if set PUSHJ P,CKSCRT ;Check STATUS='SCRATCH' conflict PUSHJ P,DFBSTS ;Set defaults based on STATUS OPENA2: PUSHJ P,CHKDLG ;Go do DIALOG if necessary PUSHJ P,CKSCRT ;Check STATUS='SCRATCH' conflict ;OPEN args all read in (including "DIALOG" if specified). OPENA3: PUSHJ P,OPENX ;Call the implicit OPEN routine ;Note: OPENX (not %OPENX) because ; there may be switch conflicts. MOVX T1,D%OPEN ;"Explicit OPEN statement has been done" IORM T1,FLAGS(D) ; Set DDB flag ;Return from OPEN PJRST %SETAV ;Set AVAR if given; clear ERRAD, etc. ; in UDB; return from OPEN. ;%OPENX: Routine to do implicit open ; This routine is used by all I/O statements that do ;an implicit OPEN, and also the OPEN statement itself. ; This routine must only be called when the arguments given ;so far do not conflict. ; D and U are setup with the implicit args. ; (including ERR=, IOSTAT=) ; Errors go to ERR= or call DIALOG. ;If no errors, DDBTAB entry is set up. ;Here if we either know or suspect that there are conflicts ; in the args given. OPENX: PUSHJ P,DFBSTS ;Set default filespec info based on STATUS PUSHJ P,CHKDLG ;Do DIALOG mode if necessary PUSHJ P,CKCONF ;Check conflicts in OPEN switches now JRST OPENX ;Conflicts, go fix JRST OPENX1 ;No conflicts in args ;Here if we know there are no conflicting OPEN switches ; ** Implicit OPEN routine starts here ** %OPENX: PUSHJ P,%SAVE1 ;Make sure P1 gets preserved PUSHJ P,DFDEV ;Set default device PUSHJ P,DFBSTS ;Set default filespec info based on STATUS OPENX1: PUSHJ P,OPDFLT ;Set other defaults TXNE F,F%DRE ;If problem, JRST OPENX ;Go fix it PUSHJ P,DFDEV1 ;Get real device info JRST OPENX ;Fix problem PUSHJ P,CNFDEV ;Check conflicts with device type JRST OPENX ;Fix problem PUSHJ P,MARKCS ;Mark for consolidation if we can ; (goes to %ABORT if problem) MOVEM D,DDBAD(U) ;Set DDB address LOAD T1,FLAGS(D) ;Get DDB flags TXNE T1,D%IN+D%OUT ; Is it already open (consolidated DDB's?) JRST OPXRET ;Yes, return ;No errors. Do the actual OPEN if we need to LOAD T1,STAT(D) ;Get status CAIL T1,ST.DISP ;STATUS that's really a DISPOSE? PUSHJ P,STATDS ;Yes, change to DISPOSE, STATUS='UNKNOWN' ;There are four possibilities for STATUS= now. ; If STATUS='UNKNOWN' and file access is sequential ; then the file is not opened until ;the first I/O operation. CAIN T1,ST.UNK ;STATUS='UNKNOWN'? JRST OPXUNK ;Yes CAIN T1,ST.OLD ;STATUS='OLD'? JRST OPXOLD ;yes CAIN T1,ST.NEW ;STATUS='NEW'? (or implied) JRST OPXNEW ;Yes, go do the OPEN CAIN T1,ST.SCR ;STATUS='SCRATCH'? JRST OPXSCR ;Yes, go do the OPEN $SNH ;?That's all that could happen ;Here if STATUS='OLD' OPXOLD: PUSHJ P,OPNOLD ;** OPEN FILE FOR INPUT ** JRST OPENX ;Error, go try again JRST OPXRET ;Return ;Here if STATUS='NEW' OPXNEW: PUSHJ P,OPNNEW ;** OPEN FILE FOR OUTPUT ** JRST OPENX ;Error, go try again JRST OPXRET ;Return ;Here if STATUS='SCRATCH' OPXSCR: PUSHJ P,OPNSCR ;** OPEN FILE FOR SCRATCH ** JRST OPENX ;Error, go try again JRST OPXRET ;Return ;Here if STATUS='UNKNOWN' OPXUNK: LOAD T1,INDX(D) ;What type of device? CAIN T1,DI.TTY ;If TTY:, SKIPA T1,[AC.SOU] ;Pretend "SEQOUT" access. LOAD T1,ACC(D) ;Get access PUSHJ P,OPXUAC(T1) ;Do something JRST OPENX ;?failed JRST OPXRET ;Success, return ;OPEN routine to call when status='UNKNOWN', by access type OPXUAC: $SNH ;* UNKNOWN ACCESS TYPE * JRST OPNOLD ;SEQIN JRST OPNOUT ;SEQOUT - Open file for output JRST OPXUSO ;SEQINOUT- See what to do JRST OPNOLD ;RANDIN JRST OPNRIO ;RANDOM JRST OPNAPP ;APPEND ;Here if SEQINOUT UNKNOWN OPXUSO: TXNE F,F%CTTY ;Controlling TTY:? JRST OPNOUT ;Yes, go open it now JRST %POPJ1 ;Don't OPEN it yet ;Here when %OPENX is successful OPXRET: HXRE T1,UNUM(U) ; Get unit number MOVEM U,%DDBTAB(T1) ;Store unit block address in DDBTAB. ; PJRST STBLNK ;Set BLANK= default and return ;Routine to set BLANK= default ; If device is TTY: the default is always NULL ; Else if this is an OPEN statement, set BLANK=NULL ; else set BLANK=ZERO. ;This may seem like nonsense, but it makes FOROTS compatible ; with VAX. STBLNK: LOAD T1,BLNK(U) JUMPN T1,%POPJ ;Return if user specified it LOAD T2,INDX(D) ; T2= device index MOVE T1,%IONAM ; T1= address of statement name MOVE T1,(T1) ;Get ASCIZ CAIE T2,DI.TTY ;For TTY CAMN T1,[ASCIZ /OPEN/] ; or OPEN statement SKIPA T1,[BL.NULL] ;Default is BLANK=NULL MOVEI T1,BL.ZERO ;Else Default is BLANK=ZERO.. STORE T1,BLNK(U) ;Store the value POPJ P, ;Return ;Routine to change STATUS that's really a DISPOSE into ; STATUS='UNKNOWN' and DISPOSE. ;There should be no conflicts with DISPOSE and STATUS when we ;get here. ;Call: ; T1/ STATUS value that's really a dispose ;Return: ; T1/ ST.UNK, DISP(D) set, STAT(D) set to ST.UNK STATDS: SUBI T1,ST.DISP ;Get /DISPOSE value LOAD T2,DISP(D) ; If not set, SKIPN T2 STORE T1,DISP(D) ; Set it MOVEI T1,ST.UNK ;Set 'UNKNOWN' status STORE T1,STAT(D) POPJ P, ;Return, T1= 'UNKNOWN' status ;Routine to set OPEN defaults based on STATUS ;If STATUS='SCRATCH', all info except device is cleared ; Otherwise default name is FORnn.DAT ;This routine does not affect the value of F%DRE. ; and can not cause an error. ;This routine should be called before each DIALOG mode is called ; and before the OPEN is done. DFBSTS: LOAD T1,STAT(D) ;Get current value of "STATUS" CAIE T1,ST.SCR ;'SCRATCH'? PJRST DFFILE ;No, set default filename and return TXZ F,F%FSS ;Clear flag "user specified filespec stuff" TXZ F,F%EXT ;Clear "extension was specified" IF10,< ;Set defaults for STATUS='SCRATCH' DFSCR: SETZM LKPB(D) ;Clear the LOOKUP block HRLI T1,LKPB(D) HRRI T1,LKPB+1(D) BLT T1,LKPB+LLEN-1(D) ; . . SETZM PTHB(D) ;Clear the path block HRLI T1,PTHB(D) HRRI T1,PTHB+1(D) BLT T1,PTHB+^D9-1(D) ; . . SETZM PPN(D) ;Clear PPN or ptr to path block POPJ P, ;Return > IF20,< ;Set defaults for STATUS='SCRATCH' DFSCR: SETZM DIR(D) ;Clear directory SETZM FILE(D) ; Filename SETZM EXT(D) ; Extension SETZM PROT(D) ; Protection SETZM XGEN(D) ; Generation # POPJ P, ;Return > ;Routine to check for unit out of range ;Input: ; TUNIT/ unit number from OPEN or CLOSE arg list ; PUSHJ P,UNRNGE ; ; If unit is not in range for OPEN or CLOSE, ; the program takes ERR= path (TERR) or aborts. UNRNGE: MOVE T2,TUNIT ;Get unit number CAML T2,[MINUNIT] ;Skip if less than the minimum CAILE T2,MAXUNIT ;Skip if .LE. the maximum $ECALL IUN,%ABORT ;?UNIT out of range POPJ P, ;Ok, unit in range ;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. ;If IOERR happens in CLOSE, D and U blocks are not deallocated. ; (because F%DCU is not set). CLZUNT: MOVE D,DDBAD(U) ;Get old DDB block MOVE T1,%TERR ; Use ERR= from open MOVEM T1,ERRAD(U) MOVE T1,%TIOS ; Use IOSTAT= from open MOVEM T1,IOSAD(U) PJRST %CLOSE ;Go close it and return. ;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 F%DRE if there are errors. ;It must be called in OPEN after OPNARG, and after each ; DIALOG. ;If no errors, returns .+2 CKCONF: PUSHJ P,CKSCRT ;Check STATUS='scratch' conflict ;Check /STATUS conflict with /DISPOSE ;T1= status CKCNST: MOVEM T1,%OPNV1 ;Store switch value for error message LOAD T2,DISP(D) ;Get /DISPOSE CAIN T1,ST.SCR ;/STATUS=SCRATCH? JRST CKCNS1 ;Yes, /DISPOSE=SAVE not allowed SUBI T1,ST.DISP ;Convert to /DISP:something JUMPLE T1,CKCNFM ;Go check /FORM JUMPE T2,CKCNFM ; If not specified, no conflict then CAIN T1,(T2) ;Do STATUS and DISPOSE agree? JRST CKCNFM ;Yes, no error JRST CKCNS2 ;Error CKCNS1: CAIE T2,DS.SAVE ;/DISPOSE='SAVE' specified? JRST CKCNFM ;No, ok CKCNS2: MOVEM T2,%OPNV2 ;Store /DISPOSE value for error MOVEI T1,OK.STAT ;Store switch number for errors MOVEM T1,%OPNK1 MOVEI T1,OK.DISP MOVEM T1,%OPNK2 PUSHJ P,OPCONF ;Give error message ;Check /MODE and /FORM conflict CKCNFM: LOAD T1,FORM(D) ;T1= form JUMPE T1,CKCNAC ;If not specified, no conflict LOAD T2,MODE(D) ;T2= mode JUMPE T2,CKCNAC ;If not specified, no conflict CAIL T2,MD.ASC ;ASCII or greater implies /FORM:F JRST CKFMF ;Go check that ;8-SEP-81 /DAW, MODE='IMAGE' conflicts with FORM='FORMATTED' ; CAIGE T2,MD.BIN ;BINARY or greater implies /FORM:U ; JRST CKCNAC ;/MODE:IMAGE - no conflict ;Must be /FORM:UNFORMATTED CKFMU: CAIN T1,FM.UNF ;UNFORMATTED? JRST CKCNAC ;Yes, ok CKFMUE: MOVEM T1,%OPNV2 ;Store value for error message MOVEI T1,OK.MOD ;Store switch numbers MOVEM T1,%OPNK1 MOVEI T1,OK.FORM MOVEM T1,%OPNK2 MOVEM T2,%OPNV1 ;Value of /MODE PUSHJ P,OPCONF ;Give error JRST CKCNAC ;Go on ;Here if /FORM must be "FORMATTED" CKFMF: CAIE T1,FM.FORM ;FORMATTED? JRST CKFMUE ;No, give error ;Check conflict of /ACCESS and /READONLY CKCNAC: LOAD T1,RO(D) ;T1= "Readonly" bit JUMPE T1,CKCSRO ;If not specified, no conflict LOAD T2,ACC(D) ;T2= ACCESS CAIE T2,AC.SOU ;SEQOUT? CAIN T2,AC.APP ; or APPEND? JRST .+2 ;Yes, can't have READONLY JRST CKCSRO ;Otherwise it's ok MOVEM T2,%OPNV1 ;Store value of ACCESS SETOM %OPNV2 ;READONLY has no value MOVEI T1,OK.ACC MOVEM T1,%OPNK1 MOVEI T1,OK.RO MOVEM T1,%OPNK2 PUSHJ P,OPCONF ;Give error ;Check conflict of /STATUS and /READONLY CKCSRO: LOAD T1,RO(D) ;Get value of /READONLY JUMPE T1,CKCSAC ;Not specified, no conflict LOAD T2,STAT(D) ;Get /STATUS CAIE T2,ST.NEW CAIN T2,ST.SCR ;New and scratch don't make sense JRST .+2 JRST CKCSAC ;Otherwise OK MOVEM T2,%OPNV1 SETOM %OPNV2 ;READONLY has no value MOVEI T1,OK.STAT MOVEM T1,%OPNK1 MOVEI T1,OK.RO MOVEM T1,%OPNK2 PUSHJ P,OPCONF ;Give error ;Check 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: MOVEM T1,%OPNV1 MOVEM T2,%OPNV2 MOVEI T1,OK.ACC MOVEM T1,%OPNK1 MOVEI T1,OK.STAT MOVEM T1,%OPNK2 PUSHJ P,OPCONF ;Give error ;Check /ACCESS conflict with /MODE CKCACM: LOAD T1,ACC(D) ;Get /ACCESS LOAD T2,MODE(D) ;Get /MODE CAIE T1,AC.RIN ;Random? CAIN T1,AC.RIO JRST .+2 ;Yes JRST CHKRSZ ;No, -- next check ;Random (DIRECT) access. CAIE T2,MD.DMP ;/MODE:DUMP illegal (not hard to make ; it legal at some future date.. if so ; each record would be a block and /RECORDSIZE ; could not also be specified (??).). JRST CHKRSZ ;Not /MODE:DUMP, go on. MOVEM T1,%OPNV1 ;Value of ACCESS MOVEM T2,%OPNV2 ;Value of MODE MOVEI T1,OK.ACC MOVEM T1,%OPNK1 MOVEI T1,OK.MODE MOVEM T1,%OPNK2 PUSHJ P,OPCONF ;Give error ;Make sure he specified "RECORDSIZE" if random access requested CHKRSZ: LOAD T1,ACC(D) ;GET /ACCESS CAIE T1,AC.RIN ;RANDOM? CAIN T1,AC.RIO JRST .+2 ;YES JRST CKCNXT ;No MOVE T1,RSIZE(D) ;GET /RECORDSIZE JUMPN T1,CKCNXT ;NONZERO, OK ; IOERR (RRR,30,507,?,Random IO requires /RECORDSIZE,,%POPJ) $ECALL RRR,REQDIA ;"?Random IO requires /RECORDSIZE" CKCNXT: TXNN F,F%DRE ;Skip if errors AOS (P) ;No, skip return POPJ P, ;Yes, return .+1 ;CKSCRT--Routine to check for STATUS='SCRATCH' and also filespec given. ; If both specified, an error is generated. Either ERR= will be ; taken or F%DRE will be set. ;Call: ; PUSHJ P,CKSCRT ; ;On return, T1= status CKSCRT: LOAD T1,STAT(D) ;Get STATUS CAIE T1,ST.SCR ;SCRATCH? POPJ P, ;No TXNN F,F%FSS ;User specify filespec stuff? POPJ P, ;No, ok $ECALL SNM,REQDIA ;?STATUS='SCRATCH' with a named file! ;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) SKIPGE T1,%OPNV2 SKIPA T1,[[0]] PUSHJ P,FNDSWT MOVEM T1,%OPNV2 ; IOERR (ISW,30,506,?,Incompatible attributes /$Z$Z /$Z$Z,<%OPNK1,%OPNV1,%OPNK2,%OPNV2>,REQDIA) $ECALL ISW,REQDIA ;CNFDEV - Check for conflicts for OPEN device ;If there is a conflict, either ERR= is taken or ; an error message is typed and F%DRE is set. ;Readonly devices cannot do output CNFDEV: LOAD T1,IO(D) ;Get possible IO values TRNE T1,2 ;Can device do output? JRST CNFDV1 ;Yes, ok LOAD T1,ACC(D) ;Get access CAIE T1,AC.SOU ;SEQOUT CAIN T1,AC.APP ;APPEND JRST CNFDAC ;Yes, conflict CAIE T1,AC.RIO ;RANDOM (DIRECT) CAIN T1,AC.RIN ;RANDIN JRST CNFDAC ;Yes, conflict JRST CNFDV1 ;Yes, ok ;T1= Access type that conflicts 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) $ECALL IAC,REQDIA ;Set F%DRE if ERR= not taken ;Writeonly devices cannot do input CNFDV1: LOAD T1,IO(D) ;Get input/output possible TRNE T1,1 ;Can device do input? JRST CNFDV2 ;Yes, ok LOAD T1,ACC(D) ;Get ACCESS CAIE T1,AC.RIN ;No RANDOM allowed CAIN T1,AC.RIO JRST CNFDAC ;?conflict CAIN T1,AC.SIN ;SEQIN JRST CNFDAC ;?conflict JRST CNFDV2 ;No conflict ;Check for DIRECT access specified for a sequential device CNFDV2: LOAD T1,ACC(D) ;Get /ACCESS CAIE T1,AC.RIN ;Random? CAIN T1,AC.RIO JRST .+2 ;Yes, check to see if device allows this JRST CNFDV3 ;Not RANDOM access, all devices allow it LOAD T2,DVTYP(D) ;Get type of device IF20,< CAIE T2,.DVDSK ;Disk CAIN T2,.DVNUL ; and NUL: are the only random-access devices JRST CNFDV3 ;OK, next test > IF10,< CAIE T2,.TYDSK ;DSK: (and NUL: which gets this same value) CAIN T2,.TYDTA ; and DECTAPE can do random-IO JRST CNFDV3 ;OK, next test > ;Device can not do RANDOM IO ;T1= ACCESS MODE JRST CNFDAC ;/BLOCKSIZE only allowed with magtape. CNFDV3: LOAD T1,BLKSZ(D) ;Get /BLOCKSIZE JUMPE T1,CNFDV4 ;Jump if not specified LOAD T1,INDX(D) ;Get device type CAIN T1,DI.MTA ;Magtape? JRST CNFDV4 ;Yes, ok SETZ T1, ;Clear it STORE T1,BLKSZ(D) ; IOERR (BSI,0,0,% BLOCKSIZE ignored: device is not a magnetic tape) $ECALL BSI ;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 CAIE T1,DI.DSK ;DSK: everything allowed CAIN T1,DI.MTA ; also magtape JRST CNFDV5 ;No conflict LOAD T1,DVTYP(D) ;Get device type IF10,< CAIE T1,.TYDSK ;DSK: (append) CAIN T1,.TYDTA ;DTA: JRST CNFDV5 ;Everything allowed CAIE T1,.TYTTY ;TTY: CAIN T1,.TYPTY ; or PTY: JRST CNFD4X ;Yes, conflict > IF20,< CAIE T1,.DVDSK ;DSK: (append) CAIN T1,.DVNUL ;NUL: JRST CNFDV5 ;Everything allowed CAIE T1,.DVTTY ;TTY: CAIN T1,.DVPTY ;or PTY:? JRST CNFD4X ;Yes, conflict > ;Not TTY: or PTY:, everything else likes image CAIN T2,MD.IMG ;Image? JRST CNFDV5 ;Yes, no conflict ;Mode is not IMAGE or ASCII IF10, CAIN T1,.TYLPT ;LPT:? IF20, CAIN T1,.DVLPT ;LPT:? JRST CNFD4X ;Yes, conflict IF10,< CAIN T1,.TYPLT ;Plotter? JRST CNFD4X ;Yes, conflict >;END IF10 ;Not LPT: either, everthing else likes BINARY CAIN T2,MD.BIN JRST CNFDV5 ;No conflict ;Mode is LINED or DUMP (TOPS-10) ;We know that device is not MTA, DTA, DSK, NUL. ;ERROR- mode conflict 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) $ECALL IDM,REQDIA ;Request DIALOG mode CNFDV5: JRST %POPJ1 ;No error-- skip return ;CHKDLG - routine to check for dialog needed and do it ;Called from OPEN and CLOSE routines ;Returns when everything cleared up. CHKDLG: TXZN F,F%DRE ;Dialog requested because of errors? JRST CHKDL2 ;No TXZ F,F%DIALOG ;Clear /DIALOG if set CHKDL1: PUSHJ P,CLRCNS ;Clear DDB consolidation pointers, if any PUSHJ P,DIALOG ;Do DIALOG (could set F%DRE again) JRST CHKDLG ; Loop until no errors. CHKDL2: TXZE F,F%DIALOG ;DIALOG requested? JRST CHKDL1 ;Yes POPJ P, ;Return ;FNDAGL: ;Routine to find UNIT=, ERR=, and IOSTAT= in the argument list ; and if there, store them in TUNIT, %TERR, and %TIOS respectively. ; ;Called by OPEN% and CLOSE% ; ;Inputs: ; L points to argument list ;Uses T1, T2, T3 ;Leaves L intact FNDAGL: SETZM %TERR ;Not specified yet.. SETZM %TIOS ;"L" is "saved" in T1 below. MOVE T1,L ;Keep L in T1 during this code. ;Find unit. If not specified, abort. FAGL1A: LDB T2,[POINTR @%LTYPE,ARGKWD] CAIE T2,OK.UNIT AOBJN L,FAGL1A JUMPL L,FAGL1B ;Jump if we found it ; IOERR (UNS,30,501,?,Unit not specified,,%ABORT)] $ECALL UNS,%ABORT ;?Unit not specified FAGL1B: HRRE T2,(L) ;Assume unit is a constant LDB T3,[POINTR @%LTYPE,ARGTYP] CAIE T3,0 ;Is it a constant? MOVE T2,@0(L) ;No, get it MOVEM T2,TUNIT ;Store UNIT= arg. MOVE L,T1 ;Restore L ;Find ERR= and IOSTAT= if specified. FAGL2A: LDB T2,[POINTR @%LTYPE,ARGKWD] CAIN T2,OK.ERR ;ERR= JRST FAGL2B CAIN T2,OK.IOS ;IOSTAT= JRST FAGL2C FAGL2E: AOBJN L,FAGL2A ;Loop thru arg list MOVE L,T1 ;Restore L POPJ P, ;Return ;ERR= FAGL2B: XMOVEI T2,@0(L) ;Get address MOVEM T2,%TERR ;save it JRST FAGL2E ;IOSTAT= FAGL2C: XMOVEI T2,@0(L) ;Get address MOVEM T2,%TIOS ;Save it JRST FAGL2E ;Continue SEGMENT DATA ;Stuff from OPEN and CLOSE arg list %TERR: BLOCK 1 ;ERR= from arg list %TIOS: BLOCK 1 ;IOSTAT= from arg list TUNIT: BLOCK 1 ;UNIT= from arg list %TEND: BLOCK 1 ;END= SEGMENT CODE ;OPNRIO - Open random file for Input and Output. ; STATUS = 'unknown' OPNRIO: IF20,< SETZ T1,> ;No special JFN bits PJRST OPCMO ;open for output ;OPNAPP - Open file when Access= 'APPEND' OPNAPP: IF20,< SETZ T1,> ;No special JFN bits PJRST OPCMO ;Open for output ;OPNOLD - Open file for input ;This routine is called from OPEN to open a file when ; STATUS='OLD'. OPNOLD: IF20,< MOVX T1,GJ%OLD> ;"File must exist" MOVX T3,D%IN ;Assume open for input LOAD T2,ACC(D) ;But ACCESS might change it CAIE T2,AC.SOU ;SEQOUT CAIN T2,AC.APP ;APPEND MOVX T3,D%OUT ;Will open file for output TXNE T3,D%IN ;Open for input? JRST OPCMI ;Yes ; JRST OPCMO ;Open for output ;Common routine to OPEN file for output OPCMO: MOVX T0,D%IO ;Say "Doing output" IORM T0,FLAGS(D) ;. . IF10,< MOVX T1,D%OUT> PUSHJ P,DOOPEN ;Do the OPEN POPJ P, ;Problems, single return MOVX T1,D%OUT ;Set "OPENED FOR OUTPUT" IORM T1,FLAGS(D) ; . . JRST %POPJ1 ;Skip return ;Common routine to open file for input OPCMI: MOVX T0,D%IO ;Make sure "Doing output" bit ANDCAM T0,FLAGS(D) ; is off IF10,< MOVX T1,D%IN> PUSHJ P,DOOPEN ;Do the OPEN POPJ P, ;Problems, single return MOVX T1,D%IN ;Set "OPENED for input" IORM T1,FLAGS(D) ; . . JRST %POPJ1 ;OK, skip return ;OPNNEW - Open file if status=new ; This routine is called only from OPEN when STATUS='NEW'. ; The file must not exist and is opened for output. OPNNEW: IF20,< MOVX T1,GJ%NEW> ;"File must not exist" PJRST OPCMO ;Continue at common output code ;OPNOUT - Open file for output ; This is called from IO statements to open ;a file for output. If the file already exists, it is superseded. OPNOUT: IF20,< MOVX T1,GJ%FOU> ;New generation (supersede also) PJRST OPCMO ;Go to common code ;OPNIN - Open file for input ; This is called from IO statements (but not OPEN) to open ;a file for input. The file must exist. OPNIN: IF20,< MOVX T1,GJ%OLD> ;"File must exist" PJRST OPCMI ;Go to common input code ;OPNSCR - Open file if status=scratch ;This routine is called only from OPEN when STATUS='SCRATCH'. ; A random filename is generated and the file must not exist. ; It is opened for output. IF10,< OPNSCR: PJRST OPCMO ;Go to common output code > IF20,< ;TOPS-20 open scratch file routine OPNSCR: PUSHJ P,%SAVE1 ;Free up P1 PUSHJ P,GMODBY ;Get info based on /MODE MOVE T2,[POINT 7,[ASCIZ/FOROTS-SCRATCH-FILE.TMP/]] SETZ P1, ;Number of tries so far = 0 OPNTX0: PUSHJ P,GTSNAM ;Get a scratch name MOVX T1,GJ%SHT!GJ%FOU ;Next generation number, pls GTJFN% ;Get handle on a temp file ERJMP OTME01 ;Can't STORE T1,OJFN(D) ;Store it STORE T1,IJFN(D) MOVX T3,D%RJN ;'Got a real JFN' IORM T3,FLAGS(D) ;Set flag ;DO OPENF LOAD T2,ACC(D) CAIN T2,AC.RIO ;RANDOM? JRST OPSCR ;Yes, open for input and output MOVX T2,OF%WR ;SEQINOUT - OPEN FOR OUTPUT ONLY OR T2,DMBS(D) OPENF% ERJMP OTME02 ;?Can't JRST OPSCRA OPSCR: MOVX T2,OF%RD+OF%WR ;Get initial bits for OPENF OR T2,DMBS(D) ;Put in byte size OPENF% ERJMP OTME02 ;?Can't JRST OPSCRA OPSCRA: MOVX T1,D%OUT ;Say "File is opened for output" IORM T1,FLAGS(D) LOAD T1,INDX(D) ;Get device index CAIE T1,DI.DSK ;Skip if disk JRST OPSCRB ;Not DSK, skip UFPGS% LOAD T1,OJFN(D) ;Get JFN HRLZ T1,T1 SETZ T2, ;Update file pages to make the file appear UFPGS% ERJMP OTME03 ;?can't OPSCRB: LOAD T1,ACC(D) ;GET ACCESS MOVE T2,ACCTAB(T1) ;Get bits to set in DDB flags IORM T2,FLAGS(D) ; Set 'em PUSHJ P,OPFSTT ;Do DSKSET, etc. POPJ P, ;Error, return .+1 JRST %POPJ1 ;Success, return ;Here if can't get JFN for file OTME01: $ECALL OPE,%ABORT ;Wierd OPEN error ;Here if OPENF% failed OTME02: CAIE T1,OPNX9 ;Invalid simultaneous access? $ECALL OPE,%ABORT ;No, take ERR= or abort ; (No dialog if SCRATCH open fails!) ;OPENF% failed because of invalid simultanous access. ;Note that this should only happen if there are two users on the system ; and one has opened a file with the same name as this user but has not ; done an "UPFGS" JSYS yet. We will simply pick another name, try that, ; and if it continues to fail the same way we'll just give the error. ADDI P1,1 ;Increment number of tries CAILE P1,5 ;Tried too many times? $ECALL OPE,%ABORT ;Yes, go give the error LOAD T1,OJFN(D) ;Get JFN RLJFN% ERJMP .+1 ;This should never happen MOVX T1,D%RJN ;Don't have a real JFN anymore ANDCAM T1,FLAGS(D) ;Clear the DDB flag SETZ T1, STORE T1,OJFN(D) STORE T1,IJFN(D) MOVEI T1,^D100 ;Sleep for a fraction of a second DISMS% GTAD% ;Return current date/time ANDI T1,3 ;Get random number 0 to 3 MOVE T2,OTMFNS(T1) ;Get a random filename JRST OPNTX0 ;Go try again ;Table of four random filenames OTMFNS: POINT 7,[ASCIZ/WXX.TMP/] POINT 7,[ASCIZ/XXX.TMP/] POINT 7,[ASCIZ/YXX.TMP/] POINT 7,[ASCIZ/ZXX.TMP/] ;Here if UPFGS% JSYS fails OTME03: $ECALL OPE,%ABORT ;Type JSYS error, abort. ; (or take ERR=) ;Routine to get a scratch name ;Call: ; T2/ byte ptr to file name ;Return: ; T2/ byte ptr to whole filespec GTSNAM: PUSH P,T2 ;Save ptr to name MOVE T1,[POINT 7,SNAMEX] MOVE T2,[POINT 7,DEV(D)] PUSHJ P,CPYNUL ;Copy to null MOVEI T3,":" ;Colon separator after device IDPB T3,T1 POP P,T2 ;Retrieve ptr to name LOAD T3,INDX(D) ;Get device index CAIN T3,DI.MTA ;Magtape? JRST GTSNDN ;Yes, done (no file name needed) PUSHJ P,CPYNUL ; Append filename to string MOVE T2,[POINT 7,[ASCIZ/.-1;T/]] ;Say "temp file" LOAD T3,INDX(D) ;Device index again CAIN T3,DI.DSK ;DSK? PUSHJ P,CPYNUL ;Yes, append ".-1;t" to string GTSNDN: SETZ T3, ;Store null byte to end IDPB T3,T1 MOVE T2,[POINT 7,SNAMEX] ;Get ptr to whole thing POPJ P, ;And return ;Copy to null ;T1/ ptr to string to append to ;T2/ ptr to string to append ;Returns: ;T1/ updated string ptr. CPYNUL: ILDB T3,T2 ;Get a byte JUMPE T3,%POPJ ;Jump when got a null IDPB T3,T1 ;Store it JRST CPYNUL ;Loop SEGMENT DATA SNAMEX: BLOCK 100 ;ASCIZ scratch file name SEGMENT CODE >;END IF20 ;%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 TXNN T1,D%OUT ;Skip if file opened for output JRST OPIN ;No, open for input TXZ T1,D%IO ;(D%IO may have been set by OPENX for TTYs, MOVEM T1,FLAGS(D) ; even if the statement was "READ") ;File is now opened for output. SWIN: LOAD T1,ACC(D) ;Get access MOVE T2,LOUTIN(T1) ;Switch direction to input PUSHJ P,(T2) 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 ;Open file for input. OPIN: LOAD T1,ACC(D) ;Get access MOVE T2,NIOIN(T1) ;First READ routine PUSHJ P,(T2) ;Do OPEN if necessary JRST FSTINF ;?Failed to OPEN file MOVX T1,D%IN ;Set "File opened for input" IORM T1,FLAGS(D) ; Set in DDB POPJ P, ;Return ;First READ failed to OPEN file FSTINF: PUSHJ P,OPENX ;Do generic OPEN JRST %SETIN ;Go try again ;%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: LOAD T1,MODE(D) ;Get MODE CAIN T1,MD.ASL ;'LINED'? $ECALL CWL,%ABORT ;Yes, can't do it. MOVE T1,FLAGS(D) ;Get DDB flags now TXO T1,D%IO ;Set "doing output" IORM T1,FLAGS(D) TXNE T1,D%OUT ;File already opened for output? POPJ P, ;Yes, nothing to do TXNN T1,D%IN ;Skip if file was opened for input JRST OPOUT ;Open file for output ;File was open for input, switch to output LOAD T1,ACC(D) ;Get access mode MOVE T2,LINOUT(T1) ;Get routine PUSHJ P,(T2) ;Set new direction MOVE T1,FLAGS(D) ;Get DDB flags to change TXZ T1,D%IN ;Clear input TXO T1,D%OUT ;Set output MOVEM T1,FLAGS(D) ;Set new flags POPJ P, ;Done, return ;Open file for output. Supersede any file with same name. OPOUT: LOAD T1,ACC(D) ;Get access MOVE T2,NIOOUT(T1) ;First WRITE action PUSHJ P,(T2) ;Call routine JRST FWTFAI ;?Failed, no ERR= taken. MOVX T1,D%OUT ;Set output IORM T1,FLAGS(D) POPJ P, ;Return ;First WRITE failed to OPEN file. FWTFAI: PUSHJ P,OPENX ;Generic OPEN again. JRST %SETOUT ;And set output again. 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) ;. . ; IOERR (CDT,31,502,?,Can't $A an $A-only file,,%ABORT) $ECALL CDT,%ABORT ;HERE TO FIND OUT WHAT TO DO IF LAST OPERATION WAS INPUT ;AND NEXT OPERATION IS INPUT, BY ACCESS TYPE LININ: %POPJ ;SEQINOUT %POPJ ;SEQIN %POPJ ;SEQOUT %POPJ ;SEQINOUT %POPJ ;RANDIN %POPJ ;RANDOM %POPJ ;APPEND ;HERE TO FIND OUT WHAT TO DO IF LAST OPERATION WAS INPUT ;AND NEXT OPERATION IS OUTPUT, BY ACCESS TYPE LINOUT: OSWTCH ;SEQINOUT ILLOUT ;SEQIN OSWTCH ;SEQOUT OSWTCH ;SEQINOUT ILLOUT ;RANDIN %POPJ ;RANDOM OSWTCH ;APPEND ;HERE TO FIND OUT WHAT TO DO IF LAST OPERATION WAS OUTPUT ;AND NEXT OPERATION IS INPUT, BY ACCESS TYPE LOUTIN: ISWTCH ;SEQINOUT ISWTCH ;SEQIN ISWTCH ;SEQOUT ISWTCH ;SEQINOUT %POPJ ;RANDIN %POPJ ;RANDOM ISWTCH ;APPEND ;HERE TO FIND OUT WHAT TO DO IF LAST OPERATION WAS OUTPUT ;AND NEXT OPERATION IS OUTPUT, BY ACCESS TYPE LOUTOU: %POPJ ;SEQINOUT ILLOUT ;SEQIN %POPJ ;SEQOUT %POPJ ;SEQINOUT ILLOUT ;RANDIN %POPJ ;RANDOM %POPJ ;APPEND ;HERE TO FIND OUT WHAT TO DO IF NO I/O DONE BEFORE ;AND NEXT OPERATION IS INPUT, BY ACCESS TYPE NIOIN: SEQIN ;SEQINOUT FIRST READ %POPJ1 ;SEQIN NIOISW ;SEQOUT SEQIN ;SEQINOUT FIRST READ %POPJ1 ;RANDIN %POPJ1 ;RANDOM NIOISW ;APPEND NIOISW: PUSHJ P,ISWTC1 ;Switch to input JRST %POPJ1 ;Success return ;HERE TO FIND OUT WHAT TO DO IF NO I/O DONE BEFORE ;AND NEXT OPERATION IS OUTPUT, BY ACCESS TYPE NIOOUT: SEQOUT ;SEQINOUT FIRST WRITE ILLOUT ;SEQIN %POPJ1 ;SEQOUT SEQOUT ;SEQINOUT FIRST WRITE ILLOUT ;RANDIN %POPJ1 ;RANDOM %POPJ1 ;APPEND ;SEQINOUT ;HERE WHEN FIRST OPERATION IS READ SEQIN: IF20,< MOVX T1,GJ%OLD> ;File must exist IF10,< MOVX T1,D%IN> PUSHJ P,DOOPEN ;Do the OPEN POPJ P, ;Error JRST %POPJ1 ;Successful OPEN, return .+2 ;HERE WHEN FIRST OPERATION IS WRITE SEQOUT: IF20,< MOVX T1,GJ%FOU> ;Open new generation for output IF10,< MOVX T1,D%OUT > PUSHJ P,DOOPEN ;Do the OPEN POPJ P, ;Error JRST %POPJ1 ;Successful OPEN, return .+2 ;HERE FOR SEQUENTIAL FILES ON INPUT FOLLOWING OUTPUT. ;-20: JUST CLEAR THE BYTE COUNT, SPECIFYING EOF. ; ;-10: CLOSE THE FILE, REOPEN FOR INPUT, READ THE LAST ;BLOCK, POINT TO THE END OF THE BLOCK. ; ;-20 Note: DISK APPEND file is DI.OTHR. It is opened on TOPS-20 for ;APPEND access and cannot do input. But to be fast, FOROTS will not ;check and will just POPJ from this routine to set D%IN. Then ;when input is about to be done, ACCESS='APPEND' and DISK will ;cause an EOF error. REWIND and BACKSPACE are no-ops for disk APPEND files. ISWTCH: ISWTC1: LOAD T1,INDX(D) ;GET DEVICE INDEX CAIN T1,DI.DSK ;DISK? JRST DSKISW ;YES CAIN T1,DI.MTA ;OR MTA JRST MTAISW ;YES POPJ P, ;NO. NOTHING TO DO IF20,< DSKISW: MOVE T1,WSIZ(D) ;GET WINDOW SIZE SUB T1,ICNT(D) ;GET # ACTIVE BYTES SKIPE IPTR(D) ;IF WE WROTE ANY DATA MOVEM T1,WCNT(D) ;PRETEND WE READ THEM SETZM ICNT(D) ;TELL DIREC WE'RE AT EOF! POPJ P, > ;IF20 IF10,< DSKISW: MTAISW: PJRST %ISET ;JUST LIKE A BACKSPACE, ALMOST >; IF10 ;HERE FOR OUTPUT FOLLOWING INPUT FOR ALL DEVICES. ;FOR DISK AND MAGTAPE, TRUNCATE FILE AT CURRENT INPUT POINTER, ;OPEN FOR OUTPUT, AND COPY THE DATA INTO THE OUTPUT BUFFER. OSWTCH: LOAD T1,INDX(D) ;GET DEVICE INDEX CAIN T1,DI.DSK ;DISK JRST DSKOSW ;YES CAIN T1,DI.MTA ;OR MTA JRST MTAOSW ;YES POPJ P, ;OTHER IF20,< DSKOSW: MOVE T1,FLAGS(D) ;GET FLAGS TXZE T1,D%END ;END OF FILE? SOS NREC(D) ;YES. DECR THE RECORD COUNT MOVEM T1,FLAGS(D) ;SAVE FLAGS WITHOUT EOF PUSHJ P,%SAVE3 ;SAVE P ACS SKIPN IPTR(D) ;Any IO done yet? JRST CHKWRT ;Maybe REWIND just done.. MOVE T1,BYTN(D) ;GET BYTE # OF NEXT WINDOW SUB T1,ICNT(D) ;GET LAST BYTE IN USE MOVEM T1,EOFN(D) ;SAVE AS EOF PNTR MOVE T1,WSIZ(D) ;YES. GET SIZE OF WINDOW SUB T1,WCNT(D) ;GET # UNUSED BYTES IN WINDOW ADDM T1,OCNT(D) ;RESTORE FULL WINDOW SIZE MOVE T1,FLAGS(D) ;Get DDB flags now CHKWRT: TXNN T1,D%WRT ;Do we have WRITE access? PUSHJ P,CLSOUT ;No, CLOSE, reopen for OUTPUT MOVX T1,D%WRT ;We have WRITE access now IORM T1,FLAGS(D) POPJ P, ;Return CLSOUT: SETO T1, ;SET TO UNMAP FILE FOR CLOSING MOVE T2,WTAB(D) ;GET PAGE ID OF FILE WINDOW HRLI T2,.FHSLF LOAD T3,BUFCT(D) ;GET PAGE COUNT HRLI T3,(PM%CNT) PMAP% LOAD T1,IJFN(D) ;CLOSE FILE, KEEP JFN HRLI T1,(CO%NRJ) CLOSF% ; IOERR (OSW,30,,?,$J,,%ABORT) $ECALL OSW,%ABORT LOAD T1,OJFN(D) ;GET JFN BACK MOVE T2,DMBS(D) ;GET DATA MODE AND BYTE SIZE TRO T2,OF%RD+OF%WR ;GET READ+WRITE ACCESS OPENF% ;REOPEN FILE ; IOERR (OSW,30,,?,$J,,%ABORT) ;CAN'T $ECALL OSW,%ABORT HRRZ P1,IPTR(D) ;GET PROCESS ADDRESS OF FILE POINTER JUMPE P1,ZERPNT ;NO DATA NEEDED YET IF 0 PUSHJ P,%PTOF ;CONVERT TO FILE ADDRESS JUMPL P1,ZERPNT ;IF NEG FILE POSITION, NO DATA NEEDED PUSH P,P1 ;SAVE FILE POSITION MOVE P1,(P) ;GET FILE ADDRESS BACK PUSHJ P,%FTOP ;MAP IT ADDI P1,1 ;MAPW LEFT US AT ADDR-1 SUBI P2,1 ;AND WITH CURRENT WORD AS AVAILABLE HRRM P1,IPTR(D) ;STORE ADDRESS IN FILE POINTER POP P,P1 ;GET FILE ADDRESS ONE MORE TIME ADDI P1,1(P2) ;GET WORD NUMBER OF END+1 OF WINDOW LOAD T1,BPW(D) ;GET BYTES PER WORD IMULI P1,(T1) ;GET BYTE NUMBER OF END+1 OF WINDOW MOVEM P1,BYTN(D) ;STORE FOR NXTW CAIG T1,1 ;UNFORMATTED? (1 BYTE PER WORD) JRST [MOVEM P2,ICNT(D) ;YES, STORE WORDS LEFT POPJ P,] HLL P2,IPTR(D) ;PUT LH OF BYTE POINTER INTO P2 MULI P2,(T1) ;CONVERT BYTE POINTER TO BYTE COUNT IN RH(P3) ADDI P3,(P2) ;ADD # BYTES LEFT IN WORD HRRZM P3,ICNT(D) ;STORE NUMBER OF BYTES LEFT IN WINDOW POPJ P, ;DONE ZERPNT: SETZM IPTR(D) ;CLEAR PNTR/COUNT SETZM ICNT(D) POPJ P, > ;IF20 IF10,< DSKOSW: MTAOSW: LOAD T1,DMODE(D) ;GET DATA MODE CAIE T1,.IODMP ;DUMP? JRST OSNDMP ;NO SKIPN BLKN(D) ;YES. NULL FILE? PUSHJ P,OSWDEL ;YES. DELETE FILE MOVX T1,D%END ;Clear EOF if any ANDCAM T1,FLAGS(D) SETZM PATNUM ;SET FOR NO PATCHING PUSHJ P,OSWREL ;Close file, release channel. PUSHJ P,OSWUPD ;Truncate file where we are now. PJRST OSWOPN ;OPEN FOR OUTPUT AGAIN OSNDMP: PUSHJ P,OSWPAT ;RECORD DATA TO TRANSFER LOAD T1,BUFAD(D) ;GET THE CURRENT BUFFER ADDRESS MOVEM T1,PATBUF ;SAVE IT (MUST DEALLOCATE IT LATER) SKIPE PATNUM ;ANY PATCHING TO DO JRST OSWNDL ;YES. CAN'T POSSIBLY BE NULL FILE ;NO. CURRENT BLOCK HAS NO RELEVANT DATA ;SO THAT ACTUAL BLOCK COUNT SHOULD ;BE DECREMENTED, UNLESS IT'S ALREADY ZERO SKIPE BLKN(D) ;IF # BLOCKS IN FILE ZERO SOSG BLKN(D) ;OR DECREMENTING IT MAKES IT ZERO PUSHJ P,OSWDEL ;DELETE FILE IF NO BLOCKS OSWNDL: PUSHJ P,OSWREL ;RELEASE THE CHANNEL PUSHJ P,OSWUPD ;TRUNCATE FILE, REWRITE LAST BLOCK PUSHJ P,OSWOPN ;REOPEN FOR UPDATE MODE MOVE T1,PATBUF ;GET THE OLD BUFFER SET PJRST %FREBLK ;DEALLOCATE IT OSWPAT: SETZM PATNUM ;INIT # OF PATCH WORDS LOAD T1,INDX(D) ;GET DEVICE INDEX MOVE T2,FLAGS(D) ;Get DDB flags TXZN T2,D%END ;Clear EOF, skip if it was on. JRST NOBACK ;No. Don't back over EOF MOVEM T2,FLAGS(D) ;Remember we cleared EOF CAIN T1,DI.DSK ;DISK? JRST YESBAK ;YES. GO BACK OVER IT SETZM BLKN(D) ;NO. WRITING A NEW FILE MOVEI T1,1 ;START RECORD COUNTER FRESH ALSO MOVEM T1,NREC(D) POPJ P, YESBAK: PUSHJ P,%BAKEF ;BACK OVER EOF SOS NREC(D) ;DECR THE RECORD COUNT NOBACK: SKIPN BLKN(D) ;NULL FILE? POPJ P, ;YES. NOTHING MORE TO DO MOVE T1,IPTR(D) ;SAVE AWAY THE PNTR MOVEM T1,PATPNT LOAD T2,BPW(D) ;GET THE # BYTES/WORD MOVE T1,IBCB(D) ;GET THE BUFFER HEADER PNTR HRRZ T1,1(T1) ;GET THE # WORDS IN THIS BUFFER JUMPE T1,NOPAT ;IF ZERO, NO PATCHING TO DO IMULI T1,(T2) ;GET THE # BYTES IN THIS BUFFER SUB T1,ICNT(D) ;GET THE # BYTES USED MOVEM T1,PATCNT ;SAVE FOR LATER LOAD T2,MODE(D) ;GET FILE MODE CAIE T2,MD.ASC ;ASCII? JRST WORDS ;NO MOVE T2,IPTR(D) ;GET BYTE PNTR SETZ T3, ;WE HAVE TO CLEAR SOME BYTES(ARGH!!!) ZBYTLP: TLNN T2,760000 ;LAST BYTE? JRST DEPBP IDPB T3,T2 ;NO. DEPOSIT A NULL JRST ZBYTLP ;THIS WILL NOT WORK FOR XTENDED ADDRESS DEPBP: MOVEM T2,IPTR(D) ;SAVE THE NEW B.P. WORDS: HRRZ T3,IPTR(D) ;GET ADDR OF LAST BYTE HRRZ T2,IBCB(D) ;GET ADDRESS OF BUFFER SUBI T3,1(T2) ;GET NUMBER OF WORDS MOVEM T3,PATNUM ;SAVE FOR DUMP MODE WRITE LATER ADDI T2,2 ;SAVE ADDR OF ACTUAL BUFFER MOVEM T2,PATADD ;SAVE ADDRESS ALSO NOPAT: LOAD T1,INDX(D) ;GET DEVICE INDEX CAIE T1,DI.MTA ;MAGTAPE? POPJ P, ;NO. WE'RE DONE PUSHJ P,%CLRBC ;COUNT ACTIVE BUFFERS PUSH P,P4 ;Get a spare perm AC MOVE P4,T1 ;Get # of active buffers OSWBKL: PUSHJ P,%BACKB SOJG P4,OSWBKL ;BACKSPACE OVER THEM POP P,P4 ;Restore P4 POPJ P, OSWDEL: LOAD T1,INDX(D) ;GET DEVICE INDEX CAIE T1,DI.DSK ;DISK? POPJ P, ;NO. DON'T DELETE THE MAGTAPE MOVEI T1,.FODLT ;DELETE THE FILE HRRM T1,FBLK(D) ;USING THE FULL FILOP BLOCK MOVEI T1,FBLK(D) HRLI T1,FLEN FILOP. T1, ; IOERR (OSW,,,?,$E,,%ABORT) $ECALL OSW,%ABORT POPJ P, OSWREL: MOVE T2,FBLK(D) ;GET CHANNEL STUFF HRRI T2,.FOCLS ;CLOSE THE FILE MOVE T1,[1,,T2] ;WITH A FILOP FILOP. T1, PUSHJ P,CLSERR MOVE T2,FBLK(D) HRRI T2,.FOREL ; AND RELEASE THE FILE MOVE T1,[1,,T2] ;WITH A FILOP FILOP. T1, PUSHJ P,CLSERR POPJ P, OSWUPD: LOAD T1,INDX(D) ;GET DEVICE INDEX CAIE T1,DI.MTA ;MAGTAPE? SKIPN T1,BLKN(D) ;OR NULL FILE? POPJ P, ;YES. NOTHING TO UPDATE MOVEM T1,LKPB+.RBALC(D) MOVE T1,[FO.PRV+FO.ASC+.FOSAU] ;UPDATE MODE MOVEM T1,FBLK(D) ;STORE IN FILOP BLOCK PUSH P,FBLK+.FOIOS(D) ;SAVE THE OLD MODE MOVEI T1,17 ;SET TO DUMP MODE MOVEM T1,FBLK+.FOIOS(D) SETZM FBLK+.FOBRH(D) ;CLEAR THE BLOCK HEADERS SETZM FBLK+.FONBF(D) ;AND # BUFFERS MOVEI T1,FBLK(D) ;SETUP FOR OPEN HRLI T1,FLEN FILOP. T1, ; IOERR (OSW,,,?,$E,) $ECALL OSW,%ABORT SKIPN PATNUM ;ANYTHING TO WRITE? JRST NDUMP ;NO MOVE T3,BLKN(D) ;GET BLOCK # OF LAST BLOCK HLLZ T2,FBLK(D) ;SETUP FOR USETO HRRI T2,.FOUSO MOVE T1,[2,,T2] FILOP. T1, ;SET TO LAST BLOCK ; IOERR (OSW,,,?,$E,,%ABORT) $ECALL OSW,%ABORT ;Must be there. MOVN T1,PATNUM ;GET # WORDS TO WRITE HRLZI T1,(T1) ;IN IOWD HRR T1,PATADD SUBI T1,1 MOVEM T1,OLST ;SETUP OUTPUT LIST SETZM OLST+1 MOVEI T3,OLST ;SETUP TO DO OUTPUT MOVE T2,FBLK(D) ;GET CHANNEL STUFF HRRI T2,.FOOUT MOVE T1,[2,,T2] ;DO THE FILOP FILOP. T1, ; IOERR (OSW,,,?,$E,) $ECALL OSW,%ABORT NDUMP: MOVE T2,FBLK(D) ;GET CHANNEL STUFF HRRI T2,.FOCLS ;CLOSE THE FILE MOVE T1,[1,,T2] FILOP. T1, PUSHJ P,CLSERR MOVE T2,FBLK(D) HRRI T2,.FOREL ;RELEASE THE FILE MOVE T1,[1,,T2] FILOP. T1, PUSHJ P,CLSERR POP P,FBLK+.FOIOS(D) ;RESTORE OLD DATA MODE POPJ P, OSWOPN: PUSHJ P,%SAVE1 ;Uses P1 MOVE T1,[FO.PRV+FO.ASC+.FOSAU] ;UPDATE MODE MOVEM T1,FBLK(D) ;STORE IN FILOP BLOCK SETZM LKPB+.RBALC(D) ;DON'T RESET THE BLOCK COUNT MOVE T1,FLAGS(D) ;Get DDB flags TXZ T1,D%IN ;Clear the input bit TXO T1,D%IO ;Set for output direction MOVEM T1,FLAGS(D) ;Store updated flags MOVX T1,D%OUT ;Set for output only PUSHJ P,ALLBUF ;AND ALLOCATE BUFFERS PUSHJ P,DOFLP ;Now do the FILOP. JRST [PUSHJ P,FLPFL ;Give error, FILOP failed JRST %ABORT] ;Forget DIALOG. SKIPN T3,BLKN(D) ;GET BLOCK # OF LAST BLOCK POPJ P, ;DON'T PROCEED IF NO DATA! LOAD T1,INDX(D) ;GET DEVICE INDEX CAIE T1,DI.DSK ;DISK? JRST OSWMOP ;NO. MAGTAPE SKIPN PATNUM ;ANY PATCHING IN THIS BLOCK? ADDI T3,1 ;NO. THEN WE WANT BEG OF NEXT ONE! HLLZ T2,FBLK(D) ;SETUP FOR USETO HRRI T2,.FOUSO MOVE T1,[2,,T2] FILOP. T1, ;SET TO LAST BLOCK PUSHJ P,CLSERR ;MIGHT NOT BE THERE OSWMOP: SKIPN PATNUM ;ANYTHING TO BLT? POPJ P, ;NO. DON'T DO INITIAL OUTPUT MOVE T2,FBLK(D) ;DO INITIAL OUTPUT HRRI T2,.FOOUT MOVE T1,[1,,T2] FILOP. T1, ; IOERR (OSW,,,?,$E,) $ECALL OSW,%ABORT HRLZ T1,PATADD ;NOW BLT THE DATA TO THE NEW BLOCK HRR T1,OPTR(D) ADDI T1,1 HRRZ T2,OPTR(D) ADD T2,PATNUM BLT T1,(T2) MOVE T1,PATPNT ;NOW FIX UP THE PNTR/COUNT HLLM T1,OPTR(D) ;PNTR FIXUP MOVE T1,PATNUM ;AND ADDR FIXUP ADDM T1,OPTR(D) MOVN T1,PATCNT ;GET NEG # BYTES USED ADDM T1,OCNT(D) ;UPDATE THE COUNT POPJ P, %LSTBF: LOAD T1,INDX(D) ;GET DEVICE INDEX CAIE T1,DI.MTA ;MAGTAPE? POPJ P, ;NO. -10 CLOSE WRITES LAST BUFFER MOVE T2,CHAN(D) ;BUT FOR MTA A TAPE MARK HRRI T2,.FOOUT ;WON'T GET WRITTEN MOVE T1,[1,,T2] ;UNLESS AN INITIAL OUTPUT IS DONE FILOP. T1, $ECALL IOE ;ERROR. DIE POPJ P, >;END IF10 SEGMENT DATA IF10,< PATADD: BLOCK 1 ;ADDRESS OF DATA TO DUMP PATNUM: BLOCK 1 ;NUMBER OF WORDS TO DUMP PATPNT: BLOCK 1 ;PNTR OF OLD BUFFER PATCNT: BLOCK 1 ;COUNT OF BYTES USED IN OLD BUFFER PATBUF: BLOCK 1 ;BUFFER BLOCK ALLOCATED OLST: BLOCK 2 ;DUMP I/O LIST >;END IF10 SEGMENT CODE IF20,< ;HERE FOR SEQINOUT MTA ONLY ON READ WHEN FILE IS OPEN FOR OUTPUT MTAISW: PUSHJ P,%LSTBF ;WRITE LAST BUFFER MOVE T1,WSIZ(D) ;GET WINDOW SIZE SUB T1,ICNT(D) ;GET # ACTIVE BYTES SKIPE IPTR(D) ;IF WE WROTE ANY DATA MOVEM T1,WCNT(D) ;PRETEND WE READ THEM SETZM ICNT(D) ;BUFFER HAS NO MORE BYTES IN IT PUSHJ P,CLSOPN ;CLOSE FILE, OPEN FOR INPUT LOAD T1,IJFN(D) ;%LSTBF (ABOVE) WROTE AN EOF MARK, BACK OVER IT MOVEI T2,.MONOP ;FIRST WAIT FOR I/O TO STOP MTOPR% MOVEI T2,.MOBKR ;DO THE BACKSPACE MTOPR% MOVEI T2,.MONOP ;WAIT FOR TAPE TO STOP MTOPR% POPJ P, ;DONE %LSTBF: PUSHJ P,%SAVE2 ;SAVE P1,P2 DMOVE P1,OPTR(D) ;GET PNTR/COUNT JUMPE P1,LSBCLS ;IF NO I/O YET, NOTHING MUCH TO DO XMOVEI T1,(P1) ;GET JUST ADDRESS OF LAST DATA CAMGE T1,WADR(D) ;ANY DATA IN WINDOW? JRST LSBCLS ;NO. JUST WRITE EOF MARK LOAD T1,IJFN(D) ;GET JFN HRRO T2,WADR(D) ;GET BUFFER ADDR MOVE T3,FLAGS(D) ;Unformatted? TXNE T3,D%UNF ; ? HRLI T2,(POINT 36) ;YES. GET 36-BIT PNTR MOVN T3,WSIZ(D) ;GET WINDOW SIZE JUMPLE P2,.+2 ;IF MIDDLE OF WINDOW, DECREMENT BYTE COUNT ADD T3,P2 SOUTR% ;OUTPUT THE BUFFER LSBCLS: LOAD T1,INDX(D) ;GET DEVICE INDEX CAIE T1,DI.MTA ;MAGTAPE? POPJ P, ;NO LOAD T1,IJFN(D) ;GET JFN AGAIN MOVEI T2,.MONOP ;WAIT FOR I/O TO STOP MTOPR% MOVEI T2,.MOEOF ;WRITE AN EOF MARK MTOPR% MOVEI T2,.MONOP ;AND WAIT AGAIN MTOPR% POPJ P, %CLSOP: CLSOPN: LOAD T1,OJFN(D) ;CLOSE FILE HRLI T1,(CO%NRJ) ;KEEP JFN CLOSF% ; IOERR (ISW,31,,?,$J,,%ABORT) $ECALL ISW,%ABORT LOAD T1,IJFN(D) ;GET JFN AGAIN (WITHOUT BITS IN LH) MOVE T2,DMBS(D) ;GET DATA MODE & BYTE SIZE FOR OPENF TRO T2,OF%RD ;SET FOR INPUT OPENF% ;REOPEN FILE $ECALL ISW,%ABORT POPJ P, ;HERE FOR SEQINOUT MTA ONLY ON WRITE WHEN TAPE IS OPEN FOR INPUT MTAOSW: MOVE T1,FLAGS(D) ;Get DDB flags TXZN T1,D%END ;CLEAR ALL EOF BITS JRST MTANEF ;NOT AT EOF MOVEM T1,FLAGS(D) ;Remember we cleared the EOF flag SETZM BLKN(D) ;IF IT WAS EOF, NEW FILE! MOVEI T1,1 ;SET RECORD NUMBER FRESH ALSO MOVEM T1,NREC(D) JRST MTACLO ;AND JUST GO CLOSE AND REOPEN MTANEF: SKIPN IPTR(D) ;ANY I/O DONE YET? JRST MTACLO ;NO. GO CLOSE, OPEN LOAD T1,IJFN(D) ;GET JFN MOVEI T2,.MONOP ;WAIT FOR I/O TO FINISH MTOPR% MOVEI T2,.MOBKR ;BACKSPACE RECORD MTOPR% MOVEI T2,.MONOP ;AND WAIT FOR IT TO FINISH AGAIN MTOPR% MOVE T1,WSIZ(D) ;GET WINDOW SIZE SUB T1,WCNT(D) ;GET UNUSED BYTES IN WINDOW ADDM T1,OCNT(D) ;RESTORE FULL WINDOW SIZE MTACLO: LOAD T1,IJFN(D) ;REOPEN FILE FOR OUTPUT HRLI T1,(CO%NRJ) CLOSF% $ECALL OSW,%ABORT LOAD T1,OJFN(D) MOVE T2,DMBS(D) TRO T2,OF%WR OPENF% $ECALL OSW,%ABORT POPJ P, >;END IF20 SUBTTL MOVE ARGUMENTS TO DDB ;** Warning: Uses P1-P4 OPNARG: PUSHJ P,DFDEV ;Setup default device PUSHJ P,DFFILE ; and filename for this unit OARGLP: LDB P1,[POINTR @%LTYPE,ARGKWD] ;GET NEXT ARG KEYWORD CAILE P1,OPNMAX ;RANGE CHECK SKIPA T1,[OPNERR] ;OUT OF BOUNDS, ERROR HLRZ T1,OPNDSP(P1) ;POINT TO ROUTINE FOR THIS ARG IF10,< MOVE T2,OPARGN(P1) ;Get address of ASCIZ arg name MOVEM T2,%ARGNM ; To type incase errors > PUSHJ P,(T1) ;PUT ARG INTO DDB AOBJN L,OARGLP ;GO DO NEXT ARG POPJ P, ;ALL DONE, RETURN ;Here is the routine for CLOSE CLSARG: PUSHJ P,DFDEV ;Setup default device PUSHJ P,DFFILE ; and filename for this unit CLARGL: LDB P1,[POINTR @%LTYPE,ARGKWD] ;Get next arg keyword CAILE P1,OPNMAX ;Range check SKIPA T1,[OPNERR] ;Out of bounds, error HLRZ T1,CLSDSP(P1) ;Point to routine for this arg PUSHJ P,(T1) ;Call routine AOBJN L,CLARGL ;Go do next arg POPJ P, ;All done, return ;Routine to call when an OPEN arg is used in CLOSE but it is meaningless. CLIGN: MOVE T1,P1 ;Get switch number MOVEI T2,OPNSWT ;Switch table PUSHJ P,FNDSWT ;Get t1= addr of ASCII arg. $ECALL NCK,%POPJ ;?Not a CLOSE keyword, ignored ;UNIT= OPNUNT: POPJ P, ;Return (we've already range-checked it ; and put it in unit block). OPNKWD: IF20,< XMOVEI T1,ATMBUF ;MOVE ARG TO ATMBUF PUSHJ P,MVARG > IF10,< PUSHJ P,MAKEBP ;Get BP to arg in %SRCBP PUSHJ P,PRSSWV ;Parse the switch value JRST REQDIA ;?Error, request DIALOG > HRRZ T1,OPNDSP(P1) ;POINT TO KEYWORD TABLE HRROI T2,ATMBUF ;POINT TO KEYWORD PUSHJ P,TABLK ;LOOK UP KEYWORD IN TABLE JRST KWDUNK ;NOT THERE JRST KWDAMB ;AMBIGUOUS HRRZ T2,(T1) ;GET VALUE JRST OPNDPB ;GO STORE IT IN DDB ;Keyword recognizer for CLOSE keywords CLSKWD: IF20,< XMOVEI T1,ATMBUF ;MOVE ARG TO ATMBUF PUSHJ P,MVARG > IF10,< PUSHJ P,MAKEBP ;Get BP to arg in %SRCBP PUSHJ P,PRSSWV ;Parse the switch value JRST REQDIA ;?Error, request DIALOG > HRRZ T1,CLSDSP(P1) ;POINT TO KEYWORD TABLE HRROI T2,ATMBUF ;POINT TO KEYWORD PUSHJ P,TABLK ;LOOK UP KEYWORD IN TABLE JRST KWDUNK ;NOT THERE JRST KWDAMB ;AMBIGUOUS HRRZ T2,(T1) ;GET VALUE JRST OPNDPB ;GO STORE IT IN DDB OPNERR:; IOERR (UOA,30,503,%,,,%POPJ) $ECALL UOA,%POPJ KWDUNK: XMOVEI P2,[ASCIZ /Unknown/] TRNA KWDAMB: XMOVEI P2,[ASCIZ /Ambiguous/] MOVEI T1,(P1) ;GET KWD NUMBER MOVEI T2,OPNSWT ;POINT TO SWITCH TABLE PUSHJ P,FNDSWT ;FIND ASCII NAME OF SWITCH XMOVEI T5,ATMBUF ;Point to atom buffer ; IOERR (ESV,30,241,?,$A keyword value /$Z$Z,,REQDIA) $ECALL ESV,REQDIA OPNINT: MOVE T2,@(L) ;GET ARG JRST OPNDPB ;Go store it in DDB OPNADR: XMOVEI T2,@0(L) ;Get arg address JRST OPNDPB ;GO STORE IT IN DDB OPNSET: SKIPA T2,[1] ;GET A TURNED-ON BIT OPNCHR: LDB T2,[POINT 7,@(L),6] ;GET FIRST CHAR OF STRING OPNDPB: XCT OPSTOR(P1) ;STORE IN DDB POPJ P, ;RETURN ;Get next char from source string ;Returns char in T1 DPRCHR: PUSHJ P,DPRCHS ;Get char CAIN T1," " ;Ignore spaces JRST DPRCHR POPJ P, ;Return ;Same as DPRCHR but space not ignored ;P4= # chars possibly left to parse DPRCHS: SOJL P4,DPRNUL ;Return null if string ran out ILDB T1,SRCBP AOS %NCHRR POPJ P, ;Return DPRNUL: SETZ T1, POPJ P, OPNDEV: PUSHJ P,MAKEBP ;Setup SRCBP, %NCHRR, P4 PUSHJ P,PRSDEV ;Parse the device name JRST REQDIA ;?Error, request dialog TXO F,F%DSS ;Remember device specified IF10,< MOVE T1,ATMBUF ;Put in DEV(D) MOVEM T1,DEV(D) > IF20,< MOVE T1,[POINT 7,ATMBUF] MOVE T2,[POINT 7,DEV(D)] ILDB T3,T1 IDPB T3,T2 JUMPN T3,.-2 > TXO F,F%DSS ;Remember device specified POPJ P, ;Return IF10,< PRSDEV: MOVE T3,[POINT 6,ATMBUF] ;Store sixbit in atom buffer SETZM ATMBUF PRSDV1: PUSHJ P,DPRCHS ;Get next char JUMPE T1,%POPJ1 ;end ok CAIE T1," " ;Space is legal end CAIN T1,":" ;Colon ends JRST %POPJ1 PUSHJ P,DPRCSX ;Else must be plain sixbit char POPJ P, ;?Problem, return .+1 TLNE T3,770000 ;Room? IDPB T1,T3 ;Yes, store char JRST PRSDV1 ;Loop until end >;END IF10 IF20,< PRSDEV: MOVE T3,[POINT 7,ATMBUF] PRSDV1: PUSHJ P,DPRCHS ;Get char JUMPE T1,PRSDVE ;End CAIE T1," " ;Space CAIN T1,":" ;or colon JRST PRSDVE ;Is ok end IDPB T1,T3 ;Store char JRST PRSDV1 ;Loop PRSDVE: SETZ T1, ;Store null to end IDPB T1,T3 JRST %POPJ1 ;Return ok >;END IF20 IF20,< ;to be fixed later.. OPNFIL: TXO F,F%FSS ;Remember filespec stuff supplied XMOVEI T1,FILE(D) ;POINT TO PLACE TO PUT FILENAME MOVX T2,1_'.' ;TERMINATE ON DOT PUSHJ P,MVARGX ;MOVE FILENAME TO DDB CAIE T1,"." ;WAS IT TERMINATED BY DOT? POPJ P, ;NO, THAT'S IT TXO F,F%EXT ;REMEMBER EXTENSION SPECIFIED XMOVEI T1,EXT(D) ;POINT TO PLACE FOR EXTENSION MOVX T2,1_'.' ;TERMINATE ON DOT PUSHJ P,MOVARG ;MOVE EXT TO DDB IF20,< CAIE T1,"." ;GENERATION NUMBER SPECIFIED? POPJ P, ;NO, DONE XMOVEI T1,ATMBUF ;POINT TO DEST FOR GENERATION NUMBER PUSHJ P,MOVARG ;MOVE IT THERE MOVEI T1,ATMBUF ;POINT TO IT AGAIN PUSHJ P,ASCDEC ;CONVERT IT TO BINARY ; ERR (IGN,?,Illegal generation number $A,<0(L)>) $ECALL IGN,REQDIA JUMPL T1,GENNOK ;Jump if -n TLNE T1,-1 ;IN RANGE? $ECALL IGN,REQDIA ;No GENNOK: HRRZM T1,xGEN(D) ;Store in DDB > POPJ P, ;DONE >;END IF20 to be done later.. IF10,< OPNFIL: PUSHJ P,MAKEBP ;Setup SRCBP PUSHJ P,PRSFIL ;Parse the file info JRST REQDIA ;?Error, request dialog POPJ P, ;Ok, return PRSFIL: PUSHJ P,DPRFNM ;Parse filename POPJ P, ;?failed MOVE T2,ATMBUF ;Get atom (sixbit filename) MOVEM T2,FILE(D) ;Store filename TXO F,F%FSS ;Remember filespec stuff CAIE T1," " ;Space CAIN T1,0 ; or null JRST %POPJ1 ;means we're done. CAIE T1,"." ;Must be "." then $SNH TXO F,F%EXT ;Remember extension specified PUSHJ P,DPRFEX ;Parse extension POPJ P, ;?Ill char HLLZ T2,ATMBUF ;Get atom (sixbit ext.) HLLZM T2,EXT(D) ;Store it JRST %POPJ1 ;Return ok ;Parse a filename DPRFNM: MOVE T3,[POINT 6,ATMBUF] SETZM ATMBUF ;Ready for filename DPRFN1: PUSHJ P,DPRCHS ;Get char JUMPE T1,%POPJ1 ;Null ok end CAIE T1," " ;Also space CAIN T1,"." ; and dot (start of ext.) JRST %POPJ1 ;Done PUSHJ P,DPRCSX ;Else must be sixbit POPJ P, ;?no, error TLNE T3,770000 ;Store char if we can IDPB T1,T3 JRST DPRFN1 ;Loop ;Parse a file extension DPRFEX: MOVE T3,[POINT 6,ATMBUF] SETZM ATMBUF ;Ready for filename DPRFX1: PUSHJ P,DPRCHS ;Get char CAIE T1," " CAIN T1,0 ;Space or null ok JRST %POPJ1 PUSHJ P,DPRCSX ;Else must be sixbit POPJ P, ;?no, error TLNE T3,770000 ;Room? IDPB T1,T3 ;Yes, store char JRST DPRFX1 ;Loop >;END IF10 IF20,< OPNDIR: TXO F,F%FSS ;Remember filespec stuff MOVE T1,@(L) ;GET FIRST WORD OF ARG TLNN T1,(177B6) ;LEADING ASCII CHAR NULL? JRST OPNPPN ;YES, IT'S A PPN XMOVEI T1,DIR(D) ;POINT TO PLACE TO STORE STRING MOVEI T2,1 ;Break at first space PUSHJ P,MAKEBP ;CREATE SOURCE/DEST BP MOVEI P4,^D79 ;UP TO DEST SIZE PJRST MOVARG ;GO TRANSFER ARG OPNPPN: TLNE T1,-1 ;PROJECT NUMBER IN LH? JRST OPNPP1 ;YES, XWD FORMAT HRLZ T1,T1 ;No, doubleword format AOS (L) ;BUMP TO SECOND WORD HRR T1,@(L) ;PUT IN PROGRAMMER NUMBER OPNPP1: JUMPE T1,%POPJ ;ZERO MEANS "DEFAULT PATH" MOVEM T1,DIR(D) ;STORE PPN TXO F,F%PPN ;REMEMBER IT'S A PPN, NOT A STRING POPJ P, ;DONE >;END IF20 IF10,< OPNDIR: TXO F,F%FSS ;Remember he supplied filespec info PUSHJ P,%SAVE3 ;SAVE P1-P2 LDB T1,[POINTR @%LTYPE,ARGTYP] ;GET ARG TYPE CAIN T1,TP%LIT ;ASCIZ LITERAL? JRST OPPNST ;YES MOVE P1,%SIZTB(T1) ;GET ELEMENT SIZE IN WORDS MOVE T1,@(L) ;GET FIRST WORD OF ARG TLNE T1,-1 ;PROJECT NUMBER IN LH? JRST OPNPP1 ;YES, XWD FORMAT HRLZ T1,T1 ;NO, DOUBLEWORD FORMAT AOS (L) ;BUMP TO SECOND WORD HRR T1,@(L) ;PUT IN PROGRAMMER NUMBER OPNPP1: JUMPE T1,%POPJ ;ZERO MEANS DEFAULT PATH MOVEM T1,PTHB+.PTPPN(D) ;STORE PPN MOVEI P2,.PTPPN+1 ;POINT TO PLACE FOR FIRST SFD MOVEI P3,5 ;Max # SFD's. AOSA (L) ;BUMP PAST PPN WORD OPPNLP: ADDM P1,(L) ;BUMP TO NEXT ARGUMENT SKIPN @(L) ;END OF LIST? POPJ P, ;YES, DONE XMOVEI T1,PTHB(D) ;POINT TO PATH BLOCK ADDI T1,(P2) ;POINT TO DEST FOR SFD NAME PUSHJ P,MVARG ;MOVE SFD NAME INTO PATH BLOCK SOJLE P3,%POPJ ;If done 5 SFD's, return now. AOJA P2,OPPNLP ;COPY WHOLE THING OPPNST: PUSHJ P,MAKEBP ;Get SRCBP= BP to arg. PUSHJ P,DPTH ;Go parse path JRST REQDIA ;Error, go request dialog POPJ P, ;Success, return >;END IF10 IF20,< SETPROT: TXO F,F%FSS ;Remember he typed filespec info HRLZ T1,T2 ;Put binary protection in LH MOVEI T0,6 ;GET DIGIT COUNT MOVEI T3,PROT(D) ;POINT TO PROTECTION BUFFER HRLI T3,(POINT 7,) ; FOR CONVERSION TO ASCIZ PRTLP: MOVEI T2,"0"_-3 ;GET HALF A DIGIT ROTC T1,3 ;GET OTHER HALF DIGIT FROM PROT IDPB T2,T3 ;STORE IN BUFFER SOJG T0,PRTLP ;DO 6 DIGITS SETZ T2, ;TERMINATE WITH NULL IDPB T2,T3 POPJ P, > IF10,< SETPROT: TXO F,F%FSS ;Remember he typed filespec info DPB T2,[POINTR (PROT(D),RB.PRV)] ;STORE IN DDB POPJ P, > OPNDIA: XMOVEI P3,@0(L) ;Get arg address JUMPE P3,RQDIAX ;IF DIALOG WITHOUT ARGUMENT, GO REQUEST DIALOG TXO F,F%DSTRG ;SET DIALOG FROM STRING MOVEM P3,DIASAG ;Save DIALOG string arg. LDB T1,[POINTR @%LTYPE,ARGTYP] ;Get arg type MOVEM T1,DIASAT ;Save arg type POPJ P, ;Return for more args. IF20,< ;PUSHJ HERE AFTER CSB INITIALIZED TO MOVE DIALOG ARG TO TEXTI BUFFER DIABLT: $BLDBP P3 ;Get 7-bit byte ptr in P3 MOVEM P3,SRCBP ;Store BP to arg MOVEI P4,LTEXT*5-1 ;MAX STRING LENGTH IS SIZE OF BUFFER XMOVEI T1,TXTBUF ;POINT TO BUFFER MOVX T2,1_' ' ;DIALOG STRING IS TERMINATED BY SPACE MOVE T3,DIASAT ;Get arg type CAIN T3,TP%LIT ;IS IT ASCIZ? SETZ T2, ;YES, IT CAN INCLUDE IMBEDDED SPACES PUSHJ P,MOVARG ;MOVE ARG TO BUFFER JUMPGE T2,.+2 ;DID MOVARG TERMINATE NORMALLY? ; ERR (DTL,?,Dialog string too long) ;NO $ECALL DTL ;?Dialog string too long MOVEI T1,12 ;OVERWRITE TERMINATING NULL WITH A LF DPB T1,DSTBP ; TO STOP COMND JSYS SUBI P4,LTEXT*5 ;CALCULATE NUMBER OF CHARS IN STRING MOVNM P4,CSB+.CMINC ;STORE IN CSB AS IF TEXTI HAD READ THE STRING POPJ P, ;RETURN TO DIALOG SCANNER > ;IF20 REQDIA: SKIPGE I.BAT## ;BATCH? JRST %ABORT ;YES, DON'T TRY TO DIALOG WITH A .CTL FILE TXO F,F%DRE ;Error condition caused us to go do DIALOG. RQDIAX: TXO F,F%DIALOG ;REQUEST DIALOG POPJ P, ;RETURN FROM ROUTINE CONTAINING ERROR ;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 > IF10,< ;PRESERVES T5 TABLK: PUSHJ P,%SAVE3 ;SAVE P1-P3 MOVE P1,(T2) ;GET FIRST WORD OF SIXBIT STRING MOVSI P3,(IFIW (T1)) ;MAKE POINTER TO SWITCH TABLE IN P3 HRRI P3,(T1) MOVN T2,P1 ;GET RIGHTMOST BIT PRESENT IN WORD AND T2,P1 JFFO T2,.+1 ;GET BIT NUMBER OF RIGHTMOST BIT IDIVI T3,6 ;GET BYTE NUMBER OF THE BIT LSH T2,-5(T4) ;RIGHT-JUSTIFY BIT WITHIN BYTE MOVN P2,T2 ;MAKE MASK OF CHARS PRESENT IN THE WORD HLRZ T1,(P3) ;SET TABLE INDEX TO TOP OF TABLE SETO T4, ;INITIALIZE COUNT OF MATCHING SWITCHES TABLP: HLRZ T2,@P3 ;GET ADDRESS OF A SWITCH MOVE T3,(T2) ;GET FIRST WORD OF THE SWITCH CAMN T3,P1 ;EXACT MATCH SOJA T1,TABWIN ;YES, WIN NOW AND T3,P2 ;MASK OUT IGNORED TRAILING CHARS CAMN T3,P1 ;MATCH? AOJA T4,.+2 ;YES, COUNT AND KEEP LOOKING CAMLE T3,P1 ;DOES IT MATCH SWITCH WE'RE LOOKING FOR? SOJG T1,TABLP ;NO MATCH AND NOT PAST SWITCH YET, LOOP TABEND: JUMPL T4,%POPJ ;NO MATCHES, NONSKIP RETURN CAME P1,(T2) ;EXACT MATCH ALWAYS WINS JUMPG T4,%POPJ1 ;MORE THAN ONE MATCH, AMBIGUOUS RETURN TABWIN: ADDI T1,1(P3) ;CONVERT OFFSET TO ADDRESS JRST %POPJ2 ;EXACTLY ONE MATCH, FINE > ;ROUTINE TO MOVE AN ASCII ARGUMENT TO SOME LOCAL BUFFER ;ARGS: T1 = ADDRESS OF 1-WORD (10) OR 16-WORD (20) BUFFER TO PUT ARG IN ; L = ADDRESS OF FORTRAN ARGUMENT POINTER ;RETURNS WITH ARGUMENT MOVED MVARG: SETZ T2, ;STOP TRANSFER ONLY WHEN WHOLE STRING MOVED MVARGX: PUSHJ P,MAKEBP ;GET P3 = 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 ; P4 = NUMBER OF CHARS IN STRING MAKEBP: XMOVEI T0,@0(L) ;Point to arg $BLDBP T0 ;Get a byte ptr. MOVEM T0,SRCBP ;Store in SRCBP. SETZM %NCHRR ;Clear char counter LDB T0,[POINTR @%LTYPE,ARGTYP] ;GET ARG TYPE MOVEI P4,^D10 ;GUESS DOUBLEWORD, 10 CHARS CAIL T0,TP%DPR ;IS IT DOUBLE? CAILE T0,TP%CPX MOVEI P4,^D5 ;NO, SINGLE IS 5 CHARS CAIN T0,TP%LIT ;LITERAL STRING? MOVEI P4,^D79 ;YES, ONLY LIMIT IS SIZE OF DEST BUFFER POPJ P, ;DONE IF20,< ;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: T1 = 30-BIT ADDRESS OF 8-WORD BLOCK TO PUT STRING INTO ; T2 = MASK OF BREAK CHARS WITH BIT 1_N ON IF CHAR 40+N TERMINATES ARG ; SRCBP = Ptr to arg. ; P4 = CHAR COUNT ; ;RETURN: T1 = CHAR THAT TERMINATED ARG, OR -1 IF SOURCE STRING EXHAUSTED ; SRCBP, P4 UPDATED MOVARG: $BLDBP T1 ;Get BP to dest. string MOVEM T1,DSTBP BMVALP: ILDB T1,SRCBP ;GET A BYTE JUMPE T1,MVAEND ;DONE IF NULL CAIE T1,' ' ;SKIP LEADING BLANKS JRST MVAL1 ;NON-BLANK CHAR SOJG P4,BMVALP ;BLANK SETO T1, ;FLAG END OF STRING FOUND JRST MVAEND MVALP: ILDB T1,SRCBP ;GET A BYTE JUMPE T1,MVAEND ;NULL, DONE MVAL1: MOVEI T0,1 ;GET BIT LSH T0,-40(T1) ;SHIFT OVER TDNE T0,T2 ;CHECK CHAR IN BREAK MASK SOJA P4,MVAEND ;BREAK CHAR, DONE CAIN T1," " ;SPACE? JRST MVANXT ;YES, IGNORE IT CAIL T1,"a" ;CONVERT LOWER CASE TO UPPER CASE CAILE T1,"z" JRST .+2 ;NOT LC SUBI T1,40 ;LC, CONVERT IDPB T1,DSTBP ;STORE CHAR IN DEST STRING MVANXT: SOJG P4,MVALP ;COPY WHOLE STRING SETO T1, ;FLAG STRING TERMINATED BY NO MORE CHARS MVAEND: SETZ T0, ;TERMINATE DEST STRING WITH A NULL IDPB T0,DSTBP POPJ P, ;ALL DONE >;END IF20 IF10,< ;ROUTINE TO MOVE ARG TO LOCAL AREA, STANDARDIZING IT ;CONVERTS TO SIXBIT, REMOVES SPACES & CONTROL CHARS, TRUNCATES TO 6 CHARS ;COPIES ARG UNTIL IT ENDS OR UNTIL A BREAK CHAR ; ;ARGS: T1 = ADDRESS OF WORD TO STORE ARG IN ; T2 = MASK OF BREAK CHARS ; SRCBP = SOURCE BYTE PTR. ; P4 = CHAR COUNT ;RETURN: T1 = TERMINATING CHAR, OR -1 IF SOURCE STRING EXHAUSTED ; SRCBP, P4 UPDATED MOVARG: SETZM (T1) ;CLEAR DEST WORD MOVEI T3,(T1) ;MAKE BYTE POINTER TO DEST STRING HRLI T3,(POINT 6,) MVALP: ILDB T1,SRCBP ;GET SOURCE BYTE JUMPE T1,%POPJ ;NULL, DONE MOVEI T0,1 ;GET A BIT LSH T0,-40(T1) ;SHIFT OVER TDNN T0,T2 ;CHECK CHAR IN BREAK MASK CAIN T1,"," ;COMMA TOO POPJ P, ;BREAK CHAR, DONE CAIE T1,"[" ;OTHER BREAKS? CAIN T1,"]" POPJ P, ;YES, RETURN CAIG T1," " ;SPACE OR CONTROL CHAR? JRST MVANXT ;YES, INGORE IT CAIL T1,"a" ;LOWER CASE? CAILE T1,"z" SUBI T1,40 ;NO, CONVERT TO SIXBIT TLNE T3,770000 ;ALREADY HAVE 6 CHARS IN DEST STRING? IDPB T1,T3 ;NO, PUT THIS ONE IN MVANXT: SOJG P4,MVALP ;COPY WHOLE STRING SETO T1, ;RAN OUT, SET FLAG POPJ P, ;ALL DONE >;END IF10 SEGMENT DATA %SRCBP:: ;Non-indexed source BP SRCBP: BLOCK 1 ;Source byte ptr DSTBP: BLOCK 1 ;Destination byte ptr %NCHRR:: BLOCK 1 ;# chars read from SRCBP so far ; (Used by FORERR) IF10,< %ARGNM:: BLOCK 1 ;Addr of ASCII name of arg. > DIASAG: BLOCK 1 ;Address of DIALOG='string' DIASAT: BLOCK 1 ;Arg type for DIALOG='string' arg. SEGMENT CODE ;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, DECSIX: MOVE T3,[POINT 6,T4] SETZ T4, PUSHJ P,DECSX1 MOVE T1,T4 POPJ P, DECSX1: IDIVI T1,12 JUMPE T1,DECSX2 PUSH P,T2 PUSHJ P,DECSX1 POP P,T2 DECSX2: ADDI T2,'0' IDPB T2,T3 POPJ P, ;ASCDEC -- ASCII to DECIMAL conversion routine. ;Input: ; T1/ 18-bit address. ;Call: ; PUSHJ P,ASCDEC ; ; ;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 ;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 @%LTYPE,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 @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST MOVEI T1,OK.ERR ;GET KWD VALUE FOR /ERR CAMLE L,[-3,,-1] ;AT LEAST 3 ARGS PRESENT? POPJ P, ;No, done PUSH P,L ADDI L,2 ;Point to /ERR arg DPB T1,[POINTR @%LTYPE,ARGKWD] ;Store /ERR keyword POP P,L POPJ P, ;Return RLSCNV: HLRZ T1,L ;GET ARG COUNT CAIE T1,-1 ;MUST BE EXACTLY 1 ARG ; IOERR (WNA,33,504,?,Wrong number of arguments,,%ABORT) $ECALL WNA,%ABORT MOVEI T1,OK.UNIT ;GET KWD VALUE FOR /UNIT DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST POPJ P, ;DONE 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. & ;ROUTINE TO PUT DEFAULT FIELDS INTO A DDB ;ARGS: D = DDB ADDRESS ;(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,DFDIR ; DIRECTORY ; PUSHJ P,DFFILE ; FILENAME PUSHJ P,DFBUF ; BUFFER COUNT PUSHJ P,DFMODE ; MODE [CAN IMPLY /FORM, /TAPEMODE] PUSHJ P,DFSTAT ; STATUS [CAN IMPLY /DISP] PUSHJ P,DFACC ; ACCESS [INTERACTS WITH /STAT, /READONLY] PUSHJ P,DFDISP ; DISPOSE [IF NOT SET ABOVE] PUSHJ P,DFFORM ; FORM [IF NOT SET ABOVE] POPJ P, ;DONE ;*** SPOOLED LPT HAS UNIT = -1 AND DEV=.DVLPT IF20,< 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,[ASCII "DSK"] ;NO, USE DEFAULT MOVEM T1,DEV(D) ;STORE DEVICE NAME POPJ P, ;Return ;Routine to check out device and get information about it DFDEV1: HRROI T1,DEV(D) ;POINT TO DEVICE NAME STDEV% ;GET DEVICE DESIGNATOR ERJMP .+2 JRST DFDVCH ;OK XMOVEI T1,DEV(D) ;Get address of device name for error msg ; IOERR (NSD,30,245,?,No such device $A,,REQDIA) $ECALL NSD,REQDIA DFDVCH: MOVE T1,T2 ;PUT DEVICE DESIGNATOR IN RIGHT AC MOVEM T1,DVICE(D) ;Save device designator CAMN T1,TT.DES## ;OPENING CONTROLLING TTY? TXO F,F%CTTY ;YES, REMEMBER THAT DVCHR% ;GET DEVCHR WORD LDB T1,[POINT 9,T2,17] ;GET DEVICE TYPE STORE T1,DVTYP(D) ;STORE THAT CAIE T1,.DVTTY ;IS DEVICE A TTY? CAIN T1,.DVPTY ; OR PTY? TXZ T2,DV%M10 ;NO IMAGE MODE CAIN T1,.DVMTA ;IS DEVICE A MAGTAPE? TXO T2,DV%M10 ;ALLOW IMAGE MODE STORE T2,LGLM(D) ;STORE LEGAL DATA MODES ROT T2,2 ;GET INPUT/OUTPUT BITS STORE T2,IO(D) ;STORE THAT ;Figure out appropriate INDX(D) -- device type index LOAD T1,DVTYP(D) ;Get device type MOVEI T2,DI.OTHR ;Guess type "other" CAIN T1,.DVDSK ;Disk? MOVEI T2,DI.DSK ;Yes CAIN T1,.DVMTA ;Tape? MOVEI T2,DI.MTA ;Yes CAIN T1,.DVTTY ;TTY? MOVEI T2,DI.TTY LOAD T3,ACC(D) ;Get ACCESS CAIN T3,AC.APP ;APPEND? CAIN T1,.DVMTA ;Yes, not tape? JRST .+2 ;No MOVEI T2,DI.OTHR ;Append and non-tape, use SOUTS STORE T2,INDX(D) ; . . JRST %POPJ1 ;No error--Skip return DFDIR: TXNN F,F%PPN ;DID USER GIVE DIRECTORY=PPN? POPJ P, ;NO, GREAT HRROI T1,ATMBUF ;TRANSLATE PPN TO DIRECTORY STRING MOVE T2,DIR(D) ;GET PPN HRROI T3,DEV(D) ;POINT TO DEVICE NAME PPNST% ;TRANSLATE IT ERJMP PPNERR ;ERROR, GO BITCH MOVE P3,[POINT 7,ATMBUF] ;INITIALIZE STRING POINTER MOVEM P3,SRCBP MOVEI P4,LATOM*5 ;AND COUNT XMOVEI T1,ATMBUF ;MOVE STRING TO SELF MOVSI T2,(1_'<') ;UNTIL START OF DIRECTORY NAME PUSHJ P,MOVARG ;SKIP TO LEFT ANGLE BRACKET XMOVEI T1,DIR(D) ;NOW POINT TO REAL DESTINATION MOVSI T2,(1_'>') ;TERMINATE ON END OF DIRECTORY NAME PUSHJ P,MOVARG ;MOVE DIRECTORY TO DDB, RETURN TXZ F,F%PPN ;DIRECTORY IS NO LONGER STORED AS PPN POPJ P, PPNERR:; IOERR (PPN,30,405,?,$J,,REQDIA) $ECALL PPN,REQDIA ;STILL IF20 DFFILE: SKIPE FILE(D) ;FILENAME SET? JRST DFEXT ;YES, GO CHECK EXT MOVE T1,[ASCII "FOR0"] ;GET PART OF DEFAULT FILENAME MOVEM T1,FILE(D) ;STORE IN DDB HXRE T1,UNUM(U) ;GET UNIT NUMBER JUMPL T1,DFFILX ;NEGATIVE UNITS ARE SPECIAL MOVE T2,[POINT 7,FILE(D),27] ;POINT TO AFTER "FOR0" CAIL T1,^D10 ;UNLESS UNIT NUMBER IS OVER 10 MOVE T2,[POINT 7,FILE(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,FILE(D) ;SAVE IN DDB DFEXT: TXNN F,F%EXT ;EXT SPECIFIED BY FILE=? SKIPE EXT(D) ;NO, EXTENSION ALREADY SET? POPJ P, ;YES, DONE MOVE T1,[ASCIZ "DAT"] ;NO, SET DEFAULT MOVEM T1,EXT(D) POPJ P, >;END IF20 ;***TY.SPL & TY.VAR IF10,< 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 PUSHJ P,DECSIX ;CONVERT UNIT NUMBER TO SIXBIT MOVEM T1,DEV(D) ;SAVE IN DDB DEVCHR T1, ;SEE IF DEVICE EXISTS ;BL; Change at DFDEV+7 (if10) Q10-05829 ; JUMPN T1,DFDVCH ;YES, USE UNIT NUMBER AS DEVICE NAME 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 MOVSI T1,'DSK' ;NOT IN TABLE, USE DEFAULT MOVEM T1,DEV(D) ;SAVE IN DDB POPJ P, ;Return, default device set. DFDIR==%POPJ ;NO DIRECTORY PROCESSING NECESSARY ;Routine to check out device and get information about it DFDEV1: MOVE T1,DEV(D) ;Get sixbit device name IONDX. T1, ;GET UDX SETO T1, CAMN T1,TT.DES## ;OPENING CONTROLLING TTY? TXO F,F%CTTY ;YES, REMEMBER THAT MOVE T1,DEV(D) ;Get device name DEVCHR T1, ;GET DEVCHR WORD JUMPN T1,DFDVCH ;GOT IT, GO SAVE IT ; IOERR (NSD,30,245,?,No such device $S,,REQDIA) $ECALL NSD,REQDIA DFDVCH: TXNN T1,DV.TTY ;Is device a TTY? JRST DFDVC1 ;No, FOROTS allows every mode that ; the monitor allows. TXNN T1,DV.MTA ;If this is also set, device is NUL: - skip. TXZ T1,DV.M17!DV.M14!DV.M10 ;TTY: -- Don't allow DUMP,BINARY,IMAGE. DFDVC1: STORE T1,LGLM(D) ;STORE LEGAL DATA MODES SETZ T0, ;Assume this is not a directory device TXNE T1,DV.DIR ;Is it? SETO T0, ;Yes, set flag STORE T0,DRDVF(D) ;. . SETZ T0, ;T0 will get input/output bits TXNE T1,DV.IN ;Can this device do input? TRO T0,1 ;Yes, set 2nd bit in "IO" TXNE T1,DV.OUT ;Can this device do output? TRO T0,2 ;Yes, set 1st bit in "IO" STORE T0,IO(D) ;STORE LAST TWO BITS IN DDB MOVE T1,DEV(D) ;GET DEVICE NAME DEVTYP T1, ;GET DEVTYP BITS $SNH ;?Should not fail ANDI T1,TY.DEV ;GET RID OF UNWANTED BITS STORE T1,DVTYP(D) ;STORE DEVTYP CODE ;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 CAIN T1,.TYTTY ;TTY? MOVEI T2,DI.TTY ;Yes STORE T2,INDX(D) ;Store dev index for dev-dependent code ;Get physical device name (which uniquely identifies this device) ; and store in DVICE(D) MOVE T1,DEV(D) ;Get device name DEVNAM T1, ;Get phys. device name $SNH ;?Can't happen TXNE F,F%CTTY ;Controlling TTY:? MOVSI T1,'TTY' ;Yes, just store "TTY" MOVEM T1,DVICE(D) ;Store unique device identifier. JRST %POPJ1 ;No error--skip return ;STILL IF10 DFFILE: SKIPE FILE(D) ;FILENAME SET? JRST DFEXT ;YES, GO CHECK EXT HXRE T1,UNUM(U) ;GET UNIT NUMBER JUMPL T1,DFFILX ;NEGATIVE, SPECIAL CODE PUSHJ P,DECSIX ;CONVERT TO SIXBIT TLNE T1,007777 ;1-DIGIT NUMBER? JRST DFFILY ;NO, OK LSH T1,-6 ;YES, PUT IN LEADING ZERO TLO T1,'0 ' DFFILY: HRRI T1,'FOR' ;PUT IN REST OF FILENAME MOVSM T1,FILE(D) ;SAVE IN DDB JRST DFEXT ;GO DO EXT DFFILX: HLRZ T1,DEVTAB(T1) ;RH OF FILENAME IS DEVICE NAME HRLI T1,'FOR' ;PUT IN OTHER HALF OF FILENAME MOVEM T1,FILE(D) ;SAVE IN DDB DFEXT: TXNN F,F%EXT ;EXT SPECIFIED BY FILE=? SKIPE EXT(D) ;NO, EXTENSION ALREADY SET? POPJ P, ;YES, DONE MOVSI T1,'DAT' ;NO, SET DEFAULT MOVEM T1,EXT(D) POPJ P, >;END IF10 DFACC: LOAD T1,ACC(D) ;DEFAULT IS /ACCESS:SEQINOUT JUMPN T1,DFACCX ;SKIP IF ALREADY SET MOVEI T1,AC.SIO ;GET DEFAULT, SEQINOUT STORE T1,ACC(D) ;STORE IN DDB DFACCX: 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'. DFACC1: 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: IF20,< LOAD T1,BUFCT(D) ;GET BUFFER COUNT JUMPN T1,%POPJ ;IF ALREADY SET, DON'T SET DEFAULT MOVEI T1,4 ;DEFAULT IS 4 STORE T1,BUFCT(D) > ;IF20 POPJ P, DFDISP: LOAD T1,DISP(D) ;DEFAULT IS /DISP:SAVE JUMPN T1,%POPJ LOAD T2,STAT(D) ;Unless STATUS='SCRATCH' CAIN T2,ST.SCR SKIPA T1,[DS.EXP] ; Then it's /DISPOSE:EXPUNGE MOVEI T1,DS.SAVE STORE T1,DISP(D) POPJ P, DFFORM: LOAD T1,FORM(D) ;DEFAULT IS /FORM:FORMATTED JUMPN T1,DFFRM1 ;Already set MOVEI T1,FM.FORM STORE T1,FORM(D) DFFRM1: MOVE T2,FLAGS(D) ;Get DDB flags CAIN T1,FM.FORM ;Formatted? TXZA T2,D%UNF ;Yes, clear "unformatted" flag TXO T2,D%UNF ;No, set "unformatted" flag MOVEM T2,FLAGS(D) ;Store updated flags POPJ P, DFMODE: LOAD T1,MODE(D) ;GET FILE MODE JUMPN T1,DFMOD0 ;IF SET, NO DEFAULT MOVEI T1,1 ;SET FLAG XMODE TO REMEMBER WE DEFAULTED MODE STORE T1,XMODE(D) LOAD T1,FORM(D) ;GET /FORM CAIN T1,FM.UNF ;/FORM:UNFORMATTED? SKIPA T1,[MD.BIN] ;UNFORMATTED, DEFAULT IS /MODE:BINARY MOVEI T1,MD.ASC ;FORMATTED, DEFAULT IS /MODE:ASCII STORE T1,MODE(D) ;SET DEFAULT DFMOD0: CAIE T1,MD.EBC ;/MODE:EBCDIC? JRST DFMOD1 ;NO MOVEI T2,TM.IND ;YES, IMPLIES /TAPEMODE:INDUSTRY STORE T2,TAPM(D) DFMOD1: CAIL T1,MD.ASC ;ASCII OR GREATER IMPLIES /FORM:F JRST SETFORM CAIL T1,MD.BIN ;BINARY OR GREATER IMPLIES /FORM:U JRST SETUNF ;8-SEP-81 /DAW /MODE:IMAGE IMPLIES /FORM:UNF ; LOAD T1,FORM(D) ;ONLY THING LEFT IS /MODE:IMAGE ; JUMPN T1,%POPJ ;IF USER SPECIFIED /FORM, USE THAT MOVEI T1,FM.UNF ;OTHERWISE /MODE:IMAGE IMPLIES /FORM:U STORE T1,FORM(D) POPJ P, SETUNF: SKIPA T1,[FM.UNF] ;GET /FORM:U SETFORM: MOVEI T1,FM.FORM ;GET /FORM:F MOVEI T2,(T1) ;SET IT TO IMPLIED FORMAT STORE T2,FORM(D) POPJ P, ;Return ;Default STATUS DFSTAT: LOAD T1,STAT(D) ;GET /STATUS JUMPN T1,DFSTAX ;IF SET, NO DEFAULT MOVEI T1,ST.UNK ;DEFAULT IS /STATUS:UNKNOWN STORE T1,STAT(D) ;SET DEFAULT DFSTAX: SUBI T1,ST.DISP ;CONVERT TO /DISP:SOMETHING JUMPLE T1,%POPJ ;WASN'T A /STAT THAT'S REALLY /DISP, DONE STORE T1,DISP(D) ;ELSE JUST STORE NEW DISP POPJ P, ;RETURN ;FIXDEF DOES FINAL DEFAULT PROCESSING AFTER EVERYTHING IS IN PLACE ;INITIALIZES TTYW TO 72 OR RECORD SIZE, IN CASE NON-TERMINAL FIXDEF: MOVE T2,FLAGS(D) ;T2= DDB flags to update IF10,< MOVE T1,DEV(D) ;GET DEV AGAIN DEVTYP T1, ;GET DEVTYP (AGAIN) SETZ T1, TXNE T1,TY.INT ;INTERACTIVE? TXO T2,D%INT ;Yes, set flag > ;IF10 LOAD T1,FORM(D) ;GET /FORM CAIN T1,FM.UNF ;UNFORMATTED? TXO T2,D%UNF ;Yes, file is now officially unformatted LOAD T1,MODE(D) ;GET /MODE CAIN T1,MD.BIN ;BINARY? TXO T2,D%BIN ;YES, FLAG THAT TOO MOVEM T2,FLAGS(D) ;Done with flags, free up T2 LOAD T1,BPW(D) ;IS BYTES/WORD NON-ZERO ALREADY? JUMPN T1,GOTBPW ;YES. DON'T TOUCH IT LOAD T1,MODE(D) ;GET FILE MODE LDB T1,MODBYT ;GET BYTE SIZE MOVEI T2,^D36 ;DIVIDE INTO 36 TO GET # BYTES/WORD IDIVI T2,(T1) STORE T2,BPW(D) ;MIGHT BE RECALCULATED AT READ/WRITE TIME MOVE T1,T2 ;Put in T1 ;Here with # of bytes/word in T1. GOTBPW: IF10,< MOVE T2,SIZ(D) ;Incase this is an input file, IMUL T2,T1 ; get number of bytes and store in EOFN. MOVEM T2,EOFN(D) >;END IF10 MOVE T1,RSIZE(D) ;GET RECORD SIZE JUMPE T1,NOSIZE LOAD T3,BPW(D) ;GET # BYTES/WORD LOAD T2,MODE(D) ;GET FILE MODE CAIN T2,MD.ASL ;LINE-SEQUENCED ASCII? ADDI T1,6 ;YES. ADD 6 FOR LSN AND TAB CAIE T2,MD.IMG ;IMAGE? ADDI T1,1(T3) ;NO. ADD IN FOR CRLF & NULLS, OR LSCW'S IDIVI T1,(T3) ;GET # WORDS STORE T1,RSIZW(D) ;STORE RECORD SIZE IN WORDS repeat 0,< NOSIZE: SKIPN T1,RSIZE(D) ;GET RECORD SIZE AGAIN MOVEI T1,^D72 ;NO RECORD SIZE, LINES ARE 72 COLS LOAD T2,TTYW(D) ;GET LINE SIZE CAIN T2,0 ;ALREADY SET? (TERMINALS SET BY TTYSET) STORE T1,TTYW(D) ;NO, SET DEFAULT LINE SIZE > NOSIZE: SKIPN T1,RSIZE(D) ;GET RECORD SIZE AGAIN LOAD T1,TTYW(D) ; DEFAULT FROM TTYSET IF TERMINAL CAIN T1,0 ;DO WE HAVE A VALUE? MOVEI T1,^D72 ; NOW WE DO STORE T1,TTYW(D) ;SET IT POPJ P, ;FIXU - Routine to fixup U after OPEN is done. ; Called with FIXDEF, for every "U" that applies. ;SETS /CARRIAGE:DEVICE TO APPROPRIATE DEVICE DEFAULT ; and other stuff FIXU: MOVEI T1,1 ;INIT RECORD NUMBER TO 1 MOVEM T1,NREC(U) LOAD T1,CC(U) ;GET CC CAIE T1,CC.DEV ;DEVICE DEFAULT? POPJ P, ;NO, DONE LOAD T1,DVTYP(D) ;GET DEVICE TYPE IF10,< CAIE T1,.TYTTY ;TERMINAL? CAIN T1,.TYLPT > ;OR PRINTER? IF20,< CAIE T1,.DVTTY ;TERMINAL? CAIN T1,.DVLPT > ;OR PRINTER? SKIPA T1,[CC.FORT] ;YES, CC=FORT MOVEI T1,CC.LIST ;NO, CC=LIST STORE T1,CC(U) ;STORE DEFAULT CC POPJ P, ;Return ;LOOK UP SWITCH IN TABLE ;ARGS: T1 = NUMBER TO FIND IN RH OF TABLE ENTRY ; T2 = (18-bit) ADDRESS OF TBLUK-FORMAT TABLE ;RETURN: T1 = STRING ADDRESS (FROM RH OF TABLE ENTRY) ;USES T1 THRU T4 FNDSWT: HRRZ T3,(T2) ;GET LENGTH OF TABLE HRLI T2,(IFIW (T3)) ;PUT T3 INDEX IN LH OF T2 FSWLP: HRRZ T4,@T2 ;GET A TABLE ENTRY CAIE T4,(T1) ;DOES IT MATCH THE ONE WE WANT? SOJG T3,FSWLP ;NO, KEEP LOOKING HLRZ T1,@T2 ;GET STRING POINTER JUMPG T3,%POPJ ;RETURN UNLESS SWITCH WAS NOT FOUND IN TABLE $SNH ;Switch not found, internal error SUBTTL CHECK JFN FOR TTY: IF20,< ; This routine is called after a GTJFN is done, to see ; if the filespec was actually TTY:. If this is true, and ; the user has no logical name TTY:, IJFN and OJFN are changed to ; .PRIIN and .PRIOU, respectively. This way TOPS-20 allows you ; to DETACH and REATTACH somewhere else, and the TTY output will ; follow you around (just like on the -10). ;Input: ; T1/ JFN ;Call: ; PUSHJ P,CTTYJF ; ;Returns: ; T1/ JFN (if TTY:, .PRIIN is returned) ;Uses T2, T3 CTTYJF: MOVE T2,T1 ;Copy JFN SETZM TDHOLD ;Clear device field HRROI T1,TDHOLD ;Temp HOLD area MOVX T3,FLD(.JSAOF,JS%DEV) ;Output device name JFNS% ;** Return ASCIZ device name ** MOVE T1,T2 ;JFN back in T1 ;If device is exactly "TTY", set .PRIIN and .PRIOU, ; and just release the JFN MOVE T3,TDHOLD ;What did we get? CAME T3,[ASCIZ /TTY/] ;TTY:? POPJ P, ;No, return RLJFN% ;Release old JFN $SNH ;?Should work MOVEI T1,.PRIOU ;How about that. STORE T1,OJFN(D) ;Store in DDB. MOVEI T1,.PRIIN ;This gets returned in T1 STORE T1,IJFN(D) ; . . POPJ P, ;Return SEGMENT DATA TDHOLD: BLOCK <^D39+1>/5 ;Up to 39 characters in device name SEGMENT CODE >;END IF20 SUBTTL DIALOG SCANNER IF20,< DLGSTR: MOVE P3,DIASAG ;Get DIALOG='string' arg ptr. TXO F,F%INDST ;Set flag saying we're now doing DIALOG='string' DIALOG: PUSHJ P,SAVERR ;DIVERT ERR MSGS TO TTY TXNE F,F%INDST ;DIALOG FROM STRING? JRST DIASK1 ;YES, SKIP PREFIX SKIPN G.EFS ;SKIP IF PREFIX ALREADY TYPED ; IOERR (EFS,,,[,Enter correct file specs) $ECALL EFS SETOM G.EFS ;SUPPRESS PROMPT NEXT TIME DIASK1: MOVEI T1,REPARSE ;FILL IN CSB MOVEM T1,CSB+.CMFLG TXNE F,F%INDST ;DIALOG COMING FROM STRING? SKIPA T1,[.NULIO,,.NULIO] ;YES, NO JFNS MOVE T1,[.PRIIN,,.PRIOU] ;NO, NORMAL JFNS MOVEM T1,CSB+.CMIOJ HRROI T1,[ASCIZ /*/] ;PROMPT STRING MOVEM T1,CSB+.CMRTY HRROI T1,TXTBUF ;TEXT BUFFER MOVEM T1,CSB+.CMBFP MOVEM T1,CSB+.CMPTR MOVEI T1,LTEXT*5 ;CHARS IN TEXT BUFFER MOVEM T1,CSB+.CMCNT HRROI T1,ATMBUF ;ATOM BUFFER MOVEM T1,CSB+.CMABP MOVEI T1,LATOM*5-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 MOVEI T1,OPNSWT ;Assume OPEN TXNE F,F%CLS ;CLOSE? MOVEI T1,CLSSWT ; Yes, get alternate switches MOVEM T1,FLDSWT+.CMDAT ;Store in block ;STILL IF20 PUSHJ P,%SAVE4 RESCN: MOVEI T1,CSB ;POINT TO CSB MOVEI T2,[FLDDB.(.CMINI)] ;INITIALIZE IT PUSHJ P,COMAND TXNE F,F%INDST ;DIALOG FROM STRING? PUSHJ P,DIABLT ;YES, GO FAKE A TEXTI MOVEM P,SAVEP ;SAVE P FOR REPARSE REPARSE: MOVE P,SAVEP ;RESTORE P PUSHJ P,SETJFN ;FILL IN GTJFN BLOCK MOVE T1,[GJ%OLD!GJ%NEW!GJ%FOU!777777] ;Clear stuff that ANDCAM T1,JFNBLK+.GJGEN ; gets us an actual generation number TXNE F,F%CLS ;In CLOSE? HLLOM JFNBLK+.GJGEN ;Yes, default generation number to -1. MOVX T1,GJ%OFG ;Don't get link to actual file yet IORM T1,JFNBLK+.GJGEN ;(Incase he changes /ACCESS after typing ; the filespec). MOVEI T1,CSB ;RESTORE T1 MOVEI T2,FLDFNS ;Parse file name or switches PUSHJ P,COMAND ;** Go do parse ** HRRZ P1,T3 ;See what it was CAIN P1,FLDFNS ;CRLF? POPJ P, ;Yes, just return CAIN P1,FLDSWT ;Switch? JRST DIASWG ;Yes, go process ;Filename was parsed DIAFNM: MOVX T0,D%RJN ;Clear flag, this is not a JFN ANDCAM T0,FLAGS(D) ; that can be "OPENF'd". TXO F,F%FSS ;Set "Filespec info given" flag STORE T2,IJFN(D) ;STORE JFN IN DDB STORE T2,OJFN(D) ; . . PUSHJ P,DOJFNS ;STORE NEW DEVICE, FILENAME, ... IN DDB HRRZ T1,T2 ;Copy JFN PUSHJ P,CTTYJF ;Check to see if TTY: is used, ; if so, possibly change to .PRIOU, .PRIIN DIASWT: MOVEI T1,CSB ;POINT TO CSB MOVEI T2,[FLDDB.(.CMCFM,,,,,FLDSWT)] 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: MOVEI T1,CSB ;Point to COMND block HRRZ P1,(T2) ;GET KEYWORD NUMBER OF SWITCH HRRZ T2,OPNDSP(P1) ;Point to switch value handler TXNE F,F%CLS ;In CLOSE? HRRZ T2,CLSDSP(P1) ;Yes, separate handler JUMPN T2,DIASWD ;IF ANY $SNH ;No handler, internal error DIASWD: MOVE T3,(T2) ;GET ROUTINE ADDRESS OR TOP OF KEYWORD TABLE TLNN T3,-1 ;SEE WHICH IT IS JRST (T3) ;SUBROUTINE, GO TO IT DIAKWD: MOVEM T2,SWTDDB+.CMDAT ;KEYWORD TABLE, STORE ADDRESS MOVEI T2,SWTDDB ;POINT TO KEYWORD FLDDB PUSHJ P,COMAND ;PARSE SWITCH KEYWORD HRRZ T2,(T2) ;GET VALUE XCT OPSTOR(P1) ;STORE IN DDB JRST DIASWT ;LOOP ;Routine to ignore the next keyword ;P1 = Switch number DIAIGN: PUSHJ P,CLIGN ;Type "%Ignoring " 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 PUSHJ P,COMAND XCT OPSTOR(P1) ;STORE IN DDB JRST DIASWT DIACHR: 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 XCT OPSTOR(P1) ;STORE IN DDB JRST DIASWT DIASET: MOVEI T2,1 ;SET BIT TO 1 XCT OPSTOR(P1) JRST DIASWT ;CRLF or Filespec or switch FLDFNS: FLDDB. (.CMCFM,CM%SDH,,,,FLDFNM) FLDFNM: FLDDB. (.CMFIL,CM%SDH,,,,FLDSWT) SEGMENT DATA FLDSWT: BLOCK .CMDAT+1 ;Allocate space for FLDDB. block 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: 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? JRST DIAEOF ;CANNOT RECOVER FROM THAT WITH MORE DIALOG TXNN F,F%INDST ;Are we parsing DIALOG= argument? JRST CMDER2 ;No CAIE T1,NPXNOM ;"Does not match switch or keyword"? CAIN T1,NPXAMB ; or "Ambiguous"? JRST CMDER4 ;Yes ; IOERR (EDS,,,?,Error in dialog string - $J,,REQDIA) $ECALL EDS,REQDIA CMDER4: XMOVEI T1,ATMBUF ;Point to atom buffer $ECALL EDA,REQDIA ;Type EDS + atom buffer ;Not DIALOG = 'string' CMDER2: PUSH P,T1 ;Save error code PUSHJ P,COL1 ;GET TERMINAL TO COL 1 IF IT ISN'T ALREADY POP P,T1 ;See if we should type out the atom buffer with this error CAIE T1,NPXNOM ;Does not match switch or keyword CAIN T1,NPXAMB ;Ambigous JRST CMDERA ;Yes CAIN T1,NPXNC JRST CMDERA ; IOERR (JSE,30,,?,$J) $ECALL JSE,RESCN ;Type JSYS error and go try again ;Type error and type out atom buffer CMDERA: XMOVEI T1,ATMBUF ;Point to atom buffer $ECALL JSA,RESCN ;Type JSYS error and go try again ;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: HRROI T1,%CRLF ;GET TO COLUMN 1 BY TYPING CRLF PSOUT% POPJ P, ;RETURN DIAEOF: TXNE F,F%INDST ;DIALOG FROM STRING? POPJ P, ;YES, DIALOG IS COMPLETE JRST %ABORT ;END OF COMMAND FILE, FATAL ERROR > ;IF20 IF10,< DMSK==1_':' + 1_'.' + 1_'/' + 1_'=' ;BREAKS DLGSTR: MOVE P3,DIASAG ;Get DIALOG='string' arg. TXO F,F%INDST ;Set flag saying we're now doing DIALOG='string' XMOVEI T1,[ASCIZ/DIALOG=/] SKIPA DIALOG: XMOVEI T1,[ASCIZ/DIALOG/] MOVEM T1,%ARGNM ;Store arg name incase errors PUSHJ P,SAVERR ;DIVERT ERR MSGS TO TTY PUSHJ P,%SAVE4 ;SAVE P ACS TXNE F,F%INDST ;DIALOG FROM STRING? JRST DIABLT ;YES, SKIP PROMPT SKIPN G.EFS ;SKIP IF ALREADY TYPED ONCE ; IOERR (EFS,,,[,Enter correct file specs) $ECALL EFS SETOM G.EFS ;SUPPRESS NEXT TIME RESCN: OUTCHR ["*"] ;PROMPT MOVE P3,[POINT 7,TXTBUF] ;POINT TO TEXT DESTINATION MOVEI P4,LTEXT*5-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 SOJG P4,DIAINP ;READ WHOLE STRING ; IOERR (DTL,,,?,Dialog string too long,,%RESCN) $ECALL DTL,RESCN DIABLT: MOVEM P3,SRCBP MOVE P3,[POINT 7,(P3)] ;Make pointer to arg EXCH P3,SRCBP MOVEI P4,LTEXT*5-1 ;MAX STRING LENGTH IS SIZE OF BUFFER MOVE T2,[POINT 7,TXTBUF] ;POINT TO BUFFER MOVE T3,DIASAT ;Get arg type DIABL1: ILDB T1,SRCBP ;GET BYTE FROM ARG JUMPE T1,DIABL3 ;NULL, DONE CAIE T1," " ;SPACE? JRST DIABL2 ;NO CAIN T3,TP%LIT ;LITERAL ARG? JRST DIABL1 ;YES, SUPPRESS SPACE JRST DIABL3 ;NO, TERMINATES ARG DIABL2: IDPB T1,T2 ;STORE CHAR SOJG P4,DIABL1 ;LOOP ; IOERR (DTL,,,?,Dialog string too long) $ECALL DTL,RESCN DIABL3: SETZ T1, ;TERMINATE WITH NULL IDPB T1,T2 JRST DIASC2 ;DONE ;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 ADD P3,[47B5] ;DECREMENT P3 TO OVERWRITE - TLCN P3,(1B0) SUB P3,[430000,,1] JRST DIAINP ;KEEP READING DIASC1: SETZ T1, ;FLAG END OF ASCIZ STRING IDPB T1,P3 ;Now string has been stored in TXTBUF. DIASC2: MOVE P3,[POINT 7,TXTBUF] ;POINT TO TEXT BUFFER MOVEM P3,SRCBP SETZM %NCHRR ;# chars read so far = 0 MOVEI P4,LTEXT*5-1 ;MAX STRING LENGTH IS SIZE OF BUFFER ;SRCBP = current bp to source string. DIASCN: PUSHJ P,DPRS1 ;Parse filename or device ... JRST RESCN ;Error, let him try again CAIN T1,":" ;Colon terminator? JRST DIADEV ;Yes, we just got a device DIASN1: SKIPE T2,ATMBUF ;Filename? MOVEM T2,FILE(D) ;Yes, store it SKIPE T2,ATMBUF TXO F,F%FSS ;Got filespec info JUMPE T1,%POPJ ;Return if at end CAIN T1,"." ;Extension coming? JRST DIAEXT ;Yes CAIN T1,"[" ;Path coming? JRST DIAPTH ;Yes CAIN T1,.CHLAB ;Protection coming? JRST DIAPRO ;Yes CAIN T1,"/" ;Switch coming? JRST DIASW1 ;Yes $ECALL IDD,RESCN ;?Illegal character ;Got a device (":" was delimiter) DIADEV: SKIPN T2,ATMBUF ;DEV $ECALL NDI,RESCN ;?Null device MOVEM T2,DEV(D) TXO F,F%DSS ;He specified a device PUSHJ P,DPRS1 ;Parse filename.. JRST RESCN ;Error, let him try again CAIE T1,":" ;Another device? JRST DIASN1 ;No, ok $ECALL IDD,RESCN ;?Illegal character ;Next thing is extension ("." seen) DIAEXT: PUSHJ P,DPRS2 ;Parse extension JRST RESCN ;Error, let him try again TXO F,F%EXT!F%FSS ;EXT IS EXPLICITLY SPECIFIED, EVEN IF NULL HLLZ T2,ATMBUF MOVEM T2,EXT(D) JUMPE T1,%POPJ ;Return if at end CAIN T1,"[" ;Path coming? JRST DIAPTH ;Yes CAIN T1,.CHLAB ;Start of protection JRST DIAPRO CAIN T1,"/" ;Switch coming? JRST DIASW1 ;Yes $ECALL IDD,RESCN ;?Illegal character ;STILL IF10 ;Parse a protection (Left angle bracket seen). DIAPRO: PUSHJ P,DOCT ;Read protection CAIE T1," " ;space? CAIN T1,.CHRAB ;End of field? PUSHJ P,DPRCHR ;Yes, get next char. JUMPE T1,DIPROK ;Jump if ok delimiter CAIE T1,"[" ;Start of PPN CAIN T1,"/" ; or switch is ok JRST DIPROK $ECALL IDD,RESCN ;Else "illegal character" DIPROK: DPB T2,[POINTR (PROT(D),RB.PRV)] ;STORE IN DDB JUMPE T1,%POPJ ;Return if end of string CAIN T1,"/" ;Switch coming? JRST DIASW1 ;Yes ;Must be "[" ; CAIN T1,"[" ;Start of PPN? JRST DIAPTH ;Yes ;STILL IF10 DIAPTH: PUSHJ P,DPTH ;READ PATH JRST RESCN ;Error CAIE T1,"]" ;End square bracket? CAIN T1," " ; or space? PUSHJ P,DPRCHR ;Yes, get next char JUMPE T1,%POPJ ;Return if at end CAIN T1,.CHLAB ;Protection coming? JRST DIAPRO ;Yes CAIN T1,"/" ;Switch coming? JRST DIASW1 ;Yes $ECALL IDD,RESCN ;?Illegal character ;Routine to parse a path ;Reads from SRCBP updates %NCHRR ;Puts path in DDB. ;If errors, returns .+1 ($ECALL given) ; if ok, returns .+2 DPTH: PUSHJ P,DOCT ;READ PPN CAIN T2,0 ;ALLOW [P,] AND [,PN] AND [,,SFD] HLRZ T2,G.PPN CAIN T1,0 ; IOERR (IPP,,,?,Illegal PPN,,REQDIA) $ECALL IPP,%POPJ CAIE T1,"," $ECALL IDD,%POPJ PUSH P,T2 PUSHJ P,DOCT CAIN T2,0 HRRZ T2,G.PPN HRLM T2,(P) POP P,T2 MOVSM T2,PTHB+.PTPPN(D) TXO F,F%FSS ;"Filespec info seen" 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,"]" ;RIGHT BRACKET TERMINATES PATH CAIN T1," " ;SO DOES SPACE JRST %POPJ1 CAIE T1,"," ;COMMA MEANS SFDS COMING $ECALL IDD,%POPJ ;ELSE ILL DELIMITER IN DIALOG CAIL P2,PTHB+.PTPPN+6(D) ;CHECK SFD COUNT ; IOERR (TMF,,,?,Too many SFDs,,REQDIA) $ECALL TMF,%POPJ PUSHJ P,DPRS3 ;READ SFD NAME POPJ P, ;Error SKIPN T2,ATMBUF ;GET SFD ; IOERR (NSI,,,?,Null SFD,,REQDIA) $ECALL NSI,%POPJ 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 6,ATMBUF] ;Store sixbit in atom buffer SETZM ATMBUF DPRS1A: PUSHJ P,DPRCHR ;Get next char, ignore spaces JUMPE T1,%POPJ1 ;0 ok CAIE T1,":" ;COLON CAIN T1,"." ;Dot JRST %POPJ1 ;Are ok CAIE T1,"[" ;Start of PPN CAIN T1,"/" ;Start of switch JRST %POPJ1 ;Are ok CAIN T1,.CHLAB ;And start of protection 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 DPRS1A ;Loop ;Same as DPRS1 except ":" and "." are not legal delimiters DPRS2: MOVE T3,[POINT 6,ATMBUF] SETZM ATMBUF DPRS2A: PUSHJ P,DPRCHR ;Get next char, ignore spaces JUMPE T1,%POPJ1 ;Return if done CAIE T1,"[" ;Start of PPN CAIN T1,"/" ;Start of switch JRST %POPJ1 ;Are ok CAIN T1,.CHLAB ;Start of protection 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 DPRS2A ;Loop ;Parse SFD names (sixbit) DPRS3: MOVE T3,[POINT 6,ATMBUF] SETZM ATMBUF DPRS3A: PUSHJ P,DPRCHS ;Get next char (space not ignored) JUMPE T1,%POPJ1 ;Return if done CAIE T1,"]" ;End of PPN ok CAIN T1,"," ;Comma ok JRST %POPJ1 CAIN T1," " ;Space 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 ;Parse a switch DPRSWT: MOVE T3,[POINT 6,ATMBUF] SETZM ATMBUF DPRSW1: PUSHJ P,DPRCHR ;Get char JUMPE T1,%POPJ1 ;End ok CAIE T1,"=" ;Delimiters for switch value ok CAIN T1,":" JRST %POPJ1 CAIN T1,"/" ;Another switch ok JRST %POPJ1 PUSHJ P,DPRCSX ;Convert char to sixbit POPJ P, ;Error TLNE T3,770000 ;If room, IDPB T1,T3 ;Store in BP JRST DPRSW1 ;Loop ;Parse a switch value DPRSWV: MOVE T3,[POINT 6,ATMBUF] SETZM ATMBUF DPRSV1: PUSHJ P,DPRCHR ;Get char JUMPE T1,%POPJ1 ;END ok CAIN T1,"/" ;Another switch ok JRST %POPJ1 PUSHJ P,DPRCSX ;Convert to sixbit POPJ P, ;?Error TLNE T3,770000 ;If room, IDPB T1,T3 ;Store char JRST DPRSV1 ;Loop ;Parse a switch value in OPEN keyword arg. ;Leading spaces are ignored. PRSSWV: MOVE T3,[POINT 6,ATMBUF] SETZM ATMBUF PRSSV1: PUSHJ P,DPRCHR ;Get next char JUMPE T1,%POPJ1 ;END ok JRST PRSSV3 ;Got 1st char PRSSV2: PUSHJ P,DPRCHS ;Get next char (don't ignore spaces) JUMPE T1,%POPJ1 ;Null ends it CAIN T1," " ; and space ends it JRST %POPJ1 PRSSV3: PUSHJ P,DPRCSX ;Convert to sixbit POPJ P, ;?error TLNE T3,770000 ;If room, IDPB T1,T3 ;Store char JRST PRSSV2 ;Loop for all chars ;Translate char in T1 to sixbit ;Must be a letter or number ;Returns .+1 if problem (IDD error given), .+2 if ok DPRCSX: CAIL T1,"A"+40 ;Check for lowercase letter CAILE T1,"Z"+40 CAIA ;not SUBI T1,40 ;Translate to upper case CAIL T1,"A" ;Letter? CAILE T1,"Z" JRST DPRCS1 ;No DPRCS2: SUBI T1,40 ;Translate to sixbit JRST %POPJ1 ;Return ok DPRCS1: CAIL T1,"0" ;Digit? CAILE T1,"9" $ECALL IDD,%POPJ ;No, return JRST DPRCS2 ;Yes, Ok ;STILL IF10 DIASWT: PUSHJ P,DPRCHR ;Get next non-space char. DIASW1: JUMPE T1,%POPJ ;NONE, DONE CAIE T1,"/" ;BEGINNING OF SWITCH? $ECALL IDD,RESCN ;NO, BAD PUSHJ P,DPRSWT ;Parse a switch JRST RESCN ;Error - bad char DSWOK: MOVEI T1,OPNSWT ;LOOK UP KEYWORD MOVEI T2,ATMBUF MOVE T5,ATMBUF ;Get sixbit word to type incase error PUSHJ P,TABLK ; IOERR (USW,,,?,Unknown switch /$S,T5,%RESCN) $ECALL USW,RESCN ; IOERR (ASW,,,?,Ambiguous switch /$S,T5,%RESCN) $ECALL ASW,RESCN HRRZ P1,(T1) ;GET KEYWORD NUMBER HRRZ T2,OPNDSP(P1) ;POINT TO SWITCH VALUE HANDLER TXNE F,F%CLS ;CLOSE? HRRZ T2,CLSDSP(P1) ;Yes, different action routines JUMPN T2,.+2 ;IF ANY $SNH ;None, internal error MOVE T3,(T2) ;GET ROUTINE ADDRESS OR KEYWORD TABLE TLNN T3,-1 ;SEE WHICH JRST (T3) ;ROUTINE, GO TO IT DIAKWD: SETZM ATMBUF ;Clear buffer PUSH P,T2 ;SAVE KWD TABLE ADDRESS 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 JRST [POP P,(P) ;Error, fix stack JRST RESCN] ; and go try again ; SETZM ATMBUF+1 ;MAKE SURE STRING IS TERMINATED WITH NULL DIAKWW: POP P,T1 ;GET KWD TABLE ADDRESS MOVEI T2,ATMBUF PUSHJ P,TABLK JRST KWDUNK ;UNKNOWN JRST KWDAMB ;AMBIGUOUS HRRZ T2,(T1) ;GET VALUE XCT OPSTOR(P1) ;STORE IN TABLE LDB T1,SRCBP ;RELOAD DELIMITING CHAR JRST DIASW1 ;READ ON ;STILL IF10 DIAOCT: PUSHJ P,DOCT ;READ NUMBER, THEN RETURN TO LOOP XCT OPSTOR(P1) JRST DIASW1 DIAINT: PUSHJ P,DINT XCT OPSTOR(P1) JRST DIASW1 DOCT: SKIPA T5,[^D8] ;RADIX 8 DINT: MOVEI T5,^D10 ;RADIX 10 SETZ T2, ;CLEAR RESULT DINT1: ILDB T1,SRCBP ;GET CHAR AOS %NCHRR 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,DPRCHS ;Get char CAIE T1,"""" ;STARTING QUOTE? ; IOERR (NQS,,,?,PADCHAR must be single char in double quotes,,%RESCN) EENQS: $ECALL NQS,RESCN PUSHJ P,DPRCHS ;Get PAD char CAIN T1,"" ;QUOTING CHAR? PUSHJ P,DPRCHS ;YES, GET CHAR IT QUOTES JUMPE T1,EENQS ;END OF STRING HERE IS AN ERROR XCT OPSTOR(P1) ;STORE IN DDB PUSHJ P,DPRCHS ;Get closing quote CAIE T1,"""" ;CLOSING QUOTE? $ECALL NQS,RESCN ;No, complain JRST DIASWT DIASET: MOVEI T2,1 ;SET BIT TO 1 XCT OPSTOR(P1) JRST DIASWT ;RETURN ;IGNORE THE ARGUMENT DIAIGN: PUSHJ P,CLIGN ;Say "%ignoring.." PUSHJ P,DPRSWT ;Parse switch JRST RESCN ;?error CAIE T1,"=" ;If there is a switch value, CAIN T1,":" JRST DIAIG1 ;Ignore that too JRST DIASW1 DIAIG1: PUSHJ P,DPRSWV ;Parse switch value JRST RESCN ;?Error JRST DIASW1 ;Go on > ;IF10 ;ROUTINE TO PUSH U.ERR SO DIALOG IS WITH TTY, NOT FILE ;DOES NOT HANDLE SKIP RETURNS SAVERR: SKIPN U.ERR ;ERR UNIT SET? POPJ P, ;NO, NOTHING TO DO PUSH P,U.ERR ;SAVE IT SETZM U.ERR ;CLEAR IT SO WE USE TTY PUSHJ P,@-1(P) ;CALL CALLER POP P,U.ERR ;RESTORE U.ERR POP P,(P) ;Discard one return so don't return ; after "PUSHJ P,SAVERR". POPJ P, ;DONE SUBTTL DO OPEN ;Call: ; MOVX T1,GTJFN bits GJ%OLD or GJ%NEW or GJ%FOU ; PUSHJ P,DOOPEN ; ; IF20,< DOOPEN: MOVEM T1,GJBTS ;Save GTJFN bits LOAD T1,IJFN(D) ;Get JFN MOVE T2,FLAGS(D) ;Get DDB flags TXNE T2,D%RJN ;Do we have a real JFN already? JRST DOOPN1 ;Yes CAIN T1,.PRIIN ;Controlling TTY:? JRST DOOPN2 ;Yes, bypass a lot of this.. SKIPE T2,T1 ;Skip if no JFN at all, get in T2 PUSHJ P,DOJFNS ;Get info in file block PUSHJ P,SETJFN ;Setup JFN info MOVE T1,GJBTS ;Get JFN bits to set TXO T1,GJ%XTN ;Extended GTJFN HLLM T1,JFNBLK+.GJGEN ;Store away MOVEI T1,JFNBLK ;Get a JFN MOVEI T2,[0] GTJFN% ERJMP GJERR ;Failure return ;Here when got real JFN in T1 DOOPN1: STORE T1,IJFN(D) ;Store STORE T1,OJFN(D) PUSHJ P,CTTYJF ;Get .PRIIN if TTY: MOVX T0,D%RJN ;"Got a real JFN now" CAIE T1,.PRIIN ;Skip if controlling TTY: IORM T0,FLAGS(D) ;Set the flag DOOPN2: PUSHJ P,GMODBY ;Get DMBS, BPW ;Do OPENF PUSHJ P,%CHKNR ;Check data mode POPJ P, ;Illegal, go have DIALOG LOAD T1,INDX(D) ;GET DEVICE INDEX PUSHJ P,@SABDT(T1) ;SET ACCESS BY DEVICE TYPE OR T2,DMBS(D) ;SET DATA MODE, BYTE SIZE LOAD T1,IJFN(D) ;GET JFN ;T1= JFN ;T2= proper OPENF flag bits CAIE T1,.PRIIN ;Don't OPENF TTY: OPENF% ;OPEN file ERJMP OPFERR ;Can't MOVEI T2,AC.SOU ;Change ACCESS to SEQOUT LOAD T1,INDX(D) ; If device was a TTY CAIN T1,DI.TTY STORE T2,ACC(D) LOAD T1,ACC(D) ;GET ACCESS MOVE T2,ACCTAB(T1) ;Get bits to set in DDB flags IORM T2,FLAGS(D) ; Set 'em ;OPFSTT - called when OPENF% is successful to finish setup. OPFSTT: LOAD T2,INDX(D) ;Get device index PUSHJ P,@[ IFIW TTYSET IFIW DSKSET IFIW MTASET IFIW XXXSET IFIW E..SNH](T2) ;Do device-dependent stuff PJRST REQDIA ;Failed, request DIALOG PUSHJ P,FIXDEF ;Defaults after everything is in place. PUSHJ P,FIXU ;Fixup this unit block PUSHJ P,DOCONS ;Do consolidation of DDB's if necessary TXNE F,F%CTTY ;Is this the controlling TTY:? MOVEM D,D.TTY ;Yes, store the TTY's DDB address JRST %POPJ1 ;Skip return SABDT: IFIW TTYSA ;TTY IFIW DSKSA ;DSK IFIW MTASA ;MTA IFIW XXXSA ;OTHER TTYSA: MOVX T2,OF%RD+OF%WR ;READ + WRITE ACCESS POPJ P, XXXSA: DSKSA: LOAD T2,ACC(D) ;GET ACCESS TYPE HRRZ T2,FILTAB(T2) ;GET ACCESS BITS JUMPN T2,%POPJ ;LEAVE IF GOT ANY MOVX T2,OF%RD ;NONE. TRY READ MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%IO ;UNLESS WE'RE WRITING MOVX T2,OF%WR POPJ P, MTASA: LOAD T2,ACC(D) ;GET ACCESS CAIN T2,AC.APP ;APPEND? JRST MTAPP ;YES. GET WRITE ACCESS INSTEAD HRRZ T2,FILTAB(T2) ;GET ACCESS BITS JUMPN T2,%POPJ ;LEAVE IF WE GOT ANY MOVX T2,OF%RD ;NONE. TRY READ MOVE T0,FLAGS(D) ;Get DDB flags TXNE T0,D%IO ;UNLESS WE'RE WRITING MTAPP: MOVX T2,OF%WR POPJ P, ;Routine to get DMBS, BPW based on /MODE GMODBY: LOAD T1,MODE(D) ;GET /MODE MOVE T1,MODTAB(T1) ;GET DATA MODE, BYTE SIZE TLZ T1,(OF%MOD) ;USE DATA MODE 0 FOR ALL FILES MOVEM T1,DMBS(D) ;STORE IN DDB MOVEI T1,^D36 ;GET WORD SIZE LOAD T2,BSIZ(D) ;GET BYTE SIZE IDIVI T1,(T2) ;CALC BYTES/WORD STORE T1,BPW(D) ;SAVE IT POPJ P, ;Return SEGMENT DATA GJBTS: BLOCK 1 ;GTJFN bits for DOOPEN SEGMENT CODE ;ERRORS - UNDO JSYSES THAT HAVE SUCCEEDED, THEN GO HAVE DIALOG FDBERR: LOAD T1,IJFN(D) ;GET THE JFN CLOSF% ;CLOSE THE FILE JSHALT ;SHOULDN'T FAIL JRST OPFER1 ;NO NEED TO RELEASE JFN OPFERR: LOAD T1,IJFN(D) ;GET THE JFN BACK JUMPE T1,OPFER1 ;IF WE HAVE ONE RLJFN% ;RELEASE THE UNOPENED JFN JSHALT ;SHOULD NOT FAIL OPFER1: SETZ T1, ;CLEAR JFN STORED IN DDB STORE T1,IJFN(D) STORE T1,OJFN(D) GJERR:; IOERR (OPE,30,,?,$J,,REQDIA) ;TYPE ERROR MESSAGE, TRY AGAIN $ECALL OPE,REQDIA ;ROUTINE TO SET UP TERMINAL TTYSET: MOVX T1,D%SICR+D%SILF ;Suppress initial CRLF for terminals IORM T1,FLAGS(D) ; . . LOAD T1,IJFN(D) ;GET JFN RFCOC% ;SAVE CCOC WORDS FOR USE DURING TEXTI DMOVEM T2,CCOC(D) AND T2,%CCMSK ;SET CCOC FOR CORRECT OUTPUT IOR T2,%OCCOC ;LEAVE ^I AND ^L AS THEY WERE, SET OTHERS MOVE T3,%OCCOC+1 ; TO SEND LITERALLY SFCOC% MOVE T1,RSIZE(D) ;RECORD SIZE SPECIFIED? JUMPN T1,%POPJ1 ;YES, IT WINS; DON'T OVERWRITE LINE WIDTH LOAD T1,OJFN(D) ;GET JFN MOVEI T2,.MORLW ;READ LINE WIDTH MTOPR% ERJMP [SETZ T3, ;CAN'T, MAKE A GUESS JRST .+1] CAIN T3,0 ;LINE WIDTH SET? MOVEI T3,^D72 ;NO, GUESS 72 STORE T3,TTYW(D) ;STORE LINE SIZE FOR NAMELIST AND LIST-DIRECTED JRST %POPJ1 ;DONE ; @ A B C D E F G H I J K L M N O P Q R S T U V W X Y Z [ \ ] ^ _ %OCCOC: BYTE (2)1,2,2,2,2,2,2,2,2,0,2,2,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2 %CCMSK: BYTE (2)0,0,0,0,0,0,0,0,0,3,0,0,3,0,0,0,0,0 ;ROUTINE TO SET UP DISK DSKSET: LOAD T1,IJFN(D) ;GET JFN MOVSI T2,1+.FBSIZ ;READ UP THROUGH FILE SIZE MOVEI T3,FDB ;POINT TO DEST BUFFER GTFDB% ;READ FDB ERJMP FDBERR ;CAN'T LOAD T1,STAT(D) ;GET /STAT CAIE T1,ST.OLD ;/STAT:OLD? CAIN T1,ST.NEW ;OR /STAT:NEW? JRST .+2 ;YES, MUST CHECK IT JRST DSET1 ;NO MOVE T2,FDB+.FBCTL ;GET FILE BITS CAIN T1,ST.OLD ;/STAT:OLD? TXC T2,FB%NXF ;YES, FILE MUST EXIST DSET1: LDB T1,[POINTR (FDB+.FBBYV,FB%BSZ)] ;GET FILE BYTE SIZE CAIN T1,0 ;ZERO? MOVEI T1,^D36 ;YES, SET 36-BIT BYTES LOAD T2,BSIZ(D) ;GET /MODE-IMPLIED BYTE SIZE MOVEI T3,^D36 ;GET NUMBER OF BITS IN A WORD IDIVM T3,T1 ;GET OLD BYTES PER WORD IDIVM T3,T2 ;AND NEW BYTES PER WORD STORE T2,BPW(D) ;REMEMBER NUMBER OF BYTES PER WORD MOVE T3,FDB+.FBSIZ ;GET NUMBER OF OLD BYTES IN THE FILE MULI T3,(T2) ;CONVERT TO NUMBER OF NEW BYTES IN THE FILE ADDI T4,-1(T1) ;ROUND UP DIVI T3,(T1) MOVEM T3,EOFN(D) ;STORE IN DDB LOAD T1,BUFCT(D) ;GET BUFFER (PAGE) COUNT PUSHJ P,%GTPGS ;ALLOCATE THAT MANY PAGES $ECALL MFU,%ABORT ;?Can't, memory full MOVE T0,FLAGS(D) ;Get DDB flags TXNN T0,D%RAN ;Is this a RANDOM file? jrst dset2 ;no push p,t1 load t1,bufct(d) ;get page count pushj p,%gtblk ;get a block for the page table pop p,t2 ;get first page number in window hrloi t2,(t2) ;get process page,,impossible file page load t3,bufct(d) ;get count again movni t3,(t3) ;negate hrli t1,(t3) ;make aobjn pointer move t3,t1 ;copy dset3: movem t2,(t3) ;store process page,,file page add t2,[1,,0] ;bump to next process page in window aobjn t3,dset3 ;loop HRRZM T1,WPTR(D) ;store MOVEM T1,WTAB(D) LOAD T1,BPW(D) ;GET BYTES/WORD LSH T1,9 ;GET # BYTES IN A PAGE MOVEM T1,WSIZ(D) ;STORE AS WINDOW SIZE JRST %POPJ1 ;ALL SET DSET2: MOVEM T1,WTAB(D) ;SAVE PAGE ADDRESS ANDI T1,777 ;Just local section's page # LSH T1,9 ; Save local CORE ADDRESS MOVEM T1,WADR(D) LOAD T1,BUFCT(D) ;GET BUFFER COUNT LSH T1,9 ;GET WORD COUNT IN WINDOW LOAD T2,BPW(D) ;GET # BYTES/WORD IMULI T1,(T2) ;GET # BYTES IN WINDOW MOVEM T1,WSIZ(D) ;STORE AS WINDOW SIZE JRST %POPJ1 ;ROUTINE TO SET UP MTA MTASET: PUSHJ P,%SAVE1 ;SAVE P1 HRLOI T1,377777 ;MARK FILE NOT AT EOF YET MOVEM T1,EOFN(D) STKVAR ;GET TWO TEMP WORDS LOAD T1,IJFN(D) ;GET LABEL TYPE OF TAPE MOVEI T2,.MORLI ;READ LABEL INFO MOVEI T3,2 ;SET ARG BLOCK LENGTH MOVEM T3,LABINF MOVEI T3,LABINF ;POINT TO ARG BLOCK MTOPR% ;READ LABEL INFO ERJMP [MOVEI T3,1 ;CAN'T, ASSUME UNLABELED MOVEM T3,1+LABINF JRST .+1] MOVE T1,1+LABINF ;GET LABEL TYPE UNSTK ;DISCARD TEMP VARS STORE T1,LTYP(D) ;STORE FOR LATER CAIE T1,.LTUNL ;LABELED TAPE? JRST LABSKP ;YES, DO NOT TRY TO SET UP DENSITY AND FRIENDS LOAD T1,IJFN(D) ;GET JFN OF TAPE MOVEI T2,.MOSDN ;SET DENSITY LOAD T3,DEN(D) ;GET /DENSITY MOVEI P1,[ASCIZ /density/] ;GET TEXT FOR ERR MESSAGE MTOPR% ;SET IT ERCAL MOPERR ;SHOULDN'T FAIL, BUT DON'T DIE MOVEI T2,.MOSPR ;SET PARITY LOAD T3,PAR(D) ;GET /PARITY MOVEI P1,[ASCIZ /parity/] MTOPR% ;SET IT ERCAL MOPERR LOAD T2,TAPM(D) ;GET /TAPEMODE SETZ T3, ;USERS DEFAULT TAPE MODE CAIN T2,TM.IND ;INDUSTRY COMPATIBLE? MOVEI T3,.SJDM8 ;YES, SET 8-BIT BYTES CAIN T2,TM.DMP ;COREDUMP? MOVEI T3,.SJDMC ;YES, SET CORE DUMP CAIN T2,TM.ANS ;ANSI-ASCII? MOVEI T3,.SJDMA ;YES, 7-BITS IN 8 BIT BYTES JUMPE T3,MTARS ;NO EXPLICIT MODE MOVEI T2,.MOSDM ;SET HARDWARE DATA MODE MOVEI P1,[ASCIZ /data mode/] MTOPR% ;SET IT ERCAL MOPERR MTARS: MOVEI T2,.MOSRS ;SET RECORD SIZE LOAD T3,BLKSZ(D) ;GET FILE BLOCK SIZE JUMPE T3,MTANRS ;IF SET MOVEI P1,[ASCIZ /block size/] MTOPR% ;SET IT ERCAL MOPERR MTANRS: MOVE T0,FLAGS(D) ;Get DDB flags TXNN T0,D%APP ;Are we appending? JRST MTANAP ;NO MOVEI T2,.MOFWF ;FORWARD ONE FILE MTOPR% ERJMP APPERR MOVEI T2,.MOBKR ;BACK OVER TAPE MARK MTOPR% ERJMP APPERR MTANAP: LABSKP: LOAD T1,IJFN(D) ;GET JFN MOVEI T2,.MORRS ;READ RECORD SIZE MTOPR% ERJMP MOPERR ;SHOULDN'T EVER FAIL... LOAD T2,BPW(D) ;GET # BYTES/WORD ADDI T3,-1(T2) ;GET # WORDS, ROUNDED UP IDIVI T3,(T2) MOVEI T1,(T3) ;RECORD # WORDS IMULI T3,(T2) ;GET CHARS AGAIN MOVEM T3,WSIZ(D) ;SAVE AS WINDOW SIZE PUSHJ P,%GTBLK ;ALLOCATE A BLOCK MOVEM T1,WADR(D) ;SAVE THE ADDRESS OF THE BUFFER JRST %POPJ1 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 LOAD T2,BPW(D) ;GET # BYTES/WORD IMULI T2,(T1) ;GET # BYTES/BUFFER MOVEM T2,WSIZ(D) ;STORE AS WINDOW SIZE PUSHJ P,%GTBLK MOVEM T1,WADR(D) ;STORE ADDRESS OF BUFFER JRST %POPJ1 ;ALL SET MOPERR:; IOERR (UMO,30,,%,$J trying to set tape $A,,%POPJ) $ECALL UMO,%POPJ APPERR:; IOERR (APP,30,,?,$J,,%POPJ) $ECALL APP,%POPJ ;ROUTINE TO FILL IN GTJFN BLOCK FROM DDB ;POINTS DEFAULTS AT THE STRINGS STORED IN THE DDB ;SETS UP THE FLAGS APPROPRIATELY FROM /ACCESS AND /STATUS SETJFN: LOAD T2,IJFN(D) ;ALREADY HAVE A JFN? JUMPE T2,SETJ1 ;NO, SKIP PUSHJ P,DOJFNS ;CONVERT JFN TO ASCIZ, STORE IN GTJFN BLOCK MOVE T1,T2 ;RELEASE THE JFN CAIE T1,.PRIIN ;If not real JFN, CAIN T1,.PRIOU ;. . JRST SETJF0 ;Don't release it RLJFN% JSHALT ;SHOULD NOT FAIL SETJF0: MOVX T1,D%RJN ;Clear "Got a real JFN" flag ANDCAM T1,FLAGS(D) ; if set. SETZ T1, ;CLEAR JFN FIELDS IN DDB STORE T1,IJFN(D) STORE T1,OJFN(D) MOVEI T1,ATMBUF ;POINT TO ASCIZ GENERATION NUMBER PUSHJ P,ASCDEC ;CONVERT TO BINARY $SNH ;Shouldn't fail HRRZM T1,XGEN(D) ;Store in DDB SETJ1: LOAD T1,ACC(D) ;GET /ACCESS HLLZ T1,FILTAB(T1) ;GET SOME APPROPRIATE FLAG BITS HRR T1,XGEN(D) ;PUT IN DEFAULT GENERATION NUMBER LOAD T2,DVTYP(D) ;GET DEV TYPE CAIE T2,.DVDSK ;DISK? TXZ T1,GJ%OFG ;NO, CLEAR PARSE-ONLY BIT LOAD T2,STAT(D) ;GET /STATUS CAIN T2,ST.OLD ;/STATUS:OLD? TXO T1,GJ%OLD ;YES, IMPLIES GTJFN BIT CAIN T2,ST.NEW ;/STATUS:NEW? TXO T1,GJ%NEW ;YES, IMPLIES GTJFN BIT TXNE T1,GJ%OLD ;KEEP FLAG BITS CONSISTENT TXZ T1,GJ%NEW+GJ%FOU ;IF OLD, THEN NOT NEW AND NOT FOR OUTPUT TXO T1,GJ%MSG!GJ%XTN ;ALWAYS TYPE CONFIRMATION MESSAGE ; and use extended GTJFN block MOVEM T1,JFNBLK+.GJGEN ;STORE IN FLAG WORD MOVEI T1,<.GJATR-.GJF2> ;No flags,,# of words to follow extended word MOVEM T1,JFNBLK+.GJF2 MOVE T1,[.NULIO,,.NULIO] ;NO JFNS MOVEM T1,JFNBLK+.GJSRC SKIPE T1,DEV(D) ;DEVICE HRROI T1,DEV(D) MOVEM T1,JFNBLK+.GJDEV SKIPE T1,DIR(D) ;DIRECTORY HRROI T1,DIR(D) MOVEM T1,JFNBLK+.GJDIR SKIPE T1,FILE(D) ;FILENAME HRROI T1,FILE(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 ;SOMETHING LIKE THE FOLLOWING WHEN /TAPEMODE WORKS. ; It can't be done now because you get GTJFN error ; for disk ("?Attribute illegal for this device") REPEAT 0,< XMOVEI T1,[EXP 2 ;2 words in attribute block POINT 7,[ASCIZ/FORMAT:F/]] ;For MAGTAPE MOVEM T1,JFNBLK+.GJATR >;end repeat 0 POPJ P, ;ALL SET ;Routine to get the ASCII filespec fields back out of the JFN ;Call: ; T2/ JFN ; PUSHJ P,DOJFNS ; ; Uses T1, T3 DOJFNS: CAIE T2,.PRIOU ;TTY:? CAIN T2,.PRIIN ; . . JRST DOJFN1 ;Yes, don't use JFNS% ;"REAL" JFN in T2. DOJFNR: HRROI T1,DEV(D) ;STORE DEVICE AS SUBSEQUENT DEFAULT MOVX T3,FLD(.JSAOF,JS%DEV) JFNS% HRROI T1,DIR(D) ;STORE DIRECTORY MOVX T3,FLD(.JSAOF,JS%DIR) JFNS% TXZ F,F%PPN ;DIRECTORY IS NOW NOT A PPN HRROI T1,FILE(D) ;STORE FILENAME MOVX T3,FLD(.JSAOF,JS%NAM) JFNS% HRROI T1,EXT(D) ;STORE EXTENSION MOVX T3,FLD(.JSAOF,JS%TYP) JFNS% HRROI T1,ATMBUF ;STORE GENERATION NUMBER IN ASCIZ MOVX T3,FLD(.JSAOF,JS%GEN) JFNS% SETZM PROT(D) ;Clear old protection, if set. HRROI T1,PROT(D) ;STORE PROTECTION MOVX T3,FLD(.JSAOF,JS%PRO) JFNS% ; HRROI T1,ACCT(D) ;DO SOMETHING REASONABLE ABOUT THIS ; MOVX T3,FLD(.JSAOF,JS%ACT) ; JFNS% POPJ P, ;JFN in T2 was .PRIIN or .PRIOU ;Store filespec as TTY:FORTTY.DAT DOJFN1: SETZM DIR(D) ;No directory SETZM ATMBUF ;No generation number SETZM PROT(D) ;No protection ; SETZM ACCT(D) ;No account MOVE T1,[ASCIZ /TTY/] MOVEM T1,DEV(D) ;Store device name MOVE T1,[ASCII /FORTT/] MOVEM T1,FILE(D) ;Store file name.. MOVE T1,[ASCIZ /Y/] MOVEM T1,FILE+1(D) MOVE T1,[ASCIZ /DAT/] MOVEM T1,EXT(D) ;Store extension POPJ P, ;Done, return >;END IF20 IF10,< ;Call: ; T1/ BITS TO SET WHEN FILE GETS OPENED ; PUSHJ P,DOOPEN ; ; DOOPEN: PUSHJ P,%SAVE1 ;Get a free ac MOVE P1,T1 ;Save bits in P1 LOAD T1,MODE(D) ;Get /MODE LDB T2,[POINT 4,MODTAB(T1),9] ;And data mode STORE T2,DMODE(D) PUSHJ P,%CHKNR ;Check data mode JRST REQDIA ;Illegal, go have dialog PUSHJ P,SETOCH ;Set OPEN channel ;May take ERR= branch LOAD T2,ACC(D) ;Get ACCESS mode CAIE T2,AC.RIN ;RANDOM IO? CAIN T2,AC.RIO JRST [ TXO P1,D%RAN ;Yes, will set "RANDOM" if file opened MOVEI T2,.IODMP ;And set "DUMP MODE" STORE T2,DMODE(D) JRST .+1] ;Do some setup depending on device type LOAD T2,INDX(D) ;Get device index PUSHJ P,@[ IFIW TTYSET IFIW DSKSET IFIW MTASET IFIW XXXSET IFIW E..SNH](T2) ;Do dev-dependent stuff JRST [PUSHJ P,RETOCH ;?Failed, Return OPEN channel PJRST REQDIA] ;Go request DIALOG and return .+1 ;Warning-- errors from now on must first un-do the above, for ; example the allocation of buffers for disk, etc. MOVE T1,P1 ;Get flags to set in T1 PUSHJ P,ALLBUF ;Allocate buffers MOVE T5,P1 ;Get fresh flags in T5 PUSHJ P,CALOF ;Call OPEN routine based on flags, ACC, STAT POPJ P, ;error, return .+1 MOVEI T2,AC.SOU ;Change ACCESS to SEQOUT LOAD T1,INDX(D) ; If device was a TTY CAIN T1,DI.TTY STORE T2,ACC(D) PUSHJ P,FIXDEF ;Defaults after everything is in place. PUSHJ P,FIXU ;Fix unit block stuff too PUSHJ P,DOCONS ;Do consolidation of DDB's if necessary TXNE F,F%CTTY ;Is this the controlling TTY:? MOVEM D,D.TTY ;Yes, store its DDB address. JRST %POPJ1 ;Return success ;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: LOAD T1,BUFAD(D) ;Deallocate buffer (if any) JUMPE T1,OFCLN1 ; None PUSHJ P,%FREBLK SETZ T1, STORE T1,BUFAD(D) OFCLN1: MOVEI T1,FBLK(D) ;Point to FILOP. block SETZM .FONBF(T1) ;Clear buffer counts SETZM .FOBRH(T1) ;Clear buffer headers ;Deallocate stuff gotten by DSKSET LOAD T1,INDX(D) ;What type of device CAIE T1,DI.DSK ; If not disk, JRST OFCLN2 ;No more core to deallocate LOAD T1,ACC(D) ;Get ACCESS type MOVE T3,ACCTAB(T1) ;See if random file TXNN T3,D%RAN ; Skip if random JRST OFCLN2 ;No, we didn't allocate any more core HRRZ T1,WTAB(D) ;Get address of page table HLRZ T1,(T1) ;Get number of first block LSH T1,-2 ;Get first page # allocated HLRE T2,WTAB(D) ;Get -# words MOVN T2,T2 ;# words LSH T2,-2 ;# pages PUSHJ P,%FREPGS ;Free up the core HRRZ T1,WTAB(D) ;Now free the page table PUSHJ P,%FREBLK ; . . SETZM WTAB(D) ;Clear all indication that we had memory OFCLN2: PUSHJ P,RETOCH ;Return OPEN channel SETZM FBLK(D) ; Forget file was opened POPJ P, ;Return ;Routine to do general FILOP. setup. ;T1= flags to set. ;Returns .+1 always ALLBUF: PUSH P,T1 ;Save flags a sec LOAD T1,ACC(D) ;Get ACCESS MOVE T3,ACCTAB(T1) ;Get flags by ACCESS type TXNE T3,D%RAN ;RANDOM I/O? JRST NOABUF ;Yes, don't allocate buffer here MOVEI T2,DMOD(D) ;Point ot OPEN block DEVSIZ T2, ;Get buffer size JRST NOABUF ;No buffers JUMPE T2,NOABUF LOAD T1,BUFCT(D) ;Get /BUFFERCOUNT CAIN T1,0 ; If set HLRZ T1,T2 ;Else get default STORE T1,BUFCT(D) ;Store it back IMULI T1,(T2) ;Get total space needed by buffers LOAD T2,INDX(D) ;GET DEVICE INDEX CAIN T2,DI.TTY ;TTY? LSH T1,1 ;Yes, one for input, one for output NOTIN: PUSHJ P,%GTBLK ;Allocate buffers STORE T1,BUFAD(D) ;Save for CLOSE NOABUF: MOVEI T1,FBLK(D) ;T1 points to FILOP. block MOVEI T2,LKPB(D) ;Set pointers MOVEM T2,.FOLEB(T1) MOVEI T2,LLEN MOV