Trailing-Edge
-
PDP-10 Archives
-
BB-Z759A-SM
-
sort-source/srtjss.mac
There are 16 other files named srtjss.mac in the archive. Click here to see a list.
; UPD ID= 85 on 10/25/83 at 3:04 PM by FONG
TITLE SRTJSS - TOPS-20 SPECIFIC PART OF SORT/MERGE
SUBTTL D.L. CAMPBELL/DZN/DMN/BRF
SEARCH COPYRT
SALL
;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, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION
SEARCH SRTPRM
XSEARCH ;SEARCH OTHER UNIVERSALS
IFE FTOPS20,<PRINTX ? SRTJSS should not be present in TOPS-10 SORT/MERGE.>
IFN FTPRINT,<PRINTX [Entering SRTJSS.MAC]]>
.COPYRIGHT ;Put standard copyright statement in REL file
SEGMENT HPURE
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 Impure Data ....................................... 4
; 4 ENTRY POINTS
; 4.1 TOPS-20 Entry Vector .............................. 6
; 5 PSORT.
; 5.1 SETUPI - Set Up Input Files ....................... 7
; 6 I/O ROUTINES
; 6.1 INIINP - Initialize Next Input File
; 6.1.1 Set Up ..................................... 7
; 6.1.2 Disk ....................................... 9
; 6.1.3 Magtape .................................... 11
; 6.1.4 Others ..................................... 13
; 6.2 INIOUT - Initialize Next Output File
; 6.2.1 Set Up ..................................... 17
; 6.2.2 Disk ....................................... 18
; 6.2.3 Magtape .................................... 19
; 6.3 Magtape Utility Routines .......................... 20
; 6.4 File Utility Routines
; 6.4.1 Close Master Input/Output File ............. 21
; 6.4.2 Delete a Temp File ......................... 22
; 6.4.3 Unmap Buffer Pages For a File .............. 23
; 6.4.4 Initialize Output Temporary File ........... 26
; 6.4.5 Append to Temporary File ................... 27
; 7 TRY TO RENAME SINGLE TEMP FILE TO OUTPUT FILE ............ 30
; 8 GETREC
; 8.1 GETBUF - Input 1 Physical Buffer
; 8.1.1 Set Up ..................................... 33
; 8.1.2 Terminal ................................... 34
; 8.1.3 Disk ....................................... 35
; 8.1.4 Magtape .................................... 39
; 9 PUTREC
; 9.1 PUTBUF - Output 1 Physical Buffer
; 9.1.1 Set Up ..................................... 40
; 9.1.2 Disk ....................................... 41
; 9.1.3 Magtape .................................... 43
; 10 PSORT.
; 10.1 Memory Management Routines for TOPS-20 ............ 44
; 11 COLLATING SEQUENCE ROUTINES .............................. 54
; 12 ERROR MESSAGES ........................................... 55
SUBTTL DEFINITIONS -- TOPS-20 Specific Parameters
OUTSIZ==PGSIZ*3 ;DESIRABLE SIZE FOR SINGLE OUTPUT BUFFER
PPTBUF==2 ;MINIMUM PAGES PER TEMP FILE BUFFER
SM%RWX==:SM%RD!SM%WR!SM%EX ; CONVENIENCE
DDTPG.==764 ; START OF DDT
SUBTTL INTERNAL/EXTERNAL DEFINITIONS
;GENERATE STRUCTURE MACROS
;NOW GENERATE THEM MAX = 10 FOR NOW
RADIX 10
$TEMPORARY (10,10)
RADIX 8
;GLOBAL ROUTINES
INTERN ENTVEC
INTERN CLSFIL,DELFIL,ENTFIL,E$$NRO,E$$CM1,FMTBFP,GETBUF,INIOUT,ISITMT,LKPFIL,PUTBUF,RFMBFP
INTERN RMSGET,RMSPUT,TSTDEV,OBUFSZ
INTERN DFMTMD,DFMTRS,MOUNTR
INTERN BKSPF,BKSPR,CHKCOR,CLSMST,COLTRX,ERSET$,GETBUF,GETRMS,GMTVOL,INIINP,INIOUT
INTERN ISATBT,ISITMT,PUTBUF,RESET$,RWNDF,SETTMP,SETUPI,SETUPO,SKIPF,SKIPR,STRTIO,UNLDF,WRTEOF
INTERN CLSFIL,DELFIL,ENTFIL,E$$NRO,FMTBFP,GETBUF,INIOUT,ISITMT,LKPFIL,RFMBFP
;EXTERNALS
;DEFINED IN SORT
EXTERN ACTTMP,BUFALC,BUFORG,BUFPTR,BUFSZ,DFBORG,FCBORG,INPREC,IOBPW2,MAXTMP,MRGSW
EXTERN NUMENT,NUMLFT,NUMRCB,NUMTMP,OBUFNO,PHYEOF,RCBORG,RCBSZ,RECORD,REKSIZ,STRNAM,STRNUM
EXTERN TBUFNO,TCBIDX,TMPFCB,TMPTOT,TREORG,TRESZ,UBUFSZ,XTRWRD
EXTERN BLKSET,E$$NEC,FRECOR,FRESPC,GENNAM,GETSPC,RELSPC,%ERMSG,%TCRLF,%TOCTW,%TOLEB,%TSTRG
EXTERN FORRET,ERRADR
;DEFINED IN SRTSTA
EXTERN COLBUF,COLITB,COLITS,COLPTR,COLSW,CORSIZ,EXTORG,F.INZR,F.OUZR,IBUFNO
EXTERN IOMODE,MODE,MXDVSZ,RECSIZ,SEQNO
EXTERN BLDCOL,CHKLBL,DIE,E$$ICS,EOFOUT,FORENT,POSITF,START,WRTLBL
;DEFINED IN SRTCMD
EXTERN COLJFN,.NMUL,APPFLG,RMSFLG
;DEFINED IN SRTCBL
EXTERN CBLVLN,CBLVEC,COBPDP,DTRVLN,DTRVEC
;PROTOTYPE RMS STRUCTURES
SEGMENT HPURE
;PROTOTYPE FAB:
PRFAB: FAB$B
FAB$E
FABLEN==.-PRFAB ;LENGTH
;PROTOTYPE RAB:
PRRAB: RAB$B
RAB$E
RABLEN==.-PRRAB ;LENGTH
;PROTOTYPE XAB:
PRXAB: XAB$B KEY
XAB$E
XABLEN==.-PRXAB ;LENGTH
SUBTTL DEFINITIONS -- Impure Data
SEGMENT IMPURE ;[C20]
ZJ.BEG:! ;[427] FIRST DATUM TO DELETE
LD (CBPTR,1) ;CANONICAL BYTE POINTER
LD (INLST,2) ;I/O COMMAND LIST FOR MTA INPUT
LD (OUTLST,2) ;I/O COMMAND LIST FOR MTA OUTPUT
LD (PGTAB,<1000/^D36>+1) ;[C13] BIT TABLE OF MAPPED PAGES
GD (LEANUM,1) ;ARGUMENT TO /LEAVES SWITCH
GD (OBUFSZ,1) ;(MINIMUM) SIZE OF OUTPUT BUFFER
LD (DFMTRS,1) ;DEFAULT MTA RECORD SIZE
LD (DFMTMD,1) ;[C03] DEFAULT MTA HARDWARE MODE
LD (MTTEMP,2) ;[C12] TEMPORARY MTOPR% BLOCK
LD (MOUNTR,1) ;[C12] MOUNTR AROUND FLAG, 0=NO, -1=YES
LD (AZTEMP,^D20) ;[405] TEMP TO HOLD FILESPEC AT XGTJFN
LD (SOURCE,1) ;[464] AREA TO SAVE ARGS FOR PMAP
LD (DEST,1) ;[464] ...
LD (ACCESS,1) ;[464] ...
LD (PGSATM,1) ;[464] THE # OF PAGES ATTEMPTED TO PMAP
LD (ERRBLK,^D16) ;PLACE TO STORE MESSAGE FROM ERSTR%
LD (OUTORG,1) ;OUTPUT ORGANIZATION IF RMS FILE
LD (INFAB,FABLEN) ;INPUT FAB
LD (INRAB,RABLEN) ;INPUT RAB
LD (INXAB,XABLEN) ;INPUT XAB
LD (OUTFAB,FABLEN) ;OUTPUT FAB
LD (OUTRAB,RABLEN) ;OUTPUT RAB
LD (OUTXAB,XABLEN) ;OUTPUT XAB
LD (RMSJFN,1) ;JFN FOR RMS
LD (GETARG,.GBASE) ;FLAGS, LOW, HIGH ADDRESS
LD (RMSSEC,1) ;SECTION # OF SORT
LD (RFSBLK,1+.RFSFL) ;ARG BLOCK FOR LONG FORM RFSTS% JSYS
ZJ.END==.-1 ;[427] LAST DATUM TO CLEAR
SEGMENT HPURE ;[C20]
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>>
>
IF1,<
DEFINE $JRST$ <BLOCK 1> ;KEEP MACRO HAPPY
>
SUBTTL ENTRY POINTS -- TOPS-20 Entry Vector
IFE FTCOBOL,<
SEGMENT HPURE ;[C20]
ENTVEC: JRST START ;MAIN ENTRY POINT
JRST START ;REENTER ENTRY POINT
EXP V%SORT ;VERSION NUMBER
USRVLN,,USRVEC ;USER ENTRY VECTOR
CBLVLN,,CBLVEC ;COBOL ENTRY VECTOR
DTRVLN,,DTRVEC ;DATATRIEVE ENTRY VECTOR
ENTVLN==.-ENTVEC
USRVEC: JRST FORENT ;FORTRAN ENTRY POINT
USRVLN==.-USRVEC
SUBTTL PSORT. -- SETUPI - Set Up Input Files
;SETUPI - PASS OVER INPUT FILES, REMEMBER LARGEST BUFFER SIZE REQUIRED,
;SET UP SOME RANDOM STUFF
SETUPI: HRRZ T1,IOMODE ;[C20] GET I/O MODE
MOVE T1,BYTTAB-1(T1) ;[OK] 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+<1000/^D36> ;[C13] 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,
MOVE T2,X.FLG(P1)
TXNE T2,FI.RMS ;RMS FILE?
JRST [LDB T2,[POINT 9,X.DVCH(P1),17]
CAXE T2,.DVDSK ;IS IT ON DSK?
JRST E$$RMD ;NO, GIVE ERROR
JRST SETUP3] ;YES, DON'T NEED I/O BUFFERS
LDB T2,[POINT 9,X.DVCH(P1),17] ;[OK] GET DEVICE TYPE
CAXN T2,.DVDSK ;DISK?
MOVEI T1,PGSIZ ;YES, BUFFER WANTS TO BE 1 PAGE
CAXN T2,.DVMTA ;MTA?
JRST [MOVEI F,FCBORG ;[C02] YES, SETUP MINIMAL FCB
MOVE T1,X.FLG(P1) ;[OK] [C02] ..
MOVEM T1,FILFLG(F) ;[C02] ..
CALL MTBFSZ ;[C02] 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
JRST .+1]
SETUP3: 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) ;[OK] 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) ;[OK] GET JFN
HRLZM T1,FILJFN(F) ;STORE IN FCB
MOVE T3,X.FLG(P1) ;[OK] GET FILE FLAGS
MOVEM T3,FILFLG(F) ;SAVE IN FCB
MOVE T1,X.BLKF(P1) ;[OK] [C06] FETCH BLOCKING FACTOR
HRRZM T1,FILBLK(F) ;[C06] STORE AS AOBJN WORD (TO FAIL FIRST TIME)
SETZM FILSIZ(F)
SETZM FILEOF(F)
SETZM FILCNT(F)
TXNE T3,FI.RMS ;RMS FILE?
JRST RMSIN ;YES, SPECIAL ROUTINE FOR THIS
LDB T1,[POINT 9,X.DVCH(P1),17] ;[OK] GET DEVICE TYPE
CAILE T1,.DVNET ;RANGE CHECK
JRST E$$NSD ;NO SUCH DEVICE
JUMPL T1,E$$NSD ;CAN'T BE NEGATIVE
CALL @[IFIW INDSK ;[C20] 0 - DISK
IFIW E$$NSD ;[C20] 1 - NO SUCH DEVICE
IFIW INMTA ;[C20] 2 - MAGTAPE
REPEAT 4,<IFIW E$$NSD> ;[C20] 3-6 - NO SUCH DEVICE
IFIW E$$CDL ;[C20] 7 - LINE PRINTER
IFIW INCDR ;[C20] 10 - CARD READER
IFIW E$$FED ;[C20] 11 - FRONT-END DEVICE
IFIW INTTY ;[C20] 12 - TERMINAL
IFIW INPTY ;[C20] 13 - PSEUDO-TERMINAL
IFIW E$$NSD ;[C20] 14 - NO SUCH DEVICE
IFIW INNUL ;[C20] 15 - NULL DEVICE
IFIW E$$AND](T1) ;[C20] 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) ;[OK] [305] IF BLOCKED FILE,
CALL BLKSET ;[305] SET UP FOR IT
HLRZ T1,FILJFN(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,FILJFN(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
IMUL T1,IOBPW2 ;[C03] 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
MOVE T1,FILBPK(F) ;[C17] GET BYTES PER BLOCK
MOVEM T1,FILKCT(F) ;[C17] SAVE AS BLOCK BYTE COUNT
HLRZ T1,FILBUF(F) ;[321] GET PAGES PER BUFFER
LSH T1,POW2(PGSIZ) ;CONVERT TO WORDS
IMUL T1,IOBPW2 ;[C03] CONVERT TO APPROPRIATE NO. OF BYTES
MOVEM T1,FILBPB(F) ;SAVE NO. OF BYTES PER BUFFER
HLRZ T1,FILJFN(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
SKIPN FILBUF(F) ;[N26] IS THERE A BUFFER FROM A PREVIOUS FILE?
JRST INMTA1 ;[N26] NO, ITS THE FIRST TIME
HLRZ T2,FILBUF(F) ;[N26] GET THE PREVIOUS SIZE
CAMN T1,T2 ;[N26] IS IT THE SAME SIZE AS LAST TIME?
JRST INMTA2 ;[N26] YES, USE PREVIOUS BUFFERS
SUB T2,T1 ;[N26] GET THE DIFFERENCE
CAIL T2,PGSIZ ;[N26] LESS THAN 1 PAGE?
JRST INMTA1 ;[N26] NO, ALLOCATE NEW BUFFERS FOR NOW
HRLM T1,FILBUF(F) ;[N26] RESET THE BUFFER SIZE
HRLM T1,FILBF2(F) ;[N26] BUT NOT THE BUFFER LOCATION
JRST INMTA2 ;[N26] AND CONTINUE WITH BUFFERS ALLOCATED
INMTA1: HRLZM T1,FILBUF(F) ;[N26] SAVE SIZE OF BUFFER
IMUL T1,IOBPW2 ;[C03] MULTIPLE BY BYTES PER WORD
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
HRRM T1,FILBF2(F) ;[C02] SAVE ITS ADDRESS
INMTA2: HLRZ T1,FILJFN(F) ;[N26] GET JFN
MOVX T2,OF%RD!FLD(17,OF%MOD) ;OPEN FOR READ, DUMP MODE
OPENF% ;[335] ..
ERJMP E$$OPN
CALL SMTLBS ;[C12] SET MOUNTR AND FI.ATO
CALL POSITF ;[C11] POSITION AT FILE
CALL SMTDEN ;[C01] SET DENSITY
CALL SMTPAR ;[C01] SET PARITY
CALL SMTMOD ;[C01] SET HARDWARE MODE
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,FILJFN(F) ;GET JFN FOR TAPE
GDSTS% ;[335] GET CURRENT STATUS
TXZ T2,MT%IRL ;CLEAR POSSIBLE LEFTOVER ERROR BITS
SDSTS% ;[335] ..
MOVEI T1,INLST ;[C02] LOAD PARAMETER FOR SWTBUF
CALL SWTBUF ;[C02] SET BYTE POINTER AND IOWD BLOCK
;START I/O ON FIRST BUFFER
HLRZ T1,FILJFN(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
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,FILJFN(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,FILJFN(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,IOBPW2 ;[C03] ..
MOVEM T1,FILBPB(F) ;SAVE IT
RET
;COMPUTE BUFFER SIZE FOR MAGTAPE, ACCOUNTING FOR BLOCKING FACTOR
MTBFSZ: CALL MTMODE ;[C03] DO MTA HARDWARE MODE CALCULATIONS
SKIPN T3,X.BLKF(P1) ;[OK] BLOCKING FACTOR SPECIFIED?
JRST MTBFS1 ;UNBLOCKED, USE DEFAULT RECORD SIZE
HRRZ T1,IOMODE ;[C20] DISPATCH ON I/O MODE
JRST @[IFIW MTB6BT ;[C20] SIXBIT
IFIW MTBASC ;[C20] ASCII
IFIW MTBBCD ;[C20] EBCDIC
IFIW MTBBIN]-1(T1) ;[C20] 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
ADDI T1,4 ;ACCOUNT FOR REMAINDER
IDIVI T1,5 ;DIVIDED BY BYTES PER WORD
RET ;EQUALS BUFFER SIZE IN WORDS
MTBBCD: MOVE T1,RECORD ;RECORD SIZE IN BYTES
SKIPGE FILFLG(F) ;[C06] IF VARIABLE?
ADDI T1,4 ;[C06] ADD RECORD HEADER WORD
IMUL T1,T3 ;TIMES BLOCKING FACTOR
ADDI T1,3 ;ACCOUNT FOR REMAINDER
IDIVI T1,4 ;DIVIDED BY BYTES PER WORD
SKIPGE FILFLG(F) ;[C06] IF VARIABLE?
ADDI T1,1 ;[C06] ADD BLOCK HEADER WORD
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 IN BYTES
IDIV T1,FILHBW(F) ;[C06] COMPUTE NO. OF WORDS
SKIPE T2 ;[C06] COUNT PARTIAL WORDS
ADDI T1,1 ;[C06] ..
RET
;GET MAGTAPE HARDWARE MODE AND OTHER CALCULATIONS
MTMODE: MOVE T2,FILFLG(F) ;[C03] A HARDWARE MODE REQUESTED?
TXNE T2,FI.IND!FI.STA ;[C03] ..
JRST MTMOD1 ;[C03] YES
MOVE T3,DFMTMD ;[C03] NO, SET DEFAULT MODE
CAIN T3,.SJDM8 ;[C03] INDUSTRY COMPATIBLE?
TXO T2,FI.IND ;[C03] YES, REMEMBER IT
CAIN T3,.SJDMA ;[C03] ANSI-ASCII?
TXO T2,FI.STA ;[C03] YES, REMEMBER IT
MOVEM T2,FILFLG(F) ;[C03] SAVE NEW FLAGS
MTMOD1: MOVEI T1,DFMTMD ;[C03] GET ACTUAL MODE
TXNE T2,FI.IND ;[C03] INDUSTRY COMPATIBLE?
MOVEI T1,.SJDM8 ;[C03] YES, REMEMBER IT
TXNE T2,FI.STA ;[C03] ANSI-ASCII?
MOVEI T1,.SJDMA ;[C03] YES, REMEMBER IT
MOVEI T2,1 ;[C03] COMPUTE HARDWARE BYTES PER WORD
;[C03] ASSUME 1-BYTE WORDS
CAIN T1,.SJDM6 ;[C03] SIXBIT MODE?
MOVEI T2,6 ;[C03] YES, 6-BYTE WORDS
CAIN T1,.SJDMA ;[C03] ANSI-ASCII MODE?
MOVEI T2,5 ;[C03] YES, 5-BYTE WORDS
CAIN T1,.SJDM8 ;[C03] INDUSTRY COMPATIBLE MODE?
MOVEI T2,4 ;[C03] YES, 4-BYTE WORDS
MOVEM T2,FILHBW(F) ;[C03] SAVE HARDWARE BYTES PER WORD
RET ;[C03] DONE
;LABSET -- SET UP LABEL NAMES IN SIXBIT FOR LABEL PROCESSING
LABSET: MOVE T1,X.LABL(P1) ;[OK] GET LABEL TYPE FOR THIS TAPE
MOVE T2,FILFLG(F) ;[C12] 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) ;[OK] TO CLEAR STRING SPACE
HRRZI T2,^D17-1(P2) ;[OK] END OF BLT
SETZM 0(P2) ;[OK] CLEAR FIRST WORD
BLT T1,0(T2) ;[OK] SPREAD IT AROUND
SETZM X.RIB+.RBNAM(P1) ;[OK] CLEAR CELLS IN X. BLOCK
SETZM X.RIB+.RBEXT(P1) ;[OK] WHICH WILL RECEIVE SIXBIT NAME.EXT
HRRO T1,P2 ;CONSTRUCT STRING PTR TO SPACE
HRRZ T2,X.JFN(P1) ;[OK] 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)] ;[OK] 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
CAIL T1,"a" ;[C04] CONVERT LOWER CASE TO UPPER CASE
CAILE T1,"z" ;[C04] ..
SKIPA ;[C04] ..
SUBI T1,"a"-"A" ;[C04] ..
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)] ;[OK]
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: PUSH P,P1 ;GET A REGISTER
MOVEI F,FCBORG ;OUTPUT FILE IS ALWAYS 1ST FCB
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.JFN(P1) ;[OK] GET JFN
HRLZM T1,<FILJFN+FILPGN>/2(F) ;SAVE IT AND ZAP PAGE COUNT
MOVE T1,X.BLKF(P1) ;[OK] [C06] FETCH BLOCKING FACTOR
HRRZM T1,FILBLK(F) ;[C06] STORE AS AOBJN WORD (TO FAIL FIRST TIME)
MOVE T1,X.FLG(P1) ;[OK] PUT FLAGS IN FCB
TXO T1,FI.OUT ;[C06] REMEMBER THIS IS AN OUTPUT FILE
MOVEM T1,FILFLG(F) ; ..
TXNE T1,FI.RMS ;RMS FILE?
JRST RMSOUT ;YES, SPECIAL ROUTINE FOR THIS
SKIPN APPFLG ;/APPEND SWITCH?
JRST INIOU1 ;NO
SETZM APPFLG ;YES, ITS ILLEGAL FOR NOW
$ERROR (%,AAR,<APPEND switch applies to RMS output file only.>)
INIOU1: LDB T1,[POINT 9,X.DVCH(P1),17] ;[OK] 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 @[IFIW OUDSK ;[C20] 0 - DISK
IFIW E$$NSD ;[C20] 1 - NO SUCH DEVICE
IFIW OUMTA ;[C20] 2 - MAGTAPE
REPEAT 4,<IFIW E$$NSD> ;[C20] 3-6 - NO SUCH DEVICE
IFIW OULPT ;[C20] 7 - LPT
IFIW E$$CDC ;[C20] 10 - CDR
IFIW E$$FED ;[C20] 11 - FRONT-END DEVICE
IFIW OUTTY ;[C20] 12 - TERMINAL
IFIW OUPTY ;[C20] 13 - PSEUDO-TERMINAL
IFIW E$$NSD ;[C20] 14 - NO SUCH DEVICE
IFIW OUNUL ;[C20] 15 - NULL DEVICE
IFIW E$$AND](T1) ;[C20] 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) ;[OK] [305] IF BLOCKED FILE,
CALL BLKSET ;[305] SET UP FOR IT
HLRZ T1,FILJFN(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
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
MOVE T1,FILBPK(F) ;[C17] GET BYTES PER BLOCK
MOVEM T1,FILKCT(F) ;[C17] SAVE AS BLOCK BYTE COUNT
HLRZ T1,FILBUF(F) ;GET PAGES PER BUFFER
LSH T1,POW2(PGSIZ) ;COMPUTE WORDS
IMUL T1,IOBPW2 ;[C03] 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,FILJFN(F) ;GET JFN
MOVX T2,OF%WR!FLD(17,OF%MOD) ;OPEN FOR WRITE, DUMP MODE
OPENF% ;[335] ..
ERJMP E$$OPN ;OPEN ERROR
CALL SMTLBS ;[C12] SET MOUNTR AND FI.ATO
CALL MTBFSZ ;COMPUTE BUFFER SIZE (IN WORDS)
HRLZM T1,FILBUF(F) ;SAVE IT
IMUL T1,IOBPW2 ;[C03] 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
HRRM T1,FILBF2(F) ;[C02] REMEMBER ITS ADDRESS
CALL POSITF ;[C11] POSITION AT FILE
CALL SMTDEN ;[C01] SET DENSITY
CALL SMTPAR ;[C01] SET PARITY
CALL SMTMOD ;[C01] SET HARDWARE MODE
MOVEI T1,OUTLST ;[C02] LOAD PARAMETER FOR SWTBUF
CALL SWTBUF ;[C02] SET BYTE POINTER AND IOWD BLOCK
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 T1,FI.ATO ;[C12] NEED A VOLUME SWITCH?
TDNN T1,FILFLG(F) ;[C12] ..
SKIPN MOUNTR ;[C12] ..
SKIPA ;[C12] NO
CALL GMTVL1 ;[C12] MAYBE
MOVX T2,.MOREW ;[C12] FUNCTION TO REWIND TAPE
RWNDF1: HLRZ T1,FILJFN(F) ;GET JFN
MTOPR% ;[335] DO IT
RET
;UNLDF - UNLOAD MAGTAPE POINTED TO BY F
UNLDF: SKIPE MOUNTR ;[C12] MOUNTR AROUND?
RET ;[C12] CAN'T DO UNLOAD
MOVX T2,.MORUL ;[C12] 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
;BKSPR - BACKSPACE MAGTAPE ONE RECORD
BKSPR: MOVX T2,.MOBKR ;[C11] LOAD FUNCTION CODE
JRST RWNDF1 ;[C11] JOIN COMMON CODE
;BKSPF - BACKSPACE MAGTAPE ONE FILE
BKSPF: MOVX T2,.MOBKF ;[C11] FUNCTION CODE
JRST RWNDF1 ;[C11] JOIN COMMON CODE
;WRTEOF - WRITE A TAPE MARK DURING LABEL PROCESSING
WRTEOF: MOVX T2,.MOEOF ;[335] FUNCTION CODE FOR MTOPR%
JRST RWNDF1 ;DO IT
;SMTPAR - SET MAGTAPE PARITY POINTED TO BY F
SMTPAR: MOVE T1,FILXBK(F) ;[C01] GET X. BLOCK
SKIPGE T3,X.PAR(T1) ;[OK] [C01] GET PARITY PARAMETER FOR MTOPR%
RET ;[C01] DON'T SET IF DEFAULT
MOVX T2,.MOSPR ;[C01] FUNCTION CODE FOR MTOPR%
JRST RWNDF1 ;[C01] DO IT
;SMTDEN - SET MAGTAPE DENSITY POINTED TO BY F
SMTDEN: MOVE T1,FILXBK(F) ;[C01] GET X. BLOCK
SKIPGE T3,X.DEN(T1) ;[OK] [C12] [C01] GET DENSITY PARAMETER FOR MTOPR%
RET ;[C12] DON'T SET IF DEFAULT
MOVX T2,.MOSDN ;[C01] FUNCTION CODE FOR MTOPR%
JRST RWNDF1 ;[C01] DO IT
;SMTMOD - SET MAGTAPE HARDWARE MODE POINTED TO BY F
SMTMOD: MOVE T1,FILFLG(F) ;[C01] GET FLAGS
MOVX T2,.MOSDM ;[C01] FUNCTION CODE FOR MTOPR%
TXNE T1,FI.IND ;[C01] INDUSTRY COMPATABLE?
JRST [MOVX T3,.SJDM8 ;[C01] YES, GET PARAMETER FOR MTOPR%
JRST RWNDF1] ;[C01] DO IT
TXNE T1,FI.STA ;[C01] ANSI-ASCII?
JRST [MOVX T3,.SJDMA ;[C01] YES, GET PARAMETER FOR MTOPR%
JRST RWNDF1] ;[C01] DO IT
RET ;[C01] LEAVE AS DEFAULT
;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)
CPOPJ1: AOS (P)
CPOPJ: RET
;ISATBT - CHECK TO SEE IF MAGTAPE POINTED TO BY F IS AT BOT
; SKIP RETURN IF IT IS
ISATBT: HLRZ T1,FILJFN(F) ;[C11] GET JFN
GDSTS% ;[C11] GET DEVICE STATUS
TXNE T2,MT%BOT ;[C11] BOT?
AOS (P) ;[C11] YES, SKIP RETURN
RET ;[C11]
;SMTLBS - SET MOUNTR AND FI.ATO (AUTO SYSTEM LABELING FLAGS)
SMTLBS: HLRZ T1,FILJFN(F) ;[C12] GET JFN
MOVX T2,.MORLI ;[C12] FUNCTION FOR LABEL TYPE
MOVEI T3,MTTEMP ;[C12] GET MTOPR% BLOCK ADDRESS
MOVEI T4,2 ;[C12] SETUP MTOPR% BLOCK
MOVEM T4,MTTEMP ;[C12] ..
MTOPR% ;[C12] DO IT
ERJMP [SETZM MOUNTR ;[C12] MOUNTR ISN'T AROUND
RET] ;[C12]
SETOM MOUNTR ;[C12] MOUNTR IS AROUND
MOVX T1,FI.UNL ;[C12] UNLOAD REQUESTED?
TDNE T1,FILFLG(F) ;[C12] ..
CALL [ ANDCAM T1,FILFLG(F) ;[C12] YES, CLEAR IT
$ERROR (%,UIA,<Unloads illegal with MOUNTR.>) ;[C12] TELL USER
RET] ;[C12] REJOIN MAIN FLOW
MOVE T1,FILXBK(F) ;[C12] DENSITY REQUESTED?
SKIPL X.DEN(T1) ;[OK] [C12] ..
CALL [ SETOM X.DEN(T1) ;[OK] [C12] YES, CLEAR IT
$ERROR (%,DIA,<Setting DENSITY illegal with MOUNTR.>) ;[C12] TELL USER
RET] ;[C12] REJOIN MAIN FLOW
MOVE T1,MTTEMP+1 ;[C12] GET LABEL TYPE
CAXN T1,.LTUNL ;[C12] LABLED?
RET ;[C12] NO
MOVX T2,FI.ATO ;[C12] YES, SET FLAG
IORM T2,FILFLG(F) ;[C12] ..
MOVE T2,FILXBK(F) ;[C22] NOT STANDARD LABELS REQUESTED?
MOVX T3,LABSTANDARD ;[C22] ..
CAME T3,X.LABL(T2) ;[C22] ..
CALL [ MOVEM T3,X.LABL(T2) ;[C22] YES, FIX IT
$ERROR (%,LIA,<Not standard labels illegal with MOUNTR.>) ;[C22] TELL USER
RET] ;[C22] REJOIN MAIN FLOW
MOVE T2,MODE ;[C12] GET MODE
CAXN T1,.LTEBC ;[C12] EBCDIC LABELS?
CAXE T2,MODEBCDIC ;[C12] AND NOT DEALING WITH EBCDIC?
SKIPA ;[C12] NO
JRST [$ERROR (?,ILT,<Inconsistent label type.>)] ;YES
CAXN T1,.LTANS ;[C12] ANSI-ASCII LABELS?
CAXE T2,MODASCII ;[C12] AND NOT DEALING WITH ASCII?
RET ;[C12] NO
JRST E$$ILT ;[C12] YES
;GMTVOL - GET NEXT VOLUME FOR MAGTAPE POINTED TO BY F
GMTVOL: MOVX T2,.MOVLS ;[C12] FUNCTION FOR VOLUME SWITCHING
MOVEI T3,[ 3 ;[C12] GET ARGUMENT BLOCK, WORD COUNT
.VSMRV ;[C12] RELATIVE VOLUME SUBFUNCTION
1] ;[C12] NEXT RELATIVE REEL
JRST RWNDF1 ;[C12] JOIN COMMON CODE
;GMTVL1 - GET FIRST VOLUME FOR MAGTAPE POINTED TO BY F
GMTVL1: MOVX T2,.MOVLS ;[C12] FUNCTION FOR VOLUME SWITCHING
MOVEI T3,[ 2 ;[C12] GET ARGUMENT BLOCK, WORD COUNT
.VSFST] ;[C12] FIRST VOLUME SUBFUNCTION
JRST RWNDF1 ;[C12] JOIN COMMON CODE
>;END IFE FTCOBOL
SUBTTL I/O ROUTINES -- File Utility Routines -- Close Master Input/Output File
CLSMST: SKIPE COBPDP ;CALLED FROM COBOL?
POPJ P, ;YES, THEN COBOL OWNS THE MASTER FILE
TDZA T4,T4 ;REMEMBER THIS IS A MASTER CLOSE
CLSFIL: SETO T4, ;REMEMBER WE'RE CLOSING A TMP FILE
MOVE T1,FILFLG(F)
TXNE T1,FI.RMS ;IS IT AN RMS FILE?
JRST RMSCLS ;YES
TXNN T1,FI.OUT ;IS THIS AN OUTPUT FILE?
JRST CLSFL2 ;NO, DON'T WRITE PARTIAL BUFFERS
PUSH P,T4 ;SAVE FLAG REG
JSP T4,PUTBUF ;WRITE LAST PARTIAL BUFFER
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,FILJFN(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?
HLRZ T1,FILJFN(F) ;[420] GET JFN OF FILE
CLOSF% ;[335] NO, CLOSE IT
ERJMP E$$CFF ;CLOSE FAILURE FOR FILE
RET
SUBTTL I/O ROUTINES -- File Utility Routines -- Delete a Temp File
;DELFIL - DELETE FILE POINTED TO BY F
DELFIL: CALL UNMAPF ;FIRST UNMAP ANY BUFFER PAGES
HLRZ T1,FILJFN(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
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,-<<1000/^D36>+1> ;[C13] SET UP AOBJN PTR TO PGTAB
SETZ P2, ;INIT BIT NUMBER
RESET1: HRRZ T1,P1 ;[C20] GET NEXT WORD OF PGTAB
MOVE T1,PGTAB(T1) ;[C20] ..
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: CALL RELSPC ;[C13] RELEASE ALL RETAINED SPACE
;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,FILJFN(F) ;GET JFN
IORX T1,CZ%ABT ;ABORT IT
CLOSF% ;[335]
ERJMP .+1
MOVE P3,ACTTMP ;[C20] GET NO. OF ACTIVE TMP FILES
MOVEI F,TMPFCB ;[C20] SETUP PTR TO TMP FCB BLOCKS
RESTC2: HLRZ T1,FILJFN(F) ;GET JFN
IORX T1,CZ%ABT ;ABORT FILE
CLOSF% ;[335]
ERJMP .+1
ADDI F,FCBLEN ;[C20] STEP TO NEXT FCB
SOJG P3,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) ;[OK] IS BIT ALREADY SET?
JRST E$$FPM ;YES
IORM T3,0(T1) ;[OK] NO, SET IT AND RETURN
RET
;CLRBIT - ANALOGOUS TO SETBIT
CLRBIT: CALL BITSET ;COMPUTE WORD ADDR AND SET UP BIT
TDNN T3,0(T1) ;[OK] ALREADY CLEAR?
JRST E$$FPU ;YES
ANDCAM T3,0(T1) ;[OK] 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) ;[OK] 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) ;[OK] GET DIRECTORY NUMBER FOR TEMP FILE
CALL XGTJFN ;MAKE ASCIZ FILESPEC AND DO GTJFN
HRLZM T1,<FILJFN+FILPGN>/2(F) ;[503] SAVE JFN AND ZERO PAGE COUNTER
MOVX T2,OF%WR ;OPEN FOR WRITE
OPENF% ;[335]
ERJMP E$$OPN
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(F) ;[C20] BLT LIMIT
HLRZ T3,FILRUN(F) ;PRESERVE RUN NUMBER ENTFIL COMPUTED
BLT T1,-1(T2) ;[OK] 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
ADD T1,T4 ;[C20] 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) ;[OK] 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+GJ%FOU ;[503] SHORT FORM, CREATE A NEW GENERATION
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
MOVE P1,F.OUZR ;[436] LOAD ADDRESS OF OUTPUT X.BLOCK
MOVS T1,@EXTORG ;[OK] [C13] GET EXTRACT CODE
CAIN T1,(JRST (P4)) ;JUST A DUMMY?
SKIPE X.BLKF(P1) ;[OK] CAN'T DO IF OUTPUT BLOCKED
RET ;DO THE COPY
LDB T1,[POINT 9,X.DVCH(P1),17] ;[OK] 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) ;[OK] ZERO STRING SPACE
SETZM 1(T1) ;[OK] ..
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,FILJFN(T2) ;[OK] 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) ;[OK] ZERO STRING SPACE
SETZM 1(T1) ;[OK] ..
MOVE T4,T1 ;SAVE ADDRESS
HRROS T1 ;CONSTRUCT STRING PTR
HRRZ T2,X.JFN(P1) ;[OK] 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,FILJFN(T3) ;[OK] 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) ;[OK] GET JFN OF OUTPUT FILE
IORX T1,CO%NRJ ;DON'T RELEASE JFN
CLOSF% ;[335] CLOSE FILE
ERJMP E$$CFR ;OOPS
HLRZ T1,FILJFN(T3) ;[OK] GET TEMP FILE JFN AGAIN
HRRZ T2,X.JFN(T4) ;[OK] GET OUTPUT FILE JFN
RNAMF% ;[335] DO THE RENAME
ERJMP E$$RFF ;FAILED
MOVE T1,FILEOF(F) ;[437] TMPFCB #BYTES
MOVEI F,FCBORG ;[437] CHANGE F TO WHAT IS EXPECTED
MOVEM T1,FILEOF(F) ;[437] AND GIVE FCBORG CORRECT INFO
MOVE T1,INPREC ;FAKE COPY OF FILE
MOVEM T1,FILSIZ(F) ;[437] GIVE THIS INFO TOO FOR EOFOUT
MOVE T1,T2(T4) ;[OK] [437] SET UP OPENF
MOVE T2,[44B5+OF%RD+OF%WR];[437] BECAUSE CLSFIL
OPENF% ;[437] NEEDS IT OPEN FOR CHFDB
ERJMP E$$OPN ;[437] FAILURE!
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
IFN FTCOBOL,<
JRST GETDSK ;[C03] ONLY GETDSK IN COBOL SORT
>
IFE FTCOBOL,<
SKIPE COBPDP ;CALLED FROM COBOL?
JRST GETDSK ;YES, ONLY 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
MOVE T1,FILXBK(F) ;GET ADDR OF X. BLOCK FOR FILE
LDB T1,[POINT 9,X.DVCH(T1),17] ;[OK] GET DEVICE TYPE
CAXN T1,.DVTTY ;IS THIS A TTY?
JRST GETTTY ;YES, HANDLE UNIQUELY
HLRZ T1,FILJFN(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 ;[N15] [C02] 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 GETEOF ;[C03] NO, GIVE EOF RETURN
JRST .+1] ;[N15] [C03] YES, CONTINUE
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) ; ..
MOVE T1,FILCNT(F) ;[C03] RETURN WITH BYTE COUNT IN T1
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,FILJFN(F) ;GET JFN
BIN% ;[335] GET A BYTE
CAXN T2,.CHCNZ ;CTRL-Z?
JRST [ SKIPN FILCNT(F) ;[C03] WAS ANYTHING READ THIS TIME?
JRST GETEOF ;[C03] NO, GIVE EOF RETURN
BKJFN% ;[C03] YES, BACKUP OVER CTRL-Z
ERJMP E$$BER ;[C03] ERROR
MOVE T1,FILCNT ;[C03] RETURN WITH BYTE COUNT IN T1
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
GETEOF: MOVE EF,PHYEOF ;[C03] GIVE EOF RETURN
RET ;[C03] ..
SUBTTL GETREC -- GETBUF - Input 1 Physical Buffer -- Disk
GETDSK: SKIPG T1,FILEOF(F) ;[C17] ANY BYTES LEFT?
JRST GETEOF ;[C03] NO, GIVE EOF RETURN
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,<
SKIPE COBPDP ;CALLED FROM COBOL?
JRST GETDS1 ;YES
MOVN T2,T1 ;[C17] DECREMENT BLOCK BYTE COUNT
ADDM T2,FILKCT(F) ;[C17] ..
MOVX T2,FI.TMP ;IS THIS A TEMP FILE?
TDNE T2,FILFLG(F) ; IF SO, WORDS=BYTES
JRST GETDS1 ;YES, SKIP THE DIVIDE
IDIV T1,IOBPW2 ;[C03] COMPUTE NO. OF WORDS WE'RE READING
SKIPE T2 ;[C03] COUNT PARTIAL WORDS
ADDI T1,1 ;[C03] ..
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,<FILJFN+FILPGN>/2(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.
PUSH P,P1 ;[C20] SAVE P1, NEED AN EXTRA AC
HRRZ T4,FILBUF(F) ;[C20] [402] BUILD POINTER FOR PAGES
LSH T4,POW2(PGSIZ) ;[402] POINTING TO ADDRESS OF PAGE
HRRZ P1,T3 ;[C20] [402] GET PAGE COUNT
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) ;[OK] [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 ;[C20] [402] ADVANCE POINTER
SOJG P1,$B ;[C20] [402] LOOP UNTIL NO MORE PAGES
ENDB;
POP P,P1 ;[C20] RESTORE P1
RETURN ;[402] DONE
ENDB;
;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,P1 ;[C20] SAVE P1
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
HRRZ P1,T1 ;[C20] COMPUTE # AGES TO THERE
SUBI T4,-1(P1) ;[C20] [402] ..
HRRZ P1,T3 ;[C20] MORE THAN WE ASKED FOR?
CAMGE T4,P1 ;[C20] [402] ..
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] ..
POP P,P1 ;[C20] ..
RETURN ;[402] DONE
ENDB;
;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
ENDB;
> ;[402] END OF IFE FTCOBOL
SUBTTL GETREC -- GETBUF - Input 1 Physical Buffer -- Magtape
IFE FTCOBOL,<
GETMTA: MOVEI T1,INLST ;[C08] LOAD PARAMETER FOR SWTBUF
CALL SWTBUF ;[C08] SWITCH BYTE POINTER AND IOWD BLOCK
SETZM FILCNT(F) ;[C08] ZAP FILCNT
;START I/O ON NEXT BUFFER AND WAIT FOR I/O TO FINISH ON THIS ONE
HLRZ T1,FILJFN(F) ;[C08] GET JFN
MOVX T2,DM%NWT ;[C08] SET "DO NOT WAIT" BIT
HRRI T2,INLST ;ADDR OF COMMAND LIST
DUMPI% ;[335] DO IT
ERCAL [CAXN T1,IOX4 ;[C08] END OF FILE?
JRST [ HLRZ T1,FILJFN(F) ;YES, GET JFN
GDSTS% ;[335] GET CURRENT STATUS
TXZ T2,MT%EOF ;CLEAR EOF FLAG
SDSTS% ;[335] ..
POP P,(P) ;[C03] FIX UP STACK
JRST GETEOF] ;[C03] GIVE EOF RETURN
CAXE T1,IOX5 ;DEVICE OR DATA ERROR?
JRST E$$DME ;NO, BUG SOMEWHERE
HLRZ T1,FILJFN(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 BYTES READ INTO RH(T3)
IDIV T3,FILHBW(F) ;[C03] CONVERT HARDWARE BYTES TO WORDS
SKIPE T4 ;[C03] INCLUDING PARTIAL WORDS
ADDI T3,1 ;[C03] ..
IMUL T3,IOBPW2 ;[C03] CONVERT TO BYTES
MOVEM T3,FILCNT(F) ;SAVE IN FCB
MOVX T2,DM%NWT ;[C08] RESTART I/O
HRRI T2,INLST ;[C08] ..
DUMPI% ;[335] ..
ERJMP E$$DME ;TROUBLE
RET] ;[C03] REJOIN MAIN FLOW
SKIPN T1,FILCNT(F) ;GET BYTES PER (FULL) BUFFER
MOVE T1,FILBPB(F) ;[C03] UNLESS THE HAIRY LITERAL ABOVE
; COMPUTED FILCNT FOR US,
MOVEM T1,FILCNT(F) ;INDICATE BUFFER HAS BEEN FILLED
RETSKP ;GIVE GOOD RETURN
;SWTBUF - SWITCH MAGTAPE BUFFERS
; CALL WITH C(T1) = IOWD BLOCK ADDRESS
SWTBUF: MOVE T4,FILFLG(F) ;[C02] GET FLAGS
TXC T4,FI.BF2 ;[C02] SWITCH FLAG
MOVEM T4,FILFLG(F) ;[C02] ..
HRRZ T2,FILBF2(F) ;[C02] GET ADDRESS FOR IOWD WORD
HRRZ T3,FILBUF(F) ;[C02] GET ADDRESS FOR BYTE POINTER
TXNE T4,FI.BF2 ;[C02] BUFFERS SWAPPED?
EXCH T2,T3 ;[C02] YES, SWITCH ADDRESES
HLRZ T4,FILBUF(F) ;[C02] SET IOWD WORD
MOVN T4,T4 ;[C02] ..
HRL T2,T4 ;[C02] ..
SUBI T2,1 ;[C20] [C02] ..
MOVEM T2,0(T1) ;[OK] [C02] ..
SETZM 1(T1) ;[OK] [C02] TIE OFF END OF IOWD BLOCK
MOVE T4,IOMODE ;[C02] INDUSTRY COMPATIBLE EBCDIC MAGTAPE?
CAXE T4,MODEBCDIC ;[C02] ..
JRST SWTBF1 ;[C02] ..
MOVE T4,FILFLG(F) ;[C02] ..
TXNE T4,FI.IND ;[C02] ..
TXNN T4,FI.MTA ;[C02] ..
JRST SWTBF1 ;[C02] ..
HRLI T3,(POINT 8,) ;[C02] YES, BUILD 8-BIT BYTE POINTER
SKIPA ;[C02]
SWTBF1: ADD T3,CBPTR ;[C02] NO, BUILD DEFAULT BYTE POINTER
MOVEM T3,FILPTR(F) ;[C02] STORE BYTE POINTER
RET ;[C02]
>;END IFE FTCOBOL
SUBTTL PUTREC -- PUTBUF - Output 1 Physical Buffer -- Set Up
;CALL: JSP T4,PUTBUF
;RETURNS: +1/ ALWAYS, T1 CONTAINS NO. OF BYTES IN BUFFER
PUTBUF: PUSH P,T4 ;PUSH RETURN ADDR ON STACK
MOVE T1,FILCNT(F) ;[C03] EMPTY BUFFER?
CAML T1,FILBPB(F) ;[C03] ..
RET ;[C03] YES, RETURN WITH BYTE COUNT IN T1
IFE FTCOBOL,< ;FALL THROUGH TO PUTDSK IN COBOL SORT
SKIPE COBPDP ;CALLED FROM COBOL?
JRST PUTDSK ;YES
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,FILJFN(F) ;JFN
HRRO T2,FILBUF(F) ;STRING PTR TO BUFFER
MOVE T3,FILCNT(F) ;[444] BYTES NOT WRITTEN
SUB T3,FILBPB(F) ;[444] MINUS BYTES PER BUFFER
;[444] EQUALS NEGATIVE BYTES WRITTEN THIS TIME
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) ; ..
MOVE T1,FILCNT(F) ;[C03] RETURN WITH BYE COUNT IN T1
RET ;RETURN
>;END IFE FTCOBOL
SUBTTL PUTREC -- PUTBUF - Output 1 Physical Buffer -- Disk
PUTDSK: HRLZI T1,.FHSLF ;[C17] 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
MOVEM T3,PGSATM ;[464] SAVE # OF PAGES TO PMAP%
IORX T3,PM%CNT!PM%RWX ;ALLOW ALL TYPES OF ACCESS TO FILE PG.
PMAP% ;[335] MOVE THEM OUT TO THE FILE
ERCAL BADMAP ;[457] GO TO BADMAP IF PMAP% FAILURE.
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
SKIPLE T1 ;[465] IF THE # OF UNUSED BYTES IS 0 OR -1,
;[465] T2 ALREADY = # OF BYTES WRITTEN.
SUB T2,T1 ;COMPUTE BYTES WRITTEN THIS TIME
ADDM T2,FILEOF(F) ;UPDATE TOTAL NO. OF BYTES WRITTEN
IFE FTCOBOL,<
MOVE T4,FILFLG(F) ;[C20] A TEMP FILE?
TXNE T4,FI.TMP ;[C20] ..
>
ADDM T2,TMPTOT ;[C20] YES, UPDATE TOTAL PAGES USED
IFE FTCOBOL,<
MOVN T1,T2 ;[C17] DECREMENT BLOCK BYTE COUNT
SKIPN COBPDP ;SKIP IF CALLED FROM COBOL
ADDM T1,FILKCT(F) ;[C17] ..
>
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
IFE FTCOBOL,<
TXNN T4,FI.TMP ;[371] IS IT A TEMP FILE?
SKIPG SEQNO ;[371] OR OUTPUT NOT SEQUENCED
JRST PUTDS1 ;[C03] [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
ADD T3,T2 ;[C20] [371] END+1
SETZM (T2) ;[C20] CLEAR FIRST WORD
HRL T2,T2 ;[371] FORM BLT POINTER
ADDI T2,1 ;[371] EVENTUALLY
BLT T2,-1(T3) ;[OK] [371] AND THE REST
PUTDS1: ;[C03]
>;END IFE FTCOBOL
MOVE T1,FILCNT(F) ;[C03] RETURN WITH BYTE COUNT IN T1
RET ;RETURN
SUBTTL BADMAP -- HANDLE PMAP% FAILURE IF DISK FULL OR QUOTA EXCEEDED
;BADMAP is called, using ERCAL, after a PMAP% failure. This routine
;was written for case two of PMAP%(i.e. Mapping Process Pages to a
;File), but should work equally well for any of the first three cases
;of PMAP%ing(i.e. Mapping not unmapping or deleting). See the Monitor
;Calls Reference Manual.
;An appropriate error message is typed to the tty. If the failure was
;due to the disk being full or exceeding the users quota, then SORT
;may be continued after more disk space is made available.
;The AC's are saved since they have not been altered from their
;initial state so that upon returning, the calling routine will not
;be aware of the occurrence of the error. The first three AC's are
;also moved into the following memory locations for use in this error
;routine.
; SOURCE ------ Process handle ,, Page number
;
; DEST ------ JFN ,, Page number
;
; ACCESS ------ Access bits ,, Repetition count
;
;This routine checks the pages that were attempted to be PMAP%ed by
;using the RPACS% JSYS. Upon encountering a non-existent page, the
;AC's are reset to reflect the number of pages and the page numbers
;that did not get mapped and attempts to map them. If successful,
;then the old AC values are poped and control is returned to the
;caller. If not successful, then control is passed to BADMP2 and
;a loop is performed as many times as the user desires and is
;necessary.
BADMAP: PUSH P,T3 ;[457] SAVE SOME REGISTERS.
PUSH P,T4 ;[464]
BADMP2: DMOVEM T1,SOURCE ;[464] SAVE THE ARG'S FOR THE LATEST PMAP%
MOVEM T3,ACCESS ;[464] SAVE THE ACCESS BITS AND REPETITION COUNT
SKIPLE ERRADR ;WAS AN ERROR ROUTINE SPECIFIED?
PUSHJ P,PMPERR ;YES, LET HIM SEE ERROR
MOVEI T1,.FHSLF ;[457] GET PROCESS HANDLE FOR SELF
GETER% ;[457] GET LAST ERROR OF PROCESS.
HRRZ T1,T2 ;[457] GET ERROR NUMBER
CAIE T1,PMAPX6 ;[457] WAS THIS THE LAST ERROR?
CAIN T1,IOX11 ;[457] OR THIS?
JRST VLDERR ;[457] YES!
HRROI T1,CRLF ;START MESSAGE ON NEW LINE
PSOUT% ; INCASE BATCH
MOVEI T1,"?" ;PREFIX MESSAGE WITH ?
PBOUT%
MOVEI T1,.PRIOU ;[457] GET READY FOR ERSTR CALL.
SETZ T3, ;[502]
ERSTR% ;[457] PUT OUT THE ERROR MESSAGE.
HALTF% ;[457] SHOULD NOT GET HERE!
JRST .-1 ;[457] OR HERE!
HALTF% ;[457] DIE!
JRST .-1 ;[457] DO NOT ALLOW TO CONTINUE.
VLDERR: $ERROR (?,QEF,<Quota exceeded or disk full while writing:
>,+) ;[505]
HLRZ T2,DEST ;[505] GET JFN OF FILE THAT FAILS
$MORE (FILESPEC,T2) ;[505] TYPE IT
$MORE (TEXT,<
You may CONTINUE when additional space is available.
>) ;[505] FINISH MESSAGE
HALTF% ;[457] WAIT FOR USER TO FIND MORE SPACE.
;[457] SORT WILL RESUME AT THIS
;[457] POINT AFTER BEING CONTINUED.
SETZ T3, ;[464] INITIALIZE THE PAGE ADDER.
MOVE T1,DEST ;[464] GET DESTINATION OF THE ATTEMPTED PMAP%
MOVE T4,PGSATM ;[464] GET THE # OF PAGES ATTEMPTED TO PMAP%
CHKPAG: HRRZ T2,DEST ;[464] GET # OF FIRST PAGE ATTEMPTED TO PMAP%
ADD T2,T3 ;[464] CALCULATE THE PAGE TO SEARCH FOR.
HRR T1,T2 ;[464] INSERT PAGE # TO SEARCH FOR.
RPACS% ;[464] GET ACCESSIBILITY OF THIS PAGE.
TXNN T2,PA%PEX ;[464] DOES THIS PAGE EXIST?
JRST NOPAGE ;[464] NO!
AOS T3 ;[464] YES, INCREMENT THE PAGE ADDER.
SOJG T4,CHKPAG ;[464] CHECK THE NEXT PAGE.
JRST FIN ;[464] IF YOU GET HERE, SOMETHING IS FLAKY!
NOPAGE: DMOVE T1,SOURCE ;[464] GET THE SOURCE AND DESTINATION FOR THE PMAP%
ADD T1,T3 ;[464] PAGE # OF SOURCE TO START MAPPING FROM.
ADD T2,T3 ;[464] PAGE # OF DEST TO START MAPPING INTO.
MOVE T4,PGSATM ;[464] GET # OF PAGES ATTEMPTED TO PMAP%
SUB T4,T3 ;[464] GET # OF PAGES THAT DIDN'T MAKE IT.
MOVE T3,ACCESS ;[464] GET ACCESS BITS AND REPETITION COUNT.
HRR T3,T4 ;[464] UPDATE # OF PAGES TO PMAP%
PMAP% ;[464] TRY TO MAP THE REMAINDER OF THE PAGES!
ERJMP BADMP2 ;[464] DIDN'T GET 'EM ALL, KEEP TRYING!
FIN: POP P,T4 ;[464] RESTORE ORIGINAL DATA FOR RETURN.
POP P,T3 ;[457] RESTORE ACCUMULATORS.
RET ;[464] [457] RETURN TO CALLING ROUTINE.
CRLF: ASCIZ /
/
PMPERR: SKIPE FORRET ; WERE WE CALLED FROM FORTRAN?
POPJ P, ; YES, DO IT THE OLD WAY THEN
$ERROR (?,PMP,<PMAP failed for >,+)
HLRZ T2,DEST ; GET JFN OF FILE THAT FAILS
$MORE (FILESPEC,T2) ; TYPE IT
JRST LASTER ; AND GET LAST ERROR MESSAGE
;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: MOVE T3,FILBPB(F) ;[C06] GET BYTES PER (FULL) BUFFER
SUB T3,T4 ;SUBTRACT # OF UNWRITTEN BYTES
IFE FTCOBOL,<
SKIPE COBPDP ;CALLED FROM COBOL?
JRST [IDIVI T3,PGSIZ ;[366] T3 = WHOLE PAGES, T4 = REMAINING WORDS
JRST FIXUP1]
IF THIS IS NOT A TEMP 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
THEN FIND BYTES PER WORD
SKIPA T4,IOBPW2 ;[C03] [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
FIXUP1:>
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: PUSH P,FILPTR(F) ;[C03] SAVE OLD BYTE POINTER
MOVEI T1,OUTLST ;[C02] LOAD PARAMETER FOR SWTBUF
CALL SWTBUF ;[C02] SWITCH BYTE POINTER AND IOWD BLOCK
POP P,T1 ;[C03] RESTORE BYTE POINTER
MOVE T2,FILBPB(F) ;[C02] GET BUFFER LENGTH IN BYTES
SUB T2,FILCNT(F) ;[C02] SUBTRACT NO. OF BYTES WE DIDN'T WRITE
IDIV T2,IOBPW2 ;[C03] CONVERT TO WORDS
JUMPE T3,PUTMT2 ;[C03] ROUND UP TO A WHOLE WORD
ADDI T2,1 ; ..
SUB T3,IOBPW2 ;[C03] CLEAR REST OF WORD
SETZ T4, ;[C03] ..
IDPB T4,T1 ;[C03] ..
AOJL T3,.-1 ;[C03] ..
PUTMT2: MOVN T2,T2 ;[C03] [C02] NEGATE WORD COUNT
HRLM T2,OUTLST ;[C02] CORRECT IOWD WORD
HLRZ T1,FILJFN(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,FILJFN(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 T2,FI.EOT ;[C08] SET EOT BIT IN FILFLG
IORM T2,FILFLG(F) ;[C08] ..
MOVX T2,DM%NWT ;[C08] RESTART I/O
HRRI T2,OUTLST ;[C08] ..
DUMPO% ;[C08] ..
ERJMP E$$DME ;[C08] ERROR
RET] ;REJOIN MAIN FLOW
MOVX T1,FI.EOT ;[C08] AT EOT?
TDNE T1,FILFLG(F) ;[C08] ..
CALL [HLRZ T1,FILJFN(F) ;[C08] YES, GET JFN
MOVX T2,.MONOP ;[C08] GET MTOPR% FUNCTION FOR WAITING
MTOPR% ;[C08] WAIT FOR I/O TO COMPLETE
SKIPA ;[C08] SHOULD ALWAYS FAIL, STILL EOT
JRST E$$DME ;[C08] NO, BUG SOMEWHERE
MOVEI T1,.FHSLF ;[C08] GET ERROR CODE
GETER% ;[C08] ..
HRRZ T1,T2 ;[C08] ..
CAXE T1,IOX5 ;[C08] DEVICE OR DATA ERROR?
JRST E$$DME ;[C08] NO, BUG
HLRZ T1,FILJFN(F) ;[C08] GET JFN
GDSTS% ;[C08] GET TAPE STATUS BITS
TXZN T2,MT%EOT ;[C08] END OF TAPE?
JRST E$$DME ;[C08] NO, COMPLAIN
SDSTS% ;[C08] YES, CLEAR THE BIT
RET] ;[C08] REJOIN MAIN FLOW
MOVE T1,FILBPB(F) ;GET BYTES PER BUFFER
MOVEM T1,FILCNT(F) ;INDICATE BUFFER BEGGING TO BE FILLED
SKIPG SEQNO ;[371] OUTPUT NOT SEQUENCED
JRST PUTMT3 ;[C03] [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
ADD T3,T2 ;[C20] [371] END+1
SETZM (T2) ;[C20] CLEAR FIRST WORD
HRL T2,T2 ;[371] FORM BLT POINTER
ADDI T2,1 ;[371] EVENTUALLY
BLT T2,-1(T3) ;[OK] [371] AND THE REST
PUTMT3: MOVE T1,FILCNT(F) ;[C03] RETURN WITH BYTE COUNT IN T1
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
CAMGE T1,P1 ;[C20] IS MAX .LT. MIN?
JRST E$$NEC ;YES, DIE
MOVE P2,T1 ;COPY MAXIMUM BUFFER SPACE USEABLE
IFE FTCOBOL,<
SKIPN COBPDP ;SKIP IF CALLED FROM COBOL
CALL USRBUF ;DID USER SPECIFY A BUFFER AREA SIZE?
JRST CHKCR1 ;NO, USE DEFAULT
CAMGE T1,P1 ;[C20] IS USER'S SIZE .GE. MINIMUM?
JRST [ $ERROR (%,NBS,<Not enough buffer space specified>)
MOVE T1,P1 ;[C20] USE MINIMUM INSTEAD
JRST CHKTRE] ;AND RETURN
CAML T1,P2 ;[C20] IS USER'S SIZE .LT. MAXIMUM?
JRST [ $ERROR (%,TMS,<Too much buffer space specified>)
MOVE T1,P2 ;[C20] 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
CAMGE T1,P1 ;[C20] RANGE CHECK
MOVE T1,P1 ;[C20] AGAINST MINIMUM
CAML T1,P2 ;[C20] AND MAXIMUM
MOVE T1,P2 ;[C09] ..
;HERE WITH C(T1) = SIZE OF I/O BUFFER AREA TO ALLOCATE
CHKTRE: ADDI T1,PGSIZ ;[C13] IN CASE NOT ON A PAGE BOUNDARY
MOVEM T1,BUFSZ ;[C13] SAVE SIZE OF BUFFER AREA
SKIPLE MRGSW ;MERGE COMMAND?
JRST CHKRT1 ;YES, SETTMP COMPUTED NUMRCB FOR US
CALL MINTRE ;COMPUTE MINIMUM SIZE OF TREE
MOVE P1,T1 ;[C20] SAVE
CALL MAXTRE ;COMPUTE MAXIMUM SIZE OF TREE
CAMGE T1,P1 ;[C20] INSURE .GE. MINIMUM
JRST E$$NEC ;OOPS
MOVE P2,T1 ;[C20] SAVE FOR MORE TESTS
IFE FTCOBOL,<
SKIPN COBPDP ;SKIP IF CALLED FROM COBOL
CALL USRTRE ;DID USER SPECIFY A TREE SIZE?
JRST CHKCR2 ;NO, USE DEFAULT
CAMGE T1,P1 ;[C20] IS USER .GE. MINIMUM?
JRST [ $ERROR (%,NLS,<Not enough leaves specified>)
MOVE T1,P1 ;[C20] USE MINIMUM
JRST CHKRET] ;AND FINISH UP
CAMLE T1,P2 ;[C20] IS USER .LE. MAXIMUM?
JRST [ $ERROR (%,TML,<Too many leaves specified>)
MOVE T1,P2 ;[C20] 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
CAMGE T1,P1 ;[C20] RANGE CHECK
MOVE T1,P1 ;[C20] ..
CAMLE T1,P2 ;[C20] ..
MOVE T1,P2 ;[C20] ..
;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
RET ;[C13]
;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/OUTPUT PG AND 1 TMP PG
MOVEI T1,PGSIZ ;FOR TEMP FILE INPUT
SKIPE COBPDP ;CALLED FROM COBOL?
RET ;YES, ONLY NEED 1 PAGE
MOVE T2,MXDVSZ ;[C05] PLUS BIGGEST INPUT DEVICE BUFFER
CAMGE T2,OBUFSZ ;[C05] OR BIGGEST OUTPUT DEVICE BUFFER
MOVE T2,OBUFSZ ;[C05] ..
ADD T1,T2 ;[C05] ..
JRST RNDRET ;ROUND UP TO A PAGE AND RETURN
>
MINBF1:
IFN FTCOBOL,< ;FOR COBOL MERGE, JUST 1 TMP BUFFER
MOVEI T1,PGSIZ ; ..
RET
>
IFE FTCOBOL,< ;FOR REGULAR, NEED TMP PLUS INPUT/OUTPUT
MOVEI T1,PGSIZ
SKIPE COBPDP ;CALLED FROM COBOL?
RET ;YES, JUST 1 TMP BUFFER
HRRZ T1,ACTTMP ;NUMBER OF ACTIVE TEMP FILES
IMUL T1,MXDVSZ ;TIMES LARGEST BUFFER (JUST IN CASE)
MOVE T2,MXDVSZ ;[C05] PLUS BIGGEST INPUT DEVICE BUFFER
CAMGE T2,OBUFSZ ;[C05] OR BIGGEST OUTPUT DEVICE BUFFER
MOVE T2,OBUFSZ ;[C05] ..
ADD T1,T2 ;[C05] ..
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,
SKIPE COBPDP ;CALLED FROM COBOL?
RET ;YES
MOVE T2,MXDVSZ ;GET LARGEST INPUT BUFFER REQUIRED
LSH T2,POW2(4) ;4 TIMES LARGEST BUFFER
CAMGE T2,OBUFSZ ;[C05] BUT MUST BE GREATER THAN OUTPUT BUFFER
MOVE T2,OBUFSZ ;[C05] ..
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
MOVEI T1,PGSIZ*^D32 ;JUST ALLOW A LARGE OUTPUT (TMP) BUFFER
SKIPE COBPDP ;CALLED FROM COBOL?
RET ;YES
HRRZ T1,ACTTMP ;GET NUMBER OF INPUT FILES
IMUL T1,MXDVSZ ;TIMES BIGGEST KNOWN BUFFER
LSH T1,POW2(20) ;ALLOW VERY LARGE BUFFER
ADD T1,OBUFSZ ;[C05] PLUS ONE FOR OUTPUT
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
IMUL T1,T2 ;[C20] 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,<
SKIPE COBPDP ;CALLED FROM COBOL?
JRST RNDRET ;YES
MOVE T2,MXDVSZ ;[C05] PLUS BIGGEST INPUT DEVICE BUFFER
CAMGE T2,OBUFSZ ;[C05] OR BIGGEST OUTPUT DEVICE BUFFER
MOVE T2,OBUFSZ ;[C05] ..
ADD T1,T2 ;[C05] ..
>
JRST RNDRET ;ROUND UP AND RETURN
DEFBF1: MOVE T1,ACTTMP ;GET NO. OF INPUT FILES
LSH T1,POW2(PGSIZ*2) ;ALLOW 2 PGS FOR INPUT
IFE FTCOBOL,< ;[C05] IF NOT COBOL MERGE, ADD
SKIPN COBPDP ;SKIP IF CALLED FROM COBOL
ADD T1,OBUFSZ ;[C05] ROOM FOR OUTPUT FILE BUFFER
>
; 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: MOVE T1,FRECOR ;[C13] GET FREE CORE
SUB T1,BUFSZ ;[C13] MINUS BUFFER POOL SPACE
SUBI T1,1000 ;[C13] MINUS ODD BUFFERS (I.E. LABELS ETC.)
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
CALL FRESPC ;DROP IT LIKE A HOT POTATO
MOVE T1,RCBSZ ;[C13] GET SIZE OF RECORD POOL
CALL FRESPC ;[C13] DEALLOCATE IT
MOVE T1,TRESZ ;[C13] GET SIZE OF TREE AREA
CALL FRESPC ;[C13] DEALLOCATE IT
MOVEI T1,RN.LEN ;[313] SIZE OF A TREE NODE
IMUL T1,NUMRCB ;[313] TIMES NUMBER OF RECORDS
MOVEM T1,TRESZ ;[C13] SAVE SIZE OF TREE
CALL GETSPC ;ALLOCATE SPACE FOR TREE
JRST E$$RBP ;CONFUSION
MOVEM T1,TREORG ;[313] TREE ORIGIN
MOVE T1,REKSIZ ;[C13] GET SIZE OF RECORD
IMUL T1,NUMRCB ;[C13] TIMES NUMBER OF RECORDS
MOVEM T1,RCBSZ ;[C13] SAVE SIZE OF RECORD POOL
CALL GETSPC ;[C13] ALLOCATE SPACE FOR RECORD POOL
JRST E$$RBP ;[C13] FAILED
MOVEM T1,RCBORG ;[C13] RECORD POOL ORIGIN
SETZM (T1) ;[507] CLEAR THE AREA
HRLS T1 ;[507] INCASE ANY
AOS T1 ;[507] BIT 35'S
HLRZ T2,T1 ;[507] ARE ON
ADD T2,RCBSZ ;[507] DUE TO A
BLT T1,-1(T2) ;[507] PREVIOUS SORT.
HRRZ T1,ACTTMP ;GET NUMBER OF TEMP FILES
LSH T1,POW2(PGSIZ) ;TIMES SIZE OF ONE BUFFER (1 PAGE)
;IFN FTCOBOL,< ;IF COBOL SORT,
SETZ T2, ;[C13] ASSUME NO OUTPUT BUFFER
SKIPE NUMLFT ;IF WE NEED TO DO A MERGE PASS
MOVEI T2,OUTSIZ ;[C13] GET DESIRABLE SIZE FOR OUTPUT BUFFER
SKIPE COBPDP ;CALLED FROM COBOL?
MOVEM T2,OBUFSZ ;[C13] YES, SAVE IT
;>
ADD T1,OBUFSZ ;[C13] ADD SIZE OF OUTPUT BUFFER
IMULI T1,PPTBUF*2 ;DOUBLE BUFFERING WOULD BE NICE
ADDI T1,PGSIZ ;[C13] IN CASE NOT ON A PAGE BOUNDARY
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 [SUBI P1,PGSIZ ;[C13] CAN'T GET IT, TRY FOR A SINGLE BUFFER
LSH P1,-<POW2(2)> ;[C13] ..
ADDI P1,PGSIZ ;[C13] ..
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,BUFORG ;[C13] SAVE START OF BUFFER POOL
MOVEM T1,BUFPTR ;REMEMBER WHERE BUFFER POOL STARTS
MOVEM P1,BUFSZ ;REMEMBER SIZE OF BUFFER POOL
TRZE T1,PGMSK ;[C13] CALCULATE USEFUL BUFFER SPACE
ADDI T1,PGSIZ ;[C13] ..
SUB T1,BUFORG ;[C13] ..
SUB P1,T1 ;[C13] ..
MOVEM P1,UBUFSZ ;[C13] SAVE IT
POP P,P1 ;RESTORE P1
POP P,T1 ;RESTORE UNIT BUFFER-POOL SIZE
IDIVI T1,PPTBUF*2 ;RECOVER UNIT BUFFER SIZE
SUB T1,OBUFSZ ;[C13] 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,UBUFSZ ;[C13] GET USEFUL SIZE OF BUFFER POOL
SUB T2,OBUFSZ ;[C13] RESERVE SPACE FOR OUTPUT BUFFER
SKIPN P2 ;IF DOUBLE BUFFERED,
SUB T2,OBUFSZ ;[C13] RESERVE SPACE FOR 2 OUTPUT BUFFERS
IDIV T2,T1 ;[C20] 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,UBUFSZ ;[C13] GET USEFUL 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
SKIPN COBPDP ;SKIP IF CALLED FROM COBOL
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
CAIGE T1,2 ;NEED AT LEAST 2 BUFFERS
JRST E$$NRO ;NO ROOM
MOVEM T1,OBUFNO ;SAVE NUMBER OF BUFFERS
POP P,P2 ;RESTORE P2
RET ;AND RETURN
;FMTBFP -- SETUP MEMORY POOLS
BEGIN
PROCEDURE (PUSHJ P,FMTBFP)
$1% MOVE T1,NUMRCB ;GET NO. OF RECORDS IN TREE
IMULI T1,RN.LEN ;COMPUTE SIZE OF TREE
MOVEM T1,TRESZ ;[C13] SAVE TREE SIZE
CALL GETSPC ;[C13] ALLOCATE SPACE FOR TREE
JRST $2 ;[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 [MOVE T1,TRESZ ;[C13] FAILED, DEALLOCATE TREE SPACE
CALL FRESPC ;[C13] ..
JRST $2] ;[C13]
MOVEM T1,RCBORG ;[C13] SAVE ADDR OF START OF RECORD POOL
SETZM (T1) ;[507] CLEAR THE AREA
HRLS T1 ;[507] INCASE ANY
AOS T1 ;[507] BIT 35'S
HLRZ T2,T1 ;[507] ARE ON
ADD T2,RCBSZ ;[507] DUE TO A
BLT T1,-1(T2) ;[507] PREVIOUS SORT.
JRST $3 ;[C13]
$2%
;IFN FTCOBOL,<
SKIPN COBPDP ;SKIP IF CALLED FROM COBOL
JRST E$$NEC ;IF STANDALONE, NO SECOND CHANCES
MOVE T1,NUMRCB ;[C20] NOT ENOUGH SPACE, 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 ;[C13] GO TRY AGAIN
;>
;IFE FTCOBOL,<
; JRST E$$NEC ;IF STANDALONE, NO SECOND CHANCES
;>
$3% MOVE T1,BUFSZ ;[C13] ALLOCATE SEPARATE AREA FOR BUFFER POOL
CALL GETSPC ; ..
JRST E$$NEC
MOVEM T1,BUFPTR ;REMEMBER WHERE IT STARTS
MOVEM T1,BUFORG ;[C13] SAVE START OF BUFFER POOL
MOVE T2,BUFSZ ;[C13] CALCULATE USEFUL BUFFER SPACE
TRZE T1,PGMSK ;[C13] ..
ADDI T1,PGSIZ ;[C13] ..
SUB T1,BUFORG ;[C13] ..
SUB T2,T1 ;[C13] ..
MOVEM T2,UBUFSZ ;[C13] SAVE IT
RETURN ;[C13]
ENDB;
;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,BUFORG ;[C13] GET START OF BUFFER AREA
ADD T3,BUFSZ ;[C13] CALCULATE END 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) ;[OK] [371] ...
POP P,T3 ;[371] GET SIZE BACK
ADD T3,T1 ;[C20] [371] END+1
SETZM (T1) ;[OK] [371] ZERO FIRST WORD
BLT T2,-1(T3) ;[OK] [371] CLEAR ALL OF DATA
RET ;[371]
SUBTTL COLLATING SEQUENCE ROUTINES
IFE FTCOBOL,<
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
MOVE T1,[IFIW COLBUF] ;[C20] 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
ENDB;
BEGIN
PROCEDURE (PUSHJ P,COLCHR)
SOSGE COLPTR+1 ;REDUCE THE BYTE COUNT
JRST $1 ;GET A BUFFER
ILDB T1,COLPTR ;GET A BYTE
TXNN P1,COL.QU ;[467] ARE WE IN A QUOTE?
CAILE T1," " ;[467] NO, IGNORE SPACE AND ALL CONTROL CHARACTERS
CAIGE T1," " ;[467] YES, IGNORE 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
ENDB;
SUBTTL GET RMS ROUTINE
BEGIN
PROCEDURE (PUSHJ P,GETRMS)
IF WE ARE RUNNING ON AN EXTENDED MACHINE
XMOVEI T1,. ;SEE IF WE ARE IN SECTION 0
TLNN T1,-1
JRST $T ;YES, NOT AN EXTENDED MACHINE (I.E. 2020)
THEN GET XRMS.EXE INTO A NON-ZERO SECTION
MOVE T1,[.XSEVD,,.FHSLF] ;SEE IF RMS IS ALREADY THERE
XGSEV%
ERJMP [HALT] ;FAILED TRY OLD METHOD
JUMPN T2,CPOPJ ;RETURN, RMS ALREADY LOADED
MOVEI T1,.FHSLF
XGVEC% ;SAVE THE CURRENT ENTRY VECTOR
DMOVEM T2,.NMUL ;IN A SAFE PLACE
;LOOP THROUGH THE SECTIONS STARTING AT SECTION 1 LOOKING FOR A FREE ONE FOR SORT
SETZ T4, ;NOW FIND A FREE SECTION FOR SORT
$1% AOS T1,T4 ;TRY NEXT ONE
CAILE T1,37 ;MAKE SURE SOME STILL LEFT
JRST E$$FSE ;NO FREE SECTIONS
HRLI T1,.FHSLF ;
RSMAP% ;
ERJMP E$$SNA ;ERROR
AOJN T1,$1 ;THIS ONE NOT FREE
MOVEM T4,RMSSEC ;SAVE SECTION # FOR GET
SETZ T1, ;DEFINE A MEMORY SECTION
HRLI T2,.FHSLF
HRR T2,RMSSEC
MOVX T3,SM%RWX+1
SMAP%
ERJMP E$$SNA ;FAILED, OTHER SECTIONS NOT AVAILABLE
XMOVEI T1,770000 ;SEE IF THIS SECTION CONTAINS DDT
LSH T1,-9 ;GET PAGE NUMBER
HRLI T1,.FHSLF
RPACS% ;IS PAGE ACCESSIBLE?
AND T2,[PA%RD!PA%EX!PA%PEX]
CAME T2,[PA%RD!PA%EX!PA%PEX]
JRST $2 ;NO DDT
MOVE T1,770000 ;DOES IT CONTAIN DDT?
CAME T1,[JRST 770002]
JRST $2 ;NO
XMOVEI T1,DDTPG.*1000 ;GET LOWEST DDT ADDRESS IN CURRENT SECTION
LSH T1,-9
HRLI T1,.FHSLF ;SOURCE
MOVE T2,RMSSEC ;GET DESTINATION SECTION #
LSH T2,9
ADD T2,[.FHSLF,,DDTPG.] ;DESTINATION
MOVX T3,PM%CNT!PM%RWX+<1000-DDTPG.> ;ACCESS INFO THIS WILL BE
; THE AND OF RMS AND CURRENT SECTION
PMAP% ;MAP THE PAGES TOGETHER
ERJMP E$$CM2 ;ERROR
;NOW GET XRMS INTO THE NON-ZERO SECTION
; TEST FOR EXECUTE-ONLY AND IF SO ENFORCE PHYSICAL-ONLY
$2% MOVEI T1,.RFSFL+1 ;LENGTH OF ARG BLOCK
MOVEM T1,RFSBLK+.RFCNT
MOVE T1,[RF%LNG+.FHSLF] ;LONG FORM
MOVEI T2,RFSBLK ;ARG BLOCK
RFSTS% ;GET STATUS
ERJMP $3 ;ASSUME NOT EXECUTE-ONLY
IFGE RF%EXO,<PRINTX ?ERROR - RF%EXO is not the sign bit> ;INCASE IT CHANGES
SKIPGE RFSBLK+.RFSFL ;RF%EXO IS SIGN BIT
SKIPA T1,[GJ%OLD!GJ%SHT!GJ%PHY] ;PHYSICAL ONLY IF EXECUTE-ONLY
$3% MOVX T1,GJ%OLD!GJ%SHT ;GET A JFN FOR XRMS.EXE
HRROI T2,[ASCIZ /SYS:XRMS.EXE/]
GTJFN%
ERJMP ERRRJF ;COMPLAIN IF WE CAN'T FIND RMS
HRRZM T1,RMSJFN ;PUT JFN IN A SAFE PLACE
HRLZI T1,.FHSLF ;DO A GET% ON XRMS.EXE
HRR T1,RMSJFN ;GET JFN
TXO T1,GT%PRL!GT%ARG!GT%NOV ;PRE-LOAD ALL OF FILE
MOVX T2,GT%LOW!GT%BAS ;ADDRESS LIMITS PLUS RMS SECTION BASE
MOVEM T2,GETARG+.GFLAG ; ...
XMOVEI T2,GETARG ;POINT TO ARG BLOCK
GET%
ERJMP E$$XGF ;FAILED
MOVEI T1,.FHSLF
XGVEC% ;GET THE RMS ENTRY VECTOR
HRLI T1,.XSEVD ;SET RMS CODE TYPE
TXO T3,XS%EEV ;SET EXTENDED ENTRY VECTOR FLAG
XSSEV% ;TELL MONITOR WHERE RMS IS
MOVEI T1,.FHSLF ;RESTORE THE ORIGINAL ENTRY VECTOR
DMOVE T2,.NMUL
XSVEC%
JRST $F
ELSE GET RMS.EXE INTO SECTION 0 WITH SORT
MOVEI T1,.FHSLF
GDVEC% ;PRE-REL 5 DAYS
ERJMP .+2 ;NOT HERE
JUMPN T2,CPOPJ ;RETURN, RMS ALREADY LOADED
MOVEI T1,.FHSLF
GEVEC% ;SAVE THE CURRENT ENTRY VECTOR
MOVEM T2,.NMUL ;IN A SAFE PLACE
MOVX T1,GJ%OLD!GJ%SHT
HRROI T2,[ASCIZ /SYS:RMSCOB.EXE/] ;TEMP UNTIL NEW RMS AVAILABLE
GTJFN%
ERJMP ERRRJF ;NO RMS
HRLI T1,.FHSLF ;INTO SAME FORK
TXO T1,GT%NOV ;DON'T OVERLAY EXISTING PAGES
GET%
ERJMP E$$RGF ;FAILED
MOVEI T1,.FHSLF
GEVEC% ;GET THE RMS ENTRY VECTOR
SDVEC% ;TELL MONITOR WHERE RMS IS
MOVEI T1,.FHSLF ;RESTORE THE ORIGINAL ENTRY VECTOR
MOVE T2,.NMUL
SEVEC%
FI;
$MESSAGE (0) ;INITIALIZE RMS'S GLOBAL DATA
RET
ENDB;
SUBTTL RMS -- Initialize Next RMS Input File
;Note, when we were called from INIINP P1 was pushed on the stack.
RMSIN: MOVE T1,[PRFAB,,INFAB] ;COPY PROTOTYPE FAB, RAB, AND XAB
BLT T1,INFAB+FABLEN+RABLEN+XABLEN-1
MOVEI P1,INFAB
HRRZ T1,P1
HRLI T1,FABLEN(P1) ;ADDRESS OF RAB
MOVEM T1,FILFAB(F) ;POINT TO FAB AND RAB
MOVX T1,FB$NIL ;FAST READ ONLY MODE
$STORE (T1,FAC,(P1))
HLRZ T1,FILJFN(F) ;GET JFN FOR THIS FILE
$STORE (T1,JFN,(P1)) ;PUT JFN IN FAB
$OPEN <(P1)>,E$$ROF ;OPEN THE FILE
MOVE T1,P1 ;COPY OF FAB ADDRESS
MOVEI P1,INRAB ;POINT TO RAB
$STORE (T1,FAB,(P1)) ;STORE FAB IN RAB
MOVX T1,RB$PAD!RB$RAH ;PAD WITH NULLS AND READ AHEAD
$STORE (T1,ROP,(P1))
; $STORE (T1,UBF,(P1)) ;POINT TO USER BUFFER ADDRESS
MOVE T1,RECSIZ ;SIZE OF RECORD IN WORDS
$STORE (T1,USZ,(P1))
$CONNECT <(P1)>,E$$RCF
POP P,P1
RET
E$$ROF: $ERROR (?,ROF,<RMS $OPEN failed for file >,+)
HLRZ T2,FILJFN(F)
$MORE (FILESPEC,T2)
JRST LASTER
E$$RCF: $ERROR (?,RCF,<RMS $CONNECT failed for file >,+)
HLRZ T2,FILJFN(F)
$MORE (FILESPEC,T2)
JRST LASTER
SUBTTL RMS -- Initialize Next RMS Output File
;Note, when we were called from INIOUT P1 was pushed on the stack.
RMSOUT: MOVE T1,[PRFAB,,OUTFAB] ;COPY PROTOTYPE FAB, RAB, AND XAB
BLT T1,OUTFAB+FABLEN+RABLEN+XABLEN-1
MOVEI P1,OUTFAB
HRRZ T1,P1
HRLI T1,FABLEN(P1) ;ADDRESS OF RAB
MOVEM T1,FILFAB(F) ;POINT TO FAB AND RAB
MOVE T1,MODE ;GET MODE INDEX
MOVE T1,[EXP 6,7,9,^D36]-1(T1)
$STORE (T1,BSZ,(P1)) ;SET BYTE SIZE
MOVEI T2,OUTXAB
$STORE (T1,DTP,(T2)) ;ALSO IN XAB IN CASE KEYED
MOVX T1,FB$PUT ;ALLOW WRITE TO FILE
$STORE (T1,FAC,(P1))
HLRZ T1,FILJFN(F) ;GET JFN FOR THIS FILE
$STORE (T1,JFN,(P1)) ;PUT JFN IN FAB
MOVE T1,RECORD
$STORE (T1,MRS,(P1)) ;RECORD SIZE
MOVE T1,FILXBK(F) ;GET THE X. BLOCK
HRRE T2,X.ORG(T1) ;GET ORGANIZATION INDEX
SKIPGE T2
SETZ T2, ;CONVERT -1 TO 0 FOR DEFAULT
MOVEM T2,OUTORG ;SAVE IN CASE ASCII STREAM OR LSA
MOVE T1,[EXP FB$SEQ,FB$IDX,FB$REL,FB$SEQ,FB$SEQ,FB$SEQ](T2)
$STORE (T1,ORG,(P1)) ;STORE ORGANIZATION OF FILE
MOVX T1,FB$FIX ;ASSUME FIXED LENGTH
SKIPGE FILFLG(F)
MOVX T1,FB$VAR ;NO, ITS VARIABLE
CAIN T2,RMS.ST ;DO WE WANT STREAM-ASCII?
MOVX T1,FB$STM ;YES
CAIN T2,RMS.LS ;OR LINE-SEQUENCE-ASCII
MOVX T1,FB$LSA ;YES
$STORE (T1,RFM,(P1))
CAIN T2,RMS.KX ;IS IT KEYED INDEXED?
SKIPN APPFLG ;AND DEFAULT CREATE?
TRNA ;NO
SETOM APPFLG ;YES, CHANGE DEFAULT TO USE EXISTING FILE
MOVX T1,FB$DFW ;DEFERED WRITE INCASE INDEXED
SKIPGE APPFLG ;USE EXISTING FILE IF THERE IS ONE?
TXOA T1,FB$CIF ;YES
TXO T1,FB$SUP ;NO, CREATE A NEW VERSION
$STORE (T1,FOP,(P1)) ;
MOVEI T1,OUTXAB
CAIN T2,RMS.KX ;KEYED?
$STORE (T1,XAB,(P1)) ;YES, POINT TO XAB
$CREATE <(P1)>,E$$RMF ;CREATE A NEW FILE
MOVE T1,P1 ;COPY OF FAB
MOVEI P1,OUTRAB ;ADDRESS OF RAB
$STORE (T1,FAB,(P1)) ;STORE FAB IN RAB
; $STORE (T1,UBF,(P1)) ;POINT TO USER BUFFER ADDRESS
MOVE T1,RECSIZ ;SIZE OF RECORD IN WORDS
$STORE (T1,USZ,(P1))
MOVE T2,OUTORG ;GET TYPE OF RMS FILE
MOVEI T1,RB$SEQ ;ASSUME SEQUENTIAL ACCESS
CAIE T2,RMS.KX ;KEYED ACCESS?
CAIN T2,RMS.KR
MOVEI T1,RB$KEY ;YES
$STORE T1,RAC,(P1)
SKIPGE APPFLG ;APPEND TO EXISTING FILE
CAIL T2,RMS.KX ;AND NOT KEYED
JRST RMSOU1 ;NO
MOVX T1,RB$EOF ;SET NRP TO EOF
$STORE T1,ROP,(P1) ;TO CAUSE APPEND
RMSOU1: $CONNECT <(P1)>,E$$RCF
POP P,P1
RET
E$$RMF: $ERROR (?,RMF,<RMS $CREATE failed for file >,+)
HLRZ T2,FILJFN(F)
$MORE (FILESPEC,T2)
JRST RMSERR
SUBTTL RMS -- Get next RMS record
;Called by JSP P4,GETREC
RMSGET: PUSH P,P1 ;GET A SAFE ACC
HLRZ P1,FILRAB(F) ;GET ADDRESS OF RAB
XMOVEI T1,RC.KEY(R) ;GET RECORD ADDRESS
ADD T1,XTRWRD ;LEAVE SPACE FOR EXTRACTED KEYS
$STORE T1,UBF,(P1)
$GET <(P1)>,.+1
$FETCH T2,STS,(P1) ;GET STATUS
$FETCH T3,RSZ,(P1) ;GET SIZE OF RECORD
POP P,P1
CAIL T2,ER$MIN ;DID WE GET AN ERROR?
JRST RMSGTE ;YES, SEE IF E-O-F
MOVEM T3,RC.CNT(R) ;STORE BYTE COUNT
AOS FILSIZ(F) ;COUNT 1 MORE RECORD
AOJA P4,@EXTORG ;EXTRACT KEYS AND GIVE OK RETURN
RMSGTE: CAIE T2,ER$EOF ;IS IT E-O-F?
JRST E$$RGE ;NO, A REAL ERROR
PUSHJ P,GETEOF ;YES,SET ERROR RETURN
JRST (P4) ;AND RETURN
E$$RGE: $ERROR (?,RGE,<RMS $GET failed for file >,+)
HLRZ T2,FILJFN(F)
$MORE (FILESPEC,T2)
JRST RMSERR
SUBTTL RMS -- Put next RMS record
;Called by JSP P4,PUTREC
RMSPUT: PUSH P,P1 ;GET A SAFE ACC
HLRZ P1,FILRAB(F) ;GET ADDRESS OF RAB
XMOVEI T1,RC.KEY(R) ;GET RECORD ADDRESS
ADD T1,XTRWRD ;BYPASS EXTRACTED KEYS
$STORE T1,RBF,(P1) ;ONE OF THESE IS THE CORRECT ONE
$STORE T1,UBF,(P1)
HRRZ T1,RC.CNT(R) ;GET ACTUAL BYTE COUNT
$STORE T1,RSZ,(P1) ;RESET SIZE?
MOVE T1,OUTORG ;WHAT KIND OF FILE IS IT?
JRST @[IFIW RMSPTS ;SEQUENTIAL
IFIW RMSPTI ;INDEXED
IFIW RMSPTR ;RELATIVE
IFIW RMSPTS ;SEQUENTIAL
IFIW RMSPTA ;ASCII STREAM
IFIW RMSPTL ;LINE SEQUENCED ASCII
IFIW RMSPTX ;KEYED INDEX
IFIW RMSPTK](T1) ;KEYED RELATIVE
RMSPTL: MOVE T1,FILSIZ(F) ;GET RECORD NUMBER
ADDI T1,1 ;START AT 1 NOT 0
CAIG T1,^D99999 ;IS IT TOO BIG?
JRST RMSPTM ;NO
IDIVI T1,^D99999 ;YES
MOVE T1,T2 ;MODULO 99999
RMSPTM: $STORE T1,LSN,(P1) ;USE AS LINE SEQUENCE NO.
JRST RMSPTA ;JOIN STREAM CODE
RMSPTA: $PUT <(P1)>,.+1
$FETCH T2,STS,(P1) ;GET STATUS
$FETCH T3,STV,(P1) ;GET STATUS VALUE
CAIL T2,ER$MIN ;DID WE GET AN ERROR?
JRST ERRRPE ;YES
MOVEI T1,CRLF ;NEED TO ADD CR-LF
$STORE T1,RBF,(P1) ;ONE OF THESE IS THE CORRECT ONE
$STORE T1,UBF,(P1)
MOVEI T1,2
$STORE T1,RSZ,(P1) ;RESET SIZE?
JRST RMSPTS ;WRITE SEQ
RMSPTK:
RMSPTX:
RMSPTI:
RMSPTR:
RMSPTS: $PUT <(P1)>,.+1
RMSPTZ: $FETCH T2,STS,(P1) ;GET STATUS
$FETCH T3,STV,(P1) ;GET STATUS VALUE
CAIL T2,ER$MIN ;DID WE GET AN ERROR?
JRST ERRRPE ;YES
POP P,P1
AOS FILSIZ(F) ;NO, COUNT 1 MORE RECORD
JRST (P4) ;RETURN
ERRRPE: POP P,P1
$ERROR (?,RPE,<RMS $PUT failed for file >,+)
HLRZ T2,FILJFN(F)
$MORE (FILESPEC,T2)
JRST RMSERR
SUBTTL RMS -- Close RMS file
RMSCLS: HRRZ T1,FILFAB(F) ;GET FAB PTR
$CLOSE <(T1)>,E$$RZF
RET
E$$RZF: $ERROR (?,RZF,<RMS $CLOSE failed for file >,+)
HLRZ T2,FILJFN(F)
$MORE (FILESPEC,T2)
JRST LASTER
SUBTTL RMS -- General RMS error message printer
RMSERR: $MORE (TEXT,<
RMS error (STS = >)
$FETCH T1,STS,(P1) ;GET STATUS
$MORE (OCTAL,T1)
$MORE (TEXT,<, STV = >)
$FETCH T1,STV,(P1) ;GET VALUE
$MORE (OCTAL,T1)
$MORE (TEXT,<) >)
$FETCH T1,STS,(P1) ;GET STATUS AGAIN
CAIGE T1,ER$MIN ;IS IT AN ERROR?
$DIE ;NO?
CAILE T1,ER$MAX ;DO WE KNOW ABOUT IT?
MOVEI T1,ER$MAX ;NO, TOO BIG
MOVE T1,STRRMS-ER$MIN(T1)
$MORE (TEXT,T1)
$DIE
>;END IFE FTCOBOL
SUBTTL ERROR MESSAGES
E$$OPN: $ERROR (?,OPN,<OPENF failure for file >,+)
HLRZ T2,FILJFN(F) ;GET JFN OF FILE
$MORE (FILESPEC,T2)
JRST LASTER ;[357] TRY TO GIVE MORE INFO
E$$CFF: $ERROR (?,CFF,<CLOSE failure for file >,+)
HLRZ T1,FILJFN(F) ;GET JFN
$MORE (FILESPEC,T1)
JRST LASTER ;[357] TRY TO GIVE MORE INFO
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,<,
>)
HRROI T1,ERRBLK ; PLACE TO STORE ERROR MESSAGE
HRLOI T2,.FHSLF ;[357] CURRENT FORK,,LAST ERROR
MOVSI T3,-^D80 ; MAXIMUM NUMBER OF BYTES TO GET
ERSTR% ;[357] PRINT THE MESSAGE
JFCL ;[357] IGNORE UNDEFINED ERROR NUMBER
JFCL ;[357] IGNORE ERROR DURING EXECUTION OF ERSTR
MOVEI T1,ERRBLK ; GET ADDRESS OF ERROR MESSAGE
$MORE (TEXT,T1) ; TYPE IT
$DIE ;[357] GIVE UP
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$$FMC: $ERROR (?,FMC,<File's mode conflicts with mode switch for >,+)
HRRZ T2,X.JFN(P1) ;[OK] [305] PRINT THE FILE SPEC
$MORE (FILESPEC,T2) ;[305] ..
$DIE ;[305]
E$$IDM: $ERROR (?,IDM,<Illegal data mode>)
E$$JFT: $ERROR (?,JFT,<JFNS% failed for temp file>,+) ;[357]
JRST LASTER ;[357] TRY TO GIVE MORE INFORMATION
E$$NSD: $ERROR (?,NSD,<No such device>)
E$$RMD: $ERROR (?,RMD,<RMS file must be on disk>)
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) ;[OK]
$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) ;[OK]
$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,FILJFN(F) ;GET JFN
$MORE (FILESPEC,T2)
JRST LASTER ;[357] TRY TO GIVE MORE INFO
E$$SNA: $ERROR (?,SNA,<Non-zero sections not available>)
E$$CM1: $ERROR (?,CM1,<Can't MAP sections 0 and 1 together>)
E$$CM2: $ERROR (?,CM2,<Can't MAP section 0 and RMS section together>)
E$$FSE: $ERROR (?,FSE,<Free sections exhausted>)
E$$RGF: $ERROR (?,RGF,<RMS GET failed>)
E$$XGF: $ERROR (?,XGF,<Can't get XRMS into non-zero section>)
ERRRJF: SKIPL RFSBLK+.RFSFL ;EXECUTE-ONLY?
JRST E$$RJF ;NO, USE OLD MESSAGE
$ERROR (?,XJF,<Execute-only GTJFN% failed for >,+)
JRST E$RJF1 ;REST OF MESSAGE
E$$RJF: $ERROR (?,RJF,<GTJFN% failed for >,+)
E$RJF1: XMOVEI T2,. ;SEE WHAT WE LOOKED FOR
HRROI T1,[ASCIZ /SYS:XRMS.EXE/]
TLNN T2,-1
HRROI T1,[ASCIZ /SYS:RMS.EXE/]
$MORE (TEXT,T1)
JRST LASTER
>;END IFE FTCOBOL
SUBTTL RMS error codes
DEFINE SS(Z) < POINT 7,[ASCIZ Z]>
DEFINE STRS(NAME) <NAME(SS)>
; RMS error codes
DEFINE RMS(S), <
S "ER$AID - Bad Area Identification field in allocation XAB"
S "ER$ALQ - Allocation quantity incorrect"
S "ER$ANI - Not in ANSI D format"
S "ER$BKS - Bad bucket size"
S "ER$BKZ - Invalid Bucket Size in allocation XAB"
S "ER$BLN - Invalid Block Length field"
S "ER$BSZ - Invalid Byte Size field"
S "ER$BUG - Internal RMS error"
S "ER$CCF - Cannot Close File"
S "ER$CCR - Cannot Connect RAB"
S "ER$CDR - Cannot disconnect RAB"
S "ER$CEF - Cannot Erase File"
S "ER$CGJ - Cannot Get a JFN for the file"
S "ER$CHG - Illegal attempt to change a key value"
S "ER$COD - Invalid type Code field in XAB"
S "ER$COF - Cannot Open file"
S "ER$CUR - No current record"
S "ER$DAN - Invalid data area number in KEY definition XAB"
S "ER$DEL - A record accessed with RFA addressing has been deleted"
S "ER$DEV - Bad device or inappropriate device type for operation"
S "ER$DFL - Bad data-fill percentage value"
S "ER$DLK - Deadlock condition detected"
S "ER$DME - Dynamic memory exhausted"
S "ER$DTP - Invalid data type in KEY definition XAB"
S "ER$DUP - Duplicate key detected"
S "ER$EDQ - ENQ/DEQ locking error"
S "ER$EOF - End of file"
S "ER$FAB - Block is not a valid FAB"
S "ER$FAC - FAC field in the FAB is not compatible with operation"
S "ER$FEX - File already exists"
S "ER$FLG - Invalid Flag field in KEY XAB"
S "ER$FLK - File already locked"
S "ER$FNA - Bad FNA value"
S "ER$FNC - File not closed"
S "ER$FNF - File not found"
S "ER$FOP - Bad file options"
S "ER$FSZ - Invalid header size for VFC file"
S "ER$FUL - File cannot be extended"
S "ER$IAL - Illegal argument on call"
S "ER$IAN - Invalid index area number in KEY definition XAB"
S "ER$IBC - Illegal block mode connection"
S "ER$IBO - Illegal block mode operation"
S "ER$IBS - Illegal block mode sharing"
S "ER$IFI - Invalid internal file identifier in FAB"
S "ER$IFL - Bad index fill percentage"
S "ER$IMX - Multiple SUMMARY or DATE XABS"
S "ER$IOP - Invalid operation attempted"
S "ER$IRC - Illegal record encountered"
S "ER$ISI - Invalid internal stream identifier in RAB"
S "ER$JFN - Invalid JFN"
S "ER$KBF - RAC equal to RB$KEY, but did not set KBF"
S "ER$KEY - Invalid record key for random access to relative file"
S "ER$KRF - Invalid key of reference for indexed file"
S "ER$KSZ - Key size too large"
S "ER$LSN - Bad line sequence number"
S "ER$MRN - Bad MRN value"
S "ER$MRS - Invalid value for maximum record size"
S "ER$NEF - Not at end of file"
S "ER$NLG - Log file not active"
S "ER$NPK - No primary key in key definition XAB for indexed file"
S "ER$NXT - Invalid value of NXT field in XAB"
S "ER$ORD - Chained XABS not in ascending order"
S "ER$ORG - Unknown file organization"
S "ER$PEF - Cannot position to end of file"
S "ER$PLG - Error detected in files prologue"
S "ER$POS - Bad key position value"
S "ER$PRV - Insufficient privilege or file protection violation"
S "ER$QPE - Quiet point enabled"
S "ER$RAB - Block identifier field of RAB invalid"
S "ER$RAC - Invalid record access mode field in RAB"
S "ER$RAT - Invalid record attributes field in FAB"
S "ER$RBF - RBF was not setup on $PUT or $UPDATE"
S "ER$REF - Invalid key of reference in XAB"
S "ER$RER - File processor read error"
S "ER$REX - Record already exists"
S "ER$RFA - Invalid record file address in RAB"
S "ER$RFM - Invalid record format"
S "ER$RLK - Record locked by another process"
S "ER$RNF - Record not found"
S "ER$RNL - Record not locked"
S "ER$ROP - Bad record options"
S "ER$RRV - Invalid RRV record found"
S "ER$RSA - Record stream active"
S "ER$RSD - Record size discrepancy"
S "ER$RSZ - Invalid record size"
S "ER$RTB - Record too large for user buffer"
S "ER$SEQ - Keys out of sequence"
S "ER$SIZ - Invalid key size in key definition XAB"
S "ER$TRE - Index tree error detected"
S "ER$TRU - Cannot truncate this file"
S "ER$UBF - Invalid user record area address"
S "ER$UDF - File in undefined state"
S "ER$VER - Error in version number"
S "ER$WER - File processor write error"
S "ER$XAB - Invalid BID field of XAB"
S "ER$XCL - File must be open for exclusive access"
S "ER$FSI - File spec contains illegal syntax"
; This one must always be last
S "ER$??? - Unknown error code"
>
STRRMS:: STRS(RMS)
ER$MAX=.-STRRMS+ER$MIN
END <ENTVLN,,ENTVEC>