Trailing-Edge
-
PDP-10 Archives
-
BB-4157E-BM
-
fortran-ots-debugger/forio.mac
There are 25 other files named forio.mac in the archive. Click here to see a list.
SEARCH FORPRM
TV FORIO I/O ROUTINES,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
1263 JLC 09-Feb-81 QAR 10-05487
Fix -10 backspace. SOJLE should be SOJGE.
1272 DAW 19-Feb-81
A few low-risk changes to support extended addressing.
1303 JLC 25-Feb-81
Folded -10 code for %irec into the -20 code for DIREC, made
it call %SAVE4 instead of %SAVE3 as it was clobbering P4.
Save line sequence number in the DDB.
1306 DAW 26-Feb-81
New arg-list format from %SAVE.
1310 DAW 26-Feb-81
Full words in DDB for END=, ERR=, IOST=, AVAR= addresses.
1316 JLC 5-Mar-81
Major changes for magtape handling, switching i/o direction.
1325 JLC 9-Mar-81
Yet more changes to magtape I/O on the -10
1332 JLC 11-Mar-81
Installed dump mode I/O for the -10.
1333 JLC 11-Mar-81
Fix to backspace over eof.
1336 JLC 12-Mar-81
Fix to dump mode I/O, removed extraneous saves of pntr/count
for the -10, added one where crucial (just before FILOP in
binary I/O).
1341 JLC 13-Mar-81
Add code to handle rewind of file that hasn't been opened
yet for the -10.
1343 DAW 16-Mar-81
A few changes for extended addressing.
1346 JLC 16-Mar-81
Fixes to -10 backspace file, skip file, and rewind.
1353 JLC 18-Mar-81
More fixes for -10 magtape ops. BAKEOF was not backspacing
over the last block of the file.
1357 JLC 19-Mar-81
More fixes to magtape ops. BAKEOF was not handling null
files correctly. Installed code to prevent creation of
null file for rewind, skip file, backfile, or unload with
no OPEN.
1360 EDS 19-Mar-81 Q10-05866
Range check UNIT numbers used in I/O statements.
1361 JLC 20-Mar-81
Fix some typos in code to prevent null file creation.
1363 JLC 24-Mar-81
Minor fixes to magtape and error typout,
added missing global (%iset) called from foropn.
1365 JLC 25-Mar-81
Typo in WAIT FILOP.
1366 JLC 26-Mar-81
Still more typos, plus BAKEOF bug, plus END FILE was not
incrementing the block #.
1374 JLC 31-Mar-81
Replace code to turn off D%END for terminals. Previous code
was wiping T1, which contained valuable data.
1376 JLC 31-Mar-81
Fix -10 backspace code to eliminate cache-sweep bugs for
SMP (removed clearing of use-bits).
1377 JLC 01-Apr-81
Change load/store FLGS to move/movem FLAGS, since it was
a full word. Minor fix to -10 backspace. Minor changes
to UNFO, moved check for empty window from end of loop
to beginning of BLT code.
1401 JLC 30-Apr-81
Put back code to clear use-bits, was merely masking another
bug.
1402 JLC 06-Apr-81
Transplant input record initialization to where it belongs,
new subroutine called %IRINI. Move setting of CRLF suppression
to %IREC.
1406 JLC 06-Apr-81
Minor bug in backspace for -10, backspace beyond block 1
sometimes would not work.
1410 JLC 07-Apr-81
Move record buffer setup to %IRINI and %ORINI in preparation
for separation of record buffer. Modify and separate EXPRB
for same preparation.
1411 DAW 08-Apr-81
Use IJFN and OJFN instead of JFN.
1412 JLC 09-Apr-81
Fix minor problem reading fixed-length record files. Fix
backspace for the -20 for fixed-length record files.
1413 DAW 10-Apr-81
Get rid of flag D%MTOP. FOROTS doesn't need to check
whether or not its doing a magtape operation on every IO
statement.
1414 DAW 10-Apr-81
MTOP operations were ignoring ERR=.
1416 JLC 10-Apr-81
Separate record buffers. Install DTA rewind and unload.
1422 JLC 13-Apr-81
Typo in separate record buffers.
1423 DAW 13-Apr-81
Put %SETD in FORIO (was in FOROPN).
1424 JLC 14-Apr-81
Typo in %IRINI made DECODE non-existent.
1427 JLC 15-Apr-81
Changed RSIZ to be a word in the DDB. Make FORIO
ignore MODE=DUMP if ACCESS=RANDOM.
1430 JLC 15-Apr-81
Typo in -20 backspace broke it.
1432 JLC 16-Apr-81
Was trashing returned AC T3 in DIREC. Changed code to return
result in IRCNT(D) instead.
1433 JLC/CKS 16-Apr-81
Fix for binary backspace.
1435 CKS 16-Apr-81
More binary backspace fixes.
1436 JLC 16-Apr-81
More of edit 1432. Return result in IRCNT for DECODE also.
1443 JLC 17-Apr-81
Make EOFN(D) represent fixed number of bytes in file. EOF
detected by comparing BYTN with EOFN.
1444 JLC 21-Apr-81
Fix bug caused by edit 1443; it was smashing T1.
1445 DAW 21-Apr-81
Rework code around UNFSW to make it more understandable.
1450 JLC 22-Apr-81
Fix DECODE new record code.
1451 JLC 23-Apr-81
Special code for dump mode I/O in mtops.
1453 JLC 24-Apr-81
Make dump mode backspace and skiprecord work for magtape.
Insert if20 end after EOFN setup code.
1454 JLC 24-Apr-81 QAR 20-01364
Change EOFN if we switch from formatted to unformatted.
1455 JLC 27-Apr-81
Fix bug from edit 1452. Must not set D%LIN/D%LOUT on the way
out of magtape operations.
1460 JLC 28-Apr-81
Fix typo in edit 1453. It thought most files were dump mode.
1463 JLC 7-May-81
Many major changes. See FOROTS.MAC revhist.
1464 DAW 21-May-81
Error messages.
1465 JLC 15-May-81
Major changes to -20 I/O.
1474 JLC 22-May-81
Bug in %PTOF, thought WSIZ was in words, was in bytes.
1476 JLC 26-May-81
Bug in unformatted I/O, was looking at EOFN for non-disk files.
1501 JLC 27-May-81
More bugs, this time in random I/O, caused by changed calling
sequence for MAPW.
1502 JLC 28-May-81
Install defensive WAIT operations in magtape code.
1505 JLC 01-Jun-81
Many bug fixes in disk and magtape backspace operations.
Turn off EOF and initialize things for BACKFILE and
SKIPFILE.
1506 CKS 2-Jun-81
Add SLST77 and ELST77, temporarily equated to F-66 equivalents,
SLIST and ELIST.
1511 JLC 5-Jun-81
More edits to magtape code, for SKIPFILE and BACKFILE.
1516 JLC 10-Jun-81
Yet another bug, this time in disk backspace. WSIZ is not
in words! Fix end-of-record handling for unformatted I/O.
1532 DAW 14-Jul-81
OPEN rewrite: Base level 1
1535 JLC 14-Jul-81
EOF handling correction, both to zero arrays correctly
and to handle IOSTAT correctly.
1536 JLC 15-Jul-81
Minor edits.
1542 JLC 17-Jul-81
Fix ERR and END processing and %MVBLK.
1546 JLC 20-Jul-81
Fix DEC% to call DECINI. Fix TIREC for -20 to allocate
record buffer if none there yet.
1547 DAW 20-Jul-81
Replacement for old %CHKDR routine.
1550 JLC 20-Jul-81
Fix DECODE, it had off-by-one error. Fix X format, it referenced
stuff in DDB without D. Fix setup of record buffers - make sure
it happens in %ORINI or %IRINI.
1553 JLC 23-Jul-81
Fix ENCODE and DECODE again. Setup IRPTR properly in TIREC.
Eliminate useless routine ENCINX.
1560 DAW 28-Jul-81
OPEN rewrite: Base level 2
1567 JLC 30-Jul-81
More fixes to ENCODE/DECODE, output buffer setup, prompting.
1572 JLC 31-Jul-81
ENCODE - setup entire string with blanks for initialization.
1574 BL 3-Aug-81
Missing IF20 conditional around G.PRP
1575 JLC 05-Aug-81
Fix record zeroing again.
1577 DAW 11-Aug-81
Create "ENDNUL" routine to make the "drop a null at EOR"
hack work correctly.
1601 DAW 12-Aug-81
ENDFILE to a disk file was trying to open it for input on the -20.
1604 DAW 12-Aug-81
More of 1601-type stuff, for DIVERT.
1607 DAW 13-Aug-81
Fix bug in FIND code.
1613 JLC 19-Aug-81 Q10-6390
Use a character count, not a word count, in backspace of
ASCII files.
1614 JLC 19-Aug-81
Move setting of D%MOD into DOREC. Remove END= branching
for end-of-record for files with no crlf at end, thus
EOF becomes a valid record terminator, and the program
will get END= at the next read.
1622 JLC 21-Aug-81
Rewrite ENCODE/DECODE again, rework record positioning
subroutines for output, so that X, T format reaaly work.
1625 DAW 21-Aug-81
Get rid of "DF".
1627 DAW 24-Aug-81
On TOPS-20, UNLOAD and REWIND no longer need a filename
1630 JLC 24-Aug-81
Make illegal operations on magtape a fatal error.
1631 DAW 24-Aug-81
Set D%MOD in UNFO.
1632 JLC 24-Aug-81
Fixed OPAD to output spaces instead of random trash for X and
T format.
1633 JLC 25-Aug-81
On TOPS-20, SKIPFILE and BACKFILE no longer need a filename.
1634 JLC 25-Aug-81
ORPOS was left set at FIXREC, caused records to be too large.
1635 JLC 25-Aug-81
Fix for edit 1633, plus ENDFILE can't work that way.
1637 JLC 26-Aug-81
DECODE bug. IRCNT was not getting set up properly.
1642 JLC 27-Aug-81
Replace %FILOP calls with FILOPs.
1643 JLC 27-Aug-81
More code for faster EOL handling. Modify IRBUF/ORBUF to be full
words so ENCODE/DECODE will work with extended addressing.
1645 DAW 28-Aug-81
Column 1 before errors in DIVERT'ed file.
1646 DAW 28-Aug-81
DTA REWIND and UNLOAD used wrong channel.
1647 DAW 28-Aug-81
DTA REWIND and UNLOAD to not require an existing file.
1652 DAW 1-Sep-81
Fix DUMP mode I/O on TOPS-10; make "IOE" a "?" error.
1653 JLC 1-Sep-81
Return -1 (illegal LSN) for non-LINED files and LINED files
with no LSN.
1663 JLC 8-Sep-81
Fixed ill mem read for non-existent pages in read-only file.
Added code to record top page number, so unused pages can be
unmapped.
1665 DAW 8-Sep-81
Make a D.TTY hack to get error messages right; delete refs to U.TTY.
1676 DAW 9-Sep-81
%OCRLF to always output a CRLF, and not use "U".
1702 JLC 10-Sep-81
More fix to non-existent page stuff, unmapping unused pages.
Add code to prevent expansion of random files on -10 by
merely touching the page (not possible on -20).
1703 DAW 11-Sep-81
Fix printing of too many CRLF's in errors when a TTY file is open.
1704 JLC 11-Sep-81
Fix SETPOS not to pad a blank when we are at desired position.
Also typo in RDW for -10 in edit 1702.
1705 JLC 11-Sep-81
Fix more serious T-format bug. T1 was not working on output,
as it got stored as position 0. Now ORPOS contains desired
position of NEXT character.
1706 DAW 11-Sep-81
Lots of changes to errors.
1707 JLC 14-Sep-81
Edit 1705 broke %IBACK.
1712 JLC 15-Sep-81
Fixed more bugs in t-format, created IRPOS.
Eliminated D%ERR!
1716 JLC 16-Sep-81
Changed the names of ISPOS, OSPOS, etc., to make things less
confusing. Fixed typo due to confusion.
1722 JLC 16-Sep-81
Code for IRPOS more complicated than originally envisaged.
1730 JLC 18-Sep-81
More fixes for T-format.
1735 DAW 22-Sep-81
-20 DISK APPEND files now get EOF for READ.
1737 DAW 23-Sep-81
Fix processing of REREAD error "RBR".
1740 DAW 23-Sep-81
More REREAD code.
1745 JLC 24-Sep-81
Made IRBLN, ORBLN, and IRLEN full words. Removed all refs
to IRPOS, now unnecessary.
1761 JLC 5-Oct-81
Fixed ENDFILE on disk, did not open file for output before.
1774 DAW 8-Oct-81
Avoid "?Unexpected TAPOP. error" for typical errors.
1775 JLC 9-Oct-81
Fix ^Z handling.
1777 DAW 9-Oct-81
FILOP. CLOSE before RELEASE where appropriate.
2005 JLC 15-Oct-81
Fix unmapping of unused pages so it does it for random files.
On -10, update .RBSIZ so we don't return zeroes for data
that's there.
2006 JLC 15-Oct-81
Control-Z change broke DECODE by meddling with IRCNT, which
should be inviolate before the "device-dependent" call.
2010 JLC 19-Oct-81
Make EOFN and BYTN live for the -10.
2016 JLC 20-Oct-81
Fix SLISTs and ELISTs to differentiate between -66 and -77
programs and give 1-trip (i.e., 1 entry) for zero-trip
lists.
2030 JLC 27-Oct-81
Fix SLISTs and ELISTs to substitute 1 for zero or negative
supplied counts.
2033 DAW 19-Nov-81
Change symbol "LTYPE" to "%LTYPE" to avoid conflict with
user symbol.
Give error if user tries to do random I/O without an OPEN
statement with a RECORDSIZE specifier.
Pay attention to ERR= and IOSTAT= for ENCODE and DECODE.
Fix dollar format to make T and X format have some effect
at end of record.
***** End Revision History *****
\
ENTRY IN%,OUT%,RTB%,WTB%,NLI%,NLO%,ENC%,DEC%,FIND%,MTOP%
ENTRY IOLST%,FIN%
INTERN %IBYTE,%OBYTE,%IBYTC
INTERN %IREC,%OREC,%EOREC,%OCRLF,%ORECS
INTERN %IBACK,%OVNUM,%GETIO,%MAPW,%SETAV
INTERN %RPOS,%SPOS
IF10,< INTERN %RANWR,%BACKB,%CLRBC,%BAKEF,%ISET >
INTERN %SETD
INTERN %UDBAD
EXTERN %POPJ,%POPJ1,%SAVE1,%SAVE2,%SAVE3,%SAVE4,%SAVE,%PUSHT,%POPT,%JPOPT
EXTERN %FORMT,%LDI,%LDO,%NLI,%NLO
EXTERN %IOERR,%ABORT,%IONAM
EXTERN %SETIN,%SETOUT,%CHKNR,%CRLF
EXTERN %GTBLK,%MVBLK
EXTERN %ISAVE,%FSAVE,%SIZTB,%DDBTA
EXTERN %EDDB,U.RERD,U.ERR,D.TTY
IF20,< EXTERN G.PRP,G.PRMPT,%OCCOC,%CCMSK,%CLSOP >
IF10,< EXTERN %ST10B,%CALOF,%CLSER,%FREBLK >
EXTERN %LTYPE
EXTERN %OPENX,%LSTBF
EXTERN %TERR,%TIOS
EXTERN %ALCHN,%DECHN
SEGMENT CODE
SUBTTL I/O SETUP
;Formatted read -- READ (u,1)
SIXBIT /IN./
IN%: PUSHJ P,%SAVE ;SAVE ACS
PUSHJ P,FMTCNV ;CONVERT ARG LIST
MOVX P1,0 ;SET FORMATTED INPUT
JRST INGO ;GO DO I/O
;Formatted write -- WRITE (u,1)
SIXBIT /OUT./
OUT%: PUSHJ P,%SAVE ;SAVE ACS
PUSHJ P,FMTCNV ;CONVERT ARG LIST
MOVX P1,D%IO ;SET FORMATTED OUTPUT
JRST OUTGO ;GO DO I/O
;Unformatted read
SIXBIT /RTB./
RTB%: PUSHJ P,%SAVE ;SAVE ACS
PUSHJ P,UNFCNV ;CONVERT ARG LIST
MOVX P1,D%UNF ;SET UNFORMATTED INPUT
JRST INGO ;GO DO I/O
;Unformatted write
SIXBIT /WTB./
WTB%: PUSHJ P,%SAVE ;SAVE ACS
PUSHJ P,UNFCNV ;CONVERT ARG LIST
MOVX P1,D%UNF+D%IO ;SET UNFORMATTED OUTPUT
JRST OUTGO ;GO DO I/O
;Namelist input
SIXBIT /NLI./
NLI%: PUSHJ P,%SAVE ;SAVE ACS
PUSHJ P,NMLCNV ;CONVERT ARG LIST
MOVX P1,D%NML ;SET NAMELIST INPUT
JRST INGO ;GO DO I/O
;Namelist output
SIXBIT /NLO./
NLO%: PUSHJ P,%SAVE ;SAVE ACS
PUSHJ P,NMLCNV ;CONVERT ARG LIST
MOVX P1,D%NML+D%IO ;SET NAMELIST OUTPUT
JRST OUTGO ;GO DO I/O
;DECODE
SIXBIT /DEC./
DEC%: PUSHJ P,%SAVE ;SAVE ACS
PUSHJ P,ENCCNV ;CONVERT ARG LIST
XMOVEI T1,[ASCIZ /DECODE/]
MOVEM T1,%IONAM ;Set statement name
PUSHJ P,IOARG ;Move args to A.XXX
PUSHJ P,SETDE ;SET UP DDB POINTING TO STRING
MOVX T1,D%ENC ;Set ENCODE/DECODE input
MOVEM T1,FLAGS(D)
MOVEM U,%UDBAD ;SAVE DDB ADDRESS FOR IOLST
PUSHJ P,DECINI ;INIT BUFFER PNTR
PUSHJ P,%IREC ;Read record
MOVE T1,[%FORMT,,%FORMT] ;Set for formatted I/O
JRST %SIO ;Start I/O
;ENCODE
SIXBIT /ENC./
ENC%: PUSHJ P,%SAVE ;SAVE ACS
PUSHJ P,ENCCNV ;CONVERT ARG LIST
XMOVEI T1,[ASCIZ /ENCODE/]
MOVEM T1,%IONAM ;Set statement name
PUSHJ P,IOARG ;Move args to A.XXX
PUSHJ P,SETDE ;SET UP DDB POINTING TO STRING
MOVX T1,D%ENC+D%IO ;Set ENCODE/DECODE output
MOVEM T1,FLAGS(D)
MOVEM U,%UDBAD ;SAVE DDB ADDRESS FOR IOLST
PUSHJ P,ENCINI ;Init for ENCODE
MOVE T1,[%FORMT,,%FORMT] ;Set for formatted I/O
JRST %SIO ;Start I/O
SIXBIT /MTOP./
MTOP%: PUSHJ P,%SAVE ;SAVE ACS
PUSHJ P,MTCNV ;CONVERT ARG LIST
XMOVEI T1,[0] ;DON'T KNOW STATEMENT NAME YET
MOVEM T1,%IONAM
PUSHJ P,IOARG ;Move args to A.XXX
PUSHJ P,CHKUNT ;Check for unit number in range
;(Goes to ABORT% if unit is bad)
PJRST MTOP ;OK, Go do it and return.
IOARG: SETZM A.UNIT ;CLEAR BLOCK SO UNSPECIFIED ARGS ARE 0
MOVE T1,[A.UNIT,,A.UNIT+1]
BLT T1,IOARGS+MAXKWD-1
ARGLP: LDB T1,[POINTR @%LTYPE,ARGKWD] ;GET KWD OF ARGUMENT
JUMPE T1,ARGN ;POSITIONAL ARG NOT SPECIFIED, SKIP IT
XMOVEI T2,@0(L) ;Get arg address
CAIE T1,IK.UNIT ;VALUE-TYPE ARG?
CAIN T1,IK.FMS
JRST ARGV ;YES, GO GET VALUE
CAIE T1,IK.MTOP
CAIN T1,IK.HSL
JRST ARGV
JRST ARGS ;NOT VALUE ARG, GO STORE TYPE & ADDRESS
ARGV: HRRZ T2,(L) ;Get value
MOVE T3,@%LTYPE ;Get arg bits.
TXNE T3,ARGTYP ;IMMEDIATE MODE?
MOVE T2,@(L) ;NO, GET VALUE
ARGS: MOVEM T2,IOARGS(T1) ;STORE ARG IN BLOCK
LDB T2,[POINTR @%LTYPE,ARGTYP] ;GET TYPE
MOVEM T2,IOTYPS(T1) ;STORE TYPE
ARGN: AOBJN L,ARGLP ;TRANSFER WHOLE ARG BLOCK
SKIPE T1,A.IOS ;IOSTAT VARIABLE?
SETZM (T1) ;YES. CLEAR IT
POPJ P, ;DONE
SEGMENT DATA
;COPIED ARGS, MUST BE CONSECUTIVE, IN ORDER ON KEYWORD NUMBER (IK.XXX)
IOARGS==.-1 ;ARGS START AT UNIT
A.UNIT:: BLOCK 1 ;UNIT= [VALUE]
A.FMT:: BLOCK 1 ;FMT= [ADDRESS]
A.FMS:: BLOCK 1 ;FORMAT SIZE [VALUE]
A.END:: BLOCK 1 ;END= [ADDRESS]
A.ERR:: BLOCK 1 ;ERR= [ADDRESS]
A.IOS:: BLOCK 1 ;IOSTAT= [ADDRESS]
A.REC:: BLOCK 1 ;REC= [ADDRESS]
A.NML:: BLOCK 1 ;NAMELIST ADDRESS [ADDRESS]
A.MTOP:: BLOCK 1 ;MTA OP CODE [VALUE]
A.HSA:: BLOCK 1 ;ENCODE/DECODE HOL STRING ADDRESS [ADDRESS]
A.HSL:: BLOCK 1 ;ENCODE/DECODE HOL STRING LENGTH [VALUE]
MAXKWD==.-IOARGS ;MAX LEGAL IO ARG KWD NUMBER
;NOW FOR THE DATA TYPES
IOTYPS=.-1
T.UNIT:: BLOCK 1 ;UNIT= [VALUE]
T.FMT:: BLOCK 1 ;FMT= [ADDRESS]
T.FMS:: BLOCK 1 ;FORMAT SIZE [VALUE]
T.END:: BLOCK 1 ;END= [ADDRESS]
T.ERR:: BLOCK 1 ;ERR= [ADDRESS]
T.IOS:: BLOCK 1 ;IOSTAT= [ADDRESS]
T.REC:: BLOCK 1 ;REC= [ADDRESS]
T.NML:: BLOCK 1 ;NAMELIST ADDRESS [ADDRESS]
T.MTOP:: BLOCK 1 ;MTA OP CODE [VALUE]
T.HSA:: BLOCK 1 ;ENCODE/DECODE HOL STRING ADDRESS [ADDRESS]
T.HSL:: BLOCK 1 ;ENCODE/DECODE HOL STRING LENGTH [VALUE]
SEGMENT CODE
OUTGO: XMOVEI T1,[ASCIZ /WRITE/] ;Set statement name
MOVEM T1,%IONAM
PUSHJ P,STIO ;Do common start functions
PUSHJ P,%SETD ;Setup D and U, do implicit
; OPEN if necessary.
PUSHJ P,%SETOUT ;Get file opened for output.
JRST EFIO1C ;Go to common code
INGO: XMOVEI T1,[ASCIZ /READ/]
MOVEM T1,%IONAM
PUSHJ P,STIO ;Do common start functions
; (returns t1= unit number)
CAME T1,[-6] ;REREAD?
JRST INGO1 ;No
SKIPN T1,U.RERD ;GET REREAD UNIT
JRST DORBR ;?REREAD not preceeded by READ
TXO F,F%NINP ;SUPPRESS FIRST INPUT
INGO1: PUSHJ P,%SETD ;Do implicit OPEN if necessary
PUSHJ P,%SETIN ;Get file opened for input.
JRST EFIO1C ;Go rejoin common code
;Process error "REREAD not preceeded by READ"
SEGMENT ERR
DORBR: PUSHJ P,SETERI ;Setup %TERR and %TIOS
$ECALL RBR,%ABORT
SETERI: MOVE T1,A.ERR ;Setup ERR= if specified
MOVEM T1,%TERR
MOVE T1,A.IOS ; and IOSTAT=
MOVEM T1,%TIOS
POPJ P, ;Return
SEGMENT CODE
;Common READ/WRITE I-O start-up functions
;Copy IO args to A.xxx
;Check unit number in range.
;If REC= specified, sets D%RAN in P1
;Returns T1= unit number
STIO: PUSHJ P,IOARG ;MOVE ARGS TO A.XXX
PUSHJ P,CHKUNT ;Check unit number in range
; (Goes to ABORT% or ERR= if not).
SKIPE A.REC ;REC= SPECIFIED?
TXO P1,D%RAN ;YES, IMPLIES RANDOM I/O
HRRE T1,A.UNIT ;GET UNIT
POPJ P, ;Return
EFIO1C: XOR P1,OLDFLG ;CHECK THAT I/O STATEMENT MATCHES FILE
TXNN P1,D%RAN+D%UNF
JRST IOGO ;MATCHES, FINE
TXNE P1,D%RAN ;MISMATCH ON RANDOM/SEQUENTIAL?
PUSHJ P,RNSMIS ;Yes, print error and return
; (we might also have UNF/FORM error)
TXNN P1,D%UNF ;Mismatch on UNF?
JRST %ABORT ;No, just abort because of the RAN error.
;This mismatch can only occur if the file had previously been open
;assuming FORMATTED I/O and the user just did an UNFORMATTED operation.
;
;If no I/O has been done (only the OPEN statement), and the /MODE was not
; specified, this is ok-- the file is changed to be UNFORMATTED. Otherwise,
; it is a fatal error, and the program is aborted.
LOAD T1,XMODE(D) ;GET 1 IFF WE DIDN'T SEE /MODE IN OPEN
SKIPN BLKN(D) ;AT START OF FILE?
JUMPN T1,CUNFSW ;YES, CAN SWITCH IF NO /MODE IN OPEN
JRST MISFUF ;Fatal mismatch of FORMATTED/UNFORMATTED
;Here if it is possible for us to switch FORMATTED to UNFORMATTED
CUNFSW: TXNE P1,D%RAN ;But did we also get a mismatch of
; RANDOM and SEQUENTIAL?
JRST %ABORT ;Yeah, just quit.
PUSHJ P,UNFSW ;Otherwise-- switch file to UNFORMATTED.
JRST IOGO ; and go on.
;Come here if there is a fatal mismatch of FORMATTED/UNFORMATTED
;I/O. Type error message and abort the program.
MISFUF: DMOVE T2,[EXP [ASCIZ /formatted/],[ASCIZ /unformatted/]]
MOVE T1,FLAGS(D) ;Get DDB flags
TXNN T1,D%UNF ;DID HE TRY UNFORMATTED I/O?
EXCH T2,T3 ;YES
PUSHJ P,CDI ;TELL HIM HE CAN'T DO IT
PJRST %ABORT ;GO DIE
CDI: ;IOERR (CDI,31,315,?,Can't do $A I/O to $A file,<T2,T3>,%POPJ)
$ECALL CDI,%POPJ
;Routine to print fatal error message for user because
; he tried to mix and match random and sequential access.
; After the error is typed, it returns so FOROTS can type
;still more errors if necessary.
RNSMIS: DMOVE T2,[EXP [ASCIZ /direct/],[ASCIZ /sequential/]]
MOVE T1,FLAGS(D) ;Get DDB flags
TXNE T1,D%RAN ;DID USER TRY RANDOM I/O?
EXCH T2,T3 ;NO, HE TRIED SEQUENTIAL
PJRST CDI ;Tell user he can't do it; return
;Routine to switch file from FORMATTED to UNFORMATTED.
;POPJ's when done.
UNFSW: MOVX T1,D%UNF!D%BIN ;Set UNFORMATTED and BINARY
IORM T1,FLAGS(D)
MOVEI T2,^D36 ;Set byte size to 36
IF10,< STORE T2,IBSIZ(D)
STORE T2,OBSIZ(D) >
IF20,< STORE T2,BSIZ(D) >
IF20,<
LOAD T1,INDX(D) ;NONDISK?
CAIN T1,DI.DSK
JRST UNSW1 ;NO
LOAD T1,IJFN(D) ;YES, RESET MONITOR BYTE SIZE ALSO
SFBSZ%
PUSHJ P,SETBSZ ;EASY WAY FAILED, REOPEN FILE
UNSW1: LOAD T2,BPW(D) ;GET BYTES/WORD
MOVE T1,WSIZ(D) ;GET WINDOW SIZE
ADDI T1,-1(T2) ;ROUND UP
IDIVI T1,(T2) ;GET WINDOW SIZE IN WORDS
MOVEM T1,WSIZ(D) ;STORE IT
> ;IF20
MOVE T1,EOFN(D) ;GET FILE SIZE IN BYTES
CAMGE T1,[377777,,777774] ;PREVENT OVERFLOW
ADDI T1,4 ;CONVERT TO WORDS
IDIVI T1,5
MOVEM T1,EOFN(D)
MOVEI T1,MD.BIN ;Set /MODE to binary
STORE T1,MODE(D)
IF10,<
MOVE T1,FLAGS(D) ;Get DDB flags
TXNE T1,D%RAN ;Is this a RANDOM file?
JRST NODM ;YES, DON'T CHANGE DATA MODE
MOVEI T1,.IOBIN ;Binary
STORE T1,DMODE(D)
PUSHJ P,%CHKNR ;CHECK THAT MODE IS LEGAL FOR THIS DEVICE
JRST %ABORT ;NOT LEGAL, MESSAGE ALREADY TYPED; GO DIE
HLLZ T2,CHAN(D) ;DO SETSTS FILOP TO TELL MONITOR ABOUT NEW MODE
HRRI T2,.FOSET
LOAD T3,DMODE(D)
MOVE T1,[2,,T2]
FILOP. T1,
$SNH ;SETSTS shouldn't fail
NODM:
> ;IF10
MOVEI T1,1 ;SET BYTES PER WORD
STORE T1,BPW(D)
POPJ P, ;Return
IF20,<
;This routine gets called for DISK files
; when the SFBSZ% JSYS has failed.
;If the file has not been opened yet, the routine just POPJ's since
;the byte size will be set correctly when the OPENF is done.
;
;If the OPENF has already been done, the routine tries to do a CLOSF
; and another OPENF with the correct byte size. If this fails the
; program is aborted.
;
;Inputs:
; T2/ byte size we want.
; D/ pointer to the DDB.
;Call:
; PUSHJ P,SETBSZ
; <return here if ok> ;Goes to %ABORT if something is wrong
;Smashes ac T1 only
SETBSZ: PUSH P,T2 ;Save the byte size we want
LOAD T1,IJFN(D) ;GET FILE STATUS
GTSTS%
JUMPGE T2,T2POPJ ;FILE NOT OPEN YET, REAL OPEN WILL BE OK
SETZ T1, ;INIT OPENF BITS
TXNE T2,GS%RDF ;FILE OPEN FOR READ?
TXO T1,OF%RD ;YES, RE-OPEN FOR READ
TXNE T2,GS%WRF ;WRITE?
TXO T1,OF%WR
POP P,T2 ;Restore byte size
LSH T2,^D30 ;POSITION BYTE SIZE FOR OPENF
IOR T2,T1 ;Put more OPENF% bits into the arg.
LOAD T1,IJFN(D) ;CLOSE FILE
HRLI T1,(CO%NRJ) ;KEEP JFN
CLOSF% ; (This does not affect T2)
; IOERR (UFS,34,,?,$J,,%ABORT)
$ECALL UFS,%ABORT
LOAD T1,IJFN(D) ;REOPEN FILE WITH MODIFIED BYTE SIZE
OPENF%
; IOERR (UFS,30,,?,$J,%ABORT) ;CAN'T
$ECALL UFS,%ABORT
POPJ P, ;NEW BYTE SIZE SET
;Restore T2 and POPJ.
T2POPJ: POP P,T2
POPJ P, ;Return
> ;IF20
;Routine to check UNIT= to see if unit number is in range
;Call:
; PUSHJ P,CHKUNT
; <return here if ok>
;If unit is out of range and ERR= or IOSTAT= was specified,
; the program returns to the appropriate place.
;Otherwise, the error message is typed and the program is aborted.
;Uses T1,T2
CHKUNT: HRRE T2,A.UNIT ;GET UNIT
CAML T2,[-7] ;RANGE CHECK. NEGATIVE ARGS ILLEGAL
CAILE T2,MAXUNIT ; OR UNIT BEYOND RANGE OF DDBTAB
JRST .+2 ;Out of range.
POPJ P, ;Ok, return
;Prepare to call error routine
;T2= unit number (IUN error uses it)
PUSHJ P,SETERI ;Set %TERR and %TIOS
$ECALL IUN,%ABORT ;Give error
IOGO: MOVEM U,%UDBAD ;SAVE DDB ADDRESS FOR IOLST
MOVE T2,FLAGS(D) ;T2:= DDB flags
IF10,<
LOAD T1,MODE(D) ;GET THE /MODE
TXNN T2,D%RAN ;RANDOM IS SPECIAL DUMP
CAIE T1,MD.DMP ;DUMP?
JRST NOTDMP ;NO
MOVE T1,[DMPIN,,DMPOUT] ;YES.
JRST %SIO ;GO DO IT
NOTDMP:
>;END IF10
TXNE T2,D%RAN ;RANDOM I/O?
PUSHJ P,RMAPW ;YES, SET TO START OF RECORD
MOVE T2,FLAGS(D) ;Reget flags
TXNE T2,D%UNF ;Unformatted?
JRST [MOVE T1,[UNFI,,UNFO] ;Yes
JRST %SIO]
TXNN T2,D%IO ;GET A RECORD IF INPUT
PUSHJ P,%IREC
MOVE T1,[%FORMT,,%FORMT] ;ASSUME FORMATTED
SKIPE T2,A.FMT ;GET FORMAT ADDR
CAMN T2,[IK.FMT_^D27] ;Compiler kludge-- keyword+0 address
MOVE T1,[%LDI,,%LDO] ;NO, ASSUME LIST-DIRECTED
SKIPE A.NML ;UNLESS NAMELIST SPECIFIED
MOVE T1,[%NLI,,%NLO] ;THEN SET NAMELIST ADDRESSES
JRST %SIO ;GO DO I/O
;HERE FROM IOLST% OR FIN% WHEN I/O IS COMPLETE
%FIO: SETZM %UDBAD ;CLEAR THE UDB PNTR
MOVE T1,FLAGS(D) ;Get DDB flags
TXNE T1,D%IO ;OUTPUT?
TXNE T1,D%UNF ;YES, FORMATTED?
JRST %SETAV ;NO
PUSHJ P,%OREC ;OUTPUT RECORD
%SETAV: MOVE T1,NREC(U) ;GET CURRENT RECORD NUMBER
SKIPE T2,AVAR(U) ;Get address of ASSOCIATE VARIABLE
MOVEM T1,(T2) ;There is one, store record number
SETZM ENDAD(U) ;Clear END=,
SETZM ERRAD(U) ; ERR=,
SETZM IOSAD(U) ; IOSTAT=.
POPJ P, ;DONE
;ROUTINE TO SET UP A DDB FOR ENCODE/DECODE
SETDE: SETZ P1, ;No funny IO flags.
SKIPE U,%EDDB ;DDB ALREADY CREATED?
JRST GOTD ;Yes, use it.
MOVEI T1,ULEN ;Get length of unit block
PUSHJ P,%GTBLK
MOVE U,T1 ;Point U to it
MOVEM U,%EDDB ;Save for use on next ENCODE/DECODE
MOVEI T1,DLEN ;GET LENGTH OF DDB
PUSHJ P,%GTBLK ;GET AN EMPTY DDB
MOVEI D,(T1) ;POINT D TO IT
MOVEM D,DDBAD(U) ;Remember it in the unit block
MOVEI T1,DI.INT ;SET "DEVICE" TYPE TO INTERNAL FILE
STORE T1,INDX(D) ;STORE IN DDB
MOVEI T1," " ;PAD WITH SPACES
STORE T1,PADCH(U)
JRST GOTD ;Done
;ROUTINES TO CONVERT POSITIONAL ARG BLOCKS TO KEYWORD ARG BLOCKS
FMTCNV: LDB T1,[POINTR @%LTYPE,ARGKWD] ;GET KWD FIELD OF FIRST ARG
JUMPN T1,%POPJ ;NONZERO, NEW-STYLE CALL
CAMLE L,[-4,,-1] ;AT LEAST 4 ARGS?
JRST IOCNV1 ;NO, SKIP /FMT
PUSH P,L
ADD L,[3,,3]
MOVEI T1,IK.FMT ;GET KWD NUMBER FOR /FMT
DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST
POP P,L
CAMLE L,[-5,,-1] ;AT LEAST 5 ARGS?
JRST IOCNV1 ;NO, SKIP FORMAT SIZE
PUSH P,L
ADD L,[4,,4]
MOVEI T1,IK.FMS ;GET KWD NUMBER FOR FORMAT SIZE
DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST
POP P,L
IOCNV1: CAMLE L,[-6,,-1] ;AT LEAST 6 ARGS?
JRST IOCNV2 ;NO, SKIP /REC
PUSH P,L
ADD L,[5,,5]
MOVEI T1,IK.REC ;GET KWD NUMBER FOR /REC
DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST
POP P,L
IOCNV2: MOVEI T1,IK.UNIT ;GET KWD NUMBER FOR /UNIT
DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST
IOCNV3: CAMLE L,[-2,,-1] ;AT LEAST 2 ARGS?
POPJ P, ;NO, DONE
MOVEI T1,IK.END ;GET KWD NUMBER FOR /END
PUSH P,L
ADDI L,1
DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST
POP P,L
CAMLE L,[-3,,-1] ;AT LEAST 3 ARGS?
POPJ P, ;NO, DONE
PUSH P,L
ADDI L,2
MOVEI T1,IK.ERR ;GET KWD NUMBER FOR /ERR
DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST
POP P,L
POPJ P, ;DONE
UNFCNV: LDB T1,[POINTR @%LTYPE,ARGKWD] ;GET KWD FIELD OF FIRST ARG
JUMPN T1,%POPJ ;NONZERO, NEW-STYLE CALL
JRST IOCNV1
NMLCNV: LDB T1,[POINTR @%LTYPE,ARGKWD] ;GET KWD FIELD OF FIRST ARG
JUMPN T1,%POPJ ;NONZERO, NEW-STYLE CALL
CAMLE L,[-4,,-1] ;AT LEAST 4 ARGS?
JRST IOCNV2 ;NO, NO NAMELIST ADDRESS
PUSH P,L
MOVEI T1,IK.NML ;GET KWD NUMBER FOR NAMELIST
ADDI L,3
DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST
POP P,L
JRST IOCNV2 ;GO DO STANDARD ARGS
ENCCNV: LDB T1,[POINTR @%LTYPE,ARGKWD] ;GET KWD FIELD OF FIRST ARG
JUMPN T1,%POPJ ;NONZERO, NEW-STYLE CALL
MOVEI T1,IK.HSL ;GET KWD NUMBER FOR STRING LENGTH
DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST
CAMLE L,[-4,,-1] ;AT LEAST 4 ARGS?
JRST IOCNV3 ;NO, SKIP /FMT
PUSH P,L
ADDI L,3
MOVEI T1,IK.FMT ;GET KWD NUMBER FOR /FMT
DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST
POP P,L
CAMLE L,[-5,,-1] ;AT LEAST 5 ARGS?
JRST IOCNV3 ;NO, SKIP FORMAT SIZE
PUSH P,L
ADDI L,4
MOVEI T1,IK.FMS ;GET KWD NUMBER FOR FORMAT SIZE
DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST
POP P,L
CAMLE L,[-6,,-1] ;AT LEAST 6 ARGS?
JRST IOCNV3 ;NO, SKIP STRING ADDRESS
PUSH P,L
ADDI L,5
MOVEI T1,IK.HSA ;GET KWD NUMBER FOR STRING ADDRESS
DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST
POP P,L
JRST IOCNV3 ;GO DO STANDARD ARGS
MTCNV: LDB T1,[POINTR @%LTYPE,ARGKWD] ;GET KWD FIELD OF FIRST ARG
JUMPN T1,%POPJ ;NONZERO, NEW-STYLE CALL
CAMLE L,[-4,,-1] ;AT LEAST 4 ARGS?
JRST IOCNV2 ;NO
PUSH P,L
ADDI L,3
MOVEI T1,IK.MTOP ;GET KWD NUMBER FOR MT OP CODE
DPB T1,[POINTR @%LTYPE,ARGKWD] ;STORE IN LOCAL ARG LIST
POP P,L
JRST IOCNV2 ;GO CONVERT UNIT, ERR, END
;SETD IS CALLED TO SET UP D FOR ALL I/O STATEMENTS.
;OPENS UNIT IF NECESSARY
;CHECKS RANDOM VS. SEQUENTIAL, FORMATTED VS. UNFORMATTED
;ARGS: T1 = UNIT NUMBER
; P1 = DF BITS D%RAN AND D%UNF
; USED FOR DEFAULT OPEN IF NECESSARY
;RETURN: D = DDB ADDRESS
%SETD: MOVE U,%DDBTAB(T1) ;Get address of unit block
JUMPN U,GOTD ;ALREADY OPEN, GO CHECK STUFF
TXNE P1,D%RAN ;Trying to do RANDOM I/O?
JRST RIOERR ;?Have to use OPEN statement to specify
; RECORDSIZE.
PUSH P,T1 ;SAVE UNIT NUMBER
MOVEI T1,DLEN ;GET LENGTH OF DDB
PUSHJ P,%GTBLK ;ALLOCATE IT
MOVE D,T1 ;POINT TO EMPTY DDB
MOVEI T1,ULEN ;Get length of unit block
PUSHJ P,%GTBLK ;Allocate it
MOVE U,T1
HRRZM P1,FLAGS(D) ;Clear LH flags, set default RH ones
MOVE T1,(P) ;GET UNIT BACK
STORE T1,UNUM(U) ;SAVE UNIT NUMBER
SKIPE T1,A.ERR ;ERR=
MOVEM T1,ERRAD(U) ; Set in Unit block
SKIPE T1,A.IOS ;IOSTAT=
MOVEM T1,IOSAD(U) ; Set in Unit block
MOVEI T1,FM.UNF ;GET /FORM:UNFORMATTED
TXNE P1,D%UNF ;UNFORMATTED I/O STATEMENT?
STORE T1,FORM(D) ;YES, OPEN FILE FOR UNFORMATTED I/O
PUSHJ P,%OPENX ;OPEN THE DDB
POP P,T1 ;GET UNIT NUMBER BACK
MOVEM U,%DDBTAB(T1) ;Store address of unit block
;Here with U pointing to the unit block and DDBAD(U) is the
; DDB block address. P1 contains flags pertinent to the IO statement.
GOTD: PUSHJ P,STREEI ;Store ERR=, END=, IOSTAT= in the unit block.
MOVE D,DDBAD(U) ;Get DDB address
MOVE T1,FLAGS(D) ;PUT IN PERM FLGS
MOVEM T1,OLDFLG ;Save old flags for UNFSW test
TXZ T1,D%CLR ;Clear temp flags
TDO T1,P1 ;Set beginning flags for statement
MOVEM T1,FLAGS(D) ;Store updated flags
POPJ P,
SEGMENT ERR
;Here if RANDOM I/O was attempted before an OPEN statement was done.
; This is a fatal error since RECORDSIZE parameter is needed
;for random I/O.
RIOERR: PUSHJ P,SETERI ;Take note of ERR=, IOSTAT=.
$ECALL RR1,%ABORT ; Go give error, abort or jump.
SEGMENT CODE
SEGMENT DATA
OLDFLG: BLOCK 1
SEGMENT CODE
;Routine to store END=, ERR=, and IOSTAT= args in the unit block.
;The args will stay in the DDB until IO returns via %SETAV.
;
;Inputs:
; U/ address of unit block
; A.ERR/ <ERR= arg address>
; A.END/ <END= arg address>
; A.IOS/ <IOSTAT= arg address>
;Call:
; PUSHJ P,STREEI
; <return here always>
STREEI: MOVE T1,A.END ;Get END=
MOVEM T1,ENDAD(U) ;Store in unit block for later
MOVE T1,A.ERR ;Get ERR=
MOVEM T1,ERRAD(U) ;Store in unit block for later
MOVE T1,A.IOS ;Get IOSTAT=
MOVEM T1,IOSAD(U) ;Store in unit block for later
POPJ P, ;Return
SUBTTL BYTE I/O
COMMENT &
IBYTE and OBYTE are the basic routines for formatted I/O; they read or write
one byte in the current record. RPOS returns the current position (column
number) within a record. SPOS sets the current position. IREC reads the next
record from the file. OREC writes a record into the file.
Each open file has a record buffer which holds the current record. (This makes
T format work and makes REREAD easier.) There is one record buffer per open
file since function calls can cause simultaneous I/O on multiple units.
Record buffer format:
Input:
IRBUF IRPTR
v v
--------------------------------------------------------------------
! !///////////////////////////!///////////////! !
--------------------------------------------------------------------
<--- IRCNT ---->
<---------------- IRLEN ------------------->
<-------------------------- IRBLN -------------------------->
Output:
ORBUF ORPTR
v v
--------------------------------------------------------------------
! !///////////////////////////!///////////////! !
--------------------------------------------------------------------
<------------ ORCNT ------------>
<---------------- ORLEN* ------------------>
<-------------------------- ORBLN -------------------------->
(*note: on output, ORLEN is not kept up to date by OBYTE, since normally
ORPTR is at the end of the record so ORLEN changes every character. ORLEN
is correct immediately after a leftward T format.)
The -1 word of the record buffer is used for carriage control. The record
is altered by replacing the first character (the carriage control character)
with 0 to 4 characters.
&
;ROUTINE TO READ SINGLE BYTE
;RETURN: T1 = NEXT BYTE FROM FILE
;DESTROYS NO ACS EXCEPT T1
;NOTE: IRCNT GOING NEGATIVE IS A LEGAL CONDITION. IT MERELY
;MEANS THAT WE ARE BEYOND THE END OF THE RECORD. T-FORMAT AND
;X-FORMAT WILL SET IT NEGATIVE IF THEY GO BEYOND THE END OF
;THE RECORD.
%IBYTE: SOSGE IRCNT(D) ;DECREMENT BYTE COUNT
JRST EOR ;NONE LEFT, END OF BUFFER
ILDB T1,IRPTR(D) ;GET BYTE FROM BUFFER
POPJ P, ;DONE
EOR: MOVX T1,D%EOR ;Tell caller record has ended (if it cares)
IORM T1,FLAGS(D) ; . .
MOVEI T1," " ;EXTEND SHORT RECORDS WITH TRAILING SPACES
POPJ P, ;RETURN
;ROUTINE TO REREAD CURRENT BYTE
;RETURN: T1 = BYTE THAT IBYTE RETURNED ON MOST RECENT CALL
;DESTROYS NO ACS EXCEPT T1
%IBYTC: MOVE T1,FLAGS(D) ;Get DDB flags
TXNE T1,D%EOR ;Has record ended?
SKIPA T1,[" "] ;YES, RETURN SPACE
LDB T1,IRPTR(D) ;NO, RETURN CHAR UNDER BYTE POINTER
POPJ P, ;RETURN
;ROUTINE TO BACK UP INPUT BYTE POINTER
;NO ARGS
;ON RETURN, IBYTE WILL BE BACKSPACED ONE CHARACTER
;CAN BE CALLED REPEATEDLY
%IBACK: PUSHJ P,RIPOS ;GET CURRENT COLUMN NUMBER
SOJA T1,SIPOS ;SET TO THAT COLUMN
;ROUTINE TO PUT SINGLE BYTE IN FILE
;ARGS: T1 = BYTE
;DESTROYS NO ACS
%OBYTE: SKIPE ORPOS(D) ;VIRTUAL POSITION SET?
PUSHJ P,SETPOS ;YES. SET NEW POSITION BEFORE DEPOSIT
LOBYTE: SOSGE ORCNT(D) ;DECREMENT BYTE COUNT
JRST OEXP ;BUFFER FULL, GO EXPAND IT
IDPB T1,ORPTR(D) ;STORE BYTE IN BUFFER
POPJ P, ;DONE
OEXP: MOVE T0,FLAGS(D) ;Get flags
TXNE T0,D%ENC ;ENCODE/DECODE?
JRST TRUNC ;YES, TRUNCATE RECORD INSTEAD OF EXPANDING
PUSHJ P,%PUSHT ;SAVE T0-T5
PUSHJ P,EXPORB ;EXPAND RECORD BUFFER
PUSHJ P,%POPT ;RESTORE T0-T5
JRST LOBYTE ;GO STORE BYTE IN EXPANDED BUFFER
TRUNC: TXOE T0,D%TRNC ;Only say this once
POPJ P,
IORM T0,FLAGS(D) ;(Remember D%TRUC was set)
AOSN ORCNT(D) ;ONLY COMPLAIN ON FIRST CHAR (CNT = -1)
; IOERR (ETL,60,509,%,Record length exceeds string length)
$ECALL ETL
SOS ORCNT(D) ;RESTORE COUNT
POPJ P,
;ROUTINE TO EXPAND THE RECORD BUFFER
;RETURN: T1 = BYTE POINTER TO START OF MOVED RECORD BUFFER
; T2 = BYTE POINTER TO FIRST FREE BYTE IN MOVED RECORD BUFFER
; T3 = NUMBER OF NEW BYTES IN MOVED RECORD BUFFER
; RBUF, RBLN, RPTR SET UP FOR NEW BUFFER
EXPIRB: MOVE T2,IRBLN(D) ;GET OLD LENGTH IN BYTES
HRRZ T1,IRBUF(D) ;AND OLD BUFFER ADDR
SETZ T3, ;NO MINIMUM SIZE
PUSHJ P,EXPRB ;EXPAND AND MOVE
MOVEM T1,IRBUF(D) ;STORE NEW BUFFER ADDR
MOVEM T1,IRPTR(D) ;STORE PNTR TO NEW BUFFER
MOVE T4,IRBLN(D) ;GET OLD SIZE AGAIN
MOVEM T3,IRBLN(D) ;STORE NEW SIZE
SUBI T3,(T4) ;RETURN SIZE LEFT IN T3
POPJ P,
EXPORB: MOVE T2,ORBLN(D) ;GET OLD LENGTH IN BYTES
HRRZ T1,ORBUF(D) ;AND OLD BUFFER ADDR
MOVE T3,ORPOS(D) ;VIRTUAL POSITION AS MINIMUM
PUSHJ P,EXPRB ;EXPAND AND MOVE
MOVEM T1,ORBUF(D) ;STORE NEW BUFFER ADDR
MOVE T4,ORBLN(D) ;GET OLD SIZE AGAIN
MOVEM T3,ORBLN(D) ;STORE NEW SIZE
SUBI T3,(T4) ;RETURN SIZE LEFT IN T3
DMOVEM T2,ORPTR(D) ;STORE PNTR/COUNT TO MIDDLE OF NEW BUFFER
POPJ P,
EXPRB: JUMPE T1,GETRB ;IF NONE YET, GET ONE
MOVEI T4,(T2) ;COPY OLD SIZE
LSH T4,1 ;DOUBLE IT
ADDI T4,(T3) ;ADD MINIMUM SIZE
IDIVI T2,5 ;GET # WORDS IN OLD BUFFER
MOVEI T3,(T4) ;COPY NEW SIZE
IDIVI T3,5 ;GET # WORDS IN NEW BUFFER
ADDI T3,1 ;ACCOUNT FOR CARRIAGE CONTROL WORD
ADDI T2,1 ; JUST BEFORE REC BUFFER
SUBI T1,1
PUSHJ P,%MVBLK ;MOVE TO BIGGER BUFFER
ADDI T1,1 ;PUT CARRIAGE CONTROL WORD BACK
SUBI T3,1 ;DON'T INCLUDE IN RECSIZ
IMULI T3,5 ;CONVERT TO CHARS
HRLI T1,(POINT 7) ;MAKE BYTE PNTR TO BEG BUFFER
HRLI T2,(POINT 7,) ;MAKE BYTE POINTER TO END OF OLD STRING
POPJ P, ;RETURN
GETRB: ADDI T3,LRECBF*5 ;MINIMUM SIZE + STANDARD SIZE
ADDI T3,4 ;ROUND UP
IDIVI T3,5 ;GET # WORDS
MOVEI T1,(T3) ;COPY IT
IMULI T3,5 ;GET EXACT # CHARS
ADDI T1,1 ;ADD 1 FOR CARRIAGE WORD
PUSH P,T3 ;DESTROYED BY %GTBLK
PUSHJ P,%GTBLK
POP P,T3 ;GET THE NUMBER OF CHARS BACK
ADDI T1,1 ;POINT PAST CARRIAGE WORD
HRLI T1,(POINT 7) ;CREATE PNTR
MOVE T2,T1 ;OLD AND NEW PNTR ARE THE SAME
POPJ P,
;Routine to drop a null at EOR
; Does not affect the byte count
;Uses T1
ENDNUL: SETZ T1, ;Get a null char.
PUSHJ P,%OBYTE ; Put in record
AOS ORCNT(D) ;Don't count it as a character.
POPJ P, ;Return
SUBTTL INPUT
%IREC: TXZE F,F%NINP ;REREAD?
JRST REREAD ;YES. GO DO SETUP ONLY
SETOM LSNUM(D) ;SET UP ILLEGAL LINE SEQUENCE NUMBER
SKIPN IRBUF(D) ;ANY BUFFER YET?
PUSHJ P,EXPIRB ;NO. ALLOCATE THE BUFFER
AOS NREC(U) ;INCREMENT RECORD NUMBER
LOAD T1,INDX(D) ;GET DEV INDEX
PUSHJ P,@IDSP(T1) ;DO DEVICE-DEPENDENT INPUT
LOAD T1,UNUM(U) ;Get unit number
LOAD T2,FLAGS(D) ;Get flags
TXNN T2,D%ENC ;Unless this is DECODE..
HRREM T1,U.RERD ;Store REREAD unit
MOVE T1,IRBUF(D) ;GET RECORD BUFFER PNTR
MOVEM T1,IRPTR(D) ;STORE INITIALIZED BYTE PTR
MOVE T1,IRBLN(D) ;GET NUMBER OF BYTES IN RECORD BUFFER
SUB T1,IRCNT(D) ;SUBTRACT NUMBER OF REMAINING BYTES
MOVEM T1,IRCNT(D) ;STORE COUNT OF BYTES READ IN
MOVEM T1,IRLEN(D)
MOVE T0,FLAGS(D) ;Get current DDB flags
TXZ T0,D%EOR ;RECORD HAS NOT ENDED YET
TXO T0,D%SICR+D%SILF ;SUPPRESS NEXT CRLF
MOVEM T0,FLAGS(D) ;Store updated DDB flags
JUMPN T1,%POPJ ;NO MORE CHECKING IF CHARS IN RECORD
TXNN T0,D%END ;ZERO CHARS. EOF ALSO?
POPJ P, ;NO. JUST A NULL RECORD
IREOF: SETZM IRCNT(D) ;EOF, RETURN A ZERO-CHARACTER RECORD
; IOERR (EOF,899,404,?,End of file,,%ABORT)
$ECALL EOF,%ABORT ;HANDLE EOF RETURN IN IOERR
POPJ P,
REREAD: MOVE T1,IRLEN(D) ;REREAD. SETUP PNTR/COUNT WITH OLD DATA
MOVEM T1,IRCNT(D)
MOVE T1,IRBUF(D)
MOVEM T1,IRPTR(D)
MOVX T1,D%EOR
ANDCAM T1,FLAGS(D) ;Clear "end of record" flag
POPJ P, ;Return
;ALL DEVICE-DEPENDENT INPUT ROUTINES HAVE THE SAME CALLING SEQUENCE:
;ARGS: IRPTR = BYTE POINTER TO START OF RECORD BUFFER
; IRBLN = NUMBER OF BYTES IN RECORD BUFFER
;RETURN: NEXT RECORD FROM FILE READ INTO RECORD BUFFER
; T3 = NUMBER OF UNUSED BYTES LEFT IN RECORD BUFFER
IDSP: IFIW TIREC
IFIW DIREC
IFIW XIREC
IFIW XIREC
IFIW DECODE
IF20,<
;TTY
TIREC: MOVE T0,FLAGS(D)
TXZ T0,D%END ;CLEAR EOF FOR TTY'S
MOVEM T0,FLAGS(D)
TXNN T0,D%SICR+D%SILF ;SUPPRESS CR OR LF?
PUSHJ P,%OCRLF ;NO. OUTPUT CRLF
MOVEI T1,.RDBRK ;SET TEXTI BLOCK LENGTH
MOVEM T1,TXIBLK+.RDCWB
MOVX T1,RD%CRF+RD%JFN+RD%BBG ;SUPPRESS CR, READ FROM JFNS, BFP GIVEN
MOVEM T1,TXIBLK+.RDFLG ;STORE FLAGS
LOAD T1,IJFN(D) ;GET JFN
HRLI T1,(T1) ;IN BOTH HALVES
MOVEM T1,TXIBLK+.RDIOJ ;STORE IT
MOVE T1,IRBUF(D) ;GET RECORD BUFFER PNTR
MOVEM T1,TXIBLK+.RDDBP ;STORE DEST BYTE POINTER
MOVEM T1,TXIBLK+.RDBFP ;AND BEGINNING-OF-BUFFER POINTER
MOVE T1,IRBLN(D) ;GET RECORD BUFFER LENGTH
MOVEM T1,TXIBLK+.RDDBC ;STORE DEST BYTE COUNT
SETZM TXIBLK+.RDBFP ;NO WAKEUP ON ^U, ^W EDITING
MOVE T1,G.PRP ;SET POINTER TO PROMPT STRING
MOVEM T1,TXIBLK+.RDRTY
MOVEI T1,TXIBRK ;POINT TO BREAK MASK
MOVEM T1,TXIBLK+.RDBRK ;STORE IT
LOAD T1,IJFN(D) ;SET CCOC WORDS FOR INPUT
DMOVE T2,CCOC(D)
SFCOC%
TCONT: MOVEI T1,TXIBLK ;POINT TO BLOCK
TEXTI% ;READ A LINE
JSHALT ;SHOULD NOT FAIL
MOVE T1,TXIBLK+.RDFLG ;GET TEXTI FLAGS
TXNN T1,RD%BTM ;INPUT TERMINATED BY BREAK CHAR?
JRST TEXP ;NO, EXPAND BUFFER AND CONTINUE
MOVX T0,D%END ;Get flag to set if CTRL-Z seen.
LDB T1,TXIBLK+.RDDBP ;GET TERMINATING CHAR
CAIN T1,32 ;^Z?
IORM T0,FLAGS(D) ;Yes, set end-of-file
LOAD T1,IJFN(D) ;SET CCOC WORDS FOR OUTPUT
MOVE T2,CCOC(D) ;SET ALL CHARS TO SEND LITERALLY
AND T2,%CCMSK ; EXCEPT ^I AND ^L, WHICH BEHAVE THE SAME
OR T2,%OCCOC ; AS ON INPUT
MOVE T3,%OCCOC+1
SFCOC%
SETZM G.PRP ;CLEAR PROMPT STRING FOR NEXT TIME
AOS T3,TXIBLK+.RDDBC ;RETURN COUNT OF LEFTOVER BYTES IN BUFFER
MOVEM T3,IRCNT(D) ; DISCARDING TERMINATING BREAK CHAR
POPJ P, ;DONE
TEXP: PUSHJ P,EXPIRB ;EXPAND RECORD BUFFER
MOVEM T1,TXIBLK+.RDBFP ;SET NEW POINTER TO START OF BUFFER
MOVEM T2,TXIBLK+.RDDBP ;SET POINTER TO DEST STRING
MOVEM T3,TXIBLK+.RDDBC ;SET BYTE COUNT OF DEST STRING
JRST TCONT ;DO ANOTHER TEXTI TO CONTINUE INPUT
;STILL IF20
;TEXTI BREAK TABLE FOR STANDARD FORTRAN CHAR SET
TXIBRK: 1B<^O12>+1B<^O13>+1B<^O14>+1B<^O32> ;BREAK ON LF, VT, FF, ^Z
0 ;AND NOTHING ELSE
0
0
SEGMENT DATA
TXIBLK: BLOCK 1+.RDBRK ;TEXTI ARG BLOCK
SEGMENT CODE
;STILL IF20
;DISK
DIREC:
XIREC:
>;END IF20
IF10,<
TIREC: MOVE T0,FLAGS(D) ;Get current DDB flags
TXZ T0,D%END ;CLEAR EOF FOR TTY'S
MOVEM T0,FLAGS(D) ;Store updated flags
TXNN T0,D%SICR+D%SILF ;SUPPRESS CR OR LF?
PUSHJ P,%OCRLF ;NO. OUTPUT CRLF
DIREC:
XIREC:
>;END IF10
MOVE T1,IRBLN(D) ;GET # BYTES IN RECORD BUFFER
MOVEM T1,IRCNT(D) ;SETUP INITIAL COUNT
MOVE T1,FLAGS(D) ;ARE WE AT EOF?
TXNE T1,D%END
POPJ P, ;YES. GO NO FURTHER
PUSHJ P,%SAVE4 ;SAVE SOME P ACS
DMOVE P1,IPTR(D) ;GET FILE WINDOW BYTE POINTER/COUNT
MOVE P3,RSIZE(D) ;GET RECORD SIZE, 0 IF NONE
MOVE T2,IRBUF(D) ;GET RECORD BUFFER PNTR
MOVE T3,IRBLN(D) ;GET REC BUFFER LENGTH
LOAD T1,MODE(D) ;GET MODE OF FILE
CAIE T1,MD.ASL ;LINE-SEQUENCE ASCII?
JRST DLP ;NO
ILNLP: SOJGE P2,ILNOK ;DECR COUNT
PUSHJ P,IMAP ;COUNT RAN OUT. GET ANOTHER BUF
JRST ILNLP ;AND TRY AGAIN
JRST DIEOR ;GOT EOF
ILNOK: ILDB P4,P1 ;GET A CHAR
JUMPE P4,ILNLP ;SKIP IT IF NULL
MOVEI T1,(P1) ;GET A PROPER INDEX, (In-section address)
; Note: Don't use XMOVEI above--
; (P1 is a byte ptr)
MOVE T0,(T1) ;GET THE WORD CHAR CAME FROM
TRNN T0,1 ;LOW BIT ON?
JRST INOLN ;NO. NOT A LINE #
MOVEM T0,LSNUM(D) ;SAVE THE LSN
ADDI P1,1 ;YES. PROCEED TO NEXT WORD
SUBI P2,5 ;DECR CHAR COUNT FOR WORD
LDB P4,P1 ;GET THE BYTE AFTER WORD
CAIE P4,11 ;IS IT A TAB?
JRST INOLN ;NO. USE THE CHAR
DLP: SOJGE P2,DLPX2 ;IF OUT OF MAPPED BYTES, GO GET MORE
PUSHJ P,IMAP
JRST DLP ;KEEP IN SYNCH!
JRST DIEOR ;GOT EOF
DLPX2: ILDB P4,P1 ;GET A BYTE
INOLN: CAIGE P4,40 ;CHECK FOR SPECIAL BYTE
JRST CHKEOL ;SPECIAL
DDPB: SOJGE T3,DDPB2 ;DECR RECORD BUFFER COUNT, EXPAND IF NEEDED
PUSHJ P,EXPIRB ;USES T1
JRST DDPB ;KEEP IN SYNCH
DDPB2: IDPB P4,T2 ;DEPOSIT BYTE IN RECORD BUFFER
DDPB3: SOJL P3,DLP ;DECR THE RECSIZ COUNT
JUMPG P3,DLP ;OK IF NEG
JRST DIEOR ;END OF RECORD IF ZERO
CHKEOL: JUMPE P4,DDPB3 ;SKIP NULLS
CAIN P4,15 ;CARRIAGE RETURN?
JRST GOTCR ;YES
CAIG P4,14 ;STANDARD EOF CHARS ARE 12-14 (LF,VT,FF)
CAIGE P4,12 ;EOL CHAR?
JRST NOTEOL ;NO. CHECK FOR TTY CONTROL-Z
SOJA P3,DIEOR ;YES. DECR COUNT AND END IT ALL
NOTEOL: CAIE P4,32 ;^Z?
JRST DDPB ;NO. PASS IT THROUGH
LOAD T1,INDX(D) ;YES. GET DEVICE INDEX
CAIE T1,DI.TTY ;TTY?
JRST DDPB ;NO. PASS IT THROUGH
JRST DDPB3 ;YES. SKIP IT
GOTCR:
CRLP: DMOVEM P1,IPTR(D) ;SAVE AWAY THE CURRENT PNTR/COUNT
SOJGE P2,CRX2 ;ANY CHARS IN BUFFER?
PUSHJ P,IMAP ;NO. GET A BUFFERFUL
JRST CRLP ;KEEP IN SYNCH
JRST DIEOR ;GOT EOF
CRX2: ILDB P4,P1 ;GET A CHAR
JUMPE P4,CRX3 ;SKIP NULLS
CAIN P4,15 ;ANOTHER CARRIAGE RETURN?
JRST CRX3 ;YES. IGNORE IT
CAIG P4,14 ;VERT MOTION CHAR?
CAIGE P4,12
JRST CRONLY ;NO. DATA
SOJA P3,DIEOR ;YES. REAL END OF LINE
CRX3: SOJG P3,CRLP ;DECR RECSIZ COUNT
JUMPL P3,CRLP ;IF NEG, VARIABLE SIZE
JRST DIEOR ;IF ZERO, EOL
CRONLY: DMOVE P1,IPTR(D) ;GET PNTR/COUNT BEFORE NEW DATA
DIEOR: MOVEM T3,IRCNT(D) ;SAVE THE REDUCED REC COUNT
SKIPE RSIZE(D) ;RECORDSIZE?
PUSHJ P,IALIGN ;YES. ALIGN THE PNTR/COUNT
DMOVEM P1,IPTR(D) ;STORE UPDATED FILE BYTE POINTER
MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%RAN ;RANDOM I/O?
CAME T2,IRBUF(D) ;YES, DID WE FIND A NONZERO BYTE?
POPJ P, ;YES, DONE
JRST RNRERR ;NO, REC NOT WRITTEN
IALIGN: MOVE T3,RSIZE(D) ;GET THE RECORDSIZE
ADDI T3,6 ;2 FOR CRLF, 4 FOR ROUNDING
IDIVI T3,5 ;GET # WORDS
IMULI T3,5 ;AND # CHARS AGAIN
SUB T3,RSIZE(D) ;GET DIFF
ADDI P3,(T3) ;ADD TO # CHARS TO SKIP
JUMPE P3,IRNOSK ;NO CHARS TO SKIP
IALGLP: PUSHJ P,GETBYT ;SKIP THE CRLF
SOJG P3,IALGLP
IRNOSK: HRLI P1,(POINT 7,0,34) ;POINT TO END OF WORD
IDIVI P2,5 ;CORRECT COUNT
IMULI P2,5
POPJ P,
GETBYT: MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%END ;DID WE GET EOF ALREADY?
POPJ P, ;YES. DON'T TRY AGAIN
SOJGE P2,GOTBYT ;STILL SOME THERE
PUSHJ P,IMAP ;NO
JRST GETBYT ;Keep in synch
POPJ P, ;EOF
GOTBYT: ILDB P4,P1 ;GET A CHAR
POPJ P,
IF20,<
IMAP: LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIE T1,DI.DSK ;DISK?
JRST XSIN ;NO. MUST DO SINR'S
MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%RAN ;RANDOM?
JRST FNXTW ;YES. DO SEPARATELY
MOVE T1,BYTN(D) ;GET DESIRED BYTE #
CAML T1,EOFN(D) ;PAST EOF?
JRST DPEOF ;YES. GO SET EOF FLAG
IMAPX: PUSHJ P,FNXTW ;MAP NEXT WINDOW
MOVEM P2,WCNT(D) ;SAVE ACTIVE BYTE COUNT
MOVE T1,BYTN(D) ;GET BYTE # OF NEXT WINDOW
CAMG T1,EOFN(D) ;PAST EOF?
POPJ P, ;NO
SUB T1,EOFN(D) ;GET DIFF
SUBI P2,(T1) ;REDUCE # BYTES AVAIL
MOVEM P2,WCNT(D) ;SAVE ACTIVE BYTE COUNT
POPJ P,
DPEOF: AOS (P) ;SKIP RETURN MEANS EOF
MOVX T0,D%END ;Set EOF flag
IORM T0,FLAGS(D)
POPJ P,
>;END IF20
IF10,<
;GENERAL-PURPOSE IO ERROR MESSAGE
; IOERR (IOE,899,400,%,$I,<T1>)
IMAP: MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%RAN ;RANDOM?
JRST FNXTW ;YES
DMOVEM P1,IPTR(D) ;STORE POINTER, COUNT FOR MONITOR
PUSH P,T2
PUSH P,T3
AOS T1,BLKN(D) ;INCREMENT BLOCK #
IMULI T1,1200 ;GET NEXT BLOCK FIRST BYTE #
MOVEM T1,BYTN(D) ;SAVE FOR EOFN CALC
HLLZ T2,CHAN(D) ;GET CHANNEL NUMBER FOR FILOP
HRRI T2,.FOINP ;SET FILOP FUNCTION
MOVE T1,[1,,T2] ;SET LENGTH,,ADDRESS
FILOP. T1, ;INPUT NEXT BUFFER
PUSHJ P,TEOFCHK ;ERROR, COULD BE EOF
POP P,T3
POP P,T2
DMOVE P1,IPTR(D) ;GET NEW BYTE POINTER, COUNT
MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%END ;IF FILE ENDED,
AOS (P) ;SKIP RETURN
POPJ P, ;ELSE DONE
TEOFCHK:
LOAD T2,INDX(D) ;GET DEV INDEX
CAIN T2,DI.TTY ;TERMINAL?
TRNN T1,IO.EOF ;YES, EOF?
JRST EOFCHK ;NO, NOTHING SPECIAL
MOVE T2,[1,,T3] ;SET UP FOR CLOSE
MOVEI T3,.FOCLS
HLL T3,CHAN(D)
FILOP. T2, ;CLEAR EOF BIT, LEAVE TTY OPEN
$ECALL IOE,%ABORT
EOFCHK: MOVX T0,D%END ;Get EOF flag
TRNE T1,IO.EOF ;EOF?
IORM T0,FLAGS(D) ;Yes, this file is ended
TRNE T1,IO.EOF ;EOF OFF?
TRNE T1,IO.ERR+IO.EOT ;NO, ANY REAL ERR BITS?
$ECALL IOE,%ABORT
POPJ P, ;RETURN FROM XIREC WITH T3 SET
>;END IF10
IF20,<
XSIN: MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%END ;EOF ALREADY FOUND?
JRST %POPJ1 ;YES. SKIP RETURN
LOAD T0,DVTYP(D) ;Is this a DISK append file?
CAIN T0,.DVDSK ; (If DVTYP is disk and we are here,
JRST EOFGET ;it is, so get EOF).
PUSH P,T2 ;SAVE CRITICAL ACS
PUSH P,T3
AOS BLKN(D) ;INCR BLOCK #
LOAD T1,IJFN(D) ;GET FILE JFN
HRRO T2,WADR(D) ;GET POINTER TO BUFFER
MOVN T3,WSIZ(D) ;GET WINDOW SIZE IN BYTES
SINR% ;READ STRING
ERCAL EOFCHK ;ERROR, POSSIBLE EOF
MOVE P1,WADR(D) ;MAKE BYTE POINTER TO BUFFER
SUBI P1,1 ;POINT TO BEG-1
HRLI P1,(POINT 7,0,34)
MOVE P2,WSIZ(D) ;GET FULL WINDOW SIZE
ADD P2,T3 ;GET # BYTES WE GOT
MOVEM P2,WCNT(D) ;SAVE FOR DIRECTION SWITCHING
POP P,T3 ;RESTORE T ACS
POP P,T2
JUMPG P2,%POPJ ;RETURN TO COPY LOOP
AOS (P) ;OTHERWISE EOF
POPJ P,
;Here to return EOF because DISK APPEND file wanted to READ.
EOFGET: MOVX T0,D%END ;EOF
IORM T0,FLAGS(D)
JRST %POPJ1 ;Skip return for EOF
;Routine to get ERROR or set D%END if EOF.
;Returns .+1 unless ERR= branch taken.
EOFCHK: GTSTS% ;GET FILE STATUS
TXNN T2,GS%EOF ;EOF? [*** err+eof??]
JRST INPERR ;NO, INPUT ERROR
MOVX T0,D%END ;EOF, tell caller
IORM T0,FLAGS(D)
POPJ P, ;CONTINUE
INPERR: AOS T2,ERRN(D) ;BUMP ERROR COUNT
CAILE T2,^D10 ;TOO MANY?
; IOERR (INX,899,401,?,$J,,%ABORT) ;YES
; IOERR (INP,899,401,%,$J,,%POPJ) ;NO
$ECALL INX,%ABORT ;Yes
$ECALL INP,%POPJ ;No
> ;END IF20
RNRER1: MOVE T1,NREC(D) ;GET RECORD NUMBER
$ECALL RNR,%ABORT ;HAVEN'T INCR REC # YET
RNRERR: MOVE T1,NREC(U) ;GET RECORD NUMBER
SUBI T1,1 ;POINT BACK TO CURRENT RECORD
; IOERR (RNR,25,510,?,Record $D has not been written,<T1>,%ABORT)
$ECALL RNR,%ABORT
;DECODE
DECINI: MOVE T1,A.HSA ;GET STRING ADDR
$BLDBP T1 ;Make byte ptr to start of string
MOVEM T1,IRBUF(D) ;STORE RECORD BUFFER POINTER
SKIPGE T1,A.HSL ;GET STRING LENGTH
SETZ T1, ;NEGATIVE, SET TO 0
MOVEM T1,IRBLN(D) ;STORE AS RECORD BUFFER LENGTH
MOVEM T1,IRCNT(D) ;RETURN ZERO EMPTY CHARS IN REC BUFFER
POPJ P, ;RETURN
DECODE: MOVE T1,IRBLN(D) ;GET STRING LENGTH
SKIPLE IRCNT(D) ;IF 0 OR NEG, WE'RE AT END OF STRING
SUB T1,IRCNT(D) ;GET CURRENT CHAR POSITION
ADDI T1,4 ;GET # WORDS TAKEN
IDIVI T1,5
ADDM T1,IRBUF(D) ;SAVE NEW BUFFER PNTR
IMULI T1,5 ;GET # CHARS USED UP
MOVE T2,IRBLN(D) ;DECR # CHARS IN STRING
SUBI T2,(T1)
MOVEM T2,IRBLN(D) ;SAVE NEW COUNT
SETZM IRCNT(D) ;SETUP FOR REST OF IREC
POPJ P,
SUBTTL OUTPUT
;%OREC IS CALLED FROM INSIDE FORIO ONLY, AT THE FIN CALL AT THE END
;OF ALL FORMATTED I/O WRITES.
;%ORECS IS CALLED FROM FORFMT (FOR "/" FORMAT) AND NMLST/LDIO (TO
;OUTPUT A RECORD). IT CALLS %OREC AND THEN SETS
;UP THE OUTPUT RECORD BUFFER AGAIN EXCEPT FOR ENCODE/DECODE
%ORECS:
%OREC: MOVE T0,FLAGS(D) ;Get DDB flags
TXNN T0,D%ENC ;ENCODE?
PUSHJ P,FIXREC ;NO. DO CC SUBSTITUTION, /RECORDSIZE PADDING
ORECX: LOAD T1,INDX(D) ;GET DEV INDEX
PUSHJ P,@ODSP(T1) ;OUTPUT THE RECORD, AS APPROPRIATE FOR DEV
AOS NREC(U) ;COUNT RECORD
ORINI: MOVE T1,ORBUF(D) ;RESET BYTE POINTER
MOVEM T1,ORPTR(D)
MOVE T1,ORBLN(D) ;RESET BYTE COUNT
MOVEM T1,ORCNT(D)
SETZM ORLEN(D) ;CLEAR RECORD LENGTH
SETZM ORPOS(D) ;CLEAR VIRTUAL POS
POPJ P, ;DONE, READY FOR NEXT OUTPUT
ODSP: IFIW TOREC
IFIW DOREC
IFIW XOREC
IFIW XOREC
IFIW ENCODE
;ERROR MESSAGE OUTPUT
;ARGS: T1 = ADDRESS OF ASCIZ MESSAGE STRING
%EOREC: PUSH P,D
PUSH P,U
SKIPN U,U.ERR ;POINT TO ERR DDB
JRST ETTY ;NONE, USE PSOUT
PUSH P,U.ERR ;RECURSIVE ERRS GO TO TTY
SETZM U.ERR
MOVE D,DDBAD(U) ;Set up D
STKVAR <ERPTR> ;ALLOCATE STACK VARS
HRLI T1,(POINT 7,) ;STORE POINTER TO MSG
MOVEM T1,ERPTR
PUSHJ P,%SETOUT ;Set file open for output
PUSHJ P,ROPOS ;Get output position
CAIE T1,1 ;If not at column 1,
PUSHJ P,%OCRLF ;Get to column 1
MOVEI T1," " ;GET A SPACE
LOAD T2,CC(U) ;GET /CC
CAIN T2,CC.FORT ;/CC:FORTRAN?
PUSHJ P,%OBYTE ;YES, SPACE CARRIAGE CONTROL FOR ERRORS
EOLP: ILDB T1,ERPTR ;GET BYTE OF MSG
JUMPE T1,EOEND ;QUIT WHEN NULL
PUSHJ P,%OBYTE ;TYPE CHAR
JRST EOLP
EOEND: PUSHJ P,%OREC ;WRITE MESSAGE
MOVX T1,D%MOD ;Remember file modified
IORM T1,FLAGS(D)
UNSTK ;CLEAN UP AND RETURN
POP P,U.ERR
POP P,U
POP P,D
POPJ P,
EOCRLF: MOVEI T1,15 ;CRLF
PUSHJ P,%OBYTE
MOVEI T1,12
PJRST %OBYTE
ETTY: SKIPN D,D.TTY ;POINT TO TTY DDB IF OPEN
JRST EPSOUT ;NO, NO COMPLICATIONS
MOVE T0,FLAGS(D) ;GET FLAGS
TXNN T0,D%OUT ;DOING OUTPUT?
JRST EPSOUT ;NO, FINE
PUSH P,T1 ;SAVE MESSAGE ADDRESS
PUSHJ P,ROPOS ;Get column position
CAIE T1,1 ;Is last line out yet?
PUSHJ P,%OREC ;No, write it
MOVE T0,FLAGS(D) ;Re-get flags
TXNN T0,D%SICR+D%SILF ;Suppress CRLF?
PUSHJ P,%OCRLF ;No, get to column 1
POP P,T1 ;RESTORE MSG ADDRESS
EPSOUT: POP P,U ;Restore pushed ACs
; POP P,DF
POP P,D
IF10,< OUTSTR (T1) ;TYPE MESSAGE
OUTSTR %CRLF## >
IF20,<
HRROI T1,(T1)
PSOUT%
HRROI T1,%CRLF##
PSOUT%
>
POPJ P, ;DONE
;OUTPUT CARRIAGE CONTROL
;IF CARRIAGE CONTROL IS BEING DONE, SUBSTITUTES FOR FIRST CHAR
;IF FIXED-LENGTH RECORDS, PADS OR TRUNCATES RECORD TO CORRECT LENGTH
;
;RETURN: ORPTR = BYTE POINTER TO FIRST CHAR OF RECORD
; ORCNT = NUMBER OF BYTES IN RECORD
FIXREC: MOVE T0,FLAGS(D) ;GET DDB FLAGS
TXNN T0,D%STCR ;DOLLAR FORMAT?
JRST NODOL ;NO
SKIPE ORPOS(D) ;ANY VIRTUAL POSITION?
PUSHJ P,SETPOS ;YES. SET IT UP
NODOL: SETZM ORPOS(D) ;DON'T LET TRAILING TABBING FOOL US!
SKIPN ORPTR(D) ;ANY RECORD BUFFER YET?
PUSHJ P,EXPORB ;NO. SET ONE UP!
MOVE T1,ORBLN(D) ;GET BUFFER LENGTH
SUB T1,ORCNT(D) ;GET CURRENT POSITION
CAML T1,ORLEN(D) ;ARE WE SOMEWHERE INSIDE RECORD?
JRST NSPOS ;NO. ALREADY AT END
MOVE T1,ORLEN(D) ;GET IT AGAIN
PUSHJ P,SPOS1 ;SET TO END OF RECORD
JRST GOTPOS ;ORLEN OK AS IS
NSPOS: MOVEM T1,ORLEN(D) ;SAVE NEW LENGTH
GOTPOS: SKIPE T2,RSIZE(D) ;FIXED-LENGTH RECORDS?
CAMN T2,ORLEN(D) ;YES. PERFECT FIT?
JRST NPAD ;VARIABLE LENGTH OR PERFECT FIT. SKIP PADDING
SUB T2,ORLEN(D) ;CHECK AGAINST CHARS ALREADY WRITTEN
JUMPG T2,NTRUNC ;RECORD SHORTER THAN RECORDSIZE, FINE
MOVE T1,RSIZE(D) ;GET RECORDSIZE
PUSHJ P,SPOS1 ;TRUNCATE RECORD TO ITS MAXIMUM SIZE
JRST NPAD ;DON'T PAD
NTRUNC: PUSHJ P,CHRPAD ;APPEND PAD CHARS TO GET RECORD TO RIGHT SIZE
NPAD: LOAD T1,CC(U) ;GET /CARRIAGECONTROL
CAIN T1,CC.FORT ;/CC:FORTRAN?
JRST FIXCC ;YES, GO HANDLE
;HERE WHEN CC=LIST, IE DO NOT SUBSTITUTE CARRIAGE CONTROL CHAR
;APPEND TRAILING CRLF TO RECORD UNLESS $ FORMAT, IN WHICH CASE DON'T APPEND
;ANYTHING. IF WRITING FIXED-LENGTH RECORDS, SKIP TO WORD BOUNDARY SO DISK
;FILES LOOK THE SAME AS V5, WITH ALL RECORDS STARTING IN A NEW WORD.
MOVE T0,FLAGS(D)
TXZ T0,D%SICR+D%SILF ;Turn off "suppress CRLF" flags
MOVEM T0,FLAGS(D) ;Make sure flags are in reasonable state
TXZE T0,D%STCR ;$ format in this record?
JRST NCRLF ;Yes, skip CRLF
MOVEI T1,15 ;CRLF
PUSHJ P,%OBYTE
MOVEI T1,12
PUSHJ P,%OBYTE
MOVX T1,D%SICR+D%SILF ;Set flags that say we already got a CRLF
IORM T1,FLAGS(D)
JRST NLPAD ;GO APPEND NULLS IF NECESSARY
;Updated DDB flags are in T0.
NCRLF: TXO T0,D%SICR ;SET FLAG SO TTY INPUT WILL FIND PROMPT
MOVEM T0,FLAGS(D) ;Store updated flags
SKIPN RSIZE(D) ;FIXED-LENGTH RECORDS?
JRST NLPAD ;NO, SKIP
MOVEI T1,0 ;PUT IN 2 NULLS TO ALIGN AS IF CRLF WERE THERE
PUSHJ P,%OBYTE
PUSHJ P,%OBYTE
NLPAD: PUSHJ P,NULPAD ;PAD TO WORD BOUNDARY IF NECESSARY
MOVE T1,ORBLN(D) ;SET RCNT TO NUMBER OF BYTES IN RECORD
SUBB T1,ORCNT(D)
MOVE T1,ORBUF(D) ;GET REC BUFFER ADDRESS
MOVEM T1,ORPTR(D) ;STORE IT
IF20,< MOVEM T1,G.PRP > ;SAVE POINTER TO PROMPT STRING, MIGHT NEED IT
POPJ P,
;HERE WHEN CC=FORTRAN, IE SUBSTITUTE CARRIAGE CONTROL CHAR
;REPLACE FIRST CHAR WITH CARRIAGE CONTROL SEQUENCE. THE CARRIAGE CONTROL
;SEQUENCE STARTS WITH <CR> UNLESS THE PREVIOUS LINE ENDED WITH $ FORMAT.
;THEN COME 0-3 CHARACTERS, DEPENDING ON THE CARRIAGE CONTROL CHAR. IF
;THIS LINE HAS A $ FORMAT, SET A FLAG TO PREVENT THE <CR> NEXT TIME.
FIXCC: PUSHJ P,ENDNUL ;Drop a null at EOR
MOVE T2,ORBLN(D) ;SET RCNT TO LENGTH OF RECORD NOW,
SUBB T2,ORCNT(D) ; BEFORE CC SUBSTITUTION
MOVE T1,ORBUF(D) ;POINT TO REC BUFFER
JUMPE T2,[AOS ORCNT(D) ;IF ZERO-LENGTH RECORD,
MOVSI T2,(" "B6) ;MAKE INTO A RECORD CONTAINING ONE SPACE
MOVEM T2,(T1)
JRST .+1]
HRLI T1,(POINT 7,,6) ;MAKE POINTER TO FIRST CHAR OF RECORD
MOVEM T1,ORPTR(D) ;STORE POINTER
IF20,< MOVEM T1,G.PRP > ;STORE POINTER TO PROMPT STRING, MIGHT NEED IT
MOVX T0,D%STCR ;Flag to set (maybe)
LDB T1,T1 ;GET CC CHARACTER
CAIN T1,"$" ;DOLLAR CARRIAGE CONTROL?
IORM T0,FLAGS(D) ;Yes, same as $ FORMAT and space CC
CAIL T1,"*" ;RANGE CHECK CC CHAR
CAILE T1,"3"
MOVEI T1,"*"-1 ;OUT OF RANGE, TREAT AS SPACE
HLRZ T2,CCTAB-"*"(T1) ;GET REPEAT COUNT
HRRZ T1,CCTAB-"*"(T1) ;GET CONTROL CHAR WHICH DOES THE CC
MOVE T4,FLAGS(D) ;T4:= DDB flags
TXZN T4,D%SILF ;SUPPRESS INITIAL LF?
JRST NSUP ;NO
CAIN T1,12 ;YES, DO WE HAVE A LF TO SUPPRESS?
SUBI T2,1 ;YES, DECREMENT LF COUNT
NSUP: JUMPLE T2,NLF ;IF NO CC CHARS LEFT, SKIP
PUSHJ P,DPBD ;STORE CHAR AND DECREMENT RPTR
SOJG T2,.-1 ;REPEAT UNTIL DONE
NLF: MOVEI T1,15 ;GET CR
TXZN T4,D%SICR ;SUPPRESS INITIAL CR?
PUSHJ P,DPBD ;NO, APPEND CR TO FRONT
SOS ORCNT(D) ;CORRECT COUNT, CC CHAR IS NOW GONE
TXZE T4,D%STCR ;SUPPRESS TRAILING CR ON THIS LINE?
TXO T4,D%SICR+D%SILF ;YES, SUPPRESS INITIAL CRLF OF NEXT LINE
MOVEM T4,FLAGS(D) ;Store updated DDB flags
POPJ P, ;ALL DONE
;ROUTINE TO NORMALIZE CRLF POSITION, BY TYPING PENDING CRLF, IF ANY
;
;WHEN WRITING A FILE WITH CC=FORTRAN, THE CRLFS COME BEFORE THE
;RECORDS INSTEAD OF AFTER THEM. THE REST OF THE WORLD PUTS CRLFS
;AFTER THEIR RECORDS. THIS ROUTINE IS CALLED TO GET IN SYNC WITH THE
;OUTSIDE WORLD WHEN NECESSARY.
;
;CALLED:
; BEFORE AN ERROR MESSAGE IS TYPED
; WHEN SWITCHING FROM OUTPUT TO INPUT ON TTY
%OCRLF: MOVX T0,D%SILF+D%SICR ;Suppress next CRLF
IORM T0,FLAGS(D)
MOVEI T1,2 ;SET BYTE COUNT, PTR
MOVEM T1,ORCNT(D)
MOVE T1,ORBUF(D)
MOVEM T1,ORPTR(D)
MOVE T2,%CRLF ;GET A CRLF
MOVEM T2,(T1) ;PUT IT IN THE RECORD BUFFER
IF20,< SETZM G.PRP > ;SET NO PROMPT STRING AVAILABLE
PJRST ORECX ;FORCE THE CRLF OUT
;DEPOSIT BYTE AND DECREMENT (THE OPPOSITE OF ILDB)
;T1 = BYTE, RPTR = 7-BIT BYTE POINTER
;Uses T1 and T3 only
DPBD: AOS ORCNT(D) ;BUMP BYTE COUNT
DPB T1,ORPTR(D) ;DEPOSIT BYTE
MOVSI T3,(47B5) ;DECREMENT RPTR
ADD T3,ORPTR(D)
TLCN T3,(1B0)
SUB T3,[430000,,1]
MOVEM T3,ORPTR(D)
POPJ P,
;ROUTINES TO PAD RECORD
;NULPAD APPENDS 0-4 NULLS TO RECORD TO BRING IT TO WORD BOUNDARY
;CHRPAD APPENDS (T2) PAD CHARACTERS TO RECORD
NULPAD: SKIPN RSIZE(D) ;/REC SIZE?
POPJ P, ;NO, NO NULL PADDING IS NECESSARY
MOVE T1,ORBLN(D) ;GET REC BUF SIZE
SUB T1,ORCNT(D) ;GET # CHARS WRITTEN
MOVNI T1,(T1) ;GET -SIZE
IDIVI T1,5 ;GET T2 = -SIZE MOD 5 = NUMBER OF NULLS
JUMPE T2,%POPJ ;LEAVE ZERO REMAINDER ALONE
ADDI T2,5 ;OTHERWISE CONVERT TO POSITIVE
TDZA T1,T1 ;GET A NULL AND SKIP INTO LOOP
CHRPAD: LOAD T1,PADCH(U) ;GET PAD CHAR
PUSHJ P,%OBYTE ;OUTPUT A PAD CHAR
SOJG T2,.-1 ;KEEP PADDING UNTIL RECORD IS RIGHT SIZE
POPJ P, ;Return when done
;CARRIAGE CONTROL TABLE
;(LH) REPEAT COUNT, (RH) CONTROL CHAR TO SUBSTITUTE
;CHAR CC SEQ ACTION ON PRINTER
XWD 1,12 ;SPACE <LF> NEXT LINE
CCTAB: XWD 1,23 ;* <^S> NEXT LINE, NO PAGE SKIP
XWD 0, ;+ OVERWRITE CURRENT LINE
XWD 1,21 ;, <^Q> NEXT EVEN LINE
XWD 3,12 ;- <LF><LF><LF> SKIP 2 LINES
XWD 1,22 ;. <^R> NEXT THIRD LINE
XWD 1,24 ;/ <^T> NEXT 10TH LINE
XWD 2,12 ;0 <LF><LF> SKIP 1 LINE
XWD 1,14 ;1 <FF> PAGE SKIP
XWD 1,20 ;2 <^P> NEXT 30TH LINE
XWD 1,13 ;3 <VT> NEXT 20TH LINE
;DISK OUTPUT
IF20,<
DOREC: MOVX T0,D%MOD ;Set file modified
IORM T0,FLAGS(D)
XOREC:
>;END IF20
IF10,<
;ARBITRARY DEVICE
DOREC:
TOREC:
XOREC:
>;END IF10
PUSHJ P,%SAVE2 ;Save P1 and P2
DMOVE P1,OPTR(D) ;GET FILE POINTER/COUNT
DMOVE T2,ORPTR(D) ;GET RECORD BYTE POINTER AND RECORD LENGTH
JUMPE T3,DOFIN ;IF NO BYTES LEFT IN RECORD, DONE
DOLP: SOJL P2,DOFULL ;IF FILE WINDOW FULL, GO MOVE WINDOW
ILDB T1,T2 ;GET BYTE FROM RECORD
IDPB T1,P1 ;STORE BYTE IN FILE
SOJG T3,DOLP ;COPY WHOLE RECORD
;ALL DONE, FALL INTO DOFIN
DOFIN: DMOVEM P1,OPTR(D) ;STORE UPDATED POINTER/COUNT
IF10,<
MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%INT ;INTERACTIVE DEVICE?
PUSHJ P,NOTRAN ;YES. OUTPUT BUFFER
>;END IF10
MOVE T1,BYTN(D) ;GET BYTE # OF NEXT WINDOW
SUBI T1,(P2) ;GET LAST BYTE IN USE
MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%RAN ;RANDOM FILE?
CAMLE T1,EOFN(D) ;YES. ONLY STORE LARGER EOFN
MOVEM T1,EOFN(D) ;SAVE AS EOF PNTR
POPJ P, ;DONE
DOFULL: PUSHJ P,OMAP ;OUTPUT A WINDOWFUL
JRST DOLP ;STAY IN SYNCH
IF20,<
OMAP: LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIN T1,DI.DSK ;DISK?
JRST FNXTW ;YES. JUST MAP NEXT WINDOW
; JRST XSOUT ;NO. OTHER
;OUTPUT ROUTINES
;ARBITRARY DEVICE
XSOUT: JUMPE P1,XSKP ;IF NO CHARS, JUST PREPARE WINDOW
PUSHJ P,%PUSHT ;SAVE T ACS
LOAD T1,OJFN(D) ;GET JFN
HRRO T2,WADR(D) ;GET WINDOW ADDR
MOVN T3,WSIZ(D) ;GET WINDOW SIZE IN BYTES
JUMPLE P2,.+2 ;IF IN MIDDLE OF WINDOW
ADD T3,P2 ;DECREMENT ACTIVE BYTE COUNT
SOUTR% ;OUTPUT THE STRING
ERJMP OUTERR ;ERROR, GO TELL USER
PUSHJ P,%POPT ;RESTORE T ACS
XSKP: AOS BLKN(D) ;INCR BLOCK #
MOVE P1,WADR(D) ;SETUP BYTE PNTR
SUBI P1,1 ;POINT TO BEG-1
HRLI P1,(POINT 7,0,34)
MOVE P2,WSIZ(D) ;FULL WINDOW AVAILABLE
POPJ P, ;DONE
OUTERR: AOS T2,ERRN(D) ;BUMP ERROR COUNT
CAIG T2,^D10 ;TOO MANY?
; IOERR (OUX,899,401,?,$J,,%ABORT) ;YES
; IOERR (OUT,899,401,%,$J,,%POPJ) ;NO
$ECALL OUX,%ABORT ;Yes
$ECALL OUT,%POPJ ;No
;TTY OUTPUT
TOREC: LOAD T1,OJFN(D) ;GET JFN
MOVE T2,ORPTR(D) ;GET POINTER TO START OF RECORD
MOVN T3,ORCNT(D) ;GET NEGATIVE OF BYTE COUNT
JUMPGE T3,%POPJ ;LEAVE NOW IF 0-BYTE STRING
SOUTR% ;OUTPUT THE STRING
ERJMP OUTERR ;ERROR, GO TELL USER
POPJ P, ;DONE
>;END IF20
IF10,<
OMAP: MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%RAN ;RANDOM?
JRST FNXTW ;WRITE RANDOM BUFFER
NOTRAN: PUSHJ P,%PUSHT
DMOVEM P1,OPTR(D) ;STORE POINTER, COUNT FOR MONITOR
AOS T1,BLKN(D) ;INCR BLOCK #
IMULI T1,1200 ;GET BYTE # OF NEXT BLOCK
MOVEM T1,BYTN(D) ;SAVE FOR EOFN CALC
HLLZ T2,CHAN(D) ;GET CHANNEL NUMBER FOR FILOP
HRRI T2,.FOOUT ;SET FILOP FUNCTION
MOVE T1,[1,,T2] ;SET LENGTH,,ADDRESS
FILOP. T1, ;OUTPUT A BUFFER
$ECALL IOE,%ABORT
DMOVE P1,OPTR(D) ;GET NEW BYTE POINTER, COUNT
PJRST %JPOPT
>;END IF10
;ENCODE
ENCINI: MOVE T1,A.HSA ;GET STRING ADDR
$BLDBP T1 ;Build 7-bit byte ptr.
MOVEM T1,ORPTR(D)
MOVEM T1,ORBUF(D)
SKIPG T2,A.HSL ;GET STRING LENGTH
SETZB T2,A.HSL ;IF ZERO OR NEG, SET TO ZERO
JUMPE T2,NENCFL ;NO FILL IF NO CHARS
MOVEI T3," " ;SETUP WITH BLANKS
ENCLP: IDPB T3,T1
SOJG T2,ENCLP
NENCFL: MOVE T1,A.HSL ;RESET BYTE COUNT
MOVEM T1,ORCNT(D)
MOVEM T1,RSIZE(D) ;AND RECORD SIZE
MOVEM T1,ORBLN(D) ;AND REC BUFFER LENGTH
SETZM T1,ORLEN(D) ;AND RECORD LENGTH
POPJ P, ;DONE, READY FOR OUTPUT
ENCODE: MOVE T1,ORBLN(D) ;GET # CHARS IN STRING
SUB T1,ORCNT(D) ;GET CURRENT CHAR POS
SKIPE ORPOS(D) ;WAITING ON POSITIONING FORMAT?
MOVE T1,ORPOS(D) ;YES. SUBSTITUTE IT
ADDI T1,4 ;GET # WORDS
IDIVI T1,5
ADDM T1,ORBUF(D) ;SAVE NEW BUFFER ADDR
IMULI T1,5 ;GET # CHARS IN THOSE WORDS
MOVE T2,ORBLN(D) ;GET # CHARS IN STRING
SUBI T2,(T1) ;DECR # CHARS
MOVEM T2,ORBLN(D) ;SAVE IT
POPJ P,
SUBTTL T FORMAT
;ROUTINE TO READ RECORD POSITION
;RETURN: T1 = BYTE NUMBER OF NEXT BYTE TO/FROM RECORD
; I.E., NUMBER OF BYTES ALREADY READ FROM RECORD OR STORED IN IT
;PRESERVES T2-T5
%RPOS: MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%IO ;INPUT OR OUTPUT?
JRST ROPOS ;OUTPUT, GO HANDLE
RIPOS: MOVE T1,IRLEN(D) ;GET RECORD LENGTH
SUB T1,IRCNT(D) ;SUBTRACT # CHARS LEFT IN IT
ADDI T1,1 ;BEG OF RECORD IS COL 1
POPJ P,
ROPOS: MOVE T1,ORBLN(D) ;GET RECORD BUFFER LENGTH
SUB T1,ORCNT(D) ;SUBTRACT EMPTY SPACE
ADDI T1,1 ;BEG OF RECORD IS COL 1
SKIPE ORPOS(D) ;IS THERE A VIRTUAL POSITION?
MOVE T1,ORPOS(D) ;YES. USE IT AS CURRENT POSITION
POPJ P, ;RETURN WITH BYTE NUMBER
;ROUTINE TO SET RECORD POSITION
;ARG: T1 = BYTE NUMBER
;SETS SO THAT NEXT IBYTE/OBYTE CALL GETS OR STORES THE GIVEN BYTE
%SPOS: JUMPG T1,.+2 ;OK IF .GT. 0
MOVEI T1,1 ;SET TO 1 IF NOT
MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%IO ;INPUT?
JRST SOPOS ;NO, OUTPUT
SIPOS: SUBI T1,1 ;SET POSITION TO ONE BEFORE IT
MOVE T2,IRLEN(D) ;GET LENGTH OF RECORD
SUBI T2,(T1) ;COMPUTE NEW EMPTY-BYTE COUNT
MOVEM T2,IRCNT(D) ;SET TO DESIRED COLUMN
JUMPL T2,ISEOR ;NO BP SETUP IF BEYOND RECORD
IDIVI T1,5 ;BREAK BYTE # INTO WORD NUMBER AND BYTE OFFSET
LDB T3,[POINT 6,IRBUF(D),5] ;Get "P"-field of byte ptr.
CAILE T3,44 ;Skip if a local byte ptr.
JRST SIPOS1 ;No
MOVE T2,BPTAB(T2) ;GET LH OF BYTE POINTER
HRR T2,IRBUF(D) ;PUT IN RH POINTING TO RECORD BUFFER
ADDI T2,(T1) ;ADD IN WORD OFFSET
MOVEM T2,IRPTR(D) ;STORE NEW BYTE POINTER
POPJ P,
;The ENCODE/DECODE extended addressing version.
SIPOS1: MOVE T3,IRBUF(D) ;Get starting BP
TXZ T3,77B5 ;Clear "P" field
TDO T3,BPTABE(T2) ;Get new "P" field
ADDI T3,(T1) ;Add in word offset
MOVEM T3,IRPTR(D) ;Store new byte ptr.
POPJ P, ;Return
ISEOR: MOVX T0,D%EOR ;Set END-OF-RECORD flag
IORM T0,FLAGS(D)
POPJ P, ;DONE
SOPOS: MOVEM T1,ORPOS(D) ;STORE NEXT CHARACTER POSITION
POPJ P,
;SETPOS - SET OUTPUT POSITION ROUTINE. T FORMAT AND X FORMAT
;JUST SET ORPOS(D), THE VIRTUAL POSITION. SETPOS IS CALLED IF
;A CHARACTER IS ACTUALLY OUTPUT IN THAT POSITION. FIRST, THE
;CURRENT POSITION IS CHECKED AGAINST THE LAST RECORDED LENGTH.
;IF THE CURRENT POSITION IS GREATER THAN THE LENGTH, A NEW
;LENGTH IS RECORDED. IF ORPOS (THE DESIRED POSITION) IS
;WITHIN THE NEW LENGTH, WE JUST GO AND SETUP THE PNTR/COUNT
;APPROPRIATELY. IF IT IS NOT, WE PAD THE CURRENT RECORD WITH
;BLANKS. IF THE CURRENT POSITION WAS LESS THAN THE LAST
;RECORDED LENGTH, THEN WE JUST CHECK THIS LENGTH AGAINST
;ORPOS. IF ORPOS IS WITHIN THE LENGTH, WE GO AND SETUP THE
;PNTR/COUNT APPROPRIATELY. OTHERWISE, WE SETUP THE PNTR/COUNT
;TO THE OLD LENGTH AND PAD THE RECORD WITH BLANKS TO ORPOS.
SETPOS: PUSHJ P,%PUSHT ;SAVE T ACS
SOS ORPOS(D) ;DESIRED POSITION IS ONE LESS THAN SPECIFIED
SKIPN ORBUF(D) ;ANY BUFFER ALLOCATED YET?
PUSHJ P,EXPORB ;NO. ALLOCATE ONE
MOVE T1,ORBLN(D) ;GET RECORD BUFFER LENGTH
SUB T1,ORCNT(D) ;GET CURRENT CHARACTER POSITION
CAMGE T1,ORLEN(D) ;NEW ONE BIGGER OR SAME?
JRST LENGOK ;NO. SETUP WITHIN RECORD
MOVEM T1,ORLEN(D) ;YES. STORE NEW ONE
CAMN T1,ORPOS(D) ;ARE WE WHERE WE WANT TO BE PRECISELY?
JRST CLRVIR ;YES. TIME TO DO NOTHING
CAMLE T1,ORPOS(D) ;SMALLER THAN DESIRED POSITION?
JRST SPOSV ;NO. JUST SETUP PNTR/COUNT
JRST OPAD ;YES. PAD WITH SPACES
LENGOK: MOVE T1,ORLEN(D) ;GET BUFFER LENGTH AGAIN
CAML T1,ORPOS(D) ;IS LENGTH SMALLER THAN DESIRED POSITION?
JRST SPOSV ;NO. JUST SETUP PNTR/COUNT
PUSHJ P,SPOS1 ;YES. SET CURRENT POSITION TO END OF RECORD
;AND PAD WITH BLANKS
OPAD: MOVE T1,ORBLN(D) ;GET BUFFER LENGTH
SUB T1,ORCNT(D) ;GET CURRENT POSITION
MOVE T2,ORPOS(D) ;GET DESIRED POSITION
SUBI T2,(T1) ;GET # BLANKS TO PAD
OPADLP: MOVEI T1," " ;GET A BLANK
PUSHJ P,LOBYTE ;DON'T HAVE TO CHECK ORPOS EACH TIME
SOJG T2,OPADLP
CLRVIR: SETZM ORPOS(D) ;PREVENT REPEAT OF ABOVE
PUSHJ P,%POPT ;RESTORE T ACS
POPJ P,
SPOSV: MOVE T1,ORPOS(D) ;GET DESIRED POSITION
SETZM ORPOS(D) ;PREVENT REPEAT OF ABOVE
PUSHJ P,SPOS1 ;SET THE POSITION
PUSHJ P,%POPT ;RESTORE T ACS
POPJ P,
SPOS1: MOVE T2,ORBLN(D) ;GET BUFFER LENGTH
SUBI T2,(T1) ;GET NEW EMPTY-BYTE COUNT
MOVEM T2,ORCNT(D) ;SET NEW COUNT
IDIVI T1,5 ;BREAK BYTE # INTO WORD NUMBER AND BYTE OFFSET
LDB T3,[POINT 6,ORBUF(D),5] ;Get P-field of byte ptr.
CAILE T3,44 ;Skip if regular, local byte ptr.
JRST SPOS2 ;No, use other BP table
MOVE T2,BPTAB(T2) ;Get LH of byte ptr.
HRR T2,ORBUF(D) ;Put in RH of byte ptr.
ADDI T2,(T1) ;Add in word offset.
MOVEM T2,ORPTR(D) ;STORE NEW BYTE POINTER
POPJ P, ;DONE
;The ENCODE/DECODE extended addressing version.
SPOS2: MOVE T3,ORBUF(D) ;Get starting BP of buffer
TXZ T3,77B5 ;Clear BP bits
TDO T3,BPTABE(T2) ;Get new BP bits.
ADDI T3,(T1) ;Add in word offset
MOVEM T3,ORPTR(D) ;Store new byte pointer.
POPJ P, ;Done
BPTAB: POINT 7, ;BYTE 0
POINT 7,,6 ;BYTE 1
POINT 7,,13 ;BYTE 2
POINT 7,,20 ;BYTE 3
POINT 7,,27 ;BYTE 4
BPTABE: 610000,,0 ;BYTE 0
620000,,0 ;BYTE 1
630000,,0 ;BYTE 2
640000,,0 ;BYTE 3
650000,,0 ;BYTE 4
SUBTTL UNFORMATTED I/O
UNFI: AOS NREC(U) ;UPDATE RECORD COUNT
DMOVE P1,IPTR(D) ;GET FILE PNTR/COUNT
SKIPN P4,RSIZE(D) ;REC SIZE SPECIFIED?
HRLOI P4,377777 ;NO, USE BIG RECORDS
PUSHJ P,ILSCW1 ;READ START LSCW
$ECALL EOF,%ABORT ;EOF. GO START READING THE I/O LIST
;WHICH WILL FLUSH ITSELF OUT
SETZ T3, ;SET NO ARRAY IN PROGRESS YET
UILP: JUMPG T3,UIWIN ;IF WE HAVE AN ARRAY ADDRESS, CONTINUE WITH IT
PUSHJ P,%GTIOX ;GET NEXT ARRAY FROM IO LIST
JUMPE T3,UIEND ;IF NONE, GO FINISH UP
UIWIN: JUMPLE P4,UIZERO ;RECORDSIZE WORDS READ, GO SKIP TO END LSCW
JUMPG P2,UISEG ;IF DATA LEFT IN WINDOW, CONTINUE WITH IT
PUSHJ P,UINXTW ;READ NEXT WINDOW
JRST UIEND ;GO CHECK IF EOF OK
UISEG: JUMPG P3,UIBLT ;IF DATA LEFT IN SEGMENT, CONTINUE WITH IT
UISEGX: PUSHJ P,ILSCWX ;READ LSCW OF NEXT SEGMENT
JUMPLE P3,UIZERO ;FOUND NULL TYPE 2 OR TYPE 3, GO STORE ZEROES
UIBLT: MOVEI T2,(T3) ;GET MIN OF ARRAY LENGTH
CAILE T2,(P2) ; AND WINDOW LENGTH
MOVEI T2,(P2)
CAILE T2,(P3) ; AND SEGMENT LENGTH
MOVEI T2,(P3)
CAILE T2,(P4) ; AND RECORD LENGTH
MOVEI T2,(P4)
JUMPE T2,UILP ;DON'T LOSE ON BOUNDARY
;T1/ address of user's array
;P1/ local FOROTS address of data
;T2/ number of words to copy
IF20,<
TLNN T1,-1 ;Extended addressing?
JRST UIBLT1 ;No, normal BLT
;Use XBLT
PUSH P,T2 ;Save acs
PUSH P,T3 ; Used by XBLT
;T2/ # words to copy
XMOVEI T3,1(P1) ;T3/ "From" -- get FOROTS address of data
MOVE T4,T1 ;T4/ "To"-- user's array.
EXTEND T2,[XBLT] ;** Copy the data **
POP P,T3 ;Restore acs
POP P,T2
ADDI T1,(T2) ;Point to END+1 of BLT.
JRST UIBLT2 ;Skip normal BLT
>;END IF20
UIBLT1: MOVSI T4,1(P1) ;GET BLT-FROM ADDRESS
HRRI T4,(T1) ;AND BLT-TO ADDRESS
ADDI T1,(T2) ;POINT TO END+1 OF BLT
BLT T4,-1(T1) ;MOVE DATA INTO ARRAY
UIBLT2: ADDI P1,(T2) ;INCREMENT ADDRESS OF DATA IN WINDOW
SUBI P2,(T2) ;DECREMENT COUNT OF DATA LEFT IN WINDOW
SUBI P3,(T2) ;DECREMENT COUNT OF DATA LEFT IN SEGMENT
SUBI P4,(T2) ;DECREMENT COUNT OF DATA LEFT IN RECORD
SUBI T3,(T2) ;DECREMENT COUNT OF DATA LEFT IN ARRAY
JRST UILP ;CONTINUE
UIZERO: SETZM (T1) ;CLEAR FIRST WORD
CAIG T3,1 ;MORE THAN 1 WORD?
JRST UZSKP2 ;NO
IF20,<
TLNN T1,-1 ;Extended addressing?
JRST UZSKP1 ;No, normal BLT
;Use XBLT
PUSH P,T2 ;Save acs
PUSH P,T3
PUSH P,T4
MOVE T2,T3 ;T2/ # words to copy
MOVE T3,T1 ;t3/ "from" the array
XMOVEI T4,1(T1) ;T4/ "to" array+1
EXTEND T2,[XBLT] ;** Zero array **
POP P,T4 ;Restore saved acs
POP P,T3
POP P,T2
JRST UZSKP2
>;END IF20
UZSKP1: MOVSI T4,(T1) ;SET BLT-FROM ADDRESS
HRRI T4,1(T1) ;AND BLT-TO ADDRESS
ADDI T1,(T3) ;POINT TO END+1 OF BLT
BLT T4,-1(T1) ;CLEAR WHOLE ARRAY
;Here when BLT (or XBLT) has been done to clear array
UZSKP2: PUSHJ P,%GTIOX ;GET NEXT ARRAY FROM IO LIST
JUMPN T3,UIZERO ;IF THERE IS ONE, ZERO IT TOO
UIEND: PUSHJ P,ILSCW3 ;SKIP TO END LSCW
UIRET: DMOVEM P1,IPTR(D) ;STORE FILE POINTER/COUNT
MOVE T0,FLAGS(D) ;Get DDB flags
TXNN T0,D%END ;REACH EOF?
POPJ P, ;NO
TXNE T0,D%BIN ;BINARY FILE?
$ECALL BBF,%ABORT ;YES. BAD FORMAT
$ECALL EOF,%ABORT ;NO. JUST EOF
IF10,<
UINXTW: MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%END ;AT EOF?
JRST UIEOF ;YES. REPORT OR JRST AWAY
PUSHJ P,UNXTW ;MAP NEXT WINDOW
MOVE T0,FLAGS(D)
TXNE T0,D%END ;SEQUENTIAL FILE AND EOF?
JRST UIEOF ;YES. REPORT OR JRST AWAY
JRST %POPJ1 ;NO
> ;IF10
IF20,<
UINXTW: MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%END ;IN FILE?
JRST UIEOF ;NO. REPORT OR JRST AWAY
TXNE T0,D%RAN ;RANDOM?
JRST UIRAN ;YES. HANDLE SEPARATELY
LOAD T0,INDX(D) ;GET DEVICE INDEX
CAIE T0,DI.DSK ;DISK?
JRST UTNXTW ;NO. DON'T PROCESS EOFN
MOVE T0,BYTN(D) ;GET DESIRED WORD #
CAML T0,EOFN(D) ;WITHIN FILE?
JRST UIEOF ;NO. EOF RETURN
PUSHJ P,UNXTW ;READ NEXT WINDOW
MOVE T0,BYTN(D) ;GET WORD # OF NEXT WINDOW
CAMG T0,EOFN(D) ;PAST EOF?
JRST UINEOF ;NO
SUB T0,EOFN(D) ;GET DIFF
SUB P2,T0 ;SET COUNT TO WHAT'S THERE
UINEOF: MOVEM P2,WCNT(D) ;SAVE ACTIVE WORD COUNT
JRST %POPJ1
UTNXTW: PUSHJ P,UNXTW ;JUST GET A NEW WINDOW
MOVE T0,FLAGS(D) ;Get DDB flags
TXNN T0,D%END ;EOF?
AOS (P) ;NO. SKIP RETURN
POPJ P,
UIRAN: PUSHJ P,UNXTW ;GET NEXT WINDOW
JRST %POPJ1
> ;IF20
UIEOF: MOVX T0,D%END ;Set EOF flag
IORM T0,FLAGS(D)
POPJ P,
;HERE AT START OF RECORD
;READ START LSCW
;0 MEANS RANDOM RECORD WAS NEVER WRITTEN
ILSCW1: MOVE T0,FLAGS(D) ;Get DDB flags
TXNN T0,D%BIN ;BINARY MODE?
JRST IMG1 ;NO, IMAGE, NO LSCWS
PUSHJ P,IWORD ;GET WORD FROM BINARY FILE
POPJ P, ;EOF, MEANS END OF WHOLE FILE
JUMPE T1,RNRERR ;ZERO, RECORD WASN'T WRITTEN
LDB T2,[POINT 9,T1,8] ;GET SEGMENT CONTROL WORD
CAIE T2,1 ;START LSCW?
; IOERR (BBF,25,302,?,Bad format binary file,,%ABORT)
$ECALL BBF,%ABORT ;?Bad format binary file
MOVEI P3,(T1) ;GET SEGMENT LENGTH FROM RH
SOJA P3,%POPJ1 ;REMOVE LSCW FROM COUNT, RETURN
IMG1: MOVEI P3,-1 ;SET LARGE SEGMENT
JRST %POPJ1 ;DONE
;HERE WHEN START OR CONTINUE SEGMENT ENDS
;MUST SEE CONTINUATION OR END LSCW
ILSCWX: MOVE T0,FLAGS(D) ;Get DDB flags
TXNN T0,D%BIN ;BINARY MODE?
JRST IMG2 ;NO, IMAGE, FAKE A CONTINUATION LSCW
PUSHJ P,%PUSHT ;SAVE T ACS
ILX1: PUSHJ P,IWORD ;GET WORD FROM BINARY FILE
$ECALL BBF,%ABORT ;IOERR: ?"Bad format binary file"
SETO P3, ;ASSUME 0 SEGMENT LENGTH
LDB T2,[POINT 9,T1,8] ;GET SEGMENT CONTROL WORD
CAIN T2,3 ;END LSCW?
JRST ILXEND ;YES, END OF LOGICAL RECORD
CAIE T2,2 ;CONTINUATION LSCW?
$ECALL BBF,%ABORT ;NO. BAD LSCW, BAD BINARY FILE
MOVEI P3,(T1) ;GET SEGMENT LENGTH FROM RH
SUBI P3,1 ;REMOVE LSCW FROM COUNT
ILXEND: PJRST %JPOPT ;RESTORE T ACS AND RETURN
IMG2: MOVEI P3,-1 ;SET LARGE SEGMENT
POPJ P,
;HERE AT END OF IO LIST
;POSITION FILE JUST AFTER END LSCW
;NUMBER OF WORDS TO DISCARD IS .GE. 0 IN P3
ILSCW3: MOVE T0,FLAGS(D) ;Get DDB flags
TXNN T0,D%BIN ;BINARY?
JRST IMG3 ;NO, NO LSCW
JUMPL P3,%POPJ ;IF ALREADY READ TYPE 3, LEAVE
PUSHJ P,IWORD ;GET WORD FROM BINARY FILE
$ECALL BBF,%ABORT ;EOF. FILE IN ERROR
SOJGE P3,.-2 ;SKIP TILL LSCW
LDB T2,[POINT 9,T1,8] ;GET SEGMENT CONTROL WORD
CAIN T2,2 ;CONTINUE LSCW?
JRST [MOVEI P3,(T1) ;YES, GET SEGMENT LENGTH
SOJA P3,ILSCW3] ;CONTINUE
CAIE T2,3 ;END LSCW?
$ECALL BBF,%ABORT ;No, file in error.
POPJ P, ;DONE
IMG3: SKIPN RSIZE(D) ;RECORD SIZE SPECIFIED?
POPJ P, ;NO - WE HAVE NO CLEANUP
JUMPLE P4,%POPJ ;SKIP TO END OF RECORD
PUSHJ P,IWORD ;READ A WORD
SETZ P4, ;EOF, OK
SOJG P4,.-2 ;LOOP BACK
IMG4: POPJ P, ;RETURN
INXT: MOVE T0,FLAGS(D) ;Get DDB flags
TXNN T0,D%END ;SKIP IF AT END
PUSHJ P,UINXTW ;NOTHING LEFT, GO MAP NEXT WINDOW
POPJ P, ;EOF
; JRST IWORD ;DONE
IWORD: SOJL P2,INXT ;IF NO WORDS, GET SOME
ADDI P1,1 ;INCREMENT POINTER
MOVE T1,(P1) ;GET WORD
PJRST %POPJ1 ;SKIP RETURN
;UNFORMATTED SKIP RECORD
UNFSKP: AOS NREC(U) ;UPDATE RECORD COUNT
DMOVE P1,IPTR(D) ;GET FILE PNTR/COUNT
MOVE P4,RSIZE(D) ;GET RECORD SIZE
PUSHJ P,ILSCW1 ;READ START LSCW, P3 = SEGMENT LENGTH
POPJ P, ;EOF. JUST RETURN
SETZ T3, ;NO ARRAY IN PROGRESS
JRST UIEND ;GO SKIP TO END OF RECORD
UNFO: MOVX T0,D%MOD ;Set "file modified"
IORM T0,FLAGS(D)
MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%RAN ;RANDOM?
PUSHJ P,RMAPW ;YES, MAP CORRECT WINDOW
AOS NREC(U) ;UPDATE RECORD COUNT
DMOVE P1,OPTR(D) ;GET FILE POINTER/COUNT
MOVE T0,FLAGS(D)
TXNE T0,D%BIN ;BINARY?
PUSHJ P,OLSCW1 ;YES, OUTPUT START LSCW
SKIPN P3,RSIZE(D) ;RECORD SIZE SPECIFIED?
HRLOI P3,377777 ;NO, SET BIG RECORDS
UOLP: PUSHJ P,%GTIOX ;GET ADDRESS AND LENGTH OF AN ARRAY TO OUTPUT
JUMPE T3,UOEND ;END OF IOLST, DONE
UOBLT: JUMPG P2,WINDOK ;OK IF WE HAVE ROOM IN WINDOW
PUSHJ P,%PUSHT ;GET NEW ONE IF WE DON'T
MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%BIN ;BINARY?
PUSHJ P,OLSCWX ;YES. FINISH START OR CONTINUE LSCW
PUSHJ P,UNXTW ;OUTPUT CURRENT WINDOW, GET NEXT
MOVE T0,FLAGS(D)
TXNE T0,D%BIN ;BINARY
PUSHJ P,OLSCW2 ;YES. OUTPUT TYPE 2 LSCW
PUSHJ P,%POPT
WINDOK: JUMPLE P3,UOTRNC ;IF NONE, GO TRUNCATE RECORD
MOVEI T2,(T3) ;GET ARRAY LENGTH
CAILE T2,(P2) ;UNLESS LESS THAN WINDOW LENGTH
MOVEI T2,(P2) ;GET MIN
CAMLE T2,P3 ;UNLESS LESS THAN RECORD SIZE
MOVE T2,P3 ;GET MIN
JUMPE T2,UOSKP ;AVOID 0-WORD BLT
;T1/ addr. of user's array.
;p1/ local FOROTS address of data.
;T2/ # words to copy
IF20,<
TLNN T1,-1 ;User's array in a non-zero section?
JRST UOBLT2 ;No, normal BLT
;Use XBLT
PUSH P,T2 ;Save acs
PUSH P,T3
;T2/ # words to copy
MOVE T3,T1 ;T3/ "from" -- user's array
XMOVEI T4,1(P1) ;T4/ "to"-- get Global FOROTS' address.
EXTEND T2,[XBLT] ;** COPY array **
POP P,T3 ;Restore T3
POP P,T2 ; and T2
ADDI P1,(T2) ;Point to end+1 of XBLT
JRST UOSKP
>;END IF20
;Use BLT
UOBLT2: MOVSI T4,(T1) ;GET BLT-FROM ADDRESS
HRRI T4,1(P1) ;AND BLT-TO ADDRESS
ADDI P1,(T2) ;POINT TO END+1 OF BLT
BLT T4,(P1) ;MOVE DATA INTO WINDOW
UOSKP: SUBI P3,(T2) ;DECREMENT COUNT OF WORDS LEFT IN RECORD
SUBI P2,(T2) ;DECREMENT COUNT OF EMPTY SPACE IN WINDOW
SUBI T3,(T2) ;DECREMENT COUNT OF WORDS LEFT IN ARRAY
JUMPLE T3,UOLP ;IF ARRAY DONE, GO DO NEXT ARRAY
ADDI T1,(T2) ;BUMP ARRAY ADDRESS
JRST UOBLT ;GO DO NEXT PIECE
UOTRNC: PUSHJ P,%GTIOX
JUMPN T3,UOTRNC
UOEND: SKIPN RSIZE(D) ;RECORD SIZE?
JRST UOXYZ ;NO, FINE
JUMPLE P3,UOXYZ ;NO ZEROS NECESSARY, FINE
SETZ T1, ;GET A ZERO
PUSHJ P,OWORD ;PUT IN FILE
SOJG P3,.-1 ;PAD WHOLE RECORD
UOXYZ: MOVE T0,FLAGS(D)
TXNE T0,D%BIN ;BINARY?
PUSHJ P,OLSCW3 ;YES, OUTPUT END LSCW
DMOVEM P1,OPTR(D) ;STORE FILE POINTER/COUNT
MOVE T1,BYTN(D) ;GET BYTE # OF NEXT WINDOW
SUBI T1,(P2) ;GET LAST BYTE IN USE
MOVE T0,FLAGS(D) ;Fetch DDB flags
TXNE T0,D%RAN ;RANDOM FILE?
CAMLE T1,EOFN(D) ;YES. ONLY STORE LARGER EOFN
MOVEM T1,EOFN(D) ;SAVE AS EOF PNTR
POPJ P, ;DONE
;LSCW ROUTINES
;FORMAT OF BINARY RECORD: (FORMAT OF BINARY RECORD)
;THERE IS NO NECESSARY RELATIONSHIP BETWEEN SEGMENT SIZE AND BUFFER SIZE
OLSCW1: SKIPE RSIZE(D) ;IS RECORD SIZE SPECIFIED?
JRST O1FIX ;YES - SET TYPE 1 LSCW NOW
SETZM SEGCNT ;CLEAR WORD COUNT OF SEGMENTS ALREADY IN FILE
MOVSI T1,(1B8) ;GET START LSCW
JRST O2FIX ;SKIP TYPE 2 PROCESSING
OLSCW2: SKIPE RSIZE(D) ;IS RECORD SIZE SPECIFIED?
POPJ P, ;YES - NO NEED FOR TYPE 2 LSCW
MOVSI T1,(2B8) ;GET CONTINUE LSCW
O2FIX: PUSHJ P,OWORD ;PUT WORD INTO FILE WINDOW
MOVEM P1,CWADR ;STORE IN-CORE ADDRESS OF CONTROL WORD
POPJ P,
O1FIX: MOVE T1,RSIZE(D) ;GET RECORD SIZE
ADD T1,[1B8+1] ;SET START LSCW
SETZM CWADR ;REMEMBER WE'VE ALREADY FILLED IN START LSCW
PJRST OWORD ;AND PUT WORD INTO FILE WINDOW
OLSCWX: SKIPE RSIZE(D) ;WAS RECORD SIZE SPECIFIED?
POPJ P, ;YES - START LSCW WAS ALREADY FILLED IN
SKIPN T2,CWADR ;GET ADDRESS OF TYPE 1 OR 2 CONTROL WORD
$SNH ;Already out in file, bug
MOVEI T1,1(P1) ;POINT TO END+1 OF WINDOW
SUBI T1,(T2) ;GET DISTANCE FROM CONTROL WORD = SEG LENGTH
HRRM T1,(T2) ;STORE LENGTH IN CONTROL WORD
ADDM T1,SEGCNT ;ADD INTO TOTAL RECORD LENGTH
SETZM CWADR ;NOW NO CONTROL WORD WAITING TO BE FINISHED
POPJ P, ;DONE
OLSCW3: SKIPE RSIZE(D) ;WAS RECORD SIZE SPECIFIED?
JRST O3FIX ;YES - START LSCW ALL DONE - DO TYPE 3 ONLY
SKIPN T2,CWADR ;GET ADDRESS OF TYPE 1 OR 2 CONTROL WORD
$SNH ;Already out in file, bug
MOVEI T1,1(P1) ;POINT TO END+1 OF RECORD
SUBI T1,(T2) ;GET DISTANCE FROM CONTROL WORD = SEG LENGTH
HRRM T1,(T2) ;STORE LENGTH IN START CONTROL WORD
ADD T1,SEGCNT ;ADD IN WORDS FROM OTHER SEGMENTS
ADDI T1,1 ;ADD IN END LSCW TOO
HRLI T1,(3B8) ;PUT IN TYPE-3 LSCW HEADER
SETZM CWADR ;NOW NO CONTROL WORD WAITING TO BE FINISHED
PJRST OWORD ;PUT INTO FILE
O3FIX: MOVE T1,RSIZE(D) ;GET USER SPECIFIED RECORD SIZE
ADD T1,[3B8+2] ;SET UP END LSCW
; PJRST OWORD ;PUT INTO FILE
OWORD: SOJL P2,OWFULL ;IF NO ROOM LEFT, GET SOME
ADDI P1,1 ;INCREMENT POINTER
MOVEM T1,(P1) ;STORE WORD
POPJ P,
OWFULL: PUSHJ P,UNXTW ;NO ROOM, MAP NEXT WINDOW
JRST OWORD ;KEEP IN SYNCH
SEGMENT DATA
CWADR: BLOCK 1 ;ADDRESS OF START LSCW
SEGCNT: BLOCK 1 ;COUNT OF WORDS OUT IN FILE IN PREVIOUS SEGMENTS
SEGMENT CODE
SUBTTL DUMP MODE I/O
IF10,<
DMPIN: PUSHJ P,DMPSET ;SETUP FOR THE DUMP MODE I/O
MOVEI T2,.FOINP ;SET FOR INPUT
HLL T2,FBLK(D) ;Get channel stuff
MOVEI T3,DMPLST
MOVE T1,[2,,T2]
FILOP. T1, ;Do the INPUT
PUSHJ P,EOFCHK ;Set D%END if EOF; else give error
MOVE T1,FLAGS(D) ;Get flags
TXNE T1,D%END ;End of file?
$ECALL EOF,%ABORT ;Yes, give error
POPJ P, ;No, return
DMPOUT: PUSHJ P,DMPSET ;SETUP FOR THE DUMP MODE I/O
MOVEI T2,.FOOUT ;SET FOR OUTPUT
HLL T2,FBLK(D) ;GET CHANNEL STUFF
MOVEI T3,DMPLST
MOVE T1,[2,,T2]
FILOP. T1, ;DO THE INPUT
$ECALL IOE,%ABORT ;Error
POPJ P,
DMPSET: PUSHJ P,%SAVE2 ;SAVE P1 & P2
XMOVEI P1,DMPLST ;SETUP DUMP MODE LIST PNTR
DMPLP: PUSHJ P,%GTIOX ;GET AN I/O LIST ITEM
JUMPE T1,DMPDON ;DONE WITH SETUP IF NO ADDR
SUBI T1,1 ;GET ADDR-1
MOVNI T2,(T3) ;GET NEG # WORDS
HRLI T1,(T2) ;IN LEFT HALF
MOVEM T1,(P1) ;SAVE IN DUMP MODE LIST
ADDI T3,177 ;GET # BLOCKS
IDIVI T3,200 ;ROUNDED UP
ADDM T3,BLKN(D) ;ADD TO BLOCK COUNT
AOJA P1,DMPLP
DMPDON: SETZM (P1) ;CLEAR LAST WORD
POPJ P,
>;END IF10
SUBTTL DISK POSITIONING
COMMENT &
TOPS-20 sequential disk files are read with PMAPs by moving a n-page window
through the file. The file window always starts on a n-page boundary and is
moved only when the desired byte is not in the window. The first process page
number of the window is in WTAB(D). (The window size can be set to something
besides 4 pages with BUFFERCOUNT=).
TOPS-20 random files are similar, but there are n independent one-page windows.
If references to the file are well localized, the windows will often contain
the desired records. For random files WTAB contains an AOBJN pointer to a
n-word table, with each word giving the process page number and corresponding
file page number of a window, process page in the left half and file page in
the right half. The number of windows can be set with BUFFERCOUNT=.
TOPS-10 random files are the same, but the windows are a block long instead of
a page. WTAB uses the sign bit to remember if a block has been modified and
needs to be written back. The BUFFERCOUNT parameter is rounded up to a
multiple of 4 blocks so that an integral number of process pages are used.
TOPS-10 sequential disk files are like any other TOPS-10 sequential file.
&
;ROUTINE TO MAP NEXT WINDOW OF FILE
;ARGS: BYTN = FILE BYTE NUMBER OF START OF WINDOW
;RETURN: P1 = BYTE POINTER TO FIRST MAPPED BYTE
; P2 = COUNT OF BYTES IN WINDOW
; BYTN = FILE BYTE NUMBER+1 OF END OF WINDOW
; I.E., STARTING BYTE OF FOLLOWING WINDOW
FNXTW: PUSHJ P,%PUSHT ;SAVE T ACS
MOVE T1,BYTN(D) ;GET BYTE NUMBER
IDIVI T1,5 ;CONVERT TO WORD NUMBER
CAIE T2,0 ;BYTE # MUST BE MULT OF 5
$SNH ;If not, halt.
MOVE T0,FLAGS(D)
TXNE T0,D%RAN ;RANDOM?
PUSHJ P,MAPW ;MAP THAT BYTE INTO CORE
MOVE T0,FLAGS(D)
TXNN T0,D%RAN ;CHECK AGAIN
PUSHJ P,SMAPW ;IT'S SEQUENTIAL
IMULI P2,5 ;CONVERT WORD COUNT TO BYTE COUNT
ADDM P2,BYTN(D) ;INCREMENT BYTE NUMBER TO AFTER THIS WINDOW
HRLI P1,(POINT 7,0,34) ;MAKE POINTER TO FIRST MAPPED BYTE
PJRST %JPOPT ;RESTORE T ACS AND RETURN
UNXTW: PUSHJ P,%PUSHT ;SAVE T ACS
MOVE T1,BYTN(D) ;DISK, GET WORD NUMBER
MOVE T0,FLAGS(D)
TXNE T0,D%RAN ;RANDOM?
PUSHJ P,MAPW ;MAP THAT WORD INTO CORE
MOVE T0,FLAGS(D)
TXNN T0,D%RAN ;CHECK AGAIN
PUSHJ P,SMAPW ;IT'S SEQUENTIAL
ADDM P2,BYTN(D) ;INCREMENT WORD NUMBER FOR NEXT CALL
PJRST %JPOPT ;RESTORE T ACS AND RETURN
;ROUTINE TO GET NEXT BUFFER OF NON-DISK FILE
IF20,<
TNXTW: MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%END ;END FILE ALREADY?
POPJ P, ;YES. NOTHING TO DO
LOAD T1,IJFN(D) ;GET JFN
MOVE T2,WADR(D) ;GET ADDRESS OF BUFFER
HRLI T2,(POINT 36,) ;POINT TO FIRST WORD
MOVN T3,WSIZ(D) ;GET WINDOW SIZE IN WORDS
TXNE T0,D%IO ;INPUT OR OUTPUT?
JRST TONXTW ;OUTPUT
AOS BLKN(D) ;INCR BLOCK #
SINR% ;READ
ERJMP UEOFCHK ;EOF OR ERROR
UEOFRET:
MOVE P1,WADR(D) ;POINT TO DATA
SUBI P1,1 ;POINT TO WORD-1
MOVE P2,WSIZ(D) ;GET FULL WINDOW SIZE
ADD P2,T3 ;GET # WORDS WE ACTUALLY GOT
MOVEM P2,WCNT(D) ;SAVE FOR DIRECTION SWITCH
POPJ P, ;DONE
UEOFCHK:
PUSH P,T2 ;SAVE POINTER TO END OF DATA
GTSTS% ;GET FILE STATUS
TXNN T2,GS%EOF ;EOF?
JRST UINERR ;NO, INPUT ERROR
MOVX T0,D%END ;EOF, tell caller
IORM T0,FLAGS(D)
POP P,T2 ;RESTORE T2
JRST UEOFRET ;CONTINUE
UINERR: POP P,T2 ;RESTORE T2
; IOERR (INY,899,401,?,$J,%ABORT) ;TYPE MESSAGE AND ABORT STATEMENT
$ECALL INY,%ABORT
TONXTW: JUMPE P1,TOSKP ;IF FIRST BUFFER, DON'T WRITE IT
JUMPL P2,.+2 ;IF MIDDLE OF WINDOW
ADD T3,P2 ;WRITE PARTIAL WINDOW
SOUTR% ;WRITE BUFFER
ERJMP UOUTERR ;ERROR, TYPE MESSAGE
TOSKP: AOS BLKN(D) ;INCR BLOCK #
MOVE P1,WADR(D) ;POINT TO EMPTY BUFFER
SUBI P1,1 ;POINT TO WORD-1
MOVE P2,WSIZ(D) ;GET FULL WINDOW SIZE
POPJ P, ;DONE
UOUTERR:
; IOERR (OUY,899,401,?,$J,%ABORT) ;ERROR, TYPE MONITOR MESSAGE
$ECALL OUY,%ABORT
> ;IF20
;ROUTINE TO MAP WINDOW CONTAINING FIRST BYTE OF RANDOM RECORD
;THINGS ARE LEFT SET UP FOR NXTW IN CASE RECORD SPANS WINDOWS
;ARGS: A.REC = RECORD NUMBER TO SET TO
;RETURN: IPTR/OPTR = POINTER TO FIRST BYTE OF RECORD
; ICNT/OCNT = BYTES IN WINDOW
; BYTN = NUMBER OF FIRST BYTE IN FOLLOWING WINDOW
RMAPW: PUSHJ P,%SAVE2 ;SAVE P ACS
SKIPG T3,@A.REC ;GET RECORD NUMBER
; IOERR (IRN,25,512,?,Illegal record number $D,<T3>,%ABORT)
$ECALL IRN,%ABORT
MOVEM T3,NREC(U) ;STORE IN UNIT BLOCK
IRMAP: MOVE T1,RSIZE(D) ;GET RECORD SIZE, BYTES
MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%UNF ;UNFORMATTED?
JRST URMAP ;YES, GO DO THAT
FRMAP: ADDI T1,2+4 ;ADD 2 FOR CRLF, 4 TO ROUND UP TO WORD
IDIVI T1,5 ;GET RECORD SIZE IN WORDS
IMULI T1,-1(T3) ;GET WORD NUMBER OF START OF RECORD
MOVEI T2,5 ;GET BYTES PER WORD
IMUL T2,T1 ;GET BYTE NUMBER OF RECORD START
MOVEM T2,BYTN(D) ;STORE IT
PUSHJ P,MAPW ;MAP RECORD INTO CORE
HRLI P1,(POINT 7,0,34) ;POINT TO FIRST BYTE OF RECORD
IMULI P2,5 ;CONVERT WINDOW LENGTH TO BYTES
JRST RMAPX ;GO FINISH UP
URMAP: MOVE T0,FLAGS(D)
TXNE T0,D%BIN ;BINARY FILE?
ADDI T1,2 ;YES, ADD 2 LSCWS
IMULI T1,-1(T3) ;GET WORD NUMBER OF RECORD START
MOVEM T1,BYTN(D) ;STORE CURRENT WORD NUMBER
PUSHJ P,MAPW ;MAP RECORD START INTO CORE
RMAPX: ADDM P2,BYTN(D) ;INCREMENT WORD NUMBER FOR NXTW
DMOVEM P1,IPTR(D) ;STORE BYTE POINTER AND COUNT
DMOVEM P1,OPTR(D) ;IN BOTH PLACES
POPJ P, ;DONE
;ROUTINE TO MAP A FILE WINDOW
;ARGS: P1 = FILE ADDRESS
;RETURN: P1 = PROCESS ADDRESS
; P2 = NUMBER OF WORDS MAPPED IN WINDOW
IF10,<LWSIZ==7> ;ON 10, WINDOW SIZE IS 2**7
IF20,<LWSIZ==9> ;ON 20, WINDOW SIZE IS 2**9
PSIZ==1_LWSIZ
%MAPW:
MAPW: MOVE P1,T1 ;GET WORD ADDRESS IN FILE
LSHC P1,-LWSIZ ;GET PAGE NUMBER, SAVE OFFSET WITHIN PAGE
CAMLE P1,TPAGE(D) ;GREATER THAN ANY PAGE REFERENCED BEFORE?
MOVEM P1,TPAGE(D) ;YES. SAVE IT
MOVE T1,WTAB(D) ;GET AOBJN POINTER TO WINDOW TABLE
FINDW: HRRZ T2,(T1) ;GET PAGE NUMBER OF A MAPPED PAGE
CAIE T2,(P1) ;IS IT THE ONE WE WANT?
AOBJN T1,FINDW ;NO, LOOK ON
JUMPL T1,PTRBMP ;IN CORE
PUSHJ P,RDW ;NOT IN CORE
PTRBMP: HLRZ P1,(T1) ;GET IN-CORE PAGE NUMBER OF FILE PAGE
LSHC P1,LWSIZ ;COMBINE WITH WITHIN-PAGE OFFSET
PUSHJ P,PAGCHK ;MACHINE-DEPENDENT PAGE (BLOCK) CODE
MOVE T2,WPTR(D) ;GET REFILL POINTER TO WINDOW TABLE
CAIE T2,(T1) ;IS IT POINTING TO PAGE WE JUST USED?
JRST MAPRET ;NO, LEAVE IT WHERE IT IS
SUBI T2,1 ;YES, POINT IT SOMEPLACE ELSE
MOVE T3,WTAB(D) ;GET POINTER TO START OF TABLE
CAIL T2,(T3) ;DID WE PASS BEGINNING OF TABLE?
JRST PTRRET ;NO, FINE
HLRE T3,T3 ;YES, GET -TABLE LENGTH
SUB T2,T3 ;RESET POINTER TO TOP OF TABLE
PTRRET: MOVEM T2,WPTR(D) ;RESET REFILL POINTER
MAPRET: SETCM P2,P1 ;GET 777777777777 - OFFSET INTO WINDOW
ANDI P2,PSIZ-1 ;GET WSIZ - 1 - OFFSET INTO WINDOW
ADDI P2,1 ;GET WSIZ - OFFSET = WORDS MAPPED IN WINDOW
SOJA P1,%POPJ ;RETURN CORRECT ADDR-1
IF10,<
PAGCHK: MOVSI T2,(1B0) ;GET PAGE-WRITTEN BIT
MOVE T0,FLAGS(D)
TXNE T0,D%IO ;ARE WE WRITING?
IORM T2,(T1) ;YES, FLAG PAGE AS MODIFIED
POPJ P,
>;END IF10
IF20,<
PAGCHK: LOAD T3,ACC(D) ;GET ACCESS
CAIE T3,AC.RIN ;RANDIN?
POPJ P, ;NO. RANDOM. LEAVE PAGE ALONE
SKIP (P1) ;REFERENCE A WORD IN THE PAGE
ERJMP UNMAPR ;UNMAP THE PAGE IF NON-EXISTENT
POPJ P,
UNMAPR: PUSHJ P,%PUSHT ;SAVE T ACS
MOVEI T2,(P1) ;GET CORE ADDR
LSH T2,-LWSIZ ;MAKE IT A PAGE AGAIN
HRLI T2,.FHSLF ;THIS FORK
SETO T1, ;SETUP UNMAP FUNCTION
SETZ T3, ;WITH NO REPEAT COUNT
PMAP% ;UNMAP IT, SO IT WILL BE 0
PUSHJ P,%POPT ;RESTORE T ACS
POPJ P,
>;END IF20
IF20,<
RDW: MOVE T1,WPTR(D) ;GET POINTER TO PAGE TO BOOT FROM CORE
HRRM P1,(T1) ;STORE NEW FILE PAGE NUMBER
HLRZ T2,(T1) ;GET PROCESS PAGE NUMBER
HRLI T2,.FHSLF ;FORK HANDLE
LOAD T1,IJFN(D) ;JFN
MOVSI T1,(T1)
HRRI T1,(P1) ;FILE PAGE NUMBER
MOVSI T3,(PM%PLD+PM%RD+PM%WR) ;ACCESS BITS
PMAP% ;MAP PAGE IN
MOVE T1,WPTR(D) ;POINT TO WINDOW TABLE ENTRY
POPJ P, ;GO MOVE WINDOW POINTER TO SOMEPLACE ELSE
>;END IF20
IF10,<
RDW: PUSHJ P,WRTPG ;WRITE PAGE BACK IF MODIFIED
MOVE T1,LKPB+.RBSIZ(D) ;GET REAL FILE SIZE
ADDI T1,PSIZ-1 ;ROUND UP TO GET # BLOCKS
LSH T1,-LWSIZ
CAIGE T1,1(P1) ;BLOCK EXIST?
JRST CLRPAG ;NO. CREATE ZEROS, ACT AS IF IT DID
HLLZ T2,CHAN(D) ;SET CHANNEL NUMBER
HRRI T2,.FOUSI ;SET USETI FUNCTION
MOVEI T3,1(P1) ;GET PAGE NUMBER TO READ IN
MOVE T1,[2,,T2] ;SET TO DESIRED BLOCK
FILOP. T1,
$ECALL IOE,%ABORT
HLLZ T2,CHAN(D) ;SET CHANNEL NUMBER
HRRI T2,.FOINP ;SET INPUT FUNCTION
MOVEI T3,T4 ;SET ADDRESS OF COMMAND LIST
MOVE T1,WPTR(D) ;POINT TO WTAB ENTRY
HLRZ T4,(T1) ;GET CORE "PAGE NUMBER" TO READ INTO
LSH T4,LWSIZ ;CONVERT TO ADDRESS
SUBI T4,1 ;-1 FOR IOWD
HRLI T4,-PSIZ ;SET LENGTH
SETZ T5, ;ZERO TO END COMMAND LIST
MOVE T1,[2,,T2] ;SET ARG BLOCK POINTER
FILOP. T1, ;DO FILOP
$ECALL IOE,%ABORT
MOVE T1,WPTR(D) ;RELOAD WTAB POINTER
HRRM P1,(T1) ;STORE NEW FILE PAGE NUMBER
POPJ P, ;GO BUMP POINTER TO SOMEPLACE ELSE
WRTPG: MOVE T1,WPTR(D) ;GET POINTER TO PAGE TO BOOT FROM CORE
SKIPL T3,(T1) ;GET FILE PAGE NUMBER AND SKIP IF MODIFIED
POPJ P, ;NOT MODIFIED, NO NEED TO WRITE
HLLZ T2,CHAN(D) ;GET CHANNEL NUMBER
HRRI T2,.FOUSO ;SET USETO FUNCTION
MOVEI T3,1(T3) ;GET JUST BLOCK NUMBER
MOVE T1,[2,,T2] ;SET ARG BLOCK POINTER
FILOP. T1, ;SET TO DESIRED BLOCK
$ECALL IOE,%ABORT
IMULI T3,PSIZ ;GET # WORDS TO END OF THIS PAGE
CAMLE T3,LKPB+.RBSIZ(D) ;LARGER THAN WHAT'S THERE?
MOVEM T3,LKPB+.RBSIZ(D) ;YES. UPDATE IT
HLLZ T2,CHAN(D) ;GET CHANNEL NUMBER AGAIN
HRRI T2,.FOOUT ;SET OUTPUT FUNCTION
MOVEI T3,T4 ;SET ADDRESS OF COMMAND LIST
MOVE T1,WPTR(D) ;POINT TO WTAB ENTRY AGAIN
HLRZ T4,(T1) ;GET "PAGE NUMBER" OF WINDOW
LSH T4,LWSIZ ;MAKE INTO ADDRESS
SUBI T4,1 ;-1 FOR IOWD
HRLI T4,-PSIZ ;PUT COUNT IN LH
SETZ T5, ;ZERO TO END COMMAND LIST
MOVE T1,[2,,T2] ;SET ARG BLOCK POINTER
FILOP. T1, ;DO FILOP OR OUT UUO
$ECALL IOE,%ABORT
POPJ P, ;DONE
REPEAT 0,<
EOFOK: MOVEI T2,(T1) ;COPY BITS
ANDI T2,760000 ;CLEAR ALL BUT ERR BITS
CAIE T2,IO.EOF ;JUST EOF?
$ECALL IOE,%ABORT ;NO, TYPE MESSAGE
MOVEI T3,(T1) ;COPY BITS AGAIN
TRZ T3,760000 ;CLEAR ERR BITS
HLLZ T2,CHAN(D) ;SETSTS
HRRI T2,.FOSET
MOVE T1,[2,,T2]
FILOP. T1,
$SNH
>;END REPEAT 0
CLRPAG: MOVE T1,WPTR(D) ;CLEAR BLOCK
HLRZ T2,(T1)
LSH T2,LWSIZ
SETZM (T2)
MOVSI T3,(T2)
HRRI T3,1(T2)
BLT T3,PSIZ-1(T2)
HRRM P1,(T1) ;STORE NEW FILE PAGE NUMBER
POPJ P, ;RETURN AS IF IT HAD RETURNED ZEROS
;HERE AT CLOSE TO WRITE MODIFIED PAGES
%RANWR: PUSHJ P,%SAVE1 ;SAVE P ACS
MOVE P1,WTAB(D) ;GET AOBJN POINTER TO TABLE
RWLP: MOVEM P1,WPTR(D) ;POINT TO A PAGE
PUSHJ P,WRTPG ;WRITE IT IF MODIFIED
AOBJN P1,RWLP ;DO ALL PAGES
POPJ P, ;DONE
> ;IF10
;SEQUENTIAL CASE, ONE N-PAGE WINDOW
;ARGS: T1 = WORD NUMBER IN FILE
; BUFCT = LENGTH OF WINDOW, PAGES
IF20,<
SMAPW: LOAD T2,INDX(D) ;GET DEVICE INDEX
CAIE T2,DI.DSK ;DISK?
JRST TNXTW ;NO.
MOVE P1,T1 ;GET WORD # IN FILE
LSHC P1,-LWSIZ ;CALC PAGE #
LOAD T2,BUFCT(D) ;GET # PAGES WE ARE READING/WRITING
ADDI T2,(P1) ;GET HIGHEST PAGE #
CAMLE T2,TPAGE(D) ;HIGHER PAGE THAN RECORDED?
MOVEM T2,TPAGE(D) ;YES. RECORD IT
AOS BLKN(D) ;INCREMENT "BLOCK" NUMBER
MOVE T1,WTAB(D) ;GET PAGE ADDR OF BUFFER
MOVSI T2,.FHSLF ;THIS FORK
HRRI T2,(T1) ;PAGE NUMBER IN FORK
EXCH T1,P1 ;PAGE NUMBER IN FILE
LOAD T3,IJFN(D) ;JFN
HRLI T1,(T3)
LOAD T3,BUFCT(D) ;PAGE COUNT
HRLI T3,(PM%CNT+PM%PLD+PM%RD+PM%WR) ;ACCESS BITS, READ PAGES NOW
PMAP% ;MAP WINDOW INTO FILE
MOVE T1,FLAGS(D) ;CHECK IF INPUT OPERATION
TXNN T1,D%IN ;IS IT?
JRST NOPCH2 ;NO. DON'T CHECK PAGE EXISTENCE
LOAD T4,BUFCT(D) ;GET BUFFER COUNT
MOVNI T4,(T4) ;NEGATIVE
MOVSI T4,(T4) ;IN LEFT HALF
HRR T4,WTAB(D) ;GET PAGE # OF BOTTOM PAGE
CHPLP: MOVEI T1,(T4) ;GET CORE ADDR
LSH T1,LWSIZ
SKIP (T1)
ERJMP UNMPG ;IF NOT THERE, GO UNMAP
AOBJN T4,CHPLP ;BACK FOR MORE
JRST NOPCH2 ;DONE
UNMPG: SETO T1, ;SET TO UNMAP IT
MOVSI T2,.FHSLF ;THIS FORK
HRRI T2,(T4) ;GET THE CORRECT PAGE TO TOSS
SETZ T3, ;NO REPEAT COUNT
PMAP% ;UNMAP THE PAGE
AOBJN T4,CHPLP ;BACK FOR MORE
NOPCH2: LSHC P1,LWSIZ ;COMBINE PAGE WITH WITHIN-PAGE OFFSET
MOVE T1,P1 ;GET WITHIN-PAGE OFFSET
ANDI T1,PSIZ-1
LOAD P2,BUFCT(D) ;GET WINDOW SIZE IN PAGES
LSH P2,9 ;CONVERT TO WORDS
SUBI P2,(T1) ;GET WORDS LEFT IN WINDOW
SOJA P1,%POPJ ;POINT TO CORRECT ADDR-1
> ;END IF20
IF10,<
SMAPW: MOVE T0,FLAGS(D) ;Get DDB flags
TXNN T0,D%IO ;INPUT OPERATION?
JRST SMWIN ;YES. GO DO IT
AOS T1,BLKN(D) ;INCR BLOCK #
IMULI T1,200 ;GET BYTE # OF NEXT BLOCK
MOVEM T1,BYTN(D) ;STORE FOR EOFN CALC
DMOVEM P1,OPTR(D) ;OUTPUT. SETUP OUTPUT PNTR/COUNT
MOVE T2,CHAN(D) ;WRITE CURRENT BLOCK
HRRI T2,.FOOUT
MOVE T1,[1,,T2]
FILOP. T1,
PUSHJ P,EOFCHK
DMOVE P1,OPTR(D) ;GET POINTER TO NEXT BUFFER
POPJ P, ;DONE
SMWIN: AOS T1,BLKN(D) ;INCR BLOCK #
IMULI T1,200 ;GET BYTE # OF NEXT BLOCK
MOVEM T1,BYTN(D) ;SAVE FOR EOFN CALC
DMOVEM P1,IPTR(D) ;SETUP INPUT PNTR/COUNT
MOVE T2,CHAN(D) ;GET CHANNEL STUFF
HRRI T2,.FOINP ;READ NEXT BLOCK
MOVE T1,[1,,T2]
FILOP. T1,
PUSHJ P,EOFCHK
DMOVE P1,IPTR(D) ;GET PNTR/COUNT OF BUFFER JUST READ
POPJ P,
> ;IF10
SUBTTL TAPE POSITIONING
;Come here from MTOP% after the unit number has been checked.
;IO args have been set up in A.xxx
;A POPJ will return from the MTOP% call.
MTOP: SKIPL T1,A.MTOP ;GET OPERATION CODE
CAILE T1,MOPMAX ;NEGATIVE OR TOO BIG?
POPJ P, ;YES, NOP
XMOVEI T2,. ;Current section number in LH
HRR T2,MOPNAM(T1) ;Get global address of ASCIZ name
MOVEM T2,%IONAM ;SET STATEMENT NAME FOR ERROR MESSAGES
MOVE T1,A.UNIT ;GET UNIT NUMBER
SETZ P1, ;Clear D%UNF and D%RAN for default OPEN
PUSHJ P,%SETD ;SET UP D
DMOVE T2,[EXP [ASCIZ /direct/],[ASCIZ /sequential/]]
MOVE T1,FLAGS(D) ;GET FLAGS
TXNE T1,D%RAN ;RANDOM FILE?
$ECALL CDI ;CAN'T DO THIS UNTIL VERSION 7
MOVE T1,A.MTOP ;Get back MTOP number
PUSHJ P,@MOPDSP(T1) ;GO DO OPERATION
PJRST %SETAV ;RETURN (possibly doing ERR=, etc.)
MOPNAM: [ASCIZ /REWIND/] ;(0)
[ASCIZ /UNLOAD/] ;(1)
[ASCIZ /BACKSPACE/] ;(2)
[ASCIZ /BACK FILE/] ;(3)
[ASCIZ /ENDFILE/] ;(4)
[ASCIZ /SKIP RECORD/] ;(5)
[0] ;(6)
[ASCIZ /SKIP FILE/] ;(7)
MOPMAX==.-MOPNAM
MOPDSP: IFIW MOPREW
IFIW MOPUNL
IFIW MOPBSR
IFIW MOPBSF
IFIW MOPEND
IFIW MOPSKR
IFIW %POPJ
IFIW MOPSKF
IF20,<
;REWIND
MOPREW:
MOVE T0,FLAGS(D)
TXNE T0,D%END ;EOF?
PUSHJ P,BAKEOF ;YES. CLEAR IT
MOVEI T1,1 ;SET NEXT RECORD TO 1
MOVEM T1,NREC(U)
SETZM BLKN(D) ;AND BLOCK #
MOVX T0,D%END ;File is now not at end
ANDCAM T0,FLAGS(D)
LOAD T1,INDX(D) ;GET DEV INDEX
CAIN T1,DI.DSK ;DISK?
JRST DSKREW ;CAN DO
CAIN T1,DI.MTA ;TAPE?
JRST MTAREW ;CAN DO
POPJ P, ;ELSE NOP
DSKREW: MOVE T0,FLAGS(D) ;Get DDB flags for this file
TXNE T0,D%OUT ;WAS IT OPEN FOR OUTPUT?
PUSHJ P,%SETIN ;Yes. Switch to input
SETZM IPTR(D) ;PRETEND NO I/O DONE
SETZM ICNT(D) ;NO BYTES IN BUFFER
SETZM BYTN(D) ;SET CURRENT BYTE NUMBER TO 0
POPJ P, ;DONE
MTAREW: MOVE T1,FLAGS(D) ;Get DDB flags
TXNN T1,D%IN+D%OUT ;If not open,
JRST JSTREW ;Don't call %SETIN
PUSHJ P,%SETIN ;Get file opened for INPUT
SETZM IPTR(D) ;PRETEND NO I/O DONE
SETZM ICNT(D) ;NO BYTES IN BUFFER
MOVEI T2,.MOREW ;SET TO REWIND TAPE
JRST DOMTOP ;GO DO MTOPR
JSTREW: PUSHJ P,MTAOJF ;Open JFN, aborts if fails
MOVEI T2,.MOREW ;Get function
PUSHJ P,DOMTP1 ;Do it
PJRST MTACJF ;Close file, release JFN, return.
;Routine to create a JFN to be used for magtape operations
;Returns .+1 if ok, JFN in "RWJFN"
;The JFN is opened for input.
;If fails, goes to %ABORT.
MTAOJF: MOVE T1,[POINT 7,TMDEV] ;Get device name with ":"
MOVEI T2,DEV(D) ;From the DDB
HRLI T2,(POINT 7,)
MTAOJ1: ILDB T3,T2 ;Get a byte
JUMPE T3,MTAOJ2 ;Null, done
IDPB T3,T1 ;Store
JRST MTAOJ1 ;Loop until null found
MTAOJ2: MOVEI T3,":" ;Append a colon
IDPB T3,T1 ;Now have DEV: in "TMDEV"
;Do our own GTJFN.
MOVX T1,GJ%SHT
HRROI T2,TMDEV
GTJFN%
ERJMP E..SNH ;?Dev must exist: OPENX was done!
HRRZM T1,RWJFN ;Save JFN
;Have to OPENF the file to do a TAPOP.
MOVX T2,OF%RD ;Read ACCESS, nothing else.
OPENF% ;Get READ access to file
ERJMP MTARWO ;?OPENF failed, give error
POPJ P, ;OK, return
;Here if OPENF failed
MTARWO: MOVE T1,RWJFN ;Release JFN
RLJFN%
ERJMP .+1 ;?Too bad
$ECALL OPE,%ABORT ;Give JSYS error and abort program
SEGMENT DATA
TMDEV: BLOCK 20 ;Device name with ":"
RWJFN: BLOCK 1 ;Temp JFN used for REWIND, UNLOAD
SEGMENT CODE
;Routine to close and release JFN gotten by MTAOJF
MTACJF: MOVE T1,RWJFN ;Get saved JFN
CLOSF%
$ECALL CLF,%ABORT ;?CLOSF failed, abort program
POPJ P, ;All worked, return
;BACKSPACE
MOPBSR: PUSHJ P,%SETIN ;Switch to input if necessary
MOVE T1,NREC(U) ;GET RECORD #
SOJLE T1,%POPJ ;CAN'T GO BEFORE BEG FILE
MOVEM T1,NREC(U) ;SAVE NEW RECORD NUMBER
MOVE T0,FLAGS(D)
TXNE T0,D%END ;FILE AT END?
JRST BAKEOF ;YES. JUST BACK OVER IT
TXNE T0,D%UNF ;FORMATTED?
JRST UNFBSR ;NO, UNFORMATTED
DMOVE P1,IPTR(D) ;GET POINTER
JUMPE P1,%POPJ ;IF NO I/O YET, WE'RE DONE
MOVEI T1,(P1) ;GET JUST ADDR
CAML T1,WADR(D) ;BEG OF WINDOW?
JRST BSROK ;NO
PUSHJ P,SUBP1X ;YES. GET PREVIOUS WINDOW
POPJ P, ;NONE. JUST RETURN
BSROK: PUSHJ P,FBTST ;FIND CURRENT EOL
JRST NORSZ ;GOT TO BEG FILE
PUSHJ P,FBSLP ;AND PREVIOUS ONE
JRST NORSZ ;GOT TO BEG FILE
SKIPN RSIZE(D) ;FIXED-LENGTH RECORDS?
JRST NORSZ ;NO
HRLI P1,(POINT 7,0,34) ;YES. POINT TO END OF WORD
IDIVI P2,5 ;AND CORRECT COUNT
IMULI P2,5
NORSZ: DMOVEM P1,IPTR(D) ;STORE POINTER/COUNT
POPJ P,
FBTST: LDB T1,P1 ;GET BYTE
CAIL T1,12 ;LF, VT, FF?
CAILE T1,14
JRST FBSLP ;NO
JRST %POPJ1 ;DONE. SKIP RETURN
FBSLP: ADDI P2,1 ;ADJUST COUNT
ADD P1,[47B5] ;DECREMENT P1
TLCE P1,(1B0)
JRST FBTST ;PNTR IS OK
SUBP1: SUB P1,[430000,,1] ;DECREMENT TO PREV WORD
MOVEI T1,(P1) ;GET JUST ADDR
CAML T1,WADR(D) ;AT BEG OF WINDOW?
JRST FBTST ;NO. BACK TO TEST
PUSHJ P,SUBP1X ;YES. GET PREVIOUS WINDOW
POPJ P, ;NONE THERE
JRST FBTST ;GOT IT. BACK TO GET CHARS
SUBP1X: LOAD T1,INDX(D) ;GET DEV INDEX
CAIN T1,DI.MTA ;TAPE?
JRST MTABSA ;YES
MOVE T1,BYTN(D) ;GET BYTE # OF NEXT WINDOW
SUB T1,WSIZ(D) ;GET BYTE # OF THIS WINDOW
JUMPLE T1,%POPJ ;BEG OF FILE. NON-SKIP RETURN
SUB T1,WSIZ(D) ;GET BYTE # OF PREVIOUS WINDOW
MOVEM T1,BYTN(D) ;SAVE IT
PUSHJ P,FNXTW ;GO MAP THE WINDOW
MOVE T1,WSIZ(D) ;GET WINDOW SIZE IN BYTES
LOAD T2,BPW(D) ;GET BYTES/WORD
IDIVI T1,(T2) ;GET WINDOW SIZE IN WORDS
ADD P1,T1 ;POINT TO END OF WINDOW
HRLI P1,(POINT 7,,34)
SETZ P2, ;AND CLEAR COUNT
JRST %POPJ1 ;SKIP RETURN
MTABSA: MOVE T1,BLKN(D) ;GET CURRENT BLOCK #
SOJLE T1,%POPJ ;LEAVE IF NONE THERE AFTER DECR
MOVEM T1,BLKN(D) ;SAVE DECREMENTED AMOUNT
MOVEI T2,.MOBKR ;BACKSPACE RECORD
PUSHJ P,DOMTOP ;BACK UP TO BEGINNING OF THIS RECORD
PUSHJ P,BACKA ;BACKSPACE, READ A BLOCK
JRST %POPJ1 ;AND SKIP RETURN
BACKA: MOVEI T2,.MOBKR
PUSHJ P,DOMTOP ;BACK UP TO BEGINNING OF PREV RECORD
LOAD T1,IJFN(D) ;READ THE RECORD
MOVE T2,WADR(D) ;POINT TO BUFFER
SUBI T2,1 ;POINT TO LAST BYTE IN PREV WORD
HRLI T2,(POINT 7,0,34)
MOVN T3,WSIZ(D) ;GET LENGTH OF WINDOW
SINR% ;READ STRING
ERCAL EOFCHK ;ERROR, GO TYPE MESSAGE
MOVE T1,WSIZ(D) ;GET WINDOW SIZE
ADD T1,T3 ;GET # BYTES ACTUALLY READ
MOVEM T1,WCNT(D) ;SAVE FOR DIRECTION SWITCH
MOVE P1,T2 ;POINT AT LAST BYTE READ
SETZ P2, ;CLEAR COUNT
DMOVEM P1,IPTR(D) ;SAVE PNTR/COUNT
POPJ P,
UNFBSR: LOAD T1,INDX(D) ;CHECK DEVICE
CAIN T1,DI.MTA ;TAPE?
JRST MTABSU ;YES
DMOVE P1,IPTR(D) ;GET POINTER
MOVE T0,FLAGS(D)
TXNN T0,D%BIN ;BINARY?
JRST IBSLP ;NO, IMAGE
UBSLP: MOVEI T1,(P1) ;GET ADDR ONLY
CAML T1,WADR(D) ;AT BEG OF WINDOW?
JRST BINOK ;NO
MOVE T1,BYTN(D) ;YES. GET WORD # OF NEXT WINDOW
SUB T1,WSIZ(D) ;GET WORD # OF THIS WINDOW
JUMPLE T1,%POPJ ;IF BEG OF THIS WINDOW IS 0, LEAVE
SUB T1,WSIZ(D) ;GET WORD # OF PREVIOUS WINDOW
MOVEM T1,BYTN(D) ;SAVE IT
PUSHJ P,UNXTW ;GET PREVIOUS WINDOW
ADD P1,WSIZ(D) ;POINT TO END OF WINDOW
SETZ P2, ;AND CLEAR COUNT
BINOK: HRRZ T1,(P1) ;GET LENGTH FROM END LSCW
SUBI P1,(T1) ;GET ADDR OF BEG OF RECORD
ADDI P2,(T1) ;AND INCR WORD COUNT LEFT
MOVEI T1,(P1) ;GET ADDR ONLY
SUB T1,WADR(D) ;GET WINDOW OFFSET
CAML T1,[-1] ;BEFORE BEG OF WINDOW?
JRST UBSRET ;NO. WE'RE DONE
ADDI P1,1 ;POINT TO WORD WE WANT TO MAP
PUSHJ P,%PTOF ;GET THE FILE POSITION
JUMPGE P1,BINOK2 ;OK IF ZERO
SETZ P1, ;ELSE MAP PAGE 0
BINOK2: PUSHJ P,%FTOP ;MAP THE BEG OF RECORD
MOVE T1,BYTN(D) ;GET BYTE # OF NEXT WINDOW
CAMG T1,EOFN(D) ;PAST EOF?
JRST UBSRET ;NO
SUB T1,EOFN(D) ;YES. GET DIFF
SUBI P2,(T1) ;SUBTRACT FROM AVAILABLE CHARS
MOVE T2,WSIZ(D) ;GET WINDOW SIZE
SUBI T2,(T1) ;GET # ACTIVE CHARS
MOVEM T2,WCNT(D) ;SAVE IT
UBSRET: DMOVEM P1,IPTR(D) ;STORE POINTER
POPJ P, ;DONE
IBSLP: SKIPN T1,RSIZE(D) ;RECORDSIZE SPECIFIED?
; IOERR (CBI,25,536,?,Can't backspace image file with no RECORDSIZE,,%ABORT)
$ECALL CBI,%ABORT
SUBI P1,(T1) ;DECR PNTR
ADDI P2,(T1) ;INCR WORD COUNT
MOVEI T1,(P1) ;GET ADDR ONLY
SUB T1,WADR(D) ;GET WINDOW OFFSET
CAML T1,[-1] ;BEFORE BEG WINDOW?
JRST UBSRET ;NO. WE'RE DONE
ADDI P1,1 ;POINT TO WORD WE REALLY WANT
PUSHJ P,%PTOF ;CONVERT P1 FROM CORE ADDRESS TO FILE ADDRESS
JUMPG P1,IMGOK2 ;OK IF .GT. 0
SETZ P1, ;ELSE MAP PAGE 0
IMGOK2: JRST BINOK2 ;GO MAP PAGE, SETUP PNTR/COUNT
MTABSU: DMOVE P1,IPTR(D) ;GET BUFFER POINTER/COUNT
MOVE T0,FLAGS(D)
TXNE T0,D%BIN ;BINARY?
JRST MTABSB ;YES
SKIPN T1,RSIZE(D) ;NO, IMAGE; MUST HAVE RECORD SIZE
$ECALL CBI,%ABORT
JRST MTABSI ;GO BACK OVER THAT MANY WORDS
MTABSB: MOVEI T1,(P1) ;GET PNTR
CAML T1,WADR(D) ;AT BEG OF BUFFER?
JRST BSUOK ;NO. CAN JUST GRAB PREV RECSIZ
MOVE T1,BLKN(D) ;GET BLOCK
SOJLE T1,%POPJ ;BEG OF FILE. BACKSPACE IS NOP
MOVEM T1,BLKN(D) ;STORE AS NEW BLOCK #
MOVEI T2,.MOBKR ;BACKSPACE TO BEG OF CURRENT BLOCK
PUSHJ P,DOMTOP
PUSHJ P,BACKU ;BACKSPACE 1 RECORD, READ 1
BSUOK: HRRZ T1,(P1) ;GET RECSIZ FROM TYPE 3 LSCW
MTABSI: SUBI P1,(T1) ;DECR PNTR
ADDI P2,(T1) ;INCR COUNT
MOVEI P3,(P1) ;GET NEW PNTR
SUB P3,WADR(D) ;GET WINDOW OFFSET
CAML P3,[-1] ;BEFORE BEG OF WINDOW?
JRST GOTBF ;NO. WE'RE OK
MOVE T1,BLKN(D) ;GET BLOCK #
SOJLE T1,BEGBF ;IF BLOCK 1, JUST SET TO BEG BUFFER
MOVEM T1,BLKN(D) ;NOT. STORE NEW BLOCK #
MOVEI T2,.MOBKR ;BACKSPACE TO BEG OF CURRENT BLOCK
PUSHJ P,DOMTOP
PUSHJ P,BACKU ;BACKSPACE 1 REC, READ 1
MOVM T1,P3 ;GET NEW DECREMENT
SOJA T1,MTABSI ;BACKU POINTS 1 BACK, SO DECR THE DECR
;LOOP UNTIL DONE OR BEG FILE
BEGBF: MOVE P1,WADR(D) ;SET PNTR/COUNT TO BEG BUFFER
SUBI P1,1
MOVE P2,WCNT(D)
GOTBF: DMOVEM P1,IPTR(D) ;STORE PNTR/COUNT
POPJ P, ;DONE
BACKU: MOVEI T2,.MOBKR ;BACKSPACE RECORD
PUSHJ P,DOMTOP
LOAD T1,IJFN(D) ;READ THE RECORD
MOVE T2,WADR(D) ;POINT TO BUFFER
SUBI T2,1 ;POINT TO LAST BYTE OF WORD-1
HRLI T2,(POINT 36,0,35)
MOVN T3,WSIZ(D)
SINR%
ERCAL EOFCHK ;ERROR, GO TYPE MESSAGE
MOVEI P1,(T2) ;GET PNTR TO END OF ACTIVE BYTES
SETZ P2,
DMOVEM P1,IPTR(D) ;SAVE PNTR/COUNT
MOVE T1,WSIZ(D) ;GET WINDOW SIZE
ADD T1,T3 ;GET # ACTIVE BYTES
MOVEM T1,WCNT(D) ;SAVE IT
POPJ P,
BAKEOF: MOVX T0,D%END ;Clear EOF bit
ANDCAM T0,FLAGS(D)
LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIE T1,DI.MTA ;MAGTAPE?
POPJ P, ;NO
PUSHJ P,%CLSOP ;CLOSE, OPEN FILE
SOS BLKN(D) ;EOF MARK IS A BLOCK
MOVEI T2,.MOBKR ;BACK OVER THE EOF MARK
PUSHJ P,DOMTOP
SKIPN BLKN(D) ;ANY BLOCKS LEFT?
POPJ P, ;NO. JUST LEAVE
MOVE T0,FLAGS(D)
TXNE T0,D%UNF ;YES. UNFORMMATED?
JRST BACKU ;YES. BACKSPACE, UNFORMATTED READ
JRST BACKA ;NO. BACKSPACE, FORMATTED READ
;ROUTINES TO CONVERT BETWEEN FILE ADDRESSES AND PROCESS ADDRESSES
;
;%PTOF - CONVERT PROCESS ADDRESS TO FILE ADDRESS
;ARGS: P1 = ADDRESS, MUST BE IN THE MEMORY MAPPED TO THE FILE OPEN
; ON THE DDB POINTED TO BY D
;RETURN: P1 = CORRESPONDING WORD NUMBER IN THE FILE
;
;%FTOP - CONVERT FILE ADDRESS TO PROCESS ADDRESS
;ARGS: P1 = FILE ADDRESS
;RETURN: P1 = PROCESS ADDRESS WITH THAT WORD OF FILE MAPPED TO IT
; P2 = COUNT OF WORDS FOLLOWING MAPPED WORD IN WINDOW
%PTOF:: MOVEI P1,(P1) ;DISCARD LH(P1)
JUMPE P1,%POPJ ;ADDRESS=0 MEANS FILE PAGE 0
SUB P1,WADR(D) ;GET OFFSET IN WINDOW
MOVE T2,BYTN(D) ;GET FILE OFFSET OF NEXT WINDOW
SUB T2,WSIZ(D) ;GET FILE OFFSET OF CURRENT WINDOW
LOAD T4,BPW(D) ;GET BYTES/WORD
IDIVI T2,(T4) ;CONVERT BYTES TO WORDS
ADD P1,T2 ;ADD TO OFFSET IN THIS WINDOW
POPJ P,
%FTOP:: MOVEM P1,BYTN(D) ;STORE BYTE NUMBER
MOVE T1,P1 ;ARG IS IN T1
PUSHJ P,SMAPW ;GO MAP THE FILE, RETURN PROCESS ADDRESS
ADDM P2,BYTN(D) ;SET BYTN UP FOR NXTW
POPJ P,
;UNLOAD
MOPUNL: LOAD T1,INDX(D) ;GET DEV INDEX
CAIE T1,DI.MTA ;TAPE?
JRST MOPREW ;NO, UNLOAD IS REWIND
MOVEI T1,1 ;SET NEXT RECORD TO 1
MOVEM T1,NREC(U)
SETZM BLKN(D) ;CLEAR BLOCK #
MOVX T0,D%END ;File is now not at end
ANDCAM T0,FLAGS(D)
MOVE T1,FLAGS(D) ;Get DDB flags
TXNN T1,D%IN+D%OUT ;If not opened yet,
JRST JSTUNL ;Don't call "SETIN"
PUSHJ P,%SETIN ;Get file opened for input.
MOVEI T2,.MORUL ;SET FOR UNLOAD OPR
JRST DOMTOP ;GO DO IT
JSTUNL: PUSHJ P,MTAOJF ;Get a JFN with no filename
MOVEI T2,.MORUL ;UNLOAD it
PUSHJ P,DOMTP1
PJRST MTACJF ;Close, release JFN and return
;TOPS-20 BACKFILE
MOPBSF: LOAD T1,INDX(D) ;GET DEV INDEX
CAIE T1,DI.MTA ;TAPE?
POPJ P, ;NO, BACKFILE IS NOP
PUSHJ P,%SETIN ;Make sure we're open for input
PUSHJ P,ENDOUT ;SETUP PROPERLY
MOVEI T1,1 ;SET NEXT RECORD TO 1
MOVEM T1,NREC(U)
SETZM BLKN(D) ;CLEAR BLOCK #
MOVX T0,D%END ;File is now not at end
ANDCAM T0,FLAGS(D)
MOVEI T2,.MOBKF ;SET FOR BACKSPACE FILE
PUSHJ P,DOMTOP ;GO DO IT
MOVEI T2,.MOBKF ;AND A 2ND TIME
PUSHJ P,DOMTOP
LOAD T1,IJFN(D) ;GET JFN
GDSTS% ;GET STATUS
TXNN T2,MT%BOT ;UNLESS BEG TAPE
PUSHJ P,FORWF
PJRST %CLSOP ;MAKE SURE NO STUPID EOF STATUS
;END FILE
MOPEND: AOS NREC(D) ;INCR REC #
LOAD T1,INDX(D) ;GET DEV INDEX
CAIN T1,DI.DSK ;DISK?
JRST DSKEND ;YES
CAIE T1,DI.MTA ;TAPE?
POPJ P, ;NO. ENDFILE IS A NOP
PUSHJ P,%SETOUT ;Set to output
PUSHJ P,%LSTBF ;OUTPUT LAST BUFFER, IF ANY
PUSHJ P,%CLSOP ;CLOSE FILE, OPEN FOR INPUT AGAIN
ENDOUT: SETZM IPTR(D) ;CLEAR THE PNTR/COUNT
SETZM ICNT(D)
MOVE T1,FLAGS(D)
TXO T1,D%IN+D%END ;WE ARE OPEN FOR INPUT, AT EOF
TXZ T1,D%OUT ;NO LONGER DOING OUTPUT
MOVEM T1,FLAGS(D)
AOS BLKN(D) ;INCR BLOCK #
POPJ P,
DSKEND: PUSHJ P,%SETOUT ;SET TO OUTPUT
PUSHJ P,%SETIN ;AND THEN TO INPUT AGAIN
MOVX T1,D%END+D%MOD ;AT EOF
IORM T1,FLAGS(D)
POPJ P, ;DONE
;TOPS-20 SKIP RECORD
MOPSKR: PUSHJ P,%SETIN ;Switch to input
MOVE T0,FLAGS(D)
TXNN T0,D%UNF ;READ AND IGNORE 1 RECORD
JRST %IREC
JRST UNFSKP
;SKIP FILE
MOPSKF: LOAD T1,INDX(D) ;GET DEV INDEX
CAIE T1,DI.MTA ;TAPE?
POPJ P, ;NO, SKIP IS NOP
MOVE T0,FLAGS(D) ;GET FLAGS
TXNN T0,D%IN+D%OUT ;FILE OPEN?
JRST JSTSKF ;NO. JUST SKIP A FILE
PUSHJ P,%SETIN ;Make sure file is open for input
PUSHJ P,ENDOUT ;SETUP PROPERLY
MOVEI T1,1 ;SET NEXT RECORD TO 1
MOVEM T1,NREC(U)
SETZM BLKN(D) ;CLEAR BLOCK #
MOVX T0,D%END ;Clear EOF bit
ANDCAM T0,FLAGS(D)
MOVEI T2,.MOFWF ;SET FOR SKIP FILE
PUSHJ P,DOMTOP ;BUT IF WE WERE, DON'T GO ANYWHERE
PJRST %CLSOP ;MAKE SURE NO STUPID EOF BIT LEFT ON
JSTSKF: PUSHJ P,MTAOJF ;GET A JFN, OPEN MTA
MOVEI T2,.MOFWF ;DO A SKIP FILE MTOPR
PUSHJ P,DOMTP1
PJRST MTACJF ;GO CLOSE FILE, RELEASE JFN, LEAVE
FORWF: MOVEI T2,.MOFWF ;SKIP FILE
;DOMTOP - Routine to do the MTOP specified in T2. (does appropriate
; WAIT's etc.)
DOMTOP: LOAD T1,IJFN(D) ;GET JFN
;Enter at DOMTP1 if you want to use the JFN in T1.
DOMTP1: PUSH P,T2 ;SAVE THE OPERATION TO DO
MOVEI T2,.MONOP ;DO A WAIT
MTOPR%
ERJMP MTOPER
POP P,T2 ;GET THE OPERATION
MTOPR% ;DO OPERATION
ERJMP MTOPER
MOVEI T2,.MONOP ;AND DO A WAIT
MTOPR%
ERJMP MTOPER
POPJ P, ;DONE
MTOPER: ;IOERR (ILM,23,,?,$J,,%POPJ)
$ECALL ILM,%ABORT
> ;IF20
IF10,<
MOPREW: MOVEI T1,1 ;SET NEXT RECORD TO 1
MOVEM T1,NREC(U)
SETZM BLKN(D) ;AND BLOCK #
MOVX T0,D%END ;Clear EOF bit
ANDCAM T0,FLAGS(D)
LOAD T1,DVTYP(D) ;GET DEVICE INDEX
CAIN T1,.TYDTA ;DECTAPE?
JRST DTAREW ;YES
CAIN T1,.TYDSK ;DISK?
JRST DSKREW ;Yes
CAIN T1,.TYMTA ;Magtape?
JRST MTAREW ;Yes
POPJ P, ;OTHERWISE IT'S A NOP
.FOMTP==30
DTAREW: MOVE T1,FLAGS(D) ;Get DDB flags
TXNN T1,D%IN+D%OUT ;Is the DECTAPE open?
JRST RWDEVO ;Yes, don't use filename
PUSHJ P,%SETIN ;OPEN for input.
SETZM BLKN(D) ;CLEAR BLOCK NUMBER
MOVE T2,CHAN(D) ;LH= chan #
HRRI T2,.FOMTP ;MTAPE FILOP
MOVX T3,MTREW. ;REWIND
MOVE T1,[2,,T2]
FILOP. T1,
$ECALL IOE,%ABORT
POPJ P,
DSKREW: MOVE T1,FLAGS(D) ;Is file really OPEN?
TXNE T1,D%IN+D%OUT
PUSHJ P,CLSOPN ;Yes, CLOSE the file, open for input
POPJ P, ;Return
MTAREW: MOVE T1,FLAGS(D) ;Get flags
TXNN T1,D%IN+D%OUT ;Is file really OPEN
JRST RWDEVO ;No
PUSHJ P,CLSOPN ;CLOSE THE FILE, OPEN FOR INPUT
MOVEI T2,.TFREW ;Go do REWIND
PJRST DOMTOP
;Here to REWIND a non-directory device that is not opened yet.
; Can't use FILOP.'s because you need a filename for them.
RWDEVO: PUSHJ P,OPDEVO ;Open the device only
MOVE T1,ASCHN ;Get channel #
LSH T1,^D23 ;Shift to ac field
IOR T1,[MTREW.] ;Make instruction
XCT T1 ;** REWIND the device **
PJRST CLDEVO ;Close device and return
;Routine to OPEN the device only, (on a low channel).
; FILOP. is not done, because no file can be specified.
;The assigned channel is stored in ASCHN.
;Returns .+1 or takes ERR= or goes to %ABORT (if errors)
OPDEVO: SETZ T1, ;Get a free channel
PUSHJ P,%ALCHN ;Get a channel
$ECALL NFC,%ABORT ;?Too many OPEN units
MOVEM T1,ASCHN ;Save it
LSH T1,^D23 ;Shift into AC position
IOR T1,[OPEN T2] ;Get instruction to XCT
MOVEI T2,.IODMP ;Set dump mode
SETZ T4, ;No buffers
MOVE T3,DEV(D) ;Get device
XCT T1 ;** OPEN the device **
JRST OPDVFL ;?Failed
POPJ P, ;OK, return
;The OPEN UUO failed. Either "No such device"
;or "Assigned to another job".
OPDVFL: MOVE T1,DEV(D) ;See if this device exists
DEVTYP T1,
JRST OPDVNS ;?no such device
JUMPE T1,OPDVNS ;Or if 0 returned.
SKIPA T1,[ERDAJ%] ;"Device allocated to another job"
OPDVNS: MOVEI T1,ERNSD% ;"No such device"
$ECALL OPN,%ABORT ;Give error, abort if no ERR=
SEGMENT DATA
ASCHN: BLOCK 1 ;Assigned channel for non-FILOP. I/O
SEGMENT CODE
;Routine to CLOSE the device OPEN'ed by OPDEVO.
;Returns .+1 always
CLDEVO: MOVE T1,ASCHN ;Get assigned channel #
LSH T1,^D23 ;Shift into ac position
IOR T1,[RELEAS 0] ;Get a RELEASE instruction
XCT T1 ;Do it
MOVE T1,ASCHN ;Get channel #
PUSHJ P,%DECHN ;Deallocate it
$SNH ;?Not assigned, "can't happen"
POPJ P, ;Ok, return
;Still IF10
MOPBSR: PUSHJ P,%SETIN ;Get file open for input
LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIE T1,DI.DSK ;DISK?
CAIN T1,DI.MTA ;OR MAGTAPE?
JRST BSROK ;YES
POPJ P, ;NO. BSR IS NOP
BSROK: SKIPG BLKN(D) ;HAVE WE READ ANYTHING?
POPJ P, ;NO. BACKSPACE IS A NOP
MOVE T1,NREC(U) ;GET RECORD NUMBER
SOJLE T1,%POPJ ;CAN'T GO BACK
MOVEM T1,NREC(U) ;STORE UPDATED ONE
LOAD T1,MODE(D) ;GET FILE MODE
CAIN T1,MD.DMP ;DUMP MODE?
JRST BSRDMP ;YES. VERY SPECIAL
CAIN T1,MD.BIN ;IS IT BINARY?
JRST BSRBIN ;YES
CAIE T1,MD.ASC ;IS IT ASCII?
CAIN T1,MD.ASL
JRST BSRASC ;YES. GO LOOK BACKWARDS FOR LF
SKIPE RSIZE(D) ;NO. FIXED-LENGTH RECORDS?
JRST IMGFIX ;YES
JRST NOBSR ;NO. DO NOTHING!
BSRASC: SKIPE RSIZE(D) ;FIXED-LENGTH RECORDS?
JRST ASCFIX ;YES. EASY TREATMENT
MOVE T0,FLAGS(D)
TXNN T0,D%END ;ARE WE AT EOF?
JRST ASCNEF ;NO
PUSHJ P,BAKEOF ;YES. BACK UP AND GET PREVIOUS BLOCK
SKIPN BLKN(D) ;NULL FILE?
POPJ P, ;YES. WE'RE DONE
MOVE T1,IBCB(D) ;GET BUFFER HEADER ADDR
MOVE P2,1(T1) ;RETURN THE WORD COUNT OF THE BUFFER
IMULI P2,5 ;TURN INTO CHARS
HRRZ P1,IPTR(D) ;GET END BUFFER PNTR
MOVE T3,ICNT(D) ;AND COUNT (SHOULD BE ZERO)
MOVEI T2,4 ;SET INDEX TO END OF WORD
JRST BIDXOK ;GO BACK TO PREVIOUS EOL CHAR
ASCNEF: MOVE P1,IBCB(D) ;GET ADDR OF BUFFER
HRRZ P2,1(P1) ;GET WORD COUNT
IMULI P2,5 ;GET CHAR COUNT OF BUFFER
HRRZ P1,IPTR(D) ;GET CURRENT WORD PNTR
LDB T2,[POINT 6,IPTR(D),5] ;GET BYTE OFFSET
IDIVI T2,7 ;CALCULATE INDEX
SUBI T2,4 ;SUBTRACT FROM 4
MOVM T2,T2 ;TO GET INDEX IN RIGHT DIRECTION
MOVE T3,ICNT(D) ;GET CURRENT COUNT
PUSHJ P,BACKUP ;BACKUP TO LAST LF
ADDI T3,1 ;NOW TO PREVIOUS CHAR
SOJGE T2,BIDXOK
MOVEI T2,4
SUBI P1,1
BIDXOK: PUSHJ P,BACKUP ;AND TO PREVIOUS LF
MOVE T2,PNTABL(T2) ;CREATE PNTR TO IT
TLZ T2,17 ;THROW OUT INDEX
HRRI T2,(P1)
MOVEM T2,IPTR(D) ;SAVE IT
MOVEM T3,ICNT(D) ;AND COUNT
NOBSR: POPJ P,
%BAKEF:
BAKEOF: SOS BLKN(D) ;DECR BLOCK FOR THE EOF
%ISET: PUSHJ P,CLSOPN ;CLEAR THE EOF STATUS
LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIN T1,DI.DSK ;DISK?
JRST DSKEOF ;YES. GO DO USETI
CAIE T1,DI.MTA ;MAGTAPE?
POPJ P, ;NO. CAN'T DO ANYTHING ELSE
MOVEI T2,.TFBSB ;YES. BACKSPACE A FILEMARK
PUSHJ P,DOMTOP
LOAD T1,MODE(D) ;GET DATA MODE
CAIE T1,MD.DMP ;DUMP?
SKIPG BLKN(D) ;NO. ANY DATA?
POPJ P, ;LEAVE IF NO DATA OR DUMP MODE
MOVEI T2,.TFBSB ;BACK OVER THE RECORD WE WANT
PUSHJ P,DOMTOP
JRST COMEOF ;JOIN COMMON CODE
DSKEOF: MOVE T2,FBLK(D) ;GET CHANNEL STUFF
HRRI T2,.FOUSI ;DO USETI
SKIPG T3,BLKN(D) ;TO CURRENT BLOCK
POPJ P, ;LEAVE IF NULL FILE
MOVE T1,[2,,T2]
FILOP. T1,
$ECALL IOE,%ABORT
LOAD T1,MODE(D) ;GET DATA MODE
CAIN T1,MD.DMP ;DUMP?
POPJ P, ;YES. DON'T READ ANYTHING
COMEOF: MOVE T2,FBLK(D) ;GET CHANNEL STUFF
HRRI T2,.FOINP ;READ THE BLOCK
MOVE T1,[1,,T2]
FILOP. T1,
$ECALL IOE,%ABORT ;Should not fail with "EOF"
MOVE T1,IBCB(D) ;GET BUFFER HEADER ADDR
HRRZ T1,1(T1) ;GET THE WORD COUNT
ADDM T1,IPTR(D) ;POINT TO END OF BUFFER
SETZM ICNT(D) ;CLEAR COUNT
POPJ P,
BSRDMP: SKIPN T1,BLKN(D) ;GET BLOCK #
POPJ P, ;HAVEN'T DONE ANY INPUT YET
SOS BLKN(D) ;DECR THE BLOCK #
LOAD T2,INDX(D) ;GET DEVICE INDEX
CAIE T2,DI.DSK ;DISK?
JRST %BACKB ;NO. BACKSPACE AN MTA BLOCK
PJRST USET ;SET NEXT BLOCK TO CURRENT ONE
;HERE IF BINARY RECORD
BSRBIN: MOVE T0,FLAGS(D)
TXNE T0,D%END ;ARE WE AFTER AN EOF?
PJRST BAKEOF ;YES. GET PREV BLOCK, POINT TO END
MOVE P1,IBCB(D) ;GET ADDR OF BUFFER
HRRZ P2,1(P1) ;GET WORD COUNT
MOVEI P3,(P2) ;COPY IT
CAMN P2,ICNT(D) ;ARE WE POINTING TO BEG BLK?
JRST BBACK ;YES. MUST GET PREV BUFFER
MOVE P1,IPTR(D) ;GET THE CURRENT PNTR
MOVE T1,ICNT(D) ;GET COUNT LEFT
MOVEM T1,BSRCNT ;SAVE FOR BACKSPACE
HRRZ T1,(P1) ;GET THE WORD COUNT OF LAST REC
JRST GTBPTR ;NOW GO BACK UP THE FILE
BBACK: PUSHJ P,PRVBUF ;GET THE PREVIOUS BUFFER
JRST BBOK ;NON-SKIP MEANS NOT BEG OF FILE
POPJ P, ;SKIP MEANS BEGINNING OF FILE
BBOK: MOVEM T3,BSRCNT ;SAVE ALSO FOR BACKSPACE
MOVEI P3,(P2) ;COPY THE WORD COUNT
HRRZ T1,(P1) ;GET THE LAST REC WORD SIZE
GTBPTR: PUSHJ P,BCOM ;DO THE BACKSPACE
MOVE T1,BSRCNT ;RESTORE NEW COUNT
MOVEM T1,ICNT(D)
POPJ P,
;HERE FOR ASCII OR IMAGE FIXED-LENGTH RECORDS
ASCFIX: MOVE T0,FLAGS(D) ;Get DDB flags
TXNE T0,D%END ;ARE WE AFTER AN EOF?
PJRST BAKEOF ;YES. GET PREV BLOCK, POINT TO END
MOVE T1,ICNT(D) ;GET COUNT
IDIVI T1,5 ;GET # WORDS
MOVEM T1,BSRCNT ;SAVE WORD COUNT
PUSHJ P,BSRFIX ;GO BACK
MOVE T1,BSRCNT ;GET WORDS AGAIN
IMULI T1,5 ;CONVERT TO CHARS
MOVEM T1,ICNT(D) ;SAVE IT
HRLOI T1,7777 ;AND RIGHT JUSTIFY THE PNTR
ANDM T1,IPTR(D) ;BY CLEARING THE POSITION
POPJ P,
IMGFIX: MOVE T0,FLAGS(D)
TXNE T0,D%END ;ARE WE AFTER AN EOF?
PJRST BAKEOF ;YES. GET PREV BLOCK, POINT TO END
MOVE T1,ICNT(D) ;GET WORD COUNT
MOVEM T1,BSRCNT ;SAVE IT
PUSHJ P,BSRFIX ;GO BACK
MOVE T1,BSRCNT ;GET WORDS AGAIN
MOVEM T1,ICNT(D) ;SAVE IT
POPJ P,
BSRFIX: MOVE P1,IBCB(D) ;GET THE BUFFER ADDR
HRRZ P2,1(P1) ;GET THE WORD COUNT
MOVEI P3,(P2) ;COPY IT
LOAD T1,RSIZW(D) ;GET # WORDS IN RECORD
BCOM: SUB P3,BSRCNT ;GET # WORDS USED
SUBI P3,(T1)
JUMPL P3,BPREV ;HAVE TO GO TO PREV BUFFER
SUBI P2,(P3) ;GET NEW # WORDS
MOVEM P2,BSRCNT ;SAVE NEW COUNT
MOVNI T1,(T1) ;GET NEG REC SIZE
ADDM T1,IPTR(D) ;DECR THE PNTR
POPJ P, ;AND LEAVE
BPREV: PUSHJ P,PRVBUF ;GET PREV BUFFER
JRST NOTBEG ;NOT AT BEG OF FILE
MOVE P1,IBCB(D) ;BEG FILE. GET ADDR OF BUFFER
MOVE P2,1(P1) ;GET # WORDS IN BUFFER
MOVEM P2,BSRCNT ;BUFFER IS FULL
MOVEI T1,1(P1) ;SETUP BEG PNTR
HRRM T1,IPTR(D)
POPJ P,
NOTBEG: MOVM T1,P3 ;FIND POS DIFF NECESSARY
CAIG T1,(P2) ;.GT. BUFFER SIZE?
JRST BINOK ;NO
ADD P3,P2 ;YES. DECREASE THE NEG DIFF
JRST BPREV ;AND GO GET ANOTHER BUFFER
BINOK: ADD P1,P3 ;DECR THE PNTR
HRRM P1,IPTR(D)
MOVEM T1,BSRCNT ;AND SETUP THE COUNT
POPJ P,
AFTPRV: IMULI P2,5 ;GET BYTE COUNT
RCLP0: MOVEI T2,4 ;LOAD MAX INDEX
BACKUP:
RCLP1: CAIL T3,(P2) ;COUNT AT BUFFER MAX?
JRST BEGBUF ;YES. GO GET PREVIOUS BLOCK
LDB T1,PNTABL(T2) ;GET A CHAR
CAIG T1,14 ;EOL CHAR?
CAIGE T1,12
JRST NEOL ;NO
POPJ P, ;YES. WE'RE DONE
NEOL: ADDI T3,1 ;INCR BUFFER COUNT
SOJGE T2,RCLP1 ;LOOP FOR 5 CHARS/WORD
SOJA P1,RCLP0 ;THEN DECR THE WORD PNTR
PNTABL: POINT 7,(P1),6
POINT 7,(P1),13
POINT 7,(P1),20
POINT 7,(P1),27
POINT 7,(P1),34
;
;HERE WE MUST DIVERT THE POINTER TO THE PREVIOUS BLOCK
;AND RESET THE CHAR COUNT
BEGBUF: PUSHJ P,PRVBUF ;GET PREVIOUS BLOCK
JRST AFTPRV ;NON-SKIP MEANS WE'RE OK
MOVEI T2,4 ;RIGHT JUSTIFY THE INDEX, BECAUSE
POPJ P, ;OTHERWISE WE'RE AT FILE START
PRVBUF: MOVE T1,BLKN(D) ;GET CURRENT BLOCK #
SOJLE T1,%POPJ1 ;CAN'T GO BACKWARDS
MOVEM T1,BLKN(D) ;SAVE IT BACK
PUSHJ P,REDBLK ;READ THE BLOCK
MOVEI P2,(T1) ;RETURN THE WORD COUNT OF THE BUFFER
HRRZ P1,IPTR(D) ;GET THE WORD PNTR
MOVE T3,ICNT(D) ;AND THE COUNT
POPJ P,
REDBLK: LOAD T2,INDX(D) ;GET DEVICE INDEX
CAIE T2,DI.MTA ;MAGTAPE?
JRST DSKRED ;NO. DISK
PUSHJ P,CLRBCB ;COUNT ACTIVES
PUSH P,P4 ;Get a spare perm ac
MOVEI P4,1(T1) ;Must back over current one too
MTABLP: MOVEI T2,.TFBSB ;SETUP FOR BACKSPACE
PUSHJ P,DOMTOP ;DO IT
SOJG P4,MTABLP ;BACKSPACE FOR ALL ACTIVES
POP P,P4 ;Restore P4
JRST GOREAD ;GO READ THE BLOCK
DSKRED: PUSHJ P,USET ;POINT TO PREVIOUS BLOCK
PUSHJ P,CLRBCB ;CLEAR THE USE BITS
GOREAD: MOVSI T1,(BF.VBR) ;TURN ON VIRGIN BUFFER RING
IORM T1,IBCB(D) ;IN THE BUFFER HEADER
MOVE T2,CHAN(D) ;GET CHANNEL
HRRI T2,.FOINP ;SETUP FOR INPUT
HRRZ T3,IBCB(D) ;POINT TO CURRENT BUFFER
MOVE T1,[2,,T2] ;2-WORD FILOP
FILOP. T1,
$ECALL IOE,%ABORT ;Should not fail with EOF
MOVE T1,IBCB(D) ;GET BUFFER ADDR
HRRZ T1,1(T1) ;GET WORD COUNT
ADDM T1,IPTR(D) ;POINT TO END OF BUFFER
SETZM ICNT(D) ;AND CLEAR COUNT
POPJ P,
USET: MOVE T2,FBLK(D) ;GET FILOP WORD 0
HRRI T2,.FOUSI ;GET USETI CODE
MOVEI T3,(T1) ;GET THE BLOCK #
MOVE T1,[2,,T2] ;DO THE USETI
FILOP. T1,
$ECALL IOE,%ABORT
POPJ P,
;Routine to clear the "use" bits of all active buffers, and
; return how many there were in T1.
%CLRBC:
CLRBCB: SETZM ICNT(D) ;CLEAR BUFFER CONTROL BLOCK
HRLOI T1,7700 ;EXCEPT BYTE SIZE IN PNTR
ANDM T1,IPTR(D)
MOVE T2,CHAN(D) ;GET CHANNEL
HRRI T2,.FOWAT ;SETUP FOR WAIT
MOVE T1,[1,,T2] ;DO FILOP
FILOP. T1,
$ECALL IOE,%ABORT
SETZ T1, ;CLEAR ACTIVE BUFFER COUNT
HRRZ T3,IBCB(D) ;GET PNTR TO BUFFER
MOVEI T2,(T3) ;COPY IT
FNDUSE: MOVE T4,-1(T3) ;GET STATUS WORD
TLNE T4,40 ;TAPE EOF?
AOJA T1,USEDON ;YES. WE'RE DONE
MOVE T4,(T3) ;GET THE USE WORD
TLZE T4,(1B0) ;TURN OFF. WAS IT ON?
ADDI T1,1 ;YES. ADD TO ACTIVE COUNTER
MOVEM T4,(T3) ;PUT IT BACK
HRRZ T3,(T3) ;GET WHAT IT POINTS TO
CAIN T2,(T3) ;POINTING TO CURRENT BUFFER?
POPJ P, ;YES. WE'VE DONE IT
JRST FNDUSE ;AND TRY AGAIN
USEDON: HRLOI T4,377777 ;TURN OFF USE BIT JUST IN CASE
ANDM T4,(T3)
POPJ P,
;UNLOAD
MOPUNL: MOVEI T1,1 ;SET NEXT RECORD TO 1
MOVEM T1,NREC(U)
SETZM BLKN(D) ;CLEAR BLOCK #
MOVX T0,D%END ;File is now not at end
ANDCAM T0,FLAGS(D)
LOAD T1,DVTYP(D) ;GET DEVICE TYPE
CAIN T1,.TYDTA ;DECTAPE?
JRST DTAUNL ;YES
CAIN T1,.TYDSK ;DISK
JRST DSKUNL
CAIN T1,.TYMTA ;Or magtape
JRST MTAUNL
POPJ P, ;OTHERWISE IT'S A NOP
DSKUNL: SKIPN FBLK(D) ;IS FILE REALLY OPEN?
POPJ P, ;No, no-op.
PJRST CLSOPN ;Close file, leave OPEN for input.
MTAUNL: SKIPN FBLK(D) ;Is file really OPEN?
JRST ULDEVO ;No, just UNLOAD.
PUSHJ P,CLSOPN ;Close file, leav OPEN for input.
MOVEI T2,.TFUNL ;Setup for UNLOAD
JRST DOMTOP ;Go do it
DTAUNL: MOVE T1,FLAGS(D) ;Get DDB flags
TXNN T1,D%IN+D%OUT ;Is the DECTAPE open?
JRST ULDEVO ;Yes, don't use filename
PUSHJ P,%SETIN ;Open the dectape
MOVE T2,CHAN(D) ;LH= chann #
HRRI T2,.FOMTP ;MTAPE FILOP
MOVX T3,MTUNL. ;UNLOAD
MOVE T1,[2,,T2]
FILOP. T1,
$ECALL IOE,%ABORT
POPJ P,
;Here to UNLOAD a DECtape or magtape that is not opened yet.
; Can't use FILOP.'s because you need a filename for them.
ULDEVO: PUSHJ P,OPDEVO ;Open the device only
MOVE T1,ASCHN ;Get channel #
LSH T1,^D23 ;Shift to ac field
IOR T1,[MTUNL.] ;Make instruction
XCT T1 ;** UNLOAD the device **
PJRST CLDEVO ;Close device and return
;TOPS-10 BACKFILE
MOPBSF: LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIE T1,DI.MTA ;MAGTAPE?
POPJ P, ;OTHERWISE IT'S A NOP
MOVEI T1,1 ;SET NEXT RECORD TO 1
MOVEM T1,NREC(U)
SETZM BLKN(D) ;CLEAR BLOCK #
MOVE T0,FLAGS(D)
TXNE T0,D%END+D%OUT ;EOF OR DOING OUTPUT?
PUSHJ P,CLREOF ;YES. CLOSE/OPEN THE FILE
MOVE T0,FLAGS(D)
TXNE T0,D%IN+D%OUT ;Is file not open?
PJRST DOBKFU ;OPEN already, just do the UUO's and return.
;The MTA is not open.
PUSHJ P,OPDEVO ;OPEN the device
PUSHJ P,DOBKFU ;Do the BACKFILE UUO's.
PJRST CLDEVO ;Close device and return.
;Subroutine to do the UUO's necessary for BACKFILE.
;The device is OPEN.
DOBKFU: PUSHJ P,BACKF ;NOW BACKSPACE OVER 2 EOF MARKS
PUSHJ P,BACKF
MOVEI T2,.TFSTS ;GET STATUS OF TAPE UNIT
PUSHJ P,DOMTOP
TXNE T1,TF.BOT ;BEG TAPE?
POPJ P, ;YES. JUST LEAVE
MOVEI T2,.TFFSF ;NO. MUST FORWARD AGAIN
PJRST DOMTOP
;TOPS-10 ENDFILE
MOPEND: AOS NREC(D) ;INCR REC #
PUSHJ P,%SETOUT ;Get file opened for output
LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIE T1,DI.DSK ;DISK
CAIN T1,DI.MTA ;OR MTA
JRST .+2 ;YES
POPJ P, ;NO. END FILE IS NOP
PUSHJ P,CLSOPN ;CLOSE, THEN OPEN FOR INPUT
MOVX T0,D%END ;Set fake end if necessary
IORM T0,FLAGS(D)
AOS BLKN(D) ;SIMULATE READING THE EOF RECORD
POPJ P,
;TOPS-10 SKIP RECORD
MOPSKR: PUSHJ P,%SETIN ;Set file open for input
LOAD T1,MODE(D)
CAIN T1,MD.DMP ;DUMP MODE?
JRST SKRDMP ;YES. VERY SPECIAL
MOVE T0,FLAGS(D)
TXNE T0,D%UNF ;UNFORMATTED?
JRST UNFSKP ;YES. DO UNFORMATTED SKIP
JRST %IREC ;TO SKIP RECORD, JUST READ AND IGNORE
SKRDMP: AOS T3,BLKN(D) ;GET THE INCREMENTED BLOCK #
ADDI T3,1 ;WANT THE NEXT ONE
LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIE T1,DI.DSK ;DISK?
JRST %SKIPB ;NO. SKIP AN MTA BLOCK
MOVE T2,FBLK(D) ;GET FILOP WORD 0
HRRI T2,.FOUSO ;GET USETO CODE
MOVE T1,[2,,T2] ;DO THE USETI
FILOP. T1,
PUSHJ P,%CLSER ;JUST RETURN ON EOF
POPJ P,
;TOPS-10 SKIP FILE
MOPSKF: LOAD T1,INDX(D) ;GET DEVICE INDEX
CAIE T1,DI.MTA ;MAGTAPE?
POPJ P, ;NO. SKF IS NOP
MOVEI T1,1 ;SET NEXT RECORD TO 1
MOVEM T1,NREC(U)
SETZM BLKN(D) ;CLEAR BLOCK #
MOVE T0,FLAGS(D)
TXNN T0,D%OUT ;WERE WE DOING OUTPUT?
JRST SKFIN ;NO
PUSHJ P,%SETIN ;Yes. Close file, open again
JRST SKFCOM
;File not opened for output.
SKFIN: MOVE T1,FLAGS(D)
TXNE T1,D%IN ;Is file OPEN?
JRST SKFINN ;Yes
PUSHJ P,OPDEVO ;OPEN device
MOVEI T2,.TFFSF ;Skip a file
PUSHJ P,DOMTOP
PJRST CLDEVO ;Close again, and return.
SKFINN: PUSHJ P,CLREOF ;Clear EOF for input file
SKFCOM: MOVEI T2,.TFFSF ;SKIP A FILE
JRST DOMTOP
%SKIPB: MOVEI T2,.TFFSB ;SKIP A BLOCK
PJRST DOMTOP
%BACKB: MOVEI T2,.TFBSB ;BACKSPACE BLOCK
PJRST DOMTOP
BACKF: MOVEI T2,.TFBSF ;BACKSPACE FILE
;DOMTOP - DOES MAGTAPE OP, RETURNS FLAGS IN T1
DOMTOP: MOVE T3,DEV(D) ;GET DEVICE NAME
MOVE T1,[2,,T2] ;DO TAPOP
TAPOP. T1,
$ECALL UTE,%ABORT ;?Unexpected TAPOP error $O,<T1>
MOVEI T2,.TFWAT ;THEN A WAIT
MOVE T4,[2,,T2]
TAPOP. T4,
$ECALL UTE,%ABORT
POPJ P,
CHKEF: MOVE T1,DEV(D) ;GET THE DEVICE NAME
MOVEM T1,MTCBLK ;SETUP FOR MTCHR
MOVE T1,[MTCLEN,,MTCBLK]
MTCHR. T1, ;GET CHARACTERISTICS
; IOERR (UME,,,?,Unexpected MTCHR error $O,<T1>,%ABORT)
$ECALL UME,%ABORT
SKIPE MTCBLK+.MTREC ;ANY RECS AFTER LAST EOF?
AOS (P) ;YES. NOT AT EOF THEN. SKIP RETURN
POPJ P,
;Clear EOF by CLOSE'ing and re-OPENing the file.
;If it was opened for output, leave it that way.
; If it was opened for input, leave it that way.
CLREOF: MOVE T2,FBLK(D) ;GET THE CHANNEL STUFF
HRRI T2,.FOREL ;CLOSE THE FILE
MOVE T1,[1,,T2]
FILOP. T1,
PUSHJ P,%CLSER
MOVSI T1,(FO.PRV+FO.ASC)
HLLM T1,FBLK(D) ;AND NOW REOPEN IT
MOVX T5,D%IN ;Get flag to set
MOVE T0,FLAGS(D) ;Get current DDB flags
TXNE T0,D%OUT ;If file is now OPEN for output,
MOVX T5,D%OUT ;Leave it that way
TXZ T0,D%IN+D%OUT+D%END ;Clear current flags
MOVEM T0,FLAGS(D) ;Store new DDB flags
PUSH P,T5 ;Save flags
PUSHJ P,%ST10B ;Setup .FOBRH, .FONBF
POP P,T5 ;Restore flags to set on OPEN
PUSHJ P,%CALOF ;Try re-opening the file
JRST %ABORT ;?Failed
POPJ P, ;Worked, return
SEGMENT DATA
BSRCNT: BLOCK 1 ;# WORDS FOR BACKSPACE
DMPLST: BLOCK MAXARG+1 ;DUMP I/O LIST
BLOCK 1 ;THE ZERO WORD (JUST IN CASE)
MTCLEN==20
MTCBLK: BLOCK MTCLEN
SEGMENT CODE
;Routine to CLOSE and then re-OPEN a file for input.
;This will have the effect of clearing the EOF status if set.
CLSOPN: MOVE T1,FLAGS(D) ;GET FLAGS
TXNE T1,D%OUT ;FILE OPEN FOR OUTPUT?
PUSHJ P,%LSTBF ;YES. OUTPUT LAST BUFFER IF MTA
MOVE T2,FBLK(D) ;GET CHANNEL STUFF
HRRI T2,.FOCLS ;CLOSE THE FILE
MOVE T1,[1,,T2]
FILOP. T1,
PUSHJ P,%CLSER
MOVE T2,FBLK(D)
HRRI T2,.FOREL ;RELEASE THE CHANNEL
MOVE T1,[1,,T2]
FILOP. T1,
PUSHJ P,%CLSER
MOVE T1,[FO.PRV+FO.ASC+.FORED] ;OPEN IT FOR INPUT
MOVEM T1,FBLK(D)
SETZM LKPB+.RBALC(D) ;PREVENT TRUNCATION
MOVX T0,D%END+D%IO+D%OUT
ANDCAM T0,FLAGS(D) ;Clear flags
MOVX T5,D%IN ;Set this flag if OPEN works
PUSHJ P,%ST10B ;Setup .FOBRH, .FONBF
MOVX T5,D%IN ;Get flag again
PUSHJ P,%CALOF ;Try re-opening the file
JRST %ABORT ;Failed
POPJ P, ;Done, return
> ;IF10
SUBTTL FIND
;FIND STATEMENT
;
;POSITIONS A RANDOM-ACCESS DISK FILE SO THAT SUBSEQUENT I/O WILL TAKE LESS TIME
;IF SUFFICIENT COMPUTATION INTERVENES BETWEEN THE FIND AND THE I/O.
;
;10: IF THE UNIT IS IDLE, NOT TRANSFERRING DATA FOR THIS JOB OR ANY
; OTHER JOB, POSITIONS THE ACCESS ARMS TO THE CORRECT CYLINDER
;
;20: CAN'T BE DONE
;
;THIS STATEMENT IS ALMOST ENTIRELY WORTHLESS.
SIXBIT /FIND./
FIND%: PUSHJ P,%SAVE ;SAVE USER'S ACS
PUSHJ P,FMTCNV ;CONVERT OLD-STYLE ARG LIST
XMOVEI T1,[ASCIZ /FIND/] ;SET STATEMENT NAME FOR ERROR MESSAGES
MOVEM T1,%IONAM
SETZ P1, ;No special flags to set
PUSHJ P,STIO ;Get args, set D%RAN in P1 (hopefully)
PUSHJ P,%SETD ;SET D AND U, DO IMPLICIT OPEN IF NECESSARY
PUSHJ P,%SETIN ;Get file opened for input
MOVE T1,@A.REC ;GET RECORD NUMBER
MOVEM T1,NREC(U) ;STORE IN DDB FOR ASSOCIATE VARIABLE
IF10,<
MOVE T3,RSIZE(D) ;GET RECORD SIZE
MOVE T0,FLAGS(D)
TXNE T0,D%UNF ;FORMATTED FILE?
JRST FNDUNF ;UNFORMATTED, SLIGHTLY DIFFERENT
ADDI T3,2+4 ;ADD 2 BYTES FOR CRLF, 4 TO ROUND UP TO WORD
IDIVI T3,5 ;GET RECORD SIZE, WORDS
JRST FIND1 ;GO DO THE SEEK
;DDB flags are in T0.
FNDUNF: TXNE T0,D%BIN ;BINARY?
ADDI T3,2 ;YES, ADD 2 LSCWS
FIND1: LSH T3,-7 ;CONVERT TO BLOCK NUMBER
ADDI T3,1
HLLZ T2,CHAN(D) ;GET CHANNEL NUMBER
HRRI T2,.FOSEK ;SET SEEK FUNCTION
MOVE T1,[2,,T2] ;POINT TO FILOP BLOCK
FILOP. T1, ;DO THE "SEEK" FILOP
$ECALL IOE,%ABORT
>;END IF10
PJRST %SETAV ;GO SET ASSOCIATE VARIABLE AND RETURN
SUBTTL IOLST
SIXBIT /IOLST./
IOLST%: SKIPN %UDBAD ;DO WE HAVE A UDB?
JRST [POP P,1 ;No. Error or EOF occured, get AC1
POPJ P,] ; and go back to user pgm.
PUSHJ P,%ISAVE ;SAVE ACS
MOVE U,%UDBAD ;RESTORE DDB ADDRESS
MOVE D,DDBAD(U)
IOLP: MOVE T1,(L) ;GET NEXT I/O LIST ENTRY
SKIPN T2,@%LTYPE ;Anything there?
POPJ P, ;END OF LIST, RETURN TO USER PROGRAM
LDB T2,[POINTR T2,ARGKWD] ;GET TYPE OF ENTRY
CAILE T2,6 ;IN RANGE?
SETZ T2, ;NO, ILLEGAL
PUSHJ P,@[
IFIW ILL
IFIW DATA
IFIW SLIST
IFIW ELIST
IFIW FIN
IFIW SLST77
IFIW ELST77 ](T2) ;Process it
JRST IOLP ;CONTINUE UNTIL END OF LIST
ILL: ADDI L,1 ;INCREMENT PAST ARG
TDNN T1,[377777777777] ;ONLY LEGAL ARG IS ALL 0
JRST ILLOK ;AN OK BAD ARGUMENT...
EXCH P,OTHERP ;STUPID COROUTINE NEEDS THE RIGHT STACK!
$ECALL IOL,%ABORT ;BAD I/O LIST
ILLOK: ADJSP P,-1 ;DISCARD RETURN ADDRESS
POPJ P, ;RETURN FROM IOLST%
DATA: LDB T2,[POINTR @%LTYPE,ARGTYP] ;GET DATATYPE
MOVEI T3,1 ;1 ENTRY
MOVE T0,FLAGS(D)
TXNE T0,D%UNF ;BUT IF UNFORMATTED
MOVE T3,%SIZTB(T2) ;SET "ARRAY" LENGTH TO DATUM SIZE
SETZ T4, ;CLEAR INCREMENT
AOJA L,%DOIO ;GO PROCESS SINGLE DATUM
;EXPLICIT FIN CALL
FIN%: SKIPN %UDBAD ;ANY UDB PNTR?
JRST [POP P,1 ;No. Restore AC1
POPJ P,] ; & return (Must have gotten END or ERR).
PUSHJ P,%FSAVE ;SAVE ACS
MOVE U,%UDBAD
MOVE D,DDBAD(U)
JRST FIN1
FIN: ADJSP P,-1 ;FIN CONSTITUTES END OF LIST, SO DISCARD
; RETURN ADDRESS
FIN1: SETZB T1,T3 ;FLAG END OF I/O LIST
SETZ T2, ;ALSO CLEAR DATA TYPE REG
PJRST %DOIO ;GO FINISH UP FORMAT PROCESSING
SLST77: SETOM SWTCH7 ;SET 77 SWITCH
JRST SLCOM ;JOIN COMMON CODE
SLIST: SETZM SWTCH7 ;CLEAR 77 SWITCH
SLCOM: STKVAR <CNT,INC,OFFS,SAVEL> ;ALLOCATE LOCAL VARIABLES
MOVE T3,@%LTYPE ;Get arg type bits
TXNE T3,ARGTYP ;IMMEDIATE MODE (TYPE=0)?
JRST SLNIM ;NO. GO GET VALUE
HRRZI T1,(T1) ;CHOP EXTRANEOUS BITS OFF
JRST SLCOM2
SLNIM: HRRE T1,(T1) ;GET COUNT
SLCOM2: JUMPG T1,SLNZ ;POSITIVE COUNT OK
SKIPN SWTCH7 ;77 PROGRAM?
MOVEI T1,1 ;NO. 1-TRIP DO COUNT
SLNZ: MOVEM T1,CNT ;STORE COUNT
ADDI L,1 ;Point to increment
MOVE T1,(L) ;Get value
MOVE T3,@%LTYPE ;Get arg type bits
TXNE T3,ARGTYP ;IMMEDIATE MODE?
MOVE T1,(T1) ;NO, GET VALUE
HRREM T1,INC ;STORE INCREMENT
HRRE T4,T1 ;SAVE FOR RETURN
SUBI L,1 ;Point back to SLIST base.
MOVE T0,FLAGS(D)
TXNN T0,D%UNF ;UNFORMATTED?
JRST NOTUNF ;NO
TRNE T1,-2 ;YES, IS INCREMENT +1?
JRST SLP0 ;NO, DO ONE-BY-ONE ALGORITHM
NOTUNF: PUSH P,L
ADDI L,3 ;Word after array address
MOVE T3,@%LTYPE ;Get KWD and TYPE bits
POP P,L
MOVE T1,3(L) ;GET WORD AFTER ARRAY ADDRESS
TXNN T3,ARGKWD ;IS IT ANOTHER ARRAY?
JUMPN T1,SLP0 ;YES, MUST DO ONE-BY-ONE THING
MOVE T1,2(L) ;SINGLE ARRAY WITH INC +1, GET ADDRESS
PUSH P,L
ADDI L,2
LDB T2,[POINTR @%LTYPE,ARGTYP] ;AND DATATYPE
POP P,L
MOVE T5,%SIZTB(T2) ;GET THE ELEMENT SIZE
MOVE T3,CNT ;AND NUMBER OF ELEMENTS
MOVE T0,FLAGS(D)
TXNE T0,D%UNF ;UNFORMATTED I/O
ASH T3,-1(T5) ;YES. TURN ELEMENTS INTO WORD COUNT
ASH T4,-1(T5) ;GET INCR IN WORDS
UNSTK ;DISCARD STACK VARIABLES
ADDI L,3 ;SKIP OVER SLIST
PJRST %DOIO ;GO DO WHOLE ARRAY
SLP0: SETZM OFFS ;INITIALIZE OFFSET
XMOVEI L,2(L) ;POINT TO FIRST ARRAY ADDRESS
MOVEM L,SAVEL ;SAVE FOR LOOP THROUGH ALL ARRAYS
SLP1: MOVE L,SAVEL ;RESET L TO START OF SLIST
SLP: MOVE T1,(L) ;GET AN ARRAY BASE ADDRESS
MOVE T3,@%LTYPE
TXNE T3,ARGKWD ;IS IT AN ARRAY ADDRESS?
JRST SLPE ;NO, END OF LOOP
JUMPE T1,SLPE ;ZERO IS END OF LIST, NOT VALID ADDRESS
LDB T2,[POINTR @%LTYPE,ARGTYP] ;GET DATA TYPE OF ARRAY
MOVE T3,OFFS ;GET OFFSET INTO ARRAY
IMUL T3,%SIZTB(T2) ;TURN ELEMENTS INTO WORDS
ADDI T1,(T3) ;ADD OFFSET TO BASE ADDRESS
MOVEI T3,1 ;SET # ELEMENTS TO 1
MOVE T0,FLAGS(D)
TXNE T0,D%UNF ;UNFORMATTED I/O
MOVE T3,%SIZTB(T2) ;YES. SET TO LENGTH
PUSHJ P,%DOIO ;I/O THE ARRAY ELEMENT
AOJA L,SLP ;BUMP TO NEXT ARRAY ADDRESS, CONTINUE
SLPE: MOVE T1,INC ;GET INCREMENT
ADDM T1,OFFS ;BUMP OFFSET
SOSLE CNT ;DECREMENT COUNT
JRST SLP1 ;NOT YET ZERO, CONTINUE I/O
UNSTK ;GET RID OF LOCAL STORAGE
POPJ P, ;END OF SLIST
ELST77: SETOM SWTCH7 ;SET 77 SWITCH
JRST ELCOM ;JOIN COMMON CODE
ELIST: SETZM SWTCH7 ;CLEAR 77 SWITCH
ELCOM: STKVAR <CNT,INC,OFFS,SAVEL> ;ALLOCATE LOCAL VARIABLES
MOVE T3,@%LTYPE
TXNE T3,ARGTYP ;IMMEDIATE MODE?
JRST ELNIM ;NO. GO GET VALUE
HRRZI T1,(T1) ;TOSS OTHER BITS
JRST ELCOM2
ELNIM: HRRE T1,(T1) ;GET VALUE
ELCOM2: JUMPG T1,ELNZ ;POSITIVE COUNT
SKIPN SWTCH7 ;77 PROGRAM?
MOVEI T1,1 ;NO. 1-TRIP DO COUNT
ELNZ: MOVEM T1,CNT ;STORE COUNT
SETZ T4, ;CLEAR INCR WORD FOR FORMATTED I/O
SETZM OFFS ;CLEAR OFFSET
XMOVEI L,1(L) ;POINT TO FIRST INCREMENT/ADDRESS PAIR
MOVEM L,SAVEL ;SAVE FOR LOOP
ELP1: MOVE L,SAVEL ;RESET L
ELP: MOVE T1,(L) ;GET AN INCREMENT
MOVE T3,@%LTYPE ;Get arg type bits
TXNE T3,ARGKWD ;CHECK FOR 0 KEYWORD FIELD
JRST ELPE ;NONZERO KEYWORD, END OF LOOP
JUMPE T1,ELPE ;ZERO IS END OF LIST
TXNE T3,ARGTYP ;IMMEDIATE MODE CONSTANT?
MOVE T1,(T1) ;NO, GET VALUE
IMUL T1,OFFS ;GET OFFSET INTO ARRAY
PUSH P,L
ADDI L,1
LDB T2,[POINTR @%LTYPE,ARGTYP] ;GET ARG TYPE
POP P,L
IMUL T1,%SIZTB(T2) ;MULTIPLY OFFSET BY ELEMENT SIZE
ADD T1,1(L) ;ADD BASE ADDRESS TO OFFSET
MOVEI T3,1 ;1 ENTRY
MOVE T0,FLAGS(D)
TXNE T0,D%UNF ;BUT IF UNFORMATTED
MOVE T3,%SIZTB(T2) ;SET ARRAY LENGTH
PUSHJ P,%DOIO ;I/O THE ELEMENT
ADDI L,2 ;BUMP TO NEXT INCREMENT/ADDRESS PAIR, CONTINUE
JRST ELP
ELPE: AOS OFFS ;INCREMENT OFFSET
SOSLE CNT ;DECREMENT COUNT
JRST ELP1 ;IF NOT YET ZERO, CONTINUE
UNSTK
POPJ P, ;END OF ELIST
;COROUTINE TO GET THE NEXT ITEM IN THE I/O LIST
;ARGS: NONE
;RETURN: T1 = ADDRESS
; T2 = DATATYPE
; T3 = LENGTH, WORDS
;REQUIRES L UNCHANGED SINCE LAST CALL
%GTIOX: PUSHJ P,%SAVE4 ;SAVE P1-P4
%GETIO: EXCH P,OTHERP
POPJ P,
;COROUTINE TO PROCESS THE NEXT ITEM IN THE I/O LIST
;ARG: T1 = (30-BIT) ADDRESS
; T2 = DATATYPE
; T3 = LENGTH, WORDS
%DOIO: EXCH P,OTHERP
POPJ P,
;ROUTINE TO INITIALIZE COROUTINES
;ARG: T1 = INPUT ROUTINE,,OUTPUT ROUTINE
%SIO: MOVEM P,OTHERP ;SAVE STACK PNTR
MOVE P,[IOWD LIOPDL,IOPDL]
SETZM IO.ADR## ;CLEAR SPECIAL CROCK FLAG
MOVE T0,FLAGS(D)
TXZ T0,D%EOI ;AND OTHER SPECIAL CROCK FLAG
TXNN T0,D%IO ;OUTPUT?
HLRZ T1,T1 ;NO, GET INPUT ROUTINE ADDRESS
MOVEM T0,FLAGS(D) ;Store (possibly updated) DDB flags
TLZ T1,-1 ;Make sure this is a local address
PUSHJ P,(T1) ;DO I/O
EXCH P,OTHERP
PJRST %FIO ;GO FINISH UP I/O
SEGMENT DATA
GETADR: BLOCK 1
DOADR: BLOCK 1
%UDBAD: BLOCK 1 ;DDB ADDRESS "STACK"
SWTCH7: BLOCK 1 ;THE ANSI-77 SWITCH
OTHERP: BLOCK 1 ;OTHER STACK
LIOPDL==100
IOPDL: BLOCK LIOPDL
SEGMENT CODE
SUBTTL OVNUM
;ROUTINE TO FIND LINK NUMBER GIVEN AN ADDRESS
;ARGS: T1 = ADDR
;RETURN: T1 = LINK NUMBER,,ADDR
; Unless extended addressing: Then, T1 will not be changed.
;ASSUMPTIONS:
;THE CONTROL SECTION IS THE LAST THING IN EACH LINK.
;LINKS ARE DISJOINT AND ARE STRUNG TOGETHER IN INCREASING ORDER OF ADDRESS.
;CODE AND DATA ARE LOADED CONTIGUOUSLY WITHIN A LINK, SEPARATE FROM OTHER
;LINKS.
;CONTROL SECTION OFFSETS (FROM OVRLAY.MAC)
CS.NUM==2 ;LINK NUMBER
CS.FPT==4 ;FORWARD POINTER TO NEXT CONTROL SECTION
%OVNUM: SKIPN T2,.JBOVL ;GET ROOT LINK CONTROL SECTION ADDRESS
POPJ P, ;NONE, LINK NUMBER IS 0
;Note: At this point, we can assume that FOROTS is running in section 0
; because LINK is not supposed to allow overlays in extended sections.
; Thus the address in T1 is only 18 bits.
OVLP: HRL T1,CS.NUM(T2) ;PC IS IN THIS LINK OR SOME FOLLOWING ONE
CAIE T2,0 ;IF NO FOLLOWING LINK, DONE
CAIL T2,(T1) ;DOES LINK START BEFOE SEARCH ADDRESS?
POPJ P, ;YES, LINK NUMBER IS IN T1, DONE
HRRZ T2,CS.FPT(T2) ;GET POINTER TO FOLLOWING LINK
JRST OVLP ;SEARCH ON
PURGE $SEG$
END