.TITLE RT11 V5.0 SIMULATOR .IDENT /V5.004/ .ENABL LC .NLIST BEX,CND,ME ; Author: C J Doran ; Sira Ltd., South Hill, Chislehurst, Kent, BR7 5EH, England ; Tel: 01 467 2636 Telex: 896649 Fax: 01 467 6515 ; ; This module simulates under RSX-11M most of the RT-11 system directives, ; enabling RT11 programs to be debugged under RSX-11. ; ; It is by no means a complete simulation, and some special procedures are ; required, see accompanying documentation for current status, restrictions ; and instructions for use. ; ; Assemble as: ; ; >MAC RT11,RT11=LB:[1,1]EXEMC/ML,SY:[ggg,mmm]RT11 ; ; MODIFICATIONS RECORD ; ==================== ; V5.001 7-Oct-83 CJD ; Correct ALPHAN -- used to reject 'A'. Make it slightly more efficient. ; Correct command line detection, and output LF if there isn't one. ; Add more conditional code -- F$$LPP (FPP), F$$LTP (FIS), H$$RTZ (line freq). ; ; V5.002 10-Aug-84 CJD ; Get stack right, by popping count back to %3 if .EXTND (in WRITX) fails. ; Also in WRITX, force even byte count on short block read, since QIO ; with odd count is forbidden (and RT-11 transfers by words anyway). ; ; V5.003 11-Sept-84 CJD ; Allow for arithmetic overflow in MUL at 18$ in WRITX. ; ; V5.004 19-Nov-84 CJD ; Return EOF on read if 0 bytes remain (last block exactly full) -- ; used to return illegal buffer error (can't QIO read 0 bytes). ; ; See documentation regarding the definition of the following symbol. ; Basically, DON'T define it !!! ;ABSLOW=0 ; ; Define DEBUG to place sections at convenient offsets so that insertions ; don't change too many addresses (saves relisting each time during debugging). ;DEBUG=1 ; ; Define ONE and ONLY ONE of the following for the type of monitor to be ; simulated: ;SJ=0 ; Single-job ;FB=0 ; Foreground-background XM=0 ; Extended ; ; Set RT-11 version -- units digit is revision letter on early RT-11's (A=1) RTVRSN=50 ; V5.0 (or later) ; ; CHANS sets the maximum no of I/O channels allowed (0-CHANS) .IIF NDF CHANS,CHANS=8. ; 0-CHANS .IF NDF SJ ; TERMS sets the maximum no of additional terminals (FB & XM only) .IIF NDF TERMS,TERMS=7 ; TI:=0, others 1-TERMS .IFF TERMS=0 ; TI:=0, no other terminals .ENDC ; ; The following symbols have the same meanings as in RSXMC.MAC: ; ; Define S$$TOP if STSE directive is to be used for .WAIT, otherwise WTSE will be used. S$$TOP=0 ; ; Define P$$OFF if spawn directive is available, enabling .CHAINing P$$OFF=0 ; ; Define A$$BRT if specify requested exit AST is available, enabling .SCCA A$$BRT=0 ; ; Define F$$LPP if system has a floating-point processor, enabling FIS simulation ; and floating-point traps. F$$LPP=0 ; ; Define F$$LTP if system has FIS already, simulation not required. ;F$$LTP=0 ; .IF DF F$$LPP ; If we have a floating-point processor .IIF NDF F$$LTP,SIMFIS=0 ; but no FIS instructions, simulate them .ENDC ; ; Set line clock frequency. H$$RTZ=50. ; ; Define L$$SI1 if running on a PDP 11/03 ;L$$SI1=0 ; Bit masks: MSKVAL=1 .IRP $$$N,<0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16> BIT'$$$N=MSKVAL MSKVAL=MSKVAL*2 .ENDR .MCALL QIOW$,QIOW$S,QIO$S,GTIM$,DIR$,GTSK$,SFPA$,SFPA$S,STSE$,WTSE$ .MCALL GMCR$,EXIT$S,MRKT$,STOP$S,SPND$S,ALTP$,USTP$,RSUM$,SPWN$ .MCALL ASTX$S,ENAR$S,DSAR$S,ENCP$S,DSCP$S,STIM$,GLUN$,SREX$,ABRT$S .MCALL FCSMC$,OFNB$U,OFNB$W,OFNB$R,HDRDF$,UCBDF$,FHDOF$,ALUN$S .IIF GE RTVRSN-50, FHDOF$ ; Define file header offsets HDRDF$ ; Define task header offsets UCBDF$ ; Define unit control block offsets FCSMC$ ; Define FCS macros ; System area in "low" memory. .IF DF ABSLOW ; Note that UFLOAT to TTNFIL are mapped to local storage within the simulator. USRTRP=4 ; User routine for traps 4/10, set by .TRPSET BPTVEC=14 ; Breakpoint trap IOTVEC=20 ; IOT trap TRAPVC=34 ; User TRAP vector USERPC=40 ; Program start address USERSP=42 ; Initial SP JSW=44 ; Job status word TTLC$=BIT14 ; Bit 14 set to disable lower-upper case conversion TTSPC$=BIT12 ; Bit 12 set for TT special mode TCBIT$=BIT6 ; Bit 6 set for TT wait mode UFLOAT=46+SAVERT-46 ; USR load address USERTO=50+SAVERT-46 ; Highest memory used by program ERRBYT=52+SAVERT-46 ; EMT error code USERRB=53+SAVERT-46 ; User error code. Bits 0-4 only SUCCS$=BIT0 ; Success bit 0 WARN$=BIT1 ; Warning bit 1 ERROR$=BIT2 ; Error bit 2 SEVER$=BIT3 ; Severe error bit 3 SYSPTR=54+SAVERT-46 ; Start of resident monitor (also REAL word 54) TTFILL=56+SAVERT-46 ; No fillers TTNFIL=57+SAVERT-46 ; No of fill chars FISVEC=244 ; FIS exception vector .IFF ; Entries are in the right order, and the right size, but not the right ; place, for reasons given above. .BLKx'd locations will be filled in at the ; first EMT, or can be set by the user program. .PSECT SYSCOM,RW,D,GBL,OVR SYSCOM: .=SYSCOM+4 USRTRP: .BLKW 2 ; User routine for trap 4, set by .TRPSET .BLKW 2 ; Same routine used for trap 10, sets carry .=SYSCOM+14 BPTVEC:: .BLKW 2 ; Breakpoint trap IOTVEC:: .BLKW 2 ; IOT trap .=SYSCOM+34 TRAPVC:: .BLKW 2 ; User TRAP vector .=SYSCOM+40 USERPC:: .BLKW 1 ; Program start address USERSP:: .BLKW 1 ; Initial SP JSW:: .WORD BIT14 ; Job status word USWAP$==BIT15 ; SJ USR swap bit TTLC$==BIT14 ; Set to disable lower-upper case conversion RSTRT$==BIT13 ; Re-enter bit TTSPC$==BIT12 ; Set for TT special mode CHNIF$==BIT11 ; Pass line to KMON VIRT$==BIT10 ; Virtual image bit OVLY$==BIT9 ; Overlaid program CHAIN$==BIT8 ; Chain bit HLTER==BIT7 ; SJ I/O error halt TCBIT$==BIT6 ; Set for TT wait mode SPXIT$==BIT5 ; Special chain exit EDIT$==BIT4 ; Set to turn off single-line editor GTLIN$==BIT3 ; Non-terminating .GTLIN bit UFLOAT:: .WORD 0 ; USR load address USERTO:: .BLKW 1 ; Highest memory used by program ERRBYT:: .BYTE 0 ; EMT error code USERRB:: .BYTE ^B11110000 ; User error code. Bits 0-4 only SUCCS$==BIT0 ; Success WARN$==BIT1 ; Warning ERROR$==BIT2 ; Error SEVER$==BIT3 ; Severe error FATAL$==BIT4 ; Fatal error SYSPTR:: .WORD $RMON ; Start of resident monitor TTFILL:: .BYTE 0 ; No fillers TTNFIL:: .BYTE 0 ; No of fill chars .=SYSCOM+244 FISVEC:: .BLKW 2 ; FIS exception vector .ENDC ; Resident monitor user-accessible locations. .PSECT $RMON,D,RW,GBL,OVR DUMMY=0 ; Initialiser for dummy locations $RMON:: RTS PC ; Common interrupt entry point (not used) .=$RMON+4 $CSW:: .BLKW 16.*5 ; Background job channel area .=$RMON+244 $SYSCH:: .WORD CHANS+1 ; Internal channel (LUN) for simulator functions .=$RMON+252 I.SERR:: ; SJ Hard soft error indicators I.SPLS:: .WORD 0 .=$RMON+256 BLKEY:: .WORD DUMMY ; Directory segment number in memory CHKEY:: .WORD DUMMY ; Device index/unit no in memory $DATE:: .BLKW 1 ; Current date value DFLG:: .WORD 0 ; Directory operation in progress flag $USRLC:: .BLKW 1 ; Start of USR QCOMP:: .WORD RTSPC ; Address of I/O exit routine SPUSR:: .WORD 0 ; Special device handler error word SYUNIT:: .BYTE 0,0 ; Unit no of system device SYSVER:: .BYTE RTVRSN/10 ; Monitor version number SYSUPD:: .BYTE RTVRSN&7 ; Release level CFGW=BIT9 ; Compute configuration word (USR always resident), and: .IIF DF FB,CFGW=CFGW!BIT1 ; Bit 1 marks FB .IIF EQ H$$RTZ-50.,CFGW=CFGW!BIT5 ; Bit 5 set if 50Hz clock .IIF DF F$$LPP,CFGW=CFGW!BIT6 ; Bit 6 set if floating-point processor ; Set bit 7 to spool LP: output (simulator assumes foreground job is despooler) .IIF DF L$$SI1,CFGW=CFGW!BIT11 ; Bit 11 flags LSI-11 processor .IIF DF XM,CFGW=CFGW!BIT1!BIT12 ; Bits 1 and 12 mark XM monitor CONFIG:: .WORD CFGW SCROLL:: .WORD RTSPC ; Address of VT11 scroller TTKS:: .WORD 177560 ; Console keyboard status TTKB:: .WORD 177562 ; Console keyboard buffer TTPS:: .WORD 177564 ; Console printer status TTPB:: .WORD 177566 ; Console printer buffer MAXBLK:: .WORD 177777 ; Max file size E16LST:: .WORD EMT340-$RMON ; Offset to (simulator) EMT dispatch table .IF DF SJ $TIME:: .WORD 0,0 ; Current time .IFF CNTXT:: .WORD DUMMY ; Pointer to impure area JOBNUM:: .WORD 0 ; Current job number .ENDC SYNCH:: .WORD RTSPC ; .SYNCH routine address LOWMAP:: .WORD 0 ; Low memory protection bitmap .=$RMON+352 USRLOC:: .WORD RTSPC ; USR entry pointer GTVECT:: .WORD 320 ; VT11/VS60 display stop interrupt vector ERRCNT:: .BYTE 0 ; Error count byte .=$RMON+360 $MTPS:: RTI ; Move @SP-to-PS $MFPS:: BR STKPS ; Move PS to stack SYINDX:: .WORD DEVTAB-$RMON ; Index into monitor device tables STATWD:: .WORD 0 ; Indirect command status word CONFG2:: .WORD BIT1!BIT2!BIT8 ; Extension configuration word .IIF DF SJ,SYSGEN:: .WORD 0 ; Sysgen option word .IIF DF XM!FB,SYSGEN:: .WORD BIT0!BIT1!BIT12!BIT13 ; Sysgen option word USRARE:: .WORD 0 ; USR size ERRLEV:: .BYTE FATAL$!SEVER$!ERROR$ ; IND abort error level IFMXNS:: .BYTE 3 ; IND file nesting, default 3 EMTRTN:: .BLKW 1 ; Internal offset for BATCH FORK:: .WORD RTSPC-$RMON ; Fork request processor .IF GE RTVRSN-40 PNPTR:: .WORD DUMMY ; Offset to $PNAME table .IF DF XM MONAME:: .RAD50 /RT11XM/ ; Extended monitor SUFFIX:: .RAD50 / X/ ; Device handler suffix X .IFF .IIF DF SJ,NONAME:: .RAD50 /RT11SJ/ ; Single-job monitor .IIF DF FB,MONAME:: .RAD50 /RT11FB/ ; Foreground-background monitor SUFFIX:: .WORD 0 ; (No) device handler suffix .ENDC DECNET: .WORD 0 ; Reserved for DECNET .ENDC ; V4 ff .IF GE RTVRSN-50 EXTIND:: .BYTE 0 ; Stored error byte for IND INDSTA:: .BYTE 0 ; IND control status byte $MEMSZ:: .BLKW 1 ; Max memory available .=$RMON+424 $TCFIG:: .WORD TTCNFG ; Pointer to console configuration word $INDDV:: .WORD INDDEV ; Pointer to IND device name/unit no MEMPTR:: .WORD 0 ; Memory block control pointers (not implemented) .IF DF XM P1EXT:: .WORD 177777 ; Kernel PAR1 init routine addr (not implemented) .IFF P1EXT:: .WORD 0 ; Kernel PAR1 init routine. Not used by SJ/FB .ENDC .ENDC ; V5 ff ; Dummy monitor code (no fixed position): .IF GE RTVRSN-50 INDDEV: .ASCII "SY0:" ; IND device name & unit no .EVEN .ENDC ; Put the processor status word onto the stack. ; NOTE: The simulator recognises the instruction MFPS -(SP), see below. This ; is an illegal instruction in user mode under RSX. STKPS: MFPS -(SP) ; Push PS MOV @SP,-(SP) ; Make a space MOV 4(SP),@SP ; Copy return address to bottom MOV 2(SP),4(SP) ; and PS to what will be @SP RTI ; and do an RTI leaving PS on stack (& in PS) ; I/O and miscellaneous data areas. ; Allocate FDB's for the CHANS files. See IOAST routine for order of this data. .MACRO DEFFIL CHAN,LN COMP'CHAN: .WORD 0 BKST'CHAN: .WORD 1,0 FDB'CHAN:: FDBDF$ ; Define FDB FDAT$A R.FIX,,512. FDRC$A FD.RWM FDBK$A ,,,LN,BKST'CHAN FDOP$A LN,,,FO.UPD FDBF$A LN .ENDM DEFFIL FSRSZ$ 0,0,$RMON ; All files processed by block I/O LUN=1 ; RSX-11M LUN number = CHAN+1 .IRPC CH,<012345678> DEFFIL CH,\LUN LUN=LUN+1 .ENDR FILSPC=FDB1-FDB0 ; Space used by 1 file descriptor L.COMP=COMP0-FDB0 ; Offset to completion routine address L.BKST=BKST0-FDB0 ; Offset to status block SPRLUN=LUN ; Spare LUN SPRFLG=LUN ; and event flag ; Spare FDB for RENAME -- doesn't need an AST routine: SPRBKS: .WORD 1,0 SPRFDB: FDBDF$ FDAT$A R.FIX,,512. FDRC$A FD.RWM FDBK$A ,,,LUN,SPRBKS FDOP$A LUN,,,FO.UPD FDBF$A LUN TILUN=LUN+1 ; Next LUN for user terminal ; Terminal descriptor block(s): T.STT=0 ; Word 1 is main status T.PTR=TIPTR-TISTT ; Word 2 is pointer to buffer: T.BUFF=TIBUF-TISTT ; in next 136 bytes T.AST=TIAST-TISTT ; AST word address is next .IF GE RTVRSN-40 T.ST2=TISTT2-TISTT ; Then auxiliary status, bit 7=read-pass-all, bit 15-write-pass-all .IFTF TTCNFG:: TISTT: .WORD 1 ; Console status -- always attached TIPTR: .WORD TIBUF ; Buffer pointer ; If this task is installed, following initial code in TIBUF will return ; the command line into the buffer. TIBUF: .WORD 0 ; Will point to null here if no command GMCR: GMCR$ ; Fill rest of buffer with a GMCR DPB & buffer .=TIBUF+136. ; Allocate full input buffer TIAST: .WORD 0 ; Asynchronous terminal status word .IFT TISTT2: .WORD ^B0011 ; Configuration word 2, parity & no of bits fixed .ENDC TTYSPC=.-TISTT ; Space per terminal .IF NDF SJ ; Unless single-job monitor .MACRO DEFTTY LN ; Define terminal workspaces T'LN'STT: .WORD 0 T'LN'PTR: .WORD T'LN'BUF T'LN'BUF: .BLKB 136. T'LN'AST: .WORD 0 .IIF GE RTVRSN-40,T'LN'ST2: .WORD ^B0011 .ENDM DEFTTY LUN=1 .REPT TERMS ; Define space for rest of terminals DEFTTY \LUN LUN=LUN+1 .ENDR .ENDC ; Miscellaneous RSX-11M DPB's ; =========================== .IIF DF F$$LPP,SFPEA: SFPA$ FPTRAP ; Floating-point exception trap STIM: STIM$ OUTSPC ; Set date and time GTIME: GTIM$ OUTSPC ; Get date and time MRKT: MRKT$ SPRFLG ; Mark time GLUN: GLUN$ ,OUTSPC ; Get LUN information to OUTSPC area .IIF DF A$$BRT,SREX: SREX$ ; Set/clear requested exit AST .IF NDF S$$TOP RESTRT: RSUM$ ; Resume self TSKNAM=RESTRT+R.SUTN ; Name filled in here ALTP: ALTP$ ; Alter priority during waits WEVENT: WTSE$ ; Wait for flag WAIFLG=WEVENT+W.TSEF ; filled in here .IFF RESTRT: USTP$ ; Unstop self TSKNAM=RESTRT+U.STTN ; Name filled in here WEVENT: STSE$ ; Stop for flag WAIFLG=WEVENT+S.TSEF ; filled in here .ENDC .IIF DF P$$OFF,SPWN: SPWN$ CLI...,,,,,,,,512 ; Spawn command to default CLI ; Terminal QIOs modify and/or use DPB QIOW. ; NOTE: It is assumed almost everywhere that the default LUN is TILUN, so ; output goes to TI:. Change back to TILUN if you alter it. .MACRO TTQSET FUNC,LUN,ADDR,LEN ; Set DPB only .IIF NB,FUNC, MOV FUNC,QIOW+Q.IOFN .IF NB,LUN MOV LUN,QIOW+Q.IOLU MOVB LUN,QIOW+Q.IOEF .ENDC .IIF NB,ADDR, MOV ADDR,QIOW+Q.IOPL .IIF NB,LEN, MOV LEN,QIOW+Q.IOPL+2 .ENDM TTQSET .MACRO TTQIOW FUNC,LUN,ADDR,LEN ; Set DPB and execute TTQSET FUNC,LUN,ADDR,LEN DIR$ #QIOW .ENDM QIOW: QIOW$ IO.ATT,TILUN,TILUN,,IOSTAT,,<,,0> ; General purpose terminal QIO DPB IOSTAT: .BLKW 2 ; I/O status block CCOBUF: .BYTE TC.NEC,0 ; Cancel control/O STAR: .BYTE '*,200 ; Asterisk prompt CRLF: .BYTE 15,12 ; CRLF for .PRINT ; Table of legal RT-11 devices (see .DSTATUS write-up) ; Mark as "loaded" any device you actually have, or at least any you wish to ; use from the simulator without requiring a .FETCH. .MACRO DEVINF DEV,MAXUNT,DEVNO,STATUS,HSIZE,DSIZE,LOADED .WORD ^R'DEV ,DEVNO!STATUS,HSIZE .IIF B,LOADED, .WORD 0 .IIF NB,LOADED, .WORD $USRLC!1 .WORD DSIZE,"'DEV,MAXUNT .ENDM DEVINF ; Device table entry offsets: D.R50=0 ; Device name, radix-50 D.STAT=2 ; Device status (assumed to be 2nd word by SETFNB) D.HSIZ=4 ; Handler size D.LOAD=6 ; Load address D.DSIZ=10 ; Device size D.ASCI=12 ; Device name, ASCII D.MAXU=14 ; Max no of units D.ESIZ=16 ; Table entry size ; Status bits (hi byte). Lo byte of status is a device no. RA=BIT15 ; Random access device RO=BIT14 ; Read only device WO=BIT13 ; Write only device NR=BIT12 ; Non-RT directory structure AB=BIT11 ; Use handler abort point SF=BIT10 ; Accept .SPFUN requests SZ=BIT10!BIT8 ; .SPFUN 373 gives device size X=100 ; Dummy handler size for the moment DEVTAB: ; Name Highest Dev no Status Hdlr Vol Loaded ; unit no size size ? DEVINF CR 0 14 RO!NR X 0 ; Card reader DEVINF CT 1 13 SF X 0 ; Cassette .IIF GE RTVRSN-40,DEVINF DD 3 34 RA!SF X 512. YES ; Dectape II DEVINF DL 3 5 RA!SZ X 10240. YES ; RL01/2 DEVINF DM 7 23 RA!SZ X 27126. ; RK06/7 DEVINF DP 7 21 RA X 177777 ; RP02/3 DEVINF DS 7 16 RA X 1024. ; RJS03/4 DEVINF DT 7 1 RA X 578. ; DECtape I .IIF GE RTVRSN-50,DEVINF DU 7 50 RA!SF X 800. ; UDA50 devices DEVINF DX 3 22 RA!SF X 494. ; RX01 DEVINF DY 3 6 RA!SZ X 988. ; RX02 DEVINF EL 0 2 NR X 0 ; Error logger DEVINF LP 0 3 WO!NR X 0 YES ; Lineprinter .IIF GE RTVRSN-40,DEVINF LS 0 41 WO!NR X 0 ; Serial printer DEVINF MM 7 20 SF X 0 ; TJU16/TU45 .IIF GE RTVRSN-40,DEVINF MQ 0 42 WO!NR X 0 ; Message handler .IIF GE RTVRSN-40,DEVINF MS 7 35 SF X 0 ; TSV03 magtape DEVINF MT 7 11 SF X 0 YES ; TM11/TMA11/TS03 DEVINF NL 0 25 NR X 0 YES ; Null device DEVINF PC 0 7 NR X 0 YES ; Paper tape punch/reader DEVINF RF 0 12 RA X 1024. ; RF11 DEVINF RK 7 0 RA X 4800. YES ; RK05 DEVINF DK 7 0 RA X 4800. YES ; RK05 DEVINF TT TERMS 4 NR X 0 YES ; Terminals .IIF GE RTVRSN-50,DEVINF VM 0 47 RA X 0 ; Virtual memory ; Pseudo-devices DEVINF SY 3 5 RA X 10240. YES ; System device (RL01) TIINF: DEVINF TI 0 4 NR X 0 YES ; Terminal DEVINF PR 0 7 RO!NR X 0 YES ; Paper tape reader DEVINF PP 0 7 WO!NR X 0 YES ; Paper tape punch .WORD 0 ; End of table ; OUTSPC contains one-time code used at the first EMT. After that, it is ; re-used by several functions as general workspace. OUTSPC: MOV %0,-(SP) ; Save EMT parameter .IF DF ABSLOW OUTSPC: MOV #USERPC,%0 ; Address start of system area MOV H.IPC,(%0)+ ; Set program start address MOV H.ISP,(%0)+ ; and initial stack pointer MOV #TTLC$,@%0 ; Set JSW bit disabling LC/UC conversion CLR SAVERT ; Clear USR address (to be) .IFF MOV H.IPC,USERPC ; Set program start address MOV H.ISP,USERSP ; and initial stack pointer MOV TEMP2,USERTO ; .LIMIT in TEMP puts top of prog addr in TEMP2 .ENDC .IF GE RTVRSN-50 JSR PC,DATE ; Set up $DATE .IF DF SJ MOV #OUTPTR,%5 ; Address pointer to temporary workspace (2 words) JSR PC,GTIM ; Whilst setting $TIME .ENDC MOV #1,%0 ; Load MTGET function sub-code MOV #TIGET,%5 ; and pointer to dummy argument block JSR PC,MTIO ; Get TI: characteristics to TTCNFG .IFF DIR$ $GTIM ; Get time .ENDC MOV OUTSPC+G.TICP,TICKPS ; Save clock ticks per second for TWAIT DIR$ #GMCR ; Get command line (if any) into buffer BCS 13$ ; No command line if GMCR fails MOV $DSW,%0 ; Else fetch length of line BMI 13$ ; Again none if error MOV #GMCR+G.MCRB,%2 ; Address start of buffer ADD %2,%0 ; And end MOVB #15,(%0)+ ; End line with CR MOVB #12,(%0)+ ; and LF CLRB @%0 ; and null ; Skip past first thing on line, assumed to be task name. Look for non-alphanumeric. 11$: MOVB (%2)+,%0 ; Fetch character JSR PC,UPPER ; Convert LC to UC MOV %0,%1 ; Copy to %1 and JSR PC,ALPHAN ; see if alphanumeric BCS 11$ ; Get another if so DEC %2 ; Point back at terminator 12$: CMPB (%2)+,#40 ; Found terminator. Is it space? BEQ 12$ ; Yes, skip them CMPB -(%2),#15 ; Was it end of line? BNE 15$ ; No, start here 13$: MOV #TIBUF,%2 ; Yes, no real line. Point back at null 15$: MOV %2,TIPTR ; Store buffer pointer MOVB @TIPTR,CLICMD ; Set flag to indicate if we have a command BNE 17$ ; OK if there is one JSR PC,LINEFD ; Give a line-feed if not 17$: .IF DF F$$LPP ENAR$S ; Re-enable AST's DIR$ #SFPEA ; to set up FPP trap BCS 20$ ; Skip if no FPP or built /-FP LDFPS #40000 ; Set FPU status -- no interrupts 20$: DSAR$S ; Disable AST's again .ENDC ; F$$LPP FINIT$ ; Initialise FCS TTQIOW #IO.ATT ; Attach terminal so ctrl/O will work .IIF DF ABSLOW, MOV #$RMON,@#54 ; Set up word 54, used by some RT-11 macros COMB INITED ; Initialised now MOV (SP)+,%0 ; Restore %0 MOV %0,SAVER0 ; and SAVER0 (used by GTIM & DATE) .IF LT .-OUTSPC-40 ; Make sure we can now overwrite all up to .REPT 40-.-OUTSPC NOP .ENDR .ENDC ; here DIR$ #GTSK ; Get task parameters to OUTSPC MOV OUTSPC+G.TSTS,$USRLC ; To set up top of memory MOV OUTSPC+G.TSTN,TSKNAM ; and resume/unstop self DPB MOV OUTSPC+G.TSTN+2,TSKNAM+2 ; task name MOV OUTSPC+G.TSNL,NLUNS ; Save no of LUNS allocated .IIF GE RTVRSN-50, MOV OUTSPC+G.TSTS,$MEMSZ ; Save max memory size RTS PC ; and return GTSK: GTSK$ OUTSPC ; Get task size to OUTSPC TIGET: .WORD OUTSPC+20,0 ; Argument block for MTGET on TI: CSISPA=40.*2+OUTSPC ; Space for CSIGEN devspc, or CSISPC outspc CSIDEX=41.*2+OUTSPC ; defext for CSIGEN/CSISPC CSISTR=42.*2+OUTSPC ; cstrng for CSIGEN/CSISPC CSILIN=43.*2+OUTSPC ; linbuf for CSIGEN/CSISPC .IIF LT .-CSILIN+2, .BLKB CSILIN+2-. ; Make sure we leave enough space ; Save registers area .IRPC REG,<01234567> SAVER'REG: .WORD 0 .ENDR SAVEPS: .WORD 0 ; Save PS SAVESP=SAVER6 ; Alternative name for SP save word SAVEPC=SAVER7 ; Alternative name for PC save word .IF DF ABSLOW ; Save RSX-11M critical variables (H.DSW to H.VEXT and FISVEC) whilst in RT-11. SAVSIZ=/2+1 ; No of words to save SAVERS: .BLKW SAVSIZ+1 ; (+1 for FIS vector) ; Save RT-11 critical variables (UFLOAT to TTFILL), which occupy the ; same space in low memory, whilst in the simulator. ; Set here to initial values. SAVERT: .LIMIT ; USR load address, normally 0 ; .LIMIT wd 2 set to top of task = USERTO .BYTE 0 ; EMT error byte (returned to ERRBYT) .BYTE ^B11110000 ; User exit status (USERRB) .WORD $RMON ; Resident monitor bottom address .BYTE 0 ; Fill char .BYTE 0 ; No of fill chars .WORD 0 ; FIS exception trap vector TEMP: .BLKW 1 ; Temporary storage TEMP2: .BLKW 1 .IFF TEMP: .LIMIT ; Temporary storage TEMP2=TEMP+2 ; TEMP2 initialised by .LIMIT to top of task .ENDC NLUNS: .BLKW 1 ; No of LUNs .IIF DF A$$BRT,SCCAST: .WORD 0 ; Address of .SCCA flag word (0=none) TEMPB: .BYTE 0 ; Temporary byte INITED: .BYTE 0 ; Set after first EMT HERSER: .BYTE 0 ; Error action flag -- cleared by .HERR, set by .SERR SERVAL: .BYTE 0 ; Error no for ERRBYT if .SERR processing selected CLICMD: .BYTE 0 ; <>0 if we had a command line .EVEN TICKPS: .BLKW 1 ; Clock ticks per second, for TWAIT .IIF DF FB!XM,CMPLET: .WORD 0 ; Completion routine flag (see SPCPS) VECTBL:: .WORD ODDADR,MEMPRO,BPTRAP,IOTRAP,ILLINS,RTEMTH,TRPTRP,FISTRP ; Trap vector .IIF DF F$$LPP,USRFPT: .WORD 0 ; User floating-point trap handler, set by .SFPA ; Dispatch tables EMT340=.-700 ; EMT 340 to EMT 357 .WORD TTYIN ; 340 .WORD TTYOUT ; 341 .WORD DSTATUS ; 342 .WORD FETCH ; 343 .WORD CSIGEN ; 344 .WORD CSISPC ; 345 (and GTLIN) .WORD LOCK ; 346 .WORD UNLOCK ; 347 .WORD EXIT ; 350 .WORD PRINT ; 351 .WORD SRESET ; 352 .WORD QSET ; 353 .WORD SETTOP ; 354 .WORD RCTRLO ; 355 .WORD ILLEMT ; 356 .WORD HRESET ; 357 ; EMT 374 auxiliary codes EMT374: .WORD IOWAIT ; 0 (.WAIT) .WORD SPND ; 1 .WORD RESUME ; 2 .WORD PURGE ; 3 .WORD SERR ; 4 .WORD HERR ; 5 .WORD CLOSE ; 6 .WORD TLOCK ; 7 .WORD CHAIN ; 10 .WORD MWAIT ; 11 .WORD DATE ; 12 .IIF GE RTVRSN-50, .WORD ABTIO ; 13 MAX374=<.-EMT374>/2 EMT375: .WORD DELETE ; 0 .WORD LOOKUP ; 1 .WORD ENTER ; 2 .WORD TRPSET ; 3 .WORD RENAME ; 4 .WORD SAVESTATUS ; 5 .WORD REOPEN ; 6 .WORD ILLEMT ; 7 .WORD READX ; 10 .WORD WRITX ; 11 .WORD ILLEMT ; 12 .WORD CHCOPY ; 13 .WORD DEVICE ; 14 .WORD CDFN ; 15 .WORD ILLEMT ; 16 .WORD ILLEMT ; 17 .WORD GTJB ; 20 .WORD GTIM ; 21 .WORD MARKT ; 22 .WORD CMARKT ; 23 .WORD TWAIT ; 24 .WORD SDATX ; 25 .WORD RCVDX ; 26 .WORD CSTAT ; 27 .WORD SFPA ; 30 .WORD PROTECT ; 31 .WORD SPFUN ; 32 .WORD CNTXSW ; 33 .WORD GVAL ; 34 .WORD SCCA ; 35 .IF GE RTVRSN-40 .WORD CRAW ; 36 .WORD MTIO ; 37 .WORD SDTTM ; 40 .WORD SPCPS ; 41 .ENDC .IF GE RTVRSN-50 .WORD SFDAT ; 42 .WORD FPROT ; 43 .ENDC MAX375=<.-EMT375>/2 .NLIST BEX ; Error messages. These are basically the same as RT-11 uses. The first byte ; of the string is the .SERR error code which will be returned to ERRBYT if ; user error processing is selected. 0 means that the error is unconditionally ; fatal (not required for CSI routines). String is .ASCIZ if complete in ; itself. Terminate with <200> if return address should be appended. ILLEM: .ASCII <-11>"?MON-F-Inv EMT"<200> NOTFND: .ASCIZ "?CSI-F-File not found" ILLCMD: .ASCIZ "?CSI-F-Invalid command" ILLDEV: .ASCIZ "?CSI-F-Invalid device" DEVFUL: .ASCIZ "?CSI-F-Device full" TRAP4: .ASCII <0>"?MON-F-Trap to 4"<200> TRAP10: .ASCII <0>"?MON-F-Trap to 10"<200> FPTRP: .ASCII <0>"?MON-F-FP trap"<200> ILLSST: .ASCII <0>"?MON-F-Inv sst"<200> NTIMP: .ASCII <-23>"?SIM-F-Not implemented"<200> MMUFLT: .ASCII <0>"?MON-F-MMU fault" OCTADR: .ASCIZ " NNNNNN" ILLADD: .ASCII <-7>"?MON-F-Inv address"<200> ILCHAN: .ASCII <-10>"?MON-F-Invalid channel"<200> NODEV: .ASCII <-2>"?MON-F-No device"<200> UNLDRV: .ASCII <-15>"?MON-F-Unloaded driver"<200> .IF DF SJ STKOFL: .ASCII <0>"?MON-F-Stack overflow"<200> RDERR: .ASCIZ <0>"?MON-F-System read failure halt" WTERR: .ASCIZ <0>"?MON-F-System write error" .ENDC .IIF DF XM!FB,DIRFUL: .ASCII <-6>"?MON-F-Directory overflow"<200> .EVEN .PSECT $$RT11,I,RO $$RT11=. .IF DF DEBUG .MACRO ALIGN .=<.-$$RT11+77>&177700+$$RT11 .ENDM .IFF .MACRO ALIGN .ENDM .ENDC .PAGE ; *** Entry point for all EMT's ; ============================= RTEMTH: .IF DF FB!XM TST CMPLET ; Unless in a completion routine BNE 10$ ; when they aren't enabled anyway DSAR$S ; Disable ASTs to prevent recursive calls by them .ENDC .IF DF SJ CMP SP,#400 ; Is stack legal? BHIS 10$ ; OK if so JMP LOSTAK ; Fatal error if not .ENDC 10$: JSR PC,SAVE50 ; Save all registers TSTB INITED ; Is this the first EMT? BNE 20$ ; No, branch JSR PC,OUTSPC ; Yes, call one-time initialisation code .IF DF ABSLOW BR 30$ ; Bypass swap ; Exchange RT-11 and RSX low memory areas. 20$: MOV #SAVERS,%5 ; Address RSX save area MOV #SAVERT,%4 ; and RT-11 save area MOV #46,%3 ; Absolute address MOV #SAVSIZ,%2 ; No of words to swap 21$: MOV @%3,(%4)+ ; Save current RT-11 value MOV (%5)+,(%3)+ ; Replace by current RSX value SOB %2,21$ ; Repeat MOV @#FISVEC,@%4 ; Save FIS exception vector MOV @%5,@#FISVEC ; Replace with RSX value 30$: ENCP$S ; Checkpointing allowable in RSX state .IFF 20$: .ENDC MOV (SP)+,%1 ; Get EMT argument MOV SP,SAVESP ; Save SP in case of error BIC #1,2(SP) ; Clear carry -- assume success CMP %1,#375*2 ; Several argument case? BEQ SEVARG ; Yes, branch CMP %1,#374*2 ; One argument case? BEQ ONEARG ; Yes, branch CMP %1,#357*2 ; Range 340-357? BHI ILLEMT ; Higher is illegal CMP %1,#340*2 BLO ILLEMT ; So is lower JMP @EMT340(%1) ; Jump to routine in table ; Single Parameter Commands. ; The parameter is passed in %0, where: ; %0 hi is the instruction code, ; %0 lo is the channel number (usually). ; All called by EMT 374. ONEARG: MOV %0,%1 ; Copy argument CLRB %1 ; Put hi byte only in %1 BIC %1,%0 ; Lo byte only in %0 CMP %1,#MAX374*400 ; Make sure code not too big BHI ILLEMT ; Error if so ASH #-7,%1 ; OK, shift for table offset CCC ; Clear all condition codes JSR PC,@EMT374(%1) ; Call required routine BR RETVC ; Go check for success ; Multiple parameter commands. ; ; These commands have a parameter area, addressed by %0. The first word ; contains the instruction code and "channel number" as above. Call an ; appropriate routine with "channel number" in %0, and %5 addressing the next ; word of the parameter block. ; For multi-terminal functions, the "channel number" is, in fact, the ; function code. SEVARG: MOV %0,%5 ; Copy parameter block address MOVB (%5)+,%0 ; Get channel number MOVB (%5)+,%1 ; Get function code CMP %1,#MAX375 ; Make sure in range BHI ILLEMT ; Error if not ASL %1 ; OK, double for table offset (clears v & c) JSR PC,@EMT375(%1) ; Call required routine RETVC: BVS RETR1 ; Return with error code from %1 if V set BCS RETC ; Return with carry if set now BR RET ; Return anyway ; Return points: ; RETSPC Restores PS and PC from SAVEPS and SAVEPC (used by special fns). .IF DF ABSLOW ; RETR1 Sets carry, copying %1 to SAVEEB, for return to ERRBYT .IFF ; RETR1 Sets carry, copying %1 to ERRBYT. .IFTF ; RETC Sets carry. ; RET Restores all registers. ; RET15 Restores %1-%5 only (not %0). .IFT ; All exit points swap the RSX and RT-11 workspace in low memory. .ENDC ALIGN RETPSC: MOV SAVEPS,-(SP) ; Restore PS MOV SAVEPC,-(SP) ; and PC BR RET ; and registers RETR1: MOVB %1,ERRBYT ; Set error code RETC: INC 2(SP) ; Set carry bit in return PS RET: MOV SAVER0,%0 ; Restore %0 RET15: .IFDF ABSLOW ; Swap back RT-11 and RSX low memory areas. ; Disable checkpointing, because on return from checkpoint the RSX low core ; values are restored, destroying RT-11 values!! DSCP$S ; Can't checkpoint, as it destroys low core MOV #SAVERS,%5 ; Address RSX save area MOV #SAVERT,%4 ; and RT-11 save area MOV #46,%3 ; Absolute address MOV #SAVSIZ,%2 ; No of words to swap 10$: MOV @%3,(%5)+ ; Save current RSX value MOV (%4)+,(%3)+ ; Replace by current RT-11 value SOB %2,10$ ; Repeat MOV @%4,@#FISVEC ; Replace FIS trap vector .ENDC .IRPC REG,<12345> ; Restore %1-%5 MOV SAVER'REG,%'REG .ENDR .IF DF XM!FB TST CMPLET ; Unless in a completion routine, BNE 20$ .ENDC ENAR$S ; AST interrupts are now safe 20$: RTI ; Return from EMT .PAGE .SBTTL ERROR TRAPS ; Illegal EMT or function code ILLEMT: MOV #ILLEM,%0 ; Load message pointer BR SYSER ; Take system error action ; Monitor command not implemented in simulator NOTIMP: MOV #NTIMP,%0 ; Load message BR SYSER ; Treat as system error ; Illegal channel or terminal unit no ILLCHN: MOV #ILCHAN,%0 ; Load message pointer BR SYSER ; for system error action ; Trap 4 -- odd address ODDADR: CMP @SP,#$$RT11 ; See if it occurs within the simulator BLO 10$ ; If so, assume illegal address was specified CMP @SP,#ENDRT ; to system directive BHIS 10$ JMP ADRERR ; so trap 10$: TST USRTRP ; No, must be in user program. Trap specified? BNE CALUTP ; Yes, go call it (carry clear from TST) MOV #TRAP4,%0 ; No, set up error message BR FORTEN ; for system error action CALUTP: MOV USRTRP,-(SP) ; Push user trap address BIC @SP,USRTRP ; Clear it (DON'T DESTROY CARRY) RTS PC ;[JMP (SP)+] ; Call user trap for 4 or 10 ; Trap to 10 -- illegal instruction (and FIS simulator) ; Also handles MFPS -(SP) for $MFPS subroutine (but no other MFPS mode). ALIGN ILLINS: MOV %5,SAVER5 ; Save a work register MOV @SP,%5 ; Get return address CMP -(%5),#MFPS!46 ; -(%5) is failed instruction. Is it MFPS -(SP)? BNE 5$ ; No, try FIS MOV @SP,-(SP) ; Yes, make a copy of return address MOV 4(SP),2(SP) ; and PS MOV SAVER5,%5 ; Restore %5 RTI ; RTI restores PS, leaving a copy on stack 5$: .IF DF SIMFIS CMP @%5,#FADD ; If < FADD, BLO 10$ ; don't simulate CMP @%5,#FDIV!7 ; Highest code is FDIV PC BHI 10$ ; If in range, JMP FISSIM ; go simulate FIS instruction .ENDC 10$: MOV SAVER5,%5 ; Else restore %5 and treat as error TST USRTRP ; User trap specified? SEC ; Set carry in case BNE CALUTP ; user call needed MOV #TRAP10,%0 ; Set up error message FORTEN: .IF DF SJ CMP SP,#400 ; SP too low? BHIS SYSER ; No, say trap 4 or 10 ; Yes, fall through to stack error handler ; Stack overflow LOSTAK: MOV #STKOFL,%0 ; Load message .ENDC SYSER: BR SYSERR ; System error ; FIS exception ALIGN FISTRP: MFPS -(SP) ; Stack FIS error code MOV FISVEC,-(SP) ; and user routine address BNE 10$ ; Go to it if given CMP (SP)+,(SP)+ ; Purge stack if not (ready to return to caller) 10$: RTI ; Call user routine or return to caller .IF DF F$$LPP ; FP exception FPTRAP: CMP (SP)+,(SP)+ ; Remove FPU status TST USRFPT ; User FP trap supplied? BNE 10$ ; Yes, go use it MOV #FPTRP,%0 ; No, load message MOV #SYSERR,2(SP) ; Set up "return" address ASTX$S ; to go to SYSERR ; User FP trap supplied. Must do an ASTX$S to keep RSX happy, then set the ; stack to do an RT-11 call of the user routine. 10$: MOV 2(SP),SAVEPC ; Save PC MOV 4(SP),SAVEPS ; and PS MOV #20$,2(SP) ; Set dummy "return" address ASTX$S ; and return 20$: MOV SAVEPS,-(SP) ; here. Now set up the stack MOV SAVEPC,-(SP) ; for RT-11 entry STST -(SP) MOV USRFPT,-(SP) ; Stack user routine address CLR USRFPT ; RT11 requires .SFPA to be re-issued RTS PC ; Jump to user routine at address on stack .ENDC ; TRAP execution: TRPTRP: TST (SP)+ ; RT-11 doesn't put code on stack MOV TRAPVC+2,-(SP) ; Stack the new PS reqd MOV TRAPVC,-(SP) ; and the trap handler address BEQ NOTRAP ; Error if none DOTRAP: BIT #1,@SP ; Make sure address is even BNE NOTRAP ; Error if not RTI ; OK, set PS and jump to it if given ; BPT execution (only entered if ODT not built-in, or disabled): BPTRAP: MOV BPTVEC+2,-(SP) ; Stack new PS word (if any) MOV BPTVEC,-(SP) ; and user's trap handler address BEQ NOTRAP ; Fatal error if none BR DOTRAP ; Else go execute user's routine ; IO trap: IOTRAP: MOV IOTVEC+2,-(SP) ; Stack new PS word (if any) MOV IOTVEC,-(SP) ; and user's trap handler address BNE DOTRAP ; Go execute user's routine if any NOTRAP: CMP (SP)+,(SP)+ ; No user trap handler. Purge stack MOV #ILLSST,%0 ; Load message BR SYSERR ; and jump ; Memory protect violation MEMPRO: MOV 6(SP),%1 ; Get failing address JSR PC,CBOMG ; Insert 6 digits in string MOV #MMUFLT,%0 ; Set up message BR SYSERR ; and print system error ; Illegal (odd) address specified to system directive ALIGN ADRERR: MOV #ILLADD,%0 ; Set up message SYSERR: MOV SAVESP,SP ; Reset SP MOVB (%0)+,%1 ; Fetch .SERR error code from 1st byte of string BEQ 5$ ; No user action possible if code=0 TSTB HERSER ; User error action required? BNE 20$ ; Yes, clean up and return 5$: JSR PC,PRNTER ; Cancel control/O and print message TSTB %2 ; Do we need to print return address? BEQ 10$ ; No, just break MOV @SP,%1 ; Yes, load it JSR PC,CBOMG ; Convert to ASCII MOV #OCTADR,%0 ; Address string JSR PC,PRNT ; and print it 10$: CLR VECTBL+4 ; Disable user breakpoint trapping CMP NLUNS,#CHANS+2+TERMS+1+1 ; Did TKB allocate 2 more LUNS for ODT? BHI 15$ ; Yes if more than simulator needs, break to it .IF DF P$$OFF MOV PC,%0 ; No, inhibit chains MOVB #FATAL$,USERRB ; Set severe error status .ENDC JMP EXIT ; Exit to RSX 15$: BPT ; Break to ODT MOV #BPTRAP,VECTBL+4 ; Re-enable trap on continue ; Continue from ODT, or user called .SERR for his own error action -- return with ; code in %1 to be copied to ERRBYT. 20$: JMP RETR1 ; Just return with error code .IF DF SIMFIS ; Simulate FIS instructions FADD, FSUB, FMUL, FDIV, using the floating-point ; unit. Must find the register from the instruction code to fetch operands ; and then find the instruction itself. ALIGN F0=%0 F1=%1 FISSIM: JSR PC,SAVE40 ; Save registers (%5 done at ILLINS) MOV (SP)+,SAVEPC ; and pop PC (register could be SP) MOV (SP)+,%1 ; Save PS in %1 MOV SP,SAVESP ; Complete the set with SP STFPS SAVEPS ; Use SAVEPS for the FPP status SFPA$S #20$ ; Define special FP trap LDFPS #3000 ; and enable the right interrupts MOV @%5,%5 ; Get full instruction code MOV %5,%4 ; making a copy BIC #^C7,%5 ; Get register ASL %5 ; Shift once as pointer to saved registers ADD #SAVER0,%5 ; Point to appropriate register LDF @(%5)+,F0 ; Load first operand ADD #4,-(%5) ; Update saved register LDF @(%5)+,F1 ; Fetch second operand BIC #^C30,%4 ; Select the function bits only ASR %4 ; Shift once and add to PC ADD %4,PC ; to execute appropriate 2-word instruction ADDF F0,F1 ; 7500R is add BR 10$ SUBF F0,F1 ; 7501R is subtract BR 10$ MULF F0,F1 ; 7502R is multiply BR 10$ DIVF F0,F1 ; 7503R is divide 10$: STFPS %4 ; Return here only if successful. Put flags in %4 30$: STF F1,@-(%5) ; Store result BIC #^B1111,%1 ; Delete CCs from old PS BIS %4,%1 ; Put in new ones MOV SAVESP,SP ; Restore SP in case FXXX SP MOV %1,-(SP) ; Push PS MOV SAVEPC,-(SP) ; and return address BIT #^B10,%1 ; Error? BEQ 40$ ; No, exit normally MOV %1,-(SP) ; Yes, stack PS again MOV FISVEC,-(SP) ; and user trap address BNE 40$ ; OK if given CMP (SP)+,(SP)+ ; If not, purge the trap words MOV #FPTRP,%0 ; and load error message MOV #SYSERR,@SP ; for a system error 40$: DIR$ #SFPEA ; Re-enable standard trap LDFPS SAVEPS ; and old FPP status JMP RET ; Restore registers and exit to caller or trap 20$: TST (SP)+ ; Trap here on error. Don't need FEA MOV (SP)+,%4 ; Get FEC ASR %4 ; as a byte pointer MOVB ERRCC-2(%4),%4 ; Fetch return code CLRF F1 ; Return 0.0 MOV #30$,2(SP) ; Set address of common return code ASTX$S ; for return from AST ; FIS error condition codes, equivalent to FPP codes 4,6,8,10: ERRCC: .BYTE ^B1011,^B0000,^B0010,^B1010 .ENDC ; FIS simulation .PAGE .SBTTL SINGLE PARAMETER COMMANDS ALIGN ; IOWAIT is also called as a subroutine by READX and WRITX. IOWAIT: MOV %0,WAIFLG ; Complete stop/wait DPB in case needed INC WAIFLG ; Flag no = RT unit no + 1 JSR PC,GETFDB ; Point to FDB & see if file open (%1=0 if not) BEQ 20$ ; Exit V set if file not open TSTB L.BKST(%0) ; I/O active? BNE 5$ ; No, don't wait DIR$ #WEVENT ; Yes, stop/wait for I/O to complete TSTB L.BKST(%0) ; Make very sure 5$: BPL 30$ ; that previous I/O worked 10$: INC %1 ; Error code 1 if not 20$: SEV ; Set V flag 30$: RTS PC ; and exit .IF DF SJ SPND=ILLEMT RESUME=ILLEMT .IFF ; Suspend/resume control. Note that suspend must be done AFTER restoring ; AST recognition, otherwise the task will hang indefinately! Do this by ; calling RET (with a copy of the PS on the stack since it exits by RTI) to ; restore registers and AST handling, and THEN issue the suspend directive, ; and another RTI to get back to the caller on continue. ALIGN SPND: .IF NDF S$$TOP MOV #5,ALTP+A.LTPR ; Reduce priority to 5 DIR$ #ALTP .IFTF MOV 4(SP),@SP ; Push user's PS over (unused) return address JSR PC,RET ; Do normal exit code, returning here by RTI .IFF STOP$S ; Stop for UNS from MCR, or .RSUM from AST .IFT SPND$S ; Wait for MCR RES, or .RSUM from AST .IFTF RTI ; Return to caller RESUME: .IFT CLR ALTP+A.LTPR ; Raise to normal value on resume DIR$ #ALTP .ENDC DIR$ #RESTRT ; Resume/unstop self BR NOOP ; Return success .ENDC ALIGN PURGE: JSR PC,GETFDB ; Point %0 at FDB BEQ NOOP ; Exit OK if file not open BITB #FA.CRE,F.FACC(%0) ; File just created? BEQ CLOSEF ; No, just close if it existed previously JSR PC,.DLFNB ; Yes, delete if a new one BR NOOP ; Always succeed SERR: MOVB #-1,HERSER ; User error action BR NOOP ; Always succeeds HERR: CLRB HERSER ; No user error action RTS PC ; Always succeeds (CLRB clears flags) CLOSE: JSR PC,GETFDB ; Point %0 at FDB .IF NDF SJ ; Unless Single-Job monitor TSTB CONFIG ; Test CONFIG bit 7 to see if a foreground job, BPL CLOSEF ; assumed to be a spooler. Just close if not BITB #FA.CRE,F.FACC(%0) ; "Spooler running", is this an O/P file? BEQ CLOSEF ; No, just close CMP F.FNB+N.FTYP(%0),#^RLST ; Yes, is extension .LST? BNE CLOSEF ; No, just close JSR PC,.PRINT ; Yes, spool .ENDC CLOSEF: CLOSE$ ; Close if open NOOP: CCC ; No errors returned, as for no-op'd requests RTSPC: RTS PC ; Exit TLOCK=NOOP ; Dummy .IF NDF P$$OFF CHAIN=NOTIMP .IFF ; Chain to program whose filename is at address 500, passing command line ; at 512. Construct the command line RUN file/CMD=" ... ", and spawn it ; to MCR, using the EXIT processor. This isn't the correct simulation of how ; RT-11 works, but will do for the present. Maybe one should assume that the ; program being chained to is also a simulated one, and pass it some flags. ALIGN CHAIN: MOV #^RMCR,SPWN+S.PWTN ; Command will go to MCR... MOV #OUTSPC,%0 ; from workspace MOV %0,SPWN+S.PWCA MOV #"RU,(%0)+ ; Start with "RU MOV #"N ,(%0)+ ; N " MOV #500,%3 ; and chain information area JSR PC,C5TA ; Fetch Radix-50 device name BEQ 10$ ; Branch if none CMP -2(%3),#<^R$ > ; or if it was $ (special case) BEQ 10$ MOVB #':,(%0)+ ; Else put in a trailing ':' 10$: JSR PC,C5TA ; Do first word of filename JSR PC,C5TA ; and second MOVB #'.,(%0)+ ; Put in a '.' for type JSR PC,C5TA BNE 20$ ; If there is one DEC %0 ; Remove it if not (default .TSK) 20$: CMP %0,#OUTSPC+4 ; No file name (just the "RUN ")? BLOS 50$ ; Exit if so TSTB @%3 ; Just RUN filename if no command line BEQ 45$ .IRPC $$$CHR, ; Else put in /CMD switch MOVB #''$$$CHR,(%0)+ .ENDR 30$: MOVB (%3)+,(%0)+ ; Copy bytes BNE 30$ ; Until null 40$: MOVB #'",-1(%0) ; Replace null with trailing quote 45$: SUB #OUTSPC,%0 ; Compute length of command line MOV %0,@#510 ; Put length where EXIT expects it BIS #CHNIF$,JSW ; Set chain flag in JSW CLR %0 ; and clear %0 to enable chain 50$: JMP EXIT ; Exit processor will do rest .ENDC MWAIT=NOOP ; Dummy ALIGN DATE: DIR$ #GTIME ; Get time -- RSX way MOV #OUTSPC+G.TIYR,%1 ; Address year SUB #72.,@%1 ; past 1972 MOV (%1)+,%2 ; Fetch it MOV (%1)+,%0 ; Get month ASH #5,%0 ; Shift to make space BIS (%1)+,%0 ; for day ASH #5,%0 ; Shift again to make space BIS %2,%0 ; for year MOV %0,$DATE ; Copy into monitor MOV %0,SAVER0 ; and to save area for return CCC ; No errors RTS PC .IF GE RTVRSN-50 ALIGN ABTIO: JSR PC,GETFDB ; Set %0-> required FDB BEQ 10$ ; Just return if file not open QIOW$S #IO.KIL,F.LUN(%0),F.BKEF(%0) ; Kill I/O on this LUN CCC ; No error report 10$: RTS PC ; Return .ENDC .PAGE .SBTTL MULTIPLE ARGUMENT COMMANDS ALIGN DELETE: JSR PC,GETFDB ; Address FDB (sets %1=0 if not) BNE 10$ ; Error 0 if channel open JSR PC,ISETFN ; Set up file name as addressed by %5 BCS 7$ ; Error 1 if no such device OFNB$U ; Open file to complete filename block BCS 5$ ; Trap open error JSR PC,.DLFNB ; Try to delete file CLV BCC 20$ ; OK if it worked 5$: INC %1 ; Set error code 1 CMPB F.ERR(%0),#IE.NSF ; File not found? BEQ 10$ ; Yes, exit with code 1 .IF GE RTVRSN-50 INC %1 ; No, set code 2 CMPB F.ERR(%0),#IE.PRI ; Privilege violation? BNE 10$ ; No, error 2 .ENDC 7$: INC %1 ; Advance error no again 10$: SEV ; Set V to flag error to be stored 20$: RTS PC ; Done ; Open existing file for read and/or write. On a disk, just use open-for-update. ; On a magtape, try open for read first, or open for write if file does not exist. ALIGN LOOKUP: JSR PC,GETFDB ; Get FDB pointer (sets %1=0 if not) BNE 100$ ; Error if open already JSR PC,ISETFN ; Set up filename block BCS 50$ ; Trap error MOVB #1,L.BKST(%0) ; Set no I/O pending flag in status block for .WAIT ; Open file for update if random access device; for read if read-only; or write ; if write-only. For others (magtapes) try open for read, and if file not found, ; open for write instead. .IF EQ RA-BIT15 TST %3 ; Random-access device? (test bit 15) BMI 20$ ; Yes, open new file, or old for update .IFF BIT #RA,%3 ; Random-access device? BNE 20$ ; Yes, open new file, or old for update .ENDC BIT #RO,%3 ; Read-only? BEQ 5$ ; No, try write-only OFNB$R ; Read only. Try open BR 22$ ; Go see if it worked 5$: BIT #WO,%3 ; Write-only? BNE 10$ ; Yes, go open file ; Not read-only or write only. Must be unidirectional. See if file already ; exists. OFNB$R ; Try open for read BCC 40$ ; Return if OK 10$: FDAT$R ,,,,#0 ; Else try open for write, no blocks allocated OFNB$W BR 22$ ; Go see if it worked, abort if not 20$: OFNB$U ; Open for read and/or write 22$: BCC 40$ ; Branch if OK 25$: CMPB F.ERR(%0),#IE.ALN ; Non-sharable device already in use? BNE 50$ ; No, return error 1 CMPB (%1)+,(%1)+ ; Yes, make it 2 BR 100$ 40$: MOV F.HIBK+2(%0),SAVER0 ; OK, get no of blocks in file BR 200$ ; Return with it 50$: MOV #1,%1 ; Else set error no 1 100$: SEV ; Say error to be stored 200$: RTS PC ; Return ALIGN ENTER: JSR PC,GETFDB ; Get FDB pointer (sets %1=0 if not) BNE 10$ ; Error if open already MOV 2(%5),%4 ; Fetch file size JSR PC,ISETFN ; Set up filename block BCS 5$ ; Trap error NEG %4 ; Don't need file contiguous, so make size -ve BMI 3$ ; Store size if it is -ve CLR %4 ; Set special case (was -1) to 0 3$: FDAT$R ,,,,%4 OFNB$W ; Open for write BCS 4$ ; Trap error CLR SAVER0 ; Always return 0 for allocated space BR 20$ ; Done 4$: CMPB (%1)+,(%1)+ ; Set error 2 in case CMPB F.ERR(%0),#IE.ALN ; Open >1 files on non-sharable device (MT: etc)? BEQ 10$ .IF DF XM!FB CMPB F.ERR(%0),#IE.IFU ; Directory full? BNE 5$ ; No, some other error MOV #DIRFUL,%0 ; Yes, address error message JMP SYSERR ; and abort request .ENDC 5$: INC %1 ; Else set error no 1 10$: SEV ; Say error to be stored 20$: RTS PC ; Return ALIGN TRPSET: MOV (%5)+,USRTRP ; Remember trap location RTS PC ; and return RENAME: JSR PC,GETFDB ; Get FDB (sets %1=0) BNE 10$ ; Error 0 if channel in use JSR PC,ISETFN ; Set file name of old file BCS 7$ ; Treat illegal device as file not found MOVB #1,L.BKST(%0) ; Set no I/O pending flag in status block for .WAIT OFNB$U ; Open file, to fill in filename block BCS 5$ ; Check for error CMPB (%1)+,(%1)+ ; Also check for BIT #NR,%3 ; file-structured device? BEQ 10$ ; Error (2) if not MOV %0,%2 ; Save FDB pointer MOV #SPRFDB,%0 ; Address spare FDB JSR PC,SETFNB ; Set up new filename BCS 7$ ; Trap device error MOV %0,%1 ; Copy new FDB address MOV %2,%0 ; Re-load old one ; Copy old file-id to new, to save a .PARSE MOV #F.FNB,%3 ; Load filename block offset ADD %3,%2 ; Set %2 -> old filename block ADD %1,%3 ; %3 -> new .REPT 3 ; Copy three words MOV (%2)+,(%3)+ .ENDR JSR PC,.RENAM ; Do the rename CLV BCC 20$ ; Exit if OK 5$: MOV #1,%1 ; Set error code 1 CMPB F.ERR(%0),#IE.NSF ; Old file non-existent? BEQ 10$ ; Yes that's the error 7$: INC %1 ; No, say illegal operation 10$: SEV ; Set flag for "error code in %1" 20$: RTS PC ; Return ; SAVESTATUS saves sufficient information to re-open a file. Note that ; information block is not the same as RT-11's:- ; word 0 File-ID word 1 ; word 1 File-ID word 2 ; word 2 Device name ; word 3 Unit no ; word 4 Open mode -- read-only, or read/write ALIGN .ENABL LSB SAVESTATUS: JSR PC,GETFDB ; See if file open (sets %1=0) BEQ 10$ ; Error if not BITB #FD.DIR!FD.SDI,F.RCTL(%0) ; in case not a directory device BEQ 20$ ; Error 1 if not MOV @%5,%5 ; OK, get save buffer pointer MOV F.FNB+N.FID(%0),(%5)+ ; Save file-ID MOV F.FNB+N.FID+2(%0),(%5)+ ; 2 words MOV F.FNB+N.DVNM(%0),(%5)+ ; Device name MOV F.FNB+N.UNIT(%0),(%5)+ ; unit no MOVB F.FACC(%0),@%5 ; and open mode (RO or RW) 5$: TST (PC)+ ; Clear error flags, skipping SEV 10$: SEV ; Set error flag RTS PC ; and return ; Reopen, by saved file-ID. This is just a lookup, but with the high block ; no set from the 5th word of the filename block. ALIGN REOPEN: JSR PC,GETFDB ; Get FDB, making sure channel is free BNE 10$ ; Error if not MOV @%5,%5 ; OK, address status block MOV (%5)+,F.FNB+N.FID(%0) ; Restore file-ID MOV (%5)+,F.FNB+N.FID+2(%0) ; Both words MOV (%5)+,F.FNB+N.DVNM(%0) ; Restore device name MOV (%5)+,F.FNB+N.UNIT(%0) ; and unit BICB #FA.CRE,@%5 ; Don't create a new file FDOP$R ,,,,@%5 ; But otherwise open as before JSR PC,.OPFID ; Opening by file-ID BCC 5$ ; Exit with success if OK 20$: INC %1 ; Else error 1 BR 10$ .DSABL LSB ; Read/write. Common code, switching on IO.RVB or IO.WVB in %4. ALIGN READX: MOV #IO.RVB,%4 ; Use read QIOs BR WRITX1 ; Otherwise, code is common with write WRITX: MOV #IO.WVB,%4 ; Use write QIOs WRITX1: JSR PC,IOWAIT ; Check file open and wait for pending I/O BVC 10$ ; Continue if OK CMPB L.BKST(%0),#IE.EOF ; Was the last error end-of-file? BEQ 10$ ; Yes, ignore it -- might be rewinding CLR %3 ; Failed, no bytes transferred TST %1 ; Was it file-not-open? BNE 40$ ; No, check for general error CMPB (%1)+,(%1)+ ; Yes, file-not-open error is 2 for .READ/.WRIT BR 40$ ; Take error exit ; Before writing to a file, see if it must be extended first. ; Before reading from it, check that not too many bytes are asked for. 10$: DEC %1 ; -ve "error" code means success here MOV 4(%5),%3 ; Get word count lo BEQ 100$ ; If 0, just see if we need a completion routine ASL %3 ; Convert to bytes BITB #FD.REC,F.RCTL(%0) ; Is this a block-orientated device? BNE 20$ ; No checks needed if record-orientated CMP %4,#IO.WVB ; Write? BNE 17$ ; Branch if read ; No of blocks to be written: ; %1 = start block reqd - current max block - 1 + no of bytes/block size ; (It is not necessary to subtract 1, since the RT11 no is 1 less than RSX anyway.) MOV @%5,%1 ; Get block no reqd MOV %3,-(SP) ; Save byte count CLR %2 ; Clear byte count hi DIV F.VBSZ(%0),%2 ; /block size ADD %2,%1 ; Add no of full blocks to %1 TST %3 ; Any remainder? BEQ 12$ ; No, branch INC %1 ; Yes, need one more block 12$: SUB F.HIBK+2(%0),%1 ; Subtract current no of blocks allocated BLE 15$ ; If <=0, no extension needed CLR %2 ; Flag non-contiguous extend JSR PC,.EXTND ; Extend file BCC 14$ ; Continue if OK MOV (SP)+,%3 ; Else error. Restore byte count CLR %1 ; Assume disk full CMPB F.ERR(%0),#IE.DFU ; But was it? BR 34$ ; Return 0 or 1 accordingly 14$: MOV F.HIBK+2(%0),F.EFBK+2(%0) ; Set new last block pointer MOV %3,F.FFBY(%0) ; and last byte BNE 15$ ; If "last byte"=0 MOV F.VBSZ(%0),F.FFBY(%0) ; Say block is full 15$: MOV (SP)+,%3 ; Restore byte count BR 20$ ; Join common code ; A read QIO will only return EOF at the end of the file, not the end of the ; data. Compute how many meaningful bytes are actually available to read ; and reduce the word count if it is above this. ; No of bytes left = end block - read start block + no of bytes in last block ; Both RSX-11M QIO and RT-11 convention require this count to be even. Add one ; if it isn't (file EOF pointer can be odd). 17$: BITB #FD.SQD!FD.REC,F.RCTL(%0) ; Record-orientated or sequential device? BNE 20$ ; EOF pointers invalid for these, keep byte count MOV F.EFBK+2(%0),%2 ; Get end block (lo word only) SUB @%5,%2 ; - read start block DEC %2 ; -1, since RT11 starts at 0 BMI 99$ ; Go flag e-o-f if start is outside MOV %3,-(SP) ; OK, save byte count again MUL F.VBSZ(%0),%2 ; OK, convert blocks to bytes MOV %3,%1 ; Copy result lo to %1 MOV (SP)+,%3 ; Restore byte count ADD F.FFBY(%0),%1 ; Add last byte pointer ADC %2 ; in DP BNE 20$ ; >177777 means we have plenty left CMP %3,%1 ; c.f. no to read with no available BLOS 20$ ; OK if less MOV %1,%3 ; Set to no available if more ROR %1 ; Making sure count is even ADC %3 ; by adding 1 if it isn't BEQ 99$ ; Flag e-o-f if nothing left ; Construct a QIO DPB on the stack by hand (aren't enough registers to use ; QIO$ macro call!) 20$: CLR -(SP) ; No 6th parameter word MOV (%5)+,-(SP) ; Stack block no lo INC @SP ; +1 for RSX CLR -(SP) ; Block no hi=0 CLR -(SP) ; Carriage-control = 0 for device MOV %3,-(SP) ; Stack byte count MOV (%5)+,-(SP) ; Stack buffer address TST (%5)+ ; Bypass word count CLR -(SP) ; Assume no AST routine CMP @%5,#500 ; If any, must be at address >500 BLOS 22$ ; Branch if not MOV @%5,L.COMP(%0) ; Save RT11 completion routine address MOV #IOAST,@SP ; and put RSX linker address on stack instead 22$: MOV F.BKST(%0),-(SP) ; Push I/O status block address, MOVB F.BKEF(%0),%2 ; Get event flag MOV %2,-(SP) ; onto stack as a word MOV %2,-(SP) ; = LUN no MOV %4,-(SP) ; IO.WVB or IO.RVB MOV #6001,-(SP) ; QIO without wait 24$: DIR$ ; Execute QIO on stack BCS 30$ ; Trap error TST @%5 ; Wait for I/O completion? BNE 26$ ; No, just test status MOV %2,WAIFLG ; Yes, DIR$ #WEVENT ; stop/wait for it MOV L.BKST+2(%0),%3 ; Get no of bytes actually transferred 26$: MOV #-1,%1 ; Load -ve code to %1 in case TSTB L.BKST(%0) ; Success? BPL 50$ ; Yes, exit 30$: CLR %1 ; No, assume error was e-o-f CMPB L.BKST(%0),#IE.EOF ; But was it? 34$: BEQ 40$ ; Yes, branch 35$: INC %1 ; No, set error code 1 = hard error 40$: .IF DF SJ TSTB JSW ; Should we halt (test bit 7) BPL 55$ ; No, continue if bit clear MOV #RDERR,%0 ; Yes, suppose it's a read error CMP %4,#IO.RLB ; But if not, BEQ 42$ MOV #WTERR,%0 ; it must be write 42$: JMP SYSERR ; Print message and halt .ENDC 50$: ASR %3 ; Change bytes to words MOV %3,SAVER0 ; Count to be returned in %0 TST %1 ; Any errors? BMI 60$ ; No, leave V clear from TST 55$: SEV ; Yes, set V to flag code in %1 60$: RTS PC ; Return ; Exit without doing any I/O if:- ; (a) byte count is 0 (when %3=0) ; or (b) There are no bytes to read (bit 13 of %3 is set) ; In either case, we must return to caller with %0=0, ERRBYT=0 if (b), and ; doing completion routine if any (addressed by 6(%5)). 99$: MOV #BIT13,%3 ; Flag e-o-f if nothing left 100$: CLR SAVER0 ; Always return 0 bytes read CMP 6(%5),#500 ; Any completion routine? BHIS 110$ ; Yes, branch CLR %1 ; Will need error code 0 TST %3 ; if EOF error? BEQ 60$ ; No, return success BR 55$ ; Yes, return error ; Call completion routine, just line IOAST would (see below). Need to set ; error code (now in %3) in %0, channel no (=F.LUN(%0)-1) in %1, restore ; user's registers %2-%5, call completion routine at 6(%5), and return, restoring ; user's %1 and %0. 110$: MOVB F.LUN(%0),%1 ; Get channel no = LUN no DEC %1 ; -1 MOV %3,%0 ; Copy channel status from %3 BEQ 120$ ; 0 = success CLRB ERRBYT ; 1 = read past EOF 120$: MOV SAVER0,@SP ; Push user's %0 over our (unused) return addr MOV SAVER1,-(SP) ; Push user's %1, both for final return MOV 6(%5),-(SP) ; Push completion routine address MOV SP,CMPLET ; Save SP for SPCPS (N.B. 6(CMPLET) must be ret addr) MOV SAVER5,%5 ; Restore user's %5 MOV SAVER4,%4 ; down MOV SAVER3,%3 ; to MOV SAVER2,%2 ; %2 .IIF DF SJ, ENAR$S ; Enable other AST's JSR PC,@(SP)+ ; Call completion routine .IIF DF FB!XM, ENAR$S ; Re-enable AST's MOV (SP)+,%1 ; Restore %1 MOV (SP)+,%0 ; and %0 CLR CMPLET ; No longer in completion routine RTI ; Return to caller .IF DF SJ CHCOPY=ILLEMT .IFF ; Only one job is "running" so must be error 0, unless the channel is open ; in which case we have error 1. ALIGN CHCOPY: JSR PC,GETFDB ; Is channel open? BEQ 10$ ; No, exit with error 0 (from GETFDB) INC %1 ; Yes, error 1 10$: SEV ; Error code in %1 RTS PC ; Return (DEVICE requires no action) .ENDC DEVICE=NOOP ; .DEVICE requires no action CDFN=NOTIMP ; Inter-job communications functions always return 0, even in FB/XM simulation, ; because only one job is allowed to be active. .IIF DF SJ,NOJOB=ILLEMT .IF DF FB!XM NOJOB: CLR %1 ; Always return error 0 SEV ; = "no other job" RTS PC .ENDC GTJB=NOJOB ; No other job ALIGN GTIM: DIR$ #GTIME ; Get time MOV #OUTSPC+G.TIHR,%4 ; Address hours MOV #60.,%0 ; Load multiplier MOV (%4)+,%3 ; Fetch hours MUL %0,%3 ; in minutes ADD (%4)+,%3 ; Add minutes CLR %2 ; Clear high order part JSR PC,$DMUL ; Do a d.p. multiply ADD (%4)+,%1 ; Add seconds ADC %0 ; including carry MOV %0,%2 ; Copy seconds MOV %1,%3 TST (%4)+ ; Bypass clock tic of second MOV @%4,%0 ; To load seconds to ticks multiplier JSR PC,$DMUL ; Convert seconds to tics ADD -(%4),%1 ; Then add in ticks of second ADC %0 MOV @%5,%5 ; Get return block address MOV %0,(%5)+ ; Return high order word MOV %1,@%5 ; Then low .IF DF SJ MOV %0,$TIME ; Also update monitor save area MOV %1,$TIME+2 ; in same order .ENDC CCC ; No errors RTS PC ; Done MARKT=NOTIMP CMARKT=NOTIMP ; Wait for given no of ticks (double-precision). ; Divide it into hours/mins/secs/ticks, and wait each period separately. ALIGN TWAIT: MOV TICKPS,OUTSPC+G.TICP ; Set up clock ticks/sec MOV @%5,%5 ; Get pointer to dp ticks area MOV (%5)+,%1 ; Get hi word MOV (%5)+,%2 ; and lo JSR PC,DIVTIM ; Split time into h/m/s/t MOV #SPRFLG,WAIFLG ; Load stop/wait DPB flag .IF NDF S$$TOP MOV #5,ALTP+A.LTPR ; Reduce priority to 5 while waiting DIR$ #ALTP .ENDC MOV #OUTSPC+G.TIHR,%0 ; Address hours MOV #4,MRKT+M.KTUN ; for which unit code is 4 10$: MOV (%0)+,MRKT+M.KTMG ; Store magnitude BEQ 20$ ; Do nothing if 0 DIR$ #MRKT ; Mark time DIR$ #WEVENT ; Stop/wait for event 20$: DEC MRKT+M.KTUN ; Decrement unit code BNE 10$ ; Repeat until all done .IF NDF S$$TOP CLR ALTP+A.LTPR ; Restore normal run priority DIR$ #ALTP .ENDC CCC ; No error report RTS PC ; Return SDATX=NOJOB ; No other job RCVDX=NOJOB .ENABL LSB ALIGN CSTAT: JSR PC,GETFDB ; Address FDB BEQ 60$ ; Error if channel not open MOV @%5,%5 ; Get return block address CLR @%5 ; Pre-clear CSW .IF GE RTVRSN-40 TSTB L.BKST(%0) ; Pending I/O on channel? BNE 10$ ; No, branch BIS #BIT15,@%5 ; Yes, set ACTIV$ flag 10$: BITB #FA.CRE,F.FACC(%0) ; File being created? BEQ 12$ ; No, an old one BIS #BIT7,@%5 ; Yes, set DWRIT$ bit .ENDC 12$: TSTB F.ERR(%0) ; Are there any errors? BPL 15$ ; No, continue CMPB F.ERR(%0),#IE.EOF ; End-of-file? BNE 13$ ; No, hard error BIS #BIT13,@%5 ; Set bit 13 if e-o-f BR 15$ ; and continue 13$: INC @%5 ; Set bit 0 for hard error 15$: TST (%5)+ ; Address next word CLR (%5)+ ; Don't know block number on disk MOV F.HIBK+2(%0),(%5)+ ; Copy file length allocated MOV F.EFBK+2(%0),(%5)+ ; and highest block used MOV F.FNB+N.UNIT(%0),(%5)+ ; Store unit no JSR PC,R50NAM ; Save device name in Radix-50 30$: CCC ; Flag success 40$: RTS PC ; and return .IF NDF F$$LPP SFPA=NOOP .IFF ALIGN SFPA: MOV (%5)+,USRFPT ; (Un)define user FP trap RTS PC ; Return .ENDC ; .PROTECT and .UNPROTECT, just check validity of address. PROTECT:CMP @%5,#474 ; Check that address <=474 BHI 50$ ; Error if greater BIT #^B11,@%5 ; or not a multiple of 4 BEQ 30$ ; OK otherwise 50$: MOV #1,%1 ; Error 1 60$: SEV ; Flag it RTS PC ; and return .DSABL LSB ; Special device functions. Note that only a few are implemented, some ; cannot be done at all under RSX-11M, and at present, most give error 360, ; privilege violation, because you can't perform these operations on an open ; file (which is the only way the simulator allows you to access magtape!). ALIGN SPFUN: JSR PC,GETFDB ; See if device is open BNE 10$ ; Yes, OK CMPB (%1)+,(%1)+ ; No, set error 2 JMP 100$ ; Exit with error 10$: MOV F.FNB+N.DVNM(%0),%4 ; File open, get device name MOVB 7(%5),%3 ; Get function code CMPB %3,#367 ; Lowest is 367 BEQ 20$ ; 367 is MS: stream mode, not implemented BLO 90$ ; Return (w/o error) if illegal function CMP %4,#"CT ; Is this a cassette? BNE 15$ ; No, try magtape CMPB %3,#373 ; Yes, is function 373 (rewind?) BNE 20$ ; No others are implemented BR 30$ ; Treat like magtape 15$: .IRP $$$DEV, ; Magtape? CMP %4,#"$$$DEV BEQ 30$ ; Branch if implemented .ENDR .IRP $$$DEV, ; Disks? CMP %4,#"$$$DEV BEQ 22$ ; Branch if implemented .ENDR 20$: JMP NOTIMP ; Error action if not implemented ; Disk operations (DL,DM,DX,DY) 22$: CMPB %3,#373 ; Compare function with 373 (lowest) BLO 90$ ; Lower is invalid, ignore BNE 25$ ; Branch for read/write operations JSR PC,DEVSIZ ; 373 is fetch device size. MOV @%1,@2(%5) ; Word 4 of buffer is (lo word of) device size BR 90$ ; Return with it ; Disk read/write function 25$: ASL %3 ; Double function code MOV DKFUNC-<177774*2>(%3),%1 ; To look up RSX equivalent BR 35$ ; Go execute it, like magtape ; Magtape 30$: ASL %3 ; Double function code MOV MTFUNC-<177770*2>(%3),%1 ; Look up required function 35$: BEQ 20$ ; Can't implement 374 (write with extended gap) MOV (%5)+,-(SP) ; Save reply block pointer MOV (%5)+,%2 ; Fetch buff MOV (%5)+,%3 ; and wcnt INC %5 ; Point to function byte CMPB @%5,#375 ; Is this a space forward function? BEQ 40$ ; Yes, branch CMPB @%5,#376 ; No, space back? BNE 50$ ; No, %2/%3 are right NEG %3 ; Yes, change sign of block count if back 40$: MOV %3,%2 ; Block count is first CLR %3 ; and only argument for space function 50$: ASL %3 ; For other functions, change words to bytes INC %5 ; Point to completion routine entry MOV @%5,L.COMP(%0) ; Copy its address CMP @%5,#500 ; If less than 500 BHI 60$ CLR %5 ; We don't have one BR 70$ 60$: MOV #IOAST,%5 ; Otherwise we do, load simulator link routine addr 70$: QIO$S %1,F.LUN(%0),F.BKEF(%0),,F.BKST(%0),%5,<%2,%3> ; Perform function MOV (SP)+,%5 ; Fetch auxiliary error block pointer BIC @%5,@%5 ; Clear first word (but not carry) MOV #1,%1 ; Set main error 1 BCS 100$ ; If QIO rejected TST L.COMP(%0) ; Wait for completion? BNE 90$ ; No, just exit MOV F.BKEF(%0),WAIFLG ; Yes, load wait flag DIR$ #WEVENT ; Wait for operation TSTB L.BKST(%0) ; Test I/O status code BGT 90$ ; Success if >0 ; Look up error in table and return appropriate values to ERRBYT and dblk. MOV #SPERR,%4 ; Address lookup table 80$: MOVB (%4)+,%1 ; Load ERRBYT value MOVB (%4)+,@%5 ; and dblk value CMPB L.BKST(%0),@%4 ; in case this is our error BEQ 85$ ; Found if it is TSTB (%4)+ ; Or if end of table (null byte) BNE 80$ 85$: TST (%5)+ ; Point to dblk word 2 MOV L.BKST+2(%0),@%5 ; Put 2nd word of status there TST %1 ; If %1=0, BNE 87$ ; this is no of blocks spaced SUB %2,@%5 ; RT-11 returns no unspaced BR 89$ ; Go store it 87$: SUB %3,@%5 ; Otherwise it is no of bytes transferred, get no not ASR @%5 ; Change to words 89$: NEG @%5 ; get sign right BR 100$ ; Exit with error information 90$: TST (PC)+ ; No errors now 100$: SEV ; Come here if there are any RTS PC ; Return anyway ; RSX equivalents of RT-11 magtape function codes: ; 370 371 372 373 374 375 376 377 MTFUNC: IO.RLB, IO.WLB, IO.RWU, IO.RWD, 0, IO.SPB, IO.SPB, IO.EOF ; ; Disk operations ditto ; 374 375 376 377 DKFUNC: 0, IO.WDD, IO.RPB, IO.WPB ; RSX error codes and RT-11 equivalents. Note that errors are reported ; both in ERRBYT (1 or 0) and in the first word of the blk argument. ; ERRBYT dblk error SPERR: .BYTE 1, 3, IE.BYT ; Invalid memory (byte-aligned buffer) .BYTE 1, 5, IE.DAO ; Data overrun .BYTE 1, 1, IE.DNR ; Device not ready .BYTE 0, 1, IE.EOF ; EOF found .BYTE 0, 3, IE.EOT ; EOT found .BYTE 0, 2, IE.EOV ; EOV found .BYTE 1, 1, IE.FHE ; Hardware error .BYTE 1, 1, IE.OFL ; Off-line .BYTE 1, 3, IE.SPC ; Invalid memory .BYTE 1, 1, IE.VER ; Hardware error .BYTE 1, 4, IE.WLK ; Write-locked .BYTE 1, 0, 0 ; End of list -- all else "unknown" .EVEN .IIF DF SJ,CNTXSW=ILLEMT .IIF DF FB!XM,CNTXSW=NOOP .IIF LT RTVRSN-30,GVAL=ILLEMT .IF GE RTVRSN-40 ALIGN .IF LT RTVRSN-50 GVAL: MOV @%5,%5 ; Get offset MOV MONITR(%5),SAVER0 ; into monitor RTS PC ; returning result in %0 .IFF ; V5 ff ; GVAL(0), PEEK(1), PVAL(2), POKE(3) GVAL: MOV #3,%1 ; Load error code = max legal function CMP %0,%1 ; Check for legal function BHI 6$ ; Error if function code > 3 MOV (%5)+,%1 ; Get address or offset BIT #1,%0 ; Is this GVAL or PVAL? BNE 10$ ; No, PEEK/POKE ADD #$RMON,%1 ; Yes, point into monitor CMP %1,#MONEND ; Make sure we are within it BHI 5$ ; Error if above CMP %1,#$RMON ; OK if in range BHIS 10$ 5$: CLR %1 ; Address out of range or odd 6$: SEV ; Say error code in %1 RTS PC ; Dealt with on return 10$: .IF NDF ABSLOW CMP %1,#FISVEC-SYSCOM ; Are we within remapped area? BHI 20$ ; Keep given address if above it ADD #SYSCOM,%1 ; Else remap .ENDC 20$: BIT #1,%1 ; Make sure address is even BNE 5$ ; Error if odd MOV @%1,SAVER0 ; Always return {old} value at given address DEC %0 ; Is this a GVAL (0) or PEEK (1) BLE 30$ ; That's all if so MOV @%5,@%1 ; Else we have a value to change 30$: CCC ; Return success RTS PC .ENDC ; V5 .ENDC ; V4 ff .IF NDF A$$BRT SCCA=NOTIMP .IFF ALIGN ; Simulated .SCCA only traps ^C ABORT, which is equivalent to RT-11's ^C^C ; to abort task. Single ^C's are not put into TI: input buffer, as RT-11 ; does with .SCCA enabled. Note that .SCCA only works once, unless you reset ; it each time (even if you're privileged). This makes it a bit safer, at the ; expense of RT-11 incompatibility. Note also, that SREX$S may not be issued ; with AST's disabled, so use the same trick as .SPND to restore eveything ; and THEN issue the command. SCCA: CLR SREX+S.REAE ; Clear AST routine address MOV @%5,SCCAST ; Save address of SCCA control word BEQ 10$ ; 0 means .SCCA disabled MOV #ABOAST,SREX+S.REAE ; <>0 means enabled. Set our abort trap 10$: MOV 4(SP),@SP ; Push user's PS over (unused) return address JSR PC,RET ; Do normal exit code, returning here by RTI DIR$ #SREX ; Then issue AST setup RTI ; And return to caller ; Come here on abort request. If non-privileged, just set user's flag, and ; return. If privileged, abort now. ABOAST: BIS #BIT15,@SCCAST ; Set user flag bit 15 ROR 2(SP) ; If bit 0 of stack word 1 is clear BCS 10$ ; this is a non-privileged abort, just return MOV #20$,6(SP) ; If privileged, abort self now MOV #177777,12(SP) ; Setting any flags being waited upon 10$: ADD @SP,SP ; Purge stack ASTX$S ; and return 20$: CLR SREX+S.REAE ; Privileged abort, clear AST routine address DIR$ #SREX ; Don't re-enter, even if privileged ABRT$S TSKNAM ; Abort self .ENDC .IIF DF SJ,CRAW=ILLEMT .IIF DF FB!XM,CRAW=NOTIMP .IF LT RTVRSN-30 MTIO=ILLEMT .IFF .IF EQ TERMS MTIO=NOOP ; No multi-terminal support (SJ or disabled) .IFF .PSECT $RMON,RW,D MTFUN: .WORD MTSET ; 0 .WORD MTGET ; 1 .WORD MTIN ; 2 .WORD MTOUT ; 3 .WORD CCO ; 4 (.MTRCTO) .WORD MTATCH ; 5 .WORD MTDTCH ; 6 .WORD MTPRNT ; 7 .IIF GE RTVRSN-50, .WORD MTSTAT ; 10 MTMAX=<.-MTFUN>/2 ; Set/Get multiple-characteristics control block MTSF: MTHHT: .BYTE TC.HHT,0 ; Horizontal tab MTACR: .BYTE TC.ACR,0 ; Wrap-around mode MTHFF: .BYTE TC.HFF,0 ; Form feed mode MTESQ: .BYTE TC.ESQ,0 ; Escape sequence handling MTHLD: .BYTE TC.HLD,0 ; Hold mode MTRSP: .BYTE TC.RSP,0 ; Receive speed MTXSP: .BYTE TC.XSP,0 ; Transmit speed MTSMR: .BYTE TC.SMR,0 ; Lower case conversion MTSCP: .BYTE TC.SCP,0 ; CRT rubout MTHFL: .BYTE TC.HFL,0 ; No of fill chars after CR MTWID: .BYTE TC.WID,0 ; Width .IIF GE RTVRSN-40,MTRPA: .BYTE TC.BIN,0 ; Read pass all MTL=.-MTSF ; Block size ; Send/receive speed function table -- RSX codes SPEED: .BYTE S.50,S.75,S.110,S.134,S.150,S.300,S.600,S.1200 .BYTE S.1800,S.2000,S.2400,S.3600,S.4800,S.7200,S.9600 .BYTE 377 .EVEN ; Define offsets in RT11 status block: M.TSTS=0 ; Configuration word 1 M.TST2=2 ; Configuration word 2 (only used in V4 ff) M.TFIL=4 ; Char requiring fillers (always CR in simulator) M.FCNT=5 ; No of fillers (byte) M.TWID=6 ; Carriage width byte M.TSTW=7 ; Terminal status byte .PSECT $$RT11,RO,I ALIGN MTIO: MOV #3,%1 ; Error 3 (illegal request) CMP %0,#MTMAX ; ? BHI 20$ ; Yes, error MOV (%5)+,%3 ; Fetch addr pointer MOVB (%5)+,%4 ; Fetch RT11 LUN number DEC %1 ; Error 2 (LUN out of range) CMP %4,#TERMS ; ? BHI 20$ ; Exit if so MOVB @%5,%5 ; Fetch char count MOV %4,%1 ; Get LUN no MUL #TTYSPC,%1 ; * terminal workspace size MOV %1,%2 ; Copy to %2 ADD #TISTT,%2 ; and form absolute address of status word MOV #1,%1 ; Set %1=1 for error code etc. CMP %0,#5 ; Attach? BEQ 10$ ; Yes, terminal may be detached .IF GE RTVRSN-30 CMP %0,%1 ; Get status (code 1)? BEQ 10$ ; Yes, needn't be attached for that .ENDC BIT %1,@%2 ; Test attached flag, bit 0 BEQ 20$ ; Error 1 if not attached 10$: ADD #TILUN,%4 ; Change RT11 LUN No to RSX eqvt TTQSET ,%4 ; OK, change LUN no and event flag for QIO MOV %4,GLUN+G.LULU ; In case needed, DIR$ #GLUN ; get LUN information ASL %0 ; Double sub-code CCC ; Clear all condition codes, especially carry JSR PC,@MTFUN(%0) ; Call routine in table TTQSET ,#TILUN ; Reset default LUN/flag for QIO to TI: BCC 30$ ; OK unless function set carry 20$: SEV ; When set V too -- error code is in %1 30$: RTS PC ; Return to SEVARG controller ; On entry to any multi-terminal function: ; %0 = 2 * function sub-code ; %2 -> simulator control block status word ; %3 = addr parameter ; %4 = actual RSX LUN number ; %5 = char count parameter ; OUTSPC contains LUN information ALIGN .MACRO SETFUN ROR %0 ADCB (%1)+ INC %1 .ENDM MTSET: MOV @%3,@%2 ; Get 1st word of addr block BIS #1,@%2 ; Restore attached bit MOV @%2,%1 ; Copy BIC #^CTTSPC$!TCBIT$,%1 ; To get special control bits CMP %4,#TILUN ; Is this the console? BNE 1$ ; No, branch BIC #^CTTSPC$!TCBIT$,JSW ; Yes, must change bits BIS %1,JSW ; in JSW too 1$: MOV #MTL/2,%0 ; Load block length in words MOV #MTSF+MTL,%1 ; Point above end of block 2$: BIC #^C377,-(%1) ; Clear hi bytes SOB %0,2$ ; through whole block leaving %1->MTSF INC %1 ; Point to hi bytes of function control words MOV @%2,%0 ; Reload status word SETFUN ; Set horiz tab function -- bit 0 SETFUN ; Wrap-around, bit 1 SETFUN ; Form-feed, bit 2 ROR %0 ; Can't simulate ctrl/F and ctrl/B processing SETFUN ; Escape sequence recognition bit 4 ROR %0 ; Can't simulate escape sequence filtering bit 5 ROR %0 ; Skip wait bit 6, TCBIT$ SETFUN ; Xon/Xoff = Hold mode, bit 7 MOV %0,%4 ; Copy BIC #^C^B1111,%4 ; to select speed bits MOVB SPEED(%4),(%1)+ ; Set receive speed INC %1 ; Point to transmit speed byte MOVB SPEED(%4),(%1)+ ; Set that to the same value INC %1 ; Point to MTSMR control function ASH #-7,%0 ; Bypass speed, TTSPC$, and remote(RO) bits ADCB (%1)+ ; putting bit 14 (LC->UC bit) into carry, INC %1 ; hence setting TC.SMR control byte SETFUN ; Last bit sets CRT rubout MOVB M.FCNT(%3),@%1 ; Set fill count MOVB M.TWID(%3),MTWID+1 ; and buffer width .IF GE RTVRSN-40 TSTB M.TST2(%3) ; If bit 7 of config word 2 is set BPL 10$ ; need read-pass-all INCB MTRPA+1 ; Set bit for it (write-pass-all done by simulator) 10$: MOV M.TST2(%3),T.ST2(%2) ; Save second control word for write-pass-all flag .ENDC TTQIOW #SF.SMC,,#MTSF,#MTL ; Set characteristics from table CCC ; Ignore failure RTS PC ; Return ALIGN .MACRO GETFUN FUN RORB MT'FUN+1 ROL %0 .ENDM ; Get terminal characteristics. ; N.B. this depends mightily on word 3 of the Get LUN Information buffer ; containing terminal device characteristics word 2 (U.CW2), as defined in ; macro UCBDF$. This is not officially supported, but seems to work for the ; RSX V3.2 and V4 full duplex terminal drivers. MTGET: TTQIOW #SF.GMC,,#MTSF,#MTL ; Get characteristics to MTSF block BCS 50$ ; Give up if error GETFUN SCP ; Get CRT rubout bit 15 GETFUN SMR ; Upper/lower case conversion bit 14 MOV #SPEED,%1 ; Address speed table CLR -(SP) ; Clear counter 10$: CMPB (%1)+,MTRSP+1 ; Search table BEQ 20$ ; for matching mask INC @SP ; Counting on stack CMPB @%1,#377 ; End of table? BNE 10$ ; No, keep looking 20$: ASH #6,%0 ; Space for speed 8-11 (leave 12 & 13 for later) BIS (SP)+,%0 ; Insert speed GETFUN HLD ; Hold mode, bit 7 ASL %0 ; Will put in TCBIT$, 6, later ASL %0 ; Escape sequences not echoed (bit 5) GETFUN ESQ ; Escape sequence handling 4 SEC ; Special handling of ctrl/F, ctrl/B ROL %0 ; not implemented -- say disabled (bit 3) GETFUN HFF ; Hardware form feed bit 2 GETFUN ACR ; Wrap-around mode, bit 1 GETFUN HHT ; Hardware tab, bit 0 MOV %0,@%3 ; Store configuration word 1 MOV @%2,%0 ; Get local status word CMP %4,#TILUN ; but is this the user terminal? BNE 30$ ; No, branch MOV JSW,%0 ; Yes, special mode bits are in JSW 30$: BIC #^CTTSPC$!TCBIT$,%0 ; Select only the two required bits BIS %0,@%3 ; Put them in configuration word 1 MOV OUTSPC+G.LUCW+2,%0 ; Fetch second device characteristics word BIC #^CU2.RMT,%0 ; Select remote bit which is in the same BIS %0,(%3)+ ; position in RT11 config word as RSX! .IF GE RTVRSN-40 MOV T.ST2(%2),@%3 ; Load local status word 2 BIC #^C100000,(%3)+ ; For write-pass-all flag (not an SF.SMC function) RORB MTRPA+1 ; Check read-pass-all status (all we can check) RORB -2(%3) ; Sets sign bit in M.TST2 .IFF CLR (%3)+ ; Clear word 2, not used .IFTF MOVB #15,(%3)+ ; CR may require fillers MOVB MTHFL+1,(%3)+ ; Copy no of fillers MOVB MTWID+1,(%3)+ ; Copy carriage width CLRB @%3 ; Clear terminal status byte BIT #U2.DZ1,OUTSPC+G.LUCW+2 ; Is unit a DZ-11? BEQ 50$ ; No, OK BISB #BIT12/400,@%3 ; Yes, say so the RT-11 way .IFF 50$: .IFT SUB #M.TSTW-M.TST2,%3 ; No, point back at config word 2 BIS #^B111,@%3 ; DZ's are always 8 bits on RSX CMPB MTRSP,#S.300 ; and if speed <= 300 baud BHI 50$ BIS #BIT2,@%3 ; There are 2 stop bits ; Return success if terminal attached by self, error 1 if not attached by ; anyone, or error 4 if "attached by another job" (= terminal logged on). 50$: MOV #1,%1 ; Load error code 1 BIT %1,@%2 ; See if terminal is attached BNE 60$ ; OK if it is BIT #U2.LOG,OUTSPC+G.LUCW+2 ; Terminal logged on? BNE 70$ ; Return error 1 if not BR ATDTER ; Else error 4, and 1 in %0, like attach .ENDC 60$: CCC ; No errors reported 70$: RTS PC ; Return ALIGN MTIN: CLR %1 ; Will return error 0 if < %5 bytes available 10$: JSR PC,TTIN ; Get a character BCS 20$ ; Exit cs if none to fetch MOVB %0,(%3)+ ; cc. Copy into buffer DEC %5 ; Until all done BGT 10$ ; (Don't SOB, count=0 gets 1 char) 20$: MOV %3,SAVER0 ; Return updated buffer address RTS PC ; Then exit ALIGN MTOUT: TTQSET ,,,%5 ; Set up char count BNE 10$ ; OK if non-zero INC QIOW+Q.IOPL+2 ; 0 means output 1 char .IF GE RTVRSN-40 10$: JSR PC,WALWLB ; Set write, or write-pass-all TTQIOW ,,%3 ; Output buffer addressed by %3 .IFF 10$: TTQIOW #IO.WLB,,%3 ; Output buffer addressed by %3 .ENDC CCC ; Ignore failure RTS PC ; Just return ALIGN MTATCH: CMP %4,#TILUN ; Unless TI: BEQ 10$ ; When expect to be logged on, BIT #U2.LOG,OUTSPC+G.LUCW+2 ; terminal logged on BEQ ATDTER ; Forbid attach if so (bit is clear) 10$: INC @%2 ; Flag attached locally MOV %3,T.AST(%2) ; Save asynchronous terminal control word (if any) TTQSET #IO.ATT ; Set up for attach BR ATDTX ; Join common code with detach MTDTCH: DEC @%2 ; Flag detach locally TTQSET #IO.DET ; Set up detach function ATDTX: DIR$ #QIOW ; Perform function BCS ATDTER ; Trap directive error MOVB IOSTAT,%0 ; Fetch error byte BGT ATDTZ ; OK if >0 CMPB %0,#IE.DAA ; Don't fault device already attached (attach) BEQ ATDTZ CMPB %0,#IE.DNA ; or device not attached (detach) BEQ ATDTZ ; Just redundant operations ATDTER: MOV #4,%1 ; Give error 4 on failure .IF GE RTVRSN-40 BCC ATDTZ ; Leave %0 unchanged if OK MOV #1,SAVER0 ; Else it is dummy "other job" number .ENDC ATDTZ: RTS PC ; and return .IF GE RTVRSN-50 ; Return (simulator) terminal status block information. ALIGN MTSTAT: MOV @%3,%3 ; Get block pointer MOV #T1STT-$RMON,(%3)+ ; First word is offset to 1st TCB MOV #TISTT-$RMON,(%3)+ ; Second is offset to TI: TCB MOV #TERMS,(%3)+ ; No of terminals MOV #TTYSPC,(%3)+ ; Size of TCB's RTS PC ; Return .ENDC ; V5.0 ff .ENDC ; Multi-terminal functions for FB and XM monitors .ENDC ; RT-11 V3 or later .IF GE RTVRSN-40 ; Set date and time (N.B. you must be privileged to do this). ALIGN SDTTM: DIR$ #GTIME ; Get current time in case of defaults MOV @%5,%5 ; Get RT-11 argument block pointer MOV (%5)+,%4 ; Get date word CMP %4,#-1 ; -1 is keep current date BEQ 10$ ; So go do time MOV %4,$DATE ; Update system date JSR PC,DIVDAT ; Split into y/m/d 10$: MOV (%5)+,%1 ; Fetch hi word of time CMP %1,#-1 ; If -1 BEQ 20$ ; Leave it unchanged MOV (%5)+,%2 ; Get lo word .IF DF SJ MOV %1,$TIME ; Store in system area MOV %2,$TIME+2 .ENDC JSR PC,DIVTIM ; Else split time into h/m/s/t 20$: DIR$ #STIM ; Set time CCC ; Ignore error (e.g. not privileged) .IF DF SJ SPCPS: .IFTF RTS PC ; Return .ENDC .IF DF FB!XM ; Change return address from completion routine. This is just a matter of ; altering word 2 of the current AST return block on the stack. Location CMPLET ; contains the stack pointer addressing the saved registers %0/%1 and the AST ; information, or 0 if no completion routine is active. Bit 0 of CMPLET is set ; if we have already had an SPCPS. ALIGN SPCPS: CLR %1 ; Set error code 0 in case needed MOV CMPLET,%0 ; Fetch completion routine SP BEQ 20$ ; Error 0 if in mainline code INC %1 ; Set code 1, in case BIT %1,%0 ; any previous SPCPS's (when CMPLET is odd)? BNE 20$ ; Error if so INC CMPLET ; OK, note we have one now MOV @%5,%5 ; Get address of 3-word block ADD #6,%0 ; Point to original PC MOV @%0,%1 ; Fetch it MOV (%5)+,(%0)+ ; 1st word is required PC. Change return address MOV %1,(%5)+ ; Return old mainline PC MOV (%0)+,(%5)+ ; and PS TST (PC)+ ; Return with carry and V clear, skip SEV 20$: SEV ; Error return with code in %1 RTS PC ; Return .ENDC .ENDC ; V4 ff .IF GE RTVRSN-50 .PSECT $RMON,RW,D GETPUT: .BLKB 2 ; Read/write header info .WORD HDRSPC ; To area after time .WORD 0 ; End of request HDRSPC=OUTSPC+G.TICP ; Workspace area for file header DATSPC=HDRSPC+43 ; Workspace area for ASCII date .PSECT $$RT11,RO,I ALIGN ; Change file creation date (default today). SFDAT: MOV (PC)+,%3 ; Load initial function code for set date .BYTE -2,2 ; (read protection first), note lo byte is -ve BR SFCOM ; Set/clear file protection. Uses a lot of code in common with SFDAT. FPROT: MOV (PC)+,%3 ; Load function for set protection .BYTE 2,2 ; (note lo byte is +ve) SFCOM: MOV %3,GETPUT ; Set function code for later JSR PC,GETFDB ; Will be error 0 if channel in use BNE 100$ ; Error if open already MOV 2(%5),%4 ; Fetch date/protect function for later JSR PC,ISETFN ; Set up filename block BCS 4$ ; Trap error (type 1) ; If this isn't a directory device there is no header to read/write. If this ; is a magtape, header can't be written. Return error 2 in either case. CMPB (%1)+,(%1)+ ; Set error 2 BIT #NR,%3 ; Yes, is this a directory device? BNE 100$ ; Not if bit set, error .IF EQ RA-BIT15 TST %3 ; Sequential (magtape) device (test bit 15)? BPL 100$ ; Can't change header there either .IFF BIT #RA,%3 ; Sequential (magtape) device? BEQ 100$ ; Can't change header there either .ENDC MOV %0,%1 ; Copy FDB pointer ADD #F.FNB,%1 ; Set %1->filename block JSR PC,.FIND ; Find file-ID; no need to open it BCC 5$ ; Continue if OK MOV #1,%1 ; Set error code 1 CMPB F.ERR(%0),#IE.NSF ; In case file not found BEQ 100$ ; That's it if so 4$: INC %1 ; Else must be invalid operation, set 2 BR 100$ 5$: TSTB GETPUT ; Is this a protection setup? BMI 10$ ; No, date, branch MOV %4,HDRSPC ; Load protection code. 0 = remove protection BEQ 30$ ; which is same value as for RSX MOV #^B1110111011101110,HDRSPC ; <>0=protect. Allow everyone reads only DEC %4 ; Make sure fprot code was 1 if not 0 BEQ 30$ ; Go set protection if OK BR 60$ ; Return error 3 if not ; Protecting a file under RSX does not prevent you changing header attributes. ; Read and check protection before changing dates. (Hence request code loaded ; as flag above). Permit date change if ANYONE has delete, extend, or write ; access to the file. A more rigorous test is possible, but hardly justified. 10$: JSR PC,RATWAT ; Get header information BCS 60$ ; Trap error COM HDRSPC ; Complement protect bits BIT #^B1110111011101110,HDRSPC ; Does anyone have >read access? BEQ 60$ ; Not if all tested bits clear, file is protected ; Form date in workspace and replace creation date in header. BITB #FD.DIR!FD.SDI,F.RCTL(%0) ; Is this a directory device? BEQ 100$ ; Error 2 again if not MOV (PC)+,@(PC)+ ; Load get dates request code .BYTE -15,43 .WORD GETPUT JSR PC,RATWAT ; to read attributes BCS 100$ ; Branch if error TST %4 ; Date specified? BNE 15$ ; Yes, keep it MOV $DATE,%4 ; No, get startup date (presumably today) 15$: MOV %0,-(SP) ; Save FDB pointer JSR PC,DIVDAT ; Split the RT-11 date into y/m/d MOV #DATSPC,%0 ; Address workspace for ASCII date MOV %0,%3 ; Copy pointer CMP OUTSPC+G.TIDA,#9. ; 1-digit day? BHI 17$ ; No, 2 MOVB #'0,(%0)+ ; Yes, undo $DAT's zero suppression 17$: MOV #OUTSPC+G.TIYR,%1 ; Address stored date JSR PC,$DAT ; Use Syslib date conversion routine MOV #HDRSPC+I.CRDT-I.RVNO,%2 ; Address new date area MOV #7,%4 ; 7 bytes to copy (excluding hyphens) 20$: CMPB (%3)+,#'- ; Skip hyphens BEQ 20$ MOVB -1(%3),(%2)+ ; Copy all else SOB %4,20$ ; Until done NEGB GETPUT ; Change sign of attribute code MOV (SP)+,%0 ; Restore FDB pointer ; Common code resumes here, to write specified attributes. 30$: JSR PC,RATWAT ; Write new attributes CLV BCC 200$ ; Exit if OK 60$: MOV #3,%1 ; Protection violation or illegal prot code 100$: SEV ; Else set error flag 200$: RTS PC ; and return ; Execute read/write attributes QIO. Return cs if failed, else cc. RATWAT: MOV %0,%1 ; Copy FDB pointer to get ADD #F.FNB+N.FID,%1 ; file-ID pointer for read/write attributes: MOV #IO.RAT,%2 ; Assume we need to read attributes TSTB GETPUT ; But if request code is +ve BMI 5$ MOV #IO.WAT,%2 ; It's a write request 5$: QIOW$S %2,F.LUN(%0),F.BKEF(%0),,F.BKST(%0),,<%1,#GETPUT> BCS 10$ ; Error if QIO rejected ROLB @F.BKST(%0) ; or failed (copy sign to carry) 10$: RTS PC ; Return .ENDC .PAGE .SBTTL FUNCTIONS WITH SPECIAL ARGUMENT PASSING ; NOTE: These are entered by JMP, not JSR, as they may alter the stack. They ; must therefore exit by a JMP to one of the RET addresses. ALIGN TTYIN: MOV #TISTT,%2 ; Address terminal status word MOV JSW,@%2 ; Copy status bits BIS #1,@%2 ; Always attached JSR PC,TTIN ; Get character to %0 ADCB 2(SP) ; If none, set carry ; Handle LC->UC conversion according to TTLC$ bit (necessary only for TI: -- ; MTSET does it via SF.SMR for other terminals). BIT #TTLC$,@%2 ; Convert LC->UC? BNE 10$ ; Not if set, return character read JSR PC,UPPER ; Yes, convert lower- to upper case if reqd 10$: JMP RET15 ; Return ALIGN TTYOUT: MOVB %0,TEMPB ; Store character .IF GE RTVRSN-40 MOV #TISTT,%2 ; Address status block JSR PC,WALWLB ; Set write or write-pass-all TTQIOW ,,#TEMPB,#1 ; Write 1 byte from TEMPB .IFF TTQIOW #IO.WLB,,#TEMPB,#1 ; Write 1 byte from TEMPB .ENDC JMP RET ; and return ALIGN DSTATUS:MOV (SP)+,%1 ; Pop return address MOV (SP)+,%2 ; and PS MOV (SP)+,%5 ; to fetch retspc pointer MOV %2,-(SP) ; Replace return PS MOV %1,-(SP) ; and PC for the RTI MOV @%0,%1 ; Get device name JSR PC,DEV ; Look it up in table BCS 10$ ; Error exit if not found TST (%1)+ ; Found, point to status word MOVB (%1)+,(%5)+ ; Copy status word lo MOVB @%1,(%5)+ ; and hi RORB (%1)+ ; Save bit 8 for device size test MOV (%1)+,(%5)+ ; Copy handler size MOV (%1)+,@%5 ; Copy load address BIC #1,(%5)+ ; Make sure bit 0 is clear BCC 5$ ; Variable device size? %1 addresses table entry if not ALUN$S #SPRLUN,2(%1),%2 ; Yes, assign spare LUN to named device BCS 5$ ; Assume error is invalid device. Keep nominal size MOV #SPRFDB,%0 ; Address FDB for it JSR PC,DEVSIZ ; Fetch size by GLUN info call 5$: MOV (%1)+,@%5 ; Return device size JMP RET ; Return 10$: CLRB %1 ; Error exit, error code 0 JMP RETR1 ; Done ALIGN FETCH: MOV @%0,%1 ; Copy device name MOV (SP)+,%2 ; Pop return PC MOV (SP)+,%3 ; and PS MOV (SP)+,%0 ; to fetch handler space pointer MOV %3,-(SP) ; Replace PS MOV %2,-(SP) ; and PC JSR PC,DEV ; Look up device in table BCC 10$ ; OK if it's there CLRB ERRBYT ; Error code 0 if not INC 2(SP) ; Set carry on return BR 20$ ; Return with unchanged address in %0 10$: CMP %0,#400 ; "Address" <400? BLO RELEASE ; Means .RELEASE .IF NDF XM ; .FETCH does nothing in the Extended Monitor ADD #D.LODA,%1 ; Point to load address TST @%1 ; Device loaded already? BNE 20$ ; Yes, don't load it again MOV %0,%1 ; No, copy load address ADD -(%1),%0 ; Advance space pointer by handler size .ENDC 20$: JMP RET15 ; Return with address in %0 RELEASE: .IF NDF XM ; .RELEASE is ignored in XM monitor BIT #1,D.LODA(%1) ; Handler LOADed from KMON? BNE 10$ ; Yes, can't .RELEASE it CLR D.LODA(%1) ; No, show it's unloaded .ENDC 10$: JMP RET ; Return ; On entry, CSIGEN parameters are on stack in order: ; {linbuf} ; devspc ; defext ; cstrng ; return PS ; SP-> return PC ; If bit 0 of devspc is set, linbuf is given. If clear, linbuf is absent. ALIGN CSIGEN: MOV 10(SP),%0 ; Get devspc parameter MOV #OUTSPC,10(SP) ; Replace it with local workspace for CSISPC ROR %0 ; Get bit 0 ADC 10(SP) ; Set bit 0 on stack if it was in devspc ASL %0 ; but clear it in devspc MOV %0,SAVER0 ; Store it to be returned 1$: JSR PC,CSISP1 ; Call CSISPC code to parse line JSR PC,CLSALL ; Close all files ; Open input files first, to allow for the case X.YYY=X.YYY . For RT11, this ; would delete the original file on exit. For RSX, just create a new version. MOV #FDB3,%0 ; Address first input FDB MOV #6,%1 ; 6 input files MOV #OUTSPC+30.,%5 ; Address first filename descriptor 110$: TST @%5 ; Any file specified? BNE 115$ ; Yes, go open it ADD #8.,%5 ; No, point to next file spec BR 120$ ; and try that 115$: JSR PC,SETFNB ; Load filename block BCS 400$ ; Trap error MOVB #1,L.BKST(%0) ; Set no I/O pending flag in status block for .WAIT OFNB$R ; Open the file BCS 400$ ; Trap error 120$: ADD #FILSPC,%0 ; Address next FDB SOB %1,110$ ; Back for more ; Now open output files MOV #FDB0,%0 ; Address first O/P FDB MOV #OUTSPC,%5 ; and start of file specifications block MOV #3,%1 ; 3 output files 210$: TST @%5 ; Any file specified? BNE 215$ ; Yes, go open it ADD #10.,%5 ; No, bypass file spec BR 220$ ; and try next 215$: JSR PC,SETFNB ; Load filename block BCS 300$ ; Trap error NEG @%5 ; File need not be contiguous FDAT$R ,,,,(%5)+ ; Load file space required OFNB$W ; Open the file BCS 300$ ; Any error is "device full" 220$: ADD #FILSPC,%0 ; Address next FDB SOB %1,210$ ; Back for more JMP RETPSC ; Return, restoring PS and PC ; Error exits for CSIGEN. Put message pointer in %4, close anything opened ; and try again unless the command came from a string. ALIGN 300$: MOV #DEVFUL,%4 ; Device full MOV #3,%1 ; Error 3 BR 500$ ; Go process error 400$: MOV #NOTFND,%4 ; File not found MOV #4,%1 ; Error 4 500$: MOV #CHANS+1,%2 ; CHANS files + 1 because SOB stops at 0 MOV #FDB0+>,%0 ; Address last file+1 510$: SUB #FILSPC,%0 ; Address previous FDB TST F.BDB(%0) ; Is file open? BEQ 530$ ; Not if F.BDB=0, go test next one CMP %2,#3 ; Output file? BLOS 520$ CLOSE$ ; No, just close BR 530$ 520$: JSR PC,.DLFNB ; Yes, close and delete 530$: SOB %2,510$ ; Keep closing MOV SAVESP,SP ; Purge the stack TST CSISTR ; Input from terminal? BNE 600$ ; No, from string, branch MOV %4,%0 ; Yes, get error message JSR PC,PRNTER ; and print it ; Put the stack back the way it was before CSISP1 was called MOV CSILIN,-(SP) ; Stack linbuf BEQ 550$ ; Unless it was omitted, MOV #1,-(SP) ; put in flag bit 550$: BIS CSISPA,@SP ; Restore outspc for CSISP1 MOV CSIDEX,-(SP) ; Stack defext MOV CSISTR,-(SP) ; and string MOV SAVEPS,-(SP) ; and PS MOV SAVEPC,-(SP) ; and PC JMP 1$ ; Do it all again ; Give up if an erroneous command came from a string 600$: MOV SAVEPS,-(SP) ; Command in string, restore PS MOV SAVEPC,-(SP) ; and PC JMP RETR1 ; Return c set and code in %1 ; EMT 345 is either CSISPC or GTLIN. On entry, the stack contains: ; CSISPC GTLIN ; 12 {linbuf} linbuf ; 10 outspc 1 if .COM i/p allowed, 3 to force i/p from TI: ; 6 defext prompt (or 0 if none) ; 4 cstrng or 0 0 ; 2 return PS return PS ; 0 return PC return PC ; If bit 0 of devspc is set, linbuf is given. If clear, linbuf is absent. ALIGN CSISPC: .IF GE RTVRSN-30 CMP 10(SP),#1 ; GTLIN? BEQ GTLIN ; Yes, branch .IF GE RTVRSN-50 CMP 10(SP),#3 ; No, GTLIN with forced TI: input? BEQ GTLINT ; Yes, branch .ENDC .ENDC MOV #RETPSC,%5 ; Normal exit is via restore of PS and PC BR CSISP2 ; Process file spec and return ALIGN .IIF GE RTVRSN-50,GTLINT: CLRB @TIPTR ; Force new line of input from TI: GTLIN: MOV (SP)+,SAVEPC ; Save return PC MOV (SP)+,SAVEPS ; and PS TST (SP)+ ; Ignore the 0 MOV (SP)+,%0 ; Fetch prompt address TST (SP)+ ; Skip the 1 TST %0 ; Was there a prompt? BEQ 10$ ; No, just get line JSR PC,PRNT ; Yes, print it 10$: MOV (SP)+,%0 ; Get address of reply JSR PC,GETLIN ; Get reply JMP RETPSC ; Return, restoring PS and PC ; Common routine used by CSIGEN and CSISPC to fetch and parse command line ALIGN CSISP1: MOV (SP)+,%5 ; Get return address, CSISP2: MOV (SP)+,SAVEPC ; original PC, MOV (SP)+,SAVEPS ; original PS, MOV (SP)+,CSISTR ; command string pointer, MOV (SP)+,CSIDEX ; and default extensions block CLR %3 ; Clear linbuf address MOV (SP)+,%1 ; Next word is files descriptor block, BIT #1,%1 ; Test bit 0 BEQ 10$ ; Unless clear, MOV (SP)+,%3 ; linbuf was given DEC %1 ; Clear bit 0 of defext 10$: MOV %3,CSILIN ; Store line address (if any) MOV %1,CSISPA ; and files descriptor block MOV SP,SAVESP ; Save emptied stack pointer 1$: MOV CSISTR,%0 ; Command string given? BNE 20$ ; Yes, use it TSTB @TIPTR ; No, anything in TI: buffer (e.g. command line)? BNE 5$ ; Yes, go get it TSTB CLICMD ; No, did we have a command line? BNE 7$ ; Yes, invoked for 1-shot command. Exit second time MOV #STAR,%0 ; No, address '*' prompt JSR PC,PRNT ; Print it MOV #TIBUF,%0 ; Address buffer 5$: JSR PC,GETLIN ; for reply CMPB IOSTAT,#IE.EOF ; Was ctrl/Z typed? BNE 20$ ; No, continue 7$: JMP EXIT ; Yes, exit ; Pre-process command line in(to) TIBUF, deleting blanks and tabs, and ; converting lower case chars into upper case, except for switches. If ; linbuf was defined, the original string is copied there too. Also ; look for an equals sign, to indicate whether there are any output files. 20$: MOV #3,-(SP) ; Assume no '=' (Count them on stack) MOV #TIBUF,%1 ; Address output MOV %0,%2 ; and input buffers 30$: MOVB (%2)+,%0 ; Get character TST %3 ; Storing in linbuf? BEQ 31$ ; Skip if not MOVB %0,(%3)+ ; Store if required 31$: CMPB %0,#'/ ; Switch indicator? BNE 32$ ; No, branch MOVB %0,(%1)+ ; Store the '/' MOVB (%2)+,%0 ; and get the next character TST %3 ; Store that in linbuf? BEQ 39$ ; No, done MOVB %0,(%3)+ ; Yes, store BR 39$ ; and loop 32$: CMPB %0,#<' > ; Space? BEQ 30$ ; Yes, ignore it CMPB %0,#<' > ; Tab? BEQ 30$ ; Ignore that too .IF LT RTVRSN-30 ; Early RT-11's accepted < for = CMPB %0,#'< ; '<'? BNE 33$ ; No, try '=' MOVB #'=,%0 ; Change '<' to '=' .ENDC 33$: CMPB %0,#'= ; '='? BNE 35$ ; No, go test for letter SUB #3,@SP ; Note we have output files BR 39$ ; Go store character 35$: JSR PC,UPPER ; Make any lower-case letters upper-case 39$: MOVB %0,(%1)+ ; Store character BNE 30$ ; Loop unless null MOV CSISPA,%4 ; Get file descriptors block pointer MOV #39.,%3 ; 39. words 41$: CLR (%4)+ ; Clear block SOB %3,41$ ; for quick exits ; Parse up to CHANS files on channels 0 to CHANS-1. ; %0 -> Command line, now in TIBUF ; %1,%2 are outputs from conversion routines ; %3 -> default extension ; %4 -> file descriptor block ; %5 MUST BE PRESERVED (used by CSIGEN) ; TEMPB is current channel no ; TEMP is current default device name ; TEMP2 counts no of switches MOV #TIBUF,%0 ; Point to command string CLR TEMP2 ; Clear switch counter MOVB (SP)+,TEMPB ; Get first channel no ('=' counter) BPL 49$ ; OK if 0 or 3 JMP 1000$ ; Syntax error if >1 '=' 49$: MOV CSIDEX,%3 ; Point to TST (%3)+ ; first output default extension MOV CSISPA,%4 ; and file descriptor block MOV #^RSY0,TEMP ; Set default device TSTB TEMPB ; Starting at output channel 0? BEQ 50$ ; Yes, go TST -(%3) ; No, re-adjust pointers. %3-> default input ext ADD #30.,%4 ; %4->input file spec 50$: JSR PC,CAT5 ; Try for 1-3 Radix-50 chars MOV %1,@%4 ; Presumably a device name MOV %1,-(SP) ; Put name (or 0) on stack CMPB %2,#': ; But did it end with colon? BNE 52$ ; No, try filename MOV (%4)+,TEMP ; Yes, copy device default JSR PC,DEV ; Make sure device is valid BCC 60$ ; Continue if so JMP 1100$ ; Error if not 52$: MOV TEMP,(%4)+ ; Not a device name, use default BR 62$ ; Keep %1 as possible 1st word of filename 60$: JSR PC,CAT5 ; Get possible 1st word of filename 62$: MOV %1,(%4)+ ; Save first word of filename MOVB %2,%1 ; Fetch next char JSR PC,ALPHAN ; Is it alphanumeric? BCC 64$ ; No, branch JSR PC,CAT5 ; Yes, try for a second word MOV %1,@%4 ; Store whatever you get (even 0 if nothing) 64$: TST (%4)+ ; Advance to extension 70$: CMPB %2,#'. ; Terminated on '.'? BEQ 72$ ; Yes, get extension MOV @%3,(%4)+ ; No, use default extension BR 80$ ; Go look for next terminator 72$: JSR PC,CAT5 ; Convert filetype MOV %1,(%4)+ ; Save filetype MOV PC,@SP ; and note we had an explicit one 80$: TST (SP)+ ; Explicit device, filename, or extension given? BNE 82$ ; Yes, leave device name CLR -10(%4) ; No, clear (defaulted) device name to say no file 82$: CMPB %2,#'[ ; Terminated on [? BNE 90$ ; No, try switch JSR PC,CSDTB ; Yes, get file size, signed decimal CMPB %2,#'] ; Must finish with ']' BNE 1000$ ; Syntax error if it doesn't MOVB (%0)+,%2 ; Get char after '[' CMPB TEMPB,#3 ; Input file? BHIS 90$ ; Yes, ignore file size MOV %1,@%4 ; No, store it 90$: CMPB %2,#'/ ; Start of switch? BNE 110$ ; No, look for end of file ; Process switch specification, putting on the stack: ; {switch value if any} ; SP-> chan no/switch char (bit 15 set if value given) INC TEMP2 ; Count switch MOVB (%0)+,-(SP) ; Stack switch char MOVB TEMPB,1(SP) ; with chan no in hi byte MOVB (%0)+,%2 ; Fetch terminator CMPB %2,#': ; Is it a colon? BNE 90$ ; No, go see if another switch 95$: MOVB @%0,%1 ; Get 1st char of value JSR PC,NUMERC ; See if it's numeric BCC 100$ ; No, try Radix-50 JSR PC,GETNUM ; Yes, get numeric value BR 105$ ; and go stack it 100$: JSR PC,CAT5 ; Get Radix-50 switch value 105$: MOV (SP)+,%2 ; Value given, put it on stack MOV %1,-(SP) ; before switch char BIS #100000,%2 ; Set bit 15 of chan no/char MOV %2,-(SP) ; to say there is a value MOVB -1(%0),%2 ; Get the terminator back CMPB %2,#': ; Another switch value? BNE 90$ ; No, go test for another switch MOV @SP,-(SP) ; Yes, save chan no/char again INC TEMP2 ; Another value counts as another switch BR 95$ ; Repeat for further value ; Should be end of file here 110$: TSTB %2 ; Null is end of everything BEQ 200$ CMPB TEMPB,#2 ; Last output file? BEQ 120$ ; Yes, don't allow a comma CMPB %2,#', ; Comma? BNE 120$ ; No, try '=' INCB TEMPB ; Comma means another file. Get next channel no CMPB TEMPB,#8. ; Last file? BHI 1000$ ; Error if so CMPB TEMPB,#3 ; Doing input files? BHI 50$ ; Yes, straight back for more CMP (%4)+,(%3)+ ; No, outputs, advance pointers BR 50$ ; Back for more 120$: CMPB %2,#'= ; Only thing left is '=' BNE 1000$ ; If not must be illegal char MOVB #3,TEMPB ; '=' means input files coming. Set chan no JMP 49$ ; and restart 200$: MOV TEMP2,-(SP) ; Last word on stack is no of switches CLRB @TIPTR ; Say TI buffer empty JMP @%5 ; Return to caller ; Syntax error. Restore everything the way it was. If the command came ; from the terminal, print a message and go back for another try. If from ; a string, purge the stack and return with carry set. ALIGN 1000$: CLR %1 ; Return code 0 for syntax error BR 1105$ 1100$: MOV #1,%1 ; Return code 1 for illegal device 1105$: MOV SAVESP,SP ; Restore stack pointer CLRB @TIPTR ; Say TI buffer empty TST CSISTR ; Was a string supplied? BEQ 1110$ ; No, command line MOV SAVEPS,-(SP) ; Yes, stack PS MOV SAVEPC,-(SP) ; and PC JMP RETR1 ; Return with error code and carry set ; Command line came from terminal. Print error annd ask for another. 1110$: MOV #ILLCMD,%0 ; Address "Syntax error" message TST %1 ; But was it "Illegal device"? BEQ 1120$ ; No, print "Syntax error" MOV #ILLDEV,%1 ; Yes, point to "Illegal device" 1120$: JSR PC,PRNTER ; Print error message MOV CSILIN,%3 ; Restore %3 JMP 1$ ; Go back and try again LOCK=NOOP ; Lock UNLOCK=NOOP ; and unlock are dummies ; Exit to CLI, passing command line, if any. NOTE: If a command line IS given, ; it must be at the usual absolute address (512), with length at 510, and in ; RSX-11M format, acceptable to the current CLI. ALIGN EXIT: .IIF DF P$$OFF, MOV %0,-(SP) ; Save chain enable flag JSR PC,CLSALL ; Close all files .IF GE RTVRSN-40 ; Return RT-11 status to RSX using bits 0-3 of USERRB: ; RT-11 RSX-11M ; SUCCS$=BIT0 EX$SUC=1 ; WARN$=BIT1 EX$WAR=0 ; ERROR$=BIT2 EX$ERR=2 ; SEVER$=BIT4 EX$SEV=4 ; unknown=0 undefined=3 ; Find the highest bit of USERRB bits 0-3 which is set. MOVB USERRB,%2 ; Fetch user error byte MOV #ERRTAB,%1 ; Address RSX exit status table ASH #12.,%2 ; Shift error bits to top of word BEQ 20$ ; Exit now, unknown, if none set 10$: TST (%1)+ ; Advance table pointer ASL %2 ; Shift out a bit BCC 10$ ; Keep looking if clear .IFTF 20$: .IF DF P$$OFF TST (SP)+ ; Exit with command enabled? BNE 50$ ; %0<>0 inhibits it BIT #CHNIF$,JSW ; Yes, chain required? BEQ 50$ ; No, exit anyway MOV @#510,SPWN+S.PWCL ; Get command length BEQ 50$ ; Exit if none DIR$ #SPWN ; Spawn command at 512 ff to CLI .ENDC .IFT 50$: MOV @%1,%0 ; Fetch status JMP $EXST ; Exit with it (or without if EXST not supported) ERRTAB: .WORD 3,EX$SEV,EX$ERR,EX$WAR,EX$SUC .IFF 50$: EXIT$S .ENDC ALIGN PRINT: JSR PC,PRNT ; Call print routine JMP RET ; and return ALIGN SRESET: JSR PC,CLSALL ; Close all files JMP RET ; Return QSET=NOOP ; QSET is a dummy (dosen't even return %0) ALIGN SETTOP: CMP %0,$USRLC ; Too big? BLOS 10$ ; No, OK MOV $USRLC,%0 ; Yes, set to bottom of USR 10$: MOV %0,USERTO ; Save new max memory JMP RET ; Return RCTRLO: JSR PC,CCO ; Cancel ctrl/O JMP RET ; and return HRESET=SRESET .PAGE .SBTTL SUBROUTINES ; Save registers. Entry SAVE50 saves registers 5 to 0, entry SAVE40 saves 4 to 0. SAVE50: MOV %5,SAVER5 ; Save %5 SAVE40: .IRPC REG,<43210> MOV %'REG,SAVER'REG .ENDR RTS PC .PSECT $RMON,RW,D TYPED: .BYTE TC.TBF ; Request type-ahead count TYPCNT: .BLKB 1 ; to be returned here .PSECT $$RT11,RO,I ; Get a single character from the terminal whose LUN is currently set up in ; the QIOW DPB. On entry, %2 addresses the local status word (filled from ; JSW if this is the console). On exit, %0 will contain the character ; read. Under FB or XM, and if wait bit 6 (TCBIT$) in the status word is set, ; carry will be set if nothing has been typed. ; CAUTION: Don't destroy %3 -- it's used as a buffer pointer by MTIN. ALIGN ; Get a new line from TTY TTLIN: TTQSET #IO.RLB,,,#132. ; Set to get line, 132 bytes max TTICH: MOV %2,%4 ; Copy status word address CMP (%4)+,(%4)+ ; Point on to buffer start (ADD #T.BUFF=4,%4) TTQSET ,,%4 ; Load buffer address into DPB JSR PC,EXEQIO ; Execute QIO ADD %4,%0 ; Point to end of string MOVB IOSTAT+1,@%0 ; Copy the terminator (hi byte of status) CMPB (%0)+,#15 ; Was it carriage-return? BNE 25$ ; No, branch MOVB #12,(%0)+ ; Yes, in an LF too BIT #TF.RNE,QIOW+Q.IOFN ; and unless reading without echo, BNE 25$ JSR PC,LINEFD ; echo it 25$: CLRB @%0 ; add terminating null MOV %4,T.PTR(%2) ; Reset pointer to start of line TTIN: MOVB @T.PTR(%2),%0 ; Anything in buffer? BEQ 1$ INC T.PTR(%2) ; Yes, advance pointer for next time CLC ; Flag success BR 7$ ; and return ; Nothing in buffer. See what to do. 1$: BIT #TTSPC$,@%2 ; TTY special mode? BNE 100$ ; Yes, go get one char at a time .IF DF FB!XM BIT #TCBIT$,@%2 ; Wait mode? BEQ TTLIN ; Yes if bit clear, block until user types a line .ENDC 6$: SEC ; Failure, set carry to flag no chars ; Set bit 14 of asynchronous terminal status word if there is anything else ; in the input buffer, i.e. if T.PTR is not addressing a null byte. 7$: BIT #177777,T.AST(%2) ; Do we have an AST control word? (Keep carry, don't TST) BEQ 10$ ; No, don't set it BIC #BIT14,@T.AST(%2) ; Yes, clear "more chars" bit BITB #377,@T.PTR(%2) ; But are there any more (Don't TST again) BEQ 10$ ; No, leave bit clear BIS #BIT14,@T.AST(%2) ; Yes, set it 10$: RTS PC ; Exit ; TTY in special mode, read a character at a time, without echo. If wait mode ; is selected this is just a QIO for one character. In nowait mode, can only ; accept chars if they are in the type-ahead buffer. Nowait mode is fixed for ; the SJ monitor; for FB and XM it must be enabled if required by setting bit 6 ; of the terminal (job) status word. 100$: .IF DF FB!XM BIT #TCBIT$,@%2 ; Nowait mode? BEQ 110$ ; No, force a wait for 1 char .ENDC TTQIOW #SF.GMC,,#TYPED,#2 ; See if anything in type-ahead buffer TSTB TYPCNT ; Is there anything? BEQ 6$ ; No, exit with carry set 110$: TTQSET #IO.RLB!TF.RNE,,,#1 ; Set to read 1 byte w/o echo BR TTICH ; Go get it ; Print string addressed by %0, with allowance for null or 200 terminator ; (returned in %2). ALIGN .IF DF FB!XM MTPRNT: MOV %3,%0 ; Copy buffer address BR PRNT1 ; Join common code .ENDC PRNTER: JSR PC,CCO ; Cancel ctrl/O before error messages PRNT: .IF GE RTVRSN-40 MOV #TISTT,%2 ; Address status block PRNT1: JSR PC,WALWLB ; Set write or write-pass-all .IFF PRNT1: TTQSET #IO.WLB ; Write logical block normally .ENDC TTQSET ,,%0 ; Load address 10$: MOVB (%0)+,%2 ; Terminating null? BEQ 20$ ; Yes, start print CMPB %2,#200 ; Terminating 200? BNE 10$ ; No, keep looking 20$: DEC %0 ; Point to last char SUB QIOW+Q.IOPL,%0 ; Compute length of string TTQIOW ,,,%0 ; And print it TSTB %2 ; 200 terminator? BNE 30$ ; Yes, just exit TTQIOW ,,#CRLF,#2 ; No, terminate with CR/LF 30$: CCC ; Set no errors RTS PC ; and return ; Cancel control/O ALIGN CCO: TTQIOW #SF.SMC,,#CCOBUF,#2 ; Set characteristics function RTS PC ; and return ; Issue a line feed on terminal LINEFD: TTQIOW #IO.WLB,,#CRLF+1,#1 ; Print LF byte RTS PC ; and return .IF GE RTVRSN-40 ; Set terminal to write normal, or write-pass-all, according to bit 15 of ; second configuration word. WALWLB: TTQSET #IO.WLB ; Set for normal write TST T.ST2(%2) ; Test configuration word 2 BPL 10$ ; Normal write required if bit 15(sign) clear TTQSET #IO.WAL ; Write-pass-all if set 10$: RTS PC ; Return .ENDC ; Get a line from the terminal. If anything left in the buffer, use that, ; otherwise get a new buffer full, terminated by a null. %0 addresses buffer. ALIGN GETLIN: MOV %0,-(SP) ; Save output buffer pointer MOVB @TIPTR,%0 ; Is there a line of input waiting? BEQ 20$ ; No, must get one CMPB %0,#15 ; CR? BEQ 20$ ; Yes, line was emptied, get another CMPB %0,#12 ; or LF? BNE 100$ ; No, collect line already typed 20$: TTQSET #IO.RLB,,@SP,#80. ; Set up for read up to 80. bytes to where @SP points JSR PC,EXEQIO ; Execute QIO MOVB IOSTAT,-(SP) ; Save flag in case ctrl/Z typed JSR PC,LINEFD ; Follow CR with LF MOVB (SP)+,IOSTAT ; Restore flag ADD @SP,%0 ; Point to end of reply string CLRB @%0 ; Put in null terminator BR 200$ ; Exit, restoring pointer ; A line of unprocessed input is there already. Return that as the string. 100$: MOV TIPTR,%0 ; Address TTY buffer MOV @SP,%1 ; and destination string 110$: MOVB (%0)+,@%1 ; Get character BEQ 120$ ; End on null CMPB (%1)+,#15 ; or CR BNE 110$ ; Copy more if neither CLRB -(%1) ; Replace CR with null 120$: CLRB -(%0) ; Terminate source string with null 200$: MOV %0,TIPTR ; Point to null, to say no input pending BIT #TTLC$,JSW ; Allow lowercase? BNE 220$ ; Yes, just return MOV @SP,%1 ; No, fetch string pointer 210$: MOVB @%1,%0 ; Fetch and test char BEQ 220$ ; Done if null JSR PC,UPPER ; No, convert lower to upper case if reqd MOVB %0,(%1)+ ; Put char back BR 210$ ; and repeat 220$: MOV (SP)+,%0 ; Restore pointer RTS PC ; and return ; Execute (read) QIO, repeating indefinitely if it fails. Return length in %0. ALIGN EXEQIO: DIR$ #QIOW ; Execute it BCS EXEQIO ; Try again if not accepted CMPB IOSTAT,#IE.EOF ; Allow ctrl/Z BEQ 10$ TSTB IOSTAT ; Repeat if any other error BMI EXEQIO 10$: MOV IOSTAT+2,%0 ; Get string length RTS PC ; and return to caller ; On entry, %0=channel number. Set it to point to associated FDB, and ; test F.BDB to see if file is open. Always returns %1=0, which is the usual ; open/closed error no. ALIGN GETFDB: CMP %0,#TILUN-2 ; Make sure channel no is legal BLOS 10$ ; Continue if so MOV #ILCHAN,%0 ; Point to error message if not JMP SYSERR ; Fatal 10$: MUL #FILSPC,%0 ; Compute FDB offset ADD #FDB0,%1 ; relative to FDB for channel 0 MOV %1,%0 ; return to %0 CLR %1 ; REturn %1=0 for common error no TST F.BDB(%0) ; Set z if file not open RTS PC ; Return ; Copy an RT-11 file descriptor block addressed by %5 to the filename ; block associated with the FDB addressed by %0. %5 is advanced to the ; word after the RT-11 block. Also set up directory-ID for OFNB$x. ; Entry point ISETFN is used when %5 points to the address of the filename. ; Exit with device status word (from DEVTAB) in %3, %5 updated past name, all ; other registers preserved. ALIGN ISETFN: MOV @%5,%5 ; Get address of old filename SETFNB: MOV %2,-(SP) ; Save registers MOV %1,-(SP) MOV (%5)+,%1 ; Get device/unit no JSR PC,DEV ; Check device exists BCS 30$ ; Give up if not SEC ; Set error flag BVS 30$ ; in case unit no too big MOV D.ASCI(%1),F.FNB+N.DVNM(%0) ; If OK, copy ASCII device name CMP (%1)+,#^RLP ; ; But is device LP:? BNE 10$ ; No, continue copying filename MOV #"SY,F.FNB+N.DVNM(%0) ; Yes, spool via SY: CLR %2 ; Unit 0 ADD #6,%5 ; Get RT-11 block pointer right MOV %5,-(SP) ; and save it MOV #RT11LP,%5 ; Point to "RT11LP.LST" filename 10$: MOV @%1,%3 ; Return status word in %3 MOV %2,F.FNB+N.UNIT(%0) ; Put in unit number MOV %0,%1 ; Copy FDB pointer ADD #F.FNB+N.FNAM,%1 ; Point to filename MOV (%5)+,(%1)+ ; Copy filename MOV (%5)+,(%1)+ ; of two words CLR (%1)+ ; (Third must be blank) MOV (%5)+,(%1)+ ; Put in file type CLR @%1 ; Zero version number SUB #N.FVER,%1 ; Point %1 to filename block (%0 -> FDB still) JSR PC,.GTDID ; Set up default directory CMP %5,#RT11LP+6 ; Did we change file to "RT11LP.LST"? BNE 20$ ; No, just exit MOV (SP)+,%5 ; Yes, reload user file pointer 20$: CCC ; Clear flags after CMP 30$: MOV (SP)+,%1 ; Restore %1 MOV (SP)+,%2 ; and %2 ; Reset FDB for normal simulator usage. (Entries may be destroyed by previous use. FDAT$R ,#R.FIX,#0,#512. ; 512. byte records, embedded carriage-control FDRC$R ,#FD.RWM ; with no PUT$/GET$ buffering MOVB #1,L.BKST(%0) ; Set no I/O pending flag in status block for .WAIT RTS PC ; and exit RT11LP: .RAD50 /RT11LPLST/ ; Filename for LP: simulator ; Close all files and set %0->FDB0. ALIGN CLSALL: MOV #FDB0+>,%0 ; Address last file+1 MOV %1,-(SP) ; Save %1 MOV #CHANS+1,%1 ; as counter 10$: SUB #FILSPC,%0 ; Address next FDB down CLOSE$ ; Close file (if open) 20$: SOB %1,10$ ; Keep closing MOV (SP)+,%1 ; Restore %1 when all done RTS PC ; and exit ; Look up device in tables. ; On entry: ; %1 = radix-50 device name ; On exit: ; carry is set if device is not present. ; carry is clear if device is found, and ; %1 -> table entry, ; %2 = unit number ; V is set if unit number is above allowed maximum. ; Map device "TT " (but not "TT0") to TI: ALIGN DEV: CMP %1,#^RTT ; ; Is device "TT "? BNE 5$ ; Branch if not MOV #TIINF,%1 ; Map it to TI: if it is CLR %2 ; Unit 0, carry=V=0=success BR 60$ ; Exit 5$: MOV %0,-(SP) ; Save %0 CLR %0 ; Clear hi word DIV #50,%0 ; Remove unit number from Radix-50 name MOV %1,%2 ; Put unit no in %2 BEQ 10$ ; Radix-50 space is 0, unit no is right SUB #^R 0,%2 ; Otherwise, remove unit No 10$: MUL #50,%0 ; Put device name alone back in %0 MOV %1,%0 ; Copy to %0 MOV #DEVTAB,%1 ; Address device table 20$: TST @%1 ; End of table? SEC ; Set error flag in case BEQ 30$ ; Exit if so CMP %0,@%1 ; Found entry? BEQ 30$ ; Exit search if so ADD #D.ESIZ,%1 ; Point to next entry if not BR 20$ ; and keep looking 30$: MOV (SP)+,%0 ; Found, or end of table, restore %0 BCS 60$ ; Exit, carry set, if end of table CMP %2,D.MAXU(%1) ; Check unit number BLOS 50$ ; Exit if OK SEV ; Set V if too high 50$: CLC ; But clear carry to say device found 60$: RTS PC ; Return ; See if character in %1 is UC alphanumeric, returning carry set if so, clear if not. ALIGN ALPHAN: CMPB %1,#'Z ; Too big? BHI NOTIN ; Yes, answer no CMPB %1,#'A ; Too small? BHIS IN ; No, say in range ; Enter here to just test for decimal digit. NUMERC: CMPB %1,#'0 ; Too small? BLO NOTIN ; Yes, answer no CMPB %1,#'9 ; Too big? BLOS IN ; No, in range NOTIN: TST (PC)+ ; Clear carry (skips SEC) if not IN: SEC ; Set carry if in range RTS PC ; General-purpose I/O AST handler, called when a .READC or .WRITE request ; completes. The top word of the stack contains the address of the I/O status ; block for the appropriate FDB, which is just below the FDB itself, see ; DEFFIL macro. ; ; This routine sets up %0 as expected by RT-11, calls the user's routine, ; which is next to the status block, and cleans up on exit. ; .IF DF SJ ; In the single-job monitor, completion routines can interrupt one another, ; so we have to exit the AST immediately. Re-arrange the stack so that we ; call the user's routine on the ASTX$S, leaving data for an RTI above it, ; to be executed on return from the completion routine: ; ; Old stack New stack ; 20 event flags mainline PS } for final RTI from this code ; 16 mainline PS mainline PC } ; 14 mainline PC mainline %0 } restored on return from comp routine ; 12 $DSW mainline %1 } ; 10 stat blk adr 25$ for RTS PC from user's completion routine ; 6 event flags } ; 4 mainline PS } for ASTX$S to ; 2 comp addr } user's completion routine addr ; 0 $DSW } IOAST: SUB #8.,SP ; Make stack room MOV 20(SP),6(SP) ; Copy down AST return block: flags, MOV 16(SP),4(SP) ; Mainline PS MOV 16(SP),20(SP) ; also needed on return MOV 14(SP),16(SP) ; Mainline PC for final return MOV 12(SP),@SP ; $DSW MOV %1,12(SP) ; Save %1 MOV %0,14(SP) ; and %0 MOV 10(SP),%1 ; Fetch I/O status block address MOV #25$,10(SP) ; Put in completion routine return address .ENDC .IF DF FB!XM ; For the FB and XM monitors, completion routines are serial, so don't exit the ; AST until return for the user's completion routine. IOAST: MOV %1,-(SP) ; Save %1 MOV 2(SP),%1 ; Get I/O status block address into it MOV %0,2(SP) ; Save %0 MOV SP,CMPLET ; Flag in completion routine & save SP for possible SPCPS .ENDC CLR %0 ; Set up channel control word in %0 TSTB @%1 ; Any errors? BPL 20$ ; No, just return 0 CMPB @%1,#IE.EOF ; Yes, EOF? BNE 10$ ; No, other errors set bit 12 INC %0 ; EOF sets bit 0 BR 20$ 10$: BIS #BIT12,%0 20$: .IIF DF SJ, MOV -(%1),2(SP) ; Make completion routine the AST "return addr" .IIF DF FB!XM, MOV -(%1),-(SP) ; Push user completion routine address MOVB FDB0-COMP0+F.LUN(%1),%1 ; Load channel number = RSX LUN no DEC %1 ; -1 .IIF DF SJ, ASTX$S ; Return from AST to user's completion routine .IIF DF FB!XM, JSR PC,@(SP)+ ; Call user's completion routine as co-routine MOV (SP)+,%1 ; Restore registers MOV (SP)+,%0 ; used within completion routine .IIF DF SJ,25$: RTI ; Exit to caller .IF DF FB!XM CLR CMPLET ; Clear completion routine flag ASTX$S ; Exit AST .ENDC ; Fetch device size from GLUN info word 4, pointing %1 to stored value, for ; .DSTAT and .SPFUN 373 DEVSIZ: MOVB F.LUN(%0),GLUN+G.LULU ; Load LUN no DIR$ #GLUN ; Fetch LUN info MOV #OUTSPC+8.,%1 ; Point to device size lo word RTS PC ; and return ; Convert up to three characters from ASCII to Radix-50. On exit: ; %0 addresses the character after the terminator ; %1 contains the Radix-50 value ; %2 contains the terminator. If 3 chars were converted, ; this is the character addressed by %0. If less, this is ; the non-Radix-50 character which stopped conversion. ALIGN CAT5: CLR %1 ; Clear to stop on '.' JSR PC,$CAT5 ; Call Syslib routine BCS 10$ ; %2 is OK if <3 chars converted MOV %1,-(SP) ; If not, save the value MOVB (%0)+,%1 ; and get the next char JSR PC,ALPHAN ; See if this is alphanumeric SBC %0 ; If so, point back at it (2nd half of filename?) MOVB %1,%2 ; Copy terminator anyway MOV (SP)+,%1 ; Restore the value 10$: RTS PC ; Return ; Split time double-word in %1(hi), and %2(lo) into hours/minutes/sec/ticks, in ; GTIM$-compatible buffer. DIVTIM: MOV #OUTSPC+G.TICP,%3 ; Address tics/sec MOV @%3,%0 ; Load as divisor ; Note: $DDIV must be used for the first divide, since the result can be ; double-precision -- 24*60*60=86400. Thereafter, can use DIVs. JSR PC,$DDIV ; Divide to give secs MOV %0,-(%3) ; Remainder is odd ticks, store it MOV %1,%0 ; Copy secs hi MOV %2,%1 ; and lo DIV #60.,%0 ; Compute minutes, MOV %1,-(%3) ; storing odd seconds MOV %0,%1 ; Copy quotient CLR %0 ; Now single-precision DIV #60.,%0 ; Divide again MOV %1,-(%3) ; Remainder is minutes MOV %0,-(%3) ; Quotient is hours RTS PC ; Return .IF GE RTVRSN-50 ; Split date into year/month/day in OUTSPC+G.TIYR ff. RT-11 format date is ; supplied in %4, as: month(bits 13-10), day(9-5), year(4-0) DIVDAT: MOV #OUTSPC+G.TIYR,%3 ; Point to RSX year MOV %4,@%3 ; Store year BIC #^C^B11111,@%3 ; From lo 5 bits ADD #72.,(%3)+ ; RSX is relative to 1900, RT to 1972 ASH #-5,%4 ; Shift down day MOV %4,-(SP) ; Store it on stack temporarily BIC #^C^B11111,@SP ; from old bits 5-9 ASH #-5,%4 ; Get month from bits 13-10 (14&15 clear) MOV %4,(%3)+ ; Store it in 2nd RSX word MOV (SP)+,(%3)+ ; and day in 3rd RTS PC ; Return .ENDC ; Fetch a device name from the filename block of the FDB addressed by %0, ; and store it as a Radix-50 word where %5 points. %0 and %1 and the first ; 3 bytes of OUTSPC are destroyed. R50NAM: MOV #OUTSPC,%1 ; Address a buffer MOV F.FNB+N.DVNM(%0),(%1)+ ; for ASCII device name MOVB F.FNB+N.UNIT(%0),@%1 ; and unit number BISB #'0,@%1 ; Convert unit no to ASCII MOV #OUTSPC,%0 ; Address buffer space CLR %1 ; No '.'s JSR PC,$CAT5 ; in ASCII-Radix-50 conversion MOV %1,@%5 ; Store device name RTS PC ; and return .IF DF P$$OFF ; Convert 3 Radix-50 chars addressed by %3 to ASCII where %0 points, unless ; 0, when do nothing. %3 is always advanced, %0 if required. Return with z ; set if @%3 was 0, else clear, indicating whether anything was stored. ; Called by .CHAIN processor only. C5TA: MOV (%3)+,%1 ; Get Radix-50 value BEQ 10$ ; Just return with z set if all spaces JSR PC,$C5TA ; Else convert to ASCII 5$: CMPB -(%0),#<' > ; Trailing space? BEQ 5$ ; Yes, trim it off INC %0 ; No, keep char, (clears z) 10$: RTS PC ; Exit .ENDC ; Convert value in %0 to an unsigned 6-digit octal number in OCTADR. CBOMG: MOV #OCTADR+1,%0 ; Address place in string (past leading space) MOV SP,%2 ; Set %2<>0 to print leading zeroes JMP $CBOMG ; Insert 6 digits in string and return ; Convert lower-case letter in %0 to upper-case if necessary. UPPER: CMPB %0,#'a ; Yes, do we have a lower-case character? BLO 10$ ; No, keep unchanged CMPB %0,#'z ; Maybe, but is it in range a-z? BHI 10$ ; Don't convert { etc BICB #40,%0 ; Strip LC bit from anything else 10$: RTS PC ; Return with char ; Number fetch routines, called by CSIxxx only. ; Get an unsigned number from where %0 points. Could be in octal or decimal. ; Decimal is indicated by a trailing '.'. ALIGN GETNUM: MOV %0,-(SP) ; Save string pointer JSR PC,CDTB ; Try decimal conversion routine BCC 20$ ; Decimal if it ended '.' MOV @SP,%0 ; Not decimal, point back to start of no JSR PC,$COTB ; and try octal (error detected by caller) 20$: TST (SP)+ ; Finished with start pointer RTS PC ; Return ; Get a {possibly} signed decimal number, with or without trailing '.'. CSDTB: CLR -(SP) ; Clear sign flag CMPB (%0)+,#'+ ; Check for '+' BEQ 10$ ; Ignore if it is CMPB -(%0),#'- ; Check for '-', pointing back to 1st char BNE 10$ ; Branch if not MOVB (%0)+,@SP ; Set flag and skip '-' if it is 10$: JSR PC,CDTB ; Get number, skipping optional '.' TST (SP)+ ; -ve? BEQ 20$ ; No, return NEG %1 ; Yes, negate 20$: RTS PC ; Fetch a (supposed) decimal number, skipping trailing '.' if there is one. ; Clear carry if there is a '.', set it if not. CDTB: JSR PC,$CDTB ; Try decimal conversion routine CMPB %2,#'. ; Was the terminator '.'? BNE 10$ ; No, must be octal MOVB (%0)+,%2 ; Yes, skip '.' & return next char TST (PC)+ ; Clear carry, and skip SEC 10$: SEC ; Set carry if no '.' RTS PC ; Return anyway .PSECT $RMON,RW,D MONEND=. ; Max address for .GVAL/.PVAL .PSECT $$RT11,RO,I ENDRT: .END ; of simulator code