.MCALL .MODULE .MODULE INDOPN,VERSION=06,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 Macro and internal definitions ;+ ;System macro calls. ;- .MCALL .CSISPC, .RCTRLO, .PRINT, .LOCK, .UNLOCK .MCALL FDBDF$, FERDF$, RT5DF$, DEFIN$ FDBDF$ ;Define FDB offsets. FERDF$ ;Define file error codes. RT5DF$ ;Define RT definitions DEFIN$ ;Definitions for IND files .PSECT INDOPN .SBTTL INDOPN local data ;+ ;Local data. ;- .NLIST BEX ENATXT: .ASCIZ /SUBSTITUTION/ ;Substitution command (ASCII string) .ASCIZ /DATA/ ;Data command (ASCII string) .ASCIZ /GLOBAL/ ;Global command (ASCII string) .ASCIZ /LOWERCASE/ ;Lowercase command (ASCII string) .ASCIZ /ESCAPE/ ;Escape command (ASCII string) .ASCIZ /QUIET/ ;Quiet command (ASCII string) .ASCIZ /SUFFIX/ ;Sup. default & range spec for ASKx statements .ASCIZ /DCL/ ;Suppress execution of DCL commands .ASCIZ /MCR/ ;Same as DCL - RSX compatible .ASCIZ /DELETE/ ;Delete command file after execution .ASCIZ /OCTAL/ ;Set radix to OCTAL .ASCIZ /PREFIX/ ;Suppress printing of * and ; .ASCIZ /TRACE/ ;Set trace mode .ASCIZ /TIMEOUT/ ;Timeout on ask directives .ASCIZ /ABORT/ ;Disable control/c and control/z from keyboard .ASCIZ /CONTROL-Z/ ;Suppress abort from .ASKx statements .BYTE 0 ; ENA2: .ASCIZ /TYPEAHEAD/ ;Flush typeahead before .ASK .BYTE 0 ; .LIST BEX .EVEN SWITCH: .BLKW 1 ENAADD: .WORD DEFSUB ;Default to substitution. .WORD DATEX ;Data .WORD DEFGLS ;Global symbols .WORD LOWCAS ;Lower case characters .WORD ESCAPE ;Escape recognition .WORD QUIET ;Quiet mode .WORD SUFFIX ;Suppress default and range specifications .WORD KMON ;Suppress execution of DCL commands .WORD KMON ;For MCR setting- same as DCL .WORD DELETE ;Delete command file after execution .WORD OCTAL ;Bit cleared for OCTAL mode .WORD PREFIX ;0=suppress * and ; .WORD TRACE ;Set trace mode .WORD TIMOUT ;Time out on ask directives .WORD ABORT ;Disable control/c and control/z from keyboard .WORD CNTRLZ ;Disable control/z from .ASKx ENAA2: .WORD TYPAHD ;Flush typeahead before .ASK .SBTTL OPEN directives and TESTFILE directive entrys ;+ ;Entry point for TESTFILE. ;- .ENABL LSB TESTFL::MOV #<4>,SWITCH ;Indicate TESTFILE entry MOV #TSTFDB,R5 ;Point to FDB for TESTFILE. BR 2$ ;Service it ;+ ;Entry point for open for read directive. ;- OPENR:: MOV #<6>,SWITCH ;Indicate open for read BR 1$ ;Go service it ;+ ;Entry point for open for append directive. ;- OPENA:: CLR SWITCH ;Indicate OPEN/APPEND BR 1$ ;Join common code ;+ ;Entry for open directive. ;- OPEN:: MOV #<2>,SWITCH ;Indicate normal open for write 1$: CALL GDFDB ;Get FDB of data file BCS BFNERR ;Indicate error occured BNE FOPERR ;Branch if file is already open 2$: CALL $GNBLK ;Skip blanks BCS SYNERR ;Error - recieved end of line DEC R0 ;Back up to first non-blank MOV R0,R1 ;Copy buffer address MOV CMDBE,R3 ;Get address of end of command string SUB R1,R3 ;Calculate the length MOV R1,R2 ;Copy the pointer to the FILSPC 3$: CMPB (R2)+,# ;Is this the start of a comment? BEQ 4$ ;Yes - this is the end of FILSPC DEC R3 ;One less character remaining to scan BNE 3$ ;If ne, not yet done scanning 4$: SUB R1,R2 ;Calculate number of characters in FILSPC BEQ SYNERR ;No characters in FILSPC MOV #CSIBLK,R0 ;Point to the CSI block 5$: CMPB @R1,# ;ASCII character asterisk? BEQ SYNERR ;Yes, syntax error CMPB @R1,# ;ASCII percent sign? BEQ SYNERR ;Yes, syntax error CMPB @R1,# ;ASCII comma? BEQ SYNERR ;Yes, syntax error CMPB @R1,# ;ASCII equal? BEQ SYNERR ;Yes, syntax error CMPB @R1,# ;ASCII less than sign (equivalant to equals)? BEQ SYNERR ;Yes, syntax error MOVB (R1)+,(R0)+ ;Copy a character DEC R2 ;Clock the character moved BGT 5$ ;Branch if more. CLRB @R0 ;Fake ASCIZ string. MOV #CSIBLK,R2 ;Point to filespec .LOCK ;Gain ownership of USR to clear $BLKEY MOV @#SYSPTR,R0 ;Point to start of RMON CLR $BLKEY(R0) ;Initialize BLKEY to always force a read of ;a fresh directory .UNLOCK ;Free USR .CSISPC R2,#DFDAT,R2 ;Interpert the string. BCS SYNERR ;CSI error MOV #CSIBLK+36,R2 ;Point to RAD50 filespec TST (SP)+ ;Any switches? BNE SYNERR ;If so give error MOV R5,R1 ;Get FDB address MOV SWITCH,R4 ;Get the type of OPEN/TEST CALL @10$(R4) ;Dispatch to the appropriate routine BCC STRCOD ;Store return code for FILERR TST SWITCH ;Opening a file to append? BNE STRCOD ;No, don't check for special error return CMP #,F$ERR(R5) ;File not found? BNE STRCOD ;No, normal error processing CLR F$ERR(R5) ;Yes, clear error code BR OPEN ; and create a file ;+ ;Store error code into FILERR. ;- STRCOD: MOV #,R0 ;Point to area to store error code MOVB F$ERR(R5),(R0)+ ;Store low byte of error code CLRB @R0 ;Make sure there is nothing in high byte TST F$ERR(R5) ;Was the code 'SUCCESS'? BPL 6$ ;If plus, no error MOV R5,R0 ;Set up FDB address for error processing CMP #<4>,SWITCH ;TESTFILE operation? BNE DFEERR ;No SEC ;Make sure c-bit set on error 6$: MOV R1,R0 ;Copy FDB address. CALL FILSTR ;Expand the file specification string JMP INDRD ;Get next line ;+ ;Routine to test for existance of file (TESTFILE). ;- 7$: CALL $OPENR ;Open the file for read. BCS 8$ ;Exit from rtn with C-bit set if LOOKUP failed CALL C$LOSE ;If successful, close the file. 8$: RETURN ;Return to caller 9$: MOV #TSTFDB,R3 ;Get secondary FDB CALL $OPENA ;Go append a file RETURN ;Return to caller ;+ ;Dispatch table for OPEN/TEST functions. ;- 10$: .WORD 9$ ;Code = 0 open for append .WORD $OPENW ;Code = 2 open for write .WORD 7$ ;Code = 4 testfile .WORD $OPENR ;Code = 6 open for read DFEERR: TRAP ERDFE ;Data file open failure SYNERR: TRAP ERSYN ;Syntax error BFNERR: TRAP ERIFN ;Bad file number FOPERR: TRAP ERFOP ;File already open FNOERR: TRAP ERFNO ;File not open .DSABL LSB .SBTTL CLOSE/PURGE entry point ;+ ;CLOSE and PURGE file functions. ;- .ENABL LSB CLOSE:: MOV #<2>,SWITCH ;Indicate close entry. BR 1$ ;Branch to common code. PURGE:: CLR SWITCH ;Indicate purge entry. 1$: CLR ENDAT ;Implicit DISABLE DATA CALL GDFDB ;Get data file FDB MOV R5,R1 ;R1 points to FDB BCS BFNERR ;Error - bad file number BEQ FNOERR ;Error - file not open TST SWITCH ;PURGE or CLOSE entry? BEQ 2$ ;PURGE CALL C$LOSE ;Close the file. BR 3$ ;Branch to common exit. 2$: CALL $PURGE ;Purge the file. 3$: MOV #,R0 ;Point to area to store error code MOVB F$ERR(R5),(R0)+ ;Store low byte of error code CLRB @R0 ;Make sure there is nothing in high byte JMP INDRD ;Get next line .DSABL LSB .SBTTL DATA/READ entry points ;+ ;DATA ;Write a record ;- .ENABL LSB DATA:: CALL GDFDB ;Get data file FDB BCS BFNERR ;Error - bad file number BEQ FNOERR ;Error - file not open TSTB @R0 ;Blank line? BEQ 1$ ;Branch if yes CMPB (R0)+,# ;Next character a space? BEQ 1$ ;Branch if yes CMPB -1(R0),# ;Tab character? BNE SYNERR ;Syntax error 1$: MOV R0,R2 ;Yes, copy buffer address MOV CMDBE,R1 ;Get end of command buffer SUB R2,R1 ;Get length of data to write JMP WDATA ;Write data to data file ;+ ;READ ;Read from a file into a variable. ;- READ:: CALL GDFDB ;Get the FDB parameters if present BCS BFNERR ;Error - bad file number BEQ FNOERR ;Error - file not open MOVB #,SPEOF+SETYP ;Mark the end-of-file as FALSE SAVE ;Save the string pointer for later use MOV R5,R1 ;Point to file FDB MOV #SCR,R2 ;Point to scratch buffer. MOV #132.,R3 ;Set the length of the buffer CALL $RDREC ;Read the record. MOV #,R0 ;Point to area to store error code MOVB F$ERR(R5),(R0)+ ;Store low byte of error code BCC 3$ ;File reading worked CLRB @R0 ;Make sure there is nothing in high byte RESTOR ;Now restore the string pointer. CMP F$ERR(R5),# ;END-OF-FILE error? BNE STRCOD ;Error, set error code in FILERR MOVB #,SPEOF+SETYP ;Setup the 'END-OF-FILE' flag. 2$: JMP INDRD ;Get next command line 3$: CLRB @R0 ;Make sure there is nothing in high byte RESTOR ;Restore the string pointer. MOVB #,SYMTP ;Setup the symbol type for definition. SAVE ;Save address and length of the record. CALL PRSYM ;Setup the symbol information. RESTOR ;Get the address and length of string returned CALL ASVALS ;Assign the string value BCC 2$ ;Success - done. TRAP ERSOV ;Error - symbol table overflow. .DSABL LSB .SBTTL CHKLST - Check for valid mode ;+ ;CHKLST ;This subroutine compares what's in the command buffer to a table of ASCII ;commands. If there is a match R1 points to the address of the routine to ;to execute. If there is not a match, the c-bit is set. ;If there is a match R3 will, on exit, point to either TMPFLG or TMPFL2 ;depending on whether the match was in the first or second group. ;- .ENABL LSB CHKLST::CALL $GNBLK ;Get next non-blank BCS 1$ ;Syntax error TST R1 ;Any blanks seen? BEQ 1$ ;No, syntax error CHK1:: MOV #ENATXT,R2 ;Yes, get address of valid strings DEC R0 ;Back up to first character MOV R0,-(SP) ;Save location of first character CALL TBSRC ;Search table for string BCS 1$ ;Not in first word. Try second MOV #TMPFLG,R3 ;Assume first flag word TST (SP)+ ;Pop R0 off stack MOV ENAADD(R1),R1 ;Get address of routine to branch to BR 2$ ;Make sure c-bit cleared 1$: MOV (SP)+,R0 ;Point to first character MOV #ENA2,R2 ;Get address of second flag word CALL TBSRC ;Search second table for string BCS 3$ ;Not in second word either MOV #TMPFL2,R3 ;Second flag word MOV ENAA2(R1),R1 ;Get address of routine to branch to 2$: CLC ;Make sure carry clear 3$: RETURN .DSABL LSB .END