Trailing-Edge
-
PDP-10 Archives
-
BB-4170G-SM
-
sources/io.mac
There are 60 other files named io.mac in the archive. Click here to see a list.
;<3A.MONITOR>IO.MAC.7, 25-Aug-78 17:09:34, EDIT BY HELLIWELL
;CALL ULKSTR INSTEAD OF DIRECTLY DECREMENTING STRLK
;<3A.MONITOR>IO.MAC.6, 8-Mar-78 16:38:52, EDIT BY MILLER
;FIX UNLDS1 TO JUMP TO EMRET0 ON ERRF SET
;<3A.MONITOR>IO.MAC.5, 2-Mar-78 12:48:16, 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
;<3A.MONITOR>IO.MAC.3, 2-Mar-78 08:10:59, EDIT BY MILLER
;SINR CODE MUST INSURE ALL OF RECORD IS IN BEFORE ABORTING
;<3A.MONITOR>IO.MAC.2, 27-Feb-78 14:23:08, Edit by BORCHEK
;fix dumpo doing goto words wrong at dumpo4+2
;<4.MONITOR>IO.MAC.1, 13-Oct-77 15:47:52, EDIT BY MILLER
;COMBINE TRVAR AND STKVAR IN SIN
;<3-MONITOR>IO.MAC.217, 13-Oct-77 08:30:46, EDIT BY MILLER
;CHECK FOR PRIMARY I/O PROPERLY
;<3-MONITOR>IO.MAC.216, 12-Oct-77 13:51:51, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-MONITOR>IO.MAC.215, 11-Oct-77 12:04:01, EDIT BY OSMAN
;PUT SEMICOLON ON BEGINNING OF LINE STARTING ";CHECK FOR FEBWT"
;<3-MONITOR>IO.MAC.214, 29-Sep-77 17:05:00, EDIT BY MILLER
;CHECK FOR FEBWT IN UNLDSN
;<3-MONITOR>IO.MAC.213, 8-Sep-77 09:51:46, EDIT BY HURLEY
;<3-MONITOR>IO.MAC.212, 7-Sep-77 19:06:37, EDIT BY HURLEY
;<3-MONITOR>IO.MAC.211, 7-Sep-77 16:11:57, EDIT BY P.HURLEY
;SPEED UP CHKJFN AND UNLCKF
;<3-MONITOR>IO.MAC.210, 29-Aug-77 10:08:39, EDIT BY MILLER
;FIX MISORDERING OF TRVAR AND STKVAR IN SOUT CODE
;<3-MONITOR>IO.MAC.209, 23-Aug-77 12:53:38, EDIT BY MILLER
;MAKE SPECIAL CHECK FOR FE DISMISS
;<3-MONITOR>IO.MAC.208, 12-Aug-77 11:19:57, Edit by HESS
;FIX BYTBLT TO HANDLE POINTERS WITH INDEX FIELDS
;<3-MONITOR>IO.MAC.207, 18-Jul-77 08:33:26, EDIT BY MILLER
;ADD INTERFACE ROUTINE TO BYTBLT FOR DECNET CODE
;<3-MONITOR>IO.MAC.206, 11-Jul-77 09:41:34, Edit by HESS
;TCO 1836 - SIN/SOUT TO CHECK FOR OPEN FILE
;<3-MONITOR>IO.MAC.205, 30-Jun-77 13:43:46, EDIT BY HURLEY
;MADE SIN1 GO TO UNL ON EOF TO PREVENT NUL FROM BEING ATTACHED TO END
;<3-MONITOR>IO.MAC.204, 20-Jun-77 13:08:50, EDIT BY MILLER
;MAKE BYTBLT DO BYTE-AT-A-TIME FOR INDEXED OR INDIRECT BYTE POINTERS
;<3-MONITOR>IO.MAC.202, 7-Jun-77 13:56:13, EDIT BY MILLER
;MAKE RECOUT BLOCK IF REQUESTED
;<3-MONITOR>IO.MAC.201, 28-May-77 23:17:58, Edit by MCLEAN
;FIX BYTBLT FOR EXTENDED ADDRESSING AGAIN (SRCHLL)
;<3-MONITOR>IO.MAC.200, 27-May-77 14:53:02, EDIT BY MILLER
;UNLCKF NEEDS TO CHECK IF TTY OR PTY JFN WAS REASSIGNED
;<3-MONITOR>IO.MAC.199, 10-May-77 15:10:36, EDIT BY MILLER
;FINISH SPEED UP CHANGES FOR DN64
;<3-MONITOR>IO.MAC.198, 2-May-77 20:33:36, EDIT BY BOSACK
;<3-MONITOR>IO.MAC.197, 6-Apr-77 20:36:47, Edit by HESS
;<3-MONITOR>IO.MAC.196, 6-Apr-77 13:11:48, Edit by HESS
;TCO 1770 - ADD BLOCK CO-ROUTINES
;<3-MONITOR>IO.MAC.195, 28-Mar-77 18:02:23, Edit by MCLEAN
;REMOVE XHLLI IT IS BROKEN
;<3-MONITOR>IO.MAC.194, 28-Mar-77 13:43:46, Edit by HESS
;FIX BOUT TO SET UP DEV CORRECTLY FOR UPDLEN CALL
;<3-MONITOR>IO.MAC.193, 7-Mar-77 22:34:12, Edit by MCLEAN
;ADD XHLLI TO CORRECT SECTION NUMBER FOR BYTE POINTERS
;<3-MONITOR>IO.MAC.192, 7-Mar-77 22:30:24, Edit by MCLEAN
;<3-MONITOR>IO.MAC.191, 5-Mar-77 19:04:47, Edit by MCLEAN
;<3-MONITOR>IO.MAC.190, 23-Feb-77 20:06:16, EDIT BY HALL
;TCO 1740 - CHANGED CHKJFN'S REFERENCE TO TTFORK TO A CALL TO TTYSRV
;<3-MONITOR>IO.MAC.189, 9-Feb-77 15:16:35, Edit by MCLEAN
;<3-MONITOR>IO.MAC.188, 9-Feb-77 15:11:38, Edit by MCLEAN
;FIX BYTBLT D CONTAINED LEFT HALF JUNK
;<3-MONITOR>IO.MAC.187, 7-Feb-77 21:04:29, Edit by HESS
;TCO 1726 - FIX TO SIMULTANEOUS UPDATE EOF PROBLEM
;<3-MONITOR>IO.MAC.185, 3-Feb-77 21:10:49, Edit by MCLEAN
;<3-MONITOR>IO.MAC.184, 3-Feb-77 14:42:47, Edit by MCLEAN
;<3-MONITOR>IO.MAC.183, 2-Feb-77 17:53:25, Edit by MCLEAN
;<3-MONITOR>IO.MAC.182, 2-Feb-77 16:42:23, Edit by MCLEAN
;<3-MONITOR>IO.MAC.181, 2-Feb-77 16:18:08, Edit by MCLEAN
;<3-MONITOR>IO.MAC.180, 2-Feb-77 15:21:39, Edit by MCLEAN
;<3-MONITOR>IO.MAC.179, 28-Jan-77 14:08:28, Edit by MCLEAN
;<3-MONITOR>IO.MAC.178, 23-Jan-77 20:18:57, Edit by MCLEAN
;<3-MONITOR>IO.MAC.177, 23-Jan-77 14:58:47, Edit by MCLEAN
;<3-MONITOR>IO.MAC.176, 23-Jan-77 14:55:46, Edit by MCLEAN
;<3-MONITOR>IO.MAC.175, 15-Jan-77 17:54:18, Edit by MCLEAN
;<3-MONITOR>IO.MAC.174, 15-Jan-77 17:28:42, Edit by MCLEAN
;<3-MONITOR>IO.MAC.173, 13-Jan-77 15:28:52, Edit by MCLEAN
;<3-MONITOR>IO.MAC.172, 28-Dec-76 22:28:36, Edit by MCLEAN
;<3-MONITOR>IO.MAC.171, 27-Dec-76 17:33:03, EDIT BY HURLEY
;<3-MONITOR>IO.MAC.170, 28-Nov-76 12:51:19, Edit by MCLEAN
;<3-MONITOR>IO.MAC.169, 27-Nov-76 22:54:59, Edit by MCLEAN
;<3-MONITOR>IO.MAC.168, 26-Nov-76 20:18:43, Edit by MCLEAN
;<3-MONITOR>IO.MAC.167, 26-Nov-76 16:31:24, Edit by MCLEAN
;<2-MONITOR>IO.MAC.166, 24-Nov-76 14:25:34, EDIT BY WERME
;TCO 1667 - FIX BYTINA TO NOT DISCARD NULL IF IT'S THE FIRST BYTE OF AN ASCII FILE
;<2-MONITOR>IO.MAC.165, 31-Oct-76 13:50:44, EDIT BY HURLEY
;FIX BYTBLT TO USE XBLTUU INSTEAD OF XCTU
;<2-MONITOR>IO.MAC.164, 28-Oct-76 16:54:12, Edit by HESS
;FIX QUOTA EXCEDED INTERUPT PC BACKUP (UNLDIS)
;<2-MONITOR>IO.MAC.163, 21-Oct-76 09:46:03, Edit by HESS
;TCO 1610 - DUMPI/DUMPO IMPROVEMENTS
;<2-MONITOR>IO.MAC.162, 18-Oct-76 19:04:34, EDIT BY HURLEY
;TCO 1607 - MAKE PROPER TEST FOR LH = -1 IN SIN
;<2-MONITOR>IO.MAC.161, 13-Oct-76 13:36:21, EDIT BY HURLEY
;TCO 1592 - MAKE SOUT INTERRUPTABLE EVERY PAGE
;MAKE OVER QUOTA NOT CLOBBER AC 1 ON ERROR
;<2-MONITOR>IO.MAC.160, 11-Oct-76 09:24:28, EDIT BY HURLEY
;TCO 1583 - MAKE MAGTAPE WAITS BE DONE WITH HDISMS
;<2-MONITOR>IO.MAC.159, 9-Aug-76 17:00:47, Edit by HESS
;<2-MONITOR>IO.MAC.158, 6-Aug-76 09:41:30, EDIT BY HURLEY
;CHANGING GETFPD TO RETURN A 36 BIT DIR NUMBER
;<HESS>IO.MAC.3, 2-Aug-76 16:39:51, Edit by HESS
;TCO 1478 -- QUOTA CHECKING
;<1MILLER>IO.MAC.11, 8-Jul-76 17:33:23, EDIT BY MILLER
;<1MILLER>IO.MAC.10, 8-Jul-76 14:47:08, EDIT BY MILLER
;<1MILLER>IO.MAC.9, 8-Jul-76 08:26:08, EDIT BY MILLER
;FIX UP ROUTINES RELATED TO DISMOUNTED STRUCTURES
;<1MILLER>IO.MAC.8, 7-Jul-76 14:20:43, EDIT BY MILLER
;<1MILLER>IO.MAC.7, 7-Jul-76 14:08:46, EDIT BY MILLER
;ADD LUNLK0 ROUTINE
;<1MILLER>IO.MAC.6, 7-Jul-76 09:26:27, EDIT BY MILLER
;FIX REGISTER USAGE IN DMOCHK AND STRDMO
;<1MILLER>IO.MAC.5, 6-Jul-76 16:43:28, EDIT BY MILLER
;MAKE STRDMO INTERNAL
;<1MILLER>IO.MAC.4, 6-Jul-76 15:57:17, EDIT BY MILLER
;MAKE LUNLKF INTERNAL
;<1MILLER>IO.MAC.3, 6-Jul-76 14:21:12, EDIT BY MILLER
;USE STR TO GET STRUCTURE NUMBER
;<1MILLER>IO.MAC.2, 6-Jul-76 12:19:23, EDIT BY MILLER
;<1MILLER>IO.MAC.1, 6-Jul-76 12:03:24, EDIT BY MILLER
;ADD STRDMO, AND DMOCHK AND CALL THEM FROM CHKJFN
;<2-MONITOR>IO.MAC.1, 17-Jun-76 11:54:42, EDIT BY MILLER
;REMOVE SJFN. ADD MLJFN
;<1B-MONITOR>IO.MAC.154, 14-JUN-76 16:05:38, EDIT BY HURLEY
;<1B-MONITOR>IO.MAC.153, 14-JUN-76 14:53:07, EDIT BY JMCCARTHY
;TCO 1409 - MAKE CHKJFN UNDERSTAND DEVICE DESIGNATORS THAT ARE
;TERMINALS
;<1B-MONITOR>IO.MAC.152, 10-JUN-76 17:49:37, EDIT BY HURLEY
;TCO 1398 - MAKE BOUTA ALWAYS CLEAR BLKF IF SET.
;<1MONITOR>IO.MAC.151, 23-MAR-76 16:53:14, EDIT BY HURLEY
;<1MONITOR>IO.MAC.150, 23-MAR-76 15:16:26, EDIT BY HURLEY
;TCO 1206 - CHANGE ERROR CODE OF DSKJFN FROM PMAPX1 TO DESX8
;<1MONITOR>IO.MAC.149, 10-MAR-76 12:08:09, EDIT BY MILLER
;<1MONITOR>IO.MAC.148, 3-MAR-76 15:30:04, EDIT BY MILLER
;TCO 1147. ON ERRF, UNLOCK FILE AND RETURN IMMEDIATELY
;<2MONITOR>IO.MAC.147, 16-JAN-76 17:49:19, EDIT BY MURPHY
;<2MONITOR>IO.MAC.146, 7-JAN-76 19:07:39, EDIT BY HURLEY
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION
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
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
CHKJFD::TDZA D,D ;REMEMBER TO SKIP DISMOUNTED CHECK
CHKJFN::SETO D, ;CHECK FOR DISMOUNTED STRUCTURE
CAIN JFN,.PRIIN ;PRIMARY INPUT?
HLRZ JFN,PRIMRY ;YES. GET INPUT JFN
CAIN JFN,.PRIOU ;PRIMARY OUTPUT?
HRRZ JFN,PRIMRY ;YES. GET OUTPUT JFN
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
NOSKED ;NOW CHECK IF STR IS STILL MOUNTED
LOAD A,FILUC,(JFN) ;GET STR UNIQUE CODE
LOAD P5,STR,(JFN) ;GET STR NUMBER
SKIPN P5,STRTAB(P5) ;GET THE SDB ADDRESS
JRST [ OKSKED ;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 [ OKSKED ;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
OKSKED ;ALLOW OTHER SCHEDULING AGAIN
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 CHKJF7 ;No, garbage designator
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: MOVE A,JOBNO
HLLZ DEV,JOBPT(A) ;GET CONTROLLING TTY NUMBER
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
;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 CHKJ8A
TQNN <FRKF> ;Test for file restricted to one fork
JRST CHKJF9
CHKJ2B: HLRZ A,FILVER(JFN)
PUSH P,D ;SAVE THE ENTRY FLAG
CALL SKIIF ;OWNER INFERIOR TO THIS FORK?
JRST CHKJF8 ;NO, ACCESS ILLEGAL
POP P,D ;RESTOR THE ENTRY FLAG
CHKJF9: MOVE DEV,FILDEV(JFN) ;Set up dev
HRRZ P3,DEV
SETZB F,P5
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: POP P,0(P) ;CLEAN UP THE STACK
CHKJ8A: UNLOCK FILLCK(JFN)
OKINT
CHKJFB: MOVEI A,DESX3
RET
CHKJF1: JUMPGE JFN,CHKJF6
HLRZ A,JFN ;GET LEFT HALF
CAIE A,600000+.DVTTY ;TTY DESIGNATOR?
JRST CHKJF0 ;NO
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: POP P,JFN ;RESTORE GOOD DESIGNATOR
HRRZ P3,DEV
RETSKP
CHKJF0: CAML JFN,[777777,,0]
HRLI JFN,440700 ;Insert if lh = 777777
CAMGE JFN,[444500,,0]
JRST CHKJF6
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 (,<ULKDIR
CALL UNLCKF>)
HRRZ T2,.FBPRT(T1) ;GET PROTECTION
LOAD T1,FILUC,(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,FILUC,(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:: MOVEM A,LSTERR
JRST ITRAP
;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
NOSKED ;PROTECT DATA BASES
CALL DMOCHK ;CHECK STRUCTURE
RETBAD (DESX10,<OKSKED>) ;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: OKSKED ;ALLOW SCHEDULING
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
DMOCHK::LOAD C,FILUC,(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
; 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
AOSE FILLCK(1)
JRST SLBIN0
CALL STRDMO ;VERIFY STRUCTURE
JRST SLBIN1 ;BEEN DISMOUNTED
MOVE STS,FILSTS(1)
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>
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 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
SIN00: SKIPG FILCNT(JFN) ;ANY BYTES IN BUFFER?
JRST SIN1 ;NO, DO IT THE SLOW WAY
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
MOVE A,FILBYT(JFN) ;SOURCE POINTER
UMOVE B,2 ;TARGET
MOVX D,FLINPT!BBLTMU ;FROM FILE, COPY MONITOR TO USER
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
MOVEM A,FILBYT(JFN)
CALL UNLCKF ;UNLOCK FILE TO ALLOW INTS
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.
; 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
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]
CALL SIND ;DEPOSIT THE BYTE
CALL SIONXT ;Test for end of string
JRST SINTT1 ;Not end, continue
JRST UNL ;ALL DONE
SIN1: CALL BYTINA ;Read a byte from the source
JRST SINW ;SERVICE ROUTINE WANTS TO BLOCK
SKIPLE SINRF ;DOING SINR ABORT?
JRST SIN00 ;YES. GO CHECK THEN
JUMPE B,[TQNN <EOFF>
XCTU [SKIPN 3]
JRST UNL
JRST .+1]
CALL SIND ;DEPOSIT THE BYTE
CALL SIONXT ;Test for end of string
JRST SIN00 ;Not end, continue
JRST UNL ;ALL DONE
;LOCAL ROUTINE USED BY ABOVE TO DEPOSIT BYTE
SIND:
XCTBUU [IDPB B,2] ;Deposit the byte
RET
SIN4: CALL UNLCKF ;UNLOCK THE LOCKS
JRST SIN2 ;GO ADD NULL TO END
SIN3: XCTU [SKIPE 3] ;NON-ZERO COUNT CASE?
JRST MRETN ;YES, RETURN
SIN2: SETZ B, ;GET A NULL TERMINATOR
UMOVE A,2
XCTBU [IDPB B,A]
JRST MRETN
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
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 <STRSRC> ;BYTE POINTER IN JFN?
JRST SIOR23 ;YES, IGNORE FILCNT
CAML C,FILCNT(JFN) ;KEEP MIN OF THIS
MOVE C,FILCNT(JFN) ;AND BYTES IN BUFFER
SKIPA Q2,FILCNT(JFN) ;GET LENGTH OF SOURCE STRING FOR LINE # REMOVER
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
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
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
BYTINA: JUMPGE STS,NOTOPN
BYTIA1: CALL BYTINX ;GET A BYTE
RET ;ERROR - PASS DOWN THE LINE
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
CAIN A,<POINT 7,0,6>_-^D24;FIRST BYTE?
CAIGE C,4 ;ENUF FOR A LINE #?
RETSKP ;NO TO ONE, LET IT THRU
;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 [ MOVE A,FILBYN(JFN);NOT A LINE NUMBER. FIRST CHAR?
SOJE A,BYTIA3 ;IF SO, SKIP THIS NONSENSE IN THE FUTURE
RETSKP] ;NOT FIRST, RETURN THIS BYTE
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
BYTIA3: TQO <PASLSN> ;HERE IF WE DECIDE FILE ISN'T SEQUENCED
RETSKP ;RETURN CURRENT BYTE
;SUBROUTINE CALLED ONLY BY BYTINA:
BYTINX: TQNN <READF>
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,<BYTINA: BLKF SET BEFORE CALLING SERVICE ROUTINE>)
XMOVEI C,BYTINB ;BYTIN BLOCK ROUTINE
MOVE D,SAVJFN ;ORIGINAL JFN
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
TQNE <ERRF>
JRST INERR
TQNE <EOFF>
JRST INEOF
MOVE B,A
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: PUSH P,T2 ;SAVE JFN RETURNED
CALL UNLDIS ;UNLOCK JFN & DISMISS
POP P,JFN ;RESTORE JFN
CALL CHKJFN ;RE-VALIDATE IT
RETBAD ()
JFCL
JFCL
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: TQNE <ERRF> ;IS ERROR UP?
JRST [ FILINT (IOX5) ;YES. GIVE INTERRUPT
CALL UNLCKF ;ALLOW INTERRUPT TO TAKE
MOVEI A,IOX5 ;IF HE PROCEEDS, GEN ERROR
JRST EMRET0] ;AND RETURN
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
MOVE B,MPP ;RETURN PC POINTER
SOS -1(B) ;BACK UP PC TO INSTR
MOVE C,0(B) ;PICK UP FLAGS
TLNE C,(UMODF) ;USER MODE PC?
SOS -3(B) ;YES - TWO PC'S THEN
MOVE A,BITS+.ICQTA ;GET CHANNEL BITS
CALL IICSLF ;CAUSE INTERUPT
UNLDSN: CALL UNLCKF ;UNLOCK THE FILE AND DO AN OKINT
;INTERUPT WILL HAPPENED IF POSTED
POP P,A ;GET BACK ARG
HRRZ B,A ;GET ADDRESS OF ROUTINE BEING CALLED
CAIE B,FEBWT ;FE INPUT WAIT?
CAIN B,FEDOBE ;FE DEVICE WAIT?
JRST UNLFE ;YES. GO DO SPECIAL HANDLING
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
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.
UNLFE: 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
SOSGE FILCNT(1)
JRST SLBOU2
CALL STRDMO ;VERIFY STRUCTURE
JRST SLBOU1 ;BEEN DISMOUNTED
AOS C,FILBYN(1)
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
IDPB 2,FILBYT(1)
CALL LUNLKF ;FREE UP FILE
JRST MRETN
SLBOU2: AOS FILCNT(1)
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 A,101
DOBE
HRROI A,[ASCIZ /
?/]
PSOUT
MOVEI A,100
;CFIBF
UMOVE 1,1
JRST PSOUT1
; 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>
MOVEM Q2,SOUTRF ;SAVE SOUTR FLAG
JUMPGE 2,SOUT0
MOVSI C,440700
CAML 2,[777777,,0]
XCTU [HLLM C,2]
SOUT0: 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: SKIPG FILCNT(JFN)
JRST SOUT1 ;DO IT THE OLD WAY
MOVE B,FILBYT(JFN) ;TARGET IS FILE
UMOVE A,2 ;SOURCE IS USER
MOVX D,XFRLSN!BBLTUM ;ALWAYS PASS LSNS (THERE AREN'T ANY)
CALL SIOR2
UMOVEM A,2
MOVEM B,FILBYT(JFN)
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
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
CALL UNLCKF ;NO. ERROR
JRST EMRET0] ;AND EXIT
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
CALL APPNUL ;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: CALL SOUTB ;OUTPUT THE BYTE
JRST [ JUMPN A,SOUT0 ;DEVICE BLOCKED, START OVER
JRST SOUTRR] ;ALL THROUGH
JRST SOUTT1 ;LOOP BACK FOR ALL BYTES
;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 APPNUL
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,<BYTOUA: BLKF SET BEFORE CALL TO SERVICE ROUTINE>)
XMOVEI C,BYTOUB ;CO-ROUTINE ADDRS
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
MOVEI C,0
TLZ JFN,7700
TLO JFN,700
CAMN JFN,-1(P) ;HAVE ASCII BYTE PTR
XCTBU [IDPB C,JFN] ;YES, APPEND NULL
POP P,C
POP P,JFN
RET
;ROUTINE TO BLOCK FOR BYTOUT SERVICE ROUTINES
BYTOUB: PUSH P,T2 ;SAVE JFN RETURNED
CALL UNLDIS ;UNLOCK JFN & DISMISS
POP P,JFN ;RESTORE JFN
CALL CHKJFN
RETBAD () ;GARBAGE
JFCL
JFCL
RETSKP ;GIVE GOOD RETURN
; 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
BYTBLT::STKVAR <<TEMPA,3>,SAVQ3,SAVP6,SAVP5,SAVP3,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
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 <XFRLSN> ;SKIPPING LINE NUMBERS?
TQNE <XFR2TM> ;OR UP TO A TERMINATOR?
JRST CHKTRM ;Yes TO EITHER, look for it
TLNN B,7700 ;Zero byte size?
JRST BYTLP ;Well...if you insist
MOVE Q1,B ;Compare target
XOR Q1,A ;To source
TLNN Q1,7700 ;And if byte size differs
CAIG C,20 ;Or short transfer
JRST BYTLP ;Do byte at a time
LDB Q2,[POINT 6,B,11] ;Get byte size
MOVEM Q2,BYTSIZ ;Save it
ROT Q2,-6 ;Position in p field
LP1: SOJL C,DONE ;Until cnt < 0
XCT LDBTB(P5) ;Do transfer bytes
XCT DPBTB(P5)
CAMG Q2,B ;Until less than 1 byte remains in tgt
JUMPGE Q2,LP1 ;Loop unless bytesize >= 32
;(once is always enough)
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
HLLO Q1,A ;Get source...prevent borrows
SUB Q1,B ;When getting bit offset
ROT Q1,6
ANDI Q1,77 ;Retain just the position difference
JUMPN Q1,BYTBL1 ;Move word at a time
DMOVEM A,TEMPA ;SAVE A-C
MOVEM C,2+TEMPA
AOS Q3,B ;CALCULATE DESTINATION ADDRS
TLZ Q3,777740 ;SAVE EFFECTIVE ADDRS
TXO Q3,<XMOVEI C,> ;CONS INSTRUCTION
XCT DMVITB(P5) ;GET ADDRS
AOS Q3,A ;CALCULATE SOURCE ADDRS
TLZ Q3,777740
TXO Q3,<XMOVEI B,> ;BUILD INSTR
XCT SMVITB(P5) ;GET ADDRS
MOVE A,Q2 ;NUMBER OF WORDS TO MOVE
ADDM Q2,TEMPA ;UPDATE SRC / DEST POINTERS
ADDM Q2,1+TEMPA
XCT BLTTB(P5) ;CORRECT BLT ROUTINE
DMOVE A,TEMPA ;RESTORE REGS
MOVE C,2+TEMPA ;...
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,SAVP3
MOVE P5,SAVP5
MOVE P6,SAVP6
RET
; Transfer a word at a time
; Q1/ POSITION OFFSET (RIGHT SHIFT AMOUNT)
; Q2/ WORD COUNT
; 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
MOVE Q3,A ;COPY POINTER (SOURCE)
TLZ Q3,777740 ;CLEAR ALL BUT EFFECTIVE ADDRS
TXO Q3,<MOVEI P3,> ;BUILD INSTR
XCT SMVITB(P5) ;GET ADDRS
HRRM P3,0+PRG ;STORE FOR FIRST MOVE
AOS P3 ;ADDRS OF SECOND MOVE
HRRM P3,1+PRG ;STORE IT
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 ;...
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
MOVE Q3,B ;POINTER TO DESTINATION
TLZ Q3,777740 ;CLEAR ALL BUT EFFECTIVE ADDRS
TXO Q3,<MOVEI P3,> ;BUILD INSTR
XCT DMVITB(P5) ;GET ADDRS
HRRI P6,1(P3) ;ADDRS OF MOVEM
MOVEM P6,5+PRG ;AND NEW MOVEM INST
HRRM Q1,3+PRG ;Fill in lshc amount
ADDM Q2,B ;Update target
ADDM Q2,A ;And source
TRNE D,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 D,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
BYTLPD: MOVE A,TEMPA ;RESTORE SOURCE POINTER
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]
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
; 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
; 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,.-.(A) ;Note most rh's are filled at run time
MOVE Q2,.-.(A) ;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,.-.(A) ;Store
AOBJN A,PRG ;Loop
JRST BYTLPD ;Done
LPRG==.-PROTO
;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
; Dump io
; Parameters and variables
NDUMP==10
RS(DMPASW) ;Dump buffer assignment word
RS(DMPCNT) ;Dump buffer free count
RS(DMPLCK) ;Dump buffer assignment lock
NRP(DMPBUF,NDUMP*1000) ;Dump buffers
; 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
; 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
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: CALL UNLDIS ;UNLOCK JFN
UMOVE JFN,1 ;RESTORE USER ARG
CALL CHKJFN
RETBAD ()
JFCL
JFCL
RETSKP ;GOOD RETURN TO PROCEED
; 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(CHK,DMPRLF,<DMPREL-FAILED TO RELEASE PAGE>)
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
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)
DMPTST: CAML 1,DMPCNT
JRST 0(4)
JRST 1(4)
SWAPCD
TNXEND
END