Trailing-Edge
-
PDP-10 Archives
-
AP-D489C-SB
-
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 27-Mar-78
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1975, 1978 BY DIGITAL EQUIPMENT CORPORATION
SALL
IFN FTOPS20,<PRINTX ? SRTSCN should not be present in TOPS-20 SORT/MERGE.>
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 File Number to I/O Channel Mapping Table .......... 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 ....................... 25
; 7.5 SETMTA - Set Up Buffer Sizes for Magtapes ......... 26
; 7.6 Memory Management Routines for TOPS-10 ............ 27
; 8 HIGH SEGMENT ERROR MESSAGES .............................. 30
; 9 I/O ROUTINES
; 9.1 INIINP - Initialize Next Input File ............... 31
; 9.2 INIOUT - Initialize Next Output File .............. 33
; 9.3 RENOUT - Rename Temporary File to Output File ..... 35
; 9.4 Magtape Utility Routines .......................... 36
; 9.5 STAPF - Set Magtape File Parameters ............... 38
; 10 TRY TO RENAME SINGLE TEMP FILE TO OUTPUT FILE ............ 39
; 11 SET DISK PRIORITY LEVEL .................................. 41
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
EXTERN .SWDEC,.SWOCT,.DECNW,.SWCOR,.SIXSW,.SWSIX,.NMUL,.SAVE4
EXTERN .ERMSG,.TOCTW,.TDECW,.TSTRG,.TSIXN,.TOLEB,.TCORW,.TRBRK,.TCRLF,.TCHAR,.TTIME
;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.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 -- File Number to I/O Channel Mapping Table
SEGMENT LOW
CHNMAP:
;ONE WORD PER CHANNEL ALLOWED
;LHS = CHANNEL # IN ACC FIELD (FOR I/O INST)
;RHS = CHANNEL # (FOR FILOP. UUO)
IFE FTFORTRAN,<
ZZ==1
REPEAT MX.TMP+1,<
Z ZZ&17,ZZ&17
ZZ==ZZ+1
>
PURGE ZZ
>
IFN FTFORTRAN,<
BLOCK MX.TMP+1
>
SUBTTL RESTART CODE
SEGMENT LOW
IFE FTFORTRAN,<
BEGIN
PROCEDURE (,RSTART)
SKIPA T1,.+1
1,,RUNCOR+1
CORE T1, ;GET RID OF ALL WE DON'T NEED
NOOP
MOVE T1,HISIZE
ADDM T1,RUNCOR ;THIS IS HOW MONITOR ACTUALLY WORKS
MOVS T1,OFFSET ;RUN UUO OFFSET
HRRI T1,RUNDEV ;ARG BLOCK
SETZM RUNEXT ;USE DEFAULT
RUN T1,
HALT
END;
BEGIN
PROCEDURE (,GETSCN) ;GET HIGH SEG SCANNER AGAIN
0 ;STORE PC
IFN FTDEBUG,<
MOVE T1,MODEM ;GET RM.FPA FLAG
TXNE T1,RM.FPA ;DO WE NEED TO GET FOROTS?
JRST $1 ;YES
SKIPE .JBDDT## ;DDT LOADED?
JRSTF @GETSCN ;WE STILL HAVE IT
$1%
>
MOVEI T1,RUNDEV ;GET ARG LIST
GETSEG T1,
HALT ;FAILED
JRSTF @GETSCN ;RETURN
END;
RUNDEV: BLOCK 1 ;DEVICE
RUNNAM: BLOCK 1 ;NAME
RUNEXT: EXP 0 ;EXTENSION
EXP 0
RUNDIR: BLOCK 1 ;DIRECTORY
RUNCOR: BLOCK 1 ;CORE ASSIGNMENT
RUNPTH: EXP 0 ;NOT USED (BUT MUST BE ALLOCATED)
EXP 0
RUNPPN: BLOCK 1 ;PPN
RUNSFD: BLOCK 5 ;SFD LIST
EXP 0 ;TERMINATOR
SEGMENT HIGH
SUBTTL SCAN INTERFACE -- Interface Procedure
;STILL IN IFE FTFORTRAN
BEGIN
PROCEDURE (PUSHJ P,SCAN) ;SCAN INTERFACE
MOVE T1,.TSBLK ;DATA BLOCK FOR TSCAN
PUSHJ P,.TSCAN## ;SCAN A LINE
PUSHJ P,CLRFIL ;SEE IF ANY DEFAULTS TO SETUP
MOVE T1,.OSBLK ;DATA FOR OSCAN
PUSHJ P,.OSCAN## ;READ SWITCH.INI
RETURN
END;
;SCAN ARG BLOCKS
.ISBLK: 3,,.+1
1 ;[114] FORCE A RESCAN
OFFSET,,'SRT'
0
.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
BEGIN
PROCEDURE (,REINIT)
HLRZ T1,.JBSA## ;GET ORIGINAL JOBFF
HRL T1,T1
HRRZM T1,.JBFF## ;RESTORE ORIGINAL VALUE
SETZM (T1)
ADDI T1,1 ;BUILD BLT PTR
BLT T1,@.JBREL## ;CLEAR JUNK
JRST START ;TRY AGAIN
END;
SUBTTL SCAN INTERFACE -- Switch Table
;STILL IN IFE FTFORTRAN
DEFINE SWTCHS<
SN ALIGN,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 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
IFN FTCOL,<
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,.SWOCT,ERR,FS.NFS!FS.NUE
SP FATAL,FERCOD,.SWOCT,FEC,FS.NFS!FS.NUE
SS *FIXED,F.VARI,0,FS.NFS!FS.NUE
SP FORMAT,F.FMT,.SWASF,FMT,FS.NFS
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,LEA,FS.NUE!FS.NFS
SS *MERGE,MRGSW,1,FS.NUE!FS.NFS
SS *NUMERIC,<POINTR (MODE,RM.NUM)>,1,FS.NFS!FS.NUE
SS PACKED,<POINTR (MODE,RM.PAC)>,1,FS.NFS!FS.NUE
SP PRIORITY,PRIORI,.SWDEC,PRI,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
SL SUPPRESS,SUPFLG,SUP,SUPNONE,FS.NFS!FS.NUE
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 PRI,0,0,0
DM KEY,377777,0,0
DM COR,377777,0,0
DM BLK,377777,0,0
DM FMT,0,0,0
IFN FTCOL,<
DM COL,0,0,0
>
DM LEA,0,0,0
DM ERR,0,0,0
DM FEC,0,0,0
;STILL IN IFE FTFORTRAN
XALL
DOSCAN (SRTSW)
SALL
IF2,<PURGE ..TEMP,..TEMR>
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) ;[212] ZERO POINTER TO NEXT BLOCK
MOVE T2,F.OUZR ;PREVIOUS BLOCK (OR 0)
MOVEM T2,0(T1) ;LINK
MOVEM T1,F.OUZR ;NEW BLOCK
HRLZI T2,F.SPC+1 ;SWITCHES
HRRI T2,1(T1) ;BLT PTR
MOVEI T1,S.DEV(T1) ;END OF BLT + 1
BLT T2,-1(T1) ;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) ;[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) ;GET POINTER TO NEXT
TLNN T2,-1 ;IS THERE A NEXT?
JRST $2 ;NO
HLRZ T2,T2 ;COPY IT
JRST $1 ;TRY AGAIN
$2% MOVEM T1,(T2) ;LINK IN
JRST $F
ELSE LINK INTO INPUT CHAIN AT FRONT
MOVE T2,F.INZR ;PREVIOUS BLOCK (OR 0)
MOVEM T2,0(T1) ;LINK
MOVEM T1,F.INZR ;NEW BLOCK
FI;
HRLZI T2,F.SPC+1 ;SWITCHES
HRRI T2,1(T1) ;BLT PTR
MOVEI T1,S.DEV(T1) ;END OF BLT + 1
BLT T2,-1(T1) ;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
IFN FTCOL,<
CAIN T1,COLSW ;WAS IT /COLLATE:
JRST USRCOL ;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;
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) ;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
MOVEM T1,@LSTKEY ;CHAIN INTO LIST
FI;
MOVEM T1,LSTKEY ;POINT TO NEW END
SETZM KY.NXT(T1) ;CLEAR FORWARD POINTER
SOJL N,E$$KOR ;CHECK FOR INVALID RELATIVE TO 0
MOVEM N,KY.INI(T1) ;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) ;STORE LENGTH
MOVX T2,RM.ASC!RM.SIX!RM.EBC!RM.BIN
ANDM T2,MODE ;ONLY BITS WE CARE ABOUT
SETZM KY.ORD(T1) ;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) ;CHANGE TO DESCENDING
RETURN
END;
>;END IFE FTFORTRAN
SUBTTL SCAN INTERFACE -- Switch Handling -- /COLLATE:x[:y]
IFN FTCOL,<
IFE FTFORTRAN,<
BEGIN
PROCEDURE (PUSHJ P,USRCOL)
SKIPE COLSW ;HERE BEFORE
JRST E$$MCS ;YES, HERE BEFORE ONLY ONE ALT SEQ ALLOWED
MOVEM N,COLSW ;STORE THE INDEX
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.
SETZM COLITB ;SAFE PLACE TO STORE FILE SPEC
MOVE T1,[COLITB,,COLITB+1]
BLT T1,COLITB+S.LEN
PUSHJ P,.SWSIX ;GET THE DEVICE NAME
CAIE C,":" ;DEVICE NAME
JRST $1 ;NO, MUST BE A FILE NAME
MOVEM N,S.DEV+COLITB ;YES, STORE THE DEVICE NAME
PUSHJ P,.SWSIX ;GET THE FILE NAME
$1% MOVEM N,S.NAME+COLITB ;STORE THE FILE NAME
CAIE C,"." ;EXTENSION
JRST $2 ;NO
PUSHJ P,.SWSIX ;YES, GET THE EXTENSION
HLLZM N,S.EXT+COLITB ;STORE THE EXTENSION
$2% RETURN
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 ;GUARENTEE A NUL AT THE END
RETURN
END;
>;END IFE FTFORTRAN
;STILL IN IFN FTCOL
BEGIN
PROCEDURE (PUSHJ P,COLTRX)
MOVE T2,CHNMAP ;USE FIRST FREE CHANNEL
HLLZM T2,COLCHN ;STORE THE CHANNEL
MOVEI T1,.IODPR ;DUMP MODE INPUT
SKIPN T2,S.DEV+COLITB ;DEVICE NAME
MOVSI T2,'DSK' ;DEFAULT DEVICE NAME
SETZB T3,T4 ;
MOVE S,COLCHN ;GET THE CHANNEL NUMBER
IOR S,[OPEN 0,T1]
XCT S ;OPEN THE UNIT
JRST E$$CFA ;COLLATING SEQ FILE NOT AVAILABLE
MOVE T1,S.NAME+COLITB ;GET THE FILE NAME
HLLZ T2,S.EXT+COLITB ;GET THE EXTENSIO
SETZ T3, ;CLEAR DATE ETC
MOVE T4,S.DIR+COLITB ;GET THE PPN
MOVE S,COLCHN ;GET THE CHANNEL
IOR S,[LOOKUP 0,T1] ;GET LOOKUP
XCT S ;LOOK IT UP
JRST E$$CFA ;NO SUCH FILE
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
MOVEI T1,COLBUF ;GET THE ALT SEQ TABLE
MOVEM T1,COLSW ;STORE THE ADDRESS OF THE TABLE
MOVEI T2,COLCHR ;ADDRESS OF THE INPUT ROUTINE
PUSHJ P,BLDCOL ;BUILD THE TABLE
JRST E$$ICS ;ILLEGAL COLLATING SEQUENCE SPECIFIED
MOVE S,COLCHN ;GET THE CHANNEL NUMBER
TXO S,RELEASE
XCT S
RETURN
END;
;STILL IN IFN FTCOL
BEGIN
PROCEDURE (PUSHJ P,COLCHR)
SOSGE COLPTR+3 ;REDUCE THE BYTE COUNT
JRST $1 ;GET A BUFFER
MOVE T1,@COLPTR+2 ;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
ILDB T1,COLPTR+2 ;GET A BYTE
CAIG T1," " ;IGNORE SPACE AND ALL CONTROL CHARACTERS
JRST $B ;GET THE NEXT CHARACTER
AOS (P) ;SKIP RETURN
POPJ P, ;RETURN T1=CHAR
$1% MOVE S,COLCHN ;GET THE CHANNEL NUMBER
IOR S,[IN 0,COLPTR]
XCT S
FASTSKIP ;OK ON THE READ
RETURN ;ASSUME AN EOF
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;
>;END IFN FTCOL
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
$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 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 MX.TMP FROM LIST
MOVSI T2,-MX.TMP ;AOBJN PTR
$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) ;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
SKIPN U,(U) ;GET NEXT
JRST $F ;ALL DONE
AOBJN T2,$1 ;LOOP UNLESS TOO MANY
PUSHJ P,E$$TMT ;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
HRLI U,F.OUZR
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
HRLI U,F.INZR
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 LIST HEAD>,,<ADDR OF FIRST BLOCK>
FOR ALL INPUT FILES DO
BEGIN
TRNN U,-1 ;[214] AT END?
JRST $E ;[214] YES--QUIT
MOVE T1,S.MOD(U) ;[214] DEVICE NOT SPECIFIED?
TXNE T1,FX.NDV ;[214] ..
SKIPE S.NAME(U) ;[214] OR NO FILE NAME?
JRST $1 ;NO, OK
MOVE T1,S.SPC(U) ;GET NEXT
MOVS U,U ;GET PREVIOUS AND REMEMBER IT
MOVEM T1,S.SPC(U) ;FORGET ABOUT THIS
$1% HRL U,S.SPC(U) ;GET NEXT
MOVS U,U
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, CHECKING FOR VARIOUS FILE-SPECIFIC PARAMETERS, FULL FILE PATHS, ETC.
;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.
HRRZ P2,IOMODE ;[201,215] FIGURE OUT I/O MODE
MOVE P2,[EXP .IOBIN,.IOASC,.IOBIN,.IOBIN]-1(P2) ;[201,205] ..
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) ;[215] ..
MOVEM T1,F.OUZR ;[215] ..
MOVE T3,S.DEV(U) ;[215] REMEMBER DEVICE
MOVEM T3,OM.DEV(T1) ;[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
MOVE U,S.SPC(U) ;[215] ADVANCE TO NEXT SPEC
JRST $B ;[215] CONTINUE
END;
;EXIT WITH:
; U/ POINTER TO FIRST S. BLOCK
; T3/ DEVCHR WORD FOR THAT DEVICE
; ..
; ..
;CONTINUE WITH:
; U/ POINTER TO FIRST S. BLOCK
; T3/ DEVCHR WORD FOR THAT DEVICE
PUSH P,T3 ;SAVE DEVCHR OVER CALL TO GETSPC
MOVX T1,LN.X ;[215] ALLOCATE AN X. BLOCK FOR OUTPUT
PUSHJ P,GETSPC ;[215] ..
JRST E$$NEC ;FAILED
MOVE P1,T1 ;[215] SAVE IN SAFE PLACE
MOVE T1,F.OUZR ;[215] LINK TO FRONT OF DEVICE LIST
MOVEM T1,X.NXT(P1) ;[215] ..
MOVEM P1,F.OXBK ;[215] ..
POP P,T3 ;RESTORE DEVCHR WORD
MOVEM T3,X.DVCH(P1) ;SAVE FOR LATER REFERENCE
MOVE T1,S.MOD(U) ;[215] GET SCAN'S MODE WORD
LDB T2,[POINTR (T1,FX.DEN)] ;[215] GET DENSITY FOR TAPE
MOVEM T2,X.DEN(P1) ;[215] SAVE FOR TAPOP. IN INIINP
LSH T2,^D35-<POS (IO.DEN)> ;[215] PUT IN POSITION FOR OPEN UUO
ANDX T2,IO.DEN ;[215] CLEAR 1600, 6250 BITS
TXNE T1,FX.PHY ;[215] /PHYSICAL TYPED?
TXO T2,UU.PHS ;[215] YES--SET PHONLY BIT
TXNE T1,FX.PAR ;[215] /PARITY:EVEN TYPED?
TXO T2,IO.PAR ;[215] YES--PRESERVE IN OPEN BLOCK
OR T2,P2 ;[215] INCLUDE DATA MODE
TXO T2,UU.IBC ;[215] ALSO INHIBIT BUFFER CLEAR
MOVEM T2,X.OPN+.OPMOD(P1) ;[215] STORE IN OPEN BLOCK
MOVE T2,S.DEV(U) ;GET DEVICE
MOVEM T2,X.OPN+.OPDEV(P1) ;[215] ..
IFE FTFORTRAN,<
IF WE HAVE A MAGTAPE
CAXE T3,DVCHNL ;[215] IF NUL:, NOT A MAGTAPE
TXNN T3,DV.MTA ;[215] NOW CHECK IF REALLY A TAPE
JRST $T ;[215] NO
THEN COMPUTE BLOCKING FACTOR
PUSHJ P,SETMTA ;[215] GO FIND BLOCKING FACTOR
FASTSKIP ;[215] NOT BLOCKED
JRST $F ;[215] BLOCKED--BUFFER SIZE IN T2
ELSE ASK MONITOR FOR DEFAULT
>
MOVEI T2,X.OPN(P1) ;[215] SET UP FOR DEVSIZ
DEVSIZ T2, ;[215] FIND OUT DEFAULT
MOVEI T2,.TBS ;[215] NONE--USE DISK'S
IFE FTFORTRAN,<
FI;
>
HRRZM T2,X.DVSZ(P1) ;[215] BUFFER SIZE
HRRZ T2,T2
CAMLE T2,MXDVSZ ;[215] BIGGEST YET?
MOVEM T2,MXDVSZ ;[215] YES
; ..
; ..
MOVX T2,.RBDEV ;[215] INITIALIZE LOOKUP BLOCK
MOVEM T2,X.RIB+.RBCNT(P1) ;[215] ..
MOVE T2,S.NAME(U) ;GET NAME
MOVEM T2,X.RIB+.RBNAM(P1) ;[215] ..
DMOVE T2,S.EXT(U) ;[115] GET EXTENSION & MOD WORD
HLLZM T2,X.RIB+.RBEXT(P1) ;[215] STORE EXTENSION
MOVE T2,S.DIR(U)
IF A DIRECTORY WITH SFD'S WAS SPECIFIED
TXNN T3,FX.DIR ;[115] DIRECTORY SPECIFIED
JRST $F ;[115,215] NO OR [-], USE 0
TLNN T2,-1 ;[115] CHECK FOR [,]
HLL T2,MYPPN ;[115] FILL IN LHS
TRNN T2,-1 ;[115]
HRR T2,MYPPN ;[115] FILL IN RHS
SKIPN S.SFD(U) ;SFD SPECIFIED?
JRST $F ;[215] NO
THEN COPY THEM AND SET UP PATH. BLOCK FOR ENTER
MOVEM T2,X.PTH+.PTPPN(P1) ;[215] STORE PATH POINTER
HRLZI T3,-.FXLND ;[215] SET UP AOBJN TO COPY SFDS
HRRI T3,X.PTH+.PTSFD(P1) ;[215] ..
MOVEI T4,S.SFD(U) ;[215] AND POINTER TO SFD'S
WHILE SFD'S TO COPY
BEGIN
MOVE T2,(T4) ;[215] FETCH AN SFD NAME
MOVEM T2,(T3) ;[215] STORE IN PATH. BLOCK
ADDI T4,2 ;[215] SKIP SFD AND MASK
AOBJN T3,$B ;[215] LOOP 'TIL DONE
END;
MOVEI T2,X.PTH(P1) ;[215] STORE PATH. POINTER INSTEAD OF PPN
FI;
MOVEM T2,X.RIB+.RBPPN(P1) ;[215] STORE POINTER OR PPN
MOVE T2,S.PROT(U) ;GET PROTECTION FIELD
LSH T2,<ALIGN. (RB.PRV)> ;[215] IN PROPER PLACE
MOVEM T2,X.RIB+.RBPRV(P1) ;[215] STORE PROT, CLEAR DATES
SETZM X.RIB+.RBSIZ(P1) ;[215] CLEAR INITIAL FILE SIZE
IF USER GAVE A USEFUL /ESTIMATE
SKIPG T2,S.EST(U)
JRST $F ;[215] NOT SPECIFIED
THEN TURN INTO BLOCKS FOR ENTER
ADDI T2,177 ;ROUND UP
LSH T2,-<POW2(200)> ;IN BLOCKS
MOVEM T2,X.RIB+.RBEST(P1) ;[215] SAVE FOR ENTER
FI;
SETCM T2,S.VER(U)
SKIPE T2 ;IGNORE IF -1 (SCAN DEFAULT)
SETCAM T2,X.RIB+.RBVER(P1) ;[215] STORE ORIGINAL IN MEMORY
; ..
; ..
SKIPGE T2,S.BLKF(U) ;[215] BLOCKING FACTOR SET?
MOVE T2,P.BLKF ;[215] NO--USE STICKY DEFAULT
SKIPGE T2 ;[215] STILL NOT SET?
SETZ T2, ;[215] NO--ASSUME NO BLOCKING FACTOR
MOVEM T2,X.BLKF(P1) ;[215] STORE RESULT
SKIPGE T2,S.LABL(U) ;[215] LABEL TYPE SET?
MOVE T2,P.LABL ;[215] NO--USE STICKY DEFAULT
SKIPGE T2 ;[215] STILL NOT SET?
MOVX T2,LABSTANDARD ;[215] YES--ASSUME ONE
MOVEM T2,X.LABL(P1) ;[215] STORE RESULT
SKIPGE T2,S.VARI(U) ;VARIABLE RECORD SIZE?
MOVE T2,P.VARF ;GET DEFAULT
SKIPG T2 ;DO WE WANT VARIABLE?
TDZA T1,T1 ;NO
MOVX T1,FI.VAR ;YES
SKIPGE T2,S.INDU(U) ;INDUSTRY STANDARD MODE?
MOVE T2,P.INDU ;OR BY DEFAULT
SKIPLE T2
TXO T1,FI.IND ;YES
SKIPGE T2,S.STDA(U) ;STANDARD ASCII MODE?
MOVE T2,P.STDA ;OR BY DEFAULT
SKIPLE T2
TXO T1,FI.STA ;YES
SKIPLE S.REW(U) ;REWIND?
TXO T1,FI.REW
SKIPLE S.UNL(U) ;UNLOAD?
TXO T1,FI.UNL
MOVEM T1,X.FLG(P1) ;[215] STORE FLAG BITS
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. MOST OF THE WORK IS STRAIGHT-FORWARD, CONVERTING A SCAN
;BLOCK TO OPEN AND LOOKUP BLOCKS. 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.
HRRZ P2,IOMODE ;[201,205] FIGURE OUT I/O MODE
MOVE P2,[EXP .IOBIN,.IOASC,.IOBIN,.IOBIN]-1(P2) ;[201,205] ..
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
MOVEI T1,LN.X ;SPACE WE NEED
PUSHJ P,GETSPC ;GET IT
JRST E$$NEC ;FAILED
MOVE P1,T1 ;SAFE PLACE TO PUT IT
MOVE T1,S.MOD(U) ;[215] GET SCAN'S MODE WORD
LDB T2,[POINTR (T1,FX.DEN)] ;[215] GET DENSITY FOR TAPE
MOVEM T2,X.DEN(P1) ;[215] SAVE FOR TAPOP. IN INIINP
LSH T2,^D35-<POS (IO.DEN)> ;[215] PUT IN POSITION FOR OPEN UUO
ANDX T2,IO.DEN ;[215] CLEAR 1600, 6250 BITS
TXNE T1,FX.PHY ;[215] /PHYSICAL TYPED?
TXO T2,UU.PHS ;[215] YES--SET PHONLY BIT
TXNE T1,FX.PAR ;[215] /PARITY:EVEN TYPED?
TXO T2,IO.PAR ;[215] YES--PRESERVE IN OPEN BLOCK
OR T2,P2 ;[215] INCLUDE DATA MODE
MOVEM T2,X.OPN+.OPMOD(P1) ;[215] STORE IN OPEN BLOCK
MOVE T2,S.DEV(U) ;GET DEVICE
MOVEM T2,X.OPN+.OPDEV(P1) ;[215] ..
DEVCHR T2,
JUMPE T2,E$$DNE ;NON-EXISTENT DEVICE
TXZ T2,DVCHMD ;[215] CLEAR I/O MODE BITS
MOVEM T2,X.DVCH(P1) ;[215] SAVE CHARACTERISTICS
IFE FTFORTRAN,<
IF WE HAVE A MAGTAPE
CAXE T2,DVCHNL ;[215] IF NUL:, NOT A MAGTAPE
TXNN T2,DV.MTA ;[215] NOW CHECK IF REALLY A TAPE
JRST $T ;[215] NO
THEN COMPUTE BLOCKING FACTOR
PUSHJ P,SETMTA ;[215] GO FIND BLOCKING FACTOR
FASTSKIP ;[215] NOT BLOCKED
JRST $F ;[215] BLOCKED--BUFFER SIZE IN T2
ELSE ASK MONITOR FOR DEFAULT
>
MOVEI T2,X.OPN(P1) ;[215] SET UP FOR DEVSIZ
DEVSIZ T2, ;[215] FIND OUT DEFAULT
MOVEI T2,.TBS ;[215] NONE--USE DISK'S
IFE FTFORTRAN,< ;[215] BACK TO IFE FTFORTRAN
FI;
>
HRRZM T2,X.DVSZ(P1) ;[215] BUFFER SIZE
HRRZ T2,T2
CAMLE T2,MXDVSZ ;[215] BIGGEST YET?
MOVEM T2,MXDVSZ ;[215] YES
MOVX T2,.RBDEV ;[215] INITIALIZE LOOKUP BLOCK
MOVEM T2,X.RIB+.RBCNT(P1) ;[215] ..
SKIPE T2,S.NAME(U) ;GET NAME
JRST $5 ;OK NAME
MOVE T3,X.DVCH(P1) ;GET DEVCHR AGAIN
CAXE T3,DVCHNL ;[215] IF NUL:, WE'RE OK
TXNN T3,DV.DSK!DV.DTA ;[215] ELSE MUST BE DIRECTORY DEVICE
JRST $5 ;ASSUME USERS KNOWS WHAT HE'S DOING
$ERROR (%,NFS,<Null file specified>)
MOVE U,(U) ;IGNORE IT
JRST $B
$5% MOVEM T2,X.RIB+.RBNAM(P1) ;[215] STORE FILE NAME
DMOVE T2,S.EXT(U) ;GET EXTENSION & MOD WORD
HLLZM T2,X.RIB+.RBEXT(P1) ;[215] JUST SAVE EXTENSION
MOVE T2,S.DIR(U) ;PPN
IF A DIRECTORY WITH SFD'S WAS SPECIFIED
TXNN T3,FX.DIR ;[115] DIRECTORY SPECIFIED
JRST $F ;[115,215] NO OR [-], USE 0
TLNN T2,-1 ;[115] CHECK FOR [,]
HLL T2,MYPPN ;[115] FILL IN LHS
TRNN T2,-1 ;[115]
HRR T2,MYPPN ;[115] FILL IN RHS
SKIPN S.SFD(U) ;SFD SPECIFIED?
JRST $F ;NO
THEN COPY THEM AND SET UP PATH. BLOCK FOR ENTER
MOVEM T2,X.PTH+.PTPPN(P1) ;[215] STORE PATH POINTER
HRLZI T3,-.FXLND ;MAX. NO. OF SFDS
HRRI T3,X.PTH+.PTSFD(P1) ;[215] POINT TO FIRST
MOVEI T4,S.SFD(U) ;POINT TO FIRST ONE
WHILE SFD'S TO COPY
BEGIN
MOVE T2,(T4) ;[215] GET IT
MOVEM T2,(T3) ;STORE IT
ADDI T4,2 ;ADVANCE
AOBJN T3,$B ;[215] LOOP
END;
MOVEI T2,X.PTH(P1) ;[215] STORE PATH. POINTER INSTEAD OF PPN
FI;
MOVEM T2,X.RIB+.RBPPN(P1) ;[215] STORE POINTER OR PPN
SKIPGE T2,S.BLKF(U) ;[215] BLOCKING FACTOR SET?
MOVE T2,P.BLKF ;[215] NO--USE STICKY DEFAULT
SKIPGE T2 ;[215] STILL NOT SET?
SETZ T2, ;[215] NO--ASSUME NO BLOCKING FACTOR
MOVEM T2,X.BLKF(P1) ;[215] STORE RESULT
SKIPGE T2,S.LABL(U) ;[215] LABEL TYPE SET?
MOVE T2,P.LABL ;[215] NO--USE STICKY DEFAULT
SKIPGE T2 ;[215] STILL NOT SET?
MOVX T2,LABSTANDARD ;[215] YES--ASSUME ONE
MOVEM T2,X.LABL(P1) ;[215] STORE RESULT
SKIPGE T2,S.VARI(U) ;VARIABLE?
MOVE T2,P.VARF ;OR DEFAULT
SKIPG T2
TDZA T3,T3 ;NO
MOVX T3,FI.VAR ;YES
SKIPGE T2,S.INDU(U) ;INDUSTRY COMPATIBLE MODE
MOVE T2,P.INDU
SKIPLE T2
TXO T3,FI.IND ;YES
SKIPGE T2,S.STDA(U) ;STANDARD ASCII MODE
MOVE T2,P.STDA
SKIPLE T2
TXO T3,FI.STA ;YES
SKIPLE S.REW(U) ;REWIND?
TXO T1,FI.REW
SKIPLE S.UNL(U) ;UNLOAD?
TXO T1,FI.UNL
MOVEM T3,X.FLG(P1) ;SAVE FLAG SETTINGS
MOVE T2,F.INZR ;GET PREVIOUS
MOVEM T2,X.NXT(P1)
MOVEM P1,F.INZR ;SAVE THIS
SKIPE U,(U) ;GET NEXT BLOCK
JRST $B ;TRY NEXT
END;
RETURN ;[215] END OF INPUT LIST
END;
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
SKIPGE T1,S.BLKF(U) ;FILE BLOCKED?
JRST $F ;NO
THEN
HRRZ T2,IOMODE ;[201] GET I/O MODE
CAIE T2,MODEBCDIC ;MTA AND EBCDIC IS SPECIAL
JUMPE T1,$F ;OTHERWISE BLOCK:0 IS UNBLOCKED
CASE MODE OF SIXBIT,ASCII,EBCDIC,BINARY
JRST @[EXP $1,$2,$3,$4]-1(T2)
$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
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
IMUL T2,S.BLKF(U) ;TOTAL IN CHARS
ADDI T2,3 ;FOR OVERFLOW
IDIVI T2,4 ;NO. OF WORDS
JRST $C ;ADD IN HEADER WORDS
$4% SKIPN T1 ;BLOCKED 0?
AOS S.BLKF(U) ;YES, MAKE IT BLOCKED 1
MOVE T2,RECSIZ ;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 DID NOT SPECIFY /CORE
SKIPLE CORSIZ ;DID USER SPECIFY /CORE:N?
JRST $F ;YES
THEN
IF USER SAID RUN SORT NK
MOVE J,RUNCOR ;NO, BUT MAYBE RUN SORT nK?
CAME J,.JBREL ;IF SO WAS IT ENOUGH FOR SCAN PHASE?
JRST $F ;NO
THEN
HLRZ T1,.JBHRL ;GET HIGH SEG LENGTH
SKIPE T1 ;IGNORE IF NO HIGH SEGMENT?
IFN FTDEBUG,<
SKIPE .JBDDT ;DDT LOADED?
SETZ T1, ;YES, HIGH SEG STAYS
>
ADDI J,1(T1) ;INCREMENT LOW SEG SIZE BY HIGH SEG
MOVEM J,CORSIZ ;SAVE IT
FI;
FI;
IF EITHER /CORE OR RUN SORT NK
SKIPG J,CORSIZ ;SIZE SPECIFIED
JRST $T ;NO
THEN
CAIGE J,1000 ;YES, BUT MAKE SURE REASONABLE
LSH J,POW2(2000) ;CONVERT NUMBER TO K
JRST $F
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
PJRST SETSIZ ;SET CORE SIZE, GO TO LOW SEG
END;
BEGIN
PROCEDURE (PUSHJ P,SMALL)
MOVE P1,F.INZR ;GET FIRST INPUT FILE
MOVE T1,X.DVCH(P1) ;GET DEVCHR BITS
TXNE T1,DV.DSK ;IS IT A DSK?
SKIPE X.NXT(P1) ;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) ;COPY BLOCK
MOVX T1,.IODMP
IORM T1,X.OPN(P1) ;SET DUMP MODE
OPEN 0,X.OPN(P1) ;CHAN 0 IS FREE
JRST $1 ;TOO BAD
LOOKUP 0,X.RIB(P1) ;LOOKUP FILE
JRST $1 ;TOO BAD
MOVE T1,X.RIB+.RBSIZ(P1) ;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
IDIVI T1,(T3) ;NO. OF RECORDS
IMULI T1,3 ;MULTIPLY BY 1.5 TO GIVE
LSH T1,-1 ; 50% FUDGE FACTOR
CAIGE T1,^D16 ;GUARENTEE A MINIMUM
MOVEI T1,^D16 ;IN CASE USER IS CONFUSED
CAML T1,NUMRCB ;LESS THAN WE ALLOWED FOR?
JRST $1 ;NO
EXCH T1,NUMRCB ;STORE BACK
SUB T1,NUMRCB ;GET DIFFERENCE
MOVE T3,RECSIZ ;FIXED SIZE IN CORE
IMULI T1,RN.LEN(T3) ;GET SIZE OF IN CORE RECORDS
SUB J,T1 ;REDUCE REQUIRED SIZE
MOVE T2,X.RIB+.RBSIZ(P1)
IDIVI T2,.TBS ;SEE HOW MANY BUFFERS WE ACTUALLY NEED
SKIPE T3
ADDI T2,1
CAIGE T2,2 ;AT LEAST DOUBLE
MOVEI T2,2
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
SKIPLE T2 ;IF MAKING SMALLER
SUB J,T2 ;REDUCE SIZE
$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
SUB J,T2 ;REDUCE SIZE
IORI J,1777 ;ROUND UP TO NEXT K
$1% RELEASE 0,
MOVEI T1,LN.X ;GIVE BACK SPACE
PUSHJ P,FRESPC ;TO POOL
IFN FTFORTRAN,<
PUSHJ P,CUTBAK ;INCASE WE EXPANDED
>
RETURN
END;
IFE FTFORTRAN,<
BEGIN
PROCEDURE (PUSHJ P,SETSIZ)
;SET SIZE OF JOB, DO CORE UUO
SKIPLE CORSIZ ;DID WE GET SIZE BY DEFAULT?
JRST $1 ;NO
$ERROR ([,XPN,<Expanding to >,+)
MOVE T1,J
ADDI T1,1 ;INCASE 256K
$MORE (CORE,T1)
IFN FTDEBUG,<
SKIPN .JBDDT## ;DDT LOADED?
JRST $4 ;NO
$CHAR "+"
SKIPE T1,HISIZE ;GET HIGH SEGMENT SIZE
$MORE (CORE,T1)
>
$4% $CRLF
$1%
IFN FTDEBUG,<
SKIPE .JBDDT## ;IS DDT LOADED
JRST $3 ;YES, KEEP HI-SEG
>
MOVEI T1,RSTART
HRRM T1,.JBSA## ;SO WE CAN RESTART
MOVSI T1,1 ;TO GET RID OF HIGH SEGMENT
JRST $2 ;FROM LOW SEGMENT
;LOW SEGMENT INTERFACE
SEGMENT LOW
$2% CORE T1, ;REMOVE HIGH SEGMENT
JFCL ;SHOULD NEVER FAIL
$3% MOVE T1,MODEM ;GETSEG FOROTS?
TXNN T1,RM.FPA ;FORTRAN FLOATING-PT ASCII?
JRST $5 ;NO
PUSH P,J ;SAVE J
MOVEM P,PSAV
MOVEI T1,$9 ;GETSEG ARG BLOCK
GETSEG T1, ;GET FOROTS FROM SYS
JRST ERRGFF ;OOPS
MOVE P,PSAV
POP P,J ;RESTORE J
$5% CORE J, ;EXPAND LOW SEGMENT
JRST E$$NEC ;FAILED
PJRST PSORT% ;JOIN COMMON CODE
$9% SIXBIT /SYS/ ;WHERE TO FIND FOROTS
SIXBIT /FOROTS/
EXP 0,0,0,0
ERRGFF: MOVE P,PSAV ;RESTORE P
$ERROR (?,GFF,<GETSEG for FOROTS failed>)
END;
SEGMENT HIGH
>;END IFE FORTRAN
SUBTTL HIGH 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.>)
SEGMENT LOW
SUBTTL I/O ROUTINES -- INIINP - Initialize Next Input File
BEGIN
PROCEDURE (PUSHJ P,INIINP) ;INITIALIZE NEXT INPUT FILE
;ENTER WITH:
; F/ <CHNMAP INDEX>,,<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
HLRZ T3,F ;GET INDEX
MOVE T1,X.BLKF(P1) ;[215] GET BLOCKING FACTOR
HRRZM T1,FILBLK(F) ;STORE AS AOBJN WORD (TO FAIL FIRST TIME)
MOVE T1,X.FLG(P1) ;[215] GET FILE FLAGS
MOVEM T1,FILFLG(F) ;SET IN FCB
MOVEI T1,FILHDR(F)
HRRZM T1,X.OPN+.OPBUF(P1) ;[215] SETUP INPUT BUFFER PTR
HLLZ T1,CHNMAP(T3) ;GET ACTUAL CH #
MOVE T2,FILHDR(F) ;PRESERVE BUFFER RING HEADER
ADD T1,[OPEN X.OPN(P1)] ;[215] COMPLETE INSTRUCTION
XCT T1 ;OPEN DEVICE
JRST ERROFF ;OPEN FAILED
HRLI T2,(BF.VBR) ;RING NOT YET REFERENCED
MOVEM T2,FILHDR(F) ;RESTORE RNG HEADER
TLC T1,(<OPEN>^!<LOOKUP>)
HRRI T1,X.RIB ;[215] FORM LOOKUP UUO
MOVE T2,X.DVCH(P1) ;[215] GET DEVCHR UUO
TXNN T2,DV.DSK ;DSK?
ADDI T1,2 ;NO
XCT T1 ;LOOKUP FILE
JRST E$$FLE ;LOOKUP ERROR
MOVE P2,IBUFNO ;[215] SET UP CALL TO BUFRNG
IF BUFFERS HAVE ALREADY BEEN SET UP
SKIPL BUFALC ;[215] SET IN RELES. AND GETMRG WHEN FIRST
JRST $T ;[215] PASS OF BUFFERS HAVE BEEN SET UP
THEN USE SAME BUFFER AREA AGAIN
MOVE T1,FILBUF(F) ;[215] POINTER TO BEGINNING OF BUFF AREA
MOVEM T1,BUFPTR ;[215] TELL BUFRNG TO START THERE
PUSHJ P,BUFRNG ;[215] BUILD NEW BUFFERS, SAME AREA
JRST $F
ELSE ALLOCATE MAXIMUM BUFFER AREA FOR WORST CASE
PUSHJ P,BUFRNG ;[215] ALLOCATE AT CURRENT BUFPTR
MOVE T1,IBUFNO ;[215] INCREMENT BUFPTR BY
IMUL T1,MXDVSZ ;[215] WORST CASE SIZE
ADD T1,FILBUF(F) ;[215] IN CASE WE NEED IT
MOVEM T1,BUFPTR ;[215] ..
FI;
; ..
; ..
IF I/O MODE IS EBCDIC
HRRZ T2,IOMODE ;[201,215] CHECK FILE'S MODE
CAXE T2,MODEBCDIC ;[201,215] 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) ;[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.)
MOVE T4,FILFLG(F) ;[215] GET FLAG BITS
TXNE T4,FI.REW ;[215] REWIND REQUIRED?
PUSHJ P,RWNDF ;[215] YES--REWIND TAPE
IF MODE IS EBCDIC INDUSTRY
HRRZ T2,MODE
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
MOVE T1,X.BLKF(P1) ;[215] FETCH BLOCKING FACTOR
HRRZM T1,FILBLK(F) ;STORE AS AOBJN WORD (TO FAIL FIRST TIME)
MOVE T1,X.FLG(P1) ;GET FILE FLAGS
MOVEM T1,FILFLG(F) ;SET IN FCB
IF USER DIDN'T GIVE OUTPUT ESTIMATE
SKIPE X.RIB+.RBEST(P1) ;[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
IMULI T1,-1(T2) ;NO. OF WORDS READ
ADDI T1,177 ;ROUND UP ONE BLOCK
LSH T1,-<POW2(^D128)> ;IN BLOCKS
MOVEM T1,X.RIB+.RBEST(P1) ;[215] ALLOCATE SAME NO. FOR OUTPUT
FI;
MOVEI T1,FILHDR(F) ;[215] MAKE OPEN BLOCK POINT
HRLZM T1,X.OPN+.OPBUF(P1) ;[215] TO BUFFER HEADER
HLLZ T1,CHNMAP+0 ;[215] GET CHAN #
ADD T1,[OPEN X.OPN(P1)] ;[215] FORM UUO
XCT T1 ;OPEN CHANNEL
JRST ERROFF ;OPEN FAILED
TLC T1,(<OPEN>^!<ENTER>)
HRRI T1,X.RIB ;[215] FINISH TURNING INTO ENTER UUO
MOVE T2,X.DVCH(P1) ;[215] GET DEVCHR
TXNN T2,DV.DSK ;IS IT A DSK?
ADDI T1,2 ;NO, USE 4 WORD ENTER
XCT T1 ;ENTER FILE
JRST E$$FEE ;ENTER ERROR
MOVE T1,BUFPTR ;WHERE BUFFERS WILL START FROM
HRLI T1,1(T1) ;
SETZM (T1) ;
MOVE T2,OBUFNO ;[215] CLEAR ONLY TO END OF
IMUL T2,X.DVSZ(P1) ;[215] THIS FILE'S BUFFER AREA
ADDI T2,-1(T1) ;[215] FOR ASCII OR INDUSTRY
MOVSS T1 ;[215] MODE'S EXTRA BITS
BLT T1,(T2) ;[215] ..
MOVE P2,OBUFNO ;[215] SET UP BUFFERS
PUSHJ P,BUFRNG ;[215] ..
; ..
; ..
IF I/O MODE IS EBCDIC
HRRZ T2,IOMODE ;[201,215] FETCH FILE'S MODE
CAXE T2,MODEBCDIC ;[201,215] EBCDIC?
JRST $F ;[215] NO--BYTE POINTER OK
THEN USE EBCDIC 9-BIT BYTES
MOVX T2,<POINT 9,,35> ;[124,215] SET UP DUMMY POINTER
HLLM T2,FILPTR(F) ;[215] CHANGE REAL POINTER
FI;
IF THIS IS A MAGTAPE
MOVE T2,X.DVCH(P1) ;[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.)
MOVE T4,FILFLG(F) ;[215] GET FLAG BITS
TXNE T4,FI.REW ;[215] REWIND REQUIRED?
PUSHJ P,RWNDF ;[215] YES--REWIND TAPE
IF MODE IS EBCDIC INDUSTRY
HRRZ T2,MODE
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> ;[124,215] 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
MOVEI T1,(F)
SUBI T1,FCBORG
; MOVEI T1,-FCBORG(F) ;FCBLEN TIMES CHANNEL #
IDIVI T1,FCBLEN
HLLZ T1,CHNMAP(T1) ;GET ACTUAL CHANNEL
MOVE T1,F.OXBK ;[215] FIND OUTPUT ENTER BLOCK
MOVEI T1,X.RIB(T1) ;[215] ..
TLO T1,(RENAME)
XCT T1
JRST E$$TRE ;RENAME ERROR
RETURN
END;
SUBTTL I/O ROUTINES -- Magtape Utility Routines
BEGIN
PROCEDURE (PUSHJ P,CLOSEF) ;[215] CLOSE FILE POINTED TO BY F
;[215] THIS ROUTINE IS NOT THE GENERAL FILE CLOSING ROUTINE. IT IS
;[215] USED PRIMARILY TO CLOSE AN INPUT TAPE FILE AFTER SKIPPING
;[215] OVER A LABEL. SEE CLSFIL, CLSMST FOR THE GENERAL ROUTINE.
MOVEI T1,(F) ;[215] COMPUTE CHNMAP OFFSET
SUBI T1,FCBORG ;[215] ..
; MOVEI T1,-FCBORG(F) ;[215] WHEN MACRO UNDERSTANDS -RELOC
IDIVI T1,FCBLEN ;[215] ..
HLLZ T1,CHNMAP(T1) ;[215] GET CHANNEL IN AC FIELD
TXO T1,CLOSE ;[215] TURN INTO CLOSE UUO
XCT T1 ;[215] DO THE CLOSE
RETURN ;[215] DONE
END;
BEGIN
PROCEDURE (PUSHJ P,SKIPR) ;[215] SKIP 1 RECORD ON TAPE POINTED TO BY F
MOVEI T1,(F) ;[215] COMPUTE CHNMAP OFFSET
SUBI T1,FCBORG ;[215] ..
; MOVEI T1,-FCBORG(F) ;[215] WHEN MACRO UNDERSTANDS -RELOC
IDIVI T1,FCBLEN ;[215] ..
HLLZ T1,CHNMAP(T1) ;[215] GET CHANNEL IN AC FIELD
TXO T1,MTSKR. ;[215] TURN INTO MTSKR. UUO
XCT T1 ;[215] SKIP THE FILE
RETURN ;[215] DONE
END;
BEGIN
PROCEDURE (PUSHJ P,SKIPF) ;[215] SKIP 1 FILE ON TAPE POINTED TO BY F
MOVEI T1,(F) ;[215] COMPUTE CHNMAP OFFSET
SUBI T1,FCBORG ;[215] ..
; MOVEI T1,-FCBORG(F) ;[215] WHEN MACRO UNDERSTANDS -RELOC
IDIVI T1,FCBLEN ;[215] ..
HLLZ T1,CHNMAP(T1) ;[215] GET CHANNEL IN AC FIELD
TXO T1,MTSKF. ;[215] TURN INTO MTSKF. UUO
XCT T1 ;[215] SKIP THE FILE
RETURN ;[215] DONE
END;
BEGIN
PROCEDURE (PUSHJ P,WRTEOF) ;WRITE A TAPE MARK DURING LABEL PROCESSING
MOVEI T1,(F)
SUBI T1,FCBORG
; MOVEI T1,-FCBORG(F)
IDIVI T1,FCBLEN
HLLZ T1,CHNMAP(T1) ;ACTUAL CHAN#
TXO T1,MTEOF. ;TURN INTO MTEOF. UUO
XCT T1
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,RWNDF) ;[215] REWIND FILE POINTED TO BY F
MOVEI T1,(F) ;[215] COMPUTE CHNMAP OFFSET
SUBI T1,FCBORG ;[215] ..
; MOVEI T1,-FCBORG(F) ;[215] WHEN MACRO UNDERSTANDS -RELOC
IDIVI T1,FCBLEN ;[215] ..
HLLZ T1,CHNMAP(T1) ;[215] GET CHANNEL NUMBER
TXO T1,MTREW. ;[215] TURN INTO MTREW. UUO
XCT T1 ;[215] DO THE REWIND
RETURN ;[215] DONE
END;
BEGIN
PROCEDURE (PUSHJ P,UNLDF) ;UNLOAD FILE POINTED TO BY F
MOVEI T1,(F)
SUBI T1,FCBORG
; MOVEI T1,-FCBORG(F)
IDIVI T1,FCBLEN
HLLZ T1,CHNMAP(T1) ;ACTUAL CHAN#
IOR T1,[MTUNL.] ;UNLOAD UUO
XCT T1
RETURN
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) ;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;
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/ <CHNMAP OFFSET>,,<FCB POINTER FOR FILE>
PUSH P,P2 ;[215] SAVE TEMP FOR FILE FLAGS
MOVE P2,FILFLG(F) ;[215] ..
HLRZ T1,F ;[215] SET UP CHANNEL IN CASE
HLLZ T0,CHNMAP(T1) ;[215] NEEDED FOR MTIND.
HRRZ T1,CHNMAP(T1) ;[215] OR NUMEROUS TAPOP.'S
IF INDUSTRY COMPATIBLE MODE REQUIRED
TXNN P2,FI.IND ;[215] CHECK FOR INDUSTRY MODE
JRST $F ;[215] NO--TRY OTHERS
THEN SET IT
ADD T0,[MTIND.] ;[215] TURN CHAN INTO MTIND.
XCT T0 ;[215] DO IT
FI;
MOVX T0,.TFKTP ;[215] CONTROLLER FUNCTION
MOVSI T3,2 ;[215] 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] ..
MOVSI T3,3 ;[215] LENGTH,,ADDR
MOVX T0,.TFMOD+.TFSET ;[215] FUNCTION
MOVX T2,.TFM7B ;[215] 7-BIT MODE
TAPOP. T3, ;[215] SET IT
JFCL ;[215] WHAT ELSE?
FI;
IF DENSITY CHANGE REQUIRED
SKIPN T2,X.DEN(P1) ;[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;
MOVSI T3,3 ;[215] LENGTH,,ADDR
MOVX T0,.TFDEN+.TFSET ;[215] FUNCTION
TAPOP. T3, ;[215] SET DENSITY
JFCL ;[215] EARLY MONITOR--OPEN UUO OK
FI;
IFE FTFORTRAN,<
IF TAPE LABEL PROCESSOR EXISTS
MOVX T0,%SITLP ;[215] GET PID OF [SYSTEM]PULSAR
GETTAB T0, ;[215] IF PID, IT'S THERE
SETZ T0, ;[215] IF ERROR, IT'S NOT
JUMPE T0,$F ;[215] IF NO PID, IT'S NOT EITHER
THEN FLAG THAT PULSAR IS DOING LABELING FOR US
MOVX T0,FI.ATO ;[215] SIGNAL AUTO-LABELING
FI;
ORM T0,FILFLG(F) ;[215] SET FLAG
>
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]-1(T1)
$MORE (DECIMAL,T1)
$MORE (TEXT,< on >)
POP P,T1
DEVNAM T1,
JFCL
$MORE (SIXBIT,T1)
$DIE
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
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,@EXTRCT ;GET EXTRACT CODE
CAIN T1,(JRST (P4)) ;[117] JUST A DUMMY?
SKIPE X.BLKF(P1) ;[117,215] CAN'T DO IF OUTPUT BLOCKED
JRST $1 ;NO DO IT THE HARD WAY
HRRZ T1,CHNMAP+1 ;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) ;[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
MOVEI F,TMPFCB ;[113]
HLLZ T1,CHNMAP+0 ;[113]
ADD T1,[OPEN X.OPN(P1)] ;[113,215] TURN INTO OPEN UUO
XCT T1 ;[113] OPEN OUTPUT MASTER
JRST ERROFF ;[113] OPEN FAILED
TLC T1,(<OPEN>^!<LOOKUP>) ;[113]
HRRI T1,X.RIB ;[113,215] POINT TO RIB NOW
XCT T1 ;[113] DOES FILE ALREADY EXIST?
TDZA T2,T2 ;[113] NO
MOVE T2,X.RIB+.OPDEV(P1) ;[113,215] YES, GET DEVICE
TXC T1,<<LOOKUP (P1)>^!<CLOSE>> ;[113,215] TURN INTO PROPER CLOSE
HRRI T1,CL.NMB ;[113] DON'T DELETE NAME BLOCK
XCT T1 ;[113] SINCE WE WILL LOOKUP FILE AGAIN
TLC T1,(<CLOSE>^!<RELEASE>) ;[113]
XCT T1 ;[113]
MOVE T1,DSKARG+.DCSNM ;[113] GET INPUT STRUCTURE AGAIN
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) ;[113,215] 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
$1% RETURN ;FAILED TO FIND MATCH
CAME T1,T3 ;MATCH
JRST $B ;NOT YET
END;
JRST $F ;GOT MATCH
ELSE COMPARE STRUCTURE NAMES
CAME T1,DSKARG+.DCSNM ;IF SAME GIVE SKIP RETURN
JRST $1 ;NOT SAME
FI;
AOS (P) ;SET SKIP RETURN
MOVEI T1,RSTF ;TO RENAME SOLITARY FILE
$1% 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
HLLZ T1,CHNMAP+0
ADD T1,[OPEN X.OPN(P1)] ;[215] TURN INTO OPEN UUO
XCT T1 ;OPEN OUTPUT MASTER
JRST ERROFF ;OPEN FAILED
TLC T1,(<OPEN>^!<LOOKUP>)
HRRI T1,X.RIB ;[215] POINT TO LOOKUP BLOCK
MOVE T2,X.DVCH(P1) ;[215] GET DEVCHR
TXNN T2,DV.DSK ;IS IT A DSK?
ADDI T1,2 ;NO, USE 4 WORD ENTER
XCT T1 ;DOES FILE ALREADY EXIST?
JRST $1 ;NO
TXC T1,<<LOOKUP (P1)>^!<RENAME>> ;[215] TURN INTO PROPER RENAME
HRRI T1,D.RIB
XCT T1 ;YES, DELETE IT
JRST E$$FRE ;RENAME ERROR
$1% PUSHJ P,RENOUT ;RENAME FILE TO OUTPUT FILE NAME
MOVE T1,INPREC ;FAKE COPY OF FILE
MOVEM T1,OUTREC ;SO ENDS. IS HAPPY
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
MOVEI T2,(F) ;PTR TO FCB OF FILE
SUBI T2,FCBORG ;FCBLEN TIMES SOFTWARE CHANNEL NUMBER
IDIVI T2,FCBLEN ;CHANNEL NUMBER
HRL T1,T2 ;COMPLETE ARGUMENT FOR UUO
MOVEI T2,T1 ;POINT TO ARGUMENT
DISK. T2, ;SET DISK PRIORITY LEVEL
JFCL ;IGNORE ERROR RETURN
RETURN
END;