.MCALL .MODULE .MODULE INDCTL,VERSION=04,COMMENT= ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only with the ; inclusion of the above copyright notice. This software, or ; any other copies thereof, may not be provided or otherwise ; made available to any other person except for use on such ; system and to one who agrees to these license terms. Title ; to and ownership of the software shall at all times remain ; in Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. .ENABL GBL,LC .SBTTL System macros ;+ ;External macros. ;- .MCALL GCLDF$, DEFIN$, RT5DF$ GCLDF$ ;Define GCML offsets DEFIN$ ;Definitions for IND files RT5DF$ ;Define RT labels ;+ ;This module processes the following directives: ; ; .GOTO, .GOSUB, .RETURN, .CHAIN, .ONERR, .STOP, .EXIT, ; .BEGIN, .END ;- OPSECT INDCTL .SBTTL .GOTO directive ;+ ;GOTO ;Entry for GOTO directive. ; ;GO2ER ;Entry point for goto from on error. From ATEX1. ;- .ENABL LSB GOTO:: CALL GLAB ;Get label from command buffer BCS SYNERR ;No label was found - SYNTAX ERROR GO2ER:: BIS #,.LFLG2 ;Error Processing in progress CALL FLAB ;Is label in table? BCS 2$ ;No, search for it BEQ 1$ ;Yes, Entry is at start of table MOV @R4,@R5 ;Move entry to start of table MOV LABTP,@R4 MOV R4,LABTP 1$: ADD #6,R4 ;Point at position context BR RET1 ;Go position the file 2$: INCB SKIP ;Set searching flag TSTB BLOCK ;Within a block? BEQ 3$ ;Branch if no MOV #CONTXT,R0 ;Point to current block context MOV (R0)+,R1 ;Set up for .POINT MOV (R0)+,R2 ; MOV (R0)+,R3 ; MOV #GCML,R0 ;Get address of GCML control block CALL .POINT ;Position the file at beginning of ; block to scan for label 3$: MOVB BLOCK,SCAN ;Tell root what level to look at BISB #GE.RWD,G.MODE+GCML ;Set to rewind on end of file BICB #GE.IND,G.MODE+GCML ;Disable deeper indirect files BR NEXT ;Get next command .DSABL LSB .SBTTL ONERR - "On error goto" ;+ ;Set up error routine label here. ;- .ENABL LSB ONERR:: CLR ERLBL ;Assume ONERR is being turned off CALL GLAB ;Get the label BCC 1$ ;Process the error label TST R1 ;Any blanks? BEQ NEXT ;No, just turn ONERR off BR SYNERR ; else syntax error 1$: MOV LABL,ERLBL ;Copy it MOV LABL+2,ERLBL+2 MOV LABL+4,ERLBL+4 BR NEXT ;Get next command .DSABL LSB .SBTTL GOSUB and RETURN processors ;+ ;Routine for GOSUB. ;- .ENABL LSB GOSUB:: MOV SSP,R5 ;Get subroutine stack pointer CMP R5,#SSE-8. ;Room left for 4. words on stack? BHI 3$ ;Branch if no - error SAVE MOV #GCML,R0 ;Get FDB for indirect file CALL .MARK ;Get positional context MOV R1,(R5)+ ;Save on subroutine stack MOV R2,(R5)+ ; MOV R3,(R5)+ ; MOV BLOCK,(R5)+ ;Save block context CLR BLOCK ;Initialize new block context BISB #GSUB,BLKFLG ;Set looking for subroutine label MOV R5,SSP ;Save new stack pointer RESTOR BR GOTO ;+ ;Routine for RETURN. ;- RETUR:: MOV SSP,R4 ;Get current subroutine stack pointer CMP R4,SSB ;Anything on stack? BLOS 4$ ;Branch if no - error 1$: TSTB BLOCK ;Any block context on stack? BEQ 2$ ;Branch if no CALL POPBLK ;Pop a block BR 1$ ;See if more 2$: SUB #8.,R4 ;Point at top 4 words MOV R4,SSP ;Set new top of stack MOV 6(R4),BLOCK ;Restore old block context RET1: MOV (R4)+,R1 ;Pick up position context MOV (R4)+,R2 ; MOV (R4),R3 ; MOV #GCML,R0 ;Get indirect file FDB CALL .POINT ;Point at return record NEXT: JMP INDRD ;Read in next line 3$: TRAP ERSBN ;Too deep nesting 4$: TRAP ERRET ;.RETURN without .GOSUB SYNERR: TRAP ERSYN ;Syntax error .DSABL LSB .SBTTL CHAIN - Processor for .CHAIN directive .ENABL LSB CHAIN:: CALL $GNBLK ;Get non-blank BCS SYNERR ;Syntax error DEC R0 ;Back up to first non-blank MOV R0,R2 ;Get address of filename string MOV CMDBE,R3 ;Get end of command buffer SUB R2,R3 ;Get length of filename string MOV #GCML,R0 ;Get GCML control block CALL $MGCL5 ;Close current file and open successor BCS SYNERR ;Syntax error 1$: TSTB BLOCK ;Any block context on stack? BEQ 2$ ;Branch if no CALL POPBLK ;Yes, clean up BR 1$ ;Check for more clean up 2$: MOV @SP,SSP ;Set subroutine stack pointer MOV SSP,SSB ;Set new beginning of stack CLR ERLBL ;Set no error processing label CALL CLRLBT ;Clear out direct access label table MOV LSYME,SYMND ;Set start of new local symbol table BR NEXT ;Return for next command .DSABL LSB .SBTTL STOP and EXIT entry points .ENABL LSB STOP:: MOV #6$,-(SP) ;Stop entry point BR 1$ ;Join common code EXIT:: MOV #3$,-(SP) ;Exit entry point 1$: CALL $GNBLK ;Any arguement? BCS 2$ ;If C-bit set no - end of line DEC R0 ;Point to numeric expression CALL EVNX ;Evaluate numeric expression MOV R1,SPSEXS+SEVAL ;Set up exit status MOV R1,STATUS ;Save in case of EOF CALL $GNBLK ;Look for end of line BCC SYNERR ;If c-bit clear - error nothing should follow 2$: JMP @(SP)+ ;Go do it ;+ ;Routine for .EXIT directive ;- 3$: TSTB BLOCK ;Within a block? BEQ 4$ ;Branch if no BISB #LEAVE,BLKFLG ;Indicate leaving block INCB SKIP ;Indicate we are skipping MOVB BLOCK,SCAN ;Indicate what level to look at BICB #GE.RWD,GCML+G.MODE ;Don't rewind, only look downward BR 5$ ;Get net command 4$: MOV #GCML,R1 ;Point to GCML control block CALL CLODEL ;Close and delete file if necessary CALL POPOP1 ;Pop up a level MOV #DUMCMD,G.CMLD+2(R1) MOV #1,G.CMLD(R1) MOV R1,R0 JMP INDFDC 5$: BR NEXT ;Get next line 6$: TRAP EREOF ;End of file message - not an error .DSABL LSB .SBTTL BEGIN block processing ;+ ;BEGIN ;Mark the beginning of a new block ;- .ENABL LSB BEGIN:: BITB #,BLKFLG ;Entered from IF command? 1$: BNE SYNERR ;Yes, error CALL PSHBLK ;Save current block context on stack ;+ ;Mark the position of the next line after BEGIN statment so GOTO can point the ;file when searching for a label. ;- MRKBLK: MOV #GCML,R0 ;Point to GCML control block CALL .MARK ;Mark the file MOV #CONTXT,R4 ;Point to block context MOV R1,(R4)+ ;Save position in file MOV R2,(R4)+ ; .... MOV R3,(R4)+ ; .... BR COMMON ;Exit rtn through BEGIN and END common code .SBTTL END block processing ;+ ;END ;End current block and return context. ;- END:: BITB #,BLKFLG ;Entered from an IF command? BNE 1$ ;If yes, error BICB #,BLKFLG ;Clear bit to leave CALL POPBLK ;Restore old block context from stack COMMON: CALL CLRLBT ;Clear direct access label table BR NEXT ;Get next line .DSABL LSB ROUNDUP YES ;Check for overflow and roundup .END