;************************************************************************ ;* * ;* FILE NAME: OPTCHECK_UTIL.MAR * ;* * ;* AUTHOR: H. SIEGEL, TRW, 24 MAY 1988 * ;* * ;* PURPOSE: UTILITY ROUTINES FOR OPTCHECK TOOL * ;* * ;************************************************************************ .TITLE OPTCHECK_UTIL .IDENT /1.0/ ; ; ; .LIBRARY /SYS$LIBRARY:LIB/ $SSDEF $FABDEF ; RMS FAB BLOCK FIELD/VALUE DEFINITIONS $NAMDEF ; RMS NAM BLOCK FIELD/VALUE DEFINITIONS $RABDEF ; RMS RAB BLOCK FIELD/VALUE DEFINITIONS .PSECT $ABS$,ABS . = 0 ARGCNT: .BLKL 1 ; ARGUMENT COUNT . = 0 .BLKL 1 ; FILL MSGID: .BLKL 1 ; MESSAGE CODE TO BE SIGNALLED FABADR: .BLKL 1 ; ADDRESS OF FILE ACCESS BBLOCK AUXID: .BLKL 1 ; AUXILLIARY MESSAGE CODE TO BE SIGNALLED . = 0 .BLKL 1 ; FILL FUNC: .BLKL 1 ; ADDRESS OF FUNCTION BIT MASK WORD INSTR: .BLKL 1 ; ADDRESS OF INPUT STRING DESCRIPTOR OUTSTR: .BLKL 1 ; ADDRESS OF OUTPUT STRING DESCRIPTOR OUTLEN: .BLKL 1 ; ADDRESS OF OUTPUT LENGTH WORD . = 0 ESF_V_COLLAPSE:: .BLKB 1 ESF_V_COMPRESS:: .BLKB 1 ESF_V_TRIM:: .BLKB 1 ESF_V_TRUNCATE:: .BLKB 1 ESF_V_UPCASE:: .BLKB 1 ESF_V_DOWNCASE:: .BLKB 1 ESF_M_COLLAPSE == 1@ESF_V_COLLAPSE ESF_M_COMPRESS == 1@ESF_V_COMPRESS ESF_M_TRIM == 1@ESF_V_TRIM ESF_M_TRUNCATE == 1@ESF_V_TRUNCATE ESF_M_UPCASE == 1@ESF_V_UPCASE ESF_M_DOWNCASE == 1@ESF_V_DOWNCASE . = 0 ESF_V_WHITE: .BLKB 1 ESF_V_BLACK: .BLKB 1 ESF_M_WHITE = 1@ESF_V_WHITE ESF_M_BLACK = 1@ESF_V_BLACK . = 0 INSTR_DSCR: .BLKQ 1 ; LOCAL DESCRIPTOR FOR INPUT STRING WRKSTR_DSCR: .BLKQ 1 ; DESCRIPTOR FOR WORKING STRING OUTSTR_DSCR: .BLKQ 1 ; LOCAL DESCRIPTOR FOR OUTPUT STRING LOCAL_DATA_SIZE = . ; ; ; .PSECT OPTCHECK_UTIL,LONG,PIC,SHR,EXE,REL,RD,NOWRT ; ; ; .ENTRY FILE_STATUS,^M CMPB ARGCNT(AP),#2 ; TEST NUMBER OF CALL ARGUMENTS BGEQ 100$ ; BRANCH IF ENOUGH ARGUMENTS JMP INSUFFICIENT_ARGUMENTS ; ELSE GO PROCESS THE ERROR 100$: SUBL2 #8,SP ; ADJUST STACK POINTER AND SAVE MOVL SP,R11 ; ... BASE ADDR OF LOCAL STORE MOVL FABADR(AP),R2 ; GET ADDRESS OF FAB 1000$: MOVL FAB$L_NAM(R2),R3 ; GET ADDRESS OF NAM TSTB NAM$B_RSL(R3) ; RESULTANT NAME STRING? BEQL 1200$ ; NO, CONTINUE BELOW MOVZBL NAM$B_RSL(R3),(R11) ; SAVE NAM RSL STRING LENGTH MOVL NAM$L_RSA(R3),4(R11) ; SAVE NAM RSL STRING ADDRESS BRW 3000$ ; AND CONTINUE BELOW 1200$: TSTB NAM$B_ESL(R3) ; EXPANDED NAME STRING? BEQL 1400$ ; NO, CONTINUE BELOW MOVZBL NAM$B_ESL(R3),(R11) ; SAVE NAM EXP STRING LENGTH MOVL NAM$L_ESA(R3),4(R11) ; SAVE NAM EXP STRING ADDRESS BRW 3000$ ; AND CONTINUE BELOW 1400$: MOVZBL FAB$B_FNS(R2),(R11) ; SAVE FAB FNM STRING LENGTH MOVL FAB$L_FNA(R2),4(R11) ; SAVE FAB FNM STRING ADDRESS 3000$: CMPB ARGCNT(AP),#2 ; TEST FOR 2 CALLING ARGS BGTR 7000$ ; BRANCH IF MORE THAN 2 ARGS 3200$: BLBS FAB$L_STS(R2),3400$ ; SKIP IF NOT FAB ERROR MOVL FAB$L_STS(R2),R0 ; SAVE FAB PRIMARY STATUS MOVL FAB$L_STV(R2),R1 ; SAVE FAB AUXILLIARY STATUS BRW 5000$ ; AND CONTINUE BELOW 3400$: MOVL FAB$L_CTX(R2),R3 ; GET ADDRESS OF RAB BEQL 9000$ ; BRANCH IF RAB ADDR IS ZERO MOVL RAB$L_STS(R3),R0 ; SAVE RAB PRIMARY STATUS MOVL RAB$L_STV(R3),R1 ; SAVE RAB AUXILLIARY STATUS 5000$: PUSHL R1 ; PUSH RMS AUXILLIARY STATUS PUSHL R0 ; PUSH RMS PRIMARY STATUS PUSHL R11 ; PUSH ADDR OF INSERT PUSHL #1 ; PUSH INSERT COUNT PUSHL MSGID(AP) ; PUSH USER MESSAGE ID CALLS #5,G^LIB$SIGNAL ; SIGNAL THE MESSAGE RET ; AND RETURN TO CALLER 7000$: TSTL AUXID(AP) ; TEST FOR AUXID = 0 BEQL 8000$ ; BRANCH IF IT IS 0 PUSHL #0 ; PUSH AUX MSG INSERT COUNT PUSHL AUXID(AP) ; PUSH AUX MESSAGE ID PUSHL R11 ; PUSH ADDR OF INSERT PUSHL #1 ; PUSH INSERT COUNT PUSHL MSGID(AP) ; PUSH USER MESSAGE ID CALLS #5,G^LIB$SIGNAL ; SIGNAL THE MESSAGE RET ; AND RETURN TO CALLER 8000$: PUSHL R11 ; PUSH ADDR OF INSERT PUSHL #1 ; PUSH INSERT COUNT PUSHL MSGID(AP) ; PUSH USER MESSAGE ID CALLS #3,G^LIB$SIGNAL ; SIGNAL THE MESSAGE RET ; AND RETURN TO CALLER 9000$: PUSHL #0 ; PUSH INSERT COUNT PUSHL #RMS$_RAB ; PUSH ERROR STATUS CALLS #2,G^LIB$STOP ; AND ABORT IF THERE WAS AN ; RMS ERROR NOT ASSOCIATED ; WITH THE FAB AND A RAB WAS ; NOT PRESENT. ; ; ; .ENTRY EDIT_STRING,^M ALLOCATE_LOCAL_STORAGE: SUBL2 #LOCAL_DATA_SIZE,SP ; ADJUST STACK POINTER AND... MOVL SP,R11 ; ... SAVE ADDR OF LOCAL STORE CHECK_REQUIRED_ARGUMENTS: CMPB ARGCNT(AP),#4 ; TEST ARGUMENT COUNT BEQL 1000$ ; SKIP IF CORRECT JMP INSUFFICIENT_ARGUMENTS ; ELSE GO PROCESS THE ERROR 1000$: MOVL FUNC(AP),R10 ; GET ADDRESS OF FUNCTION ARG BNEQ 1010$ ; SKIP IF ARG PRESENT JMP BAD_ARGUMENT ; ELSE GO PROCESS ERROR 1010$: MOVZWL (R10),R10 ; GET THE EDIT FUNCTION FLAGS TSTL INSTR(AP) ; CHECK FOR INSTR ARG BNEQ 1020$ ; SKIP IF ARG PRESENT JMP BAD_ARGUMENT ; ELSE GO PROCESS ERROR 1020$: TSTL OUTSTR(AP) ; CHECK FOR OUTSTR ARG BNEQ 1099$ ; SKIP IF ARG PRESENT TSTL OUTLEN(AP) ; CHECK FOR OUTLEN ARG BNEQ 1099$ ; SKIP IF ARG PRESENT JMP INSUFFICIENT_ARGUMENTS ; ELSE GO PROCESS ERROR 1099$: ; CONTINUE CHECK_OPTIONAL_ARGUMENTS: MOVL OUTLEN(AP),R9 ; SAVE ADDRESS OF OUTLEN ARG BNEQ 1000$ ; SKIP IF ADDRESS NOT ZERO MOVAW -(SP),R9 ; ELSE PUT TEMP VALUE ON STACK 1000$: MOVL INSTR(AP),R6 ; GET ADDR OF INSTR DESCRIPTOR MOVW (R6),R0 ; GET INSTR ARG LENGTH BNEQ 2000$ ; SKIP IF INSTR NOT NULL CLRW (R9) ; ELSE SET OUTLEN TO ZERO MOVL OUTSTR(AP),R8 ; GET OUTSTR DESCR ADDR BEQL 1010$ ; SKIP IF NO OUTSTR ARG MOVC5 #0,#0,#^A/ /,(R8),@4(R8) ; FILL OUTSTR WITH BLANKS 1010$: RET ; AND RETURN TO CALLER 2000$: MOVQ (R6),INSTR_DSCR(R11) ; CREATE LOCAL INSTR DESCR... MOVAQ INSTR_DSCR(R11),R6 ; ... AND POINT TO IT MOVL OUTSTR(AP),R8 ; GET OUTSTR DESCR ADDR BEQL 3000$ ; SKIP IF OUTSTR ARG ABSENT TSTW (R8) ; CHECK OUTSTR ARG LENGTH BEQL 2010$ ; SKIP IF NULL STRING MOVQ (R8),OUTSTR_DSCR(R11) ; CREATE LOCAL OUTSTR DESCR... MOVAQ OUTSTR_DSCR(R11),R8 ; ... AND POINT TO IT BRW 4000$ ; AND CONTINUE BELOW 2010$: CLRL (R9) ; SET OUTLEN TO ZERO RET ; AND RETURN TO CALLER 3000$: MOVZWL (R6),R0 ; GET INSTR ARG LENGTH MOVAQ OUTSTR_DSCR(R11),R8 ; GET ADDR OF LOCAL OUTSTR DESCR MOVL R0,(R8) ; SET TEMP OUTSTR LENGTH SUBL2 R0,SP ; MAKE ROOM ON THE STACK AND... MOVL SP,4(R8) ; ... SAVE ADDR OF TEMP BUFFER 4000$: ; CONTINUE TRIM_STRING: BITW #ESF_M_COLLAPSE,R10 ; ELSE TEST FOR COLLAPSE FLAG BNEQ 1000$ ; BRANCH IF COLLAPSE REQUESTED BITW #ESF_M_TRIM,R10 ; TEST FOR TRIM FLAG BNEQ 1000$ ; BRANCH IF TRIM REQUESTED BITW #ESF_M_TRUNCATE,R10 ; TEST FOR TRUNCATE FLAG BNEQ 2000$ ; BRANCH IF TRUNCATE REQUESTED BRW 9000$ ; ELSE CONTINUE BELOW 1000$: SCANC (R6),@4(R6),SCANTBL,- ; SCAN FOR A NON-SPACE #ESF_M_BLACK ; CHARACTER IN THE INSTR BNEQ 3000$ ; BRANCH IF NON-SPACE CHAR FOUND MOVC5 #0,#0,#^A/ /,(R8),@4(R8) ; FILL OUTSTR WITH BLANKS CLRW (R9) ; SET OUTLEN TO ZERO RET ; AND RETURN TO CALLER 2000$: MOVZWL (R6),R0 ; GET INSTR LENGTH ADDL3 R0,4(R6),R1 ; ADDR OF 1 PAST END OF INSTR BRW 5000$ ; AND GO TRUNCATE THE STRING 3000$: MOVL R1,4(R6) ; SAVE ADJUSTED INSTR ADDRESS MOVZWL R0,R0 ; CONVERT LENGTH TO LONGWORD ADDL2 R0,R1 ; ADDR OF 1 PAST END OF INSTR 5000$: MOVZBL -(R1),R2 ; GET BYTE FROM END OF STRING BITB #ESF_M_BLACK,L^SCANTBL(R2) ; TEST FOR NON-SPACE CHARACTER BNEQ 7000$ ; BRANCH IF NON-SPACE CHAR FOUND SOBGTR R0,5000$ ; ELSE GO BACK FOR NEXT CHAR 7000$: MOVW R0,(R6) ; SAVE ADJUSTED INSTR LENGTH 9000$: ; CONTINUE ALLOCATE_WORKING_STRING_STORAGE: MOVAL WRKSTR_DSCR(R11),R7 ; ADDRESS OF WRKSTR DESCRIPTOR MOVZWL (R6),(R7) ; GET 'ADJUSTED' INSTR LENGTH SUBL2 (R7),SP ; ADJUST STACK POINTER AND MOVL SP,4(R7) ; ... SAVE ADDRESS OF WRKSTR SQUEEZE_STRING: BITW #ESF_M_COLLAPSE,R10 ; ELSE TEST FOR COLLAPSE FLAG BNEQ COLLAPSE_STRING ; BRANCH IF COLLAPSE REQUESTED BITW #ESF_M_COMPRESS,R10 ; TEST FOR COMPRESS FLAG BNEQ COMPRESS_STRING ; BRANCH IF COMPRESS REQUESTED COPY_STRING: MOVC3 (R7),@4(R6),@4(R7) ; ELSE MOVE INSTR TO WRKSTR BRW SQUOZE_STRING ; AND CONTINUE BELOW COLLAPSE_STRING: MOVZWL (R6),R0 ; GET INSTR LENGTH MOVL 4(R6),R1 ; GET INSTR ADDRESS CLRL R2 ; INITIAL WRKSTR LENGTH MOVL 4(R7),R3 ; GET WRKSTR ADDRESS 2000$: MOVZBL (R1)+,R4 ; GET A CHAR FROM INSTR BITB #ESF_M_BLACK,L^SCANTBL(R4) ; TEST FOR NON-SPACE CHARACTER BEQL 4000$ ; BRANCH IF SPACE CHAR FOUND MOVB R4,(R2)+[R3] ; ELSE MOVE GOOD CHAR TO WRKSTR 4000$: SOBGTR R0,2000$ ; AND GO BACK FOR NEXT CHAR MOVW R2,(R7) ; SAVE LENGTH OF WRKSTR BRW SQUOZE_STRING ; AND CONTINUE BELOW COMPRESS_STRING: MOVZWL (R6),R0 ; GET INSTR LENGTH MOVL 4(R6),R1 ; GET INSTR ADDRESS CLRL R2 ; INITIAL WRKSTR LENGTH MOVL 4(R7),R3 ; GET WRKSTR ADDRESS 2000$: MOVZBL (R1)+,R4 ; GET A CHAR FROM INSTR BITB #ESF_M_BLACK,L^SCANTBL(R4) ; TEST FOR NON-SPACE CHARACTER BNEQ 2500$ ; BRANCH IF NON-SPACE CHAR FOUND MOVB #^A/ /,(R2)+[R3] ; PUT FIRST SPACE IN WRKSTR BRW 4500$ ; AND CONTINUE BELOW 2500$: MOVB R4,(R2)+[R3] ; ELSE MOVE GOOD CHAR TO WRKSTR SOBGTR R0,2000$ ; AND GO BACK FOR NEXT CHAR BRW 6000$ ; NO MORE CHARS! CONTINUE BELOW 4000$: MOVZBL (R1)+,R4 ; GET A CHAR FROM INSTR BITB #ESF_M_BLACK,L^SCANTBL(R4) ; TEST FOR NON-SPACE CHARACTER BNEQ 2500$ ; BRANCH IF NON-SPACE CHAR FOUND 4500$: SOBGTR R0,4000$ ; AND GO BACK FOR NEXT CHAR 6000$: MOVW R2,(R7) ; SAVE LENGTH OF WRKSTR SQUOZE_STRING: ; CONTINUE CHANGE_CASE: BITW #ESF_M_UPCASE,R10 ; TEST FOR UPCASE FLAG BNEQ UP_CASE ; BRANCH IF UPCASE REQUESTED BITW #ESF_M_DOWNCASE,R10 ; ELSE TEST FOR DOWNCASE FLAG BNEQ DOWN_CASE ; BRANCH IF DOWNCASE REQUESTED SAME_CASE: MOVC5 (R7),@4(R7),#^A/ /,(R8),@4(R8) ; COPY/PAD WRKSTR TO OUTSTR BRW SET_OUTSTR_LENGTH ; AND CONTINUE BELOW UP_CASE: BITW #ESF_M_DOWNCASE,R10 ; ALSO TEST FOR DOWNCASE FLAG BNEQ SAME_CASE ; UP + DOWN =-> SAME_CASE MOVTC (R7),@4(R7),#^A/ /, - ; COPY/XLATE WRKSTR TO OUTSTR UPCASE_TABLE,(R8),@4(R8) BRW SET_OUTSTR_LENGTH ; AND CONTINUE BELOW DOWN_CASE: MOVTC (R7),@4(R7),#^A/ /, - ; COPY/XLATE WRKSTR TO OUTSTR DOWNCASE_TABLE,(R8),@4(R8) SET_OUTSTR_LENGTH: BLSSU 5000$ ; LEN(WRKSTR) < LEN(OUTSTR) ? MOVW (R8),(R9) ; NO, SET OUTLEN TO LEN(OUTSTR) BRB 9000$ ; AND CONTINUE BELOW 5000$: MOVW (R7),(R9) ; YES, SET OUTLEN TO LEN(WRKSTR) 9000$: ; CONTINUE ALL_FINISHED: RET ; AND RETURN TO CALLER INSUFFICIENT_ARGUMENTS: PUSHL #SS$_INSFARG ; NOT ENOUGH ARGUMENTS ERROR CALLS #1,G^LIB$STOP ; AND SIGNAL THE ERROR BAD_ARGUMENT: PUSHL #SS$_BADPARAM ; MISSING ARGUMENT ERROR CALLS #1,G^LIB$STOP ; AND SIGNAL THE ERROR ; ; ; .PSECT OPTCHECK_UTIL_DATA,BYTE,SHR,REL,NOEXE,NOWRT TAB = 9 SPACE = 32 PERIOD = 46 CAP_A = 65 CAP_Z = 90 SMALL_A = 97 SMALL_Z = 122 TILDE = 126 SCANTBL: .BYTE ESF_M_BLACK[256] .SAVE_PSECT . = SCANTBL + TAB .BYTE ESF_M_WHITE . = SCANTBL + SPACE .BYTE ESF_M_WHITE .RESTORE_PSECT SCANTBL_LEN = . - SCANTBL .IIF LT SCANTBL_LEN-256, .ERROR ; SCAN TABLE TOO SHORT .IIF GT SCANTBL_LEN-256, .ERROR ; SCAN TABLE TOO LONG UPCASE_TABLE: .REPEAT 256 .BYTE . - UPCASE_TABLE .ENDR .SAVE_PSECT . = UPCASE_TABLE + SMALL_A 400$: .REPEAT .BYTE . - 400$ + CAP_A .ENDR .RESTORE_PSECT TABLE_LEN = . - UPCASE_TABLE .IIF LT TABLE_LEN-256, .ERROR ; UP CASE TABLE TOO SHORT .IIF GT TABLE_LEN-256, .ERROR ; UP CASE TABLE TOO LONG DOWNCASE_TABLE: .REPEAT 256 .BYTE . - DOWNCASE_TABLE .ENDR .SAVE_PSECT . = DOWNCASE_TABLE + CAP_A 400$: .REPEAT .BYTE . - 400$ + SMALL_A .ENDR .RESTORE_PSECT TABLE_LEN = . - DOWNCASE_TABLE .IIF LT TABLE_LEN-256, .ERROR ; DOWN CASE TABLE TOO SHORT .IIF GT TABLE_LEN-256, .ERROR ; DOWN CASE TABLE TOO LONG END_OF_TABLES: .END