;Before assembling 2022 you must insure that the following files are located ;on the proper devices: ; ; MLIB.REL, MLIB.UNV -must be found on DSK: ; MONSYM.UNV, MACSYM.UNV -must be found on SYS: ; HR1022.REL, HL1022.REL -must be found on SYS: ; ;HL1022.REL is required only for the MC.CET routine to handle ^E interrupts. ;Since MC.CET may not be available in pre-116 versions of HL1022 don't worry if ;LINK can't find it since 2022 will run without it. ; ;Once your logical names are set up properly you can assemble 2022 for the ;latest version of 1022 it supports with the following commands: ; ; @LOAD/COMP 2022.MAC ; @SAVE ; ;To assemble 2022 for a different version of 1022 other than the latest one ;use the following commands. This example shows how to assemble 2022 for ;version 116B of 1022: ; ; @COPY TTY: 2022.16B ; VMAJOR==116 ; VMINOR==2 ;"A"=1, "B"=2, etc... ; ^Z ; @LOAD/COMP 2022.16B+2022.MAC ; @SAVE ; ;The earliest version of 1022 that 2022 supports is 116B. 2022 will probably ;still LINK and run with earlier versions but earlier versions may not have ;the MC.CET ^E support routine in HL1022. TITLE 2022 - TOPS-20 COMND% parser for 1022 SUBTTL EDIT HISTORY SEARCH MONSYM,MACSYM,MLIB INTERN DIE,SETTAB .REQUES DSK:MLIB,SYS:HR1022,SYS:HL1022 .DIRECT FLBLST ;only list first line of multiline text SALL ;make neat listings VWHO==^o2 ;2-7 indicates edit at customer site IFNDEF VMAJOR,< VMAJOR==^o117> ;MAJOR version number IFNDEF VMINOR,< VMINOR==^o2> ;MINOR version number VEDIT==^o25 ;EDIT number - never reset to zero VERSION==B2+B11+B17+VEDIT DEFINE VDISP (VMAJ,VMIN) > VDISP (\VMAJOR,\") IFG <116-VMAJOR>,> .V117B==_6 + .V117A==_6 + .V116B==_6 + DEFINE V117B (AAA) > DEFINE V117A (AAA) > DEFINE V116B (AAA) > ;WHO DATE Edit MODIFICATIONS ;=== ========= ==== ================================================ ;DLW 15-May-85 00 -genesis ;DLW 27-May-85 01 -add ^T intercept and reset name of program when ; returning from the editor ;DLW 4-Jun-85 02 -because of problem with DBEXEC putting a "." after ; each command when getting additional data. I will have ; to parse the "END" command myself ;DLW 6-Jun-85 03 -add code to parse the TRANSACT command ;DLW 10-Jun-85 04 -if user enters OPEN XXX.DMS then because .GJNAM ; gets initialized hitting return will cause the DMS file specs ; to be parsed. To prevent this I changed FOPN to parse confirm ; before FDMSN block gets parsed ;DLW 24-Jun-85 05 -make OP an abbrev. for OPEN and add SYSDBGBUF ;DLW 26-Aug-85 06 -add "MAP BY SORT" ;DLW 3-Sep-85 07 -had USE and @ commands save the last file specs plus ; fixed parsing problem in these commands ;DLW 4-Sep-85 10 -fix problem with XKEYW routine ;DLW 5-Sep-85 11 -fixed TRANSACT command so user can enter both ; "DUPLICATES TRANACT" and "DUPLICATES MASTER" ;DLW 9-Sep-85 12 -added code for ^E interrupts ;DLW 26-Sep-85 13 -use new IP.SAVE macro to save registers for interrupt ; processing - this now calls a re-entrant routine ;DLW 27-Sep-85 14 -added code for ^C interrupts. If user leaves program to ; to "@ENABLE" or "@DISABLE" then I must also change the ; capabilty word of the 1022 fork as well ;DLW 10-Oct-85 15 -added CIS% to clear interrupt system incase user ; halted program with ^C (eg to abort a long 1022 TYPE) ; and then used "@REENTER" to get back in. If interrupt ; system is not cleared ^C remains still in progress ; so the user can't halt again with another ^C ;DLW 28-Oct-85 16 -fix so "DUMP " not allowed ;DLW 29-Oct-85 17 -fix so "INFORM ATTRIBUTE " not allowed ;DLW 29-Oct-85 20 -fix so "ON " phrase for INFORM, PRINT, and VALUES ; commands will parse a null file extension if none given ;DLW 17-Feb-86 21 -add code to bring 2022 upto version 117B ;DLW 15-Jul-86 22 -add code to support #COM and #TYPE commands ;DLW 22-Jul-86 23 -Fix EDIT and USE commands to re-use last file spec ; entered if user does not enter one. This use to work ; OK in TOPS-20 version 5.1 but when we went to 6.1 they ; changed and undocumented feature of COMND%. Now it ; should work OK under both 5.1 and 6.1 ;DLW 21-Aug-86 24 -Fixed up keyword table for HELP command to recognize ; NEWS1 and NEWS2 as valid keywords ;DLW 16-Sep-86 25 -Added keywords TABLE and DATA to the INFORM STRUCTURE ; command ; *************************************************** ;NOTE: This program contains some temporary patches made to get around DBEXEC ; problems. When Software House fixes them I'll remove them. (It may ; be a while before they fix them because since I can get around them ; they don't seem to be high on their list of priorities). To find all ; these temporary patches search for the string "&&&" ; *************************************************** SUBTTL DEFINITIONS ;flags used in register "F" ; Bits "1B30 to 1B35" are reserved for flags used in MLIB F%DISP==1B29 ;1=display commands sent to DBEXEC F%INI==1B28 ;1=just do initialization F%NFIL==1B27 ;1=don't parse a file-specs F%NCHN==1B26 ;1=don't parse channel number F%SYSV==1B25 ;1=CM%NOP flag is set for some entries in SYSTAB ;flags used for miscellaneous things in keyword tables ; currently only bits 1B33 to 1B35 are use by COMND K%SET==1B18 K%NSET==1B19 K%FL1==1B18 K%FL2==1B19 K%FL3==1B20 DEFINE NOISE2 ($CH4,$REST) < ;; need this special definiton of noise so I can remove the noise ;; words prior to passing command to 1022. This macro will start the ;; noise string with a character. When using this macro the ;; string should not have any ")" in it otherwise RMVNOI will not work ;; correctly PARSE (,<.CMNOI,,! ASCIZ\$REST\]>>) > NOIBYT==.CHDEL DEFINE KWT1 ($NAM) < ;; macro to define a keyword table with only one entry $'$NAM: 1,,1 ;actual,,max length of table TBL ($NAM,,0) > DEFINE SAVEAC DEFINE RESTAC DEFINE $1022 ($DBNAM,$ARGS) < ;; macro to generate a call to a 1022 routine IFDIF <$ARGS><->,< .ARG.==0 IRP <$ARGS>,< .ARG.==.ARG.+1> ;;calc # of arguemnts to pass MOVEI 16,1+[-.ARG.,,0 ;;generate the argument list IRP <$ARGS>,< $ARGS> ] PURGE .ARG. > IFNB <$DBNAM>,< IFDIF <$DBNAM>,< SAVEAC ;;save registers> IFIDN <$DBNAM>,< CALL SATI ;;save + activate ^T> CALL $DBNAM## ;;call the 1022 routine IFDIF <$DBNAM>,< RESTAC ;;restore registers> IFIDN <$DBNAM>,< CALL RDTI ;;restore + disable ^T> > > SUBTTL CORRUPTIBLE DATA AREA ;============================================================================= ;The following command tables will generate literals that will be modified by ;the program therefore the literal pool must be assembled in the corruptible ;data area. The command tables themselves, however, will not be modifed so can ;be in the NON-corruptible area. ; keyword table for the LOAD and APPEND commands LOATAB: LOATLN,,LOATLN ;actual,,maximum number of entries TBL (BUFFER, CM%NOR,PNUM) TBL (CORE, CM%NOR,PNUM) V117B< TBL (CUSTDMI, CM%NOR,RET1##)> TBL (DATA, CM%NOR,PDMI) $LDESC: TBL (DESC, CM%NOR,PDMD) TBL (FORMFEED, CM%NOR,.LFFED) TBL (LRECL, CM%NOR,.LRECL) $LMAX: TBL (MAX, CM%NOR,PNUM) V117B< TBL (NODME, CM%NOR,RET1##)> $LNKEY: TBL (NOKEYS, CM%NOR,RET1##) TBL (NOMSG, CM%NOR,RET1##) TBL (SET, CM%NOR,.LSET) LOATLN==<.-LOATAB>-1 ; keyword table for the KEY command KEYTAB: KEYTLN,,KEYTLN ;actual,,maximum number of entries V117A< TBL ($CHECKSUM, CM%NOR!K%FL3,.K$CSV) TBL ($SCAN, CM%NOR!K%FL3,.K$CSV) TBL ($VERIFY, CM%NOR!K%FL3,.K$CSV)> ;end of V117A TBL (ALL, CM%NOR!K%FL1,RET2##) TBL (BUFFER, CM%NOR!K%FL2,PNUM) TBL (CORE, CM%NOR!K%FL1,PNUM) TBL (NOMSG, CM%NOR!K%FL2,RET1##) TBL (NOREUSE, CM%NOR!K%FL1,RET1##) TBL (NULL, CM%NOR!K%FL1,PNUM) TBL (REUSE, CM%NOR!K%FL1,RET1##) TBL (USING, CM%NOR!K%FL2,.KUSIN) KEYTLN==<.-KEYTAB>-1 ; keyword table for the MAP command MP1TAB: MP1TLN,,MP1TLN ;actual,,maximum number of entries $MBY: TBL (BY, CM%NOR,.MAPBY) TBL (LOGICAL, CM%NOR,.MAPLG) TBL (TO, CM%NOR,RET2) MP1TLN==<.-MP1TAB>-1 ; keyword table for the OPTIMIZE command OPTTAB: OPTTLN,,OPTTLN ;actual,,maximum number of entries TBL (ALL, CM%NOR,RET2##) $ONMSG: TBL (NOMSG, CM%NOR,RET1##) TBL (NULL, CM%NOR,PNUM) OPTTLN==<.-OPTTAB>-1 ; keyword table for the JOIN command JOITAB: JOITLN,,JOITLN ;actual,,maximum number of entries ; keyword table for the CREATE command TBL (AS, CM%NOR,.JAS) TBL (NOMSG, CM%NOR,RET1##) $JTO: TBL (TO, CM%NOR,.JTO) TBL (UNI, CM%NOR,RET1##) JOITLN==<.-JOITAB>-1 CRETAB: CRETLN,,CRETLN ;actual,,maximum number of entries TBL (DATA, CM%NOR,PDMI) TBL (DESC, CM%NOR,PDMD) TBL (LRECL, CM%NOR,PNUM) TBL (NOMSG, CM%NOR,RET1##) TBL (SET, CM%NOR,.CSET) CRETLN==<.-CRETAB>-1 ; keyword table for the DUMP command DMPTAB: DMPTLN,,DMPTLN ;actual,,maximum number of entries TBL (BUFFER, CM%NOR,PNUM) TBL (DATA, CM%NOR,PDMIZ) TBL (DESC, CM%NOR,PDMD) TBL (SET, CM%NOR,.DSET) TBL (SORTED, CM%NOR,.DSORT) $DUNBU: TBL (UNBUNDLED, CM%NOR,RET1##) DMPTLN==<.-DMPTAB>-1 ; keyword table for the OPEN command OPNTAB: OPNTLN,,OPNTLN ;actual,,maximum number of entries V117A< TBL ($MISSING, CM%NOR,RET1)> $OACES: TBL (ACCESS, CM%NOR,.OACSS) TBL (AS, CM%NOR,.OAS) $OENQ: TBL (ENQ, CM%NOR,.OENQ) $ONENQ: TBL (NOENQ, CM%NOR,.ONENQ) $OPASS: TBL (PASSWORD, CM%NOR,.OPASS) $OREAD: TBL (READONLY, CM%NOR,.OROLY) $ORO: TBL (RO, CM%NOR,.ORO) OPNTLN==<.-OPNTAB>-1 ;table for SORT command SORTAB: SORTLN,,SORTLN ;actual,,maximum number of entries TBL (BY, CM%NOR,.SBY) TBL (CORE, CM%NOR,.SCOR) $SKEY: TBL (KEY, CM%NOR,.SKEY) TBL (USING, CM%NOR,.SUSI) SORTLN==<.-SORTAB>-1 ;tables for TRANSACT command TRA2TB: TRA2TL,,TRA2TL ;actual,,maximum number of entries TBL (LOCATOR, CM%NOR,.TLOCA) $TSORT: TBL (SORTED, CM%NOR,.TSORT) TRA2TL==<.-TRA2TB>-1 TRA3TB: TRA3TL,,TRA3TL ;actual,,maximum number of entries TBL (MESSAGE, CM%NOR,RET2) TBL (TTYMSG, CM%NOR,RET2) TRA3TL==<.-TRA3TB>-1 TRA6TB: TRA6TL,,TRA6TL ;actual,,maximum number of entries TBL (MASTER, CM%NOR,0) TBL (TRANSACT, CM%NOR,0) TRA6TL==<.-TRA6TB>-1 TRA8TB: TRA8TL,,TRA8TL ;actual,,maximum number of entries TBL (APPLIED, CM%NOR,.TAPPL) TBL (BUFFER, CM%NOR,PNUM) TBL (CORE, CM%NOR,PNUM) V117B< TBL (CUSTDMI, CM%NOR,RET1##)> TBL (DUPLICATES,CM%NOR,.TDUPL) TBL (FORMFEED, CM%NOR,.LFFED) TBL (LRECL, CM%NOR,.LRECL) TBL (NOCHANGE, CM%NOR,.TNOCH) V117B< TBL (NODME, CM%NOR,RET1##)> TBL (NOMSG, CM%NOR,RET1##) TBL (UNAPPLIED, CM%NOR,.TUNAP) TRA8TL==<.-TRA8TB>-1 V117B< ; keyword table for the INIT DIF command IDIFTB: IDIFLN,,IDIFLN ;actual,,maximum number of entries TBL (COL, CM%NOR,.IDCOL) TBL (NCOLS, CM%NOR,.IDNCO) TBL (ROW, CM%NOR,.IDROW) IDIFLN==<.-IDIFTB>-1 ; keyword table for the INIT 123 command I123TB: I123LN,,I123LN ;actual,,maximum number of entries TBL (COL, CM%NOR,.IDCOL) $CWISE: TBL (CWISE, CM%NOR,.I1CWI) TBL (NRANGE, CM%NOR,.I1NRA) TBL (ROW, CM%NOR,.IDROW) $RWISE: TBL (RWISE, CM%NOR,.I1RWI) I123LN==<.-I123TB>-1 >;end of V117B ;table for SYSTEM variables SYSTAB: SYSTLN,,SYSTLN ;actual,,maximum number of entries TBL (SYSADDMSG, K%SET ,PSINT) TBL (SYSADMCDIR, K%NSET,0) TBL (SYSALCMSG, K%SET ,PSINT) TBL (SYSAMBATTR, K%SET ,PSINT) V117A< TBL (SYSAUXCHK, K%SET ,PSINT)> TBL (SYSBETWEEN, K%SET ,PSINT) TBL (SYSCASE, K%SET ,PSINT) TBL (SYSCBLSIGN, K%SET ,PSINT) V117B< TBL (SYSCHANGED, K%NSET,0)> TBL (SYSCLOSE2, K%NSET,0) V117A< TBL (SYSCOLNAME, K%NSET,0)> V117A< TBL (SYSCORESS, K%SET ,PSINT)> V117B< TBL (SYSCUSTDMI, K%SET ,PSINT)> TBL (SYSCVTERR, K%SET ,PSINT) TBL (SYSDAMAGE, K%NSET,0) TBL (SYSDATE, K%NSET,0) TBL (SYSDATEFMT, K%SET ,PSINT) TBL (SYSDAYTIME, K%NSET,0) TBL (SYSDBEXMSG, K%SET ,PSINT) TBL (SYSDBGBUF, K%SET ,PSINT) V117A< TBL (SYSDCORESS, K%SET ,PSINT)> TBL (SYSDELIM, K%SET ,PSDEL) TBL (SYSDEQFAST, K%SET ,PSINT) TBL (SYSDIV, K%SET ,PSINT) TBL (SYSDIVMSG, K%SET ,PSINT) TBL (SYSDIVP, K%SET ,PSINT) TBL (SYSDMETRID, K%SET ,PSINT) TBL (SYSDSALIAS, K%SET ,PSTXT) TBL (SYSDSENQ, K%NSET,0) TBL (SYSDSFILE, K%NSET,0) TBL (SYSDSNAME, K%NSET,0) TBL (SYSENQDEF, K%NSET,0) TBL (SYSENQTYPE, K%SET ,PSINT) TBL (SYSERRCODE, K%NSET,0) TBL (SYSERRDEV, K%NSET,0) TBL (SYSERREXT, K%NSET,0) TBL (SYSERRFILE, K%NSET,0) TBL (SYSERRPPN, K%NSET,0) V117A< TBL (SYSERRTEXT, K%SET ,PSINT)> TBL (SYSEURODAT, K%SET ,PSINT) V117B< TBL (SYSEXECKP, K%SET ,PSINT)> TBL (SYSEXP, K%NSET,0) TBL (SYSEXPTYPE, K%SET ,PSINT) TBL (SYSFDMATT, K%NSET,0) TBL (SYSGTABERR, K%NSET,0) TBL (SYSHLCVT, K%SET ,PSINT) TBL (SYSHLDISP, K%SET ,PSINT) TBL (SYSHLMODE, K%SET ,PSINT) TBL (SYSHLNAME, K%NSET,0) TBL (SYSID, K%NSET,0) TBL (SYSIFTYPE, K%SET ,PSINT) TBL (SYSIOMSG, K%SET ,PSINT) TBL (SYSJOBNO, K%NSET,0) TBL (SYSKEEPBUF, K%SET ,PSINT) TBL (SYSKEEPPSI, K%SET ,PSINT) TBL (SYSLINE, K%NSET,0) TBL (SYSMSTIME, K%NSET,0) TBL (SYSNOFILOP, K%NSET,0) TBL (SYSNOPSI, K%SET ,PSINT) TBL (SYSNOSEG, K%SET ,PSINT) TBL (SYSNOSEGP, K%NSET,0) TBL (SYSNOXCHAN, K%NSET,0) TBL (SYSNREC, K%NSET,0) TBL (SYSNRETRY, K%SET ,PSINT) TBL (SYSOVF, K%SET ,PSINT) TBL (SYSOVFMSG, K%SET ,PSINT) TBL (SYSOVFP, K%SET ,PSINT) TBL (SYSPAGE, K%SET ,PSINT) V117B< TBL (SYSPCCOL, K%SET ,PSINT)> V117B< TBL (SYSPCRESET, K%SET ,PSINT)> V117B< TBL (SYSPCROW, K%SET ,PSINT)> TBL (SYSPPN, K%NSET,0) TBL (SYSPROT20, K%SET ,PSINT) V117B< TBL (SYSRECLOCK, K%NSET,0)> TBL (SYSRECMODE, K%NSET,0) TBL (SYSRECNO, K%NSET,0) TBL (SYSREP1, K%SET ,PSINT) TBL (SYSREP2, K%SET ,PSINT) TBL (SYSREP3, K%NSET,0) TBL (SYSREPMODE, K%SET ,PSINT) TBL (SYSREPSYNC, K%SET ,PSINT) TBL (SYSRESET, K%SET ,PSINT) TBL (SYSRNGMSG, K%SET ,PSINT) TBL (SYSSCRDEV, K%SET ,PSTXT) V117A< TBL (SYSSCRFILE, K%SET ,PSINT)> TBL (SYSSFDFLAG, K%NSET,0) V117A< TBL (SYSSWEDSRT, K%SET ,PSINT)> TBL (SYSTENQ, K%SET ,PSINT) TBL (SYSTEXTDOT, K%SET ,PSINT) TBL (SYSTIME, K%NSET,0) V117B< TBL (SYSTOPIID, K%NSET,0)> V117B< TBL (SYSTOPSID, K%NSET,0)> TBL (SYSTRAPUP3, K%SET ,PSINT) TBL (SYSTRETRY, K%SET ,PSINT) TBL (SYSUPROG, K%NSET,0) TBL (SYSUPROJ, K%NSET,0) TBL (SYSUSERADR, K%SET ,PSINT) TBL (SYSUSERD1, K%SET ,PSDATE) TBL (SYSUSERD2, K%SET ,PSDATE) TBL (SYSUSERD3, K%SET ,PSDATE) TBL (SYSUSERI1, K%SET ,PSINT) TBL (SYSUSERI2, K%SET ,PSINT) TBL (SYSUSERI3, K%SET ,PSINT) TBL (SYSUSERR1, K%SET ,PSREAL) TBL (SYSUSERR2, K%SET ,PSREAL) TBL (SYSUSERR3, K%SET ,PSREAL) TBL (SYSUSERT10, K%SET ,PSTXT) TBL (SYSUSERT40, K%SET ,PSTXT) TBL (SYSUSERT5, K%SET ,PSTXT) TBL (SYSUSRADRP, K%NSET,0) TBL (SYSWRITE20, K%SET ,PSINT) SYSTLN==<.-SYSTAB>-1 ;----------------------------------------------------------------------------- XLIST ;assemble corrupted literal pool here LIT LIST ; These FDB must be in the corruptible area because word .CMFNP will ; be modified to chain other FDB's to it EQFDB: FLDBK. (.CMKEY,CM%SDH,$EQ,,,BKEQ,0) ASFDB: FLDBK. (.CMKEY,CM%SDH,$AS,,,,0) VIAFDB: FLDBK. (.CMKEY,CM%SDH,$VIA,,,,0) TOFDB: FLDBK. (.CMKEY,CM%SDH,$TO,,,,0) BYFDB: FLDBK. (.CMKEY,CM%SDH,$BY,,,,0) ONFDB: FLDBK. (.CMKEY,CM%SDH,$ON,,,,0) ;fake help message INFDB: FLDBK. (.CMKEY,CM%SDH,$IN,>,,,0) CMD.DA (<2022>,<2022>>,100,100,100) ;set up command data area ;NOTE: I had to make ATMBUF big for those commands that use .CMFLD to parse ; the entire command as a single field (eg: PRINT,TYPE). I tryed to use ; .CMUQS to parse it because it don't place text in the ATMBUF but I ; also discovered that ^V didn't work anymore so the user couldn't enter ; a "?" or other action characters in the string. Also when using .CMUQS ; I was no longer able to check for when a null field was entered. ; The size of ATMBUF can be reduced when a entire command is no longer ; parsed as a single field. VARBEG==. ;start of variable area zeroed for warm restart CMD.ZV ;assemble COMND variables to be zeroed FK1022: 0 ;hold handle of inferior fork 1022 is running in VAREND==.-1 ;end of variable area zeroed for warm restart SAVE.F: 0 ;save F register between calls to DB____ CMDB22: BLOCK CMDBLN ;holds the command to be sent to 1022. It differs from ;CMDBUF in that all keyword abbreviations are expanded ;IERT: 0 ;holds 1022 error type-code number ;IERC: 0 ;holds 1022 error code number PLFLAG: -1 ;hold level count for PL1022 command REFLAG: -1 ;hold level count for REPORT command TRA6TC: 0 ;holds number of unparsed entries in TRA6TB FAD4C: FLD(.CMCFM,CM%FNC)!CM%SDH+FAD4D ;will allow user to enter null command FAD4D: FLD(.CMFLD,CM%FNC)!CM%SDH!CM%BRK!CM%HPP AD4CAL: 0 ;no data - so used to hold handler address 0 ;pointer to help string LASTKW: 0 ;no default text - so holds last command BKEOL ;address of break mask AD4HLP: ASCII/additional data for / AD4CMD: BLOCK 20 ;default help text for additional data AD4PRM: BLOCK 20 ;default prompt text for additional data FSPEC: BLOCK ^d<80/5> ;holds file specs temorarly for various things EDFDB: FLD(.CMFIL,CM%FNC)!CONFM 0 ;no data 0 ;no default help POINT 7,EDSPEC ;pointer to default file specs EDSPEC: BLOCK ^d<80/5> ;holds file specs for the EDIT command CONFM: FLD(.CMCFM,CM%FNC)!CM%HPP 0 ;no data 0 ;different routines will set .CMHLP word FEQV: FLD(.CMTOK,CM%FNC)!CM%HPP!CM%SDH!USFDB ;use for "@=" command POINT 7,[ASCIZ/=/] POINT 7,[ASCIZ/=/] ;default help message POINT 7,USSPEC ;pointer to default file specs USFDB: FLD(.CMFIL,CM%FNC)!CM%HPP!CM%SDH!CONFM ;used by USE and @ commands 0 ;no data POINT 7,[ASCIZ/file specs for DMC/] ;default help message POINT 7,USSPEC ;pointer to default file specs USSPEC: BLOCK ^d<80/5> ;holds file specs for the USE command SUBTTL Software Interrupt Data LALL P.LVT ;assemble LEVTAB data for software interrupt processing SALL CHNTAB::DCW (3,CTRLT,.CTCH) ;0 ^T interrupts DCW (3,CTRLE,.CECH) ;1 ^E interrupts DCW (1,CTRLC,.CCCH) ;2 ^C interrupts 0 ;3 free 0 ;4 free 0 ;5 free 0 ;6 arithmetic overflow 0 ;7 arithmetic floating pt overflow 0 ;8 reserved for DEC 0 ;9 PANIC - pushdown list overflow 0 ;10 end of file condition 0 ;11 PANIC - data error file condition 0 ;12 PANIC - disk full or quota exceeded 0 ;13 reserved for DEC 0 ;14 reserved for DEC 0 ;15 PANIC - illegal instruction 0 ;16 PANIC - illegal memory read 0 ;17 PANIC - illegal memory write 0 ;18 reserved for DEC 0 ;19 inferior process termination 0 ;20 PANIC - system resources exhausted 0 ;21 reserved for DEC 0 ;22 nonexistent page reference REPEAT ^D13,<0> ;23-35 free ONCHNL:: $ONCHN PURGE $ONCHN SUBTTL NON-CORRUPTIBLE DATA AREA ;============================================================================= ;When adding new entries to the command tables make sure they are added in ;alphabetical order CMDTAB: CMDTLN,,CMDTLN ;actual,,maximum number of entries TBL (#COM,,.COM) TBL (#T,,.TRACE) TBL (#TYPE,,.TTYPE) TBL (#Z,,.ABORT) $K1022: TBL (1022,,.R1022) $K2022: TBL (2022,,.R2022) TBL (@,,0) TBL (A,CM%ABR!CM%INV,$ADDK) TBL (AC,CM%ABR!CM%INV,$ACCEP) $ACCEP: TBL (ACCEPT) $ADDK: TBL (ADD) TBL (ADMIT) TBL (ALLOCATE) TBL (APPEND) TBL (AUDIT) TBL (BACKTO) TBL (BODY,,.BPTYP) TBL (C,CM%ABR!CM%INV,$CHANG) $CHANG: TBL (CHANGE) TBL (CL,CM%ABR!CM%INV,$CLOSE) TBL (CLEAR) $CLOSE: TBL (CLOSE) TBL (COLLECT) V116B< TBL (COMPILE)> TBL (CREATE) TBL (DBSET) TBL (DEFINE) TBL (DELETE) TBL (DFIND) TBL (DISABLE) TBL (DROP) TBL (DUMP) TBL (EDIT) TBL (ELSE) TBL (ELSEIF) TBL (ENABLE) TBL (END) TBL (ENDIF) TBL (ENDWHILE) TBL (EVALUATE) TBL (EXIT,,.EXIT2) TBL (F,CM%ABR!CM%INV,$FIND) TBL (FILE) $FIND: TBL (FIND) TBL (FOOTING) TBL (GETREC) TBL (HEADING) TBL (HELP,,.PHELP) TBL (HOST) TBL (I,CM%ABR!CM%INV,$INFO) TBL (IF) TBL (IGNORE) $INFO: TBL (INFORM,,.INFO) TBL (INIT) TBL (JOIN) TBL (KEY) TBL (L,CM%ABR!CM%INV,$LOAD) TBL (LET) $LOAD: TBL (LOAD) V117B< TBL (LOCK)> TBL (MAP) TBL (MODIFY) TBL (O,CM%ABR!CM%INV,$OPEN) TBL (OP,CM%ABR!CM%INV,$OPEN) $OPEN: TBL (OPEN) TBL (OPTIMIZE) TBL (P,CM%ABR!CM%INV,$PRNT) TBL (PAGE,,.BPTYP) TBL (PER,CM%ABR!CM%INV,$PERMI) V116B< TBL (PERFORM)> $PERMI: TBL (PERMIT) TBL (PL1022) $PRNT: TBL (PRINT) TBL (PUSH) TBL (QUIT,,.EXIT2) ;same as EXIT at the top command level TBL (R,CM%ABR!CM%INV,$RUN) TBL (REL,CM%ABR!CM%INV,$RELEA) $RELEA: TBL (RELEASE) TBL (RELOCATE) TBL (REP,CM%ABR!CM%INV,$REPOR) TBL (REPEAT) $REPOR: TBL (REPORT) $RUN: TBL (RUN) TBL (SAVE) TBL (SEARCH) TBL (SELECT) TBL (SET,,.SETT) TBL (SORT) TBL (SOS,,.EDIT) TBL (SPSS,,.UNIMP) TBL (STARTREC) TBL (T,CM%ABR!CM%INV,$TYPE) TBL (TECO,,.UNIMP) ; TBL (TMPFILE,,.UNIMP) ;used only in TOPS-10 TBL (TRANSACT) TBL (TY,CM%ABR!CM%INV,$TYPE) TBL (TYP,CM%ABR!CM%INV,$TYPE) TBL (TYPAGE,,.BPTYP) $TYPE: TBL (TYPE) TBL (UNDELETE) TBL (UNKEY) TBL (UNTIL) TBL (UPDATE) TBL (UPTO) TBL (USE) TBL (USERCALL) TBL (VALUES) TBL (WHILE) CMDTLN==<.-CMDTAB>-1 ;table for HELP command HLPTAB: HLPTLN,,HLPTLN ;actual,,maximum number of entries TBL (#TYPE,,0) TBL (ERROR,,0) TBL (FORMAT,,0) TBL (NEWS1,,0) TBL (NEWS2,,0) TBL (SYNTAX,,0) ; TBL (TMPFILE,,0) ;used only in TOPS-10 HLPTLN==<.-HLPTAB>-1 FLOAD: FLDBK. (.CMKEY,,LOATAB,,,,CONFRM##) ;for LOAD FOPN: FLDBK. (.CMCFM,,,,,,[FLDBK. (.CMKEY,,OPNTAB,,,BKKEY$,FDMSN)]) ;for OPEN FINFO: FLDBK. (.CMKEY,,INFTAB) ;for INFORM FMAP: FLDBK. (.CMKEY,,MP2TAB,,,,FATR) ;for MAP FJOIK: FLDBK. (.CMKEY,,JOITAB,,,,FKATRC) ;for JOIN FTRA2: FLDBK. (.CMKEY,,TRA2TB) ;for TRANSACT FTRA8: FLDBK. (.CMKEY,,TRA8TB,,,,CONFRM) ;for TRANSACT FDUM: FLDBK. (.CMKEY,,DMPTAB) ;for DUMP FDUMC: FLDBK. (.CMKEY,,DMPTAB,,,,CONFRM) ;for DUMP FFORC: FLDBK. (.CMKEY,,$FOR,,,,CONFRM) ;parse FOR FAP4C: FLDBK. (.CMKEY,,ADM4TB,,,,CONFRM) ;parse PASSWORD or FOR FAT: FLDBK. (.CMTOK,CM%SDH,) ;for parsing "@" FDMX: FLDBK. (.CMFIL,CM%SDH,,) FDMV: FLDBK. (.CMFIL,CM%SDH,,) FDMD: FLDBK. (.CMFIL,CM%SDH,,) FDMI: FLDBK. (.CMFIL,CM%SDH,,) FDMS: FLDBK. (.CMFIL,CM%SDH,,) FDMSN: FLDBK. (.CMFIL,CM%SDH,,,,,FDSN) FDSN: FLDBK. (.CMFLD,CM%SDH,,,,BKDSN) FDSD: FLDBK. (.CMFIL,CM%SDH,,,,,FDSDNA) FDSDNA: FLDBK. (.CMFLD,CM%SDH,,,,BKDSN,FDSDAL) FDSDAL: FLDBK. (.CMFLD,CM%SDH,,,,BKDSN,FDSDNU) FDSDNU: FLDBK. (.CMNUM,CM%SDH,^D10,) FKATR: FLDBK. (.CMFLD,CM%SDH,,,,BKATR) FKATRC: FLDBK. (.CMFLD,CM%SDH,,,,BKATR,CONFRM) FATR: FLDBK. (.CMFLD,CM%SDH,,,,BKATR) FATRC: FLDBK. (.CMFLD,CM%SDH,,,,BKATR,CONFRM) FCOL: FLDBK. (.CMFLD,CM%SDH,,,,BKDSN) FCHN: FLDBK. (.CMNUM,CM%SDH,^D10,) FCHNC: FLDBK. (.CMNUM,CM%SDH,^D10,,,,CONFM) FCHF: FLDBK. (.CMNUM,CM%SDH,^D10,,,,FFIL) FPRNT: FLDBK. (.CMKEY,,$PRINT) FVAR: FLDBK. (.CMFLD,CM%SDH,,,,BKVAR) FFIL: FLDBK. (.CMFIL) FNUM: FLDBK. (.CMNUM,,^D10) FSRT: FLDBK. (.CMFLD,CM%SDH,,,,BKELS) FSRTC: FLDBK. (.CMFLD,CM%SDH,,,,BKELS,CONFRM##) FPSVL: FLDBK. (.CMKEY,,SYSTAB,,,,FPLST) FPLST: FLDBK. (.CMFLD,CM%SDH,,) FPLSTE: FLDBK. (.CMFLD,CM%SDH,,,,BKEOL) ;function descriptor blocks for finding records FFIND: FLDBK. (.CMKEY,,FINTAB,,,,FFIND2) FFIND2: FLDBK. (.CMCFM,CM%SDH,,,,,[ FLDBK. (.CMKEY,,ROPTAB,,,,[ FLDBK. (.CMKEY,,LOPTAB,,,,[ FLDBK. (.CMFLD,CM%SDH,,,,BKELS)])])]) FHELP2: FLDBK. (.CMFLD,CM%SDH,,<>,,BKELS,CONFRM) $AS: 2,,2 ;actual,,max length of table TBL (A,CM%NOR,0) ;don't allow "A" as abbreviation of "AS" TBL (AS,,0) $BY: 2,,2 ;actual,,max length of table TBL (B,CM%NOR,0) ;don't allow "B" as abbreviation of "BY" TBL (BY,,0) $EQ: 3,,3 ;actual,,max length of table TBL (=,,0) TBL (E,CM%NOR,0) ;don't allow "E" as abbreviation of "EQ" TBL (EQ,,0) $IN: 2,,2 ;actual,,max length of table TBL (I,CM%NOR,0) ;don't allow "I" as abbreviation of "IN" TBL (IN,,0) $ON: 2,,2 ;actual,,max length of table TBL (O,CM%NOR,0) ;don't allow "O" as abbreviation of "ON" TBL (ON,,0) $TO: 2,,2 ;actual,,max length of table TBL (T,CM%NOR,0) ;don't allow "T" as abbreviation of "TO" TBL (TO,,0) $VIA: 3,,3 ;actual,,max length of table TBL (V,CM%NOR,0) ;don't allow "V" as abbreviation of "VIA" TBL (VI,CM%NOR,0) ;don't allow "VI" as abbreviation of "VIA" TBL (VIA,,0) KWT1 KWT1 KWT1 KWT1 KWT1 KWT1 KWT1 KWT1 KWT1 KWT1 KWT1 KWT1 KWT1 KWT1 KWT1 KWT1 KWT1 KWT1 KWT1 KWT1 ;table for VALUES keyword VALTAB: VALTLN,,VALTLN ;actual,,maximum number of entries TBL (COLUMN,,0) TBL (COUNT,,0) TBL (SYSID,,0) TBL (VALUES,,0) VALTLN==<.-VALTAB>-1 ;table for INFORM keyword INFTAB: INFTLN,,INFTLN ;actual,,maximum number of entries TBL (ADMIT, ,.IADMI) TBL (ATTRIBUTE, ,.IATTR) TBL (AUDIT, ,RET1) TBL (BASE, ,RET1) TBL (COLLECT, ,.ICJ) TBL (DAMAGE, ,RET1) TBL (DATA, ,RET1) V117B< TBL (DMX, ,.IDMX)> TBL (FILES, ,RET1) TBL (JOIN, ,.ICJ) TBL (NAMES, ,RET1) TBL (SET, ,RET1) TBL (STATUS, ,RET1) TBL (STRUCTURE, ,.ISTRU) TBL (VERSION, ,.IVERS) INFTLN==<.-INFTAB>-1 ISTTAB: ISTTLN,,ISTTLN ;actual,,maximum number of entries V117B< TBL (DATA,,0)> V117B< TBL (KEYS,,0)> TBL (LENGTH,,0) V117B< TBL (TABLE,,0)> ISTTLN==<.-ISTTAB>-1 ;table for COLLECT and JOIN keywords CJTAB: CJTLN,,CJTLN ;actual,,maximum number of entries TBL (NAME,,0) TBL (NUMBER,,0) CJTLN==<.-CJTAB>-1 ;table for FILE keyword FILTAB: FILTLN,,FILTLN ;actual,,maximum number of entries TBL (COPY, ,.FCOPY) TBL (DELETE, ,.FTYPD) TBL (RENAME, ,.FRENA) TBL (TYPE, ,.FTYPD) FILTLN==<.-FILTAB>-1 ; keyword table for the UNKEY command UKYTAB: UKYTLN,,UKYTLN ;actual,,maximum number of entries TBL (ALL, ,RET2##) TBL (NOREUSE, ,RET1##) TBL (REMOVE, ,RET1##) TBL (REUSE, ,RET1##) UKYTLN==<.-UKYTAB>-1 ;table for REPORT, PL1022 commands REPTAB: REPTLN,,REPTLN ;actual,,maximum number of entries TBL (END,,0) TBL (START,,1) REPTLN==<.-REPTAB>-1 ; keyword table for the MAP command MP2TAB: MP2TLN,,MP2TLN ;actual,,maximum number of entries TBL (AND,,0) TBL (TO,,0) TBL (VIA,,0) MP2TLN==<.-MP2TAB>-1 ;table for MAP BY keyword MBYTAB: MBYTLN,,MBYTLN ;actual,,maximum number of entries TBL (GETREC,,0) TBL (KEY,,0) V117A< TBL (SORT,,,0)> MBYTLN==<.-MBYTAB>-1 ;table for MAP LOGICAL keyword MLGTAB: MLGTLN,,MLGTLN ;actual,,maximum number of entries TBL (AND,,0) TBL (CLEAR,,0) TBL (OR,,0) MLGTLN==<.-MLGTAB>-1 ;table for FORMFEED keyword FFETAB: FFETLN,,FFETLN ;actual,,maximum number of entries TBL (IGNORE,,0) TBL (TERMINATOR,,0) FFETLN==<.-FFETAB>-1 ;table for AUDIT keyword AUDTAB: AUDTLN,,AUDTLN ;actual,,maximum number of entries TBL (BACKUP,,0) TBL (CHECK,,0) TBL (CHECKPOINT,,0) TBL (COMMENT,,0) TBL (FIX,,0) TBL (LIST,,0) TBL (MERGE,,0) TBL (RECOVERY,,0) TBL (START,,0) AUDTLN==<.-AUDTAB>-1 ;table for DEFINE keyword DEFTAB: DEFTLN,,DEFTLN ;actual,,maximum number of entries TBL (DATE,,RET1) TBL (DOUBLE,,.DEFD) TBL (INTEGER,,RET1) TBL (REAL,,RET1) TBL (TEXT,,.DEFT) DEFTLN==<.-DEFTAB>-1 ;table for MODIFY keyword MODTAB: MODTLN,,MODTLN ;actual,,maximum number of entries TBL ($ACCESS,,.MOACC) TBL ($ATTRIBUTE,,.MOATR) TBL ($DSNAME,,.MODSN) MODTLN==<.-MODTAB>-1 ;table for MODIFY $ACCESS keyword MACTAB: MACTLN,,MACTLN ;actual,,maximum number of entries TBL (ENQ,,0) TBL (NOENQ,,0) V117B< TBL (NORECLOCK,,0) TBL (RECLOCK,,0)> MACTLN==<.-MACTAB>-1 ;table for MODIFY $ATTRIBUTE keyword MATTAB: MATTLN,,MATTLN ;actual,,maximum number of entries TBL (ABBREVIATION,,.MOATA) TBL (NAME,,.MOATN) MATTLN==<.-MATTAB>-1 ;table for ACCESS keyword ACSTAB: ACSTLN,,ACSTLN ;actual,,maximum number of entries TBL (READONLY,,0) TBL (RO,,0) ACSTLN==<.-ACSTAB>-1 ;table for CLEAR keyword CLRTAB: CLRTLN,,CLRTLN ;actual,,maximum number of entries TBL (COLLECT,,.CLRC) TBL (JOIN,,.CLRJ) CLRTLN==<.-CLRTAB>-1 ;table for UPDATE keyword UPDTAB: UPDTLN,,UPDTLN ;actual,,maximum number of entries TBL (ALLOW,,0) TBL (OFF,,0) TBL (ON,,0) TBL (PREVENT,,0) UPDTLN==<.-UPDTAB>-1 ;table for SET keyword STTAB: STTLN,,STTLN ;actual,,maximum number of entries TBL (BUFFER, ,PNUM) TBL (ERRCHAR, ,.SERCH) TBL (ERROR, ,.SEROR) TBL (FILERR, ,.SEROR) TBL (FMSG, ,.SFMER) TBL (FERR, ,.SFMER) TBL (PROMPT, ,.SPROM) V117A< TBL (SCRATCH, ,.SSCRA)> TBL (TAPE, ,.STAPE) STTLN==<.-STTAB>-1 ;table for SET ERROR / FILERR keywords SERTAB: SERTLN,,SERTLN ;actual,,maximum number of entries TBL (ABORT,,0) TBL (CONTINUE,,0) SERTLN==<.-SERTAB>-1 ;table for SET FMSG / FERR keywords SFMTAB: SFMTLN,,SFMTLN ;actual,,maximum number of entries TBL (0,,0) TBL (1,,0) TBL (M,,0) TBL (OFF,,0) TBL (ON,,0) SFMTLN==<.-SFMTAB>-1 ;table for SET PROMPT keyword SPMTAB: SPMTLN,,SPMTLN ;actual,,maximum number of entries TBL (CLOCK, ,RET1) TBL (CPU, ,RET1) ; TBL (DISK, ,0) ;not available under TOPS-20 TBL (TEXT, ,.SPTXT) TBL (TIME, ,RET1) SPMTLN==<.-SPMTAB>-1 ;table for SET TAPE keyword SPTTAB: SPTTLN,,SPTTLN ;actual,,maximum number of entries TBL (FF,,0) TBL (NONE,,0) SPTTLN==<.-SPTTAB>-1 ;table for FIND keyword FINTAB: FINTLN,,FINTLN ;actual,,maximum number of entries TBL (ALL,,RET2) TBL (FILE,,.FIFIL) TBL (LAST,,.FILAS) TBL (SYSID,,.FISID) FINTLN==<.-FINTAB>-1 ;tables for ADMIT command ADM1TB: ADM1TL,,ADM1TL ;actual,,maximum number of entries TBL (CLASS,,.ADCLS) TBL (CLEAR,,ADMIT7) ADM1TL==<.-ADM1TB>-1 ADM2TB: ADM2TL,,ADM2TL ;actual,,maximum number of entries TBL (LOCKED, ,0) TBL (READONLY, ,0) TBL (RO, ,0) TBL (UPDATE, ,0) ADM2TL==<.-ADM2TB>-1 ADM3TB: ADM3TL,,ADM3TL ;actual,,maximum number of entries TBL (CLEAR, ,ADMIT7) TBL (FOR, ,ADFOR3) TBL (OWNER, ,ADMIT7) TBL (PASSWORD, ,ADFOR8) ADM3TL==<.-ADM3TB>-1 ADM4TB: ADM4TL,,ADM4TL ;actual,,maximum number of entries TBL (FOR, ,0) TBL (PASSWORD, ,1) ADM4TL==<.-ADM4TB>-1 ;table for PERMIT keyword PERMTB: PERMTL,,PERMTL ;actual,,maximum number of entries TBL (ACCESS, ,0) TBL (PASSWORD, ,1) PERMTL==<.-PERMTB>-1 ;tables for INIT command INITTB: INITTL,,INITTL ;actual,,maximum number of entries V117B< TBL (1,CM%NOR ,0) ;don't recognize "1" - its a channel... TBL (123, ,.I123)> ; ...number not a abbreviation of "123" TBL (APPEND, ,.IAPND) V117B< TBL (DIF, ,.IDIF)> INITTL==<.-INITTB>-1 ;tables for GETREC command GETRTB: GETRTL,,GETRTL ;actual,,maximum number of entries V117B< TBL ($LOCK,,.G$LOC)> TBL (LEAVE,,RET1) GETRTL==<.-GETRTB>-1 V117B< ;tables for LOCK command LOCKTB: LOCKTL,,LOCKTL ;actual,,maximum number of entries TBL (OFF,,0) TBL (ON,,1) LOCKTL==<.-LOCKTB>-1 LOC2TB: LOC2TL,,LOC2TL ;actual,,maximum number of entries TBL (RECORD,,RET1) TBL (USERLOCK,,.LUSER) LOC2TL==<.-LOC2TB>-1 >;end of LOCK for V117B ;tables for TRANSACT command TRA1TB: TRA1TL,,TRA1TL ;actual,,maximum number of entries TBL (DATA,,.TDATA) TBL (SET,,.TSET) TRA1TL==<.-TRA1TB>-1 TRA4TB: TRA4TL,,TRA4TL ;actual,,maximum number of entries TBL (APPEND,,RET1) TBL (IGNORE,,RET1) TRA4TL==<.-TRA4TB>-1 TRA5TB: TRA5TL,,TRA5TL ;actual,,maximum number of entries TBL (APPLY,,RET1) TBL (DELETE,,RET1) TBL (IGNORE,,RET1) TRA5TL==<.-TRA5TB>-1 TRA7TB: TRA7TL,,TRA7TL ;actual,,maximum number of entries TBL (ALL,,RET1) TBL (FIRST,,RET1) TBL (IGNORE,,RET1) TBL (LAST,,RET1) TRA7TL==<.-TRA7TB>-1 ;table for SORT sequence-descriptors SSDTAB: SSDTLN,,SSDTLN ;actual,,maximum number of entries TBL (ASCENDING, ,0) TBL (DECENDING, ,0) TBL (DOWN, ,0) TBL (UP, ,0) SSDTLN==<.-SSDTAB>-1 ;logical operator table LOPTAB: LOPTLN,,LOPTLN ;actual,,maximum number of entries TBL (AND,,0) TBL (EQV,,0) TBL (NOT,,0) TBL (OR,,0) TBL (XOR,,0) LOPTLN==<.-LOPTAB>-1 ;relational operator table ROPTAB: ROPTLN,,ROPTLN ;actual,,maximum number of entries ; TBL (BEG,,0) ;some abbreviations were commented out... TBL (BEGINS,,0) ; ...because the interfere with using... ; TBL (BET,,0) ; ... to fill them in TBL (BETWEEN,,0) ; TBL (CONT,,0) TBL (CONTAINS,,0) TBL (CT,,0) ; TBL (EQ,,0) ; TBL (EQUAL,,0) TBL (EQUALS,,0) TBL (GE,,0) TBL (GT,,0) TBL (LE,,0) TBL (LT,,0) V117B< TBL (MATCHES,,0)> TBL (NBEG,,0) TBL (NBET,,0) TBL (NCT,,0) TBL (NE,,0) TBL (NEQ,,0) TBL (NOT,,0) V117B< TBL (NMATCHES,,0)> ROPTLN==<.-ROPTAB>-1 ;break mask for EQ and = BKEQ: BRMSK.(-1,-1,-1,-1,<=EQeq>,) ;break mask for an variable names - subscripts require "(,)" BKVAR: BRMSK.(FLDB0.,FLDB1.,FLDB2.,FLDB3.,<(,)>,<->) ;break mask for an attribute name ;(should I have BKATD. which allows "." for attribute descriptor??) BKATR: BRMSK.(FLDB0.,FLDB1.,FLDB2.,FLDB3.,<_>,<->) ;break mask for a data set name BKDSN: BRMSK.(FLDB0.,FLDB1.,FLDB2.,FLDB3.,,<->) ;break mask for a data set descriptor (allow "." for file names) ;BKDSD: BRMSK.(FLDB0.,FLDB1.,FLDB2.,FLDB3.,<.>,<->) ;break mask for a data set passwords BKPAS: BRMSK.(FLDB0.,FLDB1.,FLDB2.,FLDB3.,,) ;break mask to break only on end of line BKEOL: BRMSK.(EOLB0.,EOLB1.,EOLB2.,EOLB3.,,) ;break mask to break only on end of line or space or tab BKELS: BRMSK.(EOLB0.,EOLB1.,EOLB2.,EOLB3.,,< ?>) ;break mask for top level 1022 commands BKC22: BRMSK.(KEYB0.,KEYB1.,KEYB2.,KEYB3.,<#>,) ;break mask for help command BKH22: BRMSK.(KEYB0.,KEYB1.,KEYB2.,KEYB3.,<#@>,) BKKEY$: BRMSK.(KEYB0.,KEYB1.,KEYB2.,KEYB3.,<$>,) ;----------------------------------------------------------------------------- XLIST ;assemble command table literal pool here to reduce page faults LIT LIST SUBTTL Definitions for 1022 ;============================================================================= ;Define the logicals: .AND.: 1 ;ASCII/AND / .OR.: 2 ;ASCII/OR / .NOT.: ASCII/NOT / .EQV.: 3 ;ASCII/EQV / .XOR.: 4 ;ASCII/XOR / ;Define the relationals: .EQ.: 1 ;ASCII/EQ / .NE.: 2 ;ASCII/NE / .LT.: 3 ;ASCII/LT / .LE.: 4 ;ASCII/LE / .GT.: 5 ;ASCII/GT / .GE.: 6 ;ASCII/GE / .BET.: 7 ;ASCII/BET / .NBET.: 8 ;ASCII/NBET / .CT.: 9 ;ASCII/CT / .NCT.: 10 ;ASCII/NCT / .BEG.: 11 ;ASCII/BEG / .NBEG.: 12 ;ASCII/NBEG / ;Define special keywords for DBxxxx subroutines: DISP.: ASCII/DISP./ ;for control over argument conversions BIN.: ASCII/BIN. / ALL: ASCII/ALL / ;for DBAINI, DBFIND LAST: ASCII/LAST / SYSID: ASCII/SYSID / LOGICA: ASCII/LOGICAL / ;for DBMAP NOCLOS: ASCII/NOCLOSE / ;for DBOPEN PASSWO: ASCII/PASSWORD / ACCESS: ASCII/ACCESS / SUBTTL MAIN PROGRAM ;start of entry vector ENTVEC: JRST START ;"@START" address JRST START ;"@REENTER" address VERSION ;version number (must be 3rd word) EVLEN==.-ENTVEC ;get length of entry vector START: RESET% ;initialize the world SETZ F, ;initialize flag register MOVE P,[IOWD PDLEN,PDL] ;initialize stack register SETNAM (2022,2022) ;set private & system names of program CALL ERESET## ;say program has encountered no errors SKIPN STWARM ;is this a warm start? IFSKP. ;no, go to ENDIF. ;this code is only executed for warm restarts SETOM PLFLAG ;initialize PL1022 flag SETOM REFLAG ;initialize REPORT flag ZERO (VARBEG,VAREND) ;reinitialize memory CMD.WM ;assemble warm restart code for COMND MOVEI T2,SYSTAB ;system variable table CALL CLRFLA ;clear all the CM%NOP flags ENDIF. CALL RCNINP## ;set up to read commands from RESCAN ; SKIPN STWARM ;is this a warm start ; CALL TAKINI## ;no, setup to get commands from INI file SETOM STWARM ;next time though its a warm start CALL OUTVER ;output version of 2022 CALL ENAPSI## ;enable the interrupt system MOVE T1,[.TICCC,,.CCCH] ;activate to intercept ^C ATI% JERR (%,,PC) MOVE T1,[.TICCE,,.CECH] ;activate to intercept ^E ATI% JERR (%,,PC) $1022 (DBMAC) ;initialize for 1022 $1022 (DBERR,<[-1]>) ;if errors type message and return $1022 (DBSYSV,<[^D44],[1],[1]>) ;set SYSDBEXMSG to 1 HRROI T2,[ASCIZ\AUTO.DMC\] CALL FGTJFN## ;see if file exists IFSKP. ;no, couldn't find it HRRZM T1,T2 ;save JFN TMSGL < [Taking commands from > FILSTR (-) TMSG <] > HRRZ T1,T2 ;get jfn RLJFN% JERR (?,,PC) $1022 (DBEXEC,<[ASCIZ\USE AUTO.DMC\]>) ENDIF. ; since setting SYSDBEXMSG to 1 disables the "called from DBEXEC..." message ; I no longer need to trap and display the errors myself ; $1022 (DBERR,) ;if errors jump to this routine MOVEI T1,DIE ;exit routine for this command level HRROI T2,TOPCLP ;prompt string for this command level CALL BEGCML## ;set up this command level MOVE P1,CMDBLK+.CMPTR ;initialize ptrs for XKEYW MOVE P2,[POINT 7,CMDB22] TXZ F,F%INI!F%NFIL!F%NCHN ;initialize flags MOVX T4,CM%XIF ;don't recognize "@" IORM T4,CMDBLK+.CMFLG ;set flag word PARSE (,<.CMKEY,,CMDTAB,,,BKC22,FAT>) ANDCAM T4,CMDBLK+.CMFLG ;reset flag word to recognize "@" HRRZM T2,LASTKW ;save keyword address of last command TLZ T3,-1 ;get function descriptor block parsed CAIN T3,FAT ;was "@" parsed? JRST .AT ;yes CALL XKEYW ;expand abbreviated keyword HRRZ T4,(T2) ;get address of command server JRST (T4) ;dispatch to it ;----------------------------------------------------------------------------- ;All commands will jump here after they are completed ENDCMD:: SETZM AD4CAL ;no routine to handle more data SETZM FAD4D+.CMHLP ;no default help text SETZM AD4PRM ;no default prompt text CIS% ;incase ^C out and used "@REENTER" JRST GETCMD## ;go parse another command SUBTTL Servers for FIND, DFIND, SEARCH, SELECT commands ;============================================================================= .SEARC: NOISE2 (for ,records) JRST FIND3 ;join common code .SELEC: NOISE2 (reco,rds) JRST FIND3 ;join common code .DFIND: NOISE2 (dele,ted records) JRST FIND1 ;join common code .FIND: NOISE2 (reco,rds) FIND1: PARSE (,,FFIND) TLZ T3,-1 ;get function descriptor block parsed CAIN T3,FFIND ;parsed a command from FINTAB? CALL CKABRV ;yes, was keyword abbreviated? JRST FIND3 ;yes, assume its a selection condition HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to handler JRST FIND3 ;continue find CONFIRM JRST DBEX FIND3: PARSE (,,FFIND2) TLZ T3,-1 ;get function descriptor block parsed CAIE T3,FFIND2 ;parsed confirm? JRST FIND3 ;no loop back to parse some more CALL DOECHO## ;echo if necessary JRST DBEX ;do DBEXEC ;----------------------------------------------------------------------------- ; server for the FIND FILE keyword .FIFIL: MOVX T4,GJ%OLD ;parse existing file MOVEM T4,GTJBLK+.GJGEN SPTR T4, MOVEM T4,GTJBLK+.GJEXT ;set default file extension PARSE (,,FDMV) AOS (P) ;set +2 return CALLRET RJFN ;release JFN ;----------------------------------------------------------------------------- ; server for the FIND SYSID keyword .FISID: TXO F,F%RNOP ;have DOCMD return on CM%NOP PARSE (,<.CMKEY,,ROPTAB,>) RET ;----------------------------------------------------------------------------- ; server for the FIND LAST keyword .FILAS: TXO F,F%RNOP ;have DOCMD return on CM%NOP PARSE (,<.CMKEY,,ROPTAB,,,,CONFRM>) TLZ T3,-1 ;get function descriptor block parsed CAIE T3,CONFRM ;user confirmed command? RET ;no AOS (P) ;set +3 return AOS (P) CALLRET DOECHO## ;echo if necessary SUBTTL Servers for PRINT command ;============================================================================= .PRINT: HRLZI T3,FPSVL ; SPTR T4, SPTR T4,<> MOVEM T4,GTJBLK+.GJEXT ;set default file extension MOVEI T2,SYSTAB ;system variable table TXZE F,F%SYSV ;necessary to clear CM%NOP flags? CALL CLRFLA ;yes, do it CALL PONCF ;parse "ON or " phrase JRST PRINT4 ;failed, parsed something else instead PRINT3: PARSE (,,FPSVL) TLZ T3,-1 ;get function descriptor block parsed PRINT4: CAIE T3,FPSVL ;parsed a system variable? JRST PRINT5 ;no, join common code JRST PRINT3 ;yes, loop back for another PRINT5: PARSE (,,FPLSTE) CONFIRM JRST DBEX ;do DBEXEC SUBTTL Servers for TYPE command ;============================================================================= .TYPE: NOISE2 (on t,erminal) MOVEI T2,SYSTAB ;system variable table TXZE F,F%SYSV ;necessary to clear CM%NOP flags? CALL CLRFLA ;yes, do it JRST PRINT3 ;join common code SUBTTL Servers for CHANGE command ;============================================================================= .CHANG: NOISE2 (attr,ibute value) PARSE (,<.CMFLD,CM%SDH,, >,,BKEOL>) CONFIRM JRST DBEX ;do DBEXEC SUBTTL Servers for CLOSE command ;============================================================================= .CLOSE: NOISE2 (the ,current data set) CONFIRM JRST DBEX ;do DBEXEC SUBTTL Servers for DROP command ;============================================================================= .DROP: NOISE2 (curr,ent record from selection group) CONFIRM JRST DBEX SUBTTL Servers for GETREC command ;============================================================================= FRPE: FLDBK. (.CMFLD,CM%SDH,,,,BKEOL,CONFM) .GETRE: SPTR T4, MOVEM T4,CONFM+.CMHLP PARSE (,<.CMKEY,,GETRTB,,,BKKEY$,FRPE>) HLRZM T3,T4 TLZ T3,-1 ;get function descriptor block parsed CAME T3,T4 ;was keyword in GETRTB parsed? JRST GETRE7 ;no, parsed FRPE ; CALL XKEYW ;expand abbreviated keyword HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to it GETRE7: CONFIRM JRST DBEX ;----------------------------------------------------------------------------- ; server for the $LOCK keyword V117B< .G$LOC: PARSE (,,FRPE) ;parse relative position expression RET >;end of V117B SUBTTL Servers for DBSET command ;============================================================================= .DBSET: HRLZI T3,CONFRM ;next FDB to use if required CALL PDSD ;parse a data set descriptor JRST DBSET7 ;next field of command was parsed CONFIRM TRNA DBSET7: CALL DOECHO## ;parsed confirm - echo if necessary JRST DBEX ;do DBEXEC SUBTTL Servers for MAP command ;============================================================================= .MAP: NOISE2 (to d,ata set) MOVEI T2,MP1TAB ;address of keyword table CALL CLRFLA ;clear all the CM%NOR flags in table TXO F,F%INI ;just do initialization CALL PDMSN ;init for parsing existing data set MAP2: DMOVE P3,CMDBLK+.CMPTR ;get data for possible reparse PARSE (,<.CMKEY,,MP1TAB,,,,FDSD>) HLRZM T3,T4 TLZ T3,-1 ;get function descriptor block parsed CAME T3,T4 ;was keyword in MP1TAB parsed? JRST MAP4 ;no continue parsing data set descriptor CALL CKABRV ;yes, was keyword abbreviated? JRST MAP3 ;yes, assume its a data set descriptor CALL SETFLG ;say keyword parsed HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to handler JRST MAP2 ;loop back for next keyword TRNA ;return +2 when "TO" parsed MAP3: CALL RCMBLK ;have abbreviated keyword reparsed HRLZI T3,FMAP ;next FDB to use if required CALL PDSD ;parse a data set descriptor JRST MAP6 ;next field of command was parsed JRST MAP5 ;continue with MAP command MAP4: HRLZI T4,FMAP ;next FDB to use if required CALL PDSD2 ;contiune parsing data set descriptor JRST MAP6 ;next field of command was parsed MAP5: PARSE (,,FMAP) MAP6: TLZ T3,-1 ;get function discriptor block parsed CAIE T3,FATR ;parsed an attribute name? CALL CKABRV ;no, was keyword abbreviated? TRNA ;yes, assume its an attribute name JRST MAP5 ;no, process keyword ; gets here when I've parsed an attribute name. If a null name was parsed ; (.CMFLD will parse a null field) then user is trying to confirm command MOVE T2,CMDBLK+.CMABP ;get ptr to ATMBUF ILDB T2,T2 ;get 1st byte of string parsed JUMPN T2,MAP5 ;jump if NOT null field parsed CONFIRM JRST DBEX ;----------------------------------------------------------------------------- ; server for the MAP BY keyword .MAPBY: PARSE (,<.CMKEY,,MBYTAB>) CALLRET XKEYW ;expand abbreviated keyword ;----------------------------------------------------------------------------- ; server for the MAP LOGICAL keyword .MAPLG: MOVEI T2,$MBY ;1022 considers BY invalid after LOGICAL CALL SETFLG ;don't allow "BY" after this PARSE (,<.CMKEY,,MLGTAB,,>) CALLRET XKEYW ;expand abbreviated keyword SUBTTL Servers for INFORM command ;============================================================================= .INFO: HRLZI T3,FINFO ;address of FDB for INFORM command ; SPTR T4, SPTR T4,<> MOVEM T4,GTJBLK+.GJEXT ;set default file extension TXO F,F%NCHN ;don't allow channel number CALL PONCF ;parse "ON " phrase JRST INFO5 ;failed, parsed something else instead PARSE (,,FINFO) ;parse a INFORM keyword INFO5: CALL XKEYW ;expand abbreviated keyword HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to it CONFIRM JRST DBEX ;do DBEXEC ;----------------------------------------------------------------------------- ; server for the VERSION keyword .IVERS: CONFIRM ; VERSION==B2+B11+B17+VEDIT AOS (P) ;set +2 return CALLRET OUTVER ;output version of 2022 ;----------------------------------------------------------------------------- ; server for the ADMIT keyword .IADMI: PARSE (,<.CMUSR,,,,,,CONFRM>) TLZ T3,-1 ;get function descriptor block parsed CAIN T3,CONFRM ;user confirmed command? AOS (P) ;yes, set +2 return RET ;----------------------------------------------------------------------------- ; server for the ATTRIBUTE and STRUCTURE keywords .IATTR: PARSE (,,FATR) ;parse a attribute name PARSE (,<.CMKEY,,$LENGTH,,,,CONFRM>) JRST ISTRU2 ;join common code .ISTRU: PARSE (,<.CMKEY,,ISTTAB,,,,CONFRM>) ISTRU2: TLZ T3,-1 ;get function descriptor block parsed CAIN T3,CONFRM ;user confirmed command? AOSA (P) ;yes, set +2 return CALLRET XKEYW ;expand abbreviated keyword RET ;----------------------------------------------------------------------------- ; server for the COLLECT and JOIN keywords .ICJ: PARSE (,<.CMKEY,,CJTAB,,,,CONFRM>) CALLRET XKEYW ;expand abbreviated keyword ;----------------------------------------------------------------------------- ; server for the INFORM DMX command V117B< .IDMX: NOISE2 (file,) JRST IDMX5 >;end of V117B SUBTTL Servers for VALUES command ;============================================================================= .VALUE: HRLZI T3,FKATR ;address of FDB to parse attribute name ; SPTR T4, SPTR T4,<> MOVEM T4,GTJBLK+.GJEXT ;set default file extension TXO F,F%NCHN ;don't allow channel number CALL PONCF ;parse "ON " phrase JRST VALUE5 ;failed, parsed a attribute name instead PARSE (,,FKATR) ;parse a attribute name VALUE5: PARSE (,<.CMKEY,,VALTAB,,,,CONFRM>) TLZ T3,-1 ;get function descriptor block parsed CAIN T3,CONFRM ;user confirmed command? IFSKP. ;yes CALL XKEYW ;expand abbreviated keyword JRST VALUE5 ;loop back for another keyword ENDIF. CALL DOECHO## ;echo if necessary JRST DBEX ;do DBEXEC SUBTTL Servers for SORT command ;============================================================================= .SORT: NOISE2 (sele,ction group) MOVEI T2,SORTAB ;address of keyword table CALL CLRFLA ;clear all the CM%NOR flags in table HRRI T4,FSRTC ;build next FDB chain HRRM T4,BYFDB SORT1: PARSE (,<.CMKEY,,SORTAB,,,,FSRT>) TLZ T3,-1 ;get function discriptor block parsed MOVEI T4,.SEXP ;routine to handle sort-expressions CAIE T3,FSRT ;was sort-expression parsed? CALL CKABRV ;no, was keyword abbreviated? IFSKP. ;yes, assume its a sort-expression HRRZ T4,(T2) ;get address of command server ENDIF. CALL (T4) ;dispatch to it JRST SORT1 ;loop back for another sort option JRST DBEX ;----------------------------------------------------------------------------- ; server for the BY keyword .SBY: PARSE (,,FSRT) .SEXP: PARSE (,<.CMKEY,,SSDTAB,,,,BYFDB>) SBY3: TLZ T3,-1 ;get function descriptor block parsed CAIN T3,CONFRM ;user confirmed command? JRST SBY7 ;yes CAIE T3,FSRTC ;was sort-expression parsed? CALL CKABRV ;no, was keyword abbreviated? JRST .SEXP ;yes, assume its a sort-expression CAIN T3,BYFDB ;was "BY" parsed JRST .SBY ;yes SBY5: PARSE (,,BYFDB) MOVE T4,CMDBLK+.CMABP ;get ptr to ATMBUF ILDB T4,T4 ;get 1st byte of string parsed JUMPN T4,SBY3 ;jump if NOT null field parsed CALLRET SKEY2 ;if null field parsed then user... ; ...must be trying to confirm command SBY7: AOS (P) ;set +2 return CALLRET DOECHO## ;echo command if necessary ;----------------------------------------------------------------------------- ; server for the CORE keyword .SCOR: CALL SETFLG ;say keyword parsed PARSE (,<.CMNUM,CM%SDH,^D10,,<5>>) MOVEI T2,$SKEY ;don't allow KEY anymore CALLRET SETFLG ;----------------------------------------------------------------------------- ; server for the USING keyword .SUSI: CALL SETFLG ;say keyword parsed PARSE (,<.CMDEV,CM%SDH!CM%NSF,,>) MOVEI T2,$SKEY ;don't allow KEY anymore CALLRET SETFLG ;----------------------------------------------------------------------------- ; server for the KEY keyword .SKEY: PARSE (,,FKATR) SKEY2: CONFIRM AOS (P) ;set +2 return RET SUBTTL Servers for OPEN command ;============================================================================= .OPEN: NOISE2 (data, set) MOVEI T2,OPNTAB ;address of keyword table CALL CLRFLA ;clear all the CM%NOR flags in table TXO F,F%INI ;just do initialization CALL PDMSN ;init for parsing existing data set PARSE (,<.CMKEY,,$NOCLOSE,,,,FDMSN>) TLZ T3,-1 ;get function discriptor block parsed HRLZI T4,FOPN ;initailize for call to PDMSN1 or PDMSN2 CAIE T3,FDMSN ;parsed file spec for DMS? CAIN T3,FDSN ; ...or parsed data set name? IFSKP. ;yes ; gets here when I've parsed a keyword. If it was abbreviated then I, like ; 1022, will assume it's a data set file specs or name and reparse it CALL CKABRV ;was keyword abbreviated? CALL RCMBLK ;yes, have abbreviated keyword reparsed DMOVE P3,CMDBLK+.CMPTR ;get data for possible reparse CALL PDMSN1 ;parse a data set name/file JRST OPEN4 ;next field of command was parsed ELSE. CALL PDMSN2 ;continue parsing for data set name/file JRST OPEN4 ;next field of command was parsed ENDIF. OPEN3: DMOVE P3,CMDBLK+.CMPTR ;get data for possible reparse PARSE (,,FOPN) OPEN4: TLZ T3,-1 ;get function discriptor block parsed CAIE T3,FOPN ;parsed confirm? IFSKP. ;no CALL DOECHO## ;yes, parsed confirm - echo if necessary JRST DBEX ;do DBEXEC ENDIF. CAIE T3,FDMSN ;parsed file spec for DMS? CAIN T3,FDSN ; ...or parsed data set name? JRST OPEN8 ;yes ; checked everything else so I must have parsed a keyword from OPNTAB. If ; the keyword is abbreviated then assume its a data-set-name (this is what ; the 1022 command does) CALL CKABRV ;was keyword abbreviated? TRNA ;yes IFSKP. ;no CAIE T2,$OPASS ;was keyword abbreviation of "PASSWORD" JRST OPEN5 ;no, assume it's a data set name/file ; must check because "PASS" is a vaild abbreviation of "PASSWORD" DMOVEM T1,Q1 ;save registers HRROI T1,ATMBUF ;get pointer to atom buffer HRROI T2,[ASCIZ\PASS\] STCMP% ;compare the strings MOVEM T1,T4 ;save results DMOVE T1,Q1 ;restore registers JUMPN T4,OPEN5 ;jump if strings weren't equal ; CALL XKEYW ;expand abbreviated keyword ENDIF. HRRZ T4,T3 ;get function discriptor block parsed CALL SETFLG ;say keyword parsed HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to handler JRST OPEN3 ;loop back to parse some more ; CALL HNDLER ;call the handler to handle command ; ERR (?,,PC,DIE) ;CONFRM was parsed ; gets here when I've parsed a abbreviated keyword. Since it was abbreviated ; I, like 1022, will assume it's a data set file specs or name and reparse it OPEN5: MOVEI T2,OPNTAB ;address of keyword table CALL CLRFLA ;clear all the CM%NOR flags in table CALL RCMBLK ;have abbreviated keyword reparsed HRLZI T4,FOPN ;initailize for call to PDMSN1 CALL PDMSN1 ;parse a data set name/file JRST OPEN4 ;next field of command was parsed JRST OPEN3 ;loop back to parse some more ; gets here when data set name or file specs of DMS were parsed OPEN8: DMOVEM T2,Q1 ;save registers MOVEI T2,OPNTAB ;address of keyword table CALL CLRFLA ;clear all the CM%NOR flags in table DMOVE T2,Q1 ;restore registers HRLZI T4,FOPN ;FDB for OPEN CALL PDMSN2 ;continue parsing for data set name/file JRST OPEN4 ;next field of command was parsed JRST OPEN3 ;loop back to parse some more ;----------------------------------------------------------------------------- ; server for the ACCESS keyword .OACSS: PARSE (,<.CMKEY,,ACSTAB>) CALL XKEYW ;expand abbreviated keyword MOVEI T2,$OREAD ;address of READONLY keyword CALL SETFLG MOVEI T2,$ORO ;address of RO keyword CALLRET SETFLG ;set flag for RO and READONLY ;----------------------------------------------------------------------------- ; server for the READONLY and RO keyword .OROLY: MOVEI T2,$ORO ;address of RO keyword CALL SETFLG JRST ORO3 .ORO: MOVEI T2,$OREAD ;address of READONLY keyword CALL SETFLG ORO3: MOVEI T2,$OACES ;address of ACCESS keyword CALLRET SETFLG ;set flag ;----------------------------------------------------------------------------- ; server for the AS keyword .OAS: PARSE (,<.CMFLD,CM%SDH,,,,BKDSN>) RET ;----------------------------------------------------------------------------- ; server for the ENQ, NOENQ keyword .OENQ: MOVEI T2,$ONENQ ;address of NOENQ keyword CALLRET SETFLG ;set flag .ONENQ: MOVEI T2,$OENQ ;address of ENQ keyword CALLRET SETFLG ;set flag ;----------------------------------------------------------------------------- ; server for the PASSWORD keyword .OPASS: PARSE (,<.CMFLD,CM%SDH,,,,BKPAS>) RET SUBTTL Server for APPEND command ;============================================================================= .APPEN: NOISE2 (reco,rds from data set) MOVEI T2,LOATAB ;address of keyword table CALL CLRFLA ;clear all the CM%NOR flags in table MOVEI T2,$LMAX ;"MAX" keyword not valid in append CALL SETFLG ;remove it from list MOVEI T2,$LNKEY ;"NOKEY" keyword not valid in append CALL SETFLG ;remove it from list JRST LOAD3 ;join common code for LOAD command SUBTTL Server for LOAD command ;============================================================================= .LOAD: NOISE2 (bund,led data set) MOVEI T2,LOATAB ;address of keyword table CALL CLRFLA ;clear all the CM%NOR flags in table TXO F,F%INI ;just do initialization CALL PDMD ;init for parsing existing DMD file PARSE (,<.CMKEY,,LOATAB,,,,FDMD>) HRRZ T4,T3 ;get function discriptor block parsed CAIN T4,FDMD ;parsed file specs of DMD? IFSKP. ;yes HRLZI T3,FLOAD ;just incase handler is PDMSN JRST LOAD4 ;enter load loop ENDIF. CALL PDMD7 ;do stuff required after parsing DMD MOVEI T2,$LDESC ;get address of DESC keyword CALL SETFLG ;say keyword was parsed LOAD3: PARSE (,,FLOAD) LOAD4: CALL HNDLER ;call the handler to handle command JRST DBEX ;do DBEXEC when CONFRM parsed JRST LOAD3 ;loop back to parse some more ;----------------------------------------------------------------------------- ; server for the SET keyword .LSET: CALL PDMSNZ ;parse a data set descriptor TRNA ;next field of command was parsed RET ;return to caller ADJSP P,-1 ;remove call to .LSET JRST LOAD4 ;process next field parsed ;----------------------------------------------------------------------------- ; server for the FORMFEED keyword .LFFED: PARSE (,<.CMKEY,,FFETAB>) CALLRET XKEYW ;expand abbreviated keyword ;----------------------------------------------------------------------------- ; server for the LRECL keyword .LRECL: PARSE (,<.CMKEY,,$V,,,,FNUM>) RET SUBTTL Servers for CREATE command ;============================================================================= .CREAT: NOISE2 (unbu,ndled data set) MOVEI T2,CRETAB CALL CLRFLA ;clear all the CM%NOR flags in table CREAT3: PARSE (,<.CMKEY,,CRETAB,,,,CONFRM>) CREAT4: CALL HNDLER ;call the handler to handle command JRST DBEX ;do DBEXEC when CONFRM parsed JRST CREAT3 ;loop back to parse some more ;----------------------------------------------------------------------------- ; server for the SET keyword .CSET: CALL PDMSNZ ;parse a data set descriptor TRNA ;next field of command was parsed RET ;return to caller ADJSP P,-1 ;remove call to .CSET JRST CREAT4 ;process next field parsed SUBTTL Servers for DUMP command ;============================================================================= .DUMP: NOISE2 (sele,ction group to) MOVEI T2,DMPTAB CALL CLRFLA ;clear all the CM%NOR flags in table PARSE (,,FDUM) CALL HNDLER ;call the handler to handle command ERR (?,,PC,DIE) ;CONFRM was parsed DUMP3: PARSE (,,FDUMC) DUMP4: CALL HNDLER ;call the handler to handle command JRST DBEX ;do DBEXEC when CONFRM parsed JRST DUMP3 ;loop back to parse some more ;----------------------------------------------------------------------------- ; server for the SET keyword .DSET: MOVEI T2,$DUNBU ;remove UNBUNDLED keyword from table CALL SETFLG HRLZI T3,FDUMC ;setup next FDB to parse CALL PDMSNZ ;parse a data set descriptor TRNA ;next field of command was parsed RET ;return to caller ADJSP P,-1 ;remove call to .DSET JRST DUMP4 ;process next field parsed ;----------------------------------------------------------------------------- ; server for the SORTED keyword .DSORT: HRRI T4,FSRTC ;build next FDB chain HRRM T4,BYFDB CALLRET SBY5 ;enter common code for SORT command SUBTTL Servers for TRANSACT command ;============================================================================= .TRANS: MOVEI T2,TRA2TB CALL CLRFLA ;clear all the CM%NOR flags in table PARSE (,<.CMKEY,,TRA1TB>) CALL XKEYW ;expand abbreviated keyword HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to it JRST TRANS3 ;next field of command was parsed TRANS2: PARSE (,,FTRA2) TLZ T3,-1 ;get function descriptor block parsed TRANS3: CALL XKEYW ;expand abbreviated keyword CALL SETFLG ;say keyword was parsed HRRZ T4,(T2) ;get address of command server JRST (T4) ;dispatch to it ;----------------------------------------------------------------------------- ; server for the SORTED keyword .TSORT: PARSE (,<.CMKEY,,$SYNC,,,,FTRA2>) TLZ T3,-1 ;get function descriptor block parsed CAIN T3,FTRA2 ;was SYNC parsed JRST TRANS3 ;no, go process next keyword CALL XKEYW ;yes, expand abbreviated keyword MOVEI Q1,[FLDBK. (.CMKEY,,TRA3TB,,,,FTRA2)] CALL TPRS ;parse the field JRST TRANS3 ;go process next keyword ;----------------------------------------------------------------------------- ; server for the DATA keyword .TDATA: CALL PDMI ;parse file specs of DMI file PARSE (,<.CMKEY,,$DESC,,,,FTRA2>) TLZ T3,-1 ;get function descriptor block parsed CAIN T3,FTRA2 ;parsed a transaction keyword? RET ;yes CALL XKEYW ;expand abbreviated keyword AOS (P) ;set +2 return CALLRET PDMD ;parse filespecs for DMD ;----------------------------------------------------------------------------- ; server for the SET keyword .TSET: HRLZI T3,FTRA2 ;next FDB to use if required CALLRET PDSD ;parse a data set descriptor ;----------------------------------------------------------------------------- ; server for the LOCATOR keyword .TLOCA: HLRZ T2,TRA6TB ;get # keywords in table MOVEM T2,TRA6TC ;save it MOVEI T2,TRA6TB CALL CLRFLA ;clear all the CM%NOR flags in table MOVEI T2,TRA8TB CALL CLRFLA ;clear all the CM%NOR flags in table HLRZ T4,$TSORT ;get address of keyword flags MOVE T4,(T4) ;get flag word for SORT keyword MOVEI Q1,FATR ;initialize Q1 TXNN T4,CM%NOR ;was SORT parsed previously? MOVEI Q1,FKATR ;no, parse a keyed attribute TLOCA1: MOVE T2,Q1 ;get address of FDB to use CALL DOCMD## ;parse a attribute name PARSE (,<.CMCMA,,,,,,FTRA8>) TLZ T3,-1 ;get function descriptor block parsed CAIE T3,CONFRM ;user confirmed command? CAIN T3,FTRA8 ;parsed a comma? JRST TLOCA5 ;no, process next field parsed JRST TLOCA1 ;yes, get another attribute name TLOCA4: PARSE (,,FTRA8) TLZ T3,-1 ;get function descriptor block parsed TLOCA5: CAIN T3,CONFRM ;user confirmed command? JRST TLOCA7 ;yes CALL XKEYW ;expand abbreviated keyword CALL SETFLG ;say keyword was parsed HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to it JRST TLOCA4 ;loop back to parse some more keywords TLOCA7: CALL DOECHO## ;parsed confirm - echo if necessary JRST DBEX ;do DBEXEC ;----------------------------------------------------------------------------- ; server for the APPLIED keyword .TAPPL: MOVEI Q1,[FLDBK. (.CMKEY,,TRA3TB,,,,[FLDBK. (.CMKEY,,TRA5TB)])] CALLRET TPRS ;parse the field ;----------------------------------------------------------------------------- ; server for the UNAPPLIED keyword .TUNAP: MOVEI Q1,[FLDBK. (.CMKEY,,TRA3TB,,,,[FLDBK. (.CMKEY,,TRA4TB)])] CALLRET TPRS ;parse the field ;----------------------------------------------------------------------------- ; server for the DUPLICATES keyword .TDUPL: MOVEM T2,Q1 ;save address of DUPLICATES keyword PARSE (,<.CMKEY,,TRA6TB>) CALL XKEYW ;expand abbreviated keyword CALL SETFLG ;say keyword was parsed MOVE T2,Q1 ;get address of DUPLICATES keyword SOSLE TRA6TC ;nothing left in TRA6TB to parse? CALL CLRFLG ;no, allow DUPLICATES to be parsed again MOVEI Q1,[FLDBK. (.CMKEY,,TRA3TB,,,,[FLDBK. (.CMKEY,,TRA7TB)])] CALLRET TPRS ;parse the field ;----------------------------------------------------------------------------- ;Routine to parse MESSAGE, TTYMSG or another keyword ;ACCEPTS: Q1 - address of function descriptor block ;RETURNS: +1 always TPRS: MOVEI T2,TRA3TB CALL CLRFLA ;clear all the CM%NOR flags in table TPRS2: MOVE T2,Q1 ;get address of FDB to use CALL DOCMD## ;parse a field CALL XKEYW ;expand abbreviated keyword HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to it RET ;done CALL SETFLG ;say keyword was parsed JRST TPRS2 ;loop back for more ;----------------------------------------------------------------------------- ; server for the NOCHANGE keyword .TNOCH: NOISE2 (mast,er if tranaction field is) PARSE (,<.CMKEY,,$BLANKS,,>) RET SUBTTL Servers for COLLECT command ;============================================================================= .COLLE: NOISE2 (data, sets) TXO F,F%INI ;just do initialization CALL PDMSN ;init for parsing existing data set PARSE (,<.CMKEY,,$ALL,,,,FDSD>) HLRZM T3,T4 TLZ T3,-1 ;get function descriptor block parsed CAMN T3,T4 ;was "ALL" parsed CALL CKABRV ;yes, was keyword abbreviated? IFSKP. ;yes, assume its a data set descriptor NOISE2 (open, data sets) HRRI T4,FCOL ;build next FDB chain HRRM T4,ASFDB HRLZI T3,ASFDB ;next FDB to use if required PARSE (,,ASFDB) TLZ T3,-1 ;get function descriptor block parsed CAIE T3,FCOL ;parsed a collection name? JRST COLLE6 ;no, parsed "AS" JRST COLLE7 ;yes ENDIF. HRRI Q1,FDSD ;build next FDB chain HRRM Q1,ASFDB CAME T3,T4 ;was abbreviation of "ALL" parsed IFSKP. ;no CALL RCMBLK ;yes, have it reparsed as DSD HRLZI T3,ASFDB ;next FDB to use if required CALL PDSD ;parse a data set descriptor JRST COLLE3 ;next field of command was parsed ELSE. HRLZI T4,ASFDB ;next FDB to use if required CALL PDSD2 ;continue parsing a data set descriptor JRST COLLE3 ;next field of command was parsed ENDIF. COLLE2: SETZM GTJBLK+.GJNAM ;no default file name for next DSD DMOVE P3,CMDBLK+.CMPTR ;get data for possible reparse PARSE (,,ASFDB) TLZ T3,-1 ;get function descriptor block parsed COLLE3: SETZM GTJBLK+.GJNAM ;no default file name for next DSD CAIN T3,ASFDB ;was "AS" parsed? JRST COLLE6 ;yes CALL PDSD2 ;continue parsing a data set descriptor JRST COLLE3 ;next field of command was parsed JRST COLLE2 ;loop back to parse another DSD COLLE6: PARSE (,,FCOL) ;parse collection name COLLE7: PARSE (,<.CMKEY,,$ADD,,,,CONFRM>) TLZ T3,-1 ;get function descriptor block parsed CAIN T3,CONFRM ;user confirmed command? JRST COLLE8 ;yes NOISE2 (to d,ata set) HRLZI T3,CONFRM ;next FDB to use if required CALL PDSD ;parse a data set descriptor JRST COLLE8 ;next field of command was parsed CONFIRM TRNA COLLE8: CALL DOECHO## ;parsed confirm - echo if necessary JRST DBEX ;do DBEXEC SUBTTL Servers for JOIN command ;============================================================================= .JOIN: NOISE2 (data, sets) HRRI T4,FDSD ;build next FDB chain HRRM T4,TOFDB HRLZI T3,TOFDB ;next FDB to use if required CALL PDSD ;parse a data set descriptor JRST JOIN2 ;next field of command was parsed DMOVE P3,CMDBLK+.CMPTR ;get data for possible reparse PARSE (,,TOFDB) TLZ T3,-1 ;get function discriptor block parsed JOIN2: HRRI T4,FATR ;build next FDB chain HRRM T4,VIAFDB CAIE T3,TOFDB ;parsed "TO" ? IFSKP. ;no, parsed next DSD HRLZI T3,VIAFDB ;next FDB to use if required CALL PDSD ;parse a data set descriptor JRST JOIN3 ;next field of command was parsed ELSE. HRLZI T4,VIAFDB ;next FDB to use if required CALL PDSD2 ;continue parsing a data set descriptor JRST JOIN3 ;next field of command was parsed ENDIF. PARSE (,,VIAFDB) ;parse an attribute name TLZ T3,-1 ;get function discriptor block parsed JOIN3: CAIE T3,VIAFDB ;parsed "VIA" ? IFSKP. ;no parsed an attribute name PARSE (,,FATR) ;parse an attribute name ENDIF. MOVEI T2,JOITAB ;address of keyword table CALL CLRFLA ;clear all the CM%NOR flags in table PARSE (,,FJOIK) MOVEM T2,Q1 ;save register MOVEI T2,$JTO ;address of "TO" keyword CALL SETFLG ;say keyword parsed MOVE T2,Q1 ;restore register TLZ T3,-1 ;get function discriptor block parsed CAIN T3,FKATRC ;parsed attribute name? JRST JOIN5 ;yes CAIN T3,FJOIK ;parsed a keyword from JOITAB ? CALL CKABRV ;yes, was keyword abbreviated? JRST JOIN5 ;yes, assume it was a attribute name JRST JOIN6 ;call handler JOIN5: PARSE (,<.CMKEY,,JOITAB,,,,CONFRM>) JOIN6: CALL HNDLER ;call the handler to handle command JRST DBEX ;do DBEXEC when CONFRM parsed JRST JOIN5 ;loop back to parse some more ;----------------------------------------------------------------------------- ; server for the TO keyword .JTO: PARSE (,,FKATR) RET ;----------------------------------------------------------------------------- ; server for the AS keyword .JAS: PARSE (,<.CMFLD,CM%SDH,,,,BKDSN>) RET SUBTTL Servers for ENABLE, DISABLE commands ;============================================================================= .ENABL: SPTR T4, TRNA .DISAB: SPTR T4, MOVEM T4,CONFM+.CMHLP PARSE (,<.CMKEY,,$JOIN,,>) CALL XKEYW ;expand abbreviated keyword MOVEI T4,.EDJ ;address of handler routine JRST EDJOIN ;join common code SUBTTL Servers for CLEAR command ;============================================================================= .CLEAR: SPTR T4, MOVEM T4,CONFM+.CMHLP PARSE (,<.CMKEY,,CLRTAB,,,,CONFM>) TLZ T3,-1 ;get function discriptor block parsed CAIN T3,CONFM ;user confirmed command? JRST CLEAR8 ;yes CALL XKEYW ;expand abbreviated keyword HRRZ T4,(T2) ;get address of command server EDJOIN: CALL (T4) ;dispatch to it JRST CLEAR8 ;user confirmed command CONFIRM TRNA CLEAR8: CALL DOECHO## ;echo if necessary JRST DBEX ;do DBEXEC ;----------------------------------------------------------------------------- ; server for the COLLECT keyword .CLRC: SPTR T4, MOVEM T4,CONFM+.CMHLP PARSE (,<.CMFLD,CM%SDH,,,,BKDSN,CONFM>) TLZ T3,-1 ;get function discriptor block parsed CAIN T3,CONFM ;user confirmed command? RET ;yes HRROI T4,[0] MOVEM T4,CONFM+.CMHLP ;clear help text PARSE (,<.CMFLD,CM%SDH,,,,BKEOL,CONFM>) RET.2 ;----------------------------------------------------------------------------- ; server for the JOIN keyword .CLRJ: SPTR T4, MOVEM T4,CONFM+.CMHLP .EDJ: PARSE (,<.CMFLD,CM%SDH,,,,BKDSN,CONFM>) TLZ T3,-1 ;get function discriptor block parsed CAIN T3,CONFM ;user confirmed command? RET ;yes HRROI T4,[0] MOVEM T4,CONFM+.CMHLP ;clear help text PARSE (,<.CMFLD,CM%SDH,,,,BKEOL,CONFM>) RET.2 SUBTTL Servers for ACCEPT command ;============================================================================= .ACCEP: NOISE2 (valu,e for variable) PARSE (,<.CMFLD,CM%SDH,,,,BKEOL>) CONFIRM JRST DBEX ;do DBEXEC SUBTTL Servers for USE, @, and @= command ;============================================================================= .AT: MOVE T4,FEQV+.CMFNP ;get flag word TXO T4,CM%DPP ;say there is a default file specs SKIPE USSPEC ;do default file specs exist? MOVEM T4,FEQV+.CMFNP ;yes, save updated flag word MOVEI T2,FEQV ;use this FDB JRST USE3 ;join common code .USE: NOISE2 (comm,and file) MOVEI T2,USFDB ;use this FDB ;NOTE: When trying to parse a DMC file spec if there is no file of the type ; ___.DMC. then I will look for file with no extension (___..) USE3: CALL MOVP22 ;move parsed bytes from CMDBUF to CMDB22 MOVE Q1,CMDBLK+.CMPTR ;save ptr incase user enters file spec TXNE T1,CM%ESC ;previous field terminated with escape? ILDB T4,Q1 ;yes, adjust byte pointer SPTR T4, MOVEM T4,CONFM+.CMHLP MOVX T4,GJ%OLD ;parse existing file MOVEM T4,GTJBLK+.GJGEN SPTR T4, MOVEM T4,GTJBLK+.GJEXT ;set default file extension TXO F,F%RNOP ;have DOCMD return on CM%NOP PARSE TXNN T1,CM%NOP ;parsed OK? IFSKP. ;yes SETZM GTJBLK+.GJEXT ;look for file ___.. instead of ___.DMC. HLRZ T2,T3 ;get address of FDB for reparse PARSE ;reparse ENDIF. TLZ T3,-1 ;get function descriptor block parsed CAIE T3,FEQV ;was "=" parsed IFSKP. ;no, parsed file specs for DMC PARSE (,,FVAR) ;yes, parse a variable name CONFIRM JRST DBEX ENDIF. CAIN T3,CONFM ;user confirmed command? JRST [CALL DOECHO## ;yes, must be no previous file specs TMSGL <% No previous file to use > JRST ENDCMD] ;abort MOVEM T2,TMPJFN ;save JFN MOVE Q2,CMDBLK+.CMPTR ;save ptr to end of file specs CONFIRM CAME Q1,Q2 ;user want use saved file spec? IFSKP. ;no, must have typed in a file spec MOVEI T4," " ;separate "USE" from the file specs... IDPB T4,P2 ; ...since user entered "USE" MOVE T3,[POINT 7,USSPEC] ;ptr to save USE file spec CALL MOVBT3 ;move file specs to CMDB22 MOVE P1,Q2 ;update ptr to CMDBUF TMSGL <[Using > ;tell user what file I'll use FILSTR (TMPJFN) ;output file specs TMSG <] > ELSE. ; save the file spec the user entered FILSTR (TMPJFN,,USSPEC) MOVE T4,USFDB+.CMFNP ;get flag word TXON T4,CM%DPP ;say there is a default file specs MOVEM T4,USFDB+.CMFNP ;save updated flag word ENDIF. CALL RJFN ;release JFN in T2 SETZM TMPJFN ;say JFN released JRST DBEX SUBTTL Server for #COM command ;============================================================================= .COM: NOISE2 (comm,ent) PARSE (,<.CMFLD,CM%SDH,,,,BKEOL>) JRST TYADD. ;join common code SUBTTL Server for #TYPE command ;============================================================================= .TTYPE: NOISE2 (mess,age) PARSE (,<.CMFLD,CM%SDH,,,,BKEOL>) ; both #COM and #TYPE require command ends with a "." so insure this happens TYADD.: CALL ADD. ;ensure "." and end of command CONFIRM JRST DBEX ;do DBEXEC SUBTTL Servers for #Z command ;============================================================================= .ABORT: NOISE2 (mult,i-line command abort) CONFIRM JRST DBEX ;do DBEXEC SUBTTL Servers for #T (TRACE) command ;============================================================================= .TRACE: NOISE2 (trac,e) PARSE (,<.CMKEY,,$USE,,,,CONFRM>) TLZ T3,-1 ;get function discriptor block parsed CAIN T3,CONFRM ;user confirmed command? JRST TRACE8 ;yes CALL XKEYW ;expand abbreviated keyword JRST .USE ;parse USE command CONFIRM TRACE8: CALL DOECHO## ;echo if necessary JRST ENDCMD ;#T does nothing unless followed by... ; ...a USE command SUBTTL Servers for OPTIMIZE command ;============================================================================= .OPTIM: NOISE2 (key ,table) MOVEI T2,OPTTAB ;address of keyword table CALL CLRFLA ;clear all the CM%NOR flags in table OPTMI2: PARSE (,<.CMKEY,,OPTTAB,,,,FATR>) TXON F,F%INI ;first time through loop? CALL OPTINI ;yes, do initialization TLZ T3,-1 ;get function discriptor block parsed CAIE T3,FATR ;parsed an attribute name? CALL CKABRV ;no, was keyword abbreviated? TRNA ;yes, assume its an attribute name JRST OPTMI6 ;no, process keyword ; gets here when I've parsed an attribute-name. If a null name was parsed ; (.CMFLD will parse a null field) then user is trying to confirm command MOVE T2,CMDBLK+.CMABP ;get ptr to ATMBUF ILDB T2,T2 ;get 1st byte of string parsed JUMPN T2,OPTMI2 ;jump if NOT null field parsed OPTMI5: CONFIRM JRST DBEX ;do DBEXEC OPTMI6: CALL SETFLG ;say keyword parsed HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to it JRST OPTMI2 ;loop back to parse some more JRST OPTMI5 ;go confirm command ;----------------------------------------------------------------------------- ;Routine to initialize for OPTIMIZE OPTINI: DMOVEM T2,Q1 ;save registers MOVEI T2,$ONMSG ;"NOMSG" keyword is only allowed... CALL SETFLG ; ...as first keyword parsed DMOVE T2,Q1 ;restore registers RET SUBTTL Servers for UNKEY command ;============================================================================= .UNKEY: NOISE2 (attr,ibutes) UNKEY2: PARSE (,<.CMKEY,,UKYTAB,,,,FATR>) TLZ T3,-1 ;get function discriptor block parsed CAIE T3,FATR ;parsed an attribute name? CALL CKABRV ;no, was keyword abbreviated? TRNA ;yes, assume its an attribute name JRST UNKEY6 ;no, process keyword ; gets here when I've parsed an attribute-name. If a null name was parsed ; (.CMFLD will parse a null field) then user is trying to confirm command MOVE T2,CMDBLK+.CMABP ;get ptr to ATMBUF ILDB T2,T2 ;get 1st byte of string parsed JUMPN T2,UNKEY2 ;jump if NOT null field parsed UNKEY5: CONFIRM JRST DBEX ;do DBEXEC UNKEY6: HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to it JRST UNKEY2 ;loop back to parse some more JRST UNKEY5 ;go confirm command SUBTTL Servers for KEY command ;============================================================================= .KEY: NOISE2 (attr,ibutes) MOVEI T2,KEYTAB ;address of keyword table CALL CLRFLA ;clear all the CM%NOR flags in table PARSE (,<.CMKEY,,KEYTAB,,,BKKEY$,FATR>) TLZ T3,-1 ;get function discriptor block parsed CAIN T3,FATR ;parsed an attribute name? IFSKP. ;yes HLRZ CX,(T2) ;get address of keyword flags MOVE CX,(CX) ;get keyword flags TXNE CX,K%FL3 ;a "$____" keyword? JRST .K$CSV ;yes ENDIF. ; since I didn't parse the "$____" keywords I must set flags to prevent ; the user from parsing them DMOVEM T2,Q1 ;save registers MOVEI T2,KEYTAB ;address of keyword table MOVX CX,K%FL3 ;set only keywords with this flag CALL SETFLX DMOVE T2,Q1 ;restore registers JRST KEY3 KEY2: PARSE (,<.CMKEY,,KEYTAB,,,,FATR>) TLZ T3,-1 ;get function discriptor block parsed KEY3: CAIE T3,FATR ;parsed an attribute name? CALL CKABRV ;no, was keyword abbreviated? TRNA ;yes, assume its an attribute name JRST KEY6 ;no, process keyword ; gets here when I've parsed an attribute-name. If a null name was parsed ; (.CMFLD will parse a null field) then user is trying to confirm command MOVE T2,CMDBLK+.CMABP ;get ptr to ATMBUF ILDB T2,T2 ;get 1st byte of string parsed JUMPE T2,KEY8 ;jump if null field parsed MOVEI T2,KEYTAB ;address of keyword table MOVX CX,K%FL1 ;clear only keywords with this flag CALL CLRFLX ;clear all the CM%NOR flags in table TXNN F,F%INI ;If looking for keywords before... CALL KEYINI ; ... then do CALL JRST KEY2 ;loop back to parse some more ; gets here only when an unabbreviated keyword was parsed. If the keyword ; was abbreviated then I assumed it was an attribute name - like 1022 does KEY6: TXNN F,F%INI ;If looking for keywords before... CALL KEYINI ; ... then do CALL CALL SETFLG ;say keyword parsed HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to handler JRST KEY2 ;loop back to parse some more ; gets here when a null attribute-name is parsed. Since I know the only thing ; after the FDB for FATR is the CONFRM FDB user is trying to confirm command KEY8: CONFIRM JRST DBEX ;do DBEXEC ;----------------------------------------------------------------------------- ;Routine to check for those keyword in the KEY command that come before the ;. Once an attribute or a keyword in the ;is found I must set flags in KEYTAB so I no longer try to parse those initial ;keywords ;ACCEPTS: T2 - pointer to keyword parsed KEYINI: HLRZ CX,(T2) ;get address of keyword flags MOVE CX,(CX) ;get keyword flags TXNE CX,K%FL2 ;keyword for ? RET ;no, don't do anything special PUSH P,T2 ;yes, so make sure those keywords... CALL KEYIN7 ; ...that should only come before... POP P,T2 ; ...the are NOT... RET ; ...parsed again KEYIN7: TXO F,F%INI ;say starting MOVEI T2,KEYTAB ;address of keyword table MOVX CX,K%FL2 ;set only keywords with this flag CALLRET SETFLX ;----------------------------------------------------------------------------- ; server for the USING keyword .KUSIN: PARSE (,<.CMFLD,,,>) RET ;----------------------------------------------------------------------------- ; server for the $CHECKSUM, $SCAN, $VERIFY keywords .K$CSV: CALL XKEYW ;expand abbreviated keyword K$CSV1: PARSE (,<.CMKEY,,$ALL,,,,FATR>) TLZ T3,-1 ;get function discriptor block parsed CAIE T3,FATR ;parsed an attribute name? CALL CKABRV ;no, was keyword "ALL" abbreviated? TRNA ;yes, assume its an attribute name IFSKP. ;no, go confirm command ; gets here when I've parsed an attribute-name. If a null name was parsed ; (.CMFLD will parse a null field) then user is trying to confirm command MOVE T2,CMDBLK+.CMABP ;get ptr to ATMBUF ILDB T2,T2 ;get 1st byte of string parsed JUMPN T2,K$CSV1 ;jump if NOT a null field parsed ENDIF. CONFIRM JRST DBEX ;do DBEXEC SUBTTL Servers for ADMIT command ;============================================================================= .ADMIT: PARSE (,<.CMKEY,,ADM1TB,,,,[FLDBK. (.CMDIR,CM%SDH,CM%DWC,<>)]>) HLRZM T3,T4 TLZ T3,-1 ;get function descriptor block parsed CAMN T3,T4 ;was user-id parsed IFSKP. ;no MOVEI T4,.ADUSR ;yes, call this command server ELSE. CALL XKEYW ;expand abbreviated keyword HRRZ T4,(T2) ;get address of command server ENDIF. JRST (T4) ;dispatch to it ADMIT7: CONFIRM TRNA ADMIT8: CALL DOECHO## ;echo if necessary JRST DBEX ;do DBEXEC ;----------------------------------------------------------------------------- ; server for the PASSWORD keyword .APASS: PARSE (,<.CMFLD,CM%SDH,,,,BKPAS>) RET ;----------------------------------------------------------------------------- ; server for the ADMIT CLASS command .ADCLS: PARSE (,<.CMKEY,,$PASSWORD,,>) CALL XKEYW ;expand abbreviated keyword CALL .APASS ;get password PARSE (,<.CMKEY,,ADM2TB,,,,FFORC>) TLZ T3,-1 ;get function descriptor block parsed CAIN T3,CONFRM ;user confirmed command? JRST ADMIT8 ;yes CALL XKEYW ;expand abbreviated keyword CAIN T3,FFORC ;was "FOR" parsed? JRST ADFOR3 ;yes JRST ADFOR ;----------------------------------------------------------------------------- ; server for the ADMIT command .ADUSR: PARSE (,<.CMKEY,,ADM2TB,,,,[ FLDBK. (.CMKEY,,ADM3TB,,,,CONFRM)]>) TLZ T3,-1 ;get function descriptor block parsed CAIN T3,CONFRM ;user confirmed command? JRST ADMIT8 ;yes CALL XKEYW ;expand abbreviated keyword HRRZ T4,(T2) ;get address of command server JUMPE T4,ADUSR3 ;jump if access-code parsed JRST (T4) ;dispatch to command server ADUSR3: PARSE (,,FAP4C) TLZ T3,-1 ;get function descriptor block parsed CAIN T3,CONFRM ;user confirmed command? JRST ADMIT8 ;yes CALL XKEYW ;expand abbreviated keyword JRST ADFOR7 ;enter common code ;----------------------------------------------------------------------------- ;Routine to parse the ADMIT FOR clause ADFOR: PARSE (,,FFORC) TLZ T3,-1 ;get function descriptor block parsed CAIN T3,CONFRM ;user confirmed command? JRST ADMIT8 ;yes ADFOR3: PARSE (,,FATR) ;parse an attribute name PARSE (,<.CMKEY,,ADM2TB,,,,FAP4C>) ADFOR5: TLZ T3,-1 ;get function descriptor block parsed CAIN T3,CONFRM ;user confirmed command? JRST ADMIT8 ;yes CALL XKEYW ;expand abbreviated keyword CAIN T3,FAP4C ;was PASSWORD or FOR entered? IFSKP. ;yes PARSE (,,FAP4C) ;no, parse it now JRST ADFOR5 ;process it ENDIF. ADFOR7: HRRZ T4,(T2) ;get address of command server JUMPE T4,ADFOR3 ;jump if "FOR" parsed ADFOR8: CALL .APASS ;get password JRST ADFOR ;loop back for another FOR clause SUBTTL Servers for PERMIT command ;============================================================================= .PERMI: NOISE2 (acce,ss to attribute) PERMI1: PARSE (,,FATR) ;parse an attribute name PARSE (,<.CMKEY,,PERMTB,,,,FFORC>) TLZ T3,-1 ;get function descriptor block parsed CAIN T3,CONFRM ;user confirmed command? JRST PERMI8 ;yes CALL XKEYW ;expand abbreviated keyword CAIN T3,FFORC ;was FOR entered? JRST PERMI1 ;yes HRRZ T4,(T2) ;get address of command server JUMPE T4,PERMI5 ;jump if "ACCESS" was parsed CALL .APASS ;get password PARSE (,<.CMKEY,,$ACCESS,,,,FFORC>) TLZ T3,-1 ;get function descriptor block parsed CAIN T3,CONFRM ;user confirmed command? JRST PERMI8 ;yes CALL XKEYW ;expand abbreviated keyword CAIN T3,FFORC ;was FOR entered? JRST PERMI1 ;yes PERMI5: PARSE (,<.CMKEY,,$READONLY,,>) PARSE (,,FFORC) TLZ T3,-1 ;get function descriptor block parsed CAIN T3,CONFRM ;user confirmed command? JRST PERMI8 ;yes CALL XKEYW ;expand abbreviated keyword JRST PERMI1 ;loop back for another round PERMI8: CALL DOECHO## ;echo if necessary JRST DBEX ;do DBEXEC SUBTTL Servers for ADD command ;============================================================================= .ADD: NOISE2 (new ,record to data set) SPTR T4, MOVEM T4,CONFM+.CMHLP PARSE (,<.CMFLD,CM%SDH,, ... or NUL>,,BKEOL,CONFM>) CONFIRM MOVEI T1,MORADD ;call this routine to get more data JRST DBEXM ;do DBEXEC SUBTTL Servers for ALLOCATE command ;============================================================================= .ALLOC: NOISE2 (room, to data set) CALL PNUM ;parse a number CONFIRM JRST DBEX ;do DBEXEC SUBTTL Servers for USERCALL command ;============================================================================= .USERC: NOISE2 (MACR,O routine) PARSE (,<.CMFLD,CM%SDH,,,,BKEOL>) CONFIRM JRST DBEX ;do DBEXEC SUBTTL Servers for IF command ;============================================================================= .IF: NOISE2 (cond,ition) PARSE (,<.CMFLD,CM%SDH,,< THEN ELSEIF THEN ELSE ENDIF or END>,,BKEOL>) CONFIRM JRST DBEX ;do DBEXEC SUBTTL Servers for ELSEIF command ;============================================================================= .ELSEI: NOISE2 (cond,ition) PARSE (,<.CMFLD,CM%SDH,,< THEN ELSE ENDIF or END>,,BKEOL>) CONFIRM JRST DBEX ;do DBEXEC SUBTTL Servers for ELSE command ;============================================================================= .ELSE: PARSE (,<.CMFLD,CM%SDH,,< ENDIF or END>,,BKEOL>) CONFIRM JRST DBEX ;do DBEXEC SUBTTL Servers for UNTIL command ;============================================================================= .UNTIL: NOISE2 (cond,ition) PARSE (,<.CMFLD,CM%SDH,,<>,,BKEOL>) CONFIRM JRST DBEX ;do DBEXEC SUBTTL Servers for WHILE command ;============================================================================= .WHILE: NOISE2 (cond,ition) PARSE (,<.CMFLD,CM%SDH,,< DO ENDWHILE or END>,,BKEOL>) CONFIRM JRST DBEX ;do DBEXEC SUBTTL Servers for REPEAT command ;============================================================================= .REPEA: PARSE (,<.CMFLD,CM%SDH,,< UNTIL >,,BKEOL>) CONFIRM JRST DBEX ;do DBEXEC SUBTTL Servers for END, ENDIF, ENDWHILE commands ;============================================================================= .END: NOISE2 (IF o,r WHILE statement) .ENDIF: .ENDWH: CONFIRM JRST DBEX ;do DBEXEC SUBTTL Servers for unimplimented commands ;============================================================================= .UNIMP: PARSE (,<.CMFLD,CM%SDH,,,,BKEOL>) CONFIRM JRST DBEX ;do DBEXEC SUBTTL Servers for AUDIT command ;============================================================================= .AUDIT: PARSE (,<.CMKEY,,AUDTAB>) CALL XKEYW ;expand abbreviated keyword JRST .UNIMP ;rest of AUDIT command not implimented ; HRRZ T4,(T2) ;get address of command server ; CALL (T4) ;dispatch to it ; CONFIRM ; JRST DBEX ;do DBEXEC SUBTTL Servers for EDIT command ;============================================================================= .EDIT: NOISE2 (file,) CALL MOVP22 ;move parsed bytes from CMDBUF to CMDB22 MOVE Q1,CMDBLK+.CMPTR ;save ptr to start of file specs TXNE T1,CM%ESC ;previous field terminated with escape? ILDB T4,Q1 ;yes, adjust byte pointer SPTR T4, MOVEM T4,CONFM+.CMHLP MOVX T4,GJ%OLD!GJ%MSG ;try to parse existing file first MOVEM T4,GTJBLK+.GJGEN TXO F,F%RNOP ;have DOCMD return on CM%NOP PARSE (,,EDFDB) TXNN T1,CM%NOP ;parsed OK? IFSKP. ;yes MOVX T4,GJ%MSG ;file doesn't exist so parse new one MOVEM T4,GTJBLK+.GJGEN PARSE (,,EDFDB) ;reparse ENDIF. TLZ T3,-1 ;get function descriptor block parsed CAIE T3,CONFM ;user confirmed command? IFSKP. ;no, got file specs to use CALL DOECHO## ;echo if necessary TMSGL <% No previous file to use > JRST EDIT9 ;go do EDIT ENDIF. ; program gets here if user enters a file to EDIT or if he just hits ; and there are some saved file specs to use MOVEM T2,TMPJFN ;save JFN MOVE Q2,CMDBLK+.CMPTR ;save ptr to end of file specs CONFIRM CAME Q1,Q2 ;user want use saved file spec? IFSKP. ;no, must have typed in a file spec MOVEI T4," " ;separate "EDIT" from the file specs... IDPB T4,P2 ; ...since user entered "EDIT" MOVE T3,[POINT 7,EDSPEC] ;ptr to save EDIT file spec CALL MOVBT3 ;move file specs to CMDB22 MOVE P1,Q2 ;update ptr to CMDBUF TMSGL <[Editing > ;tell user what file I'll edit FILSTR (TMPJFN) ;output file specs TMSG <] > ELSE. ; save the file spec the user entered FILSTR (TMPJFN,,EDSPEC) MOVE T4,EDFDB+.CMFNP ;get flag word TXON T4,CM%DPP ;say there is a default file specs MOVEM T4,EDFDB+.CMFNP ;save updated flag word ENDIF. CALL RJFN ;release JFN in T2 SETZM TMPJFN ;say JFN released EDIT9: CALL DBEXR ; must reset the system and private name of this program because the editor ; sets it and does not reset it again SETNAM (2022,2022) ;set private & system names of program JRST ENDCMD SUBTTL Servers for FILE command ;============================================================================= .FILE: PARSE (,<.CMKEY,,FILTAB>) CALL XKEYW ;expand abbreviated keyword HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to it CONFIRM JRST DBEX ;do DBEXEC ;----------------------------------------------------------------------------- ; server for the COPY keyword .FCOPY: CALL .FRENA ;get files to copy PARSE (,<.CMKEY,,$BUFFERS,,,,CONFRM>) TLZ T3,-1 ;get function descriptor block parsed CAIE T3,CONFRM ;user confirmed command? IFSKP. ;no AOS (P) ;set +2 return RET ENDIF. CALL XKEYW ;expand abbreviated keyword CALLRET PNUM ;go parse a number ;----------------------------------------------------------------------------- ; server for the RENAME keyword .FRENA: PARSE (,<.CMIFI>) HRROI T1,FSPEC MOVEM T1,GTJBLK+.GJNAM ;save ptr to default file name TLZ T2,-1 ;remove any flags from JFN FILSTR (-,,-) IBP T1 ;presve null at end MOVEM T1,GTJBLK+.GJEXT ;save ptr to default file type FILSTR (-,,-) CALL RJFN ;release JFN MOVEI T1,CMDBLK ;restore T1 NOISE2 (to,) MOVX T4,GJ%FOU ;parse an output file MOVEM T4,GTJBLK+.GJGEN PARSE (,,FFIL) CALLRET RJFN ;release JFN ;----------------------------------------------------------------------------- ; server for the DELETE and TYPE keywords .FTYPD: PARSE (,<.CMIFI>) CALLRET RJFN ;release JFN SUBTTL Servers for INIT command ;============================================================================= .INIT: NOISE2 (outp,ut channel) PARSE (,<.CMKEY,,INITTB,,,,FCHN>) TLZ T3,-1 ;get function discriptor block parsed ; SPTR T4, SPTR T4,<> MOVEM T4,GTJBLK+.GJEXT ;set default file extension MOVX T4,GJ%FOU ;parse output file if FCHN was parsed CAIN T3,FCHN ;was FCHN parsed? JRST INIT5 ;yes CALL XKEYW ;expand abbreviated keyword HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to it INIT5: MOVEM T4,GTJBLK+.GJGEN ; PARSE (,<.CMFIL,,,>) PARSE (,<.CMFIL>) CALL RJFN ;release JFN CONFIRM JRST DBEX ;do DBEXEC ;----------------------------------------------------------------------------- ; server for the APPEND keyword .IAPND: PARSE (,,FCHN) ;parse channel number SETZB T4,GTJBLK+.GJEXT ;set default file extension and... ; SETZ T4, ;...parse highest existing generation RET ;----------------------------------------------------------------------------- ; server for the DIF keyword V117B< .IDIF: MOVEI T2,IDIFTB ;address of keyword table CALL CLRFLA ;clear all the CM%NOR flags in table IDIF1: PARSE (,<.CMKEY,,IDIFTB,,,,FCHN>) TLZ T3,-1 ;get function discriptor block parsed CAIN T3,FCHN ;was FCHN parsed? JRST IDIF5 ;yes CALL XKEYW ;expand abbreviated keyword CALL SETFLG ;say keyword parsed HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to it JRST IDIF1 ;loop back for next keyword IDIF5: SPTR T4, MOVEM T4,GTJBLK+.GJEXT ;set default file extension MOVX T4,GJ%FOU ;parse an output file RET ;----------------------------------------------------------------------------- ; server for the DIF/123 COL keyword .IDCOL: PARSE (,<.CMFLD,CM%SDH,,,>) RET ;----------------------------------------------------------------------------- ; server for the DIF/123 ROW keyword .IDROW: PARSE (,<.CMNUM,CM%SDH,^D10,,<1>>) RET ;----------------------------------------------------------------------------- ; server for the DIF NCOLS keyword .IDNCO: PARSE (,<.CMNUM,CM%SDH,^D10,,<100>>) RET ;----------------------------------------------------------------------------- ; server for the INIT 123 keyword .I123: MOVEI T2,I123TB ;address of keyword table CALL CLRFLA ;clear all the CM%NOR flags in table I1231: PARSE (,<.CMKEY,,I123TB,,,,FCHN>) TLZ T3,-1 ;get function discriptor block parsed CAIN T3,FCHN ;was FCHN parsed? JRST I1235 ;yes CALL XKEYW ;expand abbreviated keyword CALL SETFLG ;say keyword parsed HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to it JRST I1231 ;loop back for next keyword I1235: SPTR T4, MOVEM T4,GTJBLK+.GJEXT ;set default file extension MOVX T4,GJ%FOU ;parse an output file RET ;----------------------------------------------------------------------------- ; server for the 123 NRANGE keyword .I1NRA: CALL CLRFLG ;allow NRANGE to be parsed again PARSE (,<.CMFLD,CM%SDH,,>) PARSE (,<.CMFLD,CM%SDH,,>) PARSE (,<.CMNUM,CM%SDH,^D10,>) PARSE (,<.CMFLD,CM%SDH,,>) PARSE (,<.CMNUM,CM%SDH,^D10,>) RET ;----------------------------------------------------------------------------- ; server for the 123 CWISE keyword .I1CWI: MOVEI T2,$RWISE ;remove RWISE from keyword table CALLRET SETFLG ;----------------------------------------------------------------------------- ; server for the 123 RWISE keyword .I1RWI: MOVEI T2,$CWISE ;remove CWISE from keyword table CALLRET SETFLG >;end of INIT DIF/123 command for 117B SUBTTL Servers for RELEASE command ;============================================================================= .RELEA: NOISE2 (outp,ut channel) SPTR T4, MOVEM T4,CONFM+.CMHLP PARSE (,,FCHNC) TLZ T3,-1 ;get function descriptor block parsed CAIN T3,CONFM ;user confirmed command? JRST RELEA8 ;yes CONFIRM TRNA RELEA8: CALL DOECHO## ;echo if necessary JRST DBEX ;do DBEXEC SUBTTL Servers for SET command ;============================================================================= .SETT: PARSE (,<.CMKEY,,STTAB>) CALL XKEYW ;expand abbreviated keyword HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to it CONFIRM JRST DBEX ;do DBEXEC ;----------------------------------------------------------------------------- ; server for the ERRCHAR keyword .SERCH: NOISE2 (type,d out before all error messages to) PARSE (,<.CMFLD,CM%SDH,,,,BKEOL>) RET ;----------------------------------------------------------------------------- ; server for the ERROR and FILERR keywords .SEROR: NOISE2 (reco,very to) PARSE (,<.CMKEY,,SERTAB>) CALL XKEYW ;expand abbreviated keyword NOISE2 (when, error encounterd) RET ;----------------------------------------------------------------------------- ; server for the FMSG and FERR keywords .SFMER: NOISE2 (to,) PARSE (,<.CMKEY,,SFMTAB,,,,CONFRM>) TLZ T3,-1 ;get function descriptor block parsed CAIE T3,CONFRM ;user confirmed command? IFSKP. ;no AOS (P) ;set +2 return RET ENDIF. CALL XKEYW ;expand abbreviated keyword JRST .SFMER ;get another keyword ;----------------------------------------------------------------------------- ; server for the PROMPT keyword .SPROM: SPTR T4, MOVEM T4,CONFM+.CMHLP PARSE (,<.CMKEY,,SPMTAB,,,,CONFM>) TLZ T3,-1 ;get function descriptor block parsed CAIE T3,CONFM ;user confirmed command? IFSKP. ;no AOS (P) ;set +2 return CALLRET DOECHO## ;echo if necessary ENDIF. CALL XKEYW ;expand abbreviated keyword HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to it JRST .SPROM ;get another keyword ;----------------------------------------------------------------------------- ; server for the PROMPT TEXT keyword .SPTXT: PARSE (,<.CMQST,CM%SDH,,>) RET ;----------------------------------------------------------------------------- ; server for the TAPE keyword .STAPE: HRLZI T3,[FLDBK. (.CMKEY,,SPTTAB)] ;address of FDB for TAPE TXO F,F%NFIL ;don't accept file-specs CALL PONCF ;parse "ON " phrase JRST STAPE5 ;failed, parsed something else instead PARSE (,<.CMKEY,,SPTTAB>) STAPE5: CALLRET XKEYW ;expand keyword parsed ;----------------------------------------------------------------------------- ; server for the SCRATCH keyword V117A< .SSCRA: NOISE2 (buff,er limit to) CALLRET PNUM >;end of V117A SUBTTL Servers for LOCK command ;============================================================================= V117B< .LOCK: PARSE (,<.CMKEY,,LOCKTB>) CALL XKEYW ;expand abbreviated keyword HRRZ Q1,(T2) ;save lock ON/OFF setting PARSE (,<.CMKEY,,LOC2TB>) CALL XKEYW ;expand abbreviated keyword HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to it CONFIRM JRST DBEX ;do DBEXEC ;----------------------------------------------------------------------------- ; server for the USERLOCK keyword FLNAM: FLDBK. (.CMQST,CM%SDH,,<25 character lock name in double (") quotes>) .LUSER: JUMPE Q1,LUSER5 ;jump if LOCK OFF was parsed PARSE (,,FLNAM) ;parse lock name RET LUSER5: PARSE (,<.CMKEY,,$ALL,,,,FLNAM>) RET >;end of LOCK for V117B SUBTTL Servers for HEADING command ;============================================================================= .HEADI: HRLZI T3,FPRNT TXO F,F%NFIL ;don't accept file-specs CALL PONCF ;parse "ON " phrase IFSKP. ;failed, parsed something else instead PARSE (,,FPRNT) ENDIF. CALL XKEYW ;expand keyword parsed JRST PRINT5 ;join up will common code in PRINT SUBTTL Servers for FOOTING command ;============================================================================= FFOOT: FLDBK. (.CMNUM,CM%SDH,^D10,) .FOOTI: HRLZI T3,FFOOT TXO F,F%NFIL ;don't accept file-specs CALL PONCF ;parse "ON " phrase IFSKP. ;failed, parsed something else instead PARSE (,,FFOOT) ENDIF. PARSE (,,FPRNT) CALL XKEYW ;expand keyword parsed JRST PRINT5 ;join up will common code in PRINT SUBTTL Servers for DELETE, UNDELETE commands ;============================================================================= .DELET: .UNDEL: NOISE2 (reco,rds in current selection group from data set) CONFIRM JRST DBEX SUBTTL Servers for IGNORE command ;============================================================================= .IGNOR: PARSE (,<.CMKEY,,$DAMAGE,,>) CALL XKEYW ;expand abbreviated keyword CONFIRM JRST DBEX SUBTTL Servers for REPORT, PL1022 commands ;============================================================================= F%PL==1B1 ;1=PL1022 STARTED F%REP==1B0 ;1=REPORT STARTED .PL102: CALL STAREN ;parse START or END JUMPN T4,PL102S ;jump if START entered SKIPL PLFLAG ;skip if nothing STARTed SOSL PLFLAG ;decrement report level flag JRST DBEX ;still some nested STARTS HRROI T2,TOPCLP ;reset top level command prompt MOVEM T2,CMDBLK+.CMRTY JRST DBEX PL102S: AOSE PLFLAG ;increment report level flag JRST DBEX ;report already started TMSGL < [PL1022 is not fully supported by 2022] > HRROI T2,[ASCIZ/2022(PL)>/] ;set prompt for this command level MOVEM T2,CMDBLK+.CMRTY JRST DBEX ;----------------------------------------------------------------------------- .REPOR: CALL STAREN ;parse START or END JUMPN T4,REPORS ;jump if START entered SKIPL REFLAG ;skip if nothing STARTed SOSL REFLAG ;decrement report level flag JRST DBEX ;still some nested STARTS HRROI T2,TOPCLP ;reset top level command prompt MOVEM T2,CMDBLK+.CMRTY JRST DBEX REPORS: SKIPE REFLAG ;only allowed to START once AOSE REFLAG ;increment report level flag JRST DBEX ;report already started TMSGL < [REPORT is not fully supported by 2022] > HRROI T2,[ASCIZ/2022(R)>/] ;set prompt for this command level MOVEM T2,CMDBLK+.CMRTY JRST DBEX ;----------------------------------------------------------------------------- STAREN: PARSE (,<.CMKEY,,REPTAB>) CALL XKEYW ;expand abbreviated keyword HRRZ T4,(T2) ;get address of command server CONFIRM RET SUBTTL Servers for STARTREC command ;============================================================================= .START: NOISE2 (retu,rn to global mode) CONFIRM JRST DBEX SUBTTL Servers for RELOCATE command ;============================================================================= .RELOC: NOISE2 (unbu,ndled data file) PARSE (,<.CMKEY,,$DATA,,>) CALL XKEYW ;expand abbreviated keyword SETZM GTJBLK+.GJGEN ;use highest existing generation ; MOVX T4,GJ%OFG ;"parse-only" JFN ; MOVEM T4,GTJBLK+.GJGEN SPTR T4, MOVEM T4,GTJBLK+.GJEXT ;set default file extension PARSE (,<.CMFIL,CM%SDH,,>) CALL RJFN ;release the jfn CONFIRM JRST DBEX SUBTTL Servers for SAVE command ;============================================================================= .SAVE: NOISE2 (curr,ent selection group in file) MOVX T4,GJ%FOU ;parse an output file MOVEM T4,GTJBLK+.GJGEN SPTR T4, MOVEM T4,GTJBLK+.GJEXT ;set default file extension PARSE (,,FDMV) CALL RJFN ;release JFN CONFIRM JRST DBEX SUBTTL Servers for RUN command ;============================================================================= .RUN: NOISE2 (prog,am then exit 1022) MOVX T4,GJ%OLD ;parse existing file MOVEM T4,GTJBLK+.GJGEN SPTR T4, MOVEM T4,GTJBLK+.GJEXT ;set default file extension TXO F,F%RNOP ;have DOCMD return on CM%NOP RUN2: PARSE (,<.CMFIL,CM%SDH,,>) TXNN T1,CM%NOP ;parsed the file OK? IFSKP. ;yes ; I didn't find the file on DSK: so now try to find it on SYS:. SPTR T4, MOVEM T4,GTJBLK+.GJDEV ;try looking on SYS: JRST RUN2 ;try again ENDIF. CALL RJFN ;release the jfn CONFIRM JRST DBEX SUBTTL Server for 1022 command ;============================================================================= .R1022: SPTR T4, MOVEM T4,CONFM+.CMHLP MOVE P1,CMDBLK+.CMPTR ;initialize ptrs incase command parsed MOVE P2,[POINT 7,CMDB22] PARSE (,<.CMFLD,CM%SDH,,,,BKEOL,CONFM>) MOVE Q1,CMDBLK+.CMABP ;get ptr to ATMBUF ILDB Q1,Q1 ;get 1st byte of string parsed CONFIRM JUMPN Q1,DBEX ;jump if command line for 1022 TMSG < [type "HOST" to return to 2022] > ; must tell 1022 to display messages in DBEXEC - because I don't get them ; anymore - I think this is a bug in DBEXEC ; NOTE: Now that I set SYSDBEXMSG=1 this is no longer necessary ; $1022 (DBERR,) ;tell 1022 to display errors $1022 (DBEXEC) ; $1022 (DBERR,) ;reset back to normal JRST ENDCMD SUBTTL Server for HOST command ;============================================================================= .HOST: CONFIRM JRST ENDCMD SUBTTL Servers for COMPILE command ;============================================================================= .COMPI: NOISE2 (sour,ce file) MOVX T4,GJ%OLD ;parse existing file MOVEM T4,GTJBLK+.GJGEN SPTR T4, MOVEM T4,GTJBLK+.GJEXT ;set default file extension TXO F,F%RNOP ;have DOCMD return on CM%NOP COMPI2: PARSE (,<.CMFIL,CM%SDH,,>) TXNN T1,CM%NOP ;parsed the file OK? IFSKP. ;yes ; I didn't find a ".DMA" so try a ".DMC" SPTR T4, MOVEM T4,GTJBLK+.GJEXT ;set default file extension JRST COMPI2 ;try again ENDIF. HRROI T1,FSPEC MOVEM T1,GTJBLK+.GJNAM ;save ptr to default file name TLZ T2,-1 ;remove any flags from JFN FILSTR (-,,-) CALL RJFN ;release JFN MOVEI T1,CMDBLK ;restore T1 NOISE2 (givi,ng) MOVX T4,GJ%FOU ;parse an output file MOVEM T4,GTJBLK+.GJGEN SPTR T4, MOVEM T4,GTJBLK+.GJEXT ;set default file extension PARSE (,<.CMFIL,,,,,,CONFRM>) CALL RJFN ;release JFN CONFIRM JRST DBEX SUBTTL Servers for PERFORM command ;============================================================================= .PERFO: NOISE2 (comp,iled DMX file) V117B< IDMX5:> ;server for the INFORM DMX command MOVX T4,GJ%OLD ;parse existing file MOVEM T4,GTJBLK+.GJGEN SPTR T4, MOVEM T4,GTJBLK+.GJEXT ;set default file extension PARSE (,,FDMX) CALL RJFN ;release JFN CONFIRM JRST DBEX SUBTTL Servers for DEFINE command ;============================================================================= .DEFIN: NOISE2 (vari,able) DEFIN2: PARSE (,<.CMKEY,,DEFTAB,,,,FVAR>) TLZ T3,-1 ;get function descriptor block parsed CAIN T3,FVAR ;was a variable name parsed? IFSKP. ;yes, check it out CALL CKABRV ;no, was keyword abbreviated? JRST DEFIN2 ;yes, assume its a variable name HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to handler PARSE (,,FVAR) ;after variable-type must have... ; ...atleast one variable name ENDIF. ; gets here when I've parsed an variable name. If a null name was parsed ; (.CMFLD will parse a null field) then user is trying to confirm command MOVE T2,CMDBLK+.CMABP ;get ptr to ATMBUF ILDB T2,T2 ;get 1st byte of string parsed JUMPN T2,DEFIN2 ;jump if NOT null field parsed CONFIRM JRST DBEX ;----------------------------------------------------------------------------- ; server for the DOUBLE keyword .DEFD: PARSE (,<.CMKEY,,$INTEGER,,>) CALLRET XKEYW ;expand abbreviated keyword ;----------------------------------------------------------------------------- ; server for the TEXT keyword .DEFT: PARSE (,<.CMNUM,CM%SDH,^D10,>) RET SUBTTL Servers for LET command ;============================================================================= .LET: NOISE2 (vari,able name) MOVEI T2,SYSTAB ;system variable table MOVX CX,K%NSET ;set only keywords with this flag TXON F,F%SYSV ;necessary to set CM%NOP flags? CALL SETFLX ;yes LET2: PARSE (,<.CMKEY,,SYSTAB,,,,FVAR>) TLZ T3,-1 ;get function descriptor block parsed CAIN T3,FVAR ;parsed a variable name? JRST LET5 ;yes, join common code CALL XKEYW ;expand abbreviated keyword HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to it JRST LET2 ;loop back for another variable CONFIRM JRST DBEX ;do DBEXEC ;----------------------------------------------------------------------------- ;Common routine to parse "EQ" or "=" and then new value for a variable LETEQ: HRRM T4,EQFDB PARSE (,,EQFDB) TLZ T3,-1 ;get function descriptor block parsed CAIE T3,EQFDB ;parsed "EQ" or "=" ? RET ;no parsed next FDB HRRZ T2,EQFDB ;yes get address of next FDB PARSE RET ;----------------------------------------------------------------------------- ; server for SYSDELIM system variable PSDEL: HRRI T4,[FLDBK. (.CMQST,CM%SDH,,,<,>)] CALLRET LETEQ ;join common code ;----------------------------------------------------------------------------- ; server for INTEGER system variables PSINT: HRRI T4,[FLDBK. (.CMNUM,CM%SDH,^D10,)] CALLRET LETEQ ;join common code ;----------------------------------------------------------------------------- ; server for REAL system variables PSREAL: HRRI T4,[FLDBK. (.CMFLT,CM%SDH,,)] CALLRET LETEQ ;join common code ;----------------------------------------------------------------------------- ; server for DATE system variables PSDATE: HRRI T4,[FLDBK. (.CMQST,CM%SDH,,)] ; HRRI T4,[FLDBK. (.CMTAD,,CM%IDA)] CALLRET LETEQ ;join common code ;----------------------------------------------------------------------------- ; server for TEXT system variables PSTXT: HRRI T4,[FLDBK. (.CMQST,CM%SDH,,)] CALLRET LETEQ ;join common code SUBTTL Servers for EVALUATE command ;============================================================================= .EVALU: NOISE2 (all ,selected records into variable) LET5: PARSE (,<.CMFLD,CM%SDH,,< EQ,= >,,BKEOL>) CONFIRM JRST DBEX ;do DBEXEC SUBTTL Servers for PUSH command ;============================================================================= .PUSH: PARSE (,<.CMKEY,,$USING,,,,CONFRM>) TLZ T3,-1 ;get function descriptor block parsed CAIE T3,CONFRM ;user confirmed command? IFSKP. ;no CALL DOECHO## ;echo if necessary TMSG < [use @POP to return to 2022]> JRST DBEX ENDIF. CALL XKEYW ;expand abbreviated keyword ;;; when PUSH command is fixed by Software House I can use this code again ;;; PARSE (,<.CMFLD,CM%SDH,,,,BKEOL>) ;;; CONFIRM ;;; SPTR T4, ;;; MOVEM T4,FAD4D+.CMHLP ;initialize help message ;;; CALL DBEXR ;do DBEXEC ;;; CALL RCNCLR## ;clear any commands not processed... ;;; ; ...by the inferior EXEC ;;; JRST ENDCMD ;;;edit 02 start PUSH3: PARSE (CMDBLK,<.CMKEY,,$END,,,,[ FLDBK. (.CMFLD,CM%SDH,,,,BKELS)]>) HRROI T1,ATMBUF ;see if "END" parsed SPTR T2, STCMP% JUMPE T1,PUSH8 ;quit when "END" is found HRROI T1,ATMBUF ;see if "END." was parsed SPTR T2, STCMP% JUMPE T1,PUSH8 ;quit when "END." is found MOVE T4,CMDBLK+.CMPTR ;get ptr to next input to be parsed ILDB T4,T4 ;get next byte CAIE T4,.CTRLM ;a ^M CAIN T4,.CTRLJ ; ...or a ^J TRNA ;yes JRST PUSH3 ;no PARSE (CMDBLK,<.CMCFM>) ;eat up HRROI T1,[ASCIZ/PUSH>>/] SKIPN CMDBLK+.CMINC ;skip if reparse PSOUT% JRST PUSH3 ;loop back to get another push command PUSH8: MOVEI T1,CMDBLK ;restore address of command block CONFIRM CALL DBEXR CALL RCNCLR## ;clear any commands not processed... ; ...by the inferior EXEC JRST ENDCMD KWT1 ;;;edit 02 end SUBTTL Servers for MODIFY command ;============================================================================= .MODIF: PARSE (,<.CMKEY,,MODTAB,,,BKKEY$,FATR>) TLZ T3,-1 ;get function discriptor block parsed CAIN T3,FATR ;parsed an attribute name? IFSKP. ;yes CALL XKEYW ;expand abbreviated keyword HRRZ T4,(T2) ;get address of command server ELSE. MOVEI T4,.MOATK ;yes ENDIF. CALL (T4) ;dispatch to it CONFIRM JRST DBEX ;----------------------------------------------------------------------------- ; server for the $DSNAME keyword .MODSN: PARSE (,<.CMFLD,CM%SDH,,,,BKDSN>) RET ;----------------------------------------------------------------------------- ; server for the $ACCESS keyword .MOACC: PARSE (,<.CMKEY,,MACTAB>) CALLRET XKEYW ;expand abbreviated keyword ;----------------------------------------------------------------------------- ; server for the $ATTRIBUTE keyword .MOATR: PARSE (,,FATR) ;parse an attribute name .MOATK: PARSE (,<.CMKEY,,MATTAB>) CALL XKEYW ;expand abbreviated keyword HRRZ T4,(T2) ;get address of command server CALLRET (T4) ;dispatch to it ;----------------------------------------------------------------------------- ; server for the $ATTRIBUTE ABBREVIATION keyword .MOATA: PARSE (,<.CMFLD,CM%SDH,,,,BKATR>) RET ;----------------------------------------------------------------------------- ; server for the $ATTRIBUTE NAME keyword .MOATN: PARSE (,<.CMFLD,CM%SDH,,,,BKATR>) RET SUBTTL Servers for UPDATE command ;============================================================================= .UPDAT: SPTR T4, MOVEM T4,CONFM+.CMHLP PARSE (,<.CMKEY,,UPDTAB,,,,CONFM>) TLZ T3,-1 ;get function descriptor block parsed CAIE T3,CONFM ;user confirmed command? IFSKP. ;no CALL DOECHO## ;echo if necessary JRST DBEX ENDIF. CALL XKEYW ;expand abbreviated keyword CONFIRM JRST DBEX SUBTTL Servers for BACKTO, UPTO commands ;============================================================================= .BACKT: .UPTO: NOISE2 (1022, version) PARSE (,<.CMNUM,CM%SDH,^D10,>) CONFIRM JRST DBEX SUBTTL Servers for BODY, PAGE, TYPAGE commands ;============================================================================= .BPTYP: HRLZI T3,[FLDBK. (.CMNUM,CM%SDH,^D10,,<60>)] TXO F,F%NFIL ;don't accept file-specs CALL PONCF ;parse "ON " phrase IFSKP. ;failed, parsed something else instead PARSE (,<.CMNUM,CM%SDH,^D10,,<60>>) ENDIF. CONFIRM JRST DBEX SUBTTL Servers for HELP command ;============================================================================= .PHELP: MOVX T4,CM%XIF ;don't recognize "@" IORM T4,CMDBLK+.CMFLG ;set flag word NOISE2 (on s,ubject) PARSE (,<.CMKEY,,CMDTAB,,,BKH22,[ FLDBK. (.CMKEY,,HLPTAB,,,BKH22,FHELP2)]>) TLZ T3,-1 ;get function discriptor block parsed CAIE T3,CONFRM ;user confirmed command? IFSKP. ;no CALL DOECHO## ;echo if necessary JRST DBEX ;do DBEXEC ENDIF. CAIE T3,FHELP2 ;parsed an unknown keyword? IFSKP. ;no SETZ Q1, ;yes, let 1022 give error message... ; ...if keyword invalid ELSE. CALL XKEYW ;expand abbreviated keyword MOVEM T2,Q1 ;save keyword parsed ENDIF. PARSE (,<.CMFLD,CM%SDH,,,,BKEOL,CONFRM>) CONFIRM CAIN Q1,$K1022 ;was the keyword "1022" JRST HELP9 ;yes, give my own message CAIN Q1,$K2022 ;was the keyword "2022" JRST .HELP1## ;yes, display help file ; if all else fails pass the help command off to 1022 JRST DBEX ;do DBEXEC HELP9: HRROI T1,HLPTXT ;yes, give my own message PSOUT% JRST ENDCMD HLPTXT: ASCIZ | This command will turn control over to the 1022 command parser. You will then be able to execute any command not implimented in 2022. When you are done you can return to 2022 by entering the "HOST" command. | SUBTTL Server for EXIT command ;============================================================================= .EXIT2: NOISE2 (from, 1022) CONFIRM JRST DBEX JRST DIE ;shouldn't ever get here C.EXIT < $1022 (DBEND) ;done with 1022 >;end of C.EXIT ;============================================================================= ;Routine to call the handler for a command field ;ACCEPTS: T1-T3 as left by last COMND% ;RETURNS: normally +2 but will return +1 if CONFRM function descriptor block ; was parsed HNDLER: HRRZ T4,T3 ;get function discriptor block parsed CAIN T4,CONFRM## ;user confirmed command? CALLRET DOECHO## ;yes, echo if necessary and return CALL SETFLG ;say keyword parsed CALL XKEYW ;expand abbreviated keyword HRRZ T4,(T2) ;get address of command server CALL (T4) ;dispatch to handler AOSA (P) ;set +2 return CALLRET DOECHO## ;echo if necessary and return RET ;============================================================================= ;Routine to clear the CM%NOR flags for some or all keywords in a keyword table ; CALL CLRFLA -clear all flag in table ; CALL CLRFLX -clear ONLY if flag(s) given in CX is set ; CALL SETFLX -set ONLY if flag(s) given in CX is set ;ACCEPTS: T2 - address of keyword table ;RETURNS: +1 always ;Trashes T2-T4,CX CLRFLA: SETO CX, ;have all the flags cleared CLRFLX: HLLZ T3,(T2) ;get actual length of table MOVN T3,T3 ;set up for AOBJN HLL T2,T3 ADDI T2,1 CLRFL3: HLRZ T3,(T2) ;get address of keyword flags MOVE T4,(T3) ;get keyword flags TXZ T4,CM%NOR ;clear flag TDNE T4,CX ;was it ok to clear this flag? MOVEM T4,(T3) ;yes, save updated flag word AOBJN T2,CLRFL3 ;loop for all keywords in table RET ;----------------------------------------------------------------------------- ;Routine to set ALL the flags in a table that have flag in CX set ; (the reverse of CLRFLX) SETFLX: HLLZ T3,(T2) ;get actual length of table MOVN T3,T3 ;set up for AOBJN HLL T2,T3 ADDI T2,1 SETFL3: HLRZ T3,(T2) ;get address of keyword flags MOVE T4,(T3) ;get keyword flags TXO T4,CM%NOR ;set flag TDNE T4,CX ;was it ok to set this flag? MOVEM T4,(T3) ;yes, save updated flag word AOBJN T2,SETFL3 ;loop for all keywords in table RET ;============================================================================= ;Routines to set/clear the CM%NOR flag for a specific keyword ; CALL SETFLG ; CALL CLRFLG ;ACCEPTS: T2 - address of keyword table entry (normally returned by COMND%) ;RETURNS: +1 always ;Trashes T4,CX SETFLG: HLRZ CX,(T2) ;get address of keyword flags SETFL1: MOVE T4,(CX) ;get keyword flags TXO T4,CM%NOR ;don't parse keyword again MOVEM T4,(CX) ;save flag word TXNN T4,CM%ABR ;an abbreviation for another keyword? RET ;no, so I'm done HLRZ CX,@(T2) ;get address of flags for next keyword JRST SETFL1 ;loop back to process it CLRFLG: HLRZ CX,(T2) ;get address of keyword flags CLRFL1: MOVE T4,(CX) ;get keyword flags TXZ T4,CM%NOR ;allow keyword to be parsed again MOVEM T4,(CX) ;save flag word TXNN T4,CM%ABR ;an abbreviation for another keyword? RET ;no, so I'm done HLRZ CX,@(T2) ;get address of flags for next keyword JRST CLRFL1 ;loop back to process it ;============================================================================= ;Routine to expand an abbreviated keyword. Unfortunatly, unlike COMND%, 1022 ;usually requires more than just the unambiguous abbreviation (Eg: you can't ;use "DES" for "DESC"). ; CALL XKEYW ;ACCEPTS: T2 - as left by COMND ;RETURNS: +1 always ;Trashes none XKEYW: TXNE T1,CM%ESC ;did user terminate keword with ? RET ;yes, keyword not abbreviated DMOVEM T4,1(P) ;save registers DMOVEM Q2,3(P) XKEYW1: CAMN P1,CMDBLK+.CMPTR ;all bytes in CMDBUF moved to CMDB22 ? IFSKP. ;yes, quit ILDB T4,P1 ;get a byte from CMDBUF IDPB T4,P2 ;write it to CMDB22 JRST XKEYW1 ;loop back for more bytes ENDIF. MOVE Q1,CMDBLK+.CMABP ;get pointer to atom buffer HLRO Q2,(T2) ;get keyword parsed MOVE Q3,(Q2) TLNN Q3,774000 ;is this a flag word? ADDI Q2,1 ;yes, string begins on next word HRLI Q2,(POINT 7,) ;make byte ptr TRNA ;get into loop XKEYW4: IBP Q2 ;increment ptr to actual keyword parsed ILDB T4,Q1 ;get byte from keword in ATMBUF JUMPN T4,XKEYW4 ;loop until end of keyword found XKEYW5: ILDB T4,Q2 ;get byte from actual keyword parsed JUMPE T4,XKEYW9 ;quit when end of keyword found IDPB T4,P2 ;expand keyword in CMDB22 JRST XKEYW5 ;loop for more bytes XKEYW9: DMOVE T4,1(P) ;restore registers DMOVE Q2,3(P) RET ;============================================================================= ;Routine to check for an abbreviated keyword ;ACCEPTS: T1,T2 - as left by COMND% ;RETURNS: +1 keyword is abbreviated ; +2 if keyword is NOT abbreviated ;Trashes none CKABRV: AOS (P) ;assume NOT abbreviated TXNE T1,CM%ESC ;did user terminate keword with ? RET ;yes, keyword not abbreviated DMOVEM T1,1(P) ;save registers MOVEM T3,3(P) HRROI T1,ATMBUF ;get pointer to atom buffer HLRO T2,(T2) ;get keyword parsed MOVE T3,(T2) TLNN T3,774000 ;is this a flag word? ADDI T2,1 ;yes, string begins on next word STCMP% ;compare the strings SKIPE T1 ;are strings equal? SOS (P) ;no, set +1 return DMOVE T1,1(P) ;restore registers MOVE T3,3(P) RET ;============================================================================= ;Routines to parse file specs for DMD, DMI files ;----------------------------------------------------------------------------- ;Routines to parse a DMD file spec PDMD: MOVX T4,GJ%OLD ;parse existing file MOVEM T4,GTJBLK+.GJGEN SPTR T4, MOVEM T4,GTJBLK+.GJEXT ;set default file extension TXZE F,F%INI ;just initialize? RET ;yes, I'm done PARSE (,,FDMD) PDMD7: CALLRET SETDNR ;set up default file name ;----------------------------------------------------------------------------- ;Routines to parse a DMI file spec PDMIZ: SETZM GTJBLK+.GJGEN ;use highest existing generation JRST .+3 PDMI: MOVX T4,GJ%OLD ;parse existing file MOVEM T4,GTJBLK+.GJGEN SPTR T4, MOVEM T4,GTJBLK+.GJEXT ;set default file extension PARSE (,,FDMI) ;parse file specs for DMI file CALLRET SETDNR ;set up default file name ;----------------------------------------------------------------------------- ;Routine to parse a decimal number PNUM: PARSE (,,FNUM) ;parse a decimal number RET ;============================================================================= ;Routine to parse a data-set-descriptor. This is either a: ; -file specs of DMS file ; -data set name ; -data set alias ; -data set number ;ACCEPTS: see PDMSN ;RETURNS: see PDMSN PDSD: TXO F,F%INI ;just do initialization CALL PDMSN ;init for parsing existing data set PARSE (,,FDSD) ;parse data set descriptor PDSD2: AOS (P) ;assume +2 return TLZ T3,-1 ;get function discriptor block parsed CAIN T3,FDSD ;parsed file spec for DMS? CALLRET PDSD3 ;yes, check it out SETZ T2, ;no, say no JFN CALLRET PDSD4 ;could be name, alias or number ; When I parsed a data set name, alias or number it is impossible to tell ; which it is. The only way to find out is to try to parse "IN" or the ; next FDB supplied when this routine was called if "IN" is parsed then I ; know it was a data-set-name. Whether its a data-set-alais or data-set-number ; I don't need to worry about ;----------------------------------------------------------------------------- ;Routines to parse "data-set-file-specs" (defualt is DMS) -OR- ;a "data-set-name IN data-set-file-specs". The file-specs will be parsed first ;so that the user can use to fill them in if he wants. ;ACCEPTS: ; T3 - address of next function descriptor block to use if required ; (normally left by the COMND% jsys) ;RETURNS: ; +1 - the next FDB supplied in T3 had to be used to destinguish ; the data-set-name from a data-set-file-specs. T2,T3 contain ; data parsed for the next field ; +2 - normal return. T3 not used PDMSNZ: SETZM GTJBLK+.GJGEN ;use highest existing generation JRST .+3 PDMSN: MOVX T4,GJ%OLD ;parse existing file MOVEM T4,GTJBLK+.GJGEN SPTR T4, MOVEM T4,GTJBLK+.GJEXT ;set default file extension HLLZM T3,T4 ;save address of next FDB DMOVE P3,CMDBLK+.CMPTR ;get data for possible reparse TXZE F,F%INI ;just initialize? RET ;yes, I'm done PDMSN1: PARSE (,,FDMSN) PDMSN2: AOS (P) ;assume +2 return TLZ T3,-1 ;get function discriptor block parsed CAIN T3,FDMSN ;parsed file spec for DMS? IFSKP. ;yes HRRM T4,INFDB ;no, must be a data set name so zero... PARSE (,,INFDB) ; ...right half in INFDB and parse "IN" JRST PDMS5 ;go parse file specs for DMS ENDIF. ; COMND% parsed a file name but I must check to see if the file name entered ; could also be confused with the beginning of a data-set-name IN . If ; it can be then I must wait to see if "IN" is parsed next to know whether or ; not it is a file-name or really a data-set-name. Also it could be that a null ; field was parsed for the file name. This can happen when GTJBLK+.GJNAM is ; non-blank so if user doesn't enter a file and that file can be found COMND% ; will parse a file and ATMBUF will be null - in which case the user must NOT ; be trying to enter a data-set-name PDSD3: TXNE T1,CM%ESC ;was used to complete file name JRST PDMSN7 ;yes, can't be also a data set name MOVE Q1,CMDBLK+.CMABP ;get ptr to ATMBUF ILDB Q1,Q1 ;get 1st byte of string parsed JUMPE Q1,PDMSN7 ;jump if null field parsed PDSD4: MOVEM T2,Q1 ;save JFN DMOVE T2,CMDBLK+.CMPTR ;get current data in CMDBLK CALL RCMBLK ;restore ptrs to start of file name DMOVEM T2,P3 ;save data from CMDBLK PARSE (,,FDSN) ;could it also be a data set name? MOVE T2,Q1 ;restore JFN CAMN P3,CMDBLK+.CMPTR ;could it be a data-set-name? IFSKP. ;yes CALL RCMBLK ;no, restore ptrs to end of file-specs JRST PDMSN7 ;join common code after parsing DMS ENDIF. DMOVE P3,CMDBLK+.CMPTR ;get data for possible reparse HLRM T4,INFDB ;set address of next FDB PARSE (,,INFDB) TLZ T3,-1 ;get function discriptor block parsed CAIN T3,INFDB ;parsed "IN" keyword? IFSKP. ;yes EXCH T2,Q1 ;restore JFN MOVEM T3,Q2 ;save data returned by COMND% CALL PDMSN7 ;call common code after parsing DMS DMOVE T2,Q1 ;restore data returned by COMND% SOS (P) ;set +1 return RET ENDIF. ; what I parsed before that could have been a data set name or a file spec ; turned out to really be a data set name so release the JFN from before and ; go parse file-specs of the DMS SKIPE T2,Q1 ;restore JFN CALL RJFN ;yes, release JFN PDMS5: PARSE (,,FDMS) ;parse file specs for DMS file CALLRET SETDNR ;set up default file name PDMSN7: JUMPN T2,SETDNR ;if I have a JFN then CALLRET RET ; ...otherwise just return PDMSZ: SETZM GTJBLK+.GJGEN ;use highest existing generation JRST .+3 PDMS: MOVX T4,GJ%OLD ;parse existing file MOVEM T4,GTJBLK+.GJGEN SPTR T4, MOVEM T4,GTJBLK+.GJEXT ;set default file extension JRST PDMS5 ;----------------------------------------------------------------------------- ;Routine to restore CMDBLK to a previous location. ;ACCEPTS: ; P3,P4 - CMDBLK+.CMPTR, CMDBLK+.CMCNT ;RETURNS: +1 always. ;Trashes none RCMBLK: MOVEM P3,CMDBLK+.CMPTR ;restore previous ptr EXCH P4,CMDBLK+.CMCNT ;save previous count of space left SUB P4,CMDBLK+.CMCNT ;calc # of unparsed bytes MOVN P4,P4 ADDM P4,CMDBLK+.CMINC ;adjust # of unparsed characters MOVE P4,CMDBLK+.CMCNT ;restore register RET ;============================================================================= ;Routine to parse the "ON or " phrase ;ACCEPTS: T3 - address of next function descriptor block to use ; (normally left by the COMND% jsys) ;RETURNS: ; +1 - didn't parse "ON..." phrase parsed another FDB supplied in T3 ; +2 - parsed the "ON..." phrase ;Trashes T2-T4 ONCFTX: ASCIZ\ON or \ ONCHTX: ASCIZ\ON \ ONFITX: ASCIZ\ON \ PONCF: HLRM T3,ONFDB ;set address of next FDB HRROI T4,ONCFTX ;get help text for channel/file TXZE F,F%NFIL ;ignore file? HRROI T4,ONCHTX ;yes TXZE F,F%NCHN ;ignore channel number? HRROI T4,ONFITX ;yes MOVEM T4,ONFDB+.CMHLP PARSE (,,ONFDB) TLZ T3,-1 ;get function discriptor block parsed CAIE T3,ONFDB ;parsed "ON" keyword? RET ;no, parsed something else MOVX T4,GJ%FOU ;file for output MOVEM T4,GTJBLK+.GJGEN MOVEI T2,FCHF ;parse a channel number or file specs HRRZ T4,ONFDB+.CMHLP ;get address of default help message CAIN T4,ONCHTX ;only accepting channel number? MOVEI T2,FCHN ;yes CAIN T4,ONFITX ;only accepting file? MOVEI T2,FFIL ;yes PARSE AOS (P) ;set +2 return TLZ T3,-1 ;get function discriptor block parsed CAIE T3,FFIL ;parsed file-specs? RET ;no, must have parsed a number CALLRET RJFN ;yes, so release the JFN ;============================================================================= ;This routine will set the default file name in the GTJBLK and then release ; the JFN ; CALL SETDNR ;ACCEPTS: T2 - JFN ;RETURNS: +1 always ;Trashes T2-T3 SETDNR: PUSH P,T1 ;save register HRROI T1,FSPEC ;default file name is here MOVEM T1,GTJBLK+.GJNAM HRRZ T2,T2 ;remove any flags from JFN FILSTR (-,,-) TRNA RJFN: PUSH P,T1 ;save register HRRZ T1,T2 ;release JFN RLJFN% JERR (?,,PC) POP P,T1 ;restore register RET ;============================================================================= ;Routine to ensure the last byte parsed in the CMDBUF is a "." - if not a "." ;is added to the end of the text moved to CMDB22. Usually this routine is ;called prior to CONFIRM to insure the command parsed ends with a "." ;because some 1022 command require a terminating "." (eg: #COM, #TYPE) ; CALL ADD. ;Trashes T4 ADD.: CALL MOVP22 ;move parsed bytes from CMDBUF to CMDB22 CAIN T4,"." ;was this last byte entered? RET ;yes, I'm done MOVEI T4,"." ;no, terminate text with a "." IDPB T4,P2 RET ;============================================================================= ;Routines to move data to CMDB22 (the command buffer to be sent to 1022) ; CALL MOVB22 - move CMDBUF to CMDB22 ; CALL MOVP22 - move parsed bytes ONLY from CMDBUF to CMDB22 ; CALL MOVBT3 - move string in T3 to CMDB22 ;Trashes T3-T4 MOVBT3: ILDB T4,T3 ;get a byte from string IDPB T4,P2 ;write it to CMDB22 JUMPN T4,.-2 ;loop until end of string RET MOVP22: CAMN P1,CMDBLK+.CMPTR ;end of parsed text? RET ;yes, I'm done ILDB T4,P1 ;get a byte from CMDBUF IDPB T4,P2 ;write it to CMDB22 JRST MOVP22 ;no, loop for another byte MOVB22: ILDB T4,P1 ;get a byte from CMDBUF IDPB T4,P2 ;write it to CMDB22 JUMPN T4,MOVB22 ;loop until end of CMDBUF RET ;============================================================================= ;Routine to perform the DBEXEC routine to execute the command 2022 parsed ; JRST DBEXM -same as DBEX except initializes AD4CAL ; JRST DBEX -will return to ENDCMD after DBEXEC ; CALL DBEXR -return to caller after DBEXEC DBEXM: MOVEM T1,AD4CAL ;save routine to get more data DBEX: MOVEI T1,ENDCMD ;set return for DBEXEC PUSH P,T1 DBEXR: CALL MOVB22 ;move rest of CMDBUF to CMDB22 MOVE T1,[POINT 7,CMDB22] ;initialize source for PCTRLV MOVE T2,T1 ;destination for PCTRLV DMOVEM T1,Q1 ;save pointers CALL PCTRLV## ;remove a ^V from string ;&&& don't remove the terminating incase there is a "!" comment in the ; command. If is not there 1022 will not find the end of the comment ; line and DBEXEC will jump to GETMOR to get more info ; MOVE T1,Q1 ;get pointer to beginning of string ; CALL RMVCRL ;remove any terminating or $TEMP: ;&&&end of temporary patch DMOVE T1,Q1 ;get pointers CALL RMVNOI ;remove the noise from the string TXNN F,F%DISP ;display command sent to 1022? IFSKP. ;no TMSGL <"> HRROI T1,CMDB22 PSOUT% TMSG <" > ENDIF. $1022 (DBEXEC,) RET ;----------------------------------------------------------------------------- ;1022 will jump here when it needs more information to complete a command. ;(Eg: if user entered "ADD " then 1022 will prompt for the values of ;each attribute in the data set. Or if a password is required on OPEN 1022 ;will jump here to get it) DBEMOR: CALL RDTI ;restore registers + deactivate ^T ; HRROI T1,CMDB22 ;put input here ; MOVE T2,[RD%BEL!CMDBLN*5] ;return only on end-of-line ; SETZ T3, ;no ^R prompt ; RDTTY% ; JERR (?,,PC,DIE) ; JRST DBEX3 ;pass this info to 1022 SKIPGE PLFLAG ;in PL1022 ? SKIPL REFLAG ;in REPORT ? RET ;yes SKIPN T2,AD4CAL ;get routine to handle request for data MOVEI T2,GETMOR ;default if none given CALL (T2) ;call it JRST DBEXR ;pass command to 1022 ;----------------------------------------------------------------------------- ;General routine to get more data if 1022 wants it GETMOR: SKIPN FAD4D+.CMHLP ;is HELP string initialized? CALL INIHLP ;no, do it now SKIPN AD4PRM ;is PROMPT string initialized? CALL INIPRM ;no, do it now ; MOVEI T1,DIE ;no exit routine for this command level HRROI T2,AD4PRM ;set prompt for this command level CALL BEGCML## ;set up this command level MOVE P1,CMDBLK+.CMPTR ;initialize ptrs for MOVB22 MOVE P2,[POINT 7,CMDB22] PARSE (,,FAD4C) TLZ T3,-1 ;get function descriptor block parsed CAIE T3,FAD4C ;was confirm parsed? CONFIRM ;no, so confirm command now CALL RMVCML## ;remove this command level from stack RET ;----------------------------------------------------------------------------- ;Routine to initialize the default help string when 1022 requests more data INIHLP: HRROI T4,AD4HLP ;set pointer to help message MOVEM T4,FAD4D+.CMHLP MOVE T1,[POINT 7,AD4CMD] ;put last keyword parsed here CALLRET GETLKW ;----------------------------------------------------------------------------- ;Routine to initialize the default prompt string when 1022 requests more data INIPRM: MOVE T1,[POINT 7,AD4PRM] ;put last keyword parsed here CALL GETLKW MOVEI T3,">" IDPB T3,T1 IDPB T3,T1 SETZ T3, IDPB T3,T1 RET ;----------------------------------------------------------------------------- ;Routine to move the last keyword parsed to given area ; CALL GETLKW ;ACCEPTS: T1 - destination byte pointer ;RETURNS: +1 always ;Trashes T2-T3 GETLKW: HLRO T2,@LASTKW ;get last keyword parsed MOVE T3,(T2) TLNN T3,774000 ;is this a flag word? ADDI T2,1 ;yes, string begins on next word HRLI T2,(POINT 7,) ;make byte ptr GETLK3: ILDB T3,T2 ;get a byte from keyword IDPB T3,T1 ;write it to destination JUMPN T3,GETLK3 ;loop until end of string MOVEM T1,T3 ;save pointer SETO T1, ADJBP T1,T3 ;backup to before null RET ;----------------------------------------------------------------------------- ;Routine to get more data for ADD MORADD: MOVEI T1,.PRIOU ;make COMND% think I'm at the... SETZ T2, ; ...beginning of the line so stuff... SFPOS% ; ...for ADD looks like when 1022 asks HRRZI T4,1 ;no prompt for ADD MOVEM T4,AD4PRM HRROI T4,AD4HLP ;set pointer to help message SPTR T4, MOVEM T4,FAD4D+.CMHLP ;&&& must remove the terminating from data for ADD otherwise ADD will ; use it to give the next value a null ; CALLRET GETMOR ;get more info CALL GETMOR ;get more info CALL MOVB22 ;move rest of CMDBUF to CMDB22 MOVE T1,[POINT 7,CMDB22] ;initialize source for PCTRLV MOVE T2,T1 ;destination for PCTRLV DMOVEM T1,Q1 ;save pointers CALL PCTRLV## ;remove a ^V from string MOVE T1,Q1 ;get pointer to beginning of string CALL RMVCRL ;remove any terminating or ADJSP P,-1 ;remove call to this routine JRST $TEMP ;&&&end of temporary patch ;============================================================================= ;Routines to save and restore registers for DB____ calls and to activate and ;deactivate for ^T intercepts. ^T is intercepted so that meaningful info ;about the 1022 fork is displayed rather than the EXEC just telling the user ;that 2022 is in fork-wait. SATI: MOVE T1,[.TICCT,,.CTCH] ;activate to intercept ^T ATI% JERR (%,,PC) SAVEAC ;save registers RET RDTI: MOVEI T1,.TICCT ;deassign ^T DTI% JERR (%,,PC) RESTAC ;restore registers RET REPEAT 0,< ;Don't need this routine now that SYSDBEXMSG is set to 1 ;----------------------------------------------------------------------------- ;All errors from any DB____ calls will jump here ERTBL: ASCII \CSFIFDOPMIFOUPSOIOSYCOPL HLLDTR AU SP\ ERTBLN==^D20 ER1022: CALL RDTI ;restore registers + deactivate ^T TMSGL MOVE T2,IERT ;get error type code CAILE T2,ERTBLN ;code greater than table length? JRST [NUMOUT (-) ;yes, just display number TMSG <-> JRST ER1025] SUBI T2,1 ;calc offset into type-code table IMULI T2,2 MOVEI T1,.PRIOU ADJBP T2,[POINT 7,ERTBL] ;make pointer to error code MOVNI T3,2 ;write two bytes SOUT% ER1025: NUMOUT (IERC) ;display error code number TMSG <) > $1022 (DBERRT,<[0]>) ;print 1022 error on terminal TMSG < > JRST ENDCMD >;end of repeat ;============================================================================= ;Routine to remove all terminating carrage-returns and line-feeds from a string. ;If the string contains nothing but , then a space is added to the ;string because some 1022 commands require they be send a non-null string ;(Eg: If user enters "ADD" and DBEMOR is called for more info then if a null ;string is passed it is ignored) ; CALL RMVCRL ; CALL RMVCR1 ;ACCEPTS: ; T1 - pointer to beginning of string ; T2 - pointer to end of string ;RETURNS: ; +1 with T2 updated ;Trashes: T1,T3-T4 RMVCRL: IBP T1 ;incase byte ptr not real (440700,,-) RMVCR1: CAMN T2,T1 ;reached beginning of string JRST RMVCR7 ;yes MOVE T4,T2 ;get last ptr SETO T2, ADJBP T2,T4 ;back up one byte LDB T3,T2 CAIE T3,.CTRLJ ;was it ^J ? CAIN T3,.CTRLM ; ...or ^M ? JRST RMVCR1 ;yes, backup some more RMVCR5: SETZ T3, IDPB T3,T2 ;and end with a null RET RMVCR7: MOVEI T3," " ;insure at least one space in... DPB T3,T2 ; ...null string JRST RMVCR5 ;quit ;============================================================================= ;Routine to process the noise guide words from a string. These need to be ;removed because 1022 doesn't like them ; CALL RMVNOI ;ACCEPTS: ; T1 - source byte pointer to ASCIZ string ; T2 - destination byte pointer ;RETURNS: ; +1 always with T1, T2 updated ;Trashes T3-T4 RMVNOI: ILDB T3,T1 ;get a byte CAIN T3,"(" ;possibly the start of noise string? IFSKP. ;yes RMVNO2: IDPB T3,T2 ;write byte to destination JUMPN T3,RMVNOI ;loop until null is reached RET ENDIF. MOVEM T1,T4 ;get byte pointer ILDB T4,T4 ;get next byte CAIE T4,NOIBYT ;is it this? JRST RMVNO2 ;no, false alarm IBP T1 RMVNO4: ILDB T3,T1 ;yes, now look for end of noise string JUMPE T3,[TMSGL <%End of noise not found - should not happen> JRST RMVNO2] CAIE T3,")" ;end of noise string? JRST RMVNO4 ;no, keep on looking JRST RMVNOI ;loop back to search for next noise SUBTTL Interrupt Handlers ;============================================================================= ;Routine to handle ^E interrupts. It will call the MC.CET module from HL1022.REL ;to display the information. 2022 will still work even if MC.CET routine is not ;available CTRLE: IP.SAVE ;save F to P - just to be safe TMSGL ;insure typeout starts on new line MOVEI T1,MC.CET## ;check to see if this module is loaded JUMPE T1,[TMSG <%^E routine MC.CET is unavailable > RET] ;dismiss interrupt CALLRET MC.CET## ;output ^E stuff and... ; ...dismiss interrupt when done PX <2022 will still run even if MC.CET (for ^E) can't be found by LINK> ;============================================================================= ;Routine to handle ^C interrupts. This is necessay so that if user ^C out of ;2022 to "@ENABLE" or "@DISABLE" then I must also change the process capability ;word of the 1022 fork so that it will be the same as the top-level 2022 fork. ;If this is not done one fork may have access to files that the other fork ;doesn't - giving some very strange results. CTRLC: IP.SAVE ;save F to P MOVEI T1,.FHSLF ;get capability word for this fork RPCAP% JERR (%,,PC) HALTF% ;stop this fork MOVEM T3,Q3 ;save previous capability word RPCAP% ;get current capability word JERR (%,,PC) CAMN T3,Q3 ;have capabilities changed? RET ;no, dismiss interrupt MOVE Q2,Q3 ;make copy of old capability word ANDCA Q2,T3 ;isolate bits which were changed to 1 ANDCM Q3,T3 ;isolate bits which were changed to 0 SKIPN T1,FK1022 ;get fork handle of 1022 fork CALL GFK22 ;don't have fork handle so get it now JUMPE T1,RET1## ;dismiss interrupt if no 1022 fork yet RPCAP% ;get current capability word for... JERR (%,,PC) ; ...the 1022 inferior fork TDO T3,Q2 ;set these bits to 1 TDZ T3,Q3 ;set these bits to 0 EPCAP% ;change the capability word for the fork JERR (%,,PC) RET ;dismiss interrupt ;============================================================================= ;Routine to handle ^T interrupts. Information similar to what the EXEC ;outputs for ^T will be displayed however it is output for the fork 1022 is ;running in CTRLT: IP.SAVE ;save F to P SPTR T1,< > PSOUTL ; output time MOVEI T1,.PRIOU SETO T2, ;output current time MOVX T3,OT%NDA ;don't output the date ODTIM% JERR (%,,PC) TMSG < 1022 > ; output status of inferior fork + PC SKIPN T1,FK1022 ;get fork handle of 1022 fork CALL GFK22 ;don't have fork handle so get it now CALL FSTAT ;output status ; output the CPU time used and total elapsed time CTRLT5: TMSG < Used > MOVEI T1,.FHJOB ;get run time for entire job RUNTM% MOVEM T3,P1 ;save console time CALL TYTIME ;output cpu time in hh:mm:ss MOVEI T2,"." BOUT% ERJMP CTRLT9 IDIVI Q2,^D<100> ;calculate 10th of a second of cpu used MOVE T2,Q2 TLZ T3,-1 NOUT% ERJMP CTRLT9 TMSG < in > MOVE T1,P1 ;get console time CALL TYTIME ;output console time in hh:mm:ss ; output 1 miniute system load average TMSG <, Load > MOVE T1,[14,,.SYSTA] ;get 1 min. load average GETAB% ERJMP CTRLT9 MOVE T2,T1 ;put load average here MOVEI T1,.PRIOU MOVE T3,[FL%ONE!FL%PNT!FL%OVL!FLD(2,FL%FST)!FLD(2,FL%SND)] FLOUT% ERJMP CTRLT9 CTRLT9: TMSG < > RET ;dismiss interrupt ;============================================================================= ; Routine to output the status of the fork plus the PC of the fork ; CALL FSTAT ;ACCEPTS: ; T1 - 0,,fork handle ;RETURNS: ; +1 - always with: ; T1-P1 - trashed FSTAT: TXO T1,RF%LNG ;long form MOVEI T2,T4 ;start putting status block here MOVEI T4+.RFCNT,.RFSFL+1 RFSTS% ;get status ERJMP FSTAT9 HLRZ T3,T4+.RFPSW ;get status CAIN T3,-1 ;was fork handle ok? JRST [ TMSG ;may have been killed by... JRST FSTAT9] ; ...a superior fork TXZ T3,(RF%FRZ) ;zero frozen bit CAIL T3,FKSTLN ;do I know about this status? SETO T3, ;no, unknown status HRRO T1,FKSTAB(T3) ;get status message PSOUT% CAIN T3,.RFFPT ;was it forced termination? JRST [ TMSG < on PSI channel > MOVEI T1,.PRIOU HRRZ T2,T4+.RFPSW ;get PSI channel which... MOVEI T3,^D10 ; ...forced the termination NOUT% ERJMP FSTAT9 JRST .+1] ; output PC fork is at TMSG < at > MOVEI T1,.PRIOU MOVEI T3,10 ;print in octal TLNE T4+.RFPPC,-1 ;does PC have a section number? JRST [ HLRZ T2,T4+.RFPPC ;yes, get left half of PC NOUT% ERJMP FSTAT9 TMSG <,,> MOVEI T1,.PRIOU ;restore AC JRST .+1] HRRZ T2,T4+.RFPPC ;get right half of PC NOUT% ERJMP FSTAT9 FSTAT9: RET [ASCIZ/unknown status (call DP)/] FKSTAB: [ASCIZ/running/] [ASCIZ/IO wait/] [ASCIZ/halted/] [ASCIZ/forced termination/] [ASCIZ/fork wait/] [ASCIZ/sleep/] [ASCIZ/JSYS trap wait/] [ASCIZ/address break wait/] FKSTLN==.-FKSTAB ;length of status message table ;============================================================================= ; Routine to output time in the form "hh:mm:ss". ; CALL TYTIME ;ACCEPTS: ; T1 - time in milliseconds ;RETURNS: ; +1 - always with: ; T1 - .PRIOU ; T2,T3 - as left by call to NOUT ; T4-Q1 - trashed ; Q2 - # milliseconds remainder TYTIME: MOVEM T1,T3 ;save time IDIV T3,[^D<60*60*1000>] ;calculate hours MOVE T2,T3 MOVEI T1,.PRIOU MOVEI T3,^D10 NOUT% ERJMP .+1 MOVEI T2,":" BOUT% ERJMP .+1 IDIVI T4,^D<60*1000> ;calculate minutes MOVE T2,T4 HRLI T3,(NO%LFL!NO%ZRO!NO%AST!2B17) NOUT% ERJMP .+1 MOVEI T2,":" BOUT% ERJMP .+1 IDIVI Q1,^D<1000> ;calculate seconds MOVE T2,Q1 NOUT% ERJMP .+1 RET ;============================================================================= ;Routine to get the fork handle of the 1022 fork. ; CALL GFK22 ;ACCEPTS: no registers need to be initialized ;RETURNS: +1 always with fork handle in T1 ;Trashes T1-T3 GFK22: MOVEI T1,.FHSLF ;start here for fork structure MOVX T2,GF%GFH ;return fork handles MOVE T3,[-ATMBLN,,ATMBUF] ;store info here SETZM ATMBUF ;incase GFRKS% fails GFRKS% JERR (%,,PC) HRRZ T1,ATMBUF ;get ptr to inferior fork JUMPE T1,GFK22E ;jump if NO inferior exists HRRZ T1,1(T1) ;get fork handle MOVEM T1,FK1022 ;save it GFK22E: RET SUBTTL Commands specific to 2022 ;============================================================================= ;Command tables ro commands specific to the 2022 program ;table for the 2022 top-level commands CM2TAB: CM2TLN,,CM2TLN ;actual,,max length of table TBL (EXIT) TBL (HELP,,.HELP##) TBL (INFORMATION) TBL (QUIT,,.QUIT##) ;to exit 2022 command level TBL (SET,,.SET##) TBL (TAKE,,.TAKE##) CM2TLN==<.-CM2TAB>-1 ;table for the 2022 SET command SETTAB: SETTLN,,SETTLN ;actual,,max length of table TBL (DISPLAY,,.SDISP) TBL (ECHO,,.SECHO##) TBL (NO,,.SNO##) SETTLN==<.-SETTAB>-1 ;============================================================================= ; Top-level command server for 2022 .R2022: PARSE (,<.CMKEY,,CM2TAB,,,,CONFRM>) TLZ T3,-1 ;get function discriptor block parsed CAIE T3,CONFRM ;user confirmed command? IFSKP. ;no CALL DOECHO## ;echo if necessary MOVEI T1,ENDCMD ;exit routine for this command level HRROI T2,[ASCIZ/2022>>/] ;prompt string for this command level CALL BEGCML## ;set up this command level PARSE (,<.CMKEY,,CM2TAB,>) ENDIF. HRRZ T4,(T2) ;get address of command server JRST (T4) ;dispatch to it ;----------------------------------------------------------------------------- ;Server for SET DISPLAY .SDISP: NOISE (commands that are sent to 1022) CONFIRM TXO F,F%DISP ;assume display TXNE F,F%NO ;was "NO" keyword parsed? TXZ F,F%DISP ;yes JRST ENDCMD ;go get another command ;============================================================================= ; Server for INFORMATION command C.INFO < TMSG < Command send to 1022 will > SPTR T1, TXNN F,F%DISP ;display commands? PSOUT% ;no TMSG >; end of C.INFO ;============================================================================= ;Routine to output the version of this program OUTVER: TMSG < 2022 version > LDB T2,[POINT 9,ENTVEC+2,11] ;VMAJOR NUMOUT (-,^D8) LDB T1,[POINT 6,ENTVEC+2,17] ;VMINOR ADDI T1,"A"-1 PBOUT% MOVEI T1,"(" PBOUT% HRRZ T2,ENTVEC+2 ;VEDIT NUMOUT (-,-) MOVEI T1,")" PBOUT% LDB T2,[POINT 3,ENTVEC+2,2] ;VWHO JUMPE T2,IVERS8 ;jump if no VWHO MOVEI T1,"-" PBOUT% NUMOUT (-,-) IVERS8: TMSG < > RET ;----------------------------------------------------------------------------- LITPOL: XLIST ;so user can identify literal pool when running DDT LIT ;put literals here LIST END ;set length and start of entry vector