Trailing-Edge
-
PDP-10 Archives
-
AP-D489C-SB
-
sort.new
There are no other files named sort.new in the archive.
SUBTTL D.M.NIXON/DZN/DLC 10-APR-78
IFN FTOPS20,<
TITLE SORT - SORT/MERGE for DECSYSTEM-20
>
IFE FTOPS20,<
TITLE SORT - SORT/MERGE for DECsystem-10
>
;COPYRIGHT (C) 1975, 1978 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
SUBTTL TABLE OF CONTENTS FOR SORT
; Table of Contents for SORT
;
;
; Section Page
;
; 1 TABLE OF CONTENTS FOR SORT ............................... 2
; 2 CALLING SEQUENCE CONVENTIONS ............................. 3
; 3 DEFINITIONS
; 3.1 Low Segment Data .................................. 5
; 4 PSORT.
; 4.1 Prior Initialization .............................. 6
; 4.2 PSORT% - Initialization Continued ................. 7
; 5 CHECK MONITOR AND CPU TYPES .............................. 8
; 6 ZERO ALL LOW SEGMENT DATA ................................ 10
; 7 RELES.
; 7.1 RELES% - Add Record to Tree ....................... 11
; 8 TREE MANIPULATION
; 8.1 Initialization .................................... 12
; 8.2 Insert Next Record ................................ 13
; 9 MERGE.
; 9.1 MERGE% - Begin a Merge Cycle ...................... 16
; 9.2 MERGE0 - 0 Temporary Files ........................ 22
; 9.3 MERGE1 - 1 Temporary File ......................... 23
; 9.4 MERGE2 - Final Merge of 2 or More Temporary Files . 24
; 10 RETRN.
; 10.1 RETRN% - Return Record From Tree to Output File ... 25
; 10.2 RETRN0 - 0 Temporary Files ........................ 26
; 10.3 RETRN1 - 1 Temporary File ......................... 27
; 10.4 RETRN2 - Final Merge of 2 or More Temporary Files . 28
; 11 GETREC
; 11.1 GETREC - Get Next Record From Input File .......... 30
; 11.2 GETSXR - Get SIXBIT Record ........................ 31
; 11.3 GETASR - Get ASCII Record ......................... 33
; 11.4 GETEBR - Get EBCDIC Record ........................ 39
; 11.5 GETBNR - Get Binary Record ........................ 46
; 11.6 GTTREC - Get Next Record From Temporary File ...... 49
; 12 PUTREC
; 12.1 PUTREC - Put Next Record to Output File ........... 50
; 12.2 PUTSXR - Put SIXBIT Record ........................ 51
; 12.3 PUTASR - Put ASCII Record ......................... 52
; 12.4 PUTEBR - Put EBCDIC Record ........................ 58
; 12.5 PUTBNR - Put Binary Record ........................ 65
; 12.6 PTTREC - Put Next Record to Temporary File ........ 68
; 13 MEMORY MANAGEMENT ........................................ 70
; 14 ERROR MESSAGE SUPPRESSION CONTROL ........................ 73
; 15 ERROR MESSAGES ........................................... 74
SUBTTL CALLING SEQUENCE CONVENTIONS
COMMENT \
SORT/MERGE USES THE FOLLOWING 3 CALLING CONVENTIONS
1.0 JSP T4,SUBROUTINE
THIS IS USED ONLY IN THE FOLLOWING 3 PLACES
1.1 JSP T4,GETBUF
CALL TO GET THE NEXT INPUT BUFFER
MAKES NO FURTHER SUBROUTINE CALLS
RETURNS EITHER
JRST (T4) NORMAL CASE
OR
JRST @PHYEOF ON END OF FILE
1.2 JSP T4,PUTBUF
CALL TO WRITE THE NEXT OUTPUT BUFFER
MAKES NO FURTHER SUBROUTINE CALLS
RETURNS EITHER
JRST (T4) NORMAL CASE
OR
JRST @PHYEOF ON END OF FILE
1.3 JSP P4,@EXTRCT
CALL TO EXTRACT THE NUMERIC KEYS FROM THE RECORD
JUST READ IN BY GETREC ROUTINE.
EXTRCT CONTAINS RUN TIME GENERATED CODE OF THE FOLLOWING FORM
JSP T4,SUBROUTINE
LDB BYTE POINTER TO LOAD KEY
BYTE COUNT
IDPB BYTE POINTER TO STORE EXTRACTED KEY
ALL THESE ROUTINES RETURN
JRST 3(T4)
AT THE END OF THE CODE SEQUENCE IS
JRST (P4)
2.0 JSP P4,SUBROUTINE
USED ONLY IN THE FOLLOWING 4 PLACES
2.1 JSP P4,@EXTRCT
SEE 1.3 ABOVE
RETURN IS
JRST (P4)
2.3 JSP P4,GETREC
TO GET THE NEXT INPUT RECORD
MAY MAKE CALL TO GETBUF THEREFORE MAY NOT RETURN
SEE 1.1 ABOVE
NORMAL RETURN IS
JRST (P4)
2.4 JSP P4,PUTREC
TO WRITE OUT THE NEXT RECORD
MAY MAKE CALL TO PUTBUF, THEREFORE MAY NOT RETURN
SEE 1.2 ABOVE
NORMAL RETURN IS
JRST (P4)
3.0 PUSHJ P,SUBROUTINE
THIS IS USED WHEN ROUTINE ALWAYS RETURNS TO CALLER
RETURNS MAY BE EITHER
SINGLE RETURN TO CALLER +1
POPJ P,
OR SKIP RETURN TO EITHER CALLER+1 OR CALLER+2
AOS (P)
POPJ P,
2.2 JSP P4,@.CMPAR
.CMPAR CONTAINS RUN TIME GENERATED CODE WHICH CONTAINS
CALL TO SUBROUTINE TO COMPARE RECORDS IN
(R) AND (J)
THIS ROUTINE (WHICH IS COMPILED AT RUN TIME)
HAS THREE RETURNS
JRST 0(P4) KEY(R) = KEY(J)
JRST 1(P4) KEY(R) > KEY(J)
JRST 2(P4) KEY(R) < KEY(J)
\
SUBTTL DEFINITIONS -- Low Segment Data
SEGMENT LOW
;LOCATIONS IN SORT THAT SHOULD BE INITIALIZED TO 0 AT STARTUP TIME
;(I.E., EACH NEW COMMAND LINE) SHOULD BE BETWEEN Z.BEG AND Z.END FOR
;ZDATA TO FIND.
Z.BEG:!
CPU: BLOCK 1 ;0 = KA10, 1 = KI10, 2 = KL10
NUMRCB: BLOCK 1 ;NUMBER OF RECORDS IN TREE (ALSO IN MEMORY)
TBUFNO: BLOCK 1 ;NUMBER OF BUFFERS PER TEMPORARY FILE
OBUFNO: BLOCK 1 ;NUMBER OF BUFFERS FOR OUTPUTOR MERGE FILE
TCBIDX: BLOCK 1 ;INDEX INTO TCB TABLE
RECORD: BLOCK 1 ;INPUT RECORD SIZE IN BYTES
REKSIZ: BLOCK 1 ;NUMBER OF WORDS IN RECORD + EXTRACTED KEYS
XTRWRD: BLOCK 1 ;[207] # OF WORDS OF EXTRACTED KEYS
NUMTMP: BLOCK 1
ACTTMP: BLOCK 1 ;NO. OF TEMP FILES CURRENTLY OPEN FOR INPUT
STRNUM: BLOCK 1
STRNAM: BLOCK MX.TMP ;STRUCTURES FOR TEMPORARY FILES
MAXTMP: BLOCK 1 ;MAX. NO. OF TEMP FILES IN USE DURING MERGE
BUFALC: BLOCK 1
JOBNUM: BLOCK 1 ;SIXBIT JOB NUMBER ,, OCTAL JOB NUMBER
RUNTOT: BLOCK 1 ;NUMBER OF RUNS
NUMLFT: BLOCK 1 ;NUMBER OF TEMP FILES STILL TO MERGE
NUMENT: BLOCK 1 ;NUMBER OF ENTERS DONE (FOR APPEND CODE)
MRGNUM: BLOCK 1 ;NUMBER OF MERGE PASS
NUMINP: BLOCK 1 ;NUMBER OF INPUT FILES
BUFPTR: BLOCK 1
TREORG: BLOCK 1 ;FIRST LOCATION OF NODE TREE
TREEND: BLOCK 1 ;END OF TREE OF RECORD NODES
RCBEND: BLOCK 1 ;END OF IN-MEMORY RECORDS
LSTREC: BLOCK 1 ;PTR TO LAST RECORD JUST OUTPUT
RQ: BLOCK 1
RC: BLOCK 1
FSTNOD: BLOCK 1
LOGEOF: BLOCK 1 ;LOGICAL END OF FILE INTERCEPT
PHYEOF: BLOCK 1 ;PHYSICAL END OF FILE INTERCEPT
RSAV: BLOCK 1
PSAV: BLOCK 1
$RETRN: BLOCK 1
INPREC: BLOCK 1 ;NO. OF INPUT RECORDS SEEN
OUTREC: BLOCK 1 ;NO. OF OUTPUT RECORDS SEEN
IOBPW: BLOCK 1 ;[201] BYTES-PER-WORD IN EXTERNAL FILE
CURSEQ: BLOCK 1 ;SEQUENCE # OF RECORD IN THIS RUN
NXTSEQ: BLOCK 1 ;SEQUENCE # OF RECORD IN NEXT RUN
SEQOVF: BLOCK 1 ;-1 IF SEQUENCE NUMBERS OVERFLOW
SRTDN: BLOCK 1 ;-1 WHEN SORT PHASE OVER
MRGDN: BLOCK 1 ;-1 WHEN MERGE PHASE OVER (FINAL OUTPUT STARTED)
MRGSW: BLOCK 1 ;-1, 0 MEANS NO MERGE, 1 MEANS /MERGE
WSCSW: BLOCK 1 ;1 IF WITH SEQUENCE CHECK (/CHECK) FOR MERGE
SUPFLG: BLOCK 1 ;SEVERITY OF ERRORS TO SUPPRESS
ARGCNT: BLOCK 1 ;NUMBER OF ARGS IN FORTRAN CALL
ARGLST: BLOCK 1 ;POINTER TO ARG LIST IN USERS AREA
ERRADR: BLOCK 1 ;ERROR RETURN ADDRESS FOR USER CONTROL
FERCOD: BLOCK 1 ;ADDRESS OF WHERE TO STORE ERROR CODE
ADDR: BLOCK 1 ;ADDRESS OF MEMORY BLOCK (FOR FUNCT.)
SIZE: BLOCK 1 ;SIZE OF MEMORY BLOCK (DITTO)
STATUS: BLOCK 1 ;RETURN STATUS FROM FUNCT.
CORSTK: BLOCK 1 ;PTR TO STACK OF MEMORY ALLOCATION WORDS
CSTACK: BLOCK 100 ;STACK OF MEMORY ALLOCATION WORDS
IFE FTOPS20,< ;ONLY ON TOPS10
MYPPN: BLOCK 1 ;[115] LOGGED-IN PPN
DSKARG: BLOCK .DCUPN ;ARGS FOR DSKCHR UUO
STRUSE: BLOCK 1 ;[214] # OF FIRST UNUSED STRNAM ENTRY
STRDEF: BLOCK 1 ;[214] -1 IF WE DEFAULTED STRNAM TO DSK:
STRARG: BLOCK 3 ;ARGS FOR JOBSTR UUO
> ;END IFE FTOPS0
FCBORG: BLOCK FCBLEN
TMPFCB: BLOCK MX.TMP*FCBLEN ;DO NOT SPLIT
DFBORG: BLOCK MX.TMP*DFBLEN
STRSNM==DFBORG
STRULN==DFBORG+MX.TMP
Z.END==.-1
;LOCATIONS WHICH NEED NOT OR SHOULD NOT BE SET TO 0 ON STARTUP
;SHOULD BE PLACED HERE.
T.BLK: BLOCK LN.X ;[215] ONE BLOCK MULTIPLEXED FOR ALL .TMP FILES
SUBTTL PSORT. -- Prior Initialization
COMMENT \
ENTER PSORT% WITH:
ALL DATA ZEROED INITIALLY
THEN SET THESE LOCATIONS SPECIFICALLY
OFFSET: 1 IF ENTERED FROM CCL (SRTSCN ONLY)
CPU: SET FOR KA10=0, KI10=1 OR KL10=2
MAXTMP: MAX. NO. OF TEMP FILES TO OPEN (NO. OF CHAN#)
TCBIDX: AOBJN WORD OF -MAXTMP,,0
JOBNUM: VALUE FROM PJOB UUO
MODE: LHS BITS OF RM.???, RHS INDEX TO DATA TYPE
SIXBIT=0, ASCII=1, EBCDIC=2, BINARY=3 INDEX
STRNUM: NO. OF TEMP STRUCTURES TO USE
RECORD: NO. OF BYTES IN RECORD
RECSIZ: SIZE OF RECORD IN WORDS (NOT COBOL)
REKSIZ: SIZE OF RECORD IN WORDS + EXTRACTED KEYS
NUMRCB: NO. OF RECORDS TO HOLD IN MEMORY DURING SORT
IBUFNO: NO. OF INPUT BUFFERS (NOT COBOL)
TBUFNO: NO. OF TEMP BUFFERS FOR SORT PHASE
\
SUBTTL PSORT. -- PSORT% - Initialization Continued
SEGMENT HIGH20
BEGIN
PROCEDURE (PUSHJ P,PSORT%)
MOVE P1,NUMRCB ;NO. OF RECORDS
IFE FTCOBOL,<
MOVEM P1,RCBTOT ;FOR ENDS.
>
IMULI P1,RN.LEN ;LENGTH OF EACH NODE
ADD P1,TREORG ;PLUS BASE
MOVEM P1,TREEND ;END OF NODE TREE
MOVE P1,NUMRCB ;NO. OF RECORDS
IMUL P1,REKSIZ ;* SIZE OF EACH
ADD P1,TREEND ;PLUS BASE
MOVEM P1,RCBEND ;ADDRESS OF START OF BUFFER POOL
IFE FTOPS20,< ;DONE BY SETSIZ ON TOPS20
MOVEM P1,BUFPTR ;SAVE IT
>
IFN FTOPS20,<
MOVE P1,BUFPTR ;GET START OF BUFFER POOL
ADD P1,BUFSZ ;ADD IN SIZE OF BUFFER AREA
ADDI P1,PGSIZ ;ADD PG FOR ROUNDOFF ERROR
MOVEM P1,BUFTOP ;PUT A CEILING OVER BUFFERS
IFE FTCOBOL,<
MOVE T1,BUFSZ ;GET SIZE OF BUFFER POOL
LSH T1,-1 ;1/2 FOR TMP, 1/2 FOR INPUT
IDIV T1,MXDVSZ ;COMPUTE # OF INPUT BUFFERS
MOVEM T1,IBUFNO ; ..
IF /MERGE
SKIPG MRGSW
JRST $F
THEN DIVIDE BUFFER AREA BY NO. OF INPUT FILES
PUSH P,T1
IDIV T1,ACTTMP ;NO. OF ACTUAL FILES OVEN AT THIS TIME
MOVEM T1,IBUFNO ;NO. PER FILE
POP P,T1
FI;
SKIPN T1 ;T1 WILL BE ZERO IF INPUT
ADDI T1,1 ; IS FROM MTA, BECAUSE MXDVSZ
; HOLDS TWICE MTA BUFFER SIZE
IMUL T1,MXDVSZ ;REST IS FOR TEMP FILE BUFFERS
MOVE T2,BUFSZ ;GET SIZE OF POOL AGAIN
SUB T2,T1 ;SUBTRACT INPUT BUFFERS
>
IFN FTCOBOL,<
MOVE T2,BUFSZ ;GET SIZE OF BUFFER POOL
>
IDIVI T2,PGSIZ ;COMPUTE PAGES PER TMP BUFFER
MOVEM T2,TBUFNO ;SAVE
>
IFE FTOPS20,<
PUSHJ P,SETSTR ;SET UP TEMP DSK UNITS
>
PUSHJ P,INITRE ;INITIALIZE TREE WITH NULL RECORDS
HRROS LSTREC ;-1 SIGNALS THAT ITS JUST A DUMMY
RETURN
END;
SUBTTL CHECK MONITOR AND CPU TYPES
SEGMENT HIGH
BEGIN
PROCEDURE (JSP T4,CPUTST) ;[134] MAY NOT HAVE STACK WHEN CALLED
;CPUTST IS CALLED AS A PART OF SORT'S INITIALIZATION TO CHECK WHETHER IT IS
;BUILT FOR THE MONITOR AND CPU ON WHICH IT FINDS ITSELF RUNNING. IF ANY
;INCOMPATIBILITIES ARE FOUND, THEN APPROPRIATE MESSAGES ARE TYPED. ALSO, THE CPU
;TYPE IS SAVED FOR LATER, SINCE MANY OF THE COMPARISON GENERATION ROUTINES
;COMPILE BETTER CODE IF THEY SEE THAT SORT IS RUNNING ON A KI OR KL CPU. NOTE THAT FOR THE MONITOR INCOMPATIBILITY MESSAGES TO GET PRINTED PROPERLY, **NO**
;MONITOR CALLS SHOULD BE DONE UNTIL CPUTST IS CALLED, SO THAT THE FIRST GETTAB
;IS SORT'S FIRST MONITOR CALL.
MOVE T1,[%CNMNT] ;[134] THIS IS **SIMULATED** BY TOPS-20 MONITOR
;[134] I.E. DOES NOT CALL COMPAT. PAK.
GETTAB T1, ;SEE WHICH MONITOR
SETZ T1, ;NOT IMPLEMENTED
LDB T1,[POINTR (T1,CN%MNT)] ;GET TYPE BYTE
CAILE T1,4 ;[134] DEFINED MONITOR TYPE?
MOVEI T1,2 ;[134] NO--CALL IT 'ITS' THEN
IFE FTOPS20,< ;[134] BRANCH DEPENDING ON MONITOR TYPE AND ASM SWITCHES
CASE %CNMNT OF (.+1,.+1,E$$SRM,E$$SRM,E$$1N2) ;[134]
JRST @[EXP .+1,.+1,E$$SRM,E$$SRM,E$$1N2](T1) ;[134]
>
IFN FTOPS20,<
CASE %CNMNT OF (E$$SRM,E$$2N1,E$$SRM,,E$$SRM,.+1) ;[134]
JRST @[EXP E$$SRM,E$$2N1,E$$SRM,E$$SRM,.+1](T1) ;[134]
>
ESAC;
SETZ T2, ;[134] BUILD CPU TYPE HERE
SETO T1, ;FOR STANDARD KA/KI TEST
AOBJN T1,.+1
JUMPN T1,$1 ;KA10
ADDI T2,1 ;[134] KI10 OR KL10
BLT T1,0 ;KL10 WILL STORE 1,,1
JUMPE T1,$1 ;KI10
ADDI T2,1 ;[134] KL10
$1%
IFN FTKL10,<
CAIGE T2,KL.CPU ;[134] ARE WE RUNNING ON A KL10?
JRST E$$LNI ;[134] NO--QUIT BEFORE DMOVES, BIS CODE
>
IFN FTKI10&<FTKL10-1>,< ;[134] ASSEMBLE ONLY IF KI10
CAIGE T2,KI.CPU ;[134] ARE WE RUNNING ON A KI10?
JRST E$$INA ;[134] NO--QUIT BEFORE DMOVES, ETC.
>
MOVEM T2,CPU ;[134] SAVE CPU TYPE FOR CODE GEN
IFE FTOPS20,<
GETPPN T1, ;[115] GET LOGGED IN PPN
JFCL ;[115] JUST IN CASE
MOVEM T1,MYPPN ;[115] STORE IT
MOVE T1,[-2,,.GTADR] ;GET PROTECTION RELOCATION
GETTAB T1,
SETO T1, ;ASSUME NO HIGH SEG.
HLRE T1,T1 ;PROTECTION = LENGTH
>
IFN FTOPS20,<
HLRZ T1,.JBHRL ;GET LENGTH OF HIGH SEGMENT
SUBI T1,1 ;INCASE NONE
IORI T1,777 ;FORCE ON PAGE BOUNDARY
>
ADDI T1,1 ;IN P OR K
MOVEM T1,HISIZE
RETURN
END;
;THESE ARE MESSAGES THAT ARE PRINTED ONLY IF WE FIND OURSELVES ON THE
;WRONG CPU. HOST SYSTEM MONITOR CALLS (OR REASONABLE ASSUMPTIONS) ARE
;USED TO PRINT THE MESSAGES, TO MAXIMIZE THE POSSIBILITY THAT THE USER
;WILL SEE THEM. THUS, THE $ERROR MACRO IS NOT USED, AND SORT EXITS
;IMMEDIATELY AFTER PRINTING.
IFE FTOPS20,<
OPDEF PSOUT[JSYS 76] ;[134] NEED THESE ON TOPS-10
OPDEF HALTF[JSYS 170]
>
DEFINE $ERR1(C,CODE,MSG)< ;;[134] PRINT ON TOPS-10
OUTSTR [ASCIZ \
C'SRT'CODE MSG
\]
EXIT
>
DEFINE $ERR2(C,CODE,MSG)< ;;[134] PRINT ON TOPS-20
HRROI T1,[ASCIZ \
C'SRT'CODE MSG
\]
PSOUT
HALTF
JRST .-1 ;;[134] HALTF CONTINUES
>
E$$SRM: $ERR1 (?,SRM,<SORT/MERGE will not run on this machine.>)
IFE FTOPS20,<
E$$1N2: $ERR2 (?,1N2,<TOPS-10 version of SORT/MERGE will not run on TOPS-20.>)
>
IFN FTOPS20,<
E$$2N1: $ERR1 (?,2N1,<TOPS-20 version of SORT/MERGE will not run on TOPS-10.>)
>
IFN FTKL10,<
E$$LNI: $ERR1 (?,LNI,<KL version of SORT/MERGE will not run on KI or KA CPU.>)
>
IFN FTKI10&<FTKL10-1>,< ;[134] ASSEMBLE ONLY IF KI10
E$$INA: $ERR1 (?,INA,<KI version of SORT will not run on KA CPU.>)
>
SUBTTL ZERO ALL LOW SEGMENT DATA
BEGIN
PROCEDURE (JSP T4,ZDATA) ;ZERO AND INITIALIZE DATA AREAS
IFN FTKI10,<
DMOVE T1,[ZCOR,,ZCOR+1
Z.BEG,,Z.BEG+1]
>
IFE FTKI10,<
MOVE T1,[ZCOR,,ZCOR+1]
MOVE T2,[Z.BEG,,Z.BEG+1]
>
SETZM ZCOR ;CLEAR FIRST WORD
BLT T1,EZCOR ; AND REST OF DATA AREA
SETZM Z.BEG
BLT T2,Z.END
IFE FTOPS20,<
MOVX T1,UU.IBC+.IOBIN ;[215] INITIALIZE T.BLK
MOVEM T1,T.BLK+X.OPN+.OPMOD ;[215] ..
MOVX T1,.TBS ;[215] ..
MOVEM T1,T.BLK+X.DVSZ ;[215] ..
MOVX T1,.RBDEV ;[215] ..
MOVEM T1,T.BLK+X.RIB+.RBCNT ;[215] ..
MOVX T1,'TMP ' ;[215] ..
HLLZM T1,T.BLK+X.RIB+.RBEXT ;[215] ..
SETZM T.BLK+X.RIB+.RBSPL ;[215] ..
>;END IFE FTOPS20
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,GETJOB) ;GET JOB NUMBER
;GETJOB SETS LOCATION JOBNUM TO <SIXBIT JOB NUMBER PADDED WITH ZEROS>,,JOB
;NUMBER. THIS IS USED LATER BY THE TEMPORARY FILE ROUTINES TO GENERATE JOB-
;UNIQUE FILE NAMES FOR THE TEMPORARY FILES.
IFE FTOPS20,<
PJOB T1, ;GET JOB NUMBER
>
IFN FTOPS20,<
GJINF
MOVE T1,3 ;JOB NUMBER
>
MOVEM T1,JOBNUM ;SAVE IT
IDIVI T1,^D100 ;GET HUNDREDS
IDIVI T2,^D10 ;GET TENS
LSH T1,2*6 ;SHIFT INTO POSITION
LSH T2,6 ;...
ADDI T2,(T3)
ADDI T1,'000'(T2) ;MAKE SIXBIT
HRLM T1,JOBNUM ;SIXBIT OCTAL JOB NUMBER
RETURN
END;
SEGMENT LOW10
SUBTTL RELES. -- RELES% - Add Record to Tree
BEGIN
PROCEDURE (PUSHJ P,RELES%)
;SEE IF IN THIS RUN OR NOT
SKIPGE J,LSTREC ;GET PREVIOUS
JRST $2 ;STILL ON DUMMY RUN, WE CANNOT DO COMPARE
COMPARE (R,J)
JRST $1 ;KEY(R) = KEY(J) ;OK
JRST $1 ;KEY(R) > KEY(J) ;OK
JRST $2 ;KEY(R) < KEY(J) ;TOO BIG
$2% AOS RQ ;BUMP RUN NUMBER
AOSA T1,NXTSEQ ;BELONGS TO NEXT SEQUENCE
$1% AOS T1,CURSEQ ;BELONGS TO THIS RUN
TLNE T1,-1 ;WILL WE OVERFLOW A HALFWORD?
PUSHJ P,[ SKIPE SEQOVF ;YES, TYPED MESSAGE ALREADY?
POPJ P, ;YES, ONLY TYPE IT ONCE
SETOM SEQOVF ;REMEMBER WE TYPED IT
$ERROR (%,SNO,<Sequence number overflow - SORT may be unstable>)
POPJ P,] ;WARN OF INSTABILITY AND GO ON
HRLM T1,RN.SEQ(S) ;STORE FOR EQUAL TEST
PUSHJ P,SETTRE ;SET NEW RECORD IN TREE
MOVEI F,TMPFCB ;FCB OF TEMP FILE
MOVE T1,RQ ;GET RUN #
CAMN T1,RC ;SAME AS CURRENT?
PJRST RELOUT ;YES, OUTPUT IT
MOVEM T1,RC ;RESET
PUSHJ P,RELOUT ;OUTPUT RECORD IN LSTREC FIRST
MOVE T1,NXTSEQ ;PREPARE TO RESET SEQ #
MOVEM T1,CURSEQ
SETZM NXTSEQ
SKIPN NUMTMP ;IF FIRST RUN
PJRST FSTRUN ;THEN INITIALIZE FIRST RUN
PJRST CLSRUN ;ELSE CLOSE THE RUN, AND OPEN A NEW ONE
END;
BEGIN
PROCEDURE (PUSHJ P,RELOUT)
SKIPN RQ ;A "REAL" OUTPUT?
JRST [HRRZ R,RN.REC(S) ;NO, SET UP RECORD PTR
RETURN] ;SINCE 0 IS A DUMMY
SKIPL R,LSTREC ;HOWEVER WHAT WE ACTUALLY OUTPUT IS LSTREC
JSP P4,PTTREC ;EXCEPT FIRST TIME
HRRZ R,RN.REC(S) ;THIS WAS ONE USER THOUGHT WE OUTPUT
EXCH R,LSTREC ;KEEP IT FOR NEXT TIME, GET R FOR NEXT INPUT
HRRZS R ;KEEP LH(R) ZERO SO @RSAV WORKS
HRRZM R,RN.REC(S) ;CHANGE PTR ALSO
RETURN
END;
SUBTTL TREE MANIPULATION -- Initialization
BEGIN
PROCEDURE (PUSHJ P,INITRE)
;INITIALIZE THE RECORD TREE WITH NULL RECORD
;SET WITH
;RUN NO. = 0
;LOSER(R) = R
SETZM RC
SETZM RQ
SOS NUMRCB ;USE ONE RCB TO HOLD LAST RECORD TO OUTPUT
MOVN J,NUMRCB
HRLZ J,J ;AOBJN PTR
MOVE U,TREORG ;WHERE THE NODES START
MOVEI T1,RN.LEN(U) ;LOCATION OF NODE #1
MOVEM T1,FSTNOD ;USED IN COMPARES LATER
MOVE R,TREEND ;WHERE THE RECORDS START
$1% MOVEM U,RN.LSR(U) ;POINT TO ITSELF, RUN NO. = 0
MOVEI T1,(J) ;GET THIS INDEX
LSH T1,-1 ;J/2
IMULI T1,RN.LEN ;DISTANCE FROM START
ADD T1,TREORG ;ABS LOCATION
HRLZM T1,RN.FI(U) ;PTR TO INTERNAL FATHER
MOVE T1,NUMRCB ;
ADDI T1,(J)
LSH T1,-1
IMULI T1,RN.LEN
ADD T1,TREORG
HRRM T1,RN.FE(U)
MOVEM R,RN.REC(U) ;PTR TO RECORD
ADD R,REKSIZ ;INCREMENT RECORD PTR
ADDI U,RN.LEN ;INCREMENT NODE
AOBJN J,$1 ;LOOP
HRRZM R,LSTREC ;PLACE TO HOLD RECORD JUST OUTPUT
;-1 SIGNALS JUST A DUMMY
MOVE S,TREORG ;INITIALIZE WITH NODE #0
HRRZ R,RN.REC(S) ;AND ITS RECORD
RETURN
END;
SUBTTL TREE MANIPULATION -- Insert Next Record
BEGIN
PROCEDURE (PUSHJ P,SETTRE)
HRRZ U,RN.FE(S) ;GET NODE JUST ABOVE
$1% HLRZ T1,RN.RUN(U) ;GET ITS RUN NUMBER
CAMGE T1,RQ ;IF ITS LESS
JRST $3 ;SWAP
JUMPE T1,$4 ;DON'T TRY COMPARE IF DUMMY RUN
CAMN T1,RQ ;OR IF EQUAL
CAIN T1,-1 ;AND END DUMMY RUN
JRST $4
HRRZ J,RN.LSR(U) ;EQUAL, TEST IF LOSER(U) < R
HRRZ J,RN.REC(J)
COMPARE (R,J)
JRST $2 ;KEY(R) = KEY(J) ;TEST
JRST $3 ;KEY(R) > KEY(J) ;SWAP
JRST $4 ;KEY(R) < KEY(J) ;OK
$2% SKIPGE SRTDN ;SEE WHICH VERSION OF TEST REQUIRED
JRST $5 ;IN MERGE PHASE
HRRZ T2,RN.LSR(U) ;GET LOSER AGAIN
HLRZ T1,RN.SEQ(S) ;GET SEQ(R)
HLRZ T2,RN.SEQ(T2) ;GET SEQ(LOSER(U))
CAMG T1,T2 ;SEE WHICH CAME FIRST
JRST $4 ;KEY(R) < KEY(J)
JRST $3 ;KEY(R) > KEY(J)
$5% HRRZ T2,RN.LSR(U) ;GET LOSER AGAIN
HLRZ T2,RN.FCB(T2) ;GET FILE IT CAME FROM
HLRZ T1,RN.FCB(S)
HLRZ T1,FILRUN(T1) ;GET RUN # OF RECORD IN R
HLRZ T2,FILRUN(T2) ;GET RUN # OF RECORD IN J
CAMG T1,T2 ;SEE WHICH CAME FIRST
JRST $4 ;KEY(R) < KEY(J)
; JRST $3 ;KEY(R) > KEY(J)
$3% MOVE T1,<RN.RUN+RN.LSR>/2(U) ;GET RUN# AND LOSER
HRRM S,RN.LSR(U) ;SET NEW LOSER
HRRZ S,T1 ;SWAPED WITH S
HRRZ R,RN.REC(S) ;RESET RECORD PTR SO WE MATCH
MOVE T2,RQ ;CURRENT RUN#
HRLM T2,RN.RUN(U) ;SWAP
HLRZM T1,RQ ;...
$4%
;NOW SEE IF AT TOP YET
CAMG U,FSTNOD ;AT NODE #1?
RETURN ;YES
HLRZ U,RN.FI(U) ;RESET CURRENT WINNER AND TRY AGAIN
JRST $1 ;AND CONTINUE
END;
BEGIN
PROCEDURE (PUSHJ P,CLSRUN)
;HERE TO OPEN NEW TEMP FILE
PUSHJ P,CLSFIL ;CLOSE FILE
PUSHJ P,SETPAS ;RENDER FILE PASSIVE
IFE FTOPS20,<
PUSHJ P,OPOFIL ;OPEN NEW FILE
>
PUSHJ P,ENTFIL ;ENTER NEW FILE NAME
SETZM FILSIZ(F)
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,FSTRUN)
;INITIALIZE TEMP FILE FOR FIRST RUN
;USES P1, P2
SETZM FILSIZ(F) ;CLEAR NUMBER OF RECORDS IN FILE
IFE FTOPS20,<
PUSHJ P,OPOFIL ;OPEN FILE FOR OUTPUT
MOVEI P1,T.BLK ;[215] SET UP CALL TO BUFRNG
SKIPE SRTDN ;IF ON MERGE PHASE
SKIPA P2,OBUFNO ;[215] THEN USE OUTPUT #
MOVE P2,TBUFNO ;[215] ELSE USE .TMP #
PUSHJ P,BUFRNG ;CREATE BUFFER RING
>
SETZM BUFALC ;FIRST TIME, SO ALLOCATE BUFFER
PUSHJ P,ENTFIL ;ENTER FILE
SETOM BUFALC ;REUSE BUFFERS FROM NOW ON
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,SETMRG)
MOVE T1,NUMINP ;GET NO. OF INPUT FILES
CAIG T1,1 ;NEED AT LEAST 2 INPUT FILES
JRST E$$ATF ;ERROR
CAMLE T1,MAXTMP ;MORE THAN WE CAN HANDLE
MOVE T1,MAXTMP ;YES, USE MAX
MOVEM T1,ACTTMP
MOVEM T1,NUMRCB ;THIS IS NO. OF RECORDS IN MEMORY
MOVN T1,T1
ADDB T1,NUMINP ;NO. LEFT FOR NEXT TIME
IFE FTCOBOL,<
CAIE T1,1 ;CHECK FOR SPECIAL CASE
>
AOSA NUMRCB ;PLUS ONE FOR LASTREC
AOSA NUMINP ;YES, MAKE IT 2 FOR NEXT TIME
FASTSKIP
SOS ACTTMP ;AND ONE LESS THIS TIME
RETURN
END;
SUBTTL MERGE. -- MERGE% - Begin a Merge Cycle
BEGIN
PROCEDURE (PUSHJ P,MERGE%)
IF HERE FOR FIRST TIME (NOT A MERGE CYCLE) AND NOT /MERGE
SKIPG MRGSW
SKIPGE SRTDN ;-1 ON MERGE CYCLES
JRST $T
THEN THE OUTPUT FILE IS AT TMPFCB
MOVEI F,TMPFCB ;PTR TO FCB OF TEMPORARY OUTPUT FILE
JRST $F
ELSE ON MERGE CYCLE OUTPUT FILE IS AT FCBORG
MOVEI F,FCBORG ;FCB OF MERGE OUTPUT FILE
FI;
SKIPLE MRGSW ;ALREADY SETUP IF /MERGE
JRST $3 ;YES, JUST CLOSE RUN
IF WE HAVE NO OUTPUT FILE
SKIPN NUMTMP ;ANY OUTPUT FILES?
THEN SET RETRN. ADDRESS AND RETURN TO CALLER
JRST MERGE0
FI;
;DUMP IN MEMORY TREE
IF FIRST TIME THROUGH
SKIPGE SRTDN ;0 ON FIRST TIME
JRST $F ;NOT
THEN OUTPUT RECORD STORED IN LSTREC TO CURRENT RUN
HRRZ R,LSTREC ;FLUSH LAST RECORD FIRST
JSP P4,PTTREC ;WE KNOW IT IS IN THIS RUN
HRRZ R,RN.REC(S) ;RESET RECORD PTR
FI;
$1% HLLOS RQ ;MAKE SURE NOT IN THIS RUN
PUSHJ P,SETTRE ;SET DUMMY RECORD IN TREE
SKIPN T1,RQ ;GET RUN NUMBER OF RECORD IN (R)
JRST $1 ;STILL ON DUMMY RUN
CAIN T1,-1 ;TEST FOR END CONDITION
JRST $3 ;ALL DONE
CAMN T1,RC
JRST $2 ;STILL IN CURRENT RUN
MOVEM T1,RC ;RESET CURRENT RUN (ONLY HAPPENS AFTER DUMMY)
PUSHJ P,CLSRUN ;CLOSE THIS RUN
$2% JSP P4,PTTREC ;WRITE IT OUT
JRST $1 ;LOOP FOR ALL IN-MEMORY RECORDS
$3%
IF FIRST TIME
SKIPGE SRTDN
JRST $F
THEN STORE NO. OF RUNS
MOVE T1,NUMTMP ;GET NUMBER OF RUNS ON SORT PASS
MOVEM T1,RUNTOT ;SAVE FOR ENDS. CODE
SETOM SRTDN ;SIGNAL THAT WE'VE BEEN HERE
SETZM WSCSW ;CLEAR CHECK FLAG SINCE ITS ALL DONE WITH
FI;
;CLOSE OUT LAST TEMP FILE
PUSHJ P,CLSFIL ;CLOSE FILE
PUSHJ P,SETPAS ;RENDER FILE PASSIVE
IF ONLY ONE TEMP FILE
MOVE T1,NUMTMP ;GET NO. OF TEMP FILES
THEN COPY (OR RENAME) IT
SOJLE T1,MERGE1 ;ONLY ONE, COPY IT
FI;
IFN FTCOBOL&<1-FTOPS20>,< ;ONLY FOR TOPS-10 COBOL SORT
IF /MERGE FOR FIRST TIME NEEDING REAL MERGE PASSES
SKIPLE MRGSW
SKIPE MRGNUM
JRST $F ;NO
THEN SETUP EXTRA CHANNELS NOW
MOVE T1,CHNMAP+0 ;DONE WITH OUTPUT CHAN
MOVEM T1,CHNMAP+1 ;SO MAKE IT FIRST INPUT
SETZM CHNMAP+0 ;AVOID CONFUSION
MOVN P1,NUMTMP ;GET NUMBER OF FILES NEEDED
HRLZI P1,1(P1) ;WE ALREADY HAVE ONE
$5% PUSHJ P,GTMCHN ;GET CHANNEL
MOVEM T1,CHNMAP+2(P1) ;STORE IT
AOBJN P1,$5 ;LOOP
FI;
>
IFE FTKI10!FTKL10,<
MOVE T1,[DFBORG,,TMPFCB]
MOVE T2,[DFBLEN,,DFBLEN]
>
IFN FTKI10!FTKL10,<
DMOVE T1,[DFBORG,,TMPFCB
DFBLEN,,DFBLEN]
>
MOVE T3,MAXTMP ;NO. TO COPY BACK
$4% MOVE T4,T1 ;GET TEMP COPY
ADD T1,T2 ;ADVANCE TO NEXT
BLT T4,-1(T1) ;COPY PART WE NEED
ADDI T1,FCBLEN-DFBLEN ;ADVANCE RHS TO NEXT ALSO
SOJG T3,$4 ;LOOP
MOVE T1,NUMTMP ;NUMBER OF TEMPORARY FILES
MOVEM T1,NUMLFT ;STILL TO DO
SETZM NUMTMP ;START COUNTING AGAIN IF WE HAVE TO
CAMLE T1,MAXTMP ;MORE THAN MAXTMP ?
MOVE T1,MAXTMP ;YES, INITIALIZE ONLY LOWEST ONES
MOVEM T1,ACTTMP ;NO. ACTIVE THIS TIME
MOVEM T1,NUMRCB
AOS NUMRCB ;ONE FOR LSTREC TO HOLD AT EOF TIME
IMULI T1,RN.LEN ;SIZE OF TREE
ADD T1,TREORG ;+ BASE
MOVEM T1,TREEND
MOVE T1,NUMRCB
IMUL T1,REKSIZ
ADD T1,TREEND ;+ BASE
MOVEM T1,RCBEND ;TOP OF RECORDS
IFE FTOPS20,<
MOVEM T1,BUFPTR ;SAVE START OF BUFFER POOL
>
SETZM BUFALC ;MAKE SURE WE ALLOCATE
PUSHJ P,RFMBFP ;REFORMAT BUFFER POOL FOR MERGE
PUSHJ P,INITRE ;INITIALIZE THE TREE WITH NULLS
PUSHJ P,GETACT ;SETUP AT MOST MAXTMP FILES
IF NOT MORE THAN MAXTMP FILE
SKIPN T1,NUMLFT ;MORE THAN MAXTMP TMP FILES ?
THEN DO IN ONE PASS
JRST MERGE2 ;NO, FINAL MERGE PASS NOW
FI;
;MERGE AT MAXTMP TO 1 RATE
MOVN T1,MAXTMP ;-NO. OF TEMP FILES ALLOWED
HRLZM T1,TCBIDX ;RESET NAME INDEX
SETZM NUMENT ;START ENTERS AGAIN
IFN FTCOBOL&<1-FTOPS20>,< ;ONLY FOR TOPS-10 COBOL SORT
IF FIRST TIME
SKIPE MRGNUM ;IF FIRST TIME
JRST $F
THEN GET EXTRA CHANNEL
PUSHJ P,GTMCHN ;GET EXTRA CHANNEL FOR MERGE
MOVEM T1,CHNMAP+0 ;SAVE IT
FI;
>
AOS MRGNUM ;INCREMENT MERGE PASS NUMBER
MOVEI T1,DELEOF ;
MOVEM T1,PHYEOF ;DELETE FILE IF PHYSICAL EOF
MOVEI T1,MRGEOF
MOVEM T1,LOGEOF ;GET NEXT RUN
MOVEI F,FCBORG
PUSHJ P,FSTRUN ;OPEN NEW OUTPUT FILE
JSP P4,PTTREC ;OUTPUT CURRENT WINNER TO FREE UP
;SPACE FOR NEXT RECORD
BEGIN
;LOOP TO READ FROM ALL TEMP FILES AND OUTPUT TO NEW TEMP FILE
;NOTE THIS LOOP EXITS VIA END-OF-FILE EXITS
$1% HLRZ F,RN.FCB(S) ;GET FCB OF RECORD JUST OUTPUT
JSP P4,GTTREC ;GET NEXT RECORD FROM SAME FILE
PUSHJ P,@EF ;HANDLE E-O-F
PUSHJ P,SETTRE ;SET NEW RECORD IN TREE
MOVEI F,FCBORG ;FCB OF OUTPUT FILE
MOVE T1,RQ ;GET RUN #
CAMN T1,RC ;SAME AS CURRENT?
JRST $2 ;YES, OUTPUT IT
MOVEM T1,RC ;RESET
PUSHJ P,CLSRUN ;CLOSE THE RUN
$2% JSP P4,PTTREC
JRST $1 ;LOOP
END;
END;
BEGIN
PROCEDURE (PUSHJ P,DELEOF)
PUSHJ P,DELFIL ;DELETE TEMP FILE NOW
PUSHJ P,RELFIL ;AND RELEASE THE DEVICE
SOSG T1,ACTTMP ;LAST RUN YET?
JRST MERGE% ;YES, TRY AGAIN
HLLOS RQ ;NO, SO RETURN WITH DUMMY RECORD
SKIPLE NUMLFT ;ON THE LAST CYCLE?
RETURN ;NOT YET
MOVE T2,NUMENT ;GET NUMBER OF NEW RUNS
ADDI T2,(T1) ;TOTAL RUNS LEFT TO DO
CAMG T2,MAXTMP ;CAN WE GO STRAIGHT TO OUTPUT?
JRST MRGLST ;YES
REPEAT 0,< ;NOT WORKING YET
MOVE T2,NUMENT ;GET NEW RUNS AGAIN
IDIV T2,MAXTMP ;SEE HOW MANY PASSES
JUMPE T3,$1 ;WITH ANY LUCK WE WON'T GET ANY MORE RUNS
ADDI T1,(T3) ;REMAINDER+ WHATS LEFT FROM THIS
CAMG T1,MAXTMP ;CAN WE DO IT IN 1 PASS?
JRST MRGNXT ;YES, START NEXT MERGE PASS
>;END REPEAT 0
$1% RETURN ;NO, CONTINUE UNTIL WE CAN
END;
BEGIN
PROCEDURE (PUSHJ P,MRGEOF)
JSP P4,GTTREC ;GET FIRST RECORD OF NEXT RUN
JRST E$$RIE ;SOMETHING WRONG
SOS NUMLFT ;1 LESS LEFT TO READ NOW
MOVE T1,RQ ;GET RUN #
CAIN T1,-1 ;INCASE JUST RETURNED FROM DELEOF
RETURN ;YES, RETURN TO CALLER
PUSH P,S ;SAVE WHO WE ARE
PUSHJ P,SETTRE ;GET NEW WINNER
POP P,U ;GET BACK ORIGINAL RECORD
CAMN S,U ;WAS IT THE WINNER?
AOS RQ ;YES, SO FORSE INTO NEXT RUN
RETURN ;RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,MRGLST)
;HERE WHEN WE CAN FINISH MERGE IN THIS PASS. COMPLICATED BY THE FACT THAT SOME
;FILES (ACTTMP) ARE STILL OPEN, WHILE OTHERS (NUMTMP) ARE NOT YET. FIRST SEE IF
;WE HAVE MORE THAN ONE RUN IN MEMORY.
MOVN U,NUMRCB ;NO. OF NODES
HRLZ U,U
HRR U,TREORG ;AOBJN PTR
$1% HLRZ T1,RN.RUN(U) ;GET RUN #
CAIN T1,-1 ;IGNORE DUMMY AT END
JRST $2
CAMLE T1,RC ;IN CURRENT RUN?
JRST $3 ;NO, WE MUST FLUSH THIS RUN OUT
$2% ADDI U,RN.LEN-1
AOBJN U,$1 ;LOOP
JRST $4 ;DID N'T FIND ANYTHING TO DO
$3% PUSHJ P,SETTRE ;OUTPUT RECORD TO TREE
MOVEI F,FCBORG ;FCB OF OUTPUT FILE
MOVE T1,RQ ;GET RUN #
CAME T1,RC ;SAME AS CURRENT?
JRST $4 ;NO, SO WE ARE THROUGH
JSP P4,PTTREC ;OUTPUT THE RECORD
HLRZ F,RN.FCB(S) ;GET FCB OF RECORD JUST OUTPUT
JSP P4,GTTREC ;GET NEXT RECORD FROM SAME FILE
PUSHJ P,@EF ;HANDLE E-O-F
JRST $3 ;PUT IN TREE
$4% MOVEI F,FCBORG ;OUTPUT CHAN
PUSHJ P,CLSFIL ;CLOSE IT
PUSHJ P,SETPAS ;RENDER FILE PASSIVE
HRRZS TCBIDX ;GET NO. OF DORMANT FILES
SOS TCBIDX ;BACKUP TO POINT TO LAST FILE WRITTEN
IFE FTCOBOL,<
IFE FTOPS20,<
MOVE T1,FILBUF(F) ;GET WHERE BUFFERS START
>
IFN FTOPS20,<
HRRZ T1,FILBUF(F) ;GET PTR TO START OF BUFFERS
MOVX T2,FI.DSK ;IS THIS A DISK FILE?
TDNE T2,FILFLG(F) ; ..
LSH T1,POW2(PGSIZ) ;IF SO, CONVERT PG TO ADDR
>
MOVEM T1,BUFPTR ;SO WE CAN REALLOCATE FOR OUTPUT
PUSHJ P,INIOUT ;OPEN OUTPUT MASTER FILE
>
IFN FTCOBOL&<1-FTOPS20>,< ;ONLY FOR TOPS-10 COBOL SORT
PUSHJ P,RTMCHN ;RETURN THE EXTRA MERGE CHAN
>
BEGIN
MOVN U,NUMRCB ;GET AOBJN PTR AGAIN
HRLZ U,U
HRR U,TREORG
$1% HLRZ T1,RN.RUN(U) ;GET RUN # OF LOSER
CAIN T1,-1 ;IGNORE IF NOT DUMMY
SUBI T1,2 ;REDUCE BY 2 SO DUMMY IS NOW 777775
HRLM T1,RN.RUN(U) ;REPLACE IN TREE
ADDI U,RN.LEN-1
AOBJN U,$1 ;LOOP
SOS RQ ;REDUCE CURRENT RUN #
SOS RQ ;...
END;
BEGIN
;NOW READ ALL RECORDS FROM TREE
;IF RECORD IS A REAL ONE PUT IT BACK WITH RUN # 777776
;IF RQ = 777775 THEN IT WAS A DUMMY
;OPEN A NEW TEMP FILE AND PUT NEW RECORD IN TREE
$1% MOVE T1,RQ ;GET RUN #
CAIN T1,-2 ;SEE IF END OF CONVERSION
JRST $E ;YES
CAIE T1,-3 ;SEE IF A NEW DUMMY
JRST $2 ;NO
SKIPGE TCBIDX ;ANY MORE DORMANT FILES?
JRST [HLLOS RQ ;NO
JRST $3] ;PUT REAL DUMMY BACK
HLRZ F,RN.FCB(S) ;GET FILE THAT WAS LAST USED
PUSHJ P,SETACT ;GET A PASSIVE FILE
SETZM FILCNT(F) ;CLEAR COUNT
IFE FTOPS20,<
PUSHJ P,OPIFIL ;OPEN DEVICE FOR INPUT AGAIN
>
PUSHJ P,LKPFIL ;LOOKUP NEW FILE
AOS ACTTMP ;ONE MORE FILE NOW
JSP P4,GTTREC ;GET FIRST RECORD
JRST E$$RIE
$2% MOVEI T1,-2
MOVEM T1,RQ ;PUT RECORD BACK WITH TERMINAL #
$3% PUSHJ P,SETTRE ;PUT IN TREE
JRST $1 ;SEE WHAT POPPED UP
END;
BEGIN
;INCREASE REAL RUN NUMBERS BY 3 (TO +1)
MOVN U,NUMRCB ;GET AOBJN PTR AGAIN
HRLZ U,U
HRR U,TREORG
$1% HLRZ T1,RN.RUN(U) ;GET RUN # OF LOSER
CAIE T1,-1 ;LEAVE REAL DUMMY ALONE
ADDI T1,3 ;INCREMENT SO DUMMY IS NOW 777777
HRLM T1,RN.RUN(U) ;REPLACE IN TREE
ADDI U,RN.LEN-1
AOBJN U,$1 ;LOOP
SETZM RQ
AOS RQ ;INCREMENT CURRENT RUN #
END;
BEGIN
;SETUP END-OF-FILE TRAPS AND RETURN TO TOP LEVEL
SETOM MRGDN ;SIGNAL DONE WITH TEMP MERGES
MOVEI T1,EOF15
HRRZM T1,LOGEOF
HRRZM T1,PHYEOF
IFE FTCOBOL,<
MOVEI F,FCBORG
JSP P4,PUTREC ;WE ALREADY HAVE FIRST RECORD IN R
>
MOVEI T1,RETRN2 ;WHICH RETRN. ROUTINE TO USE
MOVEM T1,$RETRN
MOVE P,PSAV
END;
RETURN
END;
;INITIALIZE AT MOST MAXTMP ACTIVE RUNS FOR INPUT
BEGIN
PROCEDURE (PUSHJ P,GETACT)
PUSH P,NUMTMP ;SAVE NUMTMP
MOVN T1,ACTTMP ;MINUS THE RUNS WE WILL DO THIS TIME
ADDM T1,NUMLFT ;RESIDUAL RUNS
MOVEI F,FCBORG+1 ;PTR TO FIRST FCB FOR INPUT FILE
HRL F,T1 ;AOBJN PTR
MOVE S,TREORG ;GET FIRST "WINNER"
HRRZ R,RN.REC(S) ;AND RECORD
$1% ADDI F,FCBLEN-1 ;NEXT FILE
SKIPN BUFALC ;ALREADY ALLOCTED BUFFER RING ?
PUSHJ P,OBLFIL ;NO, SET IT UP FOR INPUT
JSP P4,GTTREC ;GET FIRST RECORD OF TEMP FILE
JRST E$$RIE ;SOMETHING WRONG
AOS RQ ;WILL BE RUN #1
HRLM F,RN.FCB(S) ;INDICATE WHICH FILE RECORD CAME FROM
AOS T1,NUMTMP ;RE-INITIALIZE THE RUN NUMBERS
HRLM T1,FILRUN(F) ;SAVE IN DFBORG BLOCK
PUSHJ P,SETTRE ;SET NEW RECORD IN TREE
HRRZ R,RN.REC(S) ;SET UP RECORD PTR
AOBJN F,$1 ;GET NEXT RECORD
POP P,NUMTMP ;RESTORE NUMTMP
AOS RC ;SET CURRENT RUN TO #1
SETOM BUFALC ;INDICATE BUFFER RNGS FORMED
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,OBLFIL)
;SETUP FILE FOR INPUT -- DO OPEN, SET UP BUFFERS, AND LOOKUP
SETZM FILCNT(F) ;CLEAR BUFFER COUNT
IFE FTOPS20,<
PUSHJ P,OPIFIL ;OPEN FILE FOR INPUT
MOVEI P1,T.BLK ;[215] SET UP CALL TO BUFRNG
MOVE P2,TBUFNO ;[215] ..
PUSHJ P,BUFRNG ;FORM BUFFER RING
>
PJRST LKPFIL ;PERFORM LOOKUP
END;
SUBTTL MERGE. -- MERGE0 - 0 Temporary Files
BEGIN
PROCEDURE (PUSHJ P,MERGE0)
MOVEI T1,RETRN0
MOVEM T1,$RETRN ;WHERE TO GO
IFE FTCOBOL,<
IFE FTOPS20,<
MOVE T2,RCBEND ;START OF BUFFERS
MOVEM T2,BUFPTR ;POINT TO THEM
MOVE T1,.JBREL ;TOP OF MEMORY
SUB T1,T2 ;SEE WHATS FREE
MOVE T2,F.OXBK ;[215] GET OUTPUT BUFFER SIZE
IDIV T1,X.DVSZ(T2) ;[215] DIVIDE BY BUFFER SIZE
>
IFN FTOPS20,<
MOVE T1,BUFPT1 ;GET ORIGINAL BUFPTR
MOVEM T1,BUFPTR ;RESET BUFPTR
MOVE T1,BUFSZ ;GET SIZE OF BUFFER POOL
IDIV T1,OBUFSZ ;DIVIDE BY OUTPUT BUFFER SIZE
JUMPE T1,E$$NRO
>
MOVEM T1,OBUFNO ;RESET NUMBER OF OUTPUT BUFFERS
PUSHJ P,INIOUT ;INIT OUTPUT MASTER
>
SKIPG LSTREC ;LSTREC TO FLUSH FIRST?
IFE FTCOBOL,<
RETURN
>
IFN FTCOBOL,<
PJRST RETRN0 ;GET FIRST RECORD FOR COBOL
>
MOVE R,LSTREC ;YES, GET RECORD PTR
IFE FTCOBOL,<
JSP P4,PUTREC ;OUTPUT IT
>
RETURN ;RETURN WITH RECORD IN (R)
END;
SUBTTL MERGE. -- MERGE1 - 1 Temporary File
BEGIN
PROCEDURE (PUSHJ P,MERGE1)
IFN FTCOBOL&<1-FTOPS20>,< ;ONLY FOR TOPS-10 COBOL SORT
SKIPE MRGNUM ;DID WE DO ANY MERGE PASSES?
PUSHJ P,RTMCHN ;YES, THEN RETURN EXTRA CHAN
>
IFE FTCOBOL!FTFORTRAN,<
PUSHJ P,TSTDEV ;SEE IF SAME DEVICE
>
MOVEI T1,RETRN1 ;WE WILL HAVE TO COPY
MOVEM T1,$RETRN ;SET RETRN. ADDRESS
MOVEI T1,EOFSNG ;END OF FILE TRAP
MOVEM T1,LOGEOF
MOVEM T1,PHYEOF
MOVE T2,RCBEND ;START OF BUFFERS
MOVEM T2,BUFPTR ;POINT TO THEM
IFE FTOPS20,<
MOVE T1,LOSIZE ;TOP OF MEMORY
SUB T1,T2 ;SEE WHATS FREE
IFE FTCOBOL,<
MOVE T2,F.OXBK ;[215] GET OUTPUT BUFFER SIZE
MOVE T2,X.DVSZ(T2) ;[215] SIZE OF OUTPUT BUFFER
IDIVI T1,.TBS(T2) ;DIVIDE BY COMBINED BUFFER SIZE
>
IFN FTCOBOL,<
IDIVI T1,.TBS ;INPUT TEMP BUFFERS ONLY
>
MOVEM T1,TBUFNO ;RESET NUMBER
IFE FTCOBOL,<
MOVEM T1,OBUFNO ;RESET NUMBER OF OUTPUT BUFFERS
PUSHJ P,INIOUT ;INIT OUTPUT MASTER
>;END IFE FTCOBOL
>;END IFE FTOPS20
IFN FTOPS20,<
MOVE T1,BUFSZ ;GET SIZE OF BUFFER POOL
IFE FTCOBOL,< ;IF NOT COBOL, WE HAVE OUTPUT FILE
MOVE T2,OBUFSZ ;GET OUTPUT FILE BUFFER SIZE
IDIVI T1,PGSIZ(T2) ;DIVIDE BY COMBINED BUFFER SIZE
>
IFN FTCOBOL,< ;IF COBOL, WE ONLY HAVE TEMP FILE
LSH T1,-<POW2(PGSIZ)> ;DIVIDE BY TEMP BUFFER SIZE
>
MOVEM T1,TBUFNO ;SAVE NO. OF TEMP AND OUTPUT BUFFERS
IFE FTCOBOL,<
MOVEM T1,OBUFNO
SETZM BUFALC ;FORCE BUFFER ALLOCATION
PUSHJ P,INIOUT ;OPEN THE OUTPUT FILE
>
>;END IFE FTOPS20
SETZM TCBIDX ;SO WE GET FIRST FILE AGAIN
MOVEI F,TMPFCB
PUSHJ P,OBLFIL ;LOOKUP TEMP FILE AGAIN
IFN FTCOBOL,<
MOVEI F,TMPFCB
JSP P4,GTTREC ;GET FIRST RECORD FROM TEMP FILE
JRST @EF ;E-O-F
>
MOVE P,PSAV
RETURN
END;
SUBTTL MERGE. -- MERGE2 - Final Merge of 2 or More Temporary Files
BEGIN
PROCEDURE (PUSHJ P,MERGE2)
SETOM MRGDN ;SIGNAL DONE WITH TEMP MERGES
MOVEI T1,EOF15
HRRZM T1,LOGEOF
HRRZM T1,PHYEOF
IFN FTCOBOL&<1-FTOPS20>,<
SKIPE MRGNUM ;DID WE DO ANY MERGE PASSES?
PUSHJ P,RTMCHN ;YES, THEN RETURN EXTRA CHAN
>
IFE FTCOBOL,<
PUSHJ P,INIOUT ;OPEN SORT.OUT
JSP P4,PUTREC ;WE ALREADY HAVE FIRST RECORD IN R
>
MOVEI T1,RETRN2 ;WHICH RETRN. ROUTINE TO USE
MOVEM T1,$RETRN
MOVE P,PSAV
RETURN
END;
SUBTTL RETRN. -- RETRN% - Return Record From Tree to Output File
IFE FTCOBOL,<
BEGIN
PROCEDURE (PUSHJ P,RETRN.)
MOVEM P,PSAV
SETOM MRGDN ;SO WE GO TO PUTREC
$1% PUSHJ P,RETRN% ;READ A RECORD
MOVEI F,FCBORG ;POINT TO OUTPUT FILE
JSP P4,PUTREC ;WRITE IT OUT
JRST $1 ;LOOP
RETURN
END;
>
BEGIN
PROCEDURE (PUSHJ P,RETRN%)
PJRST @$RETRN ;GO TO RIGHT ROUTINE
END;
SUBTTL RETRN. -- RETRN0 - 0 Temporary Files
BEGIN
PROCEDURE (PUSHJ P,RETRN0)
;HERE TO WRITE ALL IN-MEMORY RECORDS TO OUTPUT MASTER FILE
HLLOS RQ ;MAKE SURE NOT IN THIS RUN
HRRZ U,RN.FE(S) ;GET NODE JUST ABOVE
PUSHJ P,SETTRE ;SET DUMMY RECORD IN TREE
SKIPN T1,RQ ;GET RUN NUMBER OF RECORD IN (R)
JRST RETRN0 ;STILL ON DUMMY RUN
CAIN T1,-1 ;TEST FOR END CONDITION
JRST EOFOUT ;ALL DONE
CAME T1,RC
MOVEM T1,RC ;RESET CURRENT RUN (ONLY HAPPENS AFTER DUMMY)
RETURN
END;
SUBTTL RETRN. -- RETRN1 - 1 Temporary File
BEGIN
PROCEDURE (PUSHJ P,RETRN1)
;HERE TO COPY SINGLE TEMP FILE TO OUTPUT FILE
MOVEI F,TMPFCB
JSP P4,GTTREC ;GET A RECORD FROM TEMP FILE
JRST @EF ;E-O-F
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,EOFSNG)
PUSHJ P,DELFIL ;DELETE TEMP FILE
PUSHJ P,RELFIL ;RELEASE DEVICE
JRST EOFOUT ;FORCE OUT LAST RECORD
END;
SUBTTL RETRN. -- RETRN2 - Final Merge of 2 or More Temporary Files
BEGIN
PROCEDURE (PUSHJ P,RETRN2)
HLRZ F,RN.FCB(S) ;GET WHICH FILE
JSP P4,GTTREC ;GET A RECORD
PUSHJ P,@EF ;E-O-F RETURN
PUSHJ P,SETTRE ;SET NEW RECORD IN TREE
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,EOF15)
PUSHJ P,DELFIL ;DELETE TEMP FILE
PUSHJ P,RELFIL ;RELEASE CHAN
SOSG ACTTMP ;ALL DONE?
JRST EOFOUT ;YES
HLLOS RQ ;SET TERMINATING RUN#
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,SETPAS)
HRRZ T1,TCBIDX ;GET CURRENT POS
IMULI T1,DFBLEN
ADDI T1,DFBORG ;POSITION IN MEMORY
HRL T1,F
HRRZI T2,DFBLEN(T1) ;BLT PTR LIMIT
BLT T1,-1(T2) ;COPY FILE
MOVE T1,TCBIDX
AOBJN T1,$1 ;INCREMENT PTR
MOVN T1,T1 ;GET NUMBER
HRLZ T1,T1 ;START AGAIN
$1% MOVEM T1,TCBIDX ;STORE BACK
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,SETACT)
HRRZ T1,TCBIDX ;GET CURRENT POS
IMULI T1,DFBLEN
ADDI T1,DFBORG ;POSITION IN MEMORY
HRLZ T1,T1 ;FROM
HRR T1,F ;TO
HRRZI T2,DFBLEN(T1) ;BLT PTR LIMIT
BLT T1,-1(T2) ;COPY FILE
SOS TCBIDX ;REDUCE INDEX
RETURN
END;
SUBTTL GETREC -- GETREC - Get Next Record From Input File
IFE FTCOBOL,<
BEGIN
PROCEDURE (JSP P4,GETREC)
;GETREC RETURNS THE NEXT RECORD FROM THE INPUT FILE (OR NEXT ONE IF MERGING).
;FIRST, HANDLE ANY BLOCKING FACTOR FOR THIS FILE BY COUNTING DOWN THE RECORDS
;READ IN THIS BLOCK AND SKIPPING TO THE NEXT BLOCK IF IT'S TIME. THEN, RETURN
;THROUGH THE PROPER GET-RECORD ROUTINE BASED ON THE FILE'S I/O MODE. ALL OF THE
;LOWER-LEVEL GET-RECORD ROUTINES GETREC CALLS RETURN THROUGH THE KEY EXTRACTION
;CODE.
;
;CALL WITH:
; F/ POINTER TO FCB
; R/ POINTER TO RCB
; JSP P4,GETREC
;
;RETURNS EITHER:
; MOVE EF,PHYEOF!LOGEOF
; JRST 0(P4) ;END-OF-FILE
;OR:
; JRST 1(P4) ;NORMAL
MOVEM R,RSAV
IFE FTFORTRAN,<
$1% SKIPE T1,FILBLK(F) ;BLOCKED FILE?
AOBJP T1,[MOVN T1,T1 ;RESET BLOCKING FACTOR
HRLZM T1,FILBLK(F) ;REFORM AOBJN PTR
IFN FTOPS20,<
MOVX T1,FI.BLK ;TELL GETBUF TO BLOCK FILE
IORM T1,FILFLG(F) ; AS IF ON TOPS-10
>;END IFN FTOPS20
JSP T4,GETBUF ;FILL BUFFER
RETURN ;EOF
HRRZ T3,IOMODE ;[201] FETCH I/O MODE
CAIN T3,MODEBCDIC ;IF EBCDIC
SKIPL FILFLG(F) ;AND VARIABLE
JRST $1 ;NO
AOS FILPTR(F) ;BYPASS FILE DESCRIPTOR WORD
MOVNI T3,4
ADDM T3,FILCNT(F)
JRST $1]
MOVEM T1,FILBLK(F) ;STORE BLOCKING FACTOR BACK
>
SKIPE T1,FILCNT(F) ;NUMBER WORDS REMAINING IN CURRENT BUFFER
JRST $2 ;STILL SOME
JSP T4,GETBUF ;BUFFER EXHAUSTED, ADVANCE TO NEXT
RETURN ;GIVE ERROR RETURN
$2%
CASE MODE OF (GETSXR,GETASR,GETEBR,GETBNR)
HRRZ T3,IOMODE ;[201] FETCH I/O MODE INDEX
JRST @[EXP GETSXR,GETASR,GETEBR,GETBNR]-1(T3)
ESAC;
END;
SUBTTL GETREC -- GETSXR - Get SIXBIT Record
;STILL IN IFE FTCOBOL
IFE FTFORTRAN,<
BEGIN
PROCEDURE (JSP P4,GETSXR)
HRRZ T3,FILPTR(F) ;ADDRESS OF NEXT RECORD
HRRZ T2,(T3) ;CHECK SIXBIT COUNT WORD
MOVX T1,FI.MTA ;IS THIS A MAGTAPE?
TDNE T1,FILFLG(F) ;IF SO, L.H. MIGHT HAVE JUNK
HRRZS 0(T3) ; SO CLEAR IT OUT
AOS FILPTR(F) ;ACCOUNT FOR WORD READ
SOS T1,FILCNT(F) ; ..
JUMPE T2,GETREC ;SIMPLY IGNORE NULL RECORDS
MOVEM T2,RC.CNT(R) ;COPY BYTE COUNT
CAMGE T2,MINKEY ;IS IT BIG ENOUGH?
PUSHJ P,ERRKNR ;NO
ADD R,XTRWRD ;LEAVE SPACE FOR EXTRACTED KEYS
ADDI T2,5+6 ;ACOUNT FOR REMAINDER AND BYTE COUNT WORD
IDIVI T2,6
CAMLE T2,RECSIZ ;LEGITIMTE COUNT ?
PUSHJ P,GETTRC ;NO, TRUNCATE RECORD
SUBI T2,1 ;BUT WE HAVE ALREADY MOVED THE BYTE COUNT
IF RECORD IS CONTAINED IN CURRENT I/O BUFFER
CAIGE T1,(T2) ;IS RECORD CONTAINED IN CURRENT BUFFER ?
JRST $T ;NO, RECORD SPANS BUFFERS
THEN
HRL T3,FILPTR(F) ;YES, SET ORIGIN ADDRESS OF RECORD
HRRI T3,RC.KEY(R) ;SET DESTINATION ADDRESS
ADDI R,(T2) ;PTR TO LAST WORD IN RECORD DESTINATION
BLT T3,0(R) ;TRANSFER RECORD
SUBI T1,(T2)
MOVEM T1,FILCNT(F) ;ADJUST BUFFER COUNT
ADDM T2,FILPTR(F) ;ADVANCE BUFFER POINTER
JRST $F
ELSE COPY PIECEMEAL
MOVEI P1,(T2) ;SIZE OF RECORD (WORDS)
WHILE MORE WORDS STILL WORDS TO READ DO
BEGIN
SKIPE T1,FILCNT(F) ;NUMBER OF WORDS LEFT IN CURRENT BUFFER
JRST $1 ;STILL SOME
JSP T4,GETBUF ;CURRENT BUFFER EXHAUSTED, ADVANCE TO NEXT
JRST E$$RIE ;WARN USER
$1% MOVEI T2,(P1) ;SIZE OF RECORD RESIDUE
CAILE T2,(T1) ;CONTAINED WITHIN CURRENT BUFFER ?
MOVEI T2,(T1) ;NO, TRANSFER ONLY FILCNT WORDS
HRL T3,FILPTR(F) ;PTR TO ORIGIN OF RECORD RESIDUE
HRRI T3,RC.KEY(R) ;PTR TO DESTINATION OF RECORD FRAGMENT
ADDI R,(T2) ;PTR TO END OF RECORD FRAGMENT
BLT T3,0(R) ;TRANSFER RECORD FRAGMENT
SUBI T1,(T2)
MOVEM T1,FILCNT(F) ;ADJUST BUFFER COUNT
ADDM T2,FILPTR(F) ;ADVANCE BUFFER POINTER
SUBI P1,(T2) ;DECREMENT LENGTH OF RECORD RESIDUE
JUMPN P1,$B ;FINISHED ?
END;
FI;
MOVE R,RSAV ;RESTORE R
AOS FILSIZ(F) ;COUNT 1 MORE RECORD
AOJA P4,@EXTRCT ;EXTRACT KEYS AND GIVE OK RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,GETTRC) ;TRUNCATE RECORD ON INPUT
SUB T2,RECSIZ ;REMOVE WHATS OK
MOVEM T2,RECSAV ;SAVE DIFFERENCE
MOVEM P4,P4SAV ;FINAL RETURN
MOVEI P4,GOTTRC ;RETURN HERE
MOVE T2,RECORD ;GET MAX. RECORD COUNT
MOVEM T2,@RSAV ;STORE IT IN RECORD
MOVE T2,RECSIZ ;JUST COPY THIS MUCH
RETURN
END;
BEGIN
PROCEDURE (JSP P4,GOTTRC) ;HERE WHEN FIRST PART OF RECORD COPIED
;HERE TO DELETE REST
JRST E$$RIE ;TRAP NON-SKIP RETURN
AOS P4,P4SAV ;RESTORE SKIP RETURN
MOVE T2,RECSAV ;HOW MUCH MORE TO DELETE
$1% CAMLE T2,FILCNT(F) ;ALL IN THIS BUFFER?
MOVE T2,FILCNT(F) ;NO, USE IT ALL
ADDM T2,FILPTR(F) ;ADVANCE BYTE PTR
MOVN T2,T2
ADDM T2,RECSAV ;COUNT IT DOWN
ADDB T2,FILCNT(F) ;SAME FOR BYTE COUNT
JUMPG T2,$2 ;BUFFER EMPTY?
JSP T4,GETBUF ;YES, GET NEXT
JRST $3 ;[105] AT E-O-F
$2% SKIPE T2,RECSAV ;MORE TO DO?
JRST $1 ;YES
$3% PUSHJ P,ERRRTI ;[105] WARN USER
RETURN
END;
>;END IFE FTFORTRAN
SUBTTL GETREC -- GETASR - Get ASCII Record
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
PROCEDURE (JSP P4,GETASR) ;HERE TO GET NEXT ASCII RECORD
IF FIRST RECORD
SKIPE SEQNO ;[110] FIRST TIME ITS ZERO
JRST $F ;[110] ITS NOT
THEN CHECK FOR SEQUENCE NUMBER
MOVE T1,@FILPTR(F) ;[110] GET FIRST WORD
TRNE T1,1 ;[110] SEQUENCE NUMBER PRESENT?
AOSA T1,SEQNO ;[110] YES
SOSA SEQNO ;[110] NO
MOVEM T1,ALIGN ;[110] FORCE WORD ALIGNMENT
FI;
MOVE T2,FILPTR(F) ;GET COPY OF BYTE PTR
ILDB T1,T2 ;READ FIRST BYTE (WE KNOW ITS IN MEMORY)
IF LINE STARTS WITH NULLS OR LINE TERMINATORS
CAIG T1,.CHCRT ;CHECK FOR NUL LINE
CAIGE T1,.CHLFD ;I.E. LF, FF, VT OR CR ONLY
JUMPN T1,$F ;NO, A REAL LINE IF NOT NULL
THEN EAT IT UP
BEGIN
TLNN T2,760000 ;AT NEW WORD
ADD T2,[430000,,1] ;YES
MOVEM T2,FILPTR(F) ;STORE BACK
SOSLE FILCNT(F) ;COUNT DOWN
JRST GETASR ;AND TRY AGAIN
JSP T4,GETBUF ;RAN OUT, RELOAD NEW BUFFER
JRST 0(P4) ;OK, END OF FILE
JRST GETASR
END;
FI;
IF FIRST CHAR IS ^Z FROM A TTY
CAIE T1,.CHCNZ ;TEST FOR ^Z
JRST $F ;NOT
MOVE T2,FILXBK(F) ;[215] GET DEVCHR BITS
IFE FTOPS20,< ;ON TOPS10,
MOVE T2,X.DVCH(T2) ;[215] ..
TXZ T2,DVCHMD ;[215] CLEAR I/O MODE BITS
CAXE T2,DVCHNL ;[215] NOT TTY: IF NUL:
TXNN T2,DV.TTY ;[215] NOW CHECK FOR TTY:
JRST $F ;[215] NOT--CONTINUE
>;END IFE FTOPS20
IFN FTOPS20,< ;ON TOPS20,
LDB T2,[POINT 9,X.DVCH(T2),17] ;GET DEVICE TYPE
CAXE T2,.DVTTY ;TTY?
JRST $F ;NO, CONTINUE
>;END IFN FTOPS20
THEN RETURN EOF
JRST [MOVE EF,PHYEOF ;SET EOF RETURN
JRST 0(P4)] ;AND RETURN
FI;
MOVE T1,RECORD ;[147] GET RECORD SIZE IN BYTES
MOVEM T1,RC.CNT(R) ;[147] STORE BYTE COUNT
ADD R,XTRWRD ;[147] LEAVE SPACE FOR EXTRACTED KEYS
SKIPGE FILFLG(F) ;HOPE ITS NOT VARIABLE?
JRST GETAVR ;TOO BAD
SKIPL FILPTR(F) ;SEE IF ON A WORD BOUNDARY
JRST GETASN ;ITS NOT
IDIVI T1,5
PUSH P,T2 ;SAVE REMAINDER
MOVE T2,T1
IMULI T2,5 ;INTERGRAL NO. OF BYTES
CAMLE T2,FILCNT(F) ;ALL IN THIS BUFFER?
JRST GETAML ;NO
HRLZ T3,FILPTR(F) ;GET BYTE PTR
HRRI T3,RC.KEY(R) ;DESTINATION
ADDI R,0(T1) ;END OF BLT
SKIPE T1 ;DON'T DO BLT IF NO FULL WORDS
BLT T3,(R) ;MOVE ALL BUT LAST PARTIAL WORD
ADDM T1,FILPTR(F) ;ADJUST BYTE PTR
MOVN T2,RECORD ;NO. OF BYTES USED
ADDM T2,FILCNT(F) ;ACCOUNT FOR THEM
; PJRST GETALW ;NEXT PAGE
END;
;STILL IN IFE FTCOBOL
BEGIN
PROCEDURE (JSP P4,GETALW) ;GET ASCII LAST WORD OF RECORD
SKIPG FILCNT(F) ;WILL LAST WORD FIT?
JRST [JSP T4,GETBUF ;GET NEW BUFFER
JRST E$$RIE ;WARN USER
MOVN T2,(P) ;REMAINDER
ADDM T2,FILCNT(F) ;ADJUST BYTE COUNT
JRST .+1]
$2% POP P,T2 ;GET REMAINDER BACK
JUMPE T2,GETCRL ;ALL DONE
MOVE T1,@FILPTR(F) ;GET FULL WORD
AND T1,ASCMSK(T2) ;ONLY WHAT WE REALLY NEED
MOVEM T1,RC.KEY(R) ;STORE IT
IFE FTKL10,<
IBP FILPTR(F) ;ADJUST BYTE PTR
SOJG T2,.-1
>
IFN FTKL10,<
ADJBP T2,FILPTR(F)
MOVEM T2,FILPTR(F)
>
; PJRST GETCRL ;BELOW
END;
BEGIN
PROCEDURE (JSP P4,GETCRL) ;GET A CRLF
PUSHJ P,RDASBT ;READ AN ASCII BYTE (CR)
GETLF: PUSHJ P,RDASBT ; ... (LF)
MOVE T1,FILPTR(F)
TLNE T1,760000 ;IS IT ON WORD BOUNDARY?
JRST $3 ;NO, EXTRACT KEYS AND RETURN
ADD T1,[430000,,1] ;YES,
MOVEM T1,FILPTR(F) ;ADVANCE TO NEXT WORD
$3% AOS FILSIZ(F) ;COUNT 1 MORE RECORD
MOVE R,RSAV ;RESTORE R
MOVE T1,(R) ;GET CHAR COUNT
CAMGE T1,MINKEY ;IS IT BIG ENOUGH?
PUSHJ P,ERRKNR ;NO
AOJA P4,@EXTRCT ;EXTRACT KEYS AND GIVE OK RETURN
END;
;STILL IN IFE FTCOBOL
BEGIN
PROCEDURE (PUSHJ P,RDASBT) ;READ ASCII BYTE FROM INPUT BUFFER
IF BUFFER IS EMPTY
SOSL FILCNT(F) ;ANYTHING IN BUFFER?
JRST $F ;YES, STILL NOT EMPTY
THEN GET NEXT
JSP T4,GETBUF ;BUFFER EMPTY GET NEXT
JRST E$$RIE ;WARN USER
SOS FILCNT(F) ;COUNT DOWN BYTE WE WILL PICKUP
FI;
ILDB T1,FILPTR(F) ;GET BYTE
JUMPE T1,RDASBT ;IGNORE NULLS
CAIG T1,.CHCRT
CAIGE T1,.CHLFD
FASTSKIP
RETURN
SKIPGE FILFLG(F) ;FIXED OR VARIABLE?
JRST E$$JAL ;VARIABLE
E$$ARL: $ERROR (?,ARL,<ASCII record length incorrect>)
E$$JAL: $ERROR (?,JAL,<Junk in ASCII line>)
END;
ASCMSK: BYTE (7)
BYTE (7) 177
BYTE (7) 177,177
BYTE (7) 177,177,177
BYTE (7) 177,177,177,177
BYTE (7) 177,177,177,177,177
;STILL IN IFE FTCOBOL
BEGIN
PROCEDURE (JSP P4,GETAML) ;HERE WHEN RECORD CROSSES BLOCK BOUNDARY
MOVEI P1,(T1) ;SIZE OF RECORD (WORDS)
$1% SKIPE T1,FILCNT(F) ;NUMBER OF WORDS LEFT IN CURRENT BUFFER
JRST $2 ;STILL SOME
JSP T4,GETBUF ;EMPTY, GET NEXT
JRST E$$RIE ;WARN USER
$2% IDIVI T1,5 ;WORDS IN CURRENT BUFFER
MOVEI T2,(P1) ;SIZE OF RECORD RESIDUE
CAILE T2,(T1) ;CONTAINED WITHIN CURRENT BUFFER
MOVEI T2,(T1) ;NO, TRANSFER ONLY FILCNT WORDS
HRL T3,FILPTR(F) ;PTR TO ORIGIN OF RECORD RESIDUE
HRRI T3,RC.KEY(R) ;PTR TO DESTINATION OF RECORD FRAGMENT
ADDI R,0(T2) ;PTR TO END OF RECORD FRAGMENT -1
BLT T3,1(R) ;TRANSFER RECORD FRAGMENT
MOVNI T1,5 ;5 BYTES PER WORD
IMUL T1,T2 ;- NO. OF WORDS
ADDM T1,FILCNT(F) ;ADJUST BUFFER COUNT
ADDM T2,FILPTR(F) ;ADVANCE BUFFER POINTER
SUBI P1,(T2) ;DECREMENT LENGTH OF RECORD RESIDUE
JUMPN P1,$1 ;FINISHED ?
MOVN T2,(P) ;REMAINDER BYTES
ADDM T2,FILCNT(F) ;ACCOUNT FOR THEM
PJRST GETALW ;GET LAST WORD, SEE IF IN BUFFER
END;
;STILL IN IFE FTCOBOL
BEGIN
PROCEDURE (JSP P4,GETASN) ;HERE FOR ASCII RECORD NOT ON A WORD BOUNDARY
IFE FTKL10,<
LDB T1,[POINT 6,FILPTR(F),5] ;GET BYTE POSITION
MOVNS P1,T1 ;-NO. OF BITS LEFT
ADDI P1,^D36 ;LSHC COUNTER TO RIGHT JUSTIFY 5 BYTES
IDIVI T1,7 ;CONVERT TO BYTES
ADDM T1,FILCNT(F) ;ACCOUNT FOR THEM
ADD T1,RECORD ;NO. OF BYTES TO FOLLOW
IDIVI T1,5 ;NO. OF WORDS
PUSH P,T2 ;SAVE REMAINDER
MOVN T1,T1 ;-NO. OF FULL WORDS TO COPY
HRL R,T1 ;AOBJN PTR
MOVN T3,P1 ;NO. OF BITS TO SHIFT LEFT
ADDI T3,^D35 ;LSHC COUNTER FOR REMAINDER
AOS T2,FILPTR(F) ;ADVANCE BYTE PTR
HRLI T2,(POINT 7,) ; TO BEFORE FIRST BYTE
MOVEM T2,FILPTR(F) ; SO BOTH ILDB AND MOVE @ WORK
MOVE T1,-1(T2) ;GET FIRST WORD
LSH T1,-1 ;RIGHT JUSTIFY
IF THERE ARE FULL WORDS TO MOVE
JUMPGE R,$F ;NO
THEN LOOP FOR REMAINING FULL WORDS
BEGIN
SKIPG FILCNT(F) ;ROOM IN THIS BUFFER?
JRST [PUSH P,T1 ;SAVE PARTIAL
PUSH P,T3 ;LSHC -COUNT
JSP T4,GETBUF ;GET NEW BUFFER
JRST E$$RIE ;WARN USER
POP P,T3
POP P,T1
JRST $1]
$1% MOVE T2,@FILPTR(F) ;GET IT
LSHC T1,(P1) ;35 BITS IN T1
LSH T1,1 ;LEFT JUSTIFY
MOVEM T1,RC.KEY(R) ;STORE
LSHC T1,(T3) ;MOVE REMAINDER INTO T1
MOVNI T2,5
ADDM T2,FILCNT(F) ;ADJUST BYTE COUNT
AOS FILPTR(F) ;AND BYTE PTR
AOBJN R,$B ;LOOP FOR ALL FULL WORDS
END;
FI;
;NOW FOR LAST WORD
SKIPLE FILCNT(F) ;IS BUFFER EMPTY?
JRST $3 ;NO
PUSH P,T1 ;SAVE PARTIAL WORD
JSP T4,GETBUF ;YES, FILL IT
JRST E$$RIE ;WARN USER
POP P,T1 ;RESTORE PARTIAL WORD
$3% POP P,T3 ;GET REMAINDER
JUMPE T3,$4 ;NONE
SKIPA T2,@FILPTR(F) ;GET IT
$4% TDZA T2,T2 ;NO REMAINDER
AND T2,ASCMSK(T3) ;ONLY WHAT WE NEED
LSHC T1,(P1) ;FORM 35 BITS
LSH T1,1
MOVEM T1,RC.KEY(R) ;STORE FIRST WORD
SKIPE T2 ;ONLY ONE WORD
MOVEM T2,RC.KEY+1(R) ;STORE SECOND WORD
JUMPE T3,$5 ;NO REMAINDER
MOVN T3,T3
ADDM T3,FILCNT(F) ;ADJUST BYTE COUNT
IBP FILPTR(F)
AOJL T3,.-1 ;AND BYTE PTR
$5%
>;END OF IFE FTKL10
IFN FTKL10,<
MOVE T0,RECORD ;NO. OF BYTES TO COPY
MOVEI T4,7 ;BYTE SIZE
PUSHJ P,GETEX ;GET RECORD WITH COMMON BIS CODE
>;END IFN FTKL10
PJRST GETCRL ;ALL DONE
END;
;STILL IN IFE FTCOBOL
BEGIN
PROCEDURE (JSP P4,GETAVR) ;GET VARIABLE LENGTH ASCII RECORD
HRLZI T1,1(R) ;FORM BLT PTR
HRRI T1,2(R) ; TO CLEAR ALL OF BUFFER
SETZM 1(R) ;WE MUST DO THIS AT LEAST ONCE
; TO CLEAR BIT 35 IN EACH WORD
MOVE T2,REKSIZ ;[147] BYTE COUNT WORD + KEYS + WORDS IN USER'S RECORD
SUB T2,XTRWRD ;[147] GET JUST COUNT WORD AND REC LEN
CAIG T2,2 ;CHECK FOR SPECIAL CASE OF 1 DATA WORD
JRST $1 ;IF SO BYPASS BLT
ADDI T2,(R) ;END OF BLT
BLT T1,-1(T2) ;CLEAR IT ALL
$1%
IFE FTKL10,<
HRLI R,(POINT 7,,35) ;DEPOSIT BYTE PTR
MOVE P1,RECORD ;NO. OF CHARACTERS MAX. TO STORE
SKIPG SEQNO ;[110] CHECK FOR SEQUENCE NO.
JRST $3 ;NOT
MOVE T1,@FILPTR(F) ;GET FULL WORD
MOVEM T1,RC.KEY(R) ;STORE IT WITH BIT 35 ON
AOS FILPTR(F) ;BYPASS SEQ NO.
MOVNI T1,5 ;NO. OF BYTES
ADDM T1,FILCNT(F) ;WE'VE USED UP
SUBI P1,5 ;ACCOUNT FOR SEQ NO.
AOJA R,$3 ;GET NEXT REAL BYTE
$2% JSP T4,GETBUF ;GET NEXT BUFFER
JRST E$$RIE ;WARN USER
$3% SOSGE FILCNT(F) ;BUFFER EMPTY?
JRST $2 ;YES
ILDB T1,FILPTR(F) ;GET NEXT BYTE
JUMPE T1,$3 ;IGNORE NULLS
CAIG T1,.CHCRT ;SEE IF ONE OF
CAIGE T1,.CHLFD ;LF, VT, FF, CR
JRST [IDPB T1,R ;NO
SOJG P1,$3 ;GET NEXT
TLZN R,(POINT 7,0,35) ;MAKE NULL BYTE PTR
PUSHJ P,ERRRTI ;WARN USER FIRST TIME
JRST $3] ;LOOP UNTIL END OF LINE
SKIPGE P1 ;ONLY COUNT CHAR WE REALLY STORED
SETZ P1,
SUB P1,RECORD ;- NO. OF CHAR. STORED
MOVMM P1,@RSAV ;[147] STORE AS + BYTE COUNT
PJRST GETLF ;READ THE LF
>;END OF IFE FTKL10
IFN FTKL10,<
MOVE T3,RECORD ;MAX. NO. OF BYTES TO COPY
MOVE T0,FILCNT(F) ;NO. WE ACTUALLY HAVE IN BUFFER
CAMGE T0,T3 ;ENUF IN BUFFER?
MOVE T3,T0 ;NO, USE WHAT WE HAVE
MOVEM T3,@RSAV ;[147] WILL TRY TO STORE THIS MANY
MOVEI T4,(R) ;DESTINATION ADDRESS
HRLI T4,(POINT 7,,35) ;DESTINATION BYTE PTR
SKIPG SEQNO ;[110] CHECK FOR SEQUENCE NO.
JRST $7 ;[110] NO
MOVE T2,@FILPTR(F) ;GET FIRST WORD
MOVEM T2,RC.KEY(T4) ;STORE SEQ. NO.
MOVNI T2,5
ADDM T2,FILCNT(F) ;COUNT DOWN
AOS FILPTR(F) ;INCREMENT SOURCE
SUBI T0,5
SUBI T3,5 ;FIVE LESS BYTES TO COPY
ADDI T4,1 ;INCREMENT DESTINATION
$7% SETZ T2, ;JUST INCASE
$2% MOVE T1,FILPTR(F) ;SOURCE BYTE PTR
TXO T0,S.FLAG ;SET SIGNIFICANCE FLAG
$3% EXTEND T0,[MOVST AVRTBL
EXP 0] ;COPY AND ZERO FILL
JRST $4 ;EITHER COUNT RAN OUT OR CRLF SEEN
PUSH P,T2 ;NO, SAVE WORK ACS
PUSH P,T4 ; ..
JSP T4,GETBUF ;GET NEXT BUFFER
JRST E$$RIE ;WARN USER
POP P,T4 ;RESTORE WORK ACS
POP P,T2 ; ..
MOVE T0,FILCNT(F) ;GET COUNT POSSIBLE
MOVE T1,FILPTR(F) ;[127] RELOAD BYTE POINTER
TXNN T4,77B11 ;WERE WE JUST THROWING CHAR AWAY?
JRST $6 ;YES, KEEP DOING IT
MOVE T3,RECORD ;MAX. WE NEED
SUB T3,@RSAV ;[147] - WHAT WE ALREADY HAVE
JUMPE T3,$5 ;ALL IS DONE REALLY
CAMGE T0,T3 ;CHECK AGAIN FOR FIT
MOVE T3,T0 ;JUST USE WHAT WE HAVE
ADDM T3,@RSAV ;[147] WHAT WE EXPECT TO COPY
JRST $2 ;COPY REST
$4% TXZ T0,S.FLAG!M.FLAG
TXZN T0,N.FLAG ;SEEN ABORT BIT?
JRST $5 ;NO
MOVEM T1,FILPTR(F) ;RESTORE BYTE PTR
MOVEM T0,FILCNT(F) ;WE DIDN'T USE THEM ALL
MOVN T3,T3
ADDM T3,@RSAV ;[147] UPDATE COUNT PROPERLY
PJRST GETLF ;ALL DONE, READ LF NOW
$5% JUMPE T0,[HALT .] ;BUFFER RAN OUT
AOS @RSAV ;[147] FEATURE OF MICRO CODE
TXZE T4,77B11 ;CLEAR BYTE POINTER
PUSHJ P,ERRRTI ;REPORT RECORD TRUNCATION
AOJA T3,$3 ;READ UNTIL CR-LF SEEN
$6% MOVEI T3,1 ;INCASE IT WENT TO ZERO
JRST $3
AVRTBL: ZZ==0
REPEAT 12/2,<ZZ,,ZZ+1
ZZ==ZZ+2>
E.SBIT!E.ABRT,,E.SBIT!E.ABRT ;LF,,VT
E.SBIT!E.ABRT,,E.SBIT!E.ABRT ;FF,,CR
ZZ=ZZ+4
REPEAT <177-15>/2,<ZZ,,ZZ+1
ZZ==ZZ+2>
>;END IFN FTKL10
END;
SUBTTL GETREC -- GETEBR - Get EBCDIC Record
;STILL IN IFE FTCOBOL
IFE FTFORTRAN,<
BEGIN
PROCEDURE (JSP P4,GETEBR) ;HERE TO GET NEXT EBCDIC RECORD
;FIRST SEE IF REST OF BUFFER IS NULL
BEGIN
DMOVE T2,FILPTR(F) ;GET COPY OF BYTE PTR AND COUNT
$1% ILDB T1,T2 ;READ FIRST BYTE (WE KNOW ITS IN MEMORY)
JUMPN T1,$E ;A NON-NULL FOUND
SOJG T3,$1 ;TRY AGAIN
JSP T4,GETBUF ;TRY FOR NEXT BLOCK
JRST (P4) ;HOPE WE GOT HERE
JRST GETEBR ;NO TRY AGAIN
END;
MOVE T2,RECORD ;[150] GET BYTE COUNT
MOVEM T2,RC.CNT(R) ;[150] STORE BYTE COUNT
ADD R,XTRWRD ;[150] LEAVE SPACE FOR EXTRACTED KEYS
SKIPGE FILFLG(F) ;IS IT VARIABLE?
JRST GETEVR ;YES
MOVE T1,FILFLG(F)
TXNE T1,FI.IND ;INDUSTRY COMPATIBLE MODE?
JRST GETICR ;YES
SKIPL FILPTR(F) ;SEE IF ON A WORD BOUNDARY
JRST GETEBN ;ITS NOT
MOVE T1,RECORD ;SEE HOW MANY ACTUAL CHARS
IDIVI T1,4
PUSH P,T2 ;SAVE REMAINDER
MOVE T2,T1
LSH T2,2 ;INTERGRAL NO. OF BYTES
CAMLE T2,FILCNT(F) ;ALL IN THIS BUFFER?
JRST GETEML ;NO
HRLZ T3,FILPTR(F) ;GET BYTE PTR
HRRI T3,RC.KEY(R) ;DESTINATION
ADDI R,0(T1) ;END OF BLT
SKIPE T1 ;DON'T DO BLT IF NO FULL WORDS
BLT T3,(R) ;MOVE ALL BUT LAST PARTIAL WORD
ADDM T1,FILPTR(F) ;ADJUST BYTE PTR
MOVN T2,RECORD ;NO. OF BYTES USED
ADDM T2,FILCNT(F) ;ACCOUNT FOR THEM
; PJRST GETELW ;NEXT PAGE
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
PROCEDURE (JSP P4,GETELW) ;GET EBCDIC LAST WORD
SKIPG FILCNT(F) ;WILL LAST WORD FIT?
SKIPN 0(P) ;OR NO LAST WORD?
JRST $2 ;OK
JSP T4,GETBUF ;GET NEW BUFFER
JRST E$$RIE ;WARN USER
MOVN T2,(P) ;REMAINDER
ADDM T2,FILCNT(F) ;ADJUST BYTE COUNT
$2% POP P,T2 ;GET REMAINDER BACK
JUMPE T2,GETEBZ ;ALL DONE
MOVE T1,@FILPTR(F) ;GET FULL WORD
AND T1,EBCMSK(T2) ;ONLY WHAT WE REALLY NEED
MOVEM T1,RC.KEY(R) ;STORE IT
IFE FTKL10,<
IBP FILPTR(F) ;ADJUST BYTE PTR
SOJG T2,.-1
>
IFN FTKL10,<
ADJBP T2,FILPTR(F)
MOVEM T2,FILPTR(F)
>
; PJRST GETEBZ ;BELOW
END;
BEGIN
PROCEDURE (JSP P4,GETEBZ)
MOVE T2,FILPTR(F)
TLNE T2,700000 ;IS IT ON WORD BOUNDARY?
JRST $3 ;NO, EXTRACT KEYS AND RETURN
TLO T2,440000 ;YES, REFORM BYTE PTR
ADDI T2,1 ;INCREMENT IT TO NEXT WORD
MOVEM T2,FILPTR(F) ;ADVANCE TO NEXT WORD
$3% AOS FILSIZ(F) ;COUNT 1 MORE RECORD
MOVE R,RSAV ;RESTORE R
AOJA P4,@EXTRCT ;EXTRACT KEYS AND GIVE OK RETURN
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
PROCEDURE (PUSHJ P,RDEBBT) ;READ EBCDIC BYTE FROM INPUT BUFFER
IF BUFFER IS EMPTY
SOSL FILCNT(F) ;ANYTHING IN BUFFER?
JRST $F ;YES, STILL NOT EMPTY
THEN GET NEXT
JSP T4,GETBUF ;BUFFER EMPTY GET NEXT
JRST [POP P,(P) ;POP RETURN OFF STACK
MOVE EF,LOGEOF ;RAN OUT OF RECORDS
JRST 0(P4)] ;GIVE ERROR RETURN
SOS FILCNT(F) ;COUNT DOWN BYTE WE WILL PICKUP
FI;
ILDB T1,FILPTR(F) ;GET BYTE
RETURN
END;
EBCMSK: BYTE (9)
BYTE (9) 377
BYTE (9) 377,377
BYTE (9) 377,377,377
BYTE (9) 377,377,377,377
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
PROCEDURE (JSP P4,GETEML) ;HERE WHEN RECORD CROSSES BLOCK BOUNDARY
MOVEI P1,(T1) ;SIZE OF RECORD (WORDS)
$1% SKIPE T1,FILCNT(F) ;NUMBER OF WORDS LEFT IN CURRENT BUFFER
JRST $2 ;STILL SOME
JSP T4,GETBUF ;EMPTY, GET NEXT
JRST E$$RIE ;WARN USER
$2% IDIVI T1,4 ;WORDS IN CURRENT BUFFER
MOVEI T2,(P1) ;SIZE OF RECORD RESIDUE
CAILE T2,(T1) ;CONTAINED WITHIN CURRENT BUFFER
MOVEI T2,(T1) ;NO, TRANSFER ONLY FILCNT WORDS
HRL T3,FILPTR(F) ;PTR TO ORIGIN OF RECORD RESIDUE
HRRI T3,RC.KEY(R) ;PTR TO DESTINATION OF RECORD FRAGMENT
ADDI R,0(T2) ;PTR TO END OF RECORD FRAGMENT -1
BLT T3,0(R) ;[304] TRANSFER RECORD FRAGMENT
MOVNI T1,4 ;4 BYTES PER WORD
IMUL T1,T2 ;- NO. OF WORDS
ADDM T1,FILCNT(F) ;ADJUST BUFFER COUNT
ADDM T2,FILPTR(F) ;ADVANCE BUFFER POINTER
SUBI P1,(T2) ;DECREMENT LENGTH OF RECORD RESIDUE
JUMPN P1,$1 ;FINISHED ?
MOVN T2,(P) ;REMAINDER BYTES
ADDM T2,FILCNT(F) ;ACCOUNT FOR THEM
PJRST GETELW ;GET LAST WORD, SEE IF IN BUFFER
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
PROCEDURE (JSP P4,GETEBN) ;HERE FOR EBCDIC RECORD NOT ON A WORD BOUNDARY
IFE FTKL10,<
LDB T1,[POINT 6,FILPTR(F),5] ;GET BYTE POSITION
MOVNS P1,T1 ;-NO. OF BITS LEFT
ADDI P1,^D36 ;LSHC COUNTER TO RIGHT JUSTIFY 5 BYTES
IDIVI T1,9 ;CONVERT TO BYTES
ADDM T1,FILCNT(F) ;ACCOUNT FOR THEM
ADD T1,RECORD ;NO. OF BYTES TO FOLLOW
IDIVI T1,4 ;NO. OF WORDS
PUSH P,T2 ;SAVE REMAINDER
MOVN T1,T1 ;-NO. OF FULL WORDS TO COPY
HRL R,T1 ;AOBJN PTR
MOVN T3,P1 ;NO. OF BITS TO SHIFT LEFT
ADDI T3,^D36 ;LSHC COUNTER FOR REMAINDER
AOS T2,FILPTR(F) ;ADVANCE BYTE PTR
HRLI T2,(POINT 9,) ; TO BEFORE FIRST BYTE
MOVEM T2,FILPTR(F) ; SO BOTH ILDB AND MOVE @ WORK
MOVE T1,-1(T2) ;GET FIRST WORD
IF THERE ARE FULL WORDS TO MOVE
JUMPGE R,$F ;NO
THEN LOOP FOR REMAINING FULL WORDS
BEGIN
SKIPG FILCNT(F) ;ROOM IN THIS BUFFER?
JRST [PUSH P,T1 ;SAVE PARTIAL
PUSH P,T3 ;LSHC -COUNT
JSP T4,GETBUF ;GET NEW BUFFER
JRST E$$RIE ;WARN USER
POP P,T3
POP P,T1
JRST $1]
$1% MOVE T2,@FILPTR(F) ;GET IT
LSHC T1,(P1) ;36 BITS IN T1
MOVEM T1,RC.KEY(R) ;STORE
LSHC T1,(T3) ;MOVE REMAINDER INTO T1
MOVNI T2,4
ADDM T2,FILCNT(F) ;ADJUST BYTE COUNT
AOS FILPTR(F) ;AND BYTE PTR
AOBJN R,$B ;LOOP FOR ALL FULL WORDS
END;
FI;
;NOW FOR LAST WORD IF IT EXISTS
SKIPG FILCNT(F) ;[122] IS BUFFER EMPTY?
SKIPN 0(P) ;[122] YES, AND DO WE NEED ANY MORE?
JRST $3 ;NO
PUSH P,T1 ;SAVE PARTIAL WORD
JSP T4,GETBUF ;YES, FILL IT
JRST E$$RIE ;WARN USER
POP P,T1 ;RESTORE PARTIAL WORD
$3% POP P,T3 ;GET REMAINDER
SKIPE T2,T3 ;NO REMAINDER, GET 0
SKIPA T2,@FILPTR(F) ;GET IT
AND T2,ASCMSK(T3) ;ONLY WHAT WE NEED
LSHC T1,(P1) ;FORM 36 BITS
MOVEM T1,RC.KEY(R) ;STORE FIRST WORD
SKIPE T2 ;ONLY ONE WORD
MOVEM T2,RC.KEY+1(R) ;STORE SECOND WORD
JUMPE T3,$5 ;NO REMAINDER
MOVN T3,T3
ADDM T3,FILCNT(F) ;ADJUST BYTE COUNT
IBP FILPTR(F)
AOJL T3,.-1 ;AND BYTE PTR
$5%
>;END OF IFE FTKL10
IFN FTKL10,<
MOVE T0,RECORD ;NO. OF BYTES TO COPY
MOVEI T4,^D9 ;BYTE SIZE
PUSHJ P,GETEX ;GET RECORD WITH COMMON BIS CODE
>;END IFN FTKL10
JRST GETEBZ ;ALL DONE
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
PROCEDURE (JSP P4,GETEVR) ;GET VARIABLE LENGTH EBCDIC RECORD
PUSHJ P,RDEBBT ;READ A BYTE
LSH T1,8
MOVE P1,T1 ;STORE HIGH ORDER BYTE
PUSHJ P,RDEBBT
ADDI P1,(T1) ;ADD LOW ORDER BYTE
PUSHJ P,RDEBBT ;BYPASS JUNK
JUMPN T1,E$$SRS ;CHECK FOR IBM SPANNED RECORDS
PUSHJ P,RDEBBT ;...
SUBI P1,4 ;ACCOUNT FOR 4 BYTE HEADER
CAMGE P1,MINKEY ;IS IT BIG ENOUGH?
PUSHJ P,ERRKNR ;NO
IF RECORD IS TOO BIG
CAML P1,RECORD
JRST $T
THEN STORE ONLY MAX SIZE
PUSHJ P,ERRRTI ;TELL USER
SUB P1,RECORD ;GET DIFF
PUSH P,P1 ;STORE IT
MOVE P1,RECORD ;MAX SIZE
JRST $F
ELSE USE IT
PUSH P,[0] ;NO EXCESS
FI;
MOVEM P1,@RSAV ;[150] STORE BYTE COUNT
IFE FTKL10,<
HRLI R,(POINT 9,,35) ;DEPOSIT BYTE PTR & BYPASS BYTE COUNT
JRST $2 ;FIRST TIME
$1% JSP T4,GETBUF ;GET NEXT BUFFER
JRST E$$RIE ;WARN USER
$2% SOSGE FILCNT(F) ;BUFFER EMPTY?
JRST $1 ;YES
ILDB T1,FILPTR(F) ;GET NEXT BYTE
IDPB T1,R ;STORE
SOJG P1,$2 ;GET NEXT
POP P,P1 ;GET POSSIBLE EXCESS
JUMPE P1,$3 ;OK
TLZE R,(POINT 9,0,35) ;MAKE NULL BYTE PTR
PUSHJ P,ERRRTI ;WARN USER FIRST TIME
PUSH P,[0] ;TERMINATE CORRECTLY THIS TIME
JRST $2 ;LOOP UNTIL END OF RECORD
$3% AOS FILSIZ(F) ;COUNT 1 MORE RECORD
MOVE R,RSAV
AOJA P4,@EXTRCT
>;END OF IFE FTKL10
IFN FTKL10,<
MOVEI T0,(P1) ;NO. OF BYTES TO COPY
MOVEI T4,^D9 ;BYTE SIZE
PUSHJ P,GETEX ;GET RECORD WITH COMMON BIS CODE
$2% POP P,T1 ;GET EXCESS
JUMPE T1,GETEBZ ;ALL DONE
MOVN T2,T1
ADDB T2,FILCNT(F) ;ADJUST BYTE COUNT
JUMPGE T2,$3 ;OK
PUSH P,T2
JSP T4,GETBUF ;READ NEXT BUFFER
JRST E$$RIE ;WARN USER
JRST $2 ;TRY AGAIN
$3% ADJBP T1,FILCNT(F) ;ADJUST BYTE PTR
MOVEM T1,FILPTR(F)
PJRST GETEBZ
>;END IFN FTKL10
END;
E$$SRS: $ERROR (?,SRS,<Spanned records not supported.>)
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
PROCEDURE (JSP P4,GETICR) ;GET INDUSTRY COMPATIBLE FIXED LENGTH EBCDIC RECORD
IFE FTKL10,<
MOVE P1,RECORD ;SIZE
MOVEM P1,@RSAV ;[150] STORE BYTE COUNT
HRLI R,(POINT 9,,35) ;DEPOSIT BYTE PTR & BYPASS BYTE COUNT
JRST $2 ;FIRST TIME
$1% JSP T4,GETBUF ;GET NEXT BUFFER
JRST E$$RIE ;WARN USER
$2% SOSGE FILCNT(F) ;BUFFER EMPTY?
JRST $1 ;YES
ILDB T1,FILPTR(F) ;GET NEXT BYTE
IDPB T1,R ;STORE
SOJG P1,$2 ;GET NEXT
AOS FILSIZ(F) ;COUNT 1 MORE RECORD
MOVE R,RSAV
AOJA P4,@EXTRCT
>;END OF IFE FTKL10
IFN FTKL10,<
MOVE T0,RECORD ;NO. OF BYTES TO COPY
MOVEI T4,^D9 ;BYTE SIZE
PUSHJ P,GETEX ;GET RECORD WITH COMMON BIS CODE
JRST GETEBZ ;ALL DONE
>;END IFN FTKL10
END;
>;END IFE FTFORTRAN
SUBTTL GETREC -- GETBNR - Get Binary Record
;STILL IN IFE FTCOBOL
BEGIN
PROCEDURE (JSP P4,GETBNR)
MOVE T2,RECSIZ ;GET RECORD SIZE
MOVEM T2,RC.CNT(R) ;STORE WORD COUNT
ADD R,XTRWRD ;BYPASS EXTRACTED KEYS
HRRZ T3,FILPTR(F) ;ADDRESS OF RECORD
MOVE T4,MODE
TXNE T4,RM.FOR ;FORTRAN BINARY?
PJRST GETFBR ;YES
IF RECORD IS CONTAINED IN CURRENT I/O BUFFER
CAIGE T1,(T2) ;IS RECORD CONTAINED IN CURRENT BUFFER ?
JRST $T ;NO, RECORD SPANS BUFFERS
THEN
HRL T3,FILPTR(F) ;YES, SET ORIGIN ADDRESS OF RECORD
HRRI T3,RC.KEY(R) ;SET DESTINATION ADDRESS
ADDI R,(T2) ;PTR TO LAST WORD IN RECORD DESTINATION
BLT T3,0(R) ;TRANSFER RECORD
SUBI T1,(T2)
MOVEM T1,FILCNT(F) ;ADJUST BUFFER COUNT
ADDM T2,FILPTR(F) ;ADVANCE BUFFER POINTER
JRST $F
ELSE COPY PIECEMEAL
MOVEI P1,(T2) ;SIZE OF RECORD (WORDS)
$2% SKIPE T1,FILCNT(F) ;NUMBER OF WORDS LEFT IN CURRENT BUFFER
JRST $3 ;STILL SOME
JSP T4,GETBUF ;CURRENT BUFFER EXHAUSTED, ADVANCE TO NEXT
JRST [MOVE R,RSAV ;RESTORE R
RETURN] ;GIVE EOF RETURN
$3% MOVEI T2,(P1) ;SIZE OF RECORD RESIDUE
CAILE T2,(T1) ;CONTAINED WITHIN CURRENT BUFFER ?
MOVEI T2,(T1) ;NO, TRANSFER ONLY FILCNT WORDS
HRL T3,FILPTR(F) ;PTR TO ORIGIN OF RECORD RESIDUE
HRRI T3,RC.KEY(R) ;PTR TO DESTINATION OF RECORD FRAGMENT
ADDI R,(T2) ;PTR TO END OF RECORD FRAGMENT
BLT T3,0(R) ;TRANSFER RECORD FRAGMENT
SUBI T1,(T2)
MOVEM T1,FILCNT(F) ;ADJUST BUFFER COUNT
ADDM T2,FILPTR(F) ;ADVANCE BUFFER POINTER
SUBI P1,(T2) ;DECREMENT LENGTH OF RECORD RESIDUE
JUMPN P1,$2 ;FINISHED ?
FI;
MOVE R,RSAV ;RESTORE R
AOS FILSIZ(F) ;COUNT 1 MORE RECORD
AOJA P4,@EXTRCT ;EXTRACT KEYS AND GIVE OK RETURN
END;
;GET NEXT FORTRAN BINARY RECORD
;STILL IN IFE FTCOBOL
BEGIN
PROCEDURE (JSP P4,GETFBR)
MOVE P1,@FILPTR(F) ;GET START LSCW
AOS FILPTR(F)
SOS T1,FILCNT(F) ;ACCOUNT FOR IT
MOVE P2,RECSIZ ;GET MAX RECORD SIZE
HLRZ T2,P1 ;GET LSCW
CAIE T2,S.LSCW ;IS IT WHAT WE EXPECT
JRST E$$FCI ;ERROR
MOVEI P1,-1(P1) ;NO. OF DATA WORDS TO FOLLOW
IF RECORD IS CONTAINED IN CURRENT I/O BUFFER
$1% CAIGE T1,(P1)
JRST $T ;NO
THEN COPY ALL EXCEPT LSCW AT EITHER END
HRL T3,FILPTR(F) ;ORIGIN OF DATA
HRRI T3,RC.KEY(R) ;DESTINATION
CAIG P1,(P2) ;TOO BIG?
SKIPA T2,P1 ;NO, USE ALL
MOVE T2,P2 ;YES, JUST USE MAX.
JUMPLE P2,$6 ;DON'T COPY TOO MUCH
ADDI R,(T2) ;NO. TO COPY
BLT T3,0(R) ;COPY THEM
SUBI P2,(T2) ;COUNT DOWN
$6% MOVNI T1,(P1) ;MINUS THOSE WE HAVE READ
ADDM T1,FILCNT(F)
ADDM P1,FILPTR(F) ;ADVANCE READ POINTER
JRST $F ;READ LSCW
ELSE COPY PIECEMEAL
$2% SKIPE T1,FILCNT(F) ;NUMBER OF WORDS LEFT IN CURRENT BUFFER
JRST $3 ;STILL SOME
JSP T4,GETBUF ;CURRENT BUFFER EXHAUSTED, ADVANCE TO NEXT
JRST E$$RIE ;WARN USER
HLRZ T2,@FILPTR(F) ;GET LSCW
$3% MOVEI T2,(P1) ;SIZE OF RECORD RESIDUE
CAILE T2,(T1) ;CONTAINED WITHIN CURRENT BUFFER ?
MOVEI T2,(T1) ;NO, TRANSFER ONLY FILCNT WORDS
MOVEI T1,(T2) ;[203] REMEMBER HOW MUCH TOWARD LSCW WE'RE READING
CAILE T2,(P2) ;[203] ENOUGH ROOM TO HOLD IT?
MOVEI T2,(P2) ;[203] NO--COPY ONLY WHAT'LL FIT
JUMPLE T2,$7 ;[203] WHICH MAY BE NOTHING
HRL T3,FILPTR(F) ;PTR TO ORIGIN OF RECORD RESIDUE
HRRI T3,RC.KEY(R) ;PTR TO DESTINATION OF RECORD FRAGMENT
ADDI R,(T2) ;PTR TO END OF RECORD FRAGMENT
BLT T3,0(R) ;TRANSFER RECORD FRAGMENT
SUBI P2,(T2) ;[203] ACCOUNT FOR FILLING UP RECORD
$7% SUBI P1,(T1) ;[203] UPDATE WORDS LEFT
ADDM T1,FILPTR(F) ;[203] AND LEAVE IN T1
EXCH T1,FILCNT(F) ;[203] ..
SUBB T1,FILCNT(F) ;[203] ..
JUMPN P1,$2 ;FINISHED ?
FI;
SKIPE FILCNT(F) ;LSCW IN BUFFER?
JRST $4 ;YES
JSP T4,GETBUF
JRST E$$RIE ;WARN USER
$4% HLRZ T2,@FILPTR(F) ;GET LSCW
HRRZ P1,@FILPTR(F) ;GET WORD COUNT
AOS FILPTR(F)
SOS T1,FILCNT(F) ;ACCOUNT FOR IT
CAIN T2,E.LSCW ;END?
JRST $5 ;YES
CAIN T2,C.LSCW ;CONTINUE
SOJA P1,$1 ;YES, GET NO. OF DATA WORDS
E$$FCI: $ERROR (?,FCW,<Fortran binary control word incorrect>)
$5% HRRZ T1,R
MOVE R,RSAV
SUBI T1,(R)
JUMPE T1,GETREC ;[203] IGNORE 0-LENGTH RECORDS
MOVEM T1,RC.CNT(R) ;NO. OF DATA WORDS USED
AOS FILSIZ(F) ;COUNT 1 MORE RECORD
AOJA P4,@EXTRCT
END;
;STILL IN IFE FTCOBOL
IFN FTKL10,<
BEGIN
PROCEDURE (PUSHJ P,GETEX) ;GET NEXT RECORD USING BIS
;CALL WITH:
; T0/ NUMBER OF BYTES TO COPY
; T4/ BYTE SIZE
; F/ INDEX TO FILE TABLE (FOR BUFFER HEADER)
; R/ INDEX TO WORD BEFORE DATA IN RECORD
LSH T4,^D24 ;MOVE BYTE SIZE TO BYTE POINTER POS
HRRI T4,(R) ;FINISH POINTER WITH ADDR OF RECORD
MOVE T3,FILCNT(F) ;FILL UP ACS FOR EXTEND INSTRUCTION
$1% SETZ T2, ;UNUSED AC IN BIS
CAMGE T0,T3 ;DO ALL CHARS FIT?
MOVE T3,T0 ;YES
MOVN T1,T0
ADDM T1,FILCNT(F) ;ACCOUNT FOR BYTES READ
MOVE T1,FILPTR(F) ;SOURCE BYTE POINTER
EXTEND T0,[MOVSLJ
EXP 0] ;COPY AND 0 FILL
JRST $2
MOVEM T1,FILPTR(F) ;RESTORE BYTE POINTER
RETURN ;ALL DONE
$2% MOVEM T1,FILPTR(F) ;RESTORE BYTE POINTER
PUSH P,T0 ;SAVE WORK ACS
PUSH P,T4 ; ..
JSP T4,GETBUF ;GET NEXT BUFFER
JRST E$$RIE ;FAILED
POP P,T4 ;RESTORE WORK ACS
POP P,T0 ; ..
MOVE T3,FILCNT(F) ;GET NEW SOURCE BYTE POINTER
JRST $1 ;FINISH COPYING THE RECORD
>;END IFN FTKL10
>;END IFE FTCOBOL
SUBTTL GETREC -- GTTREC - Get Next Record From Temporary File
BEGIN
PROCEDURE (JSP P4,GTTREC)
;GTTREC GETS THE NEXT RECORD FROM A TEMPORARY FILE. RECORDS IN TEMPORARY FILES
;CONTAIN A CHARACTER COUNT WORD, FOLLOWED BY ANY EXTRACTED KEYS, FOLLOWED BY THE
;ACTUAL USER RECORD. RUN MARKERS, WHICH *SEPARATE* RUNS IN A TEMPORARY FILE, ARE
;COUNT WORDS WITH NEGATIVE LEFT HALVES. IN THIS CASE, THE RIGHT HALF IS THE
;NUMBER OF THE FOLLOWING RUN RATHER THAN A COUNT WORD. ALSO, IF THE RECORD FITS
;IN THE BUFFER THEN THERE IS NO NEED TO MOVE IT, SINCE THE RECORD WILL BE OUTPUT
;BEFORE THE BUFFER IS EMPTY. ON ENTRY, IF (R) POINTS TO AN I/O BUFFER, RESTORE R
;FROM LSTREC. ON EXIT, IF BUFFER FULLY ENCLOSES THE RECORD AND ALL OF THE KEYS
;FIT IN THE RECORD (SO THAT WE DON'T HAVE TO PROVIDE ZERO PADDING), SET R TO
;POINT TO IT.
;
;CALL WITH:
; F/ POINTER TO FCB
; R/ POINTER TO RCB OR MIDDLE OF AN INPUT BUFFER
; JSP P4,GTTREC
;
;RETURNS:
; MOVE EF,PHYEOF
; JRST 0(P4) ;END OF FILE
;OR
; JRST 1(P4) ;NORMAL
;
IF R POINTS TO AN I/O BUFFER
CAMGE R,RCBEND ;DOES R POINT TO AN I/O BUFFER?
JRST $F ;NO
THEN RESET R WITH A VALID RCB
MOVE R,@LSTREC ;GET NEXT NEXT RCB
EXCH R,LSTREC ;GET NEXT RCB
HRRM R,RN.REC(S) ;MAKE SURE PTR AGREES
FI;
SKIPE T1,FILCNT(F) ;NUMBER WORDS REMAINING IN CURRENT BUFFER
JRST $1 ;STILL SOME
JSP T4,GETBUF ;BUFFER EXHAUSTED, ADVANCE TO NEXT
JRST 0(P4) ;GIVE E-O-F RETURN
$1%
HRRZ T3,FILPTR(F) ;ADDRESS OF NEXT RECORD
IF WE HAVE A NORMAL WORD COUNT
SKIPG T2,(T3) ;CHECK BYTE OR WORD COUNT
JRST $T ;MIGHT BE LOGICAL END-OF-FILE
THEN COPY RECORD
IFE FTCOBOL,<
IF RECORD IS VARIABLE
SKIPG P.VARF
JRST $T
THEN CALCULATE EXACT SIZE
>
SUBI T2,1 ;[201] COUNT ALL BUT LAST DATA WORD
IDIV T2,IOBPW ;[201] ..
ADDI T2,2 ;[201] COUNT LAST AND COUNT WORDS
ADD T2,XTRWRD ;[201] COUNT EXTRACTED KEYS
IFE FTCOBOL,<
CAMLE T2,MAXKEY ;WILL ALL KEYS FIT?
JRST $F ;YES
MOVEI T1,1(R)
HRLI T1,0(R) ;BUILT BLT PTR
MOVE T3,MAXKEY
ADDI T3,(R) ;END OF KEYS
SETZM (R) ;ZERO FIRST WORD
BLT T1,(T3) ;ZERO THEM ALL
SETZ T1, ;FORCE COPY
JRST $F
ELSE
MOVE T2,REKSIZ ;FIXED RECORD SIZE NOW
FI;
>;END IFE FTCOBOL
IF RECORD WILL FIT IN CURRENT BUFFER
CAIGE T1,(T2) ;IS RECORD CONTAINED IN CURRENT BUFFER ?
JRST $T ;NO, RECORD SPANS BUFFERS
THEN
EXCH R,LSTREC ;YES, STORE THIS R IN LIST
MOVEM R,@LSTREC ;AND LINK IN
HRRZ R,FILPTR(F) ;FIRST DATA WORD
HRRM R,RN.REC(S) ;MAKE SURE PTR AGREES
SUBI T1,(T2)
MOVEM T1,FILCNT(F) ;ADJUST BUFFER COUNT
ADDM T2,FILPTR(F) ;ADVANCE BUFFER POINTER
JRST 1(P4) ;RETURN WITH KEYS ALREADY EXTRACTED
ELSE COPY PIECEMEAL
MOVEM R,RSAV
MOVEI P1,(T2) ;SIZE OF RECORD (WORDS)
$3% SKIPE T1,FILCNT(F) ;NUMBER OF WORDS LEFT IN CURRENT BUFFER
JRST $6 ;STILL SOME
JSP T4,GETBUF ;CURRENT BUFFER EXHAUSTED, ADVANCE TO NEXT
JRST E$$RIE ;WARN USER
$6% MOVEI T2,(P1) ;SIZE OF RECORD RESIDUE
CAILE T2,(T1) ;CONTAINED WITHIN CURRENT BUFFER ?
MOVEI T2,(T1) ;NO, TRANSFER ONLY FILCNT WORDS
HRL T3,FILPTR(F) ;PTR TO ORIGIN OF RECORD RESIDUE
HRRI T3,RC.CNT(R) ;PTR TO DESTINATION OF RECORD FRAGMENT
ADDI R,(T2) ;ADVANCE RECORD DEPOSIT POINTER
BLT T3,-1(R) ;TRANSFER RECORD FRAGMENT
SUBI T1,(T2)
MOVEM T1,FILCNT(F) ;ADJUST BUFFER COUNT
ADDM T2,FILPTR(F) ;ADVANCE BUFFER POINTER
SUBI P1,(T2) ;DECREMENT LENGTH OF RECORD RESIDUE
JUMPN P1,$3 ;FINISHED ?
MOVE R,RSAV
;KEYS ALREADY EXTRACTED
JRST 1(P4)
FI;
ELSE CHECK FOR NEXT RUN MARKER OR EOF
JUMPE T2,$5 ;NOT SURE IF 0, TRY NEXT BLOCK
HRLM T2,FILRUN(F) ;STORE GENERATION NO. FOR = TEST
SOS FILCNT(F) ;BYPASS MARKER
AOS FILPTR(F)
MOVE EF,LOGEOF ;LOAD EOF ROUTINE
JRST 0(P4) ;GIVE ERROR RETURN
$5% SETZM FILCNT(F) ;SET TO READ NEXT BLOCK, WILL GET E-O-F
JRST GTTREC ;OR RETURN WITH L-E-O-F MARKER
FI;
END;
SUBTTL PUTREC -- PUTREC - Put Next Record to Output File
IFE FTCOBOL,<
BEGIN
PROCEDURE (JSP P4,PUTREC) ;OUTPUT NEXT RECORD
MOVEM R,RSAV
IFE FTFORTRAN,<
$1% SKIPE T1,FILBLK(F) ;BLOCKED FILE?
AOBJP T1,[MOVN T1,T1 ;RESET BLOCKING FACTOR
HRLZM T1,FILBLK(F) ;IN FCB
PUSHJ P,CLRBUF ;CLEAR JUNK FROM BUFFER
JSP T4,PUTBUF ;GET NEW BUFFER
MOVE T2,FILFLG(F) ;[215] ARE WE AT EOT?
TXNE T2,FI.EOT ;[215] ..
PUSHJ P,MSTEOT ;[215] YES--GO HANDLE LABELS
HRRZ T2,IOMODE ;[201] FETCH I/O MODE INDEX
CAIN T2,MODEBCDIC ;IF EBCDIC
SKIPL FILFLG(F) ;AND VARIABLE
JRST $1 ;NO
MOVE T2,RECORD ;YES, GET RECORD SIZE
HLRE T1,FILBLK(F) ;GET BLOCKING FACTOR
SETCM T1,T1 ;AS POSS NO.
IMULI T1,4(T2) ;NO. OF BYTES + 4 BYTE OVERHEAD
ADDI T1,4 ;PLUS THIS WORD
LSHC T1,-8 ;SHIFT OUT LOW ORDER BYTE
LSH T1,1 ;THEY ARE 9 BIT BYTES
LSHC T1,8
HRLZM T1,@FILPTR(F) ;STORE COUNT
AOS FILPTR(F)
MOVNI T1,4
ADDM T1,FILCNT(F)
JRST $1] ;TRY AGAIN
MOVEM T1,FILBLK(F) ;STORE BLOCKING FACTOR BACK
>
SKIPN T1,FILCNT(F) ;NUMBER WORDS REMAINING IN CURRENT BUFFER
JSP T4,PUTBUF ;BUFFER FILLED, WRITE IT
IFE FTFORTRAN,<
MOVE T2,FILFLG(F) ;[215] CHECK IF EOT HAPPENED
TXNE T2,FI.EOT ;[215] YES--WE'D BETTER
PUSHJ P,MSTEOT ;[215] WORRY ABOUT LABELS
>
CASE I/O MODE OF (EXP PUTSXR,PUTASR,PUTEBR,PUTBNR)
HRRZ T2,IOMODE ;[201] FETCH I/O MODE INDEX
JRST @[EXP PUTSXR,PUTASR,PUTEBR,PUTBNR]-1(T2)
ESAC;
END;
SUBTTL PUTREC -- PUTSXR - Put SIXBIT Record
;STILL IN IFE FTCOBOL
IFE FTFORTRAN,<
BEGIN
PROCEDURE (JSP P4,PUTSXR)
HRRZ T2,RC.CNT(R) ;SIXBIT COUNT WORD
IF THIS IS A MAGTAPE
PUSHJ P,ISITMT ;IS IT A MAGTAPE?
JRST $F ;NO
THEN WE MUST SET UP RECORD COUNT IN LEFT HALF OF COUNT WORD
HRL T2,FILSIZ(F) ;GET RECORD NUMBER
FI;
MOVEM T2,@FILPTR(F) ;STORE IT
HRRZ T2,T2 ;BYTE COUNT ONLY
AOS FILSIZ(F) ;INCREMENT SIZE OF FILE
ADD R,XTRWRD ;BYPASS EXTRACTED KEYS
AOS FILPTR(F) ;BYPASS BYTE COUNT
SOS T1,FILCNT(F) ;AND ACCOUNT FOR IT
ADDI T2,5 ;ACOUNT FOR REMAINDER
IDIVI T2,6
IF RECORD WILL FIT IN CURRENT BUFFER
CAIGE T1,(T2) ;WILL RECORD FIT IN CURRENT BUFFER ?
JRST $T ;NO, RECORD MUST SPAN BUFFERS
THEN COPY IT
HRLZI T3,RC.KEY(R) ;YES, SET ORIGIN ADDRESS
HRR T3,FILPTR(F) ;SET DESTINATION ADDRESS
HRRZ T4,T3
ADDI T4,(T2) ;ADDRESS OF END OF RECORD DESTINATION
BLT T3,-1(T4) ;TRANSFER RECORD
SUBI T1,(T2)
MOVEM T1,FILCNT(F) ;ADJUST BUFFER COUNTER
ADDM T2,FILPTR(F) ;ADVANCE BUFFER POINTER
MOVE R,RSAV
RETURN
ELSE COPY IT PIECEMEAL
MOVEI P1,(T2) ;RECORD SIZE (WORDS)
WHILE STILL SOME WORDS TO COPY DO
BEGIN
SKIPN T1,FILCNT(F) ;NUMBER WORDS REMAINING IN CURRENT BUFFER
JSP T4,PUTBUF ;BUFFER FILLED, WRITE IT
MOVEI T2,(P1) ;SIZE OF RECORD RESIDUE
CAILE T2,(T1) ;WILL RESIDUE FIT IN CURRENT BUFFER ?
MOVEI T2,(T1) ;NO, TRANSFER ONLY FILCNT WORDS
HRLZI T3,RC.KEY(R) ;PTR TO ORIGIN OF RECORD FRAGMENT
HRR T3,FILPTR(F) ;PTR TO DESTINATION OF RECORD FRAGMENT
HRRZ T4,T3
ADDI T4,(T2) ;ADVANCE RECORD RETRIEVAL PTR
BLT T3,-1(T4) ;TRANSFER RECORD FRAGMENT
SUBI T1,(T2)
MOVEM T1,FILCNT(F) ;ADJUST BUFFER COUNTER
ADDM T2,FILPTR(F) ;ADVANCE BUFFER POINTER
ADDI R,(T2) ;ADVANCE RECORD RETRIEVAL PTR
SUBI P1,(T2) ;DECREMENT LENGTH OF RECORD RESIDUE
JUMPN P1,$B ;NOT FINISHED
END;
MOVE R,RSAV
RETURN
FI;
END;
>;END IFE FTFORTRAN
SUBTTL PUTREC -- PUTASR - Put ASCII Record
;STILL IN IFE FTCOBOL
BEGIN
PROCEDURE (JSP P4,PUTASR) ;HERE TO PUT NEXT ASCII RECORD INTO OUTPUT FILE
AOS FILSIZ(F) ;INCREMENT SIZE OF FILE
ADD R,XTRWRD ;BYPASS EXTRACTED KEYS
SKIPGE FILFLG(F) ;VARIABLE LENGTH OUTPUT?
JRST PUTAVR ;YES
SKIPL FILPTR(F) ;SEE IF ON A WORD BOUNDARY
JRST PUTASN ;NOT
MOVE T1,RECORD ;SEE HOW MANY ACTUAL CHARS
IDIVI T1,5
PUSH P,T2 ;SAVE REMAINDER
MOVE T2,T1
IMULI T2,5 ;INTERGRAL NO. OF BYTES
CAMLE T2,FILCNT(F) ;ALL IN THIS BUFFER?
JRST PUTAML ;NO
HRRZ T3,FILPTR(F) ;GET BYTE PTR
HRLI T3,RC.KEY(R) ;ORIGIN
ADDI R,(T1) ;ADVANCE READ PTR
ADDB T1,FILPTR(F) ;ADJUST BYTE PTR
BLT T3,-1(T1) ;MOVE ALL BUT LAST PARTIAL WORD
MOVN T2,T2 ;NO. OF BYTES USED BY FULL WORDS
ADDM T2,FILCNT(F) ;ACCOUNT FOR THEM
; PJRST PUTALW ;NEXT PAGE
END;
;STILL IN IFE FTCOBOL
BEGIN
PROCEDURE (JSP P4,PUTALW) ;PUT ASCII LAST WORD
SKIPG FILCNT(F) ;WILL LAST WORD FIT?
JSP T4,PUTBUF ;NO, WRITE OUT BUFFER
POP P,T2 ;GET REMAINDER BACK
JUMPE T2,PUTCRL ;END WITH CR-LF
MOVE T1,RC.KEY(R) ;GET LAST PARTIAL WORD
AND T1,ASCMSK(T2) ;ONLY WHAT WE REALLY NEED
MOVEM T1,@FILPTR(F) ;STORE FULL WORD
MOVN T1,T2 ;-NO. OF BYTES LEFT
ADDM T1,FILCNT(F) ;SUBTRACT FROM TOTAL
IFE FTKL10,<
IBP FILPTR(F) ;ADJUST BYTE PTR
SOJG T2,.-1
>
IFN FTKL10,<
ADJBP T2,FILPTR(F)
MOVEM T2,FILPTR(F)
>
; PJRST PUTCRL ;BELOW
END;
BEGIN
PROCEDURE (JSP P4,PUTCRL) ;PUT A CRLF
MOVE R,RSAV ;RESTORE R
MOVEI T1,.CHCRT ;CR
PUSHJ P,WRASBT ;WRITE ASCII BYTE
MOVEI T1,.CHLFD ;LF
PUSHJ P,WRASBT
MOVE T1,FILPTR(F) ;NOW SEE IF ALREADY ON WORD BOUNDARY
TLNE T1,760000 ;IF SO CHANGE BYTE PTR
JRST PUTALN ;NOT, SEE IF WE WANT TO WORD ALIGN
ADD T1,[430000,,1] ;YES, MAKE IT POINT TO WORD
MOVEM T1,FILPTR(F)
RETURN
END;
;STILL IN IFE FTCOBOL
BEGIN
PROCEDURE (PUSHJ P,WRASBT) ;WRITE ASCII BYTE TO OUTPUT FILE
IF BUFFER IS ALREADY FULL
SOSL FILCNT(F) ;ENOUGH ROOM?
JRST $F
THEN EMPTY IT
PUSH P,T1 ;VE CURRENT BYTE
JSP T4,PUTBUF ;WRITE OUT BUFFER
POP P,T1 ;RESTORE BYTE
SOS FILCNT(F) ;ACCOUNT FOR BYTE WE WILL NEXT STORE
FI;
IDPB T1,FILPTR(F) ;YES, STORE BYTE
RETURN
END;
BEGIN
PROCEDURE (JSP P4,PUTALN) ;ALIGN ON WORD BOUNDARY IF REQUIRED
SKIPG ALIGN ;WANT TO WORD ALIGN ON OUTPUT?
RETURN ;NO, DONE
SETZ T2, ;GET A NULL
$1% SOS FILCNT(F) ;DECREMENT BYTE COUNT
IDPB T2,T1 ;STORE NULL
TLNE T1,760000 ;GOT THERE YET?
JRST $1 ;NO
ADD T1,[430000,,1] ;YES
MOVEM T1,FILPTR(F) ;CHANGE BYTE PTR
RETURN
END;
;STILL IN IFE FTCOBOL
BEGIN
PROCEDURE (JSP P4,PUTAML) ;HERE WHEN RECORD CROSSES BLOCK BOUNDARY
MOVEI P1,(T1) ;SIZE OF RECORD (WORDS)
$1% SKIPN T1,FILCNT(F) ;NUMBER OF BYTES LEFT IN CURRENT BUFFER
JSP T4,PUTBUF ;FULL, DUMP IT
IDIVI T1,5 ;WORDS IN CURRENT BUFFER
MOVEI T2,(P1) ;SIZE OF RECORD RESIDUE
CAILE T2,(T1) ;WILL RESIDUE FIT IN CURRENT BUFFER
MOVEI T2,(T1) ;NO, TRANSFER ONLY FILCNT WORDS
HRLZI T3,RC.KEY(R) ;PTR TO ORIGIN OF RECORD FRAGMENT
HRR T3,FILPTR(F) ;PTR TO DESTINATION OF RECORD RESIDUE
ADDI R,(T2) ;ADVANCE RECORD RETRIEVAL PTR
ADDM T2,FILPTR(F) ;ADVANCE BUFFER POINTER
MOVE T1,FILPTR(F)
BLT T3,-1(T1) ;TRANSFER RECORD FRAGMENT
MOVNI T1,5 ;5 BYTES PER WORD
IMULI T1,(T2) ;- NO. OF WORDS
ADDM T1,FILCNT(F) ;ADJUST BUFFER COUNT
SUBI P1,(T2) ;DECREMENT LENGTH OF RECORD RESIDUE
JUMPN P1,$1 ;FINISHED ?
PJRST PUTALW ;HANDLE LAST PARTIAL WORD
END;
;STILL IN IFE FTCOBOL
BEGIN
PROCEDURE (JSP P4,PUTASN) ;HERE FOR ASCII RECORD NOT ON A WORD BOUNDARY
IFE FTKL10,<
LDB P1,[POINT 6,FILPTR(F),5] ;GET BYTE POSITION
SOS T1,P1 ;NO. OF BITS LEFT -1
IDIVI T1,7 ;CONVERT TO BYTES
MOVN T1,T1 ;-NO. THATS LEFT
ADDI T1,5 ;+ NO. ALREADY USED
ADDM T1,FILCNT(F) ;ACCOUNT FOR THEM
MOVE T2,RECORD ;NO. OF BYTES TO FOLLOW
IDIVI T2,5 ;NO. OF WORDS
ADDI T1,(T3) ;THOSE IN FRONT + THOSE BEHIND
PUSH P,T1 ;SAVE REMAINDER
PUSH P,T3 ;SAVE NO. OF BYTES IN (R)
MOVN T2,T2 ;-NO. OF FULL WORDS TO COPY
HRL R,T2 ;AOBJN PTR
MOVN T3,P1 ;NO. OF BITS TO SHIFT LEFT
ADDI T3,^D35 ;LSHC COUNTER FOR REMAINDER
MOVSI T2,(POINT 7,) ;RETARD BYTE POINTER TO BEFORE FIRST BYTE
HLLM T2,FILPTR(F) ; SO BOTH ILDB AND MOVE @ WORK
MOVE T1,@FILPTR(F) ;GET PARTIAL WORD
MOVN T2,P1 ;NO. OF BYTES -1 IT IS LEFT SHIFTED
LSH T1,-1(T2) ;RIGHT JUSTIFY
;LOOP FOR REMAINING WORDS
$1% SKIPG FILCNT(F) ;ROOM IN THIS BUFFER?
JRST [PUSH P,T1 ;SAVE PARTIAL
PUSH P,T3 ;LSHC -COUNT
JSP T4,PUTBUF ;GET NEW BUFFER
POP P,T3
POP P,T1
JRST $5]
$5% MOVE T2,RC.KEY(R) ;GET IT
LSHC T1,(P1) ;35 BITS IN T1
LSH T1,1 ;LEFT JUSTIFY
MOVEM T1,@FILPTR(F) ;STORE
LSHC T1,(T3) ;MOVE REMAINDER INTO T1
MOVNI T2,5
ADDM T2,FILCNT(F) ;ADJUST BYTE COUNT
AOS FILPTR(F) ;AND BYTE PTR
AOBJN R,$1 ;LOOP FOR ALL FULL WORDS
;NOW FOR LAST WORD
SKIPLE FILCNT(F) ;BUFFER FULL?
JRST $6 ;NO
PUSH P,T1 ;SAVE PARTIAL WORD
JSP T4,PUTBUF ;YES, EMPTY IT
POP P,T1 ;RESTORE PARTIAL WORD
$6% POP P,T3 ;GET REMAINDER
JUMPE T3,$2 ;NONE
SKIPA T2,RC.KEY(R) ;GET IT
$2% TDZA T2,T2 ;NO REMAINDER
AND T2,ASCMSK(T3) ;ONLY WHAT WE NEED
LSHC T1,(P1) ;FORM 35 BITS
LSH T1,1
MOVEM T1,@FILPTR(F) ;STORE FIRST WORD
POP P,T3 ;GET TOTAL REMAINDER
CAIGE T3,5 ;ONLY ONE WORD?
JRST $3 ;YES
AOS FILPTR(F) ;ADVANCE BYTE PTR
MOVNI T1,5 ;COUNT DOWN NO. OF BYTES LEFT
ADDB T1,FILCNT(F)
SUBI T3,5 ;...
JUMPG T1,$4 ;ENOUGH ROOM IN THIS BUFFER
PUSH P,T2 ;NO, SAVE REMAINDER
PUSH P,T3 ;BYTE COUNT
JSP T4,PUTBUF ;GET NEW BUFFER
POP P,T3
POP P,T2
$4% MOVEM T2,@FILPTR(F) ;STORE 2ND WORD
JUMPE T3,$7 ;NO REMAINDER LEFT BY NOW?
$3% MOVN T3,T3
ADDM T3,FILCNT(F) ;ADJUST BYTE COUNT
IBP FILPTR(F)
AOJL T3,.-1 ;AND BYTE PTR
$7%
>;END OF IFE FTKL10
IFN FTKL10,<
MOVE T0,RECORD ;NO. OF BYTES TO COPY
MOVEI T1,7 ;BYTE SIZE
PUSHJ P,PUTEX ;PUT RECORD WITH COMMON BIS CODE
>;END IFN FTKL10
JRST PUTCRL ;ALL DONE
END;
;STILL IN IFE FTCOBOL
BEGIN
PROCEDURE (JSP P4,PUTAVR) ;WRITE VARIABLE LENGTH ASCII RECORD
;TERMINATE WITH CR-LF
IFE FTKL10,<
HRLI R,(POINT 7,,35) ;FORM BYTE PTR
MOVE P1,@RSAV ;[147] NO. OF CHARACTERS TO STORE
SKIPG SEQNO ;[110] SEQUENCE NO.?
JRST $1 ;NO
MOVE T1,RC.KEY(R) ;GET FIRST WORD
MOVEM T1,@FILPTR(F) ;STORE SEQ NO.
AOS FILPTR(F) ;INCREMENT STORE PTR
MOVNI T1,5
ADDM T1,FILCNT(F) ;GET BYTE COUNT RIGHT
SUBI P1,5 ;CORRECT THE NUMBER OF CHARACTERS TO STORE
ADDI R,1 ;AND INPUT PTR
$1% ILDB T1,R ;GET CHARACTER
$2% SOSGE FILCNT(F) ;ANY ROOM IN BUFFER?
JRST [JSP T4,PUTBUF ;NO, EMPTY IT
LDB T1,R ;GET BYTE AGAIN
JRST $2] ;TRY AGAIN
IDPB T1,FILPTR(F) ;STORE
SOJG P1,$1 ;LOOP
$3%
>;END OF IFE FTKL10
IFN FTKL10,<
MOVE T0,@RSAV ;NO. OF BYTES TO COPY
SKIPG SEQNO ;[110] SEQUENCE NO.?
JRST $3 ;NO
MOVE T1,1(R) ;GET FIRST WORD
MOVEM T1,@FILPTR(F) ;YES, STORE IT
AOS FILPTR(F) ;ADVANCE
ADDI R,1 ;[216] ADVANCE RECORD POINTER TOO
MOVNI T1,5
ADDM T1,FILCNT(F) ;ACCOUNT FOR BYTES
SUBI T0,5 ; ..
$3% MOVEI T1,7 ;BYTE SIZE
PUSHJ P,PUTEX ;PUT RECORD WITH COMMON BIS CODE
>;END IFN FTKL10
JRST PUTCRL ;ALL DONE
END;
SUBTTL PUTREC -- PUTEBR - Put EBCDIC Record
;STILL IN IFE FTCOBOL
IFE FTFORTRAN,<
BEGIN
PROCEDURE (JSP P4,PUTEBR) ;HERE TO PUT NEXT EBCDIC RECORD INTO OUTPUT FILE
AOS FILSIZ(F) ;INCREMENT SIZE OF FILE
ADD R,XTRWRD ;[150] BYPASS EXTRACTED KEYS
SKIPGE T1,FILFLG(F) ;VARIABLE LENGTH OUTPUT?
JRST PUTEVR ;YES
TXNE T1,FI.IND ;INDUSTRY COMPATIBLE MODE?
JRST PUTICR ;YES
SKIPL FILPTR(F) ;SEE IF ON A WORD BOUNDARY
JRST PUTEBN ;NOT
MOVE T1,RECORD ;SEE HOW MANY ACTUAL CHARS
IDIVI T1,4
PUSH P,T2 ;SAVE REMAINDER
MOVE T2,T1
LSH T2,2 ;INTERGRAL NO. OF BYTES
CAMLE T2,FILCNT(F) ;ALL IN THIS BUFFER?
JRST PUTEML ;NO
HRRZ T3,FILPTR(F) ;GET BYTE PTR
HRLI T3,RC.KEY(R) ;ORIGIN
ADDI R,(T1) ;ADVANCE READ PTR
ADDB T1,FILPTR(F) ;ADJUST BYTE PTR
BLT T3,-1(T1) ;MOVE ALL BUT LAST PARTIAL WORD
MOVN T2,T2 ;NO. OF BYTES USED BY FULL WORDS
ADDM T2,FILCNT(F) ;ACCOUNT FOR THEM
; PJRST PUTELW ;NEXT PAGE
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
PROCEDURE (JSP P4,PUTELW) ;PUT EBCDIC LAST WORD
SKIPG FILCNT(F) ;WILL LAST WORD FIT?
JSP T4,PUTBUF ;NO, WRITE OUT BUFFER
POP P,T2 ;GET REMAINDER BACK
JUMPE T2,PUTEBZ ;END
MOVE T1,RC.KEY(R) ;GET LAST PARTIAL WORD
AND T1,EBCMSK(T2) ;ONLY WHAT WE REALLY NEED
MOVEM T1,@FILPTR(F) ;STORE FULL WORD
MOVN T1,T2 ;-NO. OF BYTES LEFT
ADDM T1,FILCNT(F) ;SUBTRACT FROM TOTAL
IFE FTKL10,<
IBP FILPTR(F) ;ADJUST BYTE PTR
SOJG T2,.-1
>
IFN FTKL10,<
ADJBP T2,FILPTR(F)
MOVEM T2,FILPTR(F)
>
; PJRST PUTEBZ ;BELOW
END;
BEGIN
PROCEDURE (JSP P4,PUTEBZ) ;PUT EBCDIC, FIX UP BYTE-POINTER
MOVE R,RSAV ;RESTORE R
MOVE T1,FILPTR(F) ;NOW SEE IF ALREADY ON WORD BOUNDARY
TLNE T1,700000 ;IF SO CHANGE BYTE PTR
RETURN ;NOT
TLO T1,440000 ;MAKE IT POINT TO START OF WORD
ADDI T1,1 ;NEXT WORD
MOVEM T1,FILPTR(F)
RETURN
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
PROCEDURE (JSP P4,PUTEML) ;HERE WHEN RECORD CROSSES BLOCK BOUNDARY
MOVEI P1,(T1) ;SIZE OF RECORD (WORDS)
$1% SKIPN T1,FILCNT(F) ;NUMBER OF BYTES LEFT IN CURRENT BUFFER
JSP T4,PUTBUF ;FULL, DUMP IT
IDIVI T1,4 ;WORDS IN CURRENT BUFFER
MOVEI T2,(P1) ;SIZE OF RECORD RESIDUE
CAILE T2,(T1) ;WILL RESIDUE FIT IN CURRENT BUFFER
MOVEI T2,(T1) ;NO, TRANSFER ONLY FILCNT WORDS
HRLZI T3,RC.KEY(R) ;PTR TO ORIGIN OF RECORD FRAGMENT
HRR T3,FILPTR(F) ;PTR TO DESTINATION OF RECORD RESIDUE
ADDI R,(T2) ;ADVANCE RECORD RETRIEVAL PTR
ADDM T2,FILPTR(F) ;ADVANCE BUFFER POINTER
MOVE T1,FILPTR(F)
BLT T3,-1(T1) ;TRANSFER RECORD FRAGMENT
MOVNI T1,4 ;5 BYTES PER WORD
IMULI T1,(T2) ;- NO. OF WORDS
ADDM T1,FILCNT(F) ;ADJUST BUFFER COUNT
SUBI P1,(T2) ;DECREMENT LENGTH OF RECORD RESIDUE
JUMPN P1,$1 ;FINISHED ?
PJRST PUTELW ;HANDLE LAST PARTIAL WORD
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
PROCEDURE (JSP P4,PUTEBN) ;HERE FOR EBCDIC RECORD NOT ON A WORD BOUNDARY
IFE FTKL10,<
LDB P1,[POINT 6,FILPTR(F),5] ;GET BYTE POSITION
MOVE T1,P1 ;NO. OF BITS LEFT
IDIVI T1,9 ;CONVERT TO BYTES
MOVN T1,T1 ;-NO. THATS LEFT
ADDI T1,4 ;+ NO. ALREADY USED
ADDM T1,FILCNT(F) ;ACCOUNT FOR THEM
MOVE T2,RECORD ;NO. OF BYTES TO FOLLOW
IDIVI T2,4 ;NO. OF WORDS
ADDI T1,(T3) ;THOSE IN FRONT + THOSE BEHIND
PUSH P,T1 ;SAVE REMAINDER
PUSH P,T3 ;SAVE NO. OF BYTES IN (R)
MOVN T2,T2 ;-NO. OF FULL WORDS TO COPY
HRL R,T2 ;AOBJN PTR
MOVN T3,P1 ;NO. OF BITS TO SHIFT LEFT
ADDI T3,^D36 ;LSHC COUNTER FOR REMAINDER
MOVEI T2,44 ;RETARD BYTE POINTER TO BEFORE FIRST BYTE
DPB T2,[POINT 6,FILPTR(F),5] ; SO BOTH ILDB AND MOVE @ WORK
MOVE T1,@FILPTR(F) ;GET PARTIAL WORD
MOVN T2,P1 ;NO. OF BYTES IT IS LEFT SHIFTED
LSH T1,(T2) ;RIGHT JUSTIFY
;LOOP FOR REMAINING WORDS
$1% SKIPG FILCNT(F) ;ROOM IN THIS BUFFER?
JRST [PUSH P,T1 ;SAVE PARTIAL
PUSH P,T3 ;LSHC -COUNT
JSP T4,PUTBUF ;GET NEW BUFFER
POP P,T3
POP P,T1
JRST $5]
$5% MOVE T2,RC.KEY(R) ;GET IT
LSHC T1,(P1) ;36 BITS IN T1
MOVEM T1,@FILPTR(F) ;STORE
LSHC T1,(T3) ;MOVE REMAINDER INTO T1
MOVNI T2,4
ADDM T2,FILCNT(F) ;ADJUST BYTE COUNT
AOS FILPTR(F) ;AND BYTE PTR
AOBJN R,$1 ;LOOP FOR ALL FULL WORDS
;NOW FOR LAST WORD
SKIPLE FILCNT(F) ;BUFFER FULL?
JRST $6 ;NO
PUSH P,T1 ;SAVE PARTIAL WORD
JSP T4,PUTBUF ;YES, EMPTY IT
POP P,T1 ;RESTORE PARTIAL WORD
$6% POP P,T3 ;GET REMAINDER
JUMPE T3,$2 ;NONE
SKIPA T2,RC.KEY(R) ;GET IT
$2% TDZA T2,T2 ;NO REMAINDER
AND T2,EBCMSK(T3) ;ONLY WHAT WE NEED
LSHC T1,(P1) ;FORM 36 BITS
MOVEM T1,@FILPTR(F) ;STORE FIRST WORD
POP P,T3 ;GET TOTAL REMAINDER
CAIGE T3,4 ;ONLY ONE WORD?
JRST $3 ;YES
AOS FILPTR(F) ;ADVANCE BYTE PTR
MOVNI T1,4 ;COUNT DOWN NO. OF BYTES LEFT
ADDB T1,FILCNT(F)
SUBI T3,4 ;...
JUMPG T1,$4 ;ENOUGH ROOM IN THIS BUFFER
PUSH P,T2 ;NO, SAVE REMAINDER
PUSH P,T3 ;BYTE COUNT
JSP T4,PUTBUF ;GET NEW BUFFER
POP P,T3
POP P,T2
$4% MOVEM T2,@FILPTR(F) ;STORE 2ND WORD
JUMPE T3,$7 ;NO REMAINDER LEFT BY NOW?
$3% MOVN T3,T3
ADDM T3,FILCNT(F) ;ADJUST BYTE COUNT
IBP FILPTR(F)
AOJL T3,.-1 ;AND BYTE PTR
$7%
>;END OF IFE FTKL10
IFN FTKL10,<
MOVE T0,RECORD ;NO. OF BYTES TO COPY
MOVEI T1,^D9 ;BYTE SIZE
PUSHJ P,PUTEX ;PUT RECORD WITH COMMON BIS CODE
>;END IFN FTKL10
JRST PUTEBZ ;ALL DONE
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
PROCEDURE (JSP P4,PUTEVR) ;WRITE VARIABLE LENGTH EBCDIC RECORD
MOVE P1,@RSAV ;[150] GET BYTE COUNT
MOVEI T1,4(P1) ;BYTE COUNT PLUS 4 BYTE OVERHEAD
ROT T1,-4 ;RIGHT JUST HIGH ORDER BITS
PUSHJ P,WREBBT ;WRITE IT
LSH T1,-^D32 ;RIGHT JUSTIFY LOW ORDER BIT
PUSHJ P,WREBBT ;WRITE IT
SETZ T1,
PUSHJ P,WREBBT ;WRITE JUNK
PUSHJ P,WREBBT ;...
IFE FTKL10,<
HRLI R,(POINT 9,,35) ;FORM BYTE PTR
$1% ILDB T1,R ;GET CHARACTER
$2% SOSGE FILCNT(F) ;ANY ROOM IN BUFFER?
JRST [JSP T4,PUTBUF ;NO, EMPTY IT
LDB T1,R ;GET BYTE AGAIN
JRST $2] ;TRY AGAIN
IDPB T1,FILPTR(F) ;STORE
SOJG P1,$1 ;LOOP
>;END OF IFE FTKL10
IFN FTKL10,<
MOVEI T0,(P1) ;NO. OF BYTES TO COPY
MOVEI T1,^D9 ;BYTE SIZE
PUSHJ P,PUTEX ;PUT RECORD WITH COMMON BIS CODE
>;END IFN FTKL10
JRST PUTEBZ ;ALL DONE
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
PROCEDURE (PUSHJ P,WREBBT) ;WRITE EBCDIC BYTE TO OUTPUT FILE
IF BUFFER IS ALREADY FULL
SOSL FILCNT(F) ;ENOUGH ROOM?
JRST $F
THEN EMPTY IT
PUSH P,T1 ;SAVE CURRENT BYTE
JSP T4,PUTBUF ;WRITE OUT BUFFER
POP P,T1 ;RESTORE BYTE
SOS FILCNT(F) ;ACCOUNT FOR BYTE WE WILL NEXT STORE
FI;
IDPB T1,FILPTR(F) ;YES, STORE BYTE
RETURN
END;
;STILL IN IFE FTCOBOL, IFE FTFORTRAN
BEGIN
PROCEDURE (JSP P4,PUTICR) ;WRITE INDUSTRY COMPATIBLE FIXED LENGTH EBCDIC RECORD
IFE FTKL10,<
MOVE P1,RECORD ;GET BYTE COUNT
HRLI R,(POINT 9,,35) ;FORM BYTE PTR
$1% ILDB T1,R ;GET CHARACTER
$2% SOSGE FILCNT(F) ;ANY ROOM IN BUFFER?
JRST [JSP T4,PUTBUF ;NO, EMPTY IT
LDB T1,R ;GET BYTE AGAIN
JRST $2] ;TRY AGAIN
IDPB T1,FILPTR(F) ;STORE
SOJG P1,$1 ;LOOP
>;END OF IFE FTKL10
IFN FTKL10,<
MOVE T0,RECORD ;NO. OF BYTES TO COPY
MOVEI T1,^D9 ;BYTE SIZE
PUSHJ P,PUTEX ;PUT RECORD WITH COMMON BIS CODE
>;END IFN FTKL10
JRST PUTEBZ ;ALL DONE
END;
>;END IFE FTFORTRAN
SUBTTL PUTREC -- PUTBNR - Put Binary Record
;STILL IN IFE FTCOBOL
BEGIN
PROCEDURE (JSP P4,PUTBNR)
AOS FILSIZ(F) ;INCREMENT SIZE OF FILE
MOVE T2,RECSIZ ;RECORD SIZE
ADD R,XTRWRD ;BYPASS EXTRACTED KEYS
MOVE T3,MODE
TXNE T3,RM.FOR ;FORTRAN BINARY FILE
PJRST PUTFBR ;YES
IF RECORD WILL FIT IN CURRENT BUFFER
CAIGE T1,(T2) ;WILL RECORD FIT IN CURRENT BUFFER ?
JRST $T ;NO, RECORD MUST SPAN BUFFERS
THEN COPY IT
HRLZI T3,RC.KEY(R) ;YES, SET ORIGIN ADDRESS
HRR T3,FILPTR(F) ;SET DESTINATION ADDRESS
HRRZ T4,T3
ADDI T4,(T2) ;ADDRESS OF END OF RECORD DESTINATION
BLT T3,0(T4) ;TRANSFER RECORD
SUBI T1,(T2)
MOVEM T1,FILCNT(F) ;ADJUST BUFFER COUNTER
ADDM T2,FILPTR(F) ;ADVANCE BUFFER POINTER
MOVE R,RSAV
RETURN
ELSE COPY IT PIECEMEAL
MOVEI P1,(T2) ;RECORD SIZE (WORDS)
BEGIN
SKIPN T1,FILCNT(F) ;NUMBER WORDS REMAINING IN CURRENT BUFFER
JSP T4,PUTBUF ;BUFFER FILLED, WRITE IT
MOVEI T2,(P1) ;SIZE OF RECORD RESIDUE
CAILE T2,(T1) ;WILL RESIDUE FIT IN CURRENT BUFFER ?
MOVEI T2,(T1) ;NO, TRANSFER ONLY FILCNT WORDS
HRLZI T3,RC.KEY(R) ;PTR TO ORIGIN OF RECORD FRAGMENT
HRR T3,FILPTR(F) ;PTR TO DESTINATION OF RECORD FRAGMENT
HRRZ T4,T3
ADDI T4,(T2) ;ADVANCE RECORD RETRIEVAL PTR
BLT T3,0(T4) ;TRANSFER RECORD FRAGMENT
SUBI T1,(T2)
MOVEM T1,FILCNT(F) ;ADJUST BUFFER COUNTER
ADDM T2,FILPTR(F) ;ADVANCE BUFFER POINTER
ADDI R,(T2) ;ADVANCE RECORD RETRIEVAL PTR
SUBI P1,(T2) ;DECREMENT LENGTH OF RECORD RESIDUE
JUMPN P1,$B ;NOT FINISHED
END;
MOVE R,RSAV
RETURN
FI;
END;
;STILL IN IFE FTCOBOL
;FIRST DEFINE A MACRO TO COMPUTE THE CONTENTS OF AN AC MOD 129. THIS IS
;NECESSARY BECAUSE FORTRAN LSCW'S CARE ABOUT TOPS-10 DISK BLOCK BOUNDARIES,
;EVEN ON TOPS20. THEREFORE WE MUST IMAGINE WHERE THE DISK BLOCK BOUNDARIES
;WOULD HAVE FALLEN BY ALWAYS LOOKING AT FILCNT MOD 129.
DEFINE MOD129(AC),<
SUBI AC,1
ANDI AC,177
ADDI AC,1
>
BEGIN
PROCEDURE (JSP P4,PUTFBR)
MOVE T2,@RSAV ;[203] GET THIS RECORD'S LENGTH IN WORDS
MOVE P3,T1 ;COPY FILCNT AND CONVERT IT
MOD129 (P3) ; TO FILCNT MOD 129
IF RECORD WILL FIT IN CURRENT BUFFER
CAIGE P3,2(T2) ;WILL RECORD FIT IN CURRENT "BUFFER" ?
JRST $T ;NO, RECORD MUST SPAN BUFFERS
THEN COPY IT
MOVEI T3,1(T2) ;WORDS TO LSCW
HRLI T3,S.LSCW
MOVEM T3,@FILPTR(F) ;STORE START LSCW
AOS T3,FILPTR(F)
HRLI T3,RC.KEY(R) ;FORM BLT PTR
HRRZ T4,T3
ADDI T4,(T2) ;ADDRESS OF END OF RECORD DESTINATION
BLT T3,0(T4) ;TRANSFER RECORD
MOVEI T3,2(T2) ;TOTAL WORDS
HRLI T3,E.LSCW
MOVEM T3,0(T4) ;STORE END CONTROL WORD
SUBI T1,2(T2)
MOVEM T1,FILCNT(F) ;ADJUST BUFFER COUNTER
ADDI T2,1
ADDM T2,FILPTR(F) ;ADVANCE BUFFER POINTER
MOVE R,RSAV
RETURN
ELSE COPY IT PIECEMEAL
IF MODE IS RANDOM
SKIPGE FILFLG(F) ;RANDOM IS FIXED SIZE
JRST $T ;MUST BE SEQUENTIAL
THEN
MOVEI P1,(T2) ;RECORD SIZE (WORDS)
MOVEI T3,1(T2) ;WORDS TO LSCW
HRLI T3,S.LSCW
MOVEM T3,@FILPTR(F) ;STORE START LSCW
AOS T3,FILPTR(F)
SOS FILCNT(F)
BEGIN
SKIPN T1,FILCNT(F) ;NUMBER WORDS REMAINING IN CURRENT BUFFER
JSP T4,PUTBUF ;BUFFER FILLED, WRITE IT
MOVEI T2,(P1) ;SIZE OF RECORD RESIDUE
CAILE T2,(T1) ;WILL RESIDUE FIT IN CURRENT BUFFER ?
MOVEI T2,(T1) ;NO, TRANSFER ONLY FILCNT WORDS
HRLZI T3,RC.KEY(R) ;PTR TO ORIGIN OF RECORD FRAGMENT
HRR T3,FILPTR(F) ;PTR TO DESTINATION OF RECORD FRAGMENT
HRRZ T4,T3
ADDI T4,(T2) ;ADVANCE RECORD RETRIEVAL PTR
BLT T3,0(T4) ;TRANSFER RECORD FRAGMENT
SUBI T1,(T2)
MOVEM T1,FILCNT(F) ;ADJUST BUFFER COUNTER
ADDM T2,FILPTR(F) ;ADVANCE BUFFER POINTER
ADDI R,(T2) ;ADVANCE RECORD RETRIEVAL PTR
SUBI P1,(T2) ;DECREMENT LENGTH OF RECORD RESIDUE
JUMPN P1,$B ;NOT FINISHED
END;
SKIPN FILCNT(F) ;ROOM FOR LSCW
JSP T4,PUTBUF ;NO
MOVE T3,RECSIZ ;NO. OF DATA WORDS
ADD T3,[E.LSCW,,2]
MOVEM T3,@FILPTR(F)
AOS FILPTR(F)
SOS FILCNT(F)
JRST $F
ELSE ITS SEQUENTIAL
MOVEI P1,(T2) ;RECORD SIZE (WORDS)
MOVE P2,P1 ;USED TO COUNT EXTRA LSCWS
MOVEI T3,0(P3) ;WORDS TO LSCW
HRLI T3,S.LSCW
MOVEM T3,@FILPTR(F) ;STORE START LSCW
AOS T3,FILPTR(F)
SOS FILCNT(F)
SUBI P3,1 ;DECREMENT "PSEUDO"-BUFFER COUNT
BEGIN
SKIPLE FILCNT(F) ;NUMBER WORDS REMAINING IN CURRENT BUFFER
JRST $2 ;STILL SOME
JSP T4,PUTBUF ;BUFFER FILLED, WRITE IT
MOVE P3,FILCNT(F) ;GET PSEUDO-BUFFER-COUNT
MOD129 (P3) ;MAKE IT MOD 129
$2% SKIPLE T1,P3 ;WORDS REMAINING IN "BUFFER"
JRST $1 ;STILL SOME
MOVEI T1,200 ;PRETEND NEW "BUFFER"
ADDI P2,1 ;ONE MORE LSCW TO COUNT
MOVEI T2,1(P1) ;SIZE OF RECORD RESIDUE + LSCW
CAILE T2,(T1) ;WILL RESIDUE FIT IN CURRENT BUFFER ?
MOVEI T2,(T1) ;NO, TRANSFER ONLY FILCNT WORDS
HRLI T2,C.LSCW
MOVEM T2,@FILPTR(F)
AOS FILPTR(F)
SOS T1,FILCNT(F)
MOD129 (T1) ;COMPUTE C(T1) MOD 129
$1% MOVEI T2,(P1) ;SIZE OF RECORD RESIDUE
CAILE T2,(T1) ;WILL RESIDUE FIT IN CURRENT BUFFER ?
MOVEI T2,(T1) ;NO, TRANSFER ONLY FILCNT WORDS
HRLZI T3,RC.KEY(R) ;PTR TO ORIGIN OF RECORD FRAGMENT
HRR T3,FILPTR(F) ;PTR TO DESTINATION OF RECORD FRAGMENT
HRRZ T4,T3
ADDI T4,(T2) ;ADVANCE RECORD RETRIEVAL PTR
BLT T3,-1(T4) ;TRANSFER RECORD FRAGMENT
MOVE T1,FILCNT(F) ;GET REAL BYTE COUNT
SUBI T1,(T2) ;SUBTRACT WHAT WE'VE WRITTEN SO FAR
MOVEM T1,FILCNT(F) ;ADJUST BUFFER COUNTER
SUBI P3,(T2) ;COUNT DOWN PSEUDO-BUFFER
ADDM T2,FILPTR(F) ;ADVANCE BUFFER POINTER
ADDI R,(T2) ;ADVANCE RECORD RETRIEVAL PTR
SUBI P1,(T2) ;DECREMENT LENGTH OF RECORD RESIDUE
JUMPN P1,$B ;NOT FINISHED
END;
MOVE T1,FILCNT(F) ;GET FILCNT
MOD129 (T1) ; MOD 129
JUMPN T1,$1 ;PLENTY OF ROOM FOR LSCW
SKIPE FILCNT(F) ;ROOM FOR LSCW
JRST $2 ;YES
JSP T4,PUTBUF ;NO
$2% MOVE T1,[C.LSCW,,1]
MOVEM T1,@FILPTR(F) ;STORE CONTINUE WORD
AOS FILPTR(F)
SOS FILCNT(F)
ADDI P2,1 ;COUNT ONE MORE LSCW
$1% MOVEI T3,2(P2) ;NO. OF DATA WORDS + LSCWS
HRLI T3,E.LSCW
MOVEM T3,@FILPTR(F)
AOS FILPTR(F)
SOS FILCNT(F)
FI;
FI;
MOVE R,RSAV
RETURN
END;
;STILL IN IFE FTCOBOL
IFN FTKL10,<
BEGIN
PROCEDURE (PUSHJ P,PUTEX)
;CALL WITH:
; T0/ NUMBER OF BYTES TO COPY
; T1/ BYTE SIZE
; F/ INDEX TO FILE TABLE (FOR BUFFER HEADER)
; R/ INDEX TO WORD BEFORE DATA IN RECORD
LSH T1,^D24 ;MOVE SIZE TO BYTE POINTER POSITION
HRRI T1,(R) ;FINISH BY STUFFING IN ADDR
MOVE T3,FILCNT(F) ;FILL UP REST OF ACS FOR EXTEND
$1% SETZ T2, ;UNUSED BIS AC
CAMGE T0,T3 ;DO THEY ALL FIT?
MOVE T3,T0 ;YES
MOVN T4,T0
ADDM T4,FILCNT(F) ;ACCOUNT FOR BYTES READ
MOVE T4,FILPTR(F) ;DESTINATION BYTE POINTER
EXTEND T0,[MOVSLJ
EXP 0] ;COPY AND 0 FILL
JRST $2
MOVEM T4,FILPTR(F) ;RESTORE BYTE POINTER
RETURN ;ALL DONE
$2% SETZM FILCNT(F) ;DON'T UPSET PUTBUF
MOVEM T4,FILPTR(F) ;UPDATE BYTE POINTER
PUSH P,T0 ;SAVE TEMPS OVER PUTBUF CALL
PUSH P,T1 ; ..
JSP T4,PUTBUF ;SEND THIS FULL BUFFER
POP P,T1 ;RESTORE TEMPS
POP P,T0 ; ..
MOVE T3,FILCNT(F) ;SET UP NEW DESTINATION
JRST $1 ;LOOP 'TIL RECORD IS SENT
END;
>;END IFN FTKL10
>;END IFE FTCOBOL
SUBTTL PUTREC -- PTTREC - Put Next Record to Temporary File
BEGIN
PROCEDURE (JSP P4,PTTREC)
AOS FILSIZ(F) ;INCREMENT SIZE OF FILE
SKIPN T1,FILCNT(F) ;NUMBER WORDS REMAINING IN CURRENT BUFFER
JSP T4,PUTBUF ;BUFFER FILLED, WRITE IT
MOVE T2,REKSIZ ;FIXED RECORD SIZE NOW
IFE FTCOBOL,<
IF RECORD IS VARIABLE SIZE
SKIPG P.VARF
JRST $F ;NO
THEN ONLY SAVE AS MUCH AS WE NEED
>
MOVE T2,RC.CNT(R) ;GET NO. OF BYTES
SUBI T2,1 ;[201] COUNT ALL BUT LAST DATA WORD
IDIV T2,IOBPW ;[201] ..
ADDI T2,2 ;[201] COUNT LAST AND COUNT WORD
ADD T2,XTRWRD ;[201] COUNT EXTRACTED KEYS
IFE FTCOBOL,<
FI;
>;END IFE FTCOBOL
IF RECORD WILL FIT IN CURRENT BUFFER
CAIGE T1,(T2) ;WILL RECORD FIT IN CURRENT BUFFER ?
JRST $1 ;NO, RECORD MUST SPAN BUFFERS
THEN COPY IT
HRLZI T3,RC.CNT(R) ;YES, SET ORIGIN ADDRESS
HRR T3,FILPTR(F) ;SET DESTINATION ADDRESS
HRRZ T4,T3
ADDI T4,(T2) ;END OF BLT
BLT T3,-1(T4) ;TRANSFER RECORD
SUBI T1,(T2)
MOVEM T1,FILCNT(F) ;ADJUST BUFFER COUNTER
ADDM T2,FILPTR(F) ;ADVANCE BUFFER POINTER
RETURN
ELSE
$1% MOVEM R,RSAV
MOVEI P1,(T2) ;RECORD SIZE (WORDS)
$2% SKIPN T1,FILCNT(F) ;NUMBER WORDS REMAINING IN CURRENT BUFFER
JSP T4,PUTBUF ;BUFFER FILLED, WRITE IT
MOVEI T2,(P1) ;SIZE OF RECORD RESIDUE
CAILE T2,(T1) ;WILL RESIDUE FIT IN CURRENT BUFFER ?
MOVEI T2,(T1) ;NO, TRANSFER ONLY FILCNT WORDS
HRLZI T3,RC.CNT(R) ;PTR TO ORIGIN OF RECORD FRAGMENT
HRR T3,FILPTR(F) ;PTR TO DESTINATION OF RECORD FRAGMENT
HRRZ T4,T3
ADDI T4,(T2) ;END OF BLT
BLT T3,-1(T4) ;TRANSFER RECORD FRAGMENT
SUBI T1,(T2)
MOVEM T1,FILCNT(F) ;ADJUST BUFFER COUNTER
ADDM T2,FILPTR(F) ;ADVANCE BUFFER POINTER
ADDI R,(T2) ;ADVANCE RECORD RETRIEVAL PTR
SUBI P1,(T2) ;DECREMENT LENGTH OF RECORD RESIDUE
IF NOT FINISHED
THEN COPY SOME MORE
JUMPN P1,$2 ;NOT FINISHED
ELSE RETURN
MOVE R,RSAV
RETURN
FI;
FI;
END;
BEGIN
PROCEDURE (PUSHJ P,GENNAM)
;GENNAM GENERATES A SIXBIT FILE NAME OF FORM ###Sxy, WHERE ### IS OUR OCTAL JOB
;NUMBER, x IS THE RUN NUMBER, y IS THE FILE NUMBER IN THE RUN. NOTE THAT SINCE
;WE ALLOW ONLY ONE LETTER FOR THE FILE NUMBER, THERE IS A LIMIT OF 26 TEMPORARY
;FILES PER MERGE PASS. TOPS-20 REACHES THIS LIMIT, WHILE TOPS-10 IS FURTHER
;LIMITED BY I/O CHANNELS.
;
;CALL WITH:
; F/ POINTER TO FCB
;
;RETURN WITH:
; T1/ NAME ON RETURN
MOVE T1,MRGNUM ;GET MERGE PASS NO.
LSH T1,6 ;MAKE ROOM FOR FILE NUMBER
ADD T1,TCBIDX ;ADD FILE NAME INDEX
ADDI T1,'S0A' ;FORM ALPHABETIC
HRRM T1,FILNAM(F) ;STORE NUMERIC FILE NAME
HLL T1,JOBNUM ;PLACE OCTAL JOB NUMBER IN LEFT HALF
RETURN
END;
SUBTTL MEMORY MANAGEMENT
BEGIN
PROCEDURE (PUSHJ P,GETSPC)
;GETSPC ALLOCATES C(T1) WORDS AND RETURNS THE ADDRESS OF THE BLOCK IN T1. SKIP
;RETURNS IF OK, ERROR RETURNS IF NO MORE MEMORY AVAILABLE.
MOVEM T1,SIZE ;SAVE REQUESTED SIZE
IFE FTCOBOL!FTFORTRAN,<
IFN FTOPS20,<
SKIPN FORTPP ;CALLED BY FORTRAN?
>
JRST GETSP1 ;NO, STANDALONE
>
MOVEI L,1+[-5,,0 ;LOAD UP ARG BLOCK FOR FUNCT. CALL
Z TP%INT,[F.GOT]
Z TP%LIT,[ASCIZ /SRT/]
Z TP%INT,STATUS
Z TP%INT,ADDR
Z TP%INT,SIZE]
PUSHJ P,FUNCT. ;ALLOCATE THE MEMORY
SKIPE STATUS ;NON-ZERO STATUS IS AN ERROR
RETURN ;GIVE ERROR RETURN
MOVE T3,CORSTK ;GET PTR TO STACK OF ALLOCATION ENTRIES
HRLZ T1,SIZE ;CONSTRUCT XWD SIZE, ADDRESS
HRR T1,ADDR ; FOR ALLOCATION STACK
PUSH T3,T1 ;PUSH THIS ENTRY ONTO STACK
MOVEM T3,CORSTK ;SAVE STACK POINTER
HRRZ T1,ADDR ;RETURN ADDRESS OF BLOCK TO CALLER
PJRST CPOPJ1 ;GIVE SKIP RETURN
;HERE IF STANDALONE (NEITHER FORTRAN NOR COBOL)
IFE FTCOBOL!FTFORTRAN,<
GETSP1: HRLZ T3,T1 ;BUILD ALLOCATION STACK ENTRY IN T3
HRRZ T2,.JBFF## ;GET ADDR OF FIRST FREE WORD
HRR T3,T2 ;MAKE XWD LENGTH, ADDRESS OF BLOCK
ADD T1,T2 ;COMPUTE NEW FREE POINTER
IFN FTOPS20,<
CAML T1,MAXFRE ;RANGE CHECK
RETURN ;OUT OF RANGE
>
HRRM T1,.JBFF## ;UPDATE IT
IFE FTOPS20,<
IF THERE'S NOT ENOUGH MEMORY
CAMG T1,.JBREL## ;SEE IF WE HAVE ENOUGH
JRST $F ;YES--GO FINISH
THEN GET SOME WITH CORE UUO
CORE T1, ;TRY TO ALLOCATE SOME MORE ROOM
JRST E$$NEC ;CAN'T
FI;
>
MOVE T1,T3 ;COPY ALLOCATION ENTRY TO T1
MOVE T3,CORSTK ;GET ALLOCATION STACK PTR
PUSH T3,T1 ;PUSH ENTRY ONTO STACK
MOVEM T3,CORSTK ;SAVE STACK PTR
MOVE T1,T2 ;RETURN ADDRESS OF BLOCK IN T1
MOVEM T1,ADDR ; AND SAVE IT IN ADDR
PJRST CPOPJ1 ;OK RETURN
>
END;
;FRESPC - FREE C(T1) WORDS
BEGIN
PROCEDURE (PUSHJ P,FRESPC)
IFE FTCOBOL!FTFORTRAN,<
IFN FTOPS20,<
SKIPN FORTPP ;CALLED BY FORTRAN?
>
JRST FRESP1 ;NO, DO STANDALONE THING
>
MOVE T4,CORSTK ;GET ALLOCATION STACK POINTER
MOVE T3,0(T4) ;GET SIZE AND ADDR OF LAST BLOCK ALLOCATED
HLRZM T3,SIZE ;SAVE FOR FUNCT. CALL
HRRZM T3,ADDR ;SAVE FOR FUNCT.
MOVEI L,1+[-5,,0 ;LOAD UP FUNCT. ARG BLOCK
Z TP%INT,[F.ROT]
Z TP%LIT,[ASCIZ /SRT/]
Z TP%INT,STATUS
Z TP%INT,ADDR
Z TP%INT,SIZE]
PUSHJ P,FUNCT. ;RELEASE THE MEMORY
SKIPE STATUS ;OK?
JRST E$$FMR ;NO, COMPLAIN
POP T4,T1 ;REMOVE ALLOCATION ENTRY FROM STACK
MOVEM T4,CORSTK ;SAVE STACK POINTER
SUB T1,T3 ;SUBTRACT WHAT WE FREED FROM
; WHAT CALLER WANTED FREED
JUMPG T1,FRESPC ;IF SOME STILL LEFT, FREE SOME MORE
RETURN ;ALL DONE
IFE FTCOBOL!FTFORTRAN,<
FRESP1: MOVE T4,CORSTK ;GET ALLOCATION STACK PTR
FRESP2: HLRZ T3,0(T4) ;GET SIZE OF TOP BLOCK
CAMGE T1,T3 ;FREEING LESS THAN TOP BLOCK'S SIZE
JRST E$$FMR ; IS AN ERROR
HRRZ T2,.JBFF## ;GET FREE POINTER
SUB T2,T3 ;FREE UP TOP BLOCK
HRRM T2,.JBFF## ;REMEMBER NEW FREE POINTER
SUB T1,T3 ;SUBTRACT WHAT WE'VE FREED
POP T4,T2 ;THROW AWAY TOP STACK ENTRY
MOVEM T4,CORSTK ;MAINTAIN COPY OF MEMORY STACK PTR
JUMPG T1,FRESP2 ;IF SOME LEFT TO DUMP, DO IT
RETURN
>
END;
BEGIN
PROCEDURE (PUSHJ P,CLRSPC)
;CLRSPC CLEARS MEMORY GOTTEN FROM GETSPC. RETURNS WITH ADDRESS OF SPACE CLEARED
;IN T1.
SKIPN T1,SIZE ;LOAD SIZE INTO T1
RETURN ; AND RETURN IF ZERO
MOVE T3,ADDR ;GET ADDR OF SPACE
HRL T2,T3 ;GET 'FROM' ADDR
HRRI T2,1(T3) ;GET 'TO' ADDR
SETZM (T3) ;CLEAR FIRST LOC
ADD T3,SIZE ;GET 'UNTIL' ADDR
CAIE T3,(T2) ;SKIP IF SIZE = ONE
BLT T2,-1(T3) ;CLEAR SPACE
MOVE T1,ADDR
RETURN
END;
SUBTTL ERROR MESSAGE SUPPRESSION CONTROL
BEGIN
PROCEDURE (PUSHJ P,%ERMSG)
HRRZS SUPFLG ;CLEAR LAST CALL
HLRZ T3,T2 ;GET ERROR CODE
CAIN T3,"?" ;FATAL?
MOVEI T3,SUPFATAL
CAIN T3,"%" ;WARNING?
MOVEI T3,SUPWARN
CAIN T3,"[" ;INFORMATION?
MOVEI T3,SUPINFO
CAIE T3,SUPFATAL ;IS THIS ERROR FATAL?
JRST $1 ;NO
SKIPLE FERCOD ;DOES USER WANT CODE RETURNED?
MOVEM T1,@FERCOD ;YES
$1% CAMLE T3,SUPFLG ;ARE WE ALLOWED TO PRINT IT?
PJRST .ERMSG ;YES
HRROS SUPFLG ;NO, AND NOT FOR $MORE EITHER
RETURN
END;
%TOCTW: SKIPL SUPFLG ;SUPPRESS IT?
PJRST .TOCTW ;NO
POPJ P,
%TDECW: SKIPL SUPFLG ;SUPPRESS IT?
PJRST .TDECW ;NO
POPJ P,
%TSTRG: SKIPL SUPFLG ;SUPPRESS IT?
PJRST .TSTRG ;NO
POPJ P,
%TSIXN: SKIPL SUPFLG ;SUPPRESS IT?
PJRST .TSIXN ;NO
POPJ P,
%TOLEB: SKIPL SUPFLG ;SUPPRESS IT?
PJRST .TOLEB ;NO
POPJ P,
%TCORW: SKIPL SUPFLG ;SUPPRESS IT?
PJRST .TCORW ;NO
POPJ P,
%TCRLF: SKIPL SUPFLG ;SUPPRESS IT?
PJRST .TCRLF ;NO
POPJ P,
%TRBRK: SKIPL SUPFLG ;SUPPRESS IT?
PJRST .TRBRK ;NO
POPJ P,
%TCHAR: SKIPL SUPFLG ;SUPPRESS IT?
PJRST .TCHAR ;NO
POPJ P,
SUBTTL ERROR MESSAGES
E$$NEC: $ERROR (?,NEC,<Not enough core for SORT/MERGE.>)
E$$FMR: $ERROR (?,FMR,<Attempt to free more memory than was originally retained.>)
E$$TMT: $ERROR (%,TMT,<Too many temporary structures specified>)
POPJ P,
E$$RIE: $ERROR (?,RIE,<Record incomplete at E-O-F>)
E$$RNI: $ERROR (%,RNI,<Record number inconsistent, >,+)
$MORE (DECIMAL,INPREC)
$MORE (TEXT,< read, >)
$MORE (DECIMAL,OUTREC)
$MORE (TEXT,< written>)
$CRLF
POPJ P,
ERRKNR: PUSH P,T1
PUSH P,T2
$ERROR (%,KNR,<Key not fully contained in record >,+)
$MORE (DECIMAL,FILSIZ(F))
$CRLF
POP P,T2
POP P,T1
POPJ P,
CPOPJ1: AOS (P) ;STANDARD SKIP-RETURN MECHANISM
CPOPJ: POPJ P, ; ..
ENDMODULE;