Trailing-Edge
-
PDP-10 Archives
-
decuslib20-10
-
decus/20-184/2022.mac
There are no other files named 2022.mac in the archive.
;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 <usually-in-the-same-directory-as-1022.EXE>
;
;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 <usually-in-the-same-directory-as-1022.EXE>
;
;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==<VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT
DEFINE VDISP (VMAJ,VMIN) <PX <Assembling 2022 for version VMAJ'VMIN of 1022>>
VDISP (\VMAJOR,\"<VMINOR+"A"-1>)
IFG <116-VMAJOR>,<PX <?Program not tested for versions less than 116>>
.V117B==<VMAJOR-117>_6 + <VMINOR-2>
.V117A==<VMAJOR-117>_6 + <VMINOR-1>
.V116B==<VMAJOR-116>_6 + <VMINOR-2>
DEFINE V117B (AAA) <IFGE .V117B,<AAA>>
DEFINE V117A (AAA) <IFGE .V117A,<AAA>>
DEFINE V116B (AAA) <IFGE .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<ret> 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 <ret>" not allowed
;DLW 29-Oct-85 17 -fix so "INFORM ATTRIBUTE <ret>" not allowed
;DLW 29-Oct-85 20 -fix so "ON <file>" 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 <del> character. When using this macro the
;; string should not have any ")" in it otherwise RMVNOI will not work
;; correctly
PARSE (,<.CMNOI,,<POINT 7,[<774000000000>!<ASCII\ $CH4\>
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 <MOVEM F,SAVE.F>
DEFINE RESTAC <MOVE F,SAVE.F>
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 <DBEXEC><$DBNAM>,< SAVEAC ;;save registers>
IFIDN <DBEXEC><$DBNAM>,< CALL SATI ;;save + activate ^T>
CALL $DBNAM## ;;call the 1022 routine
IFDIF <DBEXEC><$DBNAM>,< RESTAC ;;restore registers>
IFIDN <DBEXEC><$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,<EQ or =>,,BKEQ,0)
ASFDB: FLDBK. (.CMKEY,CM%SDH,$AS,<AS>,,,0)
VIAFDB: FLDBK. (.CMKEY,CM%SDH,$VIA,<VIA>,,,0)
TOFDB: FLDBK. (.CMKEY,CM%SDH,$TO,<TO>,,,0)
BYFDB: FLDBK. (.CMKEY,CM%SDH,$BY,<BY>,,,0)
ONFDB: FLDBK. (.CMKEY,CM%SDH,$ON,<TO>,,,0) ;fake help message
INFDB: FLDBK. (.CMKEY,CM%SDH,$IN,<IN <file>>,,,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/=<variable-name>/] ;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,<POINT 7,[ASCIZ/@/]>) ;for parsing "@"
FDMX: FLDBK. (.CMFIL,CM%SDH,,<file specs for DMX>)
FDMV: FLDBK. (.CMFIL,CM%SDH,,<file specs for DMV>)
FDMD: FLDBK. (.CMFIL,CM%SDH,,<file specs for DMD>)
FDMI: FLDBK. (.CMFIL,CM%SDH,,<file specs for DMI>)
FDMS: FLDBK. (.CMFIL,CM%SDH,,<file specs for DMS>)
FDMSN: FLDBK. (.CMFIL,CM%SDH,,<file specs for DMS>,,,FDSN)
FDSN: FLDBK. (.CMFLD,CM%SDH,,<data set name>,,BKDSN)
FDSD: FLDBK. (.CMFIL,CM%SDH,,<file specs for DMS>,,,FDSDNA)
FDSDNA: FLDBK. (.CMFLD,CM%SDH,,<data set name>,,BKDSN,FDSDAL)
FDSDAL: FLDBK. (.CMFLD,CM%SDH,,<data set alias>,,BKDSN,FDSDNU)
FDSDNU: FLDBK. (.CMNUM,CM%SDH,^D10,<data set number>)
FKATR: FLDBK. (.CMFLD,CM%SDH,,<keyed attribute name>,,BKATR)
FKATRC: FLDBK. (.CMFLD,CM%SDH,,<keyed attribute name>,,BKATR,CONFRM)
FATR: FLDBK. (.CMFLD,CM%SDH,,<attribute name>,,BKATR)
FATRC: FLDBK. (.CMFLD,CM%SDH,,<attribute name>,,BKATR,CONFRM)
FCOL: FLDBK. (.CMFLD,CM%SDH,,<collection-name>,,BKDSN)
FCHN: FLDBK. (.CMNUM,CM%SDH,^D10,<channel number (1-8)>)
FCHNC: FLDBK. (.CMNUM,CM%SDH,^D10,<channel number (1-8)>,,,CONFM)
FCHF: FLDBK. (.CMNUM,CM%SDH,^D10,<channel number (1-8)>,,,FFIL)
FPRNT: FLDBK. (.CMKEY,,$PRINT)
FVAR: FLDBK. (.CMFLD,CM%SDH,,<variable-name>,,BKVAR)
FFIL: FLDBK. (.CMFIL)
FNUM: FLDBK. (.CMNUM,,^D10)
FSRT: FLDBK. (.CMFLD,CM%SDH,,<attribute-name or sort-expression>,,BKELS)
FSRTC: FLDBK. (.CMFLD,CM%SDH,,<attribute-name or sort-expression>,,BKELS,CONFRM##)
FPSVL: FLDBK. (.CMKEY,,SYSTAB,<system-variable>,,,FPLST)
FPLST: FLDBK. (.CMFLD,CM%SDH,,<print-list [FORMAT format-list END]>)
FPLSTE: FLDBK. (.CMFLD,CM%SDH,,<print-list [FORMAT format-list END]>,,BKEOL)
;function descriptor blocks for finding records
FFIND: FLDBK. (.CMKEY,,FINTAB,,,,FFIND2)
FFIND2: FLDBK. (.CMCFM,CM%SDH,,<selection-criteria>,,,[
FLDBK. (.CMKEY,,ROPTAB,<relational operator>,,,[
FLDBK. (.CMKEY,,LOPTAB,<logical operator>,,,[
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 <ACCESS>
KWT1 <ADD>
KWT1 <ALL>
KWT1 <BLANKS>
KWT1 <BUFFERS>
KWT1 <DATA>
KWT1 <DAMAGE>
KWT1 <DESC>
KWT1 <FOR>
KWT1 <INTEGER>
KWT1 <JOIN>
KWT1 <LENGTH>
KWT1 <NOCLOSE>
KWT1 <PASSWORD>
KWT1 <PRINT>
KWT1 <READONLY>
KWT1 <SYNC>
KWT1 <USE>
KWT1 <USING>
KWT1 <V>
;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) ; ...<esc> 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,<ER1022,IERT,IERC,[0]>) ;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 "@<indirect-file>"
IORM T4,CMDBLK+.CMFLG ;set flag word
PARSE (,<.CMKEY,,CMDTAB,<A 1022 command,>,,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,<DMV>
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,<relational operator>>)
RET
;-----------------------------------------------------------------------------
; server for the FIND LAST keyword
.FILAS: TXO F,F%RNOP ;have DOCMD return on CM%NOP
PARSE (,<.CMKEY,,ROPTAB,<logical operator>,,,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,<LST>
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 <file> or <channel>" 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,,<list of <attribute> <new-value>>,,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,,<relative position expression>,,BKEOL,CONFM)
.GETRE: SPTR T4,<to get next record in selection group>
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,,<CLEAR>>)
CALLRET XKEYW ;expand abbreviated keyword
SUBTTL Servers for INFORM command
;=============================================================================
.INFO: HRLZI T3,FINFO ;address of FDB for INFORM command
; SPTR T4,<INFORM>
SPTR T4,<>
MOVEM T4,GTJBLK+.GJEXT ;set default file extension
TXO F,F%NCHN ;don't allow channel number
CALL PONCF ;parse "ON <file>" 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==<VWHO>B2+<VMAJOR>B11+<VMINOR>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,,<NAME>,,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,<VALUES>
SPTR T4,<>
MOVEM T4,GTJBLK+.GJEXT ;set default file extension
TXO F,F%NCHN ;don't allow channel number
CALL PONCF ;parse "ON <file>" 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,<sequence-descriptor>,<ASCENDING>,,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,<buffer size (3 or more)>,<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,,<scratch device for sort (leave the ":" suffix off)>>)
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 (?,<shouldn't get here>,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,,<alias data set name>,,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,,<data set password>,,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 (?,<shouldn't get here>,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,,<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,,<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,,<join-name>,,BKDSN>)
RET
SUBTTL Servers for ENABLE, DISABLE commands
;=============================================================================
.ENABL: SPTR T4,<to enable ALL joins>
TRNA
.DISAB: SPTR T4,<to disable ALL joins>
MOVEM T4,CONFM+.CMHLP
PARSE (,<.CMKEY,,$JOIN,,<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,<to clear user defined variable names>
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,<to clear ALL collections>
MOVEM T4,CONFM+.CMHLP
PARSE (,<.CMFLD,CM%SDH,,<collection-name, collection-name, ...>,,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,,<collection-name, collection-name, ...>,,BKEOL,CONFM>)
RET.2
;-----------------------------------------------------------------------------
; server for the JOIN keyword
.CLRJ: SPTR T4,<to clear ALL join definitions>
MOVEM T4,CONFM+.CMHLP
.EDJ: PARSE (,<.CMFLD,CM%SDH,,<join-name, join-name, ...>,,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,,<join-name, join-name, ...>,,BKEOL,CONFM>)
RET.2
SUBTTL Servers for ACCEPT command
;=============================================================================
.ACCEP: NOISE2 (valu,e for variable)
PARSE (,<.CMFLD,CM%SDH,,<variable-name, variable-name, ...>,,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,<to use last file used>
MOVEM T4,CONFM+.CMHLP
MOVX T4,GJ%OLD ;parse existing file
MOVEM T4,GTJBLK+.GJGEN
SPTR T4,<DMC>
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<ret>"
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,<FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!FLD(.JSAOF,JS%NAM)!FLD(.JSAOF,JS%TYP)!JS%PAF>,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,,<comment text>,,BKEOL>)
JRST TYADD. ;join common code
SUBTTL Server for #TYPE command
;=============================================================================
.TTYPE: NOISE2 (mess,age)
PARSE (,<.CMFLD,CM%SDH,,<text message>,,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 ; ...<attribute-list> 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 ; ...<attribute-list> 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
;<attribute-list>. Once an attribute or a keyword in the <attribute-list>
;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 <attribute-list>?
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 <attribute-list> are NOT...
RET ; ...parsed again
KEYIN7: TXO F,F%INI ;say starting <attribute-list>
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,,,<disk structure (no ":") to be used a scratch device for sorting>>)
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,<<directory-name>>)]>)
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,,<password>,,BKPAS>)
RET
;-----------------------------------------------------------------------------
; server for the ADMIT CLASS command
.ADCLS: PARSE (,<.CMKEY,,$PASSWORD,,<PASSWORD>>)
CALL XKEYW ;expand abbreviated keyword
CALL .APASS ;get password
PARSE (,<.CMKEY,,ADM2TB,<access-code>,<UPDATE>,,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 <user-id> command
.ADUSR:
PARSE (,<.CMKEY,,ADM2TB,<access-code>,<UPDATE>,,[
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,<access-code>,<READONLY>,,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,,<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,<to be prompted for rest of attributes>
MOVEM T4,CONFM+.CMHLP
PARSE (,<.CMFLD,CM%SDH,,<list of <attribute> <value> ...
or NUL<ret>>,,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,,<data to pass to MACRO routine>,,BKEOL>)
CONFIRM
JRST DBEX ;do DBEXEC
SUBTTL Servers for IF command
;=============================================================================
.IF: NOISE2 (cond,ition)
PARSE (,<.CMFLD,CM%SDH,,<<boolean-expression> THEN <commands>
ELSEIF <boolean-expression> THEN <commands>
ELSE <commands>
ENDIF or END>,,BKEOL>)
CONFIRM
JRST DBEX ;do DBEXEC
SUBTTL Servers for ELSEIF command
;=============================================================================
.ELSEI: NOISE2 (cond,ition)
PARSE (,<.CMFLD,CM%SDH,,<<boolean-expression> THEN <commands>
ELSE <commands>
ENDIF or END>,,BKEOL>)
CONFIRM
JRST DBEX ;do DBEXEC
SUBTTL Servers for ELSE command
;=============================================================================
.ELSE: PARSE (,<.CMFLD,CM%SDH,,<<commands> ENDIF or END>,,BKEOL>)
CONFIRM
JRST DBEX ;do DBEXEC
SUBTTL Servers for UNTIL command
;=============================================================================
.UNTIL: NOISE2 (cond,ition)
PARSE (,<.CMFLD,CM%SDH,,<<boolean-expression>>,,BKEOL>)
CONFIRM
JRST DBEX ;do DBEXEC
SUBTTL Servers for WHILE command
;=============================================================================
.WHILE: NOISE2 (cond,ition)
PARSE (,<.CMFLD,CM%SDH,,<<boolean-expression> DO <commands> ENDWHILE or END>,,BKEOL>)
CONFIRM
JRST DBEX ;do DBEXEC
SUBTTL Servers for REPEAT command
;=============================================================================
.REPEA: PARSE (,<.CMFLD,CM%SDH,,<<commands> UNTIL <boolean-expression>>,,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,,<data for command>,,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,<to edit last file edited>
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
; <return> 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<ret>"
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,<FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!FLD(.JSAOF,JS%NAM)!FLD(.JSAOF,JS%TYP)!JS%PAF>,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 (-,<FLD(.JSAOF,JS%NAM)>,-)
IBP T1 ;presve null at end
MOVEM T1,GTJBLK+.GJEXT ;save ptr to default file type
FILSTR (-,<FLD(.JSAOF,JS%TYP)>,-)
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,<LST>
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,,,<TTY: or>>)
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,<DIF>
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,,<column to begin printing at (A...Z,AA...AZ,AAA...AZZ,etc)>,<A>>)
RET
;-----------------------------------------------------------------------------
; server for the DIF/123 ROW keyword
.IDROW: PARSE (,<.CMNUM,CM%SDH,^D10,<row number to begin printing at>,<1>>)
RET
;-----------------------------------------------------------------------------
; server for the DIF NCOLS keyword
.IDNCO: PARSE (,<.CMNUM,CM%SDH,^D10,<number of columns in DIF file (between 1 and 2**18-1)>,<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,<WKS>
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,,<range name>>)
PARSE (,<.CMFLD,CM%SDH,,<column Named range begins at (A...Z,AA...AZ,AAA...AZZ,etc)>>)
PARSE (,<.CMNUM,CM%SDH,^D10,<row number Named range begins at>>)
PARSE (,<.CMFLD,CM%SDH,,<column Named range ends at (A...Z,AA...AZ,AAA...AZZ,etc)>>)
PARSE (,<.CMNUM,CM%SDH,^D10,<row number Named range ends at>>)
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,<to release ALL assigned channels>
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,,<character to type out before all error messages>,,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,<to reset default prompt>
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,,<new prompt in double (") quotes>>)
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 <channel>" 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 <channel>" 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,<number of lines to reserve at bottom of page>)
.FOOTI: HRLZI T3,FFOOT
TXO F,F%NFIL ;don't accept file-specs
CALL PONCF ;parse "ON <channel>" 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,,<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,,<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,<DMI>
MOVEM T4,GTJBLK+.GJEXT ;set default file extension
PARSE (,<.CMFIL,CM%SDH,,<file specs of new location>>)
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,<DMV>
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,<EXE>
MOVEM T4,GTJBLK+.GJEXT ;set default file extension
TXO F,F%RNOP ;have DOCMD return on CM%NOP
RUN2: PARSE (,<.CMFIL,CM%SDH,,<file specs of program to run>>)
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,<SYS:>
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,<to enter 1022 command level>
MOVEM T4,CONFM+.CMHLP
MOVE P1,CMDBLK+.CMPTR ;initialize ptrs incase command parsed
MOVE P2,[POINT 7,CMDB22]
PARSE (,<.CMFLD,CM%SDH,,<command line to send to 1022>,,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,<ER1022,IERT,IERC,[1]>) ;tell 1022 to display errors
$1022 (DBEXEC)
; $1022 (DBERR,<ER1022,IERT,IERC,[0]>) ;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,<DMA>
MOVEM T4,GTJBLK+.GJEXT ;set default file extension
TXO F,F%RNOP ;have DOCMD return on CM%NOP
COMPI2: PARSE (,<.CMFIL,CM%SDH,,<file specs of DMA (or DMC) to compile>>)
TXNN T1,CM%NOP ;parsed the file OK?
IFSKP. ;yes
; I didn't find a ".DMA" so try a ".DMC"
SPTR T4,<DMC>
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 (-,<FLD(.JSAOF,JS%NAM)>,-)
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,<DMX>
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,<DMX>
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,<a variable type>,,,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,,<INTEGER>>)
CALLRET XKEYW ;expand abbreviated keyword
;-----------------------------------------------------------------------------
; server for the TEXT keyword
.DEFT: PARSE (,<.CMNUM,CM%SDH,^D10,<text length (1 to 65535)>>)
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,<system-variable>,,,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,,<new delimiter in double quotes>,<,>)]
CALLRET LETEQ ;join common code
;-----------------------------------------------------------------------------
; server for INTEGER system variables
PSINT: HRRI T4,[FLDBK. (.CMNUM,CM%SDH,^D10,<new value (integer)>)]
CALLRET LETEQ ;join common code
;-----------------------------------------------------------------------------
; server for REAL system variables
PSREAL: HRRI T4,[FLDBK. (.CMFLT,CM%SDH,,<new value (real)>)]
CALLRET LETEQ ;join common code
;-----------------------------------------------------------------------------
; server for DATE system variables
PSDATE: HRRI T4,[FLDBK. (.CMQST,CM%SDH,,<date in double quotes>)]
; HRRI T4,[FLDBK. (.CMTAD,,CM%IDA)]
CALLRET LETEQ ;join common code
;-----------------------------------------------------------------------------
; server for TEXT system variables
PSTXT: HRRI T4,[FLDBK. (.CMQST,CM%SDH,,<new value in double quotes>)]
CALLRET LETEQ ;join common code
SUBTTL Servers for EVALUATE command
;=============================================================================
.EVALU: NOISE2 (all ,selected records into variable)
LET5: PARSE (,<.CMFLD,CM%SDH,,<<variable> EQ,= <expression>>,,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,,<EXEC-command or END>,,BKEOL>)
;;; CONFIRM
;;; SPTR T4,<EXEC-command or END>
;;; 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,,<EXEC-command>,,BKELS)]>)
HRROI T1,ATMBUF ;see if "END" parsed
SPTR T2,<END>
STCMP%
JUMPE T1,PUSH8 ;quit when "END" is found
HRROI T1,ATMBUF ;see if "END." was parsed
SPTR T2,<END.>
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 <crlf>
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 <END>
;;;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,,<new internal data set name>,,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,,<new attribute abbreviation (1-5 characters)>,,BKATR>)
RET
;-----------------------------------------------------------------------------
; server for the $ATTRIBUTE NAME keyword
.MOATN: PARSE (,<.CMFLD,CM%SDH,,<new attribute name>,,BKATR>)
RET
SUBTTL Servers for UPDATE command
;=============================================================================
.UPDAT: SPTR T4,<to turn update ON>
MOVEM T4,CONFM+.CMHLP
PARSE (,<.CMKEY,,UPDTAB,,<ON>,,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,<a 1022 version (116,117,etc...)>>)
CONFIRM
JRST DBEX
SUBTTL Servers for BODY, PAGE, TYPAGE commands
;=============================================================================
.BPTYP: HRLZI T3,[FLDBK. (.CMNUM,CM%SDH,^D10,<number of lines/page>,<60>)]
TXO F,F%NFIL ;don't accept file-specs
CALL PONCF ;parse "ON <channel>" phrase
IFSKP. ;failed, parsed something else instead
PARSE (,<.CMNUM,CM%SDH,^D10,<number of lines/page>,<60>>)
ENDIF.
CONFIRM
JRST DBEX
SUBTTL Servers for HELP command
;=============================================================================
.PHELP: MOVX T4,CM%XIF ;don't recognize "@<indirect-file>"
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,,<additional subtopics>,,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 <esc>?
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 <esc>?
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,<DMD>
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,<DMI>
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 <esc> 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,<DMS>
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 <file>. 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 <esc> 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,<DMS>
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 <file> or <channel>" 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 <file> or <channel>\
ONCHTX: ASCIZ\ON <channel>\
ONFITX: ASCIZ\ON <file>\
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 (-,<FLD(.JSAOF,JS%NAM)>,-)
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 <crlf> incase there is a "!" comment in the
; command. If <crlf> 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 <cr> or <lf>
$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,<CMDB22,DBEMOR>)
RET
;-----------------------------------------------------------------------------
;1022 will jump here when it needs more information to complete a command.
;(Eg: if user entered "ADD <ret>" 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,<value for attrubute
or NUL to give this and all further attributes null values>
MOVEM T4,FAD4D+.CMHLP
;&&& must remove the terminating <crlf> 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 <cr> or <lf>
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 <?1022: (>
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 <cr>,<lf> 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 <program disappeared> ;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,<A 2022 command,>,,,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,<A 2022 command,>>)
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,<NOT >
TXNN F,F%DISP ;display commands?
PSOUT% ;no
TMSG <be displayed
>
>; 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 <EVLEN,,ENTVEC> ;set length and start of entry vector