Trailing-Edge
-
PDP-10 Archives
-
BB-M080E-SM
-
monitor-sources/io.mac
There are 60 other files named io.mac in the archive. Click here to see a list.
;Edit 3039 to IO.MAC by CJOHNSON on Mon 7-Nov-83, for SPR #18471
; Don't restore .DVDES form, use .TTDES form internally
;Edit 2907 - Prevent file corruption when SOUTing 4 bit bytes
; UPD ID= 266, FARK:<5-1-WORKING-SOURCES.MONITOR>IO.MAC.4, 14-Dec-82 08:07:31 by DONAHUE
;Edit 2887 - Set a flag in TRPDSP when leaving BYTBLT
; UPD ID= 169, FARK:<5-1-WORKING-SOURCES.MONITOR>IO.MAC.3, 14-Oct-82 09:14:02 by DONAHUE
;Edit 2834 - Prevent ILMNRF from IDPB near SINW
; UPD ID= 49, FARK:<5-WORKING-SOURCES.MONITOR>IO.MAC.2, 20-May-82 16:09:33 by DONAHUE
;Edit 2621 - Prevent ILMNRF at ILDB in SIN1
; UPD ID= 374, SNARK:<5.MONITOR>IO.MAC.12, 5-Jan-82 09:02:27 by GRANT
;TCO 5.1649 - Add NSP null message checking
; 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
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
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
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
LOCK STRLOK ;PREVENT DISMOUNTING
LOAD A,FILUC,(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
;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
;**;[3039] Replace one line at CHKGTY:+0L CRJ 7-Nov-83
CHKGTY: ADJSP P,-1 ;[3039] Keep .TTDES form (avoid OWGBP muddle)
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 (,<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
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,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
; 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: CALL BYTINS ;Read a byte from the source
JRST SINW ;SERVICE ROUTINE WANTS TO BLOCK
TQZE <RECF> ;EOR ENCOUNTERED?
JRST [ SKIPG SINRF ;ABORTING A SINR?
JRST SIN00 ;NO. PROCEED AS USUAL THEN
CALL UNLCKF ;YES.
JRST SIN03] ;TERMINATE THEN
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
;**;[2621] Add 2 lines at SIN1:+7L PED 20-MAY-82
ERJMP [ FILINT (ILLX02) ;[2621] IF ERROR RETURN PROPER CODE
EMRETN (ILLX02,<CALL UNLCKF>)] ;[2621]
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
;**;[2834] Add 2 lines at SINW:+6L PED 14-OCT-82
ERJMP [ FILINT (ILLX02) ;[2834] SEE INTERRUPT
EMRETN (ILLX02)];[2834] 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
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
;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:
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(BLKF1)
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: TQNE <ERRF> ;IS ERROR UP?
JRST [ FILINT (IOX5) ;YES. GIVE INTERRUPT
CALL UNLCKF ;ALLOW INTERRUPT TO TAKE
MOVEI A,IOX5 ;IF HE PROCEEDS...
JRST EMRET0] ; 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
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 T1,101
DOBE
RFPOS ;GET POSITION ON LINE
HRROI T1,[ASCIZ /
/]
TRNE T2,-1 ;ALREADY AT BEGINNING OF LINE?
PSOUT ;NO, GET THERE
MOVEI T1,"?" ;ERROR CHARACTER
PBOUT
MOVEI T1,100
CFIBF
IMCALL PSOUT ;OUTPUT THE MESSAGE
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>
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: 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
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
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: 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(BLKF2)
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
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
; 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,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
LDB Q1,[POINT 6,A,5] ;GET SOURCE P FIELD
LDB Q2,[POINT 6,B,5] ;GET TARGET P FIELD
CAIGE Q1,45 ;IS SOURCE A OWGBP?
CAIL Q2,45 ;NO...IS TARGET A OWGBP?
JRST BYTLP ;YES OR YES...DO A BYTE AT A TIME
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
;..
;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 UNLESS THE FIRST WORD OF THE TARGET HAS
;BEEN FILLED.
;..
LDB Q2,[POINT 6,B,11] ;Get byte size
MOVEM Q2,BYTSIZ ;Save it
;**;[2907] Delete 1 line at LP1:-1 PED 4-FEB-83
LP1: SOJL C,DONE ;Until cnt < 0
XCT LDBTB(P5) ;Do transfer bytes
XCT DPBTB(P5)
;**;[2907] Add 1 line, Change 1 at LP1:+3L PED 4-FEB-83
LDB Q1,[POINT 6,B,5] ;[2907] Get number of bits remaining in word
CAMG Q2,Q1 ;[2907] Until less than 1 byte remains in tgt
JUMPGE Q2,LP1 ;Loop unless bytesize >= 32
;(once is always enough)
;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.
HLLO Q1,A ;Get source...prevent borrows
TLO Q1,77 ;MORE BORROW PROTECTION
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
;..
;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
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
;**;[2887] ADD 3 LINES AT BYTLP:-6L PED 13-DEC-82
EXCH A,TRPDSP ;[2887] SET FLAG
TXO A,TRPSTK ;[2887] IN TRPDSP
EXCH A,TRPDSP ;[2887] TO SAY WE'VE LEFT BYTBLT
XCT BLTTB(P5) ;CORRECT BLT ROUTINE
;**;[2887] ADD 2 LINES AT BYTLP:-2L PED 13-DEC-82
MOVX A,TRPSTK ;[2887] TURN OFF THE FLAG
XORM A,TRPDSP ;[2887] IN TRPDSP
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
;**;[2887] Add 4 lines at BYTERR:+0L PED 13-DEC-82
BYTERR: MOVE Q1,TRPDSP ;[2887] CHECK TRPDSP TO SEE
TXNE Q1,TRPSTK ;[2887] IF FLAG WAS SET
ADJSP P,-1 ;[2887] IT WAS - ADJUST STACK
SETZM TRPDSP ;[2887] ZERO TRPDSP
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)
TLZ Q3,777740 ;CLEAR ALL BUT EFFECTIVE ADDRS
TXO Q3,<XMOVEI B,> ;BUILD INSTR
XCT SMVITB(P5) ;GET ADDRS
;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
TLZ Q3,777740 ;CLEAR ALL BUT EFFECTIVE ADDRS
TXO Q3,<XMOVEI C,> ;BUILD INSTR
XCT DMVITB(P5) ;GET ADDRS
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
; 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
;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