Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_1_19910112
-
7/monitor/io.mac
There are 60 other files named io.mac in the archive. Click here to see a list.
; UPD ID= 8527, RIP:<7.MONITOR>IO.MAC.4, 9-Feb-88 16:15:13 by GSCOTT
;TCO 7.1218 - Update copyright date.
; UPD ID= 60, RIP:<7.MONITOR>IO.MAC.3, 4-Aug-87 14:23:22 by RASPUZZI
;TCO 7.1032 - Fix problem in edit 7391. It was changing a MONX02 error
;to a IOX5 error.
; *** Edit 7391 to IO.MAC by JROSSELL on 14-Nov-86, for SPR #21291
; Return the correct error (IOX7) when a SOUTR% fails due to insufficient JSB
; free space.
; *** Edit 7321 to IO.MAC by WONG on 17-Jun-86, for SPR #20898 (TCO none)
; Rewrite .SFPTR JSYS to include LSN in its calculation of the byte count if
; bit SF%LSN is on.
; *** Edit 7319 to IO.MAC by PRATT on 11-Jun-86
; Comment out edit 7317 (possibly only temporarily). The fix is fine, but
; fixing the bug could potentially cause serious problems with user programs
; depending on the bug.
; *** Edit 7317 to IO.MAC by PRATT on 11-Jun-86, for SPR #87
; Don't output a null byte if user specified positive number in AC 3 to SOUT.
; Edit 7133 to IO.MAC by LOMARTIRE on 15-Aug-85, for SPR #17490 (TCO 6-1-1523)
; Prevent DIRDNL and ULKSTZ BUGCHKs at GETFPD
; UPD ID= 2084, SNARK:<6.1.MONITOR>IO.MAC.27, 3-Jun-85 14:44:01 by MCCOLLUM
;TCO 6.1.1406 - Update copyright notice.
; UPD ID= 1996, SNARK:<6.1.MONITOR>IO.MAC.26, 21-May-85 16:51:05 by MCCOLLUM
;More of TCO 6.2194 - Add for ERJMPRs in .ESOUT
; UPD ID= 1900, SNARK:<6.1.MONITOR>IO.MAC.25, 4-May-85 16:08:40 by MCCOLLUM
;TCO 6.1.1238 - Fix more BUG. documentation
; UPD ID= 1825, SNARK:<6.1.MONITOR>IO.MAC.24, 25-Apr-85 16:30:18 by MCCOLLUM
;TCO 6.1.1238 - Fix BUG. documentation
; UPD ID= 4906, SNARK:<6.MONITOR>IO.MAC.23, 10-Oct-84 04:48:41 by TBOYLE
;TCO 6.2240 (QAR 706228) Teach APPNUL to check for 7-bit OWGBPs.
; UPD ID= 4810, SNARK:<6.MONITOR>IO.MAC.22, 17-Sep-84 10:01:30 by PURRETTA
;Update copyright notice
; UPD ID= 4745, SNARK:<6.MONITOR>IO.MAC.19, 24-Aug-84 11:18:16 by HAUDEL
;TCO 6.2194 - Add ERJMPRs in the .ESOUT code after the DOBE and RFPOS.
; UPD ID= 2639, SNARK:<6.MONITOR>IO.MAC.18, 27-Jun-83 16:19:07 by CHALL
;TCO 6.1673 CHKJFN- Handle signal JFN specially
; UPD ID= 1841, SNARK:<6.MONITOR>IO.MAC.17, 20-Feb-83 22:17:23 by MURPHY
;TCO 6.1514 - Use ITERX instead of JRST ITRAP.
; UPD ID= 1822, SNARK:<6.MONITOR>IO.MAC.16, 18-Feb-83 09:03:03 by MCINTEE
;TYPO IN BYTBLT ONE WORD GLOBAL LOGIC
; UPD ID= 1599, SNARK:<6.MONITOR>IO.MAC.15, 29-Dec-82 13:33:06 by DONAHUE
;TCO 6.1414 - Set a flag in TRPDSP when leaving BYTBLT
; UPD ID= 1595, SNARK:<6.MONITOR>IO.MAC.14, 29-Dec-82 10:36:45 by DONAHUE
;TCO 6.1173 - Add ERJMP after IDPB in SIN
; UPD ID= 1450, SNARK:<6.MONITOR>IO.MAC.13, 16-Nov-82 15:25:17 by PAETZOLD
;TCO 6.1378 - Convert universal TTY designators to the .TTDES form in CHKJFN
; UPD ID= 1376, SNARK:<6.MONITOR>IO.MAC.12, 25-Oct-82 11:55:26 by DONAHUE
;TCO 6.1318 - Prevent ILMNRF near SINW with ERJMP
; UPD ID= 1320, SNARK:<6.MONITOR>IO.MAC.11, 10-Oct-82 14:35:43 by PAETZOLD
;More TCO 6.1226 - Use index registers in FILNO references
; UPD ID= 1294, SNARK:<6.MONITOR>IO.MAC.10, 7-Oct-82 14:13:22 by MCINTEE
;TCO 6.1030 - MAKE BYTINB GLOBAL SO OTHER DEVICE ROUTINES CAN USE IT
; UPD ID= 1177, SNARK:<6.MONITOR>IO.MAC.9, 14-Sep-82 11:07:02 by MCINTEE
;More TCO 6.1226 - set SINRF before calling BYTINS in SIN1
; UPD ID= 1152, SNARK:<6.MONITOR>IO.MAC.8, 7-Sep-82 13:17:03 by MCINTEE
;More TCO 6.1226 - no skipping at end of IFSKP. clauses
; UPD ID= 1084, SNARK:<6.MONITOR>IO.MAC.7, 16-Aug-82 08:33:07 by GRANT
;TCO 6.1226 - add tests for new asynchronous output flag FILNO
; UPD ID= 858, SNARK:<6.MONITOR>IO.MAC.6, 7-Jun-82 09:38:51 by MURPHY
;TCO 6.1147 - Move bugdefs from BUGS.MAC to here and put them in-line.
; UPD ID= 783, SNARK:<6.MONITOR>IO.MAC.5, 25-May-82 12:32:45 by MCINTEE
;Fix up BYTBLT
; UPD ID= 759, SNARK:<6.MONITOR>IO.MAC.4, 18-May-82 14:18:16 by MCINTEE
;More TCO 6.1030 - The DAP% jsys needs 8 bit byte string packing &
; unpacking (XFER8 & XFER36). Also add OWGBP intelligence to BYTBLT.
; and a jacket routine for BYTBLT that preserves Q1 & Q2.
; and make BBLTxx global symbols
; UPD ID= 272, SNARK:<6.MONITOR>IO.MAC.3, 5-Jan-82 09:03:20 by GRANT
;TCO 5.1649 - Add NSP null message checking
;<6.MONITOR>IO.MAC.2, 16-Oct-81 18:01:57, EDIT BY MURPHY
;TCO 6.1030 - Node names in filespecs; etc.
;Revise DTB format; get rid of double skips on NLUKD, etc.
; UPD ID= 176, SNARK:<5.MONITOR>IO.MAC.11, 15-Sep-81 11:51:51 by MOSER
;TCO 5.1511 MOVE CODE FROM 5.1499 TO IO FROM DEVICE.
; UPD ID= 140, SNARK:<5.MONITOR>IO.MAC.10, 2-Sep-81 16:56:39 by MOSER
;TCO 5.1485 - Reference byte before going NOINT for a SIN/SINR.
; UPD ID= 125, SNARK:<5.MONITOR>IO.MAC.9, 27-Aug-81 20:15:25 by PAETZOLD
;Change TCO 5.1008X to 5.1471
; UPD ID= 114, SNARK:<5.MONITOR>IO.MAC.8, 22-Aug-81 16:09:27 by PAETZOLD
;TCO 5.1008X - Fix CHKJFN and BYTBLT for OWGBP's
; UPD ID= 92, SNARK:<5.MONITOR>IO.MAC.7, 6-Aug-81 13:58:46 by SCHMITT
;More of TCO 5.1300 - do an ILDB on pointer to avoid NonExist Ref.
; UPD ID= 1893, SNARK:<5.MONITOR>IO.MAC.6, 27-Apr-81 17:16:03 by SCHMITT
;TCO 5.1300 - Attempt to load byte before going NOINT
; UPD ID= 1524, SNARK:<5.MONITOR>IO.MAC.5, 6-Feb-81 12:46:56 by ZIMA
;TCO 5.1258 - remove historical code.
; UPD ID= 708, SNARK:<5.MONITOR>IO.MAC.4, 26-Jun-80 15:48:07 by ZIMA
;TCO 5.1084 - HAVE MEMORY TO MEMORY SIN CHECK FOR AC3 ZERO PROPERLY
; UPD ID= 655, SNARK:<5.MONITOR>IO.MAC.3, 16-Jun-80 17:00:17 by OSMAN
;tco 5.1050 - Make jfn on TTY: use fork's controlling terminal
; UPD ID= 437, SNARK:<5.MONITOR>IO.MAC.2, 13-Apr-80 15:13:30 by OSMAN
; UPD ID= 429, SNARK:<4.1.MONITOR>IO.MAC.277, 13-Apr-80 14:35:01 by OSMAN
;Reference FRKTTY instead of FKCTYP
; UPD ID= 19, SNARK:<4.1.MONITOR>IO.MAC.276, 27-Nov-79 13:25:03 by SCHMITT
;TCO 4.1.1030 - SET PASLSN IF FILE LENGTH IS LESS THAN FIVE BYTES
;<4.1.MONITOR>IO.MAC.275, 6-Nov-79 10:08:25, EDIT BY DBELL
;TCO 4.2564 - CHANGE MJFN TO RJFN AT CHKJFT
;<4.MONITOR>IO.MAC.274, 24-Oct-79 12:50:58, EDIT BY MURPHY
;UNLDIS - ITRAP IF WAIT ROUTINE ADDRESS IS 0
;<4.MONITOR>IO.MAC.273, 24-Oct-79 12:22:03, EDIT BY MURPHY
;TRPDSP IN BYTBLT
;<4.MONITOR>IO.MAC.271, 5-Oct-79 16:02:03, EDIT BY MILLER
;TCO 4.2511. DON'T DIDDLE PC IN UNLDIS FOR OVER QUOTA ERROR
;<4.MONITOR>IO.MAC.270, 4-Oct-79 14:13:44, EDIT BY OSMAN
;more 4.2256 - Don't put spurious crlf's when reading from tape to memory
;<4.MONITOR>IO.MAC.269, 19-Sep-79 09:30:36, EDIT BY OSMAN
;more 4.2256 - Prevent nulls in files copied from tape to disk
;<OSMAN.MON>IO.MAC.1, 10-Sep-79 15:35:00, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>IO.MAC.267, 20-Aug-79 13:39:44, EDIT BY DBELL
;CHECK ACRLFF FLAG BEFORE INDEXING BY JFN IN BYTINX
;<4.MONITOR>IO.MAC.266, 27-Jul-79 15:48:17, EDIT BY ENGEL
;RETURN VALID JFN (MULITPLIED BY MLJFN) FOR ALL DESX3'S
;<4.MONITOR>IO.MAC.265, 27-Jul-79 13:48:57, EDIT BY HALL
;FIX BYTBLT TO HANDLE INDEXED BYTE POINTERS
;<4.MONITOR>IO.MAC.264, 25-Jul-79 15:12:48, EDIT BY R.ACE
;TCO 4.2345 - FIX BYTBLT WITH INDEXED BYTE POINTER
;<4.MONITOR>IO.MAC.263, 24-Jul-79 08:26:45, EDIT BY OSMAN
;MORE 4.2256 - If count used up, don't attempt crlf sequence
;<4.MONITOR>IO.MAC.262, 30-Jun-79 20:24:41, EDIT BY DBELL
;TCO 4.2318 - HAVE CHKJFN USE FORK'S CONTROLLING TERMINAL FOR 777777
;<4.MONITOR>IO.MAC.261, 19-Jun-79 08:43:51, EDIT BY MILLER
;<4.MONITOR>IO.MAC.260, 19-Jun-79 08:38:56, EDIT BY MILLER
;MAKE SIN1 MORE EFFICIENT
;<4.MONITOR>IO.MAC.259, 17-Jun-79 11:40:29, EDIT BY MILLER
;MORE DIDDLES FOR ADDING CR-LF
;<4.MONITOR>IO.MAC.258, 16-Jun-79 14:24:54, EDIT BY MILLER
;MORE FIXES FOR CR-LF CODE. MAYBE IT WILL WORK NOW
;RANDOM AND SCATTERED FIXES FOR NEW CR-LF CODE
;In BYTBLT, use DCRNXT, DLFNXT instead of CRNXT, LFNXT
;<4.MONITOR>IO.MAC.257, 12-Jun-79 18:18:31, EDIT BY MILLER
;RANDOM FIXES FOR HANDLING 0 AND 1 BYTE RECORDS
;<4.MONITOR>IO.MAC.256, 6-Jun-79 09:22:22, EDIT BY OSMAN
;tco 4.2256 - give crlf's at end-of-record for appropriate tapes
;<4.MONITOR>IO.MAC.255, 28-Mar-79 12:40:25, Edit by LCAMPBELL
; Better error code from CHKJFN when large (but potentially legal) JFN given
;<4.MONITOR>IO.MAC.254, 4-Mar-79 17:29:14, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>IO.MAC.253, 2-Feb-79 13:41:42, EDIT BY MILLER
;FIXES TO RECORD PROCESSING
;<4.MONITOR>IO.MAC.252, 20-Jan-79 14:42:45, EDIT BY MILLER
;ADD RECF CODE SO CAN RETURN A NULL RECORD
;<4.MONITOR>IO.MAC.251, 9-Jan-79 11:40:59, EDIT BY MILLER
;IF CALL TO RECOUT FAILS, DO FILABT INSTEAD OF JRST EMRET0
;<4.MONITOR>IO.MAC.250, 6-Jan-79 13:03:55, EDIT BY MILLER
;CHECK FOR EOFF AT DUMPIW
;<4.MONITOR>IO.MAC.249, 10-Dec-78 15:10:27, EDIT BY MILLER
;<4.MONITOR>IO.MAC.248, 8-Dec-78 17:25:21, EDIT BY MILLER
;ADD HLDF TEST TO UNLDIS. REMOVE SPECIAL TESTS FOR FE AND CDR
;<4.MONITOR>IO.MAC.247, 8-Dec-78 16:58:37, EDIT BY MILLER
;CHECK FOR CDBBLK AT UNLDSN AND HOLD PROCESS IN BALSET IF SO
;<4.MONITOR>IO.MAC.246, 13-Nov-78 11:22:36, EDIT BY MILLER
;PASS BLOCK PARAMETERS TO "RECORD OUT" ROUTINE
;<2MCLEAN>IO.MAC.245, 10-Oct-78 23:58:34, Edit by MCLEAN
;<2MCLEAN>IO.MAC.244, 3-Oct-78 00:13:14, Edit by MCLEAN
;<4.MONITOR>IO.MAC.244, 4-Oct-78 16:37:08, EDIT BY GILBERT
;More TCO 4.2008 - fix an editing error.
;<4.MONITOR>IO.MAC.243, 2-Oct-78 23:03:21, Edit by MCLEAN
;REMOVE CALL TO APPNUL FROM SOUTB (YOU CAN'T GET THERE WITH JFN
;BEING A STRING POINTER) ALSO OTHER SPEEDUPS.
;<4.MONITOR>IO.MAC.242, 14-Sep-78 20:55:48, EDIT BY GILBERT
;TCO 4.2008 - Make ESOUT JSYS skip CRLF if already at beginning of line.
;<4.MONITOR>IO.MAC.241, 10-Aug-78 01:12:12, Edit by MCLEAN
;FIX CO-ROUTINES TO CHECK FOR CHANGE IN JFN
;<4.MONITOR>IO.MAC.240, 10-Aug-78 01:11:47, Edit by MCLEAN
;<4.MONITOR>IO.MAC.239, 21-Jul-78 11:24:24, EDIT BY MILLER
;FIX TYPEO IN UNLDIS
;<4.MONITOR>IO.MAC.238, 21-Jul-78 08:49:22, EDIT BY MILLER
;REPLACE PSOUT IN ESOUT WITH IMCALL
;<4.MONITOR>IO.MAC.237, 20-Jul-78 14:31:20, EDIT BY MILLER
;FIX ESOUT TO DO PSOUT INTEAD OF JUMPING INTO JSYS
;<4.MONITOR>IO.MAC.236, 7-Jul-78 09:19:41, EDIT BY MILLER
;ADD SOME COMMENTS TO DMOCHK
;<4.MONITOR>IO.MAC.235, 7-Jul-78 09:15:48, EDIT BY MILLER
;USE ULKSTR TO UNLOCK STRUCTURES
;<4.MONITOR>IO.MAC.234, 29-Jun-78 11:25:21, EDIT BY MILLER
;MAKE SURE STRDMO IS NOINT WHEN IT HAS STRLOK LOCKED
;<4.MONITOR>IO.MAC.233, 22-Jun-78 14:41:46, EDIT BY MILLER
;REMOVE NOSKEDS THAT PROTECTED SDBS. USE "LOCK STRLOK"
;<4.MONITOR>IO.MAC.232, 3-Jun-78 20:24:36, Edit by JBORCHEK
;REMOVE DMPBUF TO STG
;<4.MONITOR>IO.MAC.231, 9-Mar-78 08:54:31, EDIT BY MILLER
;DON'T BACK UP PC ON QUOTA EXCEEDED IF ALREADY DONE
;<4.MONITOR>IO.MAC.230, 8-Mar-78 16:39:41, EDIT BY MILLER
;JUMP TO EMRET0 AT UNLDS1 IF ERRF SET
;<4.MONITOR>IO.MAC.229, 2-Mar-78 12:47:36, EDIT BY MILLER
;FIX NEW SINR CODE NOT TO CLOBBER A
;<3A.MONITOR>IO.MAC.4, 2-Mar-78 09:27:43, EDIT BY MILLER
;MORE FIXES FOR SINR RUNNING OUT
;<4.MONITOR>IO.MAC.227, 2-Mar-78 08:13:13, EDIT BY MILLER
;SINR CODE MUST INSURE ALL OF RECORD IS IN BEFORE ABORTING
;<4.MONITOR>IO.MAC.226, 27-Feb-78 17:15:50, EDIT BY MILLER
;REMOVE CODE FROM UNLDIS THAT CHECKS FOR JSYS. DIDN'T WORK
;<4.MONITOR>IO.MAC.225, 27-Feb-78 14:26:26, Edit by BORCHEK
;fix dumpo doing goto words wrong at dumpo4+2
;<4.MONITOR>IO.MAC.224, 18-Feb-78 16:04:38, EDIT BY MILLER
;MORE FIXES. DON'T DIDDLE PC IF PREVIOUS-CONTEXT IS MONITOR
;<4.MONITOR>IO.MAC.223, 18-Feb-78 15:39:59, EDIT BY MILLER
;FIX UNLDIS TO NOT BACK UP PC ON QUOTA ERROR IF ALREADY BACKED-UP
;<4.MONITOR>IO.MAC.222, 31-Jan-78 12:29:38, Edit by HALL
;ADDED ATSMOV
;<4.MONITOR>IO.MAC.221, 28-Jan-78 23:24:19, Edit by PORCHER
;Fix bugs in CREADF
;<4.MONITOR>IO.MAC.220, 28-Jan-78 14:46:17, EDIT BY PORCHER
;Combine TRVAR and STKVAR in SINR
;<4.MONITOR>IO.MAC.219, 27-Jan-78 09:54:58, EDIT BY PORCHER
;Add routines SREADF and CREADF for Execute-Only
;Also change CHKJFN to restrict access to single process
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
SEARCH PROLOG
TTITLE IO
SWAPCD
;SPECIAL AC DEFINITIONS USED HEREIN
DEFAC (STS,P1) ;SEE GTJFN FOR FUNCTIONS
DEFAC (JFN,P2)
DEFAC (DEV,P4)
;BYTBLT COMMUNICATION REGISTER FLAGS:
MSKSTR(XFR2TM,D,1B0) ;TRANSFER STRING TO TERMINATOR (TURNED OFF
; WHEN TERMINATOR READ)
MSKSTR(XFRTRM,D,1B1) ;TRANSFER TERMINATOR
MSKSTR(STRSRC,D,1B2) ;SOURCE BYTE POINTER IS A STRING
;---------
MSKSTR(FLINPT,D,1B3) ;ON WHEN DOING SIN FROM FILE
MSKSTR(BBDONE,D,1B4) ;SET WHEN BYTBLT IS DONE TO EXIT SIN/SOUT LOOPS
MSKSTR(XFRLSN,D,1B5) ;SET FOR BYTBLT TO COPY LINE NUMBERS
;---------
MSKSTR(DISCRD,D,1B6) ;SET BY BYTBLT TO HAVE CALLER DISCARD THE
; TAB AFTER A LINE NUMBER.
MSKSTR(FEEDME,D,1B7) ;SET BY BYTBLT WHEN SOURCE STRING RUNS OUT WHILE
; WHILE SCANNING LINE NUMBERS OR NULLS
;---------
;NOTE: KEEP THESE TOGETHER. SEE REFS TO CRSTUF AND DCRSTF
MSKSTR(DCRNXT,D,1B8) ;TELL BYTBLT TO DELIVER A CARRIAGE RETURN NEXT
MSKSTR(DLFNXT,D,1B9) ;LINEFEED NEXT
MSKSTR(DFRSTF,D,1B10) ;THIS RECORD HAS BEEN FROSTED ALREADY
MSKSTR(DCRSTF,D,DCRNXT!DLFNXT!DFRSTF) ;COMPOSITE CR STUFF FIELD
BBLTMM==:0 ;DATA DIRECTIONS - BYTBLT MON TO MON
BBLTMU==:1 ;MONITOR TO USER
BBLTUM==:2 ;USER TO MONITOR
BBLTUU==:3 ;USER TO USER
DEFINE FILINT(N,EXTRA)<
CALL [EXTRA
MOVEI A,N
JRST DOINT]>
DEFINE FILABT(N,EXTRA)<
JRST [ EXTRA
MOVEI A,N
JRST ABTDO]>
DOINT: MOVEM JFN,ERRSAV
MOVEM A,LSTERR
TQNE <HLTF>
JRST ABTDO ;Halt on these conditions
MOVE T1,MPP ;GET BASE LEVEL PUSH DOWN LIST
MOVE T2,-1(T1) ;GET PC
MOVE T1,(T1) ;GET ADR OF JSYS+1(FLAGS)
CALL CHKERT ;IS THERE AN ERJMP OR ERCAL AFTER JSYS?
SKIPA T1,BITS+.ICDAE ;NO, GO DO INTERRUPT
RET ;YES, DONT CAUSE INTERRUPT
CALL IICSLF ;INTERRUPT THIS FORK
RET
ABTDO: MOVEM A,LSTERR
CALL UNLCKF
ITERR()
RESCD
SK3RET::AOS (P)
SK2RET::AOS (P)
AOS (P)
CPOPJ:: RET
SKPUNL:: AOS -1(P)
UNL:: CALL UNLCKF
JRST MRETN
SWAPCD
;CHECK STATUS OF JFN OR OTHER DESIGNATOR
; T1/ DESIGNATOR
; CALL CHKJFA
; RETURN +1 FAILURE, BAD DESIGNATOR. T1/ ERROR CODE
; RETURN +2 SUCCESS,
; T1/ DESIGNATOR TYPE CODE
; 0 (JF%FIL) - A REGULAR JFN
; 1 (JF%TTY) - A TTY DESIGNATOR
; 2 (JF%BYP) - A BYTE POINTER OR NULL
; T2/ THE CURRENT FILE STATUS
; T3/ UNIT NUMBER,,DEVICE DISPATCH TABLE ADDRESS
; T4/ JFN INDEX
;THIS IS MERELY A JACKET ROUTINE FOR CHKJFN WHICH FOLLOWS
;THE STANDARD SUBROUTINE CONVENTIONS.
; ***N.B.*** THIS DOES NOT LEAVE THE JFN LOCKED NOR GO NOINT.
;CODES
JF%FIL==:0 ;FILE
JF%TTY==:1 ;TTY DESIGNATOR
JF%BYP==:2 ;BYTE POINTER
CHKJFA::SAVEP
MOVE JFN,T1 ;SETUP THE JFN
CALL CHKJFN ;DO THE WORK
RETBAD () ;BAD DESIGNATOR
JRST [ MOVX T1,JF%TTY ;A TTY
JRST CHKJA1]
JRST [ MOVX T1,JF%BYP ;A BYTE POINTER
JRST CHKJA1]
CALL UNLCKF ;REGULAR JFN, UNLOCK IT
MOVX T1,JF%FIL ;REGULAR JFN
CHKJA1: MOVE T2,STS ;RETURN STATUS
MOVE T3,DEV ;AND DEVICE
MOVE T4,JFN ;AND INDEX
RETSKP
; Check tenex source/destination designator
; Call: JFN ;The designator
; CALL CHKJFN
; Return
; +1 ;Error, A has error #
; +2 ;Tty
; +3 ;Byte pointer OR NULL
; +4 ;File - REAL JFN
; In all cases, the following is set up
; LH(DEV) ;Unit number
; RH(DEV) ;Loc of device dispatch table
; P3 ;RH OF DEV
; JFN ;True jfn for files, byte pointer for same
; STS ;File status bits
; DOES NOT CLOBBER B AND C
; The file is locked if it is a file
; If previous context section (PCS) is zero OWGBPs will not be allowed
; as designators. Non-skip return will result.
;
; If PCS is non-zero then OWGBPs will be allowed. The UDX form of TTY
; designator will not be allowed from a non-zero PCS. The .TTDES form
; of TTY designator is allowed from non-zero PCS
CHKJFD::TDZA D,D ;REMEMBER TO SKIP DISMOUNTED CHECK
CHKJFN::SETO D, ;CHECK FOR DISMOUNTED STRUCTURE
MOVE T1,JFN ;COPY JFN SO JRST CHKJFN WINS FOR .SIGIO
CAIN T1,.PRIIN ;PRIMARY INPUT?
HLRZ T1,PRIMRY ;YES. GET INPUT JFN
CAIN T1,.PRIOU ;PRIMARY OUTPUT?
HRRZ T1,PRIMRY ;YES. GET OUTPUT JFN
CAIN T1,.SIGIO ;SIGNAL JFN?
JRST CHKJFX ;YES, HANDLE IT
MOVE JFN,T1 ;UPDATE JFN IN CASE OR PRIMARY IO
SKIPLE JFN ;IS THIS A REAL JFN
CAML JFN,MAXJFN ;...
JRST CHKJFS ;NO, GO CHECK FOR OTHER LEGAL JFN FORMS
IMULI JFN,MLJFN ;GET INDEX NTO JFN TABLES
NOINT
AOSE FILLCK(JFN) ;LOCK THE JFN LOCK
JRST [ OKINT ;FAILED
JRST CHKJ3A] ;GO WAIT FOR THE LOCK TO FREE UP
MOVE STS,FILSTS(JFN) ;SET UP THE REQUIRED ACS
TQNE <FRKF> ;NO ACCESS BY OTHER FORKS?
JRST CHKJ2B ;YES, GO CHECK IF ACCESS IS LEGAL
MOVE DEV,FILDEV(JFN) ;SET UP DEV
HRRZ P3,DEV ;AND P3
CAIE P3,DSKDTB ;IS THIS A DISK?
JRST CHKJ2A ;NO, GO CHECK OTHER SPECIAL CASES
LOCK STRLOK ;PREVENT DISMOUNTING
LOAD A,FLUC,(JFN) ;GET STR UNIQUE CODE
LOAD P5,STR,(JFN) ;GET STR NUMBER
SKIPN P5,STRTAB(P5) ;GET THE SDB ADDRESS
JRST [ UNLOCK STRLOK ;DISMOUNTED
SETZB F,P5
JUMPE D,SK3RET ;IF DONT CARE, EXIT OK
JRST CHKJDM] ;OTHERWISE, GO RETURN FAILURE
LOAD CX,STRUC,(P5) ;GET UNIQUE CODE FOR THIS STR
CAME A,CX ;DO THEY MATCH?
JRST [ UNLOCK STRLOK ;NO
SETZB F,P5
JUMPE D,SK3RET ;IF DONT CARE, EXIT OK
JRST CHKJDM] ;OTHERWISE, GO RETURN FAILURE
INCR STRLK,(P5) ;LOCK THE STR LOCK
NOINT ;LEAVE THIS PROCESS NOINTED
UNLOCK STRLOK ;ALLOW DISMOUNTS NOW
SETZB F,P5
JRST SK3RET ;ALL DONE
CHKJFS: SETZB F,P5
TLNE JFN,777777 ;Lh zero?
JRST CHKJF1 ;No, some kind of byte pointer
CAIN JFN,777777 ;Controlling tty
JRST CHKJF4 ;Yes
CAIN JFN,377777 ;Nil designator
JRST CHKJFW ;Yes.
CHKJFT: CAIGE JFN,400000+NLINES ;Valid tty designator?
CAIGE JFN,400000
JRST [ JUMPLE JFN,CHKJF7 ;REJECT NONPOSITIVE VALUES
IMULI JFN,MLJFN ;CONVERT TO REAL JFN
CAIL JFN,RJFN ;COULD THIS EVER BE A JFN?
JRST CHKJF7 ;no, give invalid s/d designator return
MOVEI A,DESX3 ;yes, give JFN not assigned return
RET] ; ..
PUSH P,C ;CAN'T CLOBBER C
PUSH P,B ; OR B
MOVEI B,-.TTDES(JFN) ;B/ LINE NUMBER
CALL GTCJOB ;GET CONTROLLING JOB
JRST [ POP P,B ;NONE. RESTORE B
POP P,C ; AND C
JRST CHKJF5] ;OK TO USE
POP P,B ;RESTORE B
CAIE C,-1 ;ASSIGNED TO ANY JOB?
CAMN C,JOBNO ;YES. assigned to this job?
JRST [ POP P,C ;OK TO USE
JRST CHKJF5]
POP P,C
MOVE A,CAPENB
TRNE A,SC%WHL!SC%OPR
JRST CHKJF5
MOVEI A,-400000(JFN)
CALL PTCHKA ;TEST FOR PTY OWNER
JUMPN A,CHKJF5 ;TRUE = OK BECAUSE CONTROLLED BY PTY
MOVEI A,DESX2 ;Illegal tty designator
RET
CHKJF5: MOVEI DEV,TTYDTB ;SET DEVICE TO BE TTY
HRLI DEV,-400000(JFN) ;AND SPECIFIED UNIT
JRST CHKJT1
CHKJF4: HRRZ A,FORKN ;GET OUR JOB FORK NUMBER
LOAD JFN,FRKTTY,(A) ;GET FORK'S CONTROLLING TERMINAL
CAIE JFN,-1 ;ONE SPECIFIED?
JRST CHKJFT ;YES, GO CHECK IT
MOVE A,JOBNO ;NO, THEN USE JOB'S CONTROLLING TERMINAL
HLLZ DEV,JOBPT(A) ;GET IT
HRRI DEV,TTYDTB ;SET DEVICE TO BE TTY
CHKJT1: MOVX STS,READF!WRTF!OPNF!PASLSN
HRRZ P3,DEV
RETSKP ;Skip return
CHKJFW: MOVEI DEV,NILDTB
HRRZ P3,DEV
MOVX STS,READF!WRTF!OPNF!PASLSN
JRST SK2RET
CHKJFX: PUSH P,T2 ;SAVE OLD T2
CALL FKTMI ;TELL SUPERIOR FORK
MOVX T1,FRZB1% ;SET INTERRUPT STATUS TO FROZEN
MOVE T2,FORKX
IORM T1,FKINT(T2)
SETZM PIOLDS ;CLEAR OLD STATE
HRROI T1,FRZWT ;SET UP SCHED TEST
MDISMS ;WAIT UNTIL SUPERIOR CONTINUES
POP P,T2
JRST CHKJFN ;GO TRY AGAIN WHEN CONTINUED
;CHKJF3: JUMPE JFN,CHKJFB ;0 NEVER EXISTS
; IMULI JFN,MLJFN
CHKJ3A: MOVEI A,^D60 ;Try 60 times to lock file
CHKJF2: SOJL A,CHKJFB ;Then fail
NOINT
AOSE FILLCK(JFN)
JRST [ OKINT
PUSH P,A
MOVEI A,^D1000
DISMS
POP P,A
JRST CHKJF2]
CHKJ2A: MOVE STS,FILSTS(JFN)
TQNN <NAMEF>
JRST CHKJF8
TQNN <FRKF> ;Test for file restricted to one fork
JRST CHKJF9
CHKJ2B: HLRZ A,FILVER(JFN)
REPEAT 0,< ;Restricted-access now means just the current process
PUSH P,D ;SAVE ENTRY FLAG
CALL SKIIF ;OWNER INFERIOR TO THIS FORK?
JRST CHKJF8 ;NO, ACCESS ILLEGAL
POP P,D ;RESTORE ENTRY FLAG
> ;End of REPEAT 0
CAME A,FORKN ;This owning process?
JRST CHKJF8 ;No, access illegal
CHKJF9: MOVE DEV,FILDEV(JFN) ;Set up dev
HRRZ P3,DEV
SETZB F,P5
CAIN P3,TTYDTB ;IS THIS A TERMINAL?
JRST [ HLRZ A,FILDDN(JFN) ;YES, GET ADDRESS OF DEVICE NAME BLOCK
MOVE A,1(A) ;GET NAME
TRZ A,377 ;FLUSH POSSIBLE GARBAGE
CAME A,[ASCIZ /TTY/] ;IS DEVICE "TTY"?
JRST .+1 ;NO, SO DEV IS CORRECT ALREADY
MOVE A,FORKN ;YES, GET FORK NUMBER
LOAD A,FRKTTY,(A) ;GET POSSIBLE FORK'S CONTROLLING TERMINAL
HRLI DEV,-.TTDES(A) ;SET UP UNIT NUMBER
CAIN A,-1 ;IS THERE REALLY A FORK CONTROLLING TERMINAL?
HRL DEV,CTRLTT ;NO, SO USE JOB'S CONTROLLING TERMINAL
JRST .+1]
CAIE P3,PTYDTB
CAIN P3,TTYDTB
JRST [ SETOM FILLCK(JFN)
OKINT
JRST .+1]
MOVEI A,0(JFN) ;GET THE JFN
PUSH P,D ;SAVE ENTRY FLAG
CALL STRDMO ;CHECK IF DISMOUNTED AND BUMP LOCK
JRST [ POP P,D ;GET BACK ENTRY CODE
JUMPE D,SK3RET ;IF DONT CARE ABOUT DISMOUNTED STRS, EXIT
JRST CHKJDM] ;OTHERWISE, GIVE FAILURE RETURN
POP P,(P) ;CLEAN UP THE STACK
JRST SK3RET ;Triple skip return
CHKJDM: UNLOCK FILLCK(JFN) ;CLEAN UP
OKINT
RETBAD (DESX10) ;AND GIVE DISMOUNTED ERROR RETURN
CHKJF8: UNLOCK FILLCK(JFN)
OKINT
CHKJFB: MOVEI A,DESX3
RET
CHKJF1: JUMPGE JFN,CHKJF6
HLRZ A,JFN ;GET LEFT HALF
CALL SPCSNZ ;DID JSYS COME FROM A NON-ZERO SECTION?
CAIE A,600000+.DVTTY ;NO...CHECK THIS FORM OF TTY DESIGNATOR?
JRST CHKJF0 ;FROM A NONZERO SECTION OR NOT A TTY UDX
PUSH P,JFN ;YES, GAVE TTY DEVICE DESIGNATOR
MOVEI JFN,400000(JFN) ;CREATE TERMINAL DESIGNATOR
CALL CHKJFT ;CHECK THIS TERMINAL
JRST CHKBTY ;BAD TERMINAL
JRST CHKGTY ;GOOD TERMINAL
CAIA ;BYTE POINTER ISN'T A TERMINAL
JFCL ;NEITHER IS A REAL JFN
CHKBTY: POP P,JFN ;RESTORE ORIGINAL BAD DESIGNATOR
RET ;ASSUME ERROR CODE IN A
CHKGTY: ADJSP P,-1 ;DISCARD THE UDX FORM OF DESIGNATOR
HRRZ P3,DEV
RETSKP
CHKJF0: CAML JFN,[777777,,0]
HRLI JFN,440700 ;Insert if lh = 777777
MOVX A,<770000,,0> ;ASSUME NON-ZERO PCS
CALL SPCSNZ ;NON-ZERO PCS?
MOVX A,<444500,,0> ;NO...ZERO PCS...OWGBPS ILLEGAL
CAMGE JFN,A ;BYTE POINTER IN RANGE
JRST CHKJF6 ;YES
CHKJF7: MOVEI A,DESX1 ;Garbage designator
RET
CHKJF6: MOVEI DEV,STRDTB ;Set up to dispatch to string routines
HRRZ P3,DEV
MOVX STS,READF!WRTF!OPNF!PASLSN
JRST SK2RET ;Double skip return
;CHECK DSK JFN - ACCEPTS ONLY JFN FOR DEVICE DSK
; JFN/ A DESIGNATOR
; CALL DSKJFN
; RETURN +1: FAILURE, ERROR CODE IN A
; RETURN +2: SUCCESS, REGISTERS SETUP AS FOR CHKJFN
DSKJFN::CALL CHKFIL ;CHECK FOR A FILE JFN
RETBAD () ;WASN'T
TQNE <ASTF> ;RULE OUT STARS
JRST [ MOVEI A,DESX7
CALLRET UNLCKF]
HRRZ B,DEV
CAIN B,DSKDTB ;DISK?
RETSKP ;YES
MOVEI A,DESX8 ;NO
CALLRET UNLCKF
;CHECK FILE JFN - REJECTS TTY OR BYTE DESIGNATORS
; JFN/ A DESIGNATOR
; CALL CHKFIL
; RETURN +1: FAILURE, ERROR CODE IN A
; RETURN +2: SUCCESS, REGISTERS SETUP AS FOR CHKJFN
CHKFIL::CALL CHKJFN
RETBAD() ;BAD DESIGNATOR
JFCL
RETBAD(DESX4) ;ILLEGAL DESIGNATOR
RETSKP
;ROUTINE TO GET PROTECTION AND DIR # OF A FILE (CALLED BY CHKAC)
;ACCEPTS IN T1/ JFN
;RETURNS +1: ERROR
; +2: T1/ DIR #
; T2/ PROT
GETFPD::SAVEPQ ;SAVE ALL PERMENANT ACS
MOVE JFN,T1 ;SET UP FOR CHKJFN
CALL DSKJFN ;MAKE SURE IT IS A DSK JFN
RETBAD ;IT ISNT
CALL GETFDB ;MAP IN FDB
RETBAD (,<CALL UNLCKF>);[7133] Error, unlock JFN and return
HRRZ T2,.FBPRT(T1) ;GET PROTECTION
LOAD T1,FLUC,(JFN) ;GET STR #
HRLZS T1
HRR T1,FILDDN(JFN) ;AND DIR #
ULKDIR ;UNLOCK DIR FROM GETFDB CALL
CALL UNLCKF ;UNLOCK THE JFN
RETSKP ;AND RETURN
; Unlock file
; Call: JFN ;Job file number
; STS ;New filsts
; CALL UNLCKF
;PRESERVES A IN CASE ERROR CODE THEREIN
UNLCKF::TLNE JFN,777777
UMOVEM JFN,1
SKIPLE JFN
CAIL JFN,RJFN
RET
PUSH P,A
MOVEI A,(DEV)
CAIE A,DSKDTB ;DISK JFN?
JRST UNLKF1 ;NO
MOVEM STS,FILSTS(JFN) ;YES, STORE STS
LOAD A,STR,(JFN) ;GET THE STR NUMBER
PUSH P,B ;SAVE AN AC
SKIPN B,STRTAB(A) ;IS THIS STR STILL THERE?
JRST UNLKF2 ;NO
LOAD B,STRUC,(B) ;GET THE UNIQUE CODE OF THE STR
LOAD CX,FLUC,(JFN) ;GET UNIQUE CODE
CAME CX,B ;MATCH?
JRST UNLKF2 ;NO
CALL ULKSTR ;YES. UNLOCK THE STR LOCK
UNLKF2: SETOM FILLCK(JFN) ;UNLOCK THE JFN
POP P,B ;RESTORE ACS
POP P,A
OKINT
RET ;ALL DONE
UNLKF1: CAIE A,PTYDTB
CAIN A,TTYDTB
JRST [ POP P,A
CAMN DEV,FILDEV(JFN) ;IS THIS THE SAME JFN?
MOVEM STS,FILSTS(JFN) ;YES. SAVE UPDATED STATUS THEN
RET]
MOVEM STS,FILSTS(JFN) ;SAVE NEW FILE STATUS BITS
MOVEI A,0(JFN) ;GET JFN
CALL LUNLKF ;DO UNLOCK
POP P,A
OKINT
RET
NOTOPN: FILABT CLSX1
IOERR:: ITERR ()
;ROUTINE TO UNLOCK A FILE AND IF FILE IS ON A MOUNTABLE STRUCTURE
;TO DECREMENT THE LOCK COUNT IN THE SDB.
; ACCEPTS: 1/ JFN
LUNLKF::CALL LUNLK0 ;FREE UP FILE LOCK IN SDB
SETOM FILLCK(A) ;RELEASE LOCK
RET ;AND DONE
;ROUTINE TO RELEASE FILE LOCK FOR A JFN.
; 1/ THE JFN
LUNLK0::SAVET ;SAVE ALL REGISTERS
CALL DMOCHK ;CHECK IF MOUNTED
RET ;ITS NOT. GIVE IT UP
JUMPE B,R ;IF NOT MOUNTABLE, GIVE IT UP
LOAD A,STR,(A) ;IT IS. GET STR NUMBER
CALLRET ULKSTR ;UNLOCK STRUCTURE
;ROUTINES TO CHECK IF A STRUCTURE HAS BEEN DISMOUNTED
;STRDMO: CHECK IF A STRUCTURE IS STILL MOUNTED AND IF SO
;INCREMENTS THE LOCK COUNT IN THE SDB.
; ACCEPTS: 1/JFN
; RETURNS: +1 IF STRUCTURE HAS BEEN DISMOUNTED
; +2 IF STRUCTURE IS STILL MOUNTED. LOCK COUNT INCREMENTED
; OR IF NOT A MOUNTABLE STRUCTURE
STRDMO::SAVET ;SAVE ALL REGS
NOINT ;MAKE SURE CAN'T BE INTERRUPTED
LOCK STRLOK ;PREVENT DISMOUNTS
CALL DMOCHK ;CHECK STRUCTURE
RETBAD (DESX10,<UNLOCK STRLOK
OKINT>) ;DISMOUNTED
JUMPE B,STRDM1 ;IF NOT MOUNTABLE, JUST GO AWAY
INCR STRLK,(B) ;STILL MOUNTED. BUMP LOCK COUNT
NOINT ;MUST BE NOINT FOR EVERY LOCK HELD
STRDM1: UNLOCK STRLOK ;ALLOW DISMOUNTS NOW
OKINT ;NO LONGER HAVE THE LOCK
RETSKP ;AND RETURN
;ROUTINE TO CHECK IF A STRUCTURE IS STILL MOUNTED.
; ACCEPTS: 1/ JFN
; RETURNS: +1 IF STRUCTURE HAS BEEN DISMOUNTED
; +2 IF STRUCTURE STILL MOUNTED
; B= SDB INDEX
; OR B=0 IF A VALID JFN ON A NON-MOUNTABLE
; DEVICE
;PRESERVES A
DMOCHK::LOAD C,FLUC,(A) ;GET UNIQUE CODE
SETZ B, ;IN CASE NOT A MOUNTABLE STRUCTURE
JUMPE C,RSKP ;IF NO UNIQUE CODE, STILL MOUNTED
LOAD D,STR,(A) ;GET STRUCTURE NUMBER
SKIPN B,STRTAB(D) ;GET SDB POINTER
RET ;NONE ,STRUCTURE HAS BEEN DISMOUNTED
LOAD D,STRUC,(B) ;GET UNIQUE CODE
CAME D,C ;SAME?
RET ;NO. STRUCTURE HAS BEEN DISMOUNTED
RETSKP ;YES. STRUCTURE STILL MOUNTED
; Subroutines for Execute-Only
;
; SREADF - Set READ access and restrict access to this process
;
; Call:
; T1/ JFN
; CALL SREADF
;
; Returns:
; +1: Always
; T2/ Previous state of FRKF and READF in LH,
; process for FRKF in RH
; Clobbers T1
;
SREADF::
MOVX T2,READF!FRKF ;Get desired state of bits
HRR T2,FORKN ; and current process
; CALLRET CREADF ;Set up bits and process
;
;
; CREADF - Reset READ access and restricted access
; (Undo what SREADF did)
;
; Call:
; T1/ JFN
; T2/ Previous state of FRKF and READF in LH,
; process for FRKF in RH
;
; Returns:
; +1: Always
; Clobbers T1,T2
;
CREADF::
SAVEP ;Save all the P's
PUSH P,F ;Also save F
PUSH P,T2 ;Save argument
MOVE JFN,T1 ;Get JFN for CHKJFN
CALL CHKJFN ;Check out the JFN and lock it, etc.
JFCL ;Invalid JFN, just ignore it
JFCL ;Terminal
JRST [ ;Byte pointer
POP P,T2 ;Not a file-- just return calling argument
POP P,F ;Restore F
RET] ;And return from CREADF/SREADF
;Yes! we have a real file!
MOVE T2,STS ;Get current status
ANDX T2,<FRKF!READF> ;Clear all but restricted access and READ
HLR T2,FILVER(JFN) ;Get process (JRFN) for restricted access
EXCH T2,(P) ;Save current state on stack
; and get desired state from call
HRLM T2,FILVER(JFN) ;Set new process id
TQZ <FRKF,READF> ;Clear current state of FRKF and READF
HLLZ T2,T2 ;Get desired state of bits
TDO STS,T2 ;Set them in STS
POP P,T2 ;Restore previous state of bits and process
POP P,F ;Restore F
CALLRET UNLCKF ;Unlock JFN, restore P's, and return from SREADF/CREADF
; Bin from primary io file
; Call: 1 ;Character
; PBIN
.PBIN:: MCENT
MOVEI JFN,100
CALL BYTIN
JRST EMRET0 ;CHECK FOR ERJMP OR ERCAL AFTER JSYS
UMOVEM B,1
JRST MRETN
; Byte input jsys
; Call: 1 ;Tenex source designator
; BIN
; Return
; +1
; B ;A byte
.BIN:: MCENT
NOINT
JUMPLE 1,SLBIN
CAIE 1,.PRIIN ;PRIMARY INPUT?
CAIN 1,.PRIOU ;OR PRIMARY OUTPUT?
JRST SLBIN ;YES. DO THE IT THE SLOW WAY
CAML 1,MAXJFN ;POSSIBLY A JFN?
JRST SLBIN
IMULI A,MLJFN
TQZ <NSPNUL> ;NOT A NULL NSP MESSAGE
AOSE FILLCK(1)
JRST SLBIN0
CALL STRDMO ;VERIFY STRUCTURE
JRST SLBIN1 ;BEEN DISMOUNTED
MOVE STS,FILSTS(1)
TQNE <ACRLFF> ;ADDING CRLF'S?
JRST SLBIN1 ;YES, DO IT THE SLOW WAY, SINCE BYTIN KNOWS HOW.
TQC <OPNF,READF,FILINP>
TQCN <OPNF,READF,FILINP>
TQNE <ERRF,FRKF>
JRST SLBIN1
BIN1: SOSGE FILCNT(1)
JRST SLBIN2
AOS 2,FILBYN(1)
CAMLE 2,FILLEN(1)
JRST SLBIN3
ILDB 2,FILBYT(1)
TQNN <PASLSN> ;DOES USER WANT LINE NUMBERS?
JRST [ JUMPE 2,BIN1 ;DISCARD NULLS
HRRZ C,FILBYT(1);GET THE WORD WE'RE READING
MOVE C,0(C) ;DO INDIRECT
TXNE C,1B35 ;IS IT A LINE NUMBER?
JRST SLBIN4 ;YES, REDO READ VIA BYTIN
JRST .+1]
CALL LUNLKF ;FREE UP FILE
UMOVEM 2,2
JRST MRETN
SLBIN4: MOVX C,7B5 ;FIXUP BYTE POINTER WE WERE READING FROM
ADDM C,FILBYT(1) ; SO THAT BYTIN WORKS RIGHT
SLBIN3: SOS FILBYN(1)
SLBIN2: AOS FILCNT(1)
SLBIN1: CALL LUNLKF ;FREE UP FILE
SLBIN0: IDIVI 1,MLJFN
SLBIN: OKINT
MOVE JFN,1
CALL BYTIN ;Read the byte
JRST [ XCTU [SETZM 2] ;RETURN A ZERO IN 2
JRST EMRET0] ;GO GIVE NON-SKIP RETURN
XCTU [MOVEM B,2] ;Store in user's ac
JRST MRETN ;Restore user ac's and return
; Random input jsys
; Call: 1 ;Tenex source designator
; 3 ;Byte number
; RIN
; Returns
; +1
; 2 ;The byte
.RIN:: MCENT
TRVAR <SAVJFN>
RIN0: UMOVE JFN,1
MOVEM JFN,SAVJFN
CALL CHKJFN
JRST IOERR
JFCL
FILABT DESX4 ;Tty and byte designators are illegal
TQNN <OPNF> ;OPEN?
JRST NOTOPN ;NO
TQNN <RNDF>
FILABT IOX3 ;Illegal to change pointer
TQNN <READF>
FILABT IOX1 ;Illegal to read
CALL @JFNID(P3) ;INIT JFN FOR INPUT
UMOVE A,3
CALL SFBNR ;Set up byte pointer
JRST ABTDO
CALL BYTINA ;Get the byte
JRST RINW ;DEVICE SERVICE ROUTINE IS BLOCKING
UMOVEM B,2
CALL UNLCKF ;UNLOCK THE JFN
JRST MRETN
RINW: JUMPN A,[CALL UNLCKF ;IF ERROR, UNLOCK THE JFN
XCTU [SETZM 2] ; LEAVE BYTE AS 0
JRST EMRET0] ; AND GIVE ERROR RETURN
MOVE A,B ;GET MDISMS WORD
CALL UNLDIS ;UNLOCK THE JFN AND MDISMS
JRST RIN0 ;GO TRY AGAIN
; String input jsys'S
; Call: 1 ;Tenex source designator
; 2 ;Byte pointer (lh = 777777 will be filled in)
; 3 ;Byte count or zero
; ;If zero, the a zero byte terminates
; ;If positive then transfer the specified number
; ;Of characters, or terminate on reading a byte
; ;Equal to that given in 4
; ;If negative, then transfer the specified number
; ;Of bytes
; 4 ;(optional) if 3 is > 0, 4 has a terminating byte
; SIN (OR SINR FOR RECORD MODE)
; Return
; +1 ;Always
; 2 ;Updated string pointer
; 3 ;Updated count (always counts toward zero)
; The updated string pointer always points to the last byte read
; Unless 3 contained zero, then it points to the last non-zero byte.
.SINR:: MCENT
SETO Q2, ;MARK THAT A SINR WAS DONE
JRST SINR1 ;ENTER COMMON CODE
.SIN:: MCENT ;Become slow etc.
SETZ Q2, ;MARK THAT A SIN WAS DONE
SINR1: TRVAR <SAVJFN,SINRF,SINZF>
SETZM SINZF ;ASSUME USER AC3 ZERO
XCTU [SKIPE 3] ;BUT TEST IT
SETOM SINZF ;USER AC3 IS NONZERO
MOVEM Q2,SINRF ;SAVE SIN/SINR FLAG
MOVSI C,440700
TLC 2,-1 ;SEE IF LH = -1
TLCN 2,-1
XCTU [HLLM C,2] ;YES, TURN IT INTO ASCII POINTER
SIN0: UMOVE T3,2 ;GET USERS POINTER
XCTBU [ILDB T3,T3] ;ATTEMPT TO GET A BYTE
UMOVE JFN,1
MOVEM JFN,SAVJFN
CALL CHKJFN ;CHECK THE JFN AND LOCK UP
JRST IOERR ;GIVE THE APPROPRIATE RETURN
JRST SINTTY ;TTY
JRST [ CAIE DEV,STRDTB
JRST SINTTY ;NOT BYTE PTR, DO BYTE AT A TIME
JRST SINBYT] ;BYTE POINTER
TQNE <OPNF> ;OPENED?
TQNN <READF>
FILABT(IOX1) ;ILLEGAL READ
CALL @JFNID(P3) ;INIT JFN FOR INPUT
TQZE <NSPNUL> ;WAS THERE A NULL NSP MESSAGE?
SKIPL SINRF ;YES, WAS THIS A SINR?
JRST SIN00E ;NO
CALL UNLCKF ;YES, SINR AND NULL NSP - UNLOCK THE FILE
JRST MRETN ;GOOD RETURN
SIN00E: MOVE B,FILLEN(JFN) ;GET TOTAL FILE LENGTH
SUB B,FILBYN(JFN) ;COMPUTE BYTES LEFT IN FILE
CAMGE B,FILCNT(JFN) ;THIS BUFFER PASSES EOF?
MOVEM B,FILCNT(JFN) ;YES, REDUCE BUFFER COUNT SO EOF WILL BE SEEN
SKIPG FILCNT(JFN) ;ANY BYTES IN BUFFER?
JRST SIN1 ;NO, DO IT THE SLOW WAY
SIN00: SKIPLE SINRF ;ABORTING A SINR?
JRST [ CALL UNLCKF ;YES. UNLOCK FILE
SETZM A ;GET A ZERO
EXCH A,FILCNT(JFN) ;GET REMAINING COUNT.
ADDB A,FILBYN(JFN) ;NEW FILE POSITION
JRST SIN01] ;AND PROCEED
CALL SIORX ;TRANSFER SOME DATA
MOVE A,FILBYN(JFN) ;SEE WHERE WE'RE UP TO IN THE FILE
CAML A,FILLEN(JFN) ;IF WE'RE AT END OF RECORD,
TQNN <ACRLFF> ;AND WE'RE SUPPOSED TO AUGMENT WITH CRLF'S
CAIA ;(WE'RE NOT)
JRST [ SKIPN SINRF ;SINR?
TQNN <FROSTF> ;DON'T START FROSTING IF ALREADY FROSTED
TQNE <LFNXT> ;AND WE'RE NOT IN THE MIDDLE OF A CRLF,
JRST .+1 ;IN MIDDLE OF FROSTING OR ALREADY FROSTED
TQO <CRNXT> ;THEN TELL BYTBLT TO PUT IN CRLF SEQUENCE NOW.
TQNN <BBDONE> ;SIORX WILL MISINTERPRET A 0 IN AC3!
CALL SIORX ;SO THE CRLF FOLLOWS THE RECORD
JRST .+1]
CALL UNLCKF ;UNLOCK FILE TO ALLOW INTS
SIN03: SKIPE SINRF ;DOING A SINR JSYS?
JRST [ MOVE A,FILBYN(JFN)
CAML A,FILLEN(JFN) ;ANY BYTES LEFT?
JRST MRETN ;NO, GIVE OK RETURN
TQNN <BBDONE> ;DONE?
JRST SIN0 ;NO, GO DO SOME MORE
ADD A,FILCNT(JFN) ;PICK UP REST OF BYTES IN BUFFER
MOVEM A,FILBYN(JFN) ;NEW FILE POSITION
SETZM FILCNT(JFN)
MOVEI B,1 ;REMEMBER DOING SINR ABORT
MOVEM B,SINRF
JRST SIN01] ;AND PROCEED
TQNN <BBDONE> ;IS BYTBLT FINISHED?
JRST SIN0 ;NO, JUST KEEP GOING
JUMPN Q1,MRETN ;IF NON-ZERO COUNT SUPPLIED, NO 0.
JRST SIN2 ;PUT THE ZERO ON THE END.
;ROUTINE CALLED FROM ABOVE TO TRANSFER SOME DATA.
SIORX: MOVE A,FILBYT(JFN) ;SOURCE POINTER
MOVX D,FLINPT!BBLTMU ;FROM FILE, COPY MONITOR TO USER
LOAD B,CRSTUF ;GET CARRIAGE RETURN STUFF
STOR B,DCRSTF ;COPY FOR BYTBLT
UMOVE B,2 ;TARGET
TQNE <PASLSN> ;COPYING LINE NUMBERS FROM FILE?
TQO <XFRLSN> ;YES, HAVE BYTBLT DO ALSO
CALL SIOR2 ;SET UP REST OF ARGS AND DO BYTBLT
UMOVEM B,2 ;UPDATE POINTERS
LOAD B,DCRSTF ;GET CARRIAGE RETURN STUFF
STOR B,CRSTUF ;STORE BACK INTO STATUS
MOVEM A,FILBYT(JFN)
RET
; DO SIN FROM BYTE POINTER
SINBYT: MOVE A,JFN
UMOVE B,2
MOVX D,STRSRC!XFRLSN!BBLTUU;STRING IN USER SPACE AND SHOULDN'T HAVE LINE #'S
CALL SIOR2
UMOVEM B,2
UMOVEM A,1
JRST SIN3
;GET HERE WHEN SINR RUNS OUT. CHECK FOR DONE
; A/ CURRENT FILE POSITION
SIN01: CAMGE A,FILLEN(JFN) ;AT EOR YET?
JRST SIN0 ;NO. KEEP TRYING
SIN02: FILINT (IOX10) ;YES. GIVE INT
MOVEI A,IOX10 ;GET ERROR CODE
JRST EMRET0 ;AND GIVE UP
;SIN WHICH MUST BE DONE BYTE-AT-A-TIME
SINTTY: CALL @JFNID(P3) ;INIT JFN FOR INPUT
SINTT1: CALL BYTINA ;Read a byte from the source
JRST SINW ;SERVICE ROUTINE WANTS TO BLOCK
JUMPE B,[TQNN <EOFF>
XCTU [SKIPN 3]
JRST SIN4
JRST .+1]
XCTBUU [IDPB B,2] ;DEPOSIT THE BYTE
CALL SIONXT ;Test for end of string
JRST SINTT1 ;Not end, continue
JRST UNL ;ALL DONE
SIN1: MOVE T1,SINRF ;get SINR flag
CALL BYTINS ;Read a byte from the source
JRST SINW ;SERVICE ROUTINE WANTS TO BLOCK
TQZE <RECF> ;EOR ENCOUNTERED?
JRST SIN00 ;yes. proceed.
SKIPLE SINRF ;DOING SINR ABORT?
JRST SIN00 ;YES. GO CHECK THEN
JUMPE B,[TQNN <EOFF>
XCTU [SKIPN 3]
JRST UNL
JRST .+1]
XCTBUU [IDPB B,2] ;DEPOSIT THE BYTE
ERJMP [FILINT (ILLX02) ;IF ERROR RETURN PROPER CODE
EMRETN (ILLX02,<CALL UNLCKF>)]
CALL SIONXT ;Test for end of string
JRST SIN00 ;NOT END
JRST UNL ;ALL DONE
SIN4: CALL UNLCKF ;UNLOCK THE LOCKS
JRST SIN2 ;GO ADD NULL TO END
SIN3: SKIPE SINZF ;NON-ZERO COUNT CASE?
MRETNG ;YES, RETURN
SIN2: SETZ B, ;GET A NULL TERMINATOR
UMOVE A,2 ;FETCH USER'S DESTINATION POINTER
XCTBU [IDPB B,A] ;DEPOSIT THE NULL
MRETNG ;RETURN FROM JSYS
SINW: JUMPN A,[CALL UNLCKF ;ERROR OCCURED
TQNN <EOFF> ;EOF SEEN?
JRST EMRET0 ;NO, BOMB OUT
SETZ B, ;APPEND A NULL
UMOVE C,2 ;GET BYTE POINTER
XCTBU [IDPB B,C] ;STORE THE NULL
ERJMP [ FILINT (ILLX02);SEE INTERRUPT
EMRETN (ILLX02)];RETURN ERROR
JRST EMRET0]
MOVE A,B ;GET DISMIS INFO
CALL UNLDIS ;UNLOCK LOCKS AND MDISMS
JRST SIN0 ;GO START OVER AGAIN
; Check for end of string io string
; Call: B ;Character just transfered
; User 3 ;Sin/sout argument
; User 4 ;Sin/sout argument
; CALL SIONXT
; Return
; +1 ;Continue
; +2 ;NO MORE LEFT TO DO
; Updates user 3
SIONXT::TLNE JFN,777777 ;If byte pointer,
UMOVEM JFN,1 ;Restore updated jfn
XCTU [SKIPN C,3]
RET
JUMPG C,SIO2 ;Positive
XCTU [AOSGE 3]
RET
RETSKP
SIO2: XCTU [SOSLE 3]
XCTU [CAMN B,4]
RETSKP
RET
; SUBROUTINE TO SET UP REST OF SIN/SOUT AND DO BYTBLT
SIOR2: UMOVE Q1,3 ;GET COUNT
MOVM C,Q1 ;MAGNITUDE OF COUNT
SKIPL Q1 ;TERMINATING BYTE?
TQO <XFR2TM> ;YES, SET FLAG
SKIPLE Q1 ;SPECIFIC TERMINATOR?
JRST [ UMOVE Q1,4 ;YES. GET (NOTE 0 IN Q1 IF COUNT=0)
TQO <XFRTRM> ;FLAG SPECIFIC TERMINATOR
JRST .+1]
SKIPN C ;NON-ZERO COUNT
HRLOI C,77 ;NO, SET MAX COUNT
TQNE <DCRNXT,DLFNXT> ;WANT TO ADD CR OR LF?
JRST [ TQO <XFRTRM> ;YES, USE EXACT COUNT
JRST SIOR23]
TQNE <STRSRC> ;BYTE POINTER IN JFN?
JRST SIOR23 ;YES, IGNORE FILCNT
TMNN FILNO,(JFN) ;NEW OUTPUT?
IFSKP. ;YES
CAML C,FILBCO(JFN) ;KEEP MIN OF THIS
MOVE C,FILBCO(JFN) ;AND BYTES IN BUFFER
MOVE Q2,FILBCO(JFN) ;GET LENGTH OF SOURCE STRING FOR LINE # REMOVER
ELSE. ;NO, OLD IO OR NEW INPUT
CAML C,FILCNT(JFN) ;KEEP MIN OF THIS
MOVE C,FILCNT(JFN) ;AND BYTES IN BUFFER
MOVE Q2,FILCNT(JFN) ;GET LENGTH OF SOURCE STRING FOR LINE # REMOVER
ENDIF.
SKIPA
SIOR23: MOVE Q2,C ;GET LENGTH OF SOURCE STRING
PUSH P,C ;SAVE COUNT
CALL BYTBLT ;DO THE TRANSFER
SKIPLE C ;BYTES LEFT?
JRST [ TQNE <FEEDME> ;YES. DID SOURCE RUNOUT?
JRST .+1 ;YEP. GO GET SOME MORE
TQNE <FLINPT> ;WAS FILE INPUT?
TQNE <XFRTRM> ;YES. NEED TO DO EXTRA DECREMENT?
JRST .+1 ;NO
SOJA C,.+1] ;YES, DO IT AND CONTINUE
SUB C,0(P) ;GET NEG OF BYTES TRANSFERRED
POP P,(P) ;DON'T NEED THIS NOW
TQNE <STRSRC> ;BYTE POINTER IN JFN?
JRST SIOR24
TMNN FILNO,(JFN) ;NEW OUTPUT?
IFSKP. ;YES
ADDM Q1,FILBNO(JFN) ;COUNT BYTES SKIPPED AS BYTES READ
MOVN Q1,Q1 ;NOW WE NEED IT NEGATIVE
ADDM Q1,FILBCO(JFN) ;AND COUNT BYTES SKIPPED AS BYTES REMOVED
ADDM C,FILBCO(JFN) ;UPDATE FILCNT
MOVN Q1,C
ADDB Q1,FILBNO(JFN)
TQNE <DISCRD> ;DISCARD A TAB?
AOS FILBNO(JFN) ;YES. THIS IS EASY, AS WE KNOW FILCNT=0
ELSE. ;NO, OLD IO OR NEW INPUT
ADDM Q1,FILBYN(JFN) ;COUNT BYTES SKIPPED AS BYTES READ
MOVN Q1,Q1 ;NOW WE NEED IT NEGATIVE
ADDM Q1,FILCNT(JFN) ;AND COUNT BYTES SKIPPED AS BYTES REMOVED
ADDM C,FILCNT(JFN) ;UPDATE FILCNT
MOVN Q1,C
ADDB Q1,FILBYN(JFN)
TQNE <DISCRD> ;DISCARD A TAB?
AOS FILBYN(JFN) ;YES. THIS IS EASY, AS WE KNOW FILCNT=0
ENDIF.
CAML Q1,FILLEN(JFN)
CALL [ MOVEM Q1,FILLEN(JFN)
CALLRET UPDLEN] ;UPDATE OFN LENGTH
SIOR24: XCTU [SKIPGE Q1,3] ;WHAT KIND OF COUNT
MOVNS C ;MAKE SIGN AGREE
JUMPE Q1,SIOR21 ;DON'T UPDATE COUNT IF 0
XCTU [ADDB C,3] ;DO UPDATE
JUMPE C,SIOR22 ;IF COUNT BECOMES 0, THEN DONE
JUMPL C,R ;STILL MORE TO DO, DON'T SAY DONE
SIOR21: TQZE <DISCRD,FEEDME> ;IF BYTBLT RETURNED 'CAUSE IT HAS TO
RET ; DISCARD A LINE NUMBER, DON'T STOP SIN.
TQNN <XFR2TM> ;FOUND THE TERMINATOR YET?
SIOR22: TQO <BBDONE> ;YES, SAY WE'RE DONE
RET
; Byte input subroutine
; Call: 1 ;Source designator
; CALL BYTIN
; Return
; +1 ;ERROR OCCURED, ERROR CODE IS IN A
; +2 ;Ok
; B ;A byte
; Clobbers most everything
BYTIN: TRVAR <SAVJFN>
MOVEM JFN,SAVJFN ;SAVE FOR BLOCK
BYTIN1: CALL CHKJFN ;Check the designator
JRST IOERR ;Bad designator
JFCL ;Tty
JFCL ;Byte pointer
CALL @JFNID(P3) ;INIT JFN FOR INPUT
CALL BYTINA ;GET A BYTE
JRST BYTINW ;SERVICE ROUTINE WANTS TO BLOCK
CALL UNLCKF ;UNLOCK THE LOCKS
RETSKP ;AND RETURN OK
BYTINW: JUMPN A,[CALLRET UNLCKF];IF ERROR, RETURN
MOVE A,B ;GET DISMIS INFO
CALL UNLDIS ;UNLOCK LOCKS AND DO MDISMS
MOVE JFN,SAVJFN ;GET JFN BACK
JRST BYTIN1 ;LOOP BACK AND TRY AGAIN
;ROUTINE TO INPUT A BYTE FROM DEVICE DEPENDENT SEQUENTIAL INPUT ROUTINE
;CALLED WITH THE JFN ALREADY LOCKED BY CHKJFN AND JFNID(P3) HAS BEEN CALLED
;CALL: CALL BYTINA
;RETURN
; +1 IF A IS NON-ZERO, AN ERROR OCCURED
; IF A = 0, ROUTINE WANTS TO BLOCK
; ;MDISMS ARGUMENT IS IN B
; +2 ;BYTE IN B
;BYTINS USED IF MAY BE A SINR
BYTINA: SETZM T1 ;NOT A SINR
BYTINS: STKVAR <FLAGS> ;SAVE ENTRY FLAG HERE
MOVEM T1,FLAGS ;SAVE IT NOW
JUMPGE STS,NOTOPN
BYTIA1: TQZ <RECF> ;NOT END OF RECORD IF HERE
CALL BYTINX ;GET A BYTE
RET ;ERROR - PASS DOWN THE LINE
TQNE <RECF> ;END OF RECORD SEEN?
JRST [ TQNN <ACRLFF> ;ADDING CR-LF?
SKIPE FLAGS ;NO. A SINR?
RETSKP ;YES. RETURN NOW THEN
JRST BYTIA1] ;NO. GET NEXT BYTE NOW
TQNE <PASLSN> ;LETTING LINE #S THRU?
RETSKP ;YES, EASY RETURN
TQZE <SKIPBY> ;ARE WE SUPPOSED TO THROW THIS AWAY (SEE BELOW)
JRST BYTIA1 ;YEP, GO GET A REAL ONE
JUMPN B,BYTIA2 ;DISCARD LSN'S MEANS ALSO DISCARD NULLS
MOVE A,FILBYN(JFN) ;HOWEVER, IF IT'S THE FIRST BYTE OF THE FILE
SOJE A,BYTIA3 ; THEN THE FILE CAN'T HAVE LINE NUMBERS
JRST BYTIA1 ;NOT FIRST BYTE, SAFE TO DISCARD IT
BYTIA2: LDB A,[POINT 12,FILBYT(JFN),11];DID WE JUST GET THE FIRST CHARACTER OF A WORD?
MOVE C,FILCNT(JFN) ;AND BETTER MAKE SURE THERE ARE ENUF LEFT
CAIE A,<POINT 7,0,6>_-^D24;FIRST BYTE?
RETSKP ; NO, LET IT THROUGH.
CAIGE C,4 ;ENUF FOR A LINE #?
JRST BYTIA4 ; NO, POSSIBLY SKIP THIS IN FUTURE
;POSSIBLE LINE NUMBER. LET'S ALSO CHECK TO SEE IF WE ARE ON THE FIRST WORD
;OF THE FILE AND IT IT ISN'T A LINE #, THEN SET PASLSN TO SPEED THINGS UP
;IN THE FUTURE
HRRZ A,FILBYT(JFN) ;GET THE WORD WE GOT THE CHARACTER FROM
MOVE A,0(A) ;DO INDIRECT
TXNN A,1B35 ;BIT 35 ON? IF SO, CALL IT A LINE #
JRST BYTIA4 ; NOT A LINE NUM. POSSIBLY SKP THIS IN FUTURE
MOVNI A,4 ;SKIP THE REST OF THE LINE NUMBER QUICKLY
ADDM A,FILCNT(JFN) ;(WE KNOW FILCNT WAS GEQ 4 BEFORE)
MOVEI A,4 ;ALSO UPDATE FILBYN
ADDM A,FILBYN(JFN)
MOVX A,77B5 ;NOW POINT TO LAST BYTE IN WORD
ANDCAM A,FILBYT(JFN) ;TO "READ" THOSE 4
CALL BYTINX ;SKIP THE TAB AFTER THE LSN
TQOA <SKIPBY> ;OOPS, NOT THIS TIME, REMEMBER AFTER WE UNBLOCK
JRST BYTIA1 ;AND GET A REAL ONE
RET ;RETURN TO BLOCK
BYTIA4: MOVE A,FILBYN(JFN) ;NOT A LINE NUMBER. FIRST CHAR?
SOSN A ;IF SO, SKIP THIS NONSENSE IN THE FUTURE
BYTIA3: TQO <PASLSN> ;HERE IF WE DECIDE FILE ISN'T SEQUENCED
RETSKP ;RETURN CURRENT BYTE
;SUBROUTINE CALLED ONLY BY BYTINA: and TSTLSN
;BYTINX expects the original JFN to be stored in SAVJFN (via TRVAR <SAVJFN>).
BYTINX::TQNN <READF> ;[7321]Make routine BYTINX external
FILABT IOX1 ;Illegal read
TQNE <ERRF>
JRST INERR ;GO GENERATE DATA ERROR INTERRUPT
TQNE <EOFF>
JRST INEOF
TQZE <BLKF,XQTAF> ;SEE IF FLAG IS ALREADY SET
BUG.(CHK,BLKF1,IO,HARD,<BYTINA - BLKF set before calling service routine>,,<
Cause: This is a consistency check in BYTINX. The environment is in IO where
sequential input is being processed. The code is getting ready to
jump to the device dependant code. Before doing so it sees if a bit
(BLKF) is set in STS (AC 8). This bit indicates that the service
routine wants to block. Therefore, no matter what the device
dependent routines do, the process will ultimately block. It is
unlikely that this is being done on purpose. It is more likely that
somewhere BLKF is not being cleaned up properly.
Action: If this is becoming a problem change the BUGCHK to a BUGHLT and
look at the dump.If FILSTS for the current JFN has the bit on then
the problem gets a little tricky since the previous use of it left
BLKF on. If BLKF is off in FILSTS then somewhere past the call to
CHKJFN it is being turned on.
>)
XMOVEI C,BYTINB ;BYTIN BLOCK ROUTINE
MOVE D,SAVJFN ;ORIGINAL JFN
TQZE <CRNXT> ;CR NEXT
JRST [ MOVEI B,.CHCRT ;YES, LOAD IT UP
TQO <LFNXT> ;REMEMBER THAT LF COMES NEXT
RETSKP]
TQZE <LFNXT> ;TIME FOR LF?
JRST [ MOVEI B,.CHLFD ;YES, LOAD IT UP
TQO <FROSTF> ;NOTE THAT THIS RECORD HAS BEEN FROSTED
RETSKP]
CALL @BIND(P3) ;Dispatch to DEVIce dependent code
TQNN <XQTAF> ;QUOTA EXCEEDED?
TQZE <BLKF> ;CHECK IF SERVICE ROUTINE WANTS TO BLOCK
JRST [ MOVE B,A ;YES, LEAVE DISMIS DATA IN B
JRST RETZ] ;AND RETURN WITH A=0
TQZ <FROSTF> ;NEW RECORD HASN'T BEEN FROSTED WITH CRLF YET
TQNE <ERRF>
JRST INERR
TQNE <EOFF>
JRST INEOF
MOVE B,A
TQNN <ACRLFF> ;WANT TO AUGMENT RECORDS WITH CRLFS?
RETSKP ;NO, JUST GIVE SKIP WITH LOCKS STILL SET
MOVE C,FILBYN(JFN) ;SEE HOW FAR WE'VE READ
CAMGE C,FILLEN(JFN) ;ARE WE AT END OF RECORD?
CAIA ;NOT END OF RECORD OR ALREADY FROSTED
TQO <CRNXT> ;AUGMENTING, START SEQUENCE.
RETSKP ;SKIP RETURN LEAVING LOCKS STILL SET
INEOF: MOVEI A,IOX4
MOVEM A,LSTERR
MOVEM JFN,ERRSAV
MOVE A,MPP ;GET BASE LEVEL STACK
MOVE B,-1(A) ;GET PC
MOVE A,0(A) ;GET ADR OF JSYS+1
CALL CHKERT ;SEE IF AN ERCAL OR ERJMP
SKIPA A,BITS+.ICEOF ;NO, CAUSE INTERRUPT ON CHANNEL 10
JRST INEOF1 ;YES, DONT INTERRUPT
CALL IICSLF ;ON THIS FOR
INEOF1: MOVEI B,0
RETBAD (IOX4) ;GIVE ERROR RETURN
INERR: FILINT (IOX5) ;GIVE CHANNEL 11 INTERRUPT
RETBAD (IOX5) ;AND RETURN
;ROUTINE TO HANDLE SERVICE ROUTINE BLOCK REQUEST
BYTINB::STKVAR <SAVDEV> ;SAVE DEV
MOVEM DEV,SAVDEV ;SAVE DEV
PUSH P,T2 ;SAVE JFN RETURNED
CALL UNLDIS ;UNLOCK JFN & DISMISS
POP P,JFN ;RESTORE JFN
CALL CHKJFN ;RE-VALIDATE IT
RETBAD ()
JFCL
JFCL
CAME DEV,SAVDEV ;CHECK FOR DEV MATCH
RETBAD (DESX4) ;NOT LEGAL TO CHANGE JFN'S
RETSKP ;ALLOW SERVICE ROUTINE TO PROCEED
;ROUTINE TO UNLOCK LOCKS AND TO DO AN MDISMS
;CALLED WITH MDISMS ARGUMENT IN A
;ENTRY AT UNLDS1, WILL CHECK ERRF FIRST, AND IF SET, WILL
;GUARANTEE THAT PROCESS "SEES" INTERRUPT
UNLDS1: TQNN <ERRF> ;[7391]Is error up?
JRST UNLDIS ;[7391]No, continue on
CAIE A,IOX7 ;[7391]JSB free space full?
IFSKP. ;[7391]
FILINT (IOX7) ;[7391]Yes, give the interrupt
ELSE. ;[7391]
CAIE A,MONX02 ;[7.1032] No more JSB space?
IFSKP. ;[7.1032]
FILINT (IOX7) ;[7.1032] Yes, give correct error
ELSE. ;[7.1032]
FILINT (IOX5) ;[7.1032] No, assume device or data error
ENDIF. ;[7.1032]
ENDIF. ;[7391]
CALL UNLCKF ;[7391]Success, unlock the file
JRST EMRET1 ;[7391]Give error
UNLDIS::PUSH P,A ;SAVE MDISMS ARGUMENT
TQZN <XQTAF> ;QUOTA EXCEEDED?
JRST UNLDSN ;NO - GO ON
MOVE A,MPP ;YES - GET ADDRS OF JSYS+1
MOVE B,-1(A) ;GET PC
MOVE A,0(A) ;...
CALL CHKERT ;SEE IF ERJMP/ERCAL
SKIPA ;NONE - TRY INTERRUPT
EMRETN (IOX11,<CALL UNLCKF>) ;TAKE ERROR RETURN
REPEAT 0,< ;OLD, INCORRECT CODE
MOVE B,MPP ;RETURN PC POINTER
MOVE C,0(B) ;PICK UP FLAGS
TXOE C,QUOTAB ;ALREADY "BACKED UP"?
JRST UNLDS2 ;YES. DON'T DO IT AGAIN
SOS -1(B) ;DECREMENT RETURN PC
MOVEM C,0(B) ;NEW FLAGS
TLNE C,(UMODF) ;USER MODE PC?
SOS -3(B) ;YES. ONE MORE PC THEN
> ;END OF REPEAT 0
UNLDS2: MOVE A,BITS+.ICQTA ;GET CHANNEL BITS
CALL IICSLF ;CAUSE INTERUPT
UNLDSN: PUSH P,STS ;SAVE STS
TQZ <HLDF> ;NEVER STORE HLDF
CALL UNLCKF ;UNLOCK THE FILE AND DO AN OKINT
;INTERUPT WILL HAPPENED IF POSTED
POP P,STS ;RESTORE ORIGINAL STS
POP P,A ;GET BACK ARG
HRRZ B,A ;LOOK AT ROUTINE ADDRESS
JUMPE B,UNLERC ;NONE, ONLY ERROR CODE IN LH
TQNE <HLDF> ;WANT TO HOLD PROCESS IN BAL SET?
JRST UNLHLD ;YES. GO ARRANGE IT
CAIE B,MTDWT1 ;IS THIS A MAG TAPE WAIT?
CAIN B,MTAWAT
JRST UNLMTA ;YES, GO DO A HDISMS
CAIN B,MTARWT ;ANOTHER TYPE OF MTA WAIT?
JRST UNLMTA ;YES
MDISMS ;WAIT UNTIL CONDITION IS SATISFIED
RET ;RETURN TO CALLER
;HERE IF SERVICE ROUTINE DOESN'T REALLY WANT TO BLOCK, BUT RATHER TO
;RETURN A SPECIFIC ERROR CODE
UNLERC: HLRZ T1,T1 ;GET ERROR CODE
ITERR ()
UNLMTA: HDISMS (^D50) ;WAIT FOR ENOUGH TIME FOR A RECORD READ
RET
;SPECIAL BLOCK FOR FE DEVICE WAIT
;THIS CODE IS HERE TO REDUCE SCHEDULER OVERHEAD FROM THE DN64'S
;1/3 SEC POLLING CYCLE. THE WAIT TIME IS A GUESS AT HOW LONG IT TAKES
;TO CLANK THE POLLER. THE INTENDED EFFECT IS TO HELP THE SCHEDULER
;DEDUCE WAHT IS GOING ON.
UNLHLD: HDISMS (^D80) ;WAIT LONG ENOUGH FOR FE AND 3780 TO
; RESPOND
RET ;AND DONE
; Output to primary output file
; Call: 1 BYTE
; PBOUT
.PBOUT::MCENT
MOVEI JFN,101
UMOVE B,1
CALL BYTOUT
JRST MRETN
; Byte output
; Call: 1 ;Tenex destination designator
; 2 ;A byte
; BOUT
.BOUT:: MCENT
NOINT
JUMPLE 1,SLBOU
CAIE 1,.PRIIN ;PRIMARY INPUT?
CAIN 1,.PRIOU ;OR PRIMARY OUTPUT?
JRST SLBOU ;YES. DO IT THE SLOW WAY
CAML 1,MAXJFN ;Possibly a jfn?
JRST SLBOU ;Not possible
IMULI 1,MLJFN ;CONVERT TO INTERNAL INDEX
AOSE FILLCK(1)
JRST SLBOU0
MOVE C,FILSTS(1)
TXC C,OPNF!WRTF!FILOUP
TXCN C,OPNF!WRTF!FILOUP
TXNE C,FRKF!ERRF
JRST SLBOU1
TMNN FILNO,(1) ;NEW OUTPUT?
IFSKP. ;YES
SOSGE FILBCO(1)
JRST SLBOU2
ELSE. ;NO, OLD IO OR NEW INPUT
SOSGE FILCNT(1)
JRST SLBOU2
ENDIF.
CALL STRDMO ;VERIFY STRUCTURE
JRST SLBOU1 ;BEEN DISMOUNTED
TMNN FILNO,(1) ;NEW OUTPUT?
AOSA C,FILBYN(1) ;NO, OLD IO OR NEW INPUT
AOS C,FILBNO(1) ;YES,
CAMLE C,FILLEN(1)
CALL [ MOVEM C,FILLEN(1)
MOVE JFN,1 ;COPY FOR UPDLEN
HRRZ DEV,FILDEV(JFN)
MOVE STS,FILSTS(JFN)
CALLRET UPDLEN] ;UPDATE OFN LENGTH
UMOVE 2,2
TMNN FILNO,(1) ;NEW OUTPUT?
IDPB 2,FILBYT(1) ;NO, OLD IO OR NEW INPUT
TMNE FILNO,(1) ;NEW OUTPUT?
IDPB 2,FILBFO (1) ;YES
CALL LUNLKF ;FREE UP FILE
JRST MRETN
SLBOU2: TMNN FILNO,(1) ;NEW OUTPUT?
AOSA FILCNT(1) ;NO, OLD IO OR NEW INPUT
AOS FILBCO(1) ;YES
SLBOU1: SETOM FILLCK(1)
SLBOU0: UMOVE 1,1 ;GET BACK ORIGINAL JFN
SLBOU: OKINT
MOVE JFN,1
CALL BYTOUT ;Output the byte
SLBOUR: TQNN <ERRF> ;ERROR OCCUR?
JRST MRETN ;NO, EXIT
MOVEI A,IOX5 ;YES, GET ERROR CODE
JRST EMRET0 ;AND EXIT
SLBOUU: CALL UNLCKF ;UNLOCK THE JFN
JRST SLBOUR ;AND RETURN
; Random output jsys
; Call: 1 ;Tenex source designator
; 2 ;A byte
; 3 ;Byte number
; ROUT
.ROUT:: MCENT
TRVAR <SAVJFN>
ROUT0: UMOVE JFN,1
MOVEM JFN,SAVJFN
CALL CHKJFN
JRST IOERR
JFCL
FILABT DESX4 ;Tty and byte designators are illegal
JUMPGE STS,NOTOPN
TQNN <RNDF>
FILABT IOX3 ;Illegal to change pointer
TQNN <WRTF>
FILABT IOX2 ;Illegal write
CALL @JFNOD(P3) ;INIT JFN FOR OUTPUT
UMOVE A,3
CALL SFBNR
JRST ABTDO
UMOVE B,2
CALL BYTOUA
JRST ROUTW ;SERVICE ROUTINE WANTS TO BLOCK
JRST SLBOUU ;UNLOCK AND RETURN
ROUTW: CALL UNLDS1 ;UNLOCK THE LOCKS AND WAIT
JRST ROUT0 ;TRY AGAIN
; String output to primary io file
; Call: 1 ;String pointer, designator, or location of string
; PSOUT
.PSOUT::MCENT
TRVAR <SAVJFN>
PSOUT1: TLNE 1,777777
JUMPGE 1,PSOUT0
MOVSI C,440700
CAML 1,[777777,,0]
XCTU [HLLM C,1]
PSOUT0: MOVEI JFN,101 ;GET JFN OF PRIMARY DEVICE
MOVEM JFN,SAVJFN ;SAVE IT IN GLOBAL VARIABLE
CALL CHKJFN ;TURN IT INTO A REAL JFN
JRST IOERR ;BAD ARGUMENT
JFCL ;TTY
JFCL ;BYTE POINTER
CALL @JFNOD(P3) ;INIT JFN FOR OUTPUT
PSOUT2: XPSHUM [PUSH P,1] ;Make a copy of byte pointer
XCTBU [ILDB B,0(P)]
JUMPE B,[XPOPMU [POP P,1]
JRST SLBOUU] ;UNLOCK AND RETURN
CALL BYTOUA
JRST PSOUTW ;SERVICE ROUTINE WANTS TO BLOCK
XPOPMU [POP P,1]
JRST PSOUT2
PSOUTW: CALL UNLDS1 ;UNLOCK AND BLOCK
POP P,(P) ;REMOVE BYTE POINTER FROM STACK
JRST PSOUT0 ;START OVER AGAIN
; PRIMARY ERROR STRING OUTPUT
.ESOUT::MCENT
MOVEI T1,101
DOBE
ERJMPR [ITERX] ;FAILED. PASS BACK ERROR.
RFPOS ;GET POSITION ON LINE
ERJMPR [ITERX] ;FAILED. PASS BACK ERROR.
HRROI T1,[ASCIZ /
/]
TRNE T2,-1 ;ALREADY AT BEGINNING OF LINE?
PSOUT ;NO, GET THERE
ERJMPR [ITERX] ;FAILED. PASS BACK ERROR.
MOVEI T1,"?" ;ERROR CHARACTER
PBOUT
ERJMPR [ITERX] ;FAILED. PASS BACK ERROR.
MOVEI T1,100
CFIBF
ERJMPR [ITERX] ;FAILED. PASS BACK ERROR.
IMCALL PSOUT ;OUTPUT THE MESSAGE
ERJMPR [ITERX] ;FAILED. PASS BACK ERROR.
MRETNG ;AND DONE
; String output
; Call: 1 ;Tenex source designator
; 2 ;Byte pointer (lh = 777777 will be filled in)
; 3 ;Byte count or zero
; ;If zero, the a zero byte terminates
; ;If positive then transfer the specified number
; ;Of characters, or terminate on reading a byte
; ;Equal to that given in 4
; ;If negative, then transfer the specified number
; ;Of bytes
; 4 ;(optional) if 3 is > 0, 4 has a terminating byte
; SOUT
; Return
; +1 ;Always
; 2 ;Updated string pointer
; 3 ;Updated count (always counts toward zero)
; The updated string pointer always points to the last byte read
; Unless 3 contained zero, then it points to the last non-zero byte.
.SOUTR::MCENT
SETO Q2, ;MARK THAT A SOUTR WAS DONE
JRST SOUTR1 ;ENTER COMMON CODE
.SOUT:: MCENT ;Become slow etc
SETZ Q2, ;MARK THAT A SOUT WAS DONE
;SOUTR1:TRVAR <SAVJFN,SOUTRF,SOUAC3> ;[7317] [7319]
; SETZM SOUAC3 ;[7317] CLEAR AC3 FLAG
; UMOVE C,3 ;[7317] GET USERS AC 3 (COUNT WORD)
; SKIPLE C ;[7317] IS IT POSITIVE ?
; SETOM SOUAC3 ;[7317] YES, REMEMBER THIS FOR LATER
SOUTR1: TRVAR <SAVJFN,SOUTRF> ;[7319]
MOVEM Q2,SOUTRF ;SAVE SOUTR FLAG
JUMPGE 2,SOUT0
MOVSI C,440700
CAML 2,[777777,,0]
XCTU [HLLM C,2]
SOUT0: UMOVE T3,2 ;GET USERS POINTER
XCTBU [ILDB T3,T3] ;ATTEMPT TO GET A BYTE
UMOVE JFN,1 ;GET USERS JFN
MOVEM JFN,SAVJFN ;SAVE IT
CALL CHKJFN ;GET REAL JFN AND LOCK UP
JRST IOERR ;BAD ARGUMENT
JRST SOUTTY
JRST [ CAIE DEV,STRDTB
JRST SOUTTY ;NOT BYTE PTR, DO BYTE AT A TIME
JRST SOUBYT]
TQNE <OPNF> ;OPENED?
TQNN <WRTF>
FILABT(IOX2)
CALL @JFNOD(P3) ;INIT JFN FOR OUTPUT
SKIPLE SOUTRF ;NEED TO MOVE SOME BYTES?
JRST SOUTRR ;NO. GO RIGHT TO RECOUT CODE
SOUT00: TMNN FILNO,(JFN) ;NEW OUTPUT?
IFSKP. ;YES
SKIPG FILBCO(JFN)
JRST SOUT1 ;DO IT THE OLD WAY
MOVE B,FILBFO(JFN) ;TARGET IS FILE
ELSE. ;NO, OLD IO OR NEW INPUT
SKIPG FILCNT(JFN)
JRST SOUT1 ;DO IT THE OLD WAY
MOVE B,FILBYT(JFN) ;TARGET IS FILE
ENDIF.
UMOVE A,2 ;SOURCE IS USER
MOVX D,XFRLSN!BBLTUM ;ALWAYS PASS LSNS (THERE AREN'T ANY)
CALL SIOR2
UMOVEM A,2
TMNN FILNO,(JFN) ;NEW OUTPUT?
MOVEM B,FILBYT(JFN) ;NO, OLD IO OR NEW INPUT
TMNE FILNO,(JFN) ;NEW OUTPUT?
MOVEM B,FILBFO(JFN) ;YES
TQNN <BBDONE> ;HAS BYTBLT FINISHED?
JRST [ CALL UNLCKF ;NO, DO SOME MORE
JRST SOUT0] ;BUT UNLOCK FIRST TO ALLOW INTERRUPTS
SOUTRR: SKIPN SOUTRF ;DOING A SOUTR JSYS?
JRST SLBOUU ;NO, JUST EXIT
XMOVEI C,BYTINB ;COMMON BLOCK ROUTINE
MOVE D,SAVJFN ;THE ORIGINAL JFN
CALL @RECOUT(P3) ;IF SOUTR, CALL SERVICE ROUTINE
JRST [ TQZE <BLKF> ;WANT TO BLOCK?
JRST [ CALL UNLDIS ;YES. SO DO IT
MOVEI T1,1 ;REMEMBER THIS HAPPENED
MOVEM T1,SOUTRF ;""
JRST SOUT0] ;AND DO IT AGAIN
FILABT (IOX5)] ;NO, ERROR
JRST SLBOUU ;UNLOCK AND EXIT
; SOUT TO STRING POINTER
SOUBYT: MOVE B,JFN
UMOVE A,2
MOVX D,STRSRC!XFRLSN!BBLTUU;FROM STRING, DON'T WORRY ABOUT LSNS,
; AND COPY USER TO USER
CALL SIOR2
UMOVEM A,2
UMOVEM B,1
MOVEM B,JFN
; SKIPN SOUAC3 ;[7317] [7319] USER AC3 ORIGINALLY POSITIVE ?
CALL APPNUL ;[7317] NO, EITHER 0 OR NEGATIVE, APPEND NULL
JRST SOUTRR ;AND RETURN
;SOUT WHICH MUST BE DONE BYTE-AT-A-TIME
;SOUTTY - FOR CASES WHERE WE DO NOT HAVE A REAL JFN
SOUTTY: CALL @JFNOD(P3) ;INIT JFN FOR OUTPUT
SOUTT1: CAIN P3,TTYDTB ;TTY?
JRST STTYOP ;YES DO OPTIMIZATION
CALL SOUTB ;OUTPUT THE BYTE
JRST [ JUMPN A,SOUT0 ;DEVICE BLOCKED, START OVER
JRST SOUTRR] ;ALL THROUGH
JRST SOUTT1 ;LOOP BACK FOR ALL BYTES
;OPTIMIZATION FOR SOUT TO A TTY. IT USES THE RECOUT ENTRY
;SINCE IT TRIES TO OPTIMIZE AND SOUTR IS IGNORED FOR TTY'S.
;REGISTERS USED FROM USER AS IN CALL TO SOUT
STTYOP: JUMPGE STS,NOTOPN
TQNN <WRTF>
FILABT IOX2 ;ILLEGAL WRITE
TQNE <ENDF>
FILABT IOX6 ;PAST ABS END OF FILE
TQNE <ERRF>
FILINT(IOX5) ;ERROR INTERRUPT
XMOVEI C,BYTINB ;COMMON CO-ROUTINE
CALL TTYBLO ;OUTPUT
JRST [ CALL UNLDS1 ;UNLOCK AND BLOCK
TQNN <BLKF> ;BLOCK
JRST SOUT0
JRST SLBOUU] ;UNLOCK AND EXIT
JRST SLBOUU ;UNLOCK AND EXIT
;SOUT1 - FOR CASES WHERE WE HAVE A REAL JFN, TRY FAST WAY AFTER DOING
;EACH BYTE IN CASE FILCNT IS THEN SETUP
SOUT1: CALL SOUTB ;OUTPUT THE BYTE
JRST [ JUMPN A,SOUT0 ;DEVICE BLOCKED, START OVER
JRST SOUTRR] ;ALL DONE
JRST SOUT00 ;SEE IF FILCNT IS NOW SET UP
;ROUTINE TO OUTPUT A BYTE
;CALL: CALL SOUTB
;RETURNS +1 A=TRUE MEANS DEVICE BLOCKED,START OVER
; A=FALSE MEANS ALL THROUGH
; +2 MORE BYTES TO BE DONE
SOUTB: XPSHUM [PUSH P,2]
XCTBU [ILDB B,0(P)]
XCTU [SKIPN 3]
JUMPE B,[XPOPMU [POP P,2]
JRST RFALSE] ;Don't write zero bytes if arg3 = 0
PUSH P,B
CALL BYTOUA
JRST SOUTW ;SERVICE ROUTINE WANTS TO BLOCK
POP P,B
XPOPMU [POP P,2]
CALL SIONXT
RETSKP ;GIVE SKIP RETURN BECAUSE MORE TO BE DONE
JRST RFALSE ;RETURN
SOUTW: CALL UNLDS1 ;UNLOCK AND BLOCK
POP P,B ;GET BACK BYTE
POP P,(P) ;POP OFF BYTE POINTER
JRST RTRUE ;TRY AGAIN
; Byte output subroutine
; Call: 1 ;Source designator
; 2 ;BYTE
; CALL BYTOUT
; Return
; +1 ;Ok
; Clobbers most everything
BYTOUT::TRVAR <SAVJFN>
MOVEM JFN,SAVJFN ;SAVE ARGUMENT
BYTOU1: CALL CHKJFN ;Check the designator
JRST IOERR ;Bad designator
JFCL ;Tty
JFCL ;Byte pooutter
PUSH P,B ;SAVE BYTE
CALL @JFNOD(P3) ;INIT JFN FOR OUTPUT
MOVE B,0(P) ;GET BACK THE BYTE
CALL BYTOUA ;SEND IT OUT
JRST BYTOUW ;SERVICE ROUTINE WANTS TO BLOCK
POP P,B ;GET BACK BYTE
CALLRET UNLCKF ;UNLOCK THE LOCKS
BYTOUW: CALL UNLDS1 ;UNLOCK AND BLOCK
POP P,B ;GET BYTE BACK
MOVE JFN,SAVJFN ;GET ARG TO CHKJFN BACK
JRST BYTOU1 ;AND TRY AGAIN
;ROUTINE TO SEND A BYTE TO SERVICE ROUTINE
;CALLED WITH FILE LOCKED DOWN AND BYTE IN B AND JFNOD(P3) HAVING BEEN CALLED
BYTOUA::JUMPGE STS,NOTOPN
TQNN <WRTF>
FILABT IOX2 ;Illegal write
TQNE <ENDF>
FILABT(IOX6) ;Past abs end of file
TQNE <ERRF>
FILINT(IOX5) ;Error interrupt
MOVE A,B
TQZE <BLKF,XQTAF> ;MAKE SURE BLKF IS OFF BEFORE CALL
BUG.(CHK,BLKF2,IO,HARD,<BYTOUA - BLKF set before call to service routine>,,<
Cause: This is a consistency check in BYTOUA. The environment is in IO just
before it gets ready to call the device dependent routines to do output.
Bit BLKF in STS (AC 8) is on. It should be off. It causes the process
to block. It is unlikely that this sort of knowledge is available.
It is more likely that this is an error.
Action: If the problem persists change the BUGCHK to a BUGHLT and look at
the dump. If FILSTS for the current JFN has the BLKF bit on then
the last one to user the JFN left it in that state. A hard problem
to find. If BLKF is off in FILSTS then somewhere after the call to
CHKJFN the bit is being set on not reset.
>)
XMOVEI C,BYTINB ;COMMON CO-ROUTINE
MOVE D,SAVJFN
CALL @BOUTD(P3) ;Dispatch to DEVIce dependent code
TQZN <BLKF> ;DOES SERVICE ROUTINE WANT TO BLOCK?
TQNE <ERRF,XQTAF> ;GOT AN ERROR?
RET ;YES, TAKE NON-SKIP RETURN
RETSKP ;NO, SKIP RETURN WITHOUT UNLOCKING
; Append null to string output designator
APPNUL::PUSH P,JFN
PUSH P,C
PUSH P,B
MOVEI C,0
LDB B,[POINT 6,JFN,5] ;GET PS FIELD FROM BYTE PTR
CAIL B,61 ;ARE WE .GE. OWGBP FOR P=36 S=7
CAILE B,66 ;ARE WE .LE. OWGBP FOR P=1 S=7
SKIPA ;NO, NOT ASCII BYTE PTR
XCTBU [IDPB C,JFN] ;YES, HAVE OWGBP ASCII BYTE PTR
TLZ JFN,7700
TLO JFN,700
CAMN JFN,-2(P) ;HAVE REGULAR ASCII BYTE PTR
XCTBU [IDPB C,JFN] ;YES, APPEND NULL
POP P,B
POP P,C
POP P,JFN
RET
;table to convert P,S field of OWGBP to P or S
;access table using the structures, OWGSZ & OWGPS, with index = P,S field
;or the routines GETSIZ & GETPOS
OWGBTB: 6,,44
6,,36
6,,30
6,,22
6,,14
6,,6
6,,0
10,,44
10,,34
10,,24
10,,14
10,,4
7,,44
7,,35
7,,26
7,,17
7,,10
7,,1
11,,44
11,,33
11,,22
11,,11
11,,0
22,,44
22,,22
22,,0
77,,77 ;illegal
DEFSTR OWGSZ,OWGBTB-^O45,17,18 ;size field
DEFSTR OWGPS,OWGBTB-^O45,35,18 ;position field
;get size field from a byte pointer, global or local
;CALL GETSIZ
;T1/ byte pointer
;returns +1 on with T1/ size
;preserves all other ACs
GETSIZ::SAVEAC <Q1>
MOVE Q1,T1 ;save pointer
LDB T1,[POINT 6,T1,5]
CAIGE T1,45 ;OWGBP ?
IFSKP.
LOAD T1,OWGSZ,(T1) ;yes. convert.
ELSE.
LDB T1,[POINT 6,Q1,11] ;no. get size field
ENDIF.
RET
;get position field from a byte pointer, global or local
;CALL GETPOS
;T1/ byte pointer
;returns +1 with T1/ position
;preserves all other ACs
GETPOS::LDB T1,[POINT 6,T1,5]
CAIL T1,45 ;OWGBP ?
LOAD T1,OWGPS,(T1) ;yes. convert.
RET
;ROUTINE TO BLOCK FOR BYTOUT SERVICE ROUTINES
; Move bytes
; Call:
; A/ SOURCE POINTER
; B/ TARGET POINTER
; C/ BYTE COUNT
; D/ MODE BITS AS AS DEFINED AT START OF LISTING
; Q1/ TERMINATOR IF ANY
; Q2/ LENGTH OF SOURCE STRING (USED BY CHKTRM ONLY)
;RETURNS A-D UPDATED,
;Q1/ # OF BYTES DISCARDED AS LINE NUMBERS OR NULL
;Q2/ CLOBBERED
;NOTE: ATS CALLS THIS ROUTINE USING AN INDEXED BYTE POINTER
;INDEXING ON P1. THIS ROUTINE MUST NOT CHANGE P1.
BYTBLT::STKVAR <<TEMPA,3>,SAVQ3,SAVP6,SAVP5,SAVP3,SAVTDS,OWGBSF,OWGBTF,BYTREM,BYTSIZ,TRMBYT,BYTSKP,<PRG,LPRG>>
MOVEM Q1,TRMBYT ;Shuffle args
MOVEM Q3,SAVQ3 ;SAVE PERMANENT ACS
MOVEM P3,SAVP3
MOVEM P5,SAVP5
MOVEM P6,SAVP6
XMOVEI P3,BYTERR ;SETUP DISPATCH FOR ANY ILLEG REF
TXO P3,TRPIRF ; THAT MIGHT OCCUR HEREIN
EXCH P3,TRPDSP ; SAVE PREVIOUS
MOVEM P3,SAVTDS
HRRZ P5,D ;SET TYPE OF XFER
SETZM BYTSKP ;HAVEN'T SKIPPED ANYTHING YET
; Preliminaries out of the way
; Now get to work
BYTB1: TQNE <DCRNXT,DLFNXT> ;ADDING CRLF'S?
JRST CHKCRL ;YES. GO DO CR-LF STUFF
TQNE <XFRLSN> ;SKIPPING LINE NUMBERS?
TQNE <XFR2TM> ;OR UP TO A TERMINATOR?
JRST CHKTRM ;Yes TO EITHER, look for it
CAIG C,20 ;Short transfer ?
JRST BYTLP ;Do byte at a time
;...
;...
;get byte size of source & target, set flags & get position of target
LDB Q1,[POINT 6,A,5] ;GET SOURCE P FIELD
CAIGE Q1,45 ;IS SOURCE A OWGBP?
IFSKP.
SETOM OWGBSF ;yes. flag source as global
LOAD Q1,OWGSZ,(Q1) ;get byte size
ELSE.
SETZM OWGBSF ;no. flag source as local
LDB Q1,[POINT 6,A,11] ;get byte size
ENDIF.
LDB Q2,[POINT 6,B,5] ;GET TARGET P FIELD
CAIGE Q2,45 ;IS TARGET A OWGBP?
IFSKP.
SETOM OWGBTF ;yes. flag target as global
LOAD Q3,OWGSZ,(Q2) ;get byte size
LOAD Q2,OWGPS,(Q2) ;get byte position
ELSE.
SETZM OWGBTF ;no. flag target as local
LDB Q3,[POINT 6,B,11] ;get byte size
ENDIF.
JUMPE Q3,BYTLP ;if target byte size = 0, do slowly.
CAME Q1,Q3 ;byte sizes differ ?
JRST BYTLP ;yes. do slowly.
MOVEM Q1,BYTSIZ ;no. save byte size.
;BYTE SIZES FOR SOURCE AND DESTINATION MATCH, AND TRANSFER IS
;LONG ENOUGH TO JUSTIFY THE OVERHEAD OF TRYING TO OPTIMIZE.
;COPY A BYTE AT A TIME UNTIL THE FIRST WORD OF THE TARGET HAS
;BEEN FILLED.
CAMLE Q3,Q2 ;at end of word to start with ?
MOVEI Q2,^D36 ;yes. transfer a full word's worth of bytes
IDIV Q2,Q3 ;compute # of bytes to move
LP1: SOJL C,DONE ;Until cnt < 0
XCT LDBTB(P5) ;Do transfer bytes
XCT DPBTB(P5)
SOJG Q2,LP1 ;Or until first word of target is filled
;ONE WORD HAS BEEN FILLED IN THE DESTINATION. MAKE SURE WE NEED
;TO TRANSFER AT LEAST ONE WORD.
BYTB2: MOVEI Q1,^D36 ;Word size
IDIV Q1,BYTSIZ ;Compute bytes/word and remainder
MOVEM Q2,BYTREM ;Save remainder
MOVE Q2,C
IDIV Q2,Q1 ;Compute words to transfer
MOVEM Q3,C ;Remaining bytes
JUMPE Q2,BYTLP ;Zero words...do byte at a time
;COMPUTE THE DIFFERENCE IN BIT POSITIONS BETWEEN THE SOURCE
;AND DESTINATION. IF THEY ARE DIFFERENT, GO OFF TO SHIFT THE SOURCE.
LDB Q1,[POINT 6,A,5] ;get source P field, assume local
SKIPE OWGBSF ;was source a OWGBP ?
LOAD Q1,OWGPS,(Q1) ;yes. get byte position.
LDB Q3,[POINT 6,B,5] ;get target P field, assume local
SKIPE OWGBTF ;was destinaion a OWGBP ?
LOAD Q3,OWGPS,(Q3) ;yes. get byte position.
SUB Q1,Q3 ;the difference
ANDI Q1,77 ;in 6 bits
JUMPN Q1,BYTBL1 ;Move word at a time
;..
;THE BYTE SIZES MATCH, AND THE ALIGNMENTS WITHIN THE WORDS
;MATCH, SO BLT THE DATA FROM SOURCE TO DESTINATION.
;..
DMOVEM A,TEMPA ;SAVE A-C
MOVEM C,2+TEMPA
AOS Q3,B ;CALCULATE DESTINATION ADDRS
SKIPN OWGBTF ;OWGBP target ?
IFSKP.
MOVE C,Q3 ;yes
TLZ C,770000 ;addr is in low 30 bits, no index or indirect
ELSE.
TLZ Q3,777740 ;NO. SAVE EFFECTIVE ADDRESS
TXO Q3,<XMOVEI C,> ;CONS INSTRUCTION
XCT DMVITB(P5) ;GET ADDRS
ENDIF.
AOS Q3,A ;CALCULATE SOURCE ADDRS
SKIPN OWGBSF ;OWGBP source ?
IFSKP.
MOVE B,Q3 ;yes.
TLZ B,770000 ;address is in low 30 bits, no index or indirect
ELSE.
TLZ Q3,777740 ;NO. SAVE EFFECTIVE ADDRESS
TXO Q3,<XMOVEI B,> ;BUILD INSTR
XCT SMVITB(P5) ;GET ADDRS
ENDIF.
MOVE A,Q2 ;NUMBER OF WORDS TO MOVE
ADDM Q2,TEMPA ;UPDATE SRC / DEST POINTERS
ADDM Q2,1+TEMPA
MOVX Q2,TRPSTK ;SET FLAG IN TRPDSP
IORM Q2,TRPDSP ; TO SAY WE LEFT BYTBLT
XCT BLTTB(P5) ;CORRECT BLT ROUTINE
MOVX A,TRPSTK ;TURN OFF FLAG
ANDCAM A,TRPDSP ; TO SAY WE'RE BACK
DMOVE A,TEMPA ;RESTORE REGS
MOVE C,2+TEMPA ;...
;TRANSFER THE REMAINING (PRESUMABLY FEW) BYTES ONE AT A TIME
BYTLP: JUMPLE C,DONE ;Do rest a byte at a time
BYTLP1: XCT LDBTB(P5)
XCT DPBTB(P5)
SOJG C,BYTLP1
DONE: MOVE Q1,BYTSKP ;RETURN # BYTES SKIPPED
MOVE Q3,SAVQ3 ;RESTORE PERMANENT ACS
MOVE P3,SAVTDS ;RESTORE
MOVEM P3,TRPDSP
MOVE P3,SAVP3
MOVE P5,SAVP5
MOVE P6,SAVP6
RET
;HERE ON ANY ILLEG MEM REF IN BYTBLT
BYTERR: MOVE Q1,TRPDSP ;CHECK TRPDSP TO SEE
TXNE Q1,TRPSTK ; IF FLAG WAS SET
ADJSP P,-1 ;IT WAS - ADJUST STACK
SETZM TRPDSP ;ZERO IT
JRST DONE ;NOTHING SPECIAL, JUST QUIT
;HERE WHEN BYTE SIZES MATCH BUT ALIGNMENT OF BYTES WITHIN
;WORDS DIFFERS. SHIFT THE SOURCE TO LINE UP WITH THE DESTINATION
;AND COPY A WORD AT A TIME.
; T1/ SOURCE POINTER
; T2/ DESTINATION POINTER
; Q1/ POSITION OFFSET (RIGHT SHIFT AMOUNT)
; Q2/ WORD COUNT
; P5/ KIND OF TRANSFER (FROM T4 ON ENTRY)
; Bytrem/ lsh amount to right justify first word
BYTBL1: HRLI P3,PROTO ;LOAD PROTO PROGRAM ONTO STACK
HRRI P3,PRG
BLT P3,LPRG-1+PRG
DMOVEM B,1+TEMPA ;SAVE B AND C
;SET UP THE SOURCE ADDRESS
MOVE Q3,A ;COPY POINTER (SOURCE)
SKIPN OWGBSF ;OWGBP source ?
IFSKP.
MOVE B,Q3 ;yes.
TLZ B,770000 ;addr is in low 30 bits, no index or indirect
ELSE.
TLZ Q3,777740 ;NO. CLEAR ALL BUT EFFECTIVE ADDRS
TXO Q3,<XMOVEI B,> ;BUILD INSTR
XCT SMVITB(P5) ;GET ADDRS
ENDIF.
;FIX LSH INSTRUCTIONS TO SHIFT OUT THE BITS THAT ARE TO THE
;RIGHT OF THE LAST BYTE
HRR P3,BYTREM ;Fill in shift amount to left justify
HRRM P3,4+PRG ;STORE IN PROGRAM
MOVNS BYTREM ;Get right shift amount
HRR P3,BYTREM ;Fill in LSH
HRRM P3,2+PRG ;...
;FIGURE OUT WHICH WAY TO DO THE COMBINED SHIFT AND WHICH AC TO
;STORE FROM
MOVNS Q1 ;NEGATE OFFSET
ADD Q1,BYTREM ;Total right shift = offset + remainder
MOVE P3,4+PRG ;GET LSH INSTRUCTION
MOVE P6,5+PRG ;AND MOVEM INST
CAMG Q1,[-^D18] ;Less than half a word?
TLCA P3,(<Z Q1^!Q2,0>) ;Change ac of lsh from Q1 to Q2
TLCA P6,(<Z Q1^!Q2,0>) ;No, change ac of MOVEM to Q1
ADDI Q1,^D36 ;Leave movem Q1, change shift amount
MOVEM P3,4+PRG ;RESTORE NEW LSH INST
HRRM Q1,3+PRG ;Fill in lshc amount
MOVEM P6,5+PRG ;PUT BACK THE FIXED MOVEM
;FIX UP THE DESTINATION POINTER
MOVE Q3,1+TEMPA ;POINTER TO DESTINATION
SKIPN OWGBTF ;OWGBP target ?
IFSKP.
MOVE C,Q3 ;yes.
TLZ C,770000 ;addr is in low 30 bits, no index or indirect
ELSE.
TLZ Q3,777740 ;NO. CLEAR ALL BUT EFFECTIVE ADDRS
TXO Q3,<XMOVEI C,> ;BUILD INSTR
XCT DMVITB(P5) ;GET ADDRS
ENDIF.
AOS C ;START STORING IN SECOND WORD
;..
;UPDATE THE SOURCE AND DESTINATION POINTERS FOR RETURN TO THE CALLER
;..
ADDM Q2,1+TEMPA ;Update target
ADDM Q2,A ;And source
;IF TRANSFER INVOLVES USER, CHANGE PROTOTYPE PROGRAM TO DUE
;XCTU'S INSTEAD OF MOVE'S AND MOVEM'S
TRNE P5,2 ;IS THIS FROM "USER"?
JRST [ MOVE Q3,[XCTU Q3]
EXCH Q3,0+PRG ;YES, SET UP XCT INST INSTEAD
MOVE P6,[XCTU P6]
EXCH P6,1+PRG
JRST .+1]
TRNE P5,1 ;IS THIS TO "USER"?
JRST [ MOVE P3,[XCTU P3]
EXCH P3,5+PRG ;YES, SET UP PROPER XCT INST
JRST .+1]
MOVEM A,TEMPA ;Want to use A for AOBJN
MOVNS Q2 ;Make aobjn
HRLZ A,Q2 ;word in A
JRST PRG ;Do the program, return to done
;PROGRAM ON STACK COMES HERE WHEN DONE
BYTLPD: MOVE A,TEMPA ;RESTORE SOURCE POINTER
DMOVE B,1+TEMPA ;RESTORE B AND C
JRST BYTLP ;Finish up any odd bytes
; Transfer til terminator OR DISCARD LINE NUMBERS
CHKTR0: XCT LDBTB(P5) ;OUT WITH THE BAD BYTE, IN WITH THE GOOD BYTE
CHKTR1: AOS BYTSKP ;BUT REMEMBER IT AS A BYTE WE SKIPPED
CHKTRM: JUMPLE C,DONE
JUMPLE Q2,[TQO FEEDME ;ALSO END WHEN SOURCE RUNS OUT
JRST DONE]
XCT LDBTB(P5)
SOJ Q2, ;REMEMBER WE GOT IT
TQNN <XFRLSN> ;PASSING LINE NUMBERS?
JRST CHKLIN ;NOPE, CHECK THIS ONE
STOBYT: CAMN Q1,TRMBYT
JRST [ TQZN <XFR2TM> ;TELL CALLER WE GOT THE TERMINATOR
JRST .+1 ;BUT HE'S NOT INTERESTED IN THE FIRST PLACE,
; AND ONLY WANTS TO DISCARD LINE #S
TQNN <XFRTRM> ;TRANSFER TERMINATOR?
JRST DONE ;NO, SAY WE DIDN'T COPY IT
XCT DPBTB(P5)
SOJA C,DONE]
STOBT1: XCT DPBTB(P5)
SOJA C,CHKTRM ;TRY FOR SOME MORE
CHKLIN: JUMPE Q1,CHKTR1 ;DISCARDING, THEREFORE DISCARD NULLS
LDB Q3,[POINT 12,A,11] ;IS THIS THE FIRST BYTE OF A WORD?
CAIL Q2,4 ;AND ARE THERE ENOUGH DATA TO BE A LINE #?
CAIE Q3,<POINT 7,0,6>_-^D24;YES, FIRST CHARACTER?
JRST STOBYT ;NO TO EITHER, MUST BE REAL DATA
PUSH P,A ;SAVE A
HRRZS A ;ELIMINATE BYTEPOINTER BITS
XCT MOVETB(P5) ;GET THE WORD
POP P,A ;RESTORE A
TXNN Q3,1B35 ;IF BIT 35 ON, THEN A LINE #
JRST STOBYT ;OTHERWISE JUST VALID DATA
SUBI Q2,5 ;SKIP THE REST OF THE WORD AND TAB QUICKLY
TXZ A,77B5 ;"READ" THE 4 CHARS
MOVEI Q3,5 ;REMEMBER WE JUST FORGOT 5 CHARACTERS
ADDM Q3,BYTSKP
JUMPGE Q2,CHKTR0 ;IF ANY LEFT, GO DISCARD THE TAB AFTER THE LSN
TQO <DISCRD,FEEDME> ;NONE THERE - MUST LET CALLER
JRST DONE ; DISCARD IT FOR US
;HERE WHEN CALLER WANTS CR-LF ADDED TO DESTINATION STRING.
CHKCRL: TQZE <DCRNXT> ;TIME FOR A CR?
JRST [ MOVEI Q1,.CHCRT ;YES, LOAD ONE UP
XCT STOBT1 ;STASH BYTE
SOJG C,.+1 ;IF MORE BYTES DO LF NOW
TQO <DLFNXT> ;SAY THAT LF NEEDED NEXT
JRST DONE] ;AND GIVE UP FOR NOW
TQZ <DLFNXT> ;CLEAR LF NEEDED FLAG
MOVEI Q1,.CHLFD ;GET A LF
TQO <DFRSTF> ;REMEMBER THAT THIS RECORD HAS BEEN FROSTED
XCT STOBT1 ;STASH IT
SOJA C,DONE ;AND DONE
; Instruction tables for different mapping modes
; 00 -- monitor to monitor
; 01 -- monitor to user
; 10 -- user to monitor
; 11 -- user to user
LDBTB: ILDB Q1,A
ILDB Q1,A
XCTBU LDBTB
XCTBU LDBTB
DPBTB: IDPB Q1,B
XCTBU DPBTB
IDPB Q1,B
XCTBU DPBTB
BLTTB: CALL XBLTA
CALL BLTMU
CALL BLTUM
CALL BLTUU
SMVITB: XCT Q3 ;FROM MONITOR
XCT Q3 ; SAME
XCTUU Q3 ;FROM USER
XCTUU Q3 ; SAME
DMVITB: XCT Q3 ;TO MONITOR
XCTUU Q3 ;TO USER
XCT Q3 ;TO MONITOR
XCTUU Q3 ;TO USER
MOVETB: MOVE Q3,(A) ;FROM MONITOR
MOVE Q3,(A) ;DITTO
XCTU MOVETB ;FROM USER
XCTU MOVETB ;DITTO
;for XFER36 and XFER8 routines
DMVTB: MOVEM Q2,(T2) ;TO MONITOR
UMOVEM Q2,(T2) ;TO USER
MOVEM Q2,(T2) ;TO MONITOR
UMOVEM Q2,(T2) ;TO USER
DMV1TB: ORM Q2,(T2) ;TO MONITOR
XCTU DMV1TB ;TO USER
ORM Q2,(T2) ;TO MONITOR
XCTU DMV1TB ;TO USER
SMVTB: MOVE Q2,(T1) ;FROM MONITOR
MOVE Q2,(T1) ; SAME
UMOVE Q2,(T1) ;FROM USER
UMOVE Q2,(T1) ; SAME
; Prototype byte blt program
; Note that address designated by .-. are filled in at run time
; also, the LSH and MOVEM instructions at PROTO +4 and +5 have their
; ac fields modified depending on where the LSHC is made to shift right
; or left. Only one of these instructions is modified in either case
; thus the two instruction end up using Q1 if shift left and Q2 if right
; Furthermore, the MOVE's and MOVEM's may be changed to UMOVE or
; UMOVEM's depending on the address space of A and B respectively
PROTO: MOVE Q1,(B) ;Note most rh's are filled at run time
MOVE Q2,1(B) ;Pick up next word
LSH Q1,.-. ;Right justify first word
LSHC Q1,.-. ;Shift to target position+unused bits
LSH Q2,.-. ;Shift back to clear unused bits
MOVEM Q1,(C) ;Store
AOS B
AOS C
AOBJN A,PRG ;Loop
JRST BYTLPD ;Done
LPRG==.-PROTO
ENDSV.
;routine to move bytes a la BYTBLT, but preserving Q1 & Q2, and sets
; a mode bit so it will go fast.
;CALL BZTBLT
; T1/ source pointer
; T2/ target pointer
; T3/ byte count
; T4/ mode bits as defined at start of listing
; returns +1 with T1-T3 updated.
BZTBLT::SAVEAC <Q1,Q2>
SETZB Q1,Q2
TQO <XFRLSN> ;copy line #s
CALL BYTBLT
RET
;move a 36-bit block of data into an 8-bit byte string
;CALL XFER36
;T1/ source addr
;T2/ destination 8-bit byte pointer
;T3/ word count
;T4/ mode
;T4 is preserved.
;returns +1 on failure, with error in T1
;returns +2 on success, with
;T1/ source addr updated
;T2/ destination byte pointer updated
;NOTE if an odd # of words are transferred the low order 4 bits of the last
; 8-bit byte will be zero.
XFER36::STKVAR <EXTRA,MODE,PTR,NBLCKS>
CALL ALIGNX ;transfer until source & destination are word
;aligned
RET ;bad byte pointer
MOVEM T4,MODE ;grab temp
MOVE T4,T3 ;compute # of words left over after
ANDX T4,7 ; the transfer of the blocks
MOVEM T4,EXTRA
LSH T3,-3 ;# of blocks to transfer (c.f. BLTTV)
MOVEM T3,NBLCKS ;save it.
IMULI T3,^D36 ;# of 8-bit bytes to transfer
MOVEM T2,PTR ;current dest. byte pointer
MOVE T2,T3 ;compute what the dest byte pointer
ADJBP T2,PTR ; should be after the blocks are transferred
EXCH T2,PTR ;save that in PTR, get the current b.p. in T2
MOVE T3,NBLCKS ;get # of blocks to transfer
MOVE T4,MODE ;get mode of transfer
CALL BLTTV ;transfer blocks
MOVE T2,PTR ;get the now accurate byte pointer
MOVE T3,EXTRA ;and the # of words left over
CALL B368 ;transfer those remaining words
RETSKP
ENDSV.
;transfer words to 8-bit byte string until none are left or
;the source and destination are word aligned
;CALL ALIGNX
;T1/ source addr
;T2/ destination byte pointer
;T3/ word count
;T4/ mode
;T4 is preserved.
;returns +1 on failure, (bad byte pointer)
;returns +2 on success with
;T1/ updated source addr
;T2/ updated destination byte pointer
;T3/ updated word count
ALIGNX: STKVAR <ADDR,PTR,WRDLFT>
MOVEM T1,ADDR ;save source addr
MOVE T1,T2 ;get byte pointer into T1
CALL GETSIZ ;check byte size
CAIE T1,10 ;is it eight ?
RET ;no. fail.
MOVE T1,T2 ;calculate # of words to transfer
CALL GETPOS ;to get alignment
CAIL T1,10 ;is byte position less than eight
CAIN T1,44 ; AND not equal to thirty-six ?
IFSKP.
LSH T1,-3 ;yes. must transfer some words. calculate :
LSH T1,1 ; (# of bytes left in current target word)*2
CAMG T1,T3 ;is that more than we have ?
IFSKP.
SETZM WRDLFT ;yes. there is nothing left.
ELSE.
SUB T3,T1 ;no. calculate how many words will be left.
MOVEM T3,WRDLFT ;save it
MOVE T3,T1 ;# of words to transfer in T3
ENDIF.
MOVE T1,ADDR ;restore source addr
CALL B368 ;move those words
MOVE T3,WRDLFT ;restore remaining word count
ELSE.
MOVE T1,ADDR ;no. restore source addr
ENDIF.
RETSKP
;moves blocks of words into an 8-bit byte string, assuming that
;the dest. byte string is starting on a word boundary.
;CALL BLTTV
;T1/ source addr
;T2/ dest 8-bit byte pointer
;T3/ # of blocks of words (8 words / block)
;T4/ mode
;preserves T4
;returns +1 always,
; with T1/ updated source addr
BLTTV: SAVEAC <Q1,Q2,Q3>
EXCH T1,T2 ;convert byte pointer
CALL PTRADR ; to address
TRN ;shouldn't happen
EXCH T1,T2 ;restore args
TRNE T4,1 ;destination = monitor ?
IFSKP.
SETZM (T2) ;yes. init first dest word
ELSE.
XCTU [SETZM (T2)] ;no. init first dest word
ENDIF.
;outer loop
BLTTVA: MOVEI Q1,40 ;initialize bit split
;inner loop
BLTTVB: XCT SMVTB(T4) ;get source word into Q2
SETZ Q3, ;zero 2nd source word
AOS T1 ;update source index
LSHC Q2,-44(Q1) ;split source word
LSH Q2,4 ;left justify first part
XCT DMV1TB(T4) ;finish this dest. word - ORM Q2,(T2)
AOS T2 ;update dest index
MOVE Q2,Q3 ;get second part (of split word)
XCT DMVTB(T4) ;start next dest. word - MOVEM Q2,(T2)
SUBI Q1,4 ;update bit split
CAIE Q1,0 ;done with this chunk ?
JRST BLTTVB ;no. continue
;end of inner loop
AOS T2 ;update dest index
SOJG T3,BLTTVA ;do next block
;end of outer loop
RET ;done
;move words into an 8-bit byte string (slowly)
;CALL B368
;T1/ source addr
;T2/ dest. byte pointer
;T3/ word count
;T4/ mode of transfer
;T4 is preserved.
;returns +1 always with
;T1/ updated source addr
;T2/ updated byte pointer
B368: SAVEAC <Q1,Q2,Q3>
B368A: SKIPG T3 ;anything left to do ?
RET ;no.
CALL B368D ;get next word into Q2
RET ;none left.
CALL B368B ;move 32 bits of it to destination
ROTC Q1,4 ;get the low order 4 bits into Q1
CALL B368D ;get next word into Q2
IFNSK.
LSH Q1,4 ;no more words. shift over those 4 bits,
XCT DPBTB(T4) ;put into destination string. - IDPB Q1,T2
RET ;all done
ENDIF.
ROTC Q1,4 ;get high 4 bits around into Q1
XCT DPBTB(T4) ;put into destination string. - IDPB Q1,T2
CALL B368B ;move next 32 bits into dest. string
JRST B368A ;continue
;move the leftmost 32 bits of Q2 into the string pointed to by T2
;returns +1 always
B368B: MOVEI Q3,4 ;loop counter
B368C: ROTC Q1,10 ;get 8 bits into Q1
XCT DPBTB(T4) ;deposit - IDPB Q1,T2
SOJG Q3,B368C ;loop
RET
;get the next word into Q1
;returns +1 on failure (no more words)
;returns +2 on success with T1 & T3 updated
B368D: SOSGE T3 ;any left ?
RET ;no.
XCT SMVTB(T4) ;yes. get next - MOVE Q1,(T1)
AOS T1 ;update source addr
RETSKP
;pack an 8 bit byte string into 36 bit words
;T1/ source byte pointer
;T2/ dest addr
;T3/ byte count
;T4/ mode of transfer
;preserves T4
;returns +2 on success
;returns +1 on failure, (bad byte pointer)
XFER8:: STKVAR <EXTRA,MODE,PTR>
CALL ALIGN ;alignment
RET
MOVEM T4,MODE ;save mode
IDIVI T3,44 ;compute # of blocks -
;4 bytes/word, 11 words/block
MOVEM T4,EXTRA ;save left over byte count
MOVE T4,T3 ;calculate what source byte pointer should
IMULI T4,44 ; be after the
ADJBP T4,T1 ; transfer of the blocks
MOVEM T4,PTR ;and save it.
MOVE T4,MODE ;get mode
CALL BLTVT ;transfer blocks
MOVE T1,PTR ;restore the now accurate source byte pointer
MOVE T3,EXTRA ;transfer the left over bytes
CALL B836
RETSKP
;packs 32 bit bytes into 36 bit words in blocks of nine / eight
;CALL BLTVT
;T1/ source byte pointer
;T2/ dest addr
;T3/ # of blocks
;T4/ mode
;preserves T4
;returns +1 always,
; with T2/ updated dest addr
BLTVT: SAVEAC <Q1,Q2,Q3>
SAVEAC <P3>
SKIPG T3 ;anything to do ?
RET ;no. return.
CALL PTRADR ;convert byte pointer to address
RET ;bad byte pointer, should never happen
;outer loop
BLTVT1: XCT SMVTB(T4) ;transfer first 32 bits
XCT DMVTB(T4)
AOS T1 ;update source index
MOVEI P3,4 ;initialize bit split
BLTVT2: XCT SMVTB(T4) ;get source word
SETZ Q3, ;zero 2nd source word
AOS T1 ;update source index
LSHC Q2,-44(P3) ;split source word
XCT DMV1TB(T4) ;finish this dest. word
AOS T2 ;update dest index
MOVE Q2,Q3 ;get second part of split
XCT DMVTB(T4) ;start next dest. word
ADDI P3,4 ;update bit split
CAIE P3,40 ;done with this chunk ?
JRST BLTVT2 ;no. continue
;end of inner loop
XCT SMVTB(T4) ;get source word
LSH Q2,-4 ;slide it over
AOS T1 ;update source index
XCT DMV1TB(T4) ;put it in
AOS T2 ;update dest index
SOJG T3,BLTVT1 ;if more to do, continue
;end of outer loop
RET ;done
;pack 8 bit bytes into 36 bit words until source & destination are
; word aligned, or until there are no more bytes
;CALL ALIGN
;T1/ source byte pointer
;T2/ dest addr
;T3/ byte count
;T4/ mode
;preserves T4
;returns +2 on success
; with T1/ updated source byte pointer
; and T2/ addr of next dest word
; and T3/ # of bytes left.
;returns +1 on failure (bad byte pointer)
ALIGN: STKVAR <PTR,BYTLFT>
MOVEM T1,PTR ;save
CALL GETSIZ ;is byte
CAIE T1,10 ; size legal ?
RET ;no. failure.
MOVE T1,PTR ;calculate how many
CALL GETPOS ; byte must be transferred to align.
CAIL T1,10 ;is byte position < eight AND
CAIN T1,44 ; not equal to 36 ?
IFSKP.
LSH T1,-3 ;yes. calculate # of bytes left in current word
IMULI T1,^D9 ;# to transfer = 9*that
CAML T3,T1 ;is that more than we have ?
IFSKP.
SETZM BYTLFT ;yes. send all we have. nothing left over.
ELSE.
SUB T3,T1 ;no. calculate left over bytes.
MOVEM T3,BYTLFT ;save it.
MOVE T3,T1 ;get # of bytes to transfer.
ENDIF.
MOVE T1,PTR ;restore source byte pointer
CALL B836 ;move those bytes
MOVE T3,BYTLFT ;restore leftover byte count
ELSE.
MOVE T1,PTR ;no. no bytes to transfer. restore byte pointer
ENDIF.
RETSKP
ENDSV.
;pack 8 bit bytes into 36 bit words (slowly)
;CALL B836
;T1/ source byte pointer
;T2/ dest addr
;T3/ byte count
;T4/ mode
;preserves T4
;returns +1 always with
;T1/ source byte pointer updated
;T2/ dest addr updated
B836: SAVEAC <Q1,Q2,Q3> ;note Q3 used in the LSHC Q2,xxx
SAVEAC <P3> ;P3 used in B836B
B836A: SKIPG T3 ;anything left to do ?
RET ;no. return
SETZ Q3, ;the word we build
CALL B836B ;transfer 4 bytes
RET ;ran out, all is done
CALL B836D ;get next byte
IFNSK.
LSH Q3,4 ;none to get, shift the word over 4
XCT DMVTB(T4) ;put it in the destination
RET
ENDIF.
LSHC Q1,-4 ;split the byte
LSH Q3,4 ;shift the word
OR Q3,Q1 ;put the 4 MSB of the byte in the 4 LSB of the
XCT DMVTB(T4) ;word, and put the word in the destination
AOS T2 ;update destination index
LSHC Q1,4 ;get back the byte.
MOVE Q3,Q1 ;start the next word (don't worry about the
;high 4 bits, they'll be shifted out)
CALL B836B ;transfer 4 bytes
RET ;ran out of bytes, all is done.
XCT DMVTB(T4) ;put the word in the destination.
AOS T2 ;update destination index
JRST B836A ;continue
;...
;...
;get 4 bytes into Q3, if possible. return +2 if 4 bytes were moved into Q3
;if not, shift Q3 by the amount it would be if 4 bytes were moved, and place
;Q3 in destination, and return +1
B836B: MOVEI P3,4
B836C: CALL B836D ;get a byte into Q1
IFSKP.
LSH Q3,10 ;got it. shift word over.
OR Q3,Q1 ;put byte into word.
SOJG P3,B836C ;loop.
RETSKP ;did all four bytes.
ELSE.
LSH P3,3 ;no more bytes. calculate the remaining
;shift for the word
LSH Q3,(P3) ;do it.
XCT DMVTB(T4) ;put word in destination
RET ;didn't do all 4 bytes
ENDIF.
;get next byte into Q1, return +2 if there was a byte, +1 if none
B836D: SOSGE T3 ;any bytes left ?
RET ;no.
XCT LDBTB(T4) ;yes. get one.
RETSKP
;convert byte pointer to address
;CALL PTRADR
;T1/ byte pointer
;returns +1 on failure (invalid byte pointer)
;returns +2 on success with address where the next byte would go in T1
; that is, the address in the pointer, except when the position of the
; pointer is less than the byte size.
;preserves all ACs except T1
PTRADR: STKVAR <PTR,SIZE>
MOVEM T1,PTR ;save byte pointer
CALL GETSIZ ;get byte size
MOVEM T1,SIZE ;save it
MOVE T1,PTR ;get byte pointer
CALL GETPOS ;get byte position
CAIN T1,77 ;illegal ?
RET ; yes.
CAMGE T1,SIZE ;is it at the end of the word ?
AOS PTR ;yes. bump byte pointer
LDB T1,[POINT 6,PTR,5] ;is byte pointer
CAIGE T1,45 ; global ?
IFSKP.
MOVE T1,PTR ;yes. addr is in low 30 bits.
TLZ T1,770000
ELSE.
HRRZ T1,PTR ;no. addr is in low 18 bits
ENDIF.
RETSKP
;SPECIAL ROUTINE USED BY DECNET SERVICE TO MOVE DATA BETWEEN
;NETWORK BUFFERS AND JFN BUFFERS. IT IS MERELY AN INTERFACE TO
;BYTBLT.
;ACCEPTS: T1/ SOURCE POINTER
; T2/ DESTINATION POINTER
; T3/ COUNT
;RETURNS WITH ALL REGS UPDATED AS DESCRIBED IN BYTBLT COMMENTS
NETMOV::SAVEQ ;SAVE PERMANENT REGS
MOVX D,XFRLSN ;PASS LINE NUMBERS AND MONITOR-TO-MONITOR
CALLRET BYTBLT ;AND DO IT
;ATSMOV - SPECIAL ROUTINE USED BY ATS SERVICE TO MOVE DATA BETWEEN
;MONITOR BUFFER AND USER BUFFER.
;ACCEPTS:
; T1/ SOURCE POINTER
; T2/ DESTINATION POINTER
; T3/ COUNT
;RETURNS WITH ALL REGS UPDATED AS DESCRIBED IN BYTBLT COMMENTS
ATSMOV::SAVEQ ;SAVE PERMANENT REGS
MOVX D,XFRLSN!BBLTMU ;PASS LINE NUMBERS AND MONITOR-TO-USER
CALLRET BYTBLT ;AND DO IT
REPEAT 0,< ;HISTORICAL CODE NO LONGER USED
; Dump io
; Parameters and variables
RS(DMPASW) ;Dump buffer assignment word
RS(DMPCNT) ;Dump buffer free count
RS(DMPLCK) ;Dump buffer assignment lock
; Initialize dump io
DMPINI::MOVEI A,NDUMP
MOVEM A,DMPCNT
SETOM DMPLCK
SETCM A,[-1_<^D36-NDUMP>]
MOVEM A,DMPASW
SETZ A,
MOVEI B,DMPBUF
MOVEI C,NDUMP
CALL MSETMP ;MAKE SURE ALL PAGES INITIALLY CLEAR
RET
> ;END OF REPEAT ZERO ON HISTORICAL CODE
; Dump input
; Call: 1 ;Jfn
; 2 ;Pointer to first command
; DUMPI
; Return
; +1 ;Error
; +2 ;Ok
.DUMPI::MCENT
MOVEI P6,[TQNN <READF> ;Executed to discover file access
IOX1 ;Error number for no read access
CALL @DMPID(P3) ; Device dependent routine dispatch
040400000000] ;Memory access needed
DUMPI1: CALL DMPCKJ ;CHECK THE JFN FOR LEGALITY
RETERR () ;NOT A VALID JFN
CALL @JFNID(P3) ;INIT JFN FOR INPUT
UMOVE A,2 ;GET IOWD FOR SERVICE ROUTINE
UMOVE A,(A) ;GET COMMAND
JUMPE A,DUMPI3 ;ZERO MEANS ALL DONE
TLNN A,-1 ;GO TO COMMAND?
JRST DUMPI4 ;YES - HANDLE XFER COMMAND
XMOVEI C,DUMPB ;DUMP BLOCK CO-ROUTINE
CALL @DMPID(P3) ;DO THE DEVICE DEPENDENT STUFF
JRST DUMPIW ;SEE IF WE NEED TO BLOCK
XCTU [AOS A,2] ;STEP THE IOWD
UMOVE A,(A) ;GET NEXT COMMAND
JUMPE A,DUMPI3 ;DONE IF ZERO
TLNN A,-1 ;XFER COMMAND?
JRST DUMPI4 ;YES - HANDLE
CALL UNLCKF ;UNLOCK IN CASE OF COMMAND LIST LOOPS
JRST DUMPI1 ;LOOP
DUMPI3: CALL UNLCKF ;UNLOCK THE JFN
SMRETN ;AND GIVE SUCCESSFUL RETURN
DUMPI4: XCTU [HRRM A,2] ;STORE NEW ADDRS
CALL UNLCKF ;UNLOCK JFN
JRST DUMPI1 ;START OVER
DUMPIW: TQZE <XQTAF> ;EXCEEDED QUOTA?
RETERR (IOX11,<CALL UNLCKF>) ;YES -RETURN ERROR
TQNE <EOFF> ;EOF DETECTED?
RETERR (IOX4,<CALL UNLCKF>) ;YES. SO NOTED
TQZN <BLKF> ;NEED TO BLOCK?
RETERR (,<CALL UNLCKF>) ;NO, ERROR
CALL UNLDIS ;GO DISMIS
JRST DUMPI1 ;TRY AGAIN
; Dump output
; Call: 1 ;Jfn
; 2 ;Pointer to first command
; DUMPO
; Return
; +1 ;Error
; +2 ;Ok
.DUMPO::MCENT
MOVEI P6,[TQNN <WRTF>
IOX2
CALL @DMPOD(P3)
100000000000] ;Memory access needed
DUMPO1: CALL DMPCKJ ;CHECK THE JFN FOR LEGALITY
RETERR () ;NOT A VALID JFN
CALL @JFNOD(P3) ;INIT JFN FOR OUTPUT
UMOVE A,2 ;GET IOWD FOR SERVICE ROUTINE
UMOVE A,(A) ;GET COMMAND
JUMPE A,DUMPO3 ;ZERO MEANS ALL DONE
TLNN A,-1 ;GO TO COMMAND?
JRST DUMPO4 ;YES - HANDLE
XMOVEI C,DUMPB ;DUMP BLOCK CO-ROUTINE
CALL @DMPOD(P3) ;DO THE DEVICE DEPENDENT STUFF
JRST DUMPOW ;SEE IF WE NEED TO BLOCK
XCTU [AOS A,2] ;STEP THE IOWD
UMOVE A,(A) ;GET NEXT COMMAND
JUMPE A,DUMPO3 ;EXIT IF ZERO
TLNN A,-1 ;SEE IF XFER COMMAND
JRST DUMPO4 ;YES - HANDLE
CALL UNLCKF ;UNLOCK IN CASE OF COMMAND LIST LOOPS
JRST DUMPO1 ;SEE IF MORE TO BE DONE
DUMPO3: CALL UNLCKF ;UNLOCK THE JFN
SMRETN ;AND GIVE SUCCESSFUL RETURN
DUMPO4: XCTU [HRRM A,2] ;STORE NEW ADDRS
CALL UNLCKF ;UNLOCK JFN
JRST DUMPo1 ;START OVER
DUMPOW: TQZE <XQTAF> ;EXCEEDED QUOTA?
RETERR (IOX11,<CALL UNLCKF>) ;YES - RETURN ERROR
TQZN <BLKF> ;NEED TO BLOCK?
RETERR (,<CALL UNLCKF>) ;NO, ERROR
CALL UNLDIS ;GO DISMIS
JRST DUMPO1 ;TRY AGAIN
;ROUTINE TO CHECK THE JFN ARGUMENT ON A DUMPI/O JSYS
DMPCKJ: UMOVE JFN,1 ;GET THE JFN
CALL CHKJFN ;CHECK IT
RETBAD ()
JFCL
RETBAD (DESX4)
TQNN <OPNF> ;DEVICE OPENED?
RETBAD (DESX5,<CALL UNLCKF>)
TRC STS,17 ;OPENED IN DUMP MODE?
TRCE STS,17
RETBAD (DUMPX2,<CALL UNLCKF>) ;NO
UMOVE B,2
TXNE B,DM%NWT ;NO-WAIT REQUESTED?
TQOA <NWTF> ;YES, PASS ON BIT
TQZ <NWTF> ;NO
RETSKP ;JFN IS GOOD
;DUMP MODE BLOCK CO-ROUTINE
DUMPB: STKVAR <SAVDEV> ;SAVE DEV
MOVEM DEV,SAVDEV
CALL UNLDIS ;UNLOCK JFN
UMOVE JFN,1 ;RESTORE USER ARG
CALL CHKJFN
RETBAD ()
JFCL
JFCL
CAME DEV,SAVDEV ;CHECK FOR SAME DEVICE
RETBAD (DESX4) ;NOPE THIS IS ILLEGAL
RETSKP ;GOOD RETURN TO PROCEED
REPEAT 0,< ;HISTORICAL CODE NO LONGER USED
; Dump common code
; A/ ADR OF SERVICE ROUTINE TO CALL TO DO THE WORK
; P6/ PTR TO CONSTANTS NEEDED
DUMPC:: STKVAR <DUMPCA,DIOWD,DAOBW,LT1,LT2,LT3>
MOVEM A,DUMPCA ;SAVE ADDRESS OF ROUTINE TO CALL
DUMPC0: UMOVE A,2 ;Get command pointer
TXNE A,DM%FIN ;FINISH-ONLY REQUEST?
JRST [ SETZM DIOWD ;YES, NO BUFFERS TO SETUP
SETZM DAOBW
NOINT
JRST DMPNOP]
UMOVE B,(A) ;And command
JUMPE B,RSKP ;0 IS END OF LIST, RETURN GOOD
JUMPG B,[XCTU [HRRM B,2] ;BRANCH CMND, SET NEW LIST ADR
JRST DUMPC0] ;CONTINUE WITH LIST
MOVEM B,DIOWD ;IOWD FOR COMMAND - SAVE IT
HLRE A,B ;- word count
MOVNS A ;Word count
ADDI A,(B) ;Last address
CAILE A,777777 ;Must not cross end of memory
RETBAD(DUMPX3) ;ERROR IF HAPPENS
MOVEI B,1(B) ;First address
LSH A,-PGSFT ;Last page number
LSH B,-PGSFT ;First page number
SUBM B,A
SOS A ;-# pages
CAMGE A,[-NDUMP]
RETBAD(DUMPX3) ;TOO MANY PAGES
NOINT
DMPSE0: LOCK DMPLCK,<CALL LCKTST>
MOVSI B,400000
ASH B,1(A) ;Get a one for each page needed
HRLZ C,A ;Initial aobjn word
MOVE P3,DMPCNT ;SAVE CURRENT AVAILABLE COUNT
DMPSE1: TDNN B,DMPASW ;Are these contiguous buffers free
JRST DMPSE2 ;Yes, assign them
ROT B,-1 ;No, try next set
AOS C ;Modify aobjn word
JUMPGE B,DMPSE1 ;When low bit wraps around
UNLOCK DMPLCK ;COULDN'T GET BUFFERS, RELEASE LOCK
EXCH A,P3 ;SAVE A, GET ORIGINAL DMPCNT
MOVSI A,0(A)
HRRI 1,DMPTST
MDISMS ;Dismiss until buffers released
MOVE A,P3 ;RECOVER A
JRST DMPSE0 ;Then try again
;"AOBJN" WORD STARTS WITH -NPAGES,,MON BFR NUMBER
DMPSE2: IORM B,DMPASW ;Mark these buffers as taken
ADDM A,DMPCNT ;Decrement count of free buffers
UNLOCK DMPLCK
MOVEM C,DAOBW ;SAVE AOBJN WORD
HRRZ A,DIOWD ;Get user first address-1
AOS A
LSH A,-PGSFT ;Page number
;TOP OF LOOP TO SETUP EACH PAGE IN ONE COMMAND
DMPSE3: MOVEM A,LT1
MOVEM C,LT2 ;SAVE VULNERABLE ACS
LSH A,PGSFT ;GET ADDRESS
XSFM B ;SET FLAGS IN LEFT HALF OF B
TXNE B,PCU ;PREVIOUS CONTEXT WAS USER?
HRLI A,(1B0) ;YES
CALL FPTA ;CONSTRUCT IDENT FOR ADDRESS
DMPSE5: MOVEM A,LT3 ;SAVE IDENT
CALL MRPACS ;Read access of page
JUMPE A,[MOVE A,LT1 ;Non-existent page, create it
LSH A,PGSFT
UMOVE A,(A) ;By referencing it
MOVE A,LT3
JRST DMPSE5]
TDNN A,3(P6) ;Test against needed access
JRST DMPSE4 ;Access not permitted
TLNN A,(1B6) ;Indirect?
JRST DMPSE7 ;No.
MOVE A,LT3 ;YES, TRACK IT DOWN
CALL MRPT ;Get id of page pointed to
JRST DMPSE5 ;Not file, continue
MOVEM A,LT3 ;FILE
JRST DMPSE6
DMPSE7: TLNN A,400 ;Write copy?
JRST DMPSE6 ;No.
MOVE B,3(P6) ;YES, GET ACCESS BITS NEEDED
TLNN B,40000 ;Write?
JRST DMPSE6 ;No.
TLNN A,100000 ;Yes, can we read?
JRST DMPSE4 ;No, must fail
MOVE B,LT1
LSH B,PGSFT
XCTU [MOVES 0(B)] ;WRITE IN PAGE TO MAKE IT PRIVATE
MOVE A,LT1
MOVE C,LT2
JRST DMPSE3 ;Recompute
DMPSE6: HRRZ A,LT2 ;Get buffer number
LSH A,PGSFT
ADDI A,DMPBUF ;Convert to address
MOVE B,A
EXCH A,LT3 ;Save address, get ptn.pn
HRLI B,140000
CALL SETIOP ;MAP AND LOCK PAGE
JRST DMPSE4 ;FAILED, GIVE UP
MOVE C,LT2
MOVE A,LT1 ;RESTORE VULNERABLE ACS
AOS A ;Next page
AOBJN C,DMPSE3 ;LOOP FOR ALL PAGES IN THIS IOWD
MOVE C,DAOBW ;RECOVER AOBJN WORD
MOVEI A,DMPBUF ;Do things the hard way cause macro
ASH A,-PGSFT ;Can't divide externals
ADDI A,(C)
AOS DIOWD
DPB A,[POINT 9,DIOWD,26]; Modify iowd to address monitor buffer
SOS DIOWD
;..
; At this point the dump region has been mapped into the monitor
; Buffer region and access checked
; DIOWD has the iowd needed for the data xfer
; DAOBW has the aobjn word needed to restore buffers when finished
DMPNOP: MOVE A,1(P6) ;GET ERROR CODE
XCT 0(P6) ;TEST STATUS OF JFN
JRST DMPER1
UMOVE B,2
TXNE B,DM%NWT ;NO-WAIT REQUESTED?
TQOA <NWTF> ;YES, PASS ON BIT
TQZ <NWTF> ;NO
MOVE A,DIOWD ;GET IOWD
DMPSDO: CALL @DUMPCA ;CALL DEVICE DEPENDENT ROUTINE
OKINT
TQNE <EOFF>
RETBAD(IOX4) ;FAIL RETURN, EOF
TQNE <ERRF>
RETBAD(IOX5) ;FAIL RETURN, ERROR
RETSKP ;RETURN GOOD
;HERE ON FILE REFERENCE ERRORS (JFN NOT OPEN, ETC). ALL BUFFERS
;MUST BE RELEASED
DMPER1: EXCH A,DAOBW ;SAVE ERROR CODE, GET AOBJN WORD
CALL DMPREL
MOVE 1,DAOBW
RETBAD()
;HERE ON ERRORS SETTING UP BUFFER PAGES. RELEASE WHATEVER HAS BEEN
;ASSIGNED/LOCKED SO FAR.
DMPSE4: MOVE A,LT2
CALL DMPRL1 ;Release buffers assigned but unlocked
HLRE C,LT2
MOVNS C
HRLZS C
MOVE A,DAOBW
ADD A,C
SKIPGE A
CALL DMPREL ;Release buffers both lock and assigned
MOVEI A,DUMPX4
RETBAD() ;ACCESS ERROR
;RELEASE DUMP BUFFERS. CALLED AT INTERRUPT LEVEL AFTER TRANSFER
;COMPLETED.
; A/ IOWD OF LAST XFER
; CALL DMPDON
; RETURN +1 ALWAYS
RESCD
DMPDON::HLRE B,A ;GET COUNT
JUMPGE B,R
;CONSTRUCT "AOBJN" WORD TO IDENTIFY MONITOR BUFFERS
MOVM B,B ;GET POSITIVE COUNT
MOVEI A,1(A) ;A=FIRST ADDRESS
ADD B,A ;B=END ADDRESS
ADDI B,777 ;BUMP TO END OF PARTIAL PAGE
LSH A,-PGSFT ;A=FIRST PAGE
LSH B,-PGSFT ;B=END PAGE
SUBM A,B ;B=NEG PAGE COUNT
MOVEI C,DMPBUF
ASH C,-PGSFT ;C=FIRST MON BUFFER PAGE
SUB A,C ;REMOVE OFFSET
HRL A,B ;PAGE CNT TO LH
CALLRET DMPREL ;NOW RELEASE THEM
;RELEASE DUMP BUFFERS (WINDOW PAGES)
; A/ -NPAGES,,FIRST RELATIVE PAGE
; CALL DMPREL
; RETURN +1 ALWAYS
DMPREL: JUMPE A,R
PUSH P,A
DMPRL0: PUSH P,A
LSH A,PGSFT
MOVEI B,DMPBUF(A)
MOVEI A,0
CALL SETIOP ;UNLOCK AND UNMAP THE PAGE
BUG(DMPRLF)
POP P,A
AOBJN A,DMPRL0
POP P,A
DMPRL1: JUMPE A,R
HLRE B,A
MOVSI C,400000
ASH C,1(B)
MOVNI A,(A)
ROT C,(A)
ANDCAM C,DMPASW
MOVNS B
ADDM B,DMPCNT
RET
> ;END OF REPEAT ZERO ON HISTORICAL CODE
;LCKTST - CALLING ROUTINE FOR LCKTSS SCHEDULER TEST
RESCD
LCKTST::PUSH P,1
MOVE 1,-1(P)
HRLZ 1,-2(1)
HRRI 1,LCKTSS
MDISMS
POP P,1
RET
LCKTSS: AOSE 0(1)
JRST 0(4)
JRST 1(4)
REPEAT 0,< ;MORE HISTORICAL CODE NO LONGER USED
DMPTST: CAML 1,DMPCNT
JRST 0(4)
JRST 1(4)
> ;END OF REPEAT ZERO ON HISTORICAL CODE
SWAPCD
TNXEND
END