.title CCL .ident /V6.AB/ .enabl LC .nlist BEX .sbttl Introduction ;+ ; JAMES G. DOWNWARD ; KMS FUSION, INC ; 3941 RESEARCH PARK DR. ; ANN ARBOR, MICH ; 313-769-8500 ; ; This program is the composite of two programs. One part uses a list of pre- ; defined commands(LIST, TYPE, DELETE...etc.) and turns them into MCR commands ; to the utilities. This part was paterned after DEC'S TDX or catchall task. ; It's included in the section 'DCL' which comprises the later part of CCL.MAC ; The second part of the program consists of code to open a file ; (USERCCL.CCL or SYSCCL.CCL) and see if the command entered corresponds ; to a command entered in the file. First the file USERCCL.CCL ; on the user's UIC and SY: is tried. If either the file does not exist ; or the command is not found, the scan is repeated using SYSCCL.CCL. ; The program logic is somewhat tangled since this is a melange of ; various programing styles, edits, and conversions from F4P. Without ; a single doubt, it should be rewritten into a single coherent ; program. The program starts out by seeing if it got a valid ; command line from MCR. If it did, it calls the DCL subroutine ; which checks to see if it matches the command in the command table. ; Note that if the first three letters match, DCL assumes it is a match, ; and will field the command, so commands which have the first three ; letters matching in a .CCL file will do no good at all. If a match is ; found the command is spawned to MCR, and ...CA. will stop itself until ; the command is executed and then will exit with the appropriate status. ; If DCL does not find the command a direct return is made to CCL ; which proceeds to open the .CCL files, and search for a command WHICH ; matches up to the first 9 letters. If a match is found, the prototype ; command line in the file is DECODED, fleshed out, and spawned to MCR. ; To provide notification when a lengthy CCL command exits, the user will ; be notified by the terminal bell ringing if %B is in the CCL command file line ; An important change by J. CLEMENT ; If this is the last command (beginning with *) CCL exits after spawning ; MCR. If you need the %B notification, then it must be the last command, or ; else the bell will occurr after the spawn, before the command is through. ; ;- .PAGE .sbttl Define assembly conditionals $DCL = 0 ; Enable DCL ;ALI $PIP = 0 ; Enable PIP subset of DCL ;ALI ;$DEBUG = 0 ; Enable debugging aids ; ; Define buffer length and maximum # of parameters allowed ; MAXPAR = 9. ; %1% to %9% ; ; Further misc. definitions ; CR = 15 ; LF = 12 ; ESC = 33 ; SPA = 40 ; Blank .SBTTL The original CCL ; ; R. J. KIRKMAN ; ; The main routine also requires LOOKUP & FIXUP. ; ; MODIFIED BY: ; 15-MAR-79 J. DOWNWARD ADD VARIOUS ERROR MESSAGES, TEST FOR ; LINES TOO LONG, AND FOR SPEED BUILD IN ; ALL KINDS OF DCL-LIKE COMMANDS. ; (EG. LIST, DIR, SPOOL, TRUNCATE, ; PURGE, DELETE., ETC.) ; ; 24-SEP-79 J. DOWNWARD ADD %U,'G%,%G,%T TO DECODED VARIABLES ; ADD MULTIPLE LINE CCL COMMANDS AND A ; ABILITY FOR CCL TO WAIT FOR A SPECIFIC ; TASK TO EXIT ; ; 10-Jan-80 A. Li Performed massive edit on all source ; U of Miami files and made the program legible. ; Also made error messages upper/lower ; and lower case. Conditionalized ; generation of DCL adn the PIP subset ; of DCL. Added %A - pass entire command ; line (except the keyword). ; ; 18-JUN-80 J. DOWNWARD SUPPORT FOR %B(RING BELL UPON EXIT) ; ; 12-NOV-81 J. CLEMENT EXIT FOR INTERNAL DCL COMMANDS. ; THIS ONLY WORKS PROPERLY IF THE PATCH ; TO DRSPW.MAC FOR EFN=-1 SPAWNING IS DONE ; Patch from [307,23] DECUS FALL 80 tape (DRSPW.SLP) ; ERASE, PAGE command deleted as specific terminals ; in question may not exist. The action of %$% has been ; changed. %$n% specifies an event flag. ; The line -$n waits for the event flag #n. ; %N,xxxx% may have N = -n or +n referring to before ; or after "=". Same for ?N. ; ; DCL commands terminated by "ESC" are echoed on terminal ; In their final form if $DEBUG enabled. *; or +; commands are ; echoed regardless of $DEBUG. .PAGE .MCALL GET$,OPEN$R,FDBDF$,FDRC$A,CLOSE$,QIOW$S .MCALL FDOP$A,FSRSZ$,DIR$,EXST$S,GTSK$S,GLUN$ .MCALL QIOW$C,CNCT$,STSE$S,CLEF$S,EXIT$S,GMCR$,SPWN$ ; ; The program reads in turn the user file SY:USERCCL.CCL ; and then the system file LB1:SYSCCL.CCL in a specific directory ; LUN 1 is used for the files and LUN 2 for error reporting and ; for asking for parameters. ; fsrsz$ 1 ; One file only! ; ; .PSECT $VARS,rw,d,con,lcl STRCMD: .WORD 0 ; Will contain string command address STRLEN:: .WORD 0 ; Will contain max address of output string ENDSAV: .WORD 0 ; Will contain address of buffer OPTION:: .WORD 0 ; Will contain address of options OPTSIZ:: .WORD 0 ; Will contain address of options size PARAMF:: .WORD 0 ; Number of params found PMIN:: .WORD 0 ; Min # params to accept PARAMS:: .WORD 0 ; Max # params to prompt for MCRL: .WORD 0 ; Length of mcr line KEYL: .WORD 0 ; Will be length of keyword GMCR: .BYTE 127.,41. ; GMCR$ directive MCR:: .BLKB 82. ; MCR buffer as input KEYB:: .ASCII / / ; Initial state of keyword buffer EVFLG:: .WORD 1 ; The event flag to use (normally 1) ; ; Tables to parse the input commands ; EQUCNT:: .WORD 0 ; Counts "=" or "<" PVECM:: .BLKW MAXPAR+1 ; Address of params before "=" PSIZM:: .BLKW MAXPAR+1 ; Size before "=" PVECP:: .BLKW MAXPAR+1 ; Address after "=" PSIZP:: .BLKW MAXPAR+1 ; Size after "=" PVECT:: .BLKW MAXPAR+1 ; Saves the locations of params PSIZ:: .BLKW MAXPAR+1 ; Saves sizes of params .ASCII ; For output of buffer MCRBUF:: ; Output MCR buffer label CMD:: .BLKB 82. ; Output new command line DUIC:: .WORD 0 ; For terminal UIC TERMIN:: .BLKB 2 ; For terminal unit UNIT:: .BLKB 10. .BLKW 7 ; To complete the rest of exit status block ; ; This common contains the original MCR command line ; minus the keyword. OMCR:: .blkb 120. ; Contains the whole MCR line PTOP: .BLKW 5 ; Top of potential MCR line RING:: .WORD 0 ; If non zero ring bell after SPAWN done .PAGE ; ; Variables to for test string function ; LABSAV: .WORD 0 ; Saves a label value TTAB: .ASCIZ /-+*?./ ; Legal first char in cmd line ; ; Error messages and prompts ; STATUS: .BLKW 8. ; For EXIT status, or SPAWN SAVTYP: .WORD 0 ; Save data type MSG1: .ASCIZ /CCL -- Too many parameters/ MSG2: .ASCIZ /CCL -- Error reading system file on LB1:/ MSG3: .ASCIZ /CCL -- No command line !/ ;JGD01 MSG4: .ASCII /? ?/ ;JGD01 .ASCIZ /CCL -- MCR syntax error or unknown command/ MSG5: .ASCIZ /CCL -- CCL command too long/ ;JGD02 MSG6: .ASCIZ /CCL -- SPAWN failure to MCR/ MSG7: .ASCIZ /CCL -- Illegal syntax in .CCL file/ EM3: .ASCIZ /CCL -- Syntax error/ EM4: .ASCII /CCL -- Task / ;JGD03 TSKNAM: .ASCII /XXXXXX/ ;JGD03 .ASCIZ / not active or not found/ ;JGD03 LBDEV: .ASCII /LB1:/ ; Dev for system file SYDEV: .ASCII /SY:/ ; Dev for userccl file SYUIC: .ASCII /[1,5]/ ; UIC for my system file SYFIL: .ASCII /SYSCCL.CCL/ ; Name of my system file USRFIL: .ASCII /USERCCL.CCL/ ; Name of users files .EVEN TERMNL: .WORD 0 ; Saves the terminal byte in command line CMDNAM: .WORD 0 ; To keep track of command name IOSTS: .BLKW 2 ; For prompting ; ; Messages for routine HEY + WAITCK ; CODES: .WORD E2 .WORD E3 .WORD E4 .WORD FUNNY ; Because exit status is 0,1,2,or 4 .WORD E5 ERRS: .WORD FUNNY ; 0 - Internal consistency error .WORD CMLINE ; 2 - Command line I/O error .WORD TNINS ; 4 - Task a CLI .WORD NSTASK ; 6 - No such active task MESS1: .ASCIZ /HEY -- Task / MESS2: .ASCIZ / exited with status - / E2: .ASCIZ /warning/ E3: .ASCIZ /success/ E4: .ASCIZ /error/ E5: .ASCIZ /severe error/ NSTASK: .ASCIZ / not active/ TNINS: .ASCIZ / not installed/ CMLINE: .ASCIZ / Missing task name/ FUNNY: .ASCIZ /FUNNY -- Internal consistency error/ .EVEN .PAGE .if df $DCL ; Only if we want it ;ALI .if df $PIP ; Only if we really want ;ALI ; ; PIP commands for DIR,LIST, DELETE, SPOOL, PURGE, TRUNCATE, UNLOCK ; TYPMSG: .ASCIZ /PIP TI:=/ PIPHD: .ASCIZ /PIP / DELMSG: .ASCIZ \/DE/LD\ DIRMSG: .ASCIZ \/LI\ PURMSG: .ASCIZ \/PU/LD\ SPOMSG: .ASCIZ \/SP\ TRUMSG: .ASCIZ \/TR\ CREMSG: .ASCIZ \=TI:\ FREMSG: .ASCIZ \/FR\ SORMSG: .ASCIZ \SRD \ .EVEN .endc; $PIP ;ALI .endc; $DCL ;ALI ; ; FDB for our CCL spec file ; FDB:: FDBDF$ FDRC$A ,INBF,132. FDOP$A 1,,,FO.RD!FA.SHR ; ; Input buffer for spec lines ; .ASCII INBF:: .BLKB 132. INUIC: .WORD 0 QNMRK: .ASCII /? / ; Buffer for error text $TEMPS: .WORD 0 SYSDST: .WORD 4,LBDEV,5,SYUIC,10.,SYFIL USRDST: .WORD 3,SYDEV,,,11.,USRFIL GTBUF: .BLKW 16. GLUN: GLUN$ 2,TERMIN CNCT: CNCT$ XX,1,,STATUS ; Connect to task ; J. CLEMENT - SPAWN with EFN=-1 to transfer offspring status to child SPWN: SPWN$ MCR...,,,,,-1,,STATUS,MCRBUF,79. .PAGE .SBTTL CCL - Root section .PSECT $CODE1,RW,I,CON,LCL CCL: GTSK$S #GTBUF ; Get our task parameters ;JGD DIR$ #GLUN ; Get our terminal LUN information ;JGD MOV GTBUF+14.,DUIC ; Get our default UIC ;JGD DIR$ #GMCR ; GET COMMAND LINE (may only execute this once) MOV $DSW,R0 ; GET LENGTH OF COMMAND LINE MOV R0,MCRL ; Save command line length BGT CCL1 ; Branch if one exists ; ; No command line, print a message and exit with severe status ; MOV #MSG3,R0 ; Get appropriate error message JMP ERROR ; Write it out and exit ;ALI ; ; Call DCL subroutine. DCL returns only if command is not a DCL one. ; CCL1: MOVB MCR(R0),TERMNL ; Save terminator CLRB MCR(R0) ; Clear byte in case to act as terminator ; ; Now compress the input command line J. CLEMENT ; All codes less than #SPA are converted to spaces ; MOV #MCR,R0 ; Start of buffer, for input MOV R0,R2 ; Likewise, for output MOV #-1,R3 ; Counts spaces (first space doesn't count) 1$: MOVB (R0)+,R1 ; Get character BEQ 10$ ; Last one CMP R1,#SPA ; Is it space or worse? BLE 1$ ; Yes ignore it BR 4$ ; No, keep it 3$: MOVB (R0)+,R1 ; Next char. BEQ 10$ ; Last char found? CMP R1,#SPA ; Is it SPACE or less? BGT 4$ ; No INC R3 ; Add 1 to space count MOVB #SPA,(R2)+ ; Save a space BR 1$ ; But allow no more 4$: MOVB R1,(R2)+ ; Keep this char CMPB R1,#'[ ; Is it left brakets? BEQ 1$ ; Yes, delete trailing spaces CMPB R1,#'( ; Is it left brakets? BEQ 1$ ; Yes, delete trailing spaces CMPB R1,#'{ ; Is it left brakets? BEQ 1$ ; Yes, delete trailing spaces CMPB R1,#'] ; Is it right brakets? BEQ 7$ ; Yes, delete leading spaces CMPB R1,#') ; Is it right brakets? BEQ 7$ ; Yes, delete leading spaces CMPB R1,#'} ; Is it right brakets? BEQ 7$ ; Yes, delete leading spaces CMPB R1,#': ; Is it colon BEQ 7$ ; Yes, delete leading spaces CMPB R1,#'; ; Is it semicolon BEQ 7$ ; Yes, delete leading spaces CMPB R1,#'. ; Is it period BEQ 7$ ; Yes, delete leading spaces CMPB R1,#', ; Is it delimiter BEQ 6$ ; Do not allow spaces after delimiters CMPB R1,#'= ; Is it delimiter BEQ 6$ ; Do not allow spaces after delimiters CMPB R1,#'< ; Is it delimiter BEQ 6$ ; Do not allow spaces after delimiters CMPB R1,#'_ ; Is it delimiter BEQ 6$ ; Do not allow spaces after delimiters BR 3$ ; Continue with compression 6$: CMPB -2(R2),#SPA ; Is char before delimiter space BNE 1$ ; No, keep it TST R3 ; Is it first space? BLE 1$ ; Yes, keep it DEC R2 ; Move back one char MOVB R1,-1(R2) ; Substitute delimiter BR 1$ ; Now zap trailing blanks 7$: CMPB -2(R2),#SPA ; Is char before right braket space BNE 3$ ; No TST R3 ; Is it first space? BLE 3$ ; Yes, keep it DEC R2 ; Yes, back up one MOVB R1,-1(R2) ; Replace blank with right braket BR 3$ ; Continue 10$: CLRB (R2) ; Terminating byte SUB #MCR,R2 ; Compression of line done, find # bytes MOV R2,MCRL ; Save byte count ; ; Now call DCL if desired ; .if df $DCL ; Sometimes useful CALL DCL ; Is it a built-in command? .endc; $DCL ; ; ; Split out command name from command line ; MOV #1,R0 GETCOM: CMPB MCR-1(R0),#SPA ; Is it a SPACE or control char(CR, ESC, ETC) BLE GOTCOM ; Branch on delimiter MOVB MCR-1(R0),MSG4+2(R0); Save it in message buffer MOVB MCR-1(R0),KEYB-1(R0); Save it in keyword buffer INC R0 ; Increment index CMP R0,#8. ; Do we have 8 characters? BLE GETCOM ; Loop if not got 8 char yet 10$: CMPB MCR-1(R0),#SPA ; Command 8 char or more long,find SPACE or CR BLE GOTCOM ; Got it INC R0 ; Bump us up one char BR 10$ ; Loop till we get it GOTCOM: ; Found a command DEC R0 ; Minus one MOV R0,KEYL ; Save length of keyword MOV #OMCR,R1 ; Get address of save buffer MOV MCRL,R3 ; Get length of the whole line SUB R0,R3 ; Compute the length of the rest of the line BEQ 20$ ; Branch if there is just a keyword DEC R3 ; Skip first character past the keyword BEQ 20$ ; Branch just in case ADD #MCR+1,R0 ; Get address of first char in remaining line 10$: MOVB (R0)+,(R1)+ ; One at a time SOB R3,10$ ; All little sob's moved? 20$: CLRB (R1) ; End the string with a null ; ; Look for USERCCL.CCL ; USROPN: MOV #SYSOPN,R2 ; Error return if "USERCCL.CCL" doesn't exist MOV #USRDST,R1 ; Data set descriptor CALL OPEN ; Try and open it ; ; Found a user file , lookup the keyword in there ; CALL LOOKUP ; Try and find the keyword TST R0 ; Is it there? BMI KEYFND ; Branch if keyword found ; ; Keyword not found, close the file and look for it in "SYSCCL.CCL" ; CALL CLOS ; FCS close ; ; Try opening "SYSCCL.CCL" ; SYSOPN: MOV #OPNFL,R2 ; Error return prints a message and exits MOV #SYSDST,R1 ; "SYSCCL.CCL" dataset descriptor CALL OPEN ; Perform the open CALL LOOKUP ; Find the keyword TST R0 ; Is it there? BMI KEYFND ; Branch if keyword found ; ; If found in system file deal in exactly same way as user file. ; If not then close file and check was last char of keyword ; a "?" in which case see if "? name" is defined, cheats and uses ; error message buffer ; CALL CLOS ; Close "SYSCCL.CCL" MOV KEYL,R0 ; Get length of keyword CMPB KEYB-1(R0),#'? ; Does it end with a question mark? BEQ HELP ; Branch if it does end with "?" MOV #MSG4,R0 ; No question mark, unknown command JMP ERROR ; Print error message and exit ; ; Generate HELP command for the above keyword ; HELP: MOVB #SPA,MCR-1(R0) ; Replace question mark with a blank MOV #-1,KEYL ; MOV QNMRK,KEYB ; Move it ;ALI MOV QNMRK+2,KEYB+2 ; two bites ;ALI MOV QNMRK+4,KEYB+4 ; at a time ;ALI MOV QNMRK+6,KEYB+6 ; No FFP needed ;ALI BR USROPN ; We have a new command to interpret ; ; Keyword found, set up max parms and min parms ; parse input command line ; KEYFND: CLR INUIC ; Not in UIC field CLR EQUCNT ; No major (< =) separators yet MOV #MAXPAR+1,R0 ; Clear 10 fields CLR R5 ; Parameter index 1$: CLR PVECM(R5) ; Zero the Parameter address CLR PSIZM(R5) ; Zero size CLR PVECP(R5) ; Zero the Parameter address CLR PSIZP(R5) ; Zero size CLR PVECT(R5) ; Zero the Parameter address CLR PSIZ(R5) ; Zero size ADD #2,R5 SOB R0,1$ ; Loop until all are clear MOV KEYL,R3 ; Length of key word ADD #MCR,R3 ; Points to start of line CLR MCRL CLR R5 ; Points to param vectors CLR PARAMF ; Start with no params MOV #OMCR,R0 ; Points to destination buffer TSTB (R3)+ BEQ NEXTL ; No input params at all TSTB (R3) BEQ NEXTL ; Blank , but no line so no params ; ; Look at next character ; R3= Input line address ; R0= Output line ; R2= Current character ; R5= Current parameter index ; SCANS: MOV R0,PVECT(R5) ; Points to start of next param. SCANI: MOVB (R3)+,R2 ; Next char to parse MOVB R2,(R0)+ ; Put it into output buffer INC MCRL CMPB R2,#'[ ; Is it start of the UIC? BNE 1$ ; No, branch DEC INUIC ; Set UIC flag 1$: CMPB R2,#'] ; Is it the end of the UIC field? BNE 2$ ; No, branch CLR INUIC ; Yes, clear UIC flag ; ; Check for ' ', '=', '<', '_', ',' (Legal separators) ; 2$: CMPB R2,#SPA ; Is it a blank? BLE SEP ; Branch if it is CMPB R2,#'= ; Equal sign? BEQ SEP ; Branch if so CMPB R2,#'< ; UNIX redirect? BEQ SEP ; Could be CMPB R2,#'_ ; Underscore? BEQ SEP ; Branch if underscore CMPB R2,#', ; Comma? BNE SCANI ; Branch if it is not TST INUIC ; Found a comma, are we in a UIC field? BNE SCANI ; Branch back if in UIC ; ; Separator character was found ; SEP: INC PARAMF ; Number of params found MOV R0,R4 ; Separator char address SUB PVECT(R5),R4 ; Number of params DEC R4 ; Do not count separator MOV R4,PSIZ(R5) ; Save it in size vector CMP R5,#2*MAXPAR ; Is R5 too big? BLT 2$ ; No it is OK JMP ERRPSZ ; Issue to many params error 2$: ADD #2,R5 ; Points to next vector element TST R2 ; Was last Separator a NULL BNE SCANS ; No, parse some more DEC MCRL ; Do not count terminator TST R4 ; Last param also NULL BNE NEXTL ; No it exists DEC PARAMF ; Adjust count for it NEXTL: CLRB (R0)+ ; Kill 1 byte as separator MOV R0,ENDSAV ; Save end of string ; ; Now parse the line + separate it into 2 parts before or after "=" ; MOV #PVECM,R1 ; Start pointing to minus vector MOV #PSIZM,R2 ; ditto size CLR R5 ; Points to param# 1-9 1$: MOV PVECT(R5),R3 ; Next vector? BEQ 4$ ; Done with this CMPB -(R3),#'= ; Is separator = BEQ 2$ ; Yes, process "after" vectors CMPB (R3),#'< ; Is it redirect < BNE 3$ ; No, contiue processing "before" 2$: MOV #PVECP,R1 ; Now stash away plus or after params MOV #PSIZP,R2 ; ditto sizes INC EQUCNT ; The number of redirects 3$: MOV PVECT(R5),(R1)+ ; Stash vectors MOV PSIZ(R5),(R2)+ ; Stash sizes ADD #2,R5 BR 1$ ; Try the next entry 4$: CALL GETLIN ; Get next line CMPB (R3),#'$ ; If another $ line skip it? BEQ 4$ ; Yes BR NCHR2 ; No, start command parsing ; ; We have all necessary parameters, start building command lines. ; ALLDON: CALL GETLIN ; Get next line from the .CCL file NCHR2: MOVB (R3),R1 ; Get char MOV #1,EVFLG ; Set event flag initially to 1 CMPB R1,#'. ; Is it a conditional? BNE 1$ ; No JMP TSTLIN ; Yes test a line 1$: CMPB R1,#'- ; Is it a "Wait for task exit"? BNE 2$ ; If NE , No CALL WAITCK ; If EQ, Yes, stop until it exits BR ALLDON ; and get another command 2$: CMPB R1,#'+ ; Is it a continuation line? BEQ CMDLIN ; Yes, CMPB R1,#'* ; Is it the final command? BEQ CMDLIN ; Yes, doit CMPB R1,#'? ; Is it question? BNE 10$ ; No, what is it? MOV ENDSAV,R0 CALL PRMPT ; Ask a question then MOV R0,ENDSAV BR ALLDON ; Look for another line. 10$: CALL LABEL ; As a last resort is it label? BR NCHR2 ; YES CMDLIN: MOVB (R3)+,SAVTYP ; Save the command type ; ; Scan input line unit we hit a "%" or NULL ; MOV #CMD,R0 MOV #CMD+79.,STRLEN MOV #FIXUP,STRCMD CALL STRING ; Convert input command string ; ; Done in one way or another ; BCS TOLONG ; Yes, give error MOV EVFLG,R1 ; Get event flag CMPB SAVTYP,#'* ; Is this the last command BNE 4$ ; NO MOV #-1,R1 ; YES, event flag = -1 4$: MOV R1,SPWN+S.PWEF ; Normal event flag is 1 SUB #CMD,R0 ; Now is length of line MOV R0,SPWN+S.PWCL ; Length of command line MOV #STATUS,R2 ; Address of status block TST R1 ; Is event flag specified BNE 5$ ; YES CLR R2 ; None 5$: CMPB MCRBUF,#'; ; Is command a comment? BNE 7$ ; NO MOV #MCRBUF-2,R0 ; Command line address CALL TYPEIT 7$: CLEF$S R1 ; Clear specified event flag DIR$ #SPWN BCC ENDDUP ; Any errors? MOV #MSG6,R0 ; Error, warn user SPAWN failed JMP ERROR ; Exit with error ENDDUP: TST R1 ; Do we wait for spawn to finish BLT FINISH ; No, Exit immediately CMP R1,#1 ; Flag 1? BNE ALLDON ; No, Do not wait. STSE$S R1 ; Wait for SPAWN to finish CMP #EX$SUC,(R2) ; Is it success BNE EREXIT ; If NE, Error - Bad status ;JGD03 JMP ALLDON ; More commands coming ;JGD03 FINISH: CALL CLOS ; Close file TST RING ; SHOULD WE RING BELL ;JGD04 BEQ 1$ ; IF EQ 0, NO ;JGD04 MOV #BELMSG,R0 ; SET BELL MESSAGE ;JGD04 CALL TYPEIT ; AND SEND IT TO TI: ;JGD04 1$: EXIT$S ; Simple exit cause parent non existant TOLONG: MOV #MSG5,R0 ; Warning message line is too long CALL TYPEIT ; Type on TI: CLRB CMD+79. ; Truncate command line MOV #CMD,R0 ; Write out the truncated command ERROR: CALL TYPEIT ; Tell the user the bad news CALL CLOS ; Close .CCL file EREXIT: EXST$S #EX$SEV ; Exit with severe error ;ALI .if df $DCL ; Only if we really want it ;+ ; ; DCL ; This subroutine implements the following commands as though they were ; part of MCR: ; ; BEL[L] Ring terminal bell. ; HOL[D] SET /HOLD =TI: ; NOHOL[D] SET /NOHOLD =TI: ; SCR[OLL] Set VT100 to slow scroll. ; NOSCR[OLL] Set VT100 to normal mode. ; LIS[T] FILESPEC,FILESPEC,.... List files at user's TI: ; TYP[E] FILESPEC,FILESPEC,.... Type files at user's TI: ; DEL[ETE] FILESPEC,FILESPEC,... Delete the specified files ; DIR[ECTORY] FILESPEC,FILESPEC,... Display a directory listing ; PUR[GE] FILESPEC, FILESPEC,.... Purge a directory of files ; SPO[OL] FILESPEC,FILESPEC,... Send files to line printer ; PRI[NT] FILESPEC,..... Send files to line printer ; TRU[NCATE] FILESPEC,FILESPEC,.... Truncate list of files ; FRE[E] DDn: Display free blocks on DDn: ; SOR[T] filespec/switches SRD [filespec/switches]/LI ; CREATE FILENAME PIP filename=TI: ; POOL SET /POOL ; UIC ={ grp, mem} Set or display UIC ; CHD Set or display UIC ; ATS or ATS TI: List all active tasks or only ; those on TI: ; SHQ Show full spool queue ; SHW Show spool queue waiting list ; DLG Display logged in terminals ; SYS Show current System UIC ; DLY NNNU Delay 'NNN' U units of time ; HEY taskname Connect to task and notify ; it when exits ; ; ; The syntax of most of the commands is: ; ; COMMAND [FILES] ; ; The directory command may be modified by using the switches ; "/BR", or "/FU" ; .SBTTL DCL - Process DCL-like PIP commands .MACRO MVZ,RA,RB,?A,?B ; Move ASCIZ string without trailing zero A: TSTB (RA) BEQ B MOVB (RA)+,(RB)+ BR A B: .ENDM EFN1 = 1 EF1 = 1 EF2 = 2 LUN2 = 2 ; LUN for TI: BELL = 7 ; Chimes .MCALL MRKT$S ; ; List of valid DCL commands. Those entries that can also take ; a prefix of "NO" are indicated by "-1" in the table and must ; immediately follow the un-prefixed entry for the same command. ; CMDTBL:; .if df $PIP ; Do we want this subset? .RAD50 /DIR/ ; LIst directory on TI: .RAD50 /PUR/ ; Purge directory .RAD50 /SPO/ ; Spool files via PIP /SP .RAD50 /PRI/ ; Print files via PIP /SP .RAD50 /FRE/ ; Display number of free blocks .RAD50 /DEL/ ; Delete file(s) .RAD50 /TYP/ ; Type file(s) on ti: .RAD50 /LIS/ ; .RAD50 /CRE/ ; Create a file .RAD50 /TRU/ ; Truncate file(s) .RAD50 /SOR/ ; Sort/brief listing .endc; $PIP ; .RAD50 /CHD/ ; Change default directory .RAD50 /UIC/ ; " " " .RAD50 /ATS/ ; List active tasks .RAD50 /SHQ/ ; Show print and batch queues in full format .RAD50 /SHW/ ; Show print and batch queues in short format .RAD50 /DLG/ ; Display terminals on TI: .RAD50 /POO/ ; Display the current amount of pool .RAD50 /SYS/ ; Display current system UIC .RAD50 /DLY/ ; Delay .RAD50 /HEY/ ; Notify terminal of specified task exit .RAD50 /BEL/ ; Ring terminal bell .RAD50 /SCR/ ; Set VT100 to scroll mode .WORD -1 ; Set VT100 to noscroll mode .RAD50 /HOL/ ; SET /HOLD=TI: .WORD -1 ; SET /NOHOLD=TI: ENDCMD: .WORD 0 ; End of command table ; ; Co-table to CMDTBL that contains the address the the servicing routine ; for the decoded command. ; JMPTBL: ; .if df $PIP ; .WORD PIPDIR ; Directory listing .WORD PIPPUR ; PURGE .WORD PIPSPO ; SPOOL command .WORD PIPSPO ; PRINT command .WORD PIPFRE ; FREE .WORD PIPDEL ; DELETE entry .WORD PIPTYP ; Use for TYPE .WORD PIPTYP ; Use for LIST same as TYPE .WORD PIPCRE ; Use PIP for CREATE .WORD PIPTRU ; Use PIP for TRUNCATE .WORD SRD ; Use code template for SRD /LI .endc; $PIP ; .WORD CHD ; .WORD CHD ; .WORD ATS ; .WORD SHQ ; .WORD SHW ; .WORD DLG ; Show actice terminals .WORD POO ; Show pool .WORD SYS ; Display SYSUIC .WORD DLY ; Delay for just a moment .WORD HEY ; Connect to task .WORD BELEP ; Ring terminal bell .WORD SCROLL ; Set VT100 to scroll mode .WORD NSCROLL ; Set VT100 to normal mode .WORD HOLD ; SET /HOLD =TI: .WORD NOHOLD ; SET /NOHOLD=TI: NOPRE: .WORD 0 ; 1 if "NO" prefixes command .EVEN .PAGE .SBTTL Compress Command Line ; ; Get the command line from MCR and peel off the command from it. ; The command is defined as the first N characters of the line up to ; but not including the first non-alphanumeric ; DCL: ; REF label MOV #MCR,R0 ; Start of MCR command buffer CLRB NOPRE ; Assume regular command CMPB (R0),#'N ; "NO"? BNE 5$ ; Branch if not CMPB 1(R0),#'O ; BNE 5$ ; Branch if not ADD #2,R0 ; Skip prefix INCB NOPRE ; Signal "NO" seen 5$: CLR R1 ; Control for $CAT5(Do not decode dots) CALL $CAT5 ; Convert R50 to ASCII ; (R1 contains command name) MOV #MCR,R0 ; Get start of command buffer again MOV R0,R2 ; for compression MOV R0,R5 ; Points to rest of command line MOV #CMDTBL,R4 ; Search the command table for a match MOV R1,CMDNAM ; Save command name for later 10$: CMP R1,(R4)+ ; See if it's a match BEQ 20$ ; Go it CMP R4,#ENDCMD ; Are we at end of table? BLO 10$ ; If LO , no, try again 15$: RETURN ; Go and try the .CCL file for a match 20$: TSTB NOPRE ; Prefixed command? BEQ 25$ ; Branch if not CMP (R4),#-1 ; Command takes "NO" prefix? BNE 15$ ; Branch if not, invalid DCL command TST (R4)+ ; Use prefixed command entry 25$: MOV R2,R0 ; Restore R0 SUB #CMDTBL+2,R4 ; R4=table index of commands ; ; Find where command ends ; The typical command will look as follows: ; ; ; ; The CMDNAME may be more than three characters long, but only the first ; three were tested against the jump table(this is consistent with MCR). ; A space separated the cmd name from any command qualifier string. ; PARSE: DEC MCRL ; Mcr CHAR count BEQ OUT ; Done CMPB (R0)+,#SPA ; Printable char? BGT PARSE ; Yes, skip it. .PAGE REPACK: MOVB (R0)+,R1 ; 1 CHAR CMPB R1,#SPA ; Is it space? BNE 1$ ; No MOVB #',,R1 ; Make it comma 1$: MOVB R1,(R2)+ ; Output BNE REPACK ; Pack next character OUT: CLRB (R2)+ ; Make sure last byte is null ; ; At this point the command line appears as follows. ; The command name and leading blanks have been removed from the command buffer. ; A zero byte follows the line. The original terminator is ; saved in TERMNL. ; ; R4 is index pointing to command # 0,2,4.... ; R5 points to the start of the command buffer ; MOV #MCRBUF,R1 ; Get SPAWN buffer MOV #ENDCMD,R2 ; Null buffer for later MOV R2,R3 ; Same .if df $PIP ; Only if we really want PIP MOV #PIPHD,R0 ; Set up to invoke PIP .endc JMP @JMPTBL(R4) ; Jump to correct section .enable LSB ERR3: MOV #EM3,R0 ; Bad syntax error message CALL TYPEIT ; Output message XIT: EXST$S #EX$ERR ; Exit with error code .DSABLE LSB .PAGE .if df $PIP ; Only if defined .SBTTL PIP-like commands ; ; DIR,SPOOL,DELETE,TRUNCATE,FREE,PURGE,CREATE, ..etc. all processed here ; FILMES: .ASCII /Files?/ .EVEN SRD: MOV #SORMSG,R0 ; Move in SRD BR PIPDIR ; Pretend this is directory PIPTYP: MOV #TYPMSG,R0 ; Else point to start of command BR COMON0 ; And skip over PIPPUR: MOV #PURMSG,R2 ; Move in second half of line BR COMON0 ; Do files pip function PIPDIR: MOV #DIRMSG,R2 ; Mov in second half of name BR COMON1 ; PIPSPO: MOV #SPOMSG,R2 ; Move in /SP BR COMON0 ; Go do it PIPFRE: MOV #FREMSG,R2 ; Move in second half of name BR COMON1 ; Go issue command PIPDEL: MOV #DELMSG,R2 ; Move in second half of command BR COMON0 ; Go issue command PIPCRE: MOV #CREMSG,R2 ; Move in second half of command BR COMON0 ; Go issue command PIPTRU: MOV #TRUMSG,R2 ; If YES, move in switch COMON0: TST MCRL ; Filename available? BNE COMON1 ; YES QIOW$S #IO.RPR,#2,#1,,#IOSTS,,<#MCR,#78.,,#FILMES,#8.> CMPB IOSTS,#IS.SUC ; Is read successful? BNE XIT MOV IOSTS+2,R4 ; Number of bytes BEQ XIT ; None CLRB MCR(R4) ; Terminal char is null MOV R4,MCRL ; Number of char saved COMON1: MVZ R0,R1 ; Mov first cmd line (PIP or SRD) CLRB INUIC ; Initially no UIC encountered 1$: CMPB (R5),#', ; Is char "," BNE 5$ ; No, more to transfer TSTB INUIC ; Is "," inside UIC [ ] BEQ 10$ ; No, it is legal separator 5$: CMPB (R5),#SPA ; Is char other separator, or end of line BLE 10$ ; Yes CMPB (R5),#'[ ; Uic started? BNE 6$ ; No DECB INUIC ; Signal start of UIC 6$: CMPB (R5),#'] ; End of UIC? BNE 7$ ; No CLRB INUIC ; Signal NO UIC 7$: MOVB (R5)+,(R1)+ ; Move to buffer BR 1$ ; Continue till end of input 10$: MVZ R2,R1 ; Rest of command MVZ R5,R1 ; Rest of input line JMP MCRSPW ; SPAWN command and exit .endc; $PIP ; No PIP or SRD commands implemented .PAGE .SBTTL CHD ATS ; ; CHD - Change (or show) current UIC ; CHDM1: .ASCIZ \SET /UIC=[\ CHDM2: .ASCIZ \SET /UIC\ .EVEN CHD: TSTB MCRL ; Is there a UIC specified? BEQ CHDSHW ; No - show current UIC MOV #CHDM1,R0 ; Get first part of command MVZ R0,R1 ; Move first part of string to spawn buffer MOV R5,R0 ; 10$: TSTB (R0) ; Is it end of line BEQ 20$ ; If EQ 0, YES, close up command CMPB (R0),#'[ ; Is it "["? BNE 11$ ; If NE, NO, skip MOVB #SPA,(R0)+ ; Yes, make it a space BR 10$ ; And try again 11$: CMPB (R0),#'= ; Is it an "="? BNE 12$ ; If NE, NO MOVB #SPA,(R0)+ ; Yes, make it a space BR 10$ ; And check again 12$: CMPB #'],(R0) ; Is it a "]"? BNE 13$ ; If NE, NO CLRB (R0) ; and 0 byte BR 20$ ; And finish up 13$: CMPB (R0)+,#SPA ; If a space seperates the GRM MEM BNE 10$ ; If NE, must be number-get another MOVB #',,-1(R0) ; Else move in a COMMA 20$: MVZ R5,R1 ; Move in UIC MOVB #'],(R1)+ ; Close up command JMP MCRSPW ; Spawn MCR CHDSHW: MOV #CHDM2,R2 ; Set message for buffer JMP MCRSP0 ; Spawn command and exit ; ; ATS - LIST ALL ACTIVE TASKS ( OR ONLY THOSE FOR A TERMINAL) ; ATSM1: .ASCIZ \ACT /ALL\ ATSM2: .ASCIZ \ACT /TERM=\ .EVEN ATS: TSTB MCRL ; IS THERE A TERMINAL SPECIFIED BNE ATSTTY ; YES, JUMP MOV #ATSM1,R2 ; Message ACT /ALL BR MCRSP0 ; SPAWN COMMAND AND EXIT ATSTTY: MOV #ATSM2,R0 ; FIRST PART OF SPAWN COMMAND MVZ R0,R1 ; MOVE ASCIZ STRING INTO SPAWN BUFFER MVZ R5,R1 ; MOVE IN TERMINAL NUMBER BR MCRSPW ; SPAWN THE COMMAND .SBTTL Terminal setting routines .ENABL LC BELMSG: .ASCIZ <7> ; Ring bell SCRMSG: .ASCIZ /[?4h/ ; Set terminal to scroll mode NSCMSG: .ASCIZ /[?4l/ ; Set terminal to fast jump mode HOLMSG: .ASCIZ \SET /HOLD=TI:\ NOHMSG: .ASCIZ \SET /NOHOLD=TI:\ .EVEN SCROLL: MOV #SCRMSG,R0 ; Set up output message BR TOTERM ; Send it out NSCROLL:MOV #NSCMSG,R0 ; Set up output message BR TOTERM ; Send it to terminal BELEP: MOV #BELMSG,R0 ; Write out message TOTERM: CALL TYPEIT ; EXST$S #EX$SUC ; What could possibly go wrong? HOLD: MOV #HOLMSG,R2 ; And buffer address BR MCRSP0 ; Spawn command and wait NOHOLD: MOV #NOHMSG,R2 ; Message to MCR BR MCRSP0 ; SPawn command and wait MCRSP0: MVZ R2,R1 ; Move message to buffer MCRSPW: CLRB (R1) ; Clear final byte for output SUB #MCRBUF,R1 ; Length of message line MOV R1,SPWN+S.PWCL ; Put length into SPAWN command CMP R1,#79. ; Is composit line too long? BLE SPWNIT ; Line is OK in length MOV #MSG5,R0 ; Say it's too long CALL TYPEIT ; Output message MOV #MCRBUF,R0 ; Set up buffer for output CLRB 79.(R0) ; Set zero byte for output termination CALL TYPEIT EXST$S #EX$ERR ; Exit with error status SPWNIT: .IFDF $DEBUG ; Debugging aid CMPB TERMNL,#ESC ; Is terminator ESCAPE BNE 1$ ; NO MOV #MCRBUF-2,R0 ; Address of message buffer CALL TYPEIT ; Now type out buffer contents .ENDC 1$: DIR$ #SPWN ; Try spawning to MCR... first BCC 10$ ; If CC we got it, Exit will be silent MOV #MSG6,R0 ; Print error message CALL TYPEIT ; Out on TI: 10$: EXST$S #EX$SEV ; Very bad error .PAGE .SBTTL SHQ - SHW - DLG ; ; SHQ - Show full queue entries ; SHQM: .ASCIZ \QUE /FU:ALL\ .EVEN SHQ: MOV #SHQM,R2 ; And buffer address BR MCRSP0 ; Spawn command ; ; SHW - Show QUE waiting list ; SHWM: .ASCIZ \QUE /BR:ALL\ .EVEN SHW: MOV #SHWM,R2 ; And address BR MCRSP0 ; Spawn command and exit ; ; DLG - Display logged in terminals ; DLGM: .ASCIZ \DEV /LOG\ .EVEN DLG: MOV #DLGM,R2 ; And address BR MCRSP0 ; Spawn the command and exit ; ; POO - Show pool amount ; POOM: .ASCIZ \SET /POOL\ .EVEN POO: MOV #POOM,R2 ; And buffer address BR MCRSP0 ; Spawn the command and exit ; ; SYS - Show current system UIC ; SYSM: .ASCIZ \SET /SYSUIC\ .EVEN SYS: MOV #SYSM,R2 ; And buffer address BR MCRSP0 ; Spawn command and exit .PAGE .SBTTL DLY ; ; DLY NNNU -- Delay 'NNNN' units of time ; DLY: MOV R5,R0 ; Copy buffer pointer CALL $CDTB ; Convert units value MOV R1,R5 ; Save units value BEQ 30$ ; Exit if null MOV #1,R4 ; Assume tics CMPB R2,#'T ; Tics? BEQ 20$ ; Yes INC R4 ; Try next time value CMPB R2,#'S ; Seconds? BEQ 20$ ; If EQ YES INC R4 ; No , assume minutes CMPB R2,#'M ; Minutes? BEQ 20$ ; If EQ, YES INC R4 ; If NE, NO assume hours CMPB R2,#'H ; Hours? BNE 30$ ; If NE, illegal value 20$: MRKT$S #EFN1,R5,R4 ; Issue marktime BCS 30$ ; If directive ERROR STSE$S #EFN1 ; Wait for marktime EXST$S #EX$SUC ; Exit with success 30$: ; Ref label JMP ERR3 ; Syntax error .endc .PAGE ; ; HEY ; .SBTTL Connect and Wait ; R3 must point to the Task name CONNEC: MOV #CNCT+C.NCTN,R4 ; Get address to put taskname CLR (R4) ; Clear out name buffer CLR 2(R4) CLR R5 ; Zero error indicator CLRB 6(R3) ; Terminator in case TSTB (R3) ; Commandline present BEQ ERROR1 ; NO MOV R3,R0 MOV #1,R1 ; Allow . as char. CALL $CAT5 ; Convert ASCIZ takname to RAD50 BCS 40$ ; If CS less than 3 characters in taskname MOV R1,(R4)+ ; 1st part of taskname in connect DPB MOV #1,R1 CALL $CAT5 ; Convert more taskname into RAD50 40$: MOV R1,(R4) ; Taskname in connect DPB CLEF$S #1 ; Clear event flag DIR$ #CNCT ; Connect to the specified task BCC 50$ ; If true, success CMP $DSW,#IE.INS ; Was specified task A CLI? BEQ ERROR2 ; If EQ YES CMP $DSW,#IE.ACT ; Was task inactive? BEQ ERROR3 ; If EQ, YES BR ERROR0 ; No, it is funny error 50$: STSE$S #EF1 ; Wait for connected task to EXIT RETURN ; ; Routine HEY ; HEY: MOV #MCR,R3 ; Input buffer CALL CONNEC ; Try connecting to task MOV #MCRBUF,R0 ; Get output buffer address MOVB #BELL,(R0)+ ; Put in a BELL MOV #MESS1,R1 ; Get address of 1st part of MESSAGE CALL MOVE ; Put it in output buffer MOV R3,R1 ; Task name to type CALL MOVE MOV #MESS2,R1 ; Get address of 2nd part of message CALL MOVE ; Move it into output buffer MOV STATUS,R1 ; Get exit status CMP #5,R1 ; Known return code BHI 60$ ; If HI, YES CLR R2 ; Suppress leading zeroes CALL $CBOMG ; Convert to octal BR 70$ ; 60$: ; ASL R1 ; Get word index MOV CODES(R1),R1 ; Get address of exit code message CALL MOVE ; Move it into buffer 70$: CLRB (R0)+ ; End of buffer MOV #MCRBUF,R0 CALL TYPEIT ; Type message ENDHEY: EXST$S #EX$SUC ; Exit successfully .PAGE .SBTTL HEY error processing ;+ ; WAITCK -- Wait for task to exit ; This subroutine processes the CCL command ; -TASKNAME ; or -$n where n =1-9 specifying an event flag ;- WAITCK: INC R3 CMPB (R3)+,#'$ ; Is it dollar? BEQ WAITEF ; Wait for event flag DEC R3 JMP CONNEC ; Connect and wait do not return to here WAITEF: MOVB (R3),R1 ; Get flag # SUB #'0,R1 ; Subtract base BLE ERRWCK ; Bad syntax CMP R1,#9. ; Is it too big? BGT ERRWCK ; YES INC R1 ; 1 < event flag < 11 STSE$S R1 RETURN ERRWCK: JMP ERRCCS ; Syntax error ERROR3: INC R5 ; Task not active ERROR2: INC R5 ; Task a CLI ERROR1: INC R5 ; No command line ERROR0: ; Funny internal error ASL R5 ; Get word index MOV #MESS1,R1 ; Get 1st part of error message MOV #MCRBUF,R0 ; Move to output buffer CALL MOVE ; Move into output buffer MOV R3,R1 ; Task name CALL MOVE ; Into output buffer MOV ERRS(R5),R1 ; Get address of error message CALL MOVE ; Move message into output buffer CLRB (R0)+ MOV #MCRBUF,R0 ; Get start of message CALL TYPEIT ; Output message EXST$S #EX$SEV ; Exit the worst way ; ; Read a line subroutine ; GETLIN: MOV R0,-(SP) ; Save GET$ #FDB ; Read in 1 line BCC 3$ ; Branch if OK JMP OPNFL ; EOF reached, very bad 3$: MOV FDB+F.NRBD,R0 ; Get the # of bytes read in CLRB INBF(R0) ; Clear byte after last as terminator CMP R0,#2 ; Is line minimum length? BGT 10$ ; Length of line is OK JMP ERRCCS ; Not ok, give syntax error 10$: MOV (SP)+,R0 ; Restore MOV #INBF,R3 ; Input line address RETURN .SBTTL Subroutines ;+ ; *** MOVE - Move an ASCIZ string ; ; INPUTS: ; R0 - ADDRESS OF OUTPUT BUFFER ; R1 - ADDRESS OF ASCIZ STRING ; ; OUTPUTS: ; R0 - UPDATED ;- MOVE: ; MVZ R1,R0 ; Move a string terminated by NULL to (R0) RETURN ; Return to caller ; ; Error message typer, error text ends in null ; TYPEIT: MOV R1,-(SP) MOV R0,R1 1$: TSTB (R1)+ BNE 1$ DEC R1 SUB R0,R1 QIOW$S #IO.WLB!TF.WAL,#2,#1,,,, MOV (SP)+,R1 RETURN ; ; Close our 1 file ; CLOS: CLOSE$ #FDB RETURN ; ; Open a file on LUN 1, dataset descriptor in R1, error label in R2 ; OPEN: OPEN$R #FDB,#1,R1 BCC 1$ JMP @R2 1$: RETURN ; ; Print could not access system file & die ; OPNFL: MOV #MSG2,R0 JMP ERROR ; Exit with severe error ; ; Bad syntax error message ; ERRCCS:: MOV #INBF-2,R0 ; Print out bad line CALL TYPEIT MOV #MSG7,R0 ; .CCL error file error JMP ERROR ; Parameters too big error message ERRPSZ: MOV #MSG1,R0 ; Buffer space error JMP ERROR STRING: MOVB (R3)+,R1 ; Are we at end BEQ 6$ CMPB R1,#'% ; Special char? BEQ 1$ ; Yes, branch MOVB R1,(R0)+ ; Save it in output BR 2$ ; Check for buffer overflow 1$: CALL @STRCMD ; Call special subroutine BCS 5$ ; Error exit 2$: CMP R0,STRLEN ; End of output buffer? BLOS STRING ; No, branch back and repeat 5$: SEC RETURN 6$: DEC R3 ; Points to terminator byte CLRB (R0) ; Terminator CLC ; No error RETURN ; ; This has to find end of input line - add ? ; Type it and get result in correct chunk. ; PRMPT: INC R3 ; Input line to parse CMP PARAMF,PMIN ; Do we have enough params? BGE NO ; Yes, do not ask again TST PARAMS ; Have we asked enough? BLE NO ; Yes, do not prompt MOVB (R3),R1 ; First character CMPB R1,#'; ; Is it comment line? BEQ COMMEN ; Yes CALL PARGET ; Get param addresses TST (R4) ; Param exist? BNE NO ; Yes, skip it CMPB (R3),#'; ; Conditional comment? BEQ COMMEN ; Yes CMPB (R3)+,#'= ; Is it default set? BEQ DEFAUL ; Yes MOV #PTOP,R1 ; Is end of param list SUB R0,R1 ; Now is max size for line BLE ERRPSZ ; Too small MOV FDB+F.NRBD,R2 ; Number of bytes in line ADD #INBF+3,R2 ; Plus start of buffer SUB R3,R2 ; Minus start of line=BYTES in line total BLE ERRCCS MOV #79.,R3 ; Assume terminal line of max 79. SUB R2,R3 ; Line size after prompt BLE ERRCCS ; No room for PARAM CMP R1,R3 ; Too big? BLE 4$ ; No, It will fit on 79. char screen MOV R3,R1 ; Now it is OK Will fit on screen 4$: MOV #INBF,R3 ; Input line address ADD FDB+F.NRBD,R3 ; Points to end of line MOVB #'?,(R3)+ ; Insert question mark MOVB #' ,(R3)+ ; Insert a space SUB R2,R3 ; Back to beginning of line QIOW$S #IO.RPR,#2,#1,,#IOSTS,, INC PARAMF ; Increment # of params found DEC PARAMS ; Decrement max # to prompt for CMPB IOSTS,#IS.SUC ; Ok return from read? BEQ 5$ ; Branch if YES MOV #EX$SEV,R0 ; Exit with severe error JMP FINISH ; Exit with no message 5$: MOV IOSTS+2,R1 ; Length of input line BEQ NO ; None MOV R0,(R4) ; Save location of parameter MOV R1,(R5) ; And size of param ADD R1,R0 ; Points to next avail location CLRB (R0)+ ; Put terminator into list NO: RETURN ; Return with success ; ; Output a question comment line ; COMMEN: MOV R0,-(SP) MOV R3,R0 ; Line address for typeit INC R0 MOVB #LF,-(R0) ; Put CR,LF at beginning MOVB #CR,-(R0) MOV FDB+F.NRBD,R2 ; Number of bytes in line ADD #INBF,R2 ; Plus start of buffer for end of buff+1 MOVB (R0),(R2)+ ; Make sure it has "return" at end CLRB (R2) ; Clear terminating byte CALL TYPEIT MOV (SP)+,R0 RETURN ; ; Get default parameter ; DEFAUL: MOV R0,-(SP) ; Address of param list MOV R4,-(SP) ; Save vect for later MOV R5,-(SP) ; Save size MOV #PTOP,STRLEN ; Max for string MOV #FIXUP1,STRCMD ; Action when % CALL STRING BCC 1$ JMP ERRPSZ 1$: MOV (SP)+,R5 ; Restore MOV (SP)+,R4 MOV R0,(R5) SUB (SP),(R5) ; size of line BEQ 2$ ; No line MOV (SP),(R4) ; Address of param CLRB (R0)+ INC PARAMF ; One mor param decided 2$: TST (SP)+ ; Pop stack RETURN ; ; Subroutine to get addresses of params ;Input ; R3= input buffer ; R1= Character to compare ;Output ; R4= Param vector address ; R5= Parameter size address ; ; If not found a syntax error is issued ; PARGET:: MOV #PVECT,R4 ; Address of param vector MOV #PSIZ,R5 ; Sizes MOVB (R3)+,R1 ; First char to test CMPB R1,#'A ; IS it All BNE 1$ ; No MOV #MCRL,R5 ; Address of size BR 5$ ; Done 1$: CMPB R1,#'- ; Is it - BNE 2$ ; NO MOV #PVECM,R4 MOV #PSIZM,R5 BR 3$ 2$: CMPB R1,#'+ ; Is it + BNE 4$ ; No, check for number instead MOV #PVECP,R4 MOV #PSIZP,R5 3$: MOVB (R3)+,R1 ; Second char. 4$: SUB #'1,R1 ; Get param # 0-8 BLT 6$ ; Incorrect CMP R1,#9. ; Is it too big? BGE 6$ ; Yes ASL R1 ; Now is index to params (0,2,4,6...18.) ADD R1,R4 ; Now is actual Vector ADD R1,R5 ; Actual size index 5$: RETURN 6$: JMP ERRCCS ; Syntax error ; ; Conver labels here ; LABEL: CLR R2 ; R2 will be number 1$: MOVB (R3)+,R1 ; Char to test CMPB R1,#': ; End of label? BEQ 5$ ; Yes SUB #'0,R1 ; Big enough? BLT 6$ ; No CMP R1,#7 ; Not too big? BGT 6$ ; No ASH #3,R2 ; Shift out digits ADD R1,R2 ; Current value BR 1$ 5$: RETURN ; Got label 6$: JMP ERRCCS ; ERROR TSTLIN: INC R3 ; Skip "." CALL LABEL ; Label follows . MOV R2,LABSAV CALL PARGET ; Get parameter addresses R3,R4 BEQ 20$ ; End of line is error MOV (R4),R4 BEQ 5$ ; Param doesn't exist so match is true MOV (R5),R5 BEQ 5$ TSTB (R3) ; Any line remaining to test? BEQ 20$ ; None, so give error TSTB 1(R3) ; Char to test? BEQ 6$ ; None, test is always true CMPB (R3),#'* ; Is it limitless search BEQ 1$ ; Yes CMPB (R3),#'\ ; Unlimited? BEQ 1$ ; Yes, unlimited MOV R3,R0 INC R0 MOV R4,R1 MOV R5,R2 MOV #1,R5 ; Limit to 1 pass BR 2$ 1$: MOV R3,R0 ; Input line INC R0 MOV R4,R1 ; Parm to test MOV R5,R2 ; Count 2$: CMPB (R0)+,(R1)+ BNE 3$ ; No match for this char. TSTB (R0) ; End of line? BEQ 6$ ; Yes, got a match SOB R2,2$ ; No, try next one BR 5$ ; No match 3$: INC R4 ; Start at new place input line SOB R5,1$ ; Until it is exhausted 5$: CMPB (R3),#'= ; Equal? BEQ 17$ ; Yes, no label search CMPB (R3),#'* ; BEQ 17$ ; Yes, no label search BR SEARCH ; Not equal so search 6$: CMPB (R3),#'= ; BEQ SEARCH CMPB (R3),#'* ; BEQ SEARCH 17$: JMP ALLDON ; No search return 20$: JMP ERRCCS SEARCH: TST LABSAV BNE 1$ ; Label is non zero JMP ERR3 ; Give Syntax error 1$: CALL GETLIN ; Next input line MOVB (R3),R1 ; First char MOV #TTAB,R4 ; Search table 2$: CMPB R1,(R4) ; MAtch BEQ 1$ TSTB (R4)+ BNE 2$ 3$: CALL LABEL CMP R2,LABSAV ; Match BNE 1$ JMP NCHR2 .END CCL