.sbttl "HARD-WIRED" COMMANDS ; ===================== ; Command Execution Routines ; -------------------------- ; ; This is a collection of routines that illustrate some of the types of ; things that you can do with "hard-wired" commands. Some of them (CD, RNO) ; might not be useful to you. You can get rid of them by editing them out ; completely (don't forget the reference string and the entries in the ; tables CEALST and RSALST) or, more simply, just remove the appropriate ; CEALST and RSALST table entries and leave the code lying around for ; reference. .psect uclhwc .sbttl chain, nochain ; "Set Up Exit-On-Bad Command Chain" [NO]CHAIN file-spec ; ===== .enabl lsb nchain:: bis #bit15,chanto ;NOCHAIN enters here br 30$ chain:: bicb #ucimd,pflags ;Disable UCI_MODE bic #bit15,chanto ;Restore possible chaining data call adjr0 ;Skip leading blanks tstb (r0) ;Null file name? beq 30$ ;Branch if so mov #chanto,r1 ;R1 => filename buffer for CHAIN mov #15.,r2 ;R2 = max. length for filename push r0 ;Save buffer pointer 10$: movb (r0)+,(r1)+ ;Move filename to CHAIN filename buffer... beq 20$ sob r2,10$ pop r4 ;Oops! filename too long... mov #millfn,r5 jmp ferrx 20$: pop r0 ;Clean up stack and 30$: jmp wtstbl ; go write out changes .dsabl lsb .sbttl display ; "Display Command Expansion" DISPLAY command-string ; ======= /EXECUTE ; /NOEXECUTE ; /FORM0 ; /NOFORM0 ; /PRINTER ; /OUT:file-spec ; /TERMINAL dsplay:: clrb prlfnm ;Init PLINE's file name buffer clr wblok0 ; and start block no. mov sp,dspsp ;Save current stack pointer value mov #dsparl,r4 ;R4 => arg. list for switches call swtchs ;Check for switches tst r5 ;Any errors? bpl 10$ ;Branch if not mov dspsp,sp ;Clean up stack and jmp @dspsea(r5) ; go handle errors 10$: bis #dspla,status ;Set display bit in status bit #exe,swstat ;"/EXECUTE"? beq 20$ ;Branch if not bis #dsplx,status ;Set display+execute bit in status 20$: call adjr0 30$: tstb (r0) ;Command entered? bne 40$ ;Branch if so .gtlin #buff,#dspqry ;"Command?" mov #buff,r0 ;R0 => input buffer br 30$ 40$: mov #buff,r1 ;Left justify remainder of input buffer... 50$: movb (r0)+,(r1)+ bne 50$ mov #buff,r0 ;R0 => input buffer cmpb (r0),#'" ;Just print the line? bne 90$ ;Branch if not inc r0 ;Skip leading " push r0 ;Save R0 60$: tstb (r0)+ ;Find end of line... bne 60$ cmpb -2(r0),#'" ;Last character a " ? bne 70$ ;Branch if not clrb -2(r0) ;Replace " with null br 80$ ; and proceed 70$: movb #200,-1(r0) ;Replace null with 200 byte (no cr/lf) 80$: pop r0 ;Restore R0 .prlin ;Print remainder of input line... .prlin #0 bic #dspla!dsplx,status ;Zap any display bits in status word return 90$: mov r0,savr0 ;Save buffer pointer .getcom ,#cmd ;Cause command execution (ensure rest of call clencm ; buffer pointers reset)... call tstuc call procap .cscan ,#rsalst tstb cxslst(r5) bmi 100$ jmp baddsp 100$: jmp @cealst(r5) ; This routine lists a command expansion. On entry, R0 contains the byte ; count and R1 the text address. It forces a return to the mainline unless ; the display+execute bit is set in STATUS. dsplst:: push ;Save R0 - R2... mov r0,r2 ;Put byte count in r2 .prlin #crlf ;Print a blank line 10$: movb (r1)+,r0 ;Get a character bne 20$ ;Branch if not null .prlin #crlf ;Print a CR/LF... br 40$ 20$: cmpb r0,#space ;Is it a control character? bge 30$ ;Branch if not bic #^C<37>,r0 ;Ensure no extraneous bits movb ctrltb(r0),ctrlch ;Print "^" whatever... .prlin #uparow br 40$ 30$: movb r0,ctrlch ;Print the character (with no "^")... .prlin #ctrlch 40$: sob r2,10$ ;If not done, go do another .prlin #crlf ;Print a blank line .prlin #0 ;Clean up any remaining output pop ;Restore R2 - R0... bit #dsplx,status ;Go ahead and execute the command? bne 60$ ;Branch if so mov dspsp,sp ;Nope, reset stack 50$: bic #,status ;Ensure display, execute bits clear return ; and return 60$: bit #ximm,status ;Execute immediate? beq 50$ ;Branch if not bic #,status ;Kill display bits mov dspsp,sp ;Reset stack jmp sypxim ;Return via execute immediate code .nlist bex uparow: .ascii /^/ ctrlch: .byte 0,200 ctrltb: .ascii /@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_/ .list bex .even ; Switch routines: dspexs: bit #nex,swstat ;Switch conflict? bne dspcsw ;Branch if so jmp swbits ;Go set bit in SWSTAT otherwise dspcsw: bis #cnswer,swstat ;Set "conflicting switches" flag sec ;Set carry and return ; return dspnxs: bit #exe,swstat ;Switch conflict? bne dspcsw ;Branch if so jmp swbits ;Go set bit in SWSTAT otherwise dspsp: .word 0 ;Save area for stack pointer ; Reference string address list for switches: dsprsa: .word exesw .word frmsw .word nexsw .word nfrmsw .word outsw .word prnsw .word trmsw .word 0 ; Switch status bit list: dspssb: .word exe .word fm0 .word nex .word nf0 .word out .word prn .word trm ; String execution address list: .word badopx .word cnfswx .word badswx .word ambswx dspsea: .word dspexs .word lisfm0 .word dspnxs .word lisnf0 .word lisout .word lisprn .word listrm ; Argument list for SWTCHS call: dsparl: .word dsprsa .word dspsea .word dspssb .sbttl erase ; "Erase A Symbol" ERASE sym1,sym2,... ; ===== /NOQUERY ; /QUERY sbksiz = /2 erase:: clr wrnmad ;Clear warning message buffer mov #ersarl,r4 ;R4 => switch processing argument list call swtchs ;Check for and flag switches tst r5 ;Any errors? bpl er1sym ;Branch if not jmp @erseal(r5) ;Go handle errors ; Erase all symbols... eralt: bit #noq,swstat ;"/NOQUERY"? bne 10$ ;Branch if set .print #eraqry ;"Erase All Symbols" .gtlin #buff,#rusure ;"Are You Sure?" bicb #40,buff ;"Y"-for-yes?... cmpb buff,#'Y beq 10$ ;Branch if so return 10$: mov #sdsat,r0 ;Clear entire symbol area... mov #sbksiz,r1 20$: clr (r0)+ sob r1,20$ mov #sdsbfr,r0 ;Insert "string deleted" bytes... mov #nsyms,r1 30$: movb #377,(r0) add #lsyms,r0 sob r1,30$ call wtstbl ;Write changes to SAV image and return ; return ; Erase one symbol at a time... .enabl lsb er1sym: call adjr0 ;Skip any blanks cmpb (r0),#'* ;Erase all? beq eralt ;Branch if so mov r0,savr0 ;Save input buffer pointer tstb (r0) ;Null byte? bne 10$ ;Branch if not .gtlin #buff,#er1qry ;"Symbol?" mov #buff,r0 tstb (r0) ;Null response? bne er1sym ;Branch if not return ;Return otherwise 10$: .getcom ,#cmd ;Extract symbol from input string tstb (r0) ;Last symbol in list? beq 20$ ;Branch if so inc r0 ;Skip separator 20$: mov r0,savr0 ;Save pointer .cscan ,#sdsat ;Try to find entry we want to erase tst r5 ;Find it? bpl 30$ ;Branch if so jmp @er1erx(r5) ;Go handle errors 30$: tst r3 ;Find an exact match? beq 40$ ;Branch if so bit #noq,swstat ;"/NOQUERY" bit set? bne 60$ ;Branch if it is mov sdsat(r5),r1 ;R1 => symbol definition string mov #cmd,r2 ;R2 => command buffer mov #6,r3 ;R3 = max. no. characters to copy call ccopy ;Copy full name of symbol into command buffer clrb (r2) ;Terminate with null br 50$ ;Go ask about this 40$: bit #qry,swstat ;"/QUERY"? beq 60$ ;Branch if not 50$: .print #ersqry ;"Erase Symbol...?" .print #cmd .gtlin #buff,#rusure ;"Are You Sure?" bicb #40,buff ;"Y"-for-yes?... cmpb buff,#'Y bne eraseq ;Branch if not 60$: add #sdsat,r5 ;R5 => symbol string address movb #377,@(r5) ;Flag string entry as deleted 70$: clr (r5) ;Clear address entry cmp r5,#sdsatl ;Last entry in table? beq eraseq ;Branch if so mov 2(r5),(r5)+ ;Shift up next address entry br 70$ ;Go shift next one eraseq: call wtstbl ;Write changes to SAV image tst wrnmad ;Doing "erase by name"? beq 80$ ;Branch if not call wrngm ;"UCL-W-Erased Symbol xxxxxx"... .print #cmd return 80$: mov savr0,r0 ;Get pointer to next symbol name call adjr0 ;Skip leading blanks tstb (r0) ;End of list? bne 10$ ;Branch if not return ; Entry for "erase by name"... er1sy0: mov #erawrn,wrnmad ;Set up for erase warning message br 60$ ;Go do it .dsabl lsb ; Error traps for ERASE .word er1erx .word er1er0 er1erx: mov #er1nfm,r5 ;"Symbol Not Found..." br er1er1 er1er0: mov #er1amm,r5 ;"Ambiguous Symbol..." er1er1: mov #cmd,r4 jmp ferrx ; Switch reference string address list for ERASE: ersal: .word noqsw .word qrysw .word 0 ; Switch status bit list for ERASE: erssbl: .word noq .word qry ; Switch execution address list: .word badopx .word cnfswx .word badswx .word ambswx erseal: .word swbits .word swbits ; Argument list for SWTCHS call: ersarl: .word ersal .word erseal .word erssbl .sbttl list ; "List Current UCL Commands" LIST arg1,arg2,... ; ==== /OUT:file-spec ALL ; /PRINTER CHAIN ; /TERMINAL COMMANDS ; /FORM0 PATH ; /NOFORM0 SYMBOLS ; UC_STATUS ; VERSION lister:: clrb prlfnm ;Init PLINE's file name buffer clr wblok0 ; and start block no. mov #liswal,r4 ;R4 => argument list for SWTCHS call call swtchs ;Check for switches tst r5 ;Any errors? bpl 10$ ;Branch if not jmp @liswel(r5) ;Handle errors 10$: call adjr0 ;Skip any intervening blanks in input string tstb (r0) ;Null argument? bne 30$ ;Branch if not call lists ;Force default to "LIST SYMBOLS" 20$: .prlin #0 ;Clean up any remaining output return ;Quit 30$: .getcom ,#cmd ;Move argument to command buffer mov r0,savr0 ;Save input buffer pointer .cscan ,#lisal ;Look for valid argument tst r5 ;Invalid argument? bmi 40$ ;Branch if so call @liseal(r5) ;Go execute appropriate routine mov savr0,r0 ;Restore input buffer pointer tstb (r0) ;Done? beq 20$ ;Branch if so inc r0 ;Point at next argument br 30$ ;Go handle it 40$: .prlin #0 ;Clean up any remaining output jmp @liseal(r5) ;Go handle errors lista: ;"LIST ALL"... call listv ;List version call listc ;List commands call lists ;List symbols call listp ;List path call listx ;List chain call listu ;List uc_status return lists: ;"LIST SYMBOLS"... .prlin #listsm ;"Current Symbols" mov #nsyms,r5 ;R5 = max. no. symbols mov #sdsat,r4 ;R4 => SDS addr. table 10$: mov (r4)+,r1 ;R1 => next string address bne 20$ ;Branch if not end of table mov #nsyms,r0 ;R0 = max. no. symbols sub r5,r0 ;Make R0 = no. symbols defined mov #scrach,r1 ;R1 => scratch buffer (for ASCII decimal) call binasc ;Convert to ASCII .prlin #scrach ;"nnn Symbols Defined"... .prlin #listsd mov r5,r0 ;R0 = no. remaining entries mov #scrach,r1 ;R1 => buffer for ASCII call binasc ;Convert to ASCII .prlin #scrach ;"nnn Entries Remain"... .prlin #listse return ;Quit 20$: mov #scrach,r2 ;R2 => buffer for output string mov #,r3 ;R3 = max. no. characters to copy mov #-7,r0 ;R0 counts no. of characters copied call ccopy ;Copy symbol part to buffer br 40$ 30$: movb #space,(r2)+ ;Pad to 6 characters with blanks... 40$: inc r0 bne 30$ 50$: movb #'=,(r2)+ ;Insert "=="... movb #'=,(r2)+ mov -2(r4),r1 ;Copy definition part (put ~'s in add #,r1 ; place of control characters)... clr r0 60$: movb (r1)+,r0 beq 80$ cmpb r0,#37 bgt 70$ movb #'~,r0 70$: movb r0,(r2)+ dec r3 bne 60$ 80$: clrb (r2) ;Terminate with null .prlin #scrach ;Print result dec r5 ;Adjust counter br 10$ ;Go get next string ; Routine to convert a binary value in R0 to a decimal ASCII string. ; On entry, R1 points at the output buffer. On return, R1 points at ; a terminating 200 byte. binasc: call 10$ ;Call conversion routine movb #200,(r1) ;Add terminating byte return ;Quit 10$: push r0 ;Binary to decimal ASCII conversion clr r0 ; routine... 20$: inc r0 ;Stolen from page 2-67 of the V5 sub #10.,(sp) ; Programmer's Reference Manual bge 20$ add #72,(sp) dec r0 beq 30$ call binasc 30$: movb (sp)+,(r1)+ return .enabl lsb listu: ;"LIST UC_STATUS" bit #ucres,status ;UC: available? bne 10$ ;Branch if so .prlin #ucnav ;"UC Handler Not Available" return 10$: .prlin #uctxt ;"UC Text String:" mov #scrach,r0 ;R0 => text string mov r0,r1 ;R1 => destination for UC text call getucb ;Get the text from UC buffer tstb (r0) ;Null string? bne 20$ ;Branch if not mov #ucmty,r0 ;R0 => "" 20$: .prlin ;Print buffer contents... br 30$ listv: .prlin #crlf ;List program name/version... .prlin #vrshun 30$: .prlin #crlf return listc: ;"LIST COMMANDS"... .prlin #listcm ;"Valid Commands:" mov #rsals0,r1 ;R1 => Reference String Address List; skip "?" 40$: mov (r1)+,r0 ;Point R0 at a string beq 30$ ;Go quit if we've hit end of list .prlin ;Print the string br 40$ ;Go look for the next one listp: ;"LIST PATH" tstb pthbuf ;Do we have anything to list? bgt 50$ ;Branch if so .prlin #listp0 ;"No Run-by-name path"... return 50$: .prlin #listpm ;"Run-by-name" path:" .prlin #pthbuf ;Print the path... br 30$ listx: tstb pflags ;Branch if UCI_MODE in effect... bmi 60$ tst chanto ;Is CHAIN in effect? bgt 70$ ;Branch if so .prlin #listx0 ;"No CHAIN In Effect" br 30$ 60$: .prlin #listxu ;"Pass-Line-To-KMON In Effect..." br 30$ 70$: .prlin #listxm ;"CHAIN In Effect To..." .prlin #chanto br 30$ .dsabl lsb badarg: mov #mbadrg,r5 ;Issue "?UCL-F-Invalid Argument"... mov #cmd,r4 jmp ferrx ;Take "fatal" error exit ; Reference string address list for LIST: lisal: .word star .word allsw .word schain .word comsw .word spath .word symsw .word ucssw .word versw .word 0 ; Argument execution address list for LIST: .word badopx .word cnfswx .word badarg .word ambcom liseal: .word lista .word lista .word listx .word listc .word listp .word lists .word listu .word listv ; Switch handling routines... lisout: bit #,swstat ;Any switch conflicts? beq lisou0 ;Branch if not liscns: bis #cnswer,swstat ;Return with error sec return lisou0: call outsr ;Go handle switch bcc lisscp ;If no errors, go set up output file name return lisscp: push ;Save R0, R1 mov #outfnm,r0 ;Move file name from OUTFNM to PRLFNM... mov #prlfnm,r1 10$: movb (r0)+,(r1)+ bne 10$ pop ;Restore R1, R0 return lisprn: bit #,swstat ;Any switch conflicts? bne liscns ;Branch if so call prntsr ;Go handle switch bcc lisscp ;If not errors, stick "LP:" in PRLFNM buffers return listrm: bit #,swstat ;Any switch conflicts? bne liscns ;Branch if so clrb prlfnm ;Just do .PRINT's... clc return lisfm0: bit #nf0,swstat ;Any switch conflicts? bne liscns ;Branch if so jmp frmsr ;Go handle switch otherwise lisnf0: bit #fm0,swstat ;Any switch conflicts? bne liscns ;Branch if so jmp nfrmsr ;Go handle switch otherwise ; Switch Reference String Address List for LIST liswrs: .word frmsw, nfrmsw, outsw, prnsw, trmsw, 0 ; Switch Status-Bit List liswbl: .word fm0, nf0, out, prn, trm ; Switch Execution Address List .word badopx .word cnfswx .word badswx .word ambswx liswel: .word lisfm0 .word lisnf0 .word lisout .word lisprn .word listrm ; Argument List for SWTCHS call liswal: .word liswrs, liswel, liswbl .sbttl nosl, slon ; "SL editor on/off" NOSL or SLON ; ==== ==== ; These commands turn the single-line editor off/on. ; ; If UCL is RUN directly, the effect is to toggle SL locally. This assumes, ; of course, that SL was installed and turned on prior to running UCL and that ; SL is enabled for use by user programs. ; ; If NOSL or SLON is entered via the monitor, the effect is the same as ; typing, respectively, SET SL OFF or SET SL ON. .enabl lsb nosl:: call dsptst ;Check DISPLAY,RUN status bis #edit$,@#jsw ;Set "disable SL" bit in JSW mov #nosltx,r1 ;R1 => "SET SL OFF" 10$: bit #runc,status ;Were we RUN? beq 30$ ;Branch if not 20$: .rctrlo ;Ensure JSW updated return 30$: jmp setcmd ;Pass command to monitor slon:: call dsptst ;Check DISPLAY,RUN status bic #edit$,@#JSW ;Allow program to use SL mov #slontx,r1 ;R1 => "SET SL ON" br 10$ ;Go take appropriate action .nlist bex nosltx: .word 50$-40$ 40$: .asciz /SET SL OFF/ 50$: .byte 0 .even slontx: .word 70$-60$ 60$: .asciz /SET SL ON/ 70$: .byte 0 .even .list bex .dsabl lsb dsptst: bit #dspla,status ;DISPLAY active? beq 10$ ;Branch if not bit #runc,status ;Were we RUN? beq 10$ ;Branch if not jmp baddsp ;Complain if both true 10$: return .sbttl pass_on ; "Pass-on Command To Next (or another) Program" PASS_ON command ; ======= /TO:program-name ; This command tells UCL to pass the specified command- ; string on to the program that you specified via the ; CHAIN command. If you specify a "program-name", then ; the command is passed to this program instead. If ; CHAINing is not in effect, and you failed to specify ; a program to chain to, you get your hand slapped with ; "UCL-F-No CHAIN In Effect". ; ; Note that the command string is passed "UCL-style" ; (byte count at location 510, string starting at 512) ; not "run-by-name" style. pass:: mov #pasarl,r4 ;Check for /TO: switch... call swtchs tst r5 ;Errors? bpl 10$ ;Branch if not jmp @passea(r5) ;Go handle errors 10$: tst swstat ;/TO: invoked? beq 50$ ;Branch if not mov #outfnm,r4 ;R4 => file-spec tstb (r4) ;Null file-spec? beq 30$ ;Branch if so mov #chanto,r1 ;Move file-spec to chain file-spec buffer... mov #15.,r2 20$: movb (r4)+,(r1)+ beq 60$ sob r2,20$ mov #prlfnm,r4 ;Oops! Bad file name... 30$: mov #millfn,r5 40$: jmp ferrx 50$: tstb pflags ;UCI_MODE in effect? bmi 55$ ;Branch if so tst chanto ;Is there a file-spec for chaining? bne 60$ ;Branch if so 55$: clr r4 ;"No CHAIN In Effect"... mov #listx0+2,r5 br 40$ 60$: call adjr0 ;Skip any intervening blanks tstb (r0) ;Null command string? bne 70$ ;Branch if not .gtlin #buff,#dspqry ;"Command?" mov #buff,r0 ;R0 => command-string br 60$ ;Go check it 70$: mov r0,savr0 ;Go hand things off to the chainer... jmp chanr pasrsa: .word tosw ;Reference string address for switch .word 0 .word badopx ;Switch execution address list .word cnfswx .word badswx .word ambswx passea: .word outsr ;(use /OUT switch code) passsb: .word 1 ;Switch status bit pasarl: .word pasrsa ;Argument list for SWTCHS call .word passea .word passsb .sbttl path, nopath ; "Set Up 'Run-by-name' Search Path" [NO]PATH dev1,dev2,... ; ==== ; If a command or symbol is not found, UCL follows the ; list of devices set up with the PATH command in ; attempting a "run-by-name". ; The limit is about 20 device mnemonics. comma = 054 .enabl lsb npath:: bisb #bit7,pthbuf ;NOPATH enters here... br 45$ path:: bicb #bit7,pthbuf ;Restore possible path list call adjr0 ;Skip leading blanks tstb (r0) ;Null list? beq 45$ ;Branch if so mov #20.,r4 ;R4 = max. no. of devices mov #pthbuf,r2 ;R2 => path buffer mov #80.,r3 ;R3 = max. no. bytes to copy 30$: call adjr0 ;Get a mnemonic... .getcom ,#cmd call tstdmn ;Check it bcs 60$ ;Branch on error push r0 ;Copy mnemonic to path buffer... call ccopy pop r0 call adjr0 ;If end of list, go quit... tstb (r0) beq 40$ inc r0 ;Skip separator (comma presumably) dec r4 ;Adjust device count bne 50$ ;Branch if still room 40$: clrb (r2) ;Add terminating null 45$: jmp wtstbl ;Go write changes 50$: movb #comma,(r2)+ ;Stick in a comma br 30$ ;Go get next device name 60$: clr r4 ;"Illegal Device"... mov #dmnerr,r5 jmp ferrx .dsabl lsb ; Routine to check a device mnemonic and force a colon on the end. ; ; On entry: ; R1 => device mnemonic ; ; On return: ; R1 is unchanged ; carry is set if mnemonic too long or too short ; carry is clear if no error tstdmn:: push ;Save R5, R0 .getcom r1,,#tmtblc ;Trim possible ":"... mov r1,r0 ;Get length of mnemonic... call len pop r0 ;Restore R0 cmp r5,#3 ;Check for valid length... bgt 10$ tst r5 bgt 20$ 10$: pop r5 ;Error: restore R5, sec ; set carry, and return ; return 20$: add r1,r5 ;R5 => end of mnemonic movb #':,(r5)+ ;Put ":" on end and clrb (r5) ; trailing null pop r5 ;Restore R5 clc ; clear carry, and return ; return .sbttl prompt ; "Set new UCL prompt" PROMPT prompt-text ; ====== ; PROMPT replaces the current UCL+ prompt string with ; a new one. If no prompt-text is entered the default ; ("UCL> ") is restored. promt:: call adjr0 ;Skip leading blanks cmpb (r0),#'= ;Skip optional "="... bne 10$ inc r0 call adjr0 10$: push ;Save working registers cmpb (r0),#'" ;Skip optional " mark... bne 20$ inc r0 20$: mov r0,r1 ;R1 => prompt-text tstb (r1) ;If no text, use default... bne 30$ mov #dfpmt,r1 30$: mov #prompt,r2 ;R2 => prompt buffer mov #8.,r3 ;R3 = maximum allowable length call ccopy ;Copy the prompt-text cmpb -(r2),#'" ;Zap optional " mark... beq 40$ inc r2 40$: movb #200,(r2) ;Terminate with 200 byte (no cr/lf) pop ;Restore registers jmp wtstbl ;Preserve changes .sbttl recall ; "Recall Symbol Definition and Status Tables" RECALL file-spec ; ====== ; Recalls (loads) the symbol definition and status area from a file that ; has previously been created with the STORE command. The default device ; is DK: and the default extension is .UCL (ie, DK:filnam.UCL where "filnam" ; is the file name you specify). recall:: call adjr0 ;Point at the file name clr r5 ;Open the file... call opnucl mov r0,savr0 ;Save file name pointer movb vznrls,r4 ;Get current version... mov #0,wblok ;Load symbol definition/status stuff from mov #sdsat,wbufa ; file... mov #nbloks,r5 10$: .readw #area,#3 bcs 30$ inc wblok add #512.,wbufa sob r5,10$ cmpb vznrls,r4 ;Loaded stuff same release? bne 20$ ;Branch if not .close #3 ;Close the input channel jmp wtstbl ;Go update UCL.SAV ; error traps... 20$: mov #vrerr,r5 ;R5 => "Wrong Version..." br 40$ ;Go take error exit 30$: mov #rclerr,r5 ;R5 => "Read Error..." 40$: bic #runc,status ;Force an exit (tables might be screwed-up) mov savr0,r4 ;R4 => input file name (as entered) .close #3 ;Make sure input channel closed jmp ferrx ;Go complain and quit ; This routine opens a UCL file. It is used by the RECALL and STORE commands. ; On entry: ; R0 points at the file name (ASCIZ string) ; R5 = 0 to open an existing file (RECALL) ; = -1 to open a new file (STORE) ; The registers are undisturbed on return. ; ; OPNUCL also prompts for a file name, if necessary. opnucl:: push ;Save R0 - R3 10$: call adjr0 ;Null file name?... tstb (r0) bne 20$ ;Branch if not .gtlin #buff,#filqry ;"File?"... mov #buff,r0 br 10$ 20$: mov r0,r1 ;Copy file name to scratch area... mov #scrach,r2 mov #14.,r3 call ccopy tst r5 ;Open old or new file? bpl 30$ ;Branch if old mov #newsfx,r1 ;Stick "[22]=" after file name... mov #6,r3 call ccopy 30$: clrb (r2) ;Add terminating null mov sp,spsav ;Open the file.. .csigen dspace,#uclext,#scrach bcs opnurx ;Branch on error mov spsav,sp ;Clean up the stack pop ;Restore R3 - R0 return ; error trap... opnurx: mov spsav,sp ;Make R4 => file name (old R0)... mov 6(sp),r4 opnur0: clr r5 ;Make R5 index to error message... movb @#errbyt,r5 asl r5 .purge #0 ;Ensure any open channels cleaned-up... .purge #3 mov opnuet(r5),r5 ;Point at error message jmp ferrx ;Go complain and quit ; data area for OPNUCL... uclext: .rad50 "UCL" ;Default extensions for .CSIGEN call .rad50 "UCL" .word 0,0 newsfx: .asciz /[22]=/ .even opnuet: .word millfn ;Error message address table .word dmnerr .word mpfilf .word mnroom .word mfilnf .sbttl store ; "Store Current Symbol Definition and Status Tables" STORE file-spec ; ===== ; The STORE command causes the symbol/status blocks to be written to a ; specified file. The default device is DK:, the default extension .UCL ; (DK:filnam.UCL). store:: movb #rls,vznrls ;Ensure version/release stuff current... movb #vzn,vznrls+1 call adjr0 ;Point at filename mov #-1,r5 ;Open the file... call opnucl mov r0,savr0 ;Save pointer to file name clr wblok ;Write-out the symbol/status blocks... mov #sdsat,wbufa mov #nbloks,r5 10$: .writw #area,#0 bcs sterx inc wblok add #512.,wbufa sob r5,10$ .close #0 ;Close the output channel return ; error trap sterx: mov savr0,r4 ;R4 => file name sterx0: mov @strerr,r5 ;R5 => "Write Error..." .purge #0 ;Close channel; don't make file permanent jmp ferrx ;Go complain .sbttl uci_mode, nouci_mode ; "Switch UCI_MODE operation on/off" [NO]UCI_MODE prompt-string ; ======== ; UCI_MODE sets the "pass line to KMON" flag ; and then executes the equivalent of a ; "PROMPT=prompt-string" command. ; ; NOUCI_MODE does a "PROMPT=prompt-string". ; The "pass line to KMON" flag is cleared. .enabl lsb ; UCI_MODE... ucimod:: bisb #ucimd,pflags ;Set UCI_MODE flag .if ne pfx call 20$ ;Activate prefix for hard-wired commands .endc 10$: jmp promt ;PROMPT=... ; NOUCI_MODE... nucimd:: bicb #ucimd,pflags ;Clear UCI_MODE and RUN flags... bicb #,status br 10$ ;Go do PROMPT=... ; If UCI_MODE is in effect, this routine adjusts the string pointers for the ; hard-wired commands to point at the prefix character. .if ne pfx ucitst: tstb pflags ;UCI_MODE in effect? bpl 40$ ;Branch if not tstb status ;Prefix stuff already done? bmi 40$ ;Branch if so 20$: push r0 ;Save R0 mov #rsals0,r0 ;R0 => reference string address list 30$: dec (r0)+ ;Point at command prefix character tst (r0) ;Done? bne 30$ ;Branch if not pop r0 ;Restore R0 bis #ucimd,status ;Flag completion 40$: return ; and quit .endc .dsabl lsb .if ne cd$c .sbttl cd ; "Change Default Device" CD device ; == ; CD dev becomes ASSIGN dev DK: ; ; CD with no argument becomes ASSIGN SY: DK: chngdf:: call adjr0 ;Skip any intervening blanks tstb (r0) ;Null argument? beq 20$ ;Branch if so 10$: mov r0,r1 ;R1 => "dev" mov #argbuf,r2 ;R2 => buffer for device mnemonic mov #4,r3 ;R3 = max. no. bytes to copy call ccopy ;Copy mnemonic to buffer... clrb (r2) mov #assign,r1 ;R1 => "ASSIGN dev" mov #dk,r0 ;R0 => " DK:" jmp subcmd ;Go assemble the parts and execute the command 20$: mov #ddk,r1 ;R1 => "ASSIGN SY: DK:" stuff jmp setcmd ;Go execute it .nlist bex ddk: .word assign-ddktxt ddktxt: .ascii /ASSIGN SY:/ dk: .asciz / DK:/ assign: .ascii /ASSIGN / argbuf: .blkb 5 .list bex .even .endc .if ne rno$c .sbttl rno ; Runoff Command Routine RNO/switches file-spec ; === ; ; RNO/switches MYFILE becomes RUNOFF outspec/switches=MYFILE ; This set of routines and tables implements an RNO command for use with ; DECUS RUNOFF version M02.4. ; ; The command switches and the RUNOFF switches and file specifications ; that they map to are as follows: ; ; RNO RUNOFF ; --- ------ ; /BEGIN:n /B:n ; /START:n ; ; /END:n /E:n ; ; /ONLY:n /B:n/E:n ; /PAGE:n ; ; /FORMLENGTH:n /F:n ; ; /HYPHENATION /H:YES ; ; /NOHYPHENATION /H:NO ; ; /HELP /I ; /INFORMATION ; ; /STRIP /S ; ; /NOSTRIP ignored ; ; /UNDERLINE /U:L ; /UNDERLINE:BACKSPACE /U:B ; :SIMULATED /U:S ; :NONE /U:N ; ; /NOUNDERLINE /U:N ; ; /VERSION /V ; ; /WAIT /W ; ; output specifications: ; ; /OUT:filename filename...= ; ; /PRINTER LP:...= ; ; /TERMINAL TT:...= ; ; no output spec. or LP:...= ; /DEFAULTS rno:: clrb outfnm ;Init. output file buffer mov #rnalst,r4 ;R5 => switch argument list call swtchs ;Process switches jmp @rnovec(r5) ;Go do whatever is right ; Above jump enters at RNOOK if no problems with switches rnook: call adjr0 ;Skip leading blanks tstb (r0) ;Null input file? bne 10$ ;Branch if not bit #4,swstat ;Input file required? bne 10$ ;Branch if not .gtlin #buff,#rnpmt ;"Input File?"... mov #buff,r0 br rnook 10$: push r0 ;Save R0 clr r0 ;Actual byte count accumulates in R0 mov #chbuf,r2 ;R2 => "chain buffer" mov #chbufl,r3 ;R3 = max. byte copy count mov #rnotxt,r1 ;Put "R RUNOFF" in chain buffer call ccopy0 bit #2,swstat ;Any output spec. entered? bne 20$ ;Branch if yes bit #4,swstat ;Output file required? bne 30$ ;Branch if not mov #deftxt,r1 ;Use "LP:" otherwise... call ccopy br 30$ 20$: mov #outfnm,r1 ;Copy output spec... call ccopy 30$: mov #stxbuf,r1 ;Copy switches... call ccopy mov #eqlsin,r1 ;Insert "="... call ccopy pop r1 ;R1 => input spec. (old R0) call ccopy0 ;Copy it to chain buffer mov #uarowc,r1 ;Copy in "^C"... call ccopy0 mov #chbuf,r1 ;Pass command line to RT-11... jmp setcm0 ; Specialized switch routines for RNO... ; /OUT:filename rnoutr: bit #2,swstat ;Already have output spec? bne confsw ;Yes jmp outsr ;No confsw: bis #cnswer,swstat ;Set "conflicting switches" flag sec ;Set carry bit return ; /PRINTER rnprnr: bit #2,swstat bne confsw jmp prntsr ; /TERMINAL rntrmr: bit #2,swstat bne confsw jmp termsr ; /DEFAULTS rndefr: bit #2,swstat ;Previous output specs? bne confsw push ;Save R0, R1... mov #deftxt,r0 ;Copy default stuff to output-spec. buffer... mov #outfnm,r1 10$: movb (r0)+,(r1)+ bne 10$ pop ;Restore R1, R0... jmp swbits ;Update switch status ; /ONLY:n and /PAGE:n rnolyr: mov #rnbsrs,r1 ;R1 => "/B:" call ctstxb ;Append it to switch text buffer call getopt ;Get the "n" part into OPBUF bcc 20$ ;Branch if it was there dec stxbp ;Zap unneeded ":"... clrb @stxbp 10$: jmp swbits ;Go update switch status 20$: push r1 ;Save R1 (points at the "n" part) 30$: cmpb (r1),#'0 ;See if "n" text is entirely numeric... blt 40$ cmpb (r1)+,#'9 bgt 40$ tstb (r1) bne 30$ movb #'.,(r1)+ ;They're all numbers; append decimal point... clrb (r1) 40$: pop r1 ;Restore R1 call ctstxb ;Append the "n" to the switch text buffer mov #rnesrs,r1 ;R1 => "/E:" call ctstxb ;Copy this part mov #opbuf,r1 ;R1 => "n" part again call ctstxb ;Copy it br 10$ ;Go quit ; /UNDERLINE:option rnuswr: call adjr0 ;Skip leading blanks cmpb (r0),#': ;Is there an option? beq 10$ ;Yes... jmp stxoly ;No, take default 10$: call getopt ;Put option in OPBUF push ;Save R3 - R5 .cscan ,#uswrsa ;Look for a match... mov r5,r1 ;Put offset in R1 bpl 20$ ;Branch if there was a match bis #badopt,swstat ;Set "bad option" flag br 30$ ; and branch 20$: mov uswsta(r1),r1 ;R1 => switch text call ctstxb ;Copy to STX buffer 30$: pop ;Restore R5 - R3... call swbits ;Update switch status bit #badopt,swstat ;Did we have bad option? beq 40$ ;Branch if not sec return 40$: clc ;Return with no errors... return ; Reference string address list for UNDERLINE options... uswrsa: .word uswb, uswn, usws, 0 ; Reference strings for options... .nlist bex uswb: .asciz /BACKSPACE/ uswn: .asciz /NONE/ usws: .asciz /SIMULATED/ .list bex .even ; UNDERLINE switch text address list... uswsta: .word rnusrb, rnusrn, rnusrs ; Address lists, tables, text for RNO command... .nlist bex rnpmt: .ascii "Input File? "<200> rnotxt: .asciz "R RUNOFF" deftxt: .asciz "LP:" eqlsin: .asciz "=" uarowc: .byte 3,0 ; Reference strings for switches: rnob: .asciz /BEGIN/ rnosta: .asciz /START/ rnod: .asciz /DEFAULTS/ rnoe: .asciz /END/ rnof: .asciz /FORMLENGTH/ rnohy: .asciz /HYPHENATION/ rnonhy: .asciz /NOHYPHENATION/ rnoi: .asciz /INFORMATION/ rnoh: .asciz /HELP/ rnooly: .asciz /ONLY/ rnoout: .asciz /OUTPUT/ rnopag: .asciz /PAGE/ rnoprn: .asciz /PRINTER/ rnos: .asciz /STRIP/ rnons: .asciz /NOSTRIP/ rnotrm: .asciz /TERMINAL/ rnou: .asciz /UNDERLINE/ rnonu: .asciz /NOUNDERLINE/ rnov: .asciz /VERSION/ rnow: .asciz /WAIT/ ; Switch text for output: rnbsrs: .asciz "/B:" rndsrs: .asciz "/D" rnesrs: .asciz "/E:" rnfsrs: .asciz "/F:" rnhsry: .asciz "/H:YES" rnhsrn: .asciz "/H:NO" rnisrs: .asciz "/I" rnssrs: .asciz "/S" rnusrb: .asciz "/U:B" rnusrl: .asciz "/U:L" rnusrn: .asciz "/U:N" rnusrs: .asciz "/U:S" rnvsrs: .asciz "/V" rnwsrs: .asciz "/W" .list bex .even ; Switch reference string address list: rnsrsa: .word rnob, rnod, rnoe, rnof, rnoh .word rnohy, rnoi, rnonhy, rnons, rnonu .word rnooly, rnoout, rnopag, rnoprn, rnosta .word rnos, rnotrm, rnou, rnov, rnow .word 0 ; Switch execution address list: rnseal: .word stxotx, rndefr, stxotx, stxotx, stxoly .word stxoly, stxoly, stxoly, swbits, stxoly .word rnolyr, rnoutr, rnolyr, rnprnr, stxotx .word stxoly, rntrmr, rnuswr, stxoly, stxoly ; Switch status bit list: rnssbl: .word 1, 2, 1, 1, 4 .word 1, 4, 1, 1, 1 .word 1, 2, 1, 2, 1 .word 1, 2, 1, 4, 1 ; Switch text address list: rnstxa: .word rnbsrs, rndsrs, rnesrs, rnfsrs, rnisrs .word rnhsry, rnisrs, rnhsrn, 0, rnusrn .word 0, 0, 0, 0, rnbsrs .word rnssrs, 0, rnusrl, rnvsrs, rnwsrs ; Argument list for SWTCHS call: rnalst: .word rnsrsa .word rnseal .word rnssbl .word rnstxa ; Jump table for results of switch parsing: .word badopx .word cnfswx .word badswx .word ambswx rnovec: .word rnook .endc