Trailing-Edge
-
PDP-10 Archives
-
BB-4160E-BM
-
sort-development/srtjss.mac
There are 16 other files named srtjss.mac in the archive. Click here to see a list.
SUBTTL TOPS-20 SPECIFIC PART OF SORT/MERGE
SUBTTL D.L. CAMPBELL/DZN/DMN/BRF 29-Aug-79
; "JSYS SAVES"
;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, 1979 BY DIGITAL EQUIPMENT CORPORATION
IFE FTOPS20,<PRINTX ? SRTJSS should not be present in TOPS-10 SORT/MERGE.>
IFN FTPRINT,<PRINTX [Entering SRTJSS.MAC]]>
SUBTTL TABLE OF CONTENTS FOR SRTJSS
; Table of Contents for SRTJSS
;
;
; Section Page
;
; 1 TOPS-20 SPECIFIC PART OF SORT/MERGE ...................... 1
; 2 TABLE OF CONTENTS FOR SRTJSS ............................. 2
; 3 DEFINITIONS
; 3.1 TOPS-20 Specific Parameters ....................... 3
; 3.2 Low Segment Data .................................. 4
; 4 ENTRY POINTS
; 4.1 TOPS-20 Entry Vector .............................. 6
; 4.2 FORTRAN Entry ..................................... 7
; 5 PSORT.
; 5.1 SETUPI - Set Up Input Files ....................... 9
; 6 I/O ROUTINES
; 6.1 INIINP - Initialize Next Input File
; 6.1.1 Set Up ..................................... 10
; 6.1.2 Disk ....................................... 11
; 6.1.3 Magtape .................................... 13
; 6.1.4 Others ..................................... 15
; 6.2 INIOUT - Initialize Next Output File
; 6.2.1 Set Up ..................................... 18
; 6.2.2 Disk ....................................... 19
; 6.2.3 Magtape .................................... 20
; 6.3 Magtape Utility Routines .......................... 21
; 6.4 File Utility Routines
; 6.4.1 Close Master Input/Output File ............. 22
; 6.4.2 Delete, Rename a File ...................... 23
; 6.4.3 Unmap Buffer Pages For a File .............. 24
; 6.4.4 Initialize Output Temporary File ........... 27
; 6.4.5 Append to Temporary File ................... 28
; 7 TRY TO RENAME SINGLE TEMP FILE TO OUTPUT FILE ............ 31
; 8 GETREC
; 8.1 GETBUF - Input 1 Physical Buffer
; 8.1.1 Set Up ..................................... 34
; 8.1.2 Terminal ................................... 35
; 8.1.3 Disk ....................................... 36
; 8.1.4 Magtape .................................... 40
; 9 PUTREC
; 9.1 PUTBUF - Output 1 Physical Buffer
; 9.1.1 Set Up ..................................... 43
; 9.1.2 Disk ....................................... 46
; 9.1.3 Magtape .................................... 48
; 10 PSORT.
; 10.1 Memory Management Routines for TOPS-20 ............ 49
; 11 COLLATING SEQUENCE ROUTINES .............................. 59
; 12 ERROR MESSAGES ........................................... 60
SUBTTL DEFINITIONS -- TOPS-20 Specific Parameters
OUTSIZ==PGSIZ*3 ;DESIRABLE SIZE FOR SINGLE OUTPUT BUFFER
PPTBUF==2 ;MINIMUM PAGES PER TEMP FILE BUFFER
SUBTTL DEFINITIONS -- Low Segment Data
SEGMENT LOW
ZJ.BEG:! ;[427] FIRST DATUM TO DELETE
CBPTR: BLOCK 1 ;CANONICAL BYTE POINTER
INLST: BLOCK 2 ;I/O COMMAND LIST FOR MTA INPUT
OUTLST: BLOCK 2 ;I/O COMMAND LIST FOR MTA OUTPUT
MAXFRE: BLOCK 1 ;FIRST UNUSABLE CORE LOC
PGTAB: BLOCK <400/^D36>+1 ;BIT TABLE OF MAPPED PAGES
BUFPT1: BLOCK 1 ;INITIAL VALUE OF BUFPTR
LEANUM: BLOCK 1 ;ARGUMENT TO /LEAVES SWITCH
BUFSZ: BLOCK 1 ;SIZE OF I/O BUFFER AREA
BUFTOT: BLOCK 1 ;COPY OF BUFSZ FOR ENDS.
BUFTOP: BLOCK 1 ;TOP OF BUFFER AREA
OBUFSZ: BLOCK 1 ;(MINIMUM) SIZE OF OUTPUT BUFFER
DFMTRS: BLOCK 1 ;DEFAULT MTA RECORD SIZE
AZTEMP: BLOCK ^D20 ;[405] TEMP TO HOLD FILESPEC AT XGTJFN
ZJ.END==.-1 ;[427] LAST DATUM TO DELETE
SEGMENT HIGH
BLOCK 1 ;[427] NEXT IN LIST
ZJ.BEG,,ZJ.END ;[427] DATA TO ZERO
.LINK S.LNK,.-2 ;[427] TELL LINK WHAT TO DO
;DEFINE MNEMONICS FOR I/O MODES AND TABLE OF CORRESPONDING BYTE POINTERS
DEFINE GENMOD,<
..INDX==1
X MODSIXBIT,<440600,,0>
X MODASCII,<440700,,0>
X MODEBCDIC,<441100,,0>
X MODBINARY,<444400,,0>
PURGE ..INDX
>
DEFINE X(NAME,BPTR),<
NAME==..INDX
BPTR
..INDX==..INDX+1
>
BYTTAB: GENMOD
IFE FTCOBOL,<
DEFINE ENDMODULE<
$PURGE
END <ENTVLN,,ENTVEC>>
DEFINE COMPARE (R,J)<
JSP P4,@.CMPAR
>
>
IF1,<
DEFINE $JRST$ <BLOCK 1> ;KEEP MACRO HAPPY
>
SUBTTL ENTRY POINTS -- TOPS-20 Entry Vector
IFE FTCOBOL,<
SEGMENT HIGH
ENTVEC: JRST START ;MAIN ENTRY POINT
JRST START ;REENTER ENTRY POINT
EXP V%SORT ;VERSION NUMBER
USRVLN,,USRVEC ;USER ENTRY VECTOR
ENTVLN==.-ENTVEC
USRVEC: JRST FORENT ;FORTRAN ENTRY POINT
USRVLN==.-USRVEC
SUBTTL ENTRY POINTS -- FORTRAN Entry
BEGIN
PROCEDURE (PUSHJ P,FORENT)
MOVX T1,.FHSLF ;[361] DEACTIVATE INTERRUPTS
MOVX T2,<1B<.ICNXP>> ;[361] ON PAGE CREATION
DIC% ;[361] SO PA1050 WON'T BITCH AT US
SETZM KEYORG ;[361] CREATE LOW SEGMENT PAGES
MOVE T3,[KEYORG,,KEYORG+1] ;[361] AND CLEAR THEM
BLT T3,LOWEND ;[361]
AIC% ;[361] REACTIVATE INTERRUPTS FOR PA1050
MOVEM P,FORTPP ;SAVE RETURN PP
HRLZ L,L ;BUILD BLT POINTER
HRRI L,FORARG ;TO SAVE ARG LIST
BLT L,FORARG+2 ;SAVE LIST
JSP P4,INITIALIZE
MOVE L,FORARG ;RECOVER ORIGINAL L
MOVEM L,ARGLST ;STORE IT FOR SCANNER
HLRE T1,-1(L) ;GET ARG COUNT
MOVMM T1,ARGCNT ;STORE FOR SCANNER
MOVEI L,@0(L) ;GET FIRST ARG
HRLI L,(POINT 7,) ;FORM INPUT BYTE POINTER
MOVE T1,[POINT 7,BUFFER] ;OUTPUT BYTE POINTER
MOVNI T2,5*BUFSIZ-2 ;NO. OF CHARACTERS (NOT INCLUDING CR,LF,NUL)
$1% ILDB T3,L ;GET CHAR
JUMPE T3,$2 ;END ON NUL
IDPB T3,T1 ;STORE
AOJL T2,$1 ;LOOP
$ERROR (?,CTL,<Command string too long>)
$2% MOVEI T3,.CHLFD ;LF
IDPB T3,T1
SETZ T3,
IDPB T3,T1 ;END WITH NUL
ADDI T2,5*BUFSIZ-1 ;DONT COUNT THE NULL
MOVEM T2,CMDLEN ;STORE SIZE
PUSHJ P,CUTBAK ;[361] MAKE SURE WE HAVE AS MUCH FREE SPACE AS POSSIBLE
JRST LOOP ;GO TO SORT
END;
BEGIN
PROCEDURE (PUSHJ P,FORXIT)
PUSHJ P,CUTBAK ;[361] GIVE SPACE BACK TO FOROTS
SKIPN TAKFLG ;SKIP IF TAKING
MOVE P,FORTPP ;RESTORE ORIGINAL PP
RETURN ;RET IF FORTRAN OR LOOP IF TAKING
END;
BEGIN
PROCEDURE (PUSHJ P,CUTBAK)
MOVEI L,1+[-3,,0 ;[361] LOAD UP ARG BLOCK FOR FUNCT. CALL
Z TP%INT,[F.CBC]
Z TP%LIT,[ASCIZ /SRT/]
Z TP%INT,STATUS]
PJRST FUNCT. ;[361] CUT BACK CORE IF POSSIBLE
END;
BEGIN
PROCEDURE (PUSHJ P,FORERR)
MOVE P,FORTPP ;RESTORE ORIGINAL PP
PUSHJ P,CUTBAK ;[361] GIVE SPACE BACK TO FOROTS
IF USERS WANTS CONTROL
SKIPG T1,ERRADR ;GET RETURN ADDRESS
JRST $T
THEN RETURN TO FORTRAN
HRRM T1,-1(P) ;SET USERS RETURN ADDRESS
RETURN
ELSE DO FORTRAN EXIT
MOVEI L,1+ERRARG ;ARG BLOCK FOR EXIT
PUSHJ P,@EXIT. ;GO TO FORTRAN EXIT
MONRET ;GIVE UP
JRST .-1 ;IN CASE OF CONTINUE
FI;
END;
ERRARG: EXP 0,0
SEGMENT LOW
FORTPP: BLOCK 1 ;SAVE RETURN PC (AC 17)
FORARG: BLOCK 1 ;ORIGINAL L
FUNCT.: BLOCK 1 ;ADDRESS OF FUNCT.
EXIT.: BLOCK 1 ;ADDRESS OF EXIT.
SEGMENT HIGH
SUBTTL PSORT. -- SETUPI - Set Up Input Files
;SETUPI - PASS OVER INPUT FILES, REMEMBER LARGEST BUFFER SIZE REQUIRED, SET
;UP SOME RANDOM STUFF
SETUPI: MOVE T1,IOMODE ;GET I/O MODE
MOVE T1,BYTTAB-1(T1) ;GET PROPER CANONICAL BYTE POINTER
MOVEM T1,CBPTR ;SAVE FOR LATER
SETZM PGTAB ;CLEAR TABLE OF MAPPED PAGES
MOVE T1,[PGTAB,,PGTAB+1] ;SET UP FOR BLT
BLT T1,PGTAB+<400/^D36> ;CLEAR THE TABLE
MOVE T1,F.INZR ;GET PTR TO INPUT FILESPEC CHAIN
CALL SETUP2 ;GET SIZE OF LARGEST BUFFER IN CHAIN
MOVEM T1,MXDVSZ ;SAVE IT
RET ;RETURN
SETUPO: MOVE T1,F.OUZR ;GET PTR TO OUTPUT FILESPEC
CALL SETUP2 ;GET SIZE OF LARGEST BUFFER IN CHAIN
MOVEM T1,OBUFSZ ;REMEMBER
RET
;FIND SIZE OF LARGEST BUFFER IN CHAIN
; CALL WITH T1 POINTING TO X. BLOCK CHAIN
; RETURN WITH T1/ SIZE OF BUFFER
SETUP2: PUSH P,P1 ;GET A REG FOR PTR TO X. BLOCK
PUSH P,P2 ;GET REG TO HOLD MAX BUFFER SIZE
SETZ P2, ;INIT MAX BUFFER SIZE
MOVE P1,T1 ;COPY HEAD OF X. BLOCK CHAIN
SETUP1: SETZ T1,
LDB T2,[POINT 9,X.DVCH(P1),17] ;GET DEVICE TYPE
CAXN T2,.DVDSK ;DISK?
MOVEI T1,PGSIZ ;YES, BUFFER WANTS TO BE 1 PAGE
CAXN T2,.DVMTA ;MTA?
CALL [CALL MTBFSZ ;YES, COMPUTE BUFFER SIZE
TRZE T1,PGMSK ;[365] ROUND UP TO PAGE BOUNDARY
ADDI T1,PGSIZ ;[365] BECAUSE MTA BUFFERS GO ON PG BOUNDARY
LSH T1,POW2(2) ;DOUBLE BECAUSE MTA IS DOUBLE BUFFERED
RET]
SKIPN T1 ;ALL ELSE USES
MOVEI T1,^D100 ; 100 WORD BUFFERS
CAML T1,P2 ;BIGGEST SO FAR?
MOVEM T1,P2 ;YES, SAVE THIS
SKIPE P1,X.NXT(P1) ;ARE THERE MORE FILESPECS IN LIST?
JRST SETUP1 ;YES, PROCESS NEXT
MOVE T1,P2 ;RETURN RESULT IN T1
POP P,P2 ;NO, RESTORE P REGISTERS
POP P,P1 ; ..
RET ;AND RETURN
SUBTTL I/O ROUTINES -- INIINP - Initialize Next Input File -- Set Up
;CALL WITH: MOVEI F,<ADDRESS OF FCB>
; PUSHJ P,INIINP
INIINP: PUSH P,P1 ;GET A REGISTER
MOVE P1,FILXBK(F) ;GET POINTER TO X. BLOCK IN P1
HRRZ T1,X.JFN(P1) ;GET JFN
HRLZM T1,FILPGN(F) ;STORE IN FCB
MOVE T3,X.FLG(P1) ;GET FILE FLAGS
MOVEM T3,FILFLG(F) ;SAVE IN FCB
MOVN T1,X.BLKF(P1) ;GET NEGATIVE BLOCKING FACTOR
SKIPE T1 ;[312] ALREADY ZERO?
SUBI T1,1 ;[305] ADJUST FOR OFF-BY-ONE CODE
HRLZM T1,FILBLK(F) ;STORE AS AOBJN WORD
SETZM FILSIZ(F)
SETZM FILEOF(F)
SETZM FILCNT(F)
LDB T1,[POINT 9,X.DVCH(P1),17] ;GET DEVICE TYPE
CAILE T1,.DVNET ;RANGE CHECK
JRST E$$NSD ;NO SUCH DEVICE
JUMPL T1,E$$NSD ;CAN'T BE NEGATIVE
CALL @[INDSK ;0 - DISK
E$$NSD ;1 - NO SUCH DEVICE
INMTA ;2 - MAGTAPE
REPEAT 4,<E$$NSD> ;3-6 - NO SUCH DEVICE
E$$CDL ;7 - LINE PRINTER
INCDR ;10 - CARD READER
E$$FED ;11 - FRONT-END DEVICE
INTTY ;12 - TERMINAL
INPTY ;13 - PSEUDO-TERMINAL
E$$NSD ;14 - NO SUCH DEVICE
INNUL ;15 - NULL DEVICE
E$$AND](T1) ;16 - ARPANET DEVICE
POP P,P1 ;RESTORE P1
RET ;AND RETURN
SUBTTL I/O ROUTINES -- INIINP - Initialize Next Input File -- Disk
;COMPUTES: FILEOF(F)/ SIZE OF FILE, IN BYTES
; FILBPB(F)/ NUMBER OF BYTES PER BUFFER
; FILBUF(F)/ (LH) NUMBER OF PAGES IN A BUFFER
; FILBUF(F)/ (RH) FIRST PAGE OF BUFFER
INDSK: MOVX T1,FI.DSK ;SET DISK BIT FOR LATER USE
IORM T1,FILFLG(F) ; ..
SKIPE X.BLKF(P1) ;[305] IF BLOCKED FILE,
CALL BLKSET ;[305] SET UP FOR IT
HLRZ T1,FILPGN(F) ;GET JFN
MOVE T2,[2,,.FBBYV] ;GET BYTE SIZE AND FILE SIZE
MOVEI T3,T3 ;RETURN IN T3 AND T4
GTFDB% ; ..
LDB T1,[POINT 6,T3,11] ;GET BYTE SIZE ALONE
JUMPE T1,INDSK2 ;MAKE ZERO BYTE SIZE IMPLY 36-BIT BYTES
CAIN T1,7 ;7-BIT BYTES?
JRST INDSK1 ;YES, GO HANDLE
CAIN T1,^D36 ;36-BIT BYTES?
JRST INDSK2 ;YES
CAIN T1,^D9 ;[305] 9-BIT BYTES?
JRST INDSK9 ;[305] YES, HANDLE IT
$ERROR (?,IBS,<Invalid byte size for >,+)
HLRZ T2,FILPGN(F)
$MORE (FILESPEC,T2)
$DIE
INDSK9: MOVX T1,MODEBCDIC ;[305] IF FILE HAS 9-BIT BYTES,
CAME T1,IOMODE ;[305] I/O MODE HAD BETTER BE EBCDIC
JRST E$$FMC ;[305] FILE MODE CONFLICT
MOVEM T4,FILEOF(F) ;[305] STUFF BYTE COUNT INTO FDB
JRST INDSK3 ;[305] REJOIN COMMON CODE
INDSK1: MOVEI T1,MODASCII ;ARE WE SORTING ASCII RECORDS?
CAME T1,IOMODE ; ..
JRST E$$FMC ;[305] FILE'S MODE CONFLICTS WITH MODE SWITCH
MOVE T1,T4 ;YES, GET BYTE COUNT IN T1
IDIVI T1,5 ;ROUND TO WORD BOUNDARY
SKIPE T2 ;IF REMAINDER
ADDI T1,1 ; ONE MORE WORD
IMULI T1,5 ;CONVERT BACK TO BYTES
MOVEM T1,FILEOF(F) ;SAVE IN FCB
JRST INDSK3
;HERE IF FILE WRITTEN IN 36-BIT BYTES. ANY I/O MODE IS LEGAL,
; SO MUST COMPUTE NUMBER OF N-BIT BYTES IN FILE GIVEN NUMBER
; OF 36-BIT BYTES
INDSK2: MOVE T1,T4 ;COPY WORD COUNT
MOVE T2,IOMODE ;UNLESS THIS IS A SIXBIT FILE,
CAXE T2,MODSIXBIT ; ..
IMUL T1,IOBPW ;MULTIPLY BY BYTES PER WORD
MOVEM T1,FILEOF(F) ;SAVE AWAY
INDSK3: MOVE T1,IBUFNO ;GET NO. OF PAGES PER INPUT BUFFER
HRLM T1,FILBUF(F) ;STORE IT
SKIPGE BUFALC ;HAS BUFFER BEEN ALLOCATED YET?
JRST INDSK5 ;YES
LSH T1,POW2(PGSIZ) ;NO, CONVERT PAGES TO WORDS
CALL ALCBPG ;ALLOCATE T1 WORDS ON PAGE BOUNDARY
LSH T1,-<POW2(PGSIZ)> ;CONVERT ADDRESS TO PAGE NO.
HRRM T1,FILBUF(F) ;STORE PAGE NO. OF BUFFER IN FCB
INDSK5: CALL MRKPGS ;[326] MARK PAGES AS POSSIBLY MAPPED
HRRZ T1,FILBUF(F) ;[326] [321] GET PAGE BUFFER STARTS ON
LSH T1,POW2(PGSIZ) ;[321] COMPUTE ADDRESS
HRLM T1,FILBSZ(F) ;[321] SAVE AS 1ST BLOCK BOUNDARY
HLRZ T1,FILBUF(F) ;[321] GET PAGES PER BUFFER
LSH T1,POW2(PGSIZ) ;CONVERT TO WORDS
MOVE T2,IOMODE ;GET I/O MODE
CAXE T2,MODSIXBIT ;IF SIXBIT, WORDS=BYTES
IMUL T1,IOBPW ;CONVERT TO APPROPRIATE NO. OF BYTES
MOVEM T1,FILBPB(F) ;SAVE NO. OF BYTES PER BUFFER
HLRZ T1,FILPGN(F) ;GET JFN
MOVX T2,OF%RD ;OPEN FOR READ
OPENF% ;[335] ..
ERJMP E$$OPN ;OOPS
RET
SUBTTL I/O ROUTINES -- INIINP - Initialize Next Input File -- Magtape
;COMPUTES: FILEOF(F)/ NOT USED FOR MAGTAPE
; FILBPB(F)/ BYTES PER BUFFER
; FILBUF(F)/ (LH) WORDS PER BUFFER (NOT PAGES)
; FILBUF(F)/ (RH) ADDRESS OF BUFFER (WORD ADDRESS, NOT PG)
INMTA: MOVX T1,FI.MTA ;REMEMBER THIS IS A MAGTAPE
IORM T1,FILFLG(F) ; ..
CALL MTBFSZ ;COMPUTE BUFFER SIZE, IN WORDS
HRLZM T1,FILBUF(F) ;SAVE SIZE OF BUFFER
IMUL T1,IOBPW ;COMPUTE BYTES PER BUFFER
MOVEM T1,FILBPB(F) ;SAVE IN FCB
HLRZ T1,FILBUF(F) ;RECOVER WORDS PER BUFFER
CALL ALCBPG ;ALLOCATE BUFFER ON PAGE BOUNDARY
HRRM T1,FILBUF(F) ;SAVE ITS ADDRESS
HLRZ T1,FILBUF(F) ;GET WORDS PER BUFFER
CALL ALCBPG ;ALLOCATE SECOND BUFFER ON PG BOUNDARY
HLRZ T1,FILPGN(F) ;GET JFN
MOVX T2,OF%RD!FLD(17,OF%MOD) ;OPEN FOR READ, DUMP MODE
OPENF% ;[335] ..
ERJMP E$$OPN
MOVX T1,FI.REW ;REWIND REQUESTED?
TDNE T1,FILFLG(F) ; ..
CALL RWNDF ;YES, DO IT
CALL LABSET ;SET UP TAPE LABEL STUFF
CALL STRTIO ;START INPUT ON FIRST BUFFER
CALLRET CHKLBL ;CHECK HEADER LABELS AND RETURN
;START I/O ON THE FIRST MAGTAPE BUFFER. THE FIRST CALL TO GETBUF
; WILL START I/O ON THE SECOND BUFFER, RETURNING WHEN ALL
; I/O TO THE FIRST BUFFER IS COMPLETE
STRTIO: HLRZ T1,FILPGN(F) ;GET JFN FOR TAPE
GDSTS% ;[335] GET CURRENT STATUS
TXZ T2,MT%IRL ;CLEAR POSSIBLE LEFTOVER ERROR BITS
SDSTS% ;[335] ..
MOVX T1,FI.BF2+FI.EOF ;CLEAR RANDOM FLAGS
ANDCAM T1,FILFLG(F) ; ..
;CONSTRUCT I/O COMMAND LIST
HLRZ T1,FILBUF(F) ;GET WORDS PER BUFFER
MOVN T1,T1 ;NEGATE
HRLZ T2,T1
HRRZ T1,FILBUF(F) ;GET BUFFER ADDRESS
MOVEI T1,-1(T1) ; MINUS ONE
HRR T2,T1 ;CONSTRUCT IOWD POINTER
MOVEM T2,INLST ;SAVE IT
SETZM INLST+1 ;TIE OFF END OF COMMAND LIST
;START I/O ON FIRST BUFFER
HLRZ T1,FILPGN(F) ;GET JFN
MOVX T2,DM%NWT ;LIGHT "DO NOT WAIT" BIT
HRRI T2,INLST ;ADDRESS OF COMMAND LIST
DUMPI% ;[335] INITIATE I/O
ERJMP E$$DME
RET
;BLKSET - SET UP FOR BLOCKED FILE. COMPUTES NUMBER OF WORDS IN
;A BLOCK (ALWAYS AN INTEGRAL MULTIPLE OF 128 WORDS).
BLKSET: MOVE T1,RECSIZ ;[344] [305] GET BYTES PER WORD
IMUL T1,X.BLKF(P1) ;[305] TIMES RECORDS PER BLOCK
TRZE T1,177 ;[435] [344] [305] LOSE LOW=ORD BITS. WORD/BLK. UNLESS ALREADY 0
ADDI T1,200 ;[305] ROUND UP TO NEXT WHOLE BLOCK SIZE
HRRM T1,FILBSZ(F) ;[321] SAVE IN FCB
RET ;[305] DONE
SUBTTL I/O ROUTINES -- INIINP - Initialize Next Input File -- Others
INNUL:
INTTY:
INPTY:
INCDR: CALL SETUP7 ;SET UP FOR 7-BIT TRIVIAL DEVICE
HLRZ T1,FILPGN(F) ;GET JFN
MOVX T2,OF%RD!FLD(7,OF%BSZ) ;OPEN FOR READ, 7-BIT BYTES
OPENF% ;[335] ..
ERJMP E$$OPN
RET
;ROUTINES TO INITIALIZE SIMPLEMINDED DEVICES FOR OUTPUT
OUNUL:
OULPT:
OUTTY:
OUPTY:
OUCDP: CALL SETUP7 ;SET UP FOR SIMPLE 7-BIT DEVICE
HLRZ T1,FILPGN(F) ;GET JFN
MOVX T2,OF%WR!FLD(7,OF%BSZ) ;OPEN FOR WRITE, 7-BIT BYTES
OPENF% ;[335]
ERJMP E$$OPN
MOVE T1,FILBPB(F) ;GET BYTES PER BUFFER
MOVEM T1,FILCNT(F) ;INDICATE BUFFER WAITING TO BE FILLED
RET
;SETUP7 - SET UP FOR SIMPLEMINDED ASCII-ONLY DEVICES
SETUP7: MOVE T1,IOMODE ;GET I/O MODE
CAXE T1,MODASCII ;LEGAL?
JRST E$$IDM ;NO, COMPLAIN
MOVEI T1,^D100 ;ARBITRARILY ALLOCATE 100-WD BUFFER
HRLZM T1,FILBUF(F) ;SAVE WORDS PER BUFFER IN FCB
CALL ALCBUF ;ALLOCATE BUFFER SPACE
HRRM T1,FILBUF(F) ;SAVE ADDRESS OF BUFFER
ADD T1,CBPTR ;CONSTRUCT BYTE POINTER
MOVEM T1,FILPTR(F) ;SAVE IT
MOVEI T1,^D100 ;COMPUTE BYTES PER BUFFER
IMUL T1,IOBPW ; ..
MOVEM T1,FILBPB(F) ;SAVE IT
RET
;COMPUTE BUFFER SIZE FOR MAGTAPE, ACCOUNTING FOR BLOCKING FACTOR
MTBFSZ: SKIPN T3,X.BLKF(P1) ;BLOCKING FACTOR SPECIFIED?
JRST MTBFS1 ;UNBLOCKED, USE DEFAULT RECORD SIZE
MOVE T1,IOMODE ;DISPATCH ON I/O MODE
JRST @[MTB6BT ;SIXBIT
MTBASC ;ASCII
MTBBCD ;EBCDIC
MTBBIN]-1(T1) ;BINARY
MTB6BT: MOVE T1,RECSIZ ;RECORD SIZE
IMUL T1,T3 ;TIMES BLOCKING FACTOR
RET ;EQUALS BUFFER SIZE
MTBASC: MOVE T1,RECORD ;RECORD SIZE IN BYTES
ADDI T1,2 ;PLUS CRILLIF
IMUL T1,T3 ;TIMES BLOCKING FACTOR
IDIVI T1,5 ;DIVIDED BY BYTES PER WORD
SKIPE T2 ;PLUS ONE
ADDI T1,1 ; IF ANY PARTIAL WORDS
RET ;EQUALS BUFFER SIZE IN WORDS
MTBBCD: MOVE T1,RECORD ;RECORD SIZE IN BYTES
IMUL T1,T3 ;TIMES BLOCKING FACTOR
IDIVI T1,4 ;DIVIDED BY BYTES PER WORD
SKIPE T2 ;PLUS ONE
ADDI T1,1 ; IF ANY PARTIAL WORDS
RET ;EQUALS BUFFER SIZE
MTBBIN: MOVE T1,RECSIZ ;RECORD SIZE IN WORDS
IMUL T1,T3 ;TIMES BLOCKING FACTOR
RET ;IS BUFFER SIZE
MTBFS1: MOVE T1,DFMTRS ;GET DEFAULT MAGTAPE RECORD SIZE
RET
;LABSET -- SET UP LABEL NAMES IN SIXBIT FOR LABEL PROCESSING
LABSET: MOVE T1,X.LABL(P1) ;GET LABEL TYPE FOR THIS TAPE
MOVE T2,X.FLG(P1) ; AND FLAGS
CAXE T1,LABOMITTED ;ARE LABELS OMITTED?
TXNE T2,FI.ATO ; OR IS PULSAR DOING LABELLING FOR US?
RET ;YES TO EITHER, SKIP THIS
PUSH P,P2 ;GET A REG
MOVEI T1,^D17 ;ALLOCATE ENUF WORDS FOR FILENAME.EXT
CALL GETSPC ; ..
JRST E$$NEC
MOVE P2,T1 ;SAVE ADDR OF STRING SPACE
HRL T1,T1 ;MAKE BLT POINTER
HRRI T1,1(P2) ; TO CLEAR STRING SPACE
HRRZI T2,^D17-1(P2) ;END OF BLT
SETZM 0(P2) ;CLEAR FIRST WORD
BLT T1,0(T2) ;SPREAD IT AROUND
SETZM X.RIB+.RBNAM(P1) ;CLEAR CELLS IN X. BLOCK
SETZM X.RIB+.RBEXT(P1) ; WHICH WILL RECEIVE SIXBIT NAME.EXT
HRRO T1,P2 ;CONSTRUCT STRING PTR TO SPACE
HRRZ T2,X.JFN(P1) ;GET JFN OF THIS TAPE
MOVX T3,<1B8+1B11+JS%PAF> ;GET FILENAME.EXT, WITH THE DOT
JFNS% ;[335] GET THE NAME
ERJMP E$$NFS ;NO FILE NAME SPECIFIED FOR LABELED TAPE
;CONVERT THE ASCIZ STRING POINTED TO BY P2 (NAME.EXT) TO
; SIXBIT AND STUFF INTO X.RIB+.RBNAM AND X.RIB+.RBEXT
HRLI P2,(POINT 7,) ;POINT TO ZEROTH BYTE
MOVEI T4,6 ;MAXIMUM CHARACTERS ALLOWED
MOVE T3,[POINT 6,X.RIB+.RBNAM(P1)] ;WHERE TO PUT SIXBIT
LABST1: ILDB T1,P2 ;GET THE NEXT BYTE
JUMPE T1,LABST2 ;NULL TERMINATES FILENAME
CAIN T1,"." ;CHECK FOR DOT
JRST LABST3 ;FOUND IT, GO ON TO TYPE
SOJL T4,E$$FTL ;FILESPEC FIELD TOO LONG FOR LABELLED TAPE
SUBI T1,40 ;CONVERT BYTE TO SIXBIT
IDPB T1,T3 ;PLUNK INTO X. BLOCK
JRST LABST1 ;ONCE MORE
LABST3: MOVEI T4,3 ;TYPE IS 3 CHARS MAX
MOVE T3,[POINT 6,X.RIB+.RBEXT(P1)]
JRST LABST1 ;GO DO THE TYPE
LABST2: MOVEI T1,^D17 ;RETURN STRING SPACE TO FREE POOL
CALL FRESPC ; ..
POP P,P2 ;RESTORE P2
RET ;RETURN
SUBTTL I/O ROUTINES -- INIOUT - Initialize Next Output File -- Set Up
;CALL: PUSHJ P,INIOUT
;RETURNS: +1/ ALWAYS
INIOUT: MOVEI F,FCBORG ;OUTPUT FILE IS ALWAYS 1ST FCB
PUSH P,P1 ;GET A REGISTER
MOVE P1,F.OUZR ;GET PTR TO X. BLOCK
MOVEM P1,FILXBK(F) ;SAVE IN FCB
SETZM FILSIZ(F) ;INIT FILE SIZE
SETZM FILEOF(F) ; AND BYTE COUNT
MOVE T1,X.FLG(P1) ;PUT FLAGS IN FCB
TXO T1,FI.OUT ;REMEMBER THIS IS AN OUTPUT FILE
MOVEM T1,FILFLG(F) ; ..
MOVE T1,X.JFN(P1) ;GET JFN
HRLZM T1,FILPGN(F) ;SAVE IT AND ZAP PAGE COUNT
MOVN T1,X.BLKF(P1) ;GET NEGATIVE BLOCKING FACTOR
SKIPE T1 ;[312] ALREADY ZERO?
SUBI T1,1 ;[305] ADJUST FOR OFF-BY-ONE CODE
HRLZM T1,FILBLK(F) ;STORE AS AOBJN WORD
LDB T1,[POINT 9,X.DVCH(P1),17] ;GET DEVICE TYPE AND DISPATCH ON IT
CAILE T1,.DVNET ;RANGE CHECK
JRST E$$NSD ;NO SUCH DEVICE
JUMPL T1,E$$NSD ;CAN'T BE NEGATIVE
CALL @[OUDSK ;0 - DISK
E$$NSD ;1 - NO SUCH DEVICE
OUMTA ;2 - MAGTAPE
REPEAT 4,<E$$NSD> ;3-6 - NO SUCH DEVICE
OULPT ;7 - LPT
E$$CDC ;10 - CDR
E$$FED ;11 - FRONT-END DEVICE
OUTTY ;12 - TERMINAL
OUPTY ;13 - PSEUDO-TERMINAL
E$$NSD ;14 - NO SUCH DEVICE
OUNUL ;15 - NULL DEVICE
E$$AND](T1) ;16 - ARPANET DEVICE
POP P,P1 ;RESTORE P1
RET
SUBTTL I/O ROUTINES -- INIOUT - Initialize Next Output File -- Disk
OUDSK: MOVX T1,FI.DSK ;REMEMBER THIS IS A DISK FILE
IORM T1,FILFLG(F) ; ..
SKIPE X.BLKF(P1) ;[305] IF BLOCKED FILE,
CALL BLKSET ;[305] SET UP FOR IT
HLRZ T1,FILPGN(F) ;GET JFN
MOVX T2,OF%RD!OF%WR ;OPEN FOR READ AND WRITE
MOVE T3,IOMODE ;GET I/O MODE
CAXN T3,MODASCII ;IS THIS TO BE AN ASCII FILE?
IORX T2,FLD(7,OF%BSZ) ;YES, SET BYTE SIZE TO 7
OPENF% ;[335]
ERJMP E$$OPN
MOVE T1,OBUFNO ;GET PAGES PER OUTPUT BUFFER
HRLM T1,FILBUF(F) ;SAVE IN FCB
LSH T1,POW2(PGSIZ) ;COMPUTE WORDS PER BUFFER
CALL ALCBPZ ;[371] ALLOC BUFFER ON PG BOUNDRY AND ZERO IT
HRLM T1,FILBSZ(F) ;[321] SAVE BUFF ORG AS 1ST BLOCK BREAK
LSH T1,-<POW2(PGSIZ)> ;COMPUTE BUFFER PAGE NUMBER
HRRM T1,FILBUF(F) ;SAVE
LSH T1,POW2(PGSIZ) ;CONVERT BACK TO ADDRESS
ADD T1,CBPTR ;CONSTRUCT BYTE POINTER
MOVEM T1,FILPTR(F) ;SAVE IT
HLRZ T1,FILBUF(F) ;GET PAGES PER BUFFER
LSH T1,POW2(PGSIZ) ;COMPUTE WORDS
MOVE T2,IOMODE ;FOR SIXBIT FILES,
CAXE T2,MODSIXBIT ; WORDS=BYTES
IMUL T1,IOBPW ;COMPUTE BYTES
MOVEM T1,FILCNT(F) ;INDICATE BUFFER WAITING TO BE FILLED
MOVEM T1,FILBPB(F) ;SAVE HOW MANY BYTES IN A BUFFER
RET ;RETURN
SUBTTL I/O ROUTINES -- INIOUT - Initialize Next Output File -- Magtape
OUMTA: MOVX T1,FI.MTA ;REMEMBER THIS IS A MAGTAPE
IORM T1,FILFLG(F)
HLRZ T1,FILPGN(F) ;GET JFN
MOVX T2,OF%WR!FLD(17,OF%MOD) ;OPEN FOR WRITE, DUMP MODE
OPENF% ;[335] ..
ERJMP E$$OPN ;OPEN ERROR
CALL MTBFSZ ;COMPUTE BUFFER SIZE (IN WORDS)
HRLZM T1,FILBUF(F) ;SAVE IT
MOVE T2,IOMODE ;[420] FOR SIXBIT FILES
CAXE T2,MODSIXBIT ;[420] WORDS=BYTES
IMUL T1,IOBPW ;COMPUTE BYTES PER BUFFER
MOVEM T1,FILBPB(F) ;SAVE IT
MOVEM T1,FILCNT(F) ;INDICATE BUFFER EMPTY
HLRZ T1,FILBUF(F) ;RECOVER WORDS PER BUFFER
CALL ALCBPZ ;[371] ALLOCATE BUFFER ON A PAGE BOUNDARY AND ZERO IT
HRRM T1,FILBUF(F) ;REMEMBER ITS ADDRESS
HLRZ T1,FILBUF(F) ;GET BUFFER SIZE AGAIN, IN WORDS
CALL ALCBPZ ;[371] ALLOCATE THE SECOND BUFFER
MOVX T1,FI.REW ;REWIND REQUESTED?
TDNE T1,FILFLG(F) ; ..
CALL RWNDF ;YES, DO IT
HRRZ T1,FILBUF(F) ;GET ADDRESS OF BUFFER
ADD T1,CBPTR ;MAKE BYTE POINTER
MOVEM T1,FILPTR(F) ;SAVE IN FCB
CALL LABSET ;SET UP LABEL PARAMETERS
CALLRET WRTLBL ;WRITE HEADER LABEL AND RETURN
SUBTTL I/O ROUTINES -- Magtape Utility Routines
;RWNDF - REWIND MAGTAPE POINTED TO BY F
RWNDF: MOVX T2,.MOREW ;FUNCTION TO REWIND TAPE
RWNDF1: HLRZ T1,FILPGN(F) ;GET JFN
MTOPR% ;[335] DO IT
RET
;UNLDF - UNLOAD MAGTAPE POINTED TO BY F
UNLDF: MOVX T2,.MORUL ;GET FUNCTION CODE
JRST RWNDF1 ;JOIN COMMON CODE
;SKIPR - SKIP MAGTAPE ONE RECORD
SKIPR: MOVX T2,.MOFWR ;LOAD FUNCTION CODE
JRST RWNDF1 ;JOIN COMMON CODE
;SKIPF - SKIP MAGTAPE ONE FILE
SKIPF: MOVX T2,.MOFWF ;FUNCTION CODE
JRST RWNDF1
;WRTEOF - WRITE A TAPE MARK DURING LABEL PROCESSING
WRTEOF: MOVX T2,.MOEOF ;[335] FUNCTION CODE FOR MTOPR%
JRST RWNDF1 ;DO IT
;FORCBF - FORCE PARTIAL BUFFER OUT TO TAPE DURING LABEL PROCESSING
FORCBF: MOVX T1,FI.CLZ ;PRETEND CLOSE IN PROGRESS
IORM T1,FILFLG(F) ; ..
JSP T4,PUTBUF ;WRITE THE BUFFER
MOVX T1,FI.CLZ ;CLEAR THE BIT
ANDCAM T1,FILFLG(F)
RET
;ISITMT - CHECK TO SEE IF FILE POINTED TO BY F IS A MAGTAPE
; SKIP RETURN IF IT IS
ISITMT: MOVX T1,FI.MTA
TDNE T1,FILFLG(F)
AOS (P)
RET
>;END IFE FTCOBOL
SUBTTL I/O ROUTINES -- File Utility Routines -- Close Master Input/Output File
CLSMST: TDZA T4,T4 ;REMEMBER THIS IS A MASTER CLOSE
CLSFIL: SETO T4, ;REMEMBER WE'RE CLOSING A TMP FILE
MOVX T1,FI.OUT ;IS THIS AN OUTPUT FILE?
TDNN T1,FILFLG(F) ; ..
JRST CLSFL2 ;NO, DON'T WRITE PARTIAL BUFFERS
PUSH P,T4 ;SAVE FLAG REG
MOVX T1,FI.CLZ ;INDICATE CLOSE IN PROGRESS
IORM T1,FILFLG(F) ; ..
JSP T4,PUTBUF ;WRITE LAST PARTIAL BUFFER
MOVX T1,FI.CLZ ;CLEAR CLOSE FLAG
ANDCAM T1,FILFLG(F) ; ..
POP P,T4 ;GET T4 BACK AGAIN
MOVX T1,FI.DSK ;IS THIS A DISK FILE?
TDNN T1,FILFLG(F) ; ..
JRST CLSFL3 ;NO, DON'T UPDATE FDB OR DO PMAPS
JUMPN T4,CLSFL2 ;[420] IF TEMP FILE CLOSE, DON'T UPDATE FDB
MOVSI T1,.FBBYV(CF%NUD) ;SET FILE BYTE SIZE
HLR T1,FILPGN(F) ;GET JFN
MOVX T2,FB%BSZ ;MASK FOR BYTE SIZE FIELD
MOVX T3,^D36B11 ;DEFAULT IS 36-BIT BYTES
IFE FTCOBOL,<
MOVE T0,IOMODE ;GET I/O MODE
CAXN T0,MODASCII ;ASCII?
MOVX T3,7B11 ;YES, BYTES ARE 7 BITS LONG
CAXN T0,MODEBCDIC ;EBCDIC?
MOVX T3,9B11 ;YES, BYTES ARE 9 BITS LONG
>
CHFDB% ;[335] UPDATE FDB
HRLI T1,.FBSIZ(CF%NUD) ;NOW UPDATE NO. OF BYTES IN FILE
SETO T2, ;CHANGE ALL BITS
MOVE T3,FILEOF(F) ;NO. OF BYTES WE WROTE
CHFDB% ;[335]
CLSFL2: MOVE T1,FILFLG(F) ;GET FILE FLAGS
TXNE T1,FI.DSK ;DISK FILE?
TXNE T1,FI.OUT ; AND INPUT?
JRST CLSFL3 ;NO TO EITHER, DON'T UNMAP BUFFER
PUSH P,T4 ;UNMAPF CALLS CLRBIT, WHICH TRASHES T4
CALL UNMAPF ;UNMAP FILE PAGES
POP P,T4
CLSFL3: JUMPN T4,CPOPJ ;[420] TEMP FILE CLOSE?
IF FILE IS OUTPUT MTA WITH LABELS
MOVE T1,FILFLG(F) ;[420] GET FLAGS
TXC T1,FI.MTA!FI.OUT ;[420]
TXCE T1,FI.MTA!FI.OUT ;[420] OUTPUT MTA?
JRST $T ;[420] NO
TXNE T1,FI.ATO ;[420] TAPE LABEL PROCESSOR AVAIL?
JRST $T ;[420] NO
MOVE T1,FILXBK(F) ;[420] GET X.??? BLOCK FOR FILE
MOVE T1,X.LABL(T1) ;[420] GET LABEL TYPE
CASE LABEL TYPE OF (STANDARD,OMITTED,NON-STANDARD,DEC,ANSI,IBM)
JRST @[EXP CPOPJ,$C,$C,CPOPJ,$C,$C]-1(T1)
ESAC;
THEN JUST RETURN WITH FILE STILL OPEN
ELSE CLOSE FILE AND RELEASE JFN
HLRZ T1,FILPGN(F) ;[420] GET JFN OF FILE
CLOSF% ;[335] NO, CLOSE IT
ERJMP E$$CFF ;CLOSE FAILURE FOR FILE
FI;
RET
SUBTTL I/O ROUTINES -- File Utility Routines -- Delete, Rename a File
;DELFIL - DELETE FILE POINTED TO BY F
DELFIL: CALL UNMAPF ;FIRST UNMAP ANY BUFFER PAGES
HLRZ T1,FILPGN(F) ;GET JFN
TXO T1,CZ%ABT ;ABORT (I.E., EXPUNGE) FILE
CLOSF% ;[335] CLOSE AND DELETE IT
ERJMP E$$CFF ;[357] CAN'T CLOSE FILE
RET
;*** TEMPORARY DUMMY ROUTINE TO RESOLVE UNDEFINED GLOBALS ***
RELFIL: RET ;JUST RETURN
;*** END OF TEMPORARY DUMMY ROUTINE ***
SUBTTL I/O ROUTINES -- File Utility Routines -- Unmap Buffer Pages For a File
UNMAPF: SETO T1, ;PREPARE TO UNMAP BUFFER
MOVSI T2,.FHSLF ;THIS FORK
HRR T2,FILBUF(F) ;STARTING FROM THIS PAGE
HLRZ T3,FILBUF(F) ;UNMAP THIS MANY PAGES
IORX T3,PM%CNT ; ..
PMAP% ;[335]
PUSH P,P1 ;GET A REG
HLRZ P1,FILBUF(F) ;GET PAGES PER BUFFER
MOVN P1,P1 ;NEGATE
HRLZ P1,P1 ;CONSTRUCT AOBJN PTR
HRR P1,FILBUF(F) ;PUT PG NO IN RH
UNMAP1: HRRZ T1,P1 ;GET BIT (PAGE) NUMBER
MOVEI T2,PGTAB ;CLEAR BIT IN PGTAB TO INDICATE
CALL CLRBIT ; THAT THIS PAGE IS NOW UNMAPPED
AOBJN P1,UNMAP1 ;LOOP FOR ALL PAGES
POP P,P1 ;RESTORE P1
RET
;ERSET$ - CLEAN UP THE MESS AFTER A FATAL ERROR; CALLED BY DIE
;RESET$ - DEALLOCATE CORE AND UNMAP BUFFER PAGES; CALLED BY ENDS.
RESET$: TDZA P3,P3 ;[335] INDICATE CALLED BY ENDS.
ERSET$: SETO P3, ;[335] INDICATE CALLED BY DIE
MOVSI P1,-<<400/^D36>+1> ;SET UP AOBJN PTR TO PGTAB
SETZ P2, ;INIT BIT NUMBER
RESET1: MOVE T1,PGTAB(P1) ;GET NEXT WORD OF PGTAB
JFFO T1,RESET2 ;ANY ONE BITS?
ADDI P2,^D36 ;NO, STEP BIT NUMBER
AOBJN P1,RESET1 ;KEEP LOOKING
JRST RESETC ;NO MORE BITS, CLOSE FILES
RESET2: ADD T2,P2 ;COMPUTE BIT WITHIN TABLE
MOVE T1,T2 ;SET UP FOR CALL TO CLRBIT
PUSH P,T2 ;SAVE BIT NUMBER OVER CLRBIT
MOVEI T2,PGTAB ; ..
CALL CLRBIT ;CLEAR THIS BIT
POP P,T2 ;RECOVER BIT (PAGE) NUMBER
HRLI T2,.FHSLF ; FROM THIS FORK
SETO T1, ;INDICATE UNMAPPING
SETZ T3, ;ONE PAGE ONLY
PMAP% ;[335] UNMAP IT
JRST RESET1
RESETC: MOVE P1,CORSTK ;GET PTR TO ALLOCATION STACK
RESTC1: HRRZ T1,P1 ;SEE IF EMPTY YET
CAIN T1,CSTACK-1 ;IS IT?
JRST RESTC3 ;YES
HLRZ T1,0(P1) ;NO, GET LENGTH OF TOP ENTRY
CALL FRESPC ;FREE IT
POP P1,T1 ;DROP THE STACK DOWN
JRST RESTC1 ;KEEP GOING
RESTC3: CAME P1,CORSTK ;FRESPC SHOULD MAKE THIS COME OUT RIGHT
JRST E$$FCR ;FATAL MEMORY MANAGEMENT ERROR AT RESET%
;WERE WE CALLED BY DIE?
JUMPE P3,CPOPJ ;NO, FILES SHOULD BE CLOSED ALREADY
MOVEI F,FCBORG ;YES, CLOSE AND ABORT MASTER FILE
HLRZ T1,FILPGN(F) ;GET JFN
IORX T1,CZ%ABT ;ABORT IT
CLOSF% ;[335]
ERJMP .+1
MOVN F,ACTTMP ;GET NO. OF ACTIVE TMP FILES
HRLZ F,F ;CONSTRUCT AOBJN PTR
HRRI F,TMPFCB ; TO TMP FCB BLOCKS
RESTC2: HLRZ T1,FILPGN(F) ;GET JFN
IORX T1,CZ%ABT ;ABORT FILE
CLOSF% ;[335]
ERJMP .+1
ADDI F,FCBLEN-1 ;STEP TO NEXT FCB (ACCOUNTING FOR AOBJN)
AOBJN F,RESTC2 ; ..
RET
;MRKPGS - MARK PAGES OF THIS FILE AS POSSIBLY BEING MAPPED
; SO ON A FATAL ERROR THEY WILL BE UNMAPPED BY RESET%
MRKPGS: PUSH P,P1 ;GET A REG
HLRZ P1,FILBUF(F) ;GET PAGES PER BUFFER
MOVN P1,P1 ;NEGATE
HRLZ P1,P1 ;MAKE AOBJN PTR
HRR P1,FILBUF(F) ;PUT PAGE NO. IN RH
MRKPG1: HRRZ T1,P1 ;GET PAGE (BIT) NUMBER
MOVEI T2,PGTAB ;SET BIT IN PGTAB
CALL SETBIT ; ..
AOBJN P1,MRKPG1 ;DO IT FOR ALL PAGES
POP P,P1 ;RESTORE P1
RET
;SETBIT - SET A BIT IN A TABLE
;CALL WITH: T1/ BIT NO.
; T2/ TABLE ADDR.
SETBIT: CALL BITSET ;COMPUTE WORD AND SET UP BIT IN T3
TDNE T3,0(T1) ;IS BIT ALREADY SET?
JRST E$$FPM ;YES
IORM T3,0(T1) ;NO, SET IT AND RETURN
RET
;CLRBIT - ANALOGOUS TO SETBIT
CLRBIT: CALL BITSET ;COMPUTE WORD ADDR AND SET UP BIT
TDNN T3,0(T1) ;ALREADY CLEAR?
JRST E$$FPU ;YES
ANDCAM T3,0(T1) ;NO, CLEAR IT
RET
;BITSET - COMPUTE WORD IN T1 AND PLACE BIT IN T3
BITSET: MOVE T4,T2 ;COPY TABLE ADDR
IDIVI T1,^D36 ;COMPUTE WORD AND BIT WITHIN WORD
MOVX T3,<1B0> ;GET ZEROTH BIT
MOVN T2,T2 ;NEGATE BIT NO. FOR LSH
LSH T3,0(T2) ;PUT BIT IN RIGHT PLACE
ADD T1,T4 ;COMPUTE WORD WITHIN TABLE
RET
SUBTTL I/O ROUTINES -- File Utility Routines -- Initialize Output Temporary File
ENTFIL: AOS T1,NUMTMP ;COUNT RUNS
HRLM T1,FILRUN(F) ;FOR COMPAR = TEST
AOS T1,NUMENT ;COUNT TEMP FILES
CAMLE T1,MAXTMP ;WRAPPED AROUND YET?
CALLRET APPFIL ;YES, APPEND TO THIS FILE
MOVX T1,FI.DSK!FI.OUT!FI.TMP ;SET APPROPRIATE FLAGS
IORM T1,FILFLG(F) ; ..
CALL GENNAM ;GENERATE NEW TEMP FILE NAME
HRRZ T2,TCBIDX ;GET INDEX TO TEMP FILE
IDIV T2,STRNUM ;ROUND ROBIN DIR NUMBERS
MOVE T2,STRNAM(T3) ;GET DIRECTORY NUMBER FOR TEMP FILE
CALL XGTJFN ;MAKE ASCIZ FILESPEC AND DO GTJFN
MOVX T2,OF%WR ;OPEN FOR WRITE
OPENF% ;[335]
ERJMP E$$OPN
HRLZM T1,FILPGN(F) ;SAVE JFN AND ZERO PAGE COUNTER
SKIPGE BUFALC ;HAVE BUFFERS BEEN ALLOCATED YET?
JRST [HRRZ T1,FILBUF(F) ;YES, GET ADDRESS OF BUFFER
JRST ENTFL1] ;GO SET UP BYTE POINTER
MOVE T1,TBUFNO ;GET PAGES PER TEMP FILE BUFFER
HRLZM T1,FILBUF(F) ;SAVE IN FCB
LSH T1,POW2(PGSIZ) ;COMPUTE WORDS IN BUFFER
MOVEM T1,FILBPB(F) ;SAVE BYTES (=WORDS) PER BUFFER
CALL ALCBPG ;ALLOCATE BUFFER ON PG BOUNDARY
LSH T1,-<POW2(PGSIZ)> ;CONVERT ADDR OF BUFFER TO PAGE NO.
HRRM T1,FILBUF(F) ;SAVE IN FCB
ENTFL1: LSH T1,POW2(PGSIZ) ;CONVERT BACK TO ADDRESS
ADD T1,CBPTR ;CONSTRUCT BYTE POINTER
MOVEM T1,FILPTR(F) ;SAVE IT
MOVE T1,FILBPB(F) ;GET BYTES PER BUFFER
MOVEM T1,FILCNT(F) ;INDICATE BUFFER WAITING TO BE FILLED
SETZM FILEOF(F) ;INDICATE NOTHING'S BEEN WRITTEN YET
RET ;RETURN
;SETTMP - PLUG OUR CONNECTED DIRECTORY NUMBER INTO STRNAM
; AS A DEFAULT IF USER DIDN'T TYPE ANY /TEMP SWITCHES
IFE FTCOBOL,<
SETTMP: SKIPE STRNUM ;DID USER TYPE ANY /TEMP SWITCHES?
RET ;YES, WE'RE ALL SET
SETZ T1, ;GET DIRECTORY ASSOCIATED WITH DSK:
HRROI T2,[ASCIZ /DSK:/] ; TO BE CONSISTENT WITH MOST EXEC COMMANDS
RCDIR% ;[335]
ERJMP NODISK ;MIGHT BE DEFINED TO BE A NON-DISK DEV
MOVEM T3,STRNAM ;SAVE IN TABLE
AOS STRNUM ;INDICATE ONLY ONE TEMP FILE AREA
RET ;AND RETURN
NODISK: GJINF% ;[335] NO, GET CONNECTED DIRNUM IN T2
MOVEM T2,STRNAM ;SAVE IN TABLE
AOS STRNUM ;INDICATE ONLY ONE TEMP FILE AREA
RET ;AND RETURN
>
SUBTTL I/O ROUTINES -- File Utility Routines -- Append to Temporary File
APPFIL: HRRZ T1,TCBIDX ;GET TMP FILE INDEX
IMULI T1,DFBLEN ;FIND OFFSET OF DFB BLOCK FOR FILE
ADDI T1,DFBORG ;ADD BASE ADDRESS OF DFB BLOCKS
HRLZ T1,T1 ;CONSTRUCT BLT POINTER
HRR T1,F ;COPY TO CURRENT FCB
HRRZI T2,DFBLEN(T1) ;BLT LIMIT
HLRZ T3,FILRUN(F) ;PRESERVE RUN NUMBER ENTFIL COMPUTED
BLT T1,-1(T2) ;RESTORE INFORMATION TO FCB
HRLM T3,FILRUN(F) ;RESTORE RUN NUMBER ENTFIL COMPUTED
MOVE T3,FILEOF(F) ;GET FILE SIZE
IDIVI T3,PGSIZ ;GET PAGE NUMBER OF LAST PAGE
HRRM T3,FILPGN(F) ;[335] REMEMBER FOR PMAP%
HRRZ T1,FILBUF(F) ;GET 1ST PG OF BUFFER
LSH T1,POW2(PGSIZ) ;COMPUTE ADDRESS
ADDI T1,(T4) ;COMPUTE 1ST UNUSED WORD
ADD T1,CBPTR ;CONSTRUCT BYTE POINTER
MOVEM T1,FILPTR(F) ;SAVE IT
JUMPE T4,APPFL1 ;IF FILE ENDS ON PG. BOUNDARY, NO
; NEED TO READ PARTIAL PAGE IN
MOVE T1,FILPGN(F) ;[335] GET PMAP% SOURCE IDENT
MOVSI T2,.FHSLF ;CONSTRUCT IDENT TO BUFFER
HRR T2,FILBUF(F) ; ..
MOVX T3,PM%RD!PM%CPY!PM%PLD ;COPY-ON-WRITE ACCESS
PMAP% ;[335] GET THE PARTIALLY WRITTEN PAGE
MOVE T1,FILEOF(F) ;GET WORDS WRITTEN SO FAR
SUB T1,T4 ;SUBTRACT PARTIAL PAGE (BECAUSE
MOVEM T1,FILEOF(F) ; PUTBUF WILL COUNT THEM AGAIN)
APPFL1: MOVE T2,FILBPB(F) ;GET BYTES PER BUFFER
SUB T2,T4 ;COMPUTE BYTES LEFT IN BUFFER
MOVEM T2,FILCNT(F) ;REMEMBER
HRRZ T1,FILPTR(F) ;GET ADDR OF FIRST WORD TO BE USED
HLRO T2,FILRUN(F) ;FAKE SIXBIT WORD COUNT FOR EOF MARKER
MOVEM T2,0(T1) ;SET EOF MARKER
AOS FILPTR(F) ;BUMP BYTE PTR PAST EOF MARKER
SOSG FILCNT(F) ;ACCOUNT FOR THE WORD WE WROTE
JSP T4,PUTBUF ;COUNT EXPIRED, GET FRESH BUFFER
RET
;LKPFIL - SET UP TO START READING FROM BEGINNING OF TEMP FILE
LKPFIL: MOVX T1,FI.DSK!FI.TMP ;REMEMBER THIS IS A TEMP FILE
IORM T1,FILFLG(F) ; ..
MOVX T1,FI.OUT ;REMEMBER WE'RE NO LONGER
ANDCAM T1,FILFLG(F) ; DOING OUTPUT TO THIS FILE
SKIPGE BUFALC ;HAVE BUFFERS BEEN ALLOCATED YET?
JRST LKPFL1 ;YES, DON'T DO IT AGAIN
MOVE T1,TBUFNO ;GET PAGES PER TEMP FILE BUFFER
HRLZM T1,FILBUF(F) ;SAVE SIZE OF BUFFER IN FCB
LSH T1,POW2(PGSIZ) ;CONVERT PAGES TO WORDS
MOVEM T1,FILBPB(F) ;SAVE WORDS (=BYTES) PER BUFFER
CALL ALCBPG ;ALLOCATE BUFFER ON PAGE BOUNDARY
LSH T1,-<POW2(PGSIZ)> ;CONVERT ADDRESS TO PAGE
HRRM T1,FILBUF(F) ;SAVE ADDR OF BUFFER IN FCB
LKPFL1: CALL MRKPGS ;MARK PAGES AS POSSIBLY MAPPED
SETZM FILCNT(F) ;SO FIRST CALL TO GETREC CAUSES PMAP
HLLZS FILPGN(F) ;RESET PG COUNTER FOR PMAP
RET
;XGTJFN - CONVERT DIRNUM AND SIXBIT FILE NAME TO ASCIZ FILESPEC
;CALL WITH:
; T1/ SIXBIT FILENAME
; T2/ DIRECTORY NUMBER
;RETURNS:
; +1: WITH JFN IN T1
XGTJFN: PUSH P,P1 ;GET SOME REGS
PUSH P,P2 ; ..
DMOVE P1,T1
HRROI T1,AZTEMP ;[405] CONVERT ADDRESS TO STRING PTR
PUSH P,T1 ;SAVE PTR TO START OF STRING
DIRST% ;[335] MAKE A STRING
ERJMP E$$IDN ;INVALID DIRECTORY NUMBER
;NOW CONVERT THE SIXBIT STRING IN P1 TO ASCII, USING BIS. NOTE
; THAT THIS CODE ASSUMES THAT P1 ALWAYS CONTAINS 6 CHARACTERS.
MOVE P2,T1 ;COPY CURRENT BYTE PTR TO FILESPEC
MOVEI T0,6 ;SOURCE STRING LENGTH
MOVE T1,[POINT 6,P1] ;BYTE PTR TO 6-BIT SOURCE STRING
MOVEI T3,6 ;DESTINATION STRING LENGTH
MOVE T4,P2 ;COPY BYTE PTR TO FILESPEC
EXTEND T0,[MOVSO 40] ;ADD 40 TO EACH BYTE TO PRODUCE ASCII
JRST E$$BIS ;ERROR
;ADD TYPE AND ;T ATTRIBUTE TO FILESPEC
MOVEI T0,7 ;MOVE 7 CHARACTERS (INCLUDING THE NULL)
MOVE T1,[POINT 7,[ASCIZ /.TMP;T/]]
MOVEI T3,7 ;7 CHARS IN DEST
EXTEND T0,[MOVSLJ] ;T4 ALREADY HAS GOOD DEST PTR
JRST E$$BIS ;ERROR
MOVX T1,GJ%SHT ;SHORT FORM
POP P,T2 ;GET BYTE PTR TO FILESPEC
GTJFN% ;[335] GET THE JFN
ERJMP E$$GFT ;FAILED
POP P,P2 ;RESTORE P REGS
POP P,P1 ; ..
RET ;ALL SET, RETURN WITH T1=JFN
SUBTTL TRY TO RENAME SINGLE TEMP FILE TO OUTPUT FILE
IFE FTCOBOL,<
;TSTDEV - CHECK TO SEE IF SINGLE TEMP FILE IS ON SAME STRUCTURE
; AS OUTPUT FILE. IF SO, WE CAN RENAME INSTEAD OF COPY.
TSTDEV: HRRZ T1,IOMODE ;GET I/O MODE INDEX
CAXE T1,MODSIXBIT ;ONLY SIXBIT LOOKS LIKE TEMP FILE
RET
MOVS T1,@EXTRCT ;GET EXTRACT CODE
CAIN T1,(JRST (P4)) ;JUST A DUMMY?
SKIPE X.BLKF(P1) ;CAN'T DO IF OUTPUT BLOCKED
RET ;DO THE COPY
LDB T1,[POINT 9,X.DVCH(P1),17] ;GET DEVICE TYPE OF OUTPUT FILE
CAXE T1,.DVDSK ;DISK?
RET ;NO, MUST COPY TO OUTPUT FILE
PUSH P,P2 ;GET A REGISTER
MOVEI T1,2 ;ALLOCATE ENOUGH WORDS TO BUILD
CALL GETSPC ; DEVICE NAME STRING
JRST E$$NEC
SETZM 0(T1) ;ZERO STRING SPACE
SETZM 1(T1) ; ..
MOVE P2,T1 ;SAVE STRING ADDRESS
HRROS T1 ;CONSTRUCT STRING PTR TO IT
MOVEI T2,TMPFCB ;ONLY ONE TMP FILE, SO FCB IS AT TMPFCB
HLRZ T2,FILPGN(T2) ;PICK UP JFN
MOVX T3,<1B2> ;OUTPUT ONLY DEVICE FIELD
JFNS% ;[335] GET IT
ERJMP E$$JFT ;FAILED
MOVEI T1,2 ;ALLOCATE SPACE FOR DEVICE NAME STRING
CALL GETSPC ; OF OUTPUT FILE
JRST E$$NEC
SETZM 0(T1) ;ZERO STRING SPACE
SETZM 1(T1) ; ..
MOVE T4,T1 ;SAVE ADDRESS
HRROS T1 ;CONSTRUCT STRING PTR
HRRZ T2,X.JFN(P1) ;GET JFN OF OUTPUT FILE
MOVX T3,<1B2> ;GET DEVICE FIELD ONLY
JFNS% ;[335] ..
ERJMP E$$JFO ;FAILED
; ..
; ..
;T4 NOW POINTS TO DEVICE STRING FOR OUTPUT FILE, P2 POINTS TO
; DEVICE STRING FOR TEMP FILE. COMPARE USING BIS AND SET UP
; TO DO RENAME IF THEY ARE EQUAL.
MOVEI T0,6 ;SOURCE STRING LENGTH
HRRZ T1,T4 ;GET ADDR OF OUTPUT FILE DEVICE STRING
HRLI T1,(POINT 7,) ;CONSTRUCT BYTE POINTER
SETZ T2, ;NOT USED BY BIS
MOVEI T3,6 ;DEST STRING LENGTH
HRRZ T4,P2 ;GET ADDR OF TMP FILE DEVICE STRING
POP P,P2 ;RESTORE P2 NOW
HRLI T4,(POINT 7,) ;CONSTRUCT BYTE POINTER
EXTEND T0,[CMPSE ;COMPARE STRINGS, SKIP IF EQUAL
0 ; ZERO FILL IF EITHER
0] ; STRING RUNS OUT
JRST [MOVEI T1,4 ;FREE STRING SPACE WE GRABBED
CALLRET FRESPC];NON-SKIP RETURN, MUST DO COPY
MOVEI T1,4 ;FREE STRING SPACE WE GRABBED
CALL FRESPC ; ..
MOVEI T1,RSTF ;ADDR OF ROUTINE TO RENAME OUTPUT FILE
RETSKP ;SKIP RETURN TO INDICATE RENAME POSSIBLE
;RSTF - RENAME SOLITARY TEMP FILE TO BE SORT OUTPUT MASTER
RSTF: MOVEI T3,TMPFCB ;ONLY ONE TEMP FILE, FCB LIVES AT TMPFCB
HLRZ T1,FILPGN(T3) ;GET SOURCE JFN (OF TEMP FILE)
IORX T1,CO%NRJ ;DON'T RELEASE JFN
CLOSF% ;[335] CLOSE IT
ERJMP E$$CFR ;SOMETHING WRONG
MOVE T4,F.OUZR ;GET ADDR OF X. BLOCK FOR OUTPUT FILE
HRRZ T1,X.JFN(T4) ;GET JFN OF OUTPUT FILE
IORX T1,CO%NRJ ;DON'T RELEASE JFN
CLOSF% ;[335] CLOSE FILE
ERJMP E$$CFR ;OOPS
HLRZ T1,FILPGN(T3) ;GET TEMP FILE JFN AGAIN
HRRZ T2,X.JFN(T4) ;GET OUTPUT FILE JFN
RNAMF% ;[335] DO THE RENAME
ERJMP E$$RFF ;FAILED
MOVE T1,INPREC ;FAKE COPY OF FILE
MOVEM T1,OUTREC ;SO ENDS. IS HAPPY
CALLRET EOFOUT ;TOP LEVEL RETURN
E$$CFR: $ERROR (?,CFR,<CLOSE failure at RSTF>,+) ;[357]
JRST LASTER ;[357] TRY TO GIVE MORE INFO
E$$RFF: $ERROR (?,RFF,<RENAME failed at RSTF>,+) ;[357]
JRST LASTER ;[357] TRY TO GIVE MORE INFO
>;END IFE FTCOBOL
SUBTTL GETREC -- GETBUF - Input 1 Physical Buffer -- Set Up
;CALL WITH: JSP T4,GETBUF
;RETURNS: +1/ END OF FILE
; +2/ SUCCESS, T1 CONTAINS NO. OF BYTES READ
GETBUF: PUSH P,T4 ;PUSH RETURN ADDRESS
IFE FTCOBOL,< ;FALL THROUGH TO GETDSK IN COBOL SORT
MOVE T1,FILFLG(F) ;[435] GET FILE FLAGS
TXNE T1,FI.DSK ;[435] FILE ON DISK?
JRST GETDSK ;YES
TXNE T1,FI.MTA ;[435] MAGTAPE?
JRST GETMTA ;YES
TXNE T1,FI.EOF ;[435] WAS EOF DETECTED LAST TIME?
JRST [MOVE EF,PHYEOF ;YES, GIVE EOF RETURN NOW
RET] ; ..
MOVE T1,FILXBK(F) ;GET ADDR OF X. BLOCK FOR FILE
LDB T1,[POINT 9,X.DVCH(T1),17] ;GET DEVICE TYPE
CAXN T1,.DVTTY ;IS THIS A TTY?
JRST GETTTY ;YES, HANDLE UNIQUELY
HLRZ T1,FILPGN(F) ;GET JFN
HRRO T2,FILBUF(F) ;STRING PTR TO BUFFER
MOVE T3,FILBPB(F) ;LENGTH OF STRING
SETZ T4, ;OR STOP ON NULL
SIN% ;[335] GET IT
ERJMP [MOVX T1,.FHSLF ;GET MOST RECENT ERROR NUMBER
GETER% ;[335] ..
HRRZ T1,T2 ; ..
CAXE T1,IOX4 ;END OF FILE?
JRST E$$BER ;NO, HARD INPUT ERROR
CAMN T3,FILBPB(F) ;WAS BYTE COUNT ALTERED (I.E., WAS ANYTHING READ?)
JRST [ MOVE EF,PHYEOF ;NO, GIVE EOF RETURN
RET]
MOVX T1,FI.EOF ;YES, SET FLAG FOR NEXT TIME
IORM T1,FILFLG(F)
RETSKP] ;AND GIVE SKIP RETURN
MOVE T1,FILBPB(F) ;GET BYTES PER BUFFER
SUB T1,T3 ;DEDUCT NO. OF BYTES NOT READ
MOVEM T1,FILCNT(F) ;EQUALS NO. OF BYTES IN THIS BUFFERLOAD
HRRZ T1,FILBUF(F) ;CONSTRUCT BYTE PTR TO BUFFER
ADD T1,CBPTR ; ..
MOVEM T1,FILPTR(F) ; ..
RETSKP ;GIVE GOOD RETURN
SUBTTL GETREC -- GETBUF - Input 1 Physical Buffer -- Terminal
GETTTY: HRRZ T4,FILBUF(F) ;CONSTRUCT BYTE POINTER TO BUFFER
ADD T4,CBPTR ; ..
MOVEM T4,FILPTR(F) ;INIT BUFFER POINTER IN FCB
SETZM FILCNT(F) ;INIT BYTE COUNTER
MOVE T3,FILBPB(F) ;GET BYTES PER BUFFER FOR COUNTDOWN
GETTT1: HLRZ T1,FILPGN(F) ;GET JFN
BIN% ;[335] GET A BYTE
CAXN T2,.CHCNZ ;CTRL-Z?
JRST [ SKIPN T1,FILCNT(F) ;WAS ANYTHING READ THIS TIME?
JRST [ MOVE EF,PHYEOF ;NO, GIVE EOF RETURN
RET] ; ..
MOVX T2,FI.EOF ;YES, SET EOF FLAG FOR NEXT TIME
IORM T2,FILFLG(F) ; ..
RETSKP] ;AND GIVE GOOD RETURN
AOS T1,FILCNT(F) ;COUNT DATA BYTES
IDPB T2,T4 ;PLUNK IT INTO THE BUFFER
SOJG T3,GETTT1 ;GET THE NEXT BYTE, UNLESS BUFFER FULL
RETSKP ;RETURN WITH T1=NO. OF BYTES READ
>;END IFE FTCOBOL
SUBTTL GETREC -- GETBUF - Input 1 Physical Buffer -- Disk
GETDSK:
IFE FTCOBOL,<
MOVX T1,FI.BLK ;BLOCKING FACTOR HACK IN PROGRESS?
TDNE T1,FILFLG(F) ; ..
CALL [ ANDCAM T1,FILFLG(F) ;[435] [321] YES, CLEAR BLK HACK BIT
CALL CLRBUF ;[321] ADVANCE TO NEXT BLOCK
SKIPG FILCNT(F) ;[321] MORE LEFT IN BUFFER?
RET ;[321] NO, REJOIN GETDSK FLOW
POP P,T1 ;[321] FIX UP STACK
RETSKP] ; AND RETURN TO GETREC
>
SKIPG T1,FILEOF(F) ;ANY BYTES LEFT?
JRST [ MOVE EF,PHYEOF ;NO, GIVE EOF RETURN
RET] ; ..
MOVE T2,FILBPB(F) ;GET NO. OF BYTES PER BUFFER
CAMLE T1,T2 ;MORE THAN 1 BUFFER'S WORTH LEFT?
MOVE T1,T2 ;YES, JUST READ ONE BUFFER'S WORTH
MOVEM T1,FILCNT(F) ;SAVE NO. OF BYTES IN THIS BUFFERLOAD
MOVE T3,FILEOF(F) ;GET NO. OF BYTES LEFT IN FILE
SUB T3,T1 ;SUBTRACT NO. WE'RE READING
MOVEM T3,FILEOF(F) ;SAVE NEW NO. OF BYTES LEFT IN FILE
IFE FTCOBOL,<
MOVX T2,FI.TMP ;IS THIS A TEMP FILE?
TDNE T2,FILFLG(F) ; IF SO, WORDS=BYTES
JRST GETDS1 ;YES, SKIP THE DIVIDE
MOVE T2,IOMODE ;GET I/O MODE
CAXE T2,MODSIXBIT ;[435] IF SIXBIT, WORDS=BYTES, SO SKIP THE DIV
IDIV T1,IOBPW ;COMPUTE NO. OF WORDS WE'RE READING
GETDS1:
>
IDIVI T1,PGSIZ ;COMPUTE NO. OF PAGES WE'RE READING
SKIPE T2 ;COUNT PARTIAL PAGES
ADDI T1,1 ; ..
MOVX T3,PM%CNT!PM%PLD ;[335] CONSTRUCT PAGE COUNT FOR PMAP%
ADD T3,T1 ; ..
MOVE T1,FILPGN(F) ;GET JFN,,PAGE NO.
HRLI T2,.FHSLF ;MAP TO THIS FORK
HRR T2,FILBUF(F) ;PAGE INTO WHICH TO START MAPPING
PMAP% ;[335] MAP THE FILE
IFE FTCOBOL,< ;[402] TEMP FILES DON'T HAVE HOLES
ERCAL FIXMAP ;[402] SEE WHICH SECTION PMAP% FAILED
IF NOT A TEMP FILE
MOVX T4,FI.TMP ;[402] LOAD TEMP FILE BIT
TDNN T4,FILFLG(F) ;[402] TEMP FILE?
THEN BEWARE OF HOLES IN INPUT FILES
CALL FIXPGS ;[402] NO--MAY HAVE HOLES TO FIX
FI;
> ;[402] END OF IFE FTCOBOL
HLRZ T1,FILBUF(F) ;GET PAGES PER BUFFER
HRRZ T2,FILPGN(F) ;GET CURRENT PAGE NUMBER
ADD T1,T2 ;COMPUTE NEXT PAGE NUMBER
HRRM T1,FILPGN(F) ;SAVE IT
HRRZ T1,FILBUF(F) ;GET 1ST PAGE OF BUFFER
LSH T1,POW2(PGSIZ) ;TURN INTO ADDRESS
ADD T1,CBPTR ;CONSTRUCT BYTE POINTER
MOVEM T1,FILPTR(F) ;INITIALIZE BYTE PTR TO BUFFER
MOVE T1,FILCNT(F) ;RETURN WITH T1=NO. OF BYTES READ
RETSKP ;RETURN
IFE FTCOBOL,<
BEGIN
PROCEDURE (PUSHJ P,FIXPGS) ;[402] MAKE HOLES INTO ZERO PAGES
;CERTAIN FILE FORMATS SUPPORTED BY SORT ARE ALLOWED TO CONTAIN HOLES, NAMELY,
;PAGES THAT DO NOT EXIST IN THE FILE. SINCE SORT IS ESSENTIALLY A SEQUENTIAL
;PROCESSOR, IT SHOULD TREAT THESE HOLES AS PAGES FULL OF ZEROS. THIS IS
;CONSISTENT WITH THE MONITOR'S HANDLING OF SIN% AND PRE-JSYSIZED VERSIONS OF
;SORT.
;
;SIMPLE HOLES ARE THOSE PAGES THAT DO NOT EXIST IN A FILE SECTION THAT DOES
;EXIST. IN THIS CASE, THE PMAP% JSYS THAT MAPS THE PAGES (ASSUMED FOR READ-ONLY
;FROM A FILE OPEN FOR READ-ONLY) WILL SUCCEED, BUT MEMORY REFERENCES INTO THE
;MAPPED PAGES WILL FAIL. THIS ROUTINE TESTS FOR THESE HOLES BY REFERENCING THE
;FIRST WORD IN EACH PAGE JUST MAPPED. ANY FAILURES (DETECTED BY AN ERJMP) THEN
;CAUSE THE OFFENDING PAGE TO BE UNMAPPED. THIS GIVES A ZERO-FILLED PAGE FOR SORT
;TO READ.
;
;CALL:
; T1-T3/ ARGUMENTS GIVEN TO PMAP%
; F/ POINTER TO THIS FILE'S FILE BLOCK
;RETURNS WITH T1-T4 DESTROYED, AND ALL HOLE PAGES UNMAPPED.
HRRZ T4,FILBUF(F) ;[402] BUILD AOBJN POINTER FOR PAGES
LSH T4,POW2(PGSIZ) ;[402] POINTING TO ADDRESS OF PAGE
MOVNI T1,(T3) ;[402] ..
HRL T4,T1 ;[402] ..
SETO T1, ;[402] MAKE PMAP% ARGS SPECIFY UNMAPPING
MOVX T3,<PM%CNT+1> ;[402] IN CASE WE HAVE TO
WHILE THERE ARE PAGES TO CHECK
BEGIN
SKIP (T4) ;[402] TOUCH THE PAGE
ERJMP [PMAP% ;[402] FAILED--UNMAP IT
JRST .+1] ;[402] AND CONTINUE LOOKING
ADDI T2,1 ;[402] ADVANCE PMAP% ARGS
ADDI T4,PGSIZ-1 ;[402] PARTIALLY ADVANCE AOBJN COUNTER
AOBJN T4,$B ;[402] LOOP UNTIL NO MORE PAGES
END;
RETURN ;[402] DONE
END;
;STILL IN IFE FTCOBOL
BEGIN
PROCEDURE (PUSHJ P,FIXMAP) ;[402] MAKE ZERO PAGES WHEN PMAP% FAILS
;IF A PMAP% JSYS FAILS FOR AN INPUT FILE, THEN SOME OF THE REQUESTED PAGES WERE
;IN A FILE SECTION THAT HAS NO INDEX BLOCK. IN THIS CASE, THE MONITOR IS
;UNWILLING TO GIVE US ANYTHING, EVEN INFORMATION ON HOW MUCH OF THE REQUEST THE
;PMAP% JSYS WAS ABLE TO MAP BEFORE QUITTING. THEREFORE, WE MUST ANALYZE THE
;STATE OF THINGS OURSELVES TO PERFORM RECOVERY.
;
;THE METHOD USED IS IN TWO PARTS. IF THERE IS NO FILE SECTION BOUNDARY
;REPRESENTED IN THE PMAP% REQUEST, THEN ALL OF THE PAGES WERE FROM THE SAME NON-
;EXISTENT SECTION. IN THIS CASE, WE SIMPLY UNMAP THEM ALL. IF THERE IS A FILE
;SECTION BOUNDARY WITHIN THE PMAP% REQUEST, THEN EITHER PORTION OF THE REQUEST
;MAY HAVE CAUSED THE PMAP% TO FAIL. IN THIS CASE, WE MUST RETRY BOTH HALVES OF
;THE PMAP% REQUEST AGAIN (THOSE PAGES BEFORE THE SECTION BOUNDARY AND THOSE
;AFTER IT), BUT SEPARATELY. IF EITHER (OR BOTH) FAILS, THEN WE UNMAP THOSE
;PAGES. WE MAKE THE LIKELY ASSUMPTION THAT THERE IS AT MOST 1 SECTION BOUNDARY
;WITHIN THE REQUESTED GROUP OF PAGES.
;
;CALL:
; T1-T3/ ARGUMENTS TO PMAP% THAT FAILED
;RETURNS WITH PAGES FROM NON-EXISTENT SECTIONS UNMAPPED, WITHOUT DESTROYING
;T1-T3.
PUSH P,T1 ;[402] SAVE T1-T3
PUSH P,T2 ;[402] ..
PUSH P,T3 ;[402] ..
IF FAILING PMAP% REQUEST WAS CONTAINED IN 1 SECTION
HRRZ T4,T1 ;[402] COMPUTE LAST PAGE OF
IORX T4,PGSIZ-1 ;[402] CURRENT FILE SECTION
SUBI T4,-1(T1) ;[402] COMPUTE # PAGES TO THERE
CAIGE T4,(T3) ;[402] MORE THAN WE ASKED FOR?
JRST $T ;[402] NO-- REQUEST CROSSED SECTION BDY
THEN ALL IN SAME NON-EXISTENT SECTION SO JUST UNMAP ALL PAGES
PUSHJ P,UNMAP ;[402] UNMAP MAPPED PAGES
JRST $F ;[402]
ELSE EITHER OR BOTH SECTIONS MAY NOT EXIST SO TRY EACH ONE
HRR T3,T4 ;[402] RETRY FIRST SECTION OF PMAP%
PMAP% ;[402] ..
ERCAL UNMAP ;[402] DOESN'T EXIST--UNMAP IT
ADD T1,T4 ;[402] TRY SECOND SECTION OF PMAP%
ADD T2,T4 ;[402] ..
HRR T3,0(P) ;[402] ..
SUB T3,T4 ;[402] ..
PMAP% ;[402] ..
ERCAL UNMAP ;[402] DOESN'T EXIST--UNMAP IT
FI;
POP P,T3 ;[402] RESTORE ACS FOR CALLER
POP P,T2 ;[402] ..
POP P,T1 ;[402] ..
RETURN ;[402] DONE
END;
;STILL IN IFE FTCOBOL
BEGIN
PROCEDURE (PUSHJ P,UNMAP) ;[402] UNMAP MAPPED PAGES
;UNMAP UNMAPPS THE PAGES SPECIFIED BY THE PMAP% ARGUMENTS IN T1-T3. DESTROYS NO ACS.
PUSH P,T1 ;[402] SAVE SOURCE
SETO T1, ;[402] SO WE CAN MAKE IT UNMAP ARG
PMAP% ;[402] UNMAP THE PAGES
POP P,T1 ;[402] RESTORE SOURCE
RETURN ;[402] DONE
END;
> ;[402] END OF IFE FTCOBOL
SUBTTL GETREC -- GETBUF - Input 1 Physical Buffer -- Magtape
IFE FTCOBOL,<
GETMTA: MOVE T1,FILFLG(F) ;[435] GET FILE FLAGS
TXNE T1,FI.LAB ;[435] IS LABEL CHECKING IN PROGRESS?
JRST GETMT1 ;YES, IGNORE PREVIOUSLY DETECTED EOF
TXNE T1,FI.EOF ;[435] DID WE ENCOUNTER EOF LAST TIME?
JRST [ MOVE EF,PHYEOF ;YES, GIVE EOF RETURN
RET] ; ..
GETMT1: TXNE T1,FI.LAB ;[435] IF LABEL PROCESSING IN PROGRESS,
TXNN T1,FI.EOF ; AND WE'RE PAST EOF,
JRST GETMT2 ; ..
SETZM INLST ;THEN WE'VE ALREADY READ TRAILER LABEL.
;[335] BUILD DUMMY COMMAND LIST SO DUMPI%
; WILL JUST INSURE THE READ FINISHED.
TXC T1,FI.BF2 ;ALSO FLIP BUFFER FLAG BECAUSE WE'RE
; NOW SYNCHRONOUS WITH TAPE
MOVEM T1,FILFLG(F) ; ..
JRST GETMT3
GETMT2: CALL ADVBUF ;ADVANCE BUFFERS AND GET ADDR OF NEXT
MOVEI T1,-1(T1) ;GET BUFFER-1
HLRZ T2,FILBUF(F) ;GET NO. OF WORDS PER BUFFER
MOVN T2,T2 ;NEGATE
HRL T1,T2 ;MAKE IOWD
MOVEM T1,INLST ;FORM I/O COMMAND LIST
;NOW START I/O ON NEXT BUFFER AND WAIT FOR I/O TO FINISH ON THIS ONE
SETZM INLST+1 ;TIE OFF I/O COMMAND LIST
MOVX T2,DM%NWT ;SET "DO NOT WAIT" BIT
GETMT3: HLRZ T1,FILPGN(F) ;GET JFN
HRRI T2,INLST ;ADDR OF COMMAND LIST
SETZM FILCNT(F) ;ZAP FILCNT
DUMPI% ;[335] DO IT
ERCAL [CAXN T1,IOX4 ;END OF FILE?
JRST [ HLRZ T1,FILPGN(F) ;YES, GET JFN
GDSTS% ;[335] GET CURRENT STATUS
TXZ T2,MT%EOF ;CLEAR EOF FLAG
SDSTS% ;[335] ..
MOVX T2,DM%NWT ;STAY ASYNCHRONOUS
HRRI T2,INLST ;GET PAST FILE MARK
DUMPI% ;[335] ..
ERJMP E$$DME
POP P,T1 ;POP USELESS RETURN
MOVX T1,FI.EOF ;SET EOF FLAG
IORM T1,FILFLG(F) ; ..
MOVE EF,PHYEOF ;GIVE EOF RETURN TO
RET] ; GUY WHO CALLED GETBUF
CAXE T1,IOX5 ;DEVICE OR DATA ERROR?
JRST E$$DME ;NO, BUG SOMEWHERE
HLRZ T1,FILPGN(F) ;GET JFN
GDSTS% ;[335] GET DEVICE STATUS
TXZN T2,MT%IRL ;RECORD LENGTH INCORRECT?
JRST E$$DME ;NO, BUG SOMEWHERE
SDSTS% ;[335] CLEAR MT%IRL
HLRZ T3,T3 ;YES, GET WORDS READ INTO RH(T3)
MOVE T4,IOMODE ;IF SIXBIT,
CAXE T4,MODSIXBIT ; WORDS=BYTES
IMUL T3,IOBPW ;COMPUTE BYTES READ
MOVEM T3,FILCNT(F) ;SAVE IN FCB
MOVX T2,FI.LAB ;TAPE LABELLING IN PROGRESS?
TDNE T2,FILFLG(F) ; ..
JRST [ MOVEI T2,INLST ;YES, RESTART I/O
DUMPI% ;[335] ..
ERJMP E$$DME ;TROUBLE
RET] ;REJOIN MAIN FLOW
MOVEI T2,INLST ;RETRY I/O OPERATION
DUMPI% ;[335] ..
JFCL ;ALWAYS SHOULD FAIL
CAXE T1,IOX4 ;END OF FILE?
JRST E$$DME ;NO, BUG SOMEWHERE
MOVX T1,FI.EOF ;FLAG EOF SEEN
IORM T1,FILFLG(F) ; ..
RET]
; ..
MOVE T1,FILBPB(F) ;GET BYTES PER (FULL) BUFFER
SKIPN FILCNT(F) ;UNLESS THE HAIRY LITERAL ABOVE
; COMPUTED FILCNT FOR US,
MOVEM T1,FILCNT(F) ;INDICATE BUFFER HAS BEEN FILLED
HRRZ T1,FILBUF(F) ;GET ADDR OF FIRST BUFFER
MOVX T2,FI.BF2 ;SECOND BUFFER IN USE?
TDNN T2,FILFLG(F) ; ..
CALL [ HLRZ T2,FILBUF(F) ;NO, GET BUFFER LENGTH
ADD T1,T2 ;ADVANCE TO 2ND BUFFER
TRZE T1,PGMSK ;ALWAYS ON PAGE BOUNDARY
ADDI T1,PGSIZ ; ..
RET]
ADD T1,CBPTR ;FORM PROPER BYTE POINTER
MOVEM T1,FILPTR(F) ;SAVE IT
MOVE T1,FILCNT(F) ;RETURN WITH T1=NO. OF BYTES READ
RETSKP ;GIVE GOOD RETURN
;ADVBUF - ADVANCE MAGTAPE BUFFERS
; RETURN WITH C(T1) = ADDR OF NEXT BUFFER
ADVBUF: HRRZ T1,FILBUF(F) ;GET BUFFER ADDRESS
MOVX T3,FI.BF2 ;2ND BUFFER IN HAVE I/O IN PROGRESS?
TDNE T3,FILFLG(F) ; ..
JRST ADVBF1 ;YES, USE FIRST BUFFER
HLRZ T2,FILBUF(F) ;NO, GET LENGTH OF A BUFFER
ADD T1,T2 ;COMPUTE ADDRESS OF 2ND BUFFER
TRZE T1,PGMSK ;ROUND UP TO A PAGE BOUNDARY
ADDI T1,PGSIZ ; ..
IORM T3,FILFLG(F) ;SET FLAG SAYING 2ND BUFFER BUSY
RET ;ALL SET
ADVBF1: ANDCAM T3,FILFLG(F) ;CLEAR FLAG SAYING 2ND BUFFER BUSY
RET
>;END IFE FTCOBOL
SUBTTL PUTREC -- PUTBUF - Output 1 Physical Buffer -- Set Up
;CALL: JSP T4,PUTBUF
;RETURNS: +1/ ALWAYS
PUTBUF: PUSH P,T4 ;PUSH RETURN ADDR ON STACK
IFE FTCOBOL,< ;FALL THROUGH TO PUTDSK IN COBOL SORT
MOVE T1,FILFLG(F) ;[435] GET FILE FLAGS
TXNE T1,FI.DSK ;[435] FILE ON DISK?
JRST PUTDSK ;YES
TXNE T1,FI.MTA ;[435] MAGTAPE?
JRST PUTMTA ;YES, HANDLE IT
HLRZ T1,FILPGN(F) ;JFN
HRRO T2,FILBUF(F) ;STRING PTR TO BUFFER
MOVE T3,FILBPB(F) ;BYTES PER BUFFER
SUB T3,FILCNT(F) ; MINUS BYTES NOT WRITTEN
; EQUALS BYTES WRITTEN THIS TIME
SETZ T4, ;OR STOP ON NULL
SOUT% ;[335] MOVE IT OUT
MOVE T1,FILBPB(F) ;INDICATE BUFFER WAITING
MOVEM T1,FILCNT(F) ; TO BE FILLED
HRRZ T1,FILBUF(F) ;GET ADDRESS OF BUFFER
ADD T1,CBPTR ;CONSTRUCT BYTE POINTER TO BUFFER
MOVEM T1,FILPTR(F) ; ..
RET ;RETURN
;CLRBUF SIMULATES SKIPPING TO NEXT TOPS-10 DISK BLOCK. THIS IS FOR BLOCKING
;VARIABLE-LENGTH RECORDS FOR RANDOM FILES. CALLED ONLY BY PUTREC AND GETDSK.
CLRBUF: MOVE T1,FILFLG(F) ;[305] FILTER OUT BUGS
TXNE T1,FI.MTA ;[401] IF MTA
RET ;[401] RETURN
TXNN T1,FI.DSK ;[305] ..
JRST E$$CCN ;NON-DISK DEVICE
CLRBF1: HLRZ T1,FILBSZ(F) ;[321] GET ADDR OF LAST BLOCK BREAK
HRRZ T2,FILBSZ(F) ;[321] GET BLOCK SIZE IN WORDS
ADD T1,T2 ;[321] COMPUTE NEXT BLOCK BREAK
HRRZ T2,FILBUF(F) ;[321] GET PAGE NO. BUFFER STARTS ON
LSH T2,POW2(PGSIZ) ;[321] COMPUTE BUFFER'S ADDRESS
HLRZ T3,FILBUF(F) ;[321] GET SIZE OF BUFFER IN PAGES
LSH T3,POW2(PGSIZ) ;[321] COMPUTE LENGTH IN WORDS
ADD T2,T3 ;[321] FIRST ADDRESS ABOVE BUFFER
CAML T1,T2 ;[321] IS BLOCK BREAK ABOVE BUFFER?
SUB T1,T3 ;[321] YES, MOD BUFFER SIZE
ADD T1,CBPTR ;[321] CONSTRUCT NICE BYTE POINTER
CALL ADJFCT ;[321] ADJUST FILCNT (HAIRY)
MOVEM T1,FILPTR(F) ;[321] STUFF BYTE PTR INTO FCB
HRLM T1,FILBSZ(F) ;[321] REMEMBER THIS BLOCK BOUNDARY
SKIPN FILCNT(F) ;[321] ANY BYTES LEFT IN BUFFER?
RET ;[321] NO, RETURN NOW
MOVE T1,FILFLG(F) ;[321] YES, GET FILE FLAG BITS
TXNE T1,FI.OUT ;[321] OUTPUT FILE?
TXO T1,FI.BLK ;[321] YES, TELL PUTBUF NOT TO DO
MOVEM T1,FILFLG(F) ;[321] OUTPUT NEXT TIME
RET
;STILL IN IFE FTCOBOL
;ADJUST FILCNT AFTER ADVANCING TO NEXT BLOCK BOUNDARY (BLOCKED DISK FILES ONLY).
;CALL:
; MOVE T1,<NEW FILPTR>
; CALL ADJFCT
; UPDATES FILCNT WITHOUT DISTURBING T1
ADJFCT: LDB T2,[POINT 6,FILPTR(F),5] ;[321] GET BYTE POSITION OF NEXT BYTE
CAIN T2,44 ;[321] FUNNY CASE?
CALL [ SOS FILPTR(F) ;[321] YES, ADJUST FOR IT
SETZ T2, ;[321] ..
RET]
MOVE T3,IOMODE ;[321] IF SIXBIT,
CAXE T3,MODSIXBIT ;[321] WORDS=BYTES
IDIV T2,IOBPW ;[321] COUNT PARTIAL WORD BYTES
AOS T3,FILPTR(F) ;[321] POINT AT FIRST FULL WORD
HRRZ T3,T3 ;[321] GET WORD ADDR OF FIRST FULL WORD
HRRZ T4,T1 ;[321] GET WORD ADDR OF NEXT BLOCK
CAMGE T4,T3 ;[435] [321] NEW BUFFERLOAD?
JRST [ SETZM FILCNT(F) ;[321] YES, JUST ZAP FILCNT
RET] ;[321] AND RETURN
SUB T4,T3 ;[321] COMPUTE WORDS BEING SKIPPED
MOVE T3,IOMODE ;[321] IF SIXBIT,
CAXE T3,MODSIXBIT ;[321] WORDS=BYTES
IMUL T4,IOBPW ;[321] TIMES BYTES PER WORD
ADD T4,T2 ;[321] ADD PARTIAL WORD BYTES
MOVE T2,FILCNT(F) ;[321] GET OLD FILCNT
SUB T2,T4 ;[321] SUBTRACT BYTES BEING SKIPPED
MOVEM T2,FILCNT(F) ;[321] UPDATE FILCNT
RET
>;END IFE FTCOBOL
SUBTTL PUTREC -- PUTBUF - Output 1 Physical Buffer -- Disk
PUTDSK:
IFE FTCOBOL,<
MOVE T1,FILFLG(F) ;[435] GET FILE FLAGS
TXZE T1,FI.BLK ;[435] BLOCKING FACTOR HACK IN PROGRESS?
JRST [ MOVEM T1,FILFLG(F) ;[435] YES, RESET THE FLAG
RET] ;AND RETURN TO CALLER OF PUTBUF
>
HRLZI T1,.FHSLF ;MAP FROM THIS PROCESS
HRR T1,FILBUF(F) ;STARTING AT THIS PAGE
MOVE T2,FILPGN(F) ;TO THIS FILE
HLRZ T3,FILBUF(F) ;GET PAGES PER BUFFER
SKIPLE T4,FILCNT(F) ;WRITING PARTIAL BUFFER?
CALL FIXUP ;YES, COMPUTE T3=PAGE COUNT
IFE FTCOBOL,<
MOVE T4,FILFLG(f) ;[371]
TXNE T4,FI.TMP ;[371] IS THIS A TMP FILE?
ADDM T3,SUMTMP ;YES, UPDATE TOTAL PAGES USED
>
IORX T3,PM%CNT!PM%RWX ;ALLOW ALL TYPES OF ACCESS TO FILE PG.
PMAP% ;[335] MOVE THEM OUT TO THE FILE
HRRZS T3 ;GET PAGE COUNT
HRRZ T2,FILPGN(F) ;GET CURRENT PAGE NUMBER
ADD T3,T2 ;COMPUTE NEXT
HRRM T3,FILPGN(F) ;SAVE IN FCB
MOVE T1,FILBPB(F) ;GET NO. OF BYTES PER BUFFER
MOVE T2,T1 ;IN T2 ALSO
EXCH T1,FILCNT(F) ;FLAG BUFFER FULL, GET # OF UNUSED BYTES
SUB T2,T1 ;COMPUTE BYTES WRITTEN THIS TIME
ADDM T2,FILEOF(F) ;UPDATE TOTAL NO. OF BYTES WRITTEN
HRRZ T1,FILBUF(F) ;GET STARTING PAGE OF BUFFER
LSH T1,POW2(PGSIZ) ;COMPUTE ADDRESS
ADD T1,CBPTR ;CONSTRUCT BYTE POINTER
MOVEM T1,FILPTR(F) ;SAVE IT
MOVE T1,FILCNT(F) ;RETURN WITH BYTE COUNT IN T1
IFE FTCOBOL,<
TXNN T4,FI.TMP ;[371] IS IT A TEMP FILE?
SKIPG SEQNO ;[371] OR OUTPUT NOT SEQUENCED
RET ;[371] YES
HRRZ T2,FILPTR(F) ;[371] YES, MUST CLEAR BUFFER IN CASE
HLRZ T3,FILBUF(F) ;[371] ANY BIT 35'S ARE LEFT O
LSH T3,POW2(PGSIZ) ;[371] GET SIZE OF BUFFER IN WORDS
ADDI T3,(T2) ;[371] END+1
HRL T2,T2 ;[371] FORM BLT POINTER
ADDI T2,1 ;[371] EVENTUALLY
SETZM -1(T2) ;[371] CLEAR FIRST WORD
BLT T2,-1(T3) ;[371] AND THE REST
>;END IFE FTCOBOL
RET ;RETURN
;FIXUP COMPUTES A PAGE COUNT FOR PMAP% WHEN WE'RE PMAPPING A PARTIAL BUFFERLOAD.
;RETURNS PAGE COUNT IN T3. MUSTN'T DISTURB T1 OR T2, AND CAN ONLY BE CALLED
;DURING A CLOSE.
FIXUP: MOVX T3,FI.CLZ ;HAD BETTER BE CLOSING THE FILE
TDNN T3,FILFLG(F) ;ARE WE?
JRST E$$AWP ;ATTEMP TO WRITE PARTIAL OUTPUT BUFFER
MOVE T3,FILBPB(F) ;GET BYTES PER (FULL) BUFFER
SUB T3,T4 ;SUBTRACT # OF UNWRITTEN BYTES
IFE FTCOBOL,<
IF THIS IS NOT A TEMP FILE NOR A SIXBIT FILE
MOVX T4,FI.TMP ;IS THIS A TEMP FILE?
TDNE T4,FILFLG(F) ;[400] ..
JRST $T ;[430] [400] YES IT'S A TEMP FILE
MOVE T4,IOMODE ;[400] NOW CHECK FOR SIXBIT
CAXE T4,MODSIXBIT ;[400] ..
THEN FIND BYTES PER WORD
SKIPA T4,IOBPW ;[366] T4 = BYTES/WORD
ELSE BYTES PER WORD IS 1
MOVX T4,1 ;[366] T4 = 1 BYTE/WORD
FI;
IMULI T4,PGSIZ ;[366] T4 = BYTES/PAGE
IDIV T3,T4 ;[366] T3 = WHOLE PAGES, T4 = REMAINING WORDS
>
IFN FTCOBOL,<
IDIVI T3,PGSIZ ;[366] T3 = WHOLE PAGES, T4 = REMAINING WORDS
> ;END IFE FTCOBOL
SKIPE T4 ;ROUND UP TO WHOLE PAGES
ADDI T3,1 ; ..
RET
SUBTTL PUTREC -- PUTBUF - Output 1 Physical Buffer -- Magtape
IFE FTCOBOL,<
PUTMTA: HRRZ T1,FILBUF(F) ;GET FIRST BUFFER'S ADDRESS
MOVX T2,FI.BF2 ;WHICH BUFFER DO WE WISH TO OUTPUT?
TDNN T2,FILFLG(F) ; ?
JRST PUTMT1 ;BUFFER ONE, T1 HAS ITS ADDRESS
HLRZ T2,FILBUF(F) ;BUFFER TWO - GET BUFFER LENGTH
ADD T1,T2 ;COMPUTE SECOND BUFFER'S ADDRESS
TRZE T1,PGMSK ;ROUND UP TO PAGE BOUNDARY
ADDI T1,PGSIZ ; ..
PUTMT1: MOVEI T1,-1(T1) ;COMPUTE BUFFER ADDRESS-1
HLRZ T2,FILBUF(F) ;GET BUFFER LENGTH
SKIPLE T3,FILCNT(F) ;WRITING PARTIAL BUFFER?
CALL [ MOVX T4,FI.CLZ ;YES, HAD BETTER BE CLOSING THE FILE
TDNN T4,FILFLG(F)
JRST E$$AWP ;ATTEMP TO WRITE PARTIAL BUFFER
IMUL T2,IOBPW ;CONVERT BUFFER SIZE IN WORDS TO BYTES
SUB T2,T3 ;SUBTRACT NO.OF BYTES WE DIDN'T WRITE
IDIV T2,IOBPW ;CONVERT BACK TO WORDS
SKIPE T3 ;ROUND UP TO A WHOLE WORD
ADDI T2,1 ; ..
RET] ;AND RETURN
MOVN T2,T2 ;NEGATE IT
HRL T1,T2 ;MAKE IOWD
MOVEM T1,OUTLST ;CONSTRUCT CMD LIST
SETZM OUTLST+1 ; ..
HLRZ T1,FILPGN(F) ;GET JFN
MOVX T2,DM%NWT ;DON'T WAIT ON I/O
HRRI T2,OUTLST ;ADDR OF CMD LIST
DUMPO% ;[335] START I/O
ERCAL [CAXE T1,IOX5 ;DEVICE OR DATA ERROR?
JRST E$$DME ;NO, BUG
HLRZ T1,FILPGN(F) ;GET JFN
GDSTS% ;[335] GET TAPE STATUS BITS
TXZN T2,MT%EOT ;END OF TAPE?
JRST E$$DME ;NO, COMPLAIN
SDSTS% ;[335] YES, CLEAR THE BIT
MOVX T1,FI.EOT ;SET EOT BIT IN FILFLG
IORM T1,FILFLG(F) ; ..
RET] ;REJOIN MAIN FLOW
MOVE T1,FILBPB(F) ;GET BYTES PER BUFFER
MOVEM T1,FILCNT(F) ;INDICATE BUFFER BEGGING TO BE FILLED
CALL ADVBUF ;ADVANCE BUFFERS
ADD T1,CBPTR ;CONSTRUCT BYTE POINTER TO BUFFER
MOVEM T1,FILPTR(F) ;SAVE IT
SKIPG SEQNO ;[371] OUTPUT NOT SEQUENCED
RET ;[371] YES
HRRZ T2,FILPTR(F) ;[371] YES, MUST CLEAR BUFFER IN CASE
HLRZ T3,FILBUF(F) ;[371] ANY BIT 35'S ARE LEFT O
ADDI T3,(T2) ;[371] END+1
HRL T2,T2 ;[371] FORM BLT POINTER
ADDI T2,1 ;[371] EVENTUALLY
SETZM -1(T2) ;[371] CLEAR FIRST WORD
BLT T2,-1(T3) ;[371] AND THE REST
RET
>;END IFE FTCOBOL
SUBTTL PSORT. -- Memory Management Routines for TOPS-20
;CHKCOR - CHECK FOR MEMORY SWITCHS AND INSURE ARGUMENTS ARE REASONABLE
CHKCOR: PUSH P,P1 ;GET SOME REGS
PUSH P,P2 ; ..
CALL MINBUF ;COMPUTE MINIMUM ALLOWABLE BUFFER AREA
MOVE P1,T1 ;SAVE
CALL MAXBUF ;COMPUTE MAXIMUM ALLOWABLE BUFFER AREA
CAIGE T1,(P1) ;IS MAX .LT. MIN?
JRST E$$NEC ;YES, DIE
MOVE P2,T1 ;COPY MAXIMUM BUFFER SPACE USEABLE
IFE FTCOBOL,<
CALL USRBUF ;DID USER SPECIFY A BUFFER AREA SIZE?
JRST CHKCR1 ;NO, USE DEFAULT
CAIGE T1,(P1) ;IS USER'S SIZE .GE. MINIMUM?
JRST [ $ERROR (%,NBS,<Not enough buffer space specified>)
MOVEI T1,(P1) ;USE MINIMUM INSTEAD
JRST CHKTRE] ;AND RETURN
CAIL T1,(P2) ;IS USER'S SIZE .LT. MAXIMUM?
JRST [ $ERROR (%,TMS,<Too much buffer space specified>)
MOVEI T1,(P2) ;USE MAXIMUM INSTEAD
JRST CHKTRE] ;AND RETURN
JRST CHKTRE ;USER'S SIZE OK, RETURN IT
>;END IFE FTCOBOL
CHKCR1: CALL DEFBUF ;COMPUTE DEFAULT BUFFER SIZE
CAIGE T1,(P1) ;RANGE CHECK
MOVEI T1,(P1) ; AGAINST MINIMUM
CAIL T1,(P2) ; AND MAXIMUM
MOVEI T1,(P2) ; ..
;HERE WITH C(T1) = SIZE OF I/O BUFFER AREA TO ALLOCATE
CHKTRE: MOVEM T1,BUFSZ ;SAVE SIZE OF BUFFER AREA
SKIPLE MRGSW ;MERGE COMMAND?
JRST CHKRT1 ;YES, SETTMP COMPUTED NUMRCB FOR US
CALL MINTRE ;COMPUTE MINIMUM SIZE OF TREE
MOVEI P1,(T1) ;SAVE
CALL MAXTRE ;COMPUTE MAXIMUM SIZE OF TREE
CAIGE T1,(P1) ;INSURE .GE. MINIMUM
JRST E$$NEC ;OOPS
MOVEI P2,(T1) ;SAVE FOR MORE TESTS
IFE FTCOBOL,<
CALL USRTRE ;DID USER SPECIFY A TREE SIZE?
JRST CHKCR2 ;NO, USE DEFAULT
CAIGE T1,(P1) ;IS USER .GE. MINIMUM?
JRST [ $ERROR (%,NLS,<Not enough leaves specified>)
MOVEI T1,(P1) ;USE MINIMUM
JRST CHKRET] ;AND FINISH UP
CAILE T1,(P2) ;IS USER .LE. MAXIMUM?
JRST [ $ERROR (%,TML,<Too many leaves specified>)
MOVEI T1,(P2) ;USE MAXIMUM
JRST CHKRET] ;AND FINISH UP
JRST CHKRET ;USER SIZE IS GOOD, FINISH UP
>;END IFE FTCOBOL
CHKCR2: CALL DEFTRE ;COMPUTE DEFAULT TREE SIZE
CAIGE T1,(P1) ;RANGE CHECK
MOVEI T1,(P1) ; ..
CAILE T1,(P2) ; ..
MOVEI T1,(P2) ; ..
;HERE WITH C(T1) = NUMBER OF WORDS TO ALLOCATE TO TREE
CHKRET: MOVE T2,REKSIZ ;GET RECORD SIZE
ADDI T2,RN.LEN ;ADD OVERHEAD WORDS
IDIV T1,T2 ;COMPUTE HOW MANY RECORDS CAN FIT IN TREE
CAIGE T1,^D16 ;MUST HAVE AT LEAST 16
JRST [$ERROR (?,NET,<Not enough core for tree>)]
MOVEM T1,NUMRCB ;SAVE FOR INITRE
CHKRT1: POP P,P2 ;RESTORE REGS
POP P,P1
CALLRET SETSIZ ;SET CORE SIZE
;MINBUF - COMPUTE MINIMUM BUFFER SPACE NEEDED FOR SORT
MINBUF: SKIPLE MRGSW ;MERGE COMMAND?
JRST MINBF1 ;YES, HANDLE DIFFERENTLY
IFN FTCOBOL,< ;FOR COBOL, ONLY NEED 1 TEMP FILE BUFFER
MOVEI T1,PGSIZ ; WHICH IS ONE PAGE
RET
>
IFE FTCOBOL,< ;OTHERWISE, NEED 1 INPUT PG AND 1 TMP PG
MOVEI T1,PGSIZ ;FOR TEMP FILE INPUT
ADD T1,MXDVSZ ;PLUS BIGGEST INPUT DEVICE BUFFER
JRST RNDRET ;ROUND UP TO A PAGE AND RETURN
>
MINBF1:
IFN FTCOBOL,< ;FOR COBOL MERGE, JUST 1 OUTPUT BUFFER
MOVEI T1,PGSIZ ; ..
RET
>
IFE FTCOBOL,< ;FOR REGULAR, NEED TMP PLUS INPUT
HRRZ T1,ACTTMP ;NUMBER OF ACTIVE TEMP FILES
ADDI T1,1 ;PLUS ONE FOR OUTPUT
IMUL T1,MXDVSZ ;TIMES LARGEST BUFFER (JUST IN CASE)
JRST RNDRET ;ROUND UP TO A PAGE AND RETURN
>
;MAXBUF COMPUTES MAXIMUM BUFFER SPACE ALLOWABLE
MAXBUF: SKIPLE MRGSW ;MERGE COMMAND?
JRST MAXBF1 ;YES, HANDLE DIFFERENTLY
MOVEI T1,PGSIZ*8 ;8 PAGES FOR TEMP FILE BUFFER
IFN FTCOBOL,<
RET
>
IFE FTCOBOL,< ;IF LIBOL ISN'T DOING I/O FOR US,
MOVE T2,MXDVSZ ;GET LARGEST BUFFER REQUIRED
LSH T2,POW2(4) ;4 TIMES LARGEST BUFFER
ADD T1,T2 ;JUST MAKE SOME ARBITRARY LARGE NUMBER
JRST RNDRET ;ROUND UP AND RETURN
>
MAXBF1:
IFN FTCOBOL,< ;FOR COBOL MERGE VERB
MOVEI T1,PGSIZ*^D32 ;JUST ALLOW A LARGE OUTPUT (TMP) BUFFER
RET
>
IFE FTCOBOL,< ;FOR STAND ALONE MERGE
HRRZ T1,ACTTMP ;GET NUMBER OF INPUT FILES
ADDI T1,1 ;PLUS ONE FOR OUTPUT
IMUL T1,MXDVSZ ;TIMES BIGGEST KNOWN BUFFER
LSH T1,POW2(20) ;ALLOW VERY LARGE BUFFER
JRST RNDRET ;ROUND UP AND RETURN
>
;USRBUF RETURNS USER'S DESIRED BUFFER AREA SIZE
IFE FTCOBOL,<
USRBUF: SKIPG T1,CORSIZ ;DID HE TYPE ONE?
RET ;NO, ERROR RETURN
LSH T1,POW2(PGSIZ) ;YES, CONVERT TO WORDS
RETSKP
>
;USRTRE - RETURN USER'S DESIRED NO. OF LEAVES ON TREE (/LEAVES:n)
IFE FTCOBOL,<
USRTRE: SKIPG T1,LEANUM ;IS THERE ONE?
RET
MOVE T2,REKSIZ ;GET RECORD SIZE, IN WORDS
ADDI T2,RN.LEN ; PLUS OVERHEAD WORDS
IMULI T1,(T2) ;COMPUTE SPACE NEEDED FOR TREE
RETSKP
>
;DEFBUF - COMPUTE DEFAULT BUFFER SPACE TO USE
DEFBUF: SKIPLE MRGSW ;MERGE COMMAND?
JRST DEFBF1 ;YES, HANDLE DIFFERENTLY
MOVEI T1,PGSIZ*4 ;4 PAGES FOR TEMP FILE BUFFER
IFE FTCOBOL,<
ADD T1,MXDVSZ ;PLUS LARGEST FILE BUFFER
>
JRST RNDRET ;ROUND UP AND RETURN
DEFBF1: MOVE T1,ACTTMP ;GET NO. OF INPUT FILES
IFE FTCOBOL,< ;IF NOT COBOL MERGE, ADD
ADDI T1,2 ; ROOM FOR OUTPUT FILE BUFFER
>
LSH T1,POW2(PGSIZ*2) ;ALLOW 2 PGS FOR INPUT, 4 FOR OUTPUT
; JRST RNDRET ;ROUND UP AND RETURN
RNDRET: TRZE T1,PGMSK ;[365] ON PAGE BOUNDARY?
ADDI T1,PGSIZ ;[365] NO, ROUND UP
RET ;AND RETURN
;MINTRE COMPUTES MINIMUM SPACE NEEDED FOR SORT TREE
MINTRE: MOVE T1,REKSIZ ;GET RECORD SIZE
ADDI T1,RN.LEN ;PLUS OVERHEAD WORDS
LSH T1,POW2(^D16) ;NEED AT LEAST 16 NODES
RET
;MAXTRE - COMPUTE MAXIMUM ALLOWABLE SPACE FOR TREE
MAXTRE: HRRZ T2,TREORG ;GET FIRST FREE
ADD T2,BUFSZ ;ADD SIZE OF BUFFER AREA
ADDI T2,PGSIZ ;ADD ROUNDING FACTOR
MOVE T1,MAXFRE ;GET HIGHEST LOC AVAILABLE
SUB T1,T2 ;USE UP ALL THE SPACE FOR THE TREE
RET
;DEFTRE - COMPUTE DEFAULT SIZE FOR TREE
DEFTRE: MOVEI T1,RN.LEN ;GET LENGTH OF A NODE
ADD T1,REKSIZ ;PLUS LENGTH OF A RECORD
IMULI T1,NRECS ;TIMES NO. OF RECORDS WE WANT TO HAVE
; IN CORE BY DEFAULT
RET
;RFMBFP -- REFORMAT BUFFER POOL FOR MERGE PHASE OF SORT
RFMBFP: MOVE T1,BUFSZ ;GET SIZE OF BUFFER POOL
ADDI T1,PGSIZ ;ADD ROUNDING FACTOR
CALL FRESPC ;DROP IT LIKE A HOT POTATO
MOVE T1,CORSTK ;GET POINTER TO ENTRY IN CORE STACK FOR TREE
HLRZ T1,0(T1) ;GET SIZE OF TREE ENTRY
CALL FRESPC ;DEALLOCATE THE TREE AREA
MOVEI T1,RN.LEN ;[313] SIZE OF A TREE NODE
ADD T1,REKSIZ ;[313] PLUS SIZE OF RECORD
IMUL T1,NUMRCB ;[313] TIMES NUMBER OF RECORDS
CALL GETSPC ;ALLOCATE SPACE FOR TREE
JRST E$$RBP ;CONFUSION
MOVEM T1,TREORG ;[313] TREE ORIGIN
MOVE T1,NUMRCB ;[313] GET NUMBER OF MERGE FILES
IMULI T1,RN.LEN ;[313] TIMES SIZE OF TREE NODE
ADD T1,TREORG ;[313] + BASE
MOVEM T1,TREEND ;[313] END OF TREE POINTERS
MOVE T1,NUMRCB ;[313] NUMBER OF RECORDS
IMUL T1,REKSIZ ;[313] TIMES THEIR SIZE
ADD T1,TREEND ;[313] + BASE
MOVEM T1,RCBEND ;[313]
HRRZ T1,ACTTMP ;GET NUMBER OF TEMP FILES
LSH T1,POW2(PGSIZ) ;TIMES SIZE OF ONE BUFFER (1 PAGE)
IFE FTCOBOL,< ;IF NOT COBOL SORT,
ADDI T1,OUTSIZ ;ADD SIZE OF OUTPUT BUFFER
>
IFN FTCOBOL,< ;IF COBOL SORT,
SKIPE NUMLFT ;IF WE NEED TO DO A MERGE PASS
ADDI T1,OUTSIZ ;ADD DESIRABLE SIZE FOR OUTPUT BUFFER
>
IMULI T1,PPTBUF*2 ;DOUBLE BUFFERING WOULD BE NICE
PUSH P,P2 ;GET A REG FOR FLAG
SETZ P2, ;ASSUME DOUBLE BUFFERING
PUSH P,T1 ;SAVE UNIT BUFFER-POOL SIZE
PUSH P,P1 ;GET A REG
MOVE P1,T1 ;SAVE WHAT WE WANT TO ALLOCATE
CALL GETSPC ;TRY FOR IT
CALL [ LSH P1,-<POW2(2)> ;CAN'T GET IT, TRY FOR SINGLE BUFFERS
MOVE T1,P1 ; ..
CALL GETSPC ;ALLOCATE IT
JRST E$$ICM ;INSUFFICIENT CORE
PUSH P,T1 ;$ERROR TRASHES T1
$ERROR(%,CDB,<Can't double buffer merge pass>)
POP P,T1
SETO P2, ;FLAG DOUBLE BUFFERING
RET] ;REJOIN MAIN FLOW
MOVEM T1,BUFPTR ;REMEMBER WHERE BUFFER POOL STARTS
MOVEM P1,BUFSZ ;REMEMBER SIZE OF BUFFER POOL
POP P,P1 ;RESTORE P1
POP P,T1 ;RESTORE UNIT BUFFER-POOL SIZE
IDIVI T1,PPTBUF*2 ;RECOVER UNIT BUFFER SIZE
SUBI T1,OUTSIZ ; FOR TEMP FILES
; JRST RFMBP1
;HERE WHEN WE HAVE ENOUGH CORE FOR BUFFERS - DIVIDE WHAT
; WE'VE GOT AMONG TEMP FILE AND OUTPUT FILE BUFFERS
RFMBP1: MOVE T2,BUFSZ ;GET SIZE OF BUFFER POOL
SUBI T2,OUTSIZ ;RESERVE SPACE FOR OUTPUT BUFFER
SKIPN P2 ;IF DOUBLE BUFFERED,
SUBI T2,OUTSIZ ; RESERVE SPACE FOR 2 OUTPUT BUFFERS
IDIVI T2,(T1) ;DIVIDE POOL SIZE BY UNIT BUFFER-POOL
; SIZE TO GET DEGREE OF BUFFERING
JUMPE T2,E$$FER ;CAN'T ALLOCATE THEM
MOVEM T2,TBUFNO ;PAGES PER TEMP FILE BUFFER
MOVE T1,BUFSZ ;GET SIZE OF BUFFER POOL
IMUL T2,ACTTMP ;COMPUTE SPACE OCCUPIED BY TEMP
LSH T2,POW2(PGSIZ) ; FILE BUFFERS
SUB T1,T2 ;WHAT'S LEFT IS FOR OUTPUT FILE
IFE FTCOBOL,< ;IF NOT COBOL, WE HAVE REAL OUTPUT
MOVE T2,OBUFSZ ;GET OUTPUT BUFFER SIZE
CAIGE T2,PGSIZ ;USE LARGE OF TEMP OR OUTPUT
MOVEI T2,PGSIZ ; ..
>
IFN FTCOBOL,< ;IF COBOL, JUST TEMP FILE OUTPUT
MOVEI T2,PGSIZ ; ..
>
IDIV T1,T2 ;DIVIDE SPACE BY SIZE OF BUFFERS
SUBI T1,1 ;TRUNCATE BECAUSE BUFFERS START ON PG
; BOUNDARIES AND BUFPTR DOESN'T NECESSARILY
CAIGE T1,2 ;NEED AT LEAST 2 BUFFERS
JRST E$$NRO ;NO ROOM
MOVEM T1,OBUFNO ;SAVE NUMBER OF BUFFERS
MOVE T1,BUFPTR ;PUT NEW CEILING ON BUFFER ALLOCATOR
ADD T1,BUFSZ ; ..
MOVEM T1,BUFTOP ; ..
IFN FTDEBUG,<
TMSG <TBUFNO = >
MOVE T1,TBUFNO
CALL .TDECW
TMSG <, OBUFNO = >
MOVE T1,OBUFNO
CALL .TDECW
TMSG <
>
>
POP P,P2 ;RESTORE P2
RET ;AND RETURN
;SETSIZ -- SET MEMORY SIZE - GET FOROTS IF REQUIRED - GO TO PSORT%
BEGIN
PROCEDURE (PUSHJ P,SETSIZ)
IFE FTCOBOL,<
IF FORTRAN FORMAT KEYS SPECIFIED
MOVE T1,MODEM
IFN FTOPS20,<
SKIPN FORTPP ;WE ALREADY HAVE FOROTS IF FORTRAN CALL
>
TXNN T1,RM.FPA
JRST $F
THEN GET SYS:FOROTS.EXE
MOVEI T1,.FHSLF ;THIS PROCESS
GEVEC% ;[335] GET ENTRY VECTOR
PUSH P,T2 ;SAVE IT
MOVX T1,GJ%OLD+GJ%SHT;[335] DO A SHORT GTJFN%
HRROI T2,[ASCIZ /SYS:FOROTS.EXE/]
GTJFN% ;[335]
JRST E$$CGF ;COMPLAIN IF WE CAN'T FIND FOROTS
HRLI T1,.FHSLF ;THIS PROCESS
TRO T1,GT%ADR ;CHECK ADDRESS LIMITS
MOVE T2,[400,,677] ;ALL OF HIGH SEGMENT
GET% ;[335]
MOVEI T1,.FHSLF
POP P,T2
SEVEC% ;[335] RESTORE ENTRY VECTOR
FI;
>;END IFE FTCOBOL
$1% MOVE T1,NUMRCB ;GET NO. OF RECORDS IN TREE
IMULI T1,RN.LEN ;COMPUTE SIZE OF TREE
MOVE T3,NUMRCB ;GET NO. OF RECORDS IN TREE
IMUL T3,REKSIZ ; TIMES SIZE OF RECORDS
ADD T1,T3 ;ADD SIZE OF RECORD AREA IN TREE
CALL GETSPC ;ALLOCATE SPACE FOR TREE AND RECORDS
IFN FTCOBOL,<
JRST [ SKIPN HLOVL.## ;NOT ENOUGH SPACE, MUST BE
JRST E$$NEC ; BECAUSE OF OVERLAYS
MOVE T1,NUMRCB ;IF SO, TRY FOR SMALLER TREE
LSH T1,-<POW2(2)> ; BY ONE HALF
CAIGE T1,^D64 ;MAKE SURE TREE DOESN'T TURN
JRST E$$NEC ; INTO A SHRUBBERY
MOVEM T1,NUMRCB ; (APOLOGIES TO M. PYTHON)
JRST $1] ;GO TRY AGAIN
>
IFE FTCOBOL,<
JRST E$$NEC ;IF STANDALONE, NO SECOND CHANCES
>
MOVEM T1,TREORG ;SAVE ADDR OF START OF TREE
MOVE T1,BUFSZ ;ALLOCATE SEPARATE AREA FOR BUFFER POOL
ADDI T1,PGSIZ ;ROUND UP ONE PAGE BECAUSE DISK BUFFERS
; ARE ON PG BOUNDARIES, SO WE'LL PROBABLY
; THROW THE PARTIAL PAGE WE GET
CALL GETSPC ; ..
JRST E$$NEC
MOVEM T1,BUFPTR ;REMEMBER WHERE IT STARTS
MOVEM T1,BUFPT1 ;SAVE INITIAL BUFPTR FOR MERGE0
MOVE T1,BUFSZ ;SAVE BUFFER AREA SIZE FOR ENDS.
MOVEM T1,BUFTOT ; ..
IFE FTCOBOL,<
PJRST PSORT% ;GO TO COMMON CODE
>
IFN FTCOBOL,<
RETURN
>
END;
IFE FTCOBOL,<
E$$CGF: $ERROR (?,CGF,<Can not get SYS:FOROTS.EXE>)
>
;ALCBPG -- ALLOCATE BUFFER ON A PAGE BOUNDARY
;CALL WITH: T1/ NO. OF WORDS DESIRED
;RETURNS+1 WITH T1/ ADDRESS OF BUFFER
ALCBPG: MOVE T2,BUFPTR ;GET FREE POINTER
TRZE T2,PGMSK ;[365] ON PAGE BOUNDARY?
ADDI T2,PGSIZ ;[365] NO, ROUND UP TO NEXT PAGE
MOVEM T2,BUFPTR ; ..
ALCBP1: MOVE T3,BUFTOP ;GET TOP OF BUFFER AREA
SUB T3,BUFPTR ;SUBTRACT BOTTOM
CAMLE T1,T3 ;IS WHAT'S WANTED .GT. WHAT'S THERE?
JRST E$$BAF ;ALLOCATION FAILURE
ADDM T1,BUFPTR ;UPDATE PTR
MOVE T1,T2 ;RETURN ADDR OF SPACE
RET
;ALCBUF - ALLOCATE BUFFER SPACE, NOT NECESSARILY ON PAGE BOUNDARY
ALCBUF: MOVE T2,BUFPTR ;GET PTR TO BUFFER AREA
CALLRET ALCBP1 ;JOIN COMMON CODE
;[371] ALCBPZ--ALLOCATE BUFFER ON A PAGE BOUNDARY AND MAKE SURE BUFFER AREA IS ZERO
ALCBPZ: PUSH P,T1 ;[371] SAVE SIZE REQUIRED
CALL ALCBPG ;[371] GET BUFFER SPACE
HRLZ T2,T1 ;[371] BUILD BLT POINTERS
HRRI T2,1(T1) ;[371] ...
POP P,T3 ;[371] GET SIZE BACK
ADDI T3,(T1) ;[371] END+1
SETZM (T1) ;[371] ZERO FIRST WORD
BLT T2,-1(T3) ;[371] CLEAR ALL OF DATA
RET +;[371]
SUBTTL COLLATING SEQUENCE ROUTINES
IFE FTCOBOL,<
IFN FTCOL,<
BEGIN
PROCEDURE (PUSHJ P,COLTRX)
MOVE T1,COLJFN ;GET JFN
MOVX T2,OF%RD!FLD(7,OF%BSZ) ;OPEN FOR READ, 7-BIT BYTES
OPENF% ;[335] ..
ERJMP E$$OPN
MOVEI T1,COLBUF ;GET THE ALT SEQ TABLE
MOVEM T1,COLSW ;STORE THE ADDRESS OF THE TABLE
MOVEI T2,COLCHR ;ADDRESS OF THE INPUT ROUTINE
PUSHJ P,BLDCOL ;BUILD THE TABLE
JRST E$$ICS ;ILLEGAL COLLATING SEQUENCE SPECIFIED
MOVE T1,COLJFN
CLOSF% ;[335]
JFCL
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,COLCHR)
SOSGE COLPTR+1 ;REDUCE THE BYTE COUNT
JRST $1 ;GET A BUFFER
MOVE T1,@COLPTR ;GET WORD
TRNE T1,1 ;CHECK FOR SEQUENCE NUMBER
JRST [AOS COLPTR ;IT IS
MOVNI T1,5
ADDM T1,COLPTR+1 ;ACCOUNT FOR 5 BYTES
JRST COLCHR] ;LOOP BACK
ILDB T1,COLPTR ;GET A BYTE
CAIG T1," " ;IGNORE SPACE AND ALL CONTROL CHARACTERS
JRST $B ;GET THE NEXT CHARACTER
PJRST CPOPJ1 ;SKIP RETURN WITH CHAR IN T1
$1% MOVE T1,COLJFN ;GET JFN
HRROI T2,COLITB ;USE LIT BUFFER
MOVEI T3,COLITS ;NO. OF CHARS
SETZ T4,
SIN% ;[335] GET IT
ERJMP [MOVX T1,.FHSLF ;GET MOST RECENT ERROR NUMBER
GETER% ;[335] ..
HRRZ T1,T2 ; ..
CAXE T1,IOX4 ;END OF FILE?
JRST [PUSHJ P,E$$BER
$MORE (FILESPEC,COLJFN)
JRST LASTER] ;[357] TRY TO GIVE MORE INFO
CAIN T3,COLITS ;WAS BYTE COUNT ALTERED (I.E., WAS ANYTHING READ?)
RETURN ;NO, ASSUME EOF
JRST .+1] ;CONTINUE, GET EOF AGAIN NEXT TIME
MOVEI T1,COLITS ;GET BYTES PER BUFFER
SUB T1,T3 ;DEDUCT NO. OF BYTES NOT READ
MOVEM T1,COLPTR+1 ;EQUALS NO. OF BYTES IN THIS BUFFERLOAD
MOVE T1,[POINT 7,COLITB]
MOVEM T1,COLPTR ;STORE NEW BYTE POINTER
JRST $B ;GET THE NEXT CHARACTER
END;
>;END IFN FTCOL
>;END IFE FTCOBOL
SUBTTL ERROR MESSAGES
;.TOLEB - PRINT "LOOKUP/ENTER" BLOCK (FILESPEC STRING) FOR
; JFN IN T2 (USED BY $MORE MACRO)
.TOLEB: MOVX T1,.PRIOU ;TYPE ON PRIMARY OUTPUT JFN
MOVX T3,<1B2+1B5+1B8+1B11+1B14+1B17+1B20>!JS%PAF ;TYPE ALL FIELDS
JFNS% ;[335] TYPE IT
RET
E$$OPN: $ERROR (?,OPN,<OPENF failure for file >,+)
HLRZ T2,FILPGN(F) ;GET JFN OF FILE
$MORE (FILESPEC,T2)
JRST LASTER ;[357] TRY TO GIVE MORE INFO
E$$FMC: $ERROR (?,FMC,<File's mode conflicts with mode switch for >,+)
HRRZ T2,X.JFN(P1) ;[305] PRINT THE FILE SPEC
$MORE (FILESPEC,T2) ;[305] ..
$DIE ;[305]
E$$CFF: $ERROR (?,CFF,<CLOSE failure for file >,+)
HLRZ T1,FILPGN(F) ;GET JFN
$MORE (FILESPEC,T1)
JRST LASTER ;[357] TRY TO GIVE MORE INFO
E$$FCR: $ERROR (?,FCR,<Fatal core management error at RESET%>)
E$$FPM: $ERROR (?,FPM,<File page already mapped>)
E$$FPU: $ERROR (?,FPU,<File page already unmapped>)
E$$IDN: $ERROR (?,IDN,<Invalid directory number for temp file>,+) ;[357]
JRST LASTER ;[357] TRY TO GIVE MORE INFO
E$$BIS: $ERROR (?,BIS,<Non-skip return from BIS>)
E$$GFT: $ERROR (?,GFT,<GTJFN% failed for temp file>,+) ;[357]
LASTER: $MORE (TEXT,<
>)
MOVEI T1,.PRIOU ;[357] PRINCIPAL OUPUT DEVICE
HRLOI T2,.FHSLF ;[357] CURRENT FORK,,LAST ERROR
SETZB T3,T4 ;[357] NO LIMIT,,FULL MESSAGE
ERSTR% ;[357] PRINT THE MESSAGE
JFCL ;[357] IGNORE UNDEFINED ERROR NUMBER
JFCL ;[357] IGNORE ERROR DURING EXECUTION OF ERSTR
$DIE ;[357] GIVE UP
E$$JFT: $ERROR (?,JFT,<JFNS% failed for temp file>,+) ;[357]
JRST LASTER ;[357] TRY TO GIVE MORE INFORMATION
E$$AWP: $ERROR (?,AWP,<Attempted to write partial buffer for >,+)
HLRZ T2,FILPGN(F) ;GET JFN
$MORE (FILESPEC,T2)
$DIE
E$$RBP: $ERROR (?,RBP,<Reformat of buffer pool failed>)
E$$ICM: $ERROR (?,ICM,<Insufficient core for merge phase>)
E$$FER: $ERROR (?,FER,<Can't allocate temp buffers at RFMBFP>)
E$$NRO: $ERROR (?,NRO,<No room for output buffer in merge phase>)
E$$BAF: $ERROR (?,BAF,<Buffer allocation failed>)
IFE FTCOBOL,< ;NON-COBOL ERROR MESSAGES
E$$CDL: $ERROR (?,CDL,<Can't do input from the line printer>)
E$$CDC: $ERROR (?,CDC,<Can't do output to the card reader>)
E$$AND: $ERROR (?,AND,<ARPANET device illegal for SORT>)
E$$FED: $ERROR (?,FED,<FRONT-END device illegal for SORT>)
E$$IDM: $ERROR (?,IDM,<Illegal data mode>)
E$$NSD: $ERROR (?,NSD,<No such device>)
E$$DME: $ERROR (?,DME,<Error in DUMP MODE I/O to magtape>,+) ;[357]
JRST LASTER ;[357] TRY TO GIVE MORE INFO
E$$NFS: $ERROR (?,NFS,<No filename specified for labelled tape >,+)
HRRZ T2,X.JFN(P1)
$MORE (FILESPEC,T2)
JRST LASTER ;[357] TRY TO GIVE MORE INFO
E$$FTL: $ERROR (?,FTL,<Filespec field too long for labelled tape >,+)
HRRZ T2,X.JFN(P1)
$MORE (FILESPEC,T2)
$DIE
E$$JFO: $ERROR (?,JFO,<JFNS% failed for output file>,+) ;[357]
JRST LASTER ;[357] TRY TO GIVE MORE INFO
E$$BER: $ERROR (?,BER,<Hard input error for device >,+)
HLRZ T2,FILPGN(F) ;GET JFN
$MORE (FILESPEC,T2)
JRST LASTER ;[357] TRY TO GIVE MORE INFO
E$$CCN: $ERROR (?,CCN,<CLRBUF called for non-disk device >,+)
HLRZ T2,FILPGN(F) ;GET JFN
$MORE (FILESPEC,T2)
$DIE
>;END IFE FTCOBOL