Trailing-Edge
-
PDP-10 Archives
-
BB-Z759A-SM
-
sort-source/srtcmd.mac
There are 16 other files named srtcmd.mac in the archive. Click here to see a list.
; UPD ID= 90 on 11/14/83 at 3:22 PM by FONG
TITLE SRTCMD - TOPS-20 COMMAND SCANNER FOR SORT/MERGE
SUBTTL J.E.FRIES/DZN/DMN/BRF/GCS 11-Feb-83
SEARCH COPYRT
SALL
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
COPYRIGHT (C) 1977, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION
SEARCH SRTPRM
XSEARCH ;SEARCH OTHER UNIVERSALS
IFE FTOPS20,<PRINTX ? SRTCMD should not be present in TOPS-10 SORT/MERGE.>
IFN FTPRINT,<PRINTX [Entering SRTCMD.MAC]>
.COPYRIGHT ;Put standard copyright statement in REL file
SEGMENT HPURE
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 /ALIGN, /AFTER, /BEFORE, /NOCRLF ........... 23
; 5.3.4 Apply Global Defaults ...................... 24
; 5.4 Control Switches
; 5.4.1 /PHYSICAL, /CHECK, /COLLATE:x[:y] .......... 25
; 5.4.2 /SUPPRESS:x ................................ 26
; 5.4.3 /BUFFER-PAGES:n, /LEAVES:n ................. 27
; 5.4.4 /ERROR-RETURN:^x, /FATAL-ERROR-CODE:^x ..... 27
; 5.4.5 /TEMPORARY-AREA:x,y,... .................... 28
; 5.5 Magtape Switches
; 5.5.1 /ANSI-ASCII, /DENSITY:n .................... 29
; 5.5.2 /INDUSTRY-COMPATIBLE, /LABEL:x ............. 29
; 5.6 Magtape Switches
; 5.6.1 /PARITY:x, /REWIND, /UNLOAD ................ 30
; 6 PARSING SUBROUTINES ...................................... 31
; 7 ERROR MESSAGES ........................................... 35
; 8 GENERAL SUBROUTINES ...................................... 36
; 9 DEFINITIONS
; 9.1 Constants and Tables .............................. 45
; 9.2 Impure Data ....................................... 46
SUBTTL INTERNAL/EXTERNAL DEFINITIONS
;GENERATE STRUCTURE MACROS
;NOW GENERATE THEM MAX = 10 FOR NOW
RADIX 10
$TEMPORARY (10,10)
RADIX 8
;GLOBAL ROUTINES
INTERN SCAN,TAKEX,RETMON
;EXTERNALS
;DEFINED IN SORT
EXTERN ERRADR,FERCOD,MAXTMP,MRGSW,NUMINP,RECORD,STRNAM,STRNUM
EXTERN CLRSPC,E$$NEC,FRESPC,SUPFLG,GETSPC,%TCRLF,%TDECW
EXTERN %ERMSG,%TOCTW,%TSTRG
;DEFINED IN SRTSTA
EXTERN ADVFLG,ALIGN,APPSTK,CLRANS,CLRFIL,COLADR,COLITB,COLITS,COLSW,CORSIZ
EXTERN E$$KLR,E$$KOR,F.BLKF,F.INDU,F.INZR,F.LABL,F.OUZR,F.POSI,F.REW,F.STDA,F.UNL,F.VARI
EXTERN FORARG,FORCNT,FORERR,FORRET,FORXIT,FSTKEY,LEANUM,LSTKEY,MEMSTK,MODE,MODEM
EXTERN NOCRLF,P.INDU,P.STDA,SETMOD,STATSW,TEMPSW,USRFMT,WSCSW
;DEFINED IN SRTJSS
EXTERN ENTVEC
SEGMENT HPURE ;[C20]
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
SKIPE FORRET ;IF CALLED FROM FORTRAN
JRST NEWCMD ;THEN DONN'T REPARSE LINE
SETZB T1,P1 ;GET READY
RSCAN% ;SEE IF THERE IS ANY INPUT FOR US
ERJMP NEWCMD ;FAILURE, IGNORE IT
JUMPE T1,NEWCMD ;NO, JUST GET COMMAND
;At this point we are looking for a command such as
;SORT SORT /REC:
;SORT MERGE /REC:
;But not
;RUN SORT
;SORT /REC:
MOVEI T1,RETMON ;SET UP REPARSE ADDRESS
MOVEM T1,.CMFLG+CMDBLK ;SO WE GIVE UP
HRROI T2,P1 ;GET A POINTER TO A NULL STRING
MOVEM T2,CMDBLK+.CMRTY ;SAVE AS CONTROL-R POINTER
HRROI T1,BUFFER ;SET UP POINTERS TO TEXT BUFFER
MOVEM T1,.CMBFP+CMDBLK ; ..
MOVEM T1,.CMPTR+CMDBLK ; ..
MOVX T1,BUFSIZ*NCHPW ;SET UP LENGTH OF TEXT BUFFER
MOVEM T1,.CMCNT+CMDBLK ; ..
SETZM .CMINC+CMDBLK ;SET UP COUNT OF UNPARSED CHARS
HRROI T1,ATMBFR ;SET UP POINTER TO ATOM BUFFER
MOVEM T1,.CMABP+CMDBLK ; ..
MOVX T1,ATMSIZ+NCHPW ;SET UP LENGTH OF ATOM BUFFER
MOVEM T1,.CMABC+CMDBLK ; .
MOVEI T1,GJFBLK ;SET UP ADDRESS OF GTJFN% BLOCK
MOVEM T1,.CMGJB+CMDBLK ; ..
MOVE T1,[.PRIIN,,.PRIOU] ;READ FROM THE TERMINAL
MOVEM T1,.CMIOJ+CMDBLK ;SET UP I/O JFNS
CALL CLRGJF ;CLEAR GTJFN BLOCK
HRROI T1,[ASCIZ /EXE/]
MOVEM T1,GJFBLK+.GJEXT ;SET DEFAULT FILE TYPE
MOVEI T2,GJFBLK ;GET ADDRESS OF JFN BLOCK
MOVEM T2,CMDBLK+.CMGJB ;AND SET IN COMMAND BLOCK
MOVX T2,GJ%OFG ;GET FLAGS
MOVEM T2,GJFBLK ;SET UP GTJFN BLOCK
MOVEI T1,CMDBLK ;POINT TO COMMAND BLOCK
MOVEI T2,[FLDDB. (.CMINI)] ;GET SET
COMND% ;INITIALIZE COMMAND
ERJMP CMDERR ;FAILED
MOVEI T2,[FLDDB. (.CMFIL)] ;WANT TO READ A FILE SPEC
COMND% ;DO IT
ERJMP EATLIN ;FAILED, JUST GO EAT LINE
TXNE T1,CM%NOP ;DIDN'T PARSE?
JRST EATLIN ;YES, GO EAT LINE
HRROI T1,RFILE ;POINT TO STORAGE
MOVX T3,FLD (.JSAOF,JS%NAM) ;SET UP TO STORE ONLY NAME
JFNS% ;DO IT
ERJMP EATLIN ;FAILED
IDPB P1,T1 ;MAKE IT ASCIZ
MOVE T1,T2 ;GET JFN
RLJFN% ;RELEASE IT
ERJMP EATLIN ;FAILED
GETNM% ;NOW GET OUR USER NAME
ERJMP EATLIN ;FAILED
MOVE T3,[POINT 7,RFILE] ;POINT TO STRING
CMPLOP: ILDB T4,T3 ;GET NEXT CHAR OF FILE NAME
JUMPE T4,CMPFIN ;DONE IF GET A NULL
SETZ T2, ;CLEAR AC
ROTC T1,6 ;SHIFT IN NEXT CHAR OF OUR NAME
CAIE T4," "(T2) ;CHARACTERS MATCH EACH OTHER?
JRST EATLIN ;NO, THEN CAN'T BE WANTED COMMAND LINE
JRST CMPLOP ;LOOP
CMPFIN: JUMPN T1,EATLIN ;EAT UP LINE IF WE DIDN'T GET A MATCH
;HERE WHEN WE KNOW OUR NAME WAS TYPED AS THE COMMAND.
;WE NOW PROCESS THE NORMAL COMMANDS.
;THE ONLY DIFFERENCE IS THAT WE EXIT TO THE MONITOR WHEN THE COMMAND IS COMPLETE.
;NOW TO PARSE ONE OF THE SORT COMMANDS.
MOVEM P,SAVPAR ;FOR ERRORS
MOVEM P,SAVREP ;AND REPARSE
SETZM SWFRST ;CLEAR FLAG THAT SAY USER TYPED /REC FIRRST
MOVEI T1,CMDBLK ;PARSE THE COMMAND NAME OR CRLF
MOVEI T2,FDBRV ; ..
PUSHJ P,PCOMND ; ..
HRRZS T3 ;GET ADDR OF FUNCTION BLOCK THAT WON
CAIN T3,FDBRV ;IF .CMCFM
JRST NEWCMD ;NO SPEC WAS TYPED, GO GET A COMMAND
SETOM XITFLG ;EXIT WHEN COMMAND IS COMPLETE
HRRZ T1,T2 ;IT WAS KEYWORD--GET ROUTINE ADDR
HRRZ T1,(T1) ; ..
CAIN T3,FDB1 ;IF /RECORD
JRST CT1REC ;DEFAULT TO SORT
PUSHJ P,(T1) ;CALL APPROPRIATE ROUTINE
RETURN
RETMON: HRROI T1,[ASCIZ/
/] ;GET A CRLF
PSOUT% ;OUTPUT IT
SKIPE TAKFLG ;IF COMMANDS FROM TAKE FILE
CALL TAKEX ;THEN CLOSE TAKE AND LOG FILES.
RESET% ;RESET EVERYTHING
HALTF% ;STOP
JRST .-1 ;STAY DEAD
;HERE WHEN WE HAVE FOUND SOMETHING IN THE RESCAN BUFFER, BUT IT
;DID NOT LOOK LIKE OUR PROGRAM NAME. WE HAVE TO EAT UP THE REST
;OF THE LINE, AND THEN GET A NORMAL COMMAND.
EATLIN: MOVEI T1,CMDBLK ;SET UP TO THE COMMAND BLOCK
MOVEI T2,CONFRM ;CONFIRM FUNCTION
COMND% ;READ TO THE END OF LINE
ERJMP NEWCMD ;IGNORE ANY ERROR
JRST NEWCMD ;OK, GO GET A NORMAL COMMAND
;HERE TO INPUT A COMMAND FOR THE PROGRAM. GOTTEN TO IF THE RESCANNED
;TEXT LOOKED INCORRECT OR HAD NO COMMAND SPECIFICATION GIVEN.
NEWCMD: 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] ..
SKIPE FORRET ;[C20] [376] IF CALLED FROM FORTRAN
SKIPA T1,[.NULIO,,.NULIO] ;[376] THEN CAN'T READ FROM TERMINAL SO USE NUL:
MOVE T1,[.PRIIN,,.PRIOU] ;[376] ELSE READ FROM THE TERMINAL
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
ENDB;
BEGIN
PROCEDURE (PUSHJ P,PARSE) ;[376] START SCANNING A NEW LINE
MOVE P,SAVPAR ;[376] RESTORE STACK IN CASE ERRORS
SKIPE XITFLG ;EXIT TO MONITOR?
SKIPE TAKFLG ;BUT NOT IN MIDDLE OF TAKE
TRNA
JRST RETMON ;YES
IF WE WERE CALLED FROM FORTRAN
SKIPN FORRET ;[C20] [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 FORRET ;[C20] [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
ENDB;
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.
SETZM SWFRST ;CLEAR FLAG THAT SAY USER TYPED /REC FIRRST
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 ;[C20] [376] IT WAS KEYWORD--GET ROUTINE ADDR
HRRZ T1,(T1) ;[C20] ..
CAIN T3,FDB1 ;IF /RECORD
JRST CT1REC ;DEFAULT TO SORT
PUSHJ P,(T1) ;[OK] [376] CALL APPROPRIATE ROUTINE
RETURN ;[376] SORT OR MERGE COMMAND FOR SORT
ENDB;
SUBTTL SORT/MERGE COMMANDS -- EXIT, SORT, MERGE
BEGIN
PROCEDURE (PUSHJ P,.EXIT) ;[376] EXIT COMMAND
;.EXIT 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
SKIPE TAKFLG ;[463] IF COMMANDS FROM TAKE FILE
CALL TAKEX ;[463] THEN CLOSE TAKE AND LOG FILES.
MONRET ;[376] SIMPLY EXIT SO CONTINUE
PJRST PARSE ;[376] WORKS EVEN FROM FORTRAN CALLS
ENDB;
SUBTTL SORT/MERGE COMMANDS -- HELP
.HELP: 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 -- PUSH
.PUSH: HRROI T2,[ASCIZ \to EXEC\]
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,CM%SDH,,<EXEC to run in inferior fork,>,,CONFRM)]
CALL PATOM ; ..
JRST TYLSEH ;YES--UNRECOGNIZED COMMAND
HRRZ T3,T3
CAIN T3,CONFRM ;JUST END OF LINE?
JRST GTPUSH ;YES, GET DEFAULT EXEC
HRRM T2,RJFN ;SAVE FILE'S JFN FOR LATER
CALL ENDCOM ;PARSE AN END-OF-LINE
RET ;OOPS
DOPUSH: MOVX T1,CR%CAP ;Create a lower fork for exec
CFORK%
JRST NOFORK
MOVE P2,T1 ;Save lower fork process handle
HRLZS T1
HRR T1,RJFN
GET%
MOVEI T1,.FHSLF ;Don't allow lower fork to log out
RPCAP%
TXZ T2,SC%LOG
SETZ T3, ;No privs enabled
MOVE T1,P2 ;Get lower fork handle
EPCAP% ;Set its capabilities
MOVE T1,P2
SETZ T2,
SFRKV% ;Start the fork
WFORK% ;Wait for it to halt
KFORK% ;Kill it
MOVE T1,P1 ;Get JFN
RLJFN% ;Release JFN
NOOP
JRST PARSE
GTPUSH: MOVX T1,GJ%OLD!GJ%PHY!GJ%SHT
HRROI T2,[ASCIZ /PS:<SYSTEM>EXEC.EXE/]
GTJFN%
JRST NOEXEC ;Failed
MOVEM T1,RJFN ;Store JFN
JRST DOPUSH
NOEXEC: TYCMP (?,ENA,<EXEC not available>)
JRST PARSE
NOFORK: TYCMP (?,NLF,<No lower forks available>)
JRST PARSE
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.
.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
MOVE T1,[POINT 7,RFILE] ; ..
SETZ T2, ; ..
MOVX T3,FSPCLN ; ..
MOVE 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 RUNARG,RJFN ;SET UP ARG FOR GET JSYS
HRLI RUNARG,.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,RUNARG ;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] ..
RUNARG: 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
.TAKE: SKIPE TAKFLG ;SKIP IF NOT TAKING
JRST [ TYCM (?,TCM,<TAKE commands may not be nested>)
CALL TAKEX
MOVE P,SAVREP ;RESET P
JRST TYCRLP]
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 ;NO, ERROR
;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 TYCRLP]
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
HRROI T1,NAMBUF ;[C10] ANY FILENAME ?
SKIPE NAMBUF ;[C10] 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,,,,NUL:)] ;[C10] 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 TYCRLP]
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
SKIPE XITFLG ;WANT TO EXIT TO MONITOR
JRST RETMON ;YES
RET
SUBTTL SORT/MERGE COMMANDS
;Here when first command is /RECORD-SIZE:
;Default to SORT and remember that we have already parsed the first switch.
BEGIN
PROCEDURE (PUSHJ P,CT1REC) ;SAW /REC FIRST
MOVEM T1,SWFRST ;SAVE ROUTINE ADDRESS AS A FLAG
; JRST .SORT ;DEFAULT TO SORT
ENDB;
BEGIN
PROCEDURE (PUSHJ P,.SORT) ;[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.
.SORT: TDZA T1,T1 ;[376] TURN OFF MERGE FLAG
.MERGE: MOVEI T1,1 ;[376] TURN ON MERGE FLAG
MOVEM T1,MRGSW ;[376] ..
; PJRST PARS ;[376] JOIN COMMON CODE
ENDB;
;CALLED FROM .SORT/.MERGE 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
SETOM TEMPSW ;[376] SAME AS CLRFIL = 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;
SKIPE T1,SWFRST ;HAVE WE ALREADY PARSED THE FIRST SWITCH?
JRST PARS01 ;YES
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 ;[C20] GET DISPATCH ADDRESS
HRRZ T1,(T1) ;[C20] ..
PARS01: CALL (T1) ;[OK] 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 ;[C20] GET DISPATCH ADDRESS
HRRZ T1,(T1) ;[C20] ..
CALL (T1) ;[OK] 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 ;[C20] GET DISPATCH ADDRESS
HRRZ T1,(T1) ;[C20] ..
CAIE T1,CS3KEY ;SKIP IF /KEY
CALL DELK ;DELETE /KEY AS AN OPTION
CALL (T1) ;[OK] 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) ;[OK] 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
CALL DELADV ;REMOVE AFTER/BEFORE-ADVANCING FROM INPUT SWITCHES
SKIPE T2,X.JFN(P1) ;[OK] 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) ;[OK] SAVE JFN IN X.BLOCK
MOVE T1,T2 ;GET THE JFN
MOVE T2,[1,,.FBCTL] ;WORD CONTAINING THE RMS BIT
MOVEI T3,.NMUL ;TEMP LOCATION
GTFDB% ;READ WORD FROM FILE DATA BLOCK
ERJMP PARSI5 ;TOO BAD
LDB T1,[POINTR (.NMUL,FB%FCF)] ;GET FILE CLASS FIELD
CAIE T1,.FBRMS ;IS IT AN RMS FILE?
JRST PARSI5 ;NO
SETOM RMSFLG ;YES, SIGNAL RMS WANTED
; MOVEI T1,1 ;T1 ALREADY CONTAINS .FBRMS = 1
MOVEM T1,F.RMS ;SET LOCAL FLAG
PARSI5: CALL IGJFBO ;INITIALIZE GET JFN BLOCK FOR OUTPUT
MOVE T1,X.JFN(P1) ;JFN
DVCHR% ;SEE WHAT DEVICE IT IS
ERJMP .+1 ;CANNOT FAIL
LDB T1,[POINTR (T2,DV%TYP)] ;GET DEVICE TYPE
CAIE T1,.DVMTA ;IS IT A MAGTAPE?
SKIPA T2,[EXP FDBC6X] ;NO, SO NO TAPE SWITCHES
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,(T2) ;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 ;[C20] GET DISPATCH ADDRESS
HRRZ T1,(T1) ;[C20] ..
CALL (T1) ;[OK] 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) ;[OK] PLACE JFN IN X.BLOCK
CALL CLRFIL ;CLEAR FILE FLAGS
MOVE T1,[CS4A,,CS4TMP] ;GET BLT POINTER
BLT T1,CS4TMP+CS4AS ;MOVE LOCAL SWITCHES TO TEMP AREA
MOVE T1,[CS6A,,CS6TMP] ;GET BLT POINTER
BLT T1,CS6TMP+CS6AS ;MOVE TAPE SWITCHES TO TEMP AREA
CALL DELGLO ;REMOVE GLOBAL SW'S THAT WERE SET
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 ADDEN6 ;ADD /BLOCKED:
FI;
MOVE T2,RMSENT ;ADDRESS OF TABLE ENTRY
CALL ADDEN4 ;ADD /RMS TO OUTPUT OPTIONS
PARSO1: SKIPL APPFLG ;IF WE WANT TO APPEND
JRST PARSO2 ; SEE IF EXISTING FILE IS RMS TYPE
MOVE T1,X.JFN(P1) ;GET THE JFN
MOVE T2,[1,,.FBCTL] ;WORD CONTAINING THE RMS BIT
MOVEI T3,.NMUL ;TEMP LOCATION
GTFDB% ;READ WORD FROM FILE DATA BLOCK
ERJMP PARSO2 ;TOO BAD
LDB T1,[POINTR (.NMUL,FB%NXF)]
JUMPN T1,PARSO2 ;FILE DOESN'T EXIST YET
LDB T1,[POINTR (.NMUL,FB%OFF)]
JUMPN T1,E$$OFF ;FILE IS OFF-LINE
LDB T1,[POINTR (.NMUL,FB%FCF)] ;GET FILE CLASS FIELD
CAIE T1,.FBRMS ;IS IT AN RMS FILE?
JRST PARSO2 ;NO
SETOM RMSFLG ;YES, SIGNAL RMS WANTED
; MOVEI T1,1 ;T1 ALREADY CONTAINS .FBRMS = 1
MOVEM T1,F.RMS ;SET LOCAL FLAG
PARSO2: MOVE T1,X.JFN(P1) ;JFN
DVCHR% ;SEE WHAT DEVICE IT IS
ERJMP .+1 ;CANNOT FAIL
LDB T1,[POINTR (T2,DV%TYP)] ;GET DEVICE TYPE
CAIE T1,.DVMTA ;IS IT A MAGTAPE?
SKIPA T2,[EXP FDB6S] ;NO, SO NO TAPE SWITCHES
MOVEI T2,FDB6R ;GET FDB ADDRESS
CALL PATOM ;PARSE /LOCAL
JRST PSWERS ;NO PARSE, COMPLAIN
PARSO3: HRRZS T3 ;ADDRESS OF PARSING ROUTINE
CAIN T3,CONFRM ;WAS IT CRLF?
JRST PARSX ;YES
HRRZ T1,T2 ;[C20] GET DISPATCH ADDRESS
HRRZ T1,(T1) ;[C20] ..
CALL (T1) ;[OK] 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
CALL DELASW ;[N11] REMOVE ALL ASCII SWITCHES FROM TABLE
CALLRET DELAES ;[N11] REMOVE ASCII, EBCDIC AND SIXBIT FROM TABLE
;SIXBIT
CS1ASI: MOVX T1,RM.SIX ;GET FLAG
IORM T1,MODE ;INCLUDE IT IN MODE
CALL DELASW ;[N11] REMOVE ALL ASCII SWITCHES FROM TABLE
CALLRET DELAES ;[N11] REMOVE ASCII, EBCDIC AND SIXBIT FROM TABLE
;BINARY
CS1CBI: MOVX T1,RM.BIN ;GET FLAG
IORM T1,MODE ;INCLUDE IT IN MODE
CALLRET DELB ;[N11] 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
MOVE T2,LSTKEY ;[C20]
MOVEM T1,(T2) ;[C20] [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) ;[OK] [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) ;[OK] [375] ..
MOVE T1,[CS3A,,TMPTBL] ;[375] COPY KEY MODES TO TEMP TABLE
BLT T1,TMPTBL+CS3AS ;[375] ..
IF Gfloating MICRO CODE
SETZB T1,T2
GFAD T1,T1 ;TRY A TYPICAL Gfloating INST
ERJMP $T ;NOT AVAILABLE
THEN ITS OK
JRST $F
ELSE DELETE /Gfloating
HRROI T2,[ASCIZ /Gfloating/]
PUSHJ P,DELENT ;SO DELETE IT
FI;
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] ..
HRROI T2,[ASCIZ /Gfloating/]
PUSHJ P,DELENT
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 $1 ;[375] NO--DONE WITH /KEY:
MOVEI T2,FDBTMP ;[375] IT WAS COMMA--PARSE KEY MODE
PUSHJ P,PATOM ;[375] ..
JRST PARERR ;[375] DIDN'T PARSE
HRRZ T1,T2 ;[C20] [375] DID--CALL PROPER ROUTINE
HRRZ T1,(T1) ;[C20] ..
PUSHJ P,(T1) ;[OK] [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
$1% AOS (P) ;[375] GIVE SKIP RETURN
ENDB;
MOVE T1,LSTKEY ;[375] DONE WITH THIS /KEY:--STORE MODES
MOVE T4,MODE ;[375] REMEMBERING TO SAVE T2, T3
MOVEM T4,KY.MOD(T1) ;[OK] [375] ..
ORM T4,MODEM ;[375] COLLECT ALL MODES IN MODEM
RETURN ;[375] DONE (NOTE POSSIBLE SKIP RETURN)
ENDB;
;ASCENDING
CS3AAS: MOVE T1,LSTKEY ;GET INDEX TO KEY BLOCK
SETZM KY.ORD(T1) ;[OK] 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) ;[OK] 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
;COMPUTATIONAL AND COMP1
CS3BCO: ;[N01] MOVE THE LABEL
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
;FORMAT
CS3BFO: CALL DELES ;DELETE EBCDIC AND SIXBIT
CALL PCOLON ;IF THER'S A COLON PARSE IT
MOVEI T2,[FLDDB. (.CMUQS,,UQSMS1,<FORTRAN FORMAT descriptor>)] ;GET FDB ADDRESS
CALL PATOM ;SKIP OVER SPACE/TABS
JRST PARERR ;OOPS - NO PARSE
; 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
CAIL T3,140 ;[511] IN LOWER CASE SET?
TRZN T3,100 ;[511] YES, HANDLE LOWER CASE
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
FASTSKIP ;[N01] USE COMMON CODE
;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
;Gfloating - ONLY USEFUL WITH /FORMAT
CS3GFL: MOVX T1,RM.GFL ;GET Gfloating FLAG
IORM T1,MODE ;SET IT
CALLRET DELANC ;DELETE MOST OF THE ENTRIES
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
ENDB;
BEGIN
PROCEDURE (PUSHJ P,<CS4AFI,CS4ARA>) ;[372] /FIXED OR /RANDOM FROM TABLE CS4A
SKIPL F.VARI ;[372] /FIXED OR /VAR SET ALREADY?
JRST E$$CFV ;[372] YES--CONFLICT WITH /FIXED, /VAR
SETZM F.VARI ;[372] SET /FIXED
PJRST DELFRS ;[372] REMOVE /FIX, /RAN, /VAR, /SEQ
ENDB;
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:
ENDB;
BEGIN
PROCEDURE (PUSHJ P,<CS4AVA,CS4ASE>) ;[372] /VAR OR /SEQ FROM TABLE CS4A
SKIPL F.VARI ;[372] /FIXED OR /VAR SET ALREADY?
JRST E$$CFV ;[372] YES--CONFLICT WITH /FIXED, /VAR
MOVE T1,1 ;[372] SET /VARIABLE
MOVEM T1,F.VARI ;[372] ..
PJRST DELFRS ;[372] REMOVE /FIX, /RAN, /VAR, /SEQ
ENDB;
BEGIN
PROCEDURE (PUSHJ P,CS4ARM) ;RMS FILE
MOVEI T1,1
MOVEM T1,F.RMS ;SET /RMS
SETOM RMSFLG ;SIGNAL RMS NEEDED
CALL DEL4BF ;REMOVE /BLOCKED: AND /FORTRAN
MOVEI T1,CS4TMP
HRROI T2,[ASCIZ /RMS/]
CALL DELEN ;REMOVE /RMS
HRROI T2,[ASCIZ /RANDOM/]
CALL DELEN ;DELETE RANDOM AND SEQUENTIAL
HRROI T2,[ASCIZ /SEQUENTIAL/]
CALL DELEN ;AS ORGANIZATION WILL TAKE CARE OF IT
MOVE T2,ORGENT
CALL ADDEN4 ;ADD /ORGANIZATION
SKIPGE APPFLG ;OK IF /APPEND
RET
MOVEI T1,CS7TMP ;OTHERWISE
HRROI T2,[ASCIZ /INDEXED/] ;REMOVE
PJRST DELEN ;INDEXED
ENDB;
BEGIN
PROCEDURE (PUSHJ P,CS4ORG) ;RMS /ORGANIZATION:
MOVEI T2,[FLDDB. (.CMKEY,,CS7TMP,,<SEQUENTIAL>)] ;PARSE VALUE
PUSHJ P,PATOM
JRST PARERR ;ILLEGAL VALUE
HRRZ T1,T2 ;GET ROUTINE ADDRESS
HRRZ T1,(T1)
PUSHJ P,(T1) ;CALL IT
MOVEI T1,CS4TMP ;REMOVE /ORGANIZATION: FROM TABLE
HRROI T2,[ASCIZ /ORGANIZATION:/]
CALL DELEN
MOVE T2,F.ORG ;GET ORGANIZATION BACK
CAIE T2,RMS.IX ;INDEXED
RET ;NO
MOVE T2,ACCENT ;YES
CALL ADDENT ;ADD /ACCESS:
MOVEI T1,CS7TMP ;CLEAR ALL OF CS7
HRROI T2,[ASCIZ /INDEXED/]
CALL DELEN
HRROI T2,[ASCIZ /LINE-SEQUENCED-ASCII/]
CALL DELEN
HRROI T2,[ASCIZ /RELATIVE/]
CALL DELEN
HRROI T2,[ASCIZ /SEQUENTIAL/]
CALL DELEN
HRROI T2,[ASCIZ /STREAM-ASCII/]
CALL DELEN
MOVE T2,SEQENT ;ADD /ACC:SEQ
CALL ADDENT
MOVEI T1,CS7TMP
MOVE T2,KEYENT ;ADD /ACC:KEY
PJRST ADDENT
ENDB;
BEGIN
PROCEDURE (PUSHJ P,CS4ACC) ;RMS /ACCESS:
MOVEI T2,[FLDDB. (.CMKEY,,CS7TMP,,<SEQUENTIAL>)] ;PARSE VALUE
PUSHJ P,PATOM
JRST PARERR ;ILLEGAL VALUE
HRRZ T1,T2 ;GET ROUTINE ADDRESS
HRRZ T1,(T1)
PUSHJ P,(T1) ;CALL IT
MOVEI T1,CS4TMP ;REMOVE /ACCESS: FROM TABLE
HRROI T2,[ASCIZ /ACCESS:/]
CALL DELEN
ENDB;
BEGIN
PROCEDURE (PUSHJ P,CS5APP) ; SET RMS APPEND CREATE
SETOM APPFLG
MOVEI T1,CS5TMP
HRROI T2,[ASCIZ /APPEND/]
PJRST DELEN ;DELETE /APPEND
ENDB;
BEGIN
PROCEDURE (PUSHJ P,CS7IX) ;RMS INDEXED
MOVEI T1,RMS.IX
MOVEM T1,F.ORG ;SET ORGANIZATION
RET
ENDB;
BEGIN
PROCEDURE (PUSHJ P,CS7LS) ;LINE-SEQUENCED-ASCII
MOVEI T1,RMS.LS
MOVEM T1,F.ORG ;SET ORGANIZATION
RET
ENDB;
BEGIN
PROCEDURE (PUSHJ P,CS7RL) ;RMS RELATIVE
MOVEI T1,RMS.RL
MOVEM T1,F.ORG ;SET ORGANIZATION
RET
ENDB;
BEGIN
PROCEDURE (PUSHJ P,CS7SQ) ;RMS SEQUENTIAL
MOVEI T1,RMS.SQ
MOVEM T1,F.ORG ;SET ORGANIZATION
RET
ENDB;
BEGIN
PROCEDURE (PUSHJ P,CS7ST) ;RMS STREAM
MOVEI T1,RMS.ST
MOVEM T1,F.ORG ;SET ORGANIZATION
RET
ENDB;
BEGIN
PROCEDURE (PUSHJ P,CS7SA) ;RMS REL/INDEXED SEQ ACCESS
RET
ENDB;
BEGIN
PROCEDURE (PUSHJ P,CS7KA) ;RMS REL/INDEXED KEYED ACCESS
MOVE T1,F.ORG ;GET CURRENT INDEX
CAIN T1,RMS.IX
MOVEI T1,RMS.KX ;CHANGE TO KEYED INDEX
CAIN T1,RMS.RL
MOVEI T1,RMS.KR ;CHANGE TO KEYED RELATIVE
MOVEM T1,F.ORG
RET
ENDB;
SUBTTL SORT AND MERGE -- ASCII File Switches -- /ALIGNED, /AFTER, /BEFORE, /NOCRLF
;ALIGNED
CS4AAL: MOVEI T1,1 ;[N11] GET ALIGN FLAG
MOVEM T1,ALIGN ;[N11] SET FLAG
MOVX T1,RM.ASC ;[421] SET ASCII BY DEFAULT
IORM T1,MODE ;[421] ...
CALL DELESB ;[N11] DELETE SIXBIT, EBCDIC, AND BINARY
PJRST DELAL ;[N11] DELETE ALIGNED
;AFTER-ADVANCING, BEFORE-ADVANCING
CS4AAA: SKIPA T2,[ADV.A] ;[N11] AFTER-ADVANCING
CS4ABA: MOVEI T2,ADV.B ;[N11] BEFORE-ADVANCING
MOVEM T2,ADVFLG ;[N11] STORE FOR OUTPUT FILE
MOVX T1,RM.ASC ;[N11] SET ASCII BY DEFAULT
IORM T1,MODE ;[N11] ...
CALL DELESB ;[N11] DELETE SIXBIT, EBCDIC, AND BINARY
CALL DELNCR ;[N11] REMOVE /NOCRLF
PJRST DELADV ;[N11] REMOVE /AFTER AND /BEFORE
;NOCRLF
CS4ANC: MOVEI T2,1 ;[N11] SIGNAL WE'VE SEEN IT
MOVEM T2,NOCRLF ;[N11] STORE FOR OUTPUT FILE
MOVX T1,RM.ASC ;[N11] SET ASCII BY DEFAULT
IORM T1,MODE ;[N11] ...
SKIPLE F.VARI ;[N11] /VARIABLE SET ALREADY?
JRST E$$CNV ;[N11] YES, CONFLICT WITH /VARIABLE
SETZM F.VARI ;[N11] SET /FIXED
CALL DELV ;[N11] REMOVE /VARIABLE
CALL DELESB ;[N11] DELETE SIXBIT, EBCDIC, AND BINARY
CALL DELADV ;[N11] REMOVE /AFTER AND /BEFORE
PJRST DELNCR ;[N11] REMOVE /NOCRLF
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) ;[OK] [372] ..
MOVE T1,F.DENS ;[C12] [372] COPY /DENSITY:
MOVEM T1,X.DEN(P1) ;[OK] [372] ..
SKIPGE T1,F.LABL ;[372] COPY /LABEL:
MOVX T1,LABSTANDARD ;[372] WITH DEFAULT OF STANDARD
MOVEM T1,X.LABL(P1) ;[OK] [372] ..
MOVE T1,F.PARI ;[C01] COPY /PARITY:
MOVEM T1,X.PAR(P1) ;[OK] [C01] ..
MOVE T1,F.POSI ;[C11] COPY /POSITION:
MOVEM T1,X.POSI(P1) ;[OK] [C11] ..
MOVE T1,F.ORG ;COPY /ORGANIZATION:
MOVEM T1,X.ORG(P1)
;FLAG (ONE BIT) SWITCHES.
MOVE T1,X.FLG(P1) ;[OK] [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.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
SKIPLE F.RMS ;SHOULD WE SET /RMS?
TXO T1,FI.RMS ;YES
MOVEM T1,X.FLG(P1) ;[OK] [372] SAVE FLAGS BACK
;GET DEVICE CHARACTERISTICS.
MOVE T1,X.JFN(P1) ;[OK] [372] GET THE JFN
DVCHR% ;[372] GET CHARACTERISTICS
ERJMP TYLSEH ;[372] OOPS
MOVEM T2,X.DVCH(P1) ;[OK] [372] SAVE IT
;SET EBCDIC MAGTAPE DEFAULTS
MOVX T1,RM.EBC ;[C09] EBCDIC MAGTAPE?
TDNN T1,MODE ;[C09] ..
JRST $1 ;[C09] NO
LDB T1,[POINTR(X.DVCH(P1),DV%TYP)] ;[OK] [C09] ..
CAIE T1,.DVMTA ;[C09] ..
JRST $1 ;[C09] NO
MOVEI T1,1 ;[C09] /BLOCKED:0?
SKIPN X.BLKF(P1) ;[OK] [C09] ..
MOVEM T1,X.BLKF(P1) ;[OK] [C09] YES, MAKE /BLOCKED:1
MOVX T1,FI.IND ;[C09] FORCE /INDUSTRY
IORM T1,X.FLG(P1) ;[OK] [C09] ..
$1% ;[C09]
RETURN ;[372] DONE
ENDB;
SUBTTL SORT AND MERGE -- Control Switches -- /PHYSICAL, /CHECK, /COLLATE:x[:y]
BEGIN
PROCEDURE (PUSHJ P,CS5APH) ;[372] /PHYSICAL FROM TABLE CS5A
MOVEI T1,1 ;[372] SET /PHYSICAL
MOVEM T1,PHYSIC ;[372] ..
PUSHJ P,IGJFBI ;[372] REINITIALIZE GTJFN% BLOCK
MOVEI T1,CS5TMP ;[372] DELETE /PHYSICAL
HRROI T2,[ASCIZ /PHYSICAL/] ;[372] ..
PJRST DELEN ;[372] ..
ENDB;
;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 T1,WSCSW ;[454] 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 ;[C20] GET COLLATE FLAG
HRR T1,(T1) ;[C20] ..
HRLI T1,(IFIW) ;[C20] ..
MOVEM T1,COLSW ;[C20] SAVE IT AWAY
MOVEI T1,CS5TMP
HRROI T2,[ASCIZ \COLLATE:\]
CALL DELEN
HRRZ T1,COLSW
JRST @[IFIWS <CPOPJ,CPOPJ,.+1,CS5CO3,CS5CO4>]-1(T1) ;[C20] 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 TYCRLP
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) ;[OK] POSITION MASK OVER THE BREAK CHARACTER
MOVEM T0,UQSMS2(T1) ;[OK] 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
CALL PADDR ;PARSE AN OCTAL ADDRESS (POSSIBLY ^<ARG>)
MOVEM T2,COLADR ;[C20] 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 ;[C20] GET SUPPRESS FLAG
HRRZ T1,(T1) ;[C20] ..
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: CALL PADDR ;PARSE AN OCTAL ADDRESS (POSSIBLY ^<ARG>)
MOVEM T2,ERRADR ;[OK] 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: CALL PADDR ;PARSE AN OCTAL ADDRESS (POSSIBLY ^<ARG>)
MOVEM T2,FERCOD ;[OK] 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
;/MAX-TEMP-FILES
CS5MTF: MOVEI T2,[FLDDB. (.CMNUM,,^D10,<maximum number of temporary files to use,>)] ;[N20] GET FDB ADDRESS
CALL PNUMB ;[N20] PARSE A NUMBER
CAIL T2,3 ;[N20] VALUE MUST BE BETWEEN 3
CAILE T2,MX.TMP ;[N20] AND MAX.
JRST E$$MTE ;[N20] ERROR
MOVEM T2,MAXTMP ;[N20] SAVE MAX NO. OF TEMP FILES
MOVEI T1,CS5TMP ;[N20] GET TABLE ADDRESS FOR DELEN
HRROI T2,[ASCIZ\MAX-TEMP-FILES:\] ;[N20] GET POINTER TO ENTRY TYPE
CALLRET DELEN ;[N20] 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) ;[OK] 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
;STATISTICS
CS5STS: LDB T1,CMDBLK+.CMPTR ;[C20] GET PREVIOUS TERMINATOR
CAIE T1,":" ;[C20] A COLON?
JRST [MOVEI T1,1 ;[C20] NO, DEFAULT A YES
JRST CS5ST1] ;[C20]
CALL PCOLON ;[C20] YES, EAT IT
MOVEI T2,[FLDDB. (.CMKEY,,CS5D,,)] ;[C20] PARSE VALUE
PUSHJ P,PATOM ;[C20] ..
JRST PARERR ;[C20] ILLEGAL VALUE
HRRZ T1,T2 ;[C20] GET VALUE
HRRZ T1,(T1) ;[C20] ..
CS5ST1: MOVEM T1,STATSW ;[C20] STORE VALUE
MOVEI T1,CS5TMP ;[C20] GET TABLE ADDRESS FOR DELEN
HRROI T2,[ASCIZ\STATISTICS\] ;[C20] GET POINTER TO ENTRY TYPE
CALLRET DELEN ;[C20] DELETE THE ENTRY
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
MOVE 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
ENDB;
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 ;[C20] [372] GET CODE ASSOCIATED WITH KEYWORD
HRRZ T1,(T1) ;[C20] ..
MOVEM T1,F.DENS ;[372] SAVE AS VALUE
MOVEI T1,CS6TMP ;[372] REMOVE /DENSITY: FROM TABLE
HRROI T2,[ASCIZ /DENSITY:/] ;[372] ..
PJRST DELEN ;[372] ..
ENDB;
BEGIN
PROCEDURE (PUSHJ P,CS6AIN) ;[372] /INDUSTRY FROM TABLE CS6A
MOVE 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] ..
ENDB;
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 ;[C20] [372] GET CODE ASSOCIATED WITH KEYWORD
HRRZ T1,(T1) ;[C20] ..
MOVEM T1,F.LABL ;[372] SET LABEL TYPE
MOVEI T1,CS6TMP ;[372] NOW DELETE /LABEL:
HRROI T2,[ASCIZ /LABEL:/] ;[372] ..
PJRST DELEN ;[372] ..
ENDB;
SUBTTL SORT AND MERGE -- Magtape Switches -- /PARITY:x, /REWIND, /POSITION:x, /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 ;[C20] [372] GET MONITOR'S SETJB% VALUE
HRRZ T1,(T1) ;[C20] ..
MOVEM T1,F.PARI ;[372] SAVE AS SWITCH VALUE
MOVEI T1,CS6TMP ;[372] DELETE /PARITY: FROM TABLE
HRROI T2,[ASCIZ /PARITY:/] ;[C01] [372] ..
PJRST DELEN ;[372] ..
ENDB;
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]
ENDB;
BEGIN
PROCEDURE (PUSHJ P,CS6APO) ;[C11] /POSITION: FROM TABLE CS6A
MOVEI T2,[FLDDB. (.CMNUM,,^D10,,)] ;[C11] PARSE VALUE
PUSHJ P,PATOM ;[C11] ..
JRST PARERR ;[C11] DIDN'T PARSE
JUMPGE T2,$1 ;[C11] A BACKSPACE?
MOVN T2,T2 ;[C11] YES, NEGATE
TXO T2,1B1 ;[C11] AND MARK AS BACKSPACE
$1% MOVEM T2,F.POSI ;[C11] SAVE AS SWITCH VALUE
MOVEI T1,CS6TMP ;[C11] DELETE /POSITION: FROM TABLE
HRROI T2,[ASCIZ /POSITION:/] ;[C11] ..
PJRST DELEN ;[C11] ..
ENDB;
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] ..
ENDB;
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,CONFRM ;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 ?
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
TXNE T1,CM%NOP ;VALID PARSE?
JRST E$$NSC ;NO, GIVE ERROR MESSAGE
SETZM ATMBFR ;YES, CLEAR FOR NEXT PARSE FAILURE
RET ;GO DISPATCH TO PROCESSING ROUTINE
TYCM (?,NSC,<No such command as>)
CALL TYPATM ;TYPE THE LAST ATOM
JRST TYCRLP ;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
;HERE TO PARSE AN OCTAL ADDRESS
PADDR: MOVEI T2,[FLDDB. (.CMNUM,,8,<octal address>)] ;GET A FUNCTION DESCRIPTOR BLOCK ADDERSS
JRST PNUMBX ;COMMON CODE
PNUMBO: MOVEI T2,[FLDDB. (.CMNUM,,8)] ;GET A FUNCTION DESCRIPTOR BLOCK ADDERSS
JRST PNUMBX ;COMMON CODE
PNUMB: SKIPA ;ENTER HERE WITH T2 INITIALIZED
PNUMBE: MOVEI T2,[FLDDB. (.CMNUM,,^D10)] ;GET FDB ADDRESS
PNUMBX: 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?
JRST PNUMBA ;NO, TRY FOR ^n
SETZM ATMBFR ;YES, CLEAR FOR NEXT PARSE FAILURE
RET ;YES, JUST RETURN
;SEE IF USE TYPED ^ RATHER THAN NUMBER
PNUMBA: MOVEI T1,CMDBLK ;SEE IF "^" IS NEXT IN COMMAND STRING
MOVEI T2,[FLDDB. (.CMTOK,CM%SDH,<POINT 7,[ASCIZ\^\]>,)] ;GET FDB ADDRESS
COMND% ;PARSE THE "^"
ERJMP CMDERR ;OOPS
TXNE T1,CM%NOP ;DID IT PARSE
JRST PNUMBI ;NO, MUST BE INVALID
;OK - GET THE NUMBER FOLLOWING THE "^"
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% ;DO INITIAL PARSE
ERJMP CMDERR ;ERROR, GO CHECK FOR EOF ON TAKE FILE
TXNE T1,CM%NOP ;VALID PARSE?
JRST PNUMBI ;NO, THIS IS ILLEGAL
SETZM ATMBFR ;YES, CLEAR FOR NEXT PARSE FAILURE
;OK - RANGE CHECK THE NUMBER OF THE ARG AND GET VALUE
CAILE T2,1 ;IS IT IN RANGE?
CAMLE T2,FORCNT ; ..
JRST FEAERR ;NO
ADD T2,FORARG ;ADD IN BASE
XMOVEI T1,. ;SEE IN IN NON-ZERO SECTION
TLNN T1,-1
TXOA T2,<Z @> ;NO, SET LOCAL INDIRECT BIT
TXO T2,EFIW ;YES, SET GLOBAL INDIRECT
MOVE T2,@T2 ;GET ACTUAL
RET
PNUMBI: TYCM(?,NVN,<>)
CALL TYPATM ;TYPE THE LAST ATOM
TMSG < not a valid number>
JRST TYCRLP
;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
TXNE T1,CM%NOP ;DID IT PARSE
JRST PARERR ;IMPOSSIBLE!!
RET ;YES, RETURN
CPOPJ1: AOS (P) ;SKIP EXIT
CPOPJ: 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,FDB6IL ;LOCAL SWITCHES THEN OUTPUT FILE?
JRST PFOERR ;YES, OUTPUT FILE ERROR
CAIE T3,FDBC6X ;YET ANOTHER POSSIBILITY
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
SETO T1, ;YEP
MOVE T2,CMDBLK+.CMCNT ;SAVE COUNT OF CHARACTERS LEFT IN BUFFER
POP P,CMDBLK+.CMPTR ; ..
POP P,CMDBLK+.CMINC ;RESTORE DATA
POP P,CMDBLK+.CMCNT ; ..
EXCH T2,CMDBLK+.CMCNT ;USE THE LATEST VALUE OF SPACE LEFT
SUB T2,CMDBLK+.CMCNT ;COMPUTE IF SWITCH WAS RECOGNIZED
ADDM T2,CMDBLK+.CMINC ;INCLUDE IN COUNT OF UNPARSED CHARACTERS
JUMPN T1,PSWER5 ;JUMP IF A KNOWN SWITCH
TYCM (?,NSS,<No such switch as>)
CALL TYPATM ;TYPE THE LAST ATOM
JRST TYCRLP ;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 TYCRLP
;SWITCH ARGUMENT DID NOT PARSE
PARERR: TYCM (?,NSA,<No such switch argument as>)
CALL TYPATM ;TYPE THE LAST ATOM
JRST TYCRLP ;GO TRY TO GET A SWITCH ARGUMENT AGAIN
;COMMA DID NOT PARSE
PCRERR: TYCM (?,CRQ,<Comma required.>)
JRST TYCRLP ;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 TYCRLP
; /ERROR OR /FATAL
FEAERR: TYCM (?,FEA,<Formal arg exceeds actual arg count>)
JRST TYCRLP
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
E$$CFV: $ERROR (?,CFV,<Conflict with /FIXED and /VARIABLE.>,,PRSERR)
E$$CNV: $ERROR (?,CNV,<Conflict with /NOCRLF and /VARIABLE.>,,PRSERR)
E$$MTE: $ERROR (?,MTE,</MAX-TEMP-FILES takes value between 3 and 26.>,,PRSERR) ;[N20]
E$$OFF: $ERROR (?,OFF,<Output file is off-line.>,,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) ;[OK] SKIP IF THERE IS NO JFN
RLJFN% ;[335] THERE IS SO RELEASE IT
ERJMP RJFERR ;OOPS
SKIPE P1,X.NXT(P1) ;[OK] 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) ;[OK] 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) ;[OK] MAKE CURRENT BECOME THE PREVIOUS X.BLOCK
MOVEM T1,F.OUZR ;POINT F.INZR TO CURRENT X.BLOCK
RET
BEGIN
PROCEDURE (PUSHJ P,IGJFBO) ;[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.
IGJFBO: SKIPL APPFLG ;DO WE WANT TO APPEND TO EXISTING FILE?
SKIPA T2,[GJ%FOU] ;NO, SET GJ%FOU FOR NORMAL OUTPUT
; MOVEI T2,-1 ;YES, DON'T SET GJ%FOU, BUT CREATE IF NOT THERE
SETZ T2, ;??? DON'T KNOW WHAT IT IS YET ???
JRST IGJFB
IGJFBI: MOVX T2,GJ%OLD ;[372] FOR INPUT
IGJFB: 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
ENDB;
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
ENDB;
; 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 FORRET ;[C20] 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 FORRET ;[C20] 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 FORRET ;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
SKIPL P.STDA ;[372] GLOBAL FLAG SET?
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 SIXBIT, EBCDIC, AND BINARY FROM RECORDING MODE TABLE
DELESB: CALL DELES ;[N11] DELETE SIXBIT AND EBCDIC
DELB: MOVEI T1,CS2TMP ;[N11] GET TABLE ADDRESS FOR DELEN
HRROI T2,[ASCIZ\BINARY\] ;GET POINTER TO ENTRY TYPE
CALLRET DELEN ;DELETE THE ENTRY
; 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
;ALSO STREAM-ASCII AND LINE-SEQUENCED-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
MOVEI T1,CS7TMP
HRROI T2,[ASCIZ \LINE-SEQUENCED-ASCII\]
CALL DELEN
HRROI T2,[ASCIZ \STREAM-ASCII\]
CALL DELEN
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\FORMAT:\] ;GET POINTER TO ENTRY TYPE
CALL DELENT ;DELETE THE ENTRY
DELANC: HRROI T2,[ASCIZ\ALPHANUMERIC\] ;GET POINTER TO ENTRY TYPE
CALL DELENT
HRROI T2,[ASCIZ\NUMERIC\] ;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 \Gfloating\]
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
DELV: MOVEI T1,CS4TMP ;GET TABLE ADDRESS
HRROI T2,[ASCIZ\VARIABLE\] ;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
;HERE TO DELETE ALL ASCII ONLY SWITCHES FROM THE TABLES
DELASW: CALL DELADV ;[N11] DELETE /AFTER-ADVANCING /BEFORE-ADVANCING
CALL DELNCR ;[N11] DELETE /NOCRLF
DELAL: MOVEI T1,CS4TMP ;[N11] GET TABLE ADDRESS
HRROI T2,[ASCIZ\ALIGNED\] ;[N11] GET POINTER TO ENTRY TYPE
CALLRET DELEN ;DELETE THE ENTRY
DELADV: MOVEI T1,CS4TMP ;[N11] GET TABLE ADDRESS
HRROI T2,[ASCIZ\AFTER-ADVANCING\] ;[N11] GET POINTER TO ENTRY TYPE
CALL DELEN ;[N11] DELETE THE ENTRY
HRROI T2,[ASCIZ\BEFORE-ADVANCING\] ;[N11] GET POINTER TO ENTRY TYPE
CALLRET DELEN ;[N11] DELETE THE ENTRY
DELNCR: MOVEI T1,CS4TMP ;[N11] GET TABLE ADDRESS
HRROI T2,[ASCIZ\NOCRLF\] ;[N11] GET POINTER TO ENTRY TYPE
CALLRET DELEN ;[N11] DELETE THE ENTRY
;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%
;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 ">)
DEDER1: 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
ADDEN4: MOVEI T1,CS4TMP
JRST ADDENT ;ADD TO TABLE 4
ADDEN6: MOVEI T1,CS6TMP ;GET TABLE ADDRESS
ADDENT: HLROM T2,DELTBE ;SAVE ENTRY TYPE FOR ERROR MESSAGE
TBADD% ;[335]
ERJMP ADDERR ;OOPS
RET
ADDERR: TYCM (?,UTA,<Unable to add table entry ">)
JRST DEDER1
; 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 CRLP BEFORE GO PARSE AGAIN
TYCRLP: TMSG <
>
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
SETZ 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
SETZ 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: HRRZS T1 ;[C20] CLEAN UP T1 FOR INDEXING
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] ;[OK] [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 T4,FERCOD ;[C20] YES, DOES USER WANT CODE RETURNED?
JRST SUPMS1 ;NO
LDB T2,[POINT 7,(T1),34];[OK] GET FIRST CHAR
SUBI T2,40 ;SIXBITIZE
DPB T2,[POINT 6,(T4),23] ;[C20]
LDB T2,[POINT 7,1(T1),6] ;[OK] GET FIRST CHAR
SUBI T2,40 ;SIXBITIZE
DPB T2,[POINT 6,(T4),29] ;[C20]
LDB T2,[POINT 7,1(T1),13];[OK] GET FIRST CHAR
SUBI T2,40 ;SIXBITIZE
DPB T2,[POINT 6,(T4),35] ;[C20]
HRRZI T2,'SRT' ;GET PROGRAM CODE
HRLM T2,(T4) ;[C20] SAVE IT
SUPMS1: CAMLE T3,SUPFLG ;ARE WE ALLOWED TO PRINT IT?
AOSA (P) ;YES
HRROS SUPFLG ;NO, AND NOT FOR $MORE EITHER
HRROS T1 ;[C20] RESTORE LH OF T1
RET
SUBTTL DEFINITIONS -- Constants and Tables
DEFINE TB(RTN,TXT)<
[ASCIZ/TXT/] ,, RTN
>
CT1: CT1SIZ ,, CT1SIZ ;CURRENT,,MAX SIZE OF COMMAND TABLE
TB (.EXIT,EXIT) ;EXIT TO MONITOR LEVEL
TB (.HELP,HELP) ;HELP MESSAGES
TB (.MERGE,MERGE) ;MERGE THE INPUT FILES
TB (.PUSH,PUSH) ;PUSH TO EXEC
TB (.RUN,RUN) ;RUN PROGRAM
TB (.SORT,SORT) ;SORT INPUT-FILES
TB (.TAKE,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 (CS3GFL,Gfloating) ;
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 (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-1 ,, CS4AS ;CURRENT,,MAX SIZE OF CMD TBL
TB (CS4AAA,AFTER-ADVANCING) ;[N11]
TB (CS4AAL,ALIGNED) ;[N11]
TB (CS4ABA,BEFORE-ADVANCING) ;[N11]
BLKED: TB (CS4ABL,BLOCKED:) ;
TB (CS4AFI,FIXED) ;
TB (CS4AFO,FORTRAN) ;
TB (CS4ANC,NOCRLF) ;[N11]
TB (CS4ARA,RANDOM) ;
TB (CS4ASE,SEQUENTIAL) ;
TB (CS4AVA,VARIABLE) ;
BLOCK 1 ;SPACE FOR /RMS AND /ORGANIZATION:
CS4AS==.-1-CS4A
CS5A: CS5AS ,, CS5AS ;CURRENT,,MAX SIZE OF CMD TBL
TB (CS5APP,APPEND) ;
TB (CS5ABP,BUFFER-PAGES:) ;
TB (CS5ACH,CHECK) ;
TB (CS5COL,COLLATE:) ;
TB (CS5AER,ERROR-RETURN:) ;
TB (CS5FEC,FATAL-ERROR-CODE:) ;
TB (CS5ALE,LEAVES:) ;
TB (CS5MTF,MAX-TEMP-FILES:) ;[N20]
TB (CS5APH,PHYSICAL) ;
TB (CS5STS,STATISTICS) ;[C20]
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 (CS6APO,POSITION:) ;[C11]
TB (CS6ARE,REWIND) ;
TB (CS6AUN,UNLOAD) ;
BLOCK 1 ;ROOM FOR /BLOCKED:
CS6AS==.-1-CS6A
CS7: CS7S,,CS7S ;CURRENT,,MAX SIZE OF CMD TBK
TB (CS7IX,INDEXED)
TB (CS7LS,LINE-SEQUENCED-ASCII)
TB (CS7RL,RELATIVE)
TB (CS7SQ,SEQUENTIAL)
TB (CS7ST,STREAM-ASCII)
CS7S==.-1-CS7
;***** CS2: CS3: CS4A: CS5A: CS6A: CS7: 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
CS5D: CS5DS ,, CS5DS ;[C20] CURRENT,,MAX SIZE OF CMD TBL
TB (0,NO) ;[C20]
TB (1,YES) ;[C20]
CS5DS==.-1-CS5D ;[C20]
CS6B: CS6BS ,, CS6BS ;CURRENT,,MAX SIZE OF CMD TBL
TB (LABANS,ANSI) ;
TB (LABDEC,DEC) ;
TB (LABIBM,IBM) ;
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) ;LH IS DENSITY
TB (.SJD62,6250) ;[422] ADD 6250 BPI
TB (.SJDN8,800) ;
TB (.SJDDN,SYSTEM-DEFAULT)
CS6DS==.-1-CS6D
RMSENT: TB (CS4ARM,RMS) ;ADD /RMS FOR OUTPUT FILE-SPEC
ORGENT: TB (CS4ORG,ORGANIZATION:) ;ADD IF /RMS IS SEEN
ACCENT: TB (CS4ACC,ACCESS:) ;ADD IF /ORG IS REL OR INDEX
SEQENT: TB (CS7SA,SEQUENTIAL) ;ADD /ACC:SEQ
KEYENT: TB (CS7KA,KEYED) ;ADD /ACC:KEYED
;FUNCTION DESCRIPTOR BLOCKS
FDBRV: FLDDB. (.CMCFM,,,,<SORT>,FDBV)
FDBV: FLDDB. (.CMKEY,,CT1,,,FDB1)
FDB1: FLDDB. (.CMSWI,,CS1,,</RECORD-SIZE:>)
FDB3: FLDDB. (.CMSWI,,CS3TMP,,</KEY:>) ;KEY
FDBTMP: FLDDB. (.CMKEY,,TMPTBL)
;FDBTMP: FLDBK. (.CMKEY,,TMPTBL,,,UQSMS5)
FDBC: FLDDB. (.CMCMA,,,,<,>)
FDBC2: FLDDB. (.CMCMA,,,<
>,,FDB23) ;COMMA + <CR-LF> FOR READABILITY
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
;Function descriptor block for input file spec
FDBI: FLDDB. (.CMFIL) ;INPUT FILESPEC
;Function descriptor block for what follows input file spec
FDBC6: FLDDB. (.CMCMA,,,<
>,,FDB6IL) ;COMMA + <CR-LF> FOR READABILITY
FDB6IL: FLDDB. (.CMSWI,,CS4TMP,<local switches,>,,FDB6IT) ;LOCAL SWITCHES
FDB6IT: FLDDB. (.CMSWI,,CS6TMP,<tape switches,>,,FDBO) ;TAPE
;Same as FDBC6 but no tape switches
FDBC6X: FLDDB. (.CMCMA,,,<
>,,FDB6IY) ;COMMA + <CR-LF> FOR READABILITY
FDB6IY: FLDDB. (.CMSWI,,CS4TMP,<local switches,>,,FDBO) ;LOCAL SWITCHES
; *** WARNING *** DO NOT COMBINE FDBI AND FDBO
FDBO: FLDDB. (.CMFIL,CM%SDH,,<output filespec>) ;OUTPUT FILESPEC
;Things after output file-spec
FDBC6R: FLDDB. (.CMCMA,,,,,FDB6R) ;COMMA
FDB6R: FLDDB. (.CMSWI,,CS4TMP,<local switches,>,,FDB6OT) ;LOCAL
FDB6OT: FLDDB. (.CMSWI,,CS6TMP,<tape switches,>,,CONFRM) ;TAPE
CONFRM: FLDDB. (.CMCFM)
;Same as FDB6R except no tape switches
FDB6S: FLDDB. (.CMSWI,,CS4TMP,<local switches,>,,CONFRM) ;LOCAL
; 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
777644,,000760 ;[C13]
400000,,000760
400000,,000760 ;[C13]
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 ;
UQSMS5: 777777,,777760 ;ALL CTRL CHARS
777774,,000760 ;ALLOW NUMBER AND ":"
400000,,000760 ;ALLOW UPPER CASE
400000,,000760 ;ALLOW LOWER CASE
PROMPT: ASCIZ /SORT>/ ;PROMPT STRING
HLPFIL: ASCIZ \HLP:SORT.HLP\ ;[453] NAME OF THE HELP FILE
SUBTTL DEFINITIONS -- Impure Data
SEGMENT IMPURE ;[C20]
;THE FOLLOWING IS TEMP STORAGE FOR SWITCH TABLES
LD (CS2TMP,CS2S+1)
LD (CS3TMP,CS3S+1)
LD (CS4TMP,CS4AS+1)
LD (CS5TMP,CS5AS+1)
LD (CS6TMP,CS6AS+1)
LD (CS7TMP,CS7S+1)
;TMPLEN IS LENGTH OF ALL TEMP SWITCH TABLES
TMPLEN=CS2S+1+CS3S+1+CS4AS+1+CS5AS+1+CS6AS+1+CS7S+1-1
LD (TOTALC,1) ;[376] TOTAL WORDS ALLOCATED FOR CURRENT LINE
GD (FOR2ND,1) ;[376] -1 MEANS WE'VE DONE A FORTRAN COMMAND
GD (F.DENS,1) ;[372] LOCAL /DENSITY: VALUE
GD (F.PARI,1) ;[372] LOCAL /PARITY: VALUE
GD (F.RMS,1) ;OUTPUT /RMS FLAG
GD (F.ORG,1) ;OUTPUT RMS FILE /ORGANIZATION: VALUE
GD (P.DENS,1) ;[372] GLOBAL /DENSITY: VALUE
GD (P.PARI,1) ;[372] GLOBAL /PARITY: VALUE
GD (P.REW,1) ;[372] GLOBAL /REWIND VALUE
GD (P.UNL,1) ;[372] GLOBAL /UNLOAD VALUE
LD (PHYSIC,1) ;[372] /PHYSICAL FLAG
GD (RMSFLG,1) ;-1 IF RMS NEEDED
GD (APPFLG,1) ;-1 IF RMS APPEND CREATE, +1 IF RMS SUPERSEDE CREATE
GD (CMDLEN,1) ;LENGTH OF COMMAND FROM FORTRAN
LD (ERRORF,1) ;WE HAVE SEEN AN ERROR
LD (SAVPAR,1) ;[376] SAVED STACK POINTER TO RESTORE ON ERRORS
LD (SAVREP,1) ;SAVED STACK POINTER TO RESTORE ON REPARSE
LD (CPSAV,1) ;POINTER TO PREVIOUS ATOM
LD (CMDBLK,.CMGJB+5) ;[335] COMMAND STATE BLOCK FOR COMND% JSYS
GD (BUFFER,BUFSIZ) ;INPUT TEXT STORED HERE
LD (ATMBFR,ATMSIZ) ;[335] ATOM BUFFER FOR COMND% JSYS
LD (GJFBLK,GJFSIZ) ;[335] GTJFN BLOCK FOR COMND% JSYS
LD (NOIFDB,FDBSIZ) ;FUNCTION DESCRIPTOR BLOCK FOR NOISE WORDS
LD (NAMBUF,8) ;BUFFER FOR NAME OF INPUT FILE
LD (INJFN,1) ;INPUT JFN FOR TAKE COMMAND
LD (OUTJFN,1) ;OUTPUT JFN FOR TAKE COMMAND
LD (HLPJFN,1) ;OUTPUT JFN FOR HELP FILE
GD (TAKFLG,1) ;NON-ZERO IF PROCESSING INDIRECT FILE
LD (TBASAV,1) ;SYMBOL TABLE ADDRESS FOR DELENT
LD (DELTBE,1) ;ASCIZ POINTER TO SYMBOL TABLE ENTRY TYPE
LD (DELTBL,1) ;ADDRESS OF TABLE TO DELETE ENTRY FROM
LD (TMPTBL,20) ;AREA FOR COPY OF SYMBOL TABLE
GD (.NMUL,3)
GD (COLJFN,1)
LD (SWFRST,1) ;NON-ZERO IS FLAG FOR /REC FIRST IN COMMAND LINE
GD (XITFLG,1) ;EXIT TO MONITOR ON ERRORS AND COMMAND COMPLETION
FSPCLN==^D168 ;MAX FILE SPEC CHAR LENGTH
FSPWLN==<FSPCLN+4>/5 ;MAX FILESPEC WORD LENGTH
LD (RJFN,1)
LD (SJFN,1)
LD (PRGNAM,1)
LD (RFILE,FSPWLN)
LD (SFILE,FSPWLN)
SEGMENT HPURE ;[C20]
END