Trailing-Edge
-
PDP-10 Archives
-
BB-H506D-SM_1983
-
sort/source/srtuuo.mac
There are 7 other files named srtuuo.mac in the archive. Click here to see a list.
SUBTTL SRTUUO - TOPS-10 SPECIFIC PART OF SORT/MERGE
SUBTTL D.M.NIXON/DMN/DZN/BRF 5-Jun-81
;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, 1981 BY DIGITAL EQUIPMENT CORPORATION
IFN FTOPS20,<PRINTX ? SRTUUO should not be present in TOPS-20 SORT/MERGE.>
IFN FTPRINT,<PRINTX [Entering SRTUUO.MAC]>
SUBTTL TABLE OF CONTENTS FOR SRTUUO
; Table of Contents for SRTUUO
;
;
; Section Page
;
; 1 SRTUUO - TOPS-10 SPECIFIC PART OF SORT/MERGE ............. 1
; 2 TABLE OF CONTENTS FOR SRTUUO ............................. 2
; 3 DEFINITIONS
; 3.1 TOPS-10 Specific Parameters ....................... 3
; 4 PSORT.
; 4.1 DEFCOR - Default Memory Allocation Algorithm ...... 4
; 4.2 SETSTR - Set Up Temporary Disk Structures ......... 6
; 5 GETREC
; 5.1 GETBUF - Input 1 Physical Buffer .................. 9
; 6 PUTREC
; 6.1 PUTBUF - Output 1 Physical Buffer ................. 10
; 7 FILE UTILITY ROUTINES
; 7.1 Close Master Input/Output File .................... 11
; 7.2 Delete, Rename a File ............................. 12
; 7.3 Open Output Temporary File ........................ 13
; 7.4 Open Input Temporary File ......................... 14
; 7.5 Enter a File ...................................... 15
; 7.6 Append to Temporary File .......................... 16
; 7.7 Delete a Temporary Structure ...................... 17
; 7.8 Lookup a Temporary File ........................... 18
; 7.9 Build a Buffer Ring ............................... 19
; 7.10 Reformat Buffer Pool for Next Merge ............... 20
; 8 CHANNEL MANAGEMENT
; 8.1 SETCHN ............................................ 21
; 8.2 GETCHN ............................................ 22
; 8.3 FRECHN ............................................ 23
; 8.4 RETCHN ............................................ 24
; 9 ERROR MESSAGES ........................................... 25
SUBTTL DEFINITIONS -- TOPS-10 Specific Parameters
;PARAMETER DEFINITIONS NEEDED ONLY ON TOPS10
.TBS==203 ;SIZE OF TEMP FILE BUFFERS
;SYMBOLS NOT YET IN FIELD IMAGE UUOSYM
.GTLBS==165 ;[C18] DSK LARGE BUFFER GETTAB TABLE
.TFLNV==12 ;[C25] NEW PULSAR LABEL TYPE NOT IN UUOSYM
FO.UOC==1B2 ;[N12] USE ALREADY OPEN CHANNEL IN FILOP.
SEGMENT IMPURE ;[C20]
FLPARG: BLOCK .FOLEB+1 ;[C19] FILOP. BLOCK
PTHARG: BLOCK 3 ;[404] PATH.
GOBARD: BLOCK 5 ;[404] GOBSTR DSK
GOBARS: BLOCK 5 ;[404] GOBSTR SYS
SYSARG: BLOCK 1 ;[404]
M7.00: BLOCK 1 ;[N12] SET NON-ZERO IF MONITOR IS 7 SERIES
XCHNO.: BLOCK 1 ;[N12] NO. OF EXTENDED CHANNELS AVAILABLE PER USER
SEGMENT HPURE ;[C20]
SUBTTL PSORT. -- MONSPC - Monitor Specific Tests
BEGIN
PROCEDURE (PUSHJ P,MONSPC)
MOVE T1,[%CNVER] ;[N12] CONFIG TABLE
GETTAB T1, ;[N12]
SETZ T1, ;[N12] MUST BE VERY OLD
LDB T2,[POINT 5,T1,23] ;[N24] [N12] MONITOR VERSION NO.
CAIN T2,7 ;[N24] [N12] TEST FOR 7.00 SERIES MONITOR
HRRZM T1,M7.00 ;[N24] [N12] SAVE VERSION # AS FLAG IF TRUE
MOVE T1,[%CNHXC] ;[N12] GETTAB FOR NO. OF EXTENDED CHANS
GETTAB T1, ;[N12]
SETZ T1, ;[N12] NONE IF NOT IMPLEMENTED
MOVEM T1,XCHNO. ;[N12] NEEDED FOR CHANNEL ALLOCATION ROUTINE
RETURN ;[N12]
END;
SUBTTL PSORT. -- DEFCOR - Default Memory Allocation Algorithm
BEGIN
PROCEDURE (PUSHJ P,DEFCOR)
COMMENT \
CALCULATE USER MINIMUM CORE SIZE FROM
DOUBLE BUFFERING + AT LEAST 16 RECORDS IN CORE
IF V/M SYSTEM THEN
IF USER MIN. GREATER THAN USER VIRTUAL LIMIT THEN ERROR
ELSE GET USER CORMAX
IF USER CORE MAX. LESS THAN USER PHY. LIM. THEN USER PHY. LIM. = USER CORMAX
IF USER MIN. GREATER THAN USER PHY. LIM.
THEN DEFAULT SIZE = USER MIN.
ELSE IF USER PHY LIM. LESS THAN 1/2 SYSTEM CORMAX
THEN DEFAULT SIZE = USER PHY. LIM.
ELSE IF USER MIN. GREATER THAN 1/2 SYSTEM CORMAX
THEN DEFAULT SIZE = USER MIN
ELSE DEFAULT SIZE = 1/2 SYSTEM CORMAX
ELSE SYSTEM DOES NOT HAVE V/M THEN
IF USER MIN. GREATER THAN USER CORMAX THEN ERROR
ELSE IF USER MIN. GREATER THAN 1/2 SYSTEM CORMAX
THEN DEFAULT SIZE = USER MIN
ELSE IF USER CORMAX GREATER THAN 1/2 SYSTEM CORMAX
THEN DEFAULT SIZE = 1/2 SYSTEM CORMAX
ELSE DEFAULT SIZE = USER CORMAX
\
PUSH P,P1 ;[C20] GET AN AC FOR CORE SIZE
PUSH P,P2 ;[C20] GET AN AC FOR HIGH SEG SIZE
HRRZ P1,.JBFF## ;[C20] [C13] CURRENT SIZE OF LOW SEGMENT
HRRZ P2,.JBHRL## ;[C23] [C20] [C13] CALCULATE SIZE OF HIGH SEGMENT
JUMPE P2,$1 ;[C23] NONE
TRZ P2,400000 ;[C23] ASSUME IT STARTS AT 400000
MOVE T1,[XWD -2,.GTUPM] ;[C23] IN CASE GETTAB FAILS
GETTAB T1, ;[C23] ..
JRST $1 ;[C23] ..
HLRZS T1 ;[C23] ..
TRZ T1,PGMSK ;[C23] ..
HRRZ T2,T1 ;MUST GUARD AGAINST EXECUTE-ONLY HIGH SEG
LSH T2,-<POW2(PGSIZ)> ; SUCH AS FOROTS
HRLI T2,.PAGCA ;SO USE PAGE. UUO TO FIND OUT
PAGE. T2, ; IF WE CAN READ THAT PAGE
TXO T2,PA.GRD ;IF PAGE. UUO FAILED ASSUME WE CAN
TXNN T2,PA.GRD ;CAN WE READ IT?
JRST $2 ;NO, USE .JBHRL
HLRZ P2,.JBHRN(T1) ;[C23] ..
IFN FTFORTRAN,<
JUMPN P2,$2 ;[N08] BUG IN FOROTS V6 MAKES THIS ZERO
HRRZ P2,.JBHRL ;[N08] USE WHATS IN JOBDAT INSTEAD
SUBI P2,(T1) ;[N08] REMOVE BASE TO GET LENGTH
$2%>
TRZE P2,PGMSK ;[C20] [C13] ..
ADDI P2,PGSIZ ;[C20] [C13] ..
IFE FTKL10!FTKI10,< ;ROUND UP TO K BOUNDARY ON KA10
TRNE P2,PGSIZ ;[C20] [C13] ..
SKIPE CPU ;[C13] ..
SKIPA ;[C13] ..
ADDI P2,PGSIZ ;[C20] [C13] ..
>
$1% ;[C23]
IFN FTKI10!FTKL10,< ;[N08] CHECK FOR VMDDT ALSO
IF VMDDT IS LOADED
HRRZ T1,.JBDDT## ;[N08] GET START OF DDT
JUMPE T1,$F ;[N08] NOT LOADED
CAMG T1,.JBREL ;[N08] IS IT IN LOW SEGMENT
JRST $F ;[N08] YES, ALREADY COUNTED
HRRZ T2,.JBHRL ;[N08] GET TOP OF HIGH SEG
CAMG T1,T2 ;[NO8] IS DDT IN HIGH SEG?
JRST $F ;[N08] YES, ALREADY COUNTED
THEN COUNT ITS SIZE AS PART OF THE MEMORY ALREADY OCCUPIED
HLRZ T2,.JBDDT ;[N08] GET TOP OF VMDDT
SUB T2,T1 ;[N08] GET LENGTH -1
ADDI T2,1 ;[N08] LENGTH
ADD P2,T2 ;[N08] MAKE IT PART OF HIGH SEG FOR CALCULATIONS
FI;
>;END IFN FTKI10!FTKL10
IFN LOWORG,<
ADDI P1,<<LOWEND/PGSIZ>-<LOWORG/PGSIZ>+1>*PGSIZ ;[C29]
>
IFN FTVM,<
SKIPE FORRET ;CALLED BY FORTRAN?
ADDI P1,FSORTSZ ;YES, ADD IN SIZE OF FSORT
>
IFN FTKI10!FTKL10!FTDEBUG!FTCOBOL!FTFORTRAN,< ;[C29]
ADD P1,P2 ;[C20] [C13] INCLUDE HI-SEGEMENT SIZE
>
IF /MERGE
SKIPG MRGSW
JRST $T
THEN ACCOUNT FOR UP TO 15 INPUT FILES
IFE FTCOBOL,<
MOVE T1,MXDVSZ ;[215] ALLOW FOR WORST CASE
IMUL T1,ACTTMP ;FOR EACH INPUT CHAN
MOVE T2,F.OXBK ;[215] GET OUTPUT BUFFER SIZE
MOVE T2,X.DVSZ(T2) ;[OK] [215] ..
CAIGE T2,.TBS ;USE LARGER
MOVEI T2,.TBS
ADD T1,T2 ;[C20] PLUS OUTPUT BUFFER
LSH T1,1 ;DOUBLE BUFFERING
>
IFN FTCOBOL,<
MOVEI T1,2*.TBS ;DOUBLE BUFFER TEMP FILE
IMUL T1,MAXTMP ;* MAX. NO. OF THEM
>
ADD P1,T1 ;[C20]
MOVE T2,REKSIZ
ADDI T2,RN.LEN
IMUL T2,NUMRCB ;NO. OF RECORDS
JRST $F
ELSE ITS A REGULAR SORT
MOVEI T1,.TBS ;TEMP BUFFER
IFE FTCOBOL,<
ADD T1,MXDVSZ ;[215] PLUS LARGEST INPUT BUFFER
>
LSH T1,1 ;AT LEAST DOUBLE BUFFERING
ADD P1,T1 ;[C20] ADD THEM IN
MOVE T2,REKSIZ ;RECORD SIZE
ADDI T2,RN.LEN ;PLUS ASSOCIATED NODE
LSH T2,POW2(^D16) ;AT LEAST 16
FI;
ADD P1,T2 ;[C20] WE NEED AT LEAST THIS MUCH
HRROI T3,.GTCVL ;CURRENT VIRTUAL/PHYSICAL LIMITS
IF A V/M SYSTEM
GETTAB T3,
JRST $T ;TRY CORMAX LIMITS
TXZ T3,1B18 ;TURN OFF LIMIT BIT
HLRZ T4,T3 ;VIRTUAL LIMIT
HRRZ T3,T3 ;PHYSICAL LIMIT
JUMPE T4,$T ;NOT A V/M SYSTEM
JUMPE T3,$T ;[C24] OR DEFAULT PHYSICAL LIMIT
THEN
LSH T3,POW2(1000) ;INTO WORDS
LSH T4,POW2(1000) ;...
CAMLE P1,T4 ;[C20] LESS THAN VIRTUAL LIMIT?
JRST E$$NEC ;NO
CAMLE T3,T4 ;[N08] IS VIRTUAL LIM .LT. PHYSICAL LIM?
MOVE T3,T4 ;[N08] YES, SET PHYSICAL LIMIT DOWN
IF /CORE:N WAS SPECIFIED ON LOGIN (E.G., SUBMIT FOO/CORE:N)
HRROI T4,.GTLIM ;[334] GET BATCH LIMITS
GETTAB T4, ;[334] ..
JSP P4,E$$MGF ;[334] CAN'T
LDB T4,[POINTR T4,JB.LCR] ;[334] GET MEMORY LIMIT
LSH T4,POW2(1000) ;[334] CONVERT PAGES TO WORDS
JUMPE T4,$F ;[334] IF ZERO, NO LIMIT
THEN 'PHYSICAL LIMIT' IS REALLY MIN(.GTLIM,.GTCVL)
CAMG T4,T3 ;[334] COMPUTE MINIMUM
MOVE T3,T4 ;[334] ..
FI;
MOVE T4,[%NSCMX] ;GET USER CORMAX
GETTAB T4,
JSP P4,E$$MGF
CAMLE T3,T4 ;PHYSICAL LIM .LE. TO CORMAX?
MOVE T3,T4 ;NO, USE CORMAX INSTEAD
CAML P1,T3 ;[C20] NEED MORE THAN PHYSICAL LIMIT?
JRST $F ;YES, USE WHAT WE NEED ONLY
MOVE T4,[%NSMXM] ;GET HOW MUCH SYSTEM HAS
GETTAB T4,
JSP P4,E$$MGF
LSH T4,-1 ;CUT IN HALF
CAXLE T4,700000 ;SEE THAT NUMBER IS BELOW PFH
MOVX T4,700000 ; ..
CAMG T3,T4 ;IS PHYLIM GT. 1/2 OF CORE
SKIPA P1,T3 ;[C20] NO, GIVE USER PHYSICAL LIMIT
CAML P1,T4 ;[C20] IS P1 GT. 1/2 OF CORE?
JRST $F ;YES, USE WHAT WE NEED
MOVE P1,T4 ;[C20] NO, TAKE 1/2 OF CORE
JRST $F
ELSE HERE IF NOT V/M
MOVE T3,[%NSMXM] ;LARGEST CORMAX (SYSTEM SIZE)
GETTAB T3,
JSP P4,E$$MGF
SETZ T4,
CORE T4, ;GET CORE USER CAN GET
LSH T4,POW2(2000) ;ALWAYS GIVES ERROR RETURN
CAMLE P1,T4 ;[C20] ENOUGH CORE?
JRST E$$NEC ;NO
LSH T3,-1 ;CUT IN HALF
CAXLE T3,700000 ;SEE THAT NUMBER IS BELOW PFH
MOVX T3,700000 ; ..
CAML P1,T3 ;[C20] WANT MORE THAN 1/2
JRST $F ;USE ALL OF WHAT WE NEED
CAMG T3,T4 ;[C20] USE THE SMALLER OF THE TWO
SKIPA P1,T3 ;[C20] T3 SMALLER
MOVE P1,T4 ;[C20] T4 SMALLER
FI;
IFN LOWORG,<
SUBI P1,<<LOWEND/PGSIZ>-<LOWORG/PGSIZ>+1>*PGSIZ ;[C29]
>
IFN FTVM,<
SKIPE FORRET ;CALLED BY FORTRAN?
SUBI P1,FSORTSZ ;YES, SUBTRACT SIZE OF FSORT
>
IFN FTKI10!FTKL10!FTDEBUG!FTCOBOL!FTFORTRAN,< ;[C29]
SUB P1,P2 ;[C20] [C13] DISCOUNT HI-SEGMENT SIZE
>
SKIPE CPU ;KI10 OR KL10?
SUBI P1,PGSIZ ;[C20] YES, ACCOUNT FOR UPMP
HRROI T1,.GTPDB ;SEE HOW MUCH "FUNNY SPACE" IS IN USE
GETTAB T1,
TDZA T1,T1 ;NOT IN THIS MONITOR
HLRZ T1,T1
ANDI T1,777 ;ISOLATE BITS WE WANT
SKIPE T1
ADDI T1,2 ;ADD IN A FUDGE FACTOR
LSH T1,POW2(PGSIZ) ;CONVERT TO WORDS
SUB P1,T1 ;REMOVE FROM AVAILABLE POOL
SUBI P1,1 ;[N22] TURN INTO HIGHEST LEGAL ADDRESS
CAILE P1,377777 ;FOR NOW, DON'T ALLOW HUGE LOWSEGS,
MOVEI P1,377777 ; SINCE TOO MANY BUGS WITH THEM
MOVE T1,P1 ;[C13] CALCULATE NEW AVAILABLE MEMORY
SUB T1,OLDFF ;[C13] ..
PUSHJ P,RSTSPC ;[C13] RE-SETUP AVAILABLE MEMORY
POP P,P2 ;[C20] RESTORE P2
POP P,P1 ;[C20] RETSORE P1
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,TSTSIZ)
MOVE P1,FRECOR ;[C13] GET WORKING COPY
IF /MERGE
SKIPG MRGSW
JRST $T
THEN COUNT ALL INPUT FILES
IFE FTCOBOL,<
MOVE T1,MXDVSZ ;[215] ASSUME WORST CASE
IMUL T1,ACTTMP ;* NUMBER OPEN AT ONE TIME
MOVE T2,F.OXBK ;[215] GET OUTPUT BUFFER SIZE
MOVE T2,X.DVSZ(T2) ;[OK] [215] ..
CAIGE T2,.TBS ;USE MAX
MOVEI T2,.TBS
ADD T1,T2 ;[C20] + OUTPUT BUFFER
LSH T1,1 ;DOUBLE BUFFERING
>
IFN FTCOBOL,<
MOVEI T1,2*.TBS ;DOUBLE BUFFER TEMP FILE
IMUL T1,MAXTMP ;* MAX. NO. OF THEM
>
MOVE T2,REKSIZ
ADDI T2,RN.LEN ;RECORD+HEADER
IMUL T2,NUMRCB ;TOTAL WE NEED
SUB P1,T1 ;[C20]
SUB P1,T2 ;[C20]
JUMPL P1,$3 ;[323] NOT ENOUGH CORE
LSH T1,-1 ;PER SINGLE BUFFER
MOVNI T3,4 ;TRY TO ALLOCATE UP TO SIX
$4% SUB P1,T1 ;[C20]
JUMPL P1,$5 ;NO MORE
AOJL T3,$4 ;TRY AGAIN
$5% ADDI T3,6 ;GET ACTUAL NO.
TRZ T3,1 ;[C18] MAKE EVEN
IFE FTCOBOL,<
MOVEM T3,IBUFNO
>
MOVEM T3,TBUFNO
MOVEM T3,OBUFNO
IMUL T3,T1 ;[C20] [C13] TOTAL NEEDED FOR BUFFERS
MOVEM T3,BUFSZ ;[C13] SAVE BUFFER POOL SIZE
RETURN
ELSE DO NORMAL SORT
MOVEI T1,.TBS ;SIZE OF TEMP BUFFER
IFE FTCOBOL,<
ADD T1,MXDVSZ ;[215] SIZE OF LARGEST INPUT BUFFER
>
LSH T1,1 ;DOUBLE BUFFER REQUIRED
MOVE T2,REKSIZ ;SIZE OF 1 RECORD
ADDI T2,RN.LEN ;PLUS ASSOCIATED NODE
LSH T2,POW2(^D16) ;16 IS ABSOLUTE SMALLEST NO.
SUB P1,T1 ;[C20]
SUB P1,T2 ;[C20]
JUMPL P1,$3 ;[C13] NOT ENOUGH SPECIFIED
ADD P1,T2 ;[C20]
LSH T2,3 ;NOW TRY FOR 128.
SUB P1,T2 ;[C20]
LSH T1,-1 ;HOW MUCH FOR ONE BUFFER EACH
MOVNI T3,4 ;TRY TO ALLOCATE UP TO SIX (4 MORE) BUFFERS
$1% SUB P1,T2 ;[C20] TRY FOR 128 MORE RECORDS
JUMPL P1,$2 ;FAILED
SUB P1,T1 ;[C20]
JUMPL P1,$2 ;NO MORE
AOJL T3,$1 ;1 MORE, TRY AGAIN
$2% ADDI T3,6 ;ACTUAL BUFFERS WE CAN USE
TRZ T3,1 ;[C18] MAKE EVEN
IFE FTCOBOL,<
MOVEM T3,IBUFNO ;FOR INPUT
>
MOVEM T3,TBUFNO ;FOR TMPBUF
IMUL T3,T1 ;[C20] TOTAL NEEDED FOR BUFFERS
MOVEM T3,BUFSZ ;[C13] SAVE BUFFER POOL SIZE
MOVE T1,FRECOR ;[C13] WHAT IS FREE
SUB T1,T3 ;[C20] MINUS BUFFERS
MOVE T2,REKSIZ ;
ADDI T2,RN.LEN ;[C20]
IDIV T1,T2 ;[C20] IS FOR RECORDS
IF /LEAVES WAS NOT SPECIFIED
SKIPG NUMRCB
THEN STORE NUMBER OF RECORDS THAT WILL FIT IN CORE
MOVEM T1,NUMRCB ;RECORDS IN CORE
FI;
RETURN ;RETURN TO CALLING PROGRAM
FI;
$3% MOVN T1,P1 ;[C13] CALCULATE NEW AVAILABLE MEMORY
ADD T1,OLDCOR ;[C13] ..
PUSHJ P,RSTSPC ;[C13] RE-SETUP AVAILABLE MEMORY
JRST TSTSIZ ;[C13] TRY AGAIN
END;
SUBTTL PSORT. -- SETSTR - Set Up Temporary Disk Structures
SEGMENT LPURE ;[C20]
BEGIN
PROCEDURE (PUSHJ P,SETSTR)
SETZB U,S ;[C20] [214] FILL ENTIRE TABLE JUST IN CASE
;[C20] [214] PTR FOR USER'S STRS
FOR EACH USER SPECIFIED STR DO
BEGIN
MOVE T1,STRNAM(U) ;[214] GET DSK STR
MOVEM T1,DSKARG+.DCNAM ;STORE NAME
MOVE T1,[.DCUPN,,DSKARG]
DSKCHR T1, ;DO UUO
JSP P4,E$$MUF
TXNN T1,DC.TYP ;GENERIC DSK IF ALL ZERO
JRST [PUSHJ P,GENSTR ;YES, TREAT IT SPECIALLY
CAML U,MAXTMP ;[N20] [C20]
JRST $B ;[C20] OK, SO TRY AGAIN
JRST $E] ;RAN OUT
TXNE T1,DC.HWP!DC.SWP ;WRITE PROTECTED
JRST E$$SWP ;[214] WRITE-PROTECTED--DIE
HLRZ T1,T1 ;GET TYPE IN RHS
ANDI T1,(DC.TYP) ;ONLY BITS WE NOW NEED
MOVE T2,DSKARG+.DCULN ;GET UNIT #
MOVEM T2,STRNAM(U) ;STORE AS NAME
CASE STR OF .DCTYP
JRST @[IFIWS <$3,$3,$4,$3,$3,$4>]-1(T1) ;[C20]
$3% MOVEM T2,STRULN(S)
MOVE T2,DSKARG+.DCSNM ;GET STRUCTURE NAME
MOVEM T2,STRSNM(S) ;SAVE IT
$4% ADDI S,1 ;[C20] [424] [214] ADVANCE USER'S STR TABLE
CAML S,STRNUM ;[C20] DONE?
JRST $E ;[C20] YES
ADDI U,1 ;[N20] DO ADDITION BEFORE TEST
CAMGE U,MAXTMP ;[N20] [C20] [424] LOOP
JRST $B ;[N20] [C20] ..
RETURN ;STRNAM IS FULL
ESAC;
END;
SETOM STRULN(S) ;MARK END OF LIST
ADDI U,1 ;[C20] [214] NEED TO ADVANCE
CAML U,MAXTMP ;[N20] [C20] AND CHECK
JRST $6 ;[C20] ..
SETZ S, ;START AT FRONT AGAIN
WHILE STRS TO CONSIDER DO
BEGIN
PUSHJ P,NXTUNI ;GET NEXT UNIT #
JUMPE T1,$E ;ALL DONE IF NO STR LEFT
MOVEM T1,STRULN(S) ;FOR NEXT TIME
MOVEM T1,DSKARG+.DCNAM ;STORE IT
MOVE T1,[.DCUPN,,DSKARG]
DSKCHR T1,
JRST [SETZM STRULN(S) ;REMOVE FROM LIST
AOJA S,$B] ;AND TRY NEXT
MOVE T1,DSKARG+.DCULN
MOVEM T1,STRNAM(U) ;STORE
AOS STRNUM ;COUNT ONE MORE
ADDI U,1 ;[C20]
CAML U,MAXTMP ;[N20] [C20] FULL?
JRST $E ;[C20] YES, DONE
ADDI S,1 ;[C20] LOOP
CAML S,STRNUM ;[C20] ..
JRST $B ;[C20] ..
END;
$6% RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,GENSTR)
PUSH P,STRNAM(U) ;SAVE CURRENT GENERIC
MOVE T1,STRNAM(U) ;[404]
MOVEM T1,PTHARG+.PTFCN ;[C19] [404]
SETZM STRNAM(U) ;IN CASE WE DON'T FIND A REPLACEMENT
MOVE T4,STRNUM ;[C20] NO. IN USE ALREADY
SETOM GOBARD+.DFGNM ;[404]
SETOM GOBARD+.DFGJN ;[404]
SETOM GOBARS+.DFGNM ;[404]
SETZM GOBARS+.DFGJN ;[447]
SETZM SYSARG ;[404]
MOVE T3,[XWD 3,PTHARG] ;[404]
PATH. T3, ;[404] FIND WHICH SEARCH LIST IS WANTED
JSP P4,E$$MUF ;[404]
BEGIN
CASE PATH. RETURN OF (NOLIST,DSK,ALL,SYS)
;The 0 return that follows should actually jump to the
;commented-out error routine ERRSII. We are assuming that
;the return is really a 1 until the PATH. UUO is fixed.
;The first jump to $1 will be replaced by the call to the
;error routine when PATH. is fixed. This method will work
;under all circumstances.
LDB T3,[POINTR(PTHARG+.PTSWT,PT.SLT)] ;[404] TO CORRECT PATH
JRST @[IFIWS <$1,$1,$2,$3>](T3) ;[C20] [404] BY THIS BIT
$1% MOVE T3,[XWD 5,GOBARD] ;[447] [404] JOB
GOBSTR T3, ;[404] GET FSNAME
JSP P4,E$$MUF ;[404]
MOVE T2,GOBARD+.DFGNM ;[404] FROM HERE
MOVE T3,GOBARD+.DFGST ;[447] GET STATUS
JRST $C ;[404]
$2% MOVE T3,SYSARG ;[404] ALL
SYSSTR T3, ;[404] GET FSNAME
JSP P4,E$$MUF ;[404]
MOVEM T3,SYSARG ;[404] SET UP FOR NEXT
MOVE T2,T3 ;[404]
SETZ T3, ;[447] ASSUME STATUS OK
JRST $C ;[404]
$3% MOVE T3,[XWD 5,GOBARS] ;[404] SYS
GOBSTR T3, ;[404] GET FSNAME
JSP P4,E$$MUF ;[404]
MOVE T2,GOBARS+.DFGNM ;[404]
MOVE T3,GOBARS+.DFGST ;[447] GET STATUS
; JRST $C ;[404]
ESAC;
JUMPE T2,$E ;[404] 0 AT FENCE
CAMN T2,[-1] ;OR AT END
JRST $E ;[404] RETURN
TXNE T3,DF.SWL!DF.SNC ;[447] CHECK STATUS
JRST $B ;[404] DON'T USE THIS ONE
MOVEM T2,DSKARG+.DCNAM ;STORE NAME FOR DSKCHR
MOVE T3,[.DCFCT,,DSKARG] ;JUST GET USERS QUOTA
DSKCHR T3,
JSP P4,E$$MUF
TXNE T3,DC.HWP!DC.SWP ;PROTECTED?
JRST $B ;[404] YES, DON'T USE IT
SKIPN STRNAM(U) ;ALREADY FOUND REPLACEMENT?
JRST [MOVEM T2,STRNAM(U) ;NO, SO DO IT NOW
CAMGE T4,MAXTMP ;[N20] [C20] DO WE HAVE ANY ROOM?
JRST $B ;[404] YES, GET NEXT STR
JRST $E] ;[404] NO, GIVE UP
MOVEM T2,STRNAM(T4) ;[OK] STORE NAME
AOS STRNUM ;COUNT ONE MORE
ADDI T4,1 ;[N20] INCREMENT BEFORE TEST
CAMGE T4,MAXTMP ;[N20] [C20] [404] ADVANCE POINTER
JRST $B ;[N20] [C20] ..
END;
POP P,T2 ;GET GENERIC NAME BACK
SKIPE STRNAM(U) ;DID WE FIND A REPLACEMENT?
RETURN ;YES
MOVEM T2,STRNAM(U) ;NO, SO USE GENERIC AGAIN
ADDI U,1 ;[C20] MOVE ON TO NEXT
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,NXTUNI)
$1% SKIPN T1,STRULN(S) ;GET UNIT NAME
AOJA S,$1 ;DOES NOT EXIST ANYMORE
CAMN T1,[-1] ;-1 IS END OF LIST
JRST $5 ;[N20] [C20] SEE IF LIST IS EXHAUSTED YES
ANDCM T1,STRSNM(S) ;GET JUST THE UNIT #
SETZ T3, ;COUNTER
$2% TRNE T1,77 ;RIGHT JUSTIFIED?
JRST $4 ;YES
LSH T1,-6 ;NO, SHIFT RIGHT 1 CHAR
AOJA T3,$2 ;LOOP
$4% TRC T1,7 ;SEE IF LEAST SIGNIFICANT UNIT IS FULL
TRCE T1,7
AOJA T1,$3 ;ITS NOT
ADDI T1,100 ;INCREMENT
IORI T1,'00' ;INCASE WE OVERFLOWED
$3% IMULI T3,6 ;SHIFT COUNTER
LSH T1,(T3) ;[OK] PUT BACK
IOR T1,STRSNM(S) ;FORM NEW NAME
RETURN
$5% SETZ S, ;[N20] START LIST AGAIN
SKIPN T1,STRULN(S) ;[N20] GET UNIT NAME
AOJA S,.-1 ;[N20] DOES NOT EXIST ANYMORE
AOJN T1,$1 ;[N20] FOUND SOMETHING TO TRY
RETURN ;[N20] LIST IS EMPTY, RETURN T1 =0
END;
SUBTTL GETREC -- GETBUF - Input 1 Physical Buffer
BEGIN
PROCEDURE (JSP T4,GETBUF) ;GET PHYSICAL I/O BUFFER
;RETURNS
; MOVE EF,PHYEOF
; JRST 0(T4) ;ERROR
;OR
; JRST 1(T4) ;NORMAL
IF 7-SERIES MONITOR
SKIPN M7.00 ;[N12] 7-SERIES?
JRST $T ;[N12] NO
THEN USE FILOP. FOR ALL I/O
HRLZ T1,FILCHN(F) ;[N12] GET CHANNEL
HRRI T1,.FOINP ;[N12] INPUT FUNCTION
MOVEM T1,FLPARG+.FOFNC ;[N12] ONLY ONE ARG
MOVE T1,[1,,FLPARG] ;[N12]
FILOP. T1, ;[N12]
JRST $F ;[N12] ERROR, T1 = STATUS
GETOK: MOVE T1,[440000,,1]
ADDM T1,FILPTR(F) ;ADVANCE BYTE PTR TO FIRST WORD OF BUFFER
IFE FTCOBOL,<
MOVN T1,FILCNT(F) ;[C18] DECREMENT BLOCK BYTE COUNT
ADDM T1,FILKCT(F) ;[C18] ..
>
MOVE T1,FILCNT(F) ;BUFFER WORD COUNT TO T1
JRST 1(T4) ;[OK] GIVE OK RETURN
ELSE USE OLD I/O UUOs
MOVE T1,FILCHN(F) ;[C19] GET CHANNEL
LSH T1,27 ;[C19] ..
TLO T1,(IN) ;COMPLETE IN CHN,0
XCT T1 ;ADVANCE TO NEXT BUFFER
JRST GETOK ;UNEVENTFUL INPUT !
TLC T1,(<IN>^!<GETSTS>)
HRRI T1,T1 ;FORM [GETSTS CHN,T1]
XCT T1 ;RETRIEVE FILE STATUS
FI;
TXNN T1,IO.ERR ;I/O ERRORS ?
JRST GETEOF ;NO, MUST BE END OF FILE
PUSH P,T1 ;SAVE STATUS
JRST E$$IRE ;[353] PRINT REASON FOR ERROR
GETEOF: MOVE EF,PHYEOF ;GET PHYSICAL E-O-F ROUTINE
JRST 0(T4) ;[OK] GIVE ERROR RETURN
END;
SUBTTL PUTREC -- PUTBUF - Output 1 Physical Buffer
BEGIN
PROCEDURE (JSP T4,PUTBUF)
MOVE T1,FILBPB(F) ;[C20] [C18] GET BYTES WRITTEN
SKIPLE T2,FILCNT(F) ;[C20] [C03] ..
SUB T1,T2 ;[C20] [C03] ..
IFE FTCOBOL,<
MOVE T2,FILFLG(F) ;[C20] A TEMP FILE?
TXNE T2,FI.TMP ;[C20] ..
>
ADDM T1,TMPTOT ;[C20] YES, UPDATE TEMP BYTES WRITTEN
IFE FTCOBOL,<
MOVN T2,T1 ;[C18] DECREMENT BLOCK BYTE COUNT
ADDM T2,FILKCT(F) ;[C18] ..
IDIV T1,IOBPW2 ;[C03] DIVIDE BY BYTES PER WORD
JUMPE T2,$1 ;[C03] CLEAR REST OF WORD
SUB T2,IOBPW2 ;[C03] ..
SETZ T1, ;[C03] ..
IDPB T1,FILPTR(F) ;[C03] ..
AOJL T2,.-1 ;[C03] ..
$1% ;[C03]
>
SKIPGE FILPTR(F) ;HAS BYTE PTR BEEN ADVANCED?
SOS FILPTR(F) ;YES, RETARD IT
IF 7-SERIES MONITOR
SKIPN M7.00 ;[N12] 7-SERIES?
JRST $T ;[N12] NO
THEN USE FILOP. FOR ALL I/O
HRLZ T1,FILCHN(F) ;[N12] GET CHANNEL
HRRI T1,.FOOUT ;[N12] OUTPUT FUNCTION
MOVEM T1,FLPARG+.FOFNC ;[N12] ONLY ONE ARG
MOVE T1,[1,,FLPARG] ;[N12]
FILOP. T1, ;[N12]
JRST $2 ;[N12] ERROR, T1 = STATUS
JRST $F ;[N12] OK
ELSE USE OLD I/O UUOs
MOVE T1,FILCHN(F) ;[C19] GET CHANNEL
LSH T1,27 ;[C19] ..
TLO T1,(OUT)
IF OUT UUO SUCCEEDS
XCT T1 ;OUT CHN,0
THEN ALL IS DANDY--RETURN
JRST $F ;[215] UNEVENTFUL OUTPUT
ELSE CHECK ERROR CONDITIONS
TLC T1,(<OUT>^!<GETSTS>)
HRRI T1,T1
XCT T1 ;GETSTS CHN,T1
$2% PUSH P,T1 ;[N12] [215] SAVE STATUS
IFE FTFORTRAN!FTCOBOL,<
IF THIS IS A MAGTAPE END-OF-TAPE ERROR
MOVE T1,FILXBK(F) ;[215] GET DEVCHR WORD
MOVE T1,X.DVCH(T1) ;[OK] [215] ..
CAXE T1,DVCHNL ;[215] IF NUL:, NOT A MAGTAPE
TXNN T1,DV.MTA ;[215] NOW CHECK IF REALLY A TAPE
JRST $T ;[215] NO--JUST PRINT ERROR STATUS
MOVE T1,(P) ;[353] GET GETSTS FLAGS BACK
TXNN T1,IO.EOT ;[353] END-OF-TAPE ERROR?
JRST $T ;[353] NO--REAL ERROR
THEN JUST SIGNAL EOT FOR PUTREC
MOVX T1,FI.EOT ;[215] REMEMBER EOT
ORM T1,FILFLG(F) ;[215] ..
JRST $F ;[215] DONE HERE
ELSE PRINT ERROR STATUS
>
JRST E$$OWE ;[353] PRINT REASON FOR ERROR
IFE FTFORTRAN!FTCOBOL,<
FI;
>
POP P,(P) ;[414] CLEAN UP STACK
FI;
FI;
MOVE T1,[440000,,1]
ADDM T1,FILPTR(F) ;ADVANCE BYTE PTR TO FIRST WORD OF BUFFER
MOVE T1,FILCNT(F) ;BUFFER WORD COUNT TO T1
RETURN
END;
SUBTTL FILE UTILITY ROUTINES -- Close Master Input/Output File
BEGIN
PROCEDURE (PUSHJ P,CLSMST) ;CLOSE FILE INDICATED BY F
;USES T1, T2, AND T4
;CALLS CLRBUF
TDZA T4,T4 ;FINAL CLOSE FOR MASTER INPUT/OUTPUT
PROCEDURE (PUSHJ P,CLSFIL)
MOVX T4,CL.ACS!CL.DLL ;DON'T DELETE ALLOCATED BLOCKS
MOVE T1,FILHDR(F) ;GET BUFFER RING HEADER
TXNE T1,BF.IBC ;BUFFER CLEAR INHIBITED?
PUSHJ P,CLRBUF ;YES, SO CLEAR JUNK
SKIPGE FILPTR(F) ;HAS BYTE PTR BEEN ADVANCED?
SOS FILPTR(F) ;YES, RETARD IT
HRL T1,FILCHN(F) ;[C19] BUILD FILOP. BLOCK, GET CHANNEL
HRRI T1,.FOCLS ;[C19] GET CLOSE FUNCTION
MOVEM T1,FLPARG+.FOFNC ;[C19] STORE THEM
MOVEM T4,FLPARG+.FOIOS ;[C19] STORE THE CLOSE BITS
SETZM FLPARG+.FOLEB ;[C19] NO LOOKUP BLOCK FOR ERRORS
MOVE T1,[XWD .FOIOS+1,FLPARG] ;[C19] DO CLOSE FILOP.
FILOP. T1, ;[C19] ..
JRST ERRFUF ;[C19] FAILED
MOVE T1,FILCHN(F) ;[C19] RELEASE CHANNEL
PJRST RELCHN ;[C19] ..
END;
BEGIN
PROCEDURE (PUSHJ P,CLRBUF) ;CLEAR JUNK FROM END OF BUFFER
SKIPG T2,FILCNT(F) ;GET BYTE COUNT
JRST $3 ;BUFFER MUST BE FULL (OR VIRGIN)
SKIPL T1,FILPTR(F) ;GET BYTE PTR
ADDI T1,1 ;BYPASS PARTIAL WORD
TXNE T1,<POINT ^O40,,35> ;[131] SIXBIT OR BINARY?
JRST $2 ;[123] YES
TXNE T1,<POINT ^O10,,35> ;[123] EBCDIC?
LSH T2,-2 ;[123] YES
TXNE T1,<POINT 4,,35> ;[123] ASCII?
IDIVI T2,5 ;GET WORDS LEFT IF ASCII
JUMPL T1,$2 ;JUMP IF ON A NEW WORD
SETZ T3, ;GET A NULL
SUBI T1,1 ;BACKUP BYTE PTR
$1% IDPB T3,T1 ;CLEAR OUT LAST PARTIAL WORD
TXNE T1,7B2 ;[123] SEE IF DONE
JRST $1 ;NOT YET
ADDI T1,1 ;ADVANCE TO NEXT WORD AGAIN
$2% JUMPE T2,$3 ;BUFFER IS FULL
HRRZS T1 ;[C20] CLEAN T1 FOR INDEXING
SETZM (T1) ;[OK] CLEAR FIRST WORD
SOJLE T2,$3 ;ONLY ONE WORD TO CLEAR
ADD T2,T1 ;[C20] END OF BLT
HRL T1,T1
ADDI T1,1
BLT T1,(T2) ;[OK] CLEAR REST OF BUFFER
$3% RETURN
END;
SUBTTL FILE UTILITY ROUTINES -- Delete, Rename a File
BEGIN
PROCEDURE (PUSHJ P,DELFIL) ;DELETE FILE INDICATED BY F
IF 7-SERIES MONITOR
SKIPN T2,M7.00 ;[N24] [N12] 7-SERIES?
JRST $T ;[N12] NO
THEN USE FILOP. FOR ALL I/O
HRLZ T1,FILCHN(F) ;[C19] BUILD FILOP. BLOCK, GET CHANNEL
HRRI T1,.FODLT ;[C19] GET DELETE FUNCTION
CAILE T2,70100 ;[N24] NEED FO.UOC BIT IN 7.02
TXO T1,FO.UOC ;[N12] USE ALREADY OPEN CHANNEL
MOVEM T1,FLPARG+.FOFNC ;[C19] STORE THEM
MOVSI T1,T2 ;[N12] NEED A RENAME BLOCK
HLLM T1,FLPARG+.FOLEB ;[N12] LOOKUP BLOCK IS NOT REALLY USED
SETZ T2, ;[N12] MONITOR WILL ZERO IT ANYWAY
MOVE T1,[.FOLEB+1,,FLPARG] ;[N12] DO DELETE FILOP.
FILOP. T1, ;[C19] ..
JRST ERRFUF ;[C19] FAILED
JRST $F ;[N12] OK
ELSE USE OLD I/O UUOs
SETZB T1,T2 ;[C20] ZERO FILE.EXT
SETZ T4, ;[C20] ZERO PPN
MOVE T3,FILCHN(F) ;[C20] [C19] GET CHANNEL
LSH T3,27 ;[C20] [C19] ..
IOR T3,[RENAME T1] ;[C20]
XCT T3 ;[C20]
JRST [HRRZ T1,T2 ;[C19] DELETE FAILED
JRST ERRFUF] ;[C19] ..
FI;
MOVE T1,FILCHN(F) ;[C19] RELEASE CHANNEL
PJRST RELCHN ;[C19] ..
END;
SUBTTL FILE UTILITY ROUTINES -- Enter a File
BEGIN
PROCEDURE (PUSHJ P,ENTFIL)
PUSH P,P1 ;[C19] SAVE AND SETUP P1
MOVEI P1,T.BLK ;[C19] ..
MOVX T1,FI.TMP!FI.DSK!FI.OUT ;[C19] SETUP FILE FLAGS
MOVEM T1,FILFLG(F) ;[C19] ..
IF BUFFERS ALREADY SETUP
SKIPL BUFALC ;[C19] NEED TO SETUP BUFFERS?
JRST $T ;[C19] YES
THEN MAKE SURE ITS USED
MOVX T1,BF.VBR ;[C19] SET VIRGIN BUFFER RING HEADER
IORM T1,FILHDR(F) ;[C19] ..
JRST $F ;[C19]
ELSE SET THE BUFFERS UP
PUSH P,P2 ;[C19] SAVE P2
MOVE P2,TBUFNO ;[C19] GET BUFFER COUNT
PUSHJ P,BUFRNG ;[C19] CREATE BUFFER RING
POP P,P2 ;[C19] RESTORE P2
FI;
HLLZS FILPTR(F) ;[C19] CLEAR RH OF BYTE POINTER
SETZM FILCNT(F) ;[C19] CLEAR FILE COUNT
PUSHJ P,GENNAM ;[C19] GENERATE FILE NAME
MOVEM T1,X.RIB+.RBNAM(P1) ;[OK] [C19] INSERT FOR ENTER UUO
PUSHJ P,GETCHN ;[C19] GET A WORKING CHANNEL
JRST E$$NEH ;[C19] FAILED
MOVEM T1,FILCHN(F) ;[C19] SAVE IT
$1% HRRZ T1,TCBIDX ;[C19] GET INDEX TO TEMP STRUCTURE
IDIV T1,STRNUM ;[C19] ROUND ROBIN
MOVE T1,STRNAM(T2) ;[OK] [C19]
MOVEM T1,X.OPN+.OPDEV(P1) ;[OK] [C19] STORE .TMP DEVICE
MOVEI T2,FILHDR(F) ;[C19]
HRLZM T2,X.OPN+.OPBUF(P1) ;[OK] [C19] POINT TO BUFFER HEADERS
SETZM X.RIB+.RBPPN(P1) ;[OK] [C19] ALWAYS USE DEFAULT PATH
HLLZS X.RIB+.RBEXT(P1) ;[OK] [C19] CLEAR EXTENDED DATE
SETZM X.RIB+.RBPRV(P1) ;[OK] [C19] ETC
SETZM X.RIB+.RBSIZ(P1) ;[OK] [C19] ..
SETZM X.RIB+.RBVER(P1) ;[OK] [C19] ..
SETZM X.RIB+.RBEST(P1) ;[OK] [C19] ..
SETZM X.RIB+.RBALC(P1) ;[OK] [C19]
HRL T1,FILCHN(F) ;[C19] BUILD FILOP. BLOCK, GET CHANNEL
HRRI T1,.FOWRT ;[C19] GET WRITE FUNCTION
TXO T1,FO.PRV ;[N14] BYPASS CHECKS IF [1,2] OR JACCT
SKIPE XCHNO. ;[N17] CAN WE USE EXTENDED CHANNELS?
TXO T1,FO.ASC ;[N17] YES, DO SO
MOVEM T1,FLPARG+.FOFNC ;[C19] STORE THEM
HRLI T1,X.OPN(P1) ;[OK] [C19] TRANSFER OPEN BLOCK
HRRI T1,FLPARG+.FOIOS ;[C19] ..
BLT T1,FLPARG+.FOIOS+2 ;[C19] ..
SETZM FLPARG+.FONBF ;[C19] NO BUFFERS
HRRZI T1,X.RIB(P1) ;[OK] [C19] GET LOOKUP BLOCK ADDRESS
MOVEM T1,FLPARG+.FOLEB ;[C19] STORE IT
AOS T2,NUMTMP ;[C19] COUNT NUMBER OF RUNS
HRLM T2,FILRUN(F) ;[C19] FOR COMPAR = TEST
AOS T2,NUMENT ;[C19] HOW MANY ENTERS DONE
CAMLE T2,MAXTMP ;[C19] WRAPPED ROUND YET?
JRST APPFIL ;[C19] YES, JUST APPEND TO PREVIOUS
MOVE T1,[.FOLEB+1,,FLPARG] ;[C19] DO WRITE FILOP.
FILOP. T1, ;[C19] ..
JRST [PUSHJ P,DELSTR ;[C19] FAILED, DELETE BAD STRUCTURE
SOS NUMTMP ;[C26] DONT COUNT IT TWICE
SOS NUMENT ;[C26] ..
JRST $1] ;[C19] AND TRY AGAIN
MOVS T1,FLPARG+.FOFNC ;[N17] GET CHANNEL BACK
ANDI T1,777 ;[N17]
HRRM T1,FILCHN(F) ;[N17] INCASE WE HAD AN EXTENDED CHAN
IFE FTCOBOL,<
PUSHJ P,DSKPRI ;[C19] SET DSK PRIORITY
>
HRRZ T1,TCBIDX ;[C19] MARK THAT WE USED THE NEXT STR
IDIV T1,STRNUM ;[C19] ..
ADDI T2,1 ;[C19] (STRUSE IS FIRST *NOT* USED)
CAMLE T2,STRUSE ;[C19] BUT ONLY IF WE HAVN'T ALREADY
MOVEM T2,STRUSE ;[C19] ..
POP P,P1 ;[C19] RESTORE P1
RETURN
END;
SUBTTL FILE UTILITY ROUTINES -- Append to Temporary File
BEGIN
PROCEDURE (PUSHJ P,APPFIL) ;APPEND TO TEMPORARY FILE
HRRI T1,.FOAPP ;[C19] SELECT APPEND FILOP.
HRRM T1,FLPARG+.FOFNC ;[C19] ..
MOVX T1,FO.PRV ;[N14] BYPASS CHECKS IF [1,2] OR JACCT
IORM T1,FLPARG+.FOFNC ;[N14]
MOVE T1,[XWD .FOLEB+1,FLPARG] ;[C19] DO APPEND FILOP.
FILOP. T1, ;[C19] ..
JRST ERRFUF ;[C19] FAILED
MOVS T1,FLPARG+.FOFNC ;[N17] GET CHANNEL BACK
ANDI T1,777 ;[N17]
HRRM T1,FILCHN(F) ;[N17] INCASE WE HAD AN EXTENDED CHAN
IFE FTCOBOL,<
PUSHJ P,DSKPRI ;[C19] SET DSK PRIORITY AND RETURN
>
MOVE T1,FILCNT(F) ;[C19] NEW BUFFER?
CAMGE T1,FILBPB(F) ;[C19] ..
JSP T4,PUTBUF ;[C19] NO, GET ONE
HLRO T1,FILRUN(F) ;FAKE SIXBIT WORD COUNT
IDPB T1,FILPTR(F) ;STORE IT
MOVE T1,[440000,,1] ;WE WANT PTR TO HAVE
ADDM T1,FILPTR(F) ;ADDRESS OF NEXT WORD IN RHS
SOS FILCNT(F)
POP P,P1 ;[C19] RESTORE P1
RETURN
END;
SUBTTL FILE UTILITY ROUTINES -- Delete a Temporary Structure
BEGIN
PROCEDURE (PUSHJ P,DELSTR) ;DELETE CURRENT STRUCTURE IN STRNAM
;DELSTR IS CALLED WHENEVER AN ATTEMPT TO INITIALIZE AN OUTPUT .TMP FILE FAILED.
;THIS CAN HAPPEN, FOR INSTANCE, IF THE USER SPECIFIES DSK:/TEMP, AND ONE OF THE
;STRUCTURES IN THE SEARCH LIST FOR DSK: IS WRITE-ENABLED, BUT HAS NO DIRECTORY
;FOR THE USER. WE DELETE THE STRUCTURE FROM STRNAM WITH POSSIBLY A WARNING
;MESSAGE, THEN RETURN. HOWEVER, IF WE DELETE THE LAST STRUCTURE IN STRNAM OR IF
;THE STRUCTURE HAS ALREADY BEEN SUCCESSFULLY USED (SO THAT OTHERS DEPEND ON THE
;ORDERING OF STRNAM), THEN WE DIE WITH A FATAL ERROR MESSAGE.
;
;ENTER WITH:
; T1/ FILOP. ERROR CODE
; RH(TCBIDX)/ CURRENT .TMP FILE INDEX
; STRNAM/ TABLE OF STRUCTURES
; STRNUM/ NUMBER OF ENTRIES IN STRNAM
; STRUSE/ NUMBER OF FIRST NOT-YET-USED ENTRY IN STRNAM
IF THIS STR HAS NOT YET BEEN REFERENCED
HRRZ T2,TCBIDX ;[214] GET CURRENT .TMP INDEX
PUSH P,STRNAM(T2) ;[OK] [214] SAVE STR NAME FOR MESSAGE
IDIV T2,STRNUM ;[214] GET INDEX INTO STRNAM
CAIGE T2,1 ;[214] PASSED OVER ENTIRE TABLE
CAMGE T3,STRUSE ;[214] OR OVER USED PART?
JRST $T
THEN DELETE THE STRUCTURE
MOVE T1,STRNUM ;GET NUMBER OF STRS
HRLZI T2,STRNAM+1(T3) ;[OK] [214] COPY END OF TABLE
HRRI T2,STRNAM(T3) ;[OK] [214] DOWN TO FRONT OF TABLE
CAIE T1,STRNAM+1(T3) ;[C20] [214] UNLESS NO END OF TABLE
BLT T2,STRNAM-2(T1) ;[OK] [214] ..
SOSLE STRNUM ;[214] NOW 1 LESS STR IN STRNAM
PJRST ERRATD ;[214] PRINT WARNING
JRST E$$NSW ;[214] NO TEMPORARY DEVICE IS WRITABLE
ELSE DIE (STRUCTURE IN USE SO CAN'T DELETE IT)
JRST ERRFUF ;[C19] FILOP. FAILED THIS TIME
FI;
END;
SUBTTL FILE UTILITY ROUTINES -- Lookup a Temporary File
BEGIN
PROCEDURE (PUSHJ P,LKPFIL) ;LOOKUP TEMPORARY FILE
PUSH P,P1 ;[C19] SAVE AND SETUP P1
MOVEI P1,T.BLK ;[C19] ..
MOVX T1,FI.TMP!FI.DSK ;[C19] SETUP FILE FLAGS
MOVEM T1,FILFLG(F) ;[C19] ..
IF BUFFERS ALREADY SETUP
SKIPL BUFALC ;[C19] NEED TO SETUP BUFFERS?
JRST $T ;[C19] YES
THEN MAKE SURE ITS USED
MOVX T1,BF.VBR ;[C19] SET VIRGIN BUFFER RING HEADER
IORM T1,FILHDR(F) ;[C19] ..
JRST $F ;[C19]
ELSE SET THE BUFFERS UP
PUSH P,P2 ;[C19] SAVE P2
MOVE P2,TBUFNO ;[C19] GET BUFFER COUNT
PUSHJ P,BUFRNG ;[C19] CREATE BUFFER RING
POP P,P2 ;[C19] RESTORE P2
FI;
HLLZS FILPTR(F) ;[C19] CLEAR RH OF BYTE POINTER
SETZM FILCNT(F) ;[C19] CLEAR FILE COUNT
HRRZ T1,FILNAM(F) ;[C19] FILE NAME
ANDI T1,77 ;[C19]
SUBI T1,'A' ;[C19] STRUCTURE INDEX
IDIV T1,STRNUM ;[C19]
MOVE T1,STRNAM(T2) ;[OK] [C19]
MOVEM T1,X.OPN+.OPDEV(P1) ;[OK] [C19] SAVE .TMP STRUCTURE
MOVEI T1,FILHDR(F) ;[C19]
HRRZM T1,X.OPN+.OPBUF(P1) ;[OK] [C19] POINT TO BUFFER HEADER
HRRZ T1,FILNAM(F) ;[C19] GET FILE NAME
HRRM T1,X.RIB+.RBNAM(P1) ;[OK] [C19] SET VARIABLE PART
SETZM X.RIB+.RBPPN(P1) ;[OK] [C19] ALWAYS USE DEFAULT PATH
PUSHJ P,GETCHN ;[C19] GET A WORKING CHANNEL
JRST E$$NEH ;[C19] FAILED
MOVEM T1,FILCHN(F) ;[C19] SAVE IT
HRLS T1 ;[C19] BUILD FILOP. BLOCK, GET CHANNEL
HRRI T1,.FORED ;[C19] GET READ FUNCTION
TXO T1,FO.PRV ;[N14] BYPASS CHECKS IF [1,2] OR JACCT
SKIPE XCHNO. ;[N17] CAN WE USE EXTENDED CHANNELS?
TXO T1,FO.ASC ;[N17] YES, DO SO
MOVEM T1,FLPARG+.FOFNC ;[C19] STORE THEM
HRLI T1,X.OPN(P1) ;[OK] [C19] TRANSFER OPEN BLOCK
HRRI T1,FLPARG+.FOIOS ;[C19] ..
BLT T1,FLPARG+.FOIOS+2 ;[C19] ..
SETZM FLPARG+.FONBF ;[C19] NO BUFFERS
HRRZI T1,X.RIB(P1) ;[OK] [C19] GET LOOKUP BLOCK ADDRESS
MOVEM T1,FLPARG+.FOLEB ;[C19] STORE IT
MOVE T1,[XWD .FOLEB+1,FLPARG] ;[C19] DO READ FILOP.
FILOP. T1, ;[C19] ..
JRST ERRFUF ;[C19] FAILED
MOVS T1,FLPARG+.FOFNC ;[N17] GET CHANNEL BACK
ANDI T1,777 ;[N17]
HRRM T1,FILCHN(F) ;[N17] INCASE WE HAD AN EXTENDED CHAN
IFE FTCOBOL,<
PUSHJ P,DSKPRI ;[C19] SET DISK PRIORITY LEVEL
>
POP P,P1 ;[C19] RESTORE P1
RETURN
END;
SUBTTL FILE UTILITY ROUTINES -- Build a Buffer Ring
BEGIN
PROCEDURE (PUSHJ P,BUFRNG) ;CREATE BUFFER RING
;ENTER WITH:
; P1/ POINTER TO X. BLOCK FOR THIS FILE
; P2/ NUMBER OF BUFFERS TO BUILD IN RING
; F/ POINTER TO FCB FOR THIS FILE
; BUFPTR/ ADDRESS WHERE BUFFERS SHOULD START; UPDATED TO END OF
; NEW BUFFERS
;
;ON RETURN, STORES ORIGINAL BUFPTR IN FILBUF(F) SO BUFFER AREA MAY BE
;REUSED. IF THIS IS AN OUTPUT FILE (CHECKS WHICH SIDE FILE WAS OPENED
;ON), THEN SET BF.IBC, INHIBIT BUFFER CLEAR.
MOVE T1,BUFPTR ;START OF BUFFER AREA
MOVEM T1,FILBUF(F) ;STORE IT
ADDI T1,1 ;HEADER POINTS TO 2ND WORD
MOVE T2,X.OPN+.OPBUF(P1) ;[OK] [215] GET BUFFER HEADER WORD FROM INIT
TLNN T2,-1 ;OUTPUT OR INPUT?
TXOA T1,BF.VBR ;INPUT, JUST SET VIRGIN RING BIT
TXO T1,BF.VBR!BF.IBC ;OUTPUT, SET INHIBIT BUFFER CLEAR ALSO
MOVEM T1,FILHDR(F) ;STORE IN FCB
IF DSK AND LARGE BUFFERS ALLOWED
MOVE T4,FILFLG(F) ;[C18] DSK?
TXNN T4,FI.DSK ;[C18] ..
JRST $T ;[C18] NO
HRROI T4,.GTLBS ;[C18] LARGE BUFFERS ALLOWED?
GETTAB T4, ;[C18] ..
JRST $T ;[C18] NO
THEN MAKE TWO LARGE BUFFERS
MOVE T4,P2 ;[C18] CALCULATE THE BUFFER SIZE
LSH T4,-1 ;[C18] ..
IMULI T4,200 ;[C18] ..
ADDI T4,3 ;[C18] ..
MOVEI T3,2-1 ;[C18] USE TWO BUFFERS (DONT INCLUDE LAST)
JRST $F ;[C18]
ELSE USE NORMAL BUFFER SIZE AND COUNT SPECIFIED
MOVEI T3,-1(P2) ;[OK] [215] # OF BUFFERS REQUIRED (NOT INCLUDING LAST)
HRRZ T4,X.DVSZ(P1) ;[OK] [215] GET BUFFER SIZE
FI;
MOVEI T2,-3(T4) ;[OK] [C18] CALCULATE BYTES PER BUFFER
IMUL T2,IOBPW2 ;[C18] ..
MOVEM T2,FILBPB(F) ;[C18] STORE BYTES PER BUFFER
HRRZS T1 ;[C20] CLEAN T1 FOR INDEXING
HRLI T2,-2(T4) ;[C20] DATA COUNT
$1% HRR T2,T1 ;[C20] GET TO NEXT
ADD T2,T4 ;[C20] ..
MOVEM T2,(T1) ;[OK] DATA COUNT,,LINK TO NEXT
SETZM 1(T1) ;[OK] [131] ZERO BOOKKEEPING AND COUNT WORD
HRRZ T1,T2 ;[C20] ADVANCE
SOJG T3,$1 ;FOR ALL BUFFERS
HRR T2,FILHDR(F) ;LAST ONE IS LINKED TO FIRST
MOVEM T2,(T1) ;[OK] TO COMPLETE THE RING
SETZM 1(T1) ;[OK] [210] ZERO LAST BOOKKEEPING AND COUNT WORD
ADDI T1,-1(T4) ;[OK] ALLOCATE SPACE FOR BUFFER
HRRZM T1,BUFPTR ;BETTER SAVE IT
RETURN
END;
SUBTTL FILE UTILITY ROUTINES -- Format Buffer Pool
BEGIN
PROCEDURE (PUSHJ P,FMTBFP)
MOVE T1,NUMRCB ;[C13] GET NO. OF RECORDS IN TREE
IMULI T1,RN.LEN ;[C13] COMPUTE SIZE OF TREE
MOVEM T1,TRESZ ;[C13] SAVE TREE SIZE
CALL GETSPC ;[C13] ALLOCATE SPACE FOR TREE
JRST E$$NEC ;[C13] FAILED
MOVEM T1,TREORG ;[C13] SAVE ADDR OF START OF TREE
MOVE T1,NUMRCB ;[C13] GET NO. OF RECORDS IN TREE
IMUL T1,REKSIZ ;[C13] TIMES SIZE OF RECORDS
MOVEM T1,RCBSZ ;[C13] SAVE SIZE OF RECORD POOL
CALL GETSPC ;[C13] ALLOCATE SPACE FOR RECORDS
JRST E$$NEC ;[C13] FAILED
MOVEM T1,RCBORG ;[C13] SAVE ADDR OF START OF RECORD POOL
MOVE T1,BUFSZ ;[C13] ALLOCATE SEPARATE AREA FOR BUFFER POOL
CALL GETSPC ;[C13] ..
JRST E$$NEC ;[C13] FAILED
MOVEM T1,BUFPTR ;[C13] REMEMBER WHERE IT STARTS
MOVEM T1,BUFORG ;[C13] SAVE START OF BUFFER POOL
MOVE T2,BUFSZ ;[C13] CALCULATE USEFUL BUFFER SPACE
MOVEM T2,UBUFSZ ;[C13] SAVE IT
RETURN ;[C13]
END;
SUBTTL FILE UTILITY ROUTINES -- Reformat Buffer Pool for Next Merge
BEGIN
PROCEDURE (PUSHJ P,RFMBFP) ;REFORMAT BUFFER POOL FOR MERGE PHASE
MOVE T1,ACTTMP ;NO. OF TMP FILES
IMULI T1,.TBS ;TIMES SIZE
IFE FTCOBOL,<
MOVE T2,F.OXBK ;[215] SIZE OF OUTPUT BUFFER
MOVE T2,X.DVSZ(T2) ;[OK] [215] ..
CAIGE T2,.TBS ;USE LARGER OF REAL OR TEMP
MOVEI T2,.TBS ; SINCE WE DON'T KNOW WHICH TO USE YET
ADD T1,T2 ;[C20] PLUS 1 OUTPUT BUFFER
>
IFN FTCOBOL,<
SKIPE NUMLFT ;IF WE NEED TO DO A MERGE PASS
ADDI T1,.TBS ;NEEDED FOR MERGE OUTPUT
>
IF ENOUGH ROOM
MOVE T2,UBUFSZ ;[C13] GET USEFUL BUFFER POOL SIZE
IDIV T2,T1 ;[C20] GIVES NO. OF BUFFERS EACH
CAIGE T2,2 ;DOUBLE BUFFERING AT LEAST REQUIRED
JRST $T
THEN JUST RESET PARAMETERS
TRZ T2,1 ;[C18] MAKE EVEN
MOVEM T2,TBUFNO ;NO. FOR MERGE FILES
MOVE T1,UBUFSZ ;[C13] GET USEFUL BUFFER POOL SIZE
IMUL T2,ACTTMP ;TIMES NO. OF TEMP FILES
IMULI T2,.TBS ;TIMES SIZE OF EACH
SUB T1,T2 ;[C20] GET HOW MUCH IS LEFT FOR OUTPUT
IFE FTCOBOL,<
MOVE T2,F.OXBK ;[215] GET OUTPUT BUFFER SIZE
MOVE T2,X.DVSZ(T2) ;[OK] [215] ..
CAIGE T2,.TBS
MOVEI T2,.TBS
IDIV T1,T2 ;[C20] GET NO. OF OUTPUT BUFFERS
>
IFN FTCOBOL,<
IDIVI T1,.TBS
>
TRZ T1,1 ;[C18] MAKE EVEN
MOVEM T1,OBUFNO ;STORE
MOVE T1,BUFORG ;[C13] RESET BUFFER POOL ADDRESS
MOVEM T1,BUFPTR ;[C13] ..
RETURN
ELSE EXPAND CORE
LSH T1,1 ;DOUBLE SIZE WE NEED
MOVEM T1,UBUFSZ ;[C13] STORE NEW USEFUL BUFFER POOL SIZE
EXCH T1,BUFSZ ;[C13] STORE NEW BUFFER POOL SIZE
PUSHJ P,FRESPC ;[C13] AND DROP OLD BUFFER POOL
MOVE T1,RCBSZ ;[C21] GET SIZE OF RECORD POOL
PUSHJ P,FRESPC ;[C21] DEALLOCATE IT
MOVE T1,TRESZ ;[C21] GET SIZE OF TREE AREA
PUSHJ P,FRESPC ;[C21] DEALLOCATE IT
MOVE T1,NUMRCB ;[C21] GET NO. OF RECORDS IN TREE
IMULI T1,RN.LEN ;[C21] COMPUTE SIZE OF TREE
MOVEM T1,TRESZ ;[C21] SAVE TREE SIZE
CALL GETSPC ;[C21] ALLOCATE SPACE FOR TREE
JRST E$$NEC ;[C21] FAILED
MOVEM T1,TREORG ;[C21] SAVE ADDR OF START OF TREE
MOVE T1,NUMRCB ;[C21] GET NO. OF RECORDS IN TREE
IMUL T1,REKSIZ ;[C21] TIMES SIZE OF RECORDS
MOVEM T1,RCBSZ ;[C21] SAVE SIZE OF RECORD POOL
CALL GETSPC ;[C21] ALLOCATE SPACE FOR RECORDS
JRST E$$NEC ;[C21] FAILED
MOVEM T1,RCBORG ;[C21] SAVE ADDR OF START OF RECORD POOL
MOVE T1,BUFSZ ;[C13] ALLOCATE NEW BUFFER POOL
PUSHJ P,GETSPC ;[C13] ..
JRST E$$NEC ;[C13] FAILED
MOVEM T1,BUFPTR ;[C21] REMEMBER WHERE IF STARTS
MOVEM T1,BUFORG ;[C13] SAVE NEW BUFFER POOL ADDRESS
JRST $B ;TRY AGAIN
FI;
END;
SUBTTL CHANNEL MANAGEMENT -- SETCHN
;SETCHN - SETUP CHANNEL MANAGEMENT ROUTINES
BEGIN
PROCEDURE (PUSHJ P,SETCHN)
SKIPE XCHNO. ;[N20] DO WE HAVE EXTENDED CHANS.?
JRST $6 ;[N20] YES, USE 26 OF THEM
IFE FTCOBOL!FTFORTRAN,<
SKIPN FORRET ;[C20] [C19] CALLED BY FORTRAN?
JRST $4 ;[C19] NO, STANDALONE
>
IFN FTCOBOL,<
MOVEI T1,MX.T15 ;[C19] GET MAX TEMP FILES
>
IFE FTCOBOL,<
MOVEI T1,MX.T15+1 ;[C19] GET MAX TEMP FILES PLUS INPUT/OUTPUT FILE
>
MOVEM T1,CHNFRE ;[C19] STORE IT
PUSH P,[-1] ;[C19] MARK END OF STACK
$1% PUSHJ P,GETCHN ;[C19] TRY FOR A CHANNEL
JRST $2 ;[C19] CAN'T
PUSH P,T1 ;[C19] SAVE IT
JRST $1 ;[C19] LOOP AROUND
$2% SETOM CHNFRE ;[N09] [C19] THAT'S ALL WE GET, BUT KEEP ONE FOR MERGE
$3% POP P,T1 ;[C19] GET CHANNEL ALLOCATED
JUMPL T1,$5 ;[C19] NO MORE
PUSHJ P,FRECHN ;[C19] FREE CHANNEL
JRST $3 ;[C19] LOOP AROUND
$5% ;[C19]
IFN FTCOBOL,<
SKIPG T1,UR.CHN ;[C19] DID USER WANT CHANNELS RESERVED?
MOVEI T1,U.CHN ;[C19] NO, GET DEFAULT
MOVNS T1 ;[C19] REDUCE MAX AVAILABLE
ADDM T1,CHNFRE ;[C19] ..
>
RETURN ;[N20]
;HERE IF STANDALONE (NEITHER FORTRAN NOR COBOL)
IFE FTCOBOL!FTFORTRAN,<
$4% SKIPA T1,[MX.T15] ;[N20] [C19] USE THEM ALL (EXCEPT 0)
>
$6% MOVEI T1,MX.TMP ;[N20] USE 26 OF THEM.
IFE FTCOBOL,<
SKIPG MAXTMP ;[N20] DID USE SPECIFY /MAXTMP?
JRST $7 ;[N20] NO, USE DEFAULT
CAMLE T1,MAXTMP ;[N20] YES, DO WE HAVE ENOUGH CHANS.?
SKIPA T1,MAXTMP ;[N20] YES, JUST USE WHAT USER SPECIFIED
$7%>
MOVEM T1,MAXTMP ;[N20]
IFE FTCOBOL,<
ADDI T1,1 ;[N20] EXTRA CHANNEL FOR INPUT/OUTPUT FILE
>
MOVEM T1,CHNFRE ;[C19] ..
RETURN ;[C19]
END;
SUBTTL CHANNEL MANAGEMENT -- GETCHN
;GETCHN ALLOCATES A CHANNEL AND RETURNS IT IN T1
;RETURNS IF OK, ERROR RETURNS IF NO MORE CHANNELS AVAILABLE.
BEGIN
PROCEDURE (PUSHJ P,GETCHN)
SKIPGE CHNFRE ;[N09] [C19] ALLOCATING TOO MANY CHANNELS?
RETURN ;[C19] YES, NOT ENOUGH
SETZM CHANEL ;[N17] ANTICIPATE 7.01
SKIPE XCHNO. ;[N17] WITH EXTENDED CHANNELS
JRST $3 ;[N17] YES IT IS
IFE FTCOBOL!FTFORTRAN,<
SKIPN FORRET ;[C20] [C19] CALLED BY FORTRAN?
JRST $1 ;[C19] NO, STANDALONE
>
MOVEI L,1+[-4,,0 ;[C19] LOAD UP ARG BLOCK FOR FUNCT. CALL
Z TP%INT,[F.GCH] ;[C19]
Z TP%LIT,[ASCIZ /SRT/] ;[C19]
Z TP%INT,STATUS ;[C19]
Z TP%INT,CHANEL] ;[C19]
PUSHJ P,FUNCT. ;[C19] ALLOCATE THE CHANNEL
SKIPE STATUS ;[C19] NON-ZERO STATUS IS AN ERROR
RETURN ;[C19] GIVE ERROR RETURN
JRST $3 ;[C19]
;HERE IF STANDALONE (NEITHER FORTRAN NOR COBOL)
IFE FTCOBOL!FTFORTRAN,<
$1%
$2% AOS T1,CHANEL ;[C19] GET A CHANNEL TO TRY
CAILE T1,17 ;[C19] RUN OUT OF CHANNELS?
RETURN ;[C19] YES
DEVNAM T1, ;[C19] AN UNUSED CHANNEL?
SKIPA ;[C19] YES
JRST $2 ;[C19] NO, LOOP AROUND
>
IFN FTDEBUG,<
$ERROR ([,ACN,<Allocating I/O channel >,+)
$MORE (OCTAL,CHANEL)
$CRLF
>
$3% SOS CHNFRE ;[C19] SUBTRACT CHANEL REQUESTED
MOVE T1,CHANEL ;[C19] RETURN CHANEL TO CALLER
PJRST CPOPJ1 ;[C19] GIVE SKIP RETURN
END;
SUBTTL CHANNEL MANAGEMENT -- FRECHN
;FRECHN - FREE CHANNEL C(T1)
BEGIN
PROCEDURE (PUSHJ P,FRECHN)
MOVEM T1,CHANEL ;[C19] SAVE CHANEL
IFE FTCOBOL!FTFORTRAN,<
SKIPE FORRET ;[N17] [C20] [C19] NOT CALLED BY FORTRAN?
>
SKIPE XCHNO. ;[N17] OR 7.01 WITH EXTENDED CHANNELS
JRST $1 ;[N17] YES IT IS
MOVEI L,1+[-4,,0 ;[C19] LOAD UP FUNCT. ARG BLOCK
Z TP%INT,[F.RCH] ;[C19]
Z TP%LIT,[ASCIZ /SRT/] ;[C19]
Z TP%INT,STATUS ;[C19]
Z TP%INT,CHANEL] ;[C19]
PUSHJ P,FUNCT. ;[C19] RELEASE THE CHANNEL
SKIPE STATUS ;[C19] OK?
JRST E$$FCN ;[C19] NO, COMPLAIN
JRST $2 ;[C19]
$1% DEVNAM T1, ;[C19] CHANNEL RELEASED YET?
$2% AOSA CHNFRE ;[C19] YES, SUBTRACT WHAT WE'VE FREED
JRST E$$FCN ;[C19] NO
IFN FTDEBUG,<
$ERROR ([,DCN,<Returning I/O channel >,+)
$MORE (OCTAL,CHANEL)
$CRLF
>
RETURN ;[C19]
END;
SUBTTL CHANNEL MANAGEMENT -- RELCHN
;RELCHN - RELEASE AND FREE CHANNEL C(T1)
BEGIN
PROCEDURE (PUSHJ P,RELCHN)
IF 7-SERIES MONITOR
SKIPN M7.00 ;[N12] 7-SERIES?
JRST $T ;[N12] NO
THEN USE FILOP. FOR ALL I/O
MOVSS T2,T1 ;[N12] MAKE A COPY OF CHAN # IN LEFT HALF
HRRI T1,.FOREL ;[N12] RELEASE FUNCTION
MOVEM T1,FLPARG+.FOFNC ;[N12] ONLY ONE ARG
MOVE T1,[1,,FLPARG] ;[N12]
FILOP. T1, ;[N12]
JRST ERRFUF ;[N12] ERROR
MOVS T1,T2 ;[N12] GET CHAN BACK
JRST FRECHN ;[N12] OK
ELSE USE OLD I/O UUOs
MOVE T2,T1 ;[C19] BUILD RELEASE UUO
LSH T2,27 ;[C19] ..
TLO T2,(RELEAS) ;[C19] ..
XCT T2 ;[C19] DO IT
PJRST FRECHN ;[C19] FREE THE CHANNEL
FI;
END;
SUBTTL ERROR MESSAGES
;FILE FILOP. ERRORS
;ENTER WITH
; T1 = ERROR CODE
; FLPARG = FILOP. BLOCK
ERRFUF: PUSH P,T1 ;[C19] SAVE ERROR CODE
$ERROR (?,FUF,<FILOP. >,+) ;[C19] TYPE PREFIX
MOVEI T1,FLPTAB ;[C20] [C19] SEARCH FOR FILOP. FUNC
HRRZ T2,FLPARG+.FOFNC ;[C19] GET FUNC TO SEARCH FOR
ERRFU1: HLRZ T3,(T1) ;[OK] [C19] GET TABLE ENTRY FUNC
CAMN T2,T3 ;[C19] ARE THEY THE SAME?
JRST ERRFU2 ;[C19] YES
CAIGE T1,FLPTAB+FLPLEN-1 ;[C20] NO, ANY MORE?
AOJA T1,ERRFU1 ;[C20] [C19] YES, TRY NEXT
$MORE (OCTAL,T2) ;[C19] NO MATCH, JUST TYPE NUMBER
JRST ERRFU3 ;[C19]
ERRFU2: HRRZ T1,(T1) ;[OK] [C19] TYPE TEXT
$MORE (ASCII,T1) ;[C19] ..
ERRFU3: $MORE (TEXT,< failed>) ;[C19]
HRRZ T1,FLPARG+.FOLEB ;[C19] A FILENAME?
JUMPE T1,ERRFU4 ;[C19] NO
$MORE (TEXT,< for >) ;[C19] YES
HRRZ T1,FLPARG+.FOLEB ;[C19] TYPE FILENAME
$MORE (FILESPEC,T1) ;[C19]
ERRFU4: $MORE (TEXT,< error >) ;[C19]
POP P,T1 ;[C19] RESTORE ERROR CODE
CAIG T1,LRELEN ;[C19] KNOWN CODE?
JRST ERRFU5 ;[C19] YES
$MORE (OCTAL,T2) ;[C19] NO, JUST TYPE NUMBER
JRST ERRFU6 ;[C19]
ERRFU5: MOVE T1,LRETAB(T1) ;[OK] [C19] TYPE TEXT
$MORE (ASCII,T1) ;[C19] ..
ERRFU6: $DIE ;[C19] DONE
LRETAB: [ASCIZ \(0) file was not found \]
[ASCIZ \(1) no directory for project-programmer number \]
[ASCIZ \(2) protection failure \]
[ASCIZ \(3) file was being modified \]
[ASCIZ \(4) rename file name already exists \]
[ASCIZ \(5) illegal sequence of UUOs \]
[ASCIZ \(6) bad UFD or bad RIB \]
[ASCIZ \(7)\]; not a SAV file \]
[ASCIZ \(10)\]; not enough core \]
[ASCIZ \(11) device not available \]
[ASCIZ \(12) no such device \]
[ASCIZ \(13) illegal monitor call \]
[ASCIZ \(14) no room or quota exceeded \]
[ASCIZ \(15) write lock error \]
[ASCIZ \(16) not enough monitor table space \]
[ASCIZ \(17) partial allocation only \]
[ASCIZ \(20) block not free on allocation \]
[ASCIZ \(21)\]; can't supersede (enter) an existing directory \]
[ASCIZ \(22)\]; can't delete (rename) a non-empty directory \]
[ASCIZ \(23) SFD not found \]
[ASCIZ \(24) search list empty \]
[ASCIZ \(25) SFD nested too deeply \]
[ASCIZ \(26) no-create on for specified SFD path \]
[ASCIZ \(27)\]; segment not on swap space \]
[ASCIZ \(30) can't update file \]
[ASCIZ \(31)\]; low segment overlaps high segment \]
[ASCIZ \(32)\]; user not logged in \]
[ASCIZ \(33)\]; file has outstanding locks set \]
[ASCIZ \(34)\]; bad EXE directory \]
[ASCIZ \(35)\]; bad EXE extersion \]
[ASCIZ \(36)\]; EXE directory too big \]
[ASCIZ \(37)\]; network capacity exceeded \]
[ASCIZ \(40)\]; task not available \]
[ASCIZ \(41)\]; unknown network node specified \]
[ASCIZ \(42)\]; rename-SFD is in use \]
[ASCIZ \(43)\]; delete-file has an NDR block \]
[ASCIZ \(44)\]; job count too high \]
LRELEN==.-LRETAB
FLPTAB: XWD .FORED,[ASCIZ /READ/] ;[C19]
XWD .FOCRE,[ASCIZ /CREATE/] ;[C19]
XWD .FOWRT,[ASCIZ /WRITE/] ;[C19]
XWD .FOAPP,[ASCIZ /APPEND/] ;[C19]
XWD .FOCLS,[ASCIZ /CLOSE/] ;[C19]
XWD .FORNM,[ASCIZ /RENAME/] ;[C19]
XWD .FODLT,[ASCIZ /DELETE/] ;[C19]
XWD .FOINP,[ASCIZ /INPUT/] ;[N12]
XWD .FOOUT,[ASCIZ /OUTPUT/] ;[N12]
XWD .FOREL,[ASCIZ /RELEASE/] ;[N12]
XWD .FOWAT,[ASCIZ /WAIT/] ;[N12]
FLPLEN==.-FLPTAB ;[C19]
E$$IRE: $ERROR (?,IRE,<Input>,+) ;[353] INPUT ERROR
JRST IREOWE ;[353] PRINT WHY
E$$OWE: $ERROR (?,OWE,<Output>,+) ;[353] OUTPUT ERROR
; JRST IREOWE ;[353] PRINT WHY
BEGIN
PROCEDURE (PUSHJ P,IREOWE) ;[353] TYPE I/O ERROR
;IREOWE IS AN INTERNAL ROUTINE FOR THE E$$IRE AND E$$OWE ERROR MESSAGE HANDLERS.
;ITS FUNCTION IS TO PRINT THE PROPER REASON FOR AN IN OR OUT UUO FAILURE.
;
;CALL:
; 0(P)/ <GETSTS WORD>
; F/ <POINTER TO FCB FOR FILE>
;RETURNS VIA $DIE.
;
;WE PRINT ALL ASSOCIATED MESSAGES FOR GETSTS ERROR BITS THAT ARE ON, UNLESS ALL
;ARE ON. IN THIS CASE, WE MUST DO A DEVOP. TO FIND OUT THE REAL ERROR AND PRINT
;A MORE SPECIFIC MESSAGE.
PUSH P,P1 ;[353] SAVE AC FOR X. BLOCK
MOVE P1,FILXBK(F) ;[353] GET ADDR OF X. BLOCK FOR FILE
$MORE (TEXT,< error for >)
IF THIS IS A TEMPORARY FILE
JUMPN P1,$T ;[353] NO X. BLOCK?
THEN X. BLOCK DOESN'T EXIST, SO NO FILE BLOCK
$MORE (TEXT,<temporary file >);[374]
LDB T1,[POINT 6,FILNAM(F),35] ;[374] GET STRUCTURE INDEX
SUBI T1,'A' ;[374] ..
IDIV T1,STRNUM ;[374] MOD NUMBER OF STRUCTURES
MOVE T1,STRNAM(T2) ;[OK] [374] GET STRUCTURE NAME
$MORE (SIXBIT,T1) ;[374] TYPE DEVICE
$CHAR (":") ;[374] COLON
HLLZ T1,JOBNUM ;[374] CONSTRUCT FILE NAME
HRR T1,FILNAM(F) ;[374] ..
$MORE (SIXBIT,T1) ;[374] TYPE IT
$MORE (TEXT,<.TMP>) ;[374] ADD EXTENSION
JRST $F ;[353]
ELSE PRINT FILE SPEC
MOVEI T2,X.RIB(P1) ;[OK] [353] GET POINTER TO LOOKUP BLOCK
$MORE (FILESPEC,T2) ;[353]
FI;
POP P,P1 ;[353] DONE WITH X. BLOCK--RESTORE AC
IF ALL ERROR BITS NOT ON
MOVE T4,(P) ;[353] GET GETSTS BITS BACK
TXC T4,IO.ERR ;[353] SEE IF ALL ERROR BITS ARE ON
TXCN T4,IO.ERR ;[353] ..
JRST $T ;[353] ALL BITS ARE ON
THEN PRINT JUST RESULTS OF GETSTS WORD
$MORE (TEXT,<, GETSTS code is:>)
TXNN T4,IO.IMP ;[353] IMPROPER MODE
JRST $1 ;[353] NO
$CRLF ;[353] NEW LINE FOR REASON
$MORE (TEXT,<Device write-locked or improper mode.>)
$1% TXNN T4,IO.DER ;[353] DEVICE DATA ERROR?
JRST $2 ;[353] NO
$CRLF ;[353] NEW LINE FOR REASON
$MORE (TEXT,<Device data error.>)
$2% TXNN T4,IO.DTE ;[353] HARD DATA ERROR?
JRST $3 ;[353] NO
$CRLF ;[353] NEW LINE FOR REASON
$MORE (TEXT,<Parity or hard data error.>)
$3% TXNN T4,IO.BKT ;[353] BLOCK TOO LARGE?
JRST $F ;[353] DONE PRINTING GETSTS RESULTS
$CRLF ;[353] NEW LINE FOR REASON
$MORE (TEXT,<Quota exceeded or block too large.>)
JRST $F ;[353] DONE PRINTING GETSTS RESULTS
ELSE PRINT DEVOP. STATUS
$MORE (TEXT,<, DEVOP. code is:>)
$CRLF ;[353] NEW LINE FOR REASON
DMOVE T1,[2,,T2 ;[353] BUILD DEVOP. UUO FOR FILE'S CHANNEL
.DFRES] ;[353] ..
MOVE T3,FILCHN(F) ;[C19] GET CHANNEL
DEVOP. T1, ;[353] GET THE REASON
JSP P4,E$$MUF ;[353] ?! DEVOP. EXISTS IF ALL BITS ON
IF CODE IS IN RANGE OF TABLE
CAXLE T1,DVPLEN ;[353] RANGE-CHECK AGAINST OUR TABLE
JRST $T ;[353] NO GOOD--SAY UNKNOWN
THEN PRINT USEFUL MESSAGE
MOVE T1,DVPTBL-1(T1) ;[OK] [353] LOAD ADDR OF PROPER MESSAGE
$MORE (TEXT,T1) ;[353] PRINT IT
JRST $F ;[353]
ELSE JUST PRINT THE CODE
PUSH P,T1 ;[353] SAVE CODE FOR A WHILE
$CHAR "(" ;[353] PRINT CODE
POP P,T1 ;[353] ..
$MORE (OCTAL,T1) ;[353] ..
$MORE (TEXT,<) Unknown cause.>)
FI;
FI;
POP P,(P) ;[353] CLEAN UP STACK
$DIE ;[353] THIS IS A FATAL ERROR
END;
DVPTBL: [ASCIZ /(1) Line printer page limit exceeded./]
[ASCIZ /(2) Line printer VFU format error./]
[ASCIZ /(3) Magtape label type error./]
[ASCIZ /(4) Magtape header label error./]
[ASCIZ /(5) Magtape trailer label error./]
[ASCIZ /(6) Magtape volume label error./]
[ASCIZ /(7) Hard device error./]
[ASCIZ /(10) Parity error./]
[ASCIZ /(11) Write lock error./]
[ASCIZ /(12) Magtape illegal positioning operation./]
[ASCIZ /(13) Magtape beginning of tape./]
[ASCIZ /(14) Magtape illegal operation./]
[ASCIZ /(15) Reserved for tape labeling./]
[ASCIZ /(16) Reserved for tape labeling./]
[ASCIZ /(17) Reserved for tape labeling./]
[ASCIZ /(20) Network node is down./]
[ASCIZ /(21) LP20 undefined character interrupt./]
[ASCIZ /(22) LP20 memory parity error./]
[ASCIZ /(23) LP20 RAM parity error./]
[ASCIZ /(24) LP20 master sync or timeout error./]
DVPLEN==.-DVPTBL
E$$MGF: $ERROR (?,MGF,<Monitor GETTAB failed at >,+) ;[C20]
XMOVEI T1,-2(P4) ;[C20] CALLED VIA JSP P4,E$$MGF
$MORE (OCTAL,T1)
$DIE
E$$MUF: $ERROR (?,MUF,<Monitor UUO failed at >,+) ;[C20]
XMOVEI T1,-2(P4) ;[C20] CALLED VIA JSP P4,E$$MUF
$MORE (OCTAL,T1)
$DIE
;Uncomment this routine and call it from GENSTR after PATH.
;is fixed.
;ERRSII: $ERROR (?,SII,<Search list information inconsistant for >,+)
; $MORE (SIXBIT,PTHARG+.PTFCN) ;[C19]
; $DIE
E$$SWP: $ERROR (?,SWP,<Temporary structure >,+)
$MORE (SIXBIT,DSKARG)
$MORE (TEXT,<: is write-locked.>)
$DIE
E$$NSW: $ERROR (?,NSW,<No temporary device is writable.>)
ERRATD: SKIPE STRDEF ;[214] IF JUST GENERIC DSK: DON'T BOTHER
JRST ATDONE ;[214] THE USER WITH THE MESSAGE
$ERROR (%,ATD,<Attempt to use temporary device >,+)
MOVE T1,(P) ;[214] GET BACK STR NAME
$MORE (SIXBIT,T1) ;[214] TYPE IT
$MORE (TEXT,<: failed--ignoring it.>)
$CRLF ;[214] FINISH LINE
ATDONE: POP P,(P) ;[214] CLEAR STACK
POPJ P, ;[214] RETURN
E$$FEA: $ERROR (?,FEA,<Formal arg exceeds actual arg count>)