ftp.barnyard.co.uk

home *** CD-ROM | disk | FTP | other *** search

/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / PROGRAMS / SORT / BSORT.LBR / BSORT.AQM / BSORT.ASM

Wrap

Assembly Source File | 2000-06-30 | 40KB | 2,057 lines

;Array exchange sort in place in memory. ;Copyright 1979,1980,1981 by C. E. Duncan. Written 1979 June 30. ;Taken from an original program written by E. W. Dijkstra on ; the back of my business card at the international meeting ; on software reliability at Los Angeles in 1975. ;Permission granted to copy for any non-commercial use. ;Revised 17:55 1981 February 10. ; ;This program, BSORT, is called as a CP/M .COM routine as follows: ; ; BSORT <input file name> <output file name> ; ; where file names are "[d:]name.typ" as usual in CP/M. ; The user will be asked for record length and sort parameters ; through a console dialog. ; PAGE 0 ;defeats CP/M page count ORG 0100H ;program origin BSORT: ; ;Set internal stacks LXI H,BSTACK ;bounds stack SHLD BSAVE LXI H,PSTACK ;program stack SHLD PSAVE SPHL ;Initialize CALL INIT1 ;Save default disk MVI C,RTCDK ;return current disk number CALL BDOS STA CDSKSAV ;Set default disk to input file LDA SFDN ;input file disk number MOV E,A CALL ASGDSK ;Read file and check further CALL INIT2 ;Do the sort CALL PARTIT ;Assign output disk as default LDA DFDN MOV E,A CALL ASGDSK ;Write output file CALL WRTARY ;Close output LXI D,DFCB MVI C,CLOSE CALL BDOS ;Restore default disk LDA CDSKSAV MOV E,A CALL ASGDSK JMP QUIT ;return to CP/M-CCP ; ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * INIT1: ;Initialize variables, read parameters, check values. ;Revised 20:10 1981 January 26. ; ;Move output file name to output FCB. MVI A,12 ;character count LXI D,SFDA ;from LXI H,DFDN ;to CALL SMOVE ;Set current (next) record pointer to 0. XRA A STA SFCR ;input STA DFCR ;output STA DFEX ;file extent STA ABRTF ;abort flags STA STLV ;bounds stack level ;Check input file name LXI D,SFCB ;input FCB CALL CHKFN JNC OK01 LXI H,ABRTF ;set abort flag INR M LXI D,FNIMSG CALL PUTMSG OK01: ; Check output file name LXI D,DFCB ;output FCB CALL CHKFN JNC OK02 LXI H,ABRTF ;set abort flag INR M LXI D,FNOMSG CALL PUTMSG ; OK02: ;Abort if these names do not check LDA ABRTF ORA A JNZ ABORT ; Calculate storage available LXI H,AR ;array base address SHLD ARBASE XCHG ;to DE LHLD BDOS+1 ;BDOS base CALL DIFF2 ;subtract DCR H ;make room for temporary storage SHLD MARSIZ ;available memory ; Check size of input file MVI A,03FH ; "?" to insure match of STA SFEX ; all extents LXI H,0 ; Reset sector count SHLD FSCNT LXI D,SBUF ; Prepare a buffer for MVI C,STDMAAD ; directory information CALL BDOS MVI C,SRCHFST ; Bring in directory for first LXI D,SFCB ; extent. Returns 0,1,2 or 3 CALL BDOS ; in 2.2, 0-3F in 1.4 CPI 0FFH JNZ OK03 LXI D,FNPMSG ; not found so quit CALL PUTMSG JMP ABORT OK03: ANI 3 ; MOD 4 (needed by CP/M 1.4 only) ;Address directory entry (one of four in buffer), then ; get sector count. 32 bytes per entry. ADD A ; *2 ADD A ; *4 ADD A ; *8 ADD A ; *16 ADD A ; *32 MVI D,15 ; plus offset to count byte ADD D MOV E,A ; add buffer base address MVI D,0 LXI H,SBUF DAD D MOV A,M ; sector count MOV E,A LHLD FSCNT ; accumulate DAD D SHLD FSCNT CPI 080H ; Full track? JNZ OK04 ; no, go on MVI C,SRCHNXT ; Get information on LXI D,SFCB ; next extent CALL BDOS CPI 0FFH ; No more entries when FF hex JNZ OK03 ; Get next entry OK04: XRA A ; Reset extent byte STA SFEX ; to zero ; Deduce input file size LHLD FSCNT ; number of sectors MOV A,H ; check for empty ORA L JZ ABORT ; nothing here ;Multiply by 128 bytes per sector DAD H ; *2 JC OK05 DAD H ; *4 JC OK05 DAD H ; *8 JC OK05 DAD H ; *16 JC OK05 DAD H ; *32 JC OK05 DAD H ; *64 JC OK05 DAD H ; *128 JNC OK06 OK05: LXI D,MULMSG ; multiply error CALL PUTMSG JMP ABORT OK06: ; Last sector may have less than 128 bytes, will check later SHLD BYIF ; Check that there is enough memory XCHG LHLD MARSIZ ;memory available CALL DIFF2 ORA A JP OK07 LXI D,FSZMSG ; report file larger than memory CALL PUTMSG JMP ABORT OK07: ;Calculate address of temporary record storage area LHLD BYIF LXI D,AR DAD D SHLD AWTP ; Open input file MVI C,OPEN LXI D,SFCB CALL BDOS INR A JNZ OK08 LXI D,FNPMSG ; file not present CALL PUTMSG JMP ABORT ;Open output file OK08: MVI C,DELETE ;delete file of same name LXI D,DFCB CALL BDOS MVI C,CREATE ;make new file LXI D,DFCB CALL BDOS INR A JNZ OK09 LXI D,NDSMSG ; signal no directory space CALL PUTMSG JMP ABORT OK09: ; Ask for record length LXI D,RCLMSG CALL PUTMSG CALL READCON ;read console input LXI D,CONSIZ ;string response LXI B,AR ;temporary buffer CALL SCANBR ;extract number JC OK09 ;try again LDAX B ;count INX B ;1st character CALL ROW1NBR ;convert to binary JC OK09 ;trouble MOV A,L STA RLEN ; calculate twos complement CMA INR A STA MRLEN OK10: ; Ask for sort parameters. XRA A ; reset parameter count STA NBRFND LXI D,PARMSG CALL PUTMSG CALL READCON ;read console input LDA CONSIZ ;number of characters read ORA A JZ OK10 ;no input, try again CALL RDPARM ;read, convert and store sort parms JC OK10 ;try again CALL CKPARM ;check parameters JC OK10 ;ask again RET ;end of INIT1 ; ;* * * * * * * * * * * * * * * * * * * * * * * * * * * ; INIT2: ;Read input file to array, correct file size, final checks. ;Written by C. E. Duncan 1979 June 30. ;Revised 08:15 1981 February 4. ; Read input file to array CALL RDARRAY ; Check and possibly correct file size calculation BYIF ; HL points to byte after last sector read. LDA SFS1 ; bytes remain in last sector ORA A JNZ OK12 MVI A,01AH ; must remove eof (1A) bytes LXI B,0 ; clear counter OK11: DCX H ; char in file CMP M ; is it EOF? JNZ OK13 ; no INX B ; count JMP OK11 OK12: CMA ; subtract off eofs MOV C,A MVI B,0FFH ; minus sign JMP OK14 OK13: MOV A,B ; get twos complement CMA ; to subtract MOV B,A MOV A,C CMA ; subtract off unused bytes MOV C,A OK14: INX B ; twos complement LHLD BYIF DAD B ; subtract SHLD BYIF ; Check that file size is multiple of record length ; and calculate upper and lower bounds MOV A,H ; check that there is a record ORA L JZ ABORT ; nothing here LDA RLEN CALL DIV12 JNC OK15 LXI D,DIVMSG CALL PUTMSG JMP ABORT OK15: MOV A,L ; check remainder CMP H JZ OK16 LXI D,RLMSG ;abort msg CALL PUTMSG JMP ABORT OK16: MOV H,B ; store quotient MOV L,C ; as UPB SHLD AUPB SHLD CUPB LXI H,1 ; LWB = 1 SHLD ALWB SHLD CLWB ;Initialize array index calculation ; A[I] has address = ARRAY BASE - (LWB A)*RLEN + I*RLEN ; = ARIF + I*RLEN ; LHLD ALWB ;LWB of A XCHG ; to DE LDA RLEN CALL MUL12 JC ABORT ;overflow XCHG LHLD ARBASE ; calculate HL - DE CALL DIFF2 ORA A ; check sign JP OK17 ; positive, ok MOV A,H ; complement if negative CMA MOV H,A MOV A,L CMA MOV L,A INX H OK17: SHLD ARIF ;Addresses of sort strings in temporary area LHLD AWTP ; temporary record store LDA POOF1 ; 1st sort offset MVI B,0 MOV C,A DAD B SHLD KWTP1 ; address of awtp[m:n] LDA PARM3 ; is there a 2nd sort? ORA A RZ LDA POOF2 ; 2nd sort offset MOV C,A LHLD AWTP DAD B SHLD KWTP2 ; address of awtp[u:v] RET ; ;* * * * * * * * * * * * * * * * * * * * * * * * * * * ; PARTIT: ;Partition sort based on a program by Dijkstra. ;Written by C. E. Duncan 1979 June 30. ;Revised 17:30 1981 February 8. ; ; p = LWB a, q = UPB a ; ;Algorithm: partition and sort until q < p ; WHILE p <= q ; DO ; IF q = p ; THEN ; unstack ; ELSE ; IF q - p <= slim ; THEN ; shorts {insertion sort} ; ELSE ; parta {partition left} ; {makes two partitions: a[p] to a[s] and a[r] to a[q]} ; FI ; FI; ; IF s = p ; THEN ; p := r ; ELSE ; IF s < p ; THEN ; partb {partition right} ; {required if parta has no "small" element} ; ELSE ; IF q = r ; THEN ; q := s ; ELSE ; IF q < r ; THEN ; unstack ; ELSE ; IF q - r > s - p ; THEN ; stack right; ; q := s ; ELSE ; stack left; ; p := r ; FI ; FI ; FI ; FI ; FI ; OD ; LHLD CLWB ; P = LWB current partition XCHG LHLD CUPB ; Q = UPB current partition CALL DIFF2 ; compare ORA A RM ;sort complete when Q < P JZ UNSTACK ; only one element XCHG LXI H,SLIM ;low size limit CALL DIFF2 ;SLIM - (P - Q) ORA A PUSH PSW CP SHORTS ;use insertion sort, small partition POP PSW JP UNSTACK ;this partition completed CM PARTA ;partition leftward ; Check size of lower partition STAR01: LHLD CLWB ; P = LWB left XCHG LHLD PS ; S = UPB left CALL DIFF2 ; S - P ORA A JZ STAR02 ; only one element, finished JM STAR04 ; no small element SHLD SMP ; Upper partition. LHLD PR ; R = LWB right XCHG LHLD CUPB ; Q = UPB right CALL DIFF2 ; Q - R ORA A JZ STAR03 ; only one element, finished JM UNSTACK ; finished with this partition ; because no large element after ; having no small element. SHLD QMR ; Save bounds of larger partition. ; If Q - R > S - P then upper part is larger. LXI H,0 ; save program stack DAD SP SHLD PSAVE LHLD BSAVE ; retrieve bounds stack SPHL ; LHLD QMR ; Q - R XCHG LHLD SMP ; S - P CALL DIFF2 ; (S-P) - (Q-R) ORA A JM STHI ; stack bunds for high side STLO: LHLD CLWB ; P, new lower bound PUSH H LHLD NUBL ; S, new upper bound PUSH H LHLD NLBH ; R, set new LWB for high side SHLD CLWB JMP REST ; restore program stack STHI: LHLD NLBH ; R, new lower bound PUSH H LHLD CUPB ; Q, new upper bound PUSH H LHLD NUBL ; S, new upper bouond for low side SHLD CUPB REST: LXI H,0 ; restore program stack DAD SP SHLD BSAVE LHLD PSAVE SPHL LXI H,STLV ; increment stack level INR M JMP PARTIT ; process next partition ; ; Process upper part STAR02: LHLD PR ; R is new lower bound SHLD CLWB ; JMP PARTIT ; STAR03: ; Process lower part LHLD PS ; S is new upper bound SHLD CUPB ; JMP PARTIT ; STAR04: ; Partition again, using R <= T and S > T in place of ; R < T and S >= T respectively. CALL PARTB ; JMP STAR01 ; ; UNSTACK: ; Recover bounds of next section to be partitioned LXI H,STLV ; check level DCR M ; RM ; stack empty, sort completed LXI H,0 ; save program stack DAD SP ; SHLD PSAVE ; LHLD BSAVE ; get bounds stack SPHL ; POP H ; SHLD CUPB ; UPB POP H ; SHLD CLWB ; LWB LXI H,0 ; restore program stack DAD SP ; SHLD BSAVE ; LHLD PSAVE ; SPHL ; JMP PARTIT ; return, do next section ; PARTA: ;Re-arrange array AR into two partitions the left of which contains ; elements which precede a pivot element, and the right contains ; those which do not. ;Written by C. E. Duncan 1979 June 30. ;Revised 15:06 1981 January 31. ; ; R = LWB A, S = UPB A, T = (R+S) OVER 2. ; ;Algorithm: ; WHILE LWB A <= R < S <= UPB A ; DO ; SWAP A[R] and A[S]; ; WHILE A[R] precedes A[T] ; DO ; R +:= 1 ; OD; ; WHILE A[S] does not precede A[T] ; DO ; S -:= 1 ; OD ; OD ; ;Calculate addresses LDA POOF1 ; 1st sort parameter offset MVI B,0 MOV C,A LHLD CLWB ; current LWB SHLD PR ; R XCHG CALL INDXR ; calculate address SHLD ACR ; .A[R] DAD B SHLD AQR1 ; .A[R][M:N], 1st sort string LHLD CUPB ; current LWB SHLD PS ; S XCHG CALL INDXR SHLD ACS ; .A[S] DAD B SHLD AQS1 ; .A[S][M:N] LHLD PR ; R XCHG LHLD PS ; S DAD D ; R + S CALL SHRHL ; divide by 2 XCHG CALL INDXR ; .A[T] XCHG ; move A[T], the pivot element, to LHLD AWTP ; a safe place LDA RLEN CALL SMOVE ; Take care of possible 2nd sort substring LDA PARM3 ORA A JZ PAR01 ;not needed LDA POOF2 ;2nd ss offset MVI B,0 MOV C,A LHLD ACR ; .A[R] DAD B SHLD AQR2 ; .A[R][V:W] LHLD ACS DAD B SHLD AQS2 ; .A[S][V:W] PAR01: ;Check if finished LHLD PS ; S XCHG LHLD PR ; R CALL DIFF2 ; R - S ORA A JP PAR03 ; finished ; Update addresses of A[R] and A[S] LHLD PR ; R XCHG CALL INDXR SHLD ACR ; .A[R] LHLD PS ; S XCHG CALL INDXR SHLD ACS ; .A[S] ; Swap LDA RLEN LHLD ACR ; .A[R] XCHG LHLD ACS ; .A[S] CALL SWAP ; While A[R] precedes A[T], etc. LHLD AQR1 ; .A[R][M:N] XCHG PAR01A: LDA SPL1 ;1st sort length LHLD KWTP1 ; .A[T][M:N] XCHG CALL CMPSRW ORA A JZ PAR04 ; check 2nd sort substring PAR01B: PUSH PSW LDA SSEQ1 ; check direction ORA A JZ PAR01C ; ascending POP PSW ; descending JZ PAR02 JP PAR01D ; A[R] precedes A[T], down JMP PAR02 PAR01C: POP PSW JP PAR02 ; A[R] does not precede A[T], up PAR01D: LHLD PR ; increment R INX H SHLD PR LDA RLEN MVI B,0 MOV C,A LDA PARM3 ;2nd sort? ORA A JZ PAR01E ;no LHLD AQR2 ;update .A[R][V:W], 2nd sort string DAD B SHLD AQR2 PAR01E: LHLD AQR1 ;update .A[R][M:N] 1st sort DAD B SHLD AQR1 XCHG JMP PAR01A PAR02: ; While A[S] does not precede A[T] etc. LHLD AQS1 ; .A[S][M:N] XCHG PAR02A: LDA SPL1 ; length of 1st sort LHLD KWTP1 ; 1st sort string address XCHG CALL CMPSRW ORA A JZ PAR05 ; check 2nd sort PAR02B: PUSH PSW LDA SSEQ1 ; check direction ORA A JZ PAR02C ; ascending POP PSW JM PAR02D JZ PAR02D JMP PAR01 ; S precedes T PAR02C: POP PSW JM PAR01 PAR02D: LHLD PS ; decrement S DCX H SHLD PS ; Check array bound at lower limit, S < LWB XCHG LHLD CLWB ; P = LWB A XCHG CALL DIFF2 ; S - P ORA A JM PAR03 ; no small element ;Update addresses for next comparison LDA MRLEN ; minus RLEN MVI B,0FFH MOV C,A LDA PARM3 ;check for 2nd sort ORA A JZ PAR02E ;no LHLD AQS2 DAD B SHLD AQS2 PAR02E: LHLD AQS1 DAD B ; reduce address by RLEN SHLD AQS1 XCHG JMP PAR02A PAR03: LHLD PR SHLD NLBH ; new LWB for right partition LHLD PS SHLD NUBL ; new UPB for left partition RET PAR04: LDA PARM3 ORA A JZ PAR01B ;no 2nd sort LHLD KWTP2 XCHG LHLD AQR2 LDA SPL2 CALL CMPSRW ORA A PUSH PSW LDA SSEQ2 ORA A JZ PAR04A ; ascending POP PSW JZ PAR02 JP PAR01D JMP PAR02 PAR04A: POP PSW JM PAR01D JMP PAR02 ; this one is out of order ; PAR05: LDA PARM3 ; is there a 2nd sort? ORA A JZ PAR02B ; no LHLD KWTP2 XCHG LHLD AQS2 LDA SPL2 CALL CMPSRW ORA A PUSH PSW LDA SSEQ2 ORA A JZ PAR05A POP PSW JZ PAR02D JM PAR02D JMP PAR01 PAR05A: POP PSW JP PAR02D JMP PAR01 ; PARTB: ;Re-arrange array A into two partitions, the right of which contains ; elements which follow a pivot element, and the left contains those ; which do not. ;Written by C. E. Duncan 1979 June 30. ;Revised 18:50 1981 February 8. ; ; R = LWB A, S = UPB A, T = (R+S) OVER 2 ; ;Algorithm: ; WHILE LWB A <= R < S <= UPB A ; DO ; SWAP A[R] and A[S]; ; WHILE A[R] does not follow A[T] ; DO ; R +:= 1 ; OD; ; WHILE A[S] follows A[T] ; DO ; S -:= 1 ; OD ; OD ; ; Calculate addresses LDA POOF1 ; 1st sort offset MVI B,0 MOV C,A LHLD CLWB ; current LWB A SHLD PR ; R XCHG CALL INDXR SHLD ACR ; .A[R] DAD B ; .A[R][M:N] SHLD AQR1 LHLD CUPB SHLD PS ; S XCHG CALL INDXR SHLD ACS ; .A[S] DAD B SHLD AQS1 ; .A[S][M:N] LHLD PR ; R XCHG LHLD PS ; S DAD D ; R+S CALL SHRHL ; shift right, OVER 2 XCHG CALL INDXR ; address of A[T] XCHG ; move A[T] to a safe place LHLD AWTP LDA RLEN CALL SMOVE ; Take care of 2nd sort substring LDA PARM3 ; is there one? ORA A JZ PAB01 ; no LDA POOF2 ; offset MVI B,0 MOV C,A LHLD ACR DAD B SHLD AQR2 ; .A[R][V:W] LHLD ACS DAD B SHLD AQS2 ; .A[S][V:W] PAB01: ; Check completion LHLD PS ; S XCHG LHLD PR ; R CALL DIFF2 ; R-S ORA A JP PAB03 ; finished ; Update addresses of A[R] and A[S] LHLD PR ; R XCHG CALL INDXR SHLD ACR ; .A[R] LHLD PS ; S XCHG CALL INDXR SHLD ACS ; .A[S] ; Swap Elements with indices R and S LDA RLEN LHLD ACR ; .A[R] XCHG LHLD ACS ; .A[S] CALL SWAP ; While A[R] does not follow A[T] increment R. LHLD AQR1 ; .A[R][M:M] XCHG PAB01A: LDA SPL1 ; length sort 1 LHLD KWTP1 ; .A[T][M:N] CALL CMPSRW ORA A JZ PAB04 ; check 2nd sort PAB01B: PUSH PSW LDA SSEQ1 ; direction ORA A JZ PAB01C POP PSW ; descending JM PAB01D JZ PAB01D JMP PAB02 PAB01C: POP PSW JM PAB02 PAB01D: LHLD PR ; R INX H SHLD PR ; Check upper bound in case no large element XCHG LHLD CUPB ; Q = UPB A CALL DIFF2 ORA A JM PAB03 ; upper limit, no large element ; Update addresses, etc. LDA RLEN MVI B,0 MOV C,A LDA PARM3 ORA A ; 2nd sort JZ PAB01E ; no LHLD AQR2 ; .A[R][V:W] DAD B SHLD AQR2 PAB01E: LHLD AQR1 DAD B SHLD AQR1 XCHG JMP PAB01A PAB02: ;While A[S] follows A[T] decrease S, etc. LHLD AQS1 ; .A[S][M:N] XCHG PAB02A: LDA SPL1 LHLD KWTP1 CALL CMPSRW ORA A JZ PAB05 ; check for 2nd sort PAB02B: PUSH PSW LDA SSEQ1 ORA A JZ PAB02C POP PSW JZ PAB01 JP PAB02D JMP PAB01 ; A[S] <= A[T] PAB02C: POP PSW JP PAB01 PAB02D: LHLD PS ; decrement S DCX H SHLD PS LDA MRLEN MVI B,0FFH MOV C,A LDA PARM3 ; 2nd sort? ORA A JZ PAB02E ; no LHLD AQS2 DAD B SHLD AQS2 PAB02E: LHLD AQS1 DAD B SHLD AQS1 XCHG JMP PAB02A ; PAB03: LHLD PR SHLD NLBH ; new LWB for right partition LHLD PS SHLD NUBL ; new UPB for left partition RET PAB04: LDA PARM3 ; 2nd sort? ORA A JZ PAB01B ; no LHLD AQR2 XCHG LHLD KWTP2 LDA SPL2 CALL CMPSRW ORA A PUSH PSW LDA SSEQ2 ORA A JZ PAB04A POP PSW JM PAB01D JZ PAB01D JMP PAB02 PAB04A: POP PSW JP PAB01D JMP PAB02 ; PAB05: LDA PARM3 ORA A JZ PAB02B LHLD AQS2 XCHG LHLD KWTP2 LDA SPL2 CALL CMPSRW ORA A PUSH PSW LDA SSEQ2 ORA A JZ PAB05A POP PSW JZ PAB01 JP PAB02D JMP PAB01 PAB05A: POP PSW JM PAB02D JMP PAB01 ; ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * ; SHORTS: ;Insertion sort for small partitions. ;Written by C. E. Duncan 1980 February 16, from Knuth volume 3 ; (Searching and Sorting) page 81. ;Revised 12:30 1981 February 8. ; ;Algorithm: ; ; FOR j FROM 2 TO UPB(a) ; DO ; IF a[j] < a[j - 1] ; THEN ; awtp := a[j]; ; FOR i FROM j - 1 BY -1 TO LWB(a) ; WHILE at < a[i] ; DO ; a[i + 1] := a[i]; ; k := i ; OD; ; a[k] := awtp ; FI ; OD ; ;Initialize indices and addresses. LHLD CLWB ;LWB of current partition SHLD PS ; j XCHG CALL INDXR SHLD ACS ; address of a[j] = a[LWB] LDA POOF1 ;1st sort offset MVI B,0 MOV C,A DAD B SHLD AQS1 ;address of a[LWB][m:n] LDA PARM3 ORA A JZ SH01 LDA POOF2 ;2nd sort offset MOV C,A LHLD ACS DAD B SHLD AQS2 ;address of a[LWB][u:v] SH01: ;Increment j, compare to UPB, set i := j - 1 LHLD PS ; j - 1 SHLD PR ; i := j - 1 INX H ; j +:= 1 SHLD PS ; j ;Check that j <= UPB XCHG LHLD CUPB ; UPB of parttion CALL DIFF2 ;UPB - j ORA A RM ;finished when J > UPB ;Update addresses LHLD ACS ;old .a[j] SHLD ACR ;new .a[i] LDA RLEN MVI B,0 MOV C,A DAD B SHLD ACS ; new a[j] ;Update sort string addresses LHLD AQS1 SHLD AQR1 ; a[i][m:n] DAD B SHLD AQS1 ; a[j][m:n] LDA PARM3 ORA A JZ SH02 LHLD AQS2 SHLD AQR2 ; a[i][u:v] DAD B SHLD AQS2 ; a[j][u:v] SH02: ;Compare a[j] with a[j - 1] = a[i] LHLD AQR1 XCHG LHLD AQS1 LDA SPL1 CALL CMPSRW ORA A JZ SH05 ; check 2nd sort SH03: PUSH PSW LDA SSEQ1 ; check direction ORA A JNZ SH04 POP PSW JM SH07 ; have to do some moves JMP SH01 ; ok where it is, go to next j SH04: POP PSW JM SH01 ; ok as is JZ SH01 ; ditto JMP SH07 SH05: ;Second compare for a[j] and a[j - 1] LDA PARM3 ORA A JZ SH03 ; no 2nd compare LHLD AQR2 XCHG LHLD AQS2 LDA SPL2 CALL CMPSRW ORA A PUSH PSW LDA SSEQ2 ORA A JNZ SH06 POP PSW JM SH07 JMP SH01 SH06: POP PSW JM SH01 JZ SH01 JMP SH07 ; SH07: ;Move a[j] to a safe place: awtp := a[j] LHLD ACS XCHG ; from LHLD AWTP ; to LDA RLEN CALL SMOVE SH08: ;Move a[i] up one place to position i + 1 LDA RLEN MVI B,0 MOV C,A LHLD ACR ; a[i] MOV D,H ; to DE, from MOV E,L DAD B ; a[i + 1] CALL SMOVE ;Decrement i, check against LWB LHLD CLWB ; LWB XCHG LHLD PR ; i DCX H ; i -:= 1 SHLD PR CALL DIFF2 ; i - LWB ORA A JM SH14 ; at LWB, hence a[LWB] := awtp ;Decrement addresses and compare again LDA MRLEN ; negative record length MVI B,0FFH MOV C,A LHLD ACR DAD B SHLD ACR ; new address of a[i] LHLD AQR1 DAD B SHLD AQR1 ; new 1st sort address LDA PARM3 ORA A JZ SH09 LHLD AQR2 DAD B SHLD AQR2 ; new 2nd sort address SH09: ;Compare awtp = a[j] with a[i] LHLD AQR1 XCHG LHLD KWTP1 LDA SPL1 CALL CMPSRW ORA A JZ SH12 SH10: PUSH PSW LDA SSEQ1 ORA A JNZ SH11 POP PSW JM SH08 ; keep trying and comparing JMP SH15 ; found place for at in a[i + 1] SH11: POP PSW JM SH15 JZ SH15 JMP SH08 ; SH12: ;Second compare for awtp = a[j] and a[i] LDA PARM3 ORA A JZ SH10 LHLD AQR2 XCHG LHLD KWTP2 LDA SPL2 CALL CMPSRW ORA A PUSH PSW LDA SSEQ2 ORA A JNZ SH13 POP PSW JM SH08 JMP SH15 SH13: POP PSW JM SH15 JZ SH15 JMP SH08 ; SH14: ;Move awtp = a[j] into slot at a[LWB] LHLD AWTP XCHG LDA RLEN LHLD ACR CALL SMOVE JMP SH01 SH15: ;Move awtp = a[j] into slot at a[i + 1] LHLD AWTP XCHG LDA RLEN MVI B,0 MOV C,A LHLD ACR DAD B CALL SMOVE JMP SH01 ; ;* * * * * * * * * * * * * * * * * * * * * * ; ABORT: ;Return to CP/M LXI D,ABMSG CALL PUTMSG JMP QUIT ; ASGDSK: ;Assign default disk for faster input and output. ; Must have desired disk number in E, and default disk number ; in location CDSKSAV. ;Written by C. E. Duncan 1981 January 28. XRA A ;get zero CMP E JNZ ASGD1 LDA CDSKSAV ;need default disk MOV E,A JMP ASGD2 ASGD1: DCR E ;A-P = 1-16 become 0-15 ASGD2: MVI C,SELDK ;select disk CALL BDOS RET ; CHAROW: ;Reset carry if character in C is present in row of character ; whose address is in DE, length in B, else set carry. ; Return position number in B. ;Written by C. E. Duncan 1981 January 23. ;Revised 09:00 1981 January 28. MOV A,B ;row length CPI 0 ;check zero length JZ CHAR2 XCHG ;row address in HL MOV A,C ;character sought MVI D,0 ;position count CHAR1: INR D ;count CMP M ;is this it? JZ CHAR3 ;yes DCR B ;count off row INX H ;next permitted JNZ CHAR1 ;more CHAR2: STC ;signal not found RET CHAR3: MOV B,D ;position number ORA A ;found, reset carry RET ; CHKFN: ; Check file name for legal characters, FCB address in DE. ; Written by C. E. Duncan 1980 February 7. ; Revised 05:30 1981 February 4. LDAX D ;drive CPI 5 ;no more than 4 drives JNC CHKFN2 ;out of limits MVI B,11 ; Number of characters to check INX D ;first character LDAX D ; must be non-blank CPI 021H ; JC CHKFN2 ; not acceptable JMP CHKFN3 ; CHKFN1: ; INX D ; next character LDAX D ; CPI 020H ; blank JC CHKFN2 ; control character CHKFN3: CPI 05BH ; [ JNC CHKFN2 ; also unacceptable DCR B ; count JNZ CHKFN1 ; return for next XRA A ; signal ok RET ; CHKFN2: ; STC ; signal presence of RET ; unacceptable character ; CKPARM: ;Check sort parameters. Each parameter one byte from PARM1. ;Written by C. E. Duncan 1981 January 21. ;Revised 13:37 1981 January 28. ; ;get parameters in registers LXI H,PARM1 ;address parameters MOV B,M INX H MOV C,M INX H MOV D,M INX H MOV E,M LDA RLEN MOV H,A ;check parameters <= RLEN MOV L,B CALL KPR ;check range of parm1 RC ;out of limits MOV L,C CALL KPR ;check parm2 RC MOV A,D ;is there a 2nd sort range? CPI 0 JZ KRR ;no MOV L,D CALL KPR ;check parm3 RC MOV L,E CALL KPR RC JMP KRR KPR: MOV A,L CPI 1 RC ;< 1 MOV A,H SUB L RET ;carry set if > RLEN KRR: ;Calculate sort string lengths and check them MOV A,C ;1st SUB B RC ;negative length INR A STA SPL1 ;length of 1st sort substring MOV L,A MOV A,H ;RLEN SUB L RC ;substring longer than record MOV A,B ;PARM1 DCR A STA POOF1 ;offset of sort substring in record MOV A,D ;PARM3 ORA A RZ ;ok return, only one substring ;Have 2nd sort substring MOV L,A MOV A,E ;PARM4 SUB L RC ;negative length INR A STA SPL2 MOV L,A MOV A,H SUB L RC ;longer than RLEN MOV A,D DCR A STA POOF2 ;offset ;Check for sort field overlap MOV A,E ;PARM4 SUB B ;PARM1 JC KRS ;ok MOV A,C ;PARM2 SUB D ;PARM3 JC KRS ;ok STC ;overlap RET KRS: XRA A ;ok, reset carry RET ; CMPSRW: ;Compare two rows of character of equal length. ;Registers DE and HL have addresses of the two rows of character, ; register A the count. Return -1, 0, +1 in register A as HL < DE, ; HL = DE, HL > DE respectively. ;Written by C. E. Duncan 1981 January 26. MOV B,A ;count INR B CMPSRWA: DCR B JZ CMPSRWEQ ;equal LDAX D CMP M JC CMPSRWGT ;HL > DE JNZ CMPSRWLT ;HL < DE INX D ;equal so far INX H JMP CMPSRWA CMPSRWGT: MVI A,1 RET CMPSRWEQ: XRA A RET CMPSRWLT: MVI A,-1 RET ; DIFF2: ;Calculate difference of integers in DE and HL. Put absolute ; difference in HL. Signal DE < HL, DE = HL, DE > HL with ; +1, 0 -1 in A. ;Written by C. E. Duncan 1980 February 18. ;Revised 13:30 1981 January 29. MOV A,D CMP H JC DIF1 ; DE < HL JNZ DIF2 ; DE > HL MOV A,E CMP L JC DIF1 ; DE < HL JNZ DIF2 ; DE > HL LXI H,0 ; DE = HL XRA A ; reset carry to signal equal RET DIF1: MVI B,1 ; signal DE < HL JMP DIF3 DIF2: MVI B,0FFH ; signal DE > HL XCHG DIF3: ; Do subtraction MOV A,L SUB E MOV L,A MOV A,H SBB D MOV H,A MOV A,B ; restore signal STC ; set carry to signal not equal RET ; DIV12: ;Divide 16 bit integer in HL by eight bit SHORT INT in A; ; return 16 bit quotient in BC, remainder in HL (L). ;20:05 10 February 1980. ORA A ;test for zero divisor JZ DIV03 ; PUSH A ;save divisor CMA ;twos complement INR A ; of divisor MOV E,A ; to DE MVI D,0FFH ;propagate negative sign LXI B,0 ;clear quotient DIV01: DAD D ;divide by subtraction JNC DIV02 ; INX B ; JMP DIV01 ; DIV02: POP A ;prepare MOV E,A ; remainder MVI D,0 ; in HL DAD D ; ORA A ;reset carry to RET ; signal ok DIV03: STC ;signal zero RET ; divisor ; GETNBR: ;Extract an ASCII number (sequence of digits) from a row of character. ; Enter with row address in DE, count in BUFCNT. Return with ; DE pointing to following characters, remaining count in BUFCNT ; and extracted number converted to binary in C. Carry set if ; unsuccessful, else reset. ;Written by C. E. Duncan 1981 January 27. ;Revised 08:00 1981 January 28. LDA BUFCNT ;get count ORA A JNZ GETN01 GETN00: STC ;signal zero length in or out RET GETN01: LXI B,AR-1 ;temporary store XCHG INR A ;count + 1 MOV D,A ; to D MVI E,0 ;output count DCX H GETN02: INX H ;next character DCR D ;count JZ GETN04 ;finished MOV A,M CPI 030H JC GETN02 ;ignore CPI 03AH JNC GETN02 ;Have found a digit GETN03: INX B ;ASCII number output STAX B INR E ;count output INX H ;address of next character DCR D ;count input JZ GETN04 ;finished MOV A,M CPI 030H JC GETN04 ;finished CPI 03AH JC GETN03 ;Windup GETN04: MOV A,D STA BUFCNT ;remaining input count PUSH H ;save current row address MOV A,E ;output count LXI B,AR ;recover output address CALL ROW1NBR ;convert ASCII number at BC to binary POP D ;recover address JC GETN00 ;problems MOV C,L RET ;binary number in C ; INDXR: ;Get address of array element with index given in DE. Return ; address of element in HL. Array base address is stored in ; location ARBASE, RLEN, the record length is less than 256. ; Address of AR[i] is given by ARIF + I*RLEN. ; Index is checked against bounds. PUSH D LHLD ALWB ;check LWB DCX H CALL DIFF2 ORA A JM IND02 ; LWB <= I IND01: LXI D,INXMSG ;report index out CALL PUTMSG ; of bounds JMP ABORT IND02: LHLD AUPB ;check UPB POP D PUSH D CALL DIFF2 ORA A JM IND01 ;abort POP D ;index ok, I <= UPB LDA RLEN CALL MUL12 JC ABORT ;overflow XCHG LHLD ARIF DAD D RET ; MU111: ;Multiply 8-bit number in E by 8-bit number in A, returning ; 8-bit number in L. Set carry for overflow, else reset. ;Written by C. E. Duncan 1981 January 24. LXI H,0 ;zero result register MVI D,0 ;for double add MVI B,8 ;bit count MU111A: DAD H ;shift HL left RAL ;same for multiplier JNC MU111B DAD D MU111B: DCR B ;count JNZ MU111A ;get next bit XRA A ;check for overflow CMP H RET ;carry set if H > 0 ; MUL12: ;Multiply 16-bit number in DE by 8-bit number in A, placing ; 16-bit result in HL. Carry set for overflow, else reset. ;Revised 22:22 1980 February 25. LXI H,0 ;clear result register MVI B,8 ;bit count MUL12A: DAD H ;shift left RAL ;same for multiplier JNC MUL12B ;this multiplier bit = 0 DAD D ;add multiplicand RC ;carry indicates overflow MUL12B: DCR B ;count bits JNZ MUL12A ;continue ORA A ;ok, reset carry RET ; PUTMSG: ; Write message to console via BDOS, address in DE PUSH D ;Save message address LXI D,CCRLF ;CR and LF MVI C,PCONBUF ; CALL BDOS ; POP D ;recover message MVI C,PCONBUF ;Signal write to console CALL BDOS ; RET ; ; RDARRAY: ;Read disk file of typed, fixed length records to array AR. ;Written by C. E. Duncan 1980 February 3. ;Revised 08:30 1981 February 4. ; Initialize LXI B,0FF80H ; -128 LXI H,AR ; array base DAD B ; PUSH H ; LXI H,0 ; Zero sector count SHLD RSCNT ; ; Read loop RDAL: ; ; Set DMA address LXI B,128 ; step pointer POP H ; DAD B ; PUSH H ; XCHG ; DMA addr in DE for BDOS MVI C,STDMAAD ; CALL BDOS ; ; Read a sector LXI D,SFCB ; Address FCB MVI C,READSEQ ; CALL BDOS ; CPI 0 ; check successful completion JNZ RD1 ; check further LHLD RSCNT ; ok, count INX H ; SHLD RSCNT ; JMP RDAL ; return for next sector RD1: CPI 1 ; JZ RD2 ; end of file JMP ABORT ; should not happen RD2: ; Read complete POP H ; Restore stack RET ; ; RDPARM: ;Read parameters from console and store in suitable form. ;Written by C. E. Duncan 1981 January 27. ;Revised 12:20 1981 January 28. LXI D,CONSIZ ;console buffer LDAX D ;count ORA A JZ RDPFIN ;no input STA BUFCNT ;count of unprocessed characters INX D ;1st character RDP1: LDAX D ;examine character ORI 020H ;convert to lower case PUSH D ;save row address MVI B,14 ;count of acceptable characters MOV C,A ;character to be tested LXI D,PRMCHRS ;list of ok characters CALL CHAROW ;is it acceptable? MOV A,C ;recover character POP D JNC RDP3 ;ok RDP2: INX D ;point to next character LXI H,BUFCNT ;update count DCR M JNZ RDP1 ;keep trying JMP RDPFIN ;no more RDP3: CPI 'a' ;ascending? JZ RDP7 ;yes, no action CPI 'd' ;descending? JNZ RDP9 ;must be a number LDA NBRFND ;which parameter? CPI 2 ;is it 3rd? JZ RDP4 ;must be 5th or 6th CPI 4 JZ RDP5 CPI 5 JZ RDP5 JMP RDP2 ;ignore RDP4: LXI H,SSEQ1 JMP RDP6 RDP5: LXI H,SSEQ2 RDP6: INR M ;set descending RDP7: LXI H,NBRFND ;update parameter count INR M JMP RDP2 ;return for more RDP8: LXI H,NBRFND ;update number of parameters found INR M LDA BUFCNT ;check for remaining characters ORA A JZ RDPFIN JMP RDP1 ;process next character RDP9: CALL GETNBR ;return binary in C, update buffer LDA NBRFND ;parameter count CPI 0 JNZ RDP10 MOV A,C STA PARM1 JMP RDP8 RDP10: CPI 1 JNZ RDP11 MOV A,C STA PARM2 JMP RDP8 RDP11: CPI 2 JNZ RDP13 RDP12: MOV A,C STA PARM3 JMP RDP8 RDP13: CPI 3 JNZ RDP14 LDA PARM3 ORA A JZ RDP12 RDP14: MOV A,C STA PARM4 JMP RDP8 RDPFIN: LDA NBRFND ;all done? CPI 2 ;at least 2 RET ;carry set if not ; READCON: ;Read console to console buffer CONBUF. LXI D,CONBUF MVI C,RCONBUF CALL BDOS RET ; ROW1NBR: ;Convert ASCII decimal row at (BC), length A, to 1-byte number ; in L. Set carry for overflow. ;Copyright 1980 by C. E. Duncan. ;Revised 12:20 1981 January 24. CPI 4 ;check size JNC RTN1A ; CPI 0 ; JNZ RTN1B ; RTN1A: STC ;signal trouble RET ; RTN1B: MOV D,A ;count MVI L,0 ;reset result register MVI E,10 ;multiplier RTN1C: MOV A,L ;multiply by 10 PUSH B ; PUSH D ; CALL MU111 ;A * E to L POP D ; POP B ; JC RTN1A ;overflow LDAX B ;next digit SUI 30H ;convert to binary JM RTN1A ;not a digit CPI 10 ; JNC RTN1A ;not a digit ADD L ; MOV L,A ; INX B ;next DCR D ;count JNZ RTN1C ;continue RET ; ; SCANBR: ;Extract an ASCII number (sequence of digits) from a string. ; Enter with address of string in DE. Leave with BC pointing ; to extracted ASCII number string, and DE pointing to remaining ; row of characters with count in A. ; String = LCCC...C. ;Written by C. E. Duncan 1981 January 23. LDAX D ;get count ORA A JNZ SCNB01 SCNB00: STC ;signal zero length in or out RET SCNB01: PUSH B ;output string origin XCHG INR A ;count + 1 MOV D,A ; to D MVI E,0 ;output count SCNB02: DCR D ;count JZ SCNB04 ;finished INX H ;next character MOV A,M CPI 030H JC SCNB02 ;ignore CPI 03AH JNC SCNB02 ;Have found a digit SCNB03: INX B ;ASCII number output STAX B INR E ;count output DCR D ;count input JZ SCNB04 ;finished INX H ;next input character MOV A,M CPI 030H JC SCNB04 ;finished CPI 03AH JNC SCNB04 ;finished JMP SCNB03 ;Windup SCNB04: POP B ;recover output origin MOV A,E ;output count ORA A ;test for zero length JZ SCNB00 STAX B MOV A,D ;input count remaining XCHG RET ;ok, carry reset ; SHRHL: ;Shift HL right one bit :=: divide HL by 2. ;Written by C. E. Duncan 1979 June 30. ANA A ;clear carry MOV A,H RAR MOV H,A MOV A,L RAR MOV L,A RET ; SMOVE: ;Non-overlapping move, left to right. ;Register A has count of bytes, < 256, DE address of source and ; HL address of destination. ;Written by C. E. Duncan 1980 February 18. ;Revised 17:30 1981 January 26. MOV B,A ;count INR B SMOVE1: DCR B RZ LDAX D MOV M,A INX D INX H JMP SMOVE1 ; SWAP: ;Exchange two rows-of-character of equal length, addresses in ; DE and HL, length in A. ;Written by C. E. Duncan 1980 February 18. ;Revised 08:40 1981 February 4. ORA A ;check length RZ ;finished MOV B,A ;count SWAP1: MOV C,M ;save byte from HL LDAX D ;move byte from MOV M,A ; DE to HL MOV A,C ;move byte from C STAX D ; (from HL) to DE INX D INX H DCR B JNZ SWAP1 RET ; WRTARY: ; Write array to disk file from AR. ; Written 1980 February 17. ; Revised 17:45 1981 January 28. ; Initialize LXI B,0FF80H ; -128 LXI H,AR ; array base DAD B ; PUSH H ; array pointer LHLD RSCNT ; sector count INX H PUSH H LXI B,128 ;DMA address increment WRAL: ; Check count of sectors remaining POP D ; get count DCX D ; count MOV A,D ORA E JNZ WR1 ; more POP H ; restore stack RET ;finished WR1: ; Set DMA address POP H LXI B,128 DAD B PUSH H PUSH D ; count XCHG MVI C,STDMAAD CALL BDOS ; Write sector LXI D,DFCB ; output FCB MVI C,WRITSEQ ; sequential write CALL BDOS CPI 0 JZ WRAL ; ok, continue ; Abort because of disk problems LXI H,ABRTF ; Abort flags MOV A,M ORI 80H MOV M,A ; write failure JMP ABORT ; quit ; ;* * * * * * * * * * * * * * * * * * * * * * * * * * * * ; ;Patch area PATCH DS 48 ; ;Equates, literals and storage for ISORT. ;Written by C. E. Duncan 1979 June 30. ;Revised 07:25 1981 February 4. ; ;Console messages ; CR: EQU 13 ;Carriage return LF: EQU 10 ;Line feed CCRLF: DB CR,LF,'$' FNIMSG: DB 'Unacceptable character in input file name.$' FNOMSG: DB 'Unacceptable character in output file name.$' FNPMSG: DB 'Input file not present.$' NDSMSG: DB 'No directory space for output file.$' RCLMSG: DB 'Enter record length: $' PARMSG: DB 'Enter sort parameters: $' ABMSG: DB 'Program discontinued.$' MULMSG: DB 'Overflow in multiply.$' DIVMSG: DB 'Divide by zero.$' RLMSG: DB 'File size not multiple of record length.$' FSZMSG: DB 'File larger than available memory.$' INXMSG: DB 'Array index out of bound.$' ; ; Storage ; PRMCHRS: DB '0123456789ad' ;permitted parameters ; ARBASE: DW 0 ;array base address RLEN: DB 0 ; record length - bytes ALWB: DW 0 ; array lower bound AUPB: DW 0 ; array upper bound CLWB: DW 0 ; current lower bound CUPB: DW 0 ; current upper bound BUFCNT: DB 0 ;characters in buffer NBRFND: DB 0 ;parameter number QMR: DW 0 ; Q - R SMP: DW 0 ; S - P PARM1: DB 0 ; sort parameters PARM2: DB 0 ; PARM3: DB 0 ; PARM4: DB 0 ; POOF1: DB 0 ;1st sort substr offset POOF2: DB 0 ;2nd sort substr offset SPL1: DB 0 ;1st sort substr length SPL2: DB 0 ;2nd sort substr length SSEQ1: DB 0 ;1st sort direction, 0=A, 1=D SSEQ2: DB 0 ;2nd sort direction AQR1: DW 0 ; .A[R][M:N] AQR2: DW 0 ; .A[R][V:W] AQS1: DW 0 ; .A[S][M:N] AQS2: DW 0 ; .A[S][V:W] NLBH: DW 0 ; new LWB for right partition NUBL: DW 0 ; new UPB for left partition ARIF: DW 0 ;Array index calculation base MARSIZ: DW 0 ; maximum available memory BYIF: DW 0 ; Total input file size - bytes ABRTF: DS 1 ;Abort flags FSCNT: DW 0 ;Sectors in input file RSCNT: DW 0 ;Sectors read count KWTP1: DW 0 ;Temporary storage, .AR[J][M:N] KWTP2: DW 0 ;Temporary storage, .AR[J][V:W] AWTP: DW 0 ; address of temp record storage PR: DW 0 ; R PS: DW 0 ; S ACR: DW 0 ; .A[R] ACS: DW 0 ; .A[S] MRLEN: DB 0 ; negative of RLEN CDSKSAV: DB 0 ;save default disk number SLIM: EQU 8 ;partition size lower limit ; DFCB: DS 36 ; output FCB DFDN: EQU DFCB+0 ; disk name DFEX: EQU DFCB+12 ; current extent DFCR: EQU DFCB+32 ; current/next/record number ; ; CONSOLE BUFFER ; CONBUF: DB CONLEN ; CONSIZ: DS 1 ;number current characters CONLIN: DS 254 ;character buffer SBUF: EQU CONSIZ ;temporary buffer for disk directory CONLEN: EQU $-CONSIZ ; ; Stack and pointers ; BSTKDP: EQU 16*4 ; PSTKDP: EQU 16*2 ; DS BSTKDP ;Bounds stack BSTACK: DW 0 ;Stack top DS PSTKDP ; program stack PSTACK: DW 0 ; base STLV: DS 1 ; current stack depth PSAVE: DW 0 ; program stack pointer BSAVE: DW 0 ; bounds stack pointer ; ; LOGICAL I/O FUNCTION EQUATES ; PCONBUF: EQU 9 ;print to console from buffer RCONBUF: EQU 10 ; read console to buffer SELDK: EQU 14 ;select disk OPEN: EQU 15 ;open disk file CLOSE: EQU 16 ;close disk file SRCHFST: EQU 17 ;search first occurrence of FCB in directory SRCHNXT: EQU 18 ;search next occurrence of FCB DELETE: EQU 19 ;delete file READSEQ: EQU 20 ;read next disk record WRITSEQ: EQU 21 ;write next disk record CREATE: EQU 22 ;create file and directory entry RTCDK EQU 25 ;return current disk number STDMAAD: EQU 26 ;set DMA address ; SFCB: EQU 05CH ;Input (default) FCB SFDN: EQU SFCB+0 ;disk number SFEX: EQU SFCB+12 ;current extent SFS1: EQU SFCB+13 ;bytes in last sector (maybe) SFDA: EQU SFCB+16 ;extent allocation vector SFCR: EQU SFCB+32 ;current/next/record number ; QUIT: EQU 0000H ;re-boot return to CPM BDOS: EQU 0005H ;DOS entry ; PROGRAM END DB 'BSORT 2-2.2 PROGRAM END' AR: DW 0 ;Base of sort array END ;