DataMuseum.dk

top - download

    Length: 3712 (0xe80)
    Types: TextFile
    Names: »SUBRDEMO.MAC«

└─⟦539d5b860⟧ Bits:30004106 SuperSort vers. 1.60
    └─ ⟦this⟧ »SUBRDEMO.MAC« 

TextFile

;SUBRDEMO.MAC  9/11/78   A MAIN PROGRAM THAT USES SUPER-SORT SUBROUTINE
;     REVISED  3/04/79   (CHANGES IN COMMENTS ONLY)
;
;TO LOAD:	L80 SUBRDEMO,SORLIB/S/E
;
WORLEN	EQU	4000	;WORK AREA ARRAY LENGTH
BOOT	EQU	0	;WHERE TO GO TO EXIT TO SYSTEM
BDOS	EQU	6	;SYSTEM ENTRY POINT = TOP OF TPA = A PLACE TO PUT STACK
;
	EXT SORSUB	;SORT SUBROUTINE
	EXT SORMSG	;PRINT ERROR MESSAGE FOR SORT, IF ANY
	EXT INLMSG	;TYPE FOLLOWING TEXT TO NULL OR THRU CHAR WITH HI ORDER
			;BIT ON (THIS SUBR IS IN SORLIB)
;
	CSEG
;
GO: ;SET STACK POINTER
	LHLD BDOS
	SPHL		;USE TOP OF TRANSIENT PROGRAM AREA AS STACK
    ;SIGN ON
	CALL INLMSG	;SUBR TYPES FOLLOWING TEXT
  DB 'THIS PROGRAM USES THE SUPERSORT SUBROUTINE TO SORT FILE A,',X'0D',X'0A'
  DB 'MERGE IT WITH FILES B AND C, AND PUT THE RESULT ON FILE D.DAT,'
  DB X'0D',X'0A','USING FIELD #1, RIGHT-ADJUSTED, AS THE KEY',X'0D',X'8A'
    ;CALL SORT SUBROUTINE - SORSUB (PARAMS, WORK, LENGTH, STATUS, COLTAB)
    ;WHERE ARGUMENTS ARE PASSED PER FORTRAN CONVENTIONS
	LXI H,SORPAR	;HL POINTS PARAM ARRAY: FIRST ARG
	LXI D,WORK	;DE POINTS WORK AREA: SECOND ARGUMENT
	LXI B,PTRBLK	;BC POINTS TO POINTERS TO ADDITIONAL ARGUMENTS
	CALL SORSUB	;DO THE SORT, RETURN ERROR CODE IN A AND HL, FLAGS SET
	;AT THIS POINT COULD JNZ TO AN ERROR ROUTINE, IF DESIRED
	CALL SORMSG	;PRINT ERROR MESSAGE, INCLUDING FILE NAMES, ETC, OR
			;PRINT NOTHING IF NO ERROR (SORT SUBR PRINTED "SORT
			;COMPLETE" IF SUCCESSFUL
	JMP BOOT	;EXIT PROGRAM, REBOOTING SYSTEM AND RETURNING TO CCP

	PAGE
;
;BLOCK OF POINTERS TO SORT SUBROUTINE ARGUMENTS 3, 4, AND 5
PTRBLK:	DW KWLEN	;POINTER TO WORK AREA LENGTH: THIRD ARGUMENT
	DW SSTAT	;POINTER TO PLACE FOR SORT TO RETURN STATUS: 4TH ARG
	;POINTER TO COLATING SEQUENCE TABLE: 5TH ARG: WOULD GO HERE IF USED
;
KWLEN:	DW WORLEN	;SORT WORK AREA LENGTH (THIRD ARG)
SSTAT:	DS 2		;PLACE FOR SORT TO RETURN STATUS (FOURTH ARG). NOTE:
			;SSTAT ISN'T REFERENCED IN THIS PROGRAM, SINCE STATUS
			;IS ALSO RETURNED IN REGISTERS, BUT IT IS DEFINED
			;BECUASE SORT STORES IN ANYWAY.
;
;WORK AREA ARRAY (SECOND ARGUMENT TO SORT SUBROUTINE)
WORK:	DS WORLEN	;LENGTH SET BY EQUATE AT BEGINNING OF PROGRAM

	PAGE
;
;SORT SUBROUTINE PARAMETER ARRAY (FIRST ARGUMENT TO SORT SUBROUTINE)
SORPAR:
    ;FIXED POSITION PARAMETERS
	DW 80		;INPUT FILE RECORD LENGTH
	DW 0		;OUTPUT FILE RECORD LENGTH: 0 MEANS SAME AS INPUT
	DW 0,0		;UNUSED (RESERVED)
	DB 1,0		;INPUT FILE CR-DELIMITED, NO EOF OPTIONS.
	DB 0,'D       DAT'	;OUTPUT FILE: CURRENT DRIVE, NAME "D.DAT"
	DW 0		;NO OUTPUT DISKETTE CHANGE (X'8000' TO CHANGE DISKETTE)
	DB 1,0		;OUTPUT FILE CR-DELIMITED, NO SPECIAL EOF OPTIONS
	DB 0		;PUT WORK FILE ON CURRENT DRIVE 
	DB 0,0,0	;NOT R-OUTPUT, NOT KR-OUTPUT, NOT TAGSORT
	DB 0		;UNUSED (RESERVED, SHOULD BE 0)
	DB 0,0,0	;NOT K-OUTPUT, NOT KP-OUTPUT, NOT P-OUTPUT
	DB 0,0		;NO XIT1, XIT2 ROUTINES
	DB 2		;PRINT LEVEL 2
	DB 0		;UNUSED (RESERVED)
    ;SORT INPUT FILES
	DW 1		;NUMBER OF FILES
	DB 0,'A          '	;NAME A, BLANK TYPE, CURRENT DRIVE
	DW 0		;RESERVED, SHOULD BE 0
	DW 0,0		;START, END RECORD: DO ENTIRE FILE
	DW -1		;ENDS INPUT FILES
    ;MERGE-ONLY INPUT FILES, IN SIMILAR FORMAT
	DW 2
	DB 0,'B          '
	DW 0,0,0	;UNUSED (RESERVED)
	DB 0,'C          '
	DW 0,0,0
	DW -1
    ;KEY FIELDS
	DW 1		;ONLY 1 KEY (OF A POSSIBLE 32)
	DW 1		;FIELD 1
	DW 20		;MAX LENGTH
	DW X'41'	;FLAG BIT 6 SAYS RIGHT-JUSTIFY, FLAG BIT 0..
			;.. INDICATES COMMA-DELIMITED-FIELD, NOT COLUMNAR FIELD
	DW -1		;TERMINATES KEYS
    ;RECORD SELECT INFO
	DW 0		;SAY NO SELECT CRITERIA
	DW -1		;TERMINATE SELECT INFO
;
	END GO		;START ADDRESS
«eof»