.TITLE ALPHLIST ;----------------------------------------------------------------------- ; This routine will arrange the account file of the calling [UIC] ; into alphabetic order for later listing with PIP. ; ;-------------------------------------------------------------------------- ; OUTPUT MACRO .MACRO TYPOUT ADDRESS JSR R5,TYP .WORD ADDRESS .ENDM TYPOUT .MCALL EXIT$S,FSRSZ$,FDBDF$,NMBLK$,DIR$,GET$,FDRC$R .MCALL FDOP$R,OPEN$M,CLOSE$S,PUT$R,WTSE$S,GET$R .MCALL QIO$S,OPEN$M,FDAT$R,GTSK$ ; FSRSZ$ 1 ACCFDB: FDBDF$ ; USER INDEX IN ACCOUNT [0,0] ACCFIL: .WORD 0,0 ; DEFAULT TO SY0: .WORD ACCS,ACC .WORD SIZ,NAME NAME: .ASCII /000000.DIR/ SIZ=.-NAME ACC: .ASCII /[0,0]/ ACCS=.-ACC .EVEN BEGIN: ; ; LOAD THE DEFAULT UIC (IE: CURRENT ACCOUNT) DIR$ #GETPAR ; GET TASK PARAMETERS MOVB BUF+17,R1 ; GROUP MOV #NAME,R0 ; FILE NAME BUFFER INC R2 ; ALLOW LEADING ZEROES CALL $CBTMG ; CONVERT TO ASCII MOVB BUF+16,R1 ; MEMBER INC R2 CALL $CBTMG ; OPEN THE ACCOUNT FILE IN [0,0] FDRC$R #ACCFDB,#FD.RAN,#BUF,#16. FDOP$R #ACCFDB,#3,#ACCFIL OPEN$M #ACCFDB,,,,,,ER5 10$: CLR LOOP 20$: CALL FILL ; FILL BUFFER WITH OLD DIRECTORY BCC 30$ ; CONTINUE IF CARRY CLEAR JMP EX 30$: MOV LASTRC,SIZE CALL SORT ; SORT THE RECORDS INTO ALPHABETIC ; ORDER (IN PLACE BUBBLE SORT) 40$: CALL PUT ; WRITE BACK DIRECTORY JMP EX ;----------------------------------------------------------------------- ; THIS SECTION WILL SORT THE RECORDS INTO ALPHABETIC ORDER ;------------------------------------------------------------------------- SORT: MOV #BUF,R3 ; POINT AT THE TWO BUFFERS MOV #BUF,R4 ADD #16.,R4 CLR FLAG ; CLEAR SWAP FLAG MOV LASTRC,R2 DEC R2 10$: CMP 6(R3),6(R4) ; FIRST WORD BEQ 30$ ; IF THE SAME GO ON TO NEXT BLOS 20$ ; GO TO NEXT RECORD CALL SWAP ; SWAP RECORDS IF NEEDED 20$: BR 80$ 30$: CMP 10(R3),10(R4) ; SECOND WORD BEQ 50$ BLOS 40$ CALL SWAP 40$: BR 80$ 50$: CMP 12(R3),12(R4) ; THIRD WORD BEQ 80$ BLOS 80$ CALL SWAP 80$: ADD #16.,R3 ; NEXT LINE ADD #16.,R4 SOB R2,10$ ; LOOP UNTIL FINISHED 90$: TST FLAG ; ANY SWAPS BEQ 100$ DEC SIZE ; MAXIMUM NUMBER OF LOOPS BEQ 100$ BR SORT ; GO AROUND AGAIN 100$: CLC RTS PC ; ;------------------------------------------------------------------------ ; THIS SECTION WILL WRITE BACK THE DIRECTORY ;---------------------------------------------------------------------- PUT: MOV #0,LOOP ; RESET ERROR FLAG MOV #BUF,PU+6 ; SET BUFFER ADDRESS MOV #1,REC MOV LASTRC,R4 ; # OF RECORDS PU: PUT$R #ACCFDB,#BUF,#16.,REC,,ER1 ; WRITE RECORD TST LOOP ; LOOK FOR ERRORS BNE 20$ ADD #16.,PU+6 ; MOVE DOWN BUFFER 1 RECORD INC REC SOB R4,PU 20$: RTS PC ;------------------------------------------------------------------------ ; THIS SECTION WILL LOAD THE REQUESTED DIRECTORY ;------------------------------------------------------------------------ FILL: CLR LOOP MOV #1,REC ; START WITH FIRST RECORD MOV #BUF,FI+6 ; SET BUFFER ADDRESS MOV #1000.,R4 FI: GET$R #ACCFDB,#BUF,#16.,REC,,ER1 TST LOOP BNE 20$ ; QUIT IF ZERO ADD #16.,FI+6 ; NEXT RECORD INC REC SOB R4,FI ; AND LOOP UNTIL FINISHED 20$: DEC REC MOV REC,LASTRC ; SAVE NUMBER OF RECORDS CLC ; CLEAR ERROR FLAG RTS PC ;------------------------------------------------------------------------- ; THIS SECTION WILL SWAP THE TWO RECORDS ;---------------------------------------------------------------------- SWAP: CALL $SAVAL ; SAVE REGISTERS 10$: MOV R3,R0 MOV R4,R1 MOV #8.,R3 20$: MOV (R0),R2 ; SAVE FIRST RECORD MOV (R1),(R0)+ ; MOVE SECOND RECORD MOV R2,(R1)+ ; REPLACE FIRST RECORD SOB R3,20$ INC FLAG ; SET FLAG RTS PC ;------------------------------------------------------------------ REC: .WORD 0 ; RECORD NUMBER LASTRC: .WORD 0 ; # OF RECORDS SIZE: .WORD SIZE FLAG: .WORD 0 ; FLAG SET BY SWAP LOOP: .WORD 0 ; FLAG SET BY LAST RECORD GETPAR: GTSK$ BUF ; GET TASK PARAMETERS ;--------------------------------------------------------------------- ; ROUTINE USED TO PRINT ERROR MESSAGES ;--------------------------------------------------------------------- TYP: MOV (R5)+,R0 ; LOAD MEESAGE ADDRESS ; FIND THE FIRST NULL CHARACTER MOV #-1,R1 1$: INC R1 ; BUMP COUNTER TSTB (R0)+ ; IS CHARACTER NULL? BNE 1$ ; NO LOOP AGAIN QIO$S #IO.WLB,#5,#1,,,,<-2(R5),R1,#40> WTSE$S #1 RTS R5 ; RETURN ;-------------------------------------------------------------------- ; ERROR MESSAGES ;-------------------------------------------------------------------- ER1: CMPB ACCFDB+52,#-10. ; END OF FILE BEQ 10$ TYPOUT MER2 JMP EX 10$: INC LOOP RTS PC ER3: TYPOUT MER3 ; ERROR IN WRITING JMP EX ER4: TYPOUT MER4 JMP EX ER5: TYPOUT MER5 ; ERROR IN OPENING ACCOUNT FILE BR EX EX: CLOSE$ #ACCFDB ; CLOSE ACCOUNT FILE EXIT$S ;--------------------------------------------------------------------- .NLIST BEX MER1: .ASCIZ <12><15>/ERROR IN READING RECORD 1 / MER2: .ASCIZ <12><15>/ERROR IN READING SECOND RECORD/ MER3: .ASCIZ <12><15>/ERROR IN WRITING FIRST RECORD/ MER4: .ASCIZ <12><15>/ERROR IN WRITING SECOND RECORD/ MER5: .ASCIZ <12><15>/ERROR IN OPENING FILE / MES1: .ASCIZ <12><15>/JOB FINISHED / MES2: .ASCIZ <12><15>/TYPE IN XXXXXX WHERE XXXXXX IS USER ID. / .EVEN BUF: .BLKW 8100. .END BEGIN