SUB CONV_BINARY (STRING IN_VALUE$,STRING OUT_VALUE$,STRING FUNC_VALUE$, & STRING FUNC_CODE$,INTEGER STAT_CODE) !========================================================================== ! This SUB program will convert a binary string as per a function value and ! code. The new value and a status code will be outputted. ! FUNCTION CODES: BITS (max) STATUS CODES: ! AND - in_value with func_value - 32 - TRUE or FALSE ! NAND - in_value with func_value - 32 - TRUE or FALSE ! OR - in_value with func_value - 32 - TRUE or FALSE ! NOR - in_value with func_value - 32 - TRUE or FALSE ! XOR - in_value with func_value - 32 - TRUE or FALSE ! XNOR - in_value with func_value - 32 - TRUE or FALSE ! ADD - in_value with func_value - 32 - TRUE or FALSE ! SUB - in_value with func_value - 32 - TRUE or FALSE ! INV - in_value all bits per length - 32 _ TRUE or FALSE ! ROL - in_value all bits per length - 32 _ TRUE or FALSE ! ROR - in_value all bits per length - 32 _ TRUE or FALSE ! SHFTL - in_value all bits 0 for lift bit - 32 _ TRUE or FALSE ! SHFTR - in_value all bits 0 for right bit - 32 _ TRUE or FALSE ! BSET - in_value select per func_value - 32 - TRUE or FALSE ! BCLR - in_value select per func_value - 32 - TRUE or FALSE ! BTST - in_value select per func_value - 32 - TRUE or FALSE ! BRET - in_value select per func_value - 32 - TRUE or FALSE !========================================================================== %IDENT "01" %INCLUDE "DEF_EXT_SUBPROGRAMS.BAS" %INCLUDE "DEF_VARIABLES.BAS" %INCLUDE "DEF_FUNCTIONS.BAS" IN_VALUE$ = EDIT$(IN_VALUE$,188) len_inval = LEN(IN_VALUE$) FUNC_VALUE$ = EDIT$(FUNC_VALUE$,188) len_fnval = LEN(FUNC_VALUE$) max_len = MAX(len_fnval,len_inval) FUNC_CODE$ = EDIT$(FUNC_CODE$,188) STAT_CODE = TRUE !========================================================================== ! MAIN PROGRAM !========================================================================== MAIN: ret_flag = TRUE chk_len = len_inval GOSUB chk_for_len ! check if value string length > 32 chars chk_numb$ = IN_VALUE$ GOSUB chk_for_bin ! check if value in is binary number IF ret_flag <> TRUE THEN BIN$ = "" GOTO exit_sub END IF SELECT FUNC_CODE$ CASE "AND" BIN$ = "" value1$ = IN_VALUE$ value2$ = FUNC_VALUE$ expd_len = max_len GOSUB equalize_len FOR X = max_len TO 1 STEP - 1 IF ((MID$(value1$,X,1) = "1") AND & (MID$(value2$,X,1) = "1")) THEN BIN$ = BIN$ + "1" ELSE BIN$ = BIN$ + "0" END IF NEXT X CASE "NAND" BIN$ = "" value1$ = IN_VALUE$ value2$ = FUNC_VALUE$ expd_len = max_len GOSUB equalize_len FOR X = max_len TO 1 STEP - 1 IF ((MID$(value1$,X,1) = "1") AND & (MID$(value2$,X,1) = "1")) THEN BIN$ = BIN$ + "0" ELSE BIN$ = BIN$ + "1" END IF NEXT X CASE "OR" BIN$ = "" value1$ = IN_VALUE$ value2$ = FUNC_VALUE$ expd_len = max_len GOSUB equalize_len FOR X = max_len TO 1 STEP - 1 IF ((MID$(value1$,X,1) = "1") OR & (MID$(value2$,X,1) = "1")) THEN BIN$ = BIN$ + "1" ELSE BIN$ = BIN$ + "0" END IF NEXT X CASE "NOR" BIN$ = "" value1$ = IN_VALUE$ value2$ = FUNC_VALUE$ expd_len = max_len GOSUB equalize_len FOR X = max_len TO 1 STEP - 1 IF ((MID$(value1$,X,1) = "1") OR & (MID$(value2$,X,1) = "1")) THEN BIN$ = BIN$ + "0" ELSE BIN$ = BIN$ + "1" END IF NEXT X CASE "XOR" BIN$ = "" value1$ = IN_VALUE$ value2$ = FUNC_VALUE$ expd_len = max_len GOSUB equalize_len FOR X = max_len TO 1 STEP - 1 IF (MID$(value1$,X,1) = MID$(value2$,X,1)) THEN BIN$ = BIN$ + "1" ELSE BIN$ = BIN$ + "0" END IF NEXT X CASE "XNOR" BIN$ = "" value1$ = IN_VALUE$ value2$ = FUNC_VALUE$ expd_len = max_len GOSUB equalize_len FOR X = max_len TO 1 STEP - 1 IF (MID$(value1$,X,1) = MID$(value2$,X,1)) THEN BIN$ = BIN$ + "0" ELSE BIN$ = BIN$ + "1" END IF NEXT X CASE "ADD" BIN$ = "" value1$ = IN_VALUE$ value2$ = FUNC_VALUE$ stat_flag% = 2 CALL CONV_NUMBERS(dec_value1%,value1$,HEX_NUM,OCT_NUM,stat_flag%) IF stat_flag% <> TRUE THEN ret_flag = FALSE END IF stat_flag% = 2 CALL CONV_NUMBERS(dec_value2%,value2$,HEX_NUM,OCT_NUM,stat_flag%) IF stat_flag% <> TRUE THEN ret_flag = FALSE END IF dec_value3% = ABS%(dec_value1% + dec_value2%) stat_flag% = 1 CALL CONV_NUMBERS(dec_value3%,BIN$,HEX_NUM,OCT_NUM,stat_flag%) IF stat_flag% <> TRUE THEN ret_flag = FALSE END IF CASE "SUB" BIN$ = "" value1$ = IN_VALUE$ value2$ = FUNC_VALUE$ stat_flag% = 2 CALL CONV_NUMBERS(dec_value1%,value1$,HEX_NUM,OCT_NUM,stat_flag%) IF stat_flag% <> TRUE THEN ret_flag = FALSE END IF stat_flag% = 2 CALL CONV_NUMBERS(dec_value2%,value2$,HEX_NUM,OCT_NUM,stat_flag%) IF stat_flag% <> TRUE THEN ret_flag = FALSE END IF IF COMP%(NUM1$(dec_value2%),NUM1$(dec_value1%)) = 1 THEN ret_flag = FALSE END IF dec_value3% = ABS%(dec_value1% - dec_value2%) stat_flag% = 1 CALL CONV_NUMBERS(dec_value3%,BIN$,HEX_NUM,OCT_NUM,stat_flag%) IF stat_flag% <> TRUE THEN ret_flag = FALSE END IF CASE "INV" BIN$ = "" FOR N = 1 TO len_inval SELECT MID$(IN_VALUE$,N,1) CASE "1" BIN$ = BIN$ + "0" CASE "0" BIN$ = BIN$ + "1" CASE ELSE ret_flag = FALSE BIN$ = "" END SELECT NEXT N CASE "ROL" BIN$ = "" BIN$ = RIGHT$(IN_VALUE$,2) + LEFT$(IN_VALUE$,1) CASE "ROR" BIN$ = "" BIN$ = RIGHT$(IN_VALUE$,len_inval) + LEFT$(IN_VALUE$,len_inval - 1) CASE "SHFTL" BIN$ = "" BIN$ = RIGHT$(IN_VALUE$,2) + "0" CASE "SHFTR" BIN$ = "" BIN$ = "0" + LEFT$(IN_VALUE$,len_inval - 1) CASE "BSET" BIN$ = "" set_bit = INTEGER(FUNC_VALUE$) value1$ = IN_VALUE$ value2$ = "" expd_len = set_bit GOSUB equalize_len len_val = LEN(value1$) IF set_bit > 32 THEN ret_flag = FALSE ELSE MID$(value1$,len_val + 1 - set_bit) = "1" BIN$ = value1$ end if CASE "BCLR" BIN$ = "" clr_bit = INTEGER(FUNC_VALUE$) value1$ = IN_VALUE$ value2$ = "" expd_len = clr_bit GOSUB equalize_len len_val = LEN(value1$) IF clr_bit > 32 THEN ret_flag = FALSE ELSE MID$(value1$,len_val + 1 - clr_bit) = "0" BIN$ = value1$ END IF CASE "BTST" BIN$ = "" tst_bit = INTEGER(FUNC_VALUE$) IF ((tst_bit > 32) OR & (tst_bit > len_inval)) THEN ret_flag = FALSE ELSE IF MID$(IN_VALUE$,len_inval - tst_bit + 1,1) <> "1" THEN ret_flag = FALSE END IF END IF CASE "BRET" BIN$ = "" tst_bit = INTEGER(FUNC_VALUE$) IF ((tst_bit > 32) OR & (tst_bit > len_inval)) THEN ret_flag = FALSE ELSE BIN$ = MID$(IN_VALUE$,len_inval - tst_bit + 1,1) END IF CASE ELSE BIN$ = "" ret_flag = FALSE END SELECT exit_sub: STAT_CODE = ret_flag OUT_VALUE$ = BIN$ EXIT SUB !========================================================================== ! expand value$ length until it matches the longest number string !========================================================================== equalize_len: UNTIL LEN(value1$) => expd_len value1$ = "0" + value1$ NEXT UNTIL LEN(value2$) => expd_len value2$ = "0" + value2$ NEXT RETURN !========================================================================== ! check string length greater then 32 !========================================================================== chk_for_len: IF chk_len > 32 THEN ret_flag = FALSE END IF RETURN !========================================================================== ! check if value is binary !========================================================================== chk_for_bin: len_chk_numb = LEN(chk_numb$) FOR X = 1 TO len_chk_numb IF ((ASCII(MID$(chk_numb$,X,1)) < 48) OR & (ASCII(MID$(chk_numb$,X,1)) > 49)) THEN ret_flag = FALSE RETURN END IF NEXT X RETURN END SUB