Trailing-Edge
-
PDP-10 Archives
-
BB-H138E-BM
-
galaxy-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 Preliminaries
;
;
; COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION
; 1975,1976,1977,1978,1979,1980,1981,1982,1983,1984,1985
;
; 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)
;Version numbers
PARMAN==:101 ;Maintenance edit number
PARDEV==:110 ;Development edit number
VERSIN (PAR) ;Generate edit number
TWOSEG
RELOC 400000
SUBTTL Table of Contents
; Table of Contents for OPRPAR
;
;
; Section Page
; 1. Preliminaries. . . . . . . . . . . . . . . . . . . . . 1
; 2. Table of Contents. . . . . . . . . . . . . . . . . . . 2
; 3. Revision history . . . . . . . . . . . . . . . . . . . 3
; 4. Entry points . . . . . . . . . . . . . . . . . . . . . 4
; 5. Storage and constants. . . . . . . . . . . . . . . . . 5
; 6. P$INIT . . . . . . . . . . . . . . . . . . . . . . . . 6
; 7. PARINI . . . . . . . . . . . . . . . . . . . . . . . . 7
; 8. PARSER . . . . . . . . . . . . . . . . . . . . . . . . 8
; 9. PARCMD . . . . . . . . . . . . . . . . . . . . . . . . 9
; 10. VALCMD . . . . . . . . . . . . . . . . . . . . . . . . 10
; 11. PARRET . . . . . . . . . . . . . . . . . . . . . . . . 11
; 12. PARERR . . . . . . . . . . . . . . . . . . . . . . . . 12
; 13. CHKEOF . . . . . . . . . . . . . . . . . . . . . . . . 13
; 14. CLSTAK . . . . . . . . . . . . . . . . . . . . . . . . 14
; 15. TAKCLR . . . . . . . . . . . . . . . . . . . . . . . . 14
; 16. ERREXT . . . . . . . . . . . . . . . . . . . . . . . . 15
; 17. INCORE . . . . . . . . . . . . . . . . . . . . . . . . 16
; 18. CMDMES . . . . . . . . . . . . . . . . . . . . . . . . 17
; 19. SETPMT . . . . . . . . . . . . . . . . . . . . . . . . 18
; 20. RESCN. . . . . . . . . . . . . . . . . . . . . . . . . 19
; 21. Dispatch for Parser Save Routines. . . . . . . . . . . 20
; 22. SAVKEY/SAVSWI Save a switch or keyword . . . . . . . . 21
; 23. SAVFIL . . . . . . . . . . . . . . . . . . . . . . . . 22
; 24. SAVNUM . . . . . . . . . . . . . . . . . . . . . . . . 23
; 25. SAVZER . . . . . . . . . . . . . . . . . . . . . . . . 23
; 26. SAVUQS . . . . . . . . . . . . . . . . . . . . . . . . 24
; 27. SAVATM . . . . . . . . . . . . . . . . . . . . . . . . 24
; 28. SAVRES . . . . . . . . . . . . . . . . . . . . . . . . 25
; 29. SAVDEV . . . . . . . . . . . . . . . . . . . . . . . . 26
; 30. SAVTOK . . . . . . . . . . . . . . . . . . . . . . . . 27
; 31. SAVNOD . . . . . . . . . . . . . . . . . . . . . . . . 27
; 32. SAVINI . . . . . . . . . . . . . . . . . . . . . . . . 27
; 33. REPARS . . . . . . . . . . . . . . . . . . . . . . . . 28
; 34. FILDEF . . . . . . . . . . . . . . . . . . . . . . . . 29
; 35. PDBCPY . . . . . . . . . . . . . . . . . . . . . . . . 30
; 36. STBDEL . . . . . . . . . . . . . . . . . . . . . . . . 30
; 37. TXTINP . . . . . . . . . . . . . . . . . . . . . . . . 31
; 38. GETTXT . . . . . . . . . . . . . . . . . . . . . . . . 32
; 39. TAKFDB . . . . . . . . . . . . . . . . . . . . . . . . 33
; 40. TAKDEF . . . . . . . . . . . . . . . . . . . . . . . . 33
; 41. TAKRTN . . . . . . . . . . . . . . . . . . . . . . . . 34
; 42. WAIFDB . . . . . . . . . . . . . . . . . . . . . . . . 35
; 43. P$STAK . . . . . . . . . . . . . . . . . . . . . . . . 36
; 44. P$TAKE . . . . . . . . . . . . . . . . . . . . . . . . 37
; 45. P$SETU . . . . . . . . . . . . . . . . . . . . . . . . 38
; 46. P$CURR . . . . . . . . . . . . . . . . . . . . . . . . 38
; 47. P$PREV . . . . . . . . . . . . . . . . . . . . . . . . 38
; 48. P$NEXT . . . . . . . . . . . . . . . . . . . . . . . . 39
; 49. P$NFLD . . . . . . . . . . . . . . . . . . . . . . . . 39
; 50. P$CFM. . . . . . . . . . . . . . . . . . . . . . . . . 40
; 51. P$COMMA. . . . . . . . . . . . . . . . . . . . . . . . 41
; 52. P$KEYW . . . . . . . . . . . . . . . . . . . . . . . . 42
; 53. P$SWIT . . . . . . . . . . . . . . . . . . . . . . . . 43
; 54. P$USER . . . . . . . . . . . . . . . . . . . . . . . . 44
; 55. P$FLOT . . . . . . . . . . . . . . . . . . . . . . . . 45
; 56. P$DIR. . . . . . . . . . . . . . . . . . . . . . . . . 46
; 57. P$TIME . . . . . . . . . . . . . . . . . . . . . . . . 47
; 58. P$NUM. . . . . . . . . . . . . . . . . . . . . . . . . 48
; 59. P$FILE . . . . . . . . . . . . . . . . . . . . . . . . 49
; 60. P$FLD. . . . . . . . . . . . . . . . . . . . . . . . . 50
; 61. P$NODE . . . . . . . . . . . . . . . . . . . . . . . . 51
; 62. P$SIXF . . . . . . . . . . . . . . . . . . . . . . . . 52
; 63. P$RNGE . . . . . . . . . . . . . . . . . . . . . . . . 53
; 64. P$TEXT . . . . . . . . . . . . . . . . . . . . . . . . 54
; 65. P$DEV. . . . . . . . . . . . . . . . . . . . . . . . . 55
; 66. P$QSTR . . . . . . . . . . . . . . . . . . . . . . . . 56
; 67. P$UQSTR. . . . . . . . . . . . . . . . . . . . . . . . 57
; 68. P$ACCT . . . . . . . . . . . . . . . . . . . . . . . . 58
; 69. P$NPRO . . . . . . . . . . . . . . . . . . . . . . . . 59
; 70. P$GPDB . . . . . . . . . . . . . . . . . . . . . . . . 60
; 71. P$PNXT . . . . . . . . . . . . . . . . . . . . . . . . 61
; 72. P$PERR . . . . . . . . . . . . . . . . . . . . . . . . 62
; 73. P$PDEF . . . . . . . . . . . . . . . . . . . . . . . . 63
; 74. P$PACT . . . . . . . . . . . . . . . . . . . . . . . . 64
; 75. P$INTR . . . . . . . . . . . . . . . . . . . . . . . . 65
; 76. SETTIM . . . . . . . . . . . . . . . . . . . . . . . . 66
; 77. CLRTIM . . . . . . . . . . . . . . . . . . . . . . . . 67
; 78. P$TINT . . . . . . . . . . . . . . . . . . . . . . . . 68
; 79. CNTCHR . . . . . . . . . . . . . . . . . . . . . . . . 69
; 80. REPRMT . . . . . . . . . . . . . . . . . . . . . . . . 70
; 81. P$HELP . . . . . . . . . . . . . . . . . . . . . . . . 71
; 82. End. . . . . . . . . . . . . . . . . . . . . . . . . . 77
SUBTTL Revision history
COMMENT \
101 4.2.1396 24-Jun-82
Clear TIMINT in one and only one place, in the literal
after the SKIPE TIMINT in PARS.2.
***** Release 4.2 -- begin maintenance edits *****
***** Release 5.0 -- begin development edits *****
110 5.1003 30-Dec-82
Move to new development area. Add version vector. Clean up
edit organization. Update TOC.
\ ;End of Revision History
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 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
RELOC
SUBTTL P$INIT Initialize and set timer (TOPS20 only)
;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 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: 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 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
PJRST 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: $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 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
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
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 ;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
$TEXT (ERRRTN,<^T/@ERRSTG/: "^T/ATMBFR/"^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 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)
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 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 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
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 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
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 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 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 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: 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 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
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,BUFSIZ-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 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
TAKFDB: $NOISE(TAK001,<commands from>)
TAK001: $FILE(TAK002,<input filespec>,<$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 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: 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
$RETIF ;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
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
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
;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$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: 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
$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$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
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==^D80/5 ;Max length of a string
TXTLEN==^D80/5 ;Length of text buffer
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,<
PUSHJ P,.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,P1>
$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 A SAFE PLACE
SETZ P1, ;Say we have no pointer yet
HELP.1: ILDB T1,S1 ;Get a character
CAIE T1," " ;Have a space?
CAIN T1,11 ;Or a tab?
JRST [SKIPN P1 ;Yes, have one previously?
MOVE P1,S2 ;No, save current location
JRST HELP.2] ;Go save it
CAIG T1," " ;Good character?
JRST HELP.3 ;No, go finish
SETZ P1, ;Real character, say no pointer
; Save current character
HELP.2: IDPB T1,S2 ;Save it
JRST HELP.1 ;Go for more
HELP.3: SKIPE P1 ;Any adjustment?
MOVE S2,P1 ;Yes, get real pointer
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,SCHARG ;Get calling pointer
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
CAIE S2,"*" ;Want to check display?
JRST HELP.B ;No, skip this
SKIPE HLPCNT ;Yes, but displayed any entry yet?
JRST [TXNE T4,FL.WLD ;Yes, but are we displaying all?
JRST .+1 ;Yes, continue displaying
JRST HELP.C] ;No, terminate searching
$CALL HLPCHK ;No display yet or all, go and check
JRST HELP.A
HELP.B: 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
HLPQUA: PJRST HLPEOL ;Process this 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
;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
SUBTTL End
XLIST ;TURN LISTING OFF
LIT ;DUMP LITERALS
LIST ;TURN LISTING ON
END