Trailing-Edge
-
PDP-10 Archives
-
BB-H506E-SM
-
sort/source/srtscn.mac
There are 14 other files named srtscn.mac in the archive. Click here to see a list.
SUBTTL SRTSCN - INTERFACE TO SCAN FOR TOPS-10 COMMAND SCANNER
SUBTTL D.M.NIXON/DMN/DZN/BRF/CLRH/GCS/PY 22-Jun-83
SEARCH COPYRT
;COPYRIGHT (C) 1975, 1985 BY DIGITAL EQUIPMENT CORPORATION
;ALL RIGHTS RESERVED
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
.COPYRIGHT
SALL
IFN FTOPS20,<PRINTX ? SRTSCN should not be present in TOPS-20 SORT/MERGE.>
IFN FTPRINT,<PRINTX [Entering SRTSCN.MAC]>
SUBTTL TABLE OF CONTENTS FOR SRTSCN
; Table of Contents for SRTSCN
;
;
; Section Page
;
; 1 SRTSCN - INTERFACE TO SCAN FOR TOPS-10 COMMAND SCANNER ... 1
; 2 TABLE OF CONTENTS FOR SRTSCN ............................. 2
; 3 DEFINITIONS
; 3.1 TOPS-10 Specific Parameters ....................... 3
; 3.2 Prototype SCAN Block .............................. 4
; 3.3 Impure Data ....................................... 5
; 4 RESTART CODE ............................................. 6
; 5 SCAN INTERFACE
; 5.1 Interface Procedure ............................... 7
; 5.2 Switch Table ...................................... 8
; 5.3 Control Routines
; 5.3.1 ALLOUT ..................................... 11
; 5.3.2 ALLIN ...................................... 12
; 5.4 Switch Handling
; 5.4.1 /PRIORITY:n ................................ 13
; 5.4.2 /KEY:n:m:x ................................. 14
; 5.4.3 /COLLATE:x[:y] ............................. 15
; 6 TYPE-IN ROUTINES
; 6.1 Format Descriptor ................................. 18
; 7 PSORT.
; 7.1 SETTMP - Set up Temporary Files ................... 19
; 7.2 PRUNE - Prune Null SCAN Blocks from I/O Lists ..... 20
; 7.3 SETUPO - Set Up Output Files ...................... 21
; 7.4 SETUPI - Set Up Input Files ....................... 22
; 7.5 STOPB - Convert SORT/SCAN To OPEN/ENTER/PATH Blocks 23
; 7.6 SETMTA - Set Up Buffer Sizes for Magtapes ......... 24
; 7.7 Memory Management Routines for TOPS-10 ............ 25
; 8 HPURE SEGMENT ERROR MESSAGES ............................. 28
; 9 I/O ROUTINES
; 9.1 INIINP - Initialize Next Input File ............... 29
; 9.2 INIOUT - Initialize Next Output File .............. 31
; 9.3 RENOUT - Rename Temporary File to Output File ..... 33
; 9.4 Magtape Utility Routines .......................... 34
; 9.5 STAPF - Set Magtape File Parameters ............... 36
; 10 TRY TO RENAME SINGLE TEMP FILE TO OUTPUT FILE ............ 37
; 11 SET DISK PRIORITY LEVEL .................................. 39
SUBTTL DEFINITIONS -- TOPS-10 Specific Parameters
;PARAMETER DEFINITIONS NEEDED ONLY ON TOPS10
DVCHMD==177777 ;MODE BIT PORTION OF DEVCHR VALUE
DVCHNL==757777,,0 ;DEVCHR FOR NUL: MINUS MODE BITS
IFE FTFORTRAN,<
;DEFINITIONS FOR INTERFACE TO SCAN
N==P3
C==P4
;**;[500] @EXTERN Replace 1 line. GCS 13-APR-82
EXTERN .SWDEC,.SWOCT,.DECNW,.SWCOR,.SIXSW,.SWSIX,.NMUL,.SAVE4,.PSH4T,.POP4T ;[500]
EXTERN .ERMSG,.TOCTW,.TDECW,.TSTRG,.TSIXN,.TOLEB,.TCORW,.TRBRK,.TCRLF,.TCHAR,.TTIME
;DEFINITIONS FOR FORTRAN-SCAN INTERFACE
BUFSIZ==200 ;[C20] SIZE OF INPUT/OUTPUT TEXT BUFFERS
;TAPOP. FUNCTIONS AND ARGS
.TFDEN==1001
.TFKTP==1002
.TFMOD==1007
.TFD80==3
.TFD16==4
.TFKTC==2
.TFKTX==3
.TFM7B==4
DEFINE ENDMODULE<
$PURGE
END START>
>;END IFE FTFORTRAN
SUBTTL DEFINITIONS -- Prototype SCAN Block
;THIS DEFINITION FOR THE S.xxxx BLOCK IS USED BY SORT AND SCAN TO KEEP TRACK OF
;FILE SPECS. AS SCAN READS FILE SPECS, IT ASKS SORT FOR MEMORY IN WHICH TO STORE
;THEM. SCAN REQUIRES ONLY THOSE LOCATIONS FROM S.DEV ON, SO THE REST IS FOR SORT
;TO LINK THE BLOCKS TOGETHER AND TO STORE SORT'S SWITCH ARGUMENTS IN.
LOC 0
S.SPC:! BLOCK 1 ;START OF SCAN FILE SPEC BLOCK
S.BLKF:!BLOCK 1 ;BLOCKING FACTOR
S.LABL:!BLOCK 1 ;STANDARD, OMITTED, NONSTANDARD
S.VARI:!BLOCK 1 ;VARIABLE RECORD SIZE
S.INDU:!BLOCK 1 ;INDUSTRY COMPATIBLE MODE
S.STDA:!BLOCK 1 ;STANDARD ASCII MODE
S.REW:! BLOCK 1 ;REWIND BEFORE USE
S.POSI:!BLOCK 1 ;/POSITION: VALUE
S.UNL:! BLOCK 1 ;UNLOAD AFTER USE
S.DEV:! BLOCK 1 ;DEVICE
S.NAME:!BLOCK 1 ;NAME
S.NAMM:!BLOCK 1 ;NAME MASK
S.EXT:! BLOCK 1 ;EXT,,MASK
S.MOD:! ;MODIFIER WORD
S.PROT:!BLOCK 1 ;OUTPUT PROTECTION
S.MODM:!BLOCK 1 ;MODIFIER MASK
S.DIR:! BLOCK 1 ;DIRECTORY
S.DIRM:!BLOCK 1 ;DIRECTORY MASK
S.SFD:! BLOCK 2*<.FXLND-1> ;SFDS + MASKS
S.BFR:! BLOCK 1 ;/BEFORE
S.SNC:! BLOCK 1 ;/SINCE
S.ABF:! BLOCK 1 ;/ABEFORE
S.ASN:! BLOCK 1 ;/ASINCE
S.FLI:! BLOCK 1 ;FILE MIN SIZE (WORDS)
S.FLM:! BLOCK 1 ;FILE MAX SIZE (WORDS)
S.EST:! BLOCK 1 ;/ESTIMATE
S.VER:! BLOCK 1 ;/VERSION
S.LEN==.-S.SPC ;LENGTH TO HOLD FULL SCAN BLOCK
S.SCNL==.-S.DEV ;LENGTH SCAN THINKS IT HAS
RELOC
SUBTTL DEFINITIONS -- Impure Data
SEGMENT IMPURE ;[C20]
OFFSET: BLOCK 1 ;[C20] ENTRY OFFSET
COLSCN: BLOCK S.LEN ;[355] SCAN BLOCK FOR COLLATE SPEC
IFE FTFORTRAN,<
BUFFER: BLOCK BUFSIZ ;[C20] FORTRAN COMMAND BUFFER
CMDPTR: BLOCK 1 ;[C20] FORTRAN COMMAND BYTE PTR
CMDLEN: BLOCK 1 ;[C20] FORTRAN COMMAND BYTE CNT
QBUFER: BLOCK 1 ;[C20] FORTRAN ERROR TYPE,,STATUS
CBUFER: BLOCK 1 ;[C20] FORTRAN ERROR CODE
TBUFER: BLOCK BUFSIZ ;[C20] FORTRAN ERROR TEXT BUFFER
FERPTR: BLOCK 1 ;[C20] FORTRAN ERROR BYTE PTR
FERCNT: BLOCK 1 ;[C20] FORTRAN ERROR BYTE CNT
>
SUBTTL GETSEG CODE
IFE FTFORTRAN,<
IFE FTVM,<
SEGMENT LPURE ;[C20]
BEGIN
PROCEDURE (PUSHJ P,GETSCN) ;[C20] GET HIGH SEG SCANNER AGAIN
IFE FTDEBUG,<
MOVEM P,RUNACS ;[C20] SAVE ACS DURING GETSEG
MOVEI T1,RUNDEV ;GET ARG LIST
GETSEG T1,
HALT ;FAILED
MOVE P,RUNACS ;[C20] RESTORE ACS AFTER GETSEG
>
RETURN ;[C20] RETURN
END;
SEGMENT IMPURE ;[C20]
RUNDEV: BLOCK 1 ;DEVICE
RUNNAM: BLOCK 1 ;NAME
RUNEXT: EXP 0 ;EXTENSION
EXP 0
RUNDIR: BLOCK 1 ;DIRECTORY
RUNPTH: EXP 0 ;NOT USED (BUT MUST BE ALLOCATED)
EXP 0
RUNPPN: BLOCK 1 ;PPN
RUNSFD: BLOCK 5 ;SFD LIST
EXP 0 ;TERMINATOR
RUNACS: BLOCK 1 ;[C20] BLOCK TO SAVE ACS DURING GETSEG
>;END IFE FTVM
SEGMENT HPURE ;[C20]
SUBTTL SCAN INTERFACE -- Interface Procedure
;STILL IN IFE FTFORTRAN
BEGIN
PROCEDURE (PUSHJ P,SCAN) ;SCAN INTERFACE
PORTAL .+1 ;INCASE EXECUTE ONLY
AOS QBUFER ;[C20] DEFER TTY OUTPUT FOR FORTRAN
MOVE T1,.TSBLK ;DATA BLOCK FOR TSCAN
PUSHJ P,.TSCAN## ;SCAN A LINE
SETZM QBUFER ;[C20] UN-DEFER TTY OUTPUT FOR FORTRAN
PUSHJ P,CLRFIL ;SEE IF ANY DEFAULTS TO SETUP
MOVE T1,.OSBLK ;DATA FOR OSCAN
SKIPN FORRET ;[C20] NOT FOR FORTRAN
PUSHJ P,.OSCAN## ;READ SWITCH.INI
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,FORINP)
SOSGE CMDLEN ;[C20] GET A BYTE FOR SCAN
JRST [$ERROR (?,FCE,Fortran command error)] ;[C20] FAILED
ILDB C,CMDPTR ;[C20] ..
RETURN ;[C20]
END;
BEGIN
PROCEDURE (PUSHJ P,FOROUT)
SKIPN QBUFER ;[C20] STORE AN ERROR BYTE FOR SCAN
JRST [OUTCHR T1 ;[C20] JUST TYPE CHAR IF NOT DEFERED
RETURN] ;[C20] ..
PUSH P,T1 ;[C20] SAVE THE TEMP ACS
PUSH P,T2 ;[C20] ..
PUSH P,T3 ;[C20] ..
PUSH P,T4 ;[C20] ..
ANDI T1,177 ;[C20] CLEAN UP BYTE
HRRZ T2,QBUFER ;[C20] GET STATUS
SETZ T3, ;[C20] CLEAR FLAGS
CAIL T1,"A" ;[C20] A LETTER?
CAILE T1,"Z" ;[C20] ..
SKIPA ;[C20] NO
TLO T3,(1B0) ;[C20] YES
CAIL T1,"a" ;[C20] ..
CAILE T1,"z" ;[C20] ..
SKIPA ;[C20] NO
TLO T3,(1B0) ;[C20] YES
CAIL T1,"0" ;[C20] A DIGIT?
CAILE T1,"9" ;[C20] ..
SKIPA ;[C20] NO
TLO T3,(1B1) ;[C20] YES
CAIE T1," " ;[C20] A SPACING CHARACTER?
CAIN T1," " ;[C20] ..
TLO T3,(1B2) ;[C20] YES
CAIE T1,.CHCRT ;[C20] END OF LINE CHARACTER?
CAIN T1,.CHLFD ;[C20] ..
TLO T3,(1B3) ;[C20] YES
$1% JRST @[IFIWS <$2,$3,$4,$5,$6,$7>]-1(T2) ;[C20] DISPTCH
$2% TLNE T3,(1B0!1B1!1B3) ;[C20] LOOK FOR PREFIX BYTE
JRST [HRRZS QBUFER ;[C20] A LETTER, DIGIT, OR EOL, NO PREFIX BYTE
MOVEI T2,2 ;[C20] ADVANCE TO ERROR CODE
JRST $1] ;[C20]
TLNE T3,(1B2) ;[C20] A SPACING CHARACTER?
JRST $8 ;[C20] YES, IGNORE IT
HRLM T1,QBUFER ;[C20] A PREFIX BYTE, STORE IT
MOVEI T2,2 ;[C20] ADVANCE TO ERROR CODE
JRST $8 ;[C20]
$3% TLNE T3,(1B2) ;[C20] LOOK FOR ERROR CODE
JRST $8 ;[C20] A SPACING CHARACTER, IGNORE IT
TLNN T3,(1B0) ;[C20] A LETTER?
JRST [SETZM CBUFER ;[C20] NO, NO ERROR CODE
MOVEI T2,4 ;[C20] ADVANCE TO TEXT
JRST $1] ;[C20]
MOVEI T2,3 ;[C20] SETUP FOR ERROR CODE
SETZM CBUFER ;[C20] ..
MOVE T4,[POINT 6,CBUFER] ;[C20] ..
MOVEM T4,FERPTR ;[C20] ..
MOVEI T4,6 ;[C20] ..
MOVEM T4,FERCNT ;[C20] ..
JRST $1 ;[C20]
$4% TLNE T3,(1B0!1B1) ;[C20] STILL IN ERROR CODE?
SOSGE FERCNT ;[C20] ..
JRST [MOVEI T2,4 ;[C20] NO, ADVANCE TO TEXT
JRST $1] ;[C20]
SUBI T1,40 ;[C20] ..
IDPB T1,FERPTR ;[C20] ..
JRST $8 ;[C20]
$5% TLNE T3,(1B2) ;[C20] LOOK FOR TEXT
JRST $8 ;[C20] A SPACING CHARACTER, IGNORE IT
MOVEI T2,5 ;[C20] SETUP FOR ERROR CODE
MOVE T4,[POINT 7,TBUFER] ;[C20] ..
MOVEM T4,FERPTR ;[C20] ..
MOVEI T4,5*BUFSIZ-3 ;[C20] ..
MOVEM T4,FERCNT ;[C20] ..
JRST $1 ;[C20]
$6% TLNN T3,(1B3) ;[C20] STILL IN TEXT?
SOSGE FERCNT ;[C20] ..
JRST [MOVEI T2,6 ;[C20] NO, ADVANCE TO EOL
JRST $1] ;[C20]
IDPB T1,FERPTR ;[C20] ..
JRST $8 ;[C20]
$7% CAIE T1,.CHLFD ;[C20] EOL, A <LF>?
JRST $8 ;[C20] NO, IGNORE IT FOR NOW
MOVEI T4,.CHCRT ;[C20] YES, FINISH TEXT WITH <CR><LF><NULL>
IDPB T4,FERPTR ;[C20] ..
MOVEI T4,.CHLFD ;[C20] ..
IDPB T4,FERPTR ;[C20] ..
SETZ T4, ;[C20] ..
IDPB T4,FERPTR ;[C20] ..
HLRZ T1,QBUFER ;[C20] SAVE PREFIX BYTE
PUSH P,T1 ;[C20] ..
MOVE T1,CBUFER ;[C20] TYPE THE MESSAGE
HLL T2,QBUFER ;[C20] ..
HRRI T2,TBUFER ;[C20] ..
PUSHJ P,%ERMSG ;[C20] ..
POP P,T1 ;[C20] A FATAL ERROR?
CAIN T1,"?" ;[C20] ..
JRST DIE ;[C20] YES, FALL INTO DIE
AOSA QBUFER ;[C20] DEFER TTY OUTPUT AGAIN
$8% HRRM T2,QBUFER ;[C20] SAVE STATUS
POP P,T4 ;[C20] RESTORE ACS
POP P,T3 ;[C20] ..
POP P,T2 ;[C20] ..
POP P,T1 ;[C20] ..
RETURN ;[C20]
END;
;SCAN ARG BLOCKS
.ISBLK: 3,,.+1
1 ;[114] FORCE A RESCAN
OFFSET,,'SRT'
0
.ISFBK: 5,,.+1 ;[C20] FORTRAN ISCAN BLOCK
0 ;[C20] NO RESCAN
0 ;[C20] NO CCL FILES
XWD FORINP,FOROUT ;[C20] I/O ROUTINES
0 ;[C20] NO INDIRECT FILE
XWD CPOPJ,E$$FCE ;[C20] NO EXITING OR PROMPTING
.TSBLK: 9,,.+1
IOWD SRTSWL,SRTSWN
SRTSWD,,SRTSWM
0,,SRTSWP
-1
CLRANS,,CLRFIL
ALLIN,,ALLOUT
MEMSTK,,APPSTK
CLRSTK,,FS.MOT
0,,STRSWT
.OSBLK: 4,,.TSBLK+1
SUBTTL SCAN INTERFACE -- Switch Table
;STILL IN IFE FTFORTRAN
DEFINE SWTCHS<
SS AFTER,ADVFLG,ADV.A,FS.NFS!FS.NUE ;[N11]
SN ALIGNED,ALIGN,FS.NFS!FS.NUE
SS ALPHANUMERIC,<POINTR (MODE,RM.ALP)>,1,FS.NFS!FS.NUE
SS *ASCII,<POINTR (MODE,RM.ASC)>,1,FS.NFS!FS.NUE
SS BEFORE,ADVFLG,ADV.B,FS.NFS!FS.NUE ;[N11]
SS BINARY,<POINTR (MODE,RM.BIN)>,1,FS.NFS!FS.NUE
SP *BLOCKED,F.BLKF,.SWDEC,BLK,FS.NUE
SS CHECK,WSCSW,1,FS.NFS!FS.NUE
SL COLLATING,COLSW,COL,COLASCII,FS.NFS
SS COMP,<POINTR (MODE,RM.COM)>,1,FS.NFS!FS.NUE
SS COMP1,<POINTR (MODE,RM.COM)>,1,FS.NFS!FS.NUE
SS COMP3,<POINTR (MODE,RM.PAC)>,1,FS.NFS!FS.NUE
SS COMPUTATIONAL,<POINTR (MODE,RM.COM)>,1,FS.NFS!FS.NUE
SP *CORE,CORSIZ,.SWCOR,COR,FS.NUE!FS.NFS
SS *EBCDIC,<POINTR (MODE,RM.EBC)>,1,FS.NFS!FS.NUE
SP ERROR,ERRADR,.SWFOR,ZRO,FS.NFS!FS.NUE!FS.VRQ ;[C20] [351]
SP FATAL,FERCOD,.SWFOR,ZRO,FS.NFS!FS.NUE!FS.VRQ ;[C20] [351]
SS *FIXED,F.VARI,0,FS.NFS!FS.NUE
SP FORMAT,F.FMT,.SWASF,ZRO,FS.NFS!FS.VRQ ;[351]
SS FORTRAN,<POINTR (MODE,RM.FOR)>,1,FS.NFS!FS.NUE
SN INDUSTRY,F.INDU,FS.NUE
SP *KEY,FSTKEY,.SWDEC,KEY,FS.VRQ!FS.NFS
SL *LABEL,F.LABL,LAB,LABSTANDARD,FS.NFS!FS.NUE
SP LEAVES,NUMRCB,.SWDEC,ZRO,FS.NUE!FS.NFS!FS.VRQ ;[351]
SP MAXTEMPFILES,MAXTMP,.SWDEC,ZRO,FS.NFS!FS.LRG ;[N20]
SS *MERGE,MRGSW,1,FS.NUE!FS.NFS
SS NOCRLF,NOCRLF,1,FS.NUE!FS.NFS ;[N11]
SS *NUMERIC,<POINTR (MODE,RM.NUM)>,1,FS.NFS!FS.NUE
SS PACKED,<POINTR (MODE,RM.PAC)>,1,FS.NFS!FS.NUE
SP POSITION,F.POSI,POSIIN,ZRO,FS.NUE!FS.VRQ ;[C11]
SP PRIORITY,PRIORI,.SWDEC,ZRO,FS.NFS!FS.LRG
SS RANDOM,F.VARI,0,FS.NFS!FS.NUE
SP *RECORD,RECORD,.SWDEC,REC,FS.VRQ!FS.NUE
SS REWIND,F.REW,1,FS.NUE
SS SEQUENTIAL,F.VARI,1,FS.NFS!FS.NUE
SS SIGNED,<POINTR (MODE,RM.SGN)>,1,FS.NFS!FS.NUE
SS *SIXBIT,<POINTR (MODE,RM.SIX)>,1,FS.NFS!FS.NUE
SS STANDARD,F.STDA,1,FS.NUE
SN STATISTICS,STATSW,FS.NFS!FS.NUE ;[C20]
SL SUPPRESS,SUPFLG,SUP,SUPNONE,FS.NFS!FS.NUE!FS.VRQ ;[351]
SS *TEMP,TEMPSW,1,FS.NUE!FS.NFS
SS UNLOAD,F.UNL,1,FS.NUE
SS *UNSIGNED,<POINTR (MODE,RM.UNS)>,1,FS.NFS!FS.NUE
SS *VARIABLE,F.VARI,1,FS.NFS!FS.NUE
>
;NOW FOR KEYWORDS
KEYS LAB,<STANDARD,OMITTED,NONSTANDARD,DEC,ANSI,IBM>
>;END IFE FTFORTRAN
KEYS COL,<ASCII,EBCDIC,FILESPEC,LITERAL,ADDRESS>
KEYS SUP,<NONE,INFORMATION,WARNING,FATAL,ALL>
IFE FTFORTRAN,<
;DEFAULT VALUES
DM REC,^D4096,0,0
DM KEY,377777,0,0
DM COR,377777,0,0
DM BLK,377777,0,0
DM ZRO,0,0,0
;STILL IN IFE FTFORTRAN
XALL
DOSCAN (SRTSW)
SALL
IF2,<PURGE ..TEMP,..TEMR>
SUBTTL SCAN INTERFACE -- Switch Processors -- POSIIN
;STILL IN IFE FTFORTRAN
BEGIN
PROCEDURE (PUSHJ P,POSIIN) ;[C11]
PUSHJ P,.DECNW## ;[C11] GET A NUMBER
JUMPGE N,$1 ;[C11] A BACKSPACE?
MOVN N,N ;[C11] YES, NEGATE
TXO N,1B1 ;[C11] AND MARK AS BACKSPACE
$1% RETURN ;[C11] DONE
END;
SUBTTL SCAN INTERFACE -- Control Routines -- ALLOUT
;STILL IN IFE FTFORTRAN
BEGIN
PROCEDURE (PUSHJ P,ALLOUT) ;ALLOCATE OUTPUT FILE SPEC
;ALLOUT IS CALLED BY SCAN WHEN IT HAS FULLY PASSED OVER AN OUTPUT FILE SPEC
;(I.E., WHEN IT HAS DETECTED A ',', '=', OR EOL) AND NEEDS MEMORY IN WHICH TO
;STORE THE FILE SPEC PARAMETERS. WE LINK THE MEMORY BLOCK INTO THE OUTPUT LIST
;AT THE FRONT OF F.OUZR, COPY ALL OF SORT'S SWITCH ARGUMENTS INTO THE BLOCK,
;THEN RETURN THE ADDRESS OF SCAN'S PORTION OF THE BLOCK.
;
;RETURNS:
; T1/ <ADDR OF SCAN'S PART OF S.xxxx BLOCK>
; T2/ <LENGTH OF SCAN'S PART OF S.xxxx BLOCK>
MOVE T1,RECORD ;SEE IF SPECIFIED ON OUTPUT SIDE
MOVEM T1,RECOUT ;SAVE IN CASE DIFFERENT ON OUTPUT
SETOM RECORD ;SET INPUT SIZE AS NULL
MOVX T1,S.LEN ;TOTAL SPACE WE NEED
PUSHJ P,GETSPC ;GET IT
JRST E$$NEC ;FAILED
SETZM S.SPC(T1) ;[OK] [212] ZERO POINTER TO NEXT BLOCK
MOVE T2,F.OUZR ;PREVIOUS BLOCK (OR 0)
MOVEM T2,0(T1) ;[OK] LINK
MOVEM T1,F.OUZR ;NEW BLOCK
HRLZI T2,F.SPC+1 ;SWITCHES
HRRI T2,1(T1) ;[OK] BLT PTR
MOVEI T1,S.DEV(T1) ;[OK] END OF BLT + 1
BLT T2,-1(T1) ;[OK] COPY TO SAFE PLACE
MOVEI T2,S.SCNL ;LENGTH SCAN THINKS IT HAS
RETURN
END;
SUBTTL SCAN INTERFACE -- Control Routines -- ALLIN
;STILL IN IFE FTFORTRAN
BEGIN
PROCEDURE (PUSHJ P,ALLIN) ;ALLOCATE INPUT FILE SPEC
;ALLIN IS CALLED BY SCAN WHEN IT HAS FULLY PASSED OVER AN INPUT FILE SPEC (I.E.,
;WHEN IT HAS DETECTED A ',' OR EOL) AND NEEDS MEMORY IN WHICH TO STORE THE FILE
;SPEC PARAMETERS. WE LINK THE MEMORY BLOCK INTO THE INPUT LIST AT THE FRONT OF
;F.INZR, COPY ALL OF SORT'S SWITCH ARGUMENTS INTO THE BLOCK, THEN RETURN THE
;ADDRESS OF SCAN'S PORTION OF THE BLOCK.
;
;RETURNS:
; T1/ <ADDR OF SCAN'S PART OF S.xxxx BLOCK>
; T2/ <LENGTH OF SCAN'S PART OF S.xxxx BLOCK>
MOVX T1,S.LEN ;TOTAL SPACE WE NEED
PUSHJ P,GETSPC ;GET IT
JRST E$$NEC ;FAILED
SETZM S.SPC(T1) ;[OK] [212] ZERO POINTER TO NEXT BLOCK
IF A TEMP DEVICE
SKIPGE TEMPSW
JRST $T
THEN LINK INTO TEMP CHAIN AT END
MOVEI T2,F.TMZR ;ADDRESS OF BLOCK
$1% HRL T2,(T2) ;[OK] GET POINTER TO NEXT
TLNN T2,-1 ;IS THERE A NEXT?
JRST $2 ;NO
HLRZ T2,T2 ;COPY IT
JRST $1 ;TRY AGAIN
$2% HRRZS T2 ;[C20] LINK IN
MOVEM T1,(T2) ;[C20] ..
JRST $F
ELSE LINK INTO INPUT CHAIN AT FRONT
MOVE T2,F.INZR ;PREVIOUS BLOCK (OR 0)
MOVEM T2,0(T1) ;[OK] LINK
MOVEM T1,F.INZR ;NEW BLOCK
FI;
HRLZI T2,F.SPC+1 ;SWITCHES
HRRI T2,1(T1) ;[OK] BLT PTR
MOVEI T1,S.DEV(T1) ;[OK] END OF BLT + 1
BLT T2,-1(T1) ;[OK] COPY TO SAFE PLACE
MOVEI T2,S.SCNL ;LENGTH SCAN THINKS IT HAS
RETURN
END;
SUBTTL SCAN INTERFACE -- Switch Handling -- /PRIORITY:n
;STILL IN IFE FTFORTRAN
BEGIN
PROCEDURE (PUSHJ P,STRSWT)
;STRSWT IS THE USER-EXIT ROUTINE FOR SWITCH PROCESSING. ALL SWITCHES DEFINED IN
;THE SWTCHS MACRO WITHOUT THE FS.NUE FLAG CAUSE SCAN TO TRANSFER HERE AFTER THE
;FIRST SWITCH ARGUMENT HAS BEEN READ. THUS, ALL OF SORT'S MORE COMPLEX SWITCHES
;ARE HANDLED HERE. WE SIMPLY BRANCH TO THE PROPER SWITCH ROUTINE.
HRRZ T1,T2 ;GET STORAGE LOCATION
CAIN T1,FSTKEY ;WAS IT /KEY?
PJRST USRKEY ;YES
CAIN T1,PRIORI ;WAS IT /PRIORITY?
PJRST USRPRI ;YES
CAIN T1,F.FMT ;WAS IT /FORMAT?
PJRST USRFMT ;YES
CAIN T1,COLSW ;WAS IT /COLLATE:
JRST USRCOL ;YES
CAIN T1,MAXTMP ;[N20] WAS IT /MAXTEMPFILES?
JRST USRMTF ;[N20] YES
E$$SSE: $ERROR (?,SSE,<Switch scanning error>)
END;
BEGIN
PROCEDURE (PUSHJ P,USRPRI) ;STORE THE /PRIORITY SWITCH
MOVM T1,N ;GET MAGNITUDE
CAILE T1,3 ;ALLOW -3 TO +3 ONLY
JRST E$$PRI
MOVEM N,PRIORI ;STORE IT
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,USRMTF) ;[N20] STORE THE /MAXTEMPFILES SWITCH
MOVE T1,N ;[N20] GET MAGNITUDE
CAIL T1,3 ;[N20] ALLOW 3 TO
CAILE T1,MX.TMP ;[N20] MAX. FILES
JRST E$$MTE ;[N20]
SKIPE XCHNO. ;[N20] UNLESS NO EXTRA CHANNELS
JRST $1 ;[N20]
CAILE T1,MX.T15 ;[N20] IN WHICH CASE ONLY ALLOW ORIGINAL 15
JRST E$$MTE ;[N20]
$1% MOVEM N,MAXTMP ;[N20] STORE IT
RETURN ;[N20]
END;
SUBTTL SCAN INTERFACE -- Switch Handling -- /KEY:n:m:x
;STILL IN IFE FTFORTRAN
BEGIN
PROCEDURE (PUSHJ P,USRKEY) ;STORE THE /KEY VALUES
MOVE T2,MODE ;GET MODE
SKIPE T1,LSTKEY ;PTR TO PREVIOUS KEY
MOVEM T2,KY.MOD(T1) ;[OK] STORE MODE FOR PREV KEY
MOVX T1,KY.LEN ;GET SPACE
PUSHJ P,GETSPC ; TO HOLD SWITCH
JRST E$$NEC ;FAILED
IF FIRST TIME
SKIPE FSTKEY ;FIRST TIME
JRST $T
THEN
MOVEM T1,FSTKEY ;INITIALIZE LIST
JRST $F
ELSE
MOVE T2,LSTKEY ;[C20] CHAIN INTO LIST
MOVEM T1,(T2) ;[C20] ..
FI;
MOVEM T1,LSTKEY ;POINT TO NEW END
SETZM KY.NXT(T1) ;[OK] CLEAR FORWARD POINTER
SOJL N,E$$KOR ;CHECK FOR INVALID RELATIVE TO 0
MOVEM N,KY.INI(T1) ;[OK] STORE INITIAL BYTE
CAIE C,":" ;LENGTH TO FOLLOW
JRST E$$KLR ;ERROR
PUSHJ P,.DECNW ;GET IT
JUMPE N,E$$KLR ;ZERO IS NOT VALID EITHER
MOVE T1,LSTKEY ;POINT TO BLOCK
MOVEM N,KY.SIZ(T1) ;[OK] STORE LENGTH
;**;[517] Change 1 Line at USRKEY+26 DMN 22-Jun-83
MOVX T2,RM.ASC!RM.SIX!RM.EBC!RM.BIN!RM.FOR ;[517]
ANDM T2,MODE ;ONLY BITS WE CARE ABOUT
;**;[506] Insert 1 Line after USRKEY+28 Lines PY 13-Sep-82
ANDM T2,MODEM ;[506] CLEAR THE MASK TOO
SETZM KY.ORD(T1) ;[OK] SET DEFAULT TO BE ASCENDING
CAIE C,":" ;ORDER FOLLOWING?
RETURN
PUSHJ P,.SIXSW ;YES, GET IT
LSH N,-^D30 ;RIGHT JUSTIFY
MOVE T1,LSTKEY ;POINT TO KEY BLOCK
SKIPE N ;DEFAULT IS ASCENDING
CAIN N,'A' ;ASCENDING?
RETURN ;YES
CAIE N,'D' ;DESCENDING?
JRST E$$KAI ;ERROR
SETOM KY.ORD(T1) ;[OK] CHANGE TO DESCENDING
RETURN
END;
>;END IFE FTFORTRAN
SUBTTL SCAN INTERFACE -- Switch Handling -- /COLLATE:x[:y]
IFE FTFORTRAN,<
BEGIN
PROCEDURE (PUSHJ P,USRCOL)
SKIPE COLSW ;HERE BEFORE
JRST E$$MCS ;YES, HERE BEFORE ONLY ONE ALT SEQ ALLOWED
HRLI N,(IFIW) ;[C20]
MOVEM N,COLSW ;STORE THE INDEX
HRRZS N ;[C20]
CAIN N,COLFILE ;CHECK FOR SPECIAL EXTERNAL FILE SPEC.
JRST COLEFS ;CALL THE FILE ROUTINE
CAIN N,COLLIT ;CHECK FOR IN-CORE LITERAL
JRST COLICL ;CALL THE LITERAL ROUTINE
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,COLEFS)
CAIE C,":" ;STOP ON A COLON
JRST E$$CFS ;BAD COLLATING SEQUENCE FILE SPEC.
MOVE T1,[F.NAM##-1,,COLSCN+S.DEV] ;[355] F.DEV=F.NAM-1 BUT NOT GLOBAL IN SCAN
BLT T1,COLSCN+S.LEN-1 ;[355] SAFE PLACE TO STORE CURRENT FILE SPEC
PUSHJ P,.FILIN## ;[355] SCAN THE FILE SPEC
AOJN T1,E$$CFS ;[355] SCAN RETURNS -1 IF FILE SPEC FOUND
;**;[504] @COLEFS) + 7L. Replace 1 line. GCS 8-Jul-82
MOVEI T2,S.SCNL ;[504] SOJG COUNT TO EXCH FILE SPECS
;**;[512] @COLEFS) + 9L, Replace 3 lines. GCS 1-Nov-82
MOVE T1,F.NAM##-2(T2) ;[512] GET COLLATE FILE SPEC WORD
EXCH T1,COLSCN+S.DEV-1(T2) ;[512] EXCHANGE WITH WAITING SPEC
MOVEM T1,F.NAM##-2(T2) ;[512] ..
SOJG T2,.-3 ;[C20] [355] LOOP FOR ALL OF FILE SPEC
MOVX T1,'DSK ' ;[355] DEFAULT TO DSK: IF FILIN. GAVE
SKIPN S.DEV+COLSCN ;[355] NO DEVICE
MOVEM T1,S.DEV+COLSCN ;[355] ..
RETURN ;[355] DONE
END;
BEGIN
PROCEDURE (PUSHJ P,COLICL)
CAIE C,":" ;STOP ON A COLON?
JRST E$$CLS ;ERROR
PUSHJ P,.TIALT## ;GET THE NEXT CHAR.
PUSHJ P,.TISQT## ;SET IT AS THE QUOTE CHAR.
PUSHJ P,.ASCQC## ;GET THE QUOTED STRING
MOVE T1,[.NMUL,,COLITB] ;STORE THE STRING
BLT T1,COLITB+.NMUE-.NMUL ;MINUS THE QUOTES
SETZM COLITB+.NMUE-.NMUL+1 ;GUARANTEE A NUL AT THE END
RETURN
END;
>;END IFE FTFORTRAN
BEGIN
PROCEDURE (PUSHJ P,COLTRX)
SETZ T4, ;[355] INDICATE INPUT FILE TO STOPB
MOVEI U,COLSCN ;[355] AND SCAN BLOCK
PUSHJ P,STOPB ;[355] CONVERT SCAN BLOCK TO X. BLOCK
PUSHJ P,GETCHN ;[C19] GET A WORKING CHANNEL
JRST E$$NEH ;[C19] FAILED
MOVEM T1,COLCHN ;[355] SAVE CHANNEL #
HRL T1,COLCHN ;[C19] BUILD FILOP. BLOCK, GET CHANNEL
HRRI T1,.FORED ;[C19] GET READ FUNCTION
TXO T1,FO.PRV ;[N14] BYPASS CHECKS IF [1,2] OR JACCT
SKIPE XCHNO. ;[N17] CAN WE USE EXTENDED CHANNELS?
TXO T1,FO.ASC ;[N17] YES, DO SO
MOVEM T1,FLPARG+.FOFNC ;[C19] STORE THEM
MOVX T1,.IODMP ;[355] USE DUMP MODE FOR COLLATE FILE
MOVEM T1,FLPARG+.FOIOS ;[C19] STORE IT
MOVE T1,X.OPN+1(P1) ;[OK] [C19] GET DEVICE
MOVEM T1,FLPARG+.FODEV ;[C19] STORE IT
SETZM FLPARG+.FOBRH ;[C19] NO BUFFERS
SETZM FLPARG+.FONBF ;[C19] ..
HRRZI T1,X.RIB(P1) ;[OK] [C19] GET LOOKUP BLOCK ADDRESS
MOVEM T1,FLPARG+.FOLEB ;[C19] STORE IT
MOVE T1,[.FOLEB+1,,FLPARG] ;[C19] DO READ FILOP.
FILOP. T1, ;[C19] ..
JRST ERRFUF ;[C19] FAILED
MOVS T1,FLPARG+.FOFNC ;[N17] GET CHANNEL BACK
ANDI T1,777 ;[N17]
HRRM T1,COLCHN ;[N17] INCASE WE HAD AN EXTENDED CHAN
MOVE T3,[IOWD 200,COLITB] ;MAKE AN IOWD TO READ THE FILE
MOVEM T3,COLPTR ;STORE IOWD
SETZM COLPTR+1 ;TERMINATE
SETZM COLPTR+2 ;CLEAR BYTE POINTER
SETZM COLPTR+3 ;CLEAR BYTE COUNTER
MOVE T1,[IFIW COLBUF] ;[C20] GET THE ALT SEQ TABLE
MOVEM T1,COLSW ;STORE THE ADDRESS OF THE TABLE
MOVEI T2,COLCHR ;ADDRESS OF THE INPUT ROUTINE
PUSHJ P,BLDCOL ;BUILD THE TABLE
JRST E$$ICS ;ILLEGAL COLLATING SEQUENCE SPECIFIED
MOVE T1,COLCHN ;[C19] RELEASE CHANNEL
PUSHJ P,RELCHN ;[C19] ..
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,COLCHR)
SOSGE COLPTR+3 ;REDUCE THE BYTE COUNT
JRST $1 ;GET A BUFFER
;**;[500] @COLCHR + 3L Replace 2 lines. GCS 13-APR-82
IBP COLPTR+2 ;[500] POINT TO NEXT BYTE
MOVE T1,@COLPTR+2 ;[500] GET WORD
TRNE T1,1 ;CHECK FOR SEQUENCE NUMBER
JRST [AOS COLPTR+2 ;IT IS
MOVNI T1,5
ADDM T1,COLPTR+3 ;ACCOUNT FOR 5 BYTES
JRST COLCHR] ;LOOP BACK
;**;[500] @COLCHR + 11L Replace 1 line. GCS 13-APR-82
LDB T1,COLPTR+2 ;[500] GET A BYTE
CAIG T1," " ;IGNORE SPACE AND ALL CONTROL CHARACTERS
JRST $B ;GET THE NEXT CHARACTER
JRST CPOPJ1 ;SKIP RETURN, T1=CHAR
$1%
IF 7-SERIES MONITOR
SKIPN M7.00 ;[N12] 7-SERIES?
JRST $T ;[N12] NO
THEN USE FILOP. FOR ALL I/O
HRLZ T1,COLCHN ;[N12] GET CHANNEL
HRRI T1,.FOINP ;[N12] INPUT FUNCTION
MOVEM T1,FLPARG+.FOFNC ;[N12] TWO ARGS FOR DUMP MODE
MOVEI T1,COLPTR ;[N12] ADDRESS OF IOWD
MOVEM T1,FLPARG+.FOIOS ;[N12]
MOVE T1,[2,,FLPARG] ;[N12]
FILOP. T1, ;[N12]
JRST $2 ;[N12] ERROR, T1 = STATUS
JRST $F ;[N12] OK
ELSE USE OLD I/O UUOs
MOVE T1,COLCHN ;[C20] GET THE CHANNEL NUMBER
LSH T1,27 ;[C20] [C19] ..
IOR T1,[IN 0,COLPTR] ;[OK]
XCT T1 ;[C20]
JRST $F ;UNEVENTFUL INPUT !
TLC T1,(<IN>^!<GETSTS>)
HRRI T1,T1 ;FORM [GETSTS CHN,T1]
XCT T1 ;RETRIEVE FILE STATUS
$2% TXNN T1,IO.ERR ;[N12] I/O ERRORS ?
RETURN ;NO, MUST BE END OF FILE
PUSH P,T1 ;SAVE STATUS
JRST E$$IRE ;[353] PRINT REASON FOR ERROR
FI;
MOVE T1,COLPTR ;GET THE BUFFER ADDRESS
HRLI T1,(POINT 7,0,35) ;MAKE AN ASCII BYTE POINTER
MOVEM T1,COLPTR+2 ;STORE NEW BYTE POINTER
MOVEI T1,200*5 ;NUMBER OF CHARACTERS/BUFFER
MOVEM T1,COLPTR+3 ;STORE
JRST $B ;GET THE NEXT CHARACTER
END;
SUBTTL TYPE-IN ROUTINES -- Format Descriptor
IFE FTFORTRAN,<
BEGIN
PROCEDURE (PUSHJ P,.SWASF)
;.SWASF -- INPUT ASCII MULTIPLE WORD
;TERMINATES AT FIRST NON-ALPHANUMERIC CHARACTER
;FOR THIS ROUTINE PERIOD IS CONSIDERED TO BE ALPHA-NUMERIC
;THROWS AWAY ANY CHARACTERS BEYOND THE BUFFER
; RETURN WITH STRING IN .NMUL
;USES T1 UPDATES C (SEPARATOR)
PUSHJ P,.TIALT## ;PRIME THE PUMP
SETZM .NMUL## ;CLEAR ACCUMULATOR
MOVE T1,[.NMUL##,,.NMUL##+1]
BLT T1,.NMUE## ; ..
HRROI T1,.TSTRG## ;SET ASCII STRING FORMAT
MOVEM T1,.LASWD## ; FOR ERROR PRINTING
MOVE T1,[POINT 6,.NMUL##] ;INITIALIZE BYTE POINTER
$1% PUSHJ P,.TICAN## ;SEE IF LEGITIMATE ALPHA-NUMERIC
JRST $3 ;NO--MAY BE DONE
CAIL C,"A"+40 ;[432] IS THE ARGUMENT
CAILE C,"Z"+40 ;[432] LOWERCASE
FASTSKIP ;[432] NO.
SUBI C,40 ;[432] YES. MAKE UPPER.
$2% SUBI C,40 ;CONVERT TO SIXBIT
CAME T1,[POINT 6,.NMUE##,35] ;SEE IF OVERFLOW
IDPB C,T1 ;NO--STORE
PUSHJ P,.TIALT## ;GET NEXT CHARACTER
JRST $1 ;LOOP BACK TO PROCESS IT
$3% CAIE C,"." ;IF PERIOD?
POPJ P, ;NO--DONE
JRST $2 ;YES--CONTINUE SCAN
END;
>;END IFE FTFORTRAN
SUBTTL TYPE-IN ROUTINES -- Formal FORTRAN arguments
IFE FTFORTRAN,<
BEGIN
PROCEDURE (PUSHJ P,.SWFOR)
;.SWFOR -- INPUT FORMAL FORTRAN ARGUMENT
;AS EITHER AN OCTAL ADDRESS OR AN ARGUMENT NUMBER WHEN PREFIXED BY "^"
PUSHJ P,.TIALT## ;[C20] GET A CHAR
CAIE C,"^" ;[C20] AN ARGUMENT?
PJRST .OCTNC## ;[C20] NO, JUST GET AN OCTAL NUMBER
PUSHJ P,.DECNW## ;[C20] YES, GET THE ARGUMENT NUMBER
CAILE N,1 ;[C20] IS IT IN RANGE?
CAMLE N,FORCNT ;[C20] ..
JRST E$$FEA ;[C20] NO
ADD N,FORARG ;[C20] ADD IN BASE
XMOVEI N,@-1(N) ;[C20] GET ACTUAL
RETURN ;[C20]
END;
>;END IFE FTFORTRAN
SUBTTL PSORT. -- SETTMP - Set up Temporary Files
BEGIN
PROCEDURE (PUSHJ P,SETTMP)
;THIS LIST IS STORED IN FORWARD ORDER
IF NO TEMP DEVICES SPECIFIED
SKIPE U,F.TMZR
JRST $T
THEN USE DSK
MOVSI T1,'DSK'
MOVEM T1,STRNAM+0 ;PUT IN FIRST SLOT
AOS STRNUM ;COUNT ONE TEMP DEVICE
SETOM STRDEF ;[214] REMEMBER THAT WE DEFAULTED TO DSK:
JRST $F
ELSE COPY FIRST MAXTMP FROM LIST
SETZ T2, ;[C20] SETUP INDEX
$1% SKIPE S.NAME(U) ;[214] DID USER SPECIFY FILNAM/TEMP?
JRST E$$FNT ;[214] YES--DIE
MOVE T3,S.DEV(U) ;GET DEVICE
MOVEM T3,STRNAM(T2) ;[OK] PUT IN LIST
DEVCHR T3,
JUMPE T3,E$$DNE ;NON-EXISTENT DEVICE
TXZ T3,DVCHMD ;[215] CLEAR MODE BITS
CAXE T3,DVCHNL ;[215] IF NUL:, NOT A DISK
TXNN T3,DV.DSK ;[215] ONLY ALLOW .TMP FILES ON DISK
JRST E$$DND ;NO
AOS STRNUM ;COUNT ONE MORE
HRRZ U,(U) ;[C20] GET NEXT
JUMPE U,$F ;[C20] ALL DONE
CAMG T2,MAXTMP ;[N20] [C20] TOO MANY
AOJA T2,$1 ;[C20] NO, LOOP AROUND
PUSHJ P,E$$TMT ;[N20] WARN USER
FI;
RETURN
END;
SUBTTL PSORT. -- PRUNE - Prune Null SCAN Blocks from I/O Lists
BEGIN
PROCEDURE (PUSHJ P,PRUNE)
MOVE U,F.OUZR ;DO OUTPUT FIRST
MOVEI T1,F.OUZR ;[C20]
PUSHJ P,PRUNEL ;[214] PRUNE OUTPUT LIST
SKIPN F.OUZR ;[214] IS OUTPUT LIST NOW NULL?!
JRST E$$ONS ;[214] YES--ERROR
MOVE U,F.INZR ;NOW FOR INPUT
MOVEI T1,F.INZR ;[C20]
PUSHJ P,PRUNEL ;[214] PRUNE INPUT LIST
SKIPN F.INZR ;[214] IS INPUT LIST NOW NULL?!
JRST E$$INS ;[214] YES--ERROR
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,PRUNEL) ;[214] PRUNE NULL SCAN BLOCKS FROM LIST
; U/ <ADDR OF FIRST BLOCK>
; T1/ <ADDR OF LIST HEADER>
FOR ALL INPUT FILES DO
BEGIN
TRNN U,-1 ;[214] AT END?
JRST $E ;[214] YES--QUIT
MOVE T2,S.MOD(U) ;[C20] [214] DEVICE NOT SPECIFIED?
TXNE T2,FX.NDV ;[C20] [214] ..
SKIPE S.NAME(U) ;[214] OR NO FILE NAME?
JRST $1 ;NO, OK
MOVE T2,S.SPC(U) ;[C20] GET NEXT
EXCH U,T1 ;[C20] GET PREVIOUS AND REMEMBER IT
MOVEM T2,S.SPC(U) ;[C20] FORGET ABOUT THIS
$1% HRRZ T1,S.SPC(U) ;[C20] GET NEXT
EXCH U,T1 ;[C20]
TRNE U,-1 ;AT END?
JRST $B ;NOT YET
END;
RETURN
END;
SUBTTL PSORT. -- SETUPO - Set Up Output Files
BEGIN
PROCEDURE (PUSHJ P,SETUPO) ;SET UP THE OUTPUT SPECS
;SETUPO IS CALLED BY PSORT. FOLLOWING CALLS TO SCAN TO READ THE USER'S COMMAND.
;WE ARE CONCERNED HERE ONLY WITH VERIFYING THE GOODNESS OF THE FILE SPECS IN THE
;LIST AT F.OUZR (SET UP BY ALLOUT DURING THE COMMAND SCANNING), AND STORING
;COMMAND INFORMATION FOR LATER. ACTUAL INITIALIZATION OF THE FILE IS PERFORMED
;IN INIOUT, DURING THE SORT OR MERGE.
;
;THERE ARE TWO OPERATIONS PERFORMED HERE. FIRST, THE FILE SPEC LIST IS SCANNED,
;CREATING OM.xxx BLOCKS FOR *EVERY* SPEC IN THE LIST. ALL BUT THE FIRST FILE
;SPEC (LAST IN THE LIST) MUST BE A MAGTAPE. THEN, THE FIRST SPEC IS HANDLED IN
;DETAIL, BY CALLING STOPB. WHEN PROCESSING IS COMPLETED HERE, THE S.xxxx BLOCKS
;HAVE BEEN DELETED FROM THE F.OUZR LIST, AND REPLACED WITH AN X.xxxx BLOCK WHICH
;HAS A LIST OF THE OM.xxx BLOCKS ATTACHED.
SKIPN U,F.OUZR ;GET LIST PTR
JRST E$$ONS
SETZM F.OUZR ;CLEAR IT
WHILE FILE SPEC BLOCKS TO LOOK AT
BEGIN
MOVX T1,OM.LEN ;[215] ALLOCATE OUTPUT MAGTAPE BLOCK
PUSHJ P,GETSPC ;[215] ..
JRST E$$NEC ;FAILED
MOVE T2,F.OUZR ;[215] LINK INTO FRONT OF LIST
MOVEM T2,OM.NXT(T1) ;[OK] [215] ..
MOVEM T1,F.OUZR ;[215] ..
MOVE T3,S.DEV(U) ;[215] REMEMBER DEVICE
MOVEM T3,OM.DEV(T1) ;[OK] [215] ..
DEVCHR T3, ;[215] GET DEVICE CHARACTERSTICS
JUMPE T3,E$$DNE ;[215] DEVICE DOES NOT EXIST
TXZ T3,DVCHMD ;[215] CLEAR I/O MODE BITS
SKIPN S.SPC(U) ;[215] DONE IF FIRST SPEC
JRST $E ;[215] YES--EXIT LOOP
CAXE T3,DVCHNL ;[215] IF NUL:, NOT A MAGTAPE
TXNN T3,DV.MTA ;[215] NOW CHECK IF REALLY A MAGTAPE
JRST E$$MOM ;[215] MULTIPLE OUTPUT FILES MUST BE TAPES
HRRZ U,S.SPC(U) ;[C20] [215] ADVANCE TO NEXT SPEC
JRST $B ;[215] CONTINUE
END;
SETO T4, ;[353] INDICATE OUTPUT FILE SPEC
PUSHJ P,STOPB ;[353] TO SCAN BLOCK CONVERTER
MOVE T1,F.OUZR ;[215] LINK TO FRONT OF DEVICE LIST
MOVEM T1,X.NXT(P1) ;[OK] [215] ..
MOVEM P1,F.OXBK ;[215] ..
RETURN
END;
SUBTTL PSORT. -- SETUPI - Set Up Input Files
BEGIN
PROCEDURE (PUSHJ P,SETUPI) ;SET UP ALL INPUT SPECS
;SETUPI IS CALLED BY PSORT. FOLLOWING CALLS TO SCAN TO READ THE USER'S COMMAND.
;WE ARE CONCERNED HERE ONLY WITH VERIFYING THE GOODNESS OF THE FILE SPECS IN THE
;LIST AT F.INZR (SET UP BY ALLIN DURING THE COMMAND SCANNING), AND STORING
;COMMAND INFORMATION FOR LATER. ACTUAL INITIALIZATION OF THE FILE IS PERFORMED
;IN INIINP, DURING THE SORT OR MERGE.
;
;WE LOOP OVER EVERY FILE SPEC IN THE LIST AT F.INZR, CREATING X.xxxx BLOCKS FOR
;EACH SPEC IN THE LIST BY THE CALL TO STOPB. WHEN PROCESSING IS COMPLETED HERE,
;THE S.xxxx BLOCKS HAVE BEEN DELETED FROM THE F.OUZR LIST, AND REPLACED WITH A
;LIST OF X.xxxx BLOCKS. SINCE F.INZR WAS IN REVERSE ORDER TO BEGIN WITH, WE
;FINISH WITH THE X.xxxx BLOCK LIST IN FORWARD ORDER.
SKIPN U,F.INZR ;GET LIST PTR
JRST E$$INS ;MUST BE INPUT FILE
SETZM F.INZR ;CLEAR PTR
WHILE FILE SPEC BLOCKS TO LOOK AT
BEGIN
AOS NUMINP ;[215] COUNT INPUT FILE
SETZ T4, ;[353] INDICATE INPUT FILE SPEC
PUSHJ P,STOPB ;[353] TO SCAN BLOCK CONVERTER
MOVE T1,F.INZR ;[353] GET PREVIOUS BLOCK
MOVEM T1,X.NXT(P1) ;[OK] [353]
MOVEM P1,F.INZR ;SAVE THIS
HRRZ U,(U) ;[C20] GET NEXT BLOCK
JUMPN U,$B ;[C20] TRY NEXT
END;
RETURN ;[215] END OF INPUT LIST
END;
SUBTTL PSORT. -- STOPB - Convert SORT/SCAN To OPEN/ENTER/PATH Blocks
BEGIN
PROCEDURE (PUSHJ P,STOPB) ;[353] CONVERT SCAN TO OPEN BLOCKS
;STOPB ALLOCATES AN X.xxxx BLOCK THEN CONVERTS A SORT/SCAN BLOCK TO THE OPEN,
;LOOKUP/ENTER AND PATH BLOCKS IN THE X.xxxx BLOCK. THIS CODE IS VERY SIMILAR TO
;THE CODE IN .STOPB IN SCAN.MAC, BUT SORT SWITCHES ARE ALSO HANDLED.
;
;CALLING SEQUENCE:
; T4/ <0 IF INPUT, -1 IF OUTPUT>
; U/ <ADDR OF SORT/SCAN BLOCK>
;RETURNS:
; U/ (UNCHANGED)
; P1/ <ADDR OF NEW X.xxxx BLOCK>
MOVX T1,LN.X ;[353] ALLOCATE NEW X.xxxx BLOCK
PUSHJ P,GETSPC ;[353] ..
JRST E$$NEC ;[353]
MOVE P1,T1 ;[353] PUT WHERE WE WILL REMEMBER IT
;BUILD THE OPEN BLOCK.
MOVE T1,S.MOD(U) ;[353] GET SCAN'S MODE WORD
LDB T2,[POINTR (T1,FX.DEN)] ;[353] GET DENSITY FOR TAPE
MOVEM T2,X.DEN(P1) ;[OK] [353] SAVE FOR TAPOP. IN INIINP
LSH T2,^D35-<POS (IO.DEN)> ;[353] PUT IN POSITION FOR OPEN UUO
ANDX T2,IO.DEN ;[353] CLEAR 1600, 6250 BITS
TXNE T1,FX.PHY ;[353] /PHYSICAL TYPED?
TXO T2,UU.PHS ;[353] YES--SET PHONLY BIT
TXNE T1,FX.PAR ;[353] /PARITY:EVEN TYPED?
TXO T2,IO.PAR ;[353] YES--PRESERVE IN OPEN BLOCK
HRRZ T3,IOMODE ;[353] COMPUTE MODE FOR OPEN UUO
OR T2,[EXP .IOBIN,.IOASC,.IOBIN,.IOBIN]-1(T3) ;[OK] [353] ..
SKIPE T4 ;[353] OUTPUT FILE?
TXO T2,UU.IBC ;[353] YES--INHIBIT BUFFER CLEAR
MOVEM T2,X.OPN+.OPMOD(P1) ;[OK] [353] STORE IN OPEN BLOCK
MOVE T1,S.DEV(U) ;[353] GET DEVICE
MOVEM T1,X.OPN+.OPDEV(P1) ;[OK] [353] ..
;GET DEVICE CHARACTERISTICS.
DEVCHR T1, ;[353] GET DEVICE CHARACTERISTICS
JUMPE T1,E$$DNE ;[353] NON-EXISTENT DEVICE
TXZ T1,DVCHMD ;[353] CLEAR I/O MODE BITS
MOVEM T1,X.DVCH(P1) ;[OK] [353] SAVE CHARACTERISTICS
;SET EBCDIC MAGTAPE DEFAULTS
IFE FTFORTRAN,<
IF WE HAVE AN EBCDIC MAGTAPE
; MOVE T1,X.DVCH(P1) ;[OK] [C09] GET DEVICE TYPE
CAXE T1,DVCHNL ;[C09] IF NUL:, NOT A MAGTAPE
TXNN T1,DV.MTA ;[C09] NOW CHECK IF REALLY A TAPE
JRST $F ;[C09] NO
MOVX T1,RM.EBC ;[C09] EBCDIC?
TDNN T1,MODE ;[C09] ..
JRST $F ;[C09] NO
THEN SET DEFAULTS
MOVEI T1,1 ;[C09] /BLOCKED:0?
SKIPG S.BLKF(U) ;[C09] ..
MOVEM T1,S.BLKF(U) ;[C09] YES, MAKE /BLOCKED:1
MOVEI T1,1 ;[C09] FORCE /INDUSTRY
MOVEM T1,S.INDU(U) ;[C09] ..
FI;
>
;COMPUTE BUFFER SIZE.
IFE FTFORTRAN,<
IF WE HAVE A MAGTAPE
MOVE T1,X.DVCH(P1) ;[OK] [C09] GET DEVICE TYPE
CAXE T1,DVCHNL ;[353] IF NUL:, NOT A MAGTAPE
TXNN T1,DV.MTA ;[353] NOW CHECK IF REALLY A TAPE
JRST $T ;[353] NO
THEN COMPUTE BLOCKING FACTOR
PUSHJ P,SETMTA ;[353] GO FIND BLOCKING FACTOR
FASTSKIP ;[353] NOT BLOCKED
JRST $F ;[353] BLOCKED--BUFFER SIZE IN T2
ELSE ASK MONITOR FOR DEFAULT
>
MOVEI T2,X.OPN(P1) ;[OK] [353] SET UP FOR DEVSIZ
DEVSIZ T2, ;[353] FIND OUT DEFAULT
MOVEI T2,.TBS ;[353] NONE--USE DISK'S
IFE FTFORTRAN,<
FI;
>
HRRZM T2,X.DVSZ(P1) ;[OK] [353] BUFFER SIZE
HRRZ T2,T2 ;[353] GET JUST BUFFER SIZE
CAMLE T2,MXDVSZ ;[353] BIGGEST YET?
MOVEM T2,MXDVSZ ;[353] YES
;BUILD THE LOOKUP/ENTER AND MAYBE PATH. BLOCK.
MOVX T1,.RBALC ;[353] INITIALIZE LOOKUP/ENTER BLOCK
MOVEM T1,X.RIB+.RBCNT(P1) ;[OK] [353] ..
MOVE T1,S.NAME(U) ;[353] GET FILE NAME
MOVEM T1,X.RIB+.RBNAM(P1) ;[OK] [353] STORE FILE NAME
DMOVE T1,S.EXT(U) ;[353] GET EXTENSION & MOD WORD
HLLZM T1,X.RIB+.RBEXT(P1) ;[OK] [353] JUST SAVE EXTENSION
MOVE T1,S.DIR(U) ;[353] GET PPN
IF DIRECTORY WE BUILD INDICATES SFD'S
TXNN T2,FX.DIR ;[353] DIRECTORY SPECIFIED
JRST $F ;[353] NO OR [-], USE 0
TLNN T1,-1 ;[353] CHECK FOR [,PN]
HLL T1,MYPPN ;[353] FILL IN LHS
TRNN T1,-1 ;[353] CHECK FOR [P,]
HRR T1,MYPPN ;[353] FILL IN RHS
SKIPN S.SFD(U) ;[353] SFD'S SPECIFIED?
JRST $F ;NO
THEN COPY THEM AND SET UP PATH. BLOCK
MOVEM T1,X.PTH+.PTPPN(P1) ;[OK] [353] STORE PATH POINTER
MOVEI T2,X.PTH+.PTSFD(P1) ;[C20] [353] FIRST IN PATH. BLOCK
MOVEI T3,S.SFD(U) ;[353] FIRST IN S.xxxx BLOCK
PUSH P,T4 ;[C20] SAVE T4
MOVEI T4,.FXLND ;[C20] MAX # OF SFD'S
WHILE SFD'S TO COPY
BEGIN
MOVE T1,(T3) ;[OK] [353] GET IT
MOVEM T1,(T2) ;[OK] [353] STORE IT
ADDI T2,1 ;[C20] ADVANCE
ADDI T3,2 ;[353] ADVANCE
SOJG T4,$B ;[C20] [353] LOOP
END;
POP P,T4 ;[C20] RESTORE T4
MOVEI T1,X.PTH(P1) ;[OK] [353] STORE PATH. POINTER INSTEAD OF PPN
FI;
MOVEM T1,X.RIB+.RBPPN(P1) ;[OK] [353] STORE POINTER OR PPN
IF THIS IS AN OUTPUT FILE
SKIPN T4 ;[353] CALLED WITH AN OUTPUT SPEC?
JRST $F ;[353] NO--NOTHING TO DO HERE
THEN SET UP PROTECTION, /ESTIMATE, /VERSION, /ERSUPERCEDE
MOVE T1,S.PROT(U) ;[353] GET PROTECTION FIELD
LSH T1,<ALIGN. (RB.PRV)> ;[353] IN PROPER PLACE
MOVEM T1,X.RIB+.RBPRV(P1) ;[OK] [353] STORE PROT, CLEAR DATES
SETZM X.RIB+.RBSIZ(P1) ;[OK] [353] CLEAR INITIAL FILE SIZE
IF USER GAVE A USEFUL /ESTIMATE
SKIPG T1,S.EST(U) ;[353] NON-ZERO NON-DEFAULT /EST?
;**;[510] @STOPB)+130 lines, Change some lines. GCS 25-Oct-82
JRST $T ;[510][353]NOT SPECIFIED
THEN TURN INTO BLOCKS FOR ENTER
ADDI T1,177 ;[353] ROUND UP TO DISK BLOCK
LSH T1,-<POW2(200)> ;[353] ..
MOVEM T1,X.RIB+.RBEST(P1) ;[OK] [353] SAVE FOR ENTER
JRST $F ;[510]
ELSE CLEAR IT ;[510]
SETZM X.RIB+.RBEST(P1) ;[510]
FI;
SETZM X.RIB+.RBSPL(P1) ;[510] CLEAR OUT ANY JUNK.
SETZM X.RIB+.RBVER(P1) ;[510] CLEAR OUT ANY JUNK.
SETCM T1,S.VER(U) ;[353] COMPLEMENT SO WE CAN
SKIPE T1 ;[353] IGNORE IF -1 (SCAN DEFAULT)
SETCAM T1,X.RIB+.RBVER(P1) ;[OK] [353] STORE ORIGINAL IN MEMORY
FI;
;REMEMBER SORT'S FILE SWITCHES.
SKIPGE T1,S.BLKF(U) ;[353] BLOCKING FACTOR SET?
MOVE T1,P.BLKF ;[353] NO--USE STICKY DEFAULT
SKIPGE T1 ;[353] STILL NOT SET?
SETZ T1, ;[353] NO--ASSUME NO BLOCKING FACTOR
MOVEM T1,X.BLKF(P1) ;[OK] [353] STORE RESULT
MOVE T1,S.POSI(U) ;[C11] GET /POSITION: VALUE
MOVEM T1,X.POSI(P1) ;[OK] [C11] STORE RESULT
SKIPGE T4,S.LABL(U) ;[353] LABEL TYPE SPECIFIED TO SORT?
MOVE T4,P.LABL ;[353] OR BY DEFAULT?
IFE FTFORTRAN,<
IF THIS IS A TAPE MOUNTED WITH NON-BLP PULSAR LABEL PARAMETER
MOVE T3,[3,,T1] ;[353] READ PULSAR LABEL TYPE
MOVX T1,.TFLBL ;[353] ..
MOVE T2,X.OPN+.OPDEV(P1) ;[OK] [353] ..
TAPOP. T3, ;[353] ..
JRST $T ;[353] EITHER NO PULSAR OR NOT A TAPE
CAXN T3,.TFLBP ;[353] OR BYPASSING LABELS
JRST $T ;[353] ..
CAXN T3,.TFLNL ;[C25] ..
JRST $T ;[C25] ..
CAXN T3,.TFLNV ;[C25] ..
JRST $T ;[C25] ..
THEN SET AUTO-LABEL AND VERIFY SORT AND PULSAR /LABEL SWITCHES
MOVX T1,FI.ATO ;[353] START FILE FLAGS WITH AUTO-LABEL
IF SORT'S /LABEL SWITCH WAS SPECIFIED
SKIPGE T4 ;[353] NON-NEGATIVE?
JRST $F ;[353] NO--NOT SPECIFIED
THEN MAKE SURE IT AGREES WITH PULSAR'S /LABEL
CAIL T3,LBLLEN ;[353] RANGE-CHECK AGAINST TABLE
JRST ERRUTL ;[353] MUST BE NEW LABEL TYPE
CAME T4,LBLTBL(T3) ;[OK] [353] SEE IF VALUES MATCH
JRST ERRLNL ;[353] NO--COMPLAIN
FI;
JRST $F ;[353] NOTHING ELSE TO DO
ELSE REMEMBER LABEL TYPE TO HANDLE IN CASE THIS IS A TAPE
>
SETZ T1, ;[353] START FILE FLAGS WITH NO AUTO-LABEL
SKIPG T4 ;[353] /LABEL SPECIFIED TO SORT?
MOVX T4,LABOMITTED ;[353] NO--DEFAULT TO /LABEL:OMITTED
MOVEM T4,X.LABL(P1) ;[OK] [353] REMEMBER WHAT LABEL TYPE TO DO
IFE FTFORTRAN,<
FI;
>
SKIPGE T2,S.VARI(U) ;[353] VARIABLE LENGTH RECORDS?
MOVE T2,P.VARF ;[353] OR BY DEFAULT
SKIPLE T2 ;[353] ..
TXO T1,FI.VAR ;[353] YES
SKIPGE T2,S.INDU(U) ;[353] INDUSTRY COMPATIBLE MODE?
MOVE T2,P.INDU ;[353] OR BY DEFAULT?
SKIPLE T2 ;[353] ..
TXO T1,FI.IND ;[353] YES
SKIPGE T2,S.STDA(U) ;[353] STANDARD ASCII MODE
MOVE T2,P.STDA ;[353] OR BY DEFAULT?
SKIPLE T2 ;[353] ..
TXO T1,FI.STA ;[353] YES
SKIPLE S.REW(U) ;[353] REWIND?
TXO T1,FI.REW ;[353] YES
SKIPLE S.UNL(U) ;[353] UNLOAD?
TXO T1,FI.UNL ;[353] YES
MOVEM T1,X.FLG(P1) ;[OK] [353] SAVE FLAG SETTINGS
RETURN ;[353] DONE
END;
LBLTBL: LABOMITTED ;[353] .TFLBP BLP
LABANSI ;[353] .TFLAL ANSI
LABANSI ;[353] .TFLAU ANSI WITH USER LABELS
LABIBM ;[353] .TFLIL IBM
LABIBM ;[353] .TFLIU IBM WITH USER LABELS
LABNONSTANDARD ;[353] .TFLTM LEADING TAPE MARK
LABNONSTANDARD ;[353] .TFLNS NON-STANDARD
LABOMITTED ;[353] .TFLNL NO LABELS
LABDEC ;[C25] .TFCBA DEC COBOL ASCII
LABDEC ;[C25] .TFCBS DEC COBOL SIXBIT
LABOMITTED ;[C25] .TFLNV NO LABELS, USER EOV
LBLLEN==.-LBLTBL ;[353] LENGTH OF PULSAR-TO-SORT LABEL TABLE
SUBTTL PSORT. -- SETMTA - Set Up Buffer Sizes for Magtapes
IFE FTFORTRAN,<
BEGIN
PROCEDURE (PUSHJ P,SETMTA) ;SET UP FOR MTA
;HERE IF DEVICE IS A MAGTAPE
;SET BUFFER SIZE IF FILE IS BLOCKED
;RETURNS WITH
;T2 = BUFFER SIZE IF BLOCKED MTA
IF FILE IS BLOCKED
SKIPG S.BLKF(U) ;[C06] FILE BLOCKED?
JRST $F ;NO
THEN
HRRZ T2,IOMODE ;[201] GET I/O MODE
CASE MODE OF SIXBIT,ASCII,EBCDIC,BINARY
JRST @[IFIWS <$1,$2,$3,$4>]-1(T2) ;[C20]
$1% MOVE T2,RECSIZ ;SIZE OF RECORD
IMUL T2,S.BLKF(U) ;SIZE OF BUFFER
JRST $C ;ADD IN HEADER WORDS
$2% MOVE T2,RECORD ;SIZE OF RECORD IN CHARS
SKIPG NOCRLF ;[N11] SKIP IF NO CRLF WANTED
ADDI T2,2 ;CR-LF
IMUL T2,S.BLKF(U) ;TOTAL IN CHARS
ADDI T2,4 ;FOR OVERFLOW
IDIVI T2,5 ;NO. OF WORDS
JRST $C ;ADD IN HEADER WORDS
$3% MOVE T2,RECORD ;SIZE OF RECORD IN CHARS
SKIPGE T1,S.VARI(U) ;[C06] VARIABLE LENGTH RECORDS?
MOVE T1,P.VARF ;[C06] OR BY DEFAULT
SKIPLE T1 ;[C06] ..
ADDI T2,4 ;[C06] ADD RECORD HEADER WORD
IMUL T2,S.BLKF(U) ;TOTAL IN CHARS
ADDI T2,3 ;FOR OVERFLOW
IDIVI T2,4 ;NO. OF WORDS
SKIPLE T1 ;[C06] IF VARIABLE?
ADDI T2,1 ;[C06] ADD BLOCK HEADER WORD
JRST $C ;ADD IN HEADER WORDS
$4% MOVE T2,RECSIZ ;[C06] SIZE IN WORDS
IMUL T2,S.BLKF(U) ;* BLOCKING FACTOR
ESAC;
ADDI T2,3 ;ADD IN HEADER WORDS
AOS (P) ;SKIP RETURN
FI;
RETURN
END;
>;END IFE FTFORTRAN
SUBTTL PSORT. -- Memory Management Routines for TOPS-10
;ROUTINE TO CHECK FOR /CORE SWITCH AND INSURE ARGUMENT IS REASONABLE
BEGIN
PROCEDURE (PUSHJ P,CHKCOR)
IF USER SPECIFIED /CORE
SKIPG T1,CORSIZ ;[C20] SIZE SPECIFIED
JRST $T ;NO
THEN
CAIGE T1,1000 ;[C20] YES, BUT MAKE SURE REASONABLE
LSH T1,POW2(2000) ;[C20] CONVERT NUMBER TO K
SUB T1,OLDFF ;[C20] [C13] CALCULATE NEW AVAILABLE MEMORY
JUMPLE T1,$2 ;ARG IS TOO SMALL
PUSHJ P,RSTSPC ;[C13] RE-SETUP AVAILABLE MEMORY
JRST $F
$2% SETZM CORSIZ ;VALUE IS TOO SMALL TO USE
PUSHJ P,E$$NCS ;WARN USER
; AND USE THE DEFAULT ALGORITHM
ELSE USE DEFAULT
PUSHJ P,DEFCOR ;USE DEFAULT ALGORITHM
FI;
PUSHJ P,TSTSIZ ;GO CHECK SIZE
PUSHJ P,SMALL ;SEE IF INPUT IS 1 SMALL FILE
IFE FTDEBUG!FTFORTRAN!FTVM,<
JRST $1 ;[C13] GET RID OF HIGH SEGMENT
SEGMENT LPURE ;[C20]
$1% MOVSI T1,1 ;[C20] [C13] REMOVE HIGH SEGMENT
CORE T1, ;[C13] ..
NOOP ;[C13] SHOULD NEVER FAIL
RETURN ;[C20] [C13] JOIN COMMON CODE
SEGMENT HPURE ;[C20]
>;END IFE FTDEBUG!FTFORTRAN!FTVM
IFN FTDEBUG!FTFORTRAN!FTVM,<
RETURN ;[C13]
>;END IFN FTDEBUG!FTFORTRAN!FTVM
END;
BEGIN
PROCEDURE (PUSHJ P,SMALL)
SKIPE LEAVES ;[N11] IF USER SPECIFIED SIZE
RETURN ;[N11] LEAVE IT ALONE
MOVE P1,F.INZR ;GET FIRST INPUT FILE
MOVE T1,X.DVCH(P1) ;[OK] GET DEVCHR BITS
TXNE T1,DV.DSK ;IS IT A DSK?
SKIPE X.NXT(P1) ;[OK] AND ONLY ONE FILE?
RETURN ;NO
MOVEI T1,LN.X ;SIZE OF DATA BLOCK
PUSHJ P,GETSPC ;GET SPACE
JRST E$$NEC ;FAILED
HRL T1,P1 ;FROM - TO
HRRZ P1,T1 ;POINT TO IT
BLT T1,LN.X-1(P1) ;[OK] COPY BLOCK
PUSHJ P,GETCHN ;[C19] GET A FREE CHANNEL
JRST E$$NEH ;[C19] FAILED
HRLS T1 ;[C19] BUILD FILOP. BLOCK, GET CHANNEL
HRRI T1,.FORED ;[C19] GET READ FUNCTION
TXO T1,FO.PRV ;[N14] BYPASS CHECKS IF [1,2] OR JACCT
SKIPE XCHNO. ;[N17] CAN WE USE EXTENDED CHANNELS?
TXO T1,FO.ASC ;[N17] YES, DO SO
MOVEM T1,FLPARG+.FOFNC ;[C19] STORE THEM
MOVX T1,.IODMP ;[C19] SET DUMP MODE
MOVEM T1,FLPARG+.FOIOS ;[C19] ..
MOVE T1,X.OPN+1(P1) ;[OK] [C19] GET DEVICE
MOVEM T1,FLPARG+.FODEV ;[C19] STORE IT
SETZM FLPARG+.FOBRH ;[C19] NO BUFFERS
SETZM FLPARG+.FONBF ;[C19] ..
HRRZI T1,X.RIB(P1) ;[OK] [C19] GET LOOKUP BLOCK ADDRESS
MOVEM T1,FLPARG+.FOLEB ;[C19] STORE IT
MOVE T1,[XWD .FOLEB+1,FLPARG] ;[C19] DO READ FILOP.
FILOP. T1, ;[C19] ..
JRST ERRFUF ;[N05] GIVE ERROR MESSAGE AND GIVE UP
MOVE T1,X.RIB+.RBSIZ(P1) ;[OK] GET SIZE IN WORDS
SKIPLE P.VARF ;VARIABLE RECORD SIZE?
SKIPA T3,MAXKEY ;YES, USE WORST CASE (ALMOST)
MOVE T3,RECSIZ ;NO, USE FIXED SIZE
SOSLE T3 ;ALLOW FOR PARTIAL WORD ONLY WORST CASE
IDIV T1,T3 ;[C20] NO. OF RECORDS
IMULI T1,3 ;MULTIPLY BY 1.5 TO GIVE
LSH T1,-1 ; 50% FUDGE FACTOR
CAIGE T1,^D16 ;GUARANTEE A MINIMUM
MOVEI T1,^D16 ;IN CASE USER IS CONFUSED
CAML T1,NUMRCB ;LESS THAN WE ALLOWED FOR?
JRST $1 ;NO
MOVEM T1,NUMRCB ;[C13] STORE BACK
MOVE T2,X.RIB+.RBSIZ(P1) ;[OK]
IDIVI T2,.TBS ;SEE HOW MANY BUFFERS WE ACTUALLY NEED
SKIPE T3
ADDI T2,1
CAIGE T2,2 ;AT LEAST DOUBLE
MOVEI T2,2
TRZE T2,1 ;[C18] MAKE EVEN
ADDI T2,2 ;[C18] ..
CAML T2,IBUFNO ;LESS THAN WE ALLOWED?
JRST $2 ;NO, USE WHAT WE CALCULATED PREVIOUSLY
EXCH T2,IBUFNO ;YES, REDUCE NO.
SUB T2,IBUFNO ;GET DIFF
IMULI T2,.TBS
MOVNS T2 ;[C13] ADJUST BUFFER POOL SIZE
ADDM T2,BUFSZ ;[C13] ..
$2% MOVEI T2,2 ;JUST IN CASE THING GO WRONG
EXCH T2,TBUFNO ;ALLOW DOUBLE BUFFERING FOR TEMP FILE
SUB T2,TBUFNO
IMULI T2,.TBS
MOVNS T2 ;[C13] REDUCE BUFFER POOL SIZE
ADDM T2,BUFSZ ;[C13] ..
$1% MOVS T1,FLPARG+.FOFNC ;[N17] GET CHANNEL BACK
ANDI T1,777 ;[N17]
PUSHJ P,RELCHN ;[C19] ..
MOVEI T1,LN.X ;GIVE BACK SPACE
PUSHJ P,FRESPC ;TO POOL
RETURN
END;
SUBTTL HPURE SEGMENT ERROR MESSAGES
E$$FNT: $ERROR (?,FNT,<File name may not be specified with /TEMP device.>)
E$$DND: $ERROR (?,DND,<Device >,+)
$MORE (SIXBIT,S.DEV(U))
$MORE (TEXT,< is not a disk. All scratch devices must be disks.>)
$DIE
E$$DNE: $ERROR (?,DNE,<Device >,+)
$MORE (SIXBIT,S.DEV(U))
$MORE (TEXT,< does not exist>)
$DIE
E$$PRI: $ERROR (?,PRI,<Priority must be in range -3 to +3.>)
E$$MTE: $ERROR (?,MTE,<Max Temp Files must be in the range 3 to >,+) ;[N20]
SKIPN XCHNO. ;[N20] EXTRA CHANNELS?
JRST [$MORE (TEXT,<15.>) ;[N20]
JRST .+2] ;[N20]
$MORE (TEXT,<26.>) ;[N20]
$DIE ;[N20]
IFE FTFORTRAN,<
ERRUTL: $ERROR (?,UTL,<Unknown tape label type detected on >,+)
MOVEI T2,X.RIB(P1) ;[OK] [353] SET UP PTR TO LOOKUP BLOCK
$MORE (FILESPEC,T2) ;[353] PRINT TAPE WITH ERROR
$DIE ;[353] FATAL ERROR
ERRLNL: PUSH P,T4 ;[353] SAVE SORT'S /LABEL ARG
$ERROR (?,LNL,</LABEL:>,+)
POP P,T1 ;[353] GET /LABEL ARG BACK
MOVE T1,LAB.T-1(T1) ;[OK] [353] GET SIXBIT /LABEL ARG
$MORE (SIXBIT,T1) ;[353] PRINT IT
$MORE (TEXT,< does not match tape's label type on >)
MOVEI T2,X.RIB(P1) ;[OK] [353] SET UP PTR TO LOOKUP BLOCK
$MORE (FILESPEC,T2) ;[353] PRINT TAPE WITH ERROR
$DIE
>
SUBTTL I/O ROUTINES -- INIINP - Initialize Next Input File
SEGMENT LPURE ;[C20]
BEGIN
PROCEDURE (PUSHJ P,INIINP) ;INITIALIZE NEXT INPUT FILE
;ENTER WITH:
; F/ FCBORG PTR
PUSH P,P1 ;[215] SAVE A TEMP FOR X. BLOCK
MOVE P1,FILXBK(F) ;[215] SET UP PTR TO X. BLOCK
SETZM FILSIZ(F) ;INITIALIZE FILE SIZE TO 0
SKIPE X.BLKF(P1) ;[OK] [C18] BLOCKED FILE?
PUSHJ P,BLKSET ;[C18] YES, SETUP FOR IT
MOVE T1,X.BLKF(P1) ;[OK] [215] GET BLOCKING FACTOR
HRRZM T1,FILBLK(F) ;STORE AS AOBJN WORD (TO FAIL FIRST TIME)
MOVE T1,FILBPK(F) ;[C18] GET BYTES PER BLOCK
MOVEM T1,FILKCT(F) ;[C18] SAVE AS BLOCK BYTE COUNT
MOVE T1,X.FLG(P1) ;[OK] [215] GET FILE FLAGS
MOVE T2,X.DVCH(P1) ;[OK] [C18] GET DEVCHR WORD
CAXN T2,DVCHNL ;[C18] NUL?
SETZ T2, ;[C18] YES, DONT GET CONFUSED
TXNE T2,DV.MTA ;[C18] MAGTAPE?
TXO T1,FI.MTA ;[C18] YES, SET FILE FLAG
TXNE T2,DV.DSK ;[C18] DSK?
TXO T1,FI.DSK ;[C18] YES, SET FILE FLAG
MOVEM T1,FILFLG(F) ;SET IN FCB
IF BUFFERS HAVE ALREADY BEEN SET UP
SKIPL BUFALC ;[C19] SET IN RELES. AND GETMRG WHEN FIRST
JRST $T ;[C19] PASS OF BUFFERS HAVE BEEN SET UP
THEN USE SAME BUFFER AREA AGAIN
MOVE T1,FILBUF(F) ;[C19] POINTER TO BEGINNING OF BUFF AREA
MOVEM T1,BUFPTR ;[C19] TELL BUFRNG TO START THERE
MOVE P2,IBUFNO ;[C19] SET UP CALL TO BUFRNG
PUSHJ P,BUFRNG ;[C19] BUILD NEW BUFFERS, SAME AREA
JRST $F ;[C19]
ELSE ALLOCATE MAXIMUM BUFFER AREA FOR WORST CASE
MOVE P2,IBUFNO ;[C19] SET UP CALL TO BUFRNG
PUSHJ P,BUFRNG ;[C19] ALLOCATE AT CURRENT BUFPTR
MOVE T1,IBUFNO ;[C19] INCREMENT BUFPTR BY
IMUL T1,MXDVSZ ;[C19] WORST CASE SIZE
ADD T1,FILBUF(F) ;[C19] IN CASE WE NEED IT
MOVEM T1,BUFPTR ;[C19] ..
FI;
HLLZS FILPTR(F) ;[C19] CLEAR RH OF BYTE POINTER
SETZM FILCNT(F) ;[C19] CLEAR FILE COUNT
MOVEI T1,FILHDR(F)
HRRZM T1,X.OPN+.OPBUF(P1) ;[OK] [215] SETUP INPUT BUFFER PTR
PUSHJ P,GETCHN ;[C19] GET A WORKING CHANNEL
JRST E$$NEH ;[C19] FAILED
MOVEM T1,FILCHN(F) ;[C19] STORE IT
HRLS T1 ;[C19] BUILD FILOP. BLOCK, GET CHANNEL
HRRI T1,.FORED ;[C19] GET READ FUNCTION
TXO T1,FO.PRV ;[N14] BYPASS CHECKS IF [1,2] OR JACCT
SKIPE XCHNO. ;[N17] CAN WE USE EXTENDED CHANNELS?
TXO T1,FO.ASC ;[N17] YES, DO SO
MOVEM T1,FLPARG+.FOFNC ;[C19] STORE THEM
HRLI T1,X.OPN(P1) ;[OK] [C19] TRANSFER OPEN BLOCK
HRRI T1,FLPARG+.FOIOS ;[C19] ..
BLT T1,FLPARG+.FOIOS+2 ;[C19] ..
SETZM FLPARG+.FONBF ;[C19] NO BUFFERS
HRRZI T1,X.RIB(P1) ;[OK] [C19] GET LOOKUP BLOCK ADDRESS
MOVE T2,X.DVCH(P1) ;[OK] [215] GET DEVCHR UUO
TXNN T2,DV.DSK ;DSK?
ADDI T1,2 ;NO
MOVEM T1,FLPARG+.FOLEB ;[C19] STORE IT
MOVE T1,[XWD .FOLEB+1,FLPARG] ;[C19] DO READ FILOP.
FILOP. T1, ;[C19] ..
JRST ERRFUF ;[C19] FAILED
MOVS T1,FLPARG+.FOFNC ;[N17] GET CHANNEL BACK
ANDI T1,777 ;[N17]
HRRM T1,FILCHN(F) ;[N17] INCASE WE HAD AN EXTENDED CHAN
; ..
IF I/O MODE IS EBCDIC
HRRZ T2,IOMODE ;[215] [201] CHECK FILE'S MODE
CAXE T2,MODEBCDIC ;[215] [201] CHECK FOR EBCDIC
JRST $F ;[215] NOT--BYTE POINTER IS OK
THEN USE EBCDIC 9-BIT BYTES
MOVX T2,<POINT 9> ;[215] SET UP DUMMY POINTER
HLLM T2,FILPTR(F) ;[215] MODIFY REAL POINTER
FI;
IF THIS IS A MAGTAPE
MOVE T1,X.DVCH(P1) ;[OK] [215] GET BACK DEVCHR WORD
CAXE T1,DVCHNL ;[215] IF NUL:, NOT A MAGTAPE
TXNN T1,DV.MTA ;[215] NOW CHECK FOR REAL MTA
JRST $F ;[215] NOT A MAGTAPE
THEN DO ADDITIONAL MAGTAPE SETUP (REWIND, DENSITY, ETC.)
PUSHJ P,POSITF ;[C11] POSITION FILE ON MAGTAPE
IF MODE IS EBCDIC INDUSTRY
HRRZ T2,MODE
MOVE T4,FILFLG(F) ;[C11] [215] GET FLAG BITS
CAIN T2,MODEBCDIC ;[215] FILE'S MODE EBCDIC?
TXNN T4,FI.IND ;[215] AND INDUSTRY?
JRST $F
THEN CHANGE BYTE POINTER TO 8-BIT
MOVX T2,<POINT 8> ;[215] YES
HLLM T2,FILPTR(F) ;RESET BYTE SIZE
FI;
PUSHJ P,STAPF ;[215] SET TAPE PARAMETERS
PUSHJ P,CHKLBL ;[215] GO CHECK ON LABELS
FI;
POP P,P1 ;[215] RESTORE TEMP
IFE FTCOBOL,<
PJRST DSKPRI ;SET DISK PRIORITY LEVEL
>
IFN FTCOBOL,<
RETURN ;DONE
>
END;
SUBTTL I/O ROUTINES -- INIOUT - Initialize Next Output File
BEGIN
PROCEDURE (PUSHJ P,INIOUT) ;INITIALIZE SORT OUTPUT FILE
MOVEI F,FCBORG ;SORT OUTPUT FILE HAS FIRST FCB
PUSH P,P1 ;[215] SAVE TEMP FOR X. BLOCK
MOVE P1,F.OXBK ;[215] LOAD SAVED X. BLOCK
MOVEM P1,FILXBK(F) ;[215] REMEMBER HERE TOO FOR LATER
SETZM FILSIZ(F) ;[215] START WITH NO RECS WRITTEN
SKIPE X.BLKF(P1) ;[OK] [C18] BLOCKED FILE?
PUSHJ P,BLKSET ;[C18] YES, SETUP FOR IT
MOVE T1,X.BLKF(P1) ;[OK] [215] FETCH BLOCKING FACTOR
HRRZM T1,FILBLK(F) ;STORE AS AOBJN WORD (TO FAIL FIRST TIME)
MOVE T1,FILBPK(F) ;[C18] GET BYTES PER BLOCK
MOVEM T1,FILKCT(F) ;[C18] SAVE AS BLOCK BYTE COUNT
MOVE T1,X.FLG(P1) ;[OK] GET FILE FLAGS
TXO T1,FI.OUT ;[C06] REMEMBER THIS IS AN OUTPUT FILE
MOVE T2,X.DVCH(P1) ;[OK] [C18] GET DEVCHR WORD
CAXN T2,DVCHNL ;[C18] NUL?
SETZ T2, ;[C18] YES, DON'T GET CONFUSED
TXNE T2,DV.MTA ;[C18] MAGTAPE?
TXO T1,FI.MTA ;[C18] YES, SET FILE FLAG
TXNE T2,DV.DSK ;[C18] DSK?
TXO T1,FI.DSK ;[C18] YES, SET FILE FLAG
MOVEM T1,FILFLG(F) ;SET IN FCB
MOVE T1,BUFPTR ;[C19] WHERE BUFFERS WILL START FROM
HRLI T2,0(T1) ;[C20] [C19]
HRRI T2,1(T1) ;[C20]
SETZM (T1) ;[OK] [C19]
MOVE T3,OBUFNO ;[C20] [C19] CLEAR ONLY TO END OF
IMUL T3,X.DVSZ(P1) ;[C20] [C19] THIS FILE'S BUFFER AREA
ADD T3,T1 ;[C20] [C19] FOR ASCII OR INDUSTRY
BLT T2,-1(T3) ;[C20] [C19] ..
MOVE P2,OBUFNO ;[C19] SET UP BUFFERS
PUSHJ P,BUFRNG ;[C19] ..
HLLZS FILPTR(F) ;[C19] CLEAR RH OF BYTE POINTER
SETZM FILCNT(F) ;[C19] CLEAR FILE COUNT
SETZM X.RIB+.RBALC(P1) ;[445] CLEAR CONTIGUOUS STORAGE REQUEST
IF USER DIDN'T GIVE OUTPUT ESTIMATE
SKIPE X.RIB+.RBEST(P1) ;[OK] [215] BELIEVE USER IF SET
JRST $F ;[215] IT IS
THEN COMPUTE ONE
MOVE T1,INPREC ;GET NO. OF RECORDS READ
MOVE T2,RECSIZ ;SIZE +1 IN WORDS
SUBI T2,1 ;[C20] MINUS 1
IMUL T1,T2 ;[C20] NO. OF WORDS READ
ADDI T1,177 ;ROUND UP ONE BLOCK
LSH T1,-<POW2(^D128)> ;IN BLOCKS
MOVEM T1,X.RIB+.RBEST(P1) ;[OK] [215] ALLOCATE SAME NO. FOR OUTPUT
FI;
MOVEI T1,FILHDR(F) ;[215] MAKE OPEN BLOCK POINT
HRLZM T1,X.OPN+.OPBUF(P1) ;[OK] [215] TO BUFFER HEADER
PUSHJ P,GETCHN ;[C19] GET A WORKING CHANNEL
JRST E$$NEH ;[C19] FAILED
MOVEM T1,FILCHN(F) ;[C19] STORE IT
HRLS T1 ;[C19] BUILD FILOP. BLOCK, GET CHANNEL
HRRI T1,.FOWRT ;[C19] GET WRITE FUNCTION
TXO T1,FO.PRV ;[N14] BYPASS CHECKS IF [1,2] OR JACCT
SKIPE XCHNO. ;[N17] CAN WE USE EXTENDED CHANNELS?
TXO T1,FO.ASC ;[N17] YES, DO SO
MOVEM T1,FLPARG+.FOFNC ;[C19] STORE THEM
HRLI T1,X.OPN(P1) ;[OK] [C19] TRANSFER OPEN BLOCK
HRRI T1,FLPARG+.FOIOS ;[C19] ..
BLT T1,FLPARG+.FOIOS+2 ;[C19] ..
SETZM FLPARG+.FONBF ;[C19] NO BUFFERS
HRRZI T1,X.RIB(P1) ;[OK] [C19] GET LOOKUP BLOCK ADDRESS
MOVE T2,X.DVCH(P1) ;[OK] [215] GET DEVCHR
TXNN T2,DV.DSK ;IS IT A DSK?
ADDI T1,2 ;NO, USE 4 WORD ENTER
MOVEM T1,FLPARG+.FOLEB ;[C19] STORE IT
MOVE T1,[.FOLEB+1,,FLPARG] ;[C19] DO WRITE FILOP.
FILOP. T1, ;[C19] ..
JRST ERRFUF ;[C19] FAILED
MOVS T1,FLPARG+.FOFNC ;[N17] GET CHANNEL BACK
ANDI T1,777 ;[N17]
HRRM T1,FILCHN(F) ;[N17] INCASE WE HAD AN EXTENDED CHAN
MOVE T1,FILBPB(F) ;[C18] GET BYTES PER BUFFER
SKIPG FILCNT(F) ;[C19] VIRGIN RING?
ADDM T1,FILKCT(F) ;[C18] YES, ADD TO BLOCK FOR DUMMY OUTPUT
; ..
IF I/O MODE IS EBCDIC
HRRZ T2,IOMODE ;[215] [201] FETCH FILE'S MODE
CAXE T2,MODEBCDIC ;[215] [201] EBCDIC?
JRST $F ;[215] NO--BYTE POINTER OK
THEN USE EBCDIC 9-BIT BYTES
MOVX T2,<POINT 9,,35> ;[215] [124] SET UP DUMMY POINTER
HLLM T2,FILPTR(F) ;[215] CHANGE REAL POINTER
MOVE T2,FILBPB(F) ;[C19] FIX UP BYTE COUNT
SKIPLE FILCNT(F) ;[C19] IF NECESSARY
MOVEM T2,FILCNT(F) ;[C19] ..
FI;
IF THIS IS A MAGTAPE
MOVE T2,X.DVCH(P1) ;[OK] [215] GET DEVCHR WORD BACK
CAXE T2,DVCHNL ;[215] IF NUL:, NOT A MAGTAPE
TXNN T2,DV.MTA ;[215] NOW CHECK FOR REAL MTA
JRST $F ;[215] NOT A MAGTAPE
THEN DO ADDITIONAL MAGTAPE SETUP (REWIND, DENSITY, ETC.)
PUSHJ P,POSITF ;[C11] POSITION FILE ON MAGTAPE
IF MODE IS EBCDIC INDUSTRY
HRRZ T2,MODE
MOVE T4,FILFLG(F) ;[C11] [215] GET FLAG BITS
CAIN T2,MODEBCDIC ;[215] FILE'S MODE EBCDIC?
TXNN T4,FI.IND ;[215] AND INDUSTRY?
JRST $F
THEN CHANGE BYTE POINTER TO 8-BIT
MOVX T2,<POINT 8,,35> ;[215] [124] YES
HLLM T2,FILPTR(F) ;RESET BYTE SIZE
FI;
PUSHJ P,STAPF ;[215] SET TAPE PARAMETERS
PUSHJ P,WRTLBL ;[215] WRITE LABELS IF ANY
FI;
POP P,P1 ;[215] RESTORE TEMP
IFE FTCOBOL,<
PJRST DSKPRI ;SET DISK PRIORITY LEVEL
>
IFN FTCOBOL,<
RETURN ;DONE
>
END;
SUBTTL I/O ROUTINES -- RENOUT - Rename Temporary File to Output File
BEGIN
PROCEDURE (PUSHJ P,RENOUT)
;RENAME FILE POINTED TO BY F TO BE SORT OUTPUT MASTER
PUSH P,P1 ;[C19] SAVE AND SETUP P1
MOVE P1,F.OXBK ;[C19] ..
IF 7-SERIES MONITOR
SKIPN M7.00 ;[N12] 7-SERIES?
JRST $T ;[N12] NO
THEN USE FILOP. FOR ALL I/O
HRLZ T1,FILCHN(F) ;[C19] BUILD FILOP. BLOCK, GET CHANNEL
HRRI T1,.FORNM ;[C19] GET RENAME FUNCTION
MOVEM T1,FLPARG+.FOFNC ;[C19] STORE THEM
SETZM FLPARG+.FOIOS ;[C19] NO DATA MODE
MOVE T1,X.OPN+.OPDEV(P1) ;[OK] [C19] TRANSFER DEVICE
MOVEM T1,FLPARG+.FODEV ;[C19] ..
SETZM FLPARG+.FOBRH ;[C19] NO BUFFERS
SETZM FLPARG+.FONBF ;[C19] ..
HRLZI T1,X.RIB(P1) ;[OK] [C19] GET RENAME BLOCK ADDRESS
MOVEM T1,FLPARG+.FOLEB ;[C19] STORE IT
MOVE T1,[XWD .FOLEB+1,FLPARG] ;[C19] DO RENAME FILOP.
FILOP. T1, ;[C19] ..
JRST ERRFUF ;[C19] FAILED
JRST $F ;[N12] OK
ELSE USE OLD I/O UUOs
MOVE T1,FILCHN(F) ;[C19] GET CHANNEL
LSH T1,27 ;[C19] ..
HRRI T1,X.RIB(P1) ;[OK] [C19] [342] [215] ..
TLO T1,(RENAME)
XCT T1
JRST [HRRZ T1,T2 ;[C19] FAILED
JRST ERRFUF] ;[C19] ..
FI;
MOVE T1,FILCHN(F) ;[C19] RELEASE CHANNEL
PUSHJ P,RELCHN ;[C19] ..
POP P,P1 ;[C19] RESTORE P1
RETURN
END;
SUBTTL I/O ROUTINES -- Magtape Utility Routines
BEGIN
PROCEDURE (PUSHJ P,SKIPR) ;[215] SKIP 1 RECORD ON TAPE POINTED TO BY F
MOVEI T1,.TFFSB ;[C19] SKIP RECORD
PJRST TAPOPX ;[C19] DO THE TAPOP.
END;
BEGIN
PROCEDURE (PUSHJ P,SKIPF) ;[215] SKIP 1 FILE ON TAPE POINTED TO BY F
MOVEI T1,.TFFSF ;[C19] SKIP FILE
PJRST TAPOPX ;[C19] DO THE TAPOP.
END;
BEGIN ;[414]
PROCEDURE (PUSHJ P,BKSPR) ;[414] BACKSPACE ONE RECORD ON MAGTAPE
MOVEI T1,.TFBSB ;[C19] BACKSPACE RECORD
PJRST TAPOPX ;[C19] DO THE TAPOP.
END; ;[414]
BEGIN
PROCEDURE (PUSHJ P,BKSPF) ;[C11] BACKSPACE ONE FILE ON MAGTAPE
MOVEI T1,.TFBSF ;[C19] BACKSPACE FILE
PJRST TAPOPX ;[C19] DO THE TAPOP.
END;
BEGIN
PROCEDURE (PUSHJ P,WRTEOF) ;WRITE A TAPE MARK DURING LABEL PROCESSING
MOVEI T1,.TFWTM ;[C19] WRITE TAPE MARK
PJRST TAPOPX ;[C19] DO THE TAPOP.
END;
BEGIN
PROCEDURE (PUSHJ P,RWNDF) ;[215] REWIND FILE POINTED TO BY F
MOVEI T1,.TFREW ;[C19] REWIND
PJRST TAPOPX ;[C19] DO THE TAPOP.
END;
BEGIN
PROCEDURE (PUSHJ P,UNLDF) ;UNLOAD FILE POINTED TO BY F
MOVEI T1,.TFUNL ;[C19] UNLOAD
PJRST TAPOPX ;[C19] DO THE TAPOP.
END;
BEGIN
PROCEDURE (PUSHJ P,TAPOPX) ;DO THE TAPOP. UUOS, C(T1)=FUNC
MOVE T2,T1 ;[C19] SETUP TAPOP. BLOCK, GET FUNC
MOVE T3,FILCHN(F) ;[C19] GET CHANNEL
MOVE T1,[XWD 2,T2] ;[C19] DO THE TAPOP.
TAPOP. T1, ;[C19] ..
SETZ T1, ;[C19] FAILED, NOT A TAPE
RETURN ;[C19]
END;
BEGIN
PROCEDURE (PUSHJ P,ISITMT)
;CHECK TO SEE IF FILE POINTED TO BY F IS A MAGTAPE
SKIPN T1,FILXBK(F) ;GET X. BLOCK ADDRESS
RETURN ;TEMP FILE, CAN'T BE MAGTAPE
MOVE T1,X.DVCH(T1) ;[OK] GET DEVCHR WORD
CAXE T1,DVCHNL ;IF NUL:, NOT A MAGTAPE
TXNN T1,DV.MTA ;NOW CHECK IF REALLY A TAPE
RETURN
AOS 0(P) ;A TAPE, SKIP RETURN
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,ISATBT) ;[C11]
;CHECK TO SEE IF MAGTAPE POINTED TO BY F IS AT BOT
MOVEI T1,.TFWAT ;[C19] WAIT FOR I/O
PUSHJ P,TAPOPX ;[C19] DO THE TAPOP.
MOVEI T1,.TFSTS ;[C19] GET TAPE STATUS
PUSHJ P,TAPOPX ;[C19] DO THE TAPOP.
TXNE T1,TF.BOT ;[C19] NOW CHECK IF AT BOT
AOS 0(P) ;[C11] YES, SKIP RETURN
RETURN ;[C11]
END;
SUBTTL I/O ROUTINES -- STAPF - Set Magtape File Parameters
BEGIN
PROCEDURE (PUSHJ P,STAPF) ;[215] SET TAPE FILE PARAMETERS
;STAPF IS CALLED FROM INIINP AND INIOUT TO SET UP ANY MAGTAPE PARAMETERS
;REQUIRED FOR THE FILE. WE ASSUME THAT OUR CALLERS HAVE VERIFIED THAT THE FILE
;IS ACTUALLY A MAGTAPE.
;ENTER WITH:
; P1/ POINTER TO X. BLOCK FOR FILE
; F/ FCB POINTER FOR FILE
PUSH P,P2 ;[215] SAVE TEMP FOR FILE FLAGS
MOVE P2,FILFLG(F) ;[215] ..
IF INDUSTRY COMPATIBLE MODE REQUIRED
TXNN P2,FI.IND ;[215] CHECK FOR INDUSTRY MODE
JRST $F ;[215] NO--TRY OTHERS
THEN SET IT
MOVX T0,.TFMOD+.TFSET ;[C19] DO TAPOP.
MOVE T1,FILCHN(F) ;[C19] ..
MOVX T2,.TFM8B ;[C19] ..
MOVX T3,<XWD 3,T0> ;[C19] ..
TAPOP. T3, ;[C19] ..
JRST ERRCSM ;[C19] FAILED
FI;
MOVX T0,.TFKTP ;[215] CONTROLLER FUNCTION
MOVE T1,FILCHN(F) ;[C19] CHANNEL
MOVX T3,<XWD 2,T0> ;[C19] LENGTH,,ADDR
TAPOP. T3, ;[215] FETCH TYPE
SETZ T2, ;[215] IN CASE IT FAILS
MOVE T4,T2 ;[215] SAVE IN SAFE AC
IF STANDARD ASCII MODE REQUIRED
TXNN P2,FI.STA ;[215] DO WE NEED IT?
JRST $F ;[215] NO--DON'T DO IT
THEN SET IT IF CONTROLLER SUPPORTS IT
CAIGE T4,.TFKTX ;[215] CHECK FOR GOOD CONTROLLER
JRST E$$SAT ;[215] ..
MOVX T3,<XWD 3,T0> ;[C19] LENGTH,,ADDR
MOVX T0,.TFMOD+.TFSET ;[215] FUNCTION
MOVE T1,FILCHN(F) ;[C19] CHANNEL
MOVX T2,.TFM7B ;[215] 7-BIT MODE
TAPOP. T3, ;[215] SET IT
JRST ERRCSM ;[C19] FAILED
FI;
IF DENSITY CHANGE REQUIRED
SKIPN T2,X.DEN(P1) ;[OK] [215] NON-DEFAULT DENSITY?
JRST $F ;[215] NO--FORGET IT
THEN TRY TO SET IT
IF CONTROLLER IS A TC10C OR A TX01
CAIGE T4,.TFKTC ;[215] CHECK FOR THEM
JRST $T ;[215] NO--CHECK FOR OTHERS
THEN DENSITY MAY ONLY BE 800 OR 1600 BPI
CAIGE T2,.TFD80 ;[215] AT LEAST 800 BPI?
JRST ERRCSD ;[215] NO--ERROR
JRST $F ;[215] OK--SET DENSITY
ELSE FOR TM10A OR TM10B, DENSITY MAY NOT BE 1600 BPI
CAILE T2,.TFD80 ;[215] CHECK FOR 800 OR LESS
JRST ERRCSD ;[215] NO--ERROR
FI;
MOVX T3,<XWD 3,T0> ;[C19] LENGTH,,ADDR
MOVX T0,.TFDEN+.TFSET ;[215] FUNCTION
MOVE T1,FILCHN(F) ;[C19] CHANNEL
TAPOP. T3, ;[215] SET DENSITY
NOOP ;[215] EARLY MONITOR--OPEN UUO OK
FI;
POP P,P2 ;[215] RESTORE TEMP
RETURN ;[215] ALL DONE
END;
ERRCSD: PUSH P,T1 ;SAVE CHAN #
PUSH P,T2 ;SAVE DENSITY
$ERROR (?,CSD,<Cannot set density to >,+)
POP P,T1
MOVE T1,[DEC 200,556,800,1600,6250]-1(T1) ;[OK]
$MORE (DECIMAL,T1)
$MORE (TEXT,< on >)
POP P,T1
DEVNAM T1,
NOOP
$MORE (SIXBIT,T1)
$DIE
ERRCSM: PUSH P,T1 ;[C19] SAVE CHAN #
$ERROR (?,CSM,<Cannot set hardware data mode on >,+) ;[C19]
POP P,T1 ;[C19]
DEVNAM T1, ;[C19]
MOVSI T1,'MTA' ;[C19] FAILED
$MORE (SIXBIT,T1) ;[C19]
$DIE ;[C19]
SUBTTL TRY TO RENAME SINGLE TEMP FILE TO OUTPUT FILE
IFE FTFORTRAN,<
BEGIN
PROCEDURE (PUSHJ P,TSTDEV)
;SEE IF TEMP DEVICE IS A SUBSET OF OUTPUT DEVICE
PUSH P,P1 ;[324] JUST IN CASE
MOVE P1,F.OXBK ;[324] RESTORE ADDRESS OF X.BLOCK-OUTPUT
HRRZ T1,IOMODE ;[201] FETCH I/O MODE INDEX
CAXE T1,MODSIXBIT ;[201] ONLY SIXBIT LOOKS LIKE A TEMP FILE
JRST $1 ;NO, CANNOT RENAME IT
MOVS T1,@EXTORG ;[OK] [C13] GET EXTRACT CODE
CAIN T1,(JRST (P4)) ;[117] JUST A DUMMY?
SKIPE X.BLKF(P1) ;[OK] [215] [117] CAN'T DO IF OUTPUT BLOCKED
JRST $1 ;NO DO IT THE HARD WAY
MOVE T1,TMPFCB+FILCHN ;[C19] GET TEMP CHANNEL
DEVNAM T1, ;SEE WHAT IT REALLY WAS
JRST $1 ;FAILED
MOVEM T1,DSKARG+.DCNAM
MOVE T1,[.DCUPN,,DSKARG]
DSKCHR T1, ;SEE WHAT IT BELONGS TO
JRST $1 ;GIVE UP
MOVE T1,DSKARG+.DCSNM ;GET STRUCTURE
MOVE T2,X.OPN+.OPDEV(P1) ;[OK] [215] GET DESIRED OUTPUT DEVICE
MOVEM T2,DSKARG+.DCNAM
MOVE T2,[.DCUPN,,DSKARG]
DSKCHR T2, ;SEE WHAT OUTPUT IS
JRST $1 ;FAILED
IF OUTPUT DEVICE IS GENERIC DSK
TXNE T2,DC.TYP ;ALL ZERO IF GENERIC DSK
JRST $T ;NO, ITS NOT
THEN SEE IF FILE ALREADY EXISTS ON DSK
PUSH P,T1 ;[404] SAVE FROM 1ST DSKCHR
MOVEI F,TMPFCB ;[113]
PUSHJ P,GETCHN ;[C19] GET A WORKING CHANNEL
JRST E$$NEH ;[C19] FAILED
HRLS T1 ;[C19] BUILD FILOP. BLOCK, GET CHANNEL
HRRI T1,.FORED ;[C19] GET READ FUNCTION
TXO T1,FO.PRV ;[N14] BYPASS CHECKS IF [1,2] OR JACCT
SKIPE XCHNO. ;[N17] CAN WE USE EXTENDED CHANNELS?
TXO T1,FO.ASC ;[N17] YES, DO SO
MOVEM T1,FLPARG+.FOFNC ;[C19] STORE THEM
HRLI T1,X.OPN(P1) ;[OK] [C19] TRANSFER OPEN BLOCK
HRRI T1,FLPARG+.FOIOS ;[C19] ..
BLT T1,FLPARG+.FOIOS+2 ;[C19] ..
SETZM FLPARG+.FONBF ;[C19] NO BUFFERS
HRRZI T1,X.RIB(P1) ;[OK] [C19] GET LOOKUP BLOCK ADDRESS
MOVEM T1,FLPARG+.FOLEB ;[C19] STORE IT
MOVE T1,[XWD .FOLEB+1,FLPARG] ;[C19] DO READ FILOP.
FILOP. T1, ;[C19] ..
TDZA T2,T2 ;[C19] [113] FAILED, FILE DOES NOT EXIST
MOVE T2,X.RIB+.OPDEV(P1) ;[OK] [C19] [215] [113] FILE EXISTS, GET DEVICE
MOVS T1,FLPARG+.FOFNC ;[N17] GET CHANNEL BACK
ANDI T1,777 ;[N17]
PUSH P,T2 ;[C19] SAVE T2
PUSHJ P,RELCHN ;[C19] RELEASE CHANNEL
POP P,T2 ;[C19] RESTORE T2
POP P,T1 ;[404] RESTORE NEEDED FOR STRUCT FROM 1ST DSKCHR
JUMPE T2,$2 ;[113] LOOKUP FAILED
MOVEM T2,DSKARG+.DCNAM ;[113] STORE UNIT
MOVE T2,[.DCUPN,,DSKARG] ;[113]
DSKCHR T2, ;[113] SEE WHAT OUTPUT IS
JRST $1 ;[113] FAILED
MOVE T2,DSKARG+.DCSNM ;[113] GET STRUCTURE
MOVEM T2,X.OPN+.OPDEV(P1) ;[OK] [215] [113] STORE IT
JRST $T ;[113] NOW NOT GENERIC
$2% SETOM STRARG ;[113] LIST IS STARTED WITH -1
MOVE T2,[3,,STRARG] ;ARG LIST FOR UUO
FOR EACH STRUCTURE UNTIL A MATCH DO
BEGIN
JOBSTR T2, ;GET NEXT STR
JRST $1 ;FAILED, GIVE UP
SKIPE T3,STRARG+.DFJNM
CAMN T3,[-1] ;ENDS WITH 0 OR -1
JRST $1 ;[324]
CAME T1,T3 ;[324] MATCH
JRST $B ;[324] NOT YET
JRST $E ;[324]
$1% POP P,P1 ;[324]
RETURN ;FAILED TO FIND MATCH
END;
JRST $F ;GOT MATCH
ELSE COMPARE STRUCTURE NAMES
CAME T1,DSKARG+.DCSNM ;IF SAME GIVE SKIP RETURN
JRST $1 ;NOT SAME
FI;
AOS -1(P) ;[342] SET SKIP RETURN
MOVEI T1,RSTF ;TO RENAME SOLITARY FILE
$1% POP P,P1 ;[324] GO DO COPY
RETURN
END;
;STILL IN IFE FTFORTRAN
BEGIN
PROCEDURE (PUSHJ P,RSTF)
;RENAME SOLITARY TMP FILE TO BE SORT OUTPUT MASTER
PUSH P,P1 ;[215] SAVE TEMP FOR X. BLOCK
MOVE P1,F.OXBK ;[215] NO FCB FOR IT YET
MOVEI F,TMPFCB
PUSHJ P,GETCHN ;[C19] GET A WORKING CHANNEL
JRST E$$NEH ;[C19] FAILED
HRLS T1 ;[C19] BUILD FILOP. BLOCK, GET CHANNEL
HRRI T1,.FODLT ;[C19] GET DELETE FUNCTION
SKIPE XCHNO. ;[N17] CAN WE USE EXTENDED CHANNELS?
TXO T1,FO.ASC ;[N17] YES, DO SO
MOVEM T1,FLPARG+.FOFNC ;[C19] STORE THEM
HRLI T1,X.OPN(P1) ;[OK] [C19] TRANSFER OPEN BLOCK
HRRI T1,FLPARG+.FOIOS ;[C19] ..
BLT T1,FLPARG+.FOIOS+2 ;[C19] ..
SETZM FLPARG+.FONBF ;[C19] NO BUFFERS
HRRZI T1,X.RIB(P1) ;[OK] [C19] GET LOOKUP BLOCK ADDRESS
MOVE T2,X.DVCH(P1) ;[OK] [215] GET DEVCHR
TXNN T2,DV.DSK ;IS IT A DSK?
ADDI T1,2 ;NO, USE 4 WORD ENTER
MOVEM T1,FLPARG+.FOLEB ;[C19] STORE IT
MOVE T1,[XWD .FOLEB+1,FLPARG] ;[C19] DO DELETE FILOP.
FILOP. T1, ;[C19] ..
JRST $1 ;[C19] FAILED
SETZM X.RIB+.RBALC(P1) ;[OK] [423] CLEAR BEFORE RENAME TRIES TO USE
$1% MOVS T1,FLPARG+.FOFNC ;[N17] GET CHANNEL BACK
ANDI T1,777 ;[N17]
PUSHJ P,RELCHN ;[C19] ..
PUSHJ P,RENOUT ;[C19] RENAME FILE TO OUTPUT FILE NAME
MOVEI F,FCBORG ;[342] FCB IS A FCBORG FOR A RENAME
MOVE T1,INPREC ;FAKE COPY OF FILE
MOVEM T1,FILSIZ(F) ;[342] CONVENTIONAL EOFOUT CALL
POP P,P1 ;[215] RESTORE TEMP
PJRST EOFOUT ;TOP LEVEL RETURN
END;
>;END IFE FTFORTRAN
SUBTTL SET DISK PRIORITY LEVEL
BEGIN
PROCEDURE (PUSHJ P,DSKPRI)
;F HAS PTR TO FCB OF RELEVANT FILE
;PRIORI HAS GLOBAL DSK PRIORITY LEVEL
SKIPN T1,PRIORI
RETURN ;IF 0 LEVEL
HRL T1,FILCHN(F) ;[C19] GET CHANNEL
MOVX T2,<.DUPRI,,T1> ;[C19] SETUP AC
DISK. T2, ;SET DISK PRIORITY LEVEL
NOOP ;IGNORE ERROR RETURN
RETURN
END;