Trailing-Edge
-
PDP-10 Archives
-
BB-Z759A-SM
-
sort-source/srtprm.mac
There are 24 other files named srtprm.mac in the archive. Click here to see a list.
; UPD ID= 93 on 11/18/83 at 3:39 PM by FONG
UNIVERSAL SRTPRM - PARAMETER FILE FOR NEW SORT
SUBTTL D.M.NIXON/DMN/DPL/DZN/BRF/DLC/CLRH 22-Jun-83
SEARCH COPYRT
SALL
COPYRIGHT (C) 1975, 1983, 1984 BY DIGITAL EQUIPMENT CORPORATION
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
CUSTVR==0 ;CUSTOMER VERSION
DECVER==5 ;DEC VERSION
DECMVR==0 ;DEC MINOR VERSION
DECEVR==517 ;DEC EDIT VERSION
V%SORT==:<CUSTVR>B2+<DECVER>B11+<DECMVR>B17+DECEVR
SUBTTL TABLE OF CONTENTS FOR SRTPRM
; Table of Contents for SRTPRM
;
;
; Section Page
;
; 1 SRTPRM - PARAMETER FILE FOR NEW SORT ..................... 1
; 2 TABLE OF CONTENTS FOR SRTPRM ............................. 2
; 3 CONDITIONAL ASSEMBLY PARAMETERS .......................... 3
; 4 REVISION HISTORY ......................................... 4
; 5 DEFINITIONS
; 5.1 Accumulators ...................................... 5
; 5.2 Recording Modes ................................... 6
; 5.3 FORTRAN Interface ................................. 7
; 5.4 Special Monitor Definitions ....................... 8
; 5.5 Business Instruction Set OPcodes .................. 9
; 5.5 Extended Addressing OPcodes ....................... 10
; 5.7 Prototype File Spec, MTA and Key Blocks ........... 11
; 5.8 File Control Block and File Flags ................. 12
; 5.9 Tree Node and Record Blocks ....................... 13
; 5.10 Segment Control - ISEGMENT and SEGMENT ............ 14
; 5.11 Error Handling
; 5.11.1 $ERROR .................................... 16
; 5.11.2 $MORE ..................................... 17
; 5.11.3 $CRLF, $CHAR, $DIE ........................ 18
; 5.12 Structure Macros
; 5.12.1 Descriptions .............................. 19
; 5.12.2 BEGIN, PROCEDURE, RETURN, END ............. 22
; 5.12.3 IF, THEN, ELSE, FI, CASE, ESAC ............ 23
; 5.12.4 WHILE, UNTIL, FOR, Debugging Macro ........ 24
; 5.12.5 Initialization And Temporary Labels ....... 25
SUBTTL CONDITIONAL ASSEMBLY PARAMETERS
;FTKL10 ;KL INSTRUCTIONS ALLOWED
;FTKI10 ;KI INSTRUCTIONS ALLOWED
;FTDEBUG ;DEBUGGING HELP
;FTOPS20 ;TOPS20 JSYS CODE
;FTCOBOL ;COBOL INTERFACE CODE
;FTFORTRAN ;SEPARATE FORTRAN-10 INTERFACE
;FTVM ;[N21] VIRTUAL MEMORY VERSION
;FTPRINT ;[373] PRINT PROGRAM STRUCTURE NESTING LEVEL
;FTNZSEC ;COBOL SORT THAT RUNS IN NON-ZERO SECTION
;FTEXSZ ;[C13] KEY EXTRACT CODE AREA SIZE
IFNDEF FTOPS20,<FTOPS20==1>
IFN FTOPS20,<FTKL10==1
FTVM==1 ;[N21] ALWAYS VM ON TOPS-20
FTNZSEC==1
FTFORTRAN==0>
IFNDEF FTKL10,<FTKL10==1>
IFN FTKL10,<FTKI10==1>
IFNDEF FTKI10,<FTKI10==1>
IFNDEF FTDEBUG,<FTDEBUG==0>
IFNDEF FTFORTRAN,<FTFORTRAN==0>
IFNDEF FTCOBOL,<FTCOBOL==0>
IFE FTKL10!FTKI10,<FTVM==0> ;[N21] ALWAYS NON-VM ON KA10
IFNDEF FTVM,<FTVM==0> ;[N21] DEFAULT IS OFF
IFNDEF FTPRINT,<FTPRINT==0> ;[373] DON'T PRINT NESTING BY DEFAULT
IFNDEF FTNZSEC,<FTNZSEC==0> ;DEFAULT IS COBOL SORT IN SECTION 0
IFNDEF FTEXSZ,<FTEXSZ==2000> ;[C13] USE 1K FOR KEY EXTRACTION CODE
IFN FTOPS20,<FTOPS10==0>
IFE FTOPS20,<FTOPS10==1>
DEFINE XSEARCH,<
SALL
SEARCH MACTEN ;*** YES, MUST REALLY BE SEARCHED ON BOTH SYSTEMS ***
IFE FTOPS20,<SEARCH UUOSYM,SCNMAC>
IFN FTOPS20,<SEARCH MONSYM,MACSYM,RMSINT>
.DIRECTIVE FLBLST, SFCOND
IFN FTKI10,<.DIRECTIVE KI10>
>
XSEARCH
SUBTTL REVISION HISTORY
;VERSION 1
;1 FIRST FIELD TEST RELEASE
;2 SECOND FIELD TEST RELEASE
;3 FIX QA FOUND BUGS
;4 FIX BUG IF RUN OF MORE THAN 400000 RECORDS
;5 FIX RANDOM BIT 35'S IN ASCII OUTPUT FILE
;6 TEST FOR DEVICE NUL:
;7 DON'T ADD EXTRA BUFFERS IF IN USE BIT IS ON FOR ALL BUFFERS IN RING
;10 ADD EXTRA BUFFERS IN CORRECT SEQUENCE
;11 STRIP LEADING NULLS AND TERMINATORS CORRECTLY AND EFFICIENTLY
;12 WAIT FOR ALL CHANNELS NOT JUST CHAN 0
;13 DON'T READ ONE CHAR TOO MANY AT GETAVR
;14 RECORD COUNT WRITTEN ONE TOO HIGH ON SIXBIT MTA FILES
;15 CALCULATE ELAPSED TIME CORRECTLY OVER MIDNIGHT
;16 DON'T RETURN CORE IF SOMEONE ELSE INCREASED IT AFTER SORT
;17 CORRECTLY HANDLE VARIABLE LENGTH ASCII RECORDS LESS THAN 6 CHAR LONG
;20 GET TO STOPR. CORRECTLY ON FATAL ERROR
;VERSION 2
;100 IMPLEMENT VERSION 2 FEATURES (EBCDIC, COMP-3, VARIABLE LENGTH, ETC)
;101 FIX BUG INTRODUCED IN PUTSXR & GETSXR
;102 FIX BUGS IN EBCDIC AND COMP-3 CODE
;103 IMPROVE TENEX CODE
;104 FIX VARIABLE ASCII WITH NUMERIC KEYS
;SORT version 2(104) Released on TOPS-10.
;105 FORCE SIXBIT FILES TO BE VARIABLE
;106 SETUP PPN OR SFD CORRECTLY FOR NEXT INPUT FILE
;107 IGNORE NULL INPUT FILES
;110 SIMPLIFY HANDLING OF SEQUENCE NUMBERS
;111 MORE TOPS-20 IMPROVEMENTS
;112 DO ROUNDING CORRECTLY ON FLOATING POINT OUTPUT
;113 RENAME SINGLE TEMP FILE CORRECTLY IF FILE ALREADY EXISTS
;SORT version 2(113) Released on TOPS-20.
;114 ACCEPT R SORT (COMMAND LINE) I.E. DO A RESCAN
;115 FIX VARIOUS PROBLEMS WITH DEFAULT PATHS
;116 MAKE MULTI-REEL FILES WORK CORRECTLY
;117 FIX SRTSCN SO THAT BLOCKED SIXBIT FILES THAT TAKE ONLY 1 RUN COME OUT BLOCKED
;120 FIX KL-10 BIS WRITE OF FIXED LENGTH ASCII AND EBCDIC RECORDS
;121 ADD ERJMP AFTER MTOPR ON TOPS-20
;122 FIX LAST RECORD OF FIXED LENGTH EBCDIC FILE
;123 DON'T ZERO TOO MANY WORDS WHEN CLEARING OUTPUT BUFFER
;124 CORRECT OUTPUT EBCDIC BYTE POINTER FOR DUMMY OUTPUT
;125 DELETE TEMP FILE IF USER ROUTINE EXITS BEFORE END-OF-FILE
;126 CORRECT BIS COMPARE WHEN BYTE POINTER IS 36 BITS (EBCDIC OR SIXBIT)
;127 CORRECT KL10 INPUT FOR VARIABLE LEN ASCII
;130 FIX VAR LNGTH RECS WITH XTRCTED KEYS
;131 FIX JUNK WRITTEN AT END OF LAST BLOCK ON OUTPUT FILE.
;132 FIX NEGATION OF DOUBLE PRECISION SIGNED NUMERICS ON KA.
;133 FIX CODE GEN OF DOUBLE PRECISION COMPARE ON KA.
;134 TYPE ERROR MESSAGES FOR ALL CROSS-CPU POSSIBILITIES.
;135 REMOVE USE OF MTOPR'S UNTIL SORT IS COMPLETELY JSYS-IZED FOR TOPS20
;136 DON'T SHARE BUFFER RING WHEN OUTPUT CHAN IS CLOSED IN COBOL SORT
;137 CLEAR ^O ON TOPS20 INSTEAD OF SETTING IT ON FATAL MESSAGES.
;140 CHANGE CHANNEL ALLOCATION SO MORE FILES CAN BE OPENED BY COBOL USER
;141 HANDLE MULTIPLE CORE EXPANSIONS PROPERLY SO SHRINK IN COBOL WORKS
;142 CAUSE SIXBIT RUNNING ON KL-10 TO SORT PROPERLY IN ALL CASES.
;143 HANDLE /FIX, /VAR MORE CONSISTENTLY, AND ISSUE BETTER ERROR MESSAGE
;144 MAKE NUMERIC UNSIGNED EBCDIC USE EBCDIC ROUTINES INSTEAD OF SIXBIT ONES.
;145 CAUSE EBCDIC ALPHANUMERIC RUNNING ON KL-10 TO SORT PROPERLY IN ALL CASES.
;146 USE WORD OFFSET IN CNVGEN SO SORTS WITH MORE THAN 1 CONVERTED KEY WORK.
;147 FIX AND CLEAN UP HANDLING OF EXTRACTED WORD COUNT IN ASCII I/O ROUTINES.
;150 FIX AND CLEAN UP HANDLING OF EXTRACTED WORD COUNT IN EBCDIC I/O ROUTINES.
;151 MAKE SRTSNA AND SRTROS FATAL ERRORS RATHER THAN WARNINGS.
;152 MAKE SURE R (AND RSAV) NEVER GETS -1 IN LH, DUE TO @RSAV.
;153 FIX ASCII ALPHANUMERIC COMPARISONS ON KL (BIS).
;154 FIX MORE ASCII AND EBCDIC I/O WHEN FTKL10==1.
;VERSION 3
;200 Implement stand-alone merge.
; Implement COBOL merge.
; Implement FORTRAN interface.
; Start to implement collating sequence.
;SORT version 3(200) Released.
;201 Separate MODE into MODE for keys and IOMODE for I/O to avoid confusion.
;202 Fix Ill UUO and defaulting of /FIX, /VAR, /SEQ, /RAN, /BIN, /COMP and /FORMAT.
;203 Fix FORTRAN binary data files of all flavors.
;204 Change SIXBIT input to ignore zero words.
;205 Fix handling of tapes in sort case.
;206 Turn on FTOPS20 conditional for TOPS-20 SORT.
;207 Write .TMP files variable length in COBOL SORT.
;210 Check forgotten case in edit 131 so files are not padded with zeros.
;211 Make sure the last I/O channel is freed before returning in FORTRAN SORT.
;212 Fix random errors on second command to SORT when using /TEMP.
;213 Fix major incompatibilities in FORTRAN SORT's command scanner.
;214 Skip .TMP structures if OPEN or ENTER fails.
;215 Fix tape label checking in stand-alone SORT.
;216 Fix handling of line-sequenced ASCII files in KL case.
;217 Fix edit 207 so data record gets copied after the keys.
;220 Fix illegal instruction when handling tapes in FORTRAN SORT.
;221 Stop FORTRAN SORT from expanding more and more on TOPS-20.
;222 Fix DECODE errors when using /FORMAT.
;223 See that R gets initialized in SCAN in SRTFOR for ? I/O to unassigned channel.
;224 Fix SRTTFC and I/O to unassigned channel errors in SRTCBL on early ENDS. calls.
;VERSION 4
;300 JSYSize SORT.
;301 Allow input and output to have different blocking factors (QAR 20-00136).
;302 Fix bugs found from second field test tape.
;SORT/MERGE version 4(302) Released
;303 Fix compares of two character EBCDIC alphanumeric keys in the middle of a word.
;304 Fix ?SRTRIE errors on EBCDIC fixed-length files.
;305 On TOPS-20, fix blocking factor problems.
;306 On TOPS-10 binary sort, MAXKEY not set up caused divide by 0.
;307 Double precision unsigned comparison routine fixes.
;310 Var. length file with random line terminators fix.
;311 Fix SIXBIT alphanumeric compares of 6 chars starting on a word boundary.
;312 Fix performance bug when sorting blocked files.
;313 Fix SRTRBP errors during merge phase of a sort.
;314 Re-insert line that got lost out of edit 305.
;315 Fix definition of RETSKP to fix undefined RSKP labels.
;316 Fix various bad output files and ill mem refs in FORTRAN binary files.
;317 Clear junk in buffer header word of OPEN block
;320 Clean up FUNCT. after SORT (FSLOC.)
;321 Fix further blocking factor problems on TOPS-20, when blocks are huge.
;322 SIXBIT, word boundary, six char. length sign compare fix
;323 Fix loop when SORT has exactly enough memory but thinks it doesn't.
;324 SIXBIT blocked file (generates only one temp file) IO error
;325 TOPS-20, ASCII MERGE loop and SIXBIT nulls fix
;326 TOPS-20 Allow multiple input files in SORT
;327 Fix merges when one or more input files are null, or more than MAXTMP files.
;330 FORTRAN SORT BINARY /COMP and non COMP fix
;331 Edit 327 broke sorts. Make RETRN. still return if not a merge.
;332 EDIT 322 broke SORT for SIXBIT alphanumeric files SORTED on .GT. 1 KEY.
;333 Default /LABELS: to STANDARD as documented on TOPS-20.
;SORT version 4A(333) with edit 337 released with COBOL-74 version 12.
;334 Fix expanding memory too much when LOGIN/CORE:n is used (e.g., BATCH).
;335 Use new form of JSYS names, NAME%, to solve global symbol conflicts.
;336 Clean up TOPS-20 command scanner - remove noise words from switches and /RMS.
;337 Really fix sorts back after edits 327 and 331.
;340 Fix /COLLATE loop on KA and KI
;341 ASCII records .EQ. /RECORD error message
;342 SIXBIT unblocked files which create only one .TMP fix
;343 S/A SORT problem with GETTAB return of 0
;344 TOPS-20 SIXBIT blocked file can lose records
;345 MERGE problems closing out file too soon- E327 331 337
;346 S/A SORT problems with multiple command lines. Restore .JBFF
;347 Fix FORTRAN command scanner to process /SWITCH:^N correctly
;350 Fix FORTRAN command scanner to process DEV:/TEMP correctly
;351 Fix errors with /SUPRES, /FATAL, /ERROR, /LEAVES, /FORMAT
;352 Fix FORTRANs problems with SFDs and PPNs
;353 Fix TOPS-10 labeled tapes, /REWIND, and I/O error messages.
;354 Fix COBOL merge when called from non-resident COBOL overlay.
;355 On TOPS-10 scan /COLLATE:FILE:file-spec correctly (allow SFDs, etc.).
;356 In COBOL SORT, clear low segment data in case second call.
;357 On TOPS-20 print more information on certain fatal errors.
;360 On TOPS-20 convert DATE UUO to ODCNV% JSYS
;361 Allocate KEY extraction and compare space in high segment.
;362 Make SRTRNI message fatal.
;363 Make /SUPPRESS:INFORMATION suppress final messages from S/A SORT.
;364 Fix more FORTRAN SORT ill mem ref problems
;365 Merge last development work for SORT %4A into maintenance sources.
;366 On TOPS-20, write last word if it is the first word in a buffer.
;367 EBCDIC variable length fix for SRTRTI
;370 Fix truncated records if extracted keys and temp files are necessary.
;371 Make sure output buffers are cleared before output starts
;372 On TOPS-20, fix /BLOCKED:n to default properly.
;373 Add debugging facility for the structure macros, and fix bugs it finds.
;374 On TOPS-10, improve error messages SRTIRE and SRTOWE for temporary files.
;375 On TOPS-20, fix looping with multiple /KEY:s, broken by 372.
;376 On TOPS-20, properly reinitialize on a new line to prevent PDL overflows, etc.
;377 On TOPS-20, fix ?SRTOPN errors on multiple commands after edit 376.
;400 On TOPS-20, fix truncation of SIXBIT files after edit 366.
;401 On TOPS-20, fix SRTCCN errors when using magtapes.
;402 Skip non-existent records in FORTRAN RANDOM files instead of issuing ?SRTFCI.
;403 Fix EBCDIC alphanumeric comparisons similar to /KEY:8:2 and /KEY:8:4.
;404 Fix TOPS-10 SRTMUF errors when ASSIGN ALL DSK,etc. is used
;405 Fix TOPS-20 '?SRTNEC' for large files bug
;406 Fix ILL MEM REF or inability to generate tape labels caused by clobbering X.DVCH in STOPB
;407 Bad sorts for unblocked tape files- 10. Wrong recsize.
;410 Wrong record size from Fortran binary sorts with /NUMERIC
;411 Fix LOOKUP error msg loop when CCL and entry fails
;412 Non specified commands default to ASCII. Message when found otherwise.
;413 FORTRAN-10 problem with multiple key SORTs - SRTCGC msg
;414 Fix further problems after edit 353 with end-of-tape processing.
;415 COBOL SORT Address check when one .TMP file is created
;416 /LEAVES causes no. of records to be reported, not no. leaves in tree
;417 Rec. trunc. message wrong. It reports characters not records.
;420 SORT-20 gives ?SRTAWP when outputting fix SIXBIT to tape
;421 SORT-20 allowed /ALI/BIN. Fix.
;422 SORT-20 now allows /DENSITY:6250
;423 SIXBIT SORTs that create only one .TMP file have output truncated
;424 TOPS-10 will not allow a unit to be temp device (DSKN0:)
;425 Edit 411 neglected to delete the TMPCOR file. Call SCAN and del it.
;426 Give error on SORT-20 allowing more than one /SUPPRESS
;427 Not all data was zeroed at new command (e.g. /LEAVES) on -20.
;430 A typo in edit 400 causes an ILL MEM REF to occur. Edit 366 is also needed.
;431 SORT calculates incorrect info for FOROTS DECODE arg block on /FORMAT
;432 SORT-10 does not allow a lowercase arg for /FORMAT-?SRTFSA occurs
;433 COBOL SORT's comparison rout. write locks hi-seg pg on TOPS-20.
;Make TOPS-10 code compatable.
;434 Fix multi-reel tape problem with EOT on TOPS-10.
;435 Fix a -20 SIXBIT blk bug; rewrite some code efficiently.
; cleanup- spelling, table contents for v4B
;*** Add METERing code.
;SORT/MERGE version 4B(435) released.
;436 Point to output file on rename of single temp file.
;437 Fix -20 bug with SIXBIT unblocked files SRTJFO,SRTCCF.
;440 Fix Fixed EBCDIC with odd number of bytes in file.
;441 Fix reformatted buffer pool memory allocation.
;442 Fix problem with EBCDIC record descriptor word corruption.
;443 Eliminate sequence number overflow warning (%SRTSNO) and associated
; instability.
;444 Fix a TOPS-20 bug in which SOUT garbages output containing nulls.
;445 Fix a TOPS-10 bug by clearing .RBALC in ENTER block.
;446 Fix a 10/20 EBCDIC bug in SRTCMP which garbaged COMP-3 Key extraction.
;447 Fix the /NOCREATE bit in GENSTR routine.
;450 Allow explicit ALPHANUMERIC keys with EBCDIC.
;451 Not required in SORT 4C (part of edit C18).
;452 Not required in SORT 4C.
;453 Make TOPS-20 HELP command look in HLP: instead of SYS:.
;454 On TOPS-20 don't clear MRGSW (in CLRANS) after setting it.
;455 Save T4 in ERRRTI (see also C28).
;456 Not required in SORT 4C.
;457 Allow TOPS-20 SORT to CONTINUE after "?QUOTA EXCEEDED OR DISK FULL" message.
;460 Build the collating table (COLBUF) correctly for SIXBIT files when the
; user specifies his own collating sequence.
;461 Correct the calculation of MINKEY when there are extracted keys.
;462 First character of a collating sequence specified in a file is lost.
;463 On TOPS-20 close the TAKE and LOG files when SORT exits if a TAKE file was being processed.
;464 On TOPS-20 fix edit 457 to put out "$" before the error message for batch.
; Also fix the continue after PMAP failure so that pages are not lost.
;465 On TOPS-20 fix the calculation of the number of bytes written to the output file.
;466 Not required in SORT 4C.
;467 Allow the space character to be specified using the quote facility
; in an alternate collating sequence file.
;C01 Implement MTA switches on TOPS-20.
;C02 Fix MTA double buffering on TOPS-20.
;C03 Fix MTA last record in file processing.
;C04 Fix lower case labels.
;C05 Fix default buffer space allocations on TOPS-20.
;C06 Fix MTA blocking.
;C07 Fix MTA EOT processing.
;C08 Fix MTA labeling.
;C09 Implement defaulting of /BLOCKED:1 and /INDUSTRY for EBCDIC MTAs.
;C10 Change default TAKE log file to NUL: on TOPS-20.
;C11 Implement /POSITION:
;C12 Support automatic MTA labeling on TOPS-20.
;C13 Remove FOROTS hack and correct memory management.
;C14 Remove hacks for MACRO-10 negative relocation deficiency.
;C15 Renamed to EDIT 447.
;C16 Renamed to EDIT 450.
;C16 Allow explicit ALPHANUMERIC keys with EBCDIC.
;C17 Fix BLOCKING HACK on TOPS-20.
;C18 Use BIG disk buffers on TOPS-10.
;C19 Change as many UUO's to FILOP. UUO's as possible for new features.
;C20 Clean up code to allow SORT-10/20 to run in a non-zero memory SECTION.
;C21 Fix memory reallocation bug in SORT-10.
;C22 Fix problem with unlabeled magnetic tapes through MOUNTR in SORT-20.
;C23 Fix problem with determining high segment size in SORT-10.
;C24 Fix problem with PHYSICAL LIMIT 0 in SORT-10.
;C25 Support for new PULSAR label types in SORT-10.
;C26 Fix bug concerning .TMP files and no UFD's in SORT-10.
;C27 Renamed to EDIT 444.
;C28 Fix record truncation on input destroying ACs (see also EDIT 455).
;C29 Fix default memory for SORT-10 on KI's and KL's.
;N01 Some minor code bumming.
;N02 Give error message if not enought input files for MERGE.
;N03 Change .LINK pseudo-op number to avoid conflict with COBOL-74 /R
;N04 Fix COBOL SORT on KA-10 to assemble correctly again.
;N05 Give file not found message as early as possible to avoid unnecessary memory expansion.
;N06 Reset CORSTK if an error occurs in SCAN (TOPS-10 only).
;N07 Fix edit C29 to work for COBOL SORT (TOPS-10 only).
;N08 More fixes to DEFCOR to account for VMDDT and V/M limits (TOPS-10 only).
;N09 Fix calculation of number of temp files on TOPS-10.
;N10 Delete FTCOL feature test switch, the code is always generated.
;N11 Add switches NOCRLF, AFTER-ADVANCING, and BEFORE-ADVANCING.
;N12 If TOPS-10 7-series monitor use FILOP.s for all I/O operations.
;N13 On TOPS-20 don't turn on page creation interupt if RMS turned it off.
;N14 On TOPS-10 bypass protection check if job is [1,2] or JACCT.
;N15 Fix read from NUL: device on TOPS-20.
;N16 Fix bug with very large keys using more than FTEXSX space.
;N17 Use extended channels if TOPS-10 7.01.
;N18 Fix bad sort for SIXBIT key /K:n:3 where n is a multiple of 6.
;N19 Return /ERROR-CODE in 3 ASCII chars. rather than 6 SIXBIT ones.
;N20 On TOPS-10 increase number of temp files to 26 if extended channels available.
;N21 On TOPS-10 put segmentation back the way it was, put new code under FTVM conditional.
;N22 On TOPS-10 fix default core allocation "off by one" bug causing not enough core error.
;N23 Make SORT with double precision COMP keys work again.
;N24 Make FILOP. DELETE work in both 7.01 and 7.02 (problem with FO.UOC bit).
;N25 Allow either " or ' to delimit quoted characters in COLLATING sequence.
;N26 On TOPS-20 fix bug with multiple input files on magtape.
;N27 Fix memory allocation in SORT for very large FORTRAN programs.
;SORT/MERGE version 4C(467) released.
;470 GCS 1-Jun-81 SRTSTA SRTSCN
; Same as edit 467 but for TOPS-10
; *** Not required in SORT 4C ***.
;471 GCS 4-Sep-81 SORT
; *** Not required in SORT 4C ***.
;472 DMN 25-Nov-81 SORT
; TOPS-10 COBOL and Fortran SORTs (except FSORT) did not release the core they
; had retained before returning to the calling program.
;473 GCS 11-Dec-81 SRTSTA
; ?ILL MEM REF can occur in FSORT. The data pages will not be created if the
; physical limit is reached. Attempt to create the pages on disk. Give error
; if this would exceed the user's virtual limit.
;474 DMN 14-Dec-81 SRTSTA
; Mark the stack created by FSORT with a "STOP!!" as expected by Fortran v6.
;475 ERD 15-Dec-81 SRTSCN
; Make /HELP illegal in FSORT.
;476 GCS 18-Jan-82 SRTSTA SRTCMD
; SORT does not correctly load the address of the argument passed by the
; Fortran caller when SORT is running in a non-zero section.
;477 GCS 18-Feb-82 SRTUUO
; The wrong error code is sometimes typed for a FILOP. error.
;500 GCS 13-Apr-82 SRTJSS SRTCER SRTSCN SRTSTA
; Fix illegal collating sequence problems.
;501 GCS 20-May-82 SORT
; Fix ill. mem. ref. caused by BLT 1 word too far.
;502 GCS 27-May-82 SRTJSS
; Fix edit 457 to not give QUOTA EXCEEDED message to the operator.
;503 GCS 25-Jun-82 SRTUUO
; Fix the default memory allocator to work with FORTRAN V6.
;504 GCS 9-Jul-82 SRTSCN
; Parse /COLLATE:FILE:file-spec correctly on TOPS-10.
;505 GCS 20-Aug-82 SRTJSS
; Add the structure name to the QUOTA EXCEEDED message.
;506 GCS 30-Jul-82 SRTSCN
; Clear up various parsing errors on TOPS-10.
;507 GCS 8-Oct-82 SRTJSS
; Make sure bit 35 is clear on ASCII files.
;510 GCS 25-Oct-82 SRTSCN
; Clear extended ENTER block correctly in TOPS-10 SORT.
;511 DMN 25-Oct-82 SRTSTA SRTFLT SRTCMP SRTCMD
; Implement Unsigned Fortran Floating Point.
;512 GCS 1-Nov-82 SRTSCN
; Fix bugs in TOPS-10 /COLLATE:FILE:filespec switch.
;513 GCS 15-Dec-82 SRTPRM
; Define EXTEND in terms of itself for KI-10 SORT.
;514 DMN 20-Jan-83 SRTSTA
; Correct edit 511 to include index at USRFMT+13.
;515 DMN 15-Feb-83 SRTFOR
; Make indirect files work when called from Fortran Sort.
;516 DMN 22-Jun-83 SRTPRM SRTUUO
; Fix default core allocation routine to work with Fortran v6 on TOPS-10.
;517 DMN 22-Jun-83 SRTPRM SRTSCN
; TOPS-10 only, added RM.FOR bit.
SUBTTL DEFINITIONS -- Accumulators
.XCREF ;[373] DON'T FILL CREF WITH USELESS SYMBOLS
EF=0 ;END OF FILE STATUS
T0=0 ;USED IN EXTRACT ROUTINES
T1=1 ;TEMPORARY
T2=2
T3=3
T4=4
P1=5 ;PRESERVED
P2=6
P3=7
P4=10
F=11 ;FILE PTR
U=12 ;GENERAL AOBJN PTR
J=13 ;2ND RECORD PTR
R=14 ;1ST RECORD PTR
S=15 ;NODE PTR
L=16 ;EXTERN ARG-LIST PTR
P=17 ;PUSHDOWN PTR
.XCREF EF,T0,T1,T2,T3,T4,P1,P2,P3,P4,F,U,J,R,S,L,P
.CREF
PGSIZ==1000 ;SIZE OF ONE PAGE
PGMSK==PGSIZ-1 ;[365] MASK FOR TESTING PAGE ALIGNMENT
PDLEN==100 ;SIZE OF STACK
IFE FTOPS20,<
MX.T15==^D15 ;[N20] MAXIMUM NUMBER OF TEMP FILES IF NO EXTENDED CHANS.
>
MX.TMP==^D26 ;ONE FOR EACH LETTER OF THE ALPHABET
U.CHN==3 ;NUMBER OF CHANNELS TO TRY TO LEAVE TO USER
MX.INP==^D100 ;MAX NUMBER OF INPUT FILES
MX.OUT==^D20 ;MAX NUMBER OF OUTPUT FILES
MAXXSZ==^D100 ;MAX KEY SIZE TO TRY OPTIMAL COMPARISONS
STCKSZ==100 ;[N06] SIZE OF CORSTK
SUBTTL DEFINITIONS -- Recording Modes
RM.ASC==1B0 ;ASCII - DISPLAY-7
RM.SIX==1B1 ;SIXBIT - DISPLAY-6
RM.EBC==1B2 ;EBCDIC - DISPLAY-9
RM.BIN==1B3 ;BINARY - 36 BIT
RM.ALP==1B4 ;ALPHANUMERIC
RM.COM==1B5 ;COMPUTATIONAL
RM.NUM==1B6 ;NUMERIC
RM.PAC==1B7 ;PACKED - COMP-3
RM.SGN==1B8 ;SIGNED
RM.UNS==1B9 ;UNSIGNED
RM.GFL==1B15 ;Gfloating
RM.FPA==1B16 ;FLOATING POINT
RM.FOR==1B17 ;FORTRAN DATA FILE
;RMS file organization values
RMS.IX==1 ;INDEXED
RMS.RL==2 ;RELATIVE
RMS.SQ==3 ;SEQUENTIAL
RMS.ST==4 ;STREAM-ASCII
RMS.LS==5 ;LINE-SEQUENCED-ASCII
RMS.KX==6 ;INDEXED KEYED ACCESS
RMS.KR==7 ;RELATIVE KEYED ACCESS
ADV.B==0 ;WRITE RECORD BEFORE ADVANCING (COBOL-68 DEFAULT).
ADV.A==1 ;WRITE RECORD AFTER ADVANCING (COBOL-74 DEFAULT).
;COLLATING SEQUENCE FLAGS
COL.MI==1B1 ;PENDING MINUS SIGN
COL.EQ==1B2 ;PENDING EQUAL SIGN
COL.QU==1B3 ;[467] PENDING QUOTE
;INDEX BITS FOR RECORDING MODE. XX IS A MACRO THAT GETS REDEFINED AT VARIOUS
;TIMES. 1ST ARG IS DISPATCH ADDRESS AND 2ND ARG IS ONE OF THE FOLLOWING:
;
; A - ALWAYS EXTRACT KEYS
; C - CONDITIONALLY EXTRACT KEYS DEPENDING UPON COLLATING SEQ. FLAG
; N - NEVER EXTRACT KEYS
DEFINE IXMODE,<
XX (ALS,C) ;ALPHANUMERIC LOGICAL SIXBIT
XX (ALA,C) ;ALPHANUMERIC LOGICAL ASCII
XX (ALE,C) ;ALPHANUMERIC LOGICAL EBCDIC
XX (NSS,A) ;NUMERIC SIGNED SIXBIT
XX (NSA,A) ;NUMERIC SIGNED ASCII
XX (NSE,A) ;NUMERIC SIGNED EBCDIC
XX (NUS,A) ;NUMERIC UNSIGNED SIXBIT
XX (NUA,A) ;NUMERIC UNSIGNED ASCII
XX (NUE,A) ;NUMERIC UNSIGNED EBCDIC
XX (CSS,N) ;COMPUTATIONAL SIGNED SIXBIT
XX (CSA,N) ;COMPUTATIONAL SIGNED ASCII
XX (CSE,N) ;COMPUTATIONAL SIGNED EBCDIC
XX (CUS,N) ;COMPUTATIONAL UNSIGNED SIXBIT
XX (CUA,N) ;COMPUTATIONAL UNSIGNED ASCII
XX (CUE,N) ;COMPUTATIONAL UNSIGNED EBCDIC
XX (C3S,A) ;COMP-3 SIGNED
XX (C3U,A) ;COMP-3 UNSIGNED
XX (CSB,N) ;COMPUTATINAL SIGNED BINARY
XX (CUB,N) ;COMPUTATIONAL UNSIGNED BINARY
XX (NSB,N) ;[330] NONCOMP SIGNED BINARY
XX (NUB,N) ;[330] NONCOMP UNSIGNED BINARY
XX (FPA,A) ;FLOATING POINT ASCII
XX (FPU,A) ;[511] UNSIGNED FLOATING POINT ASCII
XX (GFS,A) ;Gfloating SIGNED
XX (GFU,A) ;Gfloating UNSIGNED
>
;GENERATE INDEX
ZZ==0
DEFINE XX(A,B)<
IX.'A==ZZ
ZZ==ZZ+1
>
IXMODES
SUBTTL DEFINITIONS -- FORTRAN Interface
;FORTRAN BINARY LSCW'S
S.LSCW==001000 ;START
C.LSCW==002000 ;CONTINUE
E.LSCW==003000 ;END
;FORTRAN DATA TYPES
TP%UDF==0 ;UNDEFINED TYPE
TP%LOG==1 ;LOGICAL
TP%INT==2 ;INTEGER
TP%REA==4 ;REAL
TP%OCT==6 ;OCTAL
TP%LBL==7 ;LABEL OR ADDRESS
TP%DOR==10
TP%DOT==12
TP%COM==14
TP%CHR==15 ;CHARACTER (STRING + COUNT)
TP%LIT==17 ;ASCIZ TEXT (LITERAL STRING)
;FORTRAN IOLST. FUNCTIONS
OPDEF DATA.[1B8] ;CONVERT SINGLE DATA ELEMENT
OPDEF SLIST.[2B8] ;CONVERT AN ENTIRE ARRAY
OPDEF FIN.[4B8] ;IMPLIED CALL TO FIN.
;FUNCT. ARGUMENTS
F.GAD==1 ;GET CORE AT SPECIFIC ADDRESS
F.COR==2 ;GET CORE AT ANY ADDRESS
F.RAD==3 ;RETURN CORE AT ADDRESS
F.GCH==4 ;GET CHANNEL ARGUMENT
F.RCH==5 ;RETURN CHANNEL NUMBER
F.GOT==6 ;GET CORE FROM OTS LIST
F.ROT==7 ;RETURN CORE TO OTS LIST
F.CBC==12 ;CUT BACK CORE (SHRINK)
SUBTTL DEFINITIONS -- Special Monitor Definitions
;MACRO TO DEFINE AN OPDEF BUT SUPPRESS ITS TYPEOUT FROM DDT.
DEFINE SOPDEF(OP,VAL)< ;;[373]
OPDEF OP[VAL] ;;[373] DEFINE THE OPCODE
.NODDT OP ;;[373] SUPPRESS ITS TYPEOUT FROM DDT
>
;EXIT TO MONITOR--NOTE THAT BOTH OF THESE ARE CONTINUABLE!
IFE FTOPS20,<OPDEF MONRET[MONRT.]>
IFN FTOPS20,<OPDEF MONRET[HALTF%]>
;OTHER USEFUL OPDEFS
DEFINE FASTSKIP<JRST .+2> ;FASTEST SKIP--DON'T USE IN LITERALS
OPDEF NOOP [TRN] ;STANDARD FAST NOOP
SOPDEF CALL,<PUSHJ P,> ;[373] JUST IN CASE
SOPDEF RET,<POPJ P,> ;[373] ..
OPDEF CALLRET[JUMPA 16,] ;[373] MAKE DDT KNOW THE DIFFERENCE
OPDEF PJRST[JUMPA 17,] ;[373] PJRST AND JRST, ETC.
DEFINE RETSKP <JRST CPOPJ1> ;[373] ..
;MACRO TO ZERO A BLOCK OF MEMORY. AC IS A TEMPORARY ACCUMULATOR, BLOCK
;AND LENGTH ARE THE ADDRESS AND LENGTH OF THE BLOCK.
DEFINE ZERO(AC,BLOCK,LENGTH)< ;;[355]
SETZM BLOCK ;;[355] ZERO FIRST WORD
MOVE AC,[<BLOCK>,,<BLOCK+1>] ;;[355] ZERO REST OF BLOCK
BLT AC,<BLOCK>+<LENGTH>-1 ;;[355] ..
>
;MACROS TO TYPE STRINGS AND CHARACTERS
DEFINE TYPE(MESSAGE)<
IFE FTOPS20,<
OUTSTR [ASCIZ \MESSAGE\]
>
IFN FTOPS20,<
HRROI T1,[ASCIZ \MESSAGE\]
PSOUT% ;;[335]
>
>
DEFINE TYPEC(ACC)<
IFE FTOPS20,<
OUTCHR ACC
>
IFN FTOPS20,<
IFN <ACC>-T1,<
HRRZ T1,ACC
>
PBOUT% ;;[335]
>
>
;MACRO TO CLEAR CTRL/O. NOTE THAT IT POTENTIALLY DESTROYS T1 AND T2.
DEFINE CLEARO<
IFE FTOPS20,<
SKPINL ;;ANY INPUT OPERATION CLEARS ^O
JFCL
>
IFN FTOPS20,<
MOVEI T1,.PRIOU ;;READ JFN MODE WORD
RFMOD% ;[335] ; ..
TXZE T2,TT%OSP ;;TURN OFF OUTPUT-SUPPRESS
SFMOD% ;[335] ; ..
>
>
DEFINE COMPARE (R,J)<
JSP P4,@.CMPAR
>
;MONITOR TYPE GETTAB. NOTE THAT THIS GETTAB IS SIMULATED ON TOPS-20 WITHOUT
;CALLING IN THE COMPATIBILITY PACKAGE.
%CNMNT==112,,11 ;CONFIGURATION GETTAB
CN%MNT==77B23 ;MASK FOR MONITOR TYPE
IFN FTOPS20,<
CSTKLN==50 ;LENGTH OF CORE ALLOCATOR STACK
>
;CPU TYPES
KA.CPU==0
KI.CPU==1
KL.CPU==2
SUBTTL DEFINITIONS -- Business Instruction Set OPcodes
;DEFINE BIS OPCODES--MACRO KNOWS THEM BUT DDT DOESN'T YET
OPDEF EXTEND [EXTEND] ;[513] SO KI-10 MACRO CAN BUILD KI-10 SORT
OPDEF CMPSL [CMPSL] ;COMPARE STRINGS, SKIP IF LESS
OPDEF CMPSE [CMPSE] ;COMPARE STRINGS, SKIP IF EQUAL
OPDEF CMPSLE [CMPSLE] ;COMPARE STRINGS, SKIP IF LESS OR EQUAL
OPDEF CMPSGE [CMPSGE] ;COMPARE STRINGS, SKIP IF GREATER OR EQUAL
OPDEF CMPSN [CMPSN] ;COMPARE STRINGS, SKIP IF NOT EQUAL
OPDEF CMPSG [CMPSG] ;COMPARE STRINGS, SKIP IF GREATER
OPDEF EDIT [EDIT] ;PROCESS STRING ACCORDING TO MINI-PROGRAM PATTERN
OPDEF CVTDBO [CVTDBO] ;CONVERT DECIMAL TO BINARY BY OFFSET
OPDEF CVTDBT [CVTDBT] ;CONVERT DECIMAL TO BINARY BY TRANSLATION
OPDEF CVTBDO [CVTBDO] ;CONVERT BINARY TO DECIMAL BY OFFSET
OPDEF CVTBDT [CVTBDT] ;CONVERT BINARY TO DECIMAL BY TRANSLATION
OPDEF MOVSO [MOVSO] ;MOVE STRING WITH BYTE OFFSET
OPDEF MOVST [MOVST] ;MOVE STRING WITH BYTE TRANSLATION
OPDEF MOVSLJ [MOVSLJ] ;MOVE STRING UNMODFIED WITH LEFT JUSTIFICATION
OPDEF MOVSRJ [MOVSRJ] ;MOVE STRING UNMODIFIED WITH RIGHT JUSTIFICATION
OPDEF ADJBP [ADJBP] ;ADJUST BYTE POINTER
S.FLAG==1B0 ;SIGNIFICANCE FLAG
N.FLAG==1B1 ;NON-ZERO FLAG
M.FLAG==1B2 ;MINUS FLAG
E.SBIT==400000 ;SET S AND N FLAGS
E.ABRT==100000 ;ABORT EDIT (NO SKIP)
E.MCLR==200000 ;CLEAR M FLAG
E.MSET==300000 ;SET M FLAG
SUBTTL DEFINITIONS -- Extended Addressing Instruction Set OPcodes
;DEFINE Gfloating OPCODES
DEFINE GFAD [102B8]
;DEFINE EXTENDED ADDRESSING OPCODES
OPDEF XMOVEI [SETMI] ;[C20]
OPDEF XHLLI [HLLI] ;[C20]
OPDEF XJRSTF [JRST 5,] ;[C20]
SOPDEF IFIW, <1B0> ;[C20]
SOPDEF EFIW, <1B1>
DEFINE IFIWS(A),<IRP <A>,<IFIW A>> ;[C20]
IFN FTOPS20,< SM%RWX==:SM%RD!SM%WR!SM%EX ; CONVENIENCE
SUBTTL DEFINITIONS -- Prototype File Spec, MTA and Key Blocks
LOC 0
X.NXT:! BLOCK 1 ;POINTER TO NEXT
IFE FTOPS20,< ;ONLY WANT THESE ON TOPS10
X.OPN:! BLOCK 3 ;[215] OPEN BLOCK FOR FILE
X.DVSZ:!BLOCK 1 ;DEVSIZ UUO
X.DVCH:!BLOCK 1 ;DEVCHR UUO
X.RIB:! BLOCK .RBALC+1 ;[215] LAST NEEDED + COUNT WORD
X.PTH:! BLOCK .PTMAX ;[215] SFDS
>;END IFE FTOPS20
IFN FTOPS20,< ;ONLY WANT THESE ON TOPS20
X.DVCH:!BLOCK 1 ;WORD RETURNED BY DVCHR JSYS
X.JFN:! BLOCK 1 ;JFN OF FILE (UNTIL COPIED TO FCB)
X.FLGM:!BLOCK 1 ;FLAG MASK WORD
X.RIB:! BLOCK 2 ;SIXBIT NAME, EXT, FOR LABEL CHECKING
X.PAR:! BLOCK 1 ;[C01] PARITY
X.ORG:!BLOCK 1 ;INDEX KEY LIST (LHS),,FILE ORGANIZATION (RHS)
>;END IFN FTOPS20
X.DEN:! BLOCK 1 ;[215] DENSITY FOR TAPOP.
X.REEL:!BLOCK 1 ;[215] REEL NUMBER FOR MULTI-REEL FILES
X.FLG:! BLOCK 1 ;[215] HOLDS FLAGS UNTIL MOVED TO FILFLG
X.BLKF:!BLOCK 1 ;BLOCKING FACTOR
X.LABL:!BLOCK 1 ;LABEL TYPE
X.POSI:!BLOCK 1 ;[C11] /POSITION VALUE, <0 = NO POSITIONING
;[C11] 1B1=1 INDICATES BACKSPACE
LN.X==.-X.NXT
RELOC
IFN FTOPS20,<
;WORDS IN X.RIB TO HOLD SIXBIT FILENAME, EXT, FOR TAPE LABELS
.RBNAM==0
.RBEXT==1
>
;PROTOTYPE DATA BLOCK FOR MULTIPLE OUTPUT MTA SPECS
LOC 0
OM.NXT:!BLOCK 1 ;LINK TO NEXT
OM.DEV:!BLOCK 1 ;DEVICE
OM.LEN==.-OM.NXT
RELOC
;PROTOTYPE DATA BLOCK FOR KEYS
LOC 0
KY.NXT:!BLOCK 1 ;LINK TO NEXT
KY.INI:!BLOCK 1 ;INITIAL BYTE POSITION
KY.SIZ:!BLOCK 1 ;SIZE OF KEY IN BYTES OR DIGITS
KY.ORD:!BLOCK 1 ;ASCENDING OR DESCENDING
KY.MOD:!BLOCK 1 ;MODE OF KEY
KY.FMT:!BLOCK 3 ;[C13] FORMAT IF FPA
;[C13] KY.FMT+0 = FIELD WIDTH (-1=FREE FORMAT)
;[C13] KY.FMT+1 = DECIMAL PLACES
;[511] KY.FMT+2 = FLAGS,,SCALING FACTOR
KY%FDP==1B0 ;[511] DOUBLE PRECISION
KY%FUN==1B1 ;[511] UNSIGNED
KY%FBN==1B2 ;[511] BLANK=NULL
KY%FBZ==1B3 ;[511] BLANK=ZERO
KY%FGF==1B4 ;Gfloating
KY.LEN==.-KY.NXT
RELOC
SUBTTL DEFINITIONS -- File Control Block and File Flags
;FILE DEPENDENT FLAGS IN FILFLG
FI.VAR==1B0 ;VARIABLE LENGTH RECORDS
FI.IND==1B1 ;INDUSTRY COMPATIBLE MODE
FI.STA==1B2 ;STANDARD ASCII
FI.REW==1B3 ;REWIND BEFORE USE
FI.UNL==1B4 ;UNLOAD AFTER USE
FI.ATO==1B5 ;[215] TAPE LABEL PROCESSOR IS HANDLING LABELS
FI.EOT==1B6 ;[215] END-OF-TAPE FOR MULTI-REEL FILE
FI.MTA==1B7 ;FILE IS ON A MAGTAPE
FI.DSK==1B8 ;FILE IS ON DISK
FI.BF2==1B9 ;SECOND (MAGTAPE) BUFFER IN USE
FI.OUT==1B10 ;FILE IS AN OUTPUT FILE
FI.RMS==1B11 ;FILE IS IN RMS FORMAT
FI.TMP==1B15 ;THIS IS A TEMP FILE
;FILE CONTROL BLOCK
LOC 0
FILSIZ:!BLOCK 1 ;SIZE OF FILE IN RECORDS
FILRUN:! ;RUN NUMBER (LHS)
FILNAM:!BLOCK 1 ;FILE NAME INDEX (RHS)
IFN FTOPS20,<
FILEOF:!BLOCK 1 ;EOF COUNTER (IN BYTES)
FILJFN:! ;JFN (LHS)
FILPGN:!BLOCK 1 ;NEXT PAGE TO READ (RHS)
>
DFBLEN==. ;LENGTH OF DORMANT BLOCK
IFN FTOPS20,<
FILBF2:!BLOCK 1 ;[C02] WHERE SECOND MAGTAPE BUFFER STARTS
FILHBW:!BLOCK 1 ;[C03] MTA HARDWARE BYTES PER WORD
>
IFE FTOPS20,<
FILCHN:!BLOCK 1 ;[C19] FILE CHANNEL
FILHDR:!BLOCK 1 ;BUFFER HEADER
> ;END IFE FTOPS20
FILPTR:!BLOCK 1 ;POINTER TO NEXT WORD IN CURRENT BUFFER
FILCNT:!BLOCK 1 ;BUFFER COUNT
FILBUF:!BLOCK 1 ;(TOPS10) WHERE BUFFERS START (BUFPTR)
;(TOPS20) BUFFER SIZE (PGS),,1ST PAGE
;(TOPS20) EXCEPT MAGTAPE, WHICH HAS:
;(TOPS20) BUF SIZE (WORDS),,1ST WORD
FILBPB:!BLOCK 1 ;[C18] BYTES PER BUFFER ACCORDING TO I/O MODE
FILBLK:!BLOCK 1 ;FILE BLOCKING FACTOR
FILBPK:!BLOCK 1 ;[C17] FILE BLOCK SIZE IN BYTES
FILKCT:!BLOCK 1 ;[C17] FILE BLOCK BYTE COUNT
FILFLG:!BLOCK 1 ;SEE FI.??? FLAGS ABOVE
FILXBK:!BLOCK 1 ;[215] POINTER TO X.???? BLOCK FOR FILE
IFN FTOPS20,<
FILRAB:! ;POINTER TO RMS RAB (LHS)
FILFAB:!BLOCK 1 ;POINTER TO RMS FAB, RAB, AND XAB (RHS)
>
FCBLEN==. ;SIZE OF FCB
RELOC
SUBTTL DEFINITIONS -- Tree Node and Record Blocks
;PROTOTYPE NODE FOR RECORD TREE
LOC 0
RN.RUN:! ;RUN NUMBER (LHS)
RN.LSR:!BLOCK 1 ;PTR. TO LOSE (RHS)
RN.FI:! ;PTR. TO INTERNAL NODE FATHER (LHS)
RN.FE:! BLOCK 1 ;PTR. TO EXTERNAL NODE FATHER (RHS)
RN.SEQ:! ;SEQUENCE # ON SORT PHASE (LHS)
RN.FCB:! ;PTR TO FCB ON MERGE PHASE (LHS)
RN.REC:!BLOCK 1 ;PTR. TO RECORD $ KEYS (RHS)
RN.LEN==. ;LENGTH
RELOC
;PROTOTYPE RECORD BLOCK
LOC 0
RC.CNT:!BLOCK 1 ;BYTE COUNT
RC.KEY:!BLOCK 1 ;FIRST DATA WORD
RELOC
;TYPE OF INPUT
T.SIX==0 ;SIXBIT
T.ASC==1 ;ASCII
T.EBC==2 ;EBCDIC
;FLAGS FOR LEFT SIDE OF P1 DURING CNVTDB
FL.SGN==1B0 ;VALUE IS SIGNED
FL.DP==1B1 ;VALUE IS 2 WORDS
LED.SG==(3) ;LEADING SIGN MASK
LED.PL==(1) ;LEADING +
LED.MI==(2) ;LEADING -
;SPECIAL FLAGS IN CONVERSION TABLES
CF.S==1B0 ;SPECIAL FLAG
CF.N==1B1 ;NEGATIVE SIGN
CF.P==1B2 ;PLUS SIGN
CF.L==1B3 ;LEADING CHARACTER (TAB SPACE)
CF.Z==1B4 ;NUL
CF.O==1B5 ;OVERPUNCHED NEGATIVE
CF.I==1B6 ;ILLEGAL CHAR
IFN FTOPS20,<
;NUMBER OF RECORDS TO ADD TO MINIMUM CORE SIZE FOR "DEFCOR"
NRECS==^D1000
>
SUBTTL DEFINITIONS -- Segment Control - ISEGMENT and SEGMENT
IFE FTOPS20,<
;SEGMENT ORIGINS
IFE FTKI10!FTKL10,<
HIORG==400000 ;[C20] [C13] ORGIN OF PROGRAM
LOWORG==0 ;[C20] [C13] ORIGIN OF DATA
>
IFN FTKI10!FTKL10,<
HIORG==600000 ;[C20] [C13] ORIGIN OF PROGRAM
IFN FTVM,<
LOWORG==674000 ;[C20] [361] ORIGIN OF DATA
>
IFE FTVM,<
LOWORG==0 ;[N21] ORIGIN OF DATA
>
>
HILOC==HIORG ;[C13] COUNTER USED BY SEGMENT MACRO
LOWLOC==LOWORG ;[C13] COUNTER USED BY SEGMENT MACRO
DEFINE ISEGMENT<
IFE FTOPS20,<
IFE FTCOBOL!FTFORTRAN,<;; ONLY IN STAND-ALONE SORT
TWOSEG HILOC
RELOC HILOC
%SEG%==1
>
IFN FTCOBOL!FTFORTRAN,<
RELOC LOWLOC
%SEG%==0
>
>
IFN FTOPS20,<
TWOSEG HILOC
RELOC HILOC
%SEG%==1
>
DEFINE ISEGMENT<>
>
DEFINE SEGMENT(N)<
ISEGMENT
%NSEG%==-1 ;;[C20]
IFIDN <N><IMPURE>,<%NSEG%==0> ;;[C20]
IFIDN <N><LPURE>,< ;;[C20]
IFE FTVM,<%NSEG%==0> ;;[N21]
IFN FTVM,<%NSEG%==1> ;;[N21]
>
IFIDN <N><HPURE>,<%NSEG%==1> ;;[C20]
IFL %NSEG%,<PRINTX ? BAD ARGUMENT TO SEGMENT MACRO: <N>>
IFE %NSEG%,< ;;[C20]
IFG %SEG%,<
XLIST;; DUMP PENDING LITERALS
LIT
LIST
HILOC==.
>
IFN %SEG%,<
IFE FTVM,< ;;[N21] [C20]
RELOC LOWLOC
%SEG%==0
>
IFN FTVM,< ;;[N21] [C20]
LOC 0
PHASE LOWLOC
%SEG%==-1
>
>
>
IFN %NSEG%,< ;;[C20]
IFLE %SEG%,<
XLIST;; DUMP PENDING LITERALS
LIT
LIST
LOWLOC==.
IFN FTVM,< ;;[N21] [C20]
DEPHASE
>
RELOC HILOC
%SEG%==1
>
>
>
>;END IFE FTOPS20
IFN FTOPS20,<
;PSECT ORIGINS
CODORG==100000 ;ORIGIN OF CODE
DATORG==1000 ;ORIGIN OF DATA
HIORG==100000 ;[C20] [C13] ORIGIN OF PROGRAM
LOWORG==1000 ;[C20] [361] ORIGIN OF DATA
HILOC==HIORG ;[C13] COUNTER USED BY SEGMENT MACRO
LOWLOC==LOWORG ;[C13] COUNTER USED BY SEGMENT MACRO
FREORG==200000 ;ORIGIN OF FREE SPACE
DDTORG==775000 ;START OF DDT
;PSECT MACROS
DEFINE SEGMENT (N)<
IFIDN <N><IMPURE>,<.PSECT DATA,DATORG>
IFIDN <N><LPURE>,<.PSECT CODE,CODORG>
IFIDN <N><HPURE>,<.PSECT CODE,CODORG>
>
>;END IFN FTOPS20
;DATA ALLOCATION MACROS
DEFINE LD (NAME,SIZE) <NAME: BLOCK SIZE>
DEFINE GD (NAME,SIZE) <NAME:: BLOCK SIZE>
DEFINE LS (NAME,SIZE) <NAME:! BLOCK SIZE>
DEFINE GS (NAME,SIZE) <NAME::! BLOCK SIZE>
DEFINE POW2(N)<<^L1-^L<N>>>
S.LNK==2 ;[N03] [427] NO. FOR .LINK AND .LNKEND PSEUDO-OPS
;.LINK DATA BLOCK
LOC 0
Z.NXT:! BLOCK 1 ;[427] POINTER TO NEXT BLOCK
Z.ADD:! BLOCK 1 ;[427] FIRST ,, LAST DATA to zero
RELOC
SUBTTL DEFINITIONS -- Error Handling -- $ERROR
;Error messages in SORT are handled via the $ERROR macro below. Four standard
;types of messages are handled, as shown below.
;
; TYPE CALL RESULTING MESSAGE
;
; Informative $ERROR ([,xxx,<Text>) [SRTxxx Text]
; Warning $ERROR (%,xxx,<Text>) %SRTxxx Text
; Fatal $ERROR (?,xxx,<Text>) ?SRTxxx Text
; Operator intervention $ERROR ($,xxx,<Text>) $SRTxxx Text
;
;For fatal error messages, $ERROR automatically generates a call to the $DIE
;macro to abort the sort, possibly returning error information for the FORTRAN
;user.
;
;Error messages which contain text that is a function of run-time parameters are
;handled by specifying '+' as the fourth argument to $ERROR, then using the
;$MORE or $CHAR macros as needed, and finishing with $CRLF. In this case, the
;final message disposition must be performed by manually calling $DIE for fatal
;errors.
;
;When some alternate cleanup should be done on fatal errors, a fifth argument
;may be specified. This is the address to transfer control to after printing the
;message. Note that this is only applicable if '+' was not specified as the
;fourth argument. If it was, then an explicit JRST may be used in place of the
;final $DIE macro.
;
;The label of $ERROR macros is E$$xxx by convention; in fact, the macro now
;generates this label automatically. If an error message routine must do some
;preliminary computations before calling $ERROR, then the actual error routine
;label should be ERRxxx.
DEFINE $ERROR (Q,CODE,TEXT,MORE,CONT)<
...SQB==0
E$$'CODE: MOVE T1,['SRT',,''CODE'']
IFB <MORE>,<
IFDIF <Q><[>,<
MOVE T2,["Q",,[ASCIZ \TEXT
\]]
>
IFIDN <Q><[>,<
MOVE T2,["Q",,[ASCIZ \TEXT]
\]]
>
>
IFNB <MORE>,<
MOVE T2,["Q",,[ASCIZ \TEXT\]]
IFIDN <Q><[>,<
...SQB==1
>
>
PUSHJ P,%ERMSG
IFNB <CONT>,<
JRST CONT ;;[372]
>
IFB <CONT>,<
IFB <MORE>,<
IFIDN <Q><?>,<
JRST DIE
>
>
>
>
SUBTTL DEFINITIONS -- Error Handling -- $MORE
;$MORE is used following a call to $ERROR with '+' as the fourth argument.
;Thus, a sample call might be:
;
; E$$SNR: $ERROR ([,SNR,<Sorted >,+)
; $MORE (DECIMAL,OUTREC)
; $MORE (TEXT,< records.>)
; $CRLF
DEFINE $MORE (TYPE,DATA)<
IFIDN <TYPE><OCTAL>,<
IFDIF <DATA><T1>,<
MOVE T1,DATA
>
PUSHJ P,%TOCTW
>
IFIDN <TYPE><DECIMAL>,<
IFDIF <DATA><T1>,<
MOVE T1,DATA
>
PUSHJ P,%TDECW
>
IFIDN <TYPE><TEXT>,<
IFDIF <DATA><T1>,<
MOVEI T1,[ASCIZ \DATA\]
>
PUSHJ P,%TSTRG
>
IFIDN <TYPE><SIXBIT>,<
IFDIF <DATA><T1>,<
MOVE T1,DATA
>
PUSHJ P,%TSIXN
>
IFIDN <TYPE><ASCII>,<
IFDIF <DATA><T1>,<
MOVEI T1,DATA
>
PUSHJ P,%TSTRG
>
IFIDN <TYPE><FILESPEC>,<
IFDIF <DATA><T2>,<
HRRZ T2,DATA ;;[C20]
>
IFE FTOPS20,<
MOVEI T1,X.OPN-X.RIB(T2) ;;[OK]
>
PUSHJ P,%TOLEB
>
IFIDN <TYPE><CORE>,<
IFDIF <DATA><T1>,<
MOVE T1,DATA
>
PUSHJ P,%TCORW
>
>
SUBTTL DEFINITIONS -- Error Handling -- $CRLF, $CHAR, $DIE
DEFINE $CRLF<
IFN ...SQB,<
PUSHJ P,%TRBRK
...SQB==0
>
PUSHJ P,%TCRLF
>
...SQB==0
DEFINE $CHAR(CHAR)<
IFDIF <CHAR><T1>,<
MOVEI T1,CHAR
>
PUSHJ P,%TCHAR
>
DEFINE $DIE<
JRST DIE
>
DEFINE KEYZ (A,B)<
A'.L==0
IRP B,<
A'.L==A'.L+1
A'B==A'.L
>
>
;GENERATE SWITCH VALUES
KEYZ LAB,<STANDARD,OMITTED,DEC,ANSI,IBM>
KEYZ COL,<ASCII,EBCDIC,FILESPEC,LITERAL,ADDRESS,UASCII,UEBCDIC>
KEYZ MOD,<SIXBIT,ASCII,EBCDIC,BINARY>
KEYZ SUP,<NONE,INFORMATION,WARNING,FATAL,ALL>
SUBTTL DEFINITIONS -- Structure Macros -- Descriptions
;Program structuring macros are used throughout SORT to help enforce clean
;coding practices. There are several classes of macros available for different
;purposes. These are all described below.
;
;Note that all macros except the local label ones and PROCEDURE take an
;arbitrary comment as an argument.
;
;BEGIN, ENDB And Local Labels.
;
;The BEGIN and ENDB macros define the scope of a source code block. Within the
;block, special local labels are available if necessary, but the additional
;structuring macros below should be preferentially used where possilbe. Local
;label references are of the form $n, where n is 0 to 7 (don't be fooled by the
;RADIX 10 before the call to $TEMPORARY). Local label definitions are of the
;form $n%, and should be indented 2 spaces from the local left margin. Also,
;within a BEGIN - ENDB block, $B may be used as a label for the beginning of the
;block and $E for the end. Thus, a sample block might be:
;
;BEGIN ;BEGINNING OF OUTER BLOCK
; JRST $E ;JUMPS TO SECOND END
; $1% JRST $B ;JUMPS TO FIRST BEGIN
; BEGIN ;BEGINNING OF INNER BLOCK
; JRST $1 ;JUMPS TO SECOND $1%
; JRST $E ;JUMPS TO FIRST END
; $1% JRST $B ;JUMPS TO SECOND BEGIN
; ENDB ;END OF INNER BLOCK
; JRST $1 ;JUMPS TO FIRST $1%
; JRST $B ;JUMPS TO FIRST BEGIN
;ENDB; ;END OF OUTER BLOCK
;
;PROCEDURE And RETURN.
;
;These macros declare the entry and exits of a procedure. The first argument to
;PROCEDURE is the instruction used to call the procedure. Currently, this must
;be one of <PUSHJ P>, <JSP T4> or <JSP P4>. The second argument is the name of
;the procedure, or an IRP-style list of names. RETURN then generates the proper
;returning instruction whenever it is used in that procedure. Finally,
;procedures should be declared inside of a BEGIN - ENDB block, with the PROCEDURE
;macro indented 2 spaces from the local left margin, and RETURN indented with
;the surrounding code. An example is:
;
;BEGIN
; PROCEDURE (PUSHJ P,DOTHIS)
; PUSHJ P,DOTHAT
; <code to do THIS>
; RETURN
;ENDB;
;IF, THEN, ELSE And FI.
;
;These macros implement the common IF statement construct. Between the IF and
;THEN macros should be the code to determine which case is true. Control should
;fall through to the THEN if the condition is true. Control should fall into the
;ELSE (or FI if no ELSE segment) or pass to the label $T ($F if no ELSE segment)
;if the condition is false. The THEN code segment should end by transfering
;control to the FI or the label $F. Each of these macros should be indented 2
;spaces from the local left margin, and the IFs may be nested up to a depth of
;7. Some examples are:
;
; IF WE CAN DO IT IF WE CAN DO THIS IF WE WANT ONE
; <code to tell> <code to tell> MOVE T1,NUMBER
; JRST $F JRST $T CAIN T1,1
; THEN DO IT THEN DO THIS THEN GET IT
; <code to do it> <code to do THIS> SKIPA T1,['ONE ']
; FI; JRST $F ELSE GET TWO
; ELSE DO THAT MOVE T1,['TWO ']
; <code to do THAT> FI;
; FI;
;
;CASE And ESAC.
;
;These macros define the range of a selecting statement. Each code segment
;should have a local label at its beginning, and an indexed JRST is then used to
;transfer control to the correct code segment. Each segment should transfer
;control to the label $C, or, for the last segment, fall through to the ESAC.
;The CASE, ESAC and the local labels should all be indented 2 spaces from the
;local left margin. One example is:
;
; CASE DEVICE TYPE OF (.TYDSK, .TYMTA, .TYTTY)
; MOVE T1,DEVICE
; DEVTYP T1,
; JRST ERROR
; LDB T1,[POINTR T1,TY.DEV]
; CAILE T1,.TYTTY ;RANGE CHECK
; JRST $C ;OUT OF RANGE
; JRST @[IFIWS <$1,$C,$2,$3>](T1)
;
; $1% <handle DSK:>
; JRST $C
;
; $2% <handle MTA:>
; JRST $C
;
; $3% <handle TTY:>
;; JRST $C
;
;ESAC;
;WHILE, UNTIL And FOR.
;
;These are null macros used in conjunction with BEGIN and ENDB to better indicate
;the operation of loops. If used, they should be indented two spaces from the
;local left margin. An example:
;
; WHILE MORE TO DO
; BEGIN
; JUMPE T1,$E
; <do some more>
; SOJA T1,$B
; ENDB;
SUBTTL DEFINITIONS -- Structure Macros -- BEGIN, PROCEDURE, RETURN, ENDB
DEFINE BEGIN<
IFG $.NST-9,<PRINTX ? BEGIN-END nesting too deep>
$PRNST (\$.PNST,<BEGIN>)
$.PNST=$.PNST+1
..R..==..R.._3+..R..&7
..E..==..E.._3
$.NST==$.NST+1
$INITIAL \<$.NST>
$.LAB=$.LAB_4
>
DEFINE PROCEDURE (HOW,WHERE)<
$PRNST (\$.PNST,<PROCEDURE WHERE>)
IRP WHERE,<WHERE:>
IFE <<HOW>-<PUSHJ P>>,<..R..==..R..&<^-7>+1> ;;[365] ALLOW EITHER SPACES
IFE <<HOW>-<JSP P4>>,<..R..==..R..&<^-7>+2> ;;[365] OR TABS AS
IFE <<HOW>-<JSP T4>>,<..R..==..R..&<^-7>+3> ;;[365] SEPARATORS
>
DEFINE RETURN<
IFE ..R..&7,<PRINTX ? Illegal RETURN code>
IFE ..R..&7-1,<POPJ P,>
IFE ..R..&7-2,<JRST (P4)> ;;[OK]
IFE ..R..&7-3,<JRST (T4)> ;;[OK]
>
DEFINE ENDB<
IF2,< ZZ==1
REPEAT <$.LAB&17>,<
$REMOVE %,\<$.NST>,\<$.ORG+ZZ>
ZZ==ZZ+1
>
>
$UPDATE \<$.NST>
$.LAB==$.LAB_-4
..R..==..R.._-3
IFN ..E..&7,<
$LABEL E,\<$.NST>,\<$.END+1>
>
..E..==..E.._-3
IFL $.NST,<PRINTX ? BEGIN-END nesting underflow>
$.PNST=$.PNST-1
$PRNST (\$.PNST,<ENDB>)
$.NST==$.NST-1
IFGE $.NST,<
$REINIT \<$.NST>
>
>
DEFINE $REMOVE (J,K,L)<
PURGE J'K'L
>
SUBTTL DEFINITIONS -- Structure Macros -- IF, THEN, ELSE, FI, CASE, ESAC
DEFINE IF<
IFG $.INST-5,<PRINTX ? IF nesting too deep>
$PRNST (\$.PNST,<IF>)
$.PNST=$.PNST+1
$.INST==$.INST+1
..F..==..F.._3
..T..==..T.._3
$IFINITIAL \<$.INST>
REMARK>
DEFINE THEN<
$.PNST=$.PNST-1
$PRNST (\$.PNST,<THEN>)
$.PNST=$.PNST+1
REMARK>
DEFINE ELSE<
$.PNST=$.PNST-1
$PRNST (\$.PNST,<ELSE>)
$.PNST=$.PNST+1
IFN ..T..&7,<
$.THN==$.THN+1
$LABEL T,\<$.INST>,\<$.THN>
$THNUPDATE \<$.INST>
>
REMARK>
DEFINE FI<
IFN ..F..&7,<
$.IF==$.IF+1
$LABEL F,\<$.INST>,\<$.IF>
$IFUPDATE \<$.INST>
>
..F..==..F.._-3
..T..==..T.._-3
IFL $.INST,<PRINTX ? IF nesting underflow>
$.PNST=$.PNST-1
$PRNST (\$.PNST,<FI>)
$.INST==$.INST-1
IFGE $.INST,<
$IFINITIAL \<$.INST>
>>
DEFINE CASE<
IFGE $.CNST-9<PRINTX ? CASE nesting overflow>
$PRNST (\$.PNST,<CASE>)
$.PNST=$.PNST+1
$.CNST==$.CNST+1
$CASEINITIAL \<$.CNST>
REMARK>
DEFINE ESAC<
$.CASE==$.CASE+1
$LABEL C,\<$.CNST>,\<$.CASE>
IF2,<$REMOVE C,\<$.CNST>,\<$.CASE>>
$CASEUPDATE \<$.CNST>
IFL $.CNST,<PRINTX ? CASE nesting underflow>
$.PNST=$.PNST-1
$PRNST (\$.PNST,<ESAC>)
$.CNST==$.CNST-1
$CASEINITIAL \<$.CNST>
REMARK>
SUBTTL DEFINITIONS -- Structure Macros -- WHILE, UNTIL, FOR, Debugging Macro
DEFINE WHILE<REMARK>
DEFINE UNTIL<REMARK>
DEFINE FOR<REMARK>
.XCREF ;[373] KEEP $PRNST OUT OF CREF
IFE FTPRINT,<
DEFINE $PRNST<REMARK> ;;[373] DO NOTHING IF NOT REQUESTED
>
IFN FTPRINT,<
DEFINE $PRNST(N,MSG)< ;;[373] PRINT CURRENT NEST LEVEL
IFL <N>,< ;;[373] RECURSION STOPS HERE
PRINTX MSG
>
IFGE <N>,< ;;[373] RECURSION ADDS INDENTATION
$PRNST (\<<N>-1>,<! MSG>) ;;[373] ..
>
>
>
.XCREF $PRNST ;[373] ALWAYS KEEP IT OUT OF CREF
.CREF ;[373]
DEFINE $PRCHK(N)< ;;[373] COMPLAIN IF NESTING LEVEL WRONG
IFN <<N>+1>,<PRINTX ? Nesting level mismatch, value = N>
>
SUBTTL DEFINITIONS -- Structure Macros -- Initialization And Temporary Labels
;DEFINE TEMPORARY LABELS. THEY EXIST ONLY BETWEEN BEGIN AND ENDB.
DEFINE $TEMPORARY(M,D)<
.XCREF ;;[373] DON'T FILL THE CREF WITH JUNK
..R..=0
..E..=0
..F..=0
..T..=0
..C..=0
$.IF=0
$.THN=0
$.END=0
$.ORG=0 ;;ORIGIN OF LABEL
$.LAB=0 ;;MAX. LABEL SPECIFIED
$.CASE=0 ;;CASE STATEMENT
$.NST=-1 ;;NESTING DEPTH
$.INST=-1 ;;IF NESTING DEPTH
$.CNST=-1 ;;[215] CASE NESTING DEPTH
$.PNST=-1 ;;[373] PROGRAM NESTING DEPTH
DEFINE $TEMP(N)<
.XCREF ;;[373]
DEFINE $'N'%<
$LABEL %,\<$.NST>,\<$.ORG+N>
IFG N-$.LAB&17,<$.LAB==$.LAB&<-1_4>+N>
>
;;DO NOT ADD CRLF'S TO THIS MACRO, OR IT WON'T WORK
DEFINE $'N<$REFERENCE %,\<$.NST>,\<$.ORG+N>>
.XCREF $'N'%,$'N ;;[373]
.CREF ;;[373]
>
DEFINE $NEST(N)<
.XCREF ;;[373]
$.ORG'N=0
$.END'N=0
$.BEG'N=0
$.IF'N=0
$.THN'N=0
$.CAS'N=0 ;;[215]
.XCREF $.ORG'N,$.END'N,$.BEG'N,$.IF'N,$.THN'N,$.CAS'N ;[373]
.CREF ;;[373]
>
ZZ=0
REPEAT M,<
ZZ=ZZ+1
$TEMP \ZZ
>
ZZ=0
REPEAT D,<
$NEST \ZZ
ZZ=ZZ+1
>
PURGE ZZ
DEFINE $INITIAL(N)<
$.ORG=$.ORG'N
$.END=$.END'N
$.BEG'N=.
>
DEFINE $REINIT(N)<
$.ORG=$.ORG'N
$.END=$.END'N
>
DEFINE $UPDATE(N)<
$.ORG'N=$.ORG'N+$.LAB&17
IFN ..E..&7,<
$.END'N=$.END'N+1
>
>
DEFINE $IFINITIAL(N)<
$.IF=$.IF'N
$.THN=$.THN'N
>
DEFINE $IFUPDATE(N)<
$.IF'N=$.IF'N+1
>
DEFINE $THNUPDATE(N)<
$.THN'N=$.THN'N+1
>
DEFINE $CASEINITIAL(N)<
$.CASE=$.CAS'N
>
DEFINE $CASEUPDATE(N)<
$.CAS'N=$.CAS'N+1
>
DEFINE $LABEL(J,K,L)<
.XCREF ;;[373] KEEP HIDDEN LOCAL LABELS OUT OF CREF
IF1,<PURGE J'K'L>;;BUG IN MACRO 50
J'K'L:!
.XCREF J'K'L ;;[373] KEEP THESE OUT OF THE CREF
.CREF ;;[373]
>
;;DO NOT ADD CRLF'S TO THIS MACRO OR IT WILL NOT WORK.
DEFINE $REFERENCE(J,K,L)<J'K'L>
.XCREF ..R..,..E..,..F..,..T..,..C..,$.IF,$.THN,$.END,$.ORG,$.LAB,$.CASE,$.NST
.XCREF $.INST,$.CNST,$.PNST,$TEMP,$NEST,$INITIAL,$REINIT,$UPDATE,$IFINITIAL
.XCREF $IFUPDATE,$THNUPDATE,$CASEINITIAL,$CASEUPDATE,$LABEL,$REFERENCE
.CREF
>
DEFINE $B,<$BEG \<$.NST>>
DEFINE $BEG (N)<$.BEG'N>
DEFINE $E,<$REFERENCE E,\<$.NST>,\<$.END+1>
..E..==..E..!1
>
DEFINE $F,<$REFERENCE F,\<$.INST>,\<$.IF+1>
..F..==..F..!1
>
DEFINE $T,<$REFERENCE T,\<$.INST>,\<$.THN+1>
..T..==..T..!1
>
;DO NOT ADD CRLF'S TO THIS MACRO, OR IT WON'T WORK
DEFINE $C,<$REFERENCE C,\<$.CNST>,\<$.CASE+1>>
DEFINE $PURGE,<
$PRCHK \$.PNST ;;[373] MAKE SURE NESTING MATCHES
PURGE ...SQB,..R..,..E..,..F..,..T..,..C..,ZZ
PURGE $.LAB,$.NST,$.END,$.IF,$.THN,$.INST,$.ORG,$.CASE,$.CNST,$.PNST
PURGE $.BEG0,$.BEG1,$.BEG2,$.BEG3,$.BEG4,$.BEG5,$.BEG6,$.BEG7,$.BEG8,$.BEG9
PURGE $.CAS0,$.CAS1,$.CAS2,$.CAS3,$.CAS4,$.CAS5,$.CAS6,$.CAS7,$.CAS8,$.CAS9
PURGE $.END0,$.END1,$.END2,$.END3,$.END4,$.END5,$.END6,$.END7,$.END8,$.END9
PURGE $.IF0,$.IF1,$.IF2,$.IF3,$.IF4,$.IF5,$.IF6,$.IF7,$.IF8,$.IF9
PURGE $.ORG0,$.ORG1,$.ORG2,$.ORG3,$.ORG4,$.ORG5,$.ORG6,$.ORG7,$.ORG8,$.ORG9
PURGE $.THN0,$.THN1,$.THN2,$.THN3,$.THN4,$.THN5,$.THN6,$.THN7,$.THN8,$.THN9
>
;NOW GENERATE THEM MAX = 10 FOR NOW
RADIX 10
$TEMPORARY (10,10)
RADIX 8
DEFINE ENDMODULE,<
$PURGE
END
>
;IFN FTOPS20, ENDMODULE
END