Trailing-Edge
-
PDP-10 Archives
-
BB-D489E-SB
-
srtfor.mac
There are 9 other files named srtfor.mac in the archive. Click here to see a list.
SUBTTL SRTFOR - FORTRAN SUBROUTINE INTERFACE TO SORT ON TOPS-10
SUBTTL L.R. JASPER/DMN/DZN/BRF 23-Jan-81
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1975, 1981 BY DIGITAL EQUIPMENT CORPORATION
IFN FTOPS20,<PRINTX ? SRTFOR should not be present in TOPS-20 SORT/MERGE.>
IFN FTPRINT,<PRINTX [Entering SRTFOR.MAC]>
FTFORTRAN==1
FTCOBOL==0
LOWORG==<LOWLOC==0> ;[N07] SET DATA SECTION BASE TO ZERO
DEFINE SEGMENT (A) <> ;ALL IN LOW SEGMENT
SUBTTL SRTFOR TABLE OF CONTENTS
; Table of Contents for SRTFOR
;
;
; Section Page
;
; 1 SRTFOR - FORTRAN SUBROUTINE INTERFACE TO SORT ............ 1
; 2 SRTFOR TABLE OF CONTENTS ................................. 2
; 3 DEFINITIONS
; 3.1 AC Usage and Flags ................................ 3
; 3.2 Impure Data ....................................... 4
; 4 ENTRY POINT FROM FORTRAN ................................. 5
; 5 SWITCH DEFINITIONS
; 5.1 SWTCHS Macro ...................................... 6
; 5.2 Name Table ........................................ 7
; 5.3 Dispatch Table .................................... 8
; 6 COMMAND SCANNER
; 6.1 Top Level ......................................... 9
; 6.2 Control Routines .................................. 10
; 6.3 Build Token and Branch on its Type ................ 12
; 7 SWITCH HANDLING
; 7.1 Uniqueness Switch Scanner ......................... 13
; 7.2 /ALIGN, /ALPHANUMERIC, /ASCII, /BINARY, /NUMERIC .. 14
; 7.3 /PRIORITY:n, /CORE:n, /RANDOM, /FIXED, /FORTRAN ... 14
; 7.4 /COMP, /COMP1, /SIGNED, /UNSIGNED ................. 15
; 7.5 /STANDARD, /DENSITY:n, /SEQUENTIAL, /VARIABLE ..... 15
; 7.6 /COLLATE:x[:y] .................................... 16
; 7.7 /KEY:n:m:x ........................................ 17
; 7.8 /FORMAT:xn.m ...................................... 18
; 7.9 /RECORD:n, /TEMP, /ESTIMATE:n, /UNLOAD ............ 19
; 7.10 /REWIND, /SUPPRESS:^n, /MERGE, /CHECK ............ 19
; 7.11 /ERROR:^n, /FATAL:^n ............................. 20
; 8 FILE SPEC SCANNING ROUTINES .............................. 21
; 9 SCAN INPUT ROUTINES - SIXBIT, Decimal, Octal, etc. ....... 22
; 10 INDIRECT COMMAND FILE I/O ROUTINES ....................... 23
; 11 ENDS. .................................................... 25
; 12 ERROR MESSAGES ........................................... 26
; 13 DUMMY ROUTINES FOR UNSUPPORTED FEATURES .................. 27
SUBTTL DEFINITIONS -- AC Usage and Flags
;AC USAGE
; T0=0 ;USED TO ASSEMBLE CONTENTS OF T1
; T1=1 ;A VALUE RETURNED FROM SCNANNER(SWITCH NAME OR VALUE)
; T2=2 ;FLAGS DEFINING WHAT STOPPED THE SCAN
; T3=3 ;SCRATCH
; T4=4 ;SCRATCH
; P1=5 ;THE JSP POINTER
; P2=6 ;(FORTRAN) SCAN FLAGS
; P3=7 ;POINTER TO THE FD BLOCK BEING DEFINED
; P4=10 ;
; F=11 ;
; U=12 ;GLOBAL SCRATCH
; J=13 ;THE CURRENT DISPATCH ENTRY
; R=14 ;
; S=15 ;TYPE ARGUMENT CODE
; L=16 ;POINTER TO ARG BLOCK
; P=17 ;PUSH DOWN LIST POINTER
ENTRY SORT
IFE FTOPS20,<
EXTERN FUNCT. ;[C19]
>
DEFINE ENDMODULE<
$PURGE
END>
;TOKEN FLAGS--THESE ARE IN P2
SC.KEY==1B0 ;WE'VE SEEN /KEY--DATA MODE SWITCHES ALLOWED
SC.EQU==1B1 ;WE'VE SEEN "="--NOW PROCESSING INPUT
SC.FNE==1B2 ;WE'VE SEEN A FILE NAME IN THIS SPEC
SC.DEV==1B3 ;WE'VE SEEN A DEVICE--USED WITH /TEMP
SC.TMP==1B4 ;WE'VE SEEN A /TEMP
SC.NEG==1B5 ;WE'VE SEEN A "-"--NEGATIVE /PRIORITY: VALUE PENDING
;TOKEN TERMINATOR FLAGS--THESE ARE IN T2. WHEN A TOKEN TERMINATOR CHARACTER
;IS SEEN (",", "=", ETC.), 1B<VALUE OF CHAR IN SIXBIT> IS SET. CHARACTERS NOT
;USED AS TERMINATORS HEREIN HAVE THEIR FLAG BITS TIME-SHARED WITH OTHER FLAGS.
;SOME OF THESE FLAGS ARE LISTED BELOW.
EOL==1B0 ;END OF LINE FLAG
UPARO==1B22 ;[347] ^ FLAG
SUBTTL DEFINITIONS -- Impure Data
SEGMENT IMPURE ;[C20]
ATSFLG: BLOCK 1
ATSFIL: BLOCK 4 ;[C19] ATS LOOKUP BLOCK
SRTPTR: BLOCK 1 ;[C20]
SRTCNT: BLOCK 1 ;[C20]
SAVPTR: BLOCK 1 ;[C20]
SAVCNT: BLOCK 1 ;[C20]
COMBUF: BLOCK 200 ;BUFFER FOR @COMAND FILE INPUT
SAVEP: BLOCK 1
SAVEL: BLOCK 1
ARGADR: BLOCK 1
.NMUL: BLOCK 4 ;[C13] TEMP STORAGE FOR SWITCH VALUES
.NMUE=.-1 ;[C13] LAST WORD OF .NMUL
SEGMENT LPURE ;[C20]
SUBTTL ENTRY POINT FROM FORTRAN
BEGIN
PROCEDURE (PUSHJ P,SORT)
MOVEM L,SAVEL
MOVEM P,SAVEP
PUSHJ P,CUTBAK ;CUT BACK CORE IF POSSIBLE
JSP P4,INITIALIZE
PUSHJ P,LOOP
MOVE P,SAVEP
MOVE L,SAVEL
RETURN
END;
SUBTTL SWITCH DEFINITIONS -- SWTCHS Macro
DEFINE SWTCHS<
SRTARG ALIGN,ALI,UDF
SRTARG ALPHANUMERIC,ALP,UDF
SRTARG ASCII,ASC,UDF
SRTARG BINARY,BIN,UDF
;; SRTARG BLOCKED,BLO,DEC
SRTARG CHECK,CHK,UDF
SRTARG COLLATE,COL,UDF
SRTARG COMP,CMP,UDF
SRTARG COMP1,CM1,UDF
;; SRTARG COMP3,CM3,UDF
SRTARG COMPUTATIONAL,COM,UDF ;;[213]
SRTARG CORE,COR,DEC
;; SRTARG EBCDIC,EBC,UDF
SRTARG ERROR,ERR,OCT
SRTARG FATAL,FAT,OCT
SRTARG FIXED,FIX,UDF
SRTARG FORMAT,FMT,UDF ;;[213]
SRTARG FORTRAN,FOR,UDF
;; SRTARG INDUSTRY,IND,UDF
SRTARG KEY,KEY,DEC
;; SRTARG LABEL,LAB,SIX
SRTARG LEAVES,LEA,DEC
SRTARG MAXTEMPFILES,MTF,DEC ;;[N20]
SRTARG MERGE,MRG,UDF
SRTARG NUMERIC,NUM,UDF
;; SRTARG PACKED,PAC,UDF
SRTARG PRIORITY,PRI,DEC
SRTARG RANDOM,RAN,UDF
SRTARG RECORD,REC,DEC
SRTARG REWIND,REW,UDF
SRTARG SEQUENTIAL,SEQ,UDF
SRTARG SIGNED,SIG,UDF
;; SRTARG SIXBIT,SIX,UDF
SRTARG STANDARD,STA,UDF ;;[213]
SRTARG STATISTICS,STS,UDF ;;[C20]
SRTARG SUPPRESS,SUP,UDF
SRTARG TEMP,EMP,UDF
SRTARG UNLOAD,UNL,UDF
SRTARG UNSIGNED,UNS,UDF
SRTARG VARIABLE,VAR,UDF
;;SWITCHES FROM SCAN
SRTARG DENSITY,DEN,DEC ;;[213]
SRTARG ESTIMATE,EST,DEC
;; SRTARG VERSION,VER,UDF
SRTARG ,DEV,SIX ;;DISPATCH FOR DEV:
SRTARG ,NAM,SIX ;;DISPATCH FOR FILE NAME
SRTARG ,PPN,OCT ;;DISPATCH FOR PPN
SRTARG ,ATS,SIX ;;FOR INDIRECT COMMAND FILE PROCESSING
>
SUBTTL SWITCH DEFINITIONS -- Name Table
DEFINE SRTARG(KEY,PROC,VAL)<
IFNB <KEY>,<
EXP SIXBIT /KEY/
>
>
SO.SWT: SWTCHS
SO.MAX==.-SO.SWT
SUBTTL SWITCH DEFINITIONS -- Dispatch Table
DEFINE SRTARG(KEY,PROC,VAL)<
IFB <KEY>,<INX'PROC=.-SO.DSP> ;;DEFINE FILE SPEC DISPATCH OFFSETS
XWD SCN'VAL,SRT'PROC ;KEY
>
SO.DSP: SWTCHS
SUBTTL COMMAND SCANNER -- Top Level
BEGIN
PROCEDURE (PUSHJ P,SCAN)
IF WE'RE PROCESSING AN INDIRECT FILE
SKIPG ATSFLG ;ARE WE PROCESSING INDIRECT COMMAND FILE?
JRST $T ;[213] NOPE, GO SCAN THE FORTRAN LITERAL
THEN REINITIALIZE SORT
MOVE T1,SAVPTR ;[C20] RESTORE SCANNER POINTER AND COUNT
MOVEM T1,SRTPTR ;[C20] ..
MOVE T1,SAVCNT ;[C20] ..
MOVEM T1,SRTCNT ;[C20] ..
STORE (T1,ZCOR,SEQNO,0) ;CLEAR DATA AREA
MOVE T3,TCBIDX
MOVE T4,MAXTMP
MOVE T1,[Z.BEG,,Z.BEG+1] ;SET UP TO ZERO SOME SORT LOCS TOO
SETZM Z.BEG
BLT T1,Z.END ;BLT TO ZEROES
MOVEM T3,TCBIDX
MOVEM T4,MAXTMP
PUSHJ P,GETJOB ;GET JOB NUMBER
JSP T4,CPUTST ;[202] SEE WHICH CPU WE HAVE
PUSHJ P,SSTATS ;[C20] SETUP STATS LOCS
SETOM P.BLKF
SETOM P.VARF
JRST $F ;[213] GO PICK UP FROM WHERE WE LEFT OFF
ELSE JUST CHECK ARG LIST (INITIALIZATION ALREADY DONE)
SETZM SRTCNT ;[C20] [223] INITIALIZE CHAR CNT TO 'HUGE' NUMBER
MOVE L,SAVEL ;[C19] RESTORE L
HLRE T1,-1(L) ;[OK] PICK UP # OF ARGS.
MOVMM T1,FORCNT ;[C20] STORE NUMBER OF ACTUALS
MOVEM L,FORARG ;[C20] STORE ADDRESS OF ACTUALS
HRRI T1,@(L) ;[C20] GET ADDR OF FIRST ARG
HRLI T1,(POINT 7,) ;[C20] MAKE IN BYTE POINTER
MOVEM T1,SRTPTR ;[C20] SAVE IT
SETOM ATSFLG ;MARK NO @ SEEN...
FI;
SETOM TEMPSW ;RESET FLAG(NOT SEEN) FOR /TEMP SWITCH
PUSHJ P,CLRANS ;SET UP SOME SPECIAL LOCS.
SETZB T2,P2 ;[C20] [213] NO DELIMTERS PENDING
;& ZAP FLAGS (INITIALIZE ALL CONDITIONS INSIDE SCANNER)
PUSHJ P,SCNSIT ;GO SCAN THE SORT COMMAND(LITERAL)
;COMES BACK ON A NULL AND/OR
;LF (IF PROCESSING INDIRECT COMMAND FILE)
RETURN ;GOOD RETURN
END;
SUBTTL COMMAND SCANNER -- Control Routines
; FILE DESCRIPTOR/KEY BLOCKS ARE ALLOCATED VIA
; THIS CODE. DATA IS STUFFED INTO THE REAL BLOCK.
BEGIN
PROCEDURE (PUSHJ P,ALLOUT)
PUSH P,T1 ;SAVE THESE TEMPS
PUSH P,T2
MOVEI T1,S.LEN ;TOTAL SPACE NEEDED
PUSHJ P,GETSPC ;T1=ADDRESS
JRST E$$NEC ;FAILED
SETZM S.SPC(T1) ;[OK] [213] ZERO POINTER TO NEXT BLOCK
MOVE P3,T1 ;[C20] SET UP EFFECTIVE ADDR FOR SCANNER
HRLZI T2,1(T1) ;[OK] [202] SET ALL FILE SWITCHES TO -1
HRRI T2,2(T1) ;[OK] [202] WHICH IS UNINITIALIZED STATE
SETOM 1(T1) ;[OK] [202] FOR SCAN SWITCHES
BLT T2,S.DEV-1(T1) ;[OK] [202] ..
MOVE T2,F.OUZR ;PREVIOUS BLOCK (OR 0)
MOVEM T2,0(T1) ;[OK] LINK
MOVEM T1,F.OUZR ;NEW BLOCK
POP P,T2 ;RESTORE THE TEMPS
POP P,T1
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,ALLIN0)
MOVEI T1,S.LEN ;TOTAL SPACE NEEDED
PUSHJ P,GETSPC ;T1=ADDRESS
JRST E$$NEC ;FAILED
SETZM S.SPC(T1) ;[OK] [213] ZERO POINTER TO NEXT BLOCK
MOVE P3,T1 ;[C20] SAVE EFFECTIVE ADDR FOR SCAN CODE
HRLZI T2,1(T1) ;[OK] [202] SET ALL FILE SWITCHES TO -1
HRRI T2,2(T1) ;[OK] [202] WHICH IS UNINITIALIZED STATE
SETOM 1(T1) ;[OK] [202] FOR SCAN SWITCHES
BLT T2,S.DEV-1(T1) ;[OK] [202] ..
HRRM T1,ARGADR
SETZ T2, ;SET UP LIKE VIRGIN SCAN
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,ALLIN1) ;LINK INPUT SCAN BLOCK INTO PROPER LIST
HRRZ T1,ARGADR ;GET BACK BLOCK POINTER
IF THIS IS A TEMP FILE SPEC
TXNN P2,SC.TMP ;IS THIS A TEMP FILE SPEC?
JRST $T ;NOPE - GO LINK INTO INPUT CHAIN(AT FRONT)
THEN LINK INTO TEMP CHAIN AT END
MOVEI T2,F.TMZR ;YES, GET ADDR. OF LAST BLOCK
$1% HRRZ T3,(T2) ;[C20] GET POINTER TO NEXT
JUMPE T3,$2 ;[C20] NONE
MOVE T2,T3 ;[C20] COPY IT
JRST $1 ;TRY AGAIN
$2% MOVEM T1,(T2) ;[OK] LINK IN(AT BACK)
JRST $F ;GO ALLOCATE SPACE FOR THE NEXT BLOCK
ELSE LINK INTO INPUT CHAIN AT FRONT
MOVE T2,F.INZR ;PREVIOUS BLOCK(OR 0)
MOVEM T2,0(T1) ;[OK] LINK
MOVEM T1,F.INZR ;NEW BLOCK
FI;
PJRST ALLIN0 ;ALLOCATE SPACE FOR THE NEXT BLOCK
END;
SUBTTL COMMAND SCANNER -- Build Token and Branch on its Type
; T0 USED TO ASSEMBLE CONTENTS OF T1
; T1 SWITCH DATUM
; T2 END OF LINE(NULL) AND/OR DELIMITERS
; P2 FLAGS
; P3 POINTER TO FILE/KEY BLOCK
; J SWITCH INDEX
; U CONVERSION TO (INDEX FOR SCANNER)
SCNSIT: SETZ J, ;CLEAR THE SWITCH INDEX
JUMPN T2,SCNCHK ;IS THERE A DELIMETER PENDING?
SCNSWZ: PUSHJ P,SCNSIX ;NO, GO GET SOMETHING
JUMPE T1,SCNCHK ;IF NO DATUM, GO CHECK ON A SWITCH
MOVEI J,INXNAM ;ASSUME A FILE NAME
TXZE T2,<1B':'> ;IS THIS A DEVICE?
MOVEI J,INXDEV ;YES, PROCESS THE DEVICE NAME
JRST SCNSW6 ;DATUM IS IN AC T1
SCNCHK: TXZE T2,<1B'/'> ;CHECK FOR ANOTHER SWITCH
JRST SCNSWT ;WHAT IS IT?
TXZE T2,<1B','> ;IS DELIMETER A COMMA?
JRST COMMA ;YES, START NEW FILE SPEC
TXZE T2,<1B'='> ;IS DELIMITER AN EQUALS?
JRST EQUALS ;YES, GO DO SOME GOOD
TXZN T2,<1B'@'> ;INDIRECT COMMAND FILE SPEC.?
JRST IFEND ;NOPE, GO SEE IF THE END
MOVEI J,INXATS ;NO, SET UP TO HANDLE FILE NAME
JRST SCNSW5 ;DISPATCH TO GET IT
IFEND: TXZE T2,EOL ;COULD BE THE END?
JRST ENDIT ;TH TH TH THATS ALL FOLKS
TXZN T2,1B19 ;NOT FINISHED, CHECK FOR A[PPN]
JRST E$$UDL
MOVEI J,INXPPN ;GO PROCESS THE PPN,SFD
JRST SCNSW5 ;DISPATCH TO GET PSEUDO SWITCH
EQUALS: TXOE P2,SC.EQU ;HAVE WE SEEN ANOTHER EQUALS
JRST E$$ONS ;YES, GIVE ERROR
TXZN P2,SC.FNE!SC.DEV ;NOPE - SEEN AN OUTPUT FILENAME OR DEVICE?
JRST E$$ONS ;ERROR - NO OUT FILENAME OR MULTI. =
MOVE T3,RECORD ;SEE IF SPECIFIED ON OUTPUT SIDE
MOVEM T3,RECOUT ;SAVE IN CASE ITS DIFFERENT ON OUTPUT
SETOM RECORD ;SET INPUT REC. SIZE AS NULL
PUSHJ P,ALLIN0 ;ALLOCATE INPUT FILE DESCR. AREA(BLOCK)
JRST SCNSIT
COMMA: TXNN P2,SC.EQU ;HAVE WE SEEN AN EQUALS?
JRST E$$MOI
TXZN P2,SC.FNE!SC.DEV ;[350] HAVE WE SEEN AN INPUT FILENAME OR DEVICE?
JRST E$$INS ;DON'T ALLOW MULTIPLE OUTPUT SPECS
;OR A COMMA AND NO FILENAME ENCOUNTERED
PUSHJ P,ALLIN1 ;[350] GO FINISH FILE SPEC ALLOCATION
TXZ P2,SC.TMP!SC.DEV ;TURN OFF /TEMP SEEN, DEV: SEEN
;SC.TMP IS USED TO KEY CORRECT BLOCK LINKING.
JRST SCNSIT
ENDIT: TXZN P2,SC.FNE!SC.DEV ;[350] ERROR IF NO FILE NAME OR DEVICE
JRST E$$INS ;ERROR- TELL EM
PJRST ALLIN1 ;[350] FINISH UP LAST FILE SPEC. ALLOC.
SCNSWT: TXNN P2,SC.FNE!SC.DEV ;[350] [213] MUST HAVE SEEN A FILE SPEC
JRST E$$SFF ;[213] SWITCH IS NOT PROPERLY PLACED
PUSHJ P,SCNSIX ;GET SWITCH DATUM
MOVE T4,[XWD -SO.MAX,SO.SWT] ;GET THE SWITCH TABLE
PUSHJ P,SCNTBL ;SCAN THE TABLE
JRST ERRUKS ;[213] UNKNOWN SWITCH
HRRZ J,T4 ;[C20] GET THE SWITCH INDEX
SCNSW5: HLRZ U,SO.DSP(J) ;LOAD THE SWITCH ARGUMENT ROUTINE ADDR
PUSHJ P,(U) ;GET THE ARGUMENT FOR THE SWITCH
SCNSW6: HRRZ U,SO.DSP(J) ;LOAD THE SWITCH PROCESSOR ADDR
PUSHJ P,(U) ;PROCESS THE ARGUMENT
JRST SCNSIT ;PROCESS NEXT SWITCH
SUBTTL SWITCH HANDLING -- Uniqueness Switch Scanner
;ENTRY
; T0 SCRATCH
; T1= SIXBIT NAME TO SCAN FOR
; T2= NOT USED (CONTAINS FLAGS)
; T3= SCRATCH
; T4= -TABLE SIZE,,TABLE ADDRESS
;RETURN
; T4= THE INDEX INTO THE TABLE
; NON-SKIP RETURN OF ENTRY NOT FOUND
; SKIP RETURN OF FOUND IN THE TABLE
BEGIN
PROCEDURE (PUSHJ P,SCNTBL)
PUSH P,P1 ;[C20] NEED AN AC, SAVE P1
PUSH P,T4 ;SAVE THE ARGUMENT
SETZ T0, ;CLEAR THE FLAG WORD
SETO T3, ;SET UP A MASK
LSH T3,-6 ;SHIFT MASK...LRJ
TDNE T1,T3 ;CHECK MASK AGAINST SIGNIFICANT BYTES
JUMPN T3,.-2 ;RETRY THE MASK TEST
WHILE THERE ARE KEYWORDS TO CHECK
BEGIN
IF USER'S KEYWORD MATCHES THE TABLE ENTRY
HRRZ P1,T4 ;[C20] GET NEXT KEYWORD
MOVE P1,(P1) ;[C20] ..
ANDCAM T3,P1 ;[C20] TRUNCATE IT TO USER LENGTH
CAME P1,T1 ;[C20] IS THIS THE SWITCH
JRST $F ;NO--GO TRY NEXT ONE
THEN CHECK FOR EXACT MATCH
JUMPE T0,.+2 ;HAVE WE SEEN A ABRIV. SWITCH
SETO T0, ;YES, SET MULTI SWITCH FLAG
HRR T0,T4 ;[C20] SAVE SWITCH INDEX IN ANY CASE
HRRZ P1,T4 ;[C20] EXACT MATCH
CAMN T1,(P1) ;[C20] ..
JRST [ANDI T0,-1 ;YES--CLEAR MULTI FLAG
JRST $E] ; AND QUIT NOW
FI;
AOBJN T4,$B ;REDUCE COUNT AND CONTINUE SEARCH
END;
MOVE T4,T0 ;GET THE ABS ADDRESS IN T4
POP P,T0 ;GET THE ARGUMENT BACK
JUMPLE T4,$1 ;ERROR ARGUMENT NOT IN TABLE
SUB T4,T0 ;RELOCATE TO INDEX
ANDI T4,-1 ;RIGHT HALF ONLY
AOS -1(P) ;[C20] GIVE SKIP RETURN
$1% POP P,P1 ;[C20] RESTORE P1
RETURN ;[C20]
END;
SUBTTL SWITCH HANDLING -- /ALIGN, /ALPHANUMERIC, /ASCII, /BINARY, /NUMERIC
SUBTTL SWITCH HANDLING -- /PRIORITY:n, /CORE:n, /RANDOM, /FIXED, /FORTRAN
SRTALI: MOVEI T3,1 ;SET UP A +1 VALUE
MOVEM T3,ALIGN ;AND PUT IT IN APPROPR. LOC.
POPJ P,
SRTALP: MOVX T3,RM.ALP ;[213] SET UP /ALPHANUMERIC DATA MODE
PJRST STUFMD ;[213] AND STORE IT
SRTASC: MOVX T3,RM.ASC ;[213] SET UP /ASCII RECORDING MODE BIT
PJRST STFMD1 ;[213] AND STORE IT
SRTBIN: MOVX T3,RM.BIN ;[213] SET UP /BINARY RECORDING MODE BIT
PJRST STFMD1 ;[213] AND STORE IT
SRTNUM: MOVX T3,RM.NUM ;[213] SET UP /NUMERIC DATA MODE
PJRST STUFMD ;[213] AND STORE IT
SRTPRI: JUMPN T1,CHK3 ;IF T1 IS NOT = 0(FROM LAST SCAN)
;THEN IT CONTAINS A NUMBER(PRIORITY)
TXZE T2,<1B'+'> ;OTHERWISE MUST LOOK AT T2 FOR
;SIGN OF ARGUMENT
JRST PRIARG ;IT WAS A +
TXZN T2,<1B'-'> ;IS IT A -
JRST E$$PRI ;BETTER BE - CAUSE IF NOT ITS AN ERROR
TXO P2,SC.NEG ;MARK THAT WE SAW A -
PRIARG: PUSHJ P,SCNDEC ;STILL HAVE TO GET PRIO. NUMBER
CHK3: CAILE T1,3 ;CANT BE MORE THAN THREE
JRST E$$PRI ;BUT IT SURE WAS...
MOVEM T1,PRIORI ;MARK AND RECORD PRIORITY SPECIFIED
TXZE P2,SC.NEG ;DOES IT HAVE TO BE A NEGATIVE NUMBER?
MOVNM T1,PRIORI ;DO IT
POPJ P, ;RETURN TO SCANNER
SRTCOR: TRZN T2,1 ;[213] P OR K TYPED AFTER ARG?
JRST STFCOR ;[213] NO--STORE /CORE ARG AS IS
CAIN T0,'P' ;[213] P TYPED?
LSH T1,<POW2 (1000)> ;[213] YES--CONVERT TO PAGES
CAIN T0,'K' ;[213] K TYPED?
LSH T1,<POW2 (2000)> ;[213] YES--CONVERT TO K CORE
STFCOR: MOVEM T1,CORSIZ ;STUFF CORE SIZE REQUESTED
POPJ P, ;RETURN TO SCANNER
SRTRAN: SRTFIX:
SETZM S.VARI(P3) ;[C20] MARK FIXED LENGTH RECORDS
SKIPGE P.VARF ;[202] SEEN A DEFAULT YET?
SETZM P.VARF ;[202] NO--DEFAULT TO /FIX
POPJ P, ;RETURN TO SCANNER(SCNSIT)
SRTFOR: MOVX T3,RM.FOR ;[213] SET UP /FORTRAN FILE MODE
PJRST STFMD1 ;[213] AND STORE IT
SUBTTL SWITCH HANDLING -- /COMP, /COMP1, /SIGNED, /UNSIGNED
SUBTTL SWITCH HANDLING -- /STANDARD, /DENSITY:n, /SEQUENTIAL, /VARIABLE
SUBTTL SWITCH HANDLING -- /STATISTICS:<yes or no>
SRTCMP: SRTCM1: SRTCOM:
MOVX T3,RM.COM ;[213] SET UP /COMP/COMP1 DATA MODE
PJRST STUFMD ;[202,213] AND STORE IT
SRTSIG: MOVX T3,RM.SGN ;[213] SET UP /SIGNED DATA MODE
PJRST STUFMD ;[213] AND STORE IT
SRTUNS: MOVX T3,RM.UNS ;[213] SET UP /UNSIGNED DATA MODE
PJRST STUFMD ;[213] AND STORE IT
SRTSTA: MOVEI T3,1 ;[213] MARK STANDARD-ASCII TAPE
MOVEM T3,S.STDA(P3) ;[C20] [213] AND STORE IT
POPJ P, ;[213] DONE
SRTSTS: TXZN T2,<1B':'> ;[C20] ARGUMENT SPECIFIED?
SKIPA T1,[SIXBIT /YES/] ;[C20] NO, ASSUME YES
PUSHJ P,SCNSIX ;[C20] YES, GET IT
SETO T3, ;[C20] ASSUME NOTHING
LSH T1,-^D<36-6> ;[C20] USE ONLY FIRST CHARACTER
CAIN T1,'Y' ;[C20] A YES?
MOVEI T3,1 ;[C20] YES, REMEMBER IT
CAIN T1,'N' ;[C20] A NO?
MOVEI T3,0 ;[C20] YES, REMEMBER IT
JUMPL T3,E$$USV ;[C20] UNKNOWN SWITCH VALUE
MOVEM T3,STATSW ;[C20] STORE SWITCH VALUE
POPJ P, ;[C20] DONE
SRTDEN: MOVE T3,[-5,,1] ;[213] SET TO LOOP THRU VALID DENSITIES
WHILE THERE ARE DENSITIES TO CHECK
BEGIN
CAME T1,[DEC 200,556,800,1600,6250]-1(T3) ;[OK] [213] CHECK NEXT DENSITY
AOBJN T3,$B ;[213] NO GOOD--CHECK NEXT IF ANY
END;
JUMPGE T3,E$$IDS ;[213] IF +, AOBJN FELL THROUGH
HRRZS T3 ;[C20] [213] CONSTRUCT TAPOP. DENSITY ARG
DPB T3,[POINTR (S.MOD(P3),FX.DEN)] ;[C20] [213] AND SAVE IN SCAN BLOCK
POPJ P,
SRTSEQ: SRTVAR:
MOVEI T3,1 ;SET UP A +1
MOVEM T3,S.VARI(P3) ;[C20] MARK VARIABLE RECORDS USED
SKIPGE P.VARF ;[202] DEFAULT SEEN YET?
MOVEM T3,P.VARF ;[202] NO--DEFAULT TO /VARIABLE
POPJ P,
STUFMD: TXNN P2,SC.KEY ;[213] DATA MODE SWITCHES MUST FOLLOW /KEY
JRST E$$DFK ;[213] ERROR OTHERWISE
STFMD1: IORM T3,MODE ;[213] SET DATA MODE IN CURRENT KEY
IORM T3,MODEM ;[213] SET DATA MODE IN CUMULATIVE MASK
POPJ P, ;[213] DONE
SUBTTL SWITCH HANDLING -- /COLLATE:x[:y]
BEGIN
PROCEDURE (PUSHJ P,SRTCOL) ;[355] PROCESS /COLLATE SWITCH
PUSHJ P,SCNSIX ;[355] GET SWITCH ARG
JUMPE T1,E$$CND ;[355] NULL SWITCH ARGUMENT ILLEGAL
MOVE T4,[-COL.L,,COL.T] ;[355] SEARCH TABLE FOR SWITCH VALUE
PUSHJ P,SCNTBL ;[355] ..
JRST E$$CND ;[355] NOT THERE--ERROR
ADDI T4,1 ;[C20] [355] GET INDEX VALUE
CASE COLSW OF ASCII, EBCDIC, FILESPEC, LITERAL, ADDRESS
HRLI T4,(IFIW) ;[C20] ..
MOVEM T4,COLSW ;[355] STORE IT
JRST @[IFIWS <$C,$C,$1,$2,$3>]-1(T4) ;[C20] [355] DISPATCH
$1% PUSH P,P2 ;[355] SAVE CURRENT BLOCK AND FLAGS
PUSH P,P3 ;[C20] ..
MOVX P2,SC.EQU ;[C20] [355] SET UP NEW BLOCK AND FLAGS
MOVEI P3,COLSCN ;[C20] ..
ZERO (T1,COLSCN,S.LEN) ;[355] CLEAR TEMP SCAN BLOCK
PUSHJ P,SCNSIX ;[355] GET FILE SPEC
IF WE GOT A DEVICE SPECIFICATION
TXZN T2,<1B':'> ;[355] VERIFY SWITCH ARGUMENT SEPARATOR
JRST $F ;[355] NOT THERE
THEN CHECK AND REMEMBER IT, AND READ FILE NAME
JUMPE T1,E$$NDV ;[355] NULL DEVICE ILLEGAL
MOVEM T1,S.DEV(P3) ;[C20] [355] SAVE DEVICE NAME
TXO P2,SC.DEV ;[355] REMEMBER WE GOT ONE
PUSHJ P,SCNSIX ;[355] GO GET FILE NAME
FI;
JUMPE T1,E$$CFS ;[355] NULL FILE NAME ILLEGAL TOO
PUSHJ P,SRTNAM ;[355] HANDLE NAME AND EXTENSION
IF A PATH WAS SPECIFIED
TXZN T2,1B19 ;[355] LEFT SQUARE BRACKET?
JRST $F ;[355] NO--NO PATH
THEN PARSE IT
PUSHJ P,SCNOCT ;[355] READ PROJECT
PUSHJ P,SRTPPN ;[355] READ REST OF PATH
FI;
POP P,P3 ;[C20] [355] RESTORE SCANNING FLAGS AND BLOCK
POP P,P2 ;[C20] ..
RETURN ;[355] DONE HERE
$2% ILDB T1,SRTPTR ;[C20] [355] GET DELIMITER OF STRING
MOVE T4,[POINT 7,COLITB] ;WHERE TO STORE LITERAL
WHILE CHARACTERS IN LITERAL
BEGIN
ILDB T2,SRTPTR ;[C20] [355] GET CHAR
CAMN T2,T1 ;[355] AT END?
SETZ T2, ;[355] YES, END WITH NUL
IDPB T2,T4 ;[355] STORE CHAR
JUMPN T2,$B ;[355] LOOP
END;
RETURN ;[355] DONE
$3% PUSHJ P,SCNOCT ;[355] GET THE ADDRESS
TXZE T2,UPARO ;[355] FORMAL ARG?
PUSHJ P,PUPARO ;YES, PARSE THE ^
MOVEM T1,COLADR ;[C20] STORE THE ADDRESS
RETURN ;[355] DONE
ESAC;
RETURN ;[355] DONE
END;
SUBTTL SWITCH HANDLING -- /KEY:n:m:x
; THIS CODE HANDLES /KEY(NOTE ACCUMULATOR ASSIGNMENTS!!)
;
; T1 = KEY DATUM
; T2 = KEY DATUM DELIMITER
; T3 = POINTER TO KEY BLOCK
; T4 = SCRATCH
BEGIN
PROCEDURE (PUSHJ P,SRTKEY)
TXO P2,SC.KEY ;NOTE THAT WE HAVE SEEN A KEY SPEC.
MOVE T4,MODE ;GET MODE
SKIPE T3,LSTKEY ;PTR(TOPREVIOUS KEY - SKIPS IF ZERO
MOVEM T4,KY.MOD(T3) ;[OK] STORE MODE FOR PREVIOUS KEY
SETZM MODE ;[202] START OUT WITH NO MODES
PUSH P,T1 ;SAVE SCANNER ACS FROM GETSPC
PUSH P,T2 ;
MOVX T1,KY.LEN ;GET ENOUGH SPACE TO HOLD KEY BLOCK
PUSHJ P,GETSPC ;HOLD THE KEY INFO
JRST E$$NEC ;FAILED
MOVE T3,T1 ;USE T3 INSTEAD(HOLDS POINTER TO BLOCK)
POP P,T2
POP P,T1 ;GET BACK SCAN ACS(DATUM)
IF THIS IS THE FIRST KEY SWITCH
SKIPE FSTKEY ;FIRST TIME
JRST $T ;NOT THE FIRST BLOCK - CHAIN IT
THEN INITIALIZE THE KEY LIST
MOVEM T3,FSTKEY ;INITIALIZE LIST
JRST $F ;
ELSE JUST PLACE AT END OF LIST
MOVE T4,LSTKEY ;[C20] CHAIN INTO LIST
MOVEM T3,(T4) ;[C20]
FI;
MOVEM T3,LSTKEY ;POINT TO NEW END
SETZM KY.NXT(T3) ;[OK] CLEAR FORWARD POINTER
SOJL T1,E$$KOR ;CHECK FOR INVALID REL. TO 0
MOVEM T1,KY.INI(T3) ;[OK] STORE INITIAL BYTE
CAIE T0,':' ;LENGTH TO FOLLOW
JRST E$$KLR ;ERROR
PUSHJ P,SCNDEC ;GET KEY LENGTH
JUMPE T1,E$$KLR ;ERROR - ZERO NOT VALID EITHER
MOVE T3,LSTKEY ;POINT TO BLOCK
MOVEM T1,KY.SIZ(T3) ;[OK] STORE KEY LENGTH
MOVX T4,RM.ASC!RM.BIN!RM.SIX!RM.EBC;
ANDM T4,MODE ;ONLY BITS WE CARE ABOUT
SETZM KY.ORD(T3) ;[OK] SET DEFAULT TO BE ASCENDING
CAIE T0,':' ;ORDER FOLLOWING?
RETURN ;DONE THEN
PUSHJ P,SCNSIX ;GO GET 'A' OR 'D'
LSH T1,-^D30 ;RIGHT JUSTIFY IT
MOVE T3,LSTKEY ;POINT TO KEY BLOCK
SKIPE T1 ;
CAIN T1,'A' ;ASCENDING?
RETURN ;YES--DONE THEN
CAIE T1,'D' ;DESCENDING?
JRST E$$KAI ;NO--ERROR THEN
SETOM KY.ORD(T3) ;[OK] YES--CHANGE TO DESCENDING
RETURN ;DONE
END;
SUBTTL SWITCH HANDLING -- /FORMAT:xn.m
BEGIN
PROCEDURE (PUSHJ P,SRTFMT)
TXNN T2,<1B':'> ;/FORMAT TERMINATOR A ':'?
JRST E$$FSA ;NO
PUSH P,P1 ;[C13] SAVE A PERM AC
MOVE P1,[POINT 6,.NMUL] ;[C13] LOAD UP DESTINATION PTR
$1% PUSHJ P,SCNSIX ;[C13] GET A SIXBIT WORD
MOVE T0,[POINT 6,T1] ;[C13] TRANSFER SIXBIT WORD
MOVEI T3,6 ;[C13] ..
$2% ILDB T4,T0 ;[C13] ..
JUMPE T4,$3 ;[C13] ..
CAMN P1,[POINT 6,.NMUE,35-6] ;[C13] ..
JRST E$$FSA ;[C13] ..
IDPB T4,P1 ;[C13] ..
SOJG T3,$2 ;[C13] ..
$3% TXZE T2,<1B'.'> ;[C13] A PERIOD?
MOVEI T4,'.' ;[C13] YES
TXZE T2,<1B'+'> ;[C13] A PLUS?
MOVEI T4,'+' ;[C13] YES
TXZE T2,<1B'-'> ;[C13] A MINUS?
MOVEI T4,'-' ;[C13] YES
JUMPN T2,$4 ;[C13] FINISH UP IF ANYTHING ELSE
CAMN P1,[POINT 6,.NMUE,35-6] ;[C13] STORE IT
JRST E$$FSA ;[C13] ..
IDPB T4,P1 ;[C13] ..
JRST $1 ;[C13] LOOP AROUND
$4% SETZ T3, ;[C13] TERMINATE WITH NULL BYTE
IDPB T3,P1 ;[C13] ..
POP P,P1 ;[C13] RESTORE PERM AC
PUSH P,T2 ;[C13] SAVE DELIMITER
PUSHJ P,USRFMT ;[C13] PROCESS FORMAT
POP P,T2 ;[C13] RESTORE DELIMITER
RETURN ;DONE
END;
SUBTTL SWITCH HANDLING -- /RECORD:n, /TEMP, /ESTIMATE:n, /UNLOAD
SUBTTL SWITCH HANDLING -- /REWIND, /SUPPRESS:^n, /MERGE, /CHECK
SRTREC: JUMPLE T1,E$$RSR ;WAS IT SPECIFIED
CAMLE T1,RECORD ;USED THE LARGEST RECORD SIZE
MOVEM T1,RECORD ;GIVEN BY ANY /RECORD SWITCH
POPJ P,
SRTEMP: TXNE P2,SC.FNE ;ERROR IF FILE NAME WAS SEEN
JRST E$$FNT
TXNE P2,SC.DEV ;HAVE WE SEEN A DEVICE?
JRST SETEMP ;YES, NO NEED FOR DEFAULT
MOVSI T4,'DSK' ;SET DSK AS DEFAULT TMP DEVICE
MOVEM T4,S.DEV(P3) ;[C20] PUT IT AWAY
SETEMP: TXNE P2,SC.EQU ;ERROR IF NOT PROCESSING INPUT SPEC.
TXOE P2,SC.TMP ;SET /TEMP SEEN
JRST E$$FMO
SETZM TEMPSW ;MAKING TEMPSW 0 IS SUFFICIENT
POPJ P, ;RETURN TO SCANNER(SCNSIT)
SRTEST: TXNE P2,SC.EQU ;OUTPUT SIDE?
JRST E$$FMI ;NOPE - SWITCH NOT VALID FOR INPUT SIDE
MOVEM T1,S.EST(P3) ;[C20] PUT AWAY USER FILE SIZE EST.
POPJ P,
SRTUNL: HRRZI T3,1 ;SET UP A +1
MOVEM T3,S.UNL(P3) ;[C20] MARK THE UNLOAD
POPJ P, ;RETURN SCANNER
SRTREW: HRRZI T3,1 ;SET UP A +1
MOVEM T3,S.REW(P3) ;[C20] MARK THE REWIND
POPJ P, ;RETURN TO SCANNER
SRTSUP: PUSHJ P,SCNSIX ;GET SWITCH ARG
JUMPE T1,E$$SVR
MOVE T4,[-SUP.L,,SUP.T]
PUSHJ P,SCNTBL ;LOOK FOR ARG
JRST E$$USV
ADDI T4,1 ;[C20] GET INDEX VALUE
MOVEM T4,SUPFLG ;STORE IT
POPJ P,
SRTMRG: MOVEI T1,1 ;SET UP THE +1
MOVEM T1,MRGSW ;SIGNAL MERGE REQUIRED (RATHER THAN SORT)
POPJ P,
SRTCHK: MOVEI T1,1 ;SET UP THE +1
MOVEM T1,WSCSW ;SIGNAL MERGE SEQUENCE CHECK REQUIRED
POPJ P,
SUBTTL SWITCH HANDLING -- /ERROR:^n, /FATAL:^n
SRTERR: TXZE T2,UPARO ;FORMAL ARG?
PUSHJ P,PUPARO ;YES, PARSE THE ^
MOVEM T1,ERRADR ;[C20]
POPJ P,
SRTFAT: TXZE T2,UPARO ;FORMAL ARG?
PUSHJ P,PUPARO ;YES, PARSE THE ^
MOVEM T1,FERCOD ;[C20]
POPJ P,
PUPARO: PUSHJ P,SCNDEC ;GET THE ACTUAL
CAILE T1,1 ;[C20] IS IT IN RANGE
CAMLE T1,FORCNT ;[C20] ..
JRST E$$FEA ;NO
ADD T1,FORARG ;[C20] ADD IN BASE
XMOVEI T1,@-1(T1) ;[OK] GET THE ACTUAL
POPJ P,
SRTLEA: MOVEM T1,NUMRCB ;STORE NO. OF LEAVES
MOVEM T1,LEAVES ;[N11] ALSO SIGNAL /LEAVES SEEN
POPJ P,
SRTMTF: CAIL T1,3 ;[N20] ALLOW 3 TO
CAILE T1,MX.TMP ;[N20] MAX. FILES
JRST E$$MTE ;[N20]
SKIPE XCHNO. ;[N20] UNLESS NO EXTRA CHANNELS
JRST HAVXCH ;[N20]
CAILE T1,MX.T15 ;[N20] IN WHICH CASE ONLY ALLOW ORIGINAL 15
JRST E$$MTE ;[N20]
HAVXCH: MOVEM T1,MAXTMP ;[N20] STORE IT
POPJ P, ;[N20]
SUBTTL FILE SPEC SCANNING ROUTINES
SRTDEV: TXOE P2,SC.DEV ;HAVE WE SEEN DEV: BEFORE
JRST E$$DDV ;YES, AN ERROR
TXNN P2,SC.EQU ;IS IT AN OUTPUT DEVICE?
PUSHJ P,ALLOUT ;YES, SET UP THE ONLY FD BLOCK
MOVEM T1,S.DEV(P3) ;[C20] SAVE THE DEVICE NAME
POPJ P, ;RETURN TO THE SWITCH SCANNER
SRTNAM: TXOE P2,SC.DEV ;HAS A DEV BEEN SPECIFIED?
JRST STFNAM ;YES, DONT HAVE TO SET UP DEVICE
TXNN P2,SC.EQU ;IS IT AN OUTPUT FILE NAME?
PUSHJ P,ALLOUT ;YES, AND SINCE NO DEVICE WE SET UP THE FD BLOCK
MOVSI T4,'DSK' ;SET UP DSK AS DEFAULT DEVICE
MOVEM T4,S.DEV(P3) ;[C20] PUT IT IN FILE BLOCK
STFNAM: TXO P2,SC.FNE ;SET NAME ENCOUNTERED
MOVEM T1,S.NAME(P3) ;[C20] SAVE THE FILE NAME
SETOM S.NAMM(P3) ;[C20] ONES A MASK
TXZN T2,<1B'.'> ;IS THERE AN EXTENSION FOLLOWING
POPJ P,
SRTEXT: PUSHJ P,SCNSIX ;YES, GET THE EXTENSION
HLLOM T1,S.EXT(P3) ;[C20]
POPJ P, ;RETURN TO SWITCH SCANNER
SRTPPN: TXZN T2,<1B','> ;CHECK FOR A COMMA
PJRST SCNDLM ;NO COMMA - ERROR
JUMPG T2,SCNDLM ;NO COMMA - ERROR
HRLZ T4,T1 ;SAVE PROJECT NUMBER
PUSHJ P,SCNOCT ;GET PROGRAMMER NUMBER
TXZ T2,<1B21> ;CLEAR RIGHT BRACKET
TXNN T2,<1B','> ;ALLOW , AFTER PPN (FOR SFD'S)
JUMPG T2,SCNDLM ;ILLEGAL DELIMITER
HRR T4,T1 ;SAVE PROGRAMMER NUMBER
MOVEM T4,S.DIR(P3) ;[C20] SAVE THE PPN
SETOM S.DIRM(P3) ;[C20] SET MASK TO -1
MOVX T1,FX.DIR ;[352] ALSO SET THE BIT THAT SCAN
IORM T1,S.MOD(P3) ;[C20] [352] WOULD HAVE SET WHEN PPN SEEN
TXZN T2,<1B','> ;[352] COMMA DELIMETER?
POPJ P, ;[352] NO.SO NO SFD
PUSH P,P3 ;[C20] [352] SAVE CURRENT BLOCK
HRLI P3,-.FXLND+1 ;[C20] [352] FORM SFD AOBJN POINTER
SRTSFD: PUSHJ P,SCNSIX ;[352] GET SFD NAME
MOVEM T1,S.SFD(P3) ;[C20] [352] SORE SFD NAME
SETOM S.SFD+1(P3) ;[C20] [352] AND MASK
TXZE T2,<1B21> ;[352] TEST FOR "}"
JRST SRTSFE ;[352] YES AND ENDED CORRECTLY
TXNN T2,<1B','> ;[352] MORE SFDS TO FOLLOW
JRST SCNDL1 ;[352] NO. GIVE ERROR
ADDI P3,1 ;[C20] [352] ACCOUNT FOR MASK
AOBJN P3,SRTSFD ;[C20] [352] GET NEXT SFD
$ERROR (?,SFD,<SFD depth greater than 5>) ;[352]
SRTSFE: POP P,P3 ;[C20] [352] RESTORE BLOCK
POPJ P,
SUBTTL SCAN INPUT ROUTINES - SIXBIT, Decimal, Octal, etc.
SCNDL1: POP P,P3 ;[C20] [352] GET STACK RIGHT
SCNDLM: MOVEI T2,1 ;SET ILLEGAL DELIMITER
SCNUDF:
SCNNER: POPJ P, ;DUMMY ENTRY POINT
SCNSIX: MOVSI T2,(POINT 6) ;SET SIXBIT BYTE POINTER
AOJA T2,SCNCON ;SET BYTE POINTER TO T1 ADDRESS
SCNOCT: SKIPA T2,[10] ;SET OCTAL SCAN MODE
SCNDEC: MOVEI T2,12 ;SET DECIMAL SCAN MODE
SCNCON: SETZ T1, ;[C20] CLEAR THE OUTPUT WORD
SCNSI1: SOSN SRTCNT ;[C20] SKIP IF BUFFER NOT EMPTY
SCNSIZ: PUSHJ P,GETCOM ;GET ANOTHER DISK BLOCK OF COMMANDS
ILDB T0,SRTPTR ;[C20] LOAD ASCII CHARACTER
SKIPG ATSFLG ;ONLY IF WE ARE DOING @COMMAND
JRST SCNSI9 ;NOPE,TREAT AS STRAIGHT LITERAL
CAIN T0,15 ;IS CHAR. A CR?
JRST SCNSI1 ;YES, JUST EAT IT
CAIE T0,12 ;IS CHAR. A LF?
JRST SCNSI9 ;NO, GO DO AS USUAL
MOVX T2,EOL ;MARK US FINISHED WITH THIS LINE
SCNSI8: MOVE T0,SRTPTR ;[C20] SAVE SCANNER'S POINTER AND COUNT
MOVEM T0,SAVPTR ;[C20] ..
MOVE T0,SRTCNT ;[C20] ..
MOVEM T0,SAVCNT ;[C20] ..
ILDB T0,SRTPTR ;[C20] SEE IF THE NEXT BYTE IS NULL
JUMPN T0,CPOPJ ;RETURN THERE IS ANOTHER COMMAND
SOSN SRTCNT ;[C20] ANY CHARS LEFT IN BUFFER?
PUSHJ P,GETCOM ;NO, GET ANOTHER BUFFER
SKIPE ATSFLG ;ZEROED ON EOF
JRST SCNSI8 ;GO FOR MORE
MOVX T2,EOL ;SET END OF LINE FLAG
POPJ P, ;RETURN
SCNSI9: JUMPE T0,SCNSI7 ;QUIT ON A NULL
CAIN T0,11 ;IS THIS CHAR. A TAB??
JRST SCNSI1 ;YES, JUST EAT IT
TRC T0,140 ;INVERT CONTROL AND SHIFT BITS
TRNN T0,140 ;LOWER CASE ALPHA CHARACTER
IORI T0,40 ;YES, SET TO UPPER CASE
ANDCMI T0,100 ;SET TO SIXBIT AND CLEAR HIGH ORDER BIT
CAIL T0,'0' ;CHECK FOR CHARACTER RANGE
CAILE T0,'Z' ;IS THE A ALPHA NUMBERIC CHARACTER
JRST SCNSI2 ;NO, CHECK FOR DELIMITER
CAIGE T0,'A' ;CHECK FOR ALPHA CHARACTER
CAIG T0,'9' ;CHECK FOR NUMBERIC
JRST SCNSI3 ;YES ALPHA NUMBERIC CHARACTER
SCNSI2: JUMPE T0,SCNSI1 ;CHECK FOR A BLANK CHARACTER
;IGNORE BLANKS ALWAYS
CAILE T0,'Z' ;IS DELIMITER IN THE 7X GROUP
ANDCMI T0,50 ;YES PUT IN THE 2X GROUP
MOVSI T2,400000 ;MAKE A 1 BIT FLAG FOR DELIMETER
JRST SCNSI4 ;MAKE THE FLAG
SCNSI7: MOVSI T2,400000 ;MAKE A 1 BIT FLAG FOR THE DELIMITER
SCNSI4: MOVN T3,T0 ;SET THE SHIFT COUNT
LSH T2,(T3) ;[OK] SET THE FLAG FOR THE DELIMITER
POPJ P, ;RETURN TO CALLER
SCNSI3: TLNN T2,-1 ;CHECK FOR DIGIT MODE
JRST SCNSI6 ;YES, GO TO DIGIT ROUTINE
TLNE T2,760000 ;ALPHA/DIGIT ANY ROOM FOR OUTPUT
IDPB T0,T2 ;YES, DEPOSIT BYTE
JRST SCNSI1 ;RETURN FOR NEXT
SCNSI6: CAIL T0,+20(T2) ;[OK] IS DIGIT IN RANGE (OCTAL/DECIMAL)
JRST SCNDLM ;RETURN IMPOSSIBLE DELIMITER
IMUL T1,T2 ;[C20] IN RANGE MAKE ROOM FOR NEW DIGIT
ANDI T0,17 ;MAKE A BINARY DIGIT
ADD T1,T0 ;ACCUMULATE THE SUM
JRST SCNSI1 ;RETURN FOR NEXT DIGIT
SUBTTL INDIRECT COMMAND FILE I/O ROUTINES
; PROCESS AND SET UP FOR INDIRECT COMMAND FILE
; I.E TAKE COMMAND(S) FROM DISK FILE INSTEAD OF ARGS.
SRTATS: TXNE P2,SC.FNE!SC.EQU ;FILE NAME OR EQUALS SEEN?
JRST E$$IIF ;YES, AN ERROR WHEN PROC. @
JUMPE T1,E$$IIF ;ERROR IF NO FILE NAME SPECIFIED
MOVEM T1,ATSFIL ;[C19] SAVE IND. FILE NAME
SETZM ATSFIL+1 ;[C19] [213] ASSUME NULL EXTENSION
TXZN T2,<1B'.'> ;IS THERE AN EXTENSION?
JRST CHKEND ;NO, SEE IF END OF ARGUMENT
PUSHJ P,SCNSIX ;YES, GET EXTENSION
JUMPE T1,E$$IIF ;ERROR IF NO EXTENSION
HLLZM T1,ATSFIL+1 ;[C19] SAVE LEFT HALF OF EXTENSION
CHKEND: TXZN T2,EOL ;END OF ARGUMENT?
JRST E$$IIF ;NOPE, JUNK AFTER @FILNAM.EXT
MOVN T2,MAXTMP ;[C19] GET MAX TEMP FILE NUMBER
HRLZM T2,TCBIDX ;[C19] MAKE AOBJ PTRAND PLACE IT APPROPRIATELY
PUSHJ P,GETCHN ;[C19] GET A CHANNEL
JRST E$$NEH ;[C19] FAILED
HRRZM T1,ATSFLG ;REMEMBER CHANNEL WERE USING
DPB T1,[POINT 4,XIN,12] ;SET UP AC FOR IN UUO
DPB T1,[POINT 4,XSTATZ,12] ;SET UP AC IN STATZ UUO
DPB T1,[POINT 4,XGETSTS,12] ;SET UP AC IN GETSTS UUO
HRLS T1 ;[C19] BUILD FILOP. BLOCK, GET CHANNEL
HRRI T1,.FORED ;[C19] GET READ FUNCTION
TXO T1,FO.PRV ;[N14] BYPASS CHECKS IF [1,2] OR JACCT
MOVEM T1,FLPARG+.FOFNC ;[C19] STORE THEM
.DMOVE T1,[.IODMP ;[C19] GET DUMP MODE
SIXBIT /DSK/] ;[C19] AND DEVICE (DSK ONLY!)
.DMOVM T1,FLPARG+.FOIOS ;[C19] STORE THEM
SETZM FLPARG+.FOBRH ;[C19] NO BUFFERS
SETZM FLPARG+.FONBF ;[C19] ..
HRRZI T1,ATSFIL ;[C19] GET LOOKUP BLOCK ADDRESS
MOVEM T1,FLPARG+.FOLEB ;[C19] STORE IT
LOOKAT: SETZM ATSFIL+2 ;[C19] CLEAN UP ATS LOOKUP BLOCK
SETZM ATSFIL+3 ;[C19] ..
MOVE T1,[.FOLEB+1,,FLPARG] ;[C19] DO READ FILOP.
FILOP. T1, ;[C19] ..
SKIPA ;[C19] FAILED
JRST GETCOM ;[C19] OK
CAIE T1,ERFNF% ;[C19] FILE NOT FOUND?
JRST ERRFUF ;[C19] NO
HLRZ T1,ATSFIL+1 ;[C19] GET LAST FILE EXTENSION
JUMPE T1,[MOVEI T1,'CCL' ;[C19] IF NOT NULL THEN TRY CCL
HRLZM T1,ATSFIL+1 ;[C19] ..
JRST LOOKAT] ;[C19] ..
CAIN T1,'CCL' ;[C19] IF NOT CCL THEN TRY CMD
JRST [MOVEI T1,'CMD' ;[C19] ..
HRLZM T1,ATSFIL+1 ;[C19] ..
JRST LOOKAT] ;[C19] ..
JRST ERRFUF ;[C19] GIVE UP
GETCOM: MOVEI T2,5*^D128 ;[C20] CHAR CNT FOR ONE DSK BLOCK
MOVEM T2,SRTCNT ;[C20] ..
MOVE T2,[POINT 7,COMBUF] ;[C20] SET PTR TO POINT AT DUMP INPUT
MOVEM T2,SRTPTR ;[C20] BUFFER FOR SCANNER
SETZB T4,T2 ;SET UP TO MAKE IOWD, INPUT AND RETURN
HRRZI T3,COMBUF-1 ;GET POINTER TO BUFFER
HRLI T3,-200 ;FINISH MAKING IOWD, ASK FOR A BLOCK
IF 7-SERIES MONITOR
SKIPN M7.00 ;[N12] 7-SERIES?
JRST $T ;[N12] NO
THEN USE FILOP. FOR ALL I/O
HRLZ T2,ATSFLG ;[N12] GET CHANNEL
HRRI T2,.FOINP ;[N12] INPUT FUNCTION
MOVEM T2,FLPARG+.FOFNC ;[N12] TWO ARGS FOR DUMP MODE
MOVEM T3,FLPARG+.FOIOS ;[N12] IOWD
MOVE T2,[2,,FLPARG] ;[N12]
FILOP. T2, ;[N12]
FASTSKIP ;[N12] ERROR, T2 = STATUS
POPJ P, ;[N12] OK
TXNN T2,IO.EOT ;[N12] EOF?
JRST E$$IEC ;[N12] NO, GIVE ERROR MESSAGE
XCLOSE: PUSH P,T1 ;[C19] SAVE T1
MOVE T1,ATSFLG ;[C19] RELEASE CHANNEL
PUSHJ P,RELCHN ;[C19] ..
POP P,T1 ;[C19] RESTORE T1
SETZM ATSFLG ;TURN OFF @ FLAG WORD
POPJ P,
ELSE USE OLD I/O UUOs
XIN: IN ,T3 ;INPUT A DISK BLOCK OF COMMAND(S)
POPJ P, ;NOW GO PROCESS IT
XSTATZ: STATZ ,IO.EOT ;CHECK IF END OF FILE?
JRST XCLOSE ;YES, CLOSE UP THE FILE
XGETST: GETSTS ,T4 ;NOT AN EOF, WHAT WAS IT?
JRST E$$IEC ;OUTPUT STATUS WITH ERROR MESSAGE
FI;
SUBTTL ENDS.
BEGIN
PROCEDURE (PUSHJ P,ENDS.)
PUSHJ P,RELSPC ;[C13] RELEASE ANY RETAINED MEMORY
MOVE T1,INPREC ;NUMBER OF RECORDS SORTED
CAME T1,OUTREC ;SAME NUMBER AS WE OUTPUT?
PUSHJ P,E$$RNI ;RECORD NUMBER INCONSISTENT
PUSHJ P,STATS ;[C20] TYPE STATISTICS IF NECESSARY
RETURN
END;
SUBTTL ERROR MESSAGES
E$$SVR: $ERROR (?,SVR,<Switch value required.>)
E$$USV: $ERROR (?,USV,<Unknown switch value.>)
E$$UDL: $ERROR (?,UDL,<Unknown delimiter.>)
E$$MOI: $ERROR (?,MOI,<Multiple output specs are illegal.>)
ERRUKS: PUSH P,T1
$ERROR (?,UKS,<Unknown switch />,+)
POP P,T1
$MORE (SIXBIT,T1)
$DIE
E$$FMO: $ERROR (?,FMO,<File switches illegal in output file.>)
E$$DDV: $ERROR (?,DDV,<Double device illegal>)
E$$SFF: $ERROR (?,SFF,<Switches must follow file specs.>)
E$$IDS: $ERROR (?,IDS,<Illegal /DENSITY: value specified.>)
E$$FMI: $ERROR (?,FMI,<Output switch illegal in input file.>)
E$$DFK: $ERROR (?,DFK,<Data mode switches must follow a /KEY switch.>)
E$$IIF: $ERROR (?,IIF,<Illegal indirect file spec.>)
E$$IEC: $ERROR (?,IEC,<Input error from indirect command file.>)
E$$NDV: $ERROR (?,NDV,<Null device illegal.>)
SUBTTL DUMMY ROUTINES FOR UNSUPPORTED FEATURES
GETSXR: GETEBR: PUTSXR: PUTEBR:
C3SEXT: C3UEXT: NSEEXT: NSSEXT: NUEEXT: NUSEXT:
ALSGEN: ALEGEN: CSSGEN: CSEGEN: CUEGEN: CUSGEN: NSEGEN: NSSGEN:
C3SKLX: C3UKLX: NSEKLX: NUEKLX: NSSKLX: NUSKLX:
HALT
;DUMMY ROUTINES
CHKLBL: WRTEND: WRTLBL:
POPJ P,