Trailing-Edge
-
PDP-10 Archives
-
tops20-v7-ft-dist1-clock
-
7-sources/cpatop.mac
There are 7 other files named cpatop.mac in the archive. Click here to see a list.
TITLE CPATOP COMND style parsing for TOPS-10 and TOPS-20
SUBTTL Murray Berkowitz/PJT Oct 13, 1979
;
;
;
; COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1975, 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 THAT IS NOT SUPPLIED BY DIGITAL.
;
SEARCH CPASYM,CMDPAR
PROLOG (CPATOP)
RELOC
SUBTTL Table of Contents
; TABLE OF CONTENTS FOR OPRPAR
;
;
; SECTION PAGE
; 1. Table of Contents......................................... 2
; 2. PARSER ENTRY POINTS....................................... 3
; 3. PARSER DATA BASE AND CONSTANTS............................ 4
; 4. P$INIT PARSER INIT ROUTINE............................... 5
; 6. PARSE$ PARSER ENTRY POINT................................ 7
; 7. PARCMD PARSE THE COMMAND................................. 8
; 8. VALCMD VALID COMMAND PARSE ROUTINE....................... 9
; 9. PARRET PARSER CODE TO RETURN TO CALLER................... 10
; 10. PARERR COMND JSYS ERROR ROUTINE......................... 11
; 11. CHKEOF CHECK END OF TAKE FILE............................ 12
; 12. CLSTAK CLOSE THE TAKE FILE............................... 13
; 13. TAKCLR CLEANUP AFTER TAKE FILE........................... 13
; 14. ERREXT ERROR RETURN FROM PARSER.......................... 14
; 15. INCORE CHECK AND SETUP FOR INCORE PROCESSING............. 15
; 16. CMDMES CHECK AND/OR SETUP THE COMMAND MESSAGE............ 16
; 17. SETPMT SETUP THE PROMPT POINTER.......................... 17
; 18. RESCN Rescan routine to setup initial command......... 18
; 19. Dispatch for Parser Save Routines......................... 19
; 20. SAVE ROUTINES FOR COMND................................... 20
; 21. SAVE ROUTINE FOR FILE SPECS............................... 21
; 22. SAVE ROUTINE TO COPY VALUES FROM ATOM BUFFER.............. 22
; 23. SAVE ROUTINE FOR COMMA, CONFRM..FUNCTION ONLY............. 22
; 24. SAVE ROUTINE FOR NUMBERS.................................. 22
; 25. SAVUQS SAVE ROUTINE FOR UNQUOTED STRING............... 23
; 26. SAVE ROUTINE FOR SINGLE VALUE FUNCTIONS................... 24
; 27. SAVDEV SAVE ROUTINE FOR A DEVICE...................... 25
; 28. SAVE ROUTINE TO SAVE A TOKEN.............................. 26
; 29. SAVE NODE SPECIFICATION................................... 26
; 30. Initialization for Parser Save Routines................... 26
; 31. Routine to Set Up for COMND Reparse....................... 27
; 32. Routine To Fill in Defaults for COMND..................... 28
; 33. SWITCH TABLE PROCESSING ROUTINES.......................... 29
; 34. STBDEL SWITCH TABLE DELETE ROUTINE....................... 29
; 37. TAKE Command Table........................................ 32
; 38. TAKDEF TAKE DEFAULT SETTING.............................. 32
; 39. TAKE SPECIAL ROUTINES FOR TAKE COMMANDS................ 33
; 40. TAKOPN ROUTINE TO OPEN THE TAKE FILE..................... 33
; 44. P$CURR GET THE ADDRESS OF THE CURRENT ENTRY.............. 36
; 45. P$PREV POSITION TO PREVIOUS PARSER ENTRY................. 36
; 46. P$NEXT BUMP THE POINTER TO NEXT FIELD................... 37
; 47. P$NFLD TO GET HEADER AND DATA FOR A PARSER ELEMENT....... 37
; 48. P$CFM CHECK FOR A CONFIRM IN NEXT BLOCK................. 38
; 49. P$COMMA CHECK FOR A COMMA IN NEXT BLOCK................... 39
; 50. P$KEYW GET A KEYWORD FROM THE PARSED DATA................ 40
; 51. P$SWIT GET A SWITCH FROM THE PARSED DATA................. 41
; 52. P$USER GET THE USER ID FIELD............................. 42
; 53. P$FLOT GET THE FLOATING POINT NUMBER..................... 43
; 54. P$DIR GET THE DIRECTORY FIELD........................... 44
; 55. P$TIME GET THE TIME/DATE FIELD........................... 45
; 56. P$NUM GET A NUMBER FROM THE PARSER BLOCK................ 46
; 57. P$FILE GET A FILESPEC FROM THE PARSER BLOCK.............. 47
; 58. P$FLD GET A TEXT FIELD FROM BLOCK....................... 48
; 59. P$NODE GET A NODE FROM BLOCK............................. 49
; 60. P$SIXF GET A SIXBIT FIELD TYPE........................... 50
; 61. P$RNGE GET A RANGE BACK.................................. 51
; 62. P$TEXT GET A TEXT ADDRESS AND LENGTH..................... 52
; 63. P$DEV GET A DEVICE ADDRESS AND LENGTH................... 53
; 64. P$QSTR GET A QUOTED STRING............................... 54
; 65. P$UQSTR GET AN UNQUOTED STRING............................ 55
; 66. P$STR GET STRING OF SPEC TYPE (RET BP & LEN)............ 56
; 67. P$ACCT GET AN ACCOUNT STRING............................. 57
; 68. P$GPDB GET THE PDB ADDRESS IF ANY DATA................... 58
; 69. P$PNXT GET NEXT PDB GIVEN A PDB BLOCK.................... 59
; 70. P$PERR GET ERROR ROUTINE GIVEN A PDB BLOCK............... 60
; 71. P$PDEF GET DEFAULT FILLER ROUTINE GIVEN A PDB BLOCK...... 61
; 72. P$PACT GET ACTION ROUTINE GIVEN A PDB BLOCK.............. 62
SUBTTL REVISION HISTORY
SUBTTL PARSER ENTRY POINTS
ENTRY PARSE$ ;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$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$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
ENTRY P$STR ;ARBIT STRING
GLOB <.TAKE>
OPDEF $RETIF [JUMPF .POPJ] ;Return error on failure
SUBTTL PARSER DATA BASE AND CONSTANTS
$IMPURE
.SWDSP==1 ;/DISPLAY
.SWNDP==2 ;/NODISP (THE DEFAULT)
$GDATA .LGERR,1 ;LAST CMDPAR ERROR PROCESSED VIA .RETE
$GDATA .LGEPC,1 ;PC (USUALLY) OF LAST $RETE
$GDATA .NEXT,1 ;IF NON-0, USE AS NEXT PDB
$DATA ABSFLG,1 ;SET IF FLD IS ABSENT
$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 PRMTSZ,1 ;SIZE OF THE PROMPT
$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
$DATA 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
$GDATA TEMFDB,PDB.SZ ;TEMP FDB AREA
$DATA CMDERR,^D50 ;SPACE FOR COMMAND ERROR TEXT
$DATA CMDECT,1 ;COMMAND ERROR MESSAGE COUNT
$DATA CMDRET,CR.SIZ ;COMMAND RETURN DATA
$DATA ARGSAV,PAR.SZ ;SAVE AREA FOR PARSER ARGUMENTS
;STORAGE FOR PARSER TO EVENT PROCESSOR COMMUNICATION
$DATA PARDAT,1 ;ADDRESS OF PARSER DATA MESSAGE
$DATA ARGFRE,1 ;POINTER TO FIRST FREE WORD IN ARG SPACE
$DATA FLAGS,1 ;PARSER FLAG WORD
$DATA ERRSTK,1 ;ERROR STACK FOR COMMAND
;TAKE STORAGE
$DATA CMDIFN,1 ;STORAGE FOR COMMAND FILE IFN
$DATA CMDJFN,1 ;STORAGE FOR COMMAND FILE JFN
$DATA LOGIFN,1 ;STORAGE FOR LOG FILE IFN
$DATA LOGJFN,1 ;STORAGE FOR LOG FILE JFN
$DATA TAKFLG,1 ;FLAG TO INDICATE WE ARE IN TAKE COMMAND
$DATA SVP1T,1 ;LOC FOR AC SAVE ROUTINES
$PURE
SUBTTL P$INIT PARSER INIT ROUTINE
;THIS ROUTINE WILL INIT THE PARSER
;CALL: NO ARGUMENTS
P$INIT:
$CALL S%INIT ;INIT SCANNER
$CALL K%INIT ;INIT KEYBRD
$CALL F%INIT ;INIT FILE MGR
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
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
MOVEI S1,CMDBLK ;GET THE COMMAND STATE BLOCK
MOVEM S1,CMDRET+CR.FLG ;SAVE IN FLAG WORD
SETZM CMDBLK+CR.RES ;CLEAR RESULT FIELD
SETZM CMDBLK+CR.COD ;CLEAR THE FIELD CODE
MOVE S1,ARGSAV+PAR.TB ;GET THE TABLE ADDRESS
AOS S1 ;POSITION TO THE PDB
MOVEM S1,CMDRET+CR.PDB ;SAVE AS THE CURRENT PDB
$RET ;RETURN
SUBTTL PARSE$ PARSER ENTRY POINT
;THIS ROUTINE HAS THE FOLLOWING CONVENTIONS
;
;CALL: S1/ SIZE OF THE ARGUMENT BLOCK
; S2/ ADDRESS OF THE ARGUMENT BLOCK
;
;RETURN TRUE: S1/LENGTH OF ARGUMENT BLOCK
; S2/ ADDRESS OF THE BLOCK
;
;RETURN FALSE: S1/LENGTH OF RETURN BLOCK
; S2/ ADDRESS OF RETURN BLOCK
PARSE$: $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
MOVE T1,[CM%XIF!REPARS] ;GET RE-PARSE ADDRESS & DISALLOW @
MOVEM T1,CMDBLK+.CMFLG ;PUT RE-PARSE ADDRESS AWAY
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 P$INIT ;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
PJRST PARCMD ;PARSE THE COMMAND
SUBTTL PARCMD PARSE THE COMMAND
;THIS ROUTINE WILL DO ANY DEFAULT FILLING AND THEN CALL
;S%CMND TO PARSE THE COMMAND
PARCMD: $CALL FILDEF ;FILL IN ANY DEFAULTS IF NEEDED
JUMPF ERREXT ;ERROR..RETURN
SKIPE DFLAGS ;ANY ENTRY TO DELETE
$CALL STBDEL ;DELETE THE ENTRY
LOAD S2,CMDRET+CR.PDB,RHMASK ;GET THE CURRENT PDB
MOVE S1,CMDBLK+.CMPTR ;GET CURRENT BUFFER POINTER
MOVEM S1,CURPTR ;SAVE CURRENT POINTER
MOVEI S1,CMDBLK ;ADDRESS OF THE COMMAND BLOCK
$CALL S%CMND ;CALL COMND TO PARSE COMMAND
MOVE T1,CR.FLG(S2) ;GET THE RETURNED FLAGS
MOVEM T1,PARBLK+PRT.CF ;SAVE THE COMMAND FLAGS
JUMPF PARERR ;PARSER ERROR ROUTINE
HRLZ T2,S2 ;SOURCE IN LEFT HALF
HRRI T2,CMDRET ;SOMMAND RETURN BLOCK
BLT T2,CMDRET-1(S1) ;SAVE THE DATA
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,CR.SIZ ;GET THE ARGUMENT BLOCK
MOVEI S2,CMDRET ;GET BLOCK ADDRESS
PUSHJ P,0(T1) ;USE THE ERROR ROUTINE
JUMPT PARCMD ;GOOD RETURN .. PARSE THE COMMAND
SKIPE S2 ;IF S2 HAS ERROR SET..SKIP
PJRST ERREXT ;ERROR CODE..GO TO EXIT
$CALL S%ERR ;SET UP THE ERROR RETURN
MOVE S2,S1 ;ADDRESS OF MESSAGE IN S2
PJRST ERREXT ;PARSER ERROR RETURN
SUBTTL VALCMD VALID COMMAND PARSE ROUTINE
;THIS ROUTINE WILL GET CONTROL ON A SUCCESSFUL PARSE FROM COMMAND
VALCMD: SKIPL T1,CMDRET+CR.COD ;GET THE PARSED FIELD CODE
CAILE T1,.CMNOD ;WITHIN RANGE OF VALID FUNCTIONS
$STOP(IFC,INVALID FUNCTION CODE FROM COMMAND)
MOVE S1,ARGFRE ;ADDRESS OF NEXT PLACE TO SAVE
MOVEM S1,CMDRET+CR.SAV ;SAVE THE ELEMENT
MOVX S1,CR.SIZ ;SIZE OF THE BLOCK
MOVEI S2,CMDRET ;COMMAND RETURN BLOCK
PUSHJ P,@PARTAB(T1) ;SAVE THE DATA FROM COMMAND
SKIPGE ABSFLG ;ABSENT FLD?
JRST ERREXT ;S2 PTS TO HELP TEXT
LOAD S1,CMDRET+CR.PDB,RHMASK ;GET THE USED PDB BYE COMMAND
$CALL P$PACT ;ANY ACTION ROUTINE
JUMPF VALC.1 ;NO, CONTINUE ON
MOVEI S2,CMDRET ;COMMAND RETURN BLOCK
TLNE S1,-1 ;INTERNAL ACTION (ANY FLAGS SET)?
PJRST VALACT ;YES (ARGS ARE S1/S2)
VACUSR: ;RET HERE IF AC%AAC SET & RH S1 NON-0
HRRZ T2,S1 ;ISOL ROUTINE ADDR
MOVX S1,CR.SIZ ;SIZE OF THE BLOCK
PUSHJ P,0(T2) ;PROCESS THE ROUTINE
JUMPF VALC.3 ;BAD RETURN..SET UP ERROR
VALC.1:
$CALL VALNXT ;GET NEXT PDB
JUMPF PARRET ;GIVE UP
VALC.2:
MOVE T1,0(S1) ;GET 1ST WORD OF BLOCK
TLNN T1,-1 ;IS HDR WORD IF LEN INFO IN LH
JRST [MOVE T2,SUB.RA(S1) ;NO, IS $SUB, GET RET ADDR
MOVEM T2,@SUB.RV(S1) ;PUT RET ADDR AWAY
MOVEM T1,S1 ;MAKE S1 POINT AT 1ST PDB OF $SUB
JRST .+1] ;EXIT IF
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 VALID-TOKEN SUBROUTINES
VALACT: ;DO INTERNAL ACTIONS
;
; ARGUMENTS:
; S1 = ACTION DATA
; S2 = CMDRET PTR
; NOTES:
; CALLED BY PJRST
HRRZ T2,S1 ;SAVE ACTION DATA IN T2
TXNN S1,AC%NOI ;NOISE?
JRST VALAC1 ;NO
$CALL VALNXT ;GET NEXT PDB (RET IN S1)
JUMPF PARRET ;NONE
HRRZ T1,0(T2) ;GET SIZ OF FDB (INCL CNT WD)
ADD T1,T2 ;ADDR OF NOISE'S NEXT FLD
MOVEM S1,0(T1) ;SET NEXT FLD IN NOISE PDB
MOVE S1,T2 ;SET CURR PDB TO NOISE PDB IN ACT DATA
JRST VALC.2
VALAC1:
TXNN S1,AC%R0N ;MUST VAL BE 0 TO N?
JRST VALAC2 ;NO
SKIPGE T1,CR.RES(S2) ;CHK IT
JRST VALAER ;LT 0
JRST VALRUP ;CHK UPPER RANGE
VALAC2:
TXNN S1,AC%R1N ;MUST VAL BE 1 TO N?
JRST VALAIE ;INVALID ACTION FLAG
SKIPG T1,CR.RES(S2) ;GTR 0?
JRST VALAER ;NO
VALRUP:
JUMPE T2,VALC.1 ;UPPER RANGE SPEC? NO IF JUMP
TXNE S1,AC%AAC ;ACT ROUTINE RATHER THAN UPP BND?
JRST VACUSR ;YES, GO BACK AND CALL IT
CAMG T1,T2 ;IS VAL LOW ENUFF?
JRST VALC.1 ;YES
VALAER:
MOVEI S2,[ASCIZ/Number out of range/]
PJRST ERREXT ;MERGE ERR HANDLER
VALAIE:
MOVEI S2,[ASCIZ/Invalid action flag/]
PJRST ERREXT ;DITTO
VALNXT: ;DETS NEXT PDB
MOVE S1,.NEXT ;CHK GLOBAL NEXT PDB FLD
SETZM .NEXT ;INSURE OLD VAL NOT USED AGAIN
JUMPN S1,.RETT ;IS SET, GO USE IT
LOAD S1,CMDRET+CR.PDB,RHMASK ;GET THE USED PDB FROM PARSE
$CALL P$PNXT ;IS THERE A NEXT FIELD?
JUMPT .RETT ;GO USE IT
MOVE S1,CMDRET+CR.COD ;GET THE CODE FIELD
CAXE S1,.CMKEY ;YES, WAS IT A KEYWORD?
CAXN S1,.CMSWI ;OR A SWITCH?
SKIPA ;YES,
$RETF ;NO NEXT..RETURN
MOVE S1,CMDRET+CR.RES ;DATA FROM COMMAND PARSE
HRRZ S1,(S1) ;<R15>YES, GET NEXT PDB FROM DSPTAB
MOVE S1,(S1) ;<R15>NOT FROM PDB
HRRZS S1 ;PASS ONLY THE RIGHT HALF
JUMPE S1,.RETF ;NONE..RETURN WITH MESSAGE
$RETT ;YES
SUBTTL PARRET PARSER CODE TO RETURN TO CALLER
PARRET: MOVE T2,ARGFRE ;LAST FREE LOCATION
MOVE T3,PARDAT ;GET ADDRESS OF PARSER DATA MESSAGE
MOVEM T2,0(T3) ;POINTER FOR MESSAGE TEXT
HRLI T1,(POINT 7,0) ;SOURCE BYTE POINTER
HRRI T1,BUFFER ;SOURCE TEXT OF COMMAND
HRLI T2,(POINT 7,0) ;DESTINATION BYTE POINTER
PARR.0: ILDB S1,T1 ;GET A BYTE
IDPB S1,T2 ;SAVE A BYTE
JUMPN S1,PARR.0 ;NON-ZERO..KEEP CHECKING
SETZ S1, ;CLEAR S1
EXCH S1,FLAGS ;GET THE CURRENT FLAGS AND RESET
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
MOVEI S1,BUFFER ;RESET COMMAND POINTER TO STRING
SKIPE DSPTAK ;DISPLAY TAKE COMMANDS?
$CALL K%SOUT ;YES
HRROM S1,CMDBLK+.CMPTR ;SAVE POINTER TO COMMAND STRING
MOVEI S1,BUFSIZ*NCHPW ;GET # OF CHARACTERS IN BUFFER AREA
MOVEM S1,CMDBLK+.CMCNT ;SAVE IN COMMAND BLOCK
MOVEI S1,BUFFER ;SAVE ADDRESS OF BUFFER
MOVEM S1,PARBLK+PRT.MS
SETZM S1 ;IDENT BEGIN
$CALL P$SETU ;SETUP PTR TO 1ST TOKEN IN PARSER BLK
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
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/]
PJRST ERREXT ;EXIT
SUBTTL CHKEOF CHECK END OF TAKE FILE
;CHECK IF END OF FILE ON TAKE FILE
TOPS20 <
CHKEOF: HLRZ S1,CMDBLK+.CMIOJ ;GET INPUT FILE JFN FOR TAKE FILE
GTSTS% ;GET THE FILE'S STATUS
TXNN S2,GS%EOF ;AT END OF FILE ?
$RETF ;RETURN FALSE
$RETT ;RETURN TRUE
> ;End TOPS20
TOPS10 <
CHKEOF: CAXE S1,EREOF$ ;END OF FILE ERROR??
$RETF ;NO, LOSE
$RETT ;YES,
> ;End TOPS10
SUBTTL CLSTAK CLOSE THE TAKE FILE
SUBTTL TAKCLR CLEANUP AFTER TAKE FILE
CLSTAK: MOVE S1,CMDIFN ;GET IFN FOR THE TAKE FILE
$CALL F%REL ;RELEASE THE FILE
$RETIF ;Return the error on failure
$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
ERREXT: MOVE T3,PARDAT ;GET PAGE ADDRESS
HRLI S2,(POINT 7,0) ;SETUP BYTE POINTER TO SRC
MOVSI T1,(POINT 7,0) ;SETUP BYTE POINTER TO DEST
HRRI T1,CMDERR ;BUFFER FOR DATA
ERRE3A:
ILDB T2,S2 ;GET A CHAR
JUMPE T2,ERRE3B ;DONE
IDPB T2,T1 ;STORE A CHAR
JRST ERRE3A
ERRE3B:
SKIPL ABSFLG ;ABSENT FLD ERR?
JRST ERRE.4 ;NO
SETZM ABSFLG ;CLEAR IT
MOVE S2,[POINT 7,[ASCIZ/ absent/]] ;FINISH UP WITH THIS
JRST ERRE3A
ERRE.4:
IDPB T2,T1 ;STORE A CHAR
MOVEI S2,CMDERR ;SETUP ERROR POINTER
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
$RETF ;RETURN FALSE
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
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: MOVE T3,ARGSAV+PAR.CM ;ANY COMMAND MESSAGE SUPPLIED?
MOVEM T3,PARDAT ;SAVE ADDRESS OF PARSER DATA
AOS T3 ;BUMP IT BY 1
MOVEM T3,ARGFRE ;SAVE AS POINTER TO FREE AREA
$RET ;RETURN
SUBTTL SETPMT SETUP THE PROMPT POINTER
;THIS ROUTINE WILL SET UP THE PROPER PPROMPT STRING FOR COMND.
;THE DEFAULT STRING IS PARSER> ELSE THE
;POINTER GIVEN IN THE PARSER CALL WILL BE USED.
SETPMT: $CALL MAKPTR ;MAKE A POINTER FROM S1 AND RETURN IN S2
MOVEM S2,CMDBLK+.CMRTY ;SAVE THE PROMPT FOR COMMAND
MOVEM S2,CURPMT ;SAVE THE CURRENT PROMPT
SETZ T1, ;CLEAR S2
SETP.1: ILDB S1,S2 ;GET A BYTE
SKIPE S1 ;WAS IT NULL?
AOJA T1,SETP.1 ;NO, COUNT IT
MOVEM T1,PRMTSZ ;SAVE PROMPT SIZE
$RETT ;RETURN TRUE
;THIS ROUTINE WILL MAKE A BYTE POINTER FROM ARGUMENT IN S1
;AND RETURN POINTER IN S2
MAKPTR: HLLZ S2,S1 ;GET THE LEFT HALF AND CHECK FOR POINTER
TLCE S2,-1 ;LEFT HALF = 0
TLCN S2,-1 ; OR -1
HRLI S2,(POINT 7,0) ;YES, SETUP A BYTE POINTER
HRR S2,S1 ;GET THE REST OF THE DATA
$RET ;RETURN
SUBTTL RESCN Rescan routine to setup initial command
;THIS ROUTINE WILL SETUP THE CHARACTERS FROM THE RESCAN FOR PARSING
;
;RETURN S1/ COUNT OF CHARACTERS
RESCN:
TOPS20 <
MOVEI S1,.RSINI ;Make characters available
RSCAN%
ERJMP [$FATAL <Rescan JSYS failed>]
MOVEI S1,.RSCNT ;Get the number of characters available
RSCAN%
ERJMP [$FATAL <Rescan JSYS failed>]
MOVE T1,S1 ;Put count in T1
MOVE T3,T1 ;ALSO SAVE IT IN T3
RESCN1: SOJL T1,RESCN2 ;Exit when count exhausted
$CALL K%BIN ;Read a byte
IDPB S1,T2 ;Store in rescan buffer
JRST RESCN1 ;Back to get the rest
> ;End TOPS20 conditional
TOPS10 <
RESCAN
RESCN1: SKPINC ;Character available?
JRST RESCN2 ;NO, we are all done
$CALL K%BIN ;YES, get it
IDPB S1,T2 ;Store it
AOJA T3,RESCN1 ;BUMP COUNT AND TRY AGAIN
> ;End TOPS10 conditional
RESCN2: SETZ S1, ;Terminate buffer with a null
IDPB S1,T2
MOVE S1,T3 ;GET THE COUNT IN S1
$RETT
SUBTTL Dispatch for Parser Save Routines
;THE ROUTINES ON THE NEXT FEW PAGES SAVE THE OUTPUT OF THE PARSER IN
;A FORM USABLE BY THE EVENT PROCESSOR. THE ACTUAL DATA STRUCTURE IS
;DOCUMENTED IN PARSER.RNO
;THIS IS THE DISPATCH TABLE FOR THE VARIOUS SAVE ROUTINES, ONE FOR
;EACH TYPE OF FIELD THE COMND JSYS CAN PARSE. THESE ROUTINES ARE CALLED
;ON EACH SUCCESSFUL RETURN FROM THE COMND JSYS
;ALL ROUTINES ARE CALLED WITH
; S1/ LENGTH OF BLOCK
; S2/ ADDRESS OF COMND INFO
PARTAB: IFIW SAVKEY ;KEYWORD (.CMKEY)
IFIW SAVNUM ;NUMBER (.CMNUM)
IFIW .POPJ ;NOISE WORD (.CMNOI) (NO PROCESSING)
IFIW SAVSWI ;SWITCH (.CMSWI)
IFIW SAVFIL ;INPUT FILE SPEC (.CMIFI)
IFIW SAVOFI ;OUTPUT FILE SPEC (.CMOFI)
IFIW SAVFIL ;GENERAL FILE SPEC (.CMFIL)
IFIW SAVFLD ;ARBITRARY FIELD (.CMFLD)
IFIW SAVZER ;CONFIRM (.CMCFM)
IFIW SAVRES ;DIRECTORY (.CMDIR)
IFIW SAVRES ;USER NAME (.CMUSR)
IFIW SAVZER ;COMMA (.CMCMA)
IFIW SAVINI ;INITIALIZATION (.CMINI)
;THIS IS CALLED TO INITIALIZE SAVE STUFF
IFIW SAVRES ;FLOATING POINT NUMBER (.CMFLT)
IFIW SAVDEV ;DEVICE NAME (.CMDEV)
IFIW SAVATM ;TEXT TO CARRAIGE RETURN (.CMTXT)
IFIW SAVRES ;DATE AND TIME (.CMTAD)
IFIW SAVATM ;QUOTED STRING (.CMQST)
IFIW SAVUQS ;UNQUOTED STRING (.CMUQS)
IFIW SAVTOK ;TOKEN (.CMTOK)
IFIW SAVNUM ;NUMBER (ARBITRARY TERMINATOR) (.CMNUX)
IFIW SAVATM ;(.CMACT)
IFIW SAVNOD ;NODE NAME (.CMNOD)
SUBTTL SAVE ROUTINES FOR COMND
;THIS ROUTINE WILL SAVE THE SWITCH OR KEYWORD VALUE IN THE
;COMMAND MESSAGE. THE FIRST WORD WILL BE HEADER AND SECOND WORD
;WILL BE THE DATA VALUE
SAVKEY:
SAVSWI: LOAD T1,CR.COD(S2) ;GET THE FUNCTION CODE
MOVE T2,ARGFRE ;Get ptr
STORE T1,<(T2)>,PF.TYP ;SAVE TYPE IN HEADER
MOVEI T1,PFD.D1+1 ;LENGTH OF FIELD
STORE T1,<(T2)>,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
MOVE T2,ARGFRE
MOVEM T1,(T2) ;SAVE THE VALUE IN BLOCK
AOS ARGFRE ;BUMP THE POINTER
$RET ;RETURN
SUBTTL SAVE ROUTINE FOR FILE SPECS
;THIS ROUTINE WILL SAVE A FILESPEC IN THE FORM OF A GALAXY FD
;AS DESCRIBED IN GLXMAC
TOPS20 <
SAVOFI: MOVE T1,[111100,,1] ;OUTPUT ALL UP TO PROTECTION
SKIPA ;OUTPUT THE FILE
SAVFIL: MOVE T1,[111110,,1] ;OUTPUT ALL UP TO PROTECTION
DMOVE T3,S1 ;SAVE THE ARGUMENT BLOCKS
MOVE T2,ARGFRE ;START OF THE BLOCK
HRROI S1,PFD.D1(T2) ;POINTER TO START OF DATA
MOVE S2,CR.RES(S2) ;GET THE JFN
JFNS% ;MAKE JFN INTO A STRING
IBP S1 ;STEP PAST NULL AT END OF STRING
HRRZI S2,1(S1) ;POINT S2 AT FIRST FREE ARGUMENT
EXCH S2,ARGFRE ;UPDATE THE POINTER
HRRZS S1 ;MAKE AN ADDRESS ONLY
SUBI S1,-1(S2) ;GET LENGTH OF THE FD
STORE S1,PFD.HD(T2),PF.LEN ;SAVE LENGTH OF ARGUMENT
LOAD S1,CR.COD(T4) ;GET THE COMND TYPE
STORE S1,PFD.HD(T2),PF.TYP ;SAVE THE HEADER WORD
MOVE S1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR GTJFN BLOCK
SETZM GJFBLK ;CLEAR FIRST WORD
BLT S1,GJFBLK+GJFSIZ-1 ;CLEAR THE BLOCK
MOVE S1,CR.RES(T4) ;GET THE JFN
RLJFN% ;RELEASE THE JFN
JRST [MOVEI S2,[ASCIZ/Error releasing command file JFN/]
$RETF] ;RETURN FALSE
$RET ;RETURN
> ;End TOPS20
TOPS10 <
SAVOFI:
SAVFIL: MOVE T1,ARGFRE ;WHERE TO COPY TO
MOVE T4,CR.RES(S2) ;GET THE RESULT
LOAD T2,.FDLEN(T4),FD.LEN ;GET THE LENGTH OF FD
STORE T2,<(T1)>,PF.LEN ;SAVE LENGTH OF BLOCK
HRL T1,CR.RES(S2) ;WHERE TO COPY FROM
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
MOVE T1,ARGFRE
STORE T4,(<T1>),PF.TYP ;SAVE CODE AND LENGTH
MOVEI T3,1(T2) ;COMPUTE NEXT FREE LOCATION
EXCH T3,ARGFRE ;UPDATE IT
MOVE S1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR GTJFN BLOCK
SETZM GJFBLK ;CLEAR FIRST WORD
BLT S1,GJFBLK+GJFSIZ-1 ;CLEAR THE BLOCK
$RET ;RETURN
> ;End TOPS10
SUBTTL SAVE ROUTINE FOR NUMBERS
;THIS ROUTINE WILL SAVE A NUMBER BLOCK WITH THE NUMBER
;IN THE FIRST DATA WORD AND THE RADIX IN THE SECOND
SAVNUM: LOAD T2,CR.COD(S2) ;GET THE COMND TYPE
MOVE T1,ARGFRE
STORE T2,<(T1)>,PF.TYP ;SAVE THE FUNCTION CODE
MOVEI T2,PFD.SZ ;SIZE OF THE BLOCK
STORE T2,<(T1)>,PF.LEN ;SAVE THE HEADER
AOS T1,ARGFRE ;BUMP TO NEXT LOCATION
MOVE T2,CR.RES(S2) ;GET THE DATA FIELD
STORE T2,<(T1)> ;SAVE THE NUMBER IN BLOCK
AOS T1,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,<(T1)> ;SAVE THE RADIX
AOS ARGFRE ;BUMP TO NEXT LOCATION
$RET ;RETURN
SUBTTL SAVE ROUTINE FOR COMMA, CONFRM..FUNCTION ONLY
;THIS ROUTINE WILL SAVE THE FUNCTION VALUE AND A LENGTH OF 1
SAVZER: LOAD T1,CR.COD(S2) ;GET THE FUNCTION CODE
MOVE T2,ARGFRE
STORE T1,<(T2)>,PF.TYP ;SAVE THE TYPE CODE
MOVEI T1,PFD.D1 ;SIZE OF THE BLOCK
STORE T1,<(T2)>,PF.LEN ;SAVE THE VALUE
AOS ARGFRE ;BUMP TO NEXT LOCATION
$RET ;RETURN
SUBTTL SAVUQS SAVE ROUTINES FOR USER STRINGS
SAVUQS: ;THIS ROUTINE WILL BUILD BLOCK WITH TEXT FROM UNQUOTED STRING FUNCTION
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
SAVFLD: ;COPY FIELD FROM ATOM BUFFER, MAP TO UPPER CASE & CHK FOR NUL FIELD
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
ILDB T3,T1 ;CHK IF NULL STRING
JUMPN T3,SAVF1A ;NO
HRRZ T1,CR.PDB(S2) ;GET PTR TO FDB USED
HRRZ S2,.CMHLP(T1) ;GET PTR TO HELP STRING FOR FLD
SETOM ABSFLG ;SET FLD ABSENT FLAG
$RET ;RET TO CALLER
SAVF.1: ILDB T3,T1 ;GET A CHARACTER FROM THE SOURCE
SAVF1A: CAIG T3,"z" ;LOW CASE UPP BND
CAIGE T3,"a" ;LOW CASE LOWER BND
SKIPA ;OUTSIDE LOWER CASE BNDS
SUBI T3,40 ;LOWER CASE LETTER, MAP TO UPPER CASE
IDPB T3,T2 ;SAVE IT IN THE DESTINATION
JUMPN T3,SAVF.1 ;LOOP IF MORE ...NON-ZERO
JRST SAVA.2 ;DO COMMON FINISH UP
SAVATM: ;COPY TEXT OR QUOTED STRING FROM ATOM BUFFER
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
MOVE T3,ARGFRE
STORE T2,<(T3)>,PF.LEN ;SAVE THE LENGTH
LOAD T2,CR.COD(S2) ;GET THE CODE VALUE
STORE T2,<(T3)>,PF.TYP ;SAVE AS HEADER FOR BLOCK
EXCH T1,ARGFRE ;UPDATE THE FREE POINTER
$RET ;RETURN
SUBTTL SAVE ROUTINE FOR SINGLE VALUE FUNCTIONS
;THIS ROUTINE WILL CREATE A BLOCK WITH ONE DATA ELEMENT IN IT
;TO STORE THE RESULT RETURNED BY COMND
SAVRES: LOAD T2,CR.COD(S2) ;GET CODE IN LEFT HALF
MOVE T1,ARGFRE
STORE T2,<(T1)>,PF.TYP ;SAVE TYPE IN HEADER
MOVEI T2,PFD.D2 ;SIZE OF THE BLOCK
STORE T2,<(T1)>,PF.LEN ;SAVE THE HEADER VALUE
AOS T1,ARGFRE ;BUMP TO NEXT LOCATION
MOVE T2,CR.RES(S2) ;GET THE RESULT
STORE T2,<(T1)> ;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
MOVE T1,ARGFRE
STORE S2,<(T1)>,PF.LEN ;SAVE THE LENGTH IN BLOCK
LOAD S2,CR.COD(T2) ;GET THE FUNCTION CODE
STORE S2,<(T1)>,PF.TYP ;SAVE TYPE IN BLOCK
EXCH T3,ARGFRE ;UPDATE FREE POINTER
$RETT ;RETURN TRUE
> ;End TOPS20
TOPS10 <
SAVDEV==SAVATM
> ;End TOPS10
SUBTTL SAVE ROUTINE TO SAVE A TOKEN
;THIS ROUTINE WILL SAVE A TOKEN IN THE COMMAND MESSAGE
SAVTOK: LOAD T1,CR.PDB(S2),RHMASK ;PDB USED BY COMMAND
LOAD S1,.CMDAT(T1) ;DATA USED BY COMND
MOVE T1,S2 ;SAVE S2
$CALL MAKPTR ;MAKE A POINTER..RETURNED IN S2
EXCH T1,S2 ;POINTER IN T1 AND BLOCK ADDRESS IN S2
MOVE T2,ARGFRE ;GET DESTINATION POINTER
ADDI T2,1 ;BUMP BY 1 PASSED HEADER
HRLI T2,(POINT 7,0) ;MAKE DESTINATION POINTER
PJRST SAVA.1 ;USE SAVE ATOM ROUTINE
SUBTTL SAVE NODE SPECIFICATION
;THIS ROUTINE WILL SAVE ANODE SPECIFICATION IN THE COMMAND
;MESSAGE
TOPS20 <
SAVNOD: PJRST SAVATM ;SAVE THE ATOM FOR TOPS-20
> ;End TOPS20
TOPS10 <
SAVNOD: PJRST SAVRES ;SAVE AS NUMBER WITH NO RADIX
> ;End TOPS10
SUBTTL Initialization for Parser Save Routines
;THIS ROUTINE IS CALLED TO INITIALIZE THE SAVE ROUTINES FOR THE PARSER
;IT IS THE FUNCTION DEPENDENT ROUTINE FOR THE .CMINI FUNCTION
SAVINI: MOVE S1,PARDAT ;GET PAGE ADDRESS
MOVEI T1,1(S1) ;ROOM FOR PTR TO CMD TEXT
MOVEM T1,ARGFRE ;SAVE AS START OF ARGUMENT AREA
$RET ;AND RETURN
SUBTTL Routine to Set Up for COMND Reparse
;THIS ROUTINE IS GOTTEN TO BY THE COMND JSYS CHANGING THE PC WHEN
;A USER RUBS OUT ACROSS A FIELD. IT JUST CLEARS OUT THE TEMPORARY
;STORAGE USED BY COMND AND RESTARTS THE PARSER
REPARS: PUSHJ P,@.CMINI+PARTAB ;TELL SAVE ROUTINES TO FORGET 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
MOVE S1,ARGSAV+PAR.TB ;GET THE ORIGINAL TABLES FROM CALL
AOS S1 ;POSITION TO THE FDB
LOAD T1,.CMFNP(S1),CM%FNC ;GET THE FUNCTION CODE
CAIE T1,.CMINI ;MAKE SURE NOT A .CMINI
JRST REPA.1 ;NOT .CMINI.... O.K.
$CALL P$PNXT ;GET NEXT PDB
AOS S1 ;BUMP TO ACTUAL PDB
REPA.1: STORE S1,CMDRET+CR.PDB,RHMASK ;SAVE THE NEW PDB
JRST PARCMD ;JUST RESTART PARSER
SUBTTL Routine To Fill in Defaults for COMND
;THIS ROUTINE WILL FILL IN DEFAULTS BEFORE THE PDB IS PROCESSED
;
;CALL S1/ SIZE OF BLOCK
; S2/ ADDRESS OF THE BLOCK
;
;RETURN TRUE: CHECK NEXT ALTERNATE AND RETURN
;
;RETURN FALSE: S1/ ERROR CODE IF ANY
; S2/ ADDRESS OF THE STRING
FILDEF: LOAD S1,CMDRET+CR.PDB,RHMASK ;GET CURRENT PDB
FILD.1: MOVEM S1,CURPDB ;SAVE THE CURRENT PDB
$CALL P$PDEF ;IS THERE A DEFAULT ROUTINE
JUMPF FILD.2 ;NO, TRY NEXT PDB
MOVE T2,S1 ;SAVE THE ACTION ROUTINE
MOVEI S1,CR.SIZ ;SIZE OF THE BLOCK
MOVEI S2,CMDRET ;COMMAND RETURN BLOCK
PUSHJ P,0(T2) ;CALL THE DEFAULT FILLER
JUMPT FILD.2 ;O.K..CONTINUE ON
SKIPN S2 ;IF S2 HAS ERROR SET..SKIP
MOVEI S2,[ASCIZ/Error durring default filling routine/]
MOVX T2,P.DERR ;DEFAULT ROUTINE ERROR
IORM T2,FLAGS ;SAVE IN THE FLAGS
MOVEM S1,PARBLK+PRT.EC ;SAVE ANY CODE FOR CALLER
$RETF ;RETURN FALSE
FILD.2: MOVE S1,CURPDB ;GET THE CURRENT PDB
LOAD S1,.CMFNP(S1),CM%LST ;GET THE ADDR OF NEXT PDB IN LIST
JUMPN S1,FILD.1 ;LOOP ON NEXT ONE
$RETT ;RETURN
SUBTTL STBDEL SWITCH TABLE DELETE ROUTINE
;THIS ROUTINE IS CALLED BY THE MAIN PARSER TO DELETE
;THE CURRENT SWITCH VALUE FROM THE TEMFDB TABLE.
;IF ALL ENTRIES ARE GONE IT WILL TURN OF THE DEFAULT HELP
;TEXT TO COMMAND.
STBDEL: SETZM DFLAGS ;CLEAR THE FLAG
DMOVE S1,DENTRY ;GET DELETE AC'S
HLRZ T2,0(S1) ;GET USED COUNT
MOVE T1,T2 ;PLACE IN T1
SOSGE T1 ;DECREMENT..SKIP IF NOT ZERO
$RETF ;FALSE RETURN
ADD T2,S1 ;COMPUTE END OF TABLE
CAILE S2,(S1) ;ENTRY IN TABLE
CAMLE S2,T2 ;MAKE SURE
$STOP (TDE,TABLE DELETE ERROR)
HRLM T1,0(S1) ;SAVE COUNT
JUMPE T1,STBD.2 ;TABLE EMPTY
HRLI S2,1(S2) ;COMPACT TABLE
BLT S2,-1(T2) ;MOVE THE TABLE
STBD.1: SETZM 0(T2) ;CLEAR EMPTY WORD AT END
$RETT ;RETURN TRUE
STBD.2: MOVX S1,CM%SDH ;SUPPRESS DEFAULT HELP MESSAGE
IORM S1,TEMFDB ;TURN ON IN TABLE
JRST STBD.1 ;FINISH UP TABLE OPERATION
SUBTTL TAKE Command Table
.TAKE: $NOISE(TAK001,<Commands From>)
TAK001: $FILE(TAK002,,<$PREFILL(TAKDEF),$ACTION(TAKRTN),$ERROR(BADIFI)>)
TAK002: $SWITCH(,TAK003,<$ALTER(TAK004)>)
TAK003: $STAB
DSPTAB (TAK004,.SWDSP,DISPLAY)
DSPTAB (TAK004,.SWNDP,NODISPLAY)
$ETAB
TAK004: $CRLF (<$ACTION(TAKE)>)
BADIFI: SETZM S2 ;CLEAR THE ERROR CODE
$RETF ;BAD INPUT FILE
SUBTTL TAKDEF TAKE DEFAULT SETTING
TOPS20 <
TAKDEF: MOVE S1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR BLOCK
SETZM GJFBLK ;CLEAR FIRST WORD
BLT S1,GJFBLK+GJFSIZ-1 ;CLEAR THE BLOCK
MOVX S1,GJ%OLD ;FILE MUST EXIST
MOVEM S1,GJFBLK+.GJGEN ;INTO FLAGS WORD
MOVE S1,[XWD .NULIO,.NULIO] ;SUPPLY NO JFNS
MOVEM S1,GJFBLK+.GJSRC ;INTO BLOCK
HRROI S1,[ASCIZ/SYSTEM/] ;POINT AT DEFAULT FILE NAME
MOVEM S1,GJFBLK+.GJNAM ;SAVE FOR GTJFN
HRROI S1,[ASCIZ/CMD/] ;DEFAULT EXTENSION
MOVEM S1,GJFBLK+.GJEXT ;SAVE IN GTJFN BLOCK
HRROI S1,[ASCIZ/DSK/] ;GET THE DEFAULT STRUCTURE
MOVEM S1,GJFBLK+.GJDEV ;SAVE THE DEVICE
$RET ;AND RETURN
> ;End TOPS20
TOPS10 <
TAKDEF: MOVE S1,[GJFBLK,,GJFBLK+1] ;SET UP TO CLEAR BLOCK
SETZM GJFBLK ;CLEAR FIRST WORD
BLT S1,GJFBLK+GJFSIZ-1 ;CLEAR THE BLOCK
MOVE S1,[SIXBIT/SYSTEM/] ;GET FILE NAME
STORE S1,GJFBLK+.FDNAM ;SAVE IN DEFAULT BLOCK
MOVSI S1,'CMD' ;GET DEFAULT EXTENSION
STORE S1,GJFBLK+.FDEXT ;SAVE IN BLOCK
MOVSI S1,'DSK' ;GET STRUCTURE NAME
STORE S1,GJFBLK+.FDSTR ;SAVE THE STRUCTURE
$RET ;AND RETURN
> ;End TOPS10
SUBTTL TAKE SPECIAL ROUTINES FOR TAKE COMMANDS
;INCLUDED HERE ARE THE SPECIAL ROUTINES NEEDED FOR THE
;PROPER SETUP FOR TAKE COMMANDS. THESE ROUTINES ARE
;CALLED AS SPECIAL ACTION ROUTINES BY THE PARSER
TAKRTN: SKIPN TAKFLG ;PROCESSING A TAKE COMMAND
$RET ;NO, JUST RETURN
MOVEI S1,0 ;CLEAR FLAG AC
MOVEI S2,[ASCIZ/TAKE command is illegal in a command file/]
$RETF ;FALSE RETURN TO ABORT COMMAND
TAKE: SETOM TAKFLG ;SET FLAG FOR PROCESSING TAKE
MOVX T1,P.DSPT ;GET FLAG TO DISPLAY COMMAND
ANDCAM T1,FLAGS ;CLEAR THE FLAG
SETZM S1 ;START AT 1ST PDB
$CALL P$SETU ;SETUP THE POINTER
$CALL P$KEYW ;GET THE NEXT FIELD
JUMPF TAKE.1 ;ERROR..RETURN
$CALL P$FILE ;IS IT A FILE SPEC
JUMPF TAKE.2 ;NO, ERROR
MOVE T2,S1 ;ADDRESS OF THE BLOCK
$CALL P$CFM ;CHECK FOR CONFIRM
JUMPT TAK.1 ;YES, DON'T CHECK SWITCHES
$CALL TAKDSP ;CHECK TAKE DISPLAY SWITCHES
JUMPF .POPJ ;FALSE..PASS ERRORS UP
$CALL P$CFM ;CHECK FOR A CONFIRM
JUMPF TAKE.1 ;ERROR...RETURN
TAK.1: MOVX S1,P.TAKE ;SAY WE ARE DOING TAKE COMMAND
IORM S1,FLAGS
MOVE S1,T2 ;COMMAND FD TO S1
SETZM S2 ;NO LOGGING FD
$CALL P$TAKE ;OPEN THE FILES
JUMPF TAKE.3 ;OPEN ERROR ON FILE
$RETT ;RETURN TRUE
TAKDSP: $CALL P$SWIT ;CHECK FOR A SWITCH
JUMPF TAKE.4 ;NO, GIVE ERROR RETURN
CAIE S1,.SWDSP ;DISPLAY COMMAND OUTPUT
JRST TAKD.1 ;TRY OTHER FLAGS
SETOM DSPTAK ;SET DISPLAY TAKE COMMANDS
$RETT ;RETURN TRUE
TAKD.1: CAIE S1,.SWNDP ;NO DISPLAY
JRST TAKE.4 ;INVALID ARGUMENT..ERROR
SETZM DSPTAK ;CLEAR TAKE DISPLAY
$RETT ;RETURN
TAKE.1: MOVEI S2,[ASCIZ/Invalid TAKE command/]
JRST TAKERR ;TAKE ERROR EXIT
TAKE.2: MOVEI S2,[ASCIZ/No input file specified in TAKE command/]
JRST TAKERR ;TAKE ERROR EXIT
TAKE.3: MOVEI S2,[ASCIZ/Can't open TAKE command file/]
JRST TAKERR ;TAKE ERROR EXIT
TAKE.4: MOVEI S2,[ASCIZ/Invalid argument in TAKE command/]
JRST TAKERR ;TAKE ERROR EXIT
TAKERR: SETZM TAKFLG ;CLEAR THE TAKE FLAG ON ERROR
$RETF ;RETURN FALSE
SUBTTL P$TAKE ROUTINE TO SETUP A TAKE COMMAND
;THIS ROUTINE ACCEPTS TWO FDS FOR THE TAKE COMMAND TO BE
;USED AND WILL OPEN THE FILES AND UPDATE THE DATA BASE TO
;MAKE ALL OTHER FUNCTIONS OPERATE CORRECTLY
;CALL S1/ ADDRESS OF COMMAND FILE FD
; S2/ ADDRESS OF LOG FILE FD
P$TAKE: STKVAR <<CMDFOB,FOB.MZ>,<LOGFOB,FOB.MZ>>
MOVEM S1,FOB.FD+CMDFOB ;Save address of command FD
MOVEM S2,FOB.FD+LOGFOB ;Save address of logging FD
MOVX S1,FLD(7,FB.BSZ)+FLD(1,FB.LSN)
MOVEM S1,FOB.CW+CMDFOB ;Strip LSN and open as ascii
MOVEI S1,FOB.MZ ;Size of the FOB
MOVEI S2,CMDFOB ;Address of the FOB
$CALL F%IOPN ;Open the file
$RETIF ;Return the error on failure
MOVEM S1,CMDIFN ;Save the IFN
SETOM TAKFLG ;Remember we are doing a TAKE
TOPS20 <
MOVEI S2,FI.CHN ;Get the JFN for TOPS20
$CALL F%INFO
$RETIF ;Return the error on failure
MOVEM S1,CMDJFN ;Save proper file index
TXO S1,CO%NRJ+CZ%NUD ;Close but don't release JFN
CLOSF%
JRST [MOVX S1,ERUSE$ ;Should never happen
$RETF]
MOVE S1,CMDJFN ;Reclaim proper JFN
MOVX S2,FLD(7,OF%BSZ)+OF%RD ;Reopen in proper mode
OPENF%
JRST [MOVX S1,ERUSE$ ;Should never happen
$RETF]
SKIPA ;Already saved JFN
> ;End TOPS20
MOVEM S1,CMDJFN ;Save the proper file index
MOVEI S1,.NULIO ;No LOGGING
MOVEM S1,LOGIFN
MOVEM S1,LOGJFN
P$TAK1: MOVE S1,CMDIFN ;Return command IFN
MOVE S2,LOGIFN ; and logging IFN
$RETT
SUBTTL P$SETU SETUP THE PARSER BLOCK POINTER ADDRESS
;SET UP PTR TO CURR TOKEN
;THIS ROUTINE WILL USE PARDAT TO LOCATE 1ST TOKEN IN PARSER BLK
;
;CALL: S1=0 SAYS PT TO 1ST TOKEN
; S1 NOT 0 SAYS USE S1 AS PTR
;
;RETURN TRUE: ALWAYS
P$SETU::
JUMPN S1,SETCUR ;PUT INPUT VAL AWAY, IF ONE
MOVE S1,PARDAT ;GET PARDAT
ADDI S1,1 ;HOP OVER TEXT PTR
SETCUR:
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: PUSH P,S1 ;SAVE S1
MOVE S1,CURRPB ;GET THE CURRENT PB
MOVEM S1,PREVPB ;SAVE AS THE PREVIOUS POINTER
LOAD S1,<(S1)>,PF.LEN ;GET THE LENGTH
ADDM S1,CURRPB ;ADD TO CURRENT LOCATION
POP P,S1 ;RESTORE S1
$RETT ;RETURN TRUE
SUBTTL P$NFLD TO GET HEADER AND DATA FOR A PARSER ELEMENT
;THIS ROUTINE WILL RETURN THE ARGUMENT TYPE FOR THE CURRENT ENTRY
;AND THE ADDRESS OF THE CURRENT ENTRY
;
;RETURNS TRUE: S1/ ARGUMENT TYPE
; S2/ ADDRESS OF BLOCK
;
;RETURNS FALSE: ;NO MORE ARGUMENTS .. NOT IMPLEMENTED YET
P$NFLD: MOVE S2,CURRPB ;GET THE CURRENT PB
LOAD S1,PFD.HD(S2),PF.TYP ;GET THE TYPE FIELD
PJRST P$NEXT ;BUMP TO NEXT ONE
P$NARG: MOVE S2,CURRPB ;GET THE CURRENT PB
LOAD S1,PFD.HD(S2),PF.TYP ;GET THE TYPE FIELD
$RETT ;RETURN
SUBTTL P$CFM CHECK FOR A CONFIRM IN NEXT BLOCK
;THIS ROUTINE WILL CHECK THE NEXT FIELD FOR A CONFIRM
;RETURN TRUE: ON CONFIRM AND UPDATE PB
;
;RETURN FALSE: S1/CODE FOUND
P$CFM: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMCFM ;WAS IT A CONFIRM
$RETF ;NO, RETURN FALSE
PJRST P$NEXT ;ADVANCE PB AND RETURN
SUBTTL P$COMMA CHECK FOR A COMMA IN NEXT BLOCK
;THIS ROUTINE WILL CHECK THE NEXT FIELD FOR A COMMA
;RETURN TRUE: ON COMMA AND UPDATE PB
;
;RETURN FALSE: S1/CODE FOUND
P$COMMA: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMCMA ;WAS IT A COMMA
$RETF ;NO, RETURN FALSE
PJRST P$NEXT ;ADVANCE PB AND RETURN
SUBTTL P$KEYW GET A KEYWORD FROM THE PARSED DATA
;THIS ROUTINE WILL TRY TO GET A KEYWORD FROM THE NEXT ELEMENT
;IN THE PARSER DATA BLOCK POINTED TO BY PB
;
;RETURNS TRUE: S1/ KEYWORD FOUND
;
;RETURNS FALSE: S1/ DATA TYPE FOUND
P$KEYW: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMKEY ;WAS IT A KEYWORD
$RETF ;NO RETURN WITH TYPE FOUND
GETVAL: MOVE S1,PFD.D1(S2) ;GET THE DATA
PJRST P$NEXT ;RETURN AND ADVANCE PB
SUBTTL P$SWIT GET A SWITCH FROM THE PARSED DATA
;THIS ROUTINE WILL TRY TO GET A SWITCH FROM THE NEXT ELEMENT
;IN THE PARSER DATA BLOCK POINTED TO BY PB
;
;RETURNS TRUE: S1/ SWITCH FOUND
;
;RETURNS FALSE: S1/ DATA TYPE FOUND
P$SWIT: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMSWI ;WAS IT A SWITCH
$RETF ;NO RETURN WITH TYPE FOUND
MOVE S1,PFD.D1(S2) ;GET THE DATA
PJRST P$NEXT ;RETURN AND ADVANCE PB
SUBTTL P$USER GET THE USER ID FIELD
;THIS ROUTINE WILL RETURN USER NUMBER OR PPN FOR THE
;.CMUSR FUNCTION
;
;RETURNS TRUE: S1/ USER NUMBER OR PPN
;
;RETURN FALSE S1/ DATA TYPE FOUND
;
P$USER: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMUSR ;IS IT USER ID?
$RETF ;NO, RETURN FALSE
PJRST GETVAL ;YES, GET AND RETURN VALUE
SUBTTL P$FLOT GET THE FLOATING POINT NUMBER
;THIS ROUTINE WILL RETURN A FLOATING POINT NUMBER FOR THE .CMFLT
;FUNCTION
;
;RETURNS TRUE: S1/ FLOATING POINT NUMBER
;
;RETURN FALSE S1/ DATA TYPE FOUND
;
P$FLOT: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMFLT ;IS IT A FLOATING POINT NUMBER?
$RETF ;NO, RETURN FALSE
PJRST GETVAL ;YES, GET AND RETURN VALUE
SUBTTL P$DIR GET THE DIRECTORY FIELD
;THIS ROUTINE WILL RETURN DIRECTORY NUMBER OR PPN FOR THE
;.CMDIR FUNCTION
;
;RETURNS TRUE: S1/ DIRECTORY NUMBER OR PPN
;
;RETURN FALSE S1/ DATA TYPE FOUND
;
P$DIR: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMDIR ;IS IT DIRECTORY NUMBER?
$RETF ;NO, RETURN FALSE
PJRST GETVAL ;YES, GET AND RETURN VALUE
SUBTTL P$TIME GET THE TIME/DATE FIELD
;THIS ROUTINE WILL RETURN THE TIME/DATE FROM THE
;.CMTAD FUNCTION
;
;RETURNS TRUE: S1/ TIME/DATE IN UDT
;
;RETURN FALSE S1/ DATA TYPE FOUND
;
P$TIME: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMTAD ;IS IT TIME/DATE?
$RETF ;NO, RETURN FALSE
PJRST GETVAL ;YES, GET AND RETURN VALUE
SUBTTL P$NUM GET A NUMBER FROM THE PARSER BLOCK
;ON RETURN TRUE: S1/ NUMBER
; S2/ RADIX
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$NUM: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMNUM ;CHECK IF A NUMBER
$RETF ;NO, RETURN FALSE
DMOVE S1,PFD.D1(S2) ;PLACE NUMBER IN S1 AND
;RADIX IN S2
PJRST P$NEXT ;ADVANCE TO NEXT FIELD
SUBTTL P$FILE GET A FILESPEC FROM THE PARSER BLOCK
;ON RETURN TRUE: S1/ ADDRESS OF FD
; S2/ LENGTH OF FD AND HEADER
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$FILE: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMFIL ;CHECK IF A GENERAL FILE
$RETF ;NO, RETURN FALSE
JRST GETFD ;GET THE FD
P$IFIL: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMIFI ;CHECK IF A INPUT FILE
$RETF ;NO, RETURN FALSE
JRST GETFD ;GET AN FD
P$OFIL: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMOFI ;CHECK IF A OUTPUT FILE
$RETF ;NO, RETURN FALSE
GETFD: MOVE S1,CURRPB ;GET ADDRESS OF THE BLOCK
LOAD S2,PFD.HD(S1),PF.LEN ;LENGTH OF THE FD AND HEADER
PJRST P$NEXT ;ADVANCE TO NEXT FIELD
SUBTTL P$FLD GET A TEXT FIELD FROM BLOCK
;ON RETURN TRUE: S1/ ADDRESS OF FIELD
; S1/ LENGTH OF THE BLOCK
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$FLD: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMFLD ;IS IT A FIELD?
$RETF ;NO, RETURN FALSE
GETF.1: MOVE S1,CURRPB ;ADDRESS OF THE DATA
LOAD S2,PFD.HD(S1),PF.LEN ;GET THE LENGTH
PJRST P$NEXT ;BUMP TO NEXT FIELD
P$TOK: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMTOK ;IS IT A TOKEN
$RETF ;NO, RETURN FALSE
PJRST GETF.1 ;SETUP DATA AND RETURN
SUBTTL P$NODE GET A NODE FROM BLOCK
;ON RETURN TRUE: S1/ NODE NAME OR NUMBER
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$NODE: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMNOD ;WAS IT A NODE TYPE
$RETF ;NO, RETURN FALSE
MOVE S1,PFD.D1(S2) ;GET THE DATA
TOPS20 <
TLNN S1,770000 ;CHECK IF SIXBIT..DATA IN FIRST
;6 BITS
> ;End TOPS20
PJRST P$NEXT ;ADVANCE THE PB PTR AND RETURN
GETN.0: HRLI T1,(POINT 7,) ;BYTE POINTER
HRRI T1,PFD.D1(S2) ;GET THE ADDRESS
MOVE T2,[POINT 6,T3] ;SAVE IN T3
SETZM T3 ;CLEAR T3
GETN.1: ILDB S1,T1 ;GET A BYTE
JUMPE S1,GETN.2 ;END OF STRING..JUMP
CAIG S1,172 ;LOWER CASE Z
CAIGE S1,141 ;LOWER CASE A
SKIPA ;NO NEED TO CONVERT
SUBI S1,40 ;CONVERT TO UPPER CASE
SUBI S1,"A"-'A' ;CONVERT TO SIXBIT
TLNE T2,770000 ;ENOUGH SAVED??
IDPB S1,T2 ;NO, SAVE IT AWAY
JRST GETN.1 ;LOOP FOR MORE
GETN.2: MOVE S1,T3 ;PLACE NODE NAME IN S1
PJRST P$NEXT ;ADVANCE THE POINTER
SUBTTL P$SIXF GET A SIXBIT FIELD TYPE
;ON RETURN TRUE: S1/ SIXBIT FIELD
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$SIXF: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMFLD ;IS IT A FIELD TYPE
$RETF ;NO, RETURN FALSE
PJRST GETN.0 ;PROCESS THE FIELD AND RETURN
SUBTTL P$RNGE GET A RANGE BACK
;ON RETURN TRUE: S1/ LOW RANGE
; S2/ HIGH RANGE
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$RNGE: $CALL P$NUM ;GET A NUMBER
JUMPF .POPJ ;ERROR..RETURN
MOVE T4,S1 ;SAVE NUMBER
$CALL P$TOK ;TRY FOR A TOKEN
JUMPF GETR.1 ;ERROR..RETURN
$CALL P$NUM ;GET HIGH RANGE
JUMPF .POPJ ;ERROR..RETURN
MOVE S2,S1 ;PLACE NUMBER IN S2 FOR HIGH
MOVE S1,T4 ;SETUP LOW VALUE
$RETT ;RETURN TRUE
GETR.1: MOVEI S1,0 ;0 THE LOW RANGE
MOVE S2,T4 ;PUT NUMBER AS HIGH RANGE
$RETT ;RETURN TRUE
SUBTTL P$TEXT GET A TEXT ADDRESS AND LENGTH
;ON RETURN TRUE: S1/ ADDRESS OF TEXT BLOCK
; S2/ NUMBER OF WORDS OF TEXT
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$TEXT: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMTXT ;IS IT TEXT
$RETF ;NO, RETURN FALSE
LOAD S2,PFD.HD(S2),PF.LEN ;GET THE LENGTH IN S2
MOVE S1,CURRPB ;ADDRESS OF THE HEADER
PJRST P$NEXT ;BUMP TO THEE NEXT FIELD
SUBTTL P$DEV GET A DEVICE ADDRESS AND LENGTH
;ON RETURN TRUE: S1/ ADDRESS OF DEVICE BLOCK
; S2/ NUMBER OF WORDS OF DEVICE BLOCK
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$DEV: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMDEV ;IS IT TEXT
$RETF ;NO, RETURN FALSE
LOAD S2,PFD.HD(S2),PF.LEN ;GET THE LENGTH IN S2
MOVE S1,CURRPB ;ADDRESS OF THE HEADER
PJRST P$NEXT ;BUMP TO THEE NEXT FIELD
SUBTTL P$QSTR GET A QUOTED STRING
;ON RETURN TRUE: S1/ ADDRESS OF TEXT BLOCK
; S2/ NUMBER OF WORDS
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$QSTR: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMQST ;IS IT TEXT
$RETF ;NO, RETURN FALSE
LOAD S2,PFD.HD(S2),PF.LEN ;GET THE LENGTH IN S2
MOVE S1,CURRPB ;ADDRESS OF THE HEADER
PJRST P$NEXT ;BUMP TO THEE NEXT FIELD
SUBTTL P$UQSTR GET AN UNQUOTED STRING
;ON RETURN TRUE: S1/ ADDRESS OF TEXT BLOCK
; S2/ NUMBER OF WORDS
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$UQSTR: $CALL P$NARG ;GET THE TYPE ELEMENT
CAIE S1,.CMUQS ;IS IT TEXT
$RETF ;NO, RETURN FALSE
LOAD S2,PFD.HD(S2),PF.LEN ;GET THE LENGTH IN S2
MOVE S1,CURRPB ;ADDRESS OF THE HEADER
PJRST P$NEXT ;BUMP TO THEE NEXT FIELD
SUBTTL P$STR GET A STRING OF SPECIFIED TYPE
;ON INPUT: S1/ -1 OR TYPE TO CHK FOR
;ON RETURN TRUE: S1/ BYTE PTR TO TEXT
; S2/ NUMBER OF CHARS
;
;ON RETURN FALSE: S1/ DATA TYPE FOUND
P$STR:
PUSH P,S1 ;SAVE DESIRED TYPE
$CALL P$NARG ;GET THE TYPE ELEMENT
POP P,T1 ;GET IT BACK
CAME T1,S1 ;IS IT TEXT?
JUMPGE T1,.RETF ;NO, UNLESS TYPE CHK SUPPRESSED
MOVEI S1,1(S2) ;GET TO START OF TEXT
LOAD S2,PFD.HD(S2),PF.LEN ;GET THE LENGTH IN S2
HRLI S1,440700 ;MAKE BP
MOVEM S1,T1 ;DONT CLOB S1
ADDI T1,-2(S2) ;PT TO LAST WD OF TEXT
SUBI S2,1+1 ;ELIM HDR & WD OF (PARTIALLY) NULS
IMULI S2,5 ;CONV WDS TO CHARS
ILDB T2,T1 ;CHK FOR NULL BYTE
SKIPE T2 ;END YET?
AOJA S2,.-2 ;NO, BUMP CNT
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$GPDB GET THE PDB ADDRESS IF ANY DATA
;THIS ROUTINE WILL GET THE ADDRESS OF THE PDB FOR THE BLOCK
;
;CALL S1/ ADDRESS OF THE FDB
;
;RETURN TRUE: S1/ ADDRESS OF THE PDB DATA
; S2/ LENGTH OF THE PDB
;
;RETURN FALSE: NO NEXT PDB
P$GPDB: SUBI S1,1 ;POINT TO THE HEADER FOR PDB
SKIPN (S1) ;PDB O.K.
$STOP(IPP,Invalid PDB Header in Parse Block)
LOAD TF,PB%HDR(S1),PB.FDB ;GET THE LENGTH OF THE FDB
LOAD S2,PB%HDR(S1),PB.PDB ;GET THE LENGTH OF THE PDB
CAMN S2,TF ;ARE THEY THE SAME
$RETF ;RETURN FALSE .. NONE SPECIFIED
ADD S1,TF ;POSITION TO THE PDB
SUB S2,TF ;GET LENGTH OF THE PDB
$RETT ;RETURN TRUE
SUBTTL P$PNXT GET NEXT PDB GIVEN A PDB BLOCK
;THIS ROUTINE WILL RETURN INFORMATION FROM A PDB
;CALL S1/ ADDRESS OF THE PDB
;
;RETURN TRUE: S1/ ADDRESS OF THE NEXT PDB
;
;RETURN FALSE: NO NEXT PDB
P$PNXT: $CALL P$GPDB ;GET THE PDB DATA
JUMPF .POPJ ;ERROR..RETURN
CAIG S2,PB%NXT ;IS THERE A NEXT FIELD
$RETF ;NO, RETURN FALSE
MOVEI S1,@PB%NXT(S1) ;GET THE VALUE (MVI @ ALLOWS VARIABLE)
JUMPE S1,.RETF ;NO "NEXT" VAL
$RETT ;YES, O.K.
SUBTTL P$PERR GET ERROR ROUTINE GIVEN A PDB BLOCK
;THIS ROUTINE WILL RETURN INFORMATION FROM A PDB
;CALL S1/ ADDRESS OF THE PDB
;
;RETURN TRUE: S1/ ADDRESS OF THE ERROR ROUTINE
;
;RETURN FALSE: NO ERROR PDB
P$PERR: $CALL P$GPDB ;GET THE PDB DATA
JUMPF .POPJ ;ERROR..RETURN
CAIG S2,PB%ERR ;IS THERE AN ERROR FIELD
$RETF ;NO, RETURN FALSE
SKIPE S1,PB%ERR(S1) ;GET THE VALUE AND RETURN
$RETT ;YES, O.K.
$RETF ;RETURN FALSE
SUBTTL P$PDEF GET DEFAULT FILLER ROUTINE GIVEN A PDB BLOCK
;THIS ROUTINE WILL RETURN INFORMATION FROM A PDB
;CALL S1/ ADDRES OF THE PDB
;
;RETURN TRUE: S1/ ADDRESS OF THE DEFAULT FILLER ROUTINE
;
;RETURN FALSE: NO DEFAULT FILLER PDB
P$PDEF: $CALL P$GPDB ;GET THE PDB DATA
JUMPF .POPJ ;ERROR..RETURN
CAIG S2,PB%DEF ;IS THERE A DEFAULT FIELD
$RETF ;NO, RETURN FALSE
SKIPE S1,PB%DEF(S1) ;GET THE VALUE AND RETURN
$RETT ;YES, O.K.
$RETF ;RETURN FALSE
SUBTTL P$PACT GET ACTION ROUTINE GIVEN A PDB BLOCK
;THIS ROUTINE WILL RETURN INFORMATION FROM A PDB
;CALL S1/ FLAGS,,ADDRESS OF THE PDB
;
;RETURN TRUE: S1/ ADDRESS OF THE ACTION ROUTINE
;
;RETURN FALSE: NO NEXT PDB
P$PACT: $CALL P$GPDB ;GET THE PDB DATA
JUMPF .POPJ ;ERROR..RETURN
CAIG S2,PB%RTN ;IS THERE A ACTION ROUTINE
$RETF ;NO, RETURN FALSE
SKIPE S1,PB%RTN(S1) ;GET THE VALUE AND RETURN
$RETT ;YES, O.K.
$RETF ;RETURN FALSE
SUBTTL COMMON LOW-LEVEL ROUTINES
;I%NOW -- RET TIME OF DAY
;CALL IS: No arguments
;TRUE RETURN: S1/ Time and date in UDT format
ENTRY I%NOW
TOPS10 <
I%NOW: MOVX S1,%CNDTM ;GET TIME AND DATE FROM
GETTAB S1, ;THE MONITOR
$STOP(DTU,Date/Time unavailable)
$RETT ;RETURN S1/HAS UDT
> ;END TOPS10 CONDITIONAL
TOPS20 <
I%NOW: GTAD ;GET DATE AND TIME
$RETT ;AND RETURN THEM
> ;END TOPS20 CONDITIONAL
; $RETE calls .RETE to set up the last GALAXY error and location
; then set TF = FALSE and return.
ENTRY .RETE,.RETT,.RETF,.POPJ
ENTRY .ZCHNK,.STKST,.STOP
.RETE: HRRZM TF,.LGEPC ;CALLED VIA JSP TF, SO SET UP PC OF LAST ERROR
XMOVEI S1,. ;GET OUR SECTION NUMBER
TLNE S1,-1 ;NON-ZERO SECTION?
MOVEM TF,.LGEPC ;YES, SAVE SECTION NUMBER AS WELL.
MOVE S1,TF ;(To save indirection)
HRRZ S1,(S1) ;NOW FETCH ERROR CODE
MOVEM S1,.LGERR ;AND REMEMBER IT
;FALL INTO .RETF
; .RETT AND .RETF are called via the $RETT and $RETF macros and can also
; be called directly. They both set the value of TF, one to TRUE and the other
; to FALSE. After doing this, they return via a POPJ P,
;The .POPJ routine can be jumped
; to get a return, without changing the value in the TF register
.RETF: TDZA TF,TF ;ZEROS MEAN FALSE
.RETT: SETO TF, ;ONES MEAN TRUE
.POPJ: POPJ P,0 ;RETURN
;.STOP - TERMINATES PROCESSING
.STOP: $HALT
JRST .-1 ;FORBID CONTINUE
; .ZCHNK 0'S A CHUNK WHOSE SIZE IS IN S1 AND STARTING POINT IN S2
.ZCHNK: TRNN S1,-1 ;Anything to do?
$RETT ;No..just return
PUSH P,S1 ;SAVE CALLER'S SIZE
PUSH P,S2 ;AND ADDRESS
ZCHN.1: SETZM 0(S2) ;CLEAR FIRST WORD
SOJE S1,ZCHN.2 ;COUNT OF 1,,JUST RETURN
ADDI S1,0(S2) ;COMPUTE END ADDRESS
HRLS S2 ;GET ADDR,,ADDR OF CHUNK
AOS S2 ;AND NOW ADDR,,ADDR+1
BLT S2,0(S1) ;NOW CLEAR THE CHUNK
ZCHN.2: POP P,S2 ;RESTORE CALLER'S CHUNK ADDR
POP P,S1 ;AND HIS SIZE
$RETT ;AND RETURN
;COMMON ENTRY AND EXIT ROUTINE FOR STACK VARIABLE
.STKST::ADD P,@.SAC ;BUMP STACK FOR VARIABLES USED
JUMPGE P,STKSOV ;TEST FOR STACK OVERFLOW
STKSE1: PUSH P,@.SAC ;SAVE BLOCK SIZE FOR RETURN
AOS .SAC ;BUMP PAST POINTER
PUSHJ P,@.SAC ;CONTINUE ROUTINE, EXIT TO .+1
.STKRT::CAIA ;NON-SKIP RETURN
AOS -1(P) ;SKIP RETURN
SUB P,0(P) ;ADJUST PER COUNT OF VARIABLES
SUB P,[1,,1] ;REMOVE COUNT FROM STACK
POPJ P,0 ;RETURN
STKSOV: SUB P,@.SAC ;STACK OVERFLOW- UNDO ADD
HLL .SAC,@.SAC ;SETUP TO DO MULTIPLE PUSH, GET COUNT
STKSO1: PUSH P,[0] ;DO ONE PUSH AT A TIME, GET REGULAR
SUB .SAC,[1,,0] ; ACTION ON OVERFLOW
TLNE .SAC,777777 ;COUNT DOWN TO 0?
JRST STKSO1 ;NO, KEEP PUSHING
JRST STKSE1
SUBTTL SAVE AC CO-ROUTINES
;THESE ROUTINES ACT AS CO-ROUTINES WITH THE ROUTINES WHICH CALL THEM,
; THEREFORE NO CORRESPONDING "RESTORE" ROUTINES ARE NEEDED. WHEN
; THE CALLING ROUTINE RETURNS TO ITS CALLER, IT ACTUALLY RETURNS
; VIA THE RESTORE ROUTINES AUTOMATICALLY.
ENTRY .SAVE1,.SAVE2,.SAVE3,.SAVE4,.SAVET,.SV13,.SV14,.SV15,.SV16
.SAVE1: MOVEM P1,SVP1T ;SAVE P1 (temp)
EXCH P1,(P) ;Save P1, get callers address
PUSHJ P,SAVJMP
SOS -1(P)
JRST RES1 ;Restore P1
SAVJMP: HRLI P1,(1B0) ;Make IFIW
EXCH P1,SVP1T ;Save ret inst, restore P1
JRST @SVP1T ;Jump to continue transfer
.SAVE2: MOVEM P1,SVP1T ;Save P1
EXCH P1,(P) ;SAVE P1 GET CALLERS ADDRESS
PUSH P,P2 ;SAVE P2
PUSHJ P,SAVJMP
SOS -2(P)
JRST RES2 ;RESTORE P2,P1
.SAVE3: MOVEM P1,SVP1T ;Save P1
EXCH P1,(P) ;SAVE P1 GET RETURN ADDRESS
PUSH P,P2 ;SAVE P2
PUSH P,P3 ;SAVE P3
PUSHJ P,SAVJMP
SOS -3(P)
JRST RES3 ;AND RESTORE P3,P2,P1
.SAVE4: MOVEM P1,SVP1T
EXCH P1,(P) ;SAVE P1 GET RETURN ADDRESS
PUSH P,P2 ;SAVE P2
PUSH P,P3 ;SAVE P3
PUSH P,P4 ;SAVE P4
SOS -4(P)
RES4: POP P,P4 ;RESTORE P4
RES3: POP P,P3 ;RESTORE P3
RES2: POP P,P2 ;RESTORE P2
RES1: POP P,P1 ;RESTORE P1
AOS (P) ;Make skip return if needed
POPJ P, ;AND RETURN
.SAVET: MOVEM T1,SVP1T ;Save T1, get return address
EXCH T1,(P) ;SAVE T1 AND GET RETURN ADDRESS
PUSH P,T2 ;SAVE T2
PUSH P,T3 ;SAVE T3
PUSH P,T4 ;SAVE T4
PUSHJ P,SVTJMP
SOS -4(P)
POP P,T4 ;RESTORE T4
POP P,T3 ;RESTORE T3
POP P,T2 ;RESTORE T2
POP P,T1 ;RESTORE T1
AOS (P) ;Make skip return if needed
POPJ P, ;RETURN
SVTJMP: HRLI T1,(1B0) ;Make IFIW
EXCH T1,SVP1T ;Save ret inst, restore T1
JRST @SVP1T ;Jump to continue transfer
; THESE ROUTINES ARE CALLED BY THE SAVE MACRO FOR ABSOLUTE AC'S
; 13,14,15, & 16. THE MACRO FIGURES OUT WHICH ONE
.SV13: MOVEM 13,SVP1T
EXCH 13,(P) ;SAVE 13 GET CALLERS ADDRESS
PUSHJ P,SAVJ13
SOS -1(P)
POP P,13
AOS (P)
POPJ P, ;AND RETURN
SAVJ13: HRLI 13,(1B0)
EXCH 13,SVP1T
JRST @SVP1T
.SV14: MOVEM 14,SVP1T
EXCH 14,(P) ;SAVE 14 GET CALLERS ADDRESS
PUSHJ P,SAVJ14
SOS -1(P)
POP P,14 ;RESTORE 14
AOS (P)
POPJ P, ;AND RETURN
SAVJ14: HRLI 14,(1B0)
EXCH 14,SVP1T
JRST @SVP1T
.SV15: MOVEM 15,SVP1T
EXCH 15,(P) ;SAVE 15 GET CALLERS ADDRESS
PUSHJ P,SAVJ15
SOS -1(P)
POP P,15 ;RESTORE 15
AOS (P)
POPJ P, ;AND RETURN
SAVJ15: HRLI 15,(1B0)
EXCH 15,SVP1T
JRST @SVP1T
.SV16: MOVEM 16,SVP1T
EXCH 16,(P) ;SAVE 16 GET CALLERS ADDRESS
PUSHJ P,SAVJ16
SOS -1(P)
POP P,16 ;RESTORE 16
AOS (P)
POPJ P, ;AND RETURN
SAVJ16: HRLI 16,(1B0)
EXCH 16,SVP1T
JRST @SVP1T
END