Trailing-Edge
-
PDP-10 Archives
-
BB-Y393D-SM
-
monitor-sources/syserr.mac
There are 64 other files named syserr.mac in the archive. Click here to see a list.
; UPD ID= 135, FARK:<4-1-WORKING-SOURCES.MONITOR>SYSERR.MAC.2, 19-Aug-82 10:13:01 by DONAHUE
;Edit 2649 - Get Mcode version for SYSERR block
;<4-1-FIELD-IMAGE.MONITOR>SYSERR.MAC.2, 25-Feb-82 20:48:06, EDIT BY DONAHUE
;UPDATE COPYRIGHT DATE
;<4.MONITOR>SYSERR.MAC.7, 3-Jan-80 08:10:33, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<4.MONITOR>SYSERR.MAC.6, 27-Sep-79 06:58:46, EDIT BY R.ACE
;FIX COMMENT (CHANGE . TO ;)
;<4.MONITOR>SYSERR.MAC.5, 26-Sep-79 15:57:38, EDIT BY HALL
;SYERR - CALL BLTUM1 INSTEAD OF BLTUM FOR EXTENDED ADDRESSING
;<OSMAN.MON>SYSERR.MAC.1, 10-Sep-79 16:06:07, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>SYSERR.MAC.3, 14-Mar-79 10:02:26, EDIT BY KIRSCHEN
;FIX DATA CLOBBERAGE ON LARGE ENTRIES (LARGER THAN SEBBLK)
;<4.MONITOR>SYSERR.MAC.2, 11-Mar-79 13:03:02, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>SYSERR.MAC.1, 19-Dec-78 15:41:41, EDIT BY MURPHY
;ADD BLOCK PRIORITY TO SCHED CALL
;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,1980,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH PROLOG
TTITLE SYSERR
;STRUCTURE OF BLOCK
; WORD 0 - HEADER
DEFSTR SEBCDR,,35,18 ;PTR TO NEXT IN LIST
DEFSTR SEBSIZ,0,17,12 ;SIZE OF THIS BLOCK (INCLUDING HEADER)
DEFSTR SEBCOD,0,5,3 ;STATE CODE
;BLOCK STATE CODES
SBCFRE==0 ;ON FREE LIST
SBCREL==1 ;RELEASED
SBCACT==2 ;ACTIVE
; WORD 1 - LOCAL USAGE
DEFSTR SEBFN,1,35,18 ;FUNCTION TO CALL IN JOB 0
DEFSTR SEBSOF,1,17,12 ;OFFSET TO FREE STRING SPACE
SEBHED==:2 ;FIRST REGULAR HEADER WORD
; WORD 2-5 - SYSERR HEADER
DEFSTR SEHCOD,SEBHED,8,9 ;EVENT CODE
DEFSTR SEHLEN,SEBHED,35,9 ;LENGTH OF BLOCK
DEFSTR SEHTAD,SEBHED+1,35,36 ;DATE AND TIME
DEFSTR SEHUTM,SEBHED+2,35,36 ;UPTIME
DEFSTR SEHSER,SEBHED+3,35,36 ;APRID WORD
SEBDAT==:SEBHED+4 ;FIRST DATA WORD
SBSMAX==400 ;MAX SIZE, JSYS CALL
SEHWD0==1B17+1B23+4B26 ;STANDARD BITS, HEADER WORD
SEBBLK==200 ;SIZE OF LOGICAL BLOCK IN SYSERR FILE
;INITIALIZATION
RESCD
SEBINI::MOVEI T1,SEBBFR ;SETUP FREE AND END-FREE PTRS
MOVEM T1,SEBFRE
MOVEM T1,SEBEFE
MOVEI T1,SEBBSZ ;INIT FREE COUNT
MOVEM T1,SEBFCT
MOVEI T1,SEBQOU ;INIT QUEUE
MOVEM T1,SEBQIN
SETZM SEBQOU ;INIT OUTPUT POINTER ALSO
RET
;ALLOCATE SYSERR BLOCK
; T1/ SIZE (NOT INCLUDING HEADER AND LOCAL DATA)
; T2/ OFFSET TO STRING STORAGE (I.E. SIZE OF HEADER AND DATA)
; CALL ALCSEB
; RETURN +1: FAILURE, NO BUFFER SPACE AVAILABLE
; RETURN +2: SUCCESS, T1/ PTR TO BLOCK
;THIS ROUTINE MAY BE CALLED AT ANY PI LEVEL. IT TURNS THE PI SYSTEM
;OFF WHILE MANIPULATING LISTS, BUT WAS DESIGNED TO MINIMIZE THE
;DURATION OF PI DISABLING. THE FIRST TWO WORDS OF THE RETURNED BLOCK
;ARE USED FOR LOCAL PURPOSES AS DEFINED ABOVE. THE ACTUAL SYSERR
;DATA BEGINS IN THE THIRD WORD AND CONSTITUTES THE REMAINDER OF THE BLOCK.
ALCSEB::CONSZ PI,PIPION ;PI NOW ON?
SKIPA T3,[PION] ;YES
MOVX T3,<JFCL> ;NO, REMEMBER STATE
ADDI T1,SEBDAT ;INCLUDE SPACE FOR HEADER
ASUBR <ARG1,ARG2,PIF>
ALCSE1: MOVN T2,T1 ;GET NEGATIVE OF DESIRED SIZE
MOVEI T3,SEBBFR ;SETUP IN CASE WRAPAROUND
MOVNI T4,SEBBFR+SEBBSZ ; "
PIOFF ;INTO THE TUNNEL....
CAMLE T1,SEBFCT ;ENOUGH SPACE FOR REQUEST?
JRST ALCSEX ;DEFINITELY NOT
ADD T1,SEBFRE ;COMPUTE END OF BLOCK
CAIL T1,SEBBFR+SEBBSZ ;ENOUGH SPACE BEFORE END?
JRST ALCSE2 ;NO
ADDM T2,SEBFCT ;UPDATE FREE COUNT
EXCH T1,SEBFRE ;UPDATE FREE POINTER
XCT PIF ;RESTORE PI
ALCSE3: HRLZ T2,T1 ;CLEAR BLOCK--SOURCE
HRRZS T1 ;CLEAR SECTION NUMBER
HRRI T2,1(T1)
HRRZ T3,T1
ADD T3,ARG1 ;SIZE
SETZM 0(T1)
BLT T2,-1(T3)
MOVE T2,ARG1 ;GET SIZE
STOR T2,SEBSIZ,(T1) ;PUT IN BLOCK
MOVX T2,SBCACT ;SET CODE TO ACTIVE
STOR T2,SEBCOD,(T1)
MOVE T2,ARG2 ;INIT STRING STG PTR
ADDI T2,SEBDAT ;MAKE RELATIVE TO BLOCK ORIGIN
STOR T2,SEBSOF,(T1)
RETSKP ;DONE
;HERE IF SPACE TO END OF BUFFER INSUFFICIENT FOR CURRENT REQUEST
ALCSE2: ADD T4,SEBFRE ;COMPUTE (NEG) SPACE TO END OF BUFFER
ADDM T4,SEBFCT ;ASSIGN IT
EXCH T3,SEBFRE ;WRAPAROUND FREE POINTER
XCT PIF ;RESTORE PI
MOVN T4,T4 ;GET POS COUNT
CAMN T4,ARG1 ;EQUAL TO REQUEST?
JRST [ MOVE T1,T3 ;YES, CAN USE BLOCK JUST ASSIGNED
JRST ALCSE3]
STOR T4,SEBSIZ,(T3) ;SET SIZE OF BLOCK
PIOFF
EXCH T3,SEBRLQ ;PUT BLOCK ON LIST TO BE RELEASED
STOR T3,SEBCDR,@SEBRLQ
XCT PIF ;RESTORE PI
AOS SECHKF ;WAKEUP JOB 0 FOR RELEASE
MOVE T1,ARG1 ;GET ORIG REQUEST. HAVE DONE WRAPAROUND
JRST ALCSE1 ; OF BUFFER, GO TRY REQUEST AGAIN
;HERE IF INSUFFICIENT SPACE IN BUFFER FOR REQUESTED BLOCK
ALCSEX: XCT PIF ;RESTORE PI
RET
;RELEASE SYSERR BLOCK
; T1/ PTR TO BLOCK
; CALL RELSEB
; RETURN +1 ALWAYS, BLOCK RELEASED
SWAPCD
RELSEB::CAME T1,SEBEFE ;RELEASING CONTIGUOUS BLOCK?
JRST [ MOVX T2,SBCREL ;NO, SET CODE TO RELEASED
STOR T2,SEBCOD,(T1) ;LEAVE BLOCK TO BE PICKED UP LATER
RET]
RELSE1: MOVX T2,SBCFRE ;SET CODE TO FREE
STOR T2,SEBCOD,(T1)
LOAD T2,SEBSIZ,(T1) ;GET SIZE
ADD T1,T2 ;COMPUTE END ADR OF BLOCK
CAIN T1,SEBBFR+SEBBSZ ;END OF BUFFER?
MOVEI T1,SEBBFR ;YES, WRAPAROUND
MOVEM T1,SEBEFE ;UPDATE END-FREE POINTER
ADDM T2,SEBFCT ;UPDATE FREE COUNT
LOAD T2,SEBCOD,(T1) ;CHECK CODE OF NEXT BLOCK
CAME T1,SEBFRE
CAIE T2,SBCREL ;RELEASED?
RET ;NO, DONE
JRST RELSE1 ;YES, APPEND IT TO FREE LIST
;JOB 0 FUNCTION TO RELEASE BLOCKS ON RELEASE QUEUE
SEBRBB: SKIPN SEBRLQ ;ANYTHING ON QUEUE?
RET ;NO
PIOFF
LOAD T1,SEBCDR,@SEBRLQ ;GET NEXT ITEM
EXCH T1,SEBRLQ
PION
CALL RELSEB ;RELEASE IT
JRST SEBRBB ;DO ALL ITEMS
;QUEUE SYSERR BLOCK FOR JOB 0.
; T1/ PTR TO BLOCK
; CALL QUESEB
; RETURN +1 ALWAYS, BLOCK QUEUED
;MAY BE CALLED AT ANY PI LEVEL.
RESCD
QUESEB::CONI PI,T2 ;SAVE PI STATE
SETZRO SEBCDR,(T1) ;MARK NEW END OF LIST
PIOFF
STOR T1,SEBCDR,@SEBQIN ;APPEND TO END OF QUEUE
MOVEM T1,SEBQIN ;UPDATE END PTR
TXNE T2,PIPION ;PI WAS ON?
PION ;YES, RESTORE IT
AOS SECHKF ;FIRE UP JOB 0
RET
;UNQUEUE NEXT ITEM FROM SYSERR JOB 0 QUEUE
; CALL UNQSEB
; RETURN +1: NOTHING LEFT ON QUEUE
; RETURN +2: SUCCESS, T1/ PTR TO BLOCK
SWAPCD
UNQSEB::SKIPN T1,SEBQOU ;ANYTHING IN QUEUE?
RET ;NO
PIOFF
LOAD T1,SEBCDR,(T1) ;YES, GET CDR
JUMPN T1,.+3 ;QUEUE BECOMING EMPTY?
MOVEI T2,SEBQOU ;YES, FIX IN PTR
MOVEM T2,SEBQIN
EXCH T1,SEBQOU
PION
RETSKP
;COPY DATA AND STRINGS INTO SYSERR BLOCK
; T1/ POINTER TO BLOCK
; T2/ -N,,ADR - PTR TO LIST OF ITEMS
; CALL SEBCPY
; RETURN +1: FAILURE (NO CASES AT PRESENT)
; RETURN +2: SUCCESS
;THIS ROUTINE MOVES DATA INTO THE SYSERR BLOCK AND ALLOCATES STRING
;STORAGE AS NEEDED.
RESCD
SEBCPY::SAVEQ
DMOVEM T1,Q1 ;KEEP BLK PTR, LIST PTR IN Q1, Q2
SEBCP1: LOAD T4,SEBOFS,(Q2) ;GET OFFSET FOR NEXT ITEM
ADDI T4,SEBDAT(Q1) ;MAKE POINTER TO ACTUAL WORD
MOVEI T3,@0(Q2) ;GET POINTER TO DATA
LOAD T1,SEBTYP,(Q2) ;GET DATA TYPE
CAIGE T1,NSBTTB ;LEGAL?
JRST @SBTTB(T1) ;DISPATCH
LOAD T4,SEHCOD,(Q1) ;GET EVENT CODE INTO T4
BUG(SEBUDT,<<T1,D>,<T4,D>>)
SEBCP9: AOBJN Q2,SEBCP1 ;LOOP FOR ALL ITEMS
RETSKP ;DONE
;POINTER TYPE DISPATCH TABLE. POINTER CODES CHECKED HERE ALTHOUGH
;DEFINED IN PROLOG. CONFLICTING DEFINITION WILL PRODUCE
;MULDEF GLOBAL DURING LINK
SBTTB: PHASE 0
SBTWD:: IFIW!SEBCP2 ;FULL WORD
SBTSTR::IFIW!SEBCP3 ;STRING (ASCIZ)
SBTEVC::IFIW!SEBCP4 ;EVENT CODE
SBTFNA::IFIW!SEBCP5 ;FUNCTION ADDRESS
DEPHASE
NSBTTB==.-SBTTB
;DISPATCH ON POINTER TYPE IS EXECUTED WITH:
; T3/ POINTER TO DATA ITEM
; T4/ POINTER TO WORD IN SYSERR BLOCK
;FULL WORD
SEBCP2: MOVE T1,0(T3) ;GET DATA
MOVEM T1,0(T4) ;PUT INTO BLOCK
JRST SEBCP9 ;DONE
;STRING - ALLOCATE STORAGE AT END OF BLOCK, COPY STRING, SET POINTER
SEBCP3: HRLI T3,(POINT 7,0) ;MAKE BYTE PTR TO SOURCE STRING
LOAD T2,SEBSOF,(Q1) ;GET OFFSET TO FREE STRING STG
MOVEI T1,-SEBDAT(T2) ;MAKE PTR RELATIVE TO DATA AREA
MOVEM T1,0(T4) ;PUT PTR IN BLOCK
LOAD T4,SEBSIZ,(Q1) ;GET SIZE OF BLOCK
SUB T4,T2 ;COMPUTE FREE SPACE LEFT
JUMPLE T4,SEBCP7 ;JUMP IF NONE
IMULI T4,5 ;COMPUTE NUMBER BYTES LEFT
ADDI T2,0(Q1) ;MAKE PTR TO DESTINATION STRING
HRLI T2,(POINT 7,0) ;MAKE BYTE PTR
SEBCP8: SOJL T4,[SETZ T1, ;SPACE EXHAUSTED, TERMINATE
DPB T1,T2 ;STRING AS IS
JRST SEBCP7]
ILDB T1,T3 ;COPY A BYTE
IDPB T1,T2
JUMPN T1,SEBCP8 ;COPY UNTIL NULL TERMINATOR
MOVEI T2,1(T2) ;DONE, GET ADR OF NEXT FREE WORD
SUBI T2,0(Q1) ;COMPUTE PTR TO FREE SPACE
STOR T2,SEBSOF,(Q1) ;UPDATE BLOCK
JRST SEBCP9 ;DONE
;HERE IF INSUFFICIENT STORAGE FOR STRING
SEBCP7: BUG(SEBISS)
LOAD T1,SEBSIZ,(Q1) ;UPDATE FREE STRING PTR
STOR T1,SEBSOF,(Q1)
JRST SEBCP9
;EVENT CODE
SEBCP4: STOR T3,SEHCOD,(Q1) ;CODE IS IMMEDIATE
JRST SEBCP9
;FUNCTION ADDRESS
SEBCP5: STOR T3,SEBFN,(Q1) ;STORE IMMEDIATE VALUE
JRST SEBCP9
;JSYS TO LOG INFORMATION IN SYSERR FILE
; T1/ ADDRESS OF BLOCK
; T2/ SIZE OF BLOCK
; SYERR
; RETURN +1: SUCCESS. ITRAP IF FAILURE
SWAPCD
.SYERR::MCENT
MOVE T1,CAPENB
TXNN T1,SC%WHL+SC%OPR+SC%MNT ;CAPS?
ITERR CAPX1
UMOVE T1,T2 ;GET SIZE
CAIL T1,1 ;REASONABLE?
CAIL T1,SBSMAX
ITERR SYEX1 ;NO
MOVE T2,T1 ;ALLOW NO EXTRA STRING STG
NOSKED
CALL ALCSEB ;ALLOCATE A BLOCK
ITERR (SYEX2,<OKSKED>) ;NO ROOM
OKSKED
PUSH P,T1 ;SAVE BLOCK POINTER
MOVEI T3,SEBHED(T1) ;SETUP BLT PTR - DEST
UMOVE T1,T2 ;GET COUNT
UMOVE T2,T1 ;USER BUFFER ADDRESS
CALL BLTUM1 ;DO BLT FROM USER TO MONITOR
POP P,T1 ;RESTORE BLOCK POINTER
CALL QUESEB ;QUEUE BLOCK
MRETNG ;RETURN GOOD
;START SYSERR LOGGING FORK - CALLED FROM JOB 0 ONLY
SERINI::MOVX T1,1B1 ;XMIT CAPABILITIES
CFORK
BUG(SERFRK)
MOVEI T2,SEBRUN ;START PC
MSFRK ;START IN EXEC MODE
RET
;MAIN SYSERR LOGGING LOOP.
;JOB 0 FORK STARTED HERE AT SYSTEM STARTUP
SEBRUN::MOVX T1,UMODF ;INIT CONTEXT
MOVEM T1,FFL
SETZM FPC
MCENTR
CALL SEBOFI ;OPEN SYSERR FILE
JRST SEBLUP ;CAN'T - KEEP GOING ANYHOW
MOVE T1,SEBJFN ;CLOSE IT
CLOSF
JFCL
SEBLUP: MOVEI T1,SEBTST
MOVSI T2,FHV1 ;LOW PRIORITY
HDISMS
SETZM SECHKF ;CLEAR FLAG
CALL SEBRBB ;PROCESS RELEASE QUEUE
CALL SEBCHK ;PROCESS QUEUE
JRST SEBLUP
RESCD
SEBTST: SKIPN SECHKF
JRST 0(4)
JRST 1(4)
SWAPCD
;INITIALIZATION - OPEN SYSERR LOG FILE
SEBOFI: TRVAR <NEWFLG>
SETZM NEWFLG ;NO NEW SYSERR FILE YET
MOVE T1,TODCLK
CAMGE T1,SEIETM ;AT LEAST 1 MINUTE AFTER PREVIOUS FAILURE?
RET ;NO, RETURN FAILURE
MOVX T1,GJ%OLD+GJ%PHY+GJ%SHT
HRROI T2,SEFLNM
GTJFN ;TRY FOR EXISTING SYSERR FILE
JRST SEBOF1 ;THAT VERSION FAILED, TRY NEXT ONE
SEBOF3: MOVEM T1,SEBJFN ;SAVE JFN
MOVX T2,OF%RD+OF%WR
OPENF
JRST [ MOVE T1,SEBJFN ;BAD VERSION, TRY NEXT ONE
RLJFN
JFCL
SKIPE NEWFLG ;WERE TRYING FOR NEW FILE?
JRST SEBOF2 ;YES, DISASTER
JRST SEBOF1] ;NO, TRY FOR NEW VERSION
MOVE T1,SEBJFN
HRLI T1,.FBBYV
MOVX T2,<MASKB 6,11> ;SPECIFY BYTE SIZE FIELD
MOVX T3,^D36B11 ;SET IT TO 36-BIT BYTES
CHFDB
RETSKP
SEBOF1: MOVX T1,GJ%FOU+GJ%PHY+GJ%SHT
HRROI T2,SEFLNM
GTJFN ;TRY FOR NEW VERSION
JRST SEBOF2 ;TOTAL LOSS
SETOM NEWFLG ;NOTE NEW FILE STARTED
JRST SEBOF3
SEBOF2: BUG(SERGOF)
MOVX T1,^D60000 ;COMPUTE 1 MINUTE FROM NOW
ADD T1,TODCLK
MOVEM T1,SEIETM ;WON'T TRY AGAIN UNTIL THEN
RET ;RETURN FAILURE
SEFLNM: ASCIZ /<SYSTEM>ERROR.SYS/
;ROUTINE TO COPY SYSERR BLOCKS FROM BUFFER INTO FILE
; CALL SEBCHK
;CALLED UNDER JOB 0 ONLY.
SEBCHK::TRVAR <SEBOAD,SEBFBN,SEBWDN,SEBFOF,SEBOLN,SEBOID>
SETZM SEBFOF ;NOTE SYSERR FILE NOT OPEN
SEBCH0: CALL UNQSEB ;UNQUEUE NEXT BLOCK
JRST [ SKIPN SEBFOF ;NONE, SYSERR FILE OPEN?
RET ;NO, DONE.
MOVE T1,SEBJFN ;YES, CLOSE IT
CLOSF
JFCL
RET]
MOVEM T1,Q1 ;Q1 HOLDS PTR TO BLOCK
SKIPN SEBFOF ;SYSERR FILE OPEN?
CALL SEBOFI ;NO, OPEN IT
SKIPA ;FAILED, FILE NOT OPEN
SETOM SEBFOF ;NOTE FILE NOW OPEN
LOAD T4,SEBFN,(Q1) ;GET FUNCTION
MOVE T1,Q1 ;SETUP BLOCK ADR FOR CALL
SKIPE T4 ;ONE GIVEN?
CALL 0(T4) ;YES, CALL IT
SKIPN SEBFOF ;FILE OPEN?
JRST SEBCHX ;NO, FORGET REST OF PROCEDURE
LOAD Q2,SEBSOF,(Q1) ;GET FINAL LENGTH OF BLOCK
MOVEI T1,-SEBDAT(Q2) ;LENGTH OF BODY ONLY
STOR T1,SEHLEN,(Q1) ;SET LENGTH
SUBI Q2,SEBHED ;LESS LOCAL HEADER
MOVEM Q2,SEBOLN ;SAVE ORIGINAL LENGTH
MOVX T1,SEHWD0 ;GET HEADER BOILERPLATE
IORM T1,SEBHED(Q1) ;PUT IN HEADER
CALL LGTAD ;GET DATE AND TIME (FRACTION)
STOR T1,SEHTAD,(Q1)
SUB T1,TADIDT ;COMPUTE UPTIME IN UNIVERSAL UNITS
STOR T1,SEHUTM,(Q1)
;**;[2649] Change 1 line at SEBCH1:-8.L PED 19-AUG-82
CALL GAPRIM ;[2649] GET APRID WORD
STOR T1,SEHSER,(Q1)
MOVEI T1,SEBHED(Q1) ;SETUP PTR TO FIRST WORD TO BE MOVED
MOVEM T1,SEBOAD
MOVE T1,SEBJFN ;THE SYSERR FILE JFN
MOVE T2,[1,,.FBSIZ] ;READ CURRENT EOF POINTER
MOVEI T3,SEBFBN ;INTO SEBFBN
GTFDB
SEBCH1: MOVE T1,SEBFBN ;COMPUTE PAGE NUMBER AND WORD FOR APPEND
IDIVI T1,PGSIZ
MOVEM T1,SEBFBN ;SAVE PAGE NUMBER
MOVEM T2,SEBWDN ;SAVE WORD NUMBER
HRL T1,SEBJFN ;CONSTRUCT PAGE IDENT
MOVEM T1,SEBOID ;SAVE IT
CALL JFNOFN
JRST SEBCHX ;LOSE - DISCARD DATA
MOVE T2,[PTRW+FPG2A]
CALL SETMPG ;MAP FILE PAGE
MOVE T1,SEBWDN ;GET WORD NUMBER
IDIVI T1,SEBBLK ;GET WORD WITHIN SYSERR BLOCK
JUMPG T2,SEBCH2 ;FIRST WORD?
MOVE T3,SEBWDN ;YES, STORE POINTER
MOVEI T4,1 ;POINT TO THIS ENTRY UNLESS
CAME Q2,SEBOLN ;NOT AT BEGINNING
ADD T4,Q2 ;POINT TO END OF THIS ENTRY
CAIL T4,SEBBLK ;WILL THIS ENTRY USE THE ENTIRE BLOCK ?
MOVEI T4,-1 ;YES, MARK NO NEW ENTRY STARTS IN THIS BLOCK
TLO T4,775000 ;SET HIG ORDER BITS TO INDICATE START OF BLOCK
MOVEM T4,FPG2A(T3)
AOS SEBWDN ;NOTE ONE ADDITIONAL WORD USED IN FILE
MOVEI T2,1 ;ACCOUNT FOR POINTER WORD
; ..
;SEBCHK...
SEBCH2: MOVN T2,T2 ;COMPUTE SPACE LEFT IN CURRENT SYSERR BLK
ADDI T2,SEBBLK
MOVE T1,Q2 ;GET SPACE NEEDED FOR OUTPUT BLOCK
CAMLE T1,T2 ;LESS THAN SPACE AVAILABLE?
MOVE T1,T2 ;NO, USE ALL SPACE AVAILABLE
SUB Q2,T1 ;UPDATE REMAINING OUTPUT COUNT
HRLZ T2,SEBOAD ;GET POINTER TO OUTPUT DATA
ADDM T1,SEBOAD ;UPDATE FOR WORDS BEING DONE
HRR T2,SEBWDN ;MAKE BLT PTR
ADDM T1,SEBWDN ;UPDATE FILE PTR FOR WORDS BEING DONE
HRRI T2,FPG2A(T2) ;MAKE PTR TO FILE WINDOW PAGE
ADDI T1,0(T2) ;COMPUTE ADR OF END
BLT T2,-1(T1) ;COPY DATA
SETZ T1, ;UNMAP FILE WINDOW
MOVEI T2,FPG2A
CALL SETMPG
MOVE T1,SEBOID ;GET IDENT OF FILE PAGE
MOVEI T2,1 ;UPDATE IT TO DISK
UFPGS
JFCL
MOVE T3,SEBFBN ;COMPUTE NEW EOF PTR
IMULI T3,PGSIZ
ADD T3,SEBWDN
MOVEM T3,SEBFBN
JUMPG Q2,SEBCH1 ;LOOP IF MORE IN OUTPUT BLOCK
MOVE T3,SEBFBN ;GET FINAL EOF PTR
SETO T2, ;PUT IT IN FDB
MOVE T1,SEBJFN
HRLI T1,.FBSIZ
CHFDB
SEBCHX: MOVE T1,Q1 ;BLOCK DONE, RELEASE IT
CALL RELSEB
JRST SEBCH0 ;TRY FOR ANOTHER BLOCK
TNXEND
END