Trailing-Edge
-
PDP-10 Archives
-
BB-D868C-BM
-
language-sources/oprpar.mac
There are 36 other files named oprpar.mac in the archive. Click here to see a list.
TITLE OPRPAR PARSING ROUTINE FOR OPR AND ORION
SUBTTL Murray Berkowitz/PJT Oct 13, 1979
;
;
; COPYRIGHT (c) 1975,1976,1977,1978,1979
; DIGITAL EQUIPMENT CORPORATION
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
; AND 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. NO TITLE TO
; AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE
; WITHOUT NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
; BY DIGITAL EQUIPMENT CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY
; DIGITAL.
SEARCH GLXMAC,ORNMAC
PROLOG (OPRPAR)
PAREDT==:65
RELOC
SUBTTL Table of Contents
; TABLE OF CONTENTS FOR OPRPAR
;
;
; SECTION PAGE
; 1. Table of Contents......................................... 2
; 2. PARSER ENTRY POINTS....................................... 3
; 3. PARSER DATA BASE AND CONSTANTS............................ 4
; 4. P$INIT PARSER INIT ROUTINE............................... 5
; 5. PARINI PARSER INITIALIZATION CALL........................ 6
; 6. PARSER PARSER ENTRY POINT................................ 7
; 7. PARCMD PARSE THE COMMAND................................. 8
; 8. VALCMD VALID COMMAND PARSE ROUTINE....................... 9
; 9. PARRET PARSER CODE TO RETURN TO CALLER................... 10
; 10. PARERR COMND JSYS ERROR ROUTINE......................... 11
; 11. CHKEOF CHECK END OF TAKE FILE............................ 12
; 12. CLSTAK CLOSE THE TAKE FILE............................... 13
; 13. TAKCLR CLEANUP AFTER TAKE FILE........................... 13
; 14. ERREXT ERROR RETURN FROM PARSER.......................... 14
; 15. INCORE CHECK AND SETUP FOR INCORE PROCESSING............. 15
; 16. CMDMES CHECK AND/OR SETUP THE COMMAND MESSAGE............ 16
; 17. SETPMT SETUP THE PROMPT POINTER.......................... 17
; 18. RESCN Rescan routine to setup initial command......... 18
; 19. Dispatch for Parser Save Routines......................... 19
; 20. SAVE ROUTINES FOR COMND................................... 20
; 21. SAVE ROUTINE FOR FILE SPECS............................... 21
; 22. SAVE ROUTINE TO COPY VALUES FROM ATOM BUFFER.............. 22
; 23. SAVE ROUTINE FOR COMMA, CONFRM..FUNCTION ONLY............. 22
; 24. SAVE ROUTINE FOR NUMBERS.................................. 22
; 25. SAVUQS SAVE ROUTINE FOR UNQUOTED STRING............... 23
; 26. SAVE ROUTINE FOR SINGLE VALUE FUNCTIONS................... 24
; 27. SAVDEV SAVE ROUTINE FOR A DEVICE...................... 25
; 28. SAVE ROUTINE TO SAVE A TOKEN.............................. 26
; 29. SAVE NODE SPECIFICATION................................... 26
; 30. Initialization for Parser Save Routines................... 26
; 31. Routine to Set Up for COMND Reparse....................... 27
; 32. Routine To Fill in Defaults for COMND..................... 28
; 33. SWITCH TABLE PROCESSING ROUTINES.......................... 29
; 34. STBDEL SWITCH TABLE DELETE ROUTINE....................... 29
; 35. TXTINP MULTIPLE LINE TEXT INPUT ROUTINES................. 30
; 36. GETTXT INPUT MULTIPLE LINE TEXT.......................... 31
; 37. TAKE Command Table........................................ 32
; 38. TAKDEF TAKE DEFAULT SETTING.............................. 32
; 39. TAKE SPECIAL ROUTINES FOR TAKE COMMANDS................ 33
; 40. TAKOPN ROUTINE TO OPEN THE TAKE FILE..................... 33
; 41. WAITCM WAIT COMMAND AND TABLES........................... 34
; 42. P$STAK SETUP TAKE COMMAND DATA........................... 35
; 43. P$SETU SETUP THE PARSER BLOCK POINTER ADDRESS............ 36
; 44. P$CURR GET THE ADDRESS OF THE CURRENT ENTRY.............. 36
; 45. P$PREV POSITION TO PREVIOUS PARSER ENTRY................. 36
; 46. P$NEXT BUMP THE POINTER TO NEXT FIELD................... 37
; 47. P$NFLD TO GET HEADER AND DATA FOR A PARSER ELEMENT....... 37
; 48. P$CFM CHECK FOR A CONFIRM IN NEXT BLOCK................. 38
; 49. P$COMMA CHECK FOR A COMMA IN NEXT BLOCK................... 39
; 50. P$KEYW GET A KEYWORD FROM THE PARSED DATA................ 40
; 51. P$SWIT GET A SWITCH FROM THE PARSED DATA................. 41
; 52. P$USER GET THE USER ID FIELD............................. 42
; 53. P$FLOT GET THE FLOATING POINT NUMBER..................... 43
; 54. P$DIR GET THE DIRECTORY FIELD........................... 44
; 55. P$TIME GET THE TIME/DATE FIELD........................... 45
; 56. P$NUM GET A NUMBER FROM THE PARSER BLOCK................ 46
; 57. P$FILE GET A FILESPEC FROM THE PARSER BLOCK.............. 47
; 58. P$FLD GET A TEXT FIELD FROM BLOCK....................... 48
; 59. P$NODE GET A NODE FROM BLOCK............................. 49
; 60. P$SIXF GET A SIXBIT FIELD TYPE........................... 50
; 61. P$RNGE GET A RANGE BACK.................................. 51
; 62. P$TEXT GET A TEXT ADDRESS AND LENGTH..................... 52
; 63. P$DEV GET A DEVICE ADDRESS AND LENGTH................... 53
; 64. P$QSTR GET A QUOTED STRING............................... 54
; 65. P$UQSTR GET AN UNQUOTED STRING............................ 55
; 66. P$ACCT GET AN ACCOUNT STRING............................. 56
; 67. P$NPRO No Processing Required............................ 57
; 68. P$GPDB GET THE PDB ADDRESS IF ANY DATA................... 58
; 69. P$PNXT GET NEXT PDB GIVEN A PDB BLOCK.................... 59
; 70. P$PERR GET ERROR ROUTINE GIVEN A PDB BLOCK............... 60
; 71. P$PDEF GET DEFAULT FILLER ROUTINE GIVEN A PDB BLOCK...... 61
; 72. P$PACT GET ACTION ROUTINE GIVEN A PDB BLOCK.............. 62
; 73. P$INTR PARSER INTERRUPT SUPPORT CODE..................... 63
; 74. GETCJB GET THE CONTROLLING JOB........................... 64
; 75. SETTIM SETUP THE TIMER FUNCTION.......................... 65
; 76. CLRTIM CLEAR THE TIMER FUNCTION.......................... 66
; 77. P$TINT TIMER INTERRUPT ROUTINE........................... 67
; 78. CNTCHR COUNT CHARACTERS IN THE BUFFER.................... 68
; 79. REPRMT DO REPROMPT OF COMMAND............................ 69
; 80. P$HELP Routine to display help from file............. 70
SUBTTL REVISION HISTORY
COMMENT \
2 OPRPAR 8-Sept-78 Fix INCORE parsing and Add P.ENDT. Also
Release JFNS in file save routines
3 OPRPAR 12-Sept-78 Add GETTXT AND TXTINP Routines from OPR
4 OPRPAR 15-Sept-78 Have OPRPAR take a pointer for Incore parsing
5 OPRPAR 29-Sept-78 Add P$KEYW ..etc for Analyzing Parsed Blocks
6 OPRPAR 15-Oct-78 Fix PARSER to accept address in PAR.CM
7 OPRPAR 30-Oct-78 Fix .CMDEV Save Routines as well as
add P$DEV to Get Device Data
add P$QSTR to get Quoted String
10 OPRPAR 15-Nov-78 Fix GETTXT Routine to put out correct prompt
11 OPRPAR 15-Nov-78 Add Unquoted String and Accounting Routine to
the Parser.
12 OPRPAR 5-Dec-78 Fix P$NODE on the -10 to accept field as SIXBIT
13 OPRPAR 26-Dec-78 Fix INCORE to accept all Byte Pointers
14 OPRPAR 28-Dec-78 Fix GETTXT bug. Did not put null on end
15 OPRPAR 4-JAN-79 Allow non-dispatch keywords and
change KEYTAB to ORNKEY
change SWITAB To ORNSDP
Add S1 value on action false return to
PRT.EC of return block
16 OPRPAR 8-JAN-79 SETUP CURPDB FOR CURRENT PDB
17 OPRPAR 24-JAN-79 ADD P$COMMA TO CHECK FOR A COMMA
20 OPRPAR 26-JAN-79 ADD P$TIME TO RETURN UDT FOR TIME/DATE
21 OPRPAR 29-JAN-79 CHANGE BUMPPB TO P$NEXT TO BUMP TO NEXT FIELD
22 OPRPAR 6-FEB-79 ADD P$DIR TO GET DIRECTORY INFO
23 OPRPAR 7-FEB-79 CREATE P$NFLD TO RETURN FIELD HEADER IN S1,
ADDRESS OF BLOCK IN S2, AND PB TO NEXT FIELD
24 OPRPAR 9-Feb-79 Correct byte Pointers for SAVTOK and SETPMT.
Check temp table size when moving data
25 OPRPAR 23-Feb-79 Add Timer and Interrupt support into OPRPAR
and define P$INIT,P$INTR, AND P$TINT
26 OPRPAR 5-Mar-79 Add P$STAK to setup JFN for TAKE Command for
Take Commands not using TAKFDB
27 OPRPAR 7-MAR-79 Correct memory bug with ERRSAV
30 OPRPAR 13-MAR-79 Fix Timer Bug
31 OPRPAR 16-MAR-79 Add new ERRPDB support, Call ERROR and DEFAULT
Filling with CMDRET block and move DEFAULT
Filling before call to S%CMND
32 OPRPAR 20-Mar-79 Remove ac M from OPRPAR and Create PARDAT to
Hold address of the page
33 OPRPAR 11-Apr-79 Clear the Timer if set in CLRTIM using TIMSET
as the flag instead of TIMINT
34 OPRPAR 13-Apr-79 Add P$FLOT for Floating Point data
35 OPRPAR 19-Apr-79 Fix Save for Unquoted String to check if null
Input
36 OPRPAR 26-Apr-79 Clear all Take Flags on Take error
37 OPRPAR 26-Apr-79 Clear Reparse flag at VALC.4, used
wrong AC
40 OPRPAR 6-May-79 use F%REL to close Take file on the -20
Reset the buffer pointers in CMDBLK
ON A SUCCESSFUL PARSE.
41 OPRPAR 15-May-79 Reset .CMCNT on good command
42 OPRPAR 25-May-79 Have the ERROR routines continue on if return
true assuming that the caller has updated the
PDB of where to go next
43 OPRPAR 30-May-79 Add a WAIT command that will sleep for a
period of time and/or an interrupt
44 OPRPAR 12-Jun-79 Add P$SETU, P$CURR and P$PREV and eliminate
PB from being used
45 OPRPAR 14-Jun-79 Change the default for Take files to be DSK:
instead of SYS:
46 OPRPAR 21-Jun-79 Strip sequence numbers on TAKE files and
add PRT.CF to the return block for the command
Flag word incase user wishes to see the COMND
Block
47 OPRPAR 24-Jun-79 Add support for new PDB macros which only expand
what is needed
50 OPRPAR 29-Jun-79 Add another word to the calling block for the
ACTION routines which contains the address of
the saved data. The ERROR and PREFILL routines
will also have this value but will contain the
address of the last saved argument or zero
51 OPRPAR 2-Jul-79 Allow line sequence numbers for take files on
the -20 and breakout file open and close for
take files as separate routines
52 OPRPAR 13-Jul-79 Fix Reparse Bug
53 OPRPAR 24-Jul-79 Fix -10 Take Bug.. forgot a $RETT
54 OPRPAR 18-Sept-79 Support a RESCAN on an incore parse if the
incore flag is -1.
55 OPRPAR 19-Sept-79 Change WAITRN on the -10 to use SLEEP UUO
56 OPRPAR 20-Sept-79 Add support for P.CEOF EOF on INCORE parse.
57 OPRPAR 13-Oct-79 Add P$HELP routine
60 OPRPAR 24-Oct-79 Add reparse flag for parser for interrupt
61 OPRPAR 27-Oct-79 Fix GETTXT to work with usersupplied block
entry. Change CLRTIM and SETTIM to use
absolute times instead of clearing all
outstanding interrupts.
62 OPRPAR 28-Oct-79 Add P$TAKE to setup for take command
63 OPRPAR 3-Nov-79 Fix a bug in P$STAK
64 OPRPAR 21-Nov-79 Always return buffer address on return
from parser.
65 OPRPAR 29-Nov-79 Fix a bug in P$HELP
\
SUBTTL PARSER ENTRY POINTS
ENTRY PARSER ;MAIN ENTRY POINT
ENTRY P$GPDB ;GET THE PDB BLOCK
ENTRY P$PNXT ;GET NEXT PDB GIVEN A PDB BLOCK
ENTRY P$PERR ;GET ERROR BLOCK FROM PDB GIVEN A PDB
ENTRY P$PDEF ;GET DEFAULT FILLING ROUTINE GIVEN A PDB
ENTRY P$PACT ;GET ACTION ROUTINE GIVEN A PDB
ENTRY P$NARG ;NEXT ARGUMENT TYPE TO PROCESS
ENTRY P$SETU ;SETUP POINTER TO PARSER BLOCKS
ENTRY P$CURR ;GET THE CURRENT LOCATION
ENTRY P$PREV ;SET THE PREVIOUS TO CURRENT
ENTRY P$FLOT ;FLOATING POINT NUMBER
ENTRY P$TAKE ;SETUP STATE BLOCK FOR TAKE ROUTINE
ENTRY P$INIT ;PARSER INIT
ENTRY P$NPRO ;NO PROCESSING REQUIRED
ENTRY P$INTR ;PARSER INTERRUPTS
ENTRY P$TINT ;TIMER INTERRUPTS
ENTRY P$NFLD ;GET NEXT FIELD DATA
ENTRY P$DIR ;GET THE DIRECTORY FIELD
ENTRY P$NEXT ;GET TO NEXT FIELD
ENTRY P$TIME ;GET DATE/TIME
ENTRY P$COMMA ;COMMA CHECK
ENTRY P$CFM ;CONFIRM CHECK
ENTRY P$KEYW ;KEYWORD CHECK
ENTRY P$SWIT ;SWITCH CHECK
ENTRY P$USER ;USER CHECK
ENTRY P$NUM ;NUMBER CHECK
ENTRY P$FILE ;FILE SPEC CHECK
ENTRY P$IFIL ;INPUT FILE SPEC
ENTRY P$OFIL ;OUTPUT FILE SPEC
ENTRY P$FLD ;FIELD CHECK
ENTRY P$TOK ;TOKEN CHECK
ENTRY P$NODE ;NODE CHECK
ENTRY P$SIXF ;SIXBIT FIELD CHECK
ENTRY P$RNGE ;RANGE OF NUMBERS
ENTRY P$TEXT ;TEXT CHECK
ENTRY P$DEV ;GET A DEVICE STRING
ENTRY P$QSTR ;QUOTED STRING
ENTRY P$UQSTR ;UNQUOTED STRING
ENTRY P$ACCT ;ACCOUNT STRING
;NON-STANDARD ROUTINES
ENTRY P$STAK ;SETUP FOR TAKE
ENTRY PDBCPY ;COPY A PDB
ENTRY TXTINP ;GET TEXT BLOCK FROM TERMINAL
GLOB <TAKFDB,WAIFDB,BADIFI,TEMFDB>
OPDEF $RETIF [JUMPF .POPJ] ;Return error on failure
SUBTTL PARSER DATA BASE AND CONSTANTS
$DATA CURRPB,1 ;CURRENT PARSER BLOCK ADDRESS
$DATA PREVPB,1 ;PREVIOUS PARSER BLOCK ADDRESS
$DATA PRMFLG,1 ;FLAG FOR "PROCESSING MESSAGES"
$DATA CURPMT,1 ;POINTER TO CURRENT PROMPT
$DATA CURPTR,1 ;POINTER TO START OF LAST FIELD
$DATA CURPDB,1 ;PDB FOR THE DEFAULT FILLER
$DATA TIMSET,1 ;TIMER WAS SET
$DATA TIMINT,1 ;TIMER INTERUPT BREAKOUT
$DATA TIMCHK,1 ;FLAG THAT TIMER CHECKS IN USE
$DATA TIMDAT,2 ;DATA FROM PARSER INIT CALL
$DATA TIMPC,1 ;ADDRESS OF THE PC AT INTERRUPT
$DATA TIMSTI,1 ;TIMER INTERUPT CHARACTER SETUP
$DATA PRMTSZ,1 ;SIZE OF THE PROMPT
$DATA OPRTAK,1 ;DEFAULT DISPLAY FOR ALL TAKES
$DATA TXTDAT,.RDBRK+1 ;TEXTI ARGUMENT BLOCK
$DATA TEMPTR,1 ;TEMPORARY TEXT POINTER
$DATA DSPTAK,1 ;DISPLAY TAKE COMMAND FLAG
$DATA PARBLK,PRT.SZ ;PARSER RETURN BLOCK
$DATA PARINT,1 ;PARSER INITIALIZED FLAG
$DATA CORPAR,1 ;INITIAL SETTING FOR CORE PARSE
$DATA REEPAR,1 ;FLAG SAYS WE WERE CALLED FOR REPARSE
$DATA CMDBLK,.CMGJB+5 ;COMMAND STATE BLOCK FOR COMND JSYS
$DATA BUFFER,BUFSIZ ;INPUT TEXT STORED HERE
$DATA ATMBFR,ATMSIZ ;ATOM BUFFER FOR COMND JSYS
$GDATA GJFBLK,GJFSIZ ;GTJFN BLOCK FOR COMND JSYS
;***MIGHT NEED TO ENLARGE OR MAKE DYNAMIC
$DATA DENTRY,2 ;DELETE ENTRY WORDS(S1 AND S2)
$DATA DFLAGS,1 ;DELETE FLAG FOR TEMP SWITCH TAB
$DATA TEMTAB,TEMTSZ ;SAVE 10 WORDS FOR SWITCH TABLE
$GDATA TEMFDB,PDB.SZ ;TEMP FDB AREA
$DATA CMDERR,^D50 ;SPACE FOR COMMAND ERROR TEXT
$DATA CMDEPT,1 ;COMMAND ERROR MESSAGE POINTER
$DATA CMDECT,1 ;COMMAND ERROR MESSAGE COUNT
$DATA CMDRET,PC.SIZ ;COMMAND RETURN DATA
$DATA ARGSAV,PAR.SZ ;SAVE AREA FOR PARSER ARGUMENTS
$DATA ERRSAV,1 ;MESSAGE ADDRESS ON ERROR
$DATA ERRSTG,1 ;ADDRESS OF ERROR MESSAGE
;STORAGE FOR $TEXT CHARACTER STORER
$DATA STRBP,1 ;SPACE FOR A BYTE POINTER
;STORAGE FOR PARSER TO EVENT PROCESSOR COMMUNICATION
$DATA PARDAT,1 ;ADDRESS OF PARSER DATA MESSAGE
$GDATA ARGFRE,1 ;POINTER TO FIRST FREE WORD IN ARG SPACE
$DATA FLAGS,1 ;PARSER FLAG WORD
$DATA ERRSTK,1 ;ERROR STACK FOR COMMAND
$DATA INTEXT,1 ;INTERRUPT EXIT
;TAKE STORAGE
$DATA CMDIFN,1 ;STORAGE FOR COMMAND FILE IFN
$DATA LOGIFN,1 ;STORAGE FOR LOGGING FILE IFN
$DATA CMDJFN,1 ;STORAGE FOR COMMAND FILE JFN
$DATA LOGJFN,1 ;STORAGE FOR LOGGING FILE JFN
$DATA TAKFLG,1 ;FLAG TO INDICATE WE ARE IN TAKE COMMAND
SUBTTL P$INIT PARSER INIT ROUTINE
;THIS ROUTINE WILL SETUP FOR TIMER INTERRUPTS IF POSSIBLE(20 ONLY)
;AND INIT THE PARSER
;CALL S1/ LEVEL,, TIMER CHANNEL OR OFFSET
; S2/ BASE OF INTERRUPT SYSTEM OR <LEVTAB,,CHNTAB>
P$INIT: SETZM TIMCHK ;CLEAR TIMCHK SETTING
DMOVEM S1,TIMDAT ;SAVE THE VALUES
$CALL PARINI ;INIT THE PARSER
SKIPN TIMDAT+1 ;ANYTHING SPECIFIED?
$RETT ;NO, RETURN
TOPS20 <
MOVX S2,1B0 ;PLACE A BIT IN WORD
HRRZ S1,TIMDAT ;GET THE CHANNEL
MOVN S1,S1 ;MAKE IT NEGATIVE
LSH S2,0(S1) ;POSITION THE CHANNEL NUMBER
MOVEI S1,.FHSLF ;GET MY HANDLE
AIC ;ATTACH TO INTERRUPT SYSTEM
HRRZ S2,TIMDAT+1 ;GET CHANNEL TABLE ADDRESS
HRRZ TF,TIMDAT ;GET THE CHANNEL
ADD S2,TF ;GET CHANNEL TABEL LOCATION
HLLZ S1,TIMDAT ;GET LEVEL VALUE
HRRI S1,P$TINT ;TIMER INTERRUPT LOCATION
MOVEM S1,(S2) ;SAVE IN CHANNEL TABLE
SETOM TIMCHK ;SET TIME CHECK IN EFFECT
HLRZ S1,TIMDAT+1 ;GET LEVTAB ADDRESS
HLRZ S2,TIMDAT ;GET LEVTAB LEVEL
ADDI S1,-1(S2) ;GET LEVTAB ADDRESS
MOVE S2,(S1) ;GET ADDRESS OF PC
MOVEM S2,TIMPC ;SAVE THE PC ADDRESS WORD
> ;End TOPS20
TOPS10 <
MOVE S1,TIMDAT+1 ;ADDRESS OF VECTOR
ADDI S1,.PSVOP ;PC ADDRESS WORD
MOVEM S1,TIMPC ;SAVE ADDRES WORD
> ;End TOPS10
$RETT ;RETURN
SUBTTL PARINI PARSER INITIALIZATION CALL
;THIS ROUTINE IS CALLED TO SET UP THE PARSER DATA BASE FOR
;USE IN SUBSEQUENT CALLS TO THE PARSER ENTRY PARRTN
PARINI: SETOM PARINT ;REMEMBER PARSER INITIALIZED
HRROI S1,[ASCIZ /PARSER>/] ;GET POINTER TO PROMPT STRING
MOVEM S1,CMDBLK+.CMRTY ;PUT RE-TYPE PROMPT POINTER IN STATE BLOCK
HRROI S1,BUFFER ;GET POINTER TO INPUT TEXT BUFFER
MOVEM S1,CMDBLK+.CMPTR ;SAVE POINTER TO COMMAND STRING
MOVEM S1,CMDBLK+.CMBFP ;SAVE POINTER TO START-OF-BUFFER
MOVEI S1,.PRIIN ;SET PRIMARY INPUT
MOVEM S1,CMDJFN
MOVEI S1,.PRIOU ;SET PRIMARY OUTPUT
MOVEM S1,LOGJFN
MOVEI S1,REPARS ;GET RE-PARSE ADDRESS
MOVEM S1,CMDBLK+.CMFLG ;SAVE RE-PARSE ADDRESS
SETZM CMDBLK+.CMINC ;INITIALIZE # OF CHARACTERS AFTER POINTER
MOVEI S1,BUFSIZ*NCHPW ;GET # OF CHARACTERS IN BUFFER AREA
MOVEM S1,CMDBLK+.CMCNT ;SAVE INITIAL # OF FREE CHARACTER POSITIONS
HRROI S1,ATMBFR ;GET POINTER TO ATOM BUFFER
MOVEM S1,CMDBLK+.CMABP ;SAVE POINTER TO LAST ATOM INPUT
MOVEI S1,ATMSIZ*NCHPW ;GET # OF CHARACTERS IN ATOM BUFFER
MOVEM S1,CMDBLK+.CMABC ;SAVE COUNT OF SPACE LEFT IN ATOM BUFFER
MOVEI S1,GJFBLK ;GET ADDRESS OF GTJFN BLOCK
MOVEM S1,CMDBLK+.CMGJB ;SAVE IN COMMAND STATE BLOCK
SETZM ERRSAV ;CLEAR THE ERROR SAVE MESSAGE PAGE
MOVEI S1,CMDBLK ;GET THE COMMAND STATE BLOCK
MOVEM S1,CMDRET+CR.FLG ;SAVE IN FLAG WORD
SETZM CMDBLK+CR.RES ;CLEAR RESULT FIELD
SETZM CMDBLK+CR.COD ;CLEAR THE FIELD CODE
MOVE S1,ARGSAV+PAR.TB ;GET THE TABLE ADDRESS
AOS S1 ;POSITION TO THE PDB
MOVEM S1,CMDRET+CR.PDB ;SAVE AS THE CURRENT PDB
$RET ;RETURN
SUBTTL PARSER PARSER ENTRY POINT
;THIS ROUTINE HAS THE FOLLOWING CONVENTIONS
;
;CALL: S1/ SIZE OF THE ARGUMENT BLOCK
; S2/ ADDRESS OF THE ARGUMENT BLOCK
;
;RETURN TRUE: S1/LENGTH OF ARGUMENT BLOCK
; S2/ ADDRESS OF THE BLOCK
;
;RETURN FALSE: S1/LENGTH OF RETURN BLOCK
; S2/ ADDRESS OF RETURN BLOCK
PARSER: $CALL .SAVET ;Save the temporaries
CAIE S1,0
CAILE S1,PAR.SZ ;WITHIN PROPER BOUNDS
JRST [MOVEI S2,[ASCIZ/Invalid parser block size/]
PJRST ERREXT] ;SETUP RETURN BLOCK
SETOM REEPAR ;ASSUME REPARSE
JUMPL S1,PARS.2 ;ARE WE?
SETZM REEPAR ;NO, CLEAR THE FLAG
HRLZ S2,S2 ;SOURCE OF THE ARGUMENTS LH
HRRI S2,ARGSAV ;DESTINATION
BLT S2,ARGSAV-1(S1) ;MOVE THE DATA
PARS.1: CAIE S1,PAR.SZ ;DONE ALL ARGUMENTS?
JRST [SETZM ARGSAV(S1) ;NO, CLEAR THE FIELD
AOJA S1,PARS.1] ;CHECK FOR ALL
PARS.2: SKIPN PARINT ;INITIALIZED?
$CALL PARINI ;NO, THEN DO IT
$CALL INCORE ;CHECK IF INCORE PROCESSING
$CALL CMDMES ;SET UP COMMAND MESSAGE BLOCK
SKIPN S1,ARGSAV+PAR.PM ;PROMPT PROVIDED?
MOVEI S1,[ASCIZ/PARSER>/] ;NO USE THE DEFAULT
$CALL SETPMT ;SET THE PROMPT
MOVE S2,ARGSAV+PAR.TB ;ADDRESS OF THE TABLES
AOS S2 ;POSITION TO THE FDB
MOVEM S2,CMDRET+CR.PDB ;SAVE AS THE CURRENT PDB
SKIPN REEPAR ;DOING REPARSE
SKIPE CORPAR ; OR CORE PARSE BEING DONE?
PJRST REPARSE ;YES, TREAT IT AS A REPARSE
SKIPE TIMINT ;WAS THERE A TIMER INTERRUPT
JRST [LOAD T1,.CMFNP(S2),CM%FNC ;GET THE FUNCTION CODE
CAIN T1,.CMINI ;NOT .CMINI SKIP REPROMPT
PUSHJ P,REPRMT ;REPROMPT
JRST REPARSE] ;AND REPARSE
PJRST PARCMD ;PARSE THE COMMAND
SUBTTL PARCMD PARSE THE COMMAND
;THIS ROUTINE WILL DO ANY DEFAULT FILLING AND THEN CALL
;S%CMND TO PARSE THE COMMAND
PARCMD: $CALL FILDEF ;FILL IN ANY DEFAULTS IF NEEDED
JUMPF ERREXT ;ERROR..RETURN
SKIPE DFLAGS ;ANY ENTRY TO DELETE
$CALL STBDEL ;DELETE THE ENTRY
LOAD S2,CMDRET+CR.PDB,RHMASK ;GET THE CURRENT PDB
MOVE S1,CMDBLK+.CMPTR ;GET CURRENT BUFFER POINTER
MOVEM S1,CURPTR ;SAVE CURRENT POINTER
MOVEI S1,CMDBLK ;ADDRESS OF THE COMMAND BLOCK
$CALL S%CMND ;CALL COMND TO PARSE COMMAND
MOVE T1,CR.FLG(S2) ;GET THE RETURNED FLAGS
MOVEM T1,PARBLK+PRT.CF ;SAVE THE COMMAND FLAGS
JUMPF PARERR ;PARSER ERROR ROUTINE
HRLZ T2,S2 ;SOURCE IN LEFT HALF
HRRI T2,CMDRET ;SOMMAND RETURN BLOCK
BLT T2,CMDRET-1(S1) ;SAVE THE DATA
TXNE T1,CM%INT ;INTERRUPT OCCUR
JRST ERRINT ;ERROR INTERRUPT RETURN
TXNN T1,CM%NOP ;VALID COMMAND ENTERED
JRST VALCMD ;YES, CHECK IT OUT
PARC.1: LOAD S1,CR.PDB(S2),LHMASK ;GET STARTING PDB
$CALL P$PERR ;GET THE ERROR PDB
JUMPF PARERR ;NONE..ERROR..
MOVE T1,S1 ;SAVE THE ERROR BLOCK
TLZE T1,400000 ;PARSER ERROR PDB?
JRST [STORE T1,CMDRET+CR.PDB,RHMASK ;SAVE AS NEXT PDB
JRST PARCMD] ;ANY RETRY THE PARSE
MOVEI S1,PC.SIZ ;GET THE ARGUMENT BLOCK
MOVEI S2,CMDRET ;GET BLOCK ADDRESS
$CALL (T1) ;USE THE ERROR ROUTINE
JUMPT PARCMD ;GOOD RETURN .. PARSE THE COMMAND
SKIPE S2 ;IF S2 HAS ERROR SET..SKIP
PJRST ERREXT ;ERROR CODE..GO TO EXIT
$CALL S%ERR ;SET UP THE ERROR RETURN
MOVE S2,S1 ;ADDRESS OF MESSAGE IN S2
PJRST ERREXT ;PARSER ERROR RETURN
SUBTTL VALCMD VALID COMMAND PARSE ROUTINE
;THIS ROUTINE WILL GET CONTROL ON A SUCCESSFUL PARSE FROM COMMAND
VALCMD: SKIPL T1,CMDRET+CR.COD ;GET THE PARSED FIELD CODE
CAILE T1,.CMNOD ;WITHIN RANGE OF VALID FUNCTIONS
$STOP(IFC,INVALID FUNCTION CODE FROM COMMAND)
MOVE S1,ARGFRE ;ADDRESS OF NEXT PLACE TO SAVE
MOVEM S1,CMDRET+CR.SAV ;SAVE THE ELEMENT
MOVX S1,PC.SIZ ;SIZE OF THE BLOCK
MOVEI S2,CMDRET ;COMMAND RETURN BLOCK
$CALL @PARTAB(T1) ;SAVE THE DATA FROM COMMAND
LOAD S1,CMDRET+CR.PDB,RHMASK ;GET THE USED PDB BYE COMMAND
$CALL P$PACT ;ANY ACTION ROUTINE
JUMPF VALC.1 ;NO, CONTINUE ON
MOVE T2,S1 ;SAVE ROUTINE IN T2
MOVX S1,PC.SIZ ;SIZE OF THE BLOCK
MOVEI S2,CMDRET ;COMMAND RETURN BLOCK
$CALL (T2) ;PROCESS THE ROUTINE
JUMPF VALC.3 ;BAD RETURN..SET UP ERROR
VALC.1: MOVE T1,CMDRET+CR.COD ;GET THE CODE FIELD
MOVE T2,CMDRET+CR.RES ;DATA FROM COMMAND PARSE
LOAD S1,CMDRET+CR.PDB,RHMASK ;GET THE USED PDB FROM PARSE
$CALL P$PNXT ;IS THERE A NEXT FIELD?
JUMPT VALC.2 ;GO USE IT
CAXE T1,.CMKEY ;YES, WAS IT A KEYWORD?
CAXN T1,.CMSWI ;OR A SWITCH?
SKIPA ;YES,
JRST PARRET ;NO NEXT..RETURN
HRRZ S1,(T2) ;<R15>YES, GET NEXT PDB FROM DSPTAB
MOVE S1,(S1) ;<R15>NOT FROM PDB
HRRZS S1 ;PASS ONLY THE RIGHT HALF
JUMPE S1,PARRET ;NONE..RETURN WITH MESSAGE
VALC.2: AOS S1 ;BUMP TO FDB OVER THE HEADER
STORE S1,CMDRET+CR.PDB,RHMASK ;SAVE THE NEXT BLOCK
JRST PARCMD ;GO FINISH THE COMMAND
VALC.3: MOVX T2,P.REPA ;REPARSE FLAG SET
TDNE T2,FLAGS ;WAS IT SET??
JRST VALC.4 ;YES, SETUP FOR REPARSE
SKIPN S2 ;IF S2 HAS ERROR SET..SKIP
MOVEI S2,[ASCIZ/Action routine error aborted command/]
MOVX T2,P.ACTE ;ACTION ROUTINE ERROR
IORM T2,FLAGS ;SAVE IN THE FLAGS
MOVEM S1,PARBLK+PRT.EC ;SAVE ANY CODE FOR CALLER
PJRST ERREXT ;ERROR RETURN
VALC.4: ANDCAM T2,FLAGS ;CLEAR REPARSE FLAG
JRST REPARS ;FORCE THE REPARSE
SUBTTL PARRET PARSER CODE TO RETURN TO CALLER
PARRET: MOVE S1,ARGFRE ;LAST FREE LOCATION
ANDI S1,777 ;MAKE AN OFFSET
MOVE T3,PARDAT ;GET ADDRESS OF PARSER DATA MESSAGE
SKIPE COM.CM(T3) ;ALREADY SETUP TEXT
JRST PARR.2 ;YES, DO NOT MOVE TEXT
MOVEM S1,COM.CM(T3) ;POINTER FOR MESSAGE TEXT
HRLI T1,(POINT 7,0) ;SOURCE BYTE POINTER
HRRI T1,BUFFER ;SOURCE TEXT OF COMMAND
HRRZ T2,ARGFRE ;DESTINATION POINTER
AOS T2 ;LEAVE ROOM FOR HEADER
HRLI T2,(POINT 7,0) ;DESTINATION BYTE POINTER
PARR.0: ILDB S1,T1 ;GET A BYTE
PARR.1: IDPB S1,T2 ;SAVE A BYTE
JUMPN S1,PARR.0 ;NON-ZERO..KEEP CHECKING
HRRZI S1,1(T2) ;GET NEXT LOCATION AND CLEAR LH
ANDI S1,777 ;MAKE INTO LENGTH (OFFSET)
PARR.2: STORE S1,.MSTYP(T3),MS.CNT ;SAVE NEW LENGTH
MOVE S2,ARGFRE ;GET START OF TEXT ADDRESS
ANDI S2,777 ;USE AS LENGTH
SUBI S1,(S2) ;GET LENGTH OF BLOCK
STORE S1,@ARGFRE,AR.LEN ;SAVE ARGUMENT LENGTH
MOVX S1,P.NPRO ;NO PROCESSING REQUIRED
TDNN S1,FLAGS ;WAS IT SET
JRST PARR.3 ;NO, SEND TO ORION TO PROCESS
MOVX S1,CM.NPR ;NO PROCESSING REQUIRED
IORM S1,.OFLAG(T3) ;SAVE IN THE MESSAGE FLAGS
PARR.3: MOVX S1,COM.AL ;GET ARGUMENT LENGTH
MOVEM S1,.OARGC(T3) ;SAVE IN MESSAGE
SETZ S1, ;CLEAR S1
EXCH S1,FLAGS ;GET THE CURRENT FLAGS AND RESET
SKIPE DSPTAK ;DISPLAY TAKE COMMANDS
TXO S1,P.DSPT ;SET DISPLAY TAKE FLAG
MOVEM S1,PARBLK+PRT.FL ;SAVE THE FLAGS
MOVEM T3,PARBLK+PRT.CM ;SAVE THE COMMAND MESSAGE
MOVX S1,CM%INT ;GET COMMAND FLAG
ANDCAM S1,CMDBLK+.CMFLG ;CLEAR FLAG ON GOOD RETURN
$CALL CLRTIM ;CLEAR THE TIMER
SETZM TIMINT ;CLEAR TIMER INTERRUPT FLAG
HRROI S1,BUFFER ;RESET COMMAND POINTER TO STRING
MOVEM S1,CMDBLK+.CMPTR ;SAVE POINTER TO COMMAND STRING
MOVEI S1,BUFSIZ*NCHPW ;GET # OF CHARACTERS IN BUFFER AREA
MOVEM S1,CMDBLK+.CMCNT ;SAVE IN COMMAND BLOCK
MOVEI S1,BUFFER ;SAVE ADDRESS OF BUFFER
MOVEM S1,PARBLK+PRT.MS
MOVEI S1,PRT.SM ;SMALL SIZE MESSAGE
MOVEI S2,PARBLK ;PARSER RETURN BLOCK
$RETT ;RETURN
SUBTTL PARERR COMND JSYS ERROR ROUTINE
; IF END OF FILE REACHED ON A TAKE FILE, THE NEXT COMMAND
; IS SIMPLY PROCESSED. ELSE AN ERROR MESSAGE IS ISSUED AND
; THE PROGRAM IS RESTARTED.
;
;CALL: JRST PARERR
PARERR: SKIPE CORPAR ;DOING A CORE PARSE?
JRST PARE.6 ;YES?
SKIPN TAKFLG ;PROCESSING A TAKE FILE ?
JRST PARE.1 ;NO, GET THE ERROR
$CALL CHKEOF ;CHECK FOR END OF FILE
JUMPF PARE.1 ;NO, PROCESS THE ERROR
$CALL CLSTAK ;CLOSE THE TAKE FILE
JUMPT PARE.3 ;CLEANUP AND RETURN
JRST PARE.4 ;ERROR CLOSING TAKE FILE
PARE.1: $CALL S%ERR ;DO ANY ERROR TYPEOUT
MOVE S2,S1 ;ADDRESS OF MESSAGE IN S2
PJRST ERREXT ;ERROR RETURN
PARE.3: $CALL TAKCLR ;CLEAR THE TAKE INDICATORS
JRST PARE.5 ;GIVE END OF TAKE ERROR..
PARE.4: $CALL TAKCLR ;CLEAR THE TAKE INDICATORS
MOVEI S2,[ASCIZ/Error closing TAKE command file/]
PJRST ERREXT ;ERROR RETURN
PARE.5: MOVX S1,P.ENDT ;END OF THE TAKE FILE
IORM S1,FLAGS ;TURN ON THIS FLAG
SETOM INTEXT ;MARK AS INTERRUPT EXIT
MOVEI S2,[ASCIZ/End of file durring TAKE command/]
PJRST ERREXT ;DO ERROR PROCESSING AND RETURN FALSE
PARE.6: TXNE T1,CM%NOP ;VALID COMMAND ENTERED
JRST PARE.1 ;NO, GENERATE THE ERROR
MOVX S1,P.CEOF ;CORE PARSE END OF FILE
IORM S1,FLAGS ;SET THE FLAGS
MOVEI S2,[ASCIZ/End of string durring incore parse/]
SETOM INTEXT ;MARK AS INTERRUPT EXIT
PJRST ERREXT ;EXIT
SUBTTL CHKEOF CHECK END OF TAKE FILE
;CHECK IF END OF FILE ON TAKE FILE
TOPS20 <
CHKEOF: HLRZ S1,CMDBLK+.CMIOJ ;GET INPUT FILE JFN FOR TAKE FILE
GTSTS ;GET THE FILE'S STATUS
TXNN S2,GS%EOF ;AT END OF FILE ?
$RETF ;RETURN FALSE
$RETT ;RETURN TRUE
> ;End TOPS20
TOPS10 <
CHKEOF: CAXE S1,EREOF$ ;END OF FILE ERROR??
$RETF ;NO, LOSE
$RETT ;YES,
> ;End TOPS10
SUBTTL CLSTAK CLOSE THE TAKE FILE
SUBTTL TAKCLR CLEANUP AFTER TAKE FILE
CLSTAK: MOVE S1,CMDIFN ;GET IFN FOR THE TAKE FILE
$CALL F%REL ;RELEASE THE FILE
$RETIF ;Return the error on failure
MOVE S1,LOGIFN ;Release the logging file
CAIE S1,.NULIO
$CALL F%REL
$RETIF ;Return the error on failure
$RETT
TAKCLR: MOVEI S1,.PRIIN ;Set primary input
MOVEM S1,CMDJFN
MOVEI S1,.PRIOU ;Set primary output
MOVEM S1,LOGJFN
SETZM DSPTAK ;CLEAR DISPLAY TAKE FLAG
SETZM TAKFLG ;MARK THAT TAKE FILE NOT BEING PROCESSED
MOVX S1,P.CTAK ;CLEAR IN TAKE FILE
ANDCAM S1,FLAGS ;CLEAR THE FLAG VALUE
$RET ;RETURN
SUBTTL ERREXT ERROR RETURN FROM PARSER
ERRINT: MOVX S1,CM%INT ;GET INTERRUPT FLAG
ANDCAM S1,CMDBLK+.CMFLG ;CLEAR THE FLAG VALUE
TXNE T1,CM%NOP ;ALSO HAVE NO PARSE LIT?
JRST PARC.1 ;YES, TREAT AS NO PARSE
MOVX S1,P.INTE ;INTERRUPT EXIT
IORM S1,FLAGS ;SAVE IN FLAG WORD
SETOM INTEXT ;INTERRUPT EXIT
MOVEI S2,[ASCIZ/Interrupt durring command parse/]
ERREXT: MOVEM S2,ERRSTG ;SAVE THE STRING ADDRESS
SETZM TIMINT ;CLEAR TIMER INTERRUPT FLAG
$CALL CLRTIM ;CLEAR THE TIMER
MOVE T3,PARDAT ;GET PAGE ADDRESS
SKIPE ARGSAV+PAR.CM ;COMMAND MESSAGE PROVIDED
JRST ERRE.3 ;YES, JUST SET S1 WITH FLAGS
SKIPE S1,ERRSAV ;IS THERE A PAGE ALREADY
JRST ERRE.1 ;ALREADY SET..FREE THE PAGE
MOVEM T3,ERRSAV ;SAVE PAGE ADDRESS
JRST ERRE.2 ;CONTINUE ON
ERRE.1: $CALL M%RPAG ;RELEASE THE PAGE
MOVEM T3,ERRSAV ;SAVE ADDRESS OF PAGE TO REUSE
ERRE.2: SKIPE INTEXT ;INTERRUPT EXIT PROCESSING
JRST ERRE.4 ;YES, SKIP MESSAGE SETUP
ERRE.3: MOVSI T1,(POINT 7,0) ;SETUP BYTE POINTER
HRRI T1,CMDERR ;BUFFER FOR DATA
MOVEM T1,CMDEPT ;SAVE THE POINTER
MOVEI T1,^D50*5 ;SIZE OF BUFFER
MOVEM T1,CMDECT ;SAVE THE COUNT
$TEXT (ERRRTN,<^T/@ERRSTG/^0>)
MOVEI S2,CMDERR ;SETUP ERROR POINTER
ERRE.4: SETZ S1, ;CLEAR FLAG WORD
EXCH S1,FLAGS ;GET THE CURRENT FLAGS AND RESET
TXO S1,P.ERRO ;ERROR FLAG SET
MOVEM S1,PARBLK+PRT.FL ;SAVE THE FLAGS
MOVEM S2,PARBLK+PRT.EM ;SAVE THE ERROR MESSAGE
MOVEM T3,PARBLK+PRT.CM ;SAVE COMMAND MESSAGE..AS IS
MOVEI S1,BUFFER ;ADDRESS OF COMMAND TEXT
MOVEM S1,PARBLK+PRT.MS ;SAVE THE MESSAGE
MOVEI S1,PRT.SZ ;SIZE OF THE BLOCK
MOVEI S2,PARBLK ;ADDRESS OF THE BLOCK
SETZM INTEXT ;CLEAR INTERRUPT EXIT FLAG
$RETF ;RETURN FALSE
ERRRTN: SOSGE CMDECT ;DECREMENT COUNT
$RETF ;TOO MUCH TRUNCATE BUFFER
IDPB S1,CMDEPT ;SAVE THE BYTE
$RETT ;RETURN TRUE
SUBTTL INCORE CHECK AND SETUP FOR INCORE PROCESSING
;THIS ROUTINE WILL VALIDATE THE INCORE ARGUMENT AND MAKE THE
;NECESSARY CHANGES TO PROCESS A COMMAND IN CORE
INCORE: SETZM CORPAR ;RESET CORE PARSE FLAG
SKIPN TAKFLG ;PROCESSING A TAKE COMMAND
SKIPN S1,ARGSAV+PAR.SR ;IS THERE A SOURCE POINTER
JRST INCO.4 ;NO, DO NORMAL PROCESSING
MOVE T1,[.NULIO,,.NULIO] ;SET UP NULL I/O FOR COMND
STORE T1,CMDBLK+.CMIOJ ;SAVE IN THE COMMAND STATE BLOCK
HRLI T2,(POINT 7,0) ;SETUP DESTINATION POINTER
HRRI T2,BUFFER ;GET BUFFER ADDRESS
SETZM T3 ;CLEAR A COUNT
CAMN S1,[-1] ;CHECK FOR RESCAN ON INCORE PARSE
JRST INCO.7 ;YES, DO RESCAN
$CALL MAKPTR ;MAKE THE POINTER FROM S1 AND PUT IN S2
INCO.1: ILDB T4,S2 ;GET A BYTE
JUMPE T4,INCO.2 ;NULL..END OF DATA
IDPB T4,T2 ;SAVE THE BYTE
AOJA T3,INCO.1 ;BUMP THE COUNT
INCO.2: IDPB T4,T2 ;SAVE THE NULL
INCO.3: MOVEM T3,CORPAR ;SAVE BYTE COUNT
MOVEM T3,CMDBLK+.CMINC ;SAVE THE CHARACTER COUNTS
HRROI S1,BUFFER ;GET BUFFER POINTER
MOVEM S1,CMDBLK+.CMPTR ;SAVE POINTER TO COMMAND STRING
MOVEM S1,CMDBLK+.CMBFP ;SAVE POINTER TO START-OF-BUFFER
$RET ;RETURN
INCO.4: MOVX T1,P.CTAK ;COMMAND FROM TAKE FILE
SKIPE TAKFLG ;DOING A TAKE?
IORM T1,FLAGS ;YES, TURN IT ON IN FLAGS
HRLZ T1,CMDJFN ;Get input JFN
HRR T1,LOGJFN ;Get output JFN
INCO.5: STORE T1,CMDBLK+.CMIOJ ;Save for COMND
SKIPE TIMINT ;WAS THERE A TIMER INTERRUPT
$RET ;YES, LEAVE STATE ALONE
SETZM CMDBLK+.CMINC ;CLEAR COUNT OF CHAR IN BUFFER
HRROI S1,BUFFER ;GET POINTER TO INPUT TEXT BUFFER
MOVEM S1,CMDBLK+.CMBFP ;SAVE POINTER TO START-OF-BUFFER
$RET ;RETURN
INCO.7: $CALL RESCN ;DO THE RESCAN
MOVE T3,S1 ;GET THE COUNT
JRST INCO.3 ;FINISH OFF THE INCORE FLAGS
SUBTTL CMDMES CHECK AND/OR SETUP THE COMMAND MESSAGE
;THIS ROUTINE WILL VALIDATE THE COMMAND MESSAGE ARGUMENT FIELD
;IF PRESENT. IF NOT, IT WILL CREATE A PAGE AND SETUP THE MESSAGE
CMDMES: SKIPN T3,ARGSAV+PAR.CM ;ANY COMMAND MESSAGE SUPPLIED?
JRST CMDM.1 ;NO, SETUP THE PAGE
MOVEM T3,PARDAT ;SAVE ADDRESS OF PARSER DATA
LOAD T1,.MSTYP(T3),MS.CNT ;GET THE LENGTH
AOS T1 ;BUMP IT BY 1
MOVEM T1,COM.PB(T3) ;SAVE IN THE MESSAGE
ADDI T1,(T3) ;MAKE AN ADDRESS
MOVEM T1,ARGFRE ;SAVE AS POINTER TO FREE AREA
$RET ;RETURN
CMDM.1: SKIPE T3,ERRSAV ;NO SAVED MESSAGE
JRST CMDM.3 ;USE SAVED PAGE
DMOVE T1,S1 ;SAVE THE ARGUMENT BLOCK
$CALL M%GPAG ;GET A PAGE FOR COMMAND
MOVEM S1,PARDAT ;SAVE THE PAGE ADDRESS
CMDM.2: MOVEI T1,COM.SZ ;SIZE OF THE COMMAND HEADER
MOVEM T1,COM.PB(S1) ;SAVE AS PARSER BLOCK POINTER
ADDI T1,(S1) ;CONVERT TO FULL ADDRESS
MOVEM T1,ARGFRE ;SAVE AS START OF ARGUMENT AREA
MOVX T1,.OMCMD ;GET THE COMMAND MESSAGE TYPE
STORE T1,.MSTYP(S1),MS.TYP ;SAVE TYPE IN MESSAGE
$RET ;RETURN
CMDM.3: MOVEM T3,PARDAT ;SAVE THE PAGE ADDRESS
SETZM ERRSAV ;CLEAR THE SAVED ADDRESS HOLDER
$RET ;RETURN..***MIGHT NEED TO CLEAR
;BY CALLING .ZPAGE
SUBTTL SETPMT SETUP THE PROMPT POINTER
;THIS ROUTINE WILL SET UP THE PROPER PPROMPT STRING FOR COMND.
;THE DEFAULT STRING IS PARSER> ELSE THE
;POINTER GIVEN IN THE PARSER CALL WILL BE USED.
SETPMT: $CALL MAKPTR ;MAKE A POINTER FROM S1 AND RETURN IN S2
MOVEM S2,CMDBLK+.CMRTY ;SAVE THE PROMPT FOR COMMAND
MOVEM S2,CURPMT ;SAVE THE CURRENT PROMPT
SETZ T1, ;CLEAR S2
SETP.1: ILDB S1,S2 ;GET A BYTE
SKIPE S1 ;WAS IT NULL?
AOJA T1,SETP.1 ;NO, COUNT IT
MOVEM T1,PRMTSZ ;SAVE PROMPT SIZE
$RETT ;RETURN TRUE
;THIS ROUTINE WILL MAKE A BYTE POINTER FROM ARGUMENT IN S1
;AND RETURN POINTER IN S2
MAKPTR: HLLZ S2,S1 ;GET THE LEFT HALF AND CHECK FOR POINTER
TLCE S2,-1 ;LEFT HALF = 0
TLCN S2,-1 ; OR -1
HRLI S2,(POINT 7,0) ;YES, SETUP A BYTE POINTER
HRR S2,S1 ;GET THE REST OF THE DATA
$RET ;RETURN
SUBTTL RESCN Rescan routine to setup initial command
;THIS ROUTINE WILL SETUP THE CHARACTERS FROM THE RESCAN FOR PARSING
;
;RETURN S1/ COUNT OF CHARACTERS
RESCN:
TOPS20 <
MOVEI S1,.RSINI ;Make characters available
RSCAN
ERJMP [$FATAL <Rescan JSYS failed, ^E/[-2]/>]
MOVEI S1,.RSCNT ;Get the number of characters available
RSCAN
ERJMP [$FATAL <Rescan JSYS failed, ^E/[-2]/>]
MOVE T1,S1 ;Put count in T1
MOVE T3,T1 ;ALSO SAVE IT IN T3
RESCN1: SOJL T1,RESCN2 ;Exit when count exhausted
$CALL K%BIN ;Read a byte
IDPB S1,T2 ;Store in rescan buffer
JRST RESCN1 ;Back to get the rest
> ;End TOPS20 conditional
TOPS10 <
RESCAN
RESCN1: SKPINC ;Character available?
JRST RESCN2 ;NO, we are all done
$CALL K%BIN ;YES, get it
IDPB S1,T2 ;Store it
AOJA T3,RESCN1 ;BUMP COUNT AND TRY AGAIN
> ;End TOPS10 conditional
RESCN2: SETZ S1, ;Terminate buffer with a null
IDPB S1,T2
MOVE S1,T3 ;GET THE COUNT IN S1
$RETT
SUBTTL Dispatch for Parser Save Routines
;THE ROUTINES ON THE NEXT FEW PAGES SAVE THE OUTPUT OF THE PARSER IN
;A FORM USABLE BY THE EVENT PROCESSOR. THE ACTUAL DATA STRUCTURE IS
;DOCUMENTED IN PARSER.RNO
;THIS IS THE DISPATCH TABLE FOR THE VARIOUS SAVE ROUTINES, ONE FOR
;EACH TYPE OF FIELD THE COMND JSYS CAN PARSE. THESE ROUTINES ARE CALLED
;ON EACH SUCCESSFUL RETURN FROM THE COMND JSYS
;ALL ROUTINES ARE CALLED WITH
; S1/ LENGTH OF BLOCK
; S2/ ADDRESS OF COMND INFO
PARTAB: SAVKEY ;KEYWORD (.CMKEY)
SAVNUM ;NUMBER (.CMNUM)
.POPJ ;NOISE WORD (.CMNOI) (NO PROCESSING)
SAVSWI ;SWITCH (.CMSWI)
SAVFIL ;INPUT FILE SPEC (.CMIFI)
SAVOFI ;OUTPUT FILE SPEC (.CMOFI)
SAVFIL ;GENERAL FILE SPEC (.CMFIL)
SAVATM ;ARBITRARY FIELD (.CMFLD)
SAVZER ;CONFIRM (.CMCFM)
SAVRES ;DIRECTORY (.CMDIR)
SAVRES ;USER NAME (.CMUSR)
SAVZER ;COMMA (.CMCMA)
SAVINI ;INITIALIZATION (.CMINI)
;THIS IS CALLED TO INITIALIZE SAVE STUFF
SAVRES ;FLOATING POINT NUMBER (.CMFLT)
SAVDEV ;DEVICE NAME (.CMDEV)
SAVATM ;TEXT TO CARRAIGE RETURN (.CMTXT)
SAVRES ;DATE AND TIME (.CMTAD)
SAVATM ;QUOTED STRING (.CMQST)
SAVUQS ;UNQUOTED STRING (.CMUQS)
SAVTOK ;TOKEN (.CMTOK)
SAVNUM ;NUMBER (ARBITRARY TERMINATOR) (.CMNUX)
SAVATM ;(.CMACT)
SAVNOD ;NODE NAME (.CMNOD)
SUBTTL SAVE ROUTINES FOR COMND
;THIS ROUTINE WILL SAVE THE SWITCH OR KEYWORD VALUE IN THE
;COMMAND MESSAGE. THE FIRST WORD WILL BE HEADER AND SECOND WORD
;WILL BE THE DATA VALUE
SAVKEY:
SAVSWI: LOAD T1,CR.COD(S2) ;GET THE FUNCTION CODE
STORE T1,@ARGFRE,PF.TYP ;SAVE TYPE IN HEADER
MOVEI T1,PFD.D1+1 ;LENGTH OF FIELD
STORE T1,@ARGFRE,PF.LEN ;SAVE LENGTH IN HEADER
AOS ARGFRE ;BUMP THE POINTER
MOVE T1,CR.RES(S2) ;GET RESULT FROM COMND
LOAD S1,CMDRET+CR.PDB,RHMASK ;GET THE USED PDB FROM PARSE
HRRZ T1,(T1) ;GET RESULT(INDIRECT ADDRESS)
$CALL P$PNXT ;IS THERE A NEXT FIELD?
SKIPT ;YES, USE CURRENT DATA
HLRZ T1,(T1) ;NO,,GET CODE FROM COMND
MOVEM T1,@ARGFRE ;SAVE THE VALUE IN BLOCK
AOS ARGFRE ;BUMP THE POINTER
$RET ;RETURN
SUBTTL SAVE ROUTINE FOR FILE SPECS
;THIS ROUTINE WILL SAVE A FILESPEC IN THE FORM OF A GALAXY FD
;AS DESCRIBED IN GLXMAC
TOPS20 <
SAVOFI: MOVE T1,[111100,,1] ;OUTPUT ALL UP TO PROTECTION
SKIPA ;OUTPUT THE FILE
SAVFIL: MOVE T1,[111110,,1] ;OUTPUT ALL UP TO PROTECTION
DMOVE T3,S1 ;SAVE THE ARGUMENT BLOCKS
MOVE T2,ARGFRE ;START OF THE BLOCK
HRROI S1,PFD.D1(T2) ;POINTER TO START OF DATA
MOVE S2,CR.RES(S2) ;GET THE JFN
JFNS ;MAKE JFN INTO A STRING
IBP S1 ;STEP PAST NULL AT END OF STRING
HRRZI S2,1(S1) ;POINT S2 AT FIRST FREE ARGUMENT
EXCH S2,ARGFRE ;UPDATE THE POINTER
HRRZS S1 ;MAKE AN ADDRESS ONLY
SUBI S1,-1(S2) ;GET LENGTH OF THE FD
STORE S1,PFD.HD(T2),PF.LEN ;SAVE LENGTH OF ARGUMENT
LOAD S1,CR.COD(T4) ;GET THE COMND TYPE
STORE S1,PFD.HD(T2),PF.TYP ;SAVE THE HEADER WORD
MOVE S1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR GTJFN BLOCK
SETZM GJFBLK ;CLEAR FIRST WORD
BLT S1,GJFBLK+GJFSIZ-1 ;CLEAR THE BLOCK
MOVE S1,CR.RES(T4) ;GET THE JFN
RLJFN ;RELEASE THE JFN
JRST [MOVEI S2,[ASCIZ/Error releasing command file JFN/]
$RETF] ;RETURN FALSE
$RET ;RETURN
> ;End TOPS20
TOPS10 <
SAVOFI:
SAVFIL: MOVE T1,ARGFRE ;WHERE TO COPY TO
HRL T1,CR.RES(S2) ;WHERE TO COPY FROM
MOVE T4,CR.RES(S2) ;GET THE RESULT
LOAD T2,.FDLEN(T4),FD.LEN ;GET THE LENGTH OF FD
STORE T2,@ARGFRE,PF.LEN ;SAVE LENGTH OF BLOCK
ADDI T2,-1(T1) ;GET THE ENDING ADDRESS OF FD
BLT T1,(T2) ;MOVE THE FD
LOAD T4,CR.COD(S2) ;GET THE CODE OF FUNCTION
STORE T4,@ARGFRE,PF.TYP ;SAVE CODE AND LENGTH
MOVEI T3,1(T2) ;COMPUTE NEXT FREE LOCATION
EXCH T3,ARGFRE ;UPDATE IT
MOVE S1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR GTJFN BLOCK
SETZM GJFBLK ;CLEAR FIRST WORD
BLT S1,GJFBLK+GJFSIZ-1 ;CLEAR THE BLOCK
$RET ;RETURN
> ;End TOPS10
SUBTTL SAVE ROUTINE FOR NUMBERS
;THIS ROUTINE WILL SAVE A NUMBER BLOCK WITH THE NUMBER
;IN THE FIRST DATA WORD AND THE RADIX IN THE SECOND
SAVNUM: LOAD T2,CR.COD(S2) ;GET THE COMND TYPE
STORE T2,@ARGFRE,PF.TYP ;SAVE THE FUNCTION CODE
MOVEI T2,PFD.SZ ;SIZE OF THE BLOCK
STORE T2,@ARGFRE,PF.LEN ;SAVE THE HEADER
AOS ARGFRE ;BUMP TO NEXT LOCATION
MOVE T2,CR.RES(S2) ;GET THE DATA FIELD
STORE T2,@ARGFRE ;SAVE THE NUMBER IN BLOCK
AOS ARGFRE ;BUMP TO NEXT LOCATION
LOAD T2,CR.PDB(S2),RHMASK ;LAST PDB USED BY COMMAND
LOAD T2,.CMDAT(T2) ;GET THE RADIX
STORE T2,@ARGFRE ;SAVE THE RADIX
AOS ARGFRE ;BUMP TO NEXT LOCATION
$RET ;RETURN
SUBTTL SAVE ROUTINE FOR COMMA, CONFRM..FUNCTION ONLY
;THIS ROUTINE WILL SAVE THE FUNCTION VALUE AND A LENGTH OF 1
SAVZER: LOAD T1,CR.COD(S2) ;GET THE FUNCTION CODE
STORE T1,@ARGFRE,PF.TYP ;SAVE THE TYPE CODE
MOVEI T1,PFD.D1 ;SIZE OF THE BLOCK
STORE T1,@ARGFRE,PF.LEN ;SAVE THE VALUE
AOS ARGFRE ;BUMP TO NEXT LOCATION
$RET ;RETURN
SUBTTL SAVUQS SAVE ROUTINE FOR UNQUOTED STRING
;THIS ROUTINE WILL BUILD BLOCK WITH TEXT FROM UNQUOTED STRING FUNCTION
SAVUQS: MOVE T2,ARGFRE ;POINTER TO FREE LOCATION
ADDI T2,1 ;BUMP BY 1 PASSED HEADER
HRLI T2,(POINT 7,0) ;MAKE INTO A BYTE POINTER
MOVE T1,CURPTR ;USE THE BUFFER POINTER FIELD
CAME T1,CMDBLK+.CMPTR ;WERE THEY EQUAL AT THE START
JRST SAVU.1 ;SAVE A NULL AND RETURN
SETZ T3,0 ;MAKE A NULL
JRST SAVU.2 ;SAVE THE NULL AND RETURN
SAVU.1: ILDB T3,T1 ;GET A CHARACTER FROM THE SOURCE
CAMN T1,CMDBLK+.CMPTR ;AT END OF FIELD?
JRST SAVU.2 ;YES, FINISH OFF TEXT
IDPB T3,T2 ;SAVE IT IN THE DESTINATION
JRST SAVU.1 ;LOOP TILL HIT END OF TEXT
SAVU.2: IDPB T3,T2 ;SAVE THE BYTE
JRST SAVA.2 ;FINISH OFF TEXT
SUBTTL SAVE ROUTINE TO COPY VALUES FROM ATOM BUFFER
;THIS SAVE ROUTINE WILL COPY DATA FROM THE ATOM BUFFER
;TO THE COMMAND MESSAGE
;THIS ROUTINE IS USED BY .CMFLD, .CMTXT, .CMQST
SAVATM: MOVE T2,ARGFRE ;POINTER TO FREE LOCATION
ADDI T2,1 ;BUMP BY 1 PASSED HEADER
HRLI T2,(POINT 7,0) ;MAKE INTO A BYTE POINTER
HRLZI T1,(POINT 7,0) ;MAKE SOURCE BYTE POINTER
HRRI T1,ATMBFR ;SOURCE OF DATA
SAVA.1: ILDB T3,T1 ;GET A CHARACTER FROM THE SOURCE
IDPB T3,T2 ;SAVE IT IN THE DESTINATION
JUMPN T3,SAVA.1 ;LOOP IF MORE ...NON-ZERO
SAVA.2: HRRZI T2,1(T2) ;GET NEXT LOCATION AND CLEAR LH
MOVE T1,T2 ;SAVE VALUE IN T1
SUB T2,ARGFRE ;GET LENGTH OF BLOCK
STORE T2,@ARGFRE,PF.LEN ;SAVE THE LENGTH
LOAD T2,CR.COD(S2) ;GET THE CODE VALUE
STORE T2,@ARGFRE,PF.TYP ;SAVE AS HEADER FOR BLOCK
EXCH T1,ARGFRE ;UPDATE THE FREE POINTER
$RET ;RETURN
SUBTTL SAVE ROUTINE FOR SINGLE VALUE FUNCTIONS
;THIS ROUTINE WILL CREATE A BLOCK WITH ONE DATA ELEMENT IN IT
;TO STORE THE RESULT RETURNED BY COMND
SAVRES: LOAD T2,CR.COD(S2) ;GET CODE IN LEFT HALF
STORE T2,@ARGFRE,PF.TYP ;SAVE TYPE IN HEADER
MOVEI T2,PFD.D2 ;SIZE OF THE BLOCK
STORE T2,@ARGFRE,PF.LEN ;SAVE THE HEADER VALUE
AOS ARGFRE ;BUMP TO NEXT LOCATION
MOVE T2,CR.RES(S2) ;GET THE RESULT
STORE T2,@ARGFRE ;SAVE THE VALUE
AOS ARGFRE ;BUMP TO NEXT LOCATION
$RET ;RETURN
SUBTTL SAVDEV SAVE ROUTINE FOR A DEVICE
;THIS ROUTINE WILL STORE A STRING IN THE BLOCK FOR .CMDEV
TOPS20 <
SAVDEV: LOAD T1,CR.PDB(S2),RHMASK ;GET PDB USED
TXNN T1,CM%PO ;WAS IT PARSE ONLY
JRST SAVATM ;YES, PROCESS AS SAVE ATOM
DMOVE T1,S1 ;SAVE THE CALLING ARGUMENTS
HRRO S1,ARGFRE ;GET POINTER FOR STRING
ADDI S1,1 ;SKIP OVER THE HEADER
MOVE S2,CR.RES(S2) ;GET THE DEVICE DESIGNATOR
DEVST ;CONVERT TO A STRING
$STOP(DDC,DEVICE DESIGNATOR CONVERSION ERROR)
HRRZI S2,1(S1) ;GET NEXT LOCATION AND CLEAR LEFT HALF
MOVE T3,S2 ;SAVE THE LOCATION
SUB S2,ARGFRE ;GET THE LENGTH
STORE S2,@ARGFRE,PF.LEN ;SAVE THE LENGTH IN BLOCK
LOAD S2,CR.COD(T2) ;GET THE FUNCTION CODE
STORE S2,@ARGFRE,PF.TYP ;SAVE TYPE IN BLOCK
EXCH T3,ARGFRE ;UPDATE FREE POINTER
$RETT ;RETURN TRUE
> ;End TOPS20
TOPS10 <
SAVDEV==SAVATM
> ;End TOPS10
SUBTTL SAVE ROUTINE TO SAVE A TOKEN
;THIS ROUTINE WILL SAVE A TOKEN IN THE COMMAND MESSAGE
SAVTOK: LOAD T1,CR.PDB(S2),RHMASK ;PDB USED BY COMMAND
LOAD S1,.CMDAT(T1) ;DATA USED BY COMND
MOVE T1,S2 ;SAVE S2
$CALL MAKPTR ;MAKE A POINTER..RETURNED IN S2
EXCH T1,S2 ;POINTER IN T1 AND BLOCK ADDRESS IN S2
MOVE T2,ARGFRE ;GET DESTINATION POINTER
ADDI T2,1 ;BUMP BY 1 PASSED HEADER
HRLI T2,(POINT 7,0) ;MAKE DESTINATION POINTER
PJRST SAVA.1 ;USE SAVE ATOM ROUTINE
SUBTTL SAVE NODE SPECIFICATION
;THIS ROUTINE WILL SAVE ANODE SPECIFICATION IN THE COMMAND
;MESSAGE
TOPS20 <
SAVNOD: PJRST SAVATM ;SAVE THE ATOM FOR TOPS-20
> ;End TOPS20
TOPS10 <
SAVNOD: PJRST SAVRES ;SAVE AS NUMBER WITH NO RADIX
> ;End TOPS10
SUBTTL Initialization for Parser Save Routines
;THIS ROUTINE IS CALLED TO INITIALIZE THE SAVE ROUTINES FOR THE PARSER
;IT IS THE FUNCTION DEPENDENT ROUTINE FOR THE .CMINI FUNCTION
SAVINI: MOVE S1,PARDAT ;GET PAGE ADDRESS
MOVE T1,COM.PB(S1) ;GET PARSER START OFFSET
ADDI T1,(S1) ;CONVERT TO FULL ADDRESS
MOVEM T1,ARGFRE ;SAVE AS START OF ARGUMENT AREA
$RET ;AND RETURN
SUBTTL Routine to Set Up for COMND Reparse
;THIS ROUTINE IS GOTTEN TO BY THE COMND JSYS CHANGING THE PC WHEN
;A USER RUBS OUT ACROSS A FIELD. IT JUST CLEARS OUT THE TEMPORARY
;STORAGE USED BY COMND AND RESTARTS THE PARSER
REPARS: $CALL @.CMINI+PARTAB ;TELL SAVE ROUTINES TO FORGET IT
MOVX S1,P.NPRO ;GET THE NO PROCESS FLAGS
ANDCAM S1,FLAGS ;CLEAR FLAG TO BE SAFE
MOVE S1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR GTJFN BLOCK
SETZM GJFBLK ;CLEAR FIRST WORD
BLT S1,GJFBLK+GJFSIZ-1 ;CLEAR THE BLOCK
MOVE S1,ARGSAV+PAR.TB ;GET THE ORIGINAL TABLES FROM CALL
AOS S1 ;POSITION TO THE FDB
LOAD T1,.CMFNP(S1),CM%FNC ;GET THE FUNCTION CODE
CAIE T1,.CMINI ;MAKE SURE NOT A .CMINI
JRST REPA.1 ;NOT .CMINI.... O.K.
$CALL P$PNXT ;GET NEXT PDB
AOS S1 ;BUMP TO ACTUAL PDB
REPA.1: STORE S1,CMDRET+CR.PDB,RHMASK ;SAVE THE NEW PDB
JRST PARCMD ;JUST RESTART PARSER
SUBTTL Routine To Fill in Defaults for COMND
;THIS ROUTINE WILL FILL IN DEFAULTS BEFORE THE PDB IS PROCESSED
;
;CALL S1/ SIZE OF BLOCK
; S2/ ADDRESS OF THE BLOCK
;
;RETURN TRUE: CHECK NEXT ALTERNATE AND RETURN
;
;RETURN FALSE: S1/ ERROR CODE IF ANY
; S2/ ADDRESS OF THE STRING
FILDEF: LOAD S1,CMDRET+CR.PDB,RHMASK ;GET CURRENT PDB
FILD.1: MOVEM S1,CURPDB ;SAVE THE CURRENT PDB
$CALL P$PDEF ;IS THERE A DEFAULT ROUTINE
JUMPF FILD.2 ;NO, TRY NEXT PDB
MOVE T2,S1 ;SAVE THE ACTION ROUTINE
MOVEI S1,PC.SIZ ;SIZE OF THE BLOCK
MOVEI S2,CMDRET ;COMMAND RETURN BLOCK
$CALL (T2) ;CALL THE DEFAULT FILLER
JUMPT FILD.2 ;O.K..CONTINUE ON
SKIPN S2 ;IF S2 HAS ERROR SET..SKIP
MOVEI S2,[ASCIZ/Error durring default filling routine/]
MOVX T2,P.DERR ;DEFAULT ROUTINE ERROR
IORM T2,FLAGS ;SAVE IN THE FLAGS
MOVEM S1,PARBLK+PRT.EC ;SAVE ANY CODE FOR CALLER
$RETF ;RETURN FALSE
FILD.2: MOVE S1,CURPDB ;GET THE CURRENT PDB
LOAD S1,.CMFNP(S1),CM%LST ;GET THE ADDR OF NEXT PDB IN LIST
JUMPN S1,FILD.1 ;LOOP ON NEXT ONE
$RETT ;RETURN
SUBTTL SWITCH TABLE PROCESSING ROUTINES
;THIS ROUTINE IS CALLED AS A SPECIAL ROUTINE TO COPY
;THE CURRENT SWITCH TABLE TO TEMFDB SO THAT THE TABLE
;ENTRIES CAN BE DELETED AS USED.
C.SWIT==1B0 ;FLAG FOR SWITCH
PDBCPY: MOVE T3,S2 ;SAVE THE ARGUMENT BLOCK POINTER
LOAD S1,CR.PDB(T3),RHMASK ;GET THE LAST USED PDB
MOVE T2,CR.RES(T3) ;GET RESULT IN T2
$CALL P$PACT ;GET THE ACTION ROUTINE ADDRESS
TXNN S1,C.SWIT ;SPECIAL SWITCH SET
JRST PDBC.1 ;NO, ALREADY SETUP TEMP
HRRZ T1,CR.PDB(T3) ;CURRENT FDB ADDRESS
SUBI T1,1 ;INCLUDE THE HEADER FOR THE PDB
HRLZS T1,T1 ;NOW PLACE IN THE LEFT HALF
HRRI T1,TEMFDB ;NEW FDB AREA
BLT T1,TEMFDB+PDB.SZ-1 ;MOVE THE PDB
MOVEI S1,TEMFDB+1 ;GET THE CURRENT PDB
$CALL P$GPDB ;GET THE PDB ADDRESS
MOVX T1,C.SWIT ;GET SPECIAL SWITCH
ANDCAM T1,PB%RTN(S1) ;CLEAR THE BIT IN PDB
HRLZ T1,TEMFDB+1+.CMDAT ;GET TABLE ADDRESS
HRRI T1,TEMTAB ;GET TEMPORARY TABLE
HRRZ T2,@TEMFDB+1+.CMDAT ;GET COUNT OF TABLE
CAILE T2,TEMTSZ ;WITHIN TABLE SIZE
$STOP(STS,<SHARED SWITCH TABLE SIZE OF ^D/[TEMTSZ]/ TOO SMALL FOR TABLE OF SIZE ^D/T2/>)
BLT T1,TEMTAB(T2) ;MOVE THE TABLE
MOVEI T1,TEMTAB ;ADDRESS OF TABLE
MOVEM T1,TEMFDB+.CMDAT+1 ;SAVE DATA IN TABLE
MOVE T4,CR.RES(T3) ;GET THE RESULT
HRRZ T1,CR.PDB(T3) ;GET USED PDB FOR PARSE
SUB T4,.CMDAT(T1) ;GET OFFSET
MOVEI T2,TEMTAB(T4) ;GET NEW OFFSET
PDBC.1: MOVEI T1,TEMTAB ;TABLE ADDRESS IN T1
DMOVEM T1,DENTRY ;SAVE ARGUMENTS
SETOM DFLAGS ;TURN ON DELETE FLAG
$RET ;RETURN
SUBTTL STBDEL SWITCH TABLE DELETE ROUTINE
;THIS ROUTINE IS CALLED BY THE MAIN PARSER TO DELETE
;THE CURRENT SWITCH VALUE FROM THE TEMFDB TABLE.
;IF ALL ENTRIES ARE GONE IT WILL TURN OF THE DEFAULT HELP
;TEXT TO COMMAND.
STBDEL: SETZM DFLAGS ;CLEAR THE FLAG
DMOVE S1,DENTRY ;GET DELETE AC'S
HLRZ T2,0(S1) ;GET USED COUNT
MOVE T1,T2 ;PLACE IN T1
SOSGE T1 ;DECREMENT..SKIP IF NOT ZERO
$RETF ;FALSE RETURN
ADD T2,S1 ;COMPUTE END OF TABLE
CAILE S2,(S1) ;ENTRY IN TABLE
CAMLE S2,T2 ;MAKE SURE
$STOP (TDE,TABLE DELETE ERROR)
HRLM T1,0(S1) ;SAVE COUNT
JUMPE T1,STBD.2 ;TABLE EMPTY
HRLI S2,1(S2) ;COMPACT TABLE
BLT S2,-1(T2) ;MOVE THE TABLE
STBD.1: SETZM 0(T2) ;CLEAR EMPTY WORD AT END
$RETT ;RETURN TRUE
STBD.2: MOVX S1,CM%SDH ;SUPPRESS DEFAULT HELP MESSAGE
IORM S1,TEMFDB ;TURN ON IN TABLE
JRST STBD.1 ;FINISH UP TABLE OPERATION
SUBTTL TXTINP MULTIPLE LINE TEXT INPUT ROUTINES
;THIS ROUTINE WILL CHECK IF THE PRIMARY OUTPUT IS TO THE
;TERMINAL AND IF SO DISPLAY A TEXT STRING. THE ROUTINE
;WILL THEN BRANCH TO GETTXT TO INPUT THE DATA
TXTINP: HRRZ T1,CMDBLK+.CMIOJ ;GET THE OUTPUT DESIGNATOR
CAIN T1,.PRIOU ;NOT TO THE TERMINAL
$TEXT (T%TTY,<Enter text and terminate with ^^Z>)
JRST GETTXT ;GET THE TEXT
SUBTTL GETTXT INPUT MULTIPLE LINE TEXT
;THIS ROUTINE WILL ACCEPT TEXT AND TERMINATE ON A ^Z OR
;RETURN TO THE ORIGINAL COMMAND IF RUBOUT TO BEGINNING
;OF THE BUFFER.
GETTXT: MOVE T1,ARGFRE ;GET NEXT FREE LOCATION
MOVE T2,T1 ;SAVE IN T2
SOS T2 ;DECREMENT T2
LOAD T3,PFD.HD(T2),PF.TYP ;GET FIELD TYPE
CAIE T3,.CMCFM ;CHECK IF CONFIRM TYPED
JRST GETE.0 ;NO - ERROR IN BLOCK
MOVE T1,T2 ;OVERLAY CONFIRM BLOCK
STORE T1,ARGFRE ;SAVE AS CURRENT POINTER
ADDI T1,1 ;BUMP IT BY 1 FOR HEADER
MOVE T2,T1 ;SAVE ADDRESS IN T2
HRLI T1,(POINT 7,0) ;MAKE A BYTE POINTER
MOVEM T1,TXTDAT+.RDDBP ;POINTER TO SAVE INPUT
MOVEM T1,TXTDAT+.RDBFP ;POINTER TO BEGINNING OF BUFFER
SUB T2,PARDAT ;ARGFRE-START OF MESSAGE
ADDI T2,PAGSIZ-100 ;COMPUTE REMAINING LENGTH-100
IMULI T2,NCHPW ;NUMBER OF CHARACTERS PER WORD
MOVEM T2,TXTDAT+.RDDBC ;MAXIMUM SIZE OF INPUT
LOAD T1,CMDBLK+.CMIOJ ;GET JFNS FROM COMMAND
MOVEM T1,TXTDAT+.RDIOJ ;SAVE IN TEXT ARGUMENT BLOCK
MOVX T1,RD%JFN+RD%RND ;USING JFNS AND BREAKOUT ON
;RUBOUT TO BEGINNING OF BUFFER
MOVEM T1,TXTDAT+.RDFLG ;SAVE THE FLAGS
MOVEI T1,[EXP 1B26,0,0,0] ;BREAK TABLE FOR INPUT
MOVEM T1,TXTDAT+.RDBRK ;SAVE IN ARGUMENT BLOCK
ZERO TXTDAT+.RDRTY ;NO RETRY POINTER
MOVEI T1,.RDBRK ;SIZE OF THE BLOCK
MOVEM T1,TXTDAT+.RDCWB ;SAVE LENGTH IN BLOCK
MOVEI S1,TXTDAT ;ADDRESS OF THE BLOCK
$CALL K%TXTI ;INPUT THE DATA
JUMPF GETE.1 ;ERROR RETURN - RETURN
MOVX S1,RD%BFE ;BACK OVER BUFFER BEGINNING
TDNE S1,TXTDAT+.RDFLG ;WAS THIS THE REASON
PJRST GETT.1 ;YES - RESET THE COMMAND DATA
MOVX S1,RD%BTM ;BREAK TERMINATE INPUT
TDNE S1,TXTDAT+.RDFLG ;WAS THIS THE REASON
PJRST GETT.3 ;YES - FINISH STRING AND RETURN
PJRST GETE.2 ;TOO MUCH TEXT - TRUNCATED
GETT.1: SETZ S1, ;SETUP A NULL
MOVNI S2,2 ;ADJUST POINTER BACK TWO
MOVE S2,CMDBLK+.CMPTR ;GET NEW POINTER
SUBI S2,1 ;BACK UP 1 WORD
IBP S2 ;BUMP UP ONE BYTE
IBP S2 ;ONE MORE
IBP S2 ;ONE MORE SAME AS BACKING UP 2
IDPB S1,S2 ;REPLACE CR WITH NULL
IDPB S1,S2 ;REPLACE LF WITH NULL
MOVEI S1,BUFSIZ*NCHPW-2 ;SIZE OF BUFFER
SUB S1,CMDBLK+.CMCNT ;GET CHARACTERS IN BUFFER
MOVEM S1,CMDBLK+.CMINC ;SAVE IN COMMAND BLOCK
HRROI S1,BUFFER ;POINTER TO THE BUFFER
MOVEM S1,CMDBLK+.CMBFP ;RESET START OF TEXT BUFFER
MOVEM S1,CMDBLK+.CMPTR ;SAVE THE TEXT POINTER
MOVEI S1,BUFSIZ*NCHPW ;SIZE OF THE BUFFER
MOVEM S1,CMDBLK+.CMCNT ;RESET THE COUNT
MOVX S1,P.REPA ;SET FOR REPARSE
IORM S1,FLAGS ;SAVE FOR PARSER FLAGS
GETT.2: HRRZ T1,CMDBLK+.CMIOJ ;GET OUTPUT DESIGNATOR
CAIN T1,.PRIOU ;IS IT TERMINAL OUTPUT
$TEXT (T%TTY,<^Q/CURPMT/^T/BUFFER/^A>)
$RETF ;EXIT ACTION ROUTINE - repARSE
GETT.3: SETZ S1, ;CLEAR S1 FOR NULL
DPB S1,TXTDAT+.RDDBP ;REPLACE BREAK WITH NULL
MOVE S1,CMDBLK+.CMPTR ;BYTE POINTER OF STRING
MOVEM S1,TEMPTR ;SAVE IN TEMPTR
MOVE T2,ARGFRE ;ARGUMENT HEADER
AOS T2 ;POINT TO THE TEXT
$TEXT (GETOUT,<^T/(T2)/>) ;ADD TO THE BUFFER
MOVEI S1,0 ;GET A NULL
IDPB S1,TEMPTR ;SAVE THE NULL
HRRZ S1,TXTDAT+.RDDBP ;LAST USED ADDRESS
ADDI S1,1 ;BUMP TO NEXT FREE
MOVE S2,S1 ;SAVE IN S2
SUB S2,ARGFRE ;GET USED LENGTH
STORE S2,@ARGFRE,PF.LEN ;SAVE LENGTH IN HEADER
MOVEI S2,.CMTXT ;TEXT TYPE IN LEFT HALF
STORE S2,@ARGFRE,PF.TYP ;SAVE TYPE IN MESSAGE
EXCH S1,ARGFRE ;RESET NEXT FREE LOCATION
MOVEI S2,.CMCFM ;CONFIRM BLOCK
STORE S2,@ARGFRE,PF.TYP ;SAVE TYPE IN MESSAGE
MOVEI S2,1 ;ONLY ONE WORD
STORE S2,@ARGFRE,PF.LEN ;SAVE LENGTH IN HEADER
AOS ARGFRE ;BUMP TO NEXT
$RETT ;RETURN TRUE
GETE.0: MOVEI S2,[ASCIZ/Bad argument in message - expected confirm/]
$RETF ;RETURN FALSE
GETE.1: MOVEI S2,[ASCIZ/Error durring text input/]
$RETF
GETE.2: HRR T1,CMDBLK+.CMIOJ ;GET THE OUTPUT DESIGNATOR
CAIN T1,.PRIOU ;NOT TO THE TERMINAL
$WARN (Message truncated - text exceeded buffer capacity)
JRST GETT.3 ;FINISH OFF THE MESSAGE
GETOUT: IDPB S1,TEMPTR ;SAVE THE CHARACTER
$RETT ;RETURN TRUE
SUBTTL TAKE Command Table
TAKFDB: $NOISE(TAK001,<Commands From>)
TAK001: $FILE(TAK002,,<$PREFILL(TAKDEF),$ACTION(TAKRTN),$ERROR(BADIFI)>)
TAK002: $SWITCH(,TAK003,<$ALTER(TAK004)>)
TAK003: $STAB
ORNSDP (TAK004,<DISPLAY>,DSP)
ORNSDP (TAK004,<NODISPLAY>,NDP)
$ETAB
TAK004: $CRLF (<$ACTION(TAKE)>)
BADIFI: SETZM S2 ;CLEAR THE ERROR CODE
$RETF ;BAD INPUT FILE
SUBTTL TAKDEF TAKE DEFAULT SETTING
TOPS20 <
TAKDEF: MOVE S1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR BLOCK
SETZM GJFBLK ;CLEAR FIRST WORD
BLT S1,GJFBLK+GJFSIZ-1 ;CLEAR THE BLOCK
MOVX S1,GJ%OLD ;FILE MUST EXIST
MOVEM S1,GJFBLK+.GJGEN ;INTO FLAGS WORD
MOVE S1,[XWD .NULIO,.NULIO] ;SUPPLY NO JFNS
MOVEM S1,GJFBLK+.GJSRC ;INTO BLOCK
HRROI S1,[ASCIZ/SYSTEM/] ;POINT AT DEFAULT FILE NAME
MOVEM S1,GJFBLK+.GJNAM ;SAVE FOR GTJFN
HRROI S1,[ASCIZ/CMD/] ;DEFAULT EXTENSION
MOVEM S1,GJFBLK+.GJEXT ;SAVE IN GTJFN BLOCK
HRROI S1,[ASCIZ/DSK/] ;GET THE DEFAULT STRUCTURE
MOVEM S1,GJFBLK+.GJDEV ;SAVE THE DEVICE
$RET ;AND RETURN
> ;End TOPS20
TOPS10 <
TAKDEF: MOVE S1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR BLOCK
SETZM GJFBLK ;CLEAR FIRST WORD
BLT S1,GJFBLK+GJFSIZ-1 ;CLEAR THE BLOCK
MOVE S1,[SIXBIT/SYSTEM/] ;GET FILE NAME
STORE S1,GJFBLK+.FDNAM ;SAVE IN DEFAULT BLOCK
MOVSI S1,'CMD' ;GET DEFAULT EXTENSION
STORE S1,GJFBLK+.FDEXT ;SAVE IN BLOCK
MOVSI S1,'DSK' ;GET STRUCTURE NAME
STORE S1,GJFBLK+.FDSTR ;SAVE THE STRUCTURE
$RET ;AND RETURN
> ;End TOPS10
SUBTTL TAKE SPECIAL ROUTINES FOR TAKE COMMANDS
;INCLUDED HERE ARE THE SPECIAL ROUTINES NEEDED FOR THE
;PROPER SETUP FOR TAKE COMMANDS. THESE ROUTINES ARE
;CALLED AS SPECIAL ACTION ROUTINES BY THE PARSER
TAKRTN: SKIPN TAKFLG ;PROCESSING A TAKE COMMAND
$RET ;NO, JUST RETURN
MOVEI S1,0 ;CLEAR FLAG AC
MOVEI S2,[ASCIZ/TAKE command is illegal in a command file/]
$RETF ;FALSE RETURN TO ABORT COMMAND
TAKE: SETOM TAKFLG ;SET FLAG FOR PROCESSING TAKE
MOVX T1,P.DSPT ;GET FLAG TO DISPLAY COMMAND
ANDCAM T1,FLAGS ;CLEAR THE FLAG
SKIPE OPRTAK ;DISPLAY TAKE OUTPUT
IORM T1,FLAGS ;SET THE FLAG
MOVE T4,PARDAT ;GET THE PAGE ADDRESS
MOVE S1,COM.PB(T4) ;GET POINTER TO PARSER BLOCK
ADDI S1,(T4) ;GET OFFSET FOR PARSER DATA
$CALL P$SETU ;SETUP THE POINTER
$CALL P$KEYW ;GET THE NEXT FIELD
JUMPF TAKE.1 ;ERROR..RETURN
CAIE S1,.KYTAK ;IS IT A TAKE COMMAND
PJRST TAKE.1 ;INVALID TAKE COMMAND
$CALL P$FILE ;IS IT A FILE SPEC
JUMPF TAKE.2 ;NO, ERROR
MOVE T2,S1 ;ADDRESS OF THE BLOCK
$CALL P$CFM ;CHECK FOR CONFIRM
JUMPT TAK.1 ;YES, DON'T CHECK SWITCHES
$CALL TAKDSP ;CHECK TAKE DISPLAY SWITCHES
JUMPF .POPJ ;FALSE..PASS ERRORS UP
$CALL P$CFM ;CHECK FOR A CONFIRM
JUMPF TAKE.1 ;ERROR...RETURN
TAK.1: MOVX S1,P.TAKE ;SAY WE ARE DOING TAKE COMMAND
IORM S1,FLAGS
MOVE S1,T2 ;COMMAND FD TO S1
SETZM S2 ;NO LOGGING FD
$CALL P$TAKE ;OPEN THE FILES
JUMPF TAKE.3 ;OPEN ERROR ON FILE
$RETT ;RETURN TRUE
TAKDSP: $CALL P$SWIT ;CHECK FOR A SWITCH
JUMPF TAKE.4 ;NO, GIVE ERROR RETURN
CAIE S1,.SWDSP ;DISPLAY COMMAND OUTPUT
JRST TAKD.1 ;TRY OTHER FLAGS
SETOM DSPTAK ;SET DISPLAY TAKE COMMANDS
$RETT ;RETURN TRUE
TAKD.1: CAIE S1,.SWNDP ;NO DISPLAY
JRST TAKE.4 ;INVALID ARGUMENT..ERROR
SETZM DSPTAK ;CLEAR TAKE DISPLAY
$RETT ;RETURN
TAKE.1: MOVEI S2,[ASCIZ/Invalid TAKE command/]
JRST TAKERR ;TAKE ERROR EXIT
TAKE.2: MOVEI S2,[ASCIZ/No input file specified in TAKE command/]
JRST TAKERR ;TAKE ERROR EXIT
TAKE.3: MOVEI S2,[ASCIZ/Can't open TAKE command file/]
JRST TAKERR ;TAKE ERROR EXIT
TAKE.4: MOVEI S2,[ASCIZ/Invalid argument in TAKE command/]
JRST TAKERR ;TAKE ERROR EXIT
TAKERR: SETZM TAKFLG ;CLEAR THE TAKE FLAG ON ERROR
$RETF ;RETURN FALSE
SUBTTL WAITCM WAIT COMMAND AND TABLES
;This Command will sleep for a specified amount of time and wait
;and/or wait for an interrupt to proceed.
WAIFDB: $NOISE(WAI010,<for>)
WAI010: $NUMBER(WAI020,^D10,<Number of Seconds to Wait between 1 and 60>)
WAI020: $NOISE(WAI030,<Seconds>)
WAI030: $CRLF(<$ACTION(WAITRN)>)
WAITRN: MOVE T4,PARDAT ;GET THE PARSER PAGE ADDRESS
MOVE S1,COM.PB(T4) ;OFFSET TO PARSER DATA
ADDI S1,(T4) ;SETUP PB PROPERLY
$CALL P$SETU ;SETUP THE POINTER
$CALL P$KEYW ;CHECK FOR A KEYWORD
JUMPF WAITE1 ;ERROR .. NO WAIT KEYWORD
CAIE S1,.KYWAI ;WAS IT WAIT?
PJRST WAITE1 ;NO, ERROR
WAIT.1: $CALL P$NUM ;WAS IT A NUMBER
JUMPF WAITE1 ;NO GENERATE AN ERROR
MOVE T3,S1 ;SAVE THE TIME
CAIG S1,^D60 ;60 SECOND LIMIT ON SLEEP
SKIPG S1 ;VALID TIME
PJRST WAITE2 ;INVALID WAIT VALUE
WAIT.2: $CALL P$NPRO ;NO PROCESSING FLAG AND RETURN
MOVE S1,T3 ;GET THE TIME
WAITSL: SKIPG S1 ;IF A NEGATIVE NUMBER,
MOVEI S1,1 ;SLEEP FOR A SECOND
CAILE S1,^D60 ;IF MORE THAN A MINUTE
MOVEI S1,^D60 ;SLEEP FOR A MINUTE
TOPS10 <
SLEEP S1, ;SLEEP
JFCL ;IGNORE ERRORS
$RETT ;RETURN AFTER SLEEPING
> ;End TOPS10 CONDITIONAL
TOPS20 <
IMULI S1,^D1000 ;CONVERT SECONDS TO MILLISECONDS
DISMS ;ELSE SLEEP FOR SPECIFIED SECONDS
JFCL ;USE A LOCATION
$RETT ;RETURN TO CALLER
> ;End TOPS20 CONDITIONAL
WAITE1: MOVEI S2,[ASCIZ/Invalid WAIT command/]
$RETF ;RETURN FALSE
WAITE2: MOVEI S2,[ASCIZ/Wait time must be a positive number between 1 and 60/]
$RETF ;RETURN FALSE
SUBTTL P$STAK SETUP TAKE COMMAND DATA
;THIS COMMAND WILL ACCEPT A JFN FOR THE TAKE FILE TO BE USED
;AND UPDATE THE NECESSARY OPRPAR DATA BASE TO MAKE ALL OTHER
;FUNCTION WORK CORRECTLY
;
;CALL S1/ JFN (IFN ON TOPS10) FOR THE COMMAND FILE
;
TOPS10 <
P$STAK: SETOM TAKFLG ;SET FLAG FOR PROCESSING TAKE
MOVEM S1,CMDIFN ;SAVE THE IFN
MOVEM S1,CMDJFN ;SAVE AS JFN ALSO
$RETT
> ;End TOPS10
TOPS20 <
P$STAK: $CALL .SAVET ;Preserve temporaries
STKVAR <<CMDFD,^D20>> ;Get some space to build FD
MOVE S2,S1 ;Put JFN in S2
MOVSI S1,^D20 ;Setup FD header
MOVEM S1,CMDFD
HRROI S1,1+CMDFD ;Point to storage for string
MOVX T1,1B2+1B5+1B8+1B11+1B14+js%paf ;Request all fields
JFNS
ERJMP .RETF
MOVE S1,S2 ;Close the file
CLOSF
ERJMP .RETF
MOVEI S1,CMDFD ;Point to the file spec
SETZM S2 ;No logging file wanted
PJRST P$TAKE ;Setup for TAKE
> ;End TOPS20
SUBTTL P$TAKE ROUTINE TO SETUP A TAKE COMMAND
;THIS ROUTINE ACCEPTS TWO FDS FOR THE TAKE COMMAND TO BE
;USED AND WILL OPEN THE FILES AND UPDATE THE DATA BASE TO
;MAKE ALL OTHER FUNCTIONS OPERATE CORRECTLY
;CALL S1/ ADDRESS OF COMMAND FILE FD
; S2/ ADDRESS OF LOG FILE FD
P$TAKE: STKVAR <<CMDFOB,FOB.MZ>,<LOGFOB,FOB.MZ>>
MOVEM S1,FOB.FD+CMDFOB ;Save address of command FD
MOVEM S2,FOB.FD+LOGFOB ;Save address of logging FD
MOVX S1,FLD(7,FB.BSZ)+FLD(1,FB.LSN)
MOVEM S1,FOB.CW+CMDFOB ;Strip LSN and open as ascii
MOVEI S1,FOB.MZ ;Size of the FOB
MOVEI S2,CMDFOB ;Address of the FOB
$CALL F%IOPN ;Open the file
$RETIF ;Return the error on failure
MOVEM S1,CMDIFN ;Save the IFN
SETOM TAKFLG ;Remember we are doing a TAKE
TOPS20 <
MOVEI S2,FI.CHN ;Get the JFN for TOPS20
$CALL F%INFO
$RETIF ;Return the error on failure
MOVEM S1,CMDJFN ;Save proper file index
TXO S1,CO%NRJ+CZ%NUD ;Close but don't release JFN
CLOSF
JRST [MOVX S1,ERUSE$ ;Should never happen
$RETF]
MOVE S1,CMDJFN ;Reclaim proper JFN
MOVX S2,FLD(7,OF%BSZ)+OF%RD ;Reopen in proper mode
OPENF
JRST [MOVX S1,ERUSE$ ;Should never happen
$RETF]
SKIPA ;Already saved JFN
> ;End TOPS20
MOVEM S1,CMDJFN ;Save the proper file index
SKIPG FOB.FD+LOGFOB ;Logging file wanted?
JRST [MOVEI S1,.NULIO ;No, then set nulio
MOVEM S1,LOGIFN
MOVEM S1,LOGJFN
JRST P$TAK1]
MOVX S1,FLD(7,FB.BSZ) ;Open log file as ascii
MOVEM S1,FOB.CW+LOGFOB
MOVEI S1,FOB.MZ
MOVEI S2,LOGFOB
$CALL F%OOPN
$RETIF ;Return the error on failure
MOVEM S1,LOGIFN ;Save the IFN
TOPS20 <
MOVEI S2,FI.CHN ;Get the JFN for TOPS20
$CALL F%INFO
$RETIF ;Return the error on failure
MOVEM S1,LOGJFN ;Save logging JFN
TXO S1,CO%NRJ+CZ%NUD ;Close but don't release
CLOSF
JRST [MOVX S1,ERUSE$ ;Should never happen
$RETF]
MOVE S1,LOGJFN ;Reclaim proper JFN
MOVX S2,FLD(7,OF%BSZ)+OF%WR ;Reopen in proper mode
OPENF
JRST [MOVX S1,ERUSE$ ;Should never happen
$RETF]
SKIPA ;Already saved JFN
> ;End TOPS20
MOVEM S1,LOGJFN ;Save the logging JFN
P$TAK1: MOVE S1,CMDIFN ;Return command IFN
MOVE S2,LOGIFN ; and logging IFN
$RETT
SUBTTL P$SETU SETUP THE PARSER BLOCK POINTER ADDRESS
;THIS ROUTINE WILL TAKE THE ADDRESS AND USE IT FOR THE POINTER TO
;THE PARSER BLOCK
;
;CALL S1/ PARSER BLOCK ADDRESS
;
;RETURN TRUE: ALWAYS
P$SETU: MOVEM S1,CURRPB ;SAVE AS THE CURRENT POINTER
SETZM PREVPB ;CLEAR PREVIOUS POINTER
$RETT
SUBTTL P$CURR GET THE ADDRESS OF THE CURRENT ENTRY
;THIS ROUTINE WILL RETURN THE ADDRESS OF CURRENT ENTRY TO
;BE PARSED
;RETURN TRUE: S1/ ADDRESS OF CURRENT PARSER ADDRESS
P$CURR: MOVE S1,CURRPB ;GET THE CURRENT PARSER POINTER
$RETT ;RETURN TRUE
SUBTTL P$PREV POSITION TO PREVIOUS PARSER ENTRY
;THIS ROUTINE WILL CHANGE THE PARSER BLOCK TO THE PREVIOUS
;ENTRY THAT WAS PROCESSED.
;IT WILL ONLY GO BACK ONE BLOCK.
;
;RETURN TRUE: S1/ ADDRESS OF PREVIOUS.. NOW CURRENT
;
;RETURN FALSE: NO PREVIOUS ENTRY
P$PREV: SKIPN S1,PREVPB ;GET THE PREVIOUS POINTER
$RETF ;RETURN FALSE .. NONE SET
MOVEM S1,CURRPB ;SAVE AS THE CURRENT
$RETT ;RETURN TRUE
SUBTTL P$NEXT BUMP THE POINTER TO NEXT FIELD
;THIS ROUTINE WILL BUMP TO NEXT DATA FIELD AND RETURN TRUE.
;S1 AND S2 WILL HAVE THE DATA TO RETURN TO THE CALLER
P$NEXT: MOVE TF,CURRPB ;GET THE CURRENT PB
MOVEM TF,PREVPB ;SAVE AS THE PREVIOUS POINTER
LOAD TF,@CURRPB,PF.LEN ;GET THE LENGTH
ADDM TF,CURRPB ;ADD TO CURRENT LOCATION
$RETT ;RETURN TRUE
SUBTTL P$NFLD TO GET HEADER AND DATA FOR A PARSER ELEMENT
;THIS ROUTINE WILL RETURN THE ARGUMENT TYPE FOR THE CURRENT ENTRY
;AND THE ADDRESS OF THE CURRENT ENTRY
;
;RETURNS TRUE: S1/ ARGUMENT TYPE
; S2/ ADDRESS OF BLOCK
;
;RETURNS FALSE: ;NO MORE ARGUMENTS .. NOT IMPLEMENTED YET
P$NFLD: MOVE S2,CURRPB ;GET THE CURRENT PB
LOAD S1,PFD.HD(S2),PF.TYP ;GET THE TYPE FIELD
PJRST P$NEXT ;BUMP TO NEXT ONE
P$NARG: MOVE S2,CURRPB ;GET THE CURRENT PB
LOAD S1,PFD.HD(S2),PF.TYP ;GET THE TYPE FIELD
$RETT ;RETURN
SUBTTL P$CFM CHECK FOR A CONFIRM IN NEXT BLOCK
;THIS ROUTINE WILL CHECK THE NEXT FIELD FOR A CONFIRM
;RETURN TRUE: ON CONFIRM AND UPDATE PB
;
;RETURN FALSE: S1/CODE FOUND
P$CFM: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMCFM ;WAS IT A CONFIRM
$RETF ;NO, RETURN FALSE
PJRST P$NEXT ;ADVANCE PB AND RETURN
SUBTTL P$COMMA CHECK FOR A COMMA IN NEXT BLOCK
;THIS ROUTINE WILL CHECK THE NEXT FIELD FOR A COMMA
;RETURN TRUE: ON COMMA AND UPDATE PB
;
;RETURN FALSE: S1/CODE FOUND
P$COMMA: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMCMA ;WAS IT A COMMA
$RETF ;NO, RETURN FALSE
PJRST P$NEXT ;ADVANCE PB AND RETURN
SUBTTL P$KEYW GET A KEYWORD FROM THE PARSED DATA
;THIS ROUTINE WILL TRY TO GET A KEYWORD FROM THE NEXT ELEMENT
;IN THE PARSER DATA BLOCK POINTED TO BY PB
;
;RETURNS TRUE: S1/ KEYWORD FOUND
;
;RETURNS FALSE: S1/ DATA TYPE FOUND
P$KEYW: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMKEY ;WAS IT A KEYWORD
$RETF ;NO RETURN WITH TYPE FOUND
GETVAL: MOVE S1,PFD.D1(S2) ;GET THE DATA
PJRST P$NEXT ;RETURN AND ADVANCE PB
SUBTTL P$SWIT GET A SWITCH FROM THE PARSED DATA
;THIS ROUTINE WILL TRY TO GET A SWITCH FROM THE NEXT ELEMENT
;IN THE PARSER DATA BLOCK POINTED TO BY PB
;
;RETURNS TRUE: S1/ SWITCH FOUND
;
;RETURNS FALSE: S1/ DATA TYPE FOUND
P$SWIT: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMSWI ;WAS IT A SWITCH
$RETF ;NO RETURN WITH TYPE FOUND
MOVE S1,PFD.D1(S2) ;GET THE DATA
PJRST P$NEXT ;RETURN AND ADVANCE PB
SUBTTL P$USER GET THE USER ID FIELD
;THIS ROUTINE WILL RETURN USER NUMBER OR PPN FOR THE
;.CMUSR FUNCTION
;
;RETURNS TRUE: S1/ USER NUMBER OR PPN
;
;RETURN FALSE S1/ DATA TYPE FOUND
;
P$USER: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMUSR ;IS IT USER ID?
$RETF ;NO, RETURN FALSE
PJRST GETVAL ;YES, GET AND RETURN VALUE
SUBTTL P$FLOT GET THE FLOATING POINT NUMBER
;THIS ROUTINE WILL RETURN A FLOATING POINT NUMBER FOR THE .CMFLT
;FUNCTION
;
;RETURNS TRUE: S1/ FLOATING POINT NUMBER
;
;RETURN FALSE S1/ DATA TYPE FOUND
;
P$FLOT: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMFLT ;IS IT A FLOATING POINT NUMBER?
$RETF ;NO, RETURN FALSE
PJRST GETVAL ;YES, GET AND RETURN VALUE
SUBTTL P$DIR GET THE DIRECTORY FIELD
;THIS ROUTINE WILL RETURN DIRECTORY NUMBER OR PPN FOR THE
;.CMDIR FUNCTION
;
;RETURNS TRUE: S1/ DIRECTORY NUMBER OR PPN
;
;RETURN FALSE S1/ DATA TYPE FOUND
;
P$DIR: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMDIR ;IS IT DIRECTORY NUMBER?
$RETF ;NO, RETURN FALSE
PJRST GETVAL ;YES, GET AND RETURN VALUE
SUBTTL P$TIME GET THE TIME/DATE FIELD
;THIS ROUTINE WILL RETURN THE TIME/DATE FROM THE
;.CMTAD FUNCTION
;
;RETURNS TRUE: S1/ TIME/DATE IN UDT
;
;RETURN FALSE S1/ DATA TYPE FOUND
;
P$TIME: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMTAD ;IS IT TIME/DATE?
$RETF ;NO, RETURN FALSE
PJRST GETVAL ;YES, GET AND RETURN VALUE
SUBTTL P$NUM GET A NUMBER FROM THE PARSER BLOCK
;ON RETURN TRUE: S1/ NUMBER
; S2/ RADIX
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$NUM: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMNUM ;CHECK IF A NUMBER
$RETF ;NO, RETURN FALSE
DMOVE S1,PFD.D1(S2) ;PLACE NUMBER IN S1 AND
;RADIX IN S2
PJRST P$NEXT ;ADVANCE TO NEXT FIELD
SUBTTL P$FILE GET A FILESPEC FROM THE PARSER BLOCK
;ON RETURN TRUE: S1/ ADDRESS OF FD
; S2/ LENGTH OF FD AND HEADER
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$FILE: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMFIL ;CHECK IF A GENERAL FILE
$RETF ;NO, RETURN FALSE
JRST GETFD ;GET THE FD
P$IFIL: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMIFI ;CHECK IF A INPUT FILE
$RETF ;NO, RETURN FALSE
JRST GETFD ;GET AN FD
P$OFIL: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMOFI ;CHECK IF A OUTPUT FILE
$RETF ;NO, RETURN FALSE
GETFD: MOVE S1,CURRPB ;GET ADDRESS OF THE BLOCK
LOAD S2,PFD.HD(S1),PF.LEN ;LENGTH OF THE FD AND HEADER
PJRST P$NEXT ;ADVANCE TO NEXT FIELD
SUBTTL P$FLD GET A TEXT FIELD FROM BLOCK
;ON RETURN TRUE: S1/ ADDRESS OF FIELD
; S1/ LENGTH OF THE BLOCK
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$FLD: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMFLD ;IS IT A FIELD?
$RETF ;NO, RETURN FALSE
GETF.1: MOVE S1,CURRPB ;ADDRESS OF THE DATA
LOAD S2,PFD.HD(S1),PF.LEN ;GET THE LENGTH
PJRST P$NEXT ;BUMP TO NEXT FIELD
P$TOK: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMTOK ;IS IT A TOKEN
$RETF ;NO, RETURN FALSE
PJRST GETF.1 ;SETUP DATA AND RETURN
SUBTTL P$NODE GET A NODE FROM BLOCK
;ON RETURN TRUE: S1/ NODE NAME OR NUMBER
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$NODE: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMNOD ;WAS IT A NODE TYPE
$RETF ;NO, RETURN FALSE
MOVE S1,PFD.D1(S2) ;GET THE DATA
TOPS20 <
TLNN S1,770000 ;CHECK IF SIXBIT..DATA IN FIRST
;6 BITS
> ;End TOPS20
PJRST P$NEXT ;ADVANCE THE PB PTR AND RETURN
GETN.0: HRLI T1,(POINT 7,) ;BYTE POINTER
HRRI T1,PFD.D1(S2) ;GET THE ADDRESS
MOVE T2,[POINT 6,T3] ;SAVE IN T3
SETZM T3 ;CLEAR T3
GETN.1: ILDB S1,T1 ;GET A BYTE
JUMPE S1,GETN.2 ;END OF STRING..JUMP
CAIG S1,172 ;LOWER CASE Z
CAIGE S1,141 ;LOWER CASE A
SKIPA ;NO NEED TO CONVERT
SUBI S1,40 ;CONVERT TO UPPER CASE
SUBI S1,"A"-'A' ;CONVERT TO SIXBIT
TLNE T2,770000 ;ENOUGH SAVED??
IDPB S1,T2 ;NO, SAVE IT AWAY
JRST GETN.1 ;LOOP FOR MORE
GETN.2: MOVE S1,T3 ;PLACE NODE NAME IN S1
PJRST P$NEXT ;ADVANCE THE POINTER
SUBTTL P$SIXF GET A SIXBIT FIELD TYPE
;ON RETURN TRUE: S1/ SIXBIT FIELD
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$SIXF: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMFLD ;IS IT A FIELD TYPE
$RETF ;NO, RETURN FALSE
PJRST GETN.0 ;PROCESS THE FIELD AND RETURN
SUBTTL P$RNGE GET A RANGE BACK
;ON RETURN TRUE: S1/ LOW RANGE
; S2/ HIGH RANGE
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$RNGE: $CALL P$NUM ;GET A NUMBER
JUMPF .POPJ ;ERROR..RETURN
MOVE T4,S1 ;SAVE NUMBER
$CALL P$TOK ;TRY FOR A TOKEN
JUMPF GETR.1 ;ERROR..RETURN
$CALL P$NUM ;GET HIGH RANGE
JUMPF .POPJ ;ERROR..RETURN
MOVE S2,S1 ;PLACE NUMBER IN S2 FOR HIGH
MOVE S1,T4 ;SETUP LOW VALUE
$RETT ;RETURN TRUE
GETR.1: MOVEI S1,0 ;0 THE LOW RANGE
MOVE S2,T4 ;PUT NUMBER AS HIGH RANGE
$RETT ;RETURN TRUE
SUBTTL P$TEXT GET A TEXT ADDRESS AND LENGTH
;ON RETURN TRUE: S1/ ADDRESS OF TEXT BLOCK
; S2/ NUMBER OF WORDS OF TEXT
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$TEXT: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMTXT ;IS IT TEXT
$RETF ;NO, RETURN FALSE
LOAD S2,PFD.HD(S2),PF.LEN ;GET THE LENGTH IN S2
MOVE S1,CURRPB ;ADDRESS OF THE HEADER
PJRST P$NEXT ;BUMP TO THEE NEXT FIELD
SUBTTL P$DEV GET A DEVICE ADDRESS AND LENGTH
;ON RETURN TRUE: S1/ ADDRESS OF DEVICE BLOCK
; S2/ NUMBER OF WORDS OF DEVICE BLOCK
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$DEV: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMDEV ;IS IT TEXT
$RETF ;NO, RETURN FALSE
LOAD S2,PFD.HD(S2),PF.LEN ;GET THE LENGTH IN S2
MOVE S1,CURRPB ;ADDRESS OF THE HEADER
PJRST P$NEXT ;BUMP TO THEE NEXT FIELD
SUBTTL P$QSTR GET A QUOTED STRING
;ON RETURN TRUE: S1/ ADDRESS OF TEXT BLOCK
; S2/ NUMBER OF WORDS
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$QSTR: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMQST ;IS IT TEXT
$RETF ;NO, RETURN FALSE
LOAD S2,PFD.HD(S2),PF.LEN ;GET THE LENGTH IN S2
MOVE S1,CURRPB ;ADDRESS OF THE HEADER
PJRST P$NEXT ;BUMP TO THEE NEXT FIELD
SUBTTL P$UQSTR GET AN UNQUOTED STRING
;ON RETURN TRUE: S1/ ADDRESS OF TEXT BLOCK
; S2/ NUMBER OF WORDS
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$UQSTR: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMUQS ;IS IT TEXT
$RETF ;NO, RETURN FALSE
LOAD S2,PFD.HD(S2),PF.LEN ;GET THE LENGTH IN S2
MOVE S1,CURRPB ;ADDRESS OF THE HEADER
PJRST P$NEXT ;BUMP TO THEE NEXT FIELD
SUBTTL P$ACCT GET AN ACCOUNT STRING
;ON RETURN TRUE: S1/ ADDRESS OF TEXT BLOCK
; S2/ NUMBER OF WORDS
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$ACCT: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMACT ;IS IT TEXT
$RETF ;NO, RETURN FALSE
LOAD S2,PFD.HD(S2),PF.LEN ;GET THE LENGTH IN S2
MOVE S1,CURRPB ;ADDRESS OF THE HEADER
PJRST P$NEXT ;BUMP TO THEE NEXT FIELD
SUBTTL P$NPRO No Processing Required
;Set No Processing Required in the Parser Flags
P$NPRO: MOVX S1,P.NPRO ;NO PROCESSING REQUIRED
IORM S1,FLAGS ;SAVE IN FLAGS OF PARSER
$RETT ;RETURN TRUE
SUBTTL P$GPDB GET THE PDB ADDRESS IF ANY DATA
;THIS ROUTINE WILL GET THE ADDRESS OF THE PDB FOR THE BLOCK
;
;CALL S1/ ADDRESS OF THE FDB
;
;RETURN TRUE: S1/ ADDRESS OF THE PDB DATA
; S2/ LENGTH OF THE PDB
;
;RETURN FALSE: NO NEXT PDB
P$GPDB: SUBI S1,1 ;POINT TO THE HEADER FOR PDB
SKIPN (S1) ;PDB O.K.
$STOP(IPP,Invalid PDB Header in Parse Block)
LOAD TF,PB%HDR(S1),PB.FDB ;GET THE LENGTH OF THE FDB
LOAD S2,PB%HDR(S1),PB.PDB ;GET THE LENGTH OF THE PDB
CAMN S2,TF ;ARE THEY THE SAME
$RETF ;RETURN FALSE .. NONE SPECIFIED
ADD S1,TF ;POSITION TO THE PDB
SUB S2,TF ;GET LENGTH OF THE PDB
$RETT ;RETURN TRUE
SUBTTL P$PNXT GET NEXT PDB GIVEN A PDB BLOCK
;THIS ROUTINE WILL RETURN INFORMATION FROM A PDB
;CALL S1/ ADDRESS OF THE PDB
;
;RETURN TRUE: S1/ ADDRESS OF THE NEXT PDB
;
;RETURN FALSE: NO NEXT PDB
P$PNXT: $CALL P$GPDB ;GET THE PDB DATA
JUMPF .POPJ ;ERROR..RETURN
CAIG S2,PB%NXT ;IS THERE A NEXT FIELD
$RETF ;NO, RETURN FALSE
SKIPE S1,PB%NXT(S1) ;GET THE VALUE AND RETURN
$RETT ;YES, O.K.
$RETF ;RETURN FALSE
SUBTTL P$PERR GET ERROR ROUTINE GIVEN A PDB BLOCK
;THIS ROUTINE WILL RETURN INFORMATION FROM A PDB
;CALL S1/ ADDRESS OF THE PDB
;
;RETURN TRUE: S1/ ADDRESS OF THE ERROR ROUTINE
;
;RETURN FALSE: NO ERROR PDB
P$PERR: $CALL P$GPDB ;GET THE PDB DATA
JUMPF .POPJ ;ERROR..RETURN
CAIG S2,PB%ERR ;IS THERE AN ERROR FIELD
$RETF ;NO, RETURN FALSE
SKIPE S1,PB%ERR(S1) ;GET THE VALUE AND RETURN
$RETT ;YES, O.K.
$RETF ;RETURN FALSE
SUBTTL P$PDEF GET DEFAULT FILLER ROUTINE GIVEN A PDB BLOCK
;THIS ROUTINE WILL RETURN INFORMATION FROM A PDB
;CALL S1/ ADDRES OF THE PDB
;
;RETURN TRUE: S1/ ADDRESS OF THE DEFAULT FILLER ROUTINE
;
;RETURN FALSE: NO DEFAULT FILLER PDB
P$PDEF: $CALL P$GPDB ;GET THE PDB DATA
JUMPF .POPJ ;ERROR..RETURN
CAIG S2,PB%DEF ;IS THERE A DEFAULT FIELD
$RETF ;NO, RETURN FALSE
SKIPE S1,PB%DEF(S1) ;GET THE VALUE AND RETURN
$RETT ;YES, O.K.
$RETF ;RETURN FALSE
SUBTTL P$PACT GET ACTION ROUTINE GIVEN A PDB BLOCK
;THIS ROUTINE WILL RETURN INFORMATION FROM A PDB
;CALL S1/ ADDRESS OF THE PDB
;
;RETURN TRUE: S1/ ADDRESS OF THE ACTION ROUTINE
;
;RETURN FALSE: NO NEXT PDB
P$PACT: $CALL P$GPDB ;GET THE PDB DATA
JUMPF .POPJ ;ERROR..RETURN
CAIG S2,PB%RTN ;IS THERE A ACTION ROUTINE
$RETF ;NO, RETURN FALSE
SKIPE S1,PB%RTN(S1) ;GET THE VALUE AND RETURN
$RETT ;YES, O.K.
$RETF ;RETURN FALSE
SUBTTL P$INTR PARSER INTERRUPT SUPPORT CODE
;THIS ROUTINE WILL DETERMINE IF A BREAKOUT FROM THE PARSER
;SHOULD BE DONE AND IF SO RESET THE PC
P$INTR: SKIPE TAKFLG ;IN A TAKE COMMAND?
$RETT ;YES, JUST RETURN
MOVE S1,@TIMPC ;GET THE PC
$CALL S%INTR ;FLAG THE INTERRUPT
JUMPF .RETT ;NOT IN COMMAND
TOPS20 <
$CALL CNTCHR ;COUNT THE CHARACTERS
MOVE T1,S1 ;SAVE CHARACTER COUNT
$CALL K%TPOS ;ARE WE AT PROPER MARGIN
CAME S1,PRMTSZ ;SIZE OF THE PROMPT
JRST INTR.2 ;CHECK TIMER
SKIPE T1 ;ANY CHARACTERS IN BUFFER?
JRST INTR.2 ;YES, CHECK TIMER
;COVER A ^U ..DO THE RESET IF AT THE PROMPTS
MOVEI T1,NCHPW*BUFSIZ ;GET SIZE OF BUFFER
MOVEM T1,CMDBLK+.CMCNT ;RESET THE COUNT
SETZM S1,CMDBLK+.CMINC ;NO, SAVE THE COUNT
HRROI S1,BUFFER ;POINTER TO NEXT FIELD
MOVEM S1,CMDBLK+.CMPTR ;SAVE THE POINTER
> ;End TOPS20
TOPS10 <
INTR.1: MOVEI S2,BUFSIZ*NCHPW ;GET COMMAND BUFFER SIZE
CAME S1,S2 ;BUFFER EMPTY
JRST INTR.2 ;CHECK THE TIMER
> ;End TOPS10
MOVEI S1,S%EXIT ;ADDRESS OF RETURN PC
MOVEM S1,@TIMPC ;SAVE THE NEW PC
$RETT ;RETURN
INTR.2: SKIPN TIMCHK ;TIMER TRAPS IN USE
$RETT ;NO, JUST RETURN
$CALL SETTIM ;SET THE TIMER
$RETT ;RETURN
SUBTTL SETTIM SETUP THE TIMER FUNCTION
;THIS ROUTINE WILL SETUP A TIMER TO WAKEUP THE PARSER
;AFTER N SECONDS TO CHECK THE STATE WHEN A BREAKOUT WAS
;NOT DONE
SETTIM:
TOPS20 <
$CALL I%NOW ;GET THE CURRENT TIME
MOVE S2,S1 ;PUT TIME IN S2
ADDI S2,^D3*^D60 ;REQUEST INTERRUPT IN 60 SECONDS
MOVEM S2,TIMSET ;REMEMBER IN CASE WE HAVE TO CLEAR IT
MOVSI S1,.FHSLF ;GET THE FORK HANDLE
HRRI S1,.TIMDT ;GET TIMER FUNCTION
HRRZ T1,TIMDAT ;GET THE TIMER CHANNEL
TIMER ;DO THE FUNCTION
ERJMP SETT.1 ;TRAP ERROR
$RETT ;RETURN
SETT.1: $TEXT(,<
?Timer Setup Failed for ^E/s1/>)
$RETT ;RETURN
> ;End TOPS20
TOPS10 <
$RETT
> ;End TOPS10
SUBTTL CLRTIM CLEAR THE TIMER FUNCTION
;THIS ROUTINE WILL CLEAR THE TIMER IF PROCESS HAS ALREADY AWOKEN
CLRTIM:
TOPS20 <
SKIPN S2,TIMSET ;TIMER INTERRUPT SET?
$RETT ;NO, JUST RETURN
MOVSI S1,.FHSLF ;GET THE FORK HANDLE
HRRI S1,.TIMDD ;GET TIMER FUNCTION
HRRZ T1,TIMDAT ;GET THE INTERRUPT CHANNEL
TIMER ;DO THE FUNCTION
ERJMP .+1 ;TRAP ERROR
SETZM TIMSET ;CLEAR THE TIMER FLAG
$RETT ;RETURN
> ;End TOPS20
TOPS10 <
$RETT
> ;End TOPS10
SUBTTL P$TINT TIMER INTERRUPT ROUTINE
;THIS ROUTINE IS GIVEN CONTROL ON A TIMER INTERRUPT
TOPS20 <
P$TINT: $BGINT 1 ;LEVEL NUMBER
SKIPE TIMSTI ;TIMER STORE CHARACTER
JRST TINT.1 ;CHECK IT OUT
SKIPN TIMCHK ;TIMER SETUP
$DEBRK ;NO, JUST EXIT
SKIPN TIMSET ;WAS TIMER SET
$DEBRK ;NO JUST EXIT
SETZM TIMSET ;CLEAR TIMER FLAG
MOVE S1,@TIMPC ;GET THE PC
$CALL S%INTR ;STILL IN COMMAND
SKIPT ;YES, GET OUT NOW
$DEBRK ;NO .. RETURN
SETOM TIMSTI ;SETUP TERMINAL WAKEUP
HRLZI S1,.TICCB ;SETUP THE CHARACTER
HRR S1,TIMDAT ;GET THE CHANNEL
ATI ;ATTACH IT
MOVX S1,RT%DIM ;GET DEFERRED TERMINAL INTERRUPTS
HRRI S1,.FHSLF ;FOR MY PROCESS
RTIW ;READ THE VALUES.. T1 HAS MASK
MOVX S1,ST%DIM ;SET DEFERRED WAKEUP CHARACTERS
HRRI S1,.FHSLF ;FOR MY PROCESS
TXO T1,1B<.CHCNB> ;TURN ON CONTROL B
STIW ;SET THE MASK
HLRZ S1,CMDBLK+.CMIOJ ;GET THE JFN
MOVEI S2,.CHCNB ;CTRL/B
STI ;SET THE CHARACTER
$DEBRK ;RETURN ..WAIT FOR CHARACTER
TINT.1: SETZM TIMSTI ;CLEAR THE FLAG
MOVEI S1,.TICCB ;SETUP CONTROL B
DTI ;DETACH IT
$CALL CNTCHR ;GET THE POSITION
MOVEI T1,NCHPW*BUFSIZ ;GET SIZE OF BUFFER
MOVEM T1,CMDBLK+.CMCNT ;RESET THE COUNT
MOVEM S1,CMDBLK+.CMINC ;NO, SAVE THE COUNT
HRROI S1,BUFFER ;POINTER TO NEXT FIELD
MOVEM S1,CMDBLK+.CMPTR ;SAVE THE POINTER
TINT.2: MOVE S1,@TIMPC ;GET THE PC
$CALL S%INTR ;FLAG THE INTERRUPT
MOVEI S1,S%EXIT ;GET THE PC
MOVEM S1,@TIMPC ;SAVE THE PC
SETOM TIMINT ;SETUP INTERRUPT FLAG
$DEBRK ;DEBRK
> ;End TOPS20
TOPS10 <
P$TINT: $BGINT 1 ;LEVEL NUMBER
$DEBRK ;NO, JUST EXIT
> ;End TOPS10
SUBTTL CNTCHR COUNT CHARACTERS IN THE BUFFER
;THIS ROUTINE WILL COUNT THE CHARACTERS IN THE COMMAND INPUT
;BUFFER UP TO THE NULL.
;
;RETURN S1/ COUNT OF CHARACTERS
CNTCHR: HRLI S2,(POINT 7,) ;SETUP BYTE POINTER
HRRI S2,BUFFER ;TO THE TEXT
SETZM S1 ;CLEAR COUNTER
CNTC.1: ILDB T1,S2 ;GET A BYTE
JUMPE T1,.RETT ;NULL?..RETURN
AOJA S1,CNTC.1 ;NO, GET NEXT ONE
SUBTTL REPRMT DO REPROMPT OF COMMAND
;THIS ROUTINE WILL DO A REPROMPT BY PLACING A ^R IN THE TERMINALS
;INPUT BUFFER
REPRMT:
TOPS20 <
$CALL GETT.2 ;REPROMPT THE STRING
$RETT ;RETURN
> ;End TOPS20
TOPS10 <
$RETT ;RETURN
> ;End TOPS10
SUBTTL P$HELP Routine to display help from file
;Local storage for P$HELP
STRLEN==^D30 ;Length of a string
TXTLEN==^D100 ;Length of help text
BYTCLC==TXTLEN*5-1 ;MAXIMUM BYTES FOR TEXT LESS
; ONE FOR THE NULL
DEFINE $TDATA(NAME,SIZE) <
..TRR==10 ;;REMEMBER RADIX
RADIX 8
..NV==1 ;;INIT THE FRAME COUNT
.TRV1<NAME,SIZE> ;;ALLOCATE FIRST ARG
DEFINE $TDATA(NAM,SIZ) <
.TRV1<NAM,SIZ>>> ;;REDEFINE $TDATA CALLS
DEFINE $TRVAR <
IFDEF ..NV,<
JSP TF,.TRSET ;;Call the allocator
XWD ..NV,..NV ;;Set length argument
PURGE ..TRR,..NV>> ;;Purge the symbols
$TDATA HLPIFN,1 ;STORAGE FOR HELP FILE IFN
$TDATA HLPFOB,FOB.MZ ;RESERVE AREA FOR FOB
$TDATA HLPCNT,1 ;NUMBER OF STRINGS FOUND
$TDATA SRCSTR,STRLEN ;CURRENT SEARCH DATA
$TDATA HLPSTR,STRLEN ;HELP STRING
$TDATA SCHARG,1 ;SEARCH ARGUMENT
$TDATA BYTECT,1 ;NUMBER OF BYTES REMAINING
$TDATA BYTEBP,1 ;POINTER TO LAST BYTE STORED
$TDATA HLPTXT,TXTLEN ;START OF TEXT
;Flag definitions for P$HELP (T4 is flag AC)
FL.DSP==1B0 ;Display this line
FL.DSS==1B1 ;Display scratch flag
FL.EOF==1B2 ;End of file seen
FL.CRL==1B3 ;We just saw CRLF
FL.WLD==1B4 ;We saw an "*" for this field
FL.NUL==1B5 ;We were called with a null string
FL.QUA==1B6 ;We saw a "/" for this field
;P$HELP is a subroutine to search for specified help text entry
; in the system help file and output it to the user's
; terminal. (Via the default text output routine the user
; specified in their library initialization)
;Call: S1/ Address of Help file FD
; S2/ Pointer to search string
;True return: No returned arguments
; Help text has been displayed
;False return: Error message has been displayed
;The possible error conditions that may be returned are:
; 1) No Help file available
; 2) Specified keyword not found
; 3) IO error reading Help file
ENTRY P$HELP
P$HELP: $SAVE <T1,T2,T3,T4>
$TRVAR ;ALLOCATE LOCAL STORAGE
SETZM BYTECT ;CLEAR REMAINING BYTE COUNT
SETZM HLPTXT ;CLEAR FIRST WORD OF TEXT
MOVEM S1,FOB.FD+HLPFOB ;SAVE ADDRESS OF FD
TLCE S2,777777 ;Make real pointer
TLCN S2,777777
HRLI S2,(POINT 7)
MOVEM S2,SCHARG ;SAVE STRING POINTER
MOVX S1,FLD(7,FB.BSZ)+FLD(1,FB.LSN)
MOVEM S1,FOB.CW+HLPFOB ;SETUP BYTESIZE
MOVEI S1,FOB.MZ ;SETUP FOR OPEN
MOVEI S2,HLPFOB
$CALL F%IOPN ;OPEN THE HELP FILE
JUMPF [MOVEI S2,HLPFNF ;POINT TO ERROR TEXT
SETOM HLPIFN ;SET FILE NOT OPEN FLAG
JRST HELPRT]
MOVEM S1,HLPIFN ;SAVE THE IFN
SETOM S2 ;GET ACTUAL FILE NAME
$CALL F%FD
MOVEM S1,FOB.FD+HLPFOB ;SAVE IN CASE OF ERROR
MOVE S1,SCHARG ;GET POINTER TO DESIRED HELP
MOVE S2,[POINT 7,HLPSTR] ;STORE IN SAFE PLACE
HELP.1: ILDB T1,S1 ;GET A BYTE
CAIG T1," " ;READ UNTIL FIRST SEPARATOR
JRST HELP.2
IDPB T1,S2
JRST HELP.1
HELP.2: SETZ T1, ;TERMINATE STRING WITH A NULL
IDPB T1,S2
$CALL GETHLP ;CALL MAIN WORKING CODE
;AS A SUBROUTINE.
SKIPF ;ANYTHING FAIL?
SETZ S2,0 ;NO, SO CLEAR ERROR MESSAGE
HELPRT: SETZ S1,0 ;ALWAYS RETURN ERROR BLOCK
;ADDRESS REGISTER
DMOVE T1,S1 ;RELOCATE ERROR ARGUMENTS
SKIPE S2 ;ALL OK?
$TEXT (,^I/0(S2)/) ;NO, DISPLAY ERROR
SKIPL S1,HLPIFN ;GET THE IFN IF ANY
$CALL F%REL ;RELEASE THE FILE
SKIPN S2,T2 ;STATUS
$RETT
$RETF
HLPFNF: ITEXT<%Help file "^F/@FOB.FD+HLPFOB/" not found>
;GETHLP is herein defined as a subroutine only for the purpose of
; clarifying the code. The subroutine does all of the
; "work" involved in searching the data file for the
; specified ASCII string and displaying it on the terminal.
;Call: No calling arguments. T3 contains address of
; dynamic page
;True return: No arguments returned
;False return: S2 contains address of error message
GETHLP: SETZM HLPCNT ;COUNT NUMBER OF ENTRIES
SETZM T4 ;CLEAR THE FLAGS
MOVE S1,[POINT 7,HLPSTR] ;Point to calling string
ILDB S2,S1 ;Get the first byte
CAIN S2,.CHNUL ;Null string?
TXO T4,FL.DSP!FL.NUL ;YES, display and remember
CAIN S2,"/" ;Qualifier?
JRST [TXO T4,FL.QUA ;YES, remember it
ILDB S2,S1 ;Get the next byte
JRST .+1]
CAIN S2,"*" ;Wild card?
TXO T4,FL.WLD ;YES, match all
HELP.A: TXNE T4,FL.EOF ;End of file?
JRST HELP.C ;YES, return
$CALL GETBYT ;Get a byte from help file
JUMPF HELP.C ;Assume EOF
CAIN S2,"*" ;Want to check display?
JRST [$CALL HLPCHK ;Yes
JRST HELP.A]
CAIN S2,"!" ;Is this a comment?
JRST [$CALL HLPCOM ;Yes
JRST HELP.A]
CAIN S2,"@" ;Indirecting?
JRST [$CALL HLPIND ;Yes
JRST HELP.A]
CAIN S2,"/" ;Qualifier?
JRST [$CALL HLPQUA ;Yes
JRST HELP.A]
TXNE T4,FL.DSP ;Are we displaying?
AOS HLPCNT ;YES, remember it
$CALL HLPEOL ;Process this line
JRST HELP.A ;Do the next line
HELP.C: SKIPE HLPCNT ;ANY HELP FOUND?
JRST HELP.D ;YES, FORCE OUT LAST LINE
MOVEI S2,HLPNHA ;NO, RETURN AN ERROR
$RETF
HELP.D: MOVEI S2,.CHNUL ;Get a null
$CALL PUTBYT
$TEXT (,^T/HLPTXT/^A) ;Force out the buffer
$RETT
HLPNHA: ITEXT<%No help available for "^Q/SCHARG/">
;Routine to process a help file line
HLPCOM: TXZE T4,FL.DSP+FL.DSS ;Clear and check display flag
TXO T4,FL.DSS ;Remember it was set
HLPLIN: $CALL GETBYT ;Read a byte from file
JUMPF HLPEOF ;Check for error or EOF
HLPEOL: TXNE T4,FL.DSP ;Want to display?
$CALL PUTBYT ;Yes
CAIE S2,.CHCRT ;Was it a Carriage return?
JRST HLPLIN ;NO, loop until we find one
$CALL GETBYT ;Read another byte
JUMPF HLPEOF ;Check for error or EOF
TXNE T4,FL.DSP ;Want to display?
$CALL PUTBYT ;Yes
CAIE S2,.CHLFD ;Was it a line feed?
JRST HLPLIN ;NO, loop until we find CRLF
TXZE T4,FL.DSS ;Need to restore display flag?
TXO T4,FL.DSP ;YES, set it again
TXO T4,FL.CRL ;Say we just say CRLF
$RETT ;Return
HLPIND: $CALL HLPCOM ;Treat indirect as a comment
$RETT
HLPEOF: TXO T4,FL.EOF ;Set end of file
CAIN S1,EREOF$ ;Really end of file?
$RETF ;YES, just return
HLPERR: MOVEI S2,HLPERF ;NO, error reading file
$RETF
HLPERF: ITEXT<?Error reading help file "^F/@FOB.FD+HLPFOB/">
;HLPCHK is called when an "*" is seen in column 1 of the help file
; It checks to see if the remaining keyword text should
; be displayed.
HLPCHK: TXNE T4,FL.WLD ;Wild field?
JRST [TXO T4,FL.DSP ;Yes
$RETT]
MOVE T1,[POINT 7,SRCSTR] ;Point to storage
TXZ T4,FL.DSP ;Clear display flag
HLPC.A: $CALL GETBYT ;Get a byte from help file
JUMPF HLPEOF ;Check for error or EOF
IDPB S2,T1 ;Store the byte
CAIE S2,.CHCRT ;Was it a carriage return?
JRST HLPC.A ;NO, get the next byte
MOVEI S2,.CHNUL ;YES, replace it with a null
DPB S2,T1
$CALL GETBYT ;Insist on CRLF
JUMPF HLPEOF ;Check for error or EOF
CAIE S2,.CHLFD
$RETF ;Oops..the help file is bad
HLPC.B: HRROI S1,HLPSTR ;Point to desired string
HRROI S2,SRCSTR ;Point to help string
$CALL S%SCMP ;See if they match
SKIPE S1 ;Do they match?
TXNE S1,SC%SUB ; or almost match?
TXO T4,FL.DSP ;YES, display subsequent help
TXNE S1,SC%LSS ;Looked at enough?
TXO T4,FL.EOF ;YES, End the search
$RETT
HLPQUA: $RETT
;Subroutine to get a byte from the help file.
;Call: T4/ FL.DSP if byte is to be displayed
;Return: TRUE S2/ Byte from file
; FALSE S1/ Error code (Most likely end of file)
GETBYT: MOVE S1,HLPIFN ;Point to the file
$CALL F%IBYT ;Get the byte
CAIE S2,.CHLFD ;Line feed or Form feed?
CAIN S2,.CHFFD
$RET ;YES, just return
TXZ T4,FL.CRL ;NO, clear CRLF seen
$RET
;Subroutine to output data to our preallocated page. If overflow
; occurs the page is immediately output, the pointers are
; reset, and the page is reused.
;Call: S2 contains ASCII byte
;Return: Always to .+1
PUTBYT: SOSGE BYTECT ;ANY ROOM LEFT?
JRST PUTOUT ;NOPE
IDPB S2,BYTEBP ;YUP, PLANT THE CHARACTER
$RET
PUTOUT: PUSH P,S1 ;SAVE THE CHARACTER REGISTER
PUSH P,S2
$TEXT (,^T/HLPTXT/^A) ;TYPE THE DATA
MOVEI S1,BYTCLC ;RESET THE COUNT
MOVEM S1,BYTECT ;..
MOVE S2,[POINT 7,HLPTXT] ;AND THE BP
MOVEM S2,BYTEBP
POP P,S2
POP P,S1
JRST PUTBYT
END