.TITLE RNOIF ; ; This section handles the following commands ; ; .IF ; .IFNOT ; .ENDIF ; .VARIANT ; .NO VARIANT ; .ENABLE UNCONDITIONAL ; .DISABLE UNCONDITIONAL ; IF.ON=^o10 ; Zero if text enabled IF.NOT=^o20 ; Set if in a not branch IF.ELS=^o40 ; Set if no ELSE IF.VAR=^o100 ; Set if variant command .vars FIELD: .BLKA 1 TYPE: .BLKA 1 INLAB: .BLKB IFMAX+1 .even .code ; ; Routine to test if label present ; And if not enter it into table ; LABEN0: CLR R5 BR LABEN1 LABENT: MOV #-1,R5 LABEN1: CALL LABTS0 BCC 40$ CALL ENDBF ; Set up for output MOV #INLAB,R2 ; get input buffer 10$: MOVB (R2)+,R1 ; Get char BEQ 20$ ; Done ? CALL PBYT ; Save it BR 10$ 20$: MOV #^o200,R1 CALL PBYT ; Chock end of string 40$: RETURN ; No success ; ; Test if label present ; Input: R5 = 0 if wild chars ignored ; R5 = -1 wild chars parsed ; Output: Carry set if no label ; Carry clear if label ; and R1 = status ; MISERR: MOV #7,R0 ; Error number JMP ILCMA LABTST: MOV #-1,R5 LABTS0: CALL SKPSP BCS MISERR ; End of labels ? 10$: CALL BKSPI ; Backspace over char MOV #INLAB,R2 ; Temporary buffer for label 20$: CALL CCINUC ; Get 1 character of label BCS 30$ ; At end of buffer ? MOVB R1,(R2)+ ; Save char CMP R2,#INLAB+IFMAX ; Check how many chars BLOS 20$ ; Not too many ? MOV #51.,R0 ; Label too long JMP ILCMA 30$: CLRB (R2)+ ; Chock end of buffer TSTEQB INLAB,MISERR ; No string ? MOV #IFBF,R3 ; If buffer address CALL BEGBF ; Start at beginning of IF buffer ; Search for matching label 40$: MOV #INLAB,R2 ; Now search buffer for label 50$: CALL GBYT ; Get first label BCS 80$ ; None ? BLE 70$ ; At end of string ? 55$: CMPEQB (R2)+,R1,50$ ; Chars match ? TSTEQ R5,60$ ; Wild chars not allowed ? CMPEQB R1,#STARR,65$ ; Is it wild ? ; Skip over rest of label 60$: CALL GBYT ; Get next input byte BCS 80$ ; End of buffer ? BLE 40$ ; End of string ? BR 60$ ; Not yet 65$: CALL GBYT ; Get next input byte BCS 80$ ; End of buffer ? BLE 75$ ; End of string ? BR 65$ ; Not yet 70$: TSTNEB (R2),40$ ; Not end of input ? 75$: CLC 80$: RETURN ; ; Insert entry into if stack ; Z set if no varint this entry ; R0=points to $IFSTT ; STKERR: MOV #53.,R0 ; Error number JMP ILCMA ; Kill this comand INSERT: TSTNEB SUBSTK,STKERR ; Error in stack depth ? CLR FIELD ; Clear field counter 1$: INC FIELD ; Increment field counter CALL LABTST BCC 15$ ; Found label ? CALL SKPSP ; Get more chars ? BCS 2$ ; No more CALL BKSPI ; Backup 1 char BR 1$ ; Try next one 2$: CALL ENDBF ; Set up for output MOV #INLAB,R2 ; get input buffer 5$: MOVB (R2)+,R1 ; Get char BEQ 10$ ; Done ? CALL PBYT ; Save it BR 5$ 10$: MOV #^o200,R1 CALL PBYT ; Chock end of string 15$: BITNEB #IF.VAR,R1,20$ ; Variant set ? CALL SKPSP ; Get more chars ? BCS 25$ ; No more CALL BKSPI ; Backup 1 char BR 1$ ; Try another ? 20$: CALL SKPSP ; Skip rest of chars BCC 20$ ; Not end of command ? 25$: MOV $IFSTK,R0 ; Get if stack in R0 BNE 30$ ; Not first ? BIC #IFFLG,F.1 ; Reset if flag 30$: INC R0 CMP R0,#IFDPTH ; Check stack depth BLE 40$ ; Is it OK? MOV #45.,R0 ; Error message number JMP ILCMA 40$: MOV R0,$IFSTK ; new stack entry MOV R0,R2 ; Entry INDXA R2 ; Now is word pointer MOV R0,R5 ADD #$IFSTT-1,R5 ; Points to if status ADD #$IFSTK,R2 ; Point to if stack CLRB (R5) ; Clean slate MOV BF.FUL(R3),(R2) ; Store stack pointer BITEQ #IFFLG,F.1,50$ ; If flag clear ? BISB #IF.NOT,(R5) ; Set not 50$: MOVB @BF.ADD(R3),R1 ; get status BITB #IF.VAR,R1 ; Check variant RETURN ; ; CHECK for current label ; R1=Current stack value at end ; R0=$IFSTK ; R2=points to IFSTK ; R5=points to $IFSTS ; LABCK: TSTEQB SUBSTK,1$ ; Zero stack level ? JMP STKERR ; Error in stack depth ? 1$: CALL SKPSP ; Get first char BCC 5$ ; Got one ? JMP MISERR ; No parameter error 5$: CMPEQB R1,#STARR,10$ ; Is it "*" CALL BKSPI ; Save it CLR FIELD CALL LABTST ; Get label + find it BCC 10$ ; Found one ? JMP IFERR ; None ? 10$: MOV $IFSTK,R0 MOV R0,R5 ADD #$IFSTT-1,R5 ; Points to if status MOV R0,R2 INDXA R2 ; If stack pointer ADD #$IFSTK,R2 CMPEQB R1,#STARR,20$ ; Is it "*" CMPEQ (R2),BF.FUL(R3),20$ ; Same ? JMP IFERR ; not same ?? 20$: RETURN ; ; IFNOT command Test if label is not present ; IFNOT:: CALL INSERT BNE IFOFF ; Variant ? JMP IFON ; Not variant ? IFOFF: BISB #IF.ON,(R5) ; Disable it IFRET: MOV $IFSTK,R5 ; Get stack BNE 10$ ; IF in progress ? BIC #IFFLG,F.1 ; Set no if TSTEQB $IFUSW,15$ ; Unconditional flag off BIS #IFFLG,F.1 ; Disable text output MOV #CMADR,R0 ; Set up for return MOV #IFCMD,(R0)+ ; Allow IF commands MOV #IFNCMD,(R0)+ ; Allow IFNOT commands MOV #ENUCMD,(R0)+ ; Allow ENable unconditional CLR (R0)+ BR 30$ 10$: ADD #$IFSTT-1,R5 ; Current entry BITNEB #IF.NOT!IF.ON,(R5),20$ ; NOT present? BIC #IFFLG,F.1 ; No text 15$: RETURN ; No keep rest of line 20$: BIS #IFFLG,F.1 ; Set no text MOV #CMADR,R0 ; Set up for return MOV #IFCMD,(R0)+ ; Allow IF commands MOV #IFNCMD,(R0)+ ; Allow IFNOT commands MOV #ELSCMD,(R0)+ ; Allow else commands MOV #EICMD,(R0)+ ; Allow End commands CLR (R0)+ 30$: JMP COMNT ; And kill rest of line ; ; error routine ; IFERR: MOV #46.,R0 ; Error message number JMP ILCMA ; Now return ; ; IF command Test if label is true ; IF:: CALL INSERT BNE IFON ; Variant ? JMP IFOFF ; Not variant ? IFON: BICB #IF.ON,(R5) ; Enable it BR IFRET ; ; ELSE command ; ELSE:: CALL LABCK ; Check if correct entry BITNEB #IF.ELS,(R5),IFERR ; Already else ? BISB #IF.ELS,(R5) ; Set else BITNEB #IF.ON,(R5),IFON ; If flag on ? BR IFOFF ; no, turn it off ; ; ENDIF command ; ENDIF:: CALL LABCK DEC R0 ; New stack entry BLT IFERR ; Bad stack ? MOV R0,$IFSTK ; new stack entry BR IFRET ; return ; ; VARIANT command ; VARIAN::CLR FIELD 1$: CALL SKPSP ; Check if second label ? BCS 20$ ; None CALL BKSPI ; Backspace over char CALL LABEN0 ; Get char string BISB #IF.VAR,@BF.ADD(R3) ; Set label present BR 1$ ; And try again 20$: RETURN ; ; NO VARIANT command ; NOVARN::CLR FIELD 1$: CALL SKPSP ; Check if second label ? BCS 20$ ; None CALL BKSPI ; Backspace over char CALL LABEN0 ; Get char string BICB #IF.VAR,@BF.ADD(R3) ; Set variant off BR 1$ ; And try again 20$: RETURN ; ; Subroutine to get only upper case input ; INput: R5 = 0 Wild chars allowed in input ; Output: C = clear if got char ; C = set no char ; R1 = char ; CCINUC: CALL CCINP ; Get input char BCS 5$ ; End of input ? CMPEQB (R0),#GC.LC,10$ ; Lower case ? CMPEQB (R0),#GC.UC,20$ ; Upper case letter ? CMPEQB (R0),#GC.DIG,20$ ; Number ? CMPEQB R1,#UNDSC,20$ ; Underscore TSTNE R5,4$ ; No special chars ? CMPEQB R1,#STARR,20$ ; Is it star 4$: CALL BKSPI ; Back over input char. 5$: SEC ; And set end of input RETURN 10$: SUB #^o40,R1 ; Make it upper 20$: CLC ; Set char ok ! RETURN ; ; ENABLE UNCONDITIONAL ; DISABLE UNCONDITIONAL ; DSUNC:: BISB #SW.DIS,$IFUSW ; Set unconditional off JMP IFRET ENUNC:: BICB #SW.DIS,$IFUSW ; Set unconditional on JMP IFRET ; ; IMMEDIATE IF command ; IMMEDIATE IFNOT command ; IIF:: CLR FIELD CALL LABTST ; Get label + find it BCS IINO ; Not present BITEQB #IF.VAR,R1,IINO ; Not a variant ?? IIYES: RETURN ; Accept the line IIFNOT::CLR FIELD CALL LABTST ; Get label + find it BCS IIYES ; None ? BITEQB #IF.VAR,R1,IIYES ; Variant not enabled ? IINO: TST (SP)+ ; Pop stack JMP COMNT ; Kill current line .END