Trailing-Edge
-
PDP-10 Archives
-
BB-4160E-BM
-
sort-development/srtcmd.mac
There are 16 other files named srtcmd.mac in the archive. Click here to see a list.
SUBTTL SRTCMD - TOPS-20 COMMAND SCANNER FOR SORT/MERGE
SUBTTL J.E.FRIES/DZN/DMN/BRF 18-Jul-79
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1977, 1979 BY DIGITAL EQUIPMENT CORPORATION
IFE FTOPS20,<PRINTX ? SRTCMD should not be present in TOPS-10 SORT/MERGE.>
IFN FTPRINT,<PRINTX [Entering SRTCMD.MAC]>
SUBTTL TABLE OF CONTENTS FOR SRTCMD
; Table of Contents for SRTCMD
;
;
; Section Page
;
; 1 SRTCMD - TOPS-20 COMMAND SCANNER FOR SORT/MERGE .......... 1
; 2 TABLE OF CONTENTS FOR SRTCMD ............................. 2
; 3 COMMAND PARSER AND DISPATCH .............................. 4
; 4 SORT/MERGE COMMANDS
; 4.1 EXIT, SORT, MERGE ................................. 8
; 4.2 HELP .............................................. 9
; 4.3 RUN ............................................... 10
; 4.4 TAKE .............................................. 13
; 4.5 Continuation of SORT and MERGE .................... 16
; 4.6 Continuation of SORT and MERGE
; 4.6.1 Input specs ................................ 17
; 4.6.2 Output spec ................................ 18
; 5 SORT AND MERGE
; 5.1 /RECORD-SIZE: and Recording Mode Switches ......... 19
; 5.2 /KEY: ............................................. 20
; 5.3 File Switches
; 5.3.1 /BLOCKED:n, /FIXED, /FORTRAN ............... 22
; 5.3.2 /RANDOM, /SEQUENTIAL, /VARIABLE ............ 22
; 5.3.3 Apply Global Defaults ...................... 23
; 5.4 Control Switches
; 5.4.1 /PHYSICAL, /CHECK, /COLLATE:x[:y] .......... 24
; 5.4.2 /SUPPRESS:x ................................ 25
; 5.4.3 /BUFFER-PAGES:n, /LEAVES:n ................. 26
; 5.4.4 /ERROR-RETURN:^x, /FATAL-ERROR-CODE:^x ..... 26
; 5.4.5 /TEMPORARY-AREA:x,y,... .................... 27
; 5.5 Magtape Switches
; 5.5.1 /ANSI-ASCII, /DENSITY:n .................... 28
; 5.5.2 /INDUSTRY-COMPATIBLE, /LABEL:x ............. 28
; 5.6 Magtape Switches
; 5.6.1 /PARITY:x, /REWIND, /UNLOAD ................ 29
; 6 PARSING SUBROUTINES ...................................... 30
; 7 ERROR MESSAGES ........................................... 34
; 8 GENERAL SUBROUTINES ...................................... 35
; 9 DEFINITIONS
; 9.1 Constants and Tables .............................. 43
; 9.2 Low Segment Data .................................. 45
IFNDEF FTFORTRAN,<FTFORTRAN==0>
SEGMENT HIGH
NCHPW==5 ;NUMBER OF ASCII CHARACTERS PER WORD
BUFSIZ==200 ;SIZE OF INPUT TEXT BUFFER
ATMSIZ==BUFSIZ ;SIZE OF ATOM BUFFER FOR COMND JSYS
GJFSIZ==.GJRTY+2 ;SIZE OF GTJFN BLOCK USED BY COMND JSYS
FDBSIZ==.CMDEF+2 ;SIZE OF FUNCTION DESCRIPTOR BLOCK
DEFINE TXT(TEXT) <POINT 7,[ASCIZ\TEXT\]>
DEFINE TMSG (MSG)<
HRROI T1,[ASCIZ\MSG\]
CALL TYPMSG
>
DEFINE TYCM (Q,CODE,TEXT)<
E$$'CODE: HRROI T1,[ASCIZ\Q'SRT'CODE TEXT\]
CALL TYCMR
>
DEFINE TYCMP (Q,CODE,TEXT)<
E$$'CODE: HRROI T1,[ASCIZ\Q'SRT'CODE TEXT\]
CALL TYCMPR
>
SUBTTL COMMAND PARSER AND DISPATCH
;SCAN, PARSE AND REPARS CONSTITUTE THE TOP LEVEL ROUTINES IN TOPS-20 SORT'S
;COMMAND SCANNER. THE FLOW OF CONTROL BETWEEN THESE ROUTINES IS SOMEWHAT
;DICTATED BY THE REST OF SORT AND THE COMND% JSYS, SO THEIR OPERATION IS:
;
;SCAN
;
;SCAN IS CALLED TO READ COMMAND LINES UNTIL A VALID SORT OR MERGE COMMAND IS
;TYPED. SCAN THEN RETURNS TO LET THE REST OF SORT PROCESS THAT LINE. IF THE
;COMMAND SCANNER GETS A TAKE COMMAND, IT REMEMBERS THIS FACT SO THAT WHEN THE
;TOP LOOP CALLS SCAN THE NEXT TIME, THE COMND% STATE BLOCK IS NOT REINITIALIZED,
;BUT STILL POINTS TO THE TAKE FILE.
;
;PARSE
;
;PARSE IS CALLED INTERNALLY WHEN A VALID SORT OR MERGE COMMAND WAS NOT THE LAST
;COMMAND TYPED, AND A NEW COMMAND LINE SHOULD BE READ. THIS HAPPENS IF ONE OF
;THE OTHER VALID COMMANDS WAS TYPED (HELP, TAKE), OR IF A COMMAND SCANNER ERROR
;WAS DETECTED. PARSE THEN EITHER READS ANOTHER COMMAND, OR, IF APPLICABLE,
;RETURNS THE ERROR CODE TO THE FORTRAN SUBROUTINE THAT CALLED SORT. NOTE THAT
;FOR THE ^H FEATURE OF COMND% TO WORK, THE COMMAND STATE BLOCK SHOULD *NOT* BE
;REINITIALIZED HERE. THE .CMINI FUNCTION NEEDS THE OLD TEXT BUFFER POINTERS IN
;THIS CASE, AND WILL DO THE REINITIALIZATION FOR US IF ^H IS NOT TYPED. ALSO, IF
;WE ARE CALLED FROM FORTRAN WITH A STRING, WE MUST CONVINCE COMND% TO USE IT.
;THE ONLY KNOWN WAY IS TO SET THE JFNS TO NUL: (DONE IN SCAN), DO THE .CMINI
;FUNCTION, AND ONLY THEN TELL COMND% THAT THERE ARE A LOT OF UNPARSED CHARACTERS
;THAT JUST HAPPEN TO BE THE USER'S COMMAND STRING (PUT THERE ON ENTRY TO SORT).
;
;ALSO, SINCE PARSE FUNCTIONS AS A CLEAN-UP FOR COMMAND ERRORS AND THE LIKE, WE
;MUST BE PREPARED TO RETURN TO THE CALLER IF WE WERE CALLED BY A FORTRAN
;PROGRAM. THIS RETURN CAN EITHER BE DUE TO AN ERROR, OR THE COMND%'S LIMITATION
;OF ONE COMMAND. THIS IS THE BULK OF THE WORK PRIOR TO ACTUALLY STARTING TO
;PARSE A COMMAND.
;
;REPARS
;
;REPARS IS CALLED FROM PARSE, BUT IS ALSO THE COMND% REPARSE ROUTINE. THEREFORE,
;IT MUST RESTORE SORT'S STATE TO THAT AT THE BEGINNING OF A NEW COMMAND LINE.
;THERE ARE TWO REASONS FOR THIS. FIRST, ON A COMND% REPARSE, WE MUST RE-SCAN THE
;LINE FROM THE BEGINNING. SECOND, ALL COMMAND SCANNING ERRORS EVENTUALLY END UP
;AT PARSE (AFTER PRINTING THE ERROR MESSAGE) SO THAT ANY PARTIAL INFORMATION
;ABOUT THE BAD LINE SHOULD BE DISCARDED. CURRENTLY, ALL THIS INVOLVES IS FREEING
;ANY MEMORY ALLOCATED VIA GETSPC.
;
;FINALLY, REPARSE PARSES THE FIRST FIELD ON THE COMMAND LINE AND CALLS THE
;APPROPRIATE ROUTINE. ONLY THE SORT AND MERGE COMMANDS RETURN, CAUSING REPARS
;TO RETURN TO THE REST OF SORT TO PROCESS THESE COMMANDS. THE OTHERS EITHER
;NEVER RETURN (E.G., RUN) OR 'RETURN' VIA TRANSFERRING TO PARSE.
BEGIN
PROCEDURE (PUSHJ P,SCAN) ;[376] SCANNER INITIALIZATION
IF NOT PROCESSING A 'TAKE' FILE
SKIPE TAKFLG ;[376]
JRST $F ;[376]
THEN SET UP COMND% STATE BLOCK
MOVEI T1,REPARS ;[376] SET UP REPARSE ADDRESS
MOVEM T1,.CMFLG+CMDBLK ;[376] ..
HRROI T1,[ASCIZ /SORT>/] ;[376] SET UP PROMPT
MOVEM T1,.CMRTY+CMDBLK ;[376] ..
HRROI T1,BUFFER ;[376] SET UP POINTERS TO TEXT BUFFER
MOVEM T1,.CMBFP+CMDBLK ;[376] ..
MOVEM T1,.CMPTR+CMDBLK ;[376] ..
MOVX T1,BUFSIZ*NCHPW ;[376] SET UP LENGTH OF TEXT BUFFER
MOVEM T1,.CMCNT+CMDBLK ;[376] ..
SETZM .CMINC+CMDBLK ;[376] SET UP COUNT OF UNPARSED CHARS
HRROI T1,ATMBFR ;[376] SET UP POINTER TO ATOM BUFFER
MOVEM T1,.CMABP+CMDBLK ;[376] ..
MOVX T1,ATMSIZ+NCHPW ;[376] SET UP LENGTH OF ATOM BUFFER
MOVEM T1,.CMABC+CMDBLK ;[376] .
MOVEI T1,GJFBLK ;[376] SET UP ADDRESS OF GTJFN% BLOCK
MOVEM T1,.CMGJB+CMDBLK ;[376] ..
IF CALLED FROM FORTRAN
SKIPE FORTPP ;[376]
THEN CAN'T READ FROM TERMINAL SO USE NUL:
SKIPA T1,[.NULIO,,.NULIO] ;[376]
ELSE READ FROM THE TERMINAL
MOVE T1,[.PRIIN,,.PRIOU] ;[376]
FI;
MOVEM T1,.CMIOJ+CMDBLK ;[376] SET UP I/O JFNS
FI;
SETZM TOTALC ;[376] NO MEMORY ALLOCATED YET
MOVEM P,SAVPAR ;[376] SAVE STACK IN CASE ERRORS
; PJRST PARSE ;[376] FALL THROUGH INTO PARSE
END;
BEGIN
PROCEDURE (PUSHJ P,PARSE) ;[376] START SCANNING A NEW LINE
MOVE P,SAVPAR ;[376] RESTORE STACK IN CASE ERRORS
IF WE WERE CALLED FROM FORTRAN
SKIPN FORTPP ;[376] CALLED FROM FORTRAN?
JRST $F ;[376] NO--SKIP ALL RETURN TESTS
THEN WE MAY NEED TO RETURN TO CALLER
IF ERROR OCCURRED ON LAST COMMAND
SKIPE ERRORF ;[376] ERROR?
THEN RETURN IT TO CALLER
PJRST FORERR ;[376] YES--RETURN IT
ELSE MAY STILL NEED TO RETURN
IF NOT IN A TAKE FILE AND SECOND REAL COMMAND
SKIPN TAKFLG ;[376] TAKE FILE?
SKIPN FOR2ND ;[376] 2ND COMMAND?
JRST $T ;[376] NO
THEN RETURN TO CALLER (ONLY ONE COMMAND CAN BE PASSED)
PJRST FORXIT ;[376] DONE
ELSE REMEMBER WE'VE STARTED FIRST COMMAND
SETOM FOR2ND ;[376] FOR NEXT TIME
FI;
FI;
FI;
SETZM ERRORF ;[376] NO ERROR NOW
HRRZS SUPFLG ;[376] CLEAR SUPPRESS FLAG
MOVEI T1,CMDBLK ;[376] DO COMND% INITIALIZATION
MOVEI T2,[FLDDB. (.CMINI)] ;[376] ..
COMND% ;[376] ..
ERJMP CMDERR ;[376] MOST LIKELY EOF ON TAKE FILE
IF CALLED FROM FORTRAN AND NOT A TAKE FILE
SKIPE FORTPP ;[376] CALLED FROM FORTRAN?
SKIPE TAKFLG ;[376] AND NOT A TAKE FILE?
JRST $F ;[376] NO
THEN TELL COMND% TO USE USER'S STRING WHICH IS NOW IN BUFFER
MOVE T1,CMDLEN ;[376] SET # UNPARSED CHARS TO
MOVEM T1,.CMINC+CMDBLK ;[376] LENGTH OF USER'S STRING
FI;
MOVEM P,SAVREP ;[376] SAVE P TO UNWIND ON REPARSE
; PJRST REPARS ;[376] GO TO WORK
END;
BEGIN
PROCEDURE (PUSHJ P,REPARS) ;[376] CLEAN UP AND START NEW LINE
MOVE P,SAVREP ;[376] UNBIND TO SCANNER TOP LEVEL
IF ANY MEMORY ALLOCATED FOR THIS LINE
SKIPN T1,TOTALC ;[376]
JRST $F ;[376]
THEN FREE IT
PUSHJ P,FRESPC ;[376] FRESPC TAKES # WORDS TO RETURN
SETZM TOTALC ;[376] NO SPACE ALLOCATED NOW
FI;
;NOW TO PARSE ONE OF THE SORT COMMANDS.
MOVEI T1,CMDBLK ;[376] PARSE THE COMMAND NAME OR CRLF
MOVEI T2,FDBRV ;[376] ..
PUSHJ P,PCOMND ;[376] ..
HRRZS T3 ;[376] GET ADDR OF FUNCTION BLOCK THAT WON
CAIN T3,FDBRV ;[376] IF .CMCFM THEN JUST SKIP LINE
PJRST PARSE ;[376] YES--NEW LINE
HRRZ T1,(T2) ;[376] IT WAS KEYWORD--GET ROUTINE ADDR
PUSHJ P,(T1) ;[376] CALL APPROPRIATE ROUTINE
RETURN ;[376] SORT OR MERGE COMMAND FOR SORT
END;
SUBTTL SORT/MERGE COMMANDS -- EXIT, SORT, MERGE
BEGIN
PROCEDURE (PUSHJ P,CT1EXI) ;[376] EXIT COMMAND
;CT1EXI PROCESSES SORT'S EXIT COMMAND. NOTE CAREFULLY THAT EXIT CAN EVEN BE
;GIVEN BY A FORTRAN CALL. SINCE IT IS DESIRABLE THAT A CONTINUE COMMAND TO THE
;EXEC GET BACK TO WHATEVER WAS PENDING (INCLUDING THAT POTENTIAL FORTRAN
;CALLER), WE SIMPLY EXIT WITH ABSOLUTELY NO CLEANUP OF ANY KIND.
HRROI T2,[ASCIZ \SORT/MERGE\] ;[376] PARSE USEFUL NOISE PHRASE
PUSHJ P,SKPNOI ;[376] ..
PJRST PARSE ;[376] DIDN'T PARSE--PARSE NEW LINE
PUSHJ P,ENDCOM ;[376] PARSE END OF LINE
PJRST PARSE ;[376] DIDN'T PARSE--PARSE NEW LINE
MONRET ;[376] SIMPLY EXIT SO CONTINUE
PJRST PARSE ;[376] WORKS EVEN FROM FORTRAN CALLS
END;
BEGIN
PROCEDURE (PUSHJ P,CT1SOR) ;[376] SORT COMMAND
;THE SORT AND MERGE COMMANDS SIMPLY SAVE A FLAG REMEMBERING WHICH COMMAND WAS
;TYPED, THEN JOIN COMMON CODE TO PARSE THE REST OF THE LINE.
CT1SOR: TDZA T1,T1 ;[376] TURN OFF MERGE FLAG
CT1MER: MOVEI T1,1 ;[376] TURN ON MERGE FLAG
MOVEM T1,MRGSW ;[376] ..
PJRST PARS ;[376] JOIN COMMON CODE
END;
SUBTTL SORT/MERGE COMMANDS -- HELP
CT1HEL: HRROI T2,[ASCIZ\FOR SORT/MERGE\] ;GET NOISE WORDS
CALL SKPNOI ;GO PARSE NOISE FIELD
JRST CT1HEX ;TAKE ERROR EXIT
CALL ENDCOM ;GO PARSE END OF COMMAND
JRST CT1HEX ;TAKE ERROR EXIT
CALL IGJFBI ;GO CLEAR GTJFN BLOCK
MOVEI T1,GJFBLK ;GET ADDRESS OF JFN BLOCK
HRROI T2,HLPFIL ;GET POINTER TO HELP FILE
GTJFN% ;[335] GET JFN FOR HELP FILE
ERJMP CGJERR ;OOPS
HRRZM T1,HLPJFN ;SAVE JFN
MOVE T1,HLPJFN ;GET JFN
MOVE T2,[7B5+OF%RD] ;7 BIT BYTES + READ
OPENF% ;[335] OPEN THE FILE
ERJMP COHERR ;OOPS
CT1H03: MOVE T1,HLPJFN ;GET JFN
BIN% ;[335] GET A CHARACTER
ERJMP IEFERR ;OOPS
JUMPE T2,CT1H90 ;CHECK FOR EOF
MOVE T1,T2 ;GET BYTE TO T1
PBOUT% ;[335] TYPE IT ON TERMINAL
ERJMP OEFERR ;OOPS
JRST CT1H03 ;LOOP
CT1H90: GTSTS% ;[335] GET STATUS
TLNN T2,(GS%EOF) ;EOF?
JRST CT1H03 ;NO, SO EAT A NULL
CT1H91: MOVE T1,HLPJFN ;GET JFN
CLOSF% ;[335] CLOSE THE HELP FILE
ERJMP CEFERR ;OOPS
CT1HEX: JRST PARSE ;GET NEXT COMMAND
CGJERR: TYCMP (?,CGJ,<Cannot get JFN for help file>)
JRST CT1HEX
COHERR: TYCMP (?,COH,<Cannot open help file>)
JRST CT1HEX
IEFERR: MOVE T1,HLPJFN ;GET HELP JFN
GTSTS% ;[335] GET STATUS
TLNE T2,(GS%EOF) ;SKIP IF NOT EOF
JRST CT1H91 ;FINISH UP
TYCMP (?,IEF,<Input error from help file>)
JRST CT1HEX
OEFERR: TYCMP (?,OEF,<Output error from user terminal>)
JRST CT1HEX
CEFERR: TYCMP (?,CEF,<Close error from help file>)
JRST CT1HEX
SUBTTL SORT/MERGE COMMANDS -- RUN
;This code processes the RUN command. Following successful typein by the user,
;the current core image is replaced with the program to be run, and then the new
;program is started. To do this properly requires a great attention to detail.
;The following roughly describes the algorithm used:
;
; 1. Process the file specification argument, and finish the command.
; 2. Convert file specification's file name to SIXBIT for the later SETSN.
; 3. Determine if the file is from SYS: so system name or '(PRIV)' can be
; set. This is the bulk of the code. Do this by tacking "SYS:" on the
; front of just the file specification's name.typ, and do a physical-
; only GTJFN. Get the full file specification for both the user's program
; and the one we tried to find on SYS: and compare them. If they match
; completely, the original file is from SYS:, and we can set the system
; name. This algorithm guarantees that only the first occurrance of the
; program on system logical name SYS: qualifies as `from SYS:', since
; subsystem statistics taken on more than one program are not very valid.
; 4. Load the final code into the ACs to kill the current core image, bring
; in the new one, and start it. Final code must execute in the ACs since
; we have no other core left after the PMAP.
FSPCLN==^D168 ;MAX FILE SPEC CHAR LENGTH
FSPWLN==<FSPCLN+4>/5 ;MAX FILESPEC WORD LENGTH
INTEGER RJFN, SJFN, PRGNAM
SEGMENT LOW
ARRAY RFILE[FSPWLN], SFILE[FSPWLN]
VAR
SEGMENT HIGH
.RUN: HRROI T2,[ASCIZ\PROGRAM\]
CALL SKPNOI ;GIVE USER SOME ADVICE
RET ;OOPS
CALL CLRGJF ;CLEAR GTJFN BLOCK
MOVX T2,GJ%OLD!GJ%MSG!GJ%XTN ;FILL IN GTJFN BLOCK
MOVEM T2,GJFBLK+.GJGEN ; ..
HRROI T2,[ASCIZ\EXE\] ; DEFAULT FILE TYPE FOR RUN
MOVEM T2,GJFBLK+.GJEXT ; ..
MOVEI T2,GJFBLK ;NOW PARSE AN EXE FILE SPEC
MOVEM T2,CMDBLK+.CMGJB ; ..
MOVEI T2,[FLDDB. (.CMFIL,,,<program to run,>)]
CALL PATOM ; ..
JRST TYLSEH ;YES--UNRECOGNIZED COMMAND
HRRM T2,RJFN ;SAVE FILE'S JFN FOR LATER
CALL ENDCOM ;PARSE AN END-OF-LINE
RET ;OOPS
HRROI T1,RFILE ;EXTRACT JUST FILE NAME
HRRZ T2,RJFN ; SO WE CAN DO SETSN
MOVX T3,<FLD .JSAOF,JS%NAM> ; ..
JFNS% ;[335] ..
; ..
; ..
HRROI T1,RFILE ;NOW CONVERT FILE NAME TO SIXBIT
CALL ASCSIX ; ..
MOVEM T2,PRGNAM ; AND SAVE FOR LATER SETSN
HRROI T1,RFILE ;GET FILE.TYP ONLY IN RFILE
HRRZ T2,RJFN ; OF THE FILE TO BE RUN
MOVX T3,<<FLD .JSAOF,JS%NAM>!<FLD .JSAOF,JS%TYP>!JS%PAF>
JFNS% ;[335] ..
CALL CLRGJF ;ZERO GTJFN BLOCK FOR 'FROM SYS:' CHECK
MOVX T1,GJ%OLD!GJ%PHY ;LOOK FOR FILE ON PHYSICAL SYS:
MOVEM T1,GJFBLK+.GJGEN ; ..
HRROI T1,[ASCIZ\SYS\] ; ..
MOVEM T1,GJFBLK+.GJDEV ; ..
MOVEI T1,GJFBLK ; ..
HRROI T2,RFILE ; ..
GTJFN% ;[335] ..
JRST NOTSYS ;MUST NOT BE FROM SYS: THEN
HRRZM T1,SJFN ;SAVE JFN OF SYS: FILE FOR LATER
ZERO (T1,RFILE,FSPWLN) ;CLEAR FILE SPEC AREA FOR TEST
HRROI T1,RFILE ;GET COMPLETE FILE SPEC OF RUN FILE
HRRZ T2,RJFN ; ..
MOVX T3,<<FLD .JSAOF,JS%DEV>!<FLD .JSAOF,JS%DIR>!<FLD .JSAOF,JS%NAM>!
<FLD .JSAOF,JS%TYP>!<FLD .JSAOF,JS%GEN>!JS%PAF>
JFNS% ;[335] ..
ZERO (T1,SFILE,FSPWLN) ;CLEAR FILE SPEC AREA FOR TEST
HRROI T1,SFILE ;GET COMPLETE FILE SPEC OF SYS: FILE
HRRZ T2,SJFN ; ..
MOVX T3,<<FLD .JSAOF,JS%DEV>!<FLD .JSAOF,JS%DIR>!<FLD .JSAOF,JS%NAM>!
<FLD .JSAOF,JS%TYP>!<FLD .JSAOF,JS%GEN>!JS%PAF>
JFNS% ;[335] ..
MOVX T0,FSPCLN ;NOW COMPARE RUN AND SYS: FILE SPECS
MOVX T1,<POINT 7,RFILE> ; ..
SETZ T2, ; ..
MOVX T3,FSPCLN ; ..
MOVX T4,<POINT 7,SFILE> ; ..
EXTEND T0,[EXP CMPSN,0,0] ; HERE'S THE REAL WORK!!
SKIPA T1,PRGNAM ;WE WIN!! IT'S FROM SYS:!
NOTSYS: MOVX T1,'(PRIV)' ;NOT FROM SYS:--USE SYSTEM DEFAULT
MOVE T2,PRGNAM ;ALSO SET UP PROGRAM NAME
SETSN% ;[335] ALL THIS WORK FOR A MEASLY SETSN
ERJMP TYLSEH ; WITH AN UNDOCUMENTED ERROR RETURN TOO
SETO T1, ;SET UP PMAP ARGS TO
MOVX T2,<.FHSLF,,0> ; UNMAP ALL OF OUR PAGES
MOVX T3,PM%CNT!1000 ; ..
;NOTE: FROM HERE ON, THE STACK IS POTENTIALLY DESTROYED, SO DON'T USE IT!!
HRRZ GETARG,RJFN ;SET UP ARG FOR GET JSYS
HRLI GETARG,.FHSLF ; ..
MOVE T0,[RUNCOD,,RUNIT] ;MOVE FINAL CODE INTO ACS
BLT T0,RUNEND ; ..
JRST RUNIT ; AND JUMP TO IT
;ASCSIX -- RETURNS SIXBIT REPRESENTATION OF A STRING.
;
;ACCEPTS IN AC1: SOURCE DESIGNATOR (BYTE POINTER OR -1,,ADDRESS)
;
;RETURNS +1: ALWAYS, UPDATED STRING POINTER IN AC1, AND
; SIXBIT REPRESENTATION OF FIRST 6 CHARACTERS
; OF THE STRING IN AC2.
ASCSIX: PUSH P,T3 ;SAVE SOME TEMPS
PUSH P,T4 ; ..
TXC T1,<-1,,0> ;DEFAULT BYTE SIZE?
TXCN T1,<-1,,0> ; ..
HRLI T1,(POINT 7) ;YES--SET UP 7-BIT BYTES
SETZ T2, ;INITIALIZE RESULT
MOVX T3,<POINT 6,T2> ;POINT TO DESTINATION
ASLOOP: ILDB T4,T1 ;FETCH NEXT BYTE
JUMPE T4,ASDONE ;DONE IF NUL
CAIGE T4," " ;IGNORE CONTROL CHARACTERS
JRST ASLOOP ; ..
CAIL T4,"`" ;CONVERT LOWER CASE TO UPPER
SUBI T4,"a"-"A" ; ..
SUBI T4,"A"-'A' ;CONVERT TO SIXBIT
IDPB T4,T3 ;STORE IN DESTINATION
CAME T3,[POINT 6,T2,35] ;DONE?
JRST ASLOOP ;NO--LOOP FOR MORE
ASDONE: POP P,T4 ;YES--RESTORE TEMPS
POP P,T3 ; ..
POPJ P, ;RETURN
;This is the final code for the RUN command that has to run in the ACs.
RUNCOD: PHASE T4 ;RELOCATE CODE INTO THE ACS
RUNIT:! PMAP% ;[335] UNMAP ALL PAGES
MOVE T1,GETARG ;GET PROCESS HANDLE,,JFN
GET% ;[335] AND LOAD PROGRAM TO BE RUN
MOVEI T1,.FHSLF ;NOW START UP OUR PROCESS
SETZ T2, ; AT THE NEW ENTRY VECTOR
RUNEND:!SFRKV% ;[335] ..
GETARG: BLOCK 1 ;GET ARG PLACED HERE
IFG <.-20>,<PRINTX ? Final run code overflows the ACs.>
DEPHASE ;BACK TO THE REAL WORLD
SUBTTL SORT/MERGE COMMANDS -- TAKE
CT1TAK: SKIPE TAKFLG ;SKIP IF NOT TAKING
JRST [ TYCM (?,TCM,<TAKE commands may not be nested>)
CALL TAKEX
MOVE P,SAVREP ;RESET P
JRST PARSE]
HRROI T2,[ASCIZ/COMMANDS FROM/] ;GET NOISE TEXT
CALL SKPNOI ;GO PARSE NOISE FIELD
RET ;FAILED, RETURN FAILURE
CALL CLRGJF ;GO CLEAR GTJFN BLOCK
MOVX T1,GJ%OLD ;GET EXISTING FILE FLAG
MOVEM T1,GJFBLK+.GJGEN ;STORE GTJFN FLAGS
HRROI T1,[ASCIZ/CMD/] ;GET DEFAULT FILE TYPE FIELD
MOVEM T1,GJFBLK+.GJEXT ;STORE DEFAULT EXTENSION
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMFIL)] ;GET FUNCTION DESCRIPTOR BLOCK ADDRESS
COMND% ;[335] PARSE INPUT FILESPEC
ERJMP CMDERR ;ERROR, GO CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;PARSED FILE-SPEC OK ?
JRST TAKE10 ;YES, GO ON AND SAVE INPUT JFN
; HERE ON A GOOD INPUT FILESPEC
MOVEM T2,INJFN ;SAVE INPUT JFN FOR COMMANDS
MOVE T1,T2 ;JFN TO T1
DVCHR% ;[335] GET DEVICE CHARACTERISTICS
ERJMP TYLSEH ;OOPS
LOAD T1,DV%TYP,T2 ;GET DEVICE TYPE
CAIN T1,.DVTTY ;SKIP IF NOT A TTY
JRST [ TYCM (?,TFM,<TAKE file may not originate from TTY>)
MOVE P,SAVREP ;RESET P
JRST PARSE]
HRROI T2,[ASCIZ/LOGGING OUTPUT ON/] ;GET NOISE TEXT
CALL SKPNOI ;GO PARSE NOISE FIELD
RET ;FAILED, RETURN FAILURE
CALL CLRGJF ;GO CLEAR GTJFN BLOCK USED BY COMND JSYS
MOVX T1,GJ%FOU ;GET FLAG SAYING FILE IS FOR OUTPUT USE
MOVEM T1,GJFBLK+.GJGEN ;SAVE GTJFN FLAGS
SETZM NAMBUF ;INITIALIZE FILENAME BUFFER
HRROI T1,NAMBUF ;GET POINTER TO WHERE FILENAME IS TO GO
MOVE T2,INJFN ;GET INPUT JFN
MOVX T3,<FLD(.JSAOF,JS%NAM)> ;GET FLAG BITS SAYING OUTPUT NAME ONLY
JFNS% ;[335] GET FILE NAME OF INPUT FILE
SKIPE NAMBUF ;ANY FILENAME ?
HRROI T1,NAMBUF ;YES, GET A POINTER TO THE FILE NAME FOR INPUT
MOVEM T1,GJFBLK+.GJNAM ;STORE DEFAULT NAME OF OUTPUT FILE
HRROI T1,[ASCIZ/LOG/] ;GET DEFAULT FILE TYPE OF OUTPUT FILE
MOVEM T1,GJFBLK+.GJEXT ;STORE DEFAULT EXTENSION
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMFIL)] ;GET FILE-SPEC FUNCTION BLOCK ADDRESS
COMND% ;[335] PARSE OUTPUT FILESPEC
ERJMP CMDERR ;ERROR, GO CHECK FOR EOF ON TAKE FILE
TXNN T1,CM%NOP ;FILESPEC PARSED OK ?
JRST TAKE20 ;YES, GO ON TO SAVE JFN
TAKE10: TYCM (?,ITF,<Invalid TAKE file specification, >)
JRST TYLSEP ;TYPE LAST SYSTEM ERROR THEN PARSE
; HERE TO SAVE OUTPUT JFN AND GET COMMAND CONFIRMATION
TAKE20: MOVEM T2,OUTJFN ;SAVE LOGGIN FILE JFN
MOVE T1,T2 ;JFN TO T1
DVCHR% ;[335] GET DEVICE CHARACTERISTICS
ERJMP TYLSEH ;OOPS
LOAD T1,DV%TYP,T2 ;GET DEVICE TYPE
CAIN T1,.DVTTY ;SKIP IF NOT A TTY
JRST [ TYCM (?,TLF,<TAKE log file may not reside on TTY:>)
MOVE P,SAVREP ;RESET P
MOVE T1,OUTJFN
RLJFN% ;[335] GIVE BACK JFN
ERJMP RJFERR ;FAILED
JRST PARSE]
CALL ENDCOM ;GO PARSE COMMAND CONFIRMATION
RET ;RETURN, BAD CONFIRMATION
; OPEN INPUT AND OUTPUT FILES
MOVE T1,INJFN ;GET INPUT JFN
MOVE T2,[7B5+OF%RD] ;7 BIT BYTES, READ ACCESS
OPENF% ;[335] OPEN INPUT FILE
JRST [TYCM (?,COC,<Cannot OPEN command file, >)
JRST TYLSEP] ;TYPE LAST SYSTEM ERROR THEN PARSE
MOVE T1,OUTJFN ;GET OUTPUT JFN
CAIN T1,.PRIOU ;STILL PRIMARY OUTPUT JFN ?
JRST TAKE30 ;NO OUTPUT JFN, GO ON
MOVE T2,[7B5+OF%WR] ;7 BIT BYTES, WRITE ACCESS
OPENF% ;[335] OPEN OUTPUT FILE
JRST [ MOVE T1,INJFN ;GET INPUT JFN AGAIN
CLOSF% ;[335] CLOSE INPUT FILE
JFCL ;IGNORE ERRORS HERE
TYCM (?,COL,<Cannot OPEN logging file, >)
JRST TYLSEP] ;TYPE LAST SYSTEM ERROR THEN PARSE
; NOW SAVE NEW JFN'S AND RETURN TO PARSER
TAKE30: HRLZ T1,INJFN ;GET INPUT JFN
HRR T1,OUTJFN ;GET OUTPUT JFN
MOVEM T1,CMDBLK+.CMIOJ ;SAVE NEW JFN'S
SETOM TAKFLG ;MARK THAT COMMANDS ARE COMING FROM FILE
JRST PARSE ;RETURN TO PARSER
;ROUTINE TO CLOSE TAKE FILES
TAKEX: SETZM TAKFLG ;MARK THAT TAKE FILE NOT BEING PROCESSED
MOVE T1,OUTJFN ;GET TAKE LOG FILE JFN
CLOSF% ;[335] CLOSE THE FILE
CALL [TYCM (?,CCL,<Cannot close TAKE log file>)
CALLRET TYLSEH]
MOVE T1,INJFN ;GET TAKE FILE JFN
CLOSF% ;[335] CLOSE THE FILE
CALL [TYCM (?,CCC,<Cannot close TAKE command file>)
CALLRET TYLSEH]
MOVE T1,[.PRIIN,,.PRIOU] ;YES, GET STANDARD PRIMARY JFN'S
MOVEM T1,CMDBLK+.CMIOJ ;RESET INPUT AND OUTPUT JFN'S
RET
SUBTTL SORT/MERGE COMMANDS -- Continuation of SORT and MERGE
;CALLED FROM CT1SOR/MER TO PARSE REST OF COMMAND LINE
;FIRST PARSE /RECORD-SIZE
PARS: SETZM NUMINP ;[376] NO INPUT FILES SEEN YET
SETZM MODE ;[376] CLEAR THE RECORDING MODE
CALL RLSJFN ;[376] RELEASE ALL JFNS ASSIGN BY SRTCMD
CALL CLRANS ;[376] CLEAR SOME VARIABLES
CALL CLRFIL ;[376] CLEAR FILE FLAGS
CALL IGJFBI ;[377] INIT GTJFN% BLOCK FOR INPUT
MOVE T1,[CS2,,CS2TMP] ;[376] GET BLT POINTER
BLT T1,CS2TMP+TMPLEN ;[376] LOAD THE TEMP SWITCH TABLES
IF THIS IS A SORT COMMAND
SKIPE MRGSW ;[376]
JRST $F ;[376]
THEN REMOVE /CHECK SWITCH
MOVEI T1,CS5TMP ;[376] GET TABLE ADDRESS FOR DELEN
HRROI T2,[ASCIZ\CHECK\] ;[376] GET POINTER TO ENTRY TYPE
CALL DELEN ;[376] DELETE THE ENTRY
FI;
MOVEI T2,FDB1 ;[376] GET FUNCTION DESCRIPTOR BLOCK ADDRESS
CALL PATOM ;GET A SWITCH (/RECORD-SIZE:)
JRST PSWERS ;GIVE THE NO-PARSE ERROR MESSAGE
HRRZ T1,(T2) ;GET DISPATCH ADDRESS
CALL (T1) ;GET THE DECIMAL RECORD SIZE
;NEXT PARSE /KEY:(POSITION AND SIZE)
MOVEI T2,FDB3 ;GET FUNCTION DESCRIPTOR BLOCK ADDRESS
CALL PATOM ;GET A SWITCH (/KEY:)
JRST PSWERS ;GIVE THE NO-PARSE ERROR MESSAGE
HRRZ T1,(T2) ;GET DISPATCH ADDRESS
CALL (T1) ;GET /KEY:ARGUMENTS (POSITION, WIDTH ETC)
JRST PARS20 ;HERE IF /KEY:ARGUMENT TABLE IS EMPTY
JRST PARS21 ;/KEY: PARSED A NON-KEY ARGUMENT
;NEXT PARSE ALL OTHER SWITCHES
PARS20: MOVEI T2,FDB23 ;GET FDB ADDRESS
CALL PATOM ;GET A SWITCH
JRST PSWERR ;GIVE NO-PARSE ERROR MESSAGE
PARS21: HRRZS T3 ;ADDRESS OF FDB THAT PARSED THE ATOM
CAIN T3,FDBI ;SKIP IF INPUT FILESPEC NOT PARSED
JRST PARSI ;GO PROCESS INPUT FILESPEC
HRRZ T1,(T2) ;GET DISPATCH ADDRESS
CAIE T1,CS3KEY ;SKIP IF /KEY
CALL DELK ;DELETE /KEY AS AN OPTION
CALL (T1) ;PERFORM REQUESTED FUNCTION
JRST PARS20 ;LOOP TILL A FILESPEC IS SEEN
JRST PARS21 ;/KEY: PARSED A NON-KEY ARGUMENT
SUBTTL SORT/MERGE COMMANDS -- Continuation of SORT and MERGE -- Input specs
PARSI: PUSH P,T2 ;SAVE INPUT JFN
CALL ALLIN ;GET SPACE FOR FIRST INPUT X.BLOCK
MOVE P1,T1 ;[372] GET INDEX TO X.BLOCK
POP P,X.JFN(P1) ;PLACE JFN IN X.BLOCK
CALL MEMSTK ;SAVE GLOBAL DEFAULTS IN P.????
MOVE T1,MODE ;[375] COLLECT ALL FILE MODES IN MODEM
ORB T1,MODEM ;[375] ..
ANDX T1,RM.ASC!RM.SIX!RM.EBC!RM.BIN!RM.FOR!RM.FPA ;[375] REMEMBER FORTRAN
MOVEM T1,MODE ;[375] AND ALL FILE MODES IN MODE
CALL SETMOD ;[372] DEFAULT DATA MODE AND /FIX/VAR IF NECESSARY
PARSI1: CALL IGJFBI ;INITIALIZE GET JFN BLOCK FOR INPUT
MOVE T1,[CS6A,,CS6TMP] ;GET BLT POINTER
BLT T1,CS6TMP+CS6AS ;MOVE LOCAL SWITCHES TO TEMP AREA
CALL DELGLO ;REMOVE GLOBAL SW'S THAT WERE SET
SKIPE T2,X.JFN(P1) ;ALREADY HAVE JFN FOR FIRST INPUT FILE?
JRST PARSI3 ;YES - SKIP THE NEXT PARSE
MOVEI T2,FDBI ;GET FDB ADDRESS
CALL PATOM ;PARSE A INPUT FILESPEC
JRST PFIERR ;ERROR
PARSI3: AOS NUMINP ;COUNT NUMBER OF INPUT FILES
MOVEM T2,X.JFN(P1) ;SAVE JFN IN X.BLOCK
PARSI5: CALL IGJFBO ;INITIALIZE GET JFN BLOCK FOR OUTPUT
MOVEI T2,FDBC6 ;GET FDB ADDRESS
CALL PATOM ;PARSE COMMA, /LOCAL OR OUT FILESPEC
JRST PSWERR ;NO PARSE, COMPLAIN
HRRZS T3 ;ADDRESS OF FDB THAT PARSED THE ATOM
CAIE T3,FDBC6 ;SKIP IF A COMMA
JRST PARSI7 ;GO TO NEXT CHECK
;WE HAVE A COMMA. FINISH THE PENDING INPUT FILE SPEC AND START UP A NEW ONE.
CALL F.TOX. ;[372] COPY F.???? VARS TO X.???? BLOCK
CALL ALLIN ;GET SPACE FOR THIS INPUT X.BLOCK
MOVE P1,T1 ;[372] GET INDEX TO X.BLOCK
CALL CLRFIL ;CLEAR THE FILE FLAGS
JRST PARSI1 ;GO GET A IN FILESPEC
PARSI7: CAIN T3,FDBO ;SKIP IF NOT AN OUT FILESPEC
JRST PARSO ;GO PROCESS OUT FILESPEC
HRRZ T1,(T2) ;GET DISPATCH ADDRESS
CALL (T1) ;PERFORM REQUESTED FUNCTION
JRST PARSI5 ;TRY FOR MORE IN FILESPEC'S
SUBTTL SORT/MERGE COMMANDS -- Continuation of SORT and MERGE -- Output spec
;WE'VE PARSED THE OUTPUT SPEC. FIRST, FINISH UP LAST INPUT SPEC, THEN HANDLE
;THE OUTPUT SPEC.
PARSO: PUSH P,T2 ;SAVE OUTPUT JFN
CALL F.TOX. ;[372] COPY F.???? VARS TO X.???? BLOCK
CALL ALLOUT ;GET SPACE FOR FIRST OUTPUT X.BLOCK
MOVE P1,T1 ;[372] GET INDEX TO OUTPUT X.BLOCK
POP P,X.JFN(P1) ;PLACE JFN IN X.BLOCK
CALL CLRFIL ;CLEAR FILE FLAGS
MOVE T1,[CS6A,,CS6TMP] ;GET BLT POINTER
BLT T1,CS6TMP+CS6AS ;MOVE LOCAL SWITCHES TO TEMP AREA
IF /FORTRAN WAS NOT SPECIFIED
MOVE T1,MODE ;[372] FETCH MODES FOR THIS SORT
TXNE T1,RM.FOR ;[372] /FORTRAN SPECIFIED?
JRST $F ;[372] YES--DON'T PUT /BLOCKED: BACK IN
THEN PUT /BLOCKED: BACK IN FOR LOCAL OUTPUT SWITCH
MOVE T2,BLKED ;ADDRESS OF TABLE ENTRY
CALL ADDENT ;ADD /BLOCKED:
FI;
PARSO1: MOVEI T2,FDB6R ;GET FDB ADDRESS
CALL PATOM ;PARSE /LOCAL
JRST PSWERS ;NO PARSE, COMPLAIN
PARSO3: HRRZS T3 ;ADDRESS OF PARSING ROUTINE
CAIN T3,FDBR ;WAS IT CRLF?
JRST PARSX ;YES
HRRZ T1,(T2) ;GET DISPATCH ADDRESS
CALL (T1) ;PERFORM REQUESTED FUNCTION
JRST PARSO1 ;GET ANOTHER LOCAL SWITCH
JRST PARSO3 ;/UNIT: PARSED A NON-/UNIT ARGUMENT
PARSX: CALL TAKTST ;TYPE COMMAND IF INPUT FROM TAKE FILE
CALL F.TOX. ;[372] COPY F.???? VARS TO X.???? BLOCK
CALLRET CLRFIL ;CLEAR FILE FLAGS AND RETURN TO CALLER (SORT OR MERGE)
SUBTTL SORT AND MERGE -- /RECORD-SIZE: and Recording Mode Switches
; HERE TO PARSE /RECORD-SIZE
CS1REC: MOVEI T2,[FLDDB. (.CMNUM,,^D10,<record size,>)] ;GET FDB ADDRESS
CALL PNUMB ;PARSE A NUMBER
MOVEM T2,RECORD ;SAVE THE RECORD SIZE
RET
;RECORDING MODE ROUTINES
;ASCII
CS1AAS: MOVX T1,RM.ASC ;GET ASCII FLAG
IORM T1,MODE ;INCLUDE IT IN MODE
CALLRET DELAES ;REMOVE ASCII, EBCDIC AND SIXBIT FROM TABLE
;EBCDIC
CS1AEB: MOVX T1,RM.EBC ;GET FLAG
IORM T1,MODE ;INCLUDE IT IN MODE
CALLRET DELAAE ;REMOVE ALIGN, ASCII, EBCDIC AND SIXBIT FROM TABLE
;SIXBIT
CS1ASI:
MOVX T1,RM.SIX ;GET FLAG
IORM T1,MODE ;INCLUDE IT IN MODE
CALLRET DELAAE ;REMOVE ALIGN, ASCII, EBCDIC AND SIXBIT FROM TABLE
;ALIGN
CS1BAL: MOVEI T1,1 ;GET ALIGN FLAG
MOVEM ALIGN ;SET FLAG
MOVX T1,RM.ASC ;[421] SET ASCII BY DEFAULT
IORM T1,MODE ;[421] ...
CALL DELES ;[421] DELETE SIXBIT AND EBCDIC
JRST DELAB ;[421] DELETE ALIGN AND BINARY
;BINARY
CS1CBI: MOVX T1,RM.BIN ;GET FLAG
IORM T1,MODE ;INCLUDE IT IN MODE
DELAB: CALL DELAL ;[421] DELETE ALIGN
MOVEI T1,CS2TMP ;GET TABLE ADDRESS FOR DELEN
HRROI T2,[ASCIZ\BINARY\] ;GET POINTER TO ENTRY TYPE
CALLRET DELEN ;DELETE THE ENTRY
SUBTTL SORT AND MERGE -- /KEY:
BEGIN
PROCEDURE (PUSHJ P,CS3KEY) ;[375] PARSE /KEY: AND ITS ARGUMENTS
;CS3KEY PARSES THE /KEY: SWITCH WITH ALL OF ITS ARGUMENT, APPENDING A KEY BLOCK
;TO THE KEY LIST. WE RETURN WITH T2 AND T3 SET UP TO THE COMND% DATA, SINCE
;VARIOUS FIELDS MAY FOLLOW /KEY:, AND THE CALLER NEEDS TO FIGURE OUT WHAT IT
;WAS. ALSO, WE GIVE A SKIP RETURN IF ALL ALLOWABLE OPTIONS HAVE BEEN TYPED TO
;THIS /KEY:.
MOVX T1,KY.LEN ;[375] GET A KEY BLOCK
ADDM T1,TOTALC ;[376] REMEMBERING HOW BIG
PUSHJ P,GETSPC ;[375] ..
JRST E$$NEC ;[375] CAN'T
PUSHJ P,CLRSPC ;[375] MAKE SURE IT'S CLEAN
IF THIS IS THE FIRST /KEY: SWITCH
SKIPE FSTKEY ;[375] SEEN ONE YET?
JRST $T ;[375] YES--PUT BLOCK AT END
THEN MAKE THIS BLOCK THE FIRST IN THE LIST
MOVEM T1,FSTKEY ;[375]
JRST $F ;[375]
ELSE PUT SUBSEQUENT BLOCKS AT END OF THE LIST
MOVEM T1,@LSTKEY ;[375]
FI;
MOVEM T1,LSTKEY ;[375] REMEMBER NEW LAST BLOCK
MOVX T1,RM.ASC!RM.SIX!RM.EBC!RM.BIN ;[375] KEEP ONLY RECORDING MODES
ANDM T1,MODE ;[375] FOR NEXT /KEY: SWITCH
MOVEI T2,[FLDDB. (.CMNUM,,^D10,<starting position>)] ;[375] PARSE START POS
PUSHJ P,PNUMB ;[375] ..
SOJL T2,E$$KOR ;[375] ERROR IF .LE. ZERO
MOVE T1,LSTKEY ;[375] STORE STARTING POSITION
MOVEM T2,KY.INI(T1) ;[375] ..
MOVEI T2,FDBC ;[375] PARSE A COMMA
PUSHJ P,PATOM ;[375] ..
JRST PCRERR ;[375] DIDN'T PARSE
MOVEI T2,[FLDDB. (.CMNUM,,^D10,<length>)] ;[375] PARSE KEY LENGTH
PUSHJ P,PNUMB ;[375] ..
JUMPLE T2,E$$KLR ;[375] ERROR IF .LE. TO ZERO
MOVE T1,LSTKEY ;[375] STORE KEY LENGTH
MOVEM T2,KY.SIZ(T1) ;[375] ..
MOVE T1,[CS3A,,TMPTBL] ;[375] COPY KEY MODES TO TEMP TABLE
BLT T1,TMPTBL+CS3AS ;[375] ..
IF /FORMAT: WAS SEEN
MOVE T1,MODEM ;[375] GET KEY MODES SEEN SO FAR
TXNN T1,RM.FPA ;[375] SEEN /FORMAT:?
JRST $T ;[375] NO--TRY /COMP3 THEN
THEN REMOVE /COMP3 (THEY CONFLICT)
HRROI T2,[ASCIZ /COMP3/] ;[375] REMOVE /COMP3
PUSHJ P,DELENT ;[375] ..
JRST $F ;[375]
ELSE
IF /COMP3 WAS SEEN
TXNN T1,RM.PAC ;[375] SEEN /COMP3?
JRST $F ;[375] NO--DONE THEN
THEN DELETE /FORMAT: (THEY CONFLICT)
HRROI T2,[ASCIZ /FORMAT:/] ;[375] REMOVE /FORMAT:
PUSHJ P,DELENT ;[375] ..
FI;
FI;
WHILE MORE /KEY: MODIFIERS TO PARSE
BEGIN
MOVEI T2,FDBC2 ;[375] COMMA OR STUFF AFTER /KEY:
PUSHJ P,PATOM ;[375] ..
JRST $E ;[375] DIDN'T PARSE
HRRZS T3 ;[375] SEE IF IT WAS THE COMMA
CAIE T3,FDBC2 ;[375] ..
JRST [AOS (P) ;[375] NO--DONE WITH /KEY:
JRST $E] ;[375] SO GIVE SKIP RETURN
MOVEI T2,FDBTMP ;[375] IT WAS COMMA--PARSE KEY MODE
PUSHJ P,PATOM ;[375] ..
JRST PARERR ;[375] DIDN'T PARSE
HRRZ T1,(T2) ;[375] DID--CALL PROPER ROUTINE
PUSHJ P,(T1) ;[375] ..
HLRZ T1,TMPTBL ;[375] SEE IF TMPTBL IS NOW EMPTY
JUMPE T1,$E ;[375] YES--GIVE NON-SKIP RETURN
JRST $B ;[375] NO--TRY FOR ANOTHER MODE
END;
MOVE T1,LSTKEY ;[375] DONE WITH THIS /KEY:--STORE MODES
MOVE T4,MODE ;[375] REMEMBERING TO SAVE T2, T3
MOVEM T4,KY.MOD(T1) ;[375] ..
ORM T4,MODEM ;[375] COLLECT ALL MODES IN MODEM
RETURN ;[375] DONE (NOTE POSSIBLE SKIP RETURN)
END;
;ASCENDING
CS3AAS: MOVE T1,LSTKEY ;GET INDEX TO KEY BLOCK
SETZM KY.ORD(T1) ;SET TO ASCENDING
CALLRET DELAD ;DELETE A/DESCENDING FROM SYMBOL TABLE
;DESCENDING
CS3ADE: MOVE T1,LSTKEY ;GET INDEX TO KEY BLOCK
SETOM KY.ORD(T1) ;SET TO DESCENDING
CALLRET DELAD ;DELETE A/DESCENDING FROM SYMBOL TABLE
;ALPHANUMERIC
CS3BAL: MOVX T1,RM.ALP ;GET ALPHANUMERIC FLAG
IORM T1,MODE ;SET IT
CALL DELACC ;DELETE SOME ARGUMENTS FROM SYMBOL TABLE
CALLRET DELSU ;DELETE SIGNED AND UNSIGNED
;COMP1
CS3BC1: MOVX T1,RM.COM ;GET COMPUTATIONAL FLAG
IORM T1,MODE ;SET IT
CALLRET DELACC ;DELETE SOME ARGUMENTS FROM SYMBOL TABLE
;COMP3
CS3BC3: CALL DELA ;DELETE ASCII
CALL DELS ;DELETE SIXBIT
MOVX T1,RM.PAC ;GET COMP-3 FLAG
IORM T1,MODE ;SET IT
CALLRET DELAAC ;DELETE ALIGN,ALPHA,COMP1,COMP3,COMPU,FORMAT,NUMERIC
;COMPUTATIONAL
CS3BCO: MOVX T1,RM.COM ;GET COMPUTATIONAL FLAG
IORM T1,MODE ;SET IT
CALLRET DELACC ;DELETE SOME ARGUMENTS FROM SYMBOL TABLE
;FORMAT
CS3BFO: CALL DELES ;DELETE EBCDIC AND SIXBIT
CALL PCOLON ;IF THER'S A COLON PARSE IT
CALL PSPACE ;SKIP OVER THE SPACE/TABS
MOVEI T2,[FLDDB. (.CMUQS,,UQSMSK,<FORTRAN FORMAT descriptor>)] ;GET FDB ADDRESS
CALL PATOM ;GET SWITCH ARGUMENT
JRST PARERR ;GIVE NO-PARSE ERROR
MOVE T1,CPSAV ;GET POINTER TO FORMAT ARGUMENT
CAMN T1,CMDBLK+.CMPTR ;SKIP IF NOT NULL
JRST PARERR ;NULL ARGUMENTS ARE ILLEGAL
MOVE T2,[POINT 6,.NMUL] ;POINTER TO STORAGE AREA FOR USRFMT
CS3BF1: CAMN T1,CMDBLK+.CMPTR ;SKIP INTO THE LOOP IF NOT DONE
JRST CS3BF2 ;GO STICK A NULL ON THE END
ILDB T3,T1 ;GET AN ASCII CHAR
SUBI T3,40 ;CHANGE TO SIXBIT
IDPB T3,T2 ;STORE SIXBIT CHAR
JRST CS3BF1 ;LOOP
CS3BF2: SETZ T3, ;GET A NULL
IDPB T3,T2 ;TERMINATE THE STRING
CALL USRFMT ;GO CHECK THE UNQUOTED FORMAT STRING
CALLRET DELACC ;DELETE SOME ARGUMENTS FROM SYMBOL TABLE
;NUMERIC
CS3BNU: MOVX T1,RM.NUM ;GET NUMERIC FLAG
IORM T1,MODE ;SET IT
CALLRET DELACC ;DELETE SOME ARGUMENTS FROM SYMBOL TABLE
;SIGNED
CS3CSI: MOVX T1,RM.SGN ;GET SIGNED FLAG
IORM T1,MODE ;SET IT
HRROI T2,[ASCIZ\ALPHANUMERIC\] ;GET POINTER TO ENTRY TYPE
CALL DELENT ;DELETE THE ENTRY
CALLRET DELSU ;DELETE SIGNED AND UNSIGNED
;UNSIGNED
CS3CUN: MOVX T1,RM.UNS ;GET UNSIGNED FLAG
IORM T1,MODE ;SET IT
HRROI T2,[ASCIZ\ALPHANUMERIC\] ;GET POINTER TO ENTRY TYPE
CALL DELENT ;DELETE THE ENTRY
CALLRET DELSU ;DELETE SIGNED AND UNSIGNED
SUBTTL SORT AND MERGE -- File Switches -- /BLOCKED:n, /FIXED, /FORTRAN
SUBTTL SORT AND MERGE -- File Switches -- /RANDOM, /SEQUENTIAL, /VARIABLE
;EACH FILE SWITCH (INCLUDING FILE FORMAT AND TAPE SWITCHES) HAS TWO VARIABLES
;ASSOCIATED WITH IT. THE P.???? VARIABLE IS A GLOBAL VALUE SET BY THE FILE
;SWITCH TYPED BEFORE ALL FILE SPECIFICATIONS, AND THE F.???? VARIABLE IS THE
;PARTICULAR (LOCAL) VALUE FOR THE PRECEEDING FILE. ALL VARIABLES ARE INITIALIZED
;TO -1 PRIOR TO SCANNING A LINE, SO THAT ALL VALID SWITCH VALUES SHOULD BE
;NON-NEGATIVE. EACH SWITCH PROCESSING ROUTINE SETS ONLY THE ASSOCIATED F.????
;VARIABLE. THEN, WHEN THE FIRST FILE SPECIFICATION IS SEEN, MEMSTK IS CALLED TO
;MOVE THE F.???? VALUES TO THE P.???? VARIABLES AND CLRFIL IS CALLED TO
;REINITIALIZE THE F.???? VARIABLES. THE F.???? VARIABLES ARE THEN SET FOR ANY
;LOCAL SWITCHES, UNTIL THE NEXT FILE SPECIFICATION OR THE END OF THE LINE IS
;DETECTED. WHEN THIS OCCURS, F.TOX. IS CALLED TO APPLY ANY GLOBAL VALUES TO
;THOSE SWITCHES THAT WERE NOT SPECIFIED (STILL -1), AND TO PACK THIS DATA INTO
;THE FILE'S X.???? BLOCK FOR THE REST OF SORT.
BEGIN
PROCEDURE (PUSHJ P,CS4ABL) ;[372] /BLOCKED:n FROM TABLE CS4A
MOVEI T2,[FLDDB. (.CMNUM,,^D10,<COBOL blocking factor,>)] ;[372]
PUSHJ P,PNUMB ;[372] PARSE BLOCKING FACTOR
JUMPL T2,ERRSVN ;[372] SWITCH VALUE NEGATIVE
MOVEM T2,F.BLKF ;[372] SAVE VALUE IN FILE VAR
PJRST DEL4BF ;[372] REMOVE /BLOCKED: AND /FORTRAN
END;
BEGIN
PROCEDURE (PUSHJ P,<CS4AFI,CS4ARA>) ;[372] /FIXED OR /RANDOM FROM TABLE CS4A
SKIPL F.VARI ;[372] /FIXED OR /VAR SET ALREADY?
JRST ERRCFV ;[372] YES--CONFLICT WITH /FIXED, /VAR
SETZM F.VARI ;[372] SET /FIXED
PJRST DELFRS ;[372] REMOVE /FIX, /RAN, /VAR, /SEQ
END;
BEGIN
PROCEDURE (PUSHJ P,CS4AFO) ;[372] /FORTRAN FROM TABLE CS4A
MOVX T1,RM.FOR ;[372] SET /FORTRAN
ORM T1,MODE ;[372] ..
PJRST DEL4AB ;[372] REMOVE /FORTRAN AND /BLOCKED:
END;
BEGIN
PROCEDURE (PUSHJ P,<CS4AVA,CS4ASE>) ;[372] /VAR OR /SEQ FROM TABLE CS4A
SKIPL F.VARI ;[372] /FIXED OR /VAR SET ALREADY?
JRST ERRCFV ;[372] YES--CONFLICT WITH /FIXED, /VAR
MOVX T1,1 ;[372] SET /VARIABLE
MOVEM T1,F.VARI ;[372] ..
PJRST DELFRS ;[372] REMOVE /FIX, /RAN, /VAR, /SEQ
END;
SUBTTL SORT AND MERGE -- File Switches -- Apply Global Defaults
BEGIN
PROCEDURE (PUSHJ P,F.TOX.) ;[372] FILL IN X. BLOCK WITH SWITCHES
;F.TOX. IS CALLED AFTER A FILE SPEC AND ITS LOCAL SWITCHES HAVE BEEN READ. WE
;APPLY GLOBAL DEFAULTS (SAVED IN THE P.???? VARIABLES) TO THE LOCAL VALUES (IN
;THE F.???? VARIABLES), AND COPY THE RESULTS INTO THE CURRENT X. BLOCK. FINALLY,
;WE FILL IN ANY REMAINING X.???? FIELDS.
PUSHJ P,APPSTK ;[372] APPLY GLOBAL (STICKY) DEFAULTS
;FULL WORD SWITCHES.
SKIPGE T1,F.BLKF ;[372] COPY /BLOCKED:n
SETZ T1, ;[372] WITH DEFAULT OF 0
MOVEM T1,X.BLKF(P1) ;[372] ..
SKIPGE T1,F.DENS ;[372] COPY /DENSITY:
MOVX T1,.SJDDN ;[372] WITH DEFAULT OF SYSTEM'S
MOVEM T1,X.DEN(P1) ;[372] ..
SKIPGE T1,F.LABL ;[372] COPY /LABEL:
MOVX T1,LABSTANDARD ;[372] WITH DEFAULT OF STANDARD
MOVEM T1,X.LABL(P1) ;[372] ..
;FLAG (ONE BIT) SWITCHES.
MOVE T1,X.FLG(P1) ;[372] GET FLAGS FOR SPEED
SKIPLE F.REW ;[372] SHOULD WE SET /REWIND?
TXO T1,FI.REW ;[372] YES
SKIPLE F.UNL ;[372] SHOULD WE SET /UNLOAD?
TXO T1,FI.UNL ;[372] YES
SKIPLE F.INDU ;[372] SHOULD WE SET /INDUSTRY?
TXO T1,FI.IND ;[372] YES
SKIPLE F.PARI ;[372] SHOULD WE SET /PARITY:EVEN?
TXO T1,FI.EVN ;[372] YES
SKIPLE F.STDA ;[372] SHOULD WE SET /ANSI-ASCII?
TXO T1,FI.STA ;[372] YES
SKIPLE F.VARI ;[372] SHOULD WE SET /VARIABLE?
TXO T1,FI.VAR ;[372] YES
MOVEM T1,X.FLG(P1) ;[372] SAVE FLAGS BACK
;GET DEVICE CHARACTERISTICS.
MOVE T1,X.JFN(P1) ;[372] GET THE JFN
DVCHR% ;[372] GET CHARACTERISTICS
ERJMP TYLSEH ;[372] OOPS
MOVEM T2,X.DVCH(P1) ;[372] SAVE IT
RETURN ;[372] DONE
END;
SUBTTL SORT AND MERGE -- Control Switches -- /PHYSICAL, /CHECK, /COLLATE:x[:y]
BEGIN
PROCEDURE (PUSHJ P,CS5APH) ;[372] /PHYSICAL FROM TABLE CS5A
MOVX T1,1 ;[372] SET /PHYSICAL
MOVEM T1,PHYSIC ;[372] ..
PUSHJ P,IGJFBI ;[372] REINITIALIZE GTJFN% BLOCK
MOVEI T1,CS6TMP ;[372] DELETE /PHYSICAL
HRROI T2,[ASCIZ /PHYSICAL/] ;[372] ..
PJRST DELEN ;[372] ..
END;
;CHECK (RECORD SEQUENCE OF MERGE INPUT FILES)
CS5ACH: HRROI T2,[ASCIZ/RECORD SEQUENCE OF MERGE INPUT FILES/] ;GET NOISE FIELD
CALL SKPNOI ;PARSE NOISE FIELD
RET ;FAILED, RETURN FAILURE
MOVEI T1,1 ;GET CHECK FLAG
MOVEM WSCSW ;SET CHECK FLAG
MOVEI T1,CS5TMP ;GET TABLE ADDRESS FOR DELEN
HRROI T2,[ASCIZ\CHECK\] ;GET POINTER TO ENTRY TYPE
CALLRET DELEN ;DELETE THE ENTRY
;COLLATE
CS5COL: MOVEI T2,[FLDDB. (.CMKEY,,CS5B)] ;GET FDB ADDRESS
CALL PATOM ;GET /COLLATE: ARGUMENT
JRST PARERR ;OOPS
HRRZ T1,(T2) ;GET COLLATE FLAG
HRROM T1,COLSW ;SAVE IT AWAY
MOVEI T1,CS5TMP
HRROI T2,[ASCIZ \COLLATE:\]
CALL DELEN
HRRZ T1,COLSW
JRST @[EXP CPOPJ,CPOPJ,.+1,CS5CO3,CS5CO4]-1(T1) ;DISPATCH
CALL PCOLON ;IF THER'S A COLON PARSE IT
CALL CLRGJF ;CLEAR GET JFN BLOCK
MOVX T1,GJ%OLD ;GET THE FILE MUST EXIST FLAG
MOVEM T1,GJFBLK+.GJGEN ;SET IT
MOVEI T2,FDBI ;GET FDB ADDRESS
CALL PATOM ;GET A FILESPEC
JRST PFCERR ;OOPS
MOVEM T2,COLJFN ;SAVE THE JFN
MOVE T1,T2 ;JFN TO T1
DVCHR% ;[335] GET DEVICE CHARACTERISTICS
ERJMP TYLSEH ;OOPS
LOAD T1,DV%TYP,T2 ;GET DEVICE TYPE
CAIE T1,.DVTTY ;SKIP IF A TTY
RET
TYCM (?,CSF,<COLLATING SEQUENCE file may not reside on TTY>)
MOVE P,SAVREP ;RESET P
MOVE T1,COLJFN
RLJFN% ;[335] GIVE BACK JFN
ERJMP RJFERR ;FAILED
JRST PARSE
SUBTTL SORT AND MERGE -- Control Switches -- /SUPPRESS:x
CS5CO3: CALL PCOLON ;IF THERE'S A COLON PARSE IT
SETZM UQSMS2 ;CLEAR BREAK CHARACTER MASK BIT TABLE
MOVE T1,[UQSMS2,,UQSMS2+1] ;GET BLT FROM,TO POINTER
BLT T1,UQSMS2+3 ;ZERO THE BITS
CALL PSPACE ;GET NEXT NONSPACE/TAB TO T1
CALL GNCHAR ;GET NEXT CHARACTER TO T1
HRLZI T0,(1B0) ;GET BREAK CHARACTER MASK
IDIVI T1,^D32 ;GET POSITION AND INDEX
MOVNS T2 ;NEGATE THE POSITION
LSH T0,(T2) ;POSITION MASK OVER THE BREAK CHARACTER
MOVEM T0,UQSMS2(T1) ;STICK IT IN THE TABLE
MOVEI T2,[FLDDB. (.CMUQS,,UQSMS2)] ;GET FDB ADDRESS
CALL PATOM ;GET THE LITERAL
JRST PARERR ;OOPS
MOVE T1,CPSAV ;GET POINTER TO BEG OF LITERAL
MOVE T2,[POINT 7,COLITB] ;GET POINTER TO DESTINATION BUFFER
MOVEI T3,COLITS ;GET SIZE OF LITERAL BUFFER
CS5CO5: CAMN T1,CMDBLK+.CMPTR ;SKIP IF NOT THE DELIMITER
JRST CS5CO7 ;WERE DONE
ILDB T0,T1 ;GET A CHAR
IDPB T0,T2 ;STICK IT IN LITERAL BUFFER
SOJG T3,CS5CO5 ;LOOP IF BUFFER NOT FULL
JRST LTLERR ;LITERAL TOO LONG FOR COLLATING SEQUENCE
CS5CO7: SETZ T0, ;GET A NULL
IDPB T0,T2 ;TERMINATE THE STRING
CALLRET GNCHAR ;GOBBLE UP THE TRAILING DELIMITER
CS5CO4: CALL PCOLON ;IF THER'S A COLON PARSE IT
PUSHJ P,PUPARO ;SEE IF FORMAL PARAMETER IE "^"
JRST CS5C41 ;NOT AN UPARROW
CALL PNUMBE ;PARSE A NUMBER
CALL CUPARO ;CHECK ARG AND CONVERT IT
JRST CS5C42 ;FINISH UP
CS5C41: MOVEI T2,[FLDDB. (.CMNUM,,8)] ;GET A FUNCTION DESCRIPTOR BLOCK ADDERSS
CALL PNUMB ;PARSE A NUMBER
CS5C42: MOVEM T2,COLBUF ;SAVE THE COLLATING SEQUENCE TABLE ADDRESS
RET
;/SUPPRESS-ERROR
CS5SUP: MOVEI T2,[FLDDB. (.CMKEY,,CS5C)] ;GET FDB ADDRESS
CALL PATOM ;GET /SUPPRESS: ARGUMENT
JRST PARERR ;OOPS
HRRZ T1,(T2) ;GET SUPPRESS FLAG
MOVEM T1,SUPFLG ;SAVE IT AWAY
MOVEI T1,CS5TMP ;[426] TABLE ADDR FOR DELEN
HRROI T2,[ASCIZ\SUPPRESS-ERROR:\];[426]POINTER TO ENTRY TYPE
CALLRET DELEN ;[426] DELETE THE ENTRY FROM TABLE
SUBTTL SORT AND MERGE -- Control Switches -- /BUFFER-PAGES:n, /LEAVES:n
SUBTTL SORT AND MERGE -- Control Switches -- /ERROR-RETURN:^x, /FATAL-ERROR-CODE:^x
;/BUFFER-PAGES
CS5ABP: MOVEI T2,[FLDDB. (.CMNUM,,^D10)] ;GET A FUNCTION DESCRIPTOR BLOCK ADDERSS
CALL PNUMBE ;PARSE A NUMBER
MOVEM T2,CORSIZ ;SAVE THE NUMBER OF PAGES
MOVEI T1,CS5TMP ;GET TABLE ADDRESS FOR DELEN
HRROI T2,[ASCIZ\BUFFER-PAGES:\] ;GET POINTER TO ENTRY TYPE
CALLRET DELEN ;DELETE THE ENTRY
;/LEAVES
CS5ALE: MOVEI T2,[FLDDB. (.CMNUM,,^D10,<number of records to keep in main memory,>)] ;GET FDB ADDRESS
CALL PNUMB ;PARSE A NUMBER
MOVEM T2,LEANUM ;SAVE NUMBER OF LEAVES
MOVEI T1,CS5TMP ;GET TABLE ADDRESS FOR DELEN
HRROI T2,[ASCIZ\LEAVES:\] ;GET POINTER TO ENTRY TYPE
CALLRET DELEN ;DELETE THE ENTRY
;/ERROR-RETURN
CS5AER: PUSHJ P,PUPARO ;SEE IF FORMAL PARAMETER IE "^"
JRST CS5ER1 ;NOT AN UPARROW
CALL PNUMBE ;PARSE A NUMBER
CALL CUPARO ;CHECK ARG AND CONVERT IT
JRST CS5ER2 ;FINISH UP
CS5ER1: MOVEI T2,[FLDDB. (.CMNUM,,8)] ;GET A FUNCTION DESCRIPTOR BLOCK ADDERSS
CALL PNUMB ;PARSE A NUMBER
CS5ER2: MOVEM T2,ERRADR ;SAVE FATAL ERROR RETURN ADDRESS
MOVEI T1,CS5TMP ;GET TABLE ADDRESS FOR DELEN
HRROI T2,[ASCIZ\ERROR-RETURN:\] ;GET POINTER TO ENTRY TYPE
CALLRET DELEN ;DELETE THE ENTRY
;/FATAL-ERROR-CODE
CS5FEC: PUSHJ P,PUPARO ;SEE IF FORMAL PARAMETER IE "^"
JRST CS5EC1 ;NOT AN UPARROW
CALL PNUMBE ;PARSE A NUMBER
CALL CUPARO ;CHECK ARG AND CONVERT IT
JRST CS5EC2 ;FINISH UP
CS5EC1: MOVEI T2,[FLDDB. (.CMNUM,,8)] ;GET A FUNCTION DESCRIPTOR BLOCK ADDERSS
CALL PNUMB ;PARSE A NUMBER
CS5EC2: MOVEM T2,FERCOD ;SAVE THE FATAL ERROR CODE ADDRESS
MOVEI T1,CS5TMP ;GET TABLE ADDRESS FOR DELEN
HRROI T2,[ASCIZ\FATAL-ERROR-CODE:\] ;GET POINTER TO ENTRY TYPE
CALLRET DELEN ;DELETE THE ENTRY
SUBTTL SORT AND MERGE -- Control Switches -- /TEMPORARY-AREA:x,y,...
;TEMP
CS5ATE: MOVEI T1,CS5TMP ;GET TABLE ADDRESS FOR DELEN
HRROI T2,[ASCIZ\TEMPORARY-AREA:\] ;GET POINTER TO ENTRY TYPE
CALL DELEN ;DELETE THE ENTRY
SETZM STRNUM ;INITIALIZE THE NUMBER OF TEMP FILES
CS5TE1: MOVEI T2,[FLDDB. (.CMDIR)] ;GET FDB ADDRESS
CALL PATOM ;PARSE A DEVICE/DIRECTORY
JRST PDERR ;NO-PARSE SO COMPLAIN
AOS T1,STRNUM ;COUNT THE NUMBER OF TEMP DIRECTORIES
ADDI T1,STRNAM-1 ;GET INDEX TO CURRENT ENTRY
CAIGE T1,STRNAM+MX.TMP ;CAN ONLY HANDLE SO MANY TEMP DIRS
MOVEM T2,(T1) ;SAVE THE DIRECTORY NUMBER
MOVEI T2,FDBC2 ;GET FDB ADDRESS - COMMA, SWITCH OR INPUT
CALL PATOM ;PARSE AN ATOM
JRST PSWERR ;NO-PARSE SO COMPLAIN
HRRZS T3 ;ADDRESS OF FDB THAT PARSED THE ATOM
CAIN T3,FDBC2 ;SKIP IF IT WAS NOT A COMMA
JRST CS5TE1 ;COMMA SO DIRECTORY IS NEXT
RETSKP ;SOME OTHER SWITCH WAS PARSED
SUBTTL SORT AND MERGE -- Magtape Switches -- /ANSI-ASCII, /DENSITY:n
SUBTTL SORT AND MERGE -- Magtape Switches -- /INDUSTRY-COMPATIBLE, /LABEL:x
BEGIN
PROCEDURE (PUSHJ P,CS6ANS) ;[372] /ANSI-ASCII FROM TABLE CS6A
MOVX T1,1 ;[372] REMEMBER ANSI-ASCII WAS SPEC
MOVEM T1,F.STDA ;[372] ..
;The following three lines are in version 4 and 4A uncommented and the PJRST DELAA is omitted
; MOVEI T1,CS6TMP ;[372] DELETE /ANSI-ASCII FROM TABLE
; HRROI T2,[ASCIZ /ANSI-ASCII/] ;[372] ..
; PJRST DELEN ;[372] ..
PJRST DELAA ;[372*] DELETE /ANSI-AS CII FROM TABLE
END;
BEGIN
PROCEDURE (PUSHJ P,CS6ADE) ;[372] /DENSITY: FROM TABLE CS6A
MOVEI T2,[FLDDB. (.CMKEY,,CS6D,,<SYSTEM-DEFAULT>)] ;[372] PARSE VALUE
PUSHJ P,PATOM ;[372] ..
JRST PARERR ;[372] ILLEGAL VALUE
HRRZ T1,(T2) ;[372] GET CODE ASSOCIATED WITH KEYWORD
MOVEM T1,F.DENS ;[372] SAVE AS VALUE
MOVEI T1,CS6TMP ;[372] REMOVE /DENSITY: FROM TABLE
HRROI T2,[ASCIZ /DENSITY:/] ;[372] ..
PJRST DELEN ;[372] ..
END;
BEGIN
PROCEDURE (PUSHJ P,CS6AIN) ;[372] /INDUSTRY FROM TABLE CS6A
MOVX T1,1 ;[372] SET /INDUSTRY-COMPATIBLE
MOVEM T1,F.INDU ;[372] ..
MOVEI T1,CS6TMP ;[372] DELETE /INDUSTRY FROM TABLE
HRROI T2,[ASCIZ /INDUSTRY-COMPATIBLE/] ;[372] ..
PJRST DELEN ;[372] ..
END;
BEGIN
PROCEDURE (PUSHJ P,CS6ALA) ;[372] /LABEL: FROM TABLE CS6A
MOVEI T2,[FLDDB. (.CMKEY,,CS6B,,<STANDARD>)] ;[372] PARSE VALUE
PUSHJ P,PATOM ;[372] ..
JRST PARERR ;[372] ILLEGAL VALUE
HRRZ T1,(T2) ;[372] GET CODE ASSOCIATED WITH KEYWORD
MOVEM T1,F.LABL ;[372] SET LABEL TYPE
MOVEI T1,CS6TMP ;[372] NOW DELETE /LABEL:
HRROI T2,[ASCIZ /LABEL:/] ;[372] ..
PJRST DELEN ;[372] ..
END;
SUBTTL SORT AND MERGE -- Magtape Switches -- /PARITY:x, /REWIND, /UNLOAD
BEGIN
PROCEDURE (PUSHJ P,CS6APA) ;[372] /PARITY: FROM TABLE CS6A
MOVEI T2,[FLDDB. (.CMKEY,,CS6C,,<ODD>)] ;[372] PARSE VALUE
PUSHJ P,PATOM ;[372] ..
JRST PARERR ;[372] DIDN'T PARSE
HRRZ T1,(T2) ;[372] GET MONITOR'S SETJB% VALUE
MOVEM T1,F.PARI ;[372] SAVE AS SWITCH VALUE
MOVEI T1,CS6TMP ;[372] DELETE /PARITY: FROM TABLE
HRROI T1,[ASCIZ /PARITY:/] ;[372] ..
PJRST DELEN ;[372] ..
END;
BEGIN
PROCEDURE (PUSHJ P,CS6ARE) ;[372] /REWIND FROM TABLE CS6A
MOVX T1,1 ;[372] SET /REWIND
MOVEM T1,F.REW ;[372] ..
MOVEI T1,CS6TMP ;[372] REMOVE /REWIND
HRROI T2,[ASCIZ /REWIND/] ;[372] ..
PJRST DELEN ;[372]
END;
BEGIN
PROCEDURE (PUSHJ P,CS6AUN) ;[372] /UNLOAD FROM TABLE CS6A
MOVX T1,1 ;[372] SET /UNLOAD
MOVEM T1,F.UNL ;[372] ..
MOVEI T1,CS6TMP ;[372] REMOVE /UNLOAD
HRROI T2,[ASCIZ /UNLOAD/] ;[372] ..
PJRST DELEN ;[372] ..
END;
SUBTTL PARSING SUBROUTINES
; ROUTINE TO PARSE AN END-OF-COMMAND
;
; CALL: CALL ENDCOM
; RETURNS: +1 BAD CONFIRMATION, MESSAGE ALREADY ISSUED
; +2 SUCCESS, COMMAND CONFIRMED
ENDCOM: MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMCFM)] ;GET FUNCTION BLOCK FOR CONFIM
COMND% ;[335] PARSE CONFIRMATION
ERJMP CMDERR ;ERROR, GO CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;VALID END-OF-COMMAND SEEN ?
JRST [ CALLRET CFMERR ] ;NO, ISSUE ERROR MESSAGE AND RETURN
CALL TAKTST ;OUTPUT COMMAND LINE IF DOING TAKE COMMAND
RETSKP ;SUCCESS, RETURN
; ROUTINE TO PARSE NOISE PHRASE
;
; CALL: T2/ POINTER TO NOISE PHRASE
; CALL SKPNOI
; RETURNS: +1 ERROR, INVALID NOISE PHRASE
; +2 SUCCESS, NOISE PHRASE PARSED OK
SKPNOI: MOVE T1,[NOIFDB,,NOIFDB+1] ;SET UP TO CLEAR FUNCTION DESCRIPTOR BLOCK
SETZM NOIFDB ;CLEAR FIRST WORD OF BLOCK
BLT T1,NOIFDB+FDBSIZ-1 ;CLEAR FUNCTION DESCRIPTOR BLOCK
MOVX T1,.CMNOI ;GET FUNCTION TO PERFORM
STOR T1,CM%FNC,NOIFDB ;STORE FUNCTION CODE IN FDB
MOVEM T2,NOIFDB+.CMDAT ;STORE POINTER TO NOISE PHRASE IN FDB
MOVEI T1,CMDBLK ;GET ADDRESS OF COMMAND STATE BLOCK
MOVEI T2,NOIFDB ;GET ADDRESS OF FUNCTION BLOCK
COMND% ;[335] PARSE NOISE WORD
ERJMP CMDERR ;ERROR, GO CHECK FOR EOF ON TAKE FILE
TXNN T1,CM%NOP ;NOISE PHRASE PARSED OK ?
RETSKP ;YES, RETURN SUCCESS
TYCM (?,IGP,<Invalid guide phrase>)
CALLRET TYPATM ;OUTPUT THE TEXT ENTERED AND RETURN
; PSPACE - EATS SPACES AND TABS
PSPACE: MOVEI T2,[FLDDB. (.CMUQS,,UQSMS1)] ;GET FDB ADR
CALL PATOM ;EAT EM
JRST PARERR ;OOPS - NO PARSE
RET
; PCOMND - ROUTINE TO PARSE A COMMAND KEYWORD
;
; ACCEPTS IN T2 ADDRESS OF FUNCTION DESCRIPTOR BLOCK
; CALL PCOMND
; RETURNS: +1 ALWAYS
PCOMND: MOVEI T1,CMDBLK ;GET POINTER TO COMMAND STATE BLOCK
COMND% ;[335] DO INITIAL PARSE
ERJMP CMDERR ;ERROR, GO CHECK FOR EOF ON TAKE FILE
TXNN T1,CM%NOP ;VALID PARSE?
SETZM ATMBFR ;YES, CLEAR FOR NEXT PARSE FAILURE
TXNN T1,CM%NOP ;VALID COMMAND ENTERED ?
RET ;YES, GO DISPATCH TO PROCESSING ROUTINE
TYCM (?,NSC,<No such command as >)
CALL TYPATM ;TYPE THE LAST ATOM
JRST PARSE ;GO TRY TO GET A SWITCH AGAIN
; PATOM - ROUTINE TO PARSE AN ARGUMENT, COMMA, KEYWORD, OR SWITCH
;
; ACCEPTS IN T2 ADDRESS OF FUNCTION DESCRIPTOR BLOCK
; CALL PATOM
; RETURNS: +1 IF ATOM NOT PARSED
; +2 IF PARSED
;
PATOM: MOVE T1,CMDBLK+.CMPTR ;GET POINTER TO CURRENT ATOM
MOVEM T1,CPSAV ;SAVE, TYPE FROM HERE IF ATOM BUFFER IS EMPTY
MOVEI T1,CMDBLK ;GET POINTER TO COMMAND STATE BLOCK
COMND% ;[335] DO INITIAL PARSE
ERJMP CMDERR ;ERROR, GO CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;VALID PARSE?
RET ;NO, TAKE THE NO-PARSE RETURN
SETZM ATMBFR ;[365] YES, CLEAR FOR NEXT PARSE FAILURE
RETSKP ;[365] AND TAKE A SKIP EXIT
;PNUMB - ALTERNATE ENTRY POINT TO PNUMBE
; T2 ALREADY INITIALIZE
;PNUMBE - ROUTINE TO PARSE A NUMBER
;
; CALL PNUMBE
;RETURNS: +1 ALWAYS
;
;AC2 CONTAINS THE NUMBER
PNUMB: SKIPA ;ENTER HERE WITH T2 INITIALIZED
PNUMBE: MOVEI T2,[FLDDB. (.CMNUM,,^D10)] ;GET FDB ADDRESS
MOVE T1,CMDBLK+.CMPTR ;GET POINTER TO CURRENT ATOM
MOVEM T1,CPSAV ;SAVE, TYPE FROM HERE IF ATOM BUFFER IS EMPTY
MOVEI T1,CMDBLK ;GET POINTER TO COMMAND STATE BLOCK
COMND% ;[335] DO INITIAL PARSE
ERJMP CMDERR ;ERROR, GO CHECK FOR EOF ON TAKE FILE
TXNN T1,CM%NOP ;VALID PARSE?
SETZM ATMBFR ;YES, CLEAR FOR NEXT PARSE FAILURE
TXNN T1,CM%NOP ;VALID COMMAND ENTERED ?
RET ;YES, JUST RETURN
TYCM(?,NVN,<>)
CALL TYPATM ;TYPE THE LAST ATOM
TMSG < not a valid number>
JRST PARSE
;HERE TO PARSE A COLON IF A KEYWORD (.CMKEY) WAS LAST
PCOLON: MOVE T1,CMDBLK+.CMPTR ;GET POINTER TO CURRENT ATOM
MOVEM T1,CPSAV ;SAVE, TYPE FROM HERE IF ATOM BUFFER IS EMPTY
ILDB T1,T1 ;GET PREVIOUS TERMINATOR
CAIE T1,":" ;SEE IF IT WAS A COLON
RET ;NOT A COLON SO JUST RETURN
MOVEI T1,CMDBLK ;SEE IF ":" IS NEXT IN COMMAND STRING
MOVEI T2,[FLDDB. (.CMTOK,,<POINT 7,[ASCIZ\:\]>)] ;GET FDB ADDRESS
COMND% ;[335] PARSE THE ":"
ERJMP CMDERR ;OOPS
TXNN T1,CM%NOP ;DID IT PARSE
RET ;YES, RETURN
JRST PARERR ;IMPOSSIBLE!!
; HERE TO PARSE AN UPARROW - SKIP EXIT ON SUCCESS
PUPARO: MOVEI T1,CMDBLK ;SEE IF "^" IS NEXT IN COMMAND STRING
MOVEI T2,[FLDDB. (.CMTOK,CM%SDH,<POINT 7,[ASCIZ\^\]>,<octal address>)] ;GET FDB ADDRESS
COMND% ;[335] PARSE THE "^"
ERJMP CMDERR ;OOPS
TXNN T1,CM%NOP ;DID IT PARSE
AOS (P) ;SKIP EXIT IF SO
RET
; CUPARO - RANGE CHECK THE NUMBER OF THE ARG AND GET VALUE
CUPARO: CAMLE T2,ARGCNT ;IS IT IN RANGE?
JRST FEAERR ;NO
ADD T2,ARGLST ;ADD IN BASE
MOVEI T2,@-1(T2) ;GET ACTUAL
RET
; SCHAR - GET THE NEXT CHARACTER FROM COMMAND BUFFER TO T1
GNCHAR: ILDB T1,CMDBLK+.CMPTR ;GET CHAR
SOS CMDBLK+.CMCNT ;ONE CHARACTER SPACE LESS
SOS CMDBLK+.CMINC ;ONE UNPARSED CHARACTER LESS
RET
SUBTTL ERROR MESSAGES
;ATOM DID NOT PARSE - SWITCH OR FILE SPEC
PSWERR: PUSH P,T3 ;SAVE IT
MOVE T3,CPSAV ;GET POINTER TO LAST ATOM
MOVE T2,CMDBLK+.CMINC ;GET NUMBER OF CHARS IN COMMAND BUFFER
PSWER1: ILDB T1,T3 ;GET A CHAR
SOJL T2,PSWER2 ;JUMP IF NONE LEFT
CAIE T1," " ;IGNORE SPACE
CAIN T1," " ; AND TAB
JRST PSWER1 ;IGNORE THEM
PSWER2: POP P,T3 ;RESTORE IT
CAIN T1,"/" ;PREVIOUS ATOM A SWITCH?
JRST PSWERS ;YES
;ASSUME A FILE SPEC
MOVSS T3 ;WERE WE LOOKING FOR AN INPUT OR OUTPUT FILE?
CAIE T3,FDBO ;OUTPUT FILE?
CAIN T3,FDB6O ;LOCAL SWITCHES THEN OUTPUT FILE?
JRST PFOERR ;YES, OUTPUT FILE ERROR
CAIN T3,FDBC6 ;COMMA THEN LOCAL SWS THEN OUTPUT FILE?
JRST PFOERR ;YES, OUTPUT FILE ERROR
JRST PFIERR ;INPUT FILE ERROR
PSWERS: PUSH P,CMDBLK+.CMCNT ;SAVE DATA SO REPARSE WILL WORK
PUSH P,CMDBLK+.CMINC ; ..
PUSH P,CMDBLK+.CMPTR ; ..
MOVEI T2,FDBLGS ;GET FDB ADR FOR ALL LEGAL SWITCHES
CALL PATOM ;SEE IF THIS WAS A KNOWN SWITCH
TDZA T1,T1 ;NOP
SETOM T1 ;YEP
POP P,CMDBLK+.CMPTR ; ..
POP P,CMDBLK+.CMINC ;RESTORE DATA
POP P,CMDBLK+.CMCNT ; ..
JUMPN T1,PSWER5 ;JUMP IF A KNOWN SWITCH
TYCM (?,NSS,<No such switch as>)
CALL TYPATM ;TYPE THE LAST ATOM
JRST PARSE ;GO TRY TO GET A SWITCH AGAIN
PSWER5: TYCM (?,TFS,<The following switch is illegal at this point in the command string.>)
CALL TYPATM ;TYPE THE LAST ATOM
JRST PARSE
;SWITCH ARGUMENT DID NOT PARSE
PARERR: TYCM (?,NSA,<No such switch argument as>)
CALL TYPATM ;TYPE THE LAST ATOM
JRST PARSE ;GO TRY TO GET A SWITCH ARGUMENT AGAIN
;COMMA DID NOT PARSE
PCRERR: TYCM (?,CRQ,<Comma required.>)
JRST PARSE ;START OVER
; RLJFN% JSYS FAILED
RJFERR: TYCM (?,CRJ,<Cannot release JFNs on a reparse>)
CALL TYPLSE ;TYPE WHY NOT
JRST ENTVEC+1
; PARSE DIRECTORY NAME FAILURE
PDERR: TYCM (?,CPD,<Cannot parse directory name>)
CALL TYPATM ;TYPE THE DIRECTORY NAME
JRST TYLSEP ;TYPE LAST SYSTEM ERROR THEN PARSE
; PARSE DEVICE DESIGNATOR FAILURE
PDVERR: TYCM (?,PDV,<Cannot parse device name>)
CALL TYPATM ;TYPE THE DIRECTORY NAME
JRST TYLSEP ;TYPE LAST SYSTEM ERROR THEN PARSE
; PARSE INPUT FILESPEC FAILED
PFIERR: TYCM (?,IIF,<Invalid input file specification, >)
JRST TYLSEP ;TYPE LAST SYSTEM ERROR THEN PARSE
; PARSE OUTPUT FILESPEC FAILED
PFOERR: TYCM (?,IOF,<Invalid output file specification, >)
JRST TYLSEP ;TYPE LAST SYSTEM ERROR THEN PARSE
; PARSE /COLATE:FILE: FILESPEC FAILED
PFCERR: TYCM (?,ICF,<Invalid collate file specification, >)
JRST TYLSEP ;TYPE LAST SYSTEM ERROR THEN PARSE
; INVALID END-OF-COMMAND
CFMERR: TYCM (?,GAE,<Garbage at end-of-command
>) ;OUTPUT ERROR MESSAGE
RET ;RETURN TO WHENCE WE CAME ...
; /COLLATE:LITERAL "LITERAL TOO LONG ERROR....."
LTLERR: TYCM (?,LTL,<Literal too long for collating sequence>)
JRST PARSE
; /ERROR OR /FATAL
FEAERR: TYCM (?,FEA,<Formal arg exceeds actual arg count>)
JRST PARSE
ERRSVN: PUSH P,T2 ;[372] SAVE SWITCH VALUE
$ERROR (?,SVN,<Switch value negative >,+)
POP P,T1 ;[372] RESTORE SWITCH VALUE
$MORE (DECIMAL,T1) ;[372] INCLUDE IT IN MESSAGE
$MORE (TEXT,<.>) ;[372]
$CRLF ;[372] COMPLETE THE LINE
PRSERR: SETOM ERRORF ;[372] SIGNAL AN ERROR SO PARSE WILL
JRST PARSE ;[372] UNWIND AND RETURN FOR FORTRAN
ERRCFV: $ERROR (?,CFV,<Conflict with /FIXED and /VARIABLE.>,,PRSERR)
SUBTTL GENERAL SUBROUTINES
; HERE TO RELEASE ALL JFNS ASSIGNED BY SRTCMD
RLSJFN: SKIPN P1,F.INZR ;SKIP IF ANY INPUT X.BLOCKS
JRST RLSJF2 ;NONE - TRY FOR OUTPUT JFNS
RLSJF1: SKIPE T1,X.JFN(P1) ;SKIP IF THERE IS NO JFN
RLJFN% ;[335] THERE IS SO RELEASE IT
ERJMP RJFERR ;OOPS
SKIPE P1,X.NXT(P1) ;GET INDEX TO NEXT X.BLOCK
JRST RLSJF1 ;LOOP FOR NEXT X.BLOCK
RLSJF2: EXCH P1,F.OUZR ;ZERO F.OUZR
JUMPN P1,RLSJF1 ;NOW LOOP THRU THE OUTPUT X.BLOCKS
SETZM F.INZR ;CLEAR THE INDEXES
SETZM F.OUZR
RET
; HERE TO ALLOCATE SPACE FOR THE INPUT X.BLOCK
; F.INZR POINTS TO THE LAST X.BLOCK APPENDED TO THE LIST
ALLIN: MOVX T1,LN.X ;GET SIZE OF SPACE
ADDM T1,TOTALC ;[376] COUNT TOWARD SPACE USED ON THIS LINE
PUSHJ P,GETSPC ;GET THE SPACE, ADDRESS IN T1
JRST E$$NEC ;OOPS
CALL CLRSPC ;CLEAR SPACE
MOVE T2,F.INZR ;GET POINTER TO CURRENT X.BLOCK
MOVEM T2,X.NXT(T1) ;MAKE CURRENT BECOME THE PREVIOUS X.BLOCK
MOVEM T1,F.INZR ;POINT F.INZR TO CURRENT X.BLOCK
RET
; HERE TO ALLOCATE SPACE FOR THE OUTPUT X.BLOCK
; F.INZR POINTS TO THE LAST X.BLOCK APPENDED TO THE LIST
ALLOUT: MOVX T1,LN.X ;GET SIZE OF SPACE
ADDM T1,TOTALC ;[376] COUNT TOWARD SPACE USED ON THIS LINE
PUSHJ P,GETSPC ;GET THE SPACE, ADDRESS IN T1
JRST E$$NEC ;OOPS
CALL CLRSPC ;CLEAR SPACE
MOVE T2,F.OUZR ;GET POINTER TO CURRENT X.BLOCK
MOVEM T2,X.NXT(T1) ;MAKE CURRENT BECOME THE PREVIOUS X.BLOCK
MOVEM T1,F.OUZR ;POINT F.INZR TO CURRENT X.BLOCK
RET
BEGIN
PROCEDURE (PUSHJ P,IGJFBI) ;[372] INITIALIZE GTJFN% BLOCK
;INITIALIZE GJFBLK BY CLEARING IT AND SETTING UP USEFUL FLAGS. IF /PHYSICAL WAS
;SPECIFIED, THEN ENFORCE IT BY SETTING GJ%PHY. ENTRY IGJFBI SETS UP THE BLOCK TO
;REQUEST AN INPUT (ALREADY EXISTING) FILE SPECIFICATION, AND ENTRY IGJFBO SETS
;UP THE BLOCK FOR AN OUTPUT (NEXT GENERATION) FILE SPECIFICATION.
IGJFBI: SKIPA T2,[GJ%OLD] ;[372] FOR INPUT
IGJFBO: MOVX T2,GJ%FOU ;[372] OR ALTERNATELY FOR OUTPUT
PUSHJ P,CLRGJF ;[372] ZERO BLOCK FIRST
SKIPLE PHYSIC ;[372] IF /PHYSICAL WAS SET
TXO T2,GJ%PHY ;[372] THEN MAKE GTJFN% ENFORCE IT
MOVEM T2,.GJGEN+GJFBLK ;[372] STORE NEW FLAGS
RETURN ;[372] DONE
END;
BEGIN
PROCEDURE (PUSHJ P,CLRGJF) ;[372] ZERO GTJFN% BLOCK
;CLRJFN CLEARS GJFBLK AND SETS .GJSRC TO NUL:. DESTROYS T1.
ZERO (T1,GJFBLK,GJFSIZ) ;[372] ..
MOVX T1,<.NULIO,,.NULIO> ;[372] SORT NEVER READS FROM A JFN
MOVEM T1,.GJSRC+GJFBLK ;[372] SO SAY SO
RETURN ;[372] DONE
END;
; ROUTINE TO OUTPUT COMMAND LINE TO TERMINAL IF PROCESSING TAKE FILE
;
; CALL: CALL TAKTST
; RETURNS: +1 ALWAYS, COMMAND LINE OUTPUT IF NEEDED
TAKTST: SKIPN TAKFLG ;COMMANDS COMING FROM FILE ?
RET ;NO
HRROI T1,BUFFER ;GET POINTER TO COMMAND LINE
SKIPN FORTPP ;DONT TYPE IF CALLED FROM FORTRAN
PSOUT% ;[335] OUTPUT COMMAND LINE
HRRZ T1,CMDBLK+.CMIOJ ;GET DESTINATION JFN
HRROI T2,BUFFER ;GET COMMAND LINE POINTER
SETZ T3,
CAIE T1,.PRIOU ;SKIP IF PRIMARY OUT DEVICE
SOUT% ;[335]
RET ;RETURN
;CMDERR - ROUTINE TO PROCESS ERRORS ON EXECUTING A COMND% JSYS
; IF END OF FILE REACHED ON A TAKE FILE, THE NEXT COMMAND
; IS SIMPLY PROCESSED. ELSE AN ERROR MESSAGE IS ISSUED AND
; THE PROGRAM IS RESTARTED.
;
; CALL: JRST CMDERR
CMDERR: SKIPN TAKFLG ;PROCESSING A TAKE FILE ?
JRST CMER10 ;NO, GO ISSUE ERROR MESSAGE
HLRZ T1,CMDBLK+.CMIOJ ;GET INPUT FILE JFN FOR TAKE FILE
GTSTS% ;[335] GET THE FILE'S STATUS
TXNN T2,GS%EOF ;AT END OF FILE ?
JRST CMER10 ;NO, GIVE AN ERROR MESS
CALL TAKEX ;YES, CLOSE TAKE FILES
MOVE P,SAVREP ;RESET P
SKIPN FORTPP ;SKIP IF CALLED FROM FORTRAN
JRST PARSE ;GET NEXT COMMAND
JRST FORXIT ;RETURN TO FORTRAN
CMER10: TYCM (?,UCJ,<Unexpected COMND% JSYS error, restarting...
>) ;OUTPUT MESSAGE
CALL TYPLSE ;TYPE OUT THE LAST ERROR
SKIPE FORTPP ;SKIP IF NOT CALLED FROM ELSEWHERE (FORTRAN)
JRST PARSE ;ENSURE THE CORRECT ERROR EXIT
JRST ENTVEC+1 ;GO SIMULATE A "REENTER"
; HERE TO DELETE LOCAL SWITCHES THAT ARE ALREADY SET AS GLOBALS
DELGLO: MOVEI T1,CS6TMP ;[372] GET TABLE ADDRESS
HRROI T2,[ASCIZ\INDUSTRY-COMPATIBLE\] ;GET POINTER TO ENTRY TYPE
SKIPL P.INDU ;[372] GLOBAL FLAG SET?
CALL DELEN ;YES, DELETE ENTRY
;The following two lines are in the code for version 4 and 4A
; MOVEI T1,CS6TMP ;GET TABLE ADDRESS
; HRROI T2,[ASCIZ\ANSI-ASCII\] ;GET POINTER TO ENTRY TYPE
SKIPL P.STDA ;[372] GLOBAL FLAG SET?
;The following line is a CALL DELEN in versioN 4 and 4A
CALL DELAA ;YES, DELETE ANSI-ASCII
MOVEI T1,CS6TMP ;GET TABLE ADDRESS
HRROI T2,[ASCIZ\REWIND\] ;GET POINTER TO ENTRY TYPE
SKIPL P.REW ;[372] GLOBAL FLAG SET?
CALL DELEN ;YES, DELETE ENTRY
MOVEI T1,CS6TMP ;GET TABLE ADDRESS
HRROI T2,[ASCIZ\UNLOAD\] ;GET POINTER TO ENTRY TYPE
SKIPL P.UNL ;[372] GLOBAL FLAG SET?
CALL DELEN ;YES, DELETE ENTRY
RET ;[372] DONE
;HERE TO DELETE ALIGN PLUS RECORDING MODE FROM TABLE CS2TMP
DELAAE: CALL DELAL ;DELETE ALIGN
; HERE TO DELETE THREE ENTRIES FROM RECORDING-MODE TABLE CS2TMP
DELAES: CALL DELA ;DELETE ASCII
DELES: CALL DELE ;DELETE EBCDIC
DELS: MOVEI T1,CS2TMP ;GET TABLE ADDRESS
HRROI T2,[ASCIZ\SIXBIT\] ;GET POINTER TO ENTRY TYPE
CALLRET DELEN ;DELETE THE ENTRY
;DELETE ASCII AND MAYBE ANSI-ASCII
DELA: MOVEI T1,CS2TMP ;GET TABLE ADDRESS
HRROI T2,[ASCIZ\ASCII\] ;GET POINTER TO ENTRY TYPE
CALL DELEN ;DELETE ASCII
MOVE T1,MODE ;GET RECORDING MODE
TXNE T1,RM.ASC ;SKIP IF NOT "ASCII"
RET ;ASCII SO ANSI-ASCII STILL LEGAL
;The label DELAA does not exist in versons 4 and 4A
DELAA: MOVEI T1,CS6TMP ;TABLE ADDRESS
HRROI T2,[ASCIZ\ANSI-ASCII\] ;POINTER TO ENTRY TYPE
CALLRET DELEN ;DELETE THE ENTRY
;DELETE EBCDIC
DELE: MOVEI T1,CS2TMP ;GET TABLE ADDRESS
HRROI T2,[ASCIZ\EBCDIC\] ;GET POINTER TO ENTRY TYPE
CALLRET DELEN ;DELETE THE ENTRY
;HERE TO DELETE ENTRIES FROM THE /KEY: ARGUMENT TABLE TMPTBL
DELAD: HRROI T2,[ASCIZ\ASCENDING\] ;GET POINTER TO ENTRY TYPE
CALL DELENT ;DELETE THE ENTRY
HRROI T2,[ASCIZ\DESCENDING\] ;GET POINTER TO ENTRY TYPE
CALLRET DELENT ;DELETE THE ENTRY
DELAAC: CALL DELA ;DELETE ALIGN
DELACC: HRROI T2,[ASCIZ\ALPHANUMERIC\] ;GET POINTER TO ENTRY TYPE
CALL DELENT ;DELETE THE ENTRY
HRROI T2,[ASCIZ\COMP1\] ;GET POINTER TO ENTRY TYPE
CALL DELENT ;DELETE THE ENTRY
HRROI T2,[ASCIZ\COMP3\] ;GET POINTER TO ENTRY TYPE
CALL DELENT ;DELETE THE ENTRY
HRROI T2,[ASCIZ\COMPUTATIONAL\] ;GET POINTER TO ENTRY TYPE
CALL DELENT ;DELETE THE ENTRY
HRROI T2,[ASCIZ\FORMAT:\] ;GET POINTER TO ENTRY TYPE
CALL DELENT ;DELETE THE ENTRY
HRROI T2,[ASCIZ\NUMERIC\] ;GET POINTER TO ENTRY TYPE
CALLRET DELENT ;DELETE THE ENTRY
DELSU: HRROI T2,[ASCIZ\SIGNED\] ;GET POINTER TO ENTRY TYPE
CALL DELENT ;DELETE THE ENTRY
HRROI T2,[ASCIZ\UNSIGNED\] ;GET POINTER TO ENTRY TYPE
CALLRET DELENT ;DELETE THE ENTRY
DEL4AB: CALL DELAL ;DELETE ALIGN
DEL4BF: MOVEI T1,CS4TMP ;GET TABLE ADDRESS FOR DELEN
HRROI T2,[ASCIZ\BLOCKED:\] ;GET POINTER TO ENTRY TYPE
CALL DELEN ;DELETE THE ENTRY
MOVEI T1,CS4TMP ;GET TABLE ADDRESS FOR DELEN
HRROI T2,[ASCIZ\FORTRAN\] ;BLOCKED IMPLIES COBOL
CALL DELEN ; SO GET RID OF FORTRAN
MOVEI T1,CS6TMP ;GET TABLE ADDRESS FOR DELEN
HRROI T2,[ASCIZ\BLOCKED:\] ;GET POINTER TO ENTRY TYPE
CALLRET DELEN ;DELETE THE ENTRY
DELFRS: MOVEI T1,CS4TMP ;GET TABLE ADDRESS
HRROI T2,[ASCIZ\FIXED\] ;GET POINTER TO ENTRY TYPE
CALL DELEN ;DELETE THE ENTRY
MOVEI T1,CS4TMP ;GET TABLE ADDRESS
HRROI T2,[ASCIZ\RANDOM\] ;GET POINTER TO ENTRY TYPE
CALL DELEN ;DELETE THE ENTRY
MOVEI T1,CS4TMP ;GET TABLE ADDRESS
HRROI T2,[ASCIZ\SEQUENTIAL\] ;GET POINTER TO ENTRY TYPE
CALL DELEN ;DELETE THE ENTRY
MOVEI T1,CS4TMP ;GET TABLE ADDRESS
HRROI T2,[ASCIZ\VARIABLE\] ;GET POINTER TO ENTRY TYPE
CALLRET DELEN ;DELETE THE ENTRY
DELAL: MOVEI T1,CS2TMP ;GET TABLE ADDRESS
HRROI T2,[ASCIZ\ALIGN\] ;GET POINTER TO ENTRY TYPE
CALLRET DELEN ;DELETE THE ENTRY
DELK: PUSH P,T1 ;SAVE T1
MOVEI T1,CS3TMP ;GET TABLE ADDR
HRROI T2,[ASCIZ\KEY:\] ;GET PTR TO ENTRY TYPE
CALL DELEN ;DELETE /KEY:
POP P,T1 ;RESTORE T1
RET
;DELENT - ROUTINE TO DELETE A SWITCH OR SWITCH ARGUMENT FROM A KEYWORD
; SYMBOL TABLE. IT DOES A TBLUK% TO LOCATE THE APPROPIATE ENTRY
; AND THEN A TBDEL% TO DELETE IT.
;
;SETUP: T1 HAS SYMBOL TABLE ADDRESS
; T2 HAS ASCIZ POINTER TO TYPE OF ENTRY TO BE DELETED
;CALL: CALL DELENT
;RET: +1 ALWAYS
DELENT: MOVEI T1,TMPTBL ;GET TABLE ADDRESS
DELEN: ;ENTER HERE WITH T1 ALREADY INITIALIZED
MOVEM T1,DELTBL ;[335] SAVE TABLE ADDRESS FOR TBDEL%
MOVEM T2,DELTBE ;SAVE ENTRY TYPE FOR ERROR MESSAGE
TBLUK% ;[335] FIND ENTRY'S ADDRESS FOR TBDEL%
TXNN T2,TL%EXM ;AN EXACT MATCH?
RET ;NO, ASSUME SOME OTHER FUNCTION DELETED IT
MOVE T2,T1 ;GET TABLE ENTRY ADDRESS
MOVE T1,DELTBL ;GET TABLE ADDRESS
TBDEL% ;[335] DELETE IT FROM THE TABLE
ERJMP DEDERR ;OOPS
RET
DEDERR: TYCM (?,UTD,<Unable to delete table entry ">)
MOVE T1,DELTBE ;GET POINTER TO ENTRY
CALL TYPMSG ;TYPE IT
TMSG <", restarting...>
JRST ENTVEC+1 ;SIMULATE A "REENTER"
;ADDENT - ROUTINE TO ADD A SWITCH TO A KEYWORD TABLE.
; T1 HAS TABLE ADDRESS
; T2 HAS ADDRESS OF TABLE ENTRY
ADDENT:MOVEI T1,CS6TMP ;GET TABLE ADDRESS
TBADD% ;[335]
ERJMP ADDERR ;OOPS
RET
ADDERR: TYCM (?,UTA,<Unable to add table entry ">)
MOVE T1,DELTBE ;GET POINTER TO ENTRY
CALL TYPMSG ;TYPE IT
TMSG <", restarting...>
CALL TYPLSE ;TYPE LAST SYSTEM ERROR
JRST ENTVEC+1 ;SIMULATE A "REENTER"
; ROUTINE TO TYPE ERROR CODE AND LAST SYSTEM ERROR
TYLSEH: TYCM (?,LSE,<>) ;TYPE "?"
TYLSEP: ;ENTER HERE TO AVOID THE ERROR CODE
CALL TYPLSE ;TYPE THE LAST SYSTEM ERROR
JRST PARSE
; TYPE A MESSAGE AND CALL TYPLSE
TYCMPR: CALL SUPMSG ;SUPPRESS MESSAGE?
RET ;YES
CALL TYCMR ;TYPE THE MESSAGE
CALLRET TYPLSE ;TYPE THE LAST SYSTEM ERROR
; SUBROUTINE TO TYPE MESSAGE AT BEGINNING OF LINE
TYCMR: CALL SUPMSG ;SUPPRESS MESSAGE?
RET ;YES
PUSH P,T1 ;SAVE POINTER TO MESSAGE
CALL TSTCOL ;GO TO BEGINNING OF LINE
POP P,T1 ;RESTORE T1
CALLRET TYPMSG ;TYPE THE MESSAGE
; ROUTINE TO OUTPUT THE JSYS MESSAGE ON AN ERROR FROM A GTJFN OR OPENF
;
; CALL: CALL TYPLSE
; RETURNS: +1 ALWAYS
TYPLSE: SKIPGE SUPFLG ;SUPPRESS IT?
RET ;YES
MOVX T1,.PRIOU ;GET PRIMARY OUTPUT JFN
HRLOI T2,.FHSLF ;OUR FORK, LAST ERROR CODE
SETZM T3 ;
ERSTR% ;[335] OUTPUT ERROR STRING
JFCL ;IGNORE
JFCL ;IGNORE
;NOW - OUTPUT THE SAME TO THE TAKE LOG FILE
HRRZ T1,CMDBLK+.CMIOJ ;GET DESTINATION JFN
HRLOI T2,.FHSLF ;OUR FORK, LAST ERROR CODE
SETZM T3 ;
CAIE T1,.PRIOU ;SKIP IF PRIMARY JFN
ERSTR% ;[335] OUTPUT ERROR STRING
JFCL ;IGNORE
JFCL ;IGNORE
TMSG <
> ;OUTPUT NEW LINE
RET ;RETURN TO WHENCE WE CAME ...
;TYPATM - ROUTINE TO TYPE THE CONTENTS OF THE ATOM BUFFER
;
; CALL TYPATM
;RETURNS: +1 ALWAYS
TYPATM: SKIPGE SUPFLG ;SUPPRESS IT?
RET ;YES
TMSG < "> ;OUTPUT PUNCTUATION
LDB T1,[POINT 7,ATMBFR,6] ;GET FIRST CHAR OF ATOM
JUMPE T1,TYPAT1 ;JUMP IF NULL ATOM
HRROI T1,ATMBFR ;GET POINTER TO THE ATOM BUFFER
CALL TYPMSG ;OUTPUT THE STRING
JRST TYPATX
TYPAT1: PUSH P,CMDBLK+.CMPTR
PUSH P,CMDBLK+.CMCNT
PUSH P,CMDBLK+.CMINC
MOVEI T2,[FLDDB. (.CMUQS,,UQSMS3)] ;PASSOVER LEADING BREAK CHARS
CALL PATOM ; TAB SPACE COMMA SLASH COLON
JRST TYPAT2 ;OUTPUT WHATEVER IS THERE
MOVEI T2,[FLDDB. (.CMUQS,,UQSMS4)] ;PARSE EVERYTHING BUT BREAK CHARS
CALL PATOM ;PASSOVER THE ATOM
JRST TYPAT2 ;OUTPUT WHAT'S THERE
MOVEI T1,0 ;GET A NULL
IDPB T1,CMDBLK+.CMPTR ;TERMINATE THE ATOM
TYPAT2: POP P,CMDBLK+.CMINC
POP P,CMDBLK+.CMCNT
POP P,CMDBLK+.CMPTR
MOVE T1,CPSAV ;GET POINTER TO LAST ATOM IN CMD BUFFER
CALL TYPMSG ;TYPE IT
TYPATX: TMSG <" > ;OUTPUT END OF LINE
RET ;RETURN
; SUBROUTINE TO TEST COLUMN POSITION AND OUTPUT CRLF IF NEEDED
TSTCOL: MOVEI T1,.PRIOU ;GET PRIMARY OUTPUT DESIGNATOR
RFPOS% ;[335] READ FILE POSITION
HRRZ T2,T2 ;KEEP JUST THE COLUMN POSITION
JUMPE T2,RETN ;IF AT COLUMN 1 DO NOT OUTPUT CRLF
TMSG <
> ;NO, OUTPUT A CRLF
RETN: RET ;RETURN TO WHENCE WE CAME ...
; HERE TO SEND ERROR MESSAGE TO TERMINAL AND "TAKE" LOG FILE
TYPMSG: SETOM ERRORF ;WE HAVE A PROBLEM
MOVE T2,T1 ;GET COPY OF ASCIZ STRING POINTER
PSOUT% ;[335] SEND MESSAGE TO TERMINAL
HRRZ T1,CMDBLK+.CMIOJ
MOVEI T3,0
CAIE T1,.PRIOU
SOUT% ;[335] AND TO THE "TAKE" LOG FILE
RET
; SUPPRESS ERROR MESSAGE IF REQUESTED TO DO SO
SUPMSG: HRRES SUPFLG ;[372] CLEAR LAST CALL
SKIPGE SUPFLG ;[372] IF NEVER BEEN SET BY SWITCH
SETZM SUPFLG ;[372] CLEAR THE PRE-SCAN INITIAL VALUE
LDB T3,[POINT 7,(T1),6] ;[372] GET ERROR CODE
CAIN T3,"?" ;FATAL?
MOVEI T3,SUPFATAL
CAIN T3,"%" ;WARNING?
MOVEI T3,SUPWARN
CAIN T3,"[" ;INFORMATION?
MOVEI T3,SUPINFO
CAIN T3,SUPFATAL ;IS THIS ERROR FATAL?
SKIPG FERCOD ;YES, DOES USER WANT CODE RETURNED?
JRST SUPMS1 ;NO
LDB T2,[POINT 7,(T1),34];GET FIRST CHAR
SUBI T2,40 ;SIXBITIZE
DPB T2,[POINT 6,@FERCOD,23]
LDB T2,[POINT 7,1(T1),6] ;GET FIRST CHAR
SUBI T2,40 ;SIXBITIZE
DPB T2,[POINT 6,@FERCOD,29]
LDB T2,[POINT 7,1(T1),13];GET FIRST CHAR
SUBI T2,40 ;SIXBITIZE
DPB T2,[POINT 6,@FERCOD,35]
HRRZI T2,'SRT' ;GET PROGRAM CODE
HRLM T2,@FERCOD ;SAVE IT
SUPMS1: CAMLE T3,SUPFLG ;ARE WE ALLOWED TO PRINT IT?
AOSA (P) ;YES
HRROS SUPFLG ;NO, AND NOT FOR $MORE EITHER
RET
SUBTTL DEFINITIONS -- Constants and Tables
DEFINE TB(RTN,TXT)<
[ASCIZ/TXT/] ,, RTN
>
CT1: CT1SIZ ,, CT1SIZ ;CURRENT,,MAX SIZE OF COMMAND TABLE
TB (CT1EXI,EXIT) ;EXIT TO MONITOR LEVEL
TB (CT1HEL,HELP) ;HELP MESSAGES
TB (CT1MER,MERGE) ;MERGE THE INPUT FILES
TB (.RUN,RUN) ;RUN PROGRAM
TB (CT1SOR,SORT) ;SORT INPUT-FILES
TB (CT1TAK,TAKE) ;TAKE COMMANDS FROM FILE-SPEC
CT1SIZ==.-1-CT1
CS1: CS1S ,, CS1S ;CURRENT,,MAX SIZE OF COMMAND TABLE
TB (CS1REC,RECORD-SIZE:)
CS1S==.-1-CS1
CS3A: CS3AS ,, CS3AS ;CURRENT,,MAX SIZE OF CMD TBL
TB (CS3BAL,ALPHANUMERIC) ;
TB (CS3AAS,ASCENDING) ;
TB (CS3BC1,COMP1) ;
TB (CS3BC3,COMP3) ;
TB (CS3BCO,COMPUTATIONAL) ;
TB (CS3ADE,DESCENDING) ;
TB (CS3BFO,FORMAT:) ;
TB (CS3BNU,NUMERIC) ;
TB (CS3CSI,SIGNED) ;
TB (CS3CUN,UNSIGNED) ;
CS3AS==.-1-CS3A
;***** CS2: CS3: CS4A: CS5A: CS6A: MUST BE CONTIGUOUS *****
CS2: CS2S ,, CS2S ;CURRENT,,MAX SIZE OF CMD TBL
TB (CS1BAL,ALIGN) ;
TB (CS1AAS,ASCII) ;
TB (CS1CBI,BINARY) ;
TB (CS1AEB,EBCDIC) ;
TB (CS1ASI,SIXBIT) ;
CS2S==.-1-CS2
CS3: CS3S ,, CS3S ;CURRENT,,MAX SIZE OF CMD TBL
TB (CS3KEY,KEY:) ;
CS3S==.-1-CS3
CS4A: CS4AS ,, CS4AS ;CURRENT,,MAX SIZE OF CMD TBL
BLKED: TB (CS4ABL,BLOCKED:) ;
TB (CS4AFI,FIXED) ;
TB (CS4AFO,FORTRAN) ;
TB (CS4ARA,RANDOM) ;
TB (CS4ASE,SEQUENTIAL) ;
TB (CS4AVA,VARIABLE) ;
CS4AS==.-1-CS4A
CS5A: CS5AS ,, CS5AS ;CURRENT,,MAX SIZE OF CMD TBL
TB (CS5ABP,BUFFER-PAGES:) ;
TB (CS5ACH,CHECK) ;
TB (CS5COL,COLLATE:) ;
TB (CS5AER,ERROR-RETURN:) ;
TB (CS5FEC,FATAL-ERROR-CODE:) ;
TB (CS5ALE,LEAVES:) ;
TB (CS5APH,PHYSICAL) ;
TB (CS5SUP,SUPPRESS-ERROR:) ;
TB (CS5ATE,TEMPORARY-AREA:) ;
CS5AS==.-1-CS5A
CS6A: CS6AS-1 ,, CS6AS ;CURRENT,,MAX SIZE OF CMD TBL
TB (CS6ANS,ANSI-ASCII) ;
TB (CS6ADE,DENSITY:) ;
TB (CS6AIN,INDUSTRY-COMPATIBLE) ;
TB (CS6ALA,LABEL:) ;
TB (CS6APA,PARITY:) ;
TB (CS6ARE,REWIND) ;
TB (CS6AUN,UNLOAD) ;
BLOCK 1 ;ROOM FOR /BLOCKED:
CS6AS==.-1-CS6A
;***** CS2: CS3: CS4A: CS5A: CS6A: MUST BE CONTIGUOUS *****
CS5B: CS5BS ,, CS5BS ;CURRENT,,MAX SIZE OF CMD TBL
TB (COLADD,ADDRESS:) ;
TB (COLASC,ASCII) ;
TB (COLEBC,EBCDIC) ;
TB (COLFIL,FILE:) ;
TB (COLLIT,LITERAL:) ;
; TB (COLUAS,UPPER-ASCII)
; TB (COLUEB,UPPER-EBCDIC)
CS5BS==.-1-CS5B
CS5C: CS5CS ,, CS5CS ;CURRENT,,MAX SIZE OF CMD TBL
TB (SUPALL,ALL) ;
TB (SUPFAT,FATAL) ;
TB (SUPINF,INFORMATION) ;
TB (SUPNON,NONE)
TB (SUPWAR,WARNING) ;
CS5CS==.-1-CS5C
CS6B: CS6BS ,, CS6BS ;CURRENT,,MAX SIZE OF CMD TBL
TB (LABANS,ANSI) ;
TB (LABDEC,DEC) ;
TB (LABIBM,IBM) ;
TB (LABNON,NONSTANDARD) ;
TB (LABOMI,OMITTED) ;
TB (LABSTA,STANDARD) ;
CS6BS==.-1-CS6B
CS6C: CS6CS ,, CS6CS ;CURRENT,,MAX SIZE OF CMD TBL
TB (.SJPRE,EVEN) ;
TB (.SJPRO,ODD) ;
CS6CS==.-1-CS6C
CS6D: CS6DS,,CS6DS ;CURRENT,,MAX SIZE OF CMD TBK
TB (.SJD16,1600) ;
TB (.SJDN2,200) ;
TB (.SJDN5,556) ;LH IS DENSITY
TB (.SJD62,6250) ;[422] ADD 6250 BPI
TB (.SJDN8,800) ;
TB (.SJDDN,SYSTEM-DEFAULT)
CS6DS==.-1-CS6D
;FUNCTION DESCRIPTOR BLOCKS
FDBRV: FLDDB. (.CMCFM,,,,<SORT>,FDBV)
FDBV: FLDDB. (.CMKEY,,CT1)
FDB1: FLDDB. (.CMSWI,,CS1,,</RECORD-SIZE:>)
FDB3: FLDDB. (.CMSWI,,CS3TMP,,</KEY:>) ;KEY
FDBTMP: FLDDB. (.CMKEY,,TMPTBL)
FDBC: FLDDB. (.CMCMA,,,,<,>)
FDBC2: FLDDB. (.CMCMA,,,,,FDB23) ;COMMA
FDB23: FLDDB. (.CMSWI,,CS2TMP,<recording mode,>,,FDB34) ;MODE
FDB34: FLDDB. (.CMSWI,,CS3TMP,,,FDB45) ;KEY
FDB45: FLDDB. (.CMSWI,,CS4TMP,<file switches,>,,FDB56) ;FILE
FDB56: FLDDB. (.CMSWI,,CS5TMP,<control switches,>,,FDB6I) ;CONTROL
FDB6I: FLDDB. (.CMSWI,,CS6TMP,<tape switches,>,,FDBI) ;TAPE
FDBI: FLDDB. (.CMFIL) ;INPUT FILESPEC
FDBC6: FLDDB. (.CMCMA,,,,,FDB6O) ;COMMA
FDB6O: FLDDB. (.CMSWI,,CS6TMP,<local switches,>,,FDBO) ;LOCAL SWITCHES
; *** WARNING *** DO NOT COMBINE FDBI AND FDBO
FDBO: FLDDB. (.CMFIL,CM%SDH,,<output filespec>) ;OUTPUT FILESPEC
FDBC6R: FLDDB. (.CMCMA,,,,,FDB6R) ;COMMA
FDB6R: FLDDB. (.CMSWI,,CS6TMP,<local switches,>,,FDBR) ;LOCAL
FDBR: FLDDB. (.CMCFM)
; THE FOLLOWING FDBS ARE FOR PROCESSING ERROR MESSAGES - SEE PSWERR
FDBLGS: FLDDB. (.CMSWI,,CS1,,,FDBLG2)
FDBLG2: FLDDB. (.CMSWI,,CS2,,,FDBLG3)
FDBLG3: FLDDB. (.CMSWI,,CS3,,,FDBLG4)
FDBLG4: FLDDB. (.CMSWI,,CS4A,,,FDBLG5)
FDBLG5: FLDDB. (.CMSWI,,CS5A,,,FDBLG6)
FDBLG6: FLDDB. (.CMSWI,,CS6A)
;UNQUOTED STRING MASK (SEE TEXTI JSYS)
UQSMSK: 777777,,777760 ;MASK FOR FORMAT ARGUMENT
777764,,000770
400000,,000760
400000,,000740
UQSMS1: 777377,,777777 ;TAB
377777,,777777 ;SPACE
777777,,777777
777777,,777777
UQSMS2: BLOCK 4 ;MASK FOR COLLATING SEQ LITERAL STRING
UQSMS3: 777377,,777760 ;TAB
375773,,776777 ;SPACE COMMA SLASH COLON
777777,,777760 ;
777777,,777760 ;
UQSMS4: 777777,,777760 ;ALL CTRL CHARS
402004,,001020 ;SPACE COMMA SLASH COLON QUESTION
000000,,000000 ;
000000,,000000 ;
PROMPT: ASCIZ /SORT>/ ;PROMPT STRING
HLPFIL: ASCIZ \SYS:SORT.HLP\ ;NAME OF THE HELP FILE
SUBTTL DEFINITIONS -- Low Segment Data
SEGMENT LOW
;THE FOLLOWING IS TEMP STORAGE FOR SWITCH TABLES
CS2TMP: BLOCK CS2S+1
CS3TMP: BLOCK CS3S+1
CS4TMP: BLOCK CS4AS+1
CS5TMP: BLOCK CS5AS+1
CS6TMP: BLOCK CS6AS+1
;TMPLEN IS LENGTH OF ALL TEMP SWITCH TABLES
TMPLEN=CS2S+1+CS3S+1+CS4AS+1+CS5AS+1+CS6AS+1-1
TOTALC: BLOCK 1 ;[376] TOTAL WORDS ALLOCATED FOR CURRENT LINE
FOR2ND: BLOCK 1 ;[376] -1 MEANS WE'VE DONE A FORTRAN COMMAND
F.DENS: BLOCK 1 ;[372] LOCAL /DENSITY: VALUE
F.PARI: BLOCK 1 ;[372] LOCAL /PARITY: VALUE
P.DENS: BLOCK 1 ;[372] GLOBAL /DENSITY: VALUE
P.PARI: BLOCK 1 ;[372] GLOBAL /PARITY: VALUE
P.REW: BLOCK 1 ;[372] GLOBAL /REWIND VALUE
P.UNL: BLOCK 1 ;[372] GLOBAL /UNLOAD VALUE
PHYSIC: BLOCK 1 ;[372] /PHYSICAL FLAG
CMDLEN: BLOCK 1 ;LENGTH OF COMMAND FROM FORTRAN
ERRORF: BLOCK 1 ;WE HAVE SEEN AN ERROR
INITFF: BLOCK 1 ;INITIAL VALUE OF .JBFF
SAVPAR: BLOCK 1 ;[376] SAVED STACK POINTER TO RESTORE ON ERRORS
SAVREP: BLOCK 1 ;SAVED STACK POINTER TO RESTORE ON REPARSE
CPSAV: BLOCK 1 ;POINTER TO PREVIOUS ATOM
CMDBLK: BLOCK .CMGJB+5 ;[335] COMMAND STATE BLOCK FOR COMND% JSYS
BUFFER: BLOCK BUFSIZ ;INPUT TEXT STORED HERE
ATMBFR: BLOCK ATMSIZ ;[335] ATOM BUFFER FOR COMND% JSYS
GJFBLK: BLOCK GJFSIZ ;[335] GTJFN BLOCK FOR COMND% JSYS
NOIFDB: BLOCK FDBSIZ ;FUNCTION DESCRIPTOR BLOCK FOR NOISE WORDS
NAMBUF: BLOCK 8 ;BUFFER FOR NAME OF INPUT FILE
INJFN: BLOCK 1 ;INPUT JFN FOR TAKE COMMAND
OUTJFN: BLOCK 1 ;OUTPUT JFN FOR TAKE COMMAND
HLPJFN: BLOCK 1 ;OUTPUT JFN FOR HELP FILE
TAKFLG: BLOCK 1 ;NON-ZERO IF PROCESSING INDIRECT FILE
TBASAV: BLOCK 1 ;SYMBOL TABLE ADDRESS FOR DELENT
DELTBE: BLOCK 1 ;ASCIZ POINTER TO SYMBOL TABLE ENTRY TYPE
DELTBL: BLOCK 1 ;ADDRESS OF TABLE TO DELETE ENTRY FROM
TMPTBL: BLOCK 20 ;AREA FOR COPY OF SYMBOL TABLE
.NMUL: BLOCK 3
COLJFN: BLOCK 1
SEGMENT HIGH