.TITLE RNOIF ; ; This section handles the following commands ; ; .IF ; .IFNOT ; .ENDIF ; .VARIANT ; .NO VARIANT ; .ENABLE UNCONDITIONAL ; .DISABLE UNCONDITIONAL ; IF.MSK=37 ; Portion to contain stack value IF.ELS=40 ; Set if no ELSE IF.VAR=100 ; Set if variant command .psect $TEMP,RW,GBL,D,OVR TYPE: .BLKW 1 INLAB: .BLKB IFMAX+1 .psect $CODE,RO,LCL,I,CON ; ; Routine to test if label present ; LABTST: CALL SKPSP BCS 90$ ; Control char ? 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,90$ ; 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 ? CMPEQB (R2)+,R1,50$ ; Chars match ? ; 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 70$: TSTNEB (R2),40$ ; Not end of input ? RETURN 80$: BITNE #IFFLG,F.1,87$ ; No output ?? CALL ENDBF ; Set up for output MOV #INLAB,R2 ; get input buffer 85$: MOVB (R2)+,R1 ; Get char BEQ 86$ ; Done ? CALL PBYT ; Save it BR 85$ 86$: MOV #200,R1 CALL PBYT ; Chock end of string 87$: CLR R1 RETURN ; No success 90$: MOV #7,R0 ; Error number JMP ILCMA ; ; ENABLE UNCONDITIONAL ; DISABLE UNCONDITIONAL ; DSUNC:: BISB #SW.DIS,$IFUSW ; Set unconditional off TSTNEB $IFSTK,IFRET ; If being processed ?? DSUNC1: BIS #IFFLG,F.1 ; Disable it MOV #CMADR,R0 ; Set up for return MOV #IFCMD,(R0)+ ; Allow IF commands MOV #ENUCMD,(R0)+ ; Allow ENable unconditional CLR (R0)+ BR IFRET ENUNC:: BICB #SW.DIS,$IFUSW ; Set unconditional on BR IFON ; ; error routine ; IFERR: MOV #46.,R0 ; Error message number JMP ILCMA ; Now return ; ; IFNOT command Test if label is not present ; IFNOT:: CALL INSERT BEQ IFON ; Not variant ? IFOFF: BIS #IFFLG,F.1 ; Disable it MOV #CMADR,R0 ; Set up for return MOV #EICMD,(R0)+ MOV #ELSCMD,(R0)+ CLR (R0)+ IFRET: BITNE #IFFLG,F.1,10$ ; If flag on ? RETURN ; No keep rest of line 10$: JMP COMNT ; And kill rest of line ; ; IF command Test if label is true ; IF:: CALL INSERT BEQ IFOFF ; Not variant ? IFON: BIC #IFFLG,F.1 ; Enable it RETURN ; ; ELSE command ; ELSE:: CALL LABCK ; Check if correct entry BITEQB #IF.ELS,@BF.ADD(R3),IFERR; Improperly nested ELSE ? BICB #IF.ELS,@BF.ADD(R3) ; Reset else BITNE #IFFLG,F.1,IFON ; If flag on ? BR IFOFF ; no, turn it off ; ; ENDIF command ; ENDIF:: CALL LABCK BICB #IF.MSK!IF.ELS,@BF.ADD(R3); Clear entry DECB $IFSTK ; new stack entry BNE IFON ; Not bottom of stack ?? TSTNEB $IFUSW,DSUNC1 ; Unconditional off ? BR IFON ; ; VARIANT command ; VARIAN::CALL LABTST ; Get char string BISB #IF.VAR,@BF.ADD(R3) ; Set label present RETURN ; ; NO VARIANT command ; NOVARN::CALL LABTST ; Get char string BICB #IF.VAR,@BF.ADD(R3) ; Set variant off RETURN ; ; Insert entry into if stack ; Z set if no varint this entry ; INSERT: CALL LABTST ; Test for label BITNEB #IF.MSK!IF.ELS,R1,IFERR ; If already set ? MOVB $IFSTK,R1 INC R1 CMPB R1,#IF.MSK ; Check stack depth BLE 10$ ; Is it OK? MOV #45.,R0 ; Error message number JMP ILCMA 10$: MOVB R1,$IFSTK ; new stack entry BISB #IF.ELS,R1 ; Set else BISB R1,@BF.ADD(R3) ; Set if on BITB #IF.VAR,@BF.ADD(R3) ; Check variant RETURN ; ; CHECK for current label ; R1=Current stack value at end ; LABCK: CALL LABTST ; Ignore the 3 char label BITEQ #IFFLG,F.1,5$ ; Output ?? BITNEB #IF.MSK!IF.ELS,R1,5$ ; Preceeded by IF or IFNOT ? TST (SP)+ ; Pop subr-return BR IFRET ; No operation 5$: BIC #^C,R1 ; Clear extra bits BEQ IFERR ; Not enabled ?? CMPNEB $IFSTK,R1,IFERR ; Not matching entry ?? RETURN ; ; Subroutine to get only upper case input ; CCINUC: CALL CCIN ; Get input char CMPNEB GCTABL(R1),#GC.LC,10$ ; Not lower case ? SUB #40,R1 ; Make it upper 10$: CMPEQB GCTABL(R1),#GC.UC,20$ ; Upper case letter ? CMPEQB GCTABL(R1),#GC.DIG,20$ ; Number ? CALL BKSPI ; Kill input SEC ; And set end of input RETURN 20$: CLC ; Set char ok ! RETURN .END