.TITLE RCV -- Receive queue list task .IDENT -V2.0d- .ENABL MCL ;+ ; This task will list the contence of the receive queues ; for a specified task in various formats ; ; First idea by: ; I.F.E.M. HOLTZ, UNILEVER ENG.DIV. I.C.A. ; VLAARDINGEN-HOLLAND, DATE 4-NOV-81 ; ; Futher development: ; J.H. Hamakers, Asea Brown Boveri ; Rotterdam, Netherlands, 22-Feb-82 ; ; assemble: ; ; MAC RCV,RVC/-SP=LB:[1,1]EXEMC/ML,[11,10]RSXMC/PA:1,[UIC]RCV ; ; task build: ; ; RCV/CP/PR/-FP,RCV/-SP=RCV ; LB:[1,1]EXELIB/LB ; LB:[1,54]RSX11M.STB/SS ; / ; STACK=10 ; UNITS=1 ; ASG=TI:1 ; TASK=...RCV ; PRI=200 ; // ;- ; editted: ; ; 3-Aug-84 JHA02 Changed MXPACK to 100. ; ; 3-Aug-84 JHA03 Allow 2 character switches ; ; 15-Jun-87 JHA04 Added Receive by reference ; Overall changes and improvements ; ; 7-Dec-87 JHA05 Add exit with status, fix /AL/DE bug ; Fix deletion bug for a certain ref. ; packet ; 2-Feb-88 JHA06 Show space as "sp" and 177 as "del" ; ; 8-Aug-88 JHA07 Include $QRMVA routine to let it work ; in older systems as well ; .SBTTL MACRO -- Macro definitions ; .MACRO SHOW MSG MOV #'MSG',WRITE+Q.IOPL ; MOV #'MSG'L,WRITE+Q.IOPL+2 DIR$ #WRITE ; .ENDM ; .MACRO SPACE NUM .IF B MOVB #40,(R0)+ .IFF .REPT NUM MOVB #40,(R0)+ .ENDR .ENDC .ENDM .SBTTL EQU -- Some equated symbols ; LF = 12 CR = 15 ESC = 33 MXPACK = 100. ; max # of packets ; .SBTTL DATA -- Some data areas ; .NLIST BEX ; ; DATBUF: .BLKW MXPACK*17. ; Receive data structure USEBUF =DATBUF+MXPACK ; Region databuffer USESIZ =<.-USEBUF>/2 ; Databuffer size in words ; ; TXT: .BLKB 82. ; Output text buffer TXTL= .-TXT ; TARTCB: 0 ; Target task TCB TSKNAM: .BLKW 2 ; Taskname ; EXSTAT: EX$SUC ; Exit status ;JHA05 ACTSIZ: 0 ; Actual region data size BIT7: 0 ; Bit 7 flag NUMBER: 0 ; Pakket number PCKCNT: 0 ; Number of packets ROUTIN: 0 ; User state routine ERROR: 0 ; Error type RE.SWC = 1 ; Switch combination error RE.DEL = 2 ; Deletion error ; TYPSAV: 0 ; Temporary save TYPDEF: 0 ; Defaults TYPE: 0 ; Status bits ; TP.WOR = 1 ; - /WO word TP.BYT = 2 ; - /BY byte TP.ASC = 4 ; - /AS ascii TP.RAD = 10 ; - /RA rad50 TP.FRM = 17 ; - Format bits ; TP.DEC = 20 ; - /DC decimal TP.OCT = 40 ; - /OC octal TP.RDX = 60 ; - Radix bits TP.REF = 100 ; - /RR Reference packets TP.NOR = 200 ; - /RD Normal packet TP.ALL = 400 ; - /AL All packets TP.TYP = 700 ; - Type bits ; TP.NUM = 1000 ; - /PA a certain packet ; TP.DFT = 242 ; - Defaults TP.SWI = 1777 ; - Switch bits ; TP.HLP = 2000 ; - /HE or ? Help requested TP.DEL = 4000 ; - /DE Deletion requested TP.MSG = 10000 ; - /NM Deletion requested, No query ; TP.MOR = 20000 ; - more data in region TP.REG = 40000 ; - region data being processed TP.RFN = 100000 ; - a certain reference packet ; .SBTTL MSG -- Messages ; MSG1: .ASCII /RCV -- Command syntax error/ MSG1L= .-MSG1 ; MSG2: .ASCII /RCV -- Task not in system/ MSG2L= .-MSG2 ; MSG31: .ASCII /RCV -- No normal data queued/ MSG31L= .-MSG31 ; MSG32: .ASCII /RCV -- No reference data queued/ MSG32L= .-MSG32 ; MSG4: .ASCII /RCV -- More packets queued/ MSG4L= .-MSG4 ; MSG5: .ASCII / Data :/ MSG5L= .-MSG5 ; MSG6: .ASCII /RCV -- More data in region/ MSG6L= .-MSG6 ; MSG7: .ASCII ~RCV -- Examine send/receive packets~ .ASCII .ASCII ~ >RCV task/sw1..../swn~ .ASCII .ASCII ~ /HE or ? Display HELP text~ .ASCII .ASCII ~ /BY /OC,/DC Display octal/decimal bytes~ .ASCII .ASCII ~ /WO /OC,/DC Display octal/decimalwords~ .ASCII .ASCII ~ /RA Display RAD50 words ~ .ASCII .ASCII ~ /AS Display ASCII bytes~ .ASCII .ASCII ~ /AL Display All packets~ .ASCII .ASCII ~ /RD Display Normal packets~ .ASCII .ASCII ~ /RR Display Send by Reference packets~ .ASCII .ASCII ~ /DE Delete packets~ .ASCII .ASCII ~ /NM No query with delete packets~ .ASCII .ASCII ~ /PA:n Display only packet n~ .ASCII .ASCII ~ Default switches : /BY /OC /RD~ .ASCII .ASCII ~ / Receive with previous task an switch data~ .ASCII .ASCII ~ // or ^Z Exit RCV~ MSG7l=.-MSG7 ; MSG8: .ASCII /RCV -- Switch combination error/ MSG8L= .-MSG8 ; MSG9: .ASCII /RCV -- No taskname specified/ MSG9L= .-MSG9 ; MSG10: .ASCII \RCV -- Delete, are you shure [Y/N] ? \ MSG10L= .-MSG10 ; MSG11: .ASCII \RCV -- Deletion error\ MSG11L= .-MSG11 ; MSG12: .ASCII \RCV -- Indirect commandfile open or read error\ MSG12L= .-MSG12 .EVEN ; ; .SBTTL DPB -- DPB definitions ; WRITE: QIOW$ IO.WVB,1,1,,,, ; GCLBLK: GCMLB$ 1,RCV,,2 ; FSRSZ$ 1 ; FSR size ( for prompting ) ; ASCTAB: .ASCII "nul" .ASCII "soh" .ASCII "stx" .ASCII "etx" .ASCII "eot" .ASCII "enq" .ASCII "ack" .ASCII "bel" .ASCII "bs " .ASCII "ht " .ASCII "lf " .ASCII "vt " .ASCII "ff " .ASCII "cr " .ASCII "so " .ASCII "si " .ASCII "dle" .ASCII "dc1" .ASCII "dc2" .ASCII "dc3" .ASCII "dc4" .ASCII "nak" .ASCII "syn" .ASCII "etb" .ASCII "can" .ASCII "em " .ASCII "sub" .ASCII "esc" .ASCII "fs " .ASCII "gs " .ASCII "rs " .ASCII "us " .ASCII "sp " ;JHA06 .ASCII "del" ;JHA06 .EVEN .SBTTL PARSE -- Parse tables ; ISTAT$ STAT,KEY ; STATE$ PSTART TRAN$ '? ,$EXIT , ,TP.HLP ,TYPE ; ? TRAN$ '/ ,SWIT0 ; /... TRAN$ $RAD50 ,SWITCH ,TSKSAV ; task... STATE$ SWITCH TRAN$ '/ ,SWIT1 ; ..../... TRAN$ $EOS ,$EXIT ,SWPRO6 ; .... STATE$ SWIT0 TRAN$ '/ ,$EXIT ,EXIT ; // TRAN$ $EOS ,$EXIT ,SWPRO6 ; / TRAN$ $LAMDA ,SWIT1 ; /... STATE$ SWIT1 TRAN$ "BY" ,SWITCH ,SWPRO1 ,TP.BYT ,TYPE ; /BY TRAN$ "WO" ,SWITCH ,SWPRO1 ,TP.WOR ,TYPE ; /WO TRAN$ "OC" ,SWITCH ,SWPRO2 ,TP.OCT ,TYPE ; /OC TRAN$ "DC" ,SWITCH ,SWPRO2 ,TP.DEC ,TYPE ; /DC TRAN$ "AS" ,SWITCH ,SWPRO3 ,TP.ASC ,TYPE ; /AS TRAN$ "RA" ,SWITCH ,SWPRO3 ,TP.RAD ,TYPE ; /RA TRAN$ "RD" ,SWITCH ,SWPRO4 ,TP.NOR ,TYPE ; /RD TRAN$ "RR" ,SWITCH ,SWPRO4 ,TP.REF ,TYPE ; /RR TRAN$ "AL" ,SWITCH ,SWPRO5 ,TP.ALL ,TYPE ; /AL TRAN$ "DE" ,SWITCH , ,TP.DEL ,TYPE ; /DE TRAN$ "NM" ,SWITCH , ,TP.MSG ,TYPE ; /NM TRAN$ "PA" ,SWIT2 ,SWPRO5 ,TP.NUM ,TYPE ; /PA... TRAN$ "HE" ,$EXIT , ,TP.HLP ,TYPE ; /HE STATE$ SWIT2 TRAN$ ': ,SWIT3 ; /PA:... STATE$ SWIT3 TRAN$ $DNUMB ,SWITCH ,NUMSAV ; /PA:nnn STATE$ END .SBTTL NUMSAV -- Save number ; NUMSAV: MOV .PNUMB,NUMBER ; Save packet number BEQ REJECT ; Reject if "0" RETURN ; .SBTTL SWPROC -- Switch processors ; .SBTTL SWPRO1 -- Switch processor BY,WO ; SWPRO1: BIT #TP.FRM,TYPE ; Format specified ? BNE SWERR ; Yes : => SWERR RETURN ; ; .SBTTL SWPRO2 -- Switch processor OC,DC ; SWPRO2: BIT #TP.RDX!TP.ASC!TP.RAD,TYPE ; Radix, /AS or /RA specified ? BNE SWERR ; Yes : => SWERR RETURN ; ; .SBTTL SWPRO3 -- Switch processor AS,RA ; SWPRO3: BIT #TP.FRM!TP.RDX,TYPE ; Radix or Format specified ? BNE SWERR ; Yes : => SWERR RETURN ; ; .SBTTL SWPRO4 -- Switch processor SD,SR ; SWPRO4: BIT #TP.TYP,TYPE ; Type specified ? BNE SWERR ; Yes : => SWERR RETURN ; ; .SBTTL SWPRO5 -- Switch processor AL,PA ; SWPRO5: BIT #TP.ALL!TP.NUM,TYPE ; /AL or /PA specified ? BNE SWERR ; Yes : => SWERR RETURN ; ; .SBTTL SWPRO6 -- Switch processor Defaults ; SWPRO6: BIT #TP.SWI,TYPE ; Switches specified ? BNE 10$ ; Yes : => 10$ BIS TYPDEF,TYPE ; Take default BR 60$ ; => 60$ 10$: BIT #TP.NUM,TYPE ; Packet number specified? BEQ 20$ ; No : => 20$ BIT #TP.ALL,TYPDEF ; /AL in default ? BEQ 20$ ; No : => 20$ BIC #TP.ALL,TYPDEF ; Clear it BIS #TP.NOR,TYPDEF ; Take normal as default 20$: BIT #TP.TYP,TYPE ; Packet type defined ? BNE 30$ ; Yes : => 30$ MOV TYPDEF,R0 ; Take default BIC #^C TP.TYP,R0 ; Mask type bits BIS R0,TYPE ; Insert packettype bits BR 40$ ; => 40$ 30$: BIC #TP.NUM,TYPDEF ; Type bit specified, clear /PA bit 40$: MOV TYPDEF,R0 ; Take default BIC #^C TP.NUM,R0 ; Mask TP.NUM bit BIS R0,TYPE ; Insert form bits ; BIT #TP.FRM,TYPE ; RAD50, ASCII, BYTE or WORD ? BNE 50$ ; Yes : => 50$ MOV TYPDEF,R0 ; Take default BIC #^C TP.FRM,R0 ; Mask format bits BIS R0,TYPE ; Insert form bits 50$: BIT #TP.RDX,TYPE ; OCTAL or DECIMAL ? BNE 60$ ; Yes : => 60$ MOV TYPDEF,R0 ; Take default BIC #^C TP.RDX,R0 ; Mask radix bits BIS R0,TYPE ; Insert radix bits 60$: BIT #TP.MSG,TYPE ; /NM ? BEQ 70$ ; No : => 70$ BIT #TP.MSG,TYPE ; /DE ? BEQ SWERR ; Yes : => SWERR 70$: RETURN ; ; SWERR: MOV #RE.SWC,ERROR ; Switch combination error CALLR REJECT ; ; .SBTTL TSKSAV -- Save taskname ; TSKSAV: CMP .PSTCN,#6. ; Test length BHI REJECT ; CLR TSKNAM+2 ; 2nd word = 0 MOV #1,R1 ; Allow "..." MOV .PSTPT,R0 ; R0 => String CALL $CAT5 ; Convert MOV R1,TSKNAM ; Taskname BCS 10$ ; MOV #1,R1 ; Allow "..." CALL $CAT5 ; Convert MOV R1,TSKNAM+2 ; Taskname 10$: RETURN ; ; REJECT: ADD #2,(SP) ; Reject RETURN ; .SBTTL MAIN -- Main program ; START: FINIT$ ; Init FSR MOV #TP.DFT,TYPDEF ; Set default BR RESTR1 ; => RESTRT: BIC #^C TP.SWI,TYPE ; Clear all but switches MOV TYPE,TYPDEF ; Save for default CLR TYPE ; Clear old switches RESTR1: CLR ERROR ; Clear pending error GCML$ #GCLBLK ; Get commandline BCC PARSE ; Ok => PARSE CMPB GCLBLK+G.ERR,#GE.EOF BEQ EXIT ; End of file => Exit MOV #EX$SEV,EXSTAT ; Severe error ;JHA05 SHOW MSG12 ; Cmdfile error EXIT: EXST$S EXSTAT ; Exit with status ;JHA05 PARSE: MOV #1,R1 ; Do not suppress blanks MOV #KEY,R2 ; R2 => Key table MOV G.CMLD (R0),R3 ; R3 = Length BEQ RESTR1 ; Empty line ? => RESTR1 MOV G.CMLD+2(R0),R4 ; R4 = Address MOV R4,R5 ; R5 => Start ADD R3,R5 ; R5 => end CLRB (R5) ; EOS MOV #STAT,R5 ; R5 => State table CALL .TPARS ; Parse MOV ERROR,R0 ; Error code ? BNE 20$ ; Yes : => 20$ BCC 30$ ; OK => 30$ 10$: MOV #EX$ERR,EXSTAT ; Error ;JHA05 SHOW MSG1 ; Syntax BR RESTR1 ; Restart 20$: CMP R0,#RE.SWC ; Switch combination ? BNE 10$ ; No : => 10$ MOV #EX$ERR,EXSTAT ; Error ;JHA05 SHOW MSG8 ; Switch combination BR RESTR1 ; Restart 30$: BIT #TP.HLP,TYPE ; Help ? BEQ 40$ ; No : => 40$ SHOW MSG7 ; Help text BIC #TP.HLP,TYPE ; Clear Help bit BR RESTR1 ; Restart 40$: TST TSKNAM ; Task specified ? BNE 50$ ; Yes : => 50$ MOV #EX$ERR,EXSTAT ; Error ;JHA05 SHOW MSG9 ; No taskname BR RESTR1 ; Restart 50$: .SBTTL SYSTEM -- Sytemstate routines ; SYSTEM: CALL $SWSTK,USER ;; Switch to system state 10$: MOV $TSKHD,R5 ;; R5 => STD 20$: CMP TSKNAM,T.NAM(R5);; Taskname ok BNE 30$ ;; Br if not CMP TSKNAM+2,T.NAM+2(R5) ;; Taskname ok BEQ 50$ ;; Get data if ok 30$: MOV T.TCBL(R5),R5 ;; Point next tcb TST T.TCBL(R5) ;; Nul task ? BNE 20$ ;; No : Keep searching TST TSKNAM+2 ;; Try ...tsk ? BNE 40$ ;; Br if not posible MOV TSKNAM,TSKNAM+2 ;; Set task name over MOV #^R...,TSKNAM ;; And try ...tsk BR 10$ ;; Try it 40$: MOV #ERROU,ROUTIN ;; Notify error BR 180$ ;; Exit 50$: MOV R5,TARTCB ;; Save target TCB address MOV #DATBUF,R0 ;; R0 => data MOV #1,R2 ;; R2 = counter MOV T.RCVL(R5),R1 ;; R1 => RCV packets BIT #TP.REF,TYPE ;; REF ? BEQ 60$ ;; No : => 60$ MOV T.RRFL(R5),R1 ;; R1 => RREF packets 60$: TST R1 ;; Any packet ? BNE 70$ ;; If not empty get them MOV #NODAT,ROUTIN ;; Set no data adres BR 180$ ;; And return ; ; Process packets ; 70$: MOV R1,R3 ;; Get a copy of packet pointer MOV (R3)+,R1 ;; Get next pointer BIT #TP.NUM,TYPE ;; A certain packet ? BEQ 80$ ;; No : all CMP R2,NUMBER ;; This pakket ? BNE 160$ ;; No : 80$: CMP R2,#MXPACK ;; Still room ? BGT 170$ ;; No BIT #TP.REF,TYPE ;; REF ? BEQ 140$ ;; No : => 140$ ; .SBTTL REF -- Reference packets ; ; Data strucktures Send/Receive by reference packets ; ================================================== ; ; Packet in queue Attachment Descr Block PCB ; ; +-----------------+ +-----------------+ +-----------------+ ; | Link pointer | +->| A.PCBL | +->| P.LNK | ; +-----------------+ | +--------+--------+ | +--------+--------+ ; | Sendertask TCB | | | A.IOC | A.PRI | | | P.IOC | P.PRI | ; +-----------------+ | +--------+--------+ | +--------+--------+ ; | * Sender - | | | A.TCB | | | * P.NAM | ; |- - - - - - - - -| | +-----------------+ | | - - - - - - - - | ; | * taskname | | | A.TCBL | | | * | ; +-----------------+ | +--------+--------+ | +-----------------+ ; | Region ID |----+ | A.CNT | A.STS | | | P.SUB | ; +-----------------+ +--------+--------+ | +-----------------+ ; | * Region offset | | A.PCB |----+ | P.MAIN | ; +-----------------+ +-----------------+ +-----------------+ ; | * Region length | | * P.REL | ; +-----------------+ +-----------------+ ; | * Status | | * P.SIZE | ; +-----------------+ +-----------------+ ; | * 8 words data | | | ; \ \ ; | | ; +-----------------+ * = copied to databufferpacket ; ; ; Packet in databuffer ; formed by following ; routine ; ; +-----------------+ Main memory ; | Sender - | | ; |- - - - - - - - -| | ; | taskname | | ; +-----------------+ | ; | Partition - | | ; |- - - - - - - - -| +--------------->+------------------ ; | name | | | . ; +-----------------+ | | . ; | Relocation bias |----+ | . ; +-----------------+ | Partition ; | Partition size | +----------->+-------- Size ; +-----------------+ | | . . ; | Region offset |--------+ | Region . ; +-----------------+ | length . ; | Region length | | . . ; +-----------------+ +-------- . ; | Status | | . ; +-----------------+ | . ; | 8 words data | | . ; \ \ +------------------ ; | | | ; +-----------------+ ; ; When a certain Referencepacket is wanted the data ; from the region is copied in a userbuffer untill ; its maximum size. ; MOV (R3)+,R5 ;; R5 => TCB of sending task BEQ 90$ ;; 0 => 90$ MOV T.NAM(R5),(R0)+ ;; Task MOV T.NAM+2(R5),(R0)+;; name CMP (R3)+,(R3)+ ;; Point to ADB BR 100$ ;; 90$: MOV (R3)+,(R0)+ ;; Move MOV (R3)+,(R0)+ ;; taskname 100$: MOV (R3)+,R5 ;; R5 => ADB MOV A.PCB(R5),R5 ;; R5 => PCB MOV P.NAM(R5),(R0)+ ;; Partition MOV P.NAM+2(R5),(R0)+;; name MOV P.REL(R5),(R0)+ ;; Partition relocation bias MOV P.SIZE(R5),(R0)+;; Partition size MOV (R3)+,(R0)+ ;; Region offset MOV (R3)+,(R0)+ ;; Region length MOV (R3)+,(R0)+ ;; Status word BIT #TP.NUM,TYPE ;; A certain packet ? BEQ 130$ ;; No : => 130$ ; ; Copy region data to userbuffer ; Use APR6 to map the region ; Use R1,R2 and R3 to move the data ; ; MOV R1,-(SP) ;; + MOV R2,-(SP) ;; Save registers MOV R3,-(SP) ;; - MOV P.REL(R5),KISAR6;; Map region MOV #140000,R1 ;; Relocate to APR6 MOV #USEBUF,R2 ;; R2 => Userbuffer MOV -6(R0),R3 ;; R3 = offset ASH #6.,R3 ;; Adjust for bytes ADD R3,R1 ;; Add offset MOV -4(R0),R3 ;; R3 = Length ASH #5.,R3 ;; Adjust for words CMP R3,#USESIZ ;; Does it fit ? BLOS 110$ ;; Yes : => 110$ MOV #USESIZ,R3 ;; Use maximum BIS #TP.MOR,TYPE ;; Mark more data 110$: MOV R3,ACTSIZ ;; Save actual size 120$: MOV (R1)+,(R2)+ ;; Copy SOB R3,120$ ;; All ; MOV (SP)+,R3 ;; + MOV (SP)+,R2 ;; Restore registers MOV (SP)+,R1 ;; - 130$: ; ; Copy data words ; MOV #8.,R4 ;; Get count BR 150$ ;; Rest of packet .SBTTL COPY -- Copy packet data ; 140$: MOV #15.,R4 ;; Get count 150$: MOV (R3)+,(R0)+ ;; Move data over SOB R4,150$ ;; Get the whole send packet 160$: TST R1 ;; At last packet ? BEQ 170$ ;; Yes : => 170$ INC R2 ;; Count a packet BR 70$ ;; Next ; ; 170$: MOV R2,PCKCNT ;; Set as packet count MOV #DISPLA,ROUTIN ;; Set display adres 180$: RETURN ;; Back to user state ; .SBTTL USER -- Userstate routines ; USER: CALL @ROUTIN ; ; BIT #TP.ALL,TYPE ; All data ? BEQ 20$ ; No : => 20$ BIT #TP.REF,TYPE ; Done Ref ? BNE 10$ ; Yes : => 10$ CALL NEWLIN ; New line BIS #TP.REF,TYPE ; Set Ref JMP SYSTEM ; And process it 10$: BIC #TP.REF,TYPE ; Clear Ref 20$: BIT #TP.DEL,TYPE ; Delete ? BEQ 30$ ; No : => 30$ CALL DELETE ; Delete packet(s) BIT #TP.ALL,TYPE ; All data ? ;JHA05 BEQ 25$ ; No : => 25$ ;JHA05 BIS #TP.REF,TYPE ; Set Ref ;JHA05 CALL DELETE ; Delete packet(s) ;JHA05 BIC #TP.REF,TYPE ; Clear Ref ;JHA05 25$: ;JHA05 BIC #TP.DEL,TYPE ; Deletion done 30$: JMP RESTRT ; ; ERROU: MOV #EX$ERR,EXSTAT ; Error ;JHA05 SHOW MSG2 BR ENDMSG ; ; NODAT: MOV #EX$WAR,EXSTAT ; Warning ;JHA05 BIT #TP.REF,TYPE ; Ref data ? BNE 10$ ; Yes : => 10$ SHOW MSG31 BR ENDMSG ; 10$: SHOW MSG32 BIT #TP.ALL,TYPE ; All data ? BNE ENDMS1 ; Yes : => ENDMS1 ; ENDMSG: BIC #TP.DEL,TYPE ; No deletion ENDMS1: RETURN ; .SBTTL DISPLA -- Display routines ; DISPLA: BIT #TP.REF,TYPE ; A ref packet ? BEQ 10$ ; No : => 10$ BIT #TP.NUM,TYPE ; A certain packet ? BEQ 10$ ; No : => 10$ BIS #TP.RFN,TYPE ; A certain reference packet 10$: MOV #TXT,WRITE+Q.IOPL; Set adres MOV #DATBUF,R3 ; Point data MOV #1,R5 ; Use r5 to count packets DISPL1: MOV #TXT,R0 ; Point text MOV R5,R1 ; Get number BIT #TP.NUM,TYPE ; A certain packet ? BEQ 20$ ; No : => 20$ CMP NUMBER,PCKCNT ; BHI NODAT ; Not available packet MOV NUMBER,R1 ; 20$: MOV #13012,R2 ; Convert parms. CALL $CBTA ; Convert SPACE ; Set a space MOV (R3)+,R1 ; Get task name CALL $C5TA ; Convert MOV (R3)+,R1 ; Task name CALL $C5TA ; Convert SPACE 2 ; Set 2 spaces BIT #TP.REF,TYPE ; Reference packet ? BNE LSTREF ; Yes : => LSTREF JMP LSTPKT ; No : => LSTPKT .SBTTL LSTREF -- List ref packets ; LSTREF: ; MOVB #'P,(R0)+ ; Insert MOVB #'a,(R0)+ ; Insert MOVB #'r,(R0)+ ; Insert MOVB #'=,(R0)+ ; Insert MOV (R3)+,R1 ; Get Partition name CALL $C5TA ; Convert MOV (R3)+,R1 ; Partition name 2nd word CALL $C5TA ; Convert SPACE 1 ; Set space MOVB #'A,(R0)+ ; Insert MOVB #'d,(R0)+ ; Insert MOVB #'d,(R0)+ ; Insert MOVB #'=,(R0)+ ; Insert MOV (R3)+,R1 ; Relocation bias MOV #31010,R2 ; Convert octal CALL $CBTA ; Convert MOVB #'0,(R0)+ ; Insert MOVB #'0,(R0)+ ; zeroes SPACE ; Set a space MOVB #'S,(R0)+ ; Insert MOVB #'i,(R0)+ ; Insert MOVB #'z,(R0)+ ; Insert MOVB #'=,(R0)+ ; Insert MOV (R3)+,R1 ; Size MOV #21010,R2 ; Convert octal CALL $CBTA ; Convert MOVB #'0,(R0)+ ; Insert MOVB #'0,(R0)+ ; zeroes SPACE ; Set a space MOVB #'O,(R0)+ ; Insert MOVB #'f,(R0)+ ; Insert MOVB #'f,(R0)+ ; Insert MOVB #'=,(R0)+ ; Insert MOV (R3)+,R1 ; Offset ASH #6.,R1 ; Normalize MOV #31010,R2 ; Convert octal CALL $CBTA ; SPACE ; Set a space MOVB #'L,(R0)+ ; Insert MOVB #'e,(R0)+ ; Insert MOVB #'n,(R0)+ ; Insert MOVB #'=,(R0)+ ; Insert MOV (R3)+,R1 ; Size ASH #6.,R1 ; Normalize MOV #31010,R2 ; Convert octal CALL $CBTA ; SPACE ; Set space MOVB #'S,(R0)+ ; Insert MOVB #'t,(R0)+ ; Insert MOVB #'a,(R0)+ ; Insert MOVB #'=,(R0)+ ; Insert MOV (R3)+,R1 ; Status MOV #31010,R2 ; Convert octal CALL $CBTA ; CALL NEWLIN ; MOV #16.,R4 ; Remaining count BR LSTPK1 ; .SBTTL LSTPKT -- List DATA packets ; LSTPKT: MOV #26.,R4 ; Asume bytes LSTPK1: CLR -(SP) ; Element counter ; BIT #TP.RFN,TYPE ; A certain reference packet ? BNE WORD ; Yes : => WORD BIT #TP.BYT,TYPE ; Bytes ? BEQ ASCII ; No : => ASCII ; ; Octal and decimal bytes ..... ; 10$: MOVB (R3)+,R1 ; Get a byte BIC #177400,R1 ; No sign extension MOV #15010,R2 ; Set conversion type BIT #TP.DEC,TYPE ; Decimal ? BEQ 20$ ; No : => 20$ MOV #17012,R2 ; Convert decimal 20$: CALL $CBTA ; Convert SPACE ; Set a space BIT #TP.DEC,TYPE ; Decimal ? BEQ 30$ ; No : => 30$ MOVB #'.,-1(R0) ; Insert "." 30$: SPACE ; Set a space INC (SP) ; One more CMP (SP),#13. ; Done 13 bytes ? BNE 40$ ; No : => 40$ CLR (SP) ; Reset counter CALL NEWLIN ; 40$: SOB R4,10$ ; Do all JMP DONE ; And done .SBTTL ASCII -- List ASCII ; ASCII: BIT #TP.ASC,TYPE ; Ascii ? BEQ WORD ; No : => WORD 10$: CLR BIT7 ; Clear bit 7 flag BITB #200,(R3) ; Bit #7 set ? BEQ 20$ ; No : => 20$ INC BIT7 ; Set 20$: MOV R5,-(SP) ; Save R5 BICB #200,(R3) ; Clear bit #7 CLR R5 ; Clear R5 BISB (R3),R5 ; Take character CMP R5,#177 ; Delete ? ;JHA06 BNE 30$ ; No : => 30$ ;JHA06 MOV #41,R5 ; Replace ;JHA06 BR 40$ ; => 40$ ;JHA06 30$: CMP R5,#40 ; Visable ? ;JHA06 BHI 80$ ; Yes : => 80$ ;JHA06 40$: MOV R5,-(SP) ; + ASL R5 ; x 3 ADD (SP)+,R5 ; - MOVB ASCTAB(R5),(R0)+; Copy 1st char. TST BIT7 ; Mark bit 7 ? BEQ 50$ ; No : => 50$ BICB #40,-1(R0) ; Upcase 50$: MOVB ASCTAB+1(R5),(R0)+;Copy 2nd char. TST BIT7 ; Mark bit 7 ? BEQ 60$ ; No : => 60$ BICB #40,-1(R0) ; Upcase 60$: MOVB ASCTAB+2(R5),(R0)+;Copy 3rd char. CMPB ASCTAB+2(R5),#40; 3rd char. space ? BEQ 70$ ; Yes : => 70$ TST BIT7 ; Mark bit 7 ? BEQ 70$ ; No : => 70$ BICB #40,-1(R0) ; Upcase 70$: TSTB (R3)+ ; Skip the character BR 100$ ; => 100$ 80$: MOVB #' ,(R0)+ ; Space TST BIT7 ; Mark bit 7 ? BEQ 90$ ; No : => 90$ MOVB #'_,-1(R0) ; Underline 90$: MOVB (R3)+,(R0)+ ; Copy character SPACE ; Set a space 100$: MOV (SP)+,R5 ; Restore R5 SPACE 2 ; Set 2 spaces INC (SP) ; One more CMP (SP),#13. ; Done 13. Bytes ? BNE 110$ ; No : => 110$ CLR (SP) ; Reset counter CALL NEWLIN ; 110$: DEC R4 ; Last ? BEQ 120$ ; Yes : => 120$ JMP 10$ ; Loop back 120$: JMP DONE ; Done ; .SBTTL WORD -- List WORDS ; WORD: ASR R4 ; Make word count 10$: ; ; Octal, decimal and RAD50 words ; ============================== ; MOV (R3)+,R1 ; Get data ; BIT #TP.RFN,TYPE ; A certain reference packet ? BNE 50$ ; Yes : => 50$ BIT #TP.RAD,TYPE ; Radix50 ? BEQ 50$ ; No : => 50$ ; ; RAD50 ; SPACE 3 ; Set 3 spaces CALL $C5TA ; Convert CMPB -3(R0),#40 ; Space ? BNE 20$ ; No : => 20$ MOVB #'_,-3(R0) ; Insert "_" 20$: CMPB -2(R0),#40 ; Space ? BNE 30$ ; No : => 30$ MOVB #'_,-2(R0) ; Insert "_" 30$: CMPB -1(R0),#40 ; Space ? BNE 40$ ; No : => 40$ MOVB #'_,-1(R0) ; Insert "_" 40$: SPACE ; Set a space BR 70$ ; => 70$ ; ; Octal and decimal ; 50$: MOV #31010,R2 ; Asume octal BIT #TP.DEC,TYPE ; Decimal ? BEQ 60$ ; No : => 60$ MOV #33012,R2 ; Convert decimal 60$: CALL $CBTA ; Convert MOVB #' ,(R0)+ ; Insert space BIT #TP.DEC,TYPE ; Decimal ? BEQ 70$ ; No : => 70$ MOVB #'.,-1(R0) ; Insert "." 70$: SPACE ; Set a space INC (SP) ; One more CMP (SP),#8. ; Done 8 words ? 80$: BNE 90$ ; No : => 90$ CLR (SP) ; Reset counter CALL NEWLIN ; 90$: DEC R4 ; Last ? BEQ 100$ ; Yes : => 100$ JMP 10$ ; Loop back 100$: JMP DONE ; Done ; DONE: TST (SP)+ ; Pending output ? BEQ 10$ ; No : => 10$ CALL NEWLIN ; 10$: BIT #TP.NUM,TYPE ; One certain packet ? BNE 30$ ; Yes : => 30$ BIT #TP.REG,TYPE ; Region data ? BNE 30$ ; Yes : => 30$ CMP R5,PCKCNT ; Ready ? BEQ 30$ ; Yes : => 30$ INC R5 ; Count a packet CMP R5,#MXPACK ; Full ? BGT 20$ ; Yes : => 20$ JMP DISPL1 ; Next packet 20$: SHOW MSG4 30$: BIT #TP.RFN,TYPE ; A certain reference packet ? BEQ 40$ ; No : => 40$ MOV TYPE,TYPSAV ; Save typebits BIC #TP.NUM!TP.REF!TP.RFN,TYPE ; Clear bits BIC #^C ,TYPSAV ; Clear bits SHOW MSG5 BIS #TP.REG,TYPE ; Mark region data MOV #USEBUF,R3 ; Point to data MOV ACTSIZ,R4 ; Actual region datasize ASL R4 ; In bytes JMP LSTPK1 ; 40$: BIT #TP.REG,TYPE ; Region data ? BEQ 50$ ; No : => 50$ BIC #TP.REG,TYPE ; clear bit BIS TYPSAV,TYPE ; Set old bits back BIT #TP.MOR,TYPE ; Mode data ? BEQ 50$ ; No : => 50$ BIC #TP.MOR,TYPE ; clear bit SHOW MSG6 50$: RETURN ; .SBTTL NEWLIN -- Subroutine newline ; NEWLIN: SUB #TXT,R0 ; R0 = Length MOV R0,WRITE+Q.IOPL+2 MOV #TXT,WRITE+Q.IOPL DIR$ #WRITE ; MOV #TXT,R0 ; Point text SPACE 11. ; Set 3 spaces RETURN ; .SBTTL DELETE -- Subroutine Delete packet(s) ; DELETE: BIT #TP.MSG,TYPE ; Message ? BNE 10$ ; No : => 10$ MOV #'$,WRITE+Q.IOPL+4 ; Prompt SHOW MSG10 ; MOV #' ,WRITE+Q.IOPL+4 MRKT$S #1,#5,#2 ; Mark time 5 sec QIOW$S #IO.RVB,#1,#1,,,,<#TXT,#TXTL> CMKT$S #1 ; Cancel QIOW$S #IO.KIL,#1,#1 ; Kil pending I/O BICB #40,TXT ; Upcase CMPB TXT,#'Y ; Yes ? BNE 150$ ; No : => 150$ 10$: CALL $SWSTK,120$ ; MOV TARTCB,R0 ;; Target task TCB MOV #1,R4 ;; Counter BIT #TP.REF,TYPE ;; Ref packet ? BNE 50$ ;; Yes : => 50$ ; ; Delete normal packet(s) ; ADD #T.RCVL,R0 ;; R0 => Queue listhead MOV (R0),R1 ;; R1 => Packet 20$: TST R1 ;; Any packet ? BEQ 110$ ;; No => 110$ BIT #TP.NUM,TYPE ;; A certain packet ? BEQ 30$ ;; No : => 30$ CMP R4,NUMBER ;; This one ? BEQ 30$ ;; Yes : => 30$ MOV (R1),R1 ;; R1 => Next packet BR 40$ ;; => 30$: MOV (R1),-(SP) ;; Save next packet address MOV R0,-(SP) ;; Save list head pointer CALL $QRMVA ;; Dequeue packet BCS 100$ ;; ??? MOV R1,R0 ;; R0 => Packet CALL $DEPKT ;; Dealocate packet MOV (SP)+,R0 ;; Restore list head pointer MOV (SP)+,R1 ;; Restore packet address 40$: INC R4 ;; Next packet BR 20$ ;; => 20$ ; 50$: ; ; Delete reference packet(s) + detach region ; ADD #T.RRFL,R0 ;; R0 => Queue listhead MOV (R0),R1 ;; R1 => Packet 60$: TST R1 ;; Any packet ? BEQ 110$ ;; No => 110$ BIT #TP.NUM,TYPE ;; A certain packet ? BEQ 70$ ;; No : => 70$ CMP R4,NUMBER ;; This one ? BEQ 70$ ;; Yes : => 70$ MOV (R1),R1 ;; R1 => Next packet BR 90$ ;; => 70$: MOV (R1),-(SP) ;; Save next packet address MOV R0,-(SP) ;; Save list head pointer CALL $QRMVA ;; Dequeue packet ;JHA05 BCS 100$ ;; ??? ;JHA05 MOV R1,-(SP) ;; Save packet address ;JHA05 MOV 2(R1),R5 ;; R5 => Sender TCB BEQ 80$ ;; No TCB : => 80$ DECB T.SRCT(R5) ;; Decr. outstanding Send by REF packets MOV 4(R1),R0 ;; EFN Mask MOV 6(R1),R1 ;; EFN Address BEQ 80$ ;; No address : => 134$ CALL $SETMG ;; Set EFN and unlock if group global 80$: MOV (SP)+,R1 ;; Restore packet address ;JHA05 ;;;; MOV (SP),R0 ;; Queue listhead ;JHA05 ;;;; CALL $QRMVF ;; Dequeue first packet ;JHA05 MOV R1,R0 ;; R0 => Packet MOV 10(R1),R5 ;; R5 => ADP CALL $DEPKT ;; Dealocate packet CALL $DETRG ;; Detach region and delete MOV (SP)+,R0 ;; Restore list head pointer MOV (SP)+,R1 ;; Restore packet address 90$: INC R4 ;; Next packet BR 60$ ;; => 60$ ; ; ; 100$: MOV #RE.DEL,ERROR ;; Deletion error CMP (SP)+,(SP)+ ;; Clean stack ; 110$: RETURN ;; To user state ; ; User state ; 120$: CMP ERROR,#RE.DEL ; Deletion error ? BNE 130$ ; No : => 130$ MOV #EX$SEV,EXSTAT ; Severe error ;JHA05 SHOW MSG11 ; 130$: BIT #TP.ALL,TYPE ; All data ? BEQ 150$ ; No : => 150$ BIT #TP.REF,TYPE ; Done Ref ? BNE 140$ ; Yes : => 140$ BIS #TP.REF,TYPE ; Set Ref JMP 10$ ; And process it 140$: BIC #TP.REF,TYPE ; Clear Ref 150$: RETURN ; .SBTTL $QRMVA -- Subroutine to delete a packet from a queue ; ;+JHA07 $QRMVA: MOV R0,R3 ; Copy address of listhead 10$: MOV R3,R2 ; R2 => Current entry MOV (R2),R3 ; R3 => Next entry BEQ 40$ ; End of list : => 40$ CMP R1,R3 ; Address match ? BEQ 20$ ; Yes : => 20$ BR 10$ ; => 10$ 20$: MOV (R3),(R2) ; Close up list BNE 30$ ; No new last : => 30$ MOV R2,2(R0) ; Set address of new last 30$: MOV R3,R1 ; Set address of entry removed CLC ; Success RETURN ; 40$: SEC ; Not success RETURN ; ; ;-JHA07 .END START