Trailing-Edge
-
PDP-10 Archives
-
cuspjul86upd_bb-jf24a-bb
-
10,7/galaxy/operat/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 12-SEP-85
;
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1975,1976,1977,1978,1979,1980,1981,1982,1983,1984,1986.
;ALL RIGHTS RESERVED.
;
; 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==:106
OPRVRS==:OPRVRS ;REFERENCE OPR/ORION'S AND
%%.OPR==:%%.OPR ;ORNMAC'S VERSIONS
TWOSEG
RELOC 400000
SUBTTL Table of Contents
; TABLE OF CONTENTS FOR OPRPAR
;
;
; SECTION PAGE
; 1. Table of Contents......................................... 2
; 2. Revision History.......................................... 3
; 3. Entry points.............................................. 4
; 4. Storage and constants..................................... 5
; 5. P$INIT Initialize and set timer (TOPS20 only)............ 6
; 6. PARINI Initialize the database........................... 7
; 7. PARSER Main entry to parse a command..................... 8
; 8. PARCMD Do the command parse.............................. 9
; 9. VALCMD Process a valid command field..................... 10
; 10. PARRET Setup arguments and return........................ 11
; 11. PARERR COMND JSYS error routine......................... 12
; 12. CHKEOF Check for end of take file........................ 13
; 13. CLSTAK Close the take file............................... 14
; 14. TAKCLR Cleanup after take file........................... 14
; 15. ERREXT Error return from parser.......................... 15
; 16. INCORE Check and setup for incore processing............. 16
; 17. CMDMES Check and/or setup the command message............ 17
; 18. SETPMT Setup the prompt pointer.......................... 18
; 19. RESCN Rescan routine to setup initial command.......... 19
; 20. Dispatch for Parser Save Routines......................... 20
; 21. SAVKEY/SAVSWI Save a switch or keyword.................... 21
; 22. SAVFIL Save a filespec................................... 22
; 23. SAVNUM Save a number..................................... 23
; 24. SAVZER Save a COMMA or CONFRM............................ 23
; 25. SAVUQS Save an unquoted string........................... 24
; 26. SAVATM Save the atom as the argument..................... 24
; 27. SAVRES Save a 2 word argument............................ 25
; 28. SAVDEV Save routine for a device......................... 26
; 29. SAVTOK Save routine to save a token...................... 27
; 30. SAVNOD Save node specification........................... 27
; 31. SAVINI Initialize the returned arguments................. 27
; 32. REPARS Set up for COMND reparse.......................... 28
; 33. FILDEF Fill in defaults for COMND........................ 29
; 34. PDBCPY Copy a switch table............................... 30
; 35. STBDEL Delete a local switch table entry................. 30
; 36. TXTINP Multiple line text input routines................. 31
; 37. GETTXT Get multiple lines of text........................ 32
; 38. TAKFDB TAKE command tables............................... 33
; 39. TAKDEF Take default setting.............................. 33
; 40. TAKRTN Special routines for TAKE commands................ 34
; 41. WAIFDB WAIT command tables............................... 35
; 42. P$STAK Setup TAKE command................................ 36
; 43. P$TAKE Routine to setup a TAKE command................... 37
; 44. P$SETU Setup the parser block pointer address............ 38
; 45. P$CURR Get the address of the current entry.............. 38
; 46. P$PREV Position to previous parser entry................. 38
; 47. P$NEXT Bump the pointer to next field.................... 39
; 48. P$NFLD Get header and data for a parser element.......... 39
; 49. P$CFM Check for a confirm in next block................. 40
; 50. P$COMMA Check for a comma in next block................... 41
; 51. P$KEYW Get a keyword from the parsed data................ 42
; 52. P$SWIT Get a switch from the parsed data................. 43
; 53. P$USER Get the user id field............................. 44
; 54. P$FLOT Get the floating point number..................... 45
; 55. P$DIR Get the directory field........................... 46
; 56. P$TIME Get the time/date field........................... 47
; 57. P$NUM Get a number from the parser block................ 48
; 58. P$FILE Get a filespec from the parser block.............. 49
; 59. P$FLD Get a text field from block....................... 50
; 60. P$NODE Get a node from block............................. 51
; 61. P$SIXF Get a sixbit field type........................... 52
; 62. P$RNGE Get a range back.................................. 53
; 63. P$TEXT Get a text address and length..................... 54
; 64. P$DEV Get a device address and length................... 55
; 65. P$QSTR Get a quoted string............................... 56
; 66. P$UQSTR Get an unquoted string............................ 57
; 67. P$ACCT Get an account string............................. 58
; 68. P$NPRO No processing required............................ 59
; 69. P$GPDB Get the PDB address if any data................... 60
; 70. P$PNXT Get next PDB given a PDB block.................... 61
; 71. P$PERR Get error routine given a PDB block............... 62
; 72. P$PDEF Get default filler routine given a PDB block...... 63
; 73. P$PACT Get action routine given a PDB block.............. 64
; 74. P$INTR Interrupt support code............................ 65
; 75. SETTIM Setup the timer function.......................... 66
; 76. CLRTIM Clear the timer function.......................... 67
; 77. P$TINT Timer interrupt routine........................... 68
; 78. CNTCHR Count characters in the buffer.................... 69
; 79. REPRMT Do reprompt of command............................ 70
; 80. P$HELP Routine to display help from file................. 71
SUBTTL 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>
SUBTTL Storage and constants
XLIST ;TURN LISTING OFF
LIT ;DUMP LITERALS
LIST ;TURN LISTING ON
RELOC 0
$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 TIMBLK,3 ;PITMR. UUO BLOCK
;**;[102]ADD 1 LINE AT TIMSTI:+1L 9-SEP-83/DPM
$DATA WAKEUP,1 ;[102]WAKEUP TIME FOR WAIT COMMAND
$DATA PRSPTR,1 ;BYTE POINTER FOR PARSING
$DATA PRSCNT,1 ;BYTE COUNT FOR PARSING
$DATA USRPTR,1 ;USER BYTE POINTER TO RETURN DATA
$DATA SBCFLG,1 ;NON-ZERO IF SUB-COMMAND PROCESSING
$DATA SBCUSR,1 ;0 IF SUB-COMMAND MODE CLEARED BY USER
$DATA SBCINI,<1+PB%SIZ> ;INIT BLOCK FOR SUB-COMMANDS
$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
$GDATA 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
$GDATA TAKFOB,FOB.SZ ;AUTO TAKE FILE FOB
$DATA FILERR,40 ;SPACE FOR ERROR MESSAGE
$DATA IMOPR,1 ;FLAG WHETHER WE ARE ORION
RELOC
SUBTTL P$INIT Initialize and set timer
;THIS ROUTINE WILL SETUP FOR TIMER INTERRUPTS IF POSSIBLE
;AND INIT THE PARSER
;CALL S1/ LEVEL,, TIMER CHANNEL OR OFFSET
; S2/ BASE OF INTERRUPT SYSTEM
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
SETOM TIMCHK ;SET TIME CHECK IN EFFECT
TOPS10 <
HRRZS TIMDAT+0 ;NO GALAXY SUPPORT FOR PSI LEVELS
HRRZ S1,TIMDAT+0 ;GET OFFSET TO VECTOR BLOCK
ADD S1,TIMDAT+1 ;PUT VECTOR ADDRESS IN S1
MOVEI S2,.PSVOP(S1) ;GET ADDRESS IF OLD PC
MOVEM S2,TIMPC ;SAVE
MOVEI S2,P$TINT ;INTERRUPT ROUTINE
MOVEM S2,.PSVNP(S1) ;SAVE
MOVEI S1,TIMBLK ;POINT TO PITMR. UUO BLOCK
MOVX S2,.PCTMR ;CONDITION CODE = TIMER
MOVEM S2,.PSECN(S1) ;SAVE
MOVE S2,TIMDAT+0 ;PSI LEVEL,,OFFSET
HRLZM S2,.PSEOR(S1) ;SAVE OFFSET,,0
HLLZM S2,.PSEPR(S1) ;SAVE PSI LEVEL,,0
HRLI S1,(PS.FAC) ;ADD CONDITION
PISYS. S1, ;ENABLE TIMER INTERRUPTS
JFCL ;IGNORE ERRORS
> ;End TOPS10
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
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
$RETT ;RETURN
SUBTTL PARINI Initialize the database
;THIS ROUTINE IS CALLED TO SET UP THE PARSER DATA BASE FOR
;USE IN SUBSEQUENT CALLS TO THE PARSER ENTRY PARRTN
PARINI: SETZM IMOPR ;ASSUME WE'RE NOT ORION
MOVNI S1,1 ;-1 FOR US
MOVEI S2,JI.JNO ;FUNCTION CODE
$CALL I%JINF ;GET OUR JOB
PUSH P,S2 ;SAVE
MOVEI S1,SP.OPR ;SPECIAL PID INDEX
$CALL C%RPRM ;GET ORION'S PID
JUMPF PARI.0 ;CAN'T
$CALL C%PIDJ ;TRANSLATE TO A JOB NUMBER
JUMPF PARI.0 ;SHOULDN'T FAIL
CAMN S1,(P) ;ORION PARSING COMMANDS?
SETOM IMOPR ;YES, REMEMBER WHO WE ARE
PARI.0: POP P,S2 ;TRIM STACK
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
PUSHJ P,P$7BIT ;SET USER BYTE POINTER TO 7-BIT
MOVX S1,DEFPTR ;GET PARSE BYTE POINTER
MOVEM S1,PRSPTR ;SAVE
MOVEI S1,44 ;BITS PER WORD
LOAD S2,PRSPTR,BP.SIZ ;GET BYTE SIZE FROM POINTER
IDIVI S1,(S2) ;COMPUTE BYTES PER WORD
MOVEM S1,PRSCNT ;SAVE
MOVE S1,PRSPTR ;GET BYTE POINTER BACK
HRRI 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 ;BUFFER SIZE IN WORDS
IMUL S1,PRSCNT ;COMPUTE TOTAL BYTES IN BUFFER
MOVEM S1,CMDBLK+.CMCNT ;SAVE INITIAL # OF FREE CHARACTER POSITIONS
MOVE S1,PRSPTR ;GET BYTE POINTER
HRRI S1,ATMBFR ;GET POINTER TO ATOM BUFFER
MOVEM S1,CMDBLK+.CMABP ;SAVE POINTER TO LAST ATOM INPUT
MOVEI S1,ATMSIZ ;BUFFER SIZE
IMUL S1,PRSCNT ;COMPUTE TOTAL BYTES IN 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 CMDRET+CR.RES ;CLEAR RESULT FIELD
SETZM CMDRET+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 Main entry to parse a command
;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 [SETZM TIMINT ;Yes, clear the timer interrupt flag
LOAD T1,.CMFNP(S2),CM%FNC ;GET THE FUNCTION CODE
CAIN T1,.CMINI ;NOT .CMINI SKIP REPROMPT
$CALL REPRMT ;REPROMPT
JRST REPARSE] ;AND REPARSE
$FALL PARCMD ;PARSE THE COMMAND
SUBTTL PARCMD Do the command parse
;THIS ROUTINE WILL DO ANY DEFAULT FILLING AND THEN CALL
;S%CMND TO PARSE THE COMMAND
PARCMD: SKIPE DFLAGS ;ANY ENTRY TO DELETE
$CALL STBDEL ;DELETE THE ENTRY
PUSHJ P,P$7BIT ;SET USER BYTE POINTER TO 7-BIT
$CALL FILDEF ;FILL IN ANY DEFAULTS IF NEEDED
JUMPF ERREXT ;ERROR..RETURN
PUSHJ P,SUBCMD ;DO ANY SUB-COMMAND PROMPTING
JUMPF PARERR ;RETURN ON FAILURE
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 SUBCMD Process a sub-command request
SUBCMD: SETZM SBCFLG ;NO SUB-COMMAND PROCESSING YET
LOAD S1,CMDRET+CR.PDB,RHMASK ;GET THE CURRENT PDB
JUMPE S1,.RETT ;RETURN IF FIRST TIME
PUSHJ P,P$GPDB ;GET THE PDB
JUMPF .RETT ;NO SUB-COMMAND PROMPT
CAILE S2,PB%PMT ;IS THERE A PROMPT WORD?
SKIPN S1,PB%PMT(S1) ;GET THE VALUE AND RETURN
$RETT ;NO SUB-COMMAND PROMPT
MOVEM S1,ARGSAV+PAR.PM ;SAVE PROMPT STRING HERE FOR CALLER
PUSHJ P,SETPMT ;SET THE PROMPT
MOVE S1,[SUBINI,,SBCINI] ;SET UP BLT
BLT S1,SBCINI+1+PB%SIZ-1 ;COPY
LOAD S1,CMDRET+CR.PDB,RHMASK ;GET CURRENT PDB AGAIN
SUBI S1,1 ;ADJUST
MOVEM S1,SBCINI+1+PB%ERR ;SAVE
MOVEI S1,SBCINI ;POINT TO INIT BLOCK
MOVEM S1,ARGSAV+PAR.TB ;SAVE FOR REPARSE
SETOM SBCFLG ;FLAG SUB-COMMAND IN PROGRESS
SETOM SBCUSR ;USER MUST CLEAR TO EXIT SUB-COMMAND
$RETT ;RETURN
SUBINI: $INIT (SUBCMD) ;DUMMY ARGUMENT
SUBTTL VALCMD Process a valid command field
;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 Setup arguments and return
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
MOVE T1,PRSPTR ;SOURCE BYTE POINTER
HRRI T1,BUFFER ;SOURCE TEXT OF COMMAND
HRRZ T2,ARGFRE ;DESTINATION POINTER
AOS T2 ;LEAVE ROOM FOR HEADER
ADD T2,USRPTR ;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
MOVE S1,PRSPTR ;GET BYTE POINTER
HRRI S1,BUFFER ;INCLUDE ADDRESS
MOVEM S1,CMDBLK+.CMPTR ;SAVE POINTER TO COMMAND STRING
MOVEI S1,BUFSIZ ;GET BUFFER SIZE
IMUL S1,PRSCNT ;COMPUTE CHARACTER COUNT
MOVEM S1,CMDBLK+.CMCNT ;SAVE IN COMMAND BLOCK
MOVEI S1,BUFFER ;RETURN 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 during 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 during incore parse/]
SETOM INTEXT ;MARK AS INTERRUPT EXIT
PJRST ERREXT ;EXIT
SUBTTL CHKEOF Check for 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 during command parse/]
ERREXT: MOVEM S2,ERRSTG ;SAVE THE STRING ADDRESS
$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
MOVE S2,PRSPTR ;BYTE POINTER
HRRI S2,ATMBFR ; TO ATOM BUFFER
$TEXT (ERRRTN,<^T/@ERRSTG/: "^Q/S2/"^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
MOVE T2,PRSPTR ;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
MOVE S2,S1 ;COPY POINTER
TLCE S2,-1 ;LH 0?
TLCN S2,-1 ;OR -1
HLL S2,USRPTR ;YES--SETUP A BYTE POINTER
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
MOVE S1,PRSPTR ;GET BYTE POINTER
HRRI S1,BUFFER ;INCLUDE ADDRESS
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
MOVE S1,PRSPTR ;GET BYTE POINTER
HRRI S1,BUFFER ;POINT TO TEXT
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: TLCE S1,-1 ;LH 0?
TLCN S1,-1 ;OR -1
HLL S1,USRPTR ;YES--SETUP A BYTE POINTER
MOVEM S1,CMDBLK+.CMRTY ;SAVE THE PROMPT FOR COMMAND
MOVEM S1,CURPMT ;SAVE THE CURRENT PROMPT
SETZ T1, ;CLEAR S2
SETP.1: ILDB S2,S1 ;GET A BYTE
SKIPE S2 ;WAS IT NULL?
AOJA T1,SETP.1 ;NO, COUNT IT
MOVEM T1,PRMTSZ ;SAVE PROMPT SIZE
$RETT ;RETURN TRUE
SUBTTL RESCN Rescan routine to setup initial command
;This routine will read the characters from the previous command
;line and place them in the command buffer for reparsing.
;
;For TOPS10 the buffer will always be terminated by a <CRLF>
;regardless of the actual break character used to terminate
;the line at command level.
;RETURN S1/ COUNT OF CHARACTERS
TOPS20 <
RESCN: 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 <
;Line break set definition for TOPS10
;<ESC><^Z><DC1-DC4><DLE><FF><VT> and <LF>
LINBRK==^B00001100000111110001110000000000
RESCN: MOVEI T3,1 ;Initialize count
RESCAN 1 ;Anything to be had?
JRST RESCN1 ;Yes..get it
JRST RESCN2 ;No..just return
RESCN1: $CALL K%BIN ;YES, get it
IDPB S1,T2 ;Store it
CAIL S1,.CHLFD ;Possible break character?
CAILE S1,.CHESC
AOJA T3,RESCN1 ;No..get next character
MOVEI S2,1 ;Get a bit to use for test
LSH S2,0(S1)
TXNN S2,LINBRK ;Is it a break character?
AOJA T3,RESCN1 ;No..get next character
CAIN S1,.CHLFD ;Yes..was it line feed?
JRST RESCN2 ;Yes..terminate the buffer
MOVEI S1,.CHCRT ;No..replace it with <CRLF>
DPB S1,T2
MOVEI S1,.CHLFD
IDPB S1,T2
AOJA T3,RESCN2 ;Bump count for extra character
> ;End TOPS10 conditional
RESCN2: SETZ S1, ;Terminate buffer with a null
IDPB S1,T2
MOVE S1,T3 ;Return 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)
SAVUSR ;USER NAME (.CMUSR)
SAVZER ;COMMA (.CMCMA)
SAVINI ;INITIALIZATION (.CMINI)
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 SAVKEY/SAVSWI Save a switch or keyword
;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 SAVFIL Save a filespec
;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 SAVUSR Save a PPN
; THIS ROUTINE WILL SAVE A PPN AND OPTIONALLY A PPN MASK
SAVUSR: MOVE T1,CR.COD(S2) ;GET COMND TYPE
STORE T1,@ARGFRE,PF.TYP ;SAVE
LOAD T1,CR.PDB(S2),RHMASK ;GET LAST PDB USED BY COMMAND
MOVE T1,.CMDAT(T1) ;GET WORD CONTAINING OPTIONAL DATA
MOVEI T2,PFD.D1+1 ;DEFAULT SIZE OF BLOCK
TXNE T1,CM%WLD!CM%WLA ;WILDCARDING?
MOVEI T2,PFD.D2+1 ;YES--IT'S A LITTLE BIGGER
STORE T2,@ARGFRE,PF.LEN ;SAVE LENGTH
AOS ARGFRE ;BUMP TO NEXT LOCATION
MOVE T2,CR.RES(S2) ;GET PPN WORD
MOVEM T2,@ARGFRE ;SAVE
AOS ARGFRE ;BUMP TO NEXT LOCATION
TXNN T1,CM%WLD!CM%WLA ;WILDCARDING?
POPJ P, ;NO--JUST RETURN
MOVE T2,1(T1) ;ELSE GET PPN MASK
MOVEM T2,@ARGFRE ;SAVE
AOS ARGFRE ;BUMP TO NEXT LOCATION
POPJ P, ;RETURN
SUBTTL SAVNUM Save a number
;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 SAVZER Save a COMMA or CONFRM
;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 an 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
ADD T2,USRPTR ;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 SAVATM Save the atom as the argument
;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
ADD T2,USRPTR ;MAKE INTO A BYTE POINTER
MOVE T1,PRSPTR ;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 SAVRES Save a 2 word argument
;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 SAVTOK Save routine to save a token
;THIS ROUTINE WILL SAVE A TOKEN IN THE COMMAND MESSAGE
SAVTOK: LOAD T2,CR.PDB(S2),RHMASK ;PDB USED BY COMMAND
MOVE T1,.CMDAT(T2) ;DATA USED BY COMND
TLCE T1,-1 ;LH 0?
TLCN T1,-1 ;OR -1
HLL T1,USRPTR ;YES--SETUP A BYTE POINTER
MOVE T2,ARGFRE ;GET DESTINATION POINTER
ADDI T2,1 ;BUMP BY 1 PASSED HEADER
ADD T2,USRPTR ;MAKE DESTINATION POINTER
PJRST SAVA.1 ;USE SAVE ATOM ROUTINE
SUBTTL SAVNOD 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 SAVINI Initialize the returned arguments
;THIS ROUTINE IS CALLED TO INITIALIZE THE SAVE ROUTINES FOR THE PARSER
;IT IS THE FUNCTION DEPENDENT ROUTINE FOR THE .CMINI FUNCTION
SAVINI: SKIPE SBCFLG ;DOING SUB-COMMAND INITIALIZATION?
JRST SAVIN1 ;YES--DO THINGS DIFFERENTLY
SETZM SBCUSR ;MAKE SURE WE START OFF CLEAN
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
POPJ P, ;AND RETURN
SAVIN1: MOVE S1,CURPTR ;GET CURRENT BYTE POINTER
MOVEM S1,CMDBLK+.CMPTR ;RESET SINCE COMND WIPES IT
POPJ P, ;RETURN
SUBTTL REPARS 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 FILDEF 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 during 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 PDBCPY Copy a switch table
;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 Delete a local switch table entry
;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+1+.CMFNP ;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 Get multiple lines of 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
ADD T1,PRSPTR ;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,BUFSIZ-100 ;COMPUTE REMAINING LENGTH-100
IMUL T2,PRSCNT ;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-2 ;SIZE OF BUFFER
IMUL S1,PRSCNT ;COMPUTE CHARACTER COUNT
SUB S1,CMDBLK+.CMCNT ;GET CHARACTERS IN BUFFER
MOVEM S1,CMDBLK+.CMINC ;SAVE IN COMMAND BLOCK
MOVE S1,PRSPTR ;GET BYTE POINTER
HRRI S1,BUFFER ;POINT TO TEXT
MOVEM S1,CMDBLK+.CMBFP ;RESET START OF TEXT BUFFER
MOVEM S1,CMDBLK+.CMPTR ;SAVE THE TEXT POINTER
MOVEI S1,BUFSIZ ;BUFFER SIZE
IMUL S1,PRSCNT ;COMPUTE CHARACTER COUNT
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 during 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 TAKFDB TAKE command tables
DEFINE NEXTF(FOO),<TEMFDB> ;LOCAL NEXT MACRO FOR AUTO TAKE
TAKFDB: $NOISE(TAK001,<commands from>)
TAK001: $IFILE(TAK002,<input filespec>,<$PREFILL(TAKDEF),$ACTION(TAKRTN),$ERROR(BADIFI)>)
TAK002: $KEYDSP (TAK010,<$DEFAULT(<NOW>),$ALTER(TAK003)>)
TAK003: $FTAD (TAK005,<$ALTER(TAK004)>)
TAK004: $SWITCH (,TAK020,<$ALTER(TAK009)>)
TAK005: $SWITCH (,TAK030,<$ACTION(C.SWIT+PDBCPY),$ALTER(TAK009)>)
TAK009: $CRLF (<$ACTION(TAKE)>)
TAK010: $STAB
ORNDSP(TAK130,DAILY,DLY)
ORNDSP(TAK140,EVERY,WKY)
ORNDSP(TAK004,NOW,NOW)
$ETAB
TAK020: $STAB
ORNSDP (TAK009,<DISPLAY>,DSP)
ORNSDP (TAK009,<NODISPLAY>,NDP)
$ETAB
TAK030: $STAB
ORNSDP(NEXTF(TAK005),<FAILSOFT>,FSF)
ORNSDP(TAK150,<REASON:>,RSN)
$ETAB
TAK130: $NOISE(TAK132,<at>)
TAK132: $TIME(TAK005)
TAK140: $KEY(TAK145,TAK142)
TAK142: $STAB
KEYTAB(2,FRIDAY)
KEYTAB(5,MONDAY)
KEYTAB(3,SATURDAY)
KEYTAB(4,SUNDAY)
KEYTAB(1,THURSDAY)
KEYTAB(6,TUESDAY)
KEYTAB(0,WEDNESDAY)
$ETAB
TAK145: $NOISE(TAK146,<at>)
TAK146: $TIME(TAK005)
TAK150: $CTEXT(TAK009,<reason text (same line) followed by confirm>)
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 TAKRTN 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: PUSH P,S1 ;SAVE SACRED AC
PUSH P,S2 ;AND ANOTHER
MOVE T1,CR.SAV(S2) ;GET FD ADDRESS
MOVEM T1,TAKFOB+FOB.FD ;SAVE
MOVE T3,.FDLEN(T1) ;PRESERVE LENGTH WORD
MOVEI T2,.FDNAT ;NATIVE MODE FILE
STORE T2,.FDLEN(T1),FD.TYP ;SAVE
MOVEI T2,7 ;7-BIT BYTES
MOVEM T2,TAKFOB+FOB.CW ;SAVE IN CONTROL WORD
MOVEI S1,FOB.SZ ;FOB SIZE
MOVEI S2,TAKFOB ;FOB ADDRESS
$CALL F%IOPN ;OPEN FILE FOR INPUT
JUMPF TAKR.1 ;CHECK ERRORS
PUSH P,S1 ;SAVE IFN
MOVNI S2,1 ;WANT ACTUAL FD
$CALL F%FD ;GET IT
MOVSI T1,(S1) ;POINT TO STORAGE
LOAD T2,.FDLEN(S1),FD.LEN ;GET ACTUAL LENGTH
MOVE S2,-1(P) ;GET SAVED ADDRESS OF CMD BLOCK
HRR T1,CR.SAV(S2) ;GET COMMAND FILESPEC STORAGE
ADD T2,CR.SAV(S2) ;COMPUTE END BLT ADDRESS
BLT T1,-1(T2) ;COPY ACTUAL FILESPEC
MOVE S1,CR.SAV(S2) ;GET FD ADDRESS
MOVEM T3,.FDLEN(S1) ;RESTORE LENGTH WORD
POP P,S1 ;GET IFN BACK
$CALL F%RREL ;RELEASE IFN
POP P,S2 ;RESTORE ACS
POP P,S1 ; ...
$RETT ;AND RETURN
TAKR.1: $TEXT (<-1,,FILERR>,<^E/S1/^0>) ;GET ERROR TEXT
MOVEI S2,FILERR ;POINT TO IT
POP P,(P) ;TRIM STACK
POP P,S1 ;RESTORE S1
$RETF ;PROPAGATE ERROR
TAKE: SKIPE IMOPR ;ORION DOING AN INTERNAL TAKE?
$RETT ;YES--CAN DO NO MORE HERE
; SETOM TAKFLG ;SET FLAG FOR PROCESSING TAKE
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$IFIL ;IS IT AN INPUT FILE SPEC ???
JUMPF TAKE.2 ;NO, ERROR
MOVE T2,S1 ;ADDRESS OF THE BLOCK
$CALL P$KEYW ;GET THE NEXT FIELD
JUMPF TAK.1 ;DID WE FIND A KEY WORD ?
CAIN S1,.KYWKY ;YES, IS IT A WEEKLY TAKE ?
JRST TAK.4 ;YES, SEND TO ORION/CLEAN UP
CAIN S1,.KYDLY ;NO, THEN IS IT A DAILY TAKE ?
JRST TAK.4 ;YES, SEND TO ORION/CLEAN UP
TAK.1: $CALL P$TIME ;NO, AN $FTAD TAKE FIELD ?
JUMPT TAK.4 ;DID WE FIND A IT ??
$CALL P$CFM ;NO, MUST BE AN IMMEDIATE TAKE
JUMPT TAK.3 ;DO WE HAVE A CONFIRM ?
$CALL TAKDSP ;NO, CHECK TAKE DISPLAY SWITCHES
$RETIF ;FALSE..PASS ERRORS UP
$CALL P$CFM ;CHECK FOR A CONFIRM
JUMPF TAKE.1 ;ERROR...RETURN
TAK.3: SKIPE TAKFLG ;PROCESSING A TAKE COMMAND
JRST TAKE.6 ;NESTING IS ILLEGAL
SETOM TAKFLG ;NOW DOING A TAKE COMMAND
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
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
TAK.4: $RETT ;NOTHING TO CLEAN UP IF SENDING TO ORION
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: MOVE S2,PARDAT ;GET THE PAGE ADDRESS
MOVE S1,COM.PB(S2) ;GET POINTER TO PARSER BLOCK
ADDI S1,(S2) ;GET OFFSET FOR PARSER DATA
$CALL P$SETU ;SET UP THE PARSE POINTER
$CALL P$KEYW ;SKIP THE NEXT FIELD
$CALL P$IFIL ;GET THE CURRENT PARSE BLOCK
JUMPF TAKE.5 ;IS IT AN INPUT FILE BLOCK ???
$TEXT (T%TTY,<? Can't open TAKE command file: "^F/@S1/"^0>); YES ...
SETOM S2 ;DON'T OUTPUT ANYTHING ELSE
JRST TAKERR ;AND RETURN
TAKE.4: MOVEI S2,[ASCIZ/Invalid argument in TAKE command/]
JRST TAKERR ;TAKE ERROR EXIT
TAKE.5: MOVEI S2,[ASCIZ/Can't find TAKE command FD parse block/]
JRST TAKERR ;TAKE ERROR EXIT
TAKE.6: MOVEI S2,[ASCIZ/TAKE command is illegal in a command file/]
$FALL TAKERR ;TAKE ERROR EXIT
TAKERR: SETZM TAKFLG ;CLEAR THE TAKE FLAG ON ERROR
SETZM DSPTAK ;ALWAYS ZERO DISPLAY FLAG
$RETF ;RETURN FALSE
SUBTTL WAIFDB WAIT command 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
;**;[102]REVAMP CODE AT WAIT.2:+2L 9-SEP-83/DPM
WAIT.3: SKIPG S1 ;[102]IF A NEGATIVE NUMBER,
MOVEI S1,1 ;[102]SLEEP FOR A SECOND
CAILE S1,^D60 ;[102]IF MORE THAN A MINUTE
MOVEI S1,^D60 ;[102]SLEEP FOR A MINUTE
PUSH P,S1 ;[102]SAVE SECONDS TO SLEEP
$CALL .SC2UD ;[102]CONVERT TO UDT FRACTION
MOVEM S1,WAKEUP ;[102]SAVE IT
$CALL I%NOW ;[102]GET CURRENT TIME
ADDM S1,WAKEUP ;[102]THIS IS THE WAKEUP TIME
POP P,S1 ;[102]GET SLEEP TIME BACK
JRST WAIT.5 ;[102]ENTER SLEEP LOOP
WAIT.4: $CALL I%NOW ;[102]GET CURRENT TIME
CAML S1,WAKEUP ;[102]TIME TO WAKE UP?
$RETT ;[102]YES
SUB S1,WAKEUP ;[102]GET DIFFERENCE
MOVMS S1 ;[102]MAKE IT POSITIVE
$CALL .UD2SC ;[102]CONVERT UDT FRACTION TO SECONDS
WAIT.5:
TOPS10 <SLEEP S1,> ;[102]SLEEP
TOPS20 <
IMULI S1,^D1000 ;[102]CONVERT SECONDS TO MILLISECONDS
DISMS ;[102]ELSE SLEEP FOR SPECIFIED SECONDS
JFCL ;[102]USE A LOCATION
> ;END TOPS20 CONDITIONAL
JRST WAIT.4 ;[102]GO SEE IF TIME TO WAKE UP
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
;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
; On failure, release all IFN's and return false
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
; The error must indicate bad IFN
MOVEM S1,CMDJFN ;Save proper file index
TXO S1,CO%NRJ+CZ%NUD ;Close but don't release JFN
CLOSF
JRST P$TAK3 ;Should never happen
MOVE S1,CMDJFN ;Reclaim the JFN
MOVX S2,FLD(7,OF%BSZ)+OF%RD ;Reopen in proper mode
OPENF
JRST P$TAK3 ;Should never happen
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
JUMPF P$TAK4 ;Return error after cleanup
MOVEM S1,LOGIFN ;Save the IFN
TOPS20 <
MOVEI S2,FI.CHN ;Get the JFN for TOPS20
$CALL F%INFO
JUMPF P$TAK4 ;Return error after cleanup
MOVEM S1,LOGJFN ;Save the JFN
TXO S1,CO%NRJ+CZ%NUD ;Close but don't release JFN
CLOSF
JRST P$TAK2 ;Should never happen
MOVE S1,LOGJFN ;Reclaim proper JFN
MOVX S2,FLD(7,OF%BSZ)+OF%WR ;Reopen in proper mode
OPENF
JRST P$TAK2 ;Should never happen
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
; Cleanup after failure
P$TAK2: MOVE S1,LOGJFN ;Want to release log file
$CALL F%REL ;And don't care about errors
P$TAK3: MOVX S1,ERUSE$ ;Error code
P$TAK4: EXCH S1,CMDIFN ;Get the command file IFN
; Saving S1 just in case
$CALL F%REL ;Close and release it
;Don't care about false returns
MOVE S1,CMDIFN ;Remember S1 if worth remembering
SETZM CMDIFN ;Forget about it
SETZM LOGIFN ;Forget about it
SETZM TAKFLG ;No takes either
$RETF ;Tell the user tuff luck
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 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$xBIT Set 7 or 8 bit byte pointer
; THIS ROUTINE WILL SET THE BYTE POINTER FOR PARSING.
; RETURN TRUE: S1/PREVIOUS BYTE POINTER
; RETURN FALSE: NOT IMPLEMENTED YET
P$8BIT::SKIPA S1,[POINT 8,0] ;8-BIT
P$7BIT::MOVSI S1,(POINT 7,0) ;7-BIT
SKIPA ;ENTER COMMON CODE
P$DBIT::MOVX S1,DEFPTR ;DEFAULT POINTER
P$XBIT::EXCH S1,USRPTR ;SWAP
$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
CAIN S1,.CMNUX ; OR TERMINATED BY NON-DIGIT?
SKIPA ;YES TO EITHER
$RETF ;LOSER
DMOVE S1,PFD.D1(S2) ;S1:= NUMBER, S2:= RADIX
PJRST P$NEXT ;ADVANCE TO NEXT FIELD AND RETURN
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: MOVE T1,PRSPTR ;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
$RETIF ;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
$RETIF ;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
$RETIF ;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$XSBC Sub-command mode routines
; Test for sub-command mode and return table header and prompt
; Call: No arguments
; TRUE return: S1/ table header, S2/ Prompt string
; FALSE return: Not in sub-command mode
P$TSBC::SKIPN SBCUSR ;IN SUB-COMMAND MODE?
$RETF ;NO
MOVE S1,ARGSAV+PAR.TB ;GET TABLE HEADER
MOVE S2,ARGSAV+PAR.PM ;GET PROMPT STRING
$RETT ;RETURN
; Exit sub-command mode
; Call: No arguments
; TRUE return: Sub-command mode terminated
; FALSE return: Not in sub-command mode
P$XSBC::SKIPN SBCUSR ;IN SUB-COMMAND MODE?
$RETF ;NO
SETZM SBCUSR ;ZERO
$RETT ;AND RETURN
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
$RETIF ;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
$RETIF ;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
$RETIF ;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 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
MOVEI S2,BUFSIZ ;GET COMMAND BUFFER SIZE
IMUL S2,PRSCNT ;COMPUTE CHARACTER COUNT
CAME S1,S2 ;BUFFER EMPTY
JRST INTR.2 ;CHECK THE TIMER
;COVER A ^U ..DO THE RESET IF AT THE PROMPTS
MOVEI S2,BUFSIZ ;GET SIZE OF BUFFER
IMUL S2,PRSCNT ;COMPUTE CHARACTER COUNT
MOVEM S2,CMDBLK+.CMCNT ;RESET THE COUNT
SETZM CMDBLK+.CMINC ;NO, SAVE THE COUNT
MOVE S1,PRSPTR ;GET BYTE POINTER BACK
HRRI S1,BUFFER ;GET POINTER TO INPUT TEXT BUFFER
MOVEM S1,CMDBLK+.CMPTR ;SAVE THE POINTER
TOPS10< PUSHJ P,SETTMX> ;CAUSE TRAP OUT OF S%CMND
TOPS20 <
MOVEI S1,S%EXIT ;ADDRESS OF RETURN PC
MOVEM S1,@TIMPC ;SAVE THE NEW PC
> ;END TOPS20
$RETT ;RETURN
INTR.2: SKIPE TIMCHK ;TIMER TRAPS IN USE?
$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
SETTMO: MOVE S1,[PS.TMS+^D250] ;INTERRUPT (ALMOST) IMMEDIATELY
PUSHJ P,SETTIM ;SET THE TIMER TRAP
SETZM TIMSET ;AVOID RECURSION
POPJ P, ;AND RETURN
SETTMX: SKIPA S1,[PS.TMS+^D250] ;INTERRUPT (ALMOST) IMMEDIATELY
SETTIM:
TOPS10 <
MOVEI S1,^D30 ;# SECONDS
MOVEM S1,TIMSET ;REMEMBER IN CASE WE HAVE TO CLEAR IT
PITMR. S1, ;ENABLE TIMER INTERRUPTS
JFCL ;FAILED
>
TOPS20 <
$CALL I%NOW ;GET THE CURRENT TIME
MOVE S2,S1 ;PUT TIME IN S2
ADDI S2,^D3*^D30 ;REQUEST INTERRUPT IN 30 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 .+1 ;TRAP ERROR
> ;END TOPS20
$RETT ;RETURN
SUBTTL CLRTIM Clear the timer function
;THIS ROUTINE WILL CLEAR THE TIMER IF PROCESS HAS ALREADY AWOKEN
CLRTIM: SKIPN S2,TIMSET ;TIMER INTERRUPT SET?
$RETT ;NO, JUST RETURN
TOPS10 <
MOVEI S1,0 ;CLEAR (ACTUALLY 1 TICK)
PITMR. S1, ;SET CLOCK REQUEST
JFCL ;FAILED
>
TOPS20 <
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
> ;END TOPS20
SETZM TIMSET ;CLEAR THE TIMER FLAG
$RETT ;RETURN
SUBTTL P$TINT Timer interrupt routine
;THIS ROUTINE IS GIVEN CONTROL ON A TIMER INTERRUPT
P$TINT: $BGINT 1 ;LEVEL NUMBER
TOPS20 <
SKIPE TIMSTI ;TIMER STORE CHARACTER
JRST TINT.1 ;CHECK IT OUT
> ;END TOPS20
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
TOPS10 <
MOVE S1,[3,,[EXP .TOTYP,<-1>,<[ASCIZ//]>]]
TRMOP. S1, ;FORCE RETYPE OF CURRENT LINE
JFCL ;CAN DO NOTHING HERE
PUSHJ P,SETTMO ;CAUSE ANOTHER INTERRUPT NOW
> ;END TOPS10
TOPS20 <
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
> ;END TOPS20
MOVEI T1,BUFSIZ ;GET SIZE OF BUFFER
IMUL T1,PRSCNT ;COMPUTE CHARACTER COUNT
MOVEM T1,CMDBLK+.CMCNT ;RESET THE COUNT
MOVEM S1,CMDBLK+.CMINC ;NO, SAVE THE COUNT
MOVE S1,PRSPTR ;GET BYTE POINTER BACK
HRRI S1,BUFFER ;GET POINTER TO INPUT TEXT BUFFER
MOVEM S1,CMDBLK+.CMPTR ;SAVE THE POINTER
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
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: MOVE S2,PRSPTR ;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
P$HELP::PUSHJ P,.SAVE2 ;SAVE P1 AND P2
DMOVE P1,S1 ;SAVE ARGS INCASE OF ERROR
PUSHJ P,.HELPF## ;CALL THE LIBRARY HELP PROCESSOR
$RETIT ;RETURN IF NO ERRORS
CAIN S1,ERNHA$ ;NO HELP AVAILABLE?
JRST HELP.1 ;YES
CAIN S2,ERFNF$ ;FILE NOT FOUND?
JRST HELP.2 ;YES
$TEXT (,<% ^E/S1/>) ;COMPLAIN
$RETF ;RETURN
HELP.1: MOVEI S2,[ITEXT (< for "^T/(P2)/">)]
SKIPN P2 ;HAVE A SEARCH STRING?
MOVEI S2,[ITEXT (<>)] ;NO
$TEXT (,<% ^E/S1/^I/(S2)/>)
$RETF ;RETURN
HELP.2: $TEXT (,<% Help file ^F/(P1)/ not found>)
$RETF ;RETURN
SUBTTL End
XLIST ;TURN LISTING OFF
LIT ;DUMP LITERALS
LIST ;TURN LISTING ON
END