Trailing-Edge
-
PDP-10 Archives
-
AP-D489C-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
SUBTTL L.R. JASPER/DMN/DZN 4-Mar-78
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1975, 1978 BY DIGITAL EQUIPMENT CORPORATION
IFN FTOPS20,<PRINTX ? SRTFOR should not be present in TOPS-20 SORT/MERGE.>
FTFORTRAN==1
FTCOBOL==0
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 Low Segment 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 CHANNEL ALLOCATE/DEALLOCATE ROUTINES ..................... 24
; 12 CORE ALLOCATION FOR TREE & BUFFERS ....................... 25
; 13 ENDS. .................................................... 26
; 14 ERROR MESSAGES ........................................... 27
; 15 DUMMY ROUTINES FOR UNSUPPORTED FEATURES .................. 28
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 ;RH, POINTER TO THE FD BLOCK BEING DEFINED
; ;LH, (FORTRAN) SCAN FLAGS
; P3=7 ;
; P4=10 ;
; F=11 ;POINTER TO THE INCORE ARG
; U=12 ;GLOBAL SCRATCH
; J=13 ;THE CURRENT DISPATCH ENTRY
; R=14 ;CHARACTER COUNT IN SCNSIT
; S=15 ;TYPE ARGUMENT CODE
; L=16 ;POINTER TO ARG BLOCK
; P=17 ;PUSH DOWN LIST POINTER
ENTRY SORT
DEFINE ENDMODULE<
$PURGE
END>
;TOKEN FLAGS--THESE ARE IN THE LEFT HALF OF 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==1B4 ;^ FLAG
SUBTTL DEFINITIONS -- Low Segment Data
SEGMENT LOW
RUNCOR: BLOCK 1
ATSFLG: BLOCK 1
SAVEFR: BLOCK 2
COMBUF: BLOCK 200 ;BUFFER FOR @COMAND FILE INPUT
SAVEP: BLOCK 1
SAVEL: BLOCK 1
ARGADR: BLOCK 1
CHSTAT: BLOCK 1 ;RETURN STATUS FROM FUNCT.
CHNMBR: BLOCK 1 ;CHANNEL NUMBER FROM FUNCT.
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
IFN FTCOL,<
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 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 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 F,SAVEFR ;RESTORE SCANNER REGISTERS F AND R
MOVE R,SAVEFR+1 ;
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
SETZ T1, ;SELECT CURRENT JOB
RUNTIM T1,
MOVEM T1,CPUTIM ;INITIAL TIME OF DAY IN MS
MSTIME T1,
MOVEM T1,ORGTIM ;INITIAL TIME OF DAY IN MS
PUSHJ P,GETJOB ;GET JOB NUMBER
JSP T4,CPUTST ;[202] SEE WHICH CPU WE HAVE
SETOM P.BLKF
SETOM P.VARF
SETOM RTRUNC
JRST $F ;[213] GO PICK UP FROM WHERE WE LEFT OFF
ELSE JUST CHECK ARG LIST (INITIALIZATION ALREADY DONE)
SETZ R, ;[223] INITIALIZE CHAR CNT TO 'HUGE' NUMBER
HLRE T1,-1(L) ;PICK UP # OF ARGS.
MOVMM T1,ARGCNT ;STORE NUMBER OF ACTUALS
MOVEM L,ARGLST ;STORE ADDRESS OF ACTUALS
MOVEI F,@(L) ;GET ADDR OF FIRST ARG
SETOM ATSFLG ;MARK NO @ SEEN...
FI;
SETOM TEMPSW ;RESET FLAG(NOT SEEN) FOR /TEMP SWITCH
PUSHJ P,CLRANS ;SET UP SOME SPECIAL LOCS.
SETZ T2, ;[213] NO DELIMTERS PENDING
HRLI P2,0 ;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) ;[213] ZERO POINTER TO NEXT BLOCK
HRR P2,T1 ;SET UP EFFECTIVE ADDR FOR SCANNER
HRLZI T2,1(T1) ;[202] SET ALL FILE SWITCHES TO -1
HRRI T2,2(T1) ;[202] WHICH IS UNINITIALIZED STATE
SETOM 1(T1) ;[202] FOR SCAN SWITCHES
BLT T2,S.DEV-1(T1) ;[202] ..
MOVE T2,F.OUZR ;PREVIOUS BLOCK (OR 0)
MOVEM T2,0(T1) ;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) ;[213] ZERO POINTER TO NEXT BLOCK
HRR P2,T1 ;SAVE EFFECTIVE ADDR FOR SCAN CODE
HRLZI T2,1(T1) ;[202] SET ALL FILE SWITCHES TO -1
HRRI T2,2(T1) ;[202] WHICH IS UNINITIALIZED STATE
SETOM 1(T1) ;[202] FOR SCAN SWITCHES
BLT T2,S.DEV-1(T1) ;[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% HRL T2,(T2) ;GET POINTER TO NEXT
TLNN T2,-1 ;IS THERE A NEXT?
JRST $2 ;NO
HLRZ T2,T2 ;COPY IT
JRST $1 ;TRY AGAIN
$2% MOVEM T1,(T2) ;LINK IN(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) ;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 RH=POINTER TO FILE/KEY BLOCK
; LH=FLAGS
; 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
TXZE P2,SC.FNE ;HAVE WE SEEN AN INPUT FILENAME?
JRST FINALL ;YES, FINISH FD BLOCK ALLOCATION
TXNN P2,SC.TMP ;NO FILENAME, ITS OK IF PROC. A /TEMP
JRST E$$INS ;DON'T ALLOW MULTIPLE OUTPUT SPECS
;OR A COMMA AND NO FILENAME ENCOUNTERED
FINALL: PUSHJ P,ALLIN1 ;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: TXZE P2,SC.FNE ;ERROR IF NO FILE NAME
JRST ENDIT0 ;NO FILENAME IS OK IF /TEMP IN PROC.
TXNN P2,SC.TMP ;ARE WE PROC. /TEMP?
JRST E$$INS ;ERROR- TELL EM
ENDIT0: PUSHJ P,ALLIN1 ;FINISH UP LAST FILE SPEC. ALLOC.
POPJ P,
SCNSWT: TXNN P2,SC.FNE ;[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
MOVEI J,(T4) ;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
; S= SCRATCH
;RETURN
; T4= THE INDEX INTO THE TABLE (N,,N)
; NON-SKIP RETURN OF ENTRY NOT FOUND
; SKIP RETURN OF FOUND IN THE TABLE
BEGIN
PROCEDURE (PUSHJ P,SCNTBL)
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
MOVE S,(T4) ;GET NEXT KEYWORD
ANDCAM T3,S ;TRUNCATE IT TO USER LENGTH
CAME S,T1 ;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
HRRI T0,(T4) ;SAVE SWITCH INDEX IN ANY CASE
CAMN T1,(T4) ;EXACT MATCH
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 (P) ;GIVE SKIP RETURN
$1% RETURN
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(P2) ;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
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(P2) ;[213] AND STORE IT
POPJ P, ;[213] DONE
SRTDEN: MOVX 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) ;[213] CHECK NEXT DENSITY
AOBJN T3,$B ;[213] NO GOOD--CHECK NEXT IF ANY
END;
JUMPGE T3,E$$IDS ;[213] IF +, AOBJN FELL THROUGH
MOVEI T3,(T3) ;[213] CONSTRUCT TAPOP. DENSITY ARG
DPB T3,[POINTR (S.MOD(P2),FX.DEN)] ;[213] AND SAVE IN SCAN BLOCK
POPJ P,
SRTSEQ: SRTVAR:
MOVEI T3,1 ;SET UP A +1
MOVEM T3,S.VARI(P2) ;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]
IFN FTCOL,<
SRTCOL: PUSHJ P,SCNSIX ;GET SWITCH ARG
JUMPE T1,E$$CND
MOVE T4,[-COL.L,,COL.T]
PUSHJ P,SCNTBL ;LOOK FOR ARG
JRST E$$CND
MOVEI T4,1(T4) ;GET INDEX VALUE
MOVEM T4,COLSW ;STORE IT
JRST @[EXP CPOPJ,CPOPJ,COLEFS,COLICL,COLICA]-1(T4) ;DISPATCH
COLEFS: TXZN T2,<1B':'> ;VERIFY SWITCH ARGUMENT SEPARATOR
JRST E$$CFS ;NOT THERE
SETZM COLITB ;SAFE PLACE TO STORE FILE SPEC
MOVE T1,[COLITB,,COLITB+1]
BLT T1,COLITB+S.LEN
PUSHJ P,SCNSIX ;GET FILE SPEC
TXZN T2,<1B':'> ;DID WE GET A DEVICE?
JRST COLFS1 ;NO
MOVEM T1,S.DEV+COLITB ;YES
PUSHJ P,SCNSIX ;GET FILE NAME
COLFS1: JUMPE T1,E$$CFS ;MUST HAVE A FILE NAME
MOVEM T1,S.NAME+COLITB ;STORE NAME
TXZN T2,<1B'.'> ;EXTENSION
POPJ P, ;NO
PUSHJ P,SCNSIX ;YES, GET IT
MOVEM T1,S.EXT+COLITB
;** NOTE THAT THIS CODE DOESN'T HANDLE PPN'S, MUCH LESS SFD'S
POPJ P,
COLICL: ILDB T1,F ;GET DELIMITER OF STRING
MOVE T4,[POINT 7,COLITB] ;WHERE TO STORE LITERAL
COLIC1: ILDB T2,F ;GET CHAR
CAMN T2,T1 ;AT END?
SETZ T2, ;YES, END WITH NUL
IDPB T2,T4 ;STORE CHAR
JUMPN T2,COLIC1 ;LOOP
POPJ P,
COLICA: PUSHJ P,SCNOCT ;GET THE ADDRESS
TXZE T2,UPARO ;FORMAL ARG?
PUSHJ P,PUPARO ;YES, PARSE THE ^
HRRZM T1,COLBUF ;STORE THE ADDRESS
POPJ P,
>
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) ;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
MOVEM T3,@LSTKEY ;CHAIN INTO LIST
FI;
MOVEM T3,LSTKEY ;POINT TO NEW END
SETZM KY.NXT(T3) ;CLEAR FORWARD POINTER
SOJL T1,E$$KOR ;CHECK FOR INVALID REL. TO 0
MOVEM T1,KY.INI(T3) ;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) ;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) ;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) ;YES--CHANGE TO DESCENDING
RETURN ;DONE
END;
SUBTTL SWITCH HANDLING -- /FORMAT:xn.m
BEGIN
PROCEDURE (PUSHJ P,SRTFMT)
MOVX T1,RM.FPA ;[202] MODE IS FLOATING POINT ASCII
IORM T1,MODE ;
IORM T1,MODEM ;
TXNN T2,<1B':'> ;/FORMAT TERMINATOR A ':'?
JRST E$$FSA ;NO
PUSHJ P,SCNSIX ;GET FORMAT TYPE PLUS WIDTH
SKIPN T3,LSTKEY ;GET INDEX TO LAST KEY
JRST E$$FSM ;IF NO KEY THEN NO FORMAT
SKIPE KY.FMT(T3) ;ONLY ONE /FORMAT PER /KEY
JRST E$$OOF ;COMPLAIN
MOVEI T3,KY.FMT(T3) ;DESTINATION ADR
HRLI T3,(POINT 6) ;POINT TO DESTINATION
MOVE T0,[POINT 6,T1] ;POINT AT FORMAT TYPE
ILDB T4,T0 ;GET FORMAT TYPE
CAIL T4,'D' ;
CAILE T4,'G' ;
JRST E$$FSA ;MUST BE D, E, F OR G
IDPB T4,T3 ;
ILDB T4,T0 ;GET FIRST WIDTH DIGIT
CAIL T4,'0' ;
CAILE T4,'9' ;
JRST E$$FSA ;NOT A DIGIT
IDPB T4,T3 ;
ILDB T0,T0 ;GET SECOND DIGIT
JUMPE T0,$1 ;SKIP IF NULL
CAIL T0,'0' ;
CAILE T0,'9' ;
JRST E$$FSA ;NOT A DIGIT
IDPB T0,T3 ;
LDB T4,[POINT 10,(T3),17] ;GET THE TWO DIGIT WIDTH
$1% PUSH P,T4 ;SAVE FOR RANGE CHECK
TRNN T1,-1 ;ONLY TWO DIGITS (3 CHARS) ALLOWED
TLNN T1,001717 ;AND NOT TWO ZEROES
JRST E$$FSA ;COMPLAIN
TXNN T2,<EOL!1B'.'!1B'/'!1B'='> ;[213] LEGAL TERMINATORS ARE EOL, ., / OR =
JRST E$$FSA ;
PUSH P,T3 ;SAVE DESTINATION PTR
SETZ T1, ;SET DEFAULT TO 0
TXNN T2,<EOL!1B'/'!1B'='> ;[213] EOL, / OR = TERMINATES THE WHOLE THING
PUSHJ P,SCNSIX ; . SO GET THE DECIMAL PLACES
POP P,T3 ;RESTORE T3
MOVE T0,[POINT 6,T1] ;SOURCE POINTER
MOVEI T4,'.' ;
IDPB T4,T3 ;STORE A PERIOD
SKIPN T1 ;ANY DECIMAL PLACES?
MOVSI T1,'0 ' ;NO - DEFAULT TO 0
TDNN T1,[77,,-1] ;SKIP IF MORE THAN 2 DIGITS
TXNN T2,<EOL!1B'/'!1B'='> ;[213] TERMINATOR AN EOL, / OR =?
JRST E$$FSA ;NO
PUSH P,T2 ;[213] SAVE DELIMITER
ILDB T4,T0 ;GET FIRST DIGIT
CAIL T4,'0' ;
CAILE T4,'9' ;
JRST E$$FSA ;NOT A DIGIT
IDPB T4,T3 ;
ILDB T2,T0 ;GET SECOND DIGIT
JUMPE T2,$2 ;SKIP IF NULL
CAIL T2,'0' ;
CAILE T2,'9' ;
JRST E$$FSA ;NOT A DIGIT
IDPB T2,T3 ;
LSH T4,6 ;MAKE ROOM FOR LOW ORDER DIGIT
XORI T4,'0 '(T2) ;GET IT AND ZERO BIT25
$2% POP P,T2 ;[213] GET DELIMITER
EXCH T2,0(P) ;[213] SWAP WITH TOTAL WIDTH
CAMGE T2,T4 ;SKIP IF WIDTH GE TO DECIMAL PLACES
JRST E$$FSA ;OOPS - COMPLAIN
SETZ T0, ;MAKE A NULL CHAR
IDPB T0,T3 ;TERMINATE STRING
LDB T0,[POINT 4,T2,29] ;CONVERT SIXBIT WIDTH TO BINARY
IMULI T0,^D10 ;
LDB T3,[POINT 4,T2,35]
ADD T0,T3 ;
MOVE T3,LSTKEY ;INDEX TO LAST KEY BLOCK
CAME T0,KY.SIZ(T3) ;MUST EQUAL KEY SIZE
JRST E$$FSA ;
POP P,T2 ;[213] RESTORE DELIMITER PENDING
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(P2) ;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(P2) ;PUT AWAY USERS FILE SIZE EST.
POPJ P,
SRTUNL: HRRZI T3,1 ;SET UP A +1
MOVEM T3,S.UNL(P2) ;MARK THE UNLOAD
POPJ P, ;RETURN SCANNER
SRTREW: HRRZI T3,1 ;SET UP A +1
MOVEM T3,S.REW(P2) ;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
MOVEI T4,1(T4) ;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 ^
HRRZM T1,ERRADR
POPJ P,
SRTFAT: TXZE T2,UPARO ;FORMAL ARG?
PUSHJ P,PUPARO ;YES, PARSE THE ^
HRRZM T1,FERCOD
POPJ P,
PUPARO: PUSHJ P,SCNDEC ;GET THE ACTUAL
CAMLE T1,ARGCNT ;IS IT IN RANGE?
JRST E$$FEA ;NO
ADD T1,ARGLST ;ADD IN BASE
MOVEI T1,@-1(T1) ;GET THE ACTUAL
POPJ P,
SRTLEA: MOVEM T1,NUMRCB ;STORE NO. OF LEAVES
POPJ P,
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(P2) ;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(P2) ;PUT IT IN FILE BLOCK
STFNAM: TXO P2,SC.FNE ;SET NAME ENCOUNTERED
MOVEM T1,S.NAME(P2) ;SAVE THE FILE NAME
SETOM S.NAMM(P2) ;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(P2) ;
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(P2) ;SAVE THE PPN
SETOM S.DIRM(P2) ;SET MASK TO -1
POPJ P,
SUBTTL SCAN INPUT ROUTINES - SIXBIT, Decimal, Octal, etc.
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,R ;CLEAR THE OUTPUT WORD AND CHAR CNT
TLNN F,-1 ;IS F ALREADY A BYTE POINTER?
HRLI F,(POINT 7) ;NO - MAKE F A BYTE POINTER
SCNSI1: SOSN R ;SKIP IF BUFFER NOT EMPTY
SCNSIZ: PUSHJ P,GETCOM ;GET ANOTHER DISK BLOCK OF COMMANDS
ILDB T0,F ;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: MOVEM F,SAVEFR ;SAVE SCANNER'S AC'S
MOVEM R,SAVEFR+1 ;
ILDB T0,F ;SEE IF THE NEXT BYTE IS NULL
JUMPN T0,CPOPJ ;RETURN THERE IS ANOTHER COMMAND
SOSN R ;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) ;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) ;IS DIGIT IN RANGE (OCTAL/DECIMAL)
JRST SCNDLM ;RETURN IMPOSSIBLE DELIMITER
IMULI T1,(T2) ;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,P3 ;SAVE IND. FILE NAME
SETZ P4, ;[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,P4 ;SAVE LEFT HALF OF EXTENSION
CHKEND: TXZN T2,EOL ;END OF ARGUMENT?
JRST E$$IIF ;NOPE, JUNK AFTER @FILNAM.EXT
HRRZI T3,CHNMAP+MX.TMP ;SET UP TO LOOK AT END OF CHNMAP
GETCHN: CAIG T3,CHNMAP+3 ;DONT TAKE ONE OF SORT'S MINIMUM CHANNELS
JRST E$$TFC ;TELL EM NO CHANNEL FOR @ FILE
SKIPE T1,(T3) ;NO CHANNEL IF 0
JRST PUTCHN ;GOT ONE, GO REMEMBER
SUBI T3,1 ;BACKUP ONE IN CHANNEL TABLE
JRST GETCHN ;GO TRY FOR ONE CHANNEL
PUTCHN: SETZM ,(T3) ;DONT LET SORT USE THIS CHANNEL
MOVE T2,MAXTMP ;GET MAX TEMP FILE NUMBER
MOVN T4,T2 ;MAKE AN AOBJ POINTER
HRLZM T4,TCBIDX ;AND PLACE IT APPROPRIATELY
HRRZM T1,ATSFLG ;REMEMBER CHANNEL WERE USING
DPB T1,[POINT 4,XOPEN,12] ;SET UP AC IN OPEN UUO
DPB T1,[POINT 4,XLOOKUP,12] ;SET UP AC IN LOOKUP UUO
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
DPB T1,[POINT 4,XCLOSE,12] ;SET UP AC IN CLOSE UUO
; DO AN OPEN (DUMP MODE 17)
MOVEI T0,17 ;SET UP DUMP MODE
MOVSI T1,'DSK' ;DEVICE IS DSK ONLY!
SETZB T2,F ;TAKE ADVANTAGE OF CHANCE TO 0 F
XOPEN: OPEN ,T0 ;OPEN DSK(SET UP WITH CHANNEL ABOVE)
JRST E$$OPF ;OPEN FAILED
; DO A LOOKUP
LOOKAT: MOVE T0,P3 ;[213] SET UP LOOKUP BLOCK
MOVE T1,P4 ;
SETZB T2,T3 ;
XLOOKUP:LOOKUP ,T0 ;LOOKUP FILE NAME
JRST [TRNE T1,-1 ;[213] FILE NOT FOUND?
JRST E$$LKF ;[213] NO
JUMPE P4,[MOVSI P4,'CCL' ;[213]
JRST LOOKAT] ;[213] TRY .CCL
CAME P4,['CCL',,0] ;[213]
JRST E$$LKF ;[213] GIVE UP
MOVSI P4,'CMD' ;[213] LAST CHANCE
JRST LOOKAT] ;[213]
GETCOM: MOVEI R,^D640 ;CHAR CNT FOR ONE DSK BLOCK
MOVE F,[POINT 7,COMBUF] ;SET F TO POINT AT DUMP INPUT
;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
XIN: IN ,T3 ;INPUT A DISK BLOCK OF COMMAND(S)
POPJ P, ;NOW GO PROCESS IT
XSTATZ: STATZ ,020000 ;CHECK IF END OF FILE?
JRST XCLOSE ;YES, CLOSE UP THE FILE
XGETSTS:GETSTS ,T4 ;NOT AN EOF, WHAT WAS IT?
JRST E$$IEC ;OUTPUT STATUS WITH ERROR MESSAGE
XCLOSE: CLOSE ,0 ;CLOSE UP @COMMAND FILE
SETZM ,ATSFLG ;TURN OFF @ FLAG WORD
POPJ P,
SUBTTL CHANNEL ALLOCATE/DEALLOCATE ROUTINES
BEGIN
PROCEDURE (PUSHJ P,SETARG)
HRRZI P1,MX.TMP-U.CHN ;GET MAXIMUM TEMP FILES-RESERVED FOR USER
MOVNI P1,(P1) ;MAKE AN AOBJ POINTER
HRLZS P1
MOVEI L,T3 ;SET ARG BLOCK POINTER
HRROI T2,0 ; SET T2 WITH BLOCK WORD COUNT OF -1,,0
MOVEI T3,T4 ;T4 WILL CONTAIN ACTUAL ARGUMENT
SETZ T4, ;DO IT RIGHT!!
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,ALCHN)
PUSHJ P,SETARG ;SET POINTERS UP
WHILE STILL MORE CHANNELS TO GET
BEGIN
MOVEI L,1+[-4,,0 ;ARG LIST FOR GET CHAN FUNCT
Z TP%INT,[F.GCH] ;GET CHANNEL FUNCTION
Z TP%LIT,[ASCIZ /SRT/] ;ERROR CODE (NOT USED)
Z TP%INT,CHSTAT ;RETURN STATUS
Z TP%INT,CHNMBR] ;RETURN CHAN NUMBER
PUSHJ P,FUNCT.## ;ASK FOROTS FOR ANY CHANNEL
SKIPE T1,CHSTAT ;DID WE GET A CHANNEL?
JRST $E ;NO
MOVE T1,CHNMBR ;GET CHANNEL
MOVEM T1,CHNMAP+1(P1) ;PUT IT IN MAP
DPB T1,[POINT 4,CHNMAP+1(P1),12] ;IN AC FIELD ALSO
AOBJN P1,$B ;GET MORE, UP TO MX.TMP-3 CHANNELS
END;
HRLI P1,0 ;ZERO LH IN CASE ITS NOT 0
CAIGE P1,3 ;DID WE GET ENOUGH CHANNELS?
JRST E$$TFC ;NOPE, AN ERROR
SUBI P1,1 ;DON'T COUNT THE IN/OUT FILE
HRRZM P1,MAXTMP ;PUT AWAY MAX NO. OF TEMP FILES
MOVN T4,P1 ;MAKE A AOBJ POINTER
HRLZM T4,TCBIDX ;PUT IT AWAY FOR LATER
MOVE L,SAVEL ;RESTORE ARG POINTER
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,DECHN)
PUSHJ P,SETARG ;SET UP POINTERS
WHILE STILL MORE CHANNELS TO DEALLOCATE
BEGIN
SKIPN T4,CHNMAP+1(P1) ;GET CHANNEL #'S UNTIL 0
JRST $E ;NO MORE CHANNELS TO RETURN
HRRZM T4,CHNMBR ;ZAP HIGH ORDER BITS
MOVEI L,1+[-4,,0 ;ARG LIST FOR RETURN CHAN FUNCT
Z TP%INT,[F.RCH] ;RETURN CHAN FUNCTION
Z TP%LIT,[ASCIZ /SRT/] ;ERROR CODE (NOT USED)
Z TP%INT,CHSTAT ;RETURN STATUS
Z TP%INT,CHNMBR] ;RETURN CHAN NUMBER
PUSHJ P,FUNCT.## ;DEALLOCATE A CHANNEL
SKIPE CHSTAT ;ANY ERRORS GETTING RID OF IT?
PUSHJ P,E$$CHF ;YES--WARN USER
SETZM CHNMAP+1(P1) ;CLEAN IT UP
AOBJN P1,$B ;DEALLOCATE ALL CHANNELS
END;
MOVE L,SAVEL ;RETRIEVE USER'S ARG POINTER
RETURN ;DONE
END;
SUBTTL CORE ALLOCATION FOR TREE & BUFFERS
BEGIN
PROCEDURE (PUSHJ P,SETSIZ)
MOVE T1,.JBFF ;GET FREE SPACE
MOVEM T1,ADDR ;TELL FOROTS
MOVEM T1,TREORG ;SET START OF TREE
MOVE T1,J ;GET TOP SIZE
SUB T1,.JBFF ;GET SIZE
MOVEM T1,SIZE
PUSHJ P,GETADR ;GET CORE AT REQUIRED ADDRESS
JRST E$$NEC ;ERROR
PJRST PSORT%
END;
BEGIN
PROCEDURE (PUSHJ P,GETADR)
MOVEI L,1+[-5,,0 ;LOAD UP ARG BLOCK FOR FUNCT. CALL
Z TP%INT,[F.GAD]
Z TP%LIT,[ASCIZ /SRT/]
Z TP%INT,STATUS
Z TP%INT,ADDR
Z TP%INT,SIZE]
PUSHJ P,FUNCT. ;ALLOCATE THE CORE
SKIPE STATUS ;NON-ZERO STATUS IS AN ERROR
RETURN ;ERROR
MOVE T3,CORSTK ;GET PTR TO STACK OF ALLOCATION ENTRIES
HRLZ T1,SIZE ;CONSTRUCT XWD SIZE, ADDRESS
HRR T1,ADDR ; FOR ALLOCATION STACK
PUSH T3,T1 ;PUSH THIS ENTRY ONTO STACK
MOVEM T3,CORSTK ;SAVE STACK POINTER
HRRZ T1,T1 ;RETURN ADDRESS OF BLOCK TO CALLER
PJRST CPOPJ1 ;OK RETURN
END;
SUBTTL ENDS.
BEGIN
PROCEDURE (PUSHJ P,ENDS.)
PUSHJ P,RESET% ;CLEAN UP CORE
PUSHJ P,DECHN ;REMOVE THE FORTRAN CHANNELS
PUSHJ P,CUTBAK ;CUT BACK CORE IF POSSIBLE
MOVE T1,INPREC ;NUMBER OF RECORDS SORTED
CAME T1,OUTREC ;SAME NUMBER AS WE OUTPUT?
PUSHJ P,E$$RNI ;RECORD NUMBER INCONSISTENT
RETURN
END;
BEGIN
PROCEDURE (PUSHJ P,CUTBAK)
MOVEI L,1+[-3,,0 ;LOAD UP ARG BLOCK FOR FUNCT. CALL
Z TP%INT,[F.CBC]
Z TP%LIT,[ASCIZ /SRT/]
Z TP%INT,STATUS]
PJRST FUNCT. ;CUT BACK CORE IF POSSIBLE
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$$CHF: $ERROR (%,CHF,<I/O channel deallocation failure.>)
POPJ P, ;JUST A WARNING--DON'T DIE
E$$TFC: $ERROR (?,TFC,<Too few channels available.>)
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$$LKF:
E$$OPF: $ERROR (?,OPF,<OPEN or LOOKUP failure for indirect command file.>)
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,