2! PROGRAM : DCLSYS.BAS 5! VERSION : V1.0 6! EDIT : D 7! EDIT DATE : 24-OCT-89 10 EXTEND 11 ! & & & ! C O P Y R I G H T & & & ! Copyright (C) 1989 by & ! Digital Equipment Corporation, Maynard, Mass. & 20 ! & & & ! M O D I F I C A T I O N H I S T O R Y & & & ! VER-ED EDIT DATE Who REASON & ! V1.0-A 30-SEP-89 PRL Creation & ! V1.0-B 12-Oct-89 PRL Add CHR function & ! V1.0-C 15-Oct-89 PRL Use quote delims for strings & ! V1.0-D 24-Oct-89 PRL Cleanup from code review & 30 ! & & & ! P r o g r a m D e s c r i p t i o n & & & ! DCLSYS is a basic plus program that can be "called" (via a CCL) & ! from a DCL command procedure to perform any of the following & ! functions: & & ! SYS Execute BASIC-PLUS SYS call & ! PEEK Execute BASIC_PLUS PEEK function & ! RAD Convert RAD50 word/byte values to string & ! CHR Convert (character) word/byte values to string & & ! DCLSYS can only be invoked through a CCL or CHAIN entry; it & ! cannot be run. DCLSYS displays an error and exits if it is & ! run. & & ! DCLSYS can be compiled under BASIC-PLUS or BASIC-PLUS-2. The & ! executable file can be located in _SY:[1,2] or another location. & & ! Assign protection code <104> for non-privileged use, or <124> to & ! restrict access. DO NOT ASSIGN temporary privileges to DCLSYS. & & ! Define the following CCLs to provide access to DCLSYS functions: & & ! $ define/command/system/line=30000 DCLSYS _SY:[1,2]DCLSYS.* & ! $ define/command/system/line=30100 DCLPEEK _SY:[1,2]DCLSYS.* & ! $ define/command/system/line=30200 DCLRAD _SY:[1,2]DCLSYS.* & ! $ define/command/system/line=30300 DCLCHR _SY:[1,2]DCLSYS.* & & ! For complete details on the use and operation of DCLSYS, see & ! the Fall 1989 DECUS (Anaheim) Session Notes. & 100 ! R U N E n t r y & & & print "?DCLSYS cannot be RUN - use CCL" & \ goto 32767 & ! display error messages & ! make a quick exit & 900 ! D i m e n s i o n S t a t e m e n t s & & & dim char%(127) ! argument char array & \ dim firqb%(40) ! SYS call byte table & \ dim arg.type%(40), ! arg type table & arg.number%(40), ! arg word/byte table & arg.string$(40) ! arg string table & 1000 ! M a i n P r o g r a m & & & on error goto 19000 & ! set standard error trap & & \ junk$ = SYS (chr$(6%) + chr$(-21%)) & ! drop temp privs for good & & \ gosub 2000 & ! gosub to initialize everything & & \ gosub 10000 & \ goto 32767 if error.code% <> 0% & ! gosub to get args from core common & ! exit if any errors & & \ gosub 11000 & \ goto 32767 if error.code% <> 0% & ! gosub to parse arg string & ! exit if any errors & & \ gosub 12000 & \ goto 32000 & ! gosub to execute function call & ! exit/execute DCL command & 2000 ! I n i t i a l i z e P r o g r a m V a l u e s & & & sign.chars$ = "+-" & \ digit.chars$ = "0123456789" & \ num.chars$ = sign.chars$ + digit.chars$ & \ prefix.chars$ = '/\"' & \ start.chars$ = prefix.chars$ + num.chars$ & \ space.chars$ = " " + chr$(9%) & ! define useful strings for validity checks & & \ EOL.char% = 11% & \ quote.char% = ascii('"') & ! define special EOL char & ! define quote char & & \ error.code% = 0% & ! init error code to show success & & \ return & ! exit & 10000 ! G e t A r g s F r o m C o r e C o m m o n & & & junk$ = sys(chr$(7%)) & \ junk% = instr(1%,junk$," ") & \ goto 13100 if junk% = 0% & \ args$ = cvt$$(right(junk$,junk%+1%),8%+128%) & \ return & ! get core common & ! find 1st space after CCL name & ! skip to '?Not enough args' error if none (null arg) & ! save arg string (strip leading/trailing spaces) & ! exit & 11000 ! P a r s e A r g s & & & change args$ to char% & \ char%(0%) = char%(0%) + 1% & \ char%(char%(0%)) = EOL.char% & \ state% = 1% & \ arg.idx% = 0% & ! convert arg string to bytes & ! incr line length for EOL char & ! add null char to indicate EOL & ! set state to 1 (looking for next arg) & ! init arg table index & & \ for char.idx% = 1% to char%(0%) & ! do for all characters in arg string: & & \ char% = char%(char.idx%) & \ char$ = chr$(char%) & ! save next char as integer & ! save next char as single-char string & & \ on state% gosub 11100, ! 1 = start of next arg & 11200, ! 2 = start of byte/word arg & 11300, ! 3 = inside byte/word arg & 11400 ! 4 = inside string arg & ! process next char based on current state & & \ return if error.code% <> 0% & \ next char.idx% & \ return & ! exit if error returned & ! next char & ! exit & 11100 ! S t a t e 1 : S t a r t o f N e x t A r g & & & return if (instr(1%,space.chars$,char$) > 0%) & or (char% = EOL.char%) & ! skip to next char if space or tab & ! or end of line reached & & \ if char$ = "/" then & goto 13500 unless allow.word% & \ arg.type% = 2% & \ state% = 2% & \ goto 11150 & ! if start of word arg, & ! display '?type not allowed' error if word not allowed & ! show arg type as word (2) & ! set new state to 2 (start of word/byte arg) & ! skip to set up for number arg & 11110 if char$ = "\" then & goto 13500 unless allow.byte% & \ arg.type% = 1% & \ state% = 2% & \ goto 11150 & ! if byte arg prefix, & ! display '?type not allowed' error if byte not allowed & ! show arg type as byte (1) & ! set new state to 2 (start of word/byte arg) & ! skip to set up for number arg & 11120 if instr(1%,num.chars$,char$) > 0% then & arg.type% = 1% & \ state% = 3% & \ gosub 11150 & \ goto 11200 & ! if +, -, or {0,...9}, & ! set arg type to default type (byte) & ! set new state to 3 (inside word/byte arg) & ! gosub to init number arg & ! treat the same as start of word/byte arg & 11130 goto 13500 unless allow.string% & \ arg.type% = 3% & \ state% = 4% & ! (must be start of a string arg) & ! display '?type not allowed' error if string not allowed & ! show arg type as string (3) & ! set new state to 4 (inside string arg) & & \ if char% = quote.char% then & chars$ = "" & \ delim% = -1% & \ return & ! if string starts with quote, & ! init string as null & ! set flag to show string is delimited & ! return to get next char & 11140 chars$ = char$ & \ delim% = 0% & \ return & ! (char must be 1st char in string) & ! save char as part of string & ! show string not delimited & ! return to get next char & 11150 number = 0. & \ sign% = 0% & \ unsigned% = -1% & \ repeat% = 1% & \ allow.repeat% = -1% & \ return & ! init arg number to 0 (fl pt) & ! init sign as + & ! init number as unsigned & ! init repeat multiplier as 1 & ! init to allow repeat operator & ! return & 11200 ! S t a t e 2 : S t a r t o f W o r d / B y t e A r g & & & goto 13300 if char% = EOL.char% & ! skip to '?Invalid number' error if end of line reached & & \ state% = 3% & ! set new state to 3 (inside word/byte arg) & & \ if instr(1%,sign.chars$,char$) > 0% then & unsigned% = 0% & \ sign% = (char$ = "-") & \ return & ! if char is a sign char (+ or -), & ! show number is signed (not unsigned) & ! save sign (-1 for "-", 0 for "+") & ! return to get next char & 11210 if instr(1%,digit.chars$,char$) > 0% then & goto 11300 & else goto 13300 & ! if char is a digit, & ! treat the same as inside word/byte arg & ! else (any other char is invalid) & ! display 'invalid number' error & 11300 ! S t a t e 3 : I n s i d e W o r d / B y t e A r g & & & goto 11330 if char% = EOL.char% & ! skip to finish field if end of line reached & & \ if instr(1%,digit.chars$,char$) > 0% then & number = number * 10. + (char% - 48%) & \ return & ! if char is a digit, & ! multiply arg number by 10 and add next digit & ! return to get next char & 11310 if char$ = "*" then & goto 13300 unless allow.repeat% & \ goto 13400 if number < 1. & \ goto 13200 if number > max.args% & \ repeat% = number & \ allow.repeat% = 0% & \ number = 0. & \ return & ! if repeat operator, & ! skip to '?Invalid number' error if multiple repeats & ! skip to '?Number out of range' error if repeat < 1 & ! skip to '?Too many args' error if repeat > maximum & ! save repeat value & ! don't allow any more repeat args & ! reset arg number & ! return to get next char & 11320 goto 13300 if instr(1%,space.chars$,char$) = 0% & ! skip to '?Invalid number' error if not a space or tab & 11330 number = -number if sign% & \ goto 13400 if (number < fnmin.number(unsigned%,arg.type%)) & or (number > fnmax.number(unsigned%,arg.type%)) & ! invert number if sign was "-" & ! skip to '?Out of range' error if number < min or > max & & \ next.idx% = arg.idx% + 1% & \ arg.idx% = arg.idx% + repeat% & \ goto 13200 if arg.idx% > max.args% & ! save current arg table index & ! compute ending index based on repeat count & ! skip to '?Too many args' error if end index > maximum & & \ for idx% = next.idx% to arg.idx% & \ arg.type%(idx%) = arg.type% & \ arg.number%(idx%) = fnsigned%(number) & \ next idx% & \ state% = 1% & \ return & ! for each repeat value: & ! save arg type in table & ! save arg number in table & !next repeat & ! reset state to look for start of new arg & ! exit to get next character & 11400 ! S t a t e 4 : I n s i d e S t r i n g A r g & & & goto 11420 if char% = EOL.char% & ! skip to finish if end-of-line reached & & \ goto 11420 if instr(1%,space.chars$,char$) > 0% & unless delim% & ! skip to finish arg if space or tab char & ! unless string is delimited & & \ if delim% then & if char% = quote.char% then & if char%(char.idx% + 1%) <> quote.char% then & goto 11420 & else char.idx% = char.idx% + 1% & ! if string is delimited, & ! if char is a quote, & ! if next char is not a quote, & ! go finish the string & ! else incr index to skip next quote & 11410 chars$ = chars$ + char$ & \ return & ! append char to string & ! return to get next char & 11420 arg.idx% = arg.idx% + 1% & \ goto 13200 if arg.idx% > max.args% & ! (end of string reached) & ! incr arg index & ! display 'too many args' error if > maximum & & \ arg.type%(arg.idx%) = arg.type% & \ arg.string$(arg.idx%) = chars$ & \ state% = 1% & \ return & ! incr arg table index & ! save arg type in arg table & ! save string in arg table & ! set state to show start of new arg & ! return to get next char & 12000 ! E x e c u t e S Y S , P E E K , R A D , C H R C a l l & & & on error goto 12500 & ! trap function errors & & \ on function% gosub 12100, ! SYS function & 12200, ! PEEK function & 12300, ! RAD function & 12400 ! CHR function & ! gosub to processor based on function & & \ on error goto 19000 & \ return & ! restore standard error trap & ! exit & 12100 ! E x e c u t e S Y S F u n c t i o n & & & chars$ = "" & ! init SYS call string & & \ for idx% = 1% to arg.idx% & ! do for all defined args: & & \ if arg.type%(idx%) = 1% then & chars$ = chars$ + chr$(arg.number%(idx%)) & else if arg.type%(idx%) = 2% then & chars$ = chars$ + cvt%$(swap%(arg.number%(idx%))) & else chars$ = chars$ + arg.string$(idx%) & ! if byte arg, & ! append chr$(number) to SYS string & ! else if word arg, & ! append cvt%$(swap%(number)) to SYS string & ! else (string arg) & ! append string to SYS string & 12110 next idx% & ! next arg & & \ change SYS(chars$) to firqb% & \ firqb%(0%) = 30% if firqb%(0%) > 30% & ! do SYS call & change to byte table & ! don't (can't) return more than 30 bytes & & \ DCL.cmd$ = "$" + function$ + ":=" + fnbyte$(firqb%(1%)) & \ DCL.cmd$ = DCL.cmd$ + " " + fnbyte$(firqb%(idx%)) & for idx% = 2% to firqb%(0%) & ! init local assignment string & ! append "nnn " text (trailing blanks) & ! for all SYS call bytes returned & & \ error.code% = 0% & \ return & ! show success & ! exit & 12200 ! E x e c u t e P E E K F u n c t i o n & & & goto 13500 if arg.type%(idx%) = 2% & for idx% = 1% to max.args% & if arg.idx% > 1% & ! skip to '?Arg type not allowed' error if arg type is word & ! for all (both) args & ! if more than one arg passed & & \ address% = arg.number%(1%) & \ address% = address% or swap%(arg.number%(2%)) & if arg.idx% > 1% & ! init 1st arg value as address & ! add 2nd arg value to address (high byte) & ! if more than 1 arg passed (both must be bytes) & & \ number = PEEK(address%) & \ number = number + 65536. if number < 0. & ! call PEEK function on address & ! convert returned number to unsigned & & \ DCL.cmd$ = "$" + function$ + "=" + num1$(number) & ! build PEEK local assignment string & & \ error.code% = 0% & \ return & ! show success & ! exit & 12300 ! E x e c u t e R A D F u n c t i o n & & & DCL.cmd$ = "$" + function$ + '="' & ! init assignment string & & \ for idx% = 1% to arg.idx% & ! for each byte/word arg passed: & & \ junk% = arg.number%(idx%) & \ if arg.type%(idx%) = 1% then & if idx% < arg.idx% then & if arg.type%(idx%+1%) = 1% then & idx% = idx% + 1% & \ junk% = junk% or & swap%(arg.number%(idx%)) & ! get next arg number & ! if type = byte, & ! if more args, & ! if next byte is also a byte, & ! point to next byte & ! add to number to form word & 12310 DCL.cmd$ = DCL.cmd$ + RAD$(junk%) & \ next idx% & \ DCL.cmd$ = DCL.cmd$ + '"' & ! add next RAD$ string to DCL command & ! next arg & ! append closing quote & & \ error.code% = 0% & \ return & ! show success & ! exit & 12400 ! E x e c u t e C H R F u n c t i o n & & & DCL.cmd$ = "$" + function$ + '="' & ! init assignment string & & \ for idx% = 1% to arg.idx% & ! for each byte/word arg passed: & & \ if arg.type%(idx%) = 1% then & junk% = arg.number%(idx%) & \ gosub 12450 & \ goto 12420 & ! if arg type is byte, & ! get byte number & ! gosub to append to command & ! skip to next arg & 12410 junk% = arg.number%(idx%) and 255% & \ gosub 12450 & \ junk% = swap%(arg.number%(idx%)) and 255% & \ gosub 12450 & ! (assume type is word) & ! get low byte of word & ! gosub to append char to command & ! get high byte of word & ! gosub to append char to command & 12420 next idx% & \ DCL.cmd$ = DCL.cmd$ + '"' & ! next arg & ! append closing quote & & \ error.code% = 0% & \ return & ! show success & ! exit & 12450 DCL.cmd$ = DCL.cmd$ + CHR$ (junk%) & if fnvalid.char%(junk%) & \ return & ! append character to command string & ! if valid string character & ! return & 12500 ! H a n d l e F u n c t i o n E r r o r s & & & error.code% = - ERR & \ resume 12510 & ! save negative error code & ! resume to exit & 12510 return & ! exit & 13000 ! D i s p l a y D C L S Y S E r r o r s & & & 13100 print "?Not enough arguments" & \ goto 13900 & ! display '?Not enough args' error & ! skip to exit & 13200 print "?Too many arguments" & \ goto 13900 & ! display '?Too many args' error & ! skip to exit & 13300 print "?Invalid number argument" & \ goto 13900 & ! display '?Invalid number' error & ! skip to exit & 13400 print "?Number argument out of range" & \ goto 13900 & ! display '?Number arg out of range' error & ! skip to exit & 13500 print "?Argument type not allowed" & \ goto 13900 & ! display '?Arg type not allowed' error & ! skip to exit & 13900 error.code% = -1% & \ return & ! return error code = -1 & ! exit & 19000 ! S t a n d a r d E r r o r H a n d l e r & & & print "??Program failure in DCLSYS" & \ on error goto 0 & \ stop & ! display severe error & ! let BASIC handle the rest & ! stop (to quiet the critics) & 20000 ! P r o g r a m F u n c t i o n s & & & 20100 ! F u n c t i o n : f n m i n . v a l u e & & & def fnmin.number (unsigned%, arg.type%) & \ if unsigned% then & fnmin.number = 0. & else fnmin.number = -128. & \ fnmin.number = -32768. if arg.type% = 2% & ! if unsigned compare, & ! minimum is always 0 & ! else init minimum as -128 (byte) & ! return minimum as -32767 if word compare & 20110 fnend & 20200 ! F u n c t i o n : f n m a x . v a l u e & & & def fnmax.number (unsigned%, arg.type%) & \ if unsigned% then & fnmax.number = +255. & \ fnmax.number = +65535. if arg.type% = 2% & \ goto 20220 & ! if unsigned compare, & ! init maximum as +255 (byte) & ! return maximum as +65535 if word compare & ! skip to exit & 20210 if arg.type% = 1% then & fnmax.number = +127. & else fnmax.number = +32767. & ! (signed compare) & ! if byte compare, & ! return maximum as +127 & ! else return maximum as +32767 & 20220 fnend & 20300 ! F u n c t i o n : f n s i g n e d % & & & def fnsigned% (number) & \ number = number - 65536. if number > 32767. & \ fnsigned% = number & \ fnend & ! invert if number exceeds max signed word (32767) & ! return number as integer & 20400 ! F u n c t i o n : f n b y t e $ & & & def fnbyte$ (number%) = & right(num1$(1000% + number%),2%) & ! return 3-digit 'nnn' byte string & ! (leading zeros) & 20500 ! F u n c t i o n : f n v a l i d . c h a r % & & & def fnvalid.char% (char%) = & (((char% >= 32%) and (char% <= 126%)) & or & ((char% >= 161%) and (char% <= 254%))) & ! return -1 if printable GL or GR character & ! return 0 otherwise & 30000 ! D C L S Y S E n t r y P o i n t & & & function$ = "SYS" & \ function% = 1% & \ allow.byte%, allow.word%, allow.string% = -1% & \ max.args% = 40% & \ goto 1000 & ! set function name (SYS) & ! set function code (1) & ! allow byte, word and string args & ! allow up to 40 args & ! skip to main program entry & 30100 ! D C L P E E K E n t r y P o i n t & & & function$ = "PEEK" & \ function% = 2% & \ allow.word%, allow.byte% = -1% & \ allow.string% = 0% & \ max.args% = 2% & \ goto 1000 & ! set function name (PEEK) & ! set function code (2) & ! allow word and byte args & ! disallow string args & ! allow max of 2 args & ! skip to main program entry & 30200 ! D C L R A D E n t r y P o i n t & & & function$ = "RAD" & \ function% = 3% & \ allow.word%, allow.byte% = -1% & \ allow.string% = 0% & \ max.args% = 40% & \ goto 1000 & ! set function name (RAD) & ! set function code (3) & ! allow word and byte args & ! disallow string args & ! allow max of 40 args & ! skip to main program entry & 30300 ! D C L C H R E n t r y P o i n t & & & function$ = "CHR" & \ function% = 4% & \ allow.word%, allow.byte% = -1% & \ allow.string% = 0% & \ max.args% = 40% & \ goto 1000 & ! set function name (CHR) & ! set function code (4) & ! allow word and byte args & ! don't allow string args & ! allow max of 40 args & ! skip to main program entry & 32000 ! P r o g r a m E x i t & & & DCL.cmd$ = "$" + function$ + "=" + num1$(error.code%) & if error.code% <> 0% & ! build command line to assign error code & ! if error being returned & & \ junk$ = sys(chr$(14%) + DCL.cmd$) & \ stop & ! exit and execute temp COM file & ! stop, just in case (of what?) & 32767 end