.MCALL .MODULE .MODULE MONMRG,VERSION=11,COMMENT=,AUDIT=YES ; Copyright (c) 1998 by Mentec, Inc., Nashua, NH. ; All rights reserved ; ; This software is furnished under a license for use only on a ; single computer system and may be copied only with the ; inclusion of the above copyright notice. This software, or ; any other copies thereof, may not be provided or otherwise ; made available to any other person except for use on such ; system and to one who agrees to these license terms. Title ; to and ownership of the software shall at all times remain ; in Mentec, Inc. ; ; The information in this document is subject to change without ; notice and should not be construed as a commitment by Digital ; Equipment Corporation, or Mentec, Inc. ; ; Digital and Mentec assume no responsibility for the use or ; reliability of its software on equipment which is not supplied ; by Digital or Mentec, and listed in the Software Product ; Description. .SBTTL MONMRG DESCRIPTION .REM % The MONMRG utility is used by the system generation (SYSGEN) procedure to produce a monitor image file and an accurate address map of that monitor image. It is necessary to have such special functionality because some variants of RT-11 monitors are now (starting with V5.5) too large for LINK to create them. MONMRG essentially glues together two files each containing a different part of the monitor image to produce the actual monitor image file. At the same time, it merges two LINK map files to produce a single map file containing addresses of all monitor program sections and global symbols. The syntax for MONMRG is: .R MONMRG *monitr.SYS,monitr.MAP=bstrap.SYS,rmon.SYS,bstrap.MAP,rmon.MAP *^C where: monitr.SYS is the monitor image file monitr.MAP is the address map of the monitor image file bstrap.SYS is the image file produced by linking the BSTRAP with "rmon.STB" rmon.SYS is the image file produced by linking all of the monitor except BSTRAP bstrap.map is the LINK map file of "bstrap.SYS" rmon.map is the LINK map file of "rmon.SYS" rmon.STB is the symbol table file of "rmon.SYS" % .SBTTL MACROS AND EXTERNALS .Globl $FnAsc ; convert Rad50 DBlk to Ascii filename .MCALL .CLOSE .EXIT .WRITW .LOOKUP .ENTER .FETCH .CSISPC .MCALL .READW .PRINT .TTYOUT .SETTOP .CSTAT .DATE .GTIM .MCALL .RCTRLO .SRESET SOB .ASSUME .BR .GVAL .LIBRARY "SRC:SYSTEM" .MCALL .JSXDF .SYCDF .JSXDF .SYCDF .MACRO .CALLR LABEL .BR LABEL .ENDM .MACRO BON LBL BNE LBL .ENDM .MACRO BOFF LBL BEQ LBL .ENDM .MACRO MAPOUT MSG .IF NB MSG .IIF DIF , MOV MSG,R1 .ENDC CALL PUTMSG .ENDM .....2=0 .....3=0 .MACRO TOKEN MASK,VALUE,STRING .IF P2 .IF EQ .....2 .....2=1 .....3=0 .ENDC .ENDC .IF NB MASK .IIF NE .....3 .=.....1+1 .BYTE MASK .IFF .IIF NE .....3 .=.....1 .ENDC .BYTE VALUE .ASCIZ STRING .....1=. .BYTE -1,0 .EVEN .....3=.....3+1 .ENDM .MACRO CALSUB SUBR,ARGS,?PRMBLK .SAVE .PSECT $PARAM PRMBLK: .BLKW 1 .....4=0 .IRP .....5, .....4=.....4+1 .WORD .....5 .ENDR .=.-<2*.....4>-2 .WORD .....4 .=.+<2*.....4> .RESTORE MOV #PRMBLK,R5 CALL SUBR .ENDM .SBTTL SYMBOL EQUATES ERRBYT =: 52 USERRB =: 53 Succs$ =: 1 ; error level bit code Warn$ =: 2 Error$ =: 4 Fatal$ =: 10 Uncon$ =: 20 CONFIG =: 300 CLK50 =: 40 BASEYR =: 72. S.SYM1 =: 0 S.SYM2 =: 2 S.VAL =: 4 S.BLNK =: 6 S.FLNK =: 10 ABSR1 =: <^R. A> ABSR2 =: <^RBS.> BLANK =: 40 COMMA =: ', DOT =: '. DOLLAR =: '$ LETA =: 'A LETZ =: 'Z ZERO =: '0 SEVEN =: '7 LPAREN =: '( RPAREN =: ') EQUAL =: '= COLON =: ': SMALLW =: 'w SMALLO =: 'o SMALLR =: 'r SMALLD =: 'd SMALLS =: 's FF =: 14 CR =: 15 LF =: 12 CTRLZ =: 32 TAB =: 11 TV.RW =: 0 TV.RO =: 1 TV.I =: 0 TV.D =: 2 TV.GBL =: 0 TV.SAV =: 4 TV.LCL =: 10 TV.REL =: 0 TV.ABS =: 20 TV.OVR =: 0 TV.CON =: 40 TM.RW =: TM.RO =: TM.RW TM.I =: TM.D =: TM.I TM.GBL =: TM.SAV =: TM.GBL TM.LCL =: TM.GBL TM.REL =: TM.ABS =: TM.REL TM.OVR =: TM.CON =: TM.OVR .SBTTL MONMRG .PSECT $VARS UNDSTR: .ASCIZ "Undefined globals:" TOKENS: TOKEN MASK=TM.RW, VALUE=TV.RW, STRING="RW" TOKEN VALUE=TM.RO, STRING="RO" TOKEN MASK=TM.I, VALUE=TV.I, STRING="I" TOKEN VALUE=TV.D, STRING="D" TOKEN MASK=TM.GBL,VALUE=TV.GBL,STRING="GBL" TOKEN VALUE=TV.SAV,STRING="SAV" TOKEN VALUE=TV.LCL,STRING="LCL" TOKEN MASK=TM.REL,VALUE=TV.REL,STRING="REL" TOKEN VALUE=TV.ABS,STRING="ABS" TOKEN MASK=TM.OVR,VALUE=TV.OVR,STRING="OVR" TOKEN VALUE=TV.CON,STRING="CON" DIV10T: .WORD 10000. .WORD 1000. .WORD 100. .WORD 10. .WORD 1 UNDFLG: .BLKW 1 NUMCOL: .BLKW 1 COL: .BLKW 1 EXTVAL: .BLKW 1 BIAS: .BLKW 1 ATTRIB: .BLKW 1 SYMBOL: .BLKW 2 VALUE: .BLKW 1 SIZE: .BLKW 1 ADDR: .BLKW 1 .ASECT .=$JSX .WORD .PSECT $CODE .ENABL LSB MONMRG:: CLR HADERR .RCTRLO .SRESET .SETTOP #-2 CALL CSISPC CALL INISYM CLR LINPPG CLR LINLFT CLR NUMCOL CALL GETLIN BCS 30$ CALL GETLIN BCS 30$ MOV #LINE+132.,R0 10$: CMPB -(R0),#TAB BEQ 20$ CMPB @R0,#BLANK BNE 40$ 20$: CMP R0,#LINE BNE 10$ 30$: .BR ERRIFF ;+ ;ERROR ERRIFF: MOV FILPTR,R3 Jsr R0,ErrMsg .WORD MsgIFF ;- .EXIT 40$: MOV #LINE,R1 MOV #LINE2,R2 50$: MOVB (R1)+,(R2)+ CMP R1,R0 BLOS 50$ CLRB (R2)+ 60$: CLR UNDFLG 70$: CALL GETLIN BCS 170$ CALL TABEXP BCS 60$ MOV #1,LINPTR MOV #LINE,R0 TST UNDFLG BEQ 90$ CMPB @R0,#BLANK BEQ 60$ MOV #6.,ENDLIN CALSUB GETUND, BCC 80$ JMP ERRIFF 80$: CALSUB GETUND, BR 70$ 90$: MOV #UNDSTR,R1 100$: CMPB (R0)+,(R1)+ BNE 120$ TSTB @R1 BNE 100$ 110$: MOV SP,UNDFLG 120$: MOV #1,LINPTR MOV #LINE,R0 CMPB (R0)+,#BLANK BNE 70$ 130$: CMPB (R0)+,#BLANK BNE 160$ CMP R0,#LINE+9. BNE 130$ CLR COL 140$: CALSUB GETSYM, BCS 150$ INC COL CALSUB ENTSYM, BR 140$ 150$: CMP NUMCOL,COL BHIS 70$ MOV COL,NUMCOL BR 70$ 160$: CALSUB GETSEC, CALSUB ENTSEC, BR 70$ 170$: CLR UNDFLG CLR ENDLIN CLR COL CLR BLKNUM CLR BUFPTR MOV @HEAD,CUR CMP CUR,NULL BNE 180$ JMP 410$ 180$: CALL MAPHDR 190$: MOV CUR,R1 BIT #1,S.BLNK(R1) BNE 200$ JMP 360$ 200$: CALL FLUSH MOV CUR,R1 MOV S.VAL(R1),EXTVAL .ASSUME S.SYM1 EQ 0 CMP @R1,#ABSR1 BNE 210$ CMP S.SYM2(R1),#ABSR2 BNE 210$ CLR BIAS BR 220$ 210$: MOV ABSSIZ,R0 SUB ABSHOL,R0 MOV R0,BIAS 220$: INC ENDLIN MOV ENDLIN,R1 ADD #,R1 MOVB #BLANK,(R1)+ MOV CUR,R3 .ASSUME S.SYM1 EQ 0 ; ADD #S.SYM1,R3 CALL R50AS2 ADD #7,ENDLIN MOV ENDLIN,R0 ADD #,R0 MOVB #TAB,(R0)+ INC ENDLIN MOVB #BLANK,(R0)+ MOV EXTVAL,R1 MOV S.SYM1+4(R1),R1 CLR R2 ADD BIAS,R1 ADC R2 CALL EXTOCT INC R0 ;Skip over TAB character MOV EXTVAL,R1 MOV S.SYM1+6(R1),R1 CLR R2 CALL EXTOCT MOV #BLANK,R2 MOVB R2,(R0)+ INC ENDLIN MOVB #EQUAL,(R0)+ MOV R0,R4 INC R4 MOV #8.,R1 230$: MOVB R2,(R0)+ SOB R1,230$ MOV EXTVAL,R0 MOV S.BLNK(R0),R0 INC R0 CLC ROR R0 CLR R5 MOV #DIV10T,R3 240$: MOV (R3)+,R1 MOV #-1,R2 250$: INC R2 SUB R1,R0 BHIS 250$ ADD R1,R0 BIS R2,R5 BNE 260$ DEC R1 BGT 240$ 260$: ADD #ZERO,R2 MOVB R2,(R4)+ DEC R1 BGT 240$ MOVB #DOT,@R4 MOV ENDLIN,R0 ADD #,R0 MOVB #SMALLW,(R0)+ MOVB #SMALLO,(R0)+ MOVB #SMALLR,(R0)+ MOVB #SMALLD,(R0)+ MOVB #SMALLS,(R0)+ MOVB #BLANK,(R0)+ MOVB #BLANK,(R0)+ MOV EXTVAL,R1 MOV S.FLNK(R1),ATTRIB MOVB #LPAREN,@R0 SUB #LINE-1,R0 MOV R0,ENDLIN MOV #TOKENS,R4 ;R4 -> token table 270$: CLR R0 ;Avoid sign extend propblem BISB (R4)+,R0 ;Get token mask BEQ 350$ ;Branch if end of token table MOV ATTRIB,R3 ;Get attributes of section COM R0 ;Change from AND to BIC mask BIC R0,R3 ;Isolate bits we're interested in 280$: MOVB (R4)+,R2 ;Get token value CMPB R2,R3 ;Is this the one? BEQ 310$ ;Branch if a match INCB R2 ;Is this a terminator for this mask? BEQ 300$ ;Branch if yes 290$: TSTB (R4)+ ;Skip over token string BNE 290$ ;String is terminated by 0 (.ASCIZ) BR 280$ 300$: JMP ERRIFF ;Bad attribute, so must be file error 310$: MOV ENDLIN,R2 ;Get index of last byte in LINE 320$: INC R2 ;Advance index to next unused byte MOVB (R4)+,LINE-1(R2) ;Copy the token string BNE 320$ ;Terminated by 0 (.ASCIZ) MOVB #COMMA,LINE-1(R2) ;Put a comma in line instead of null MOV R2,ENDLIN ;Update ENDLIN with new end-of-line 330$: MOVB (R4)+,R2 ;Get next token value INCB R2 ;No more token values signified by -1 BEQ 270$ ;Go process next mask 340$: TSTB (R4)+ ;Skip over token string BNE 340$ ;String is terminated by 0 (.ASCIZ) BR 330$ ;Get next token value 350$: MOV ENDLIN,R0 MOVB #RPAREN,LINE-1(R0) CALL FLUSH CLR COL JMP 400$ 360$: INC COL CMP COL,NUMCOL BLOS 370$ CALL FLUSH MOV #1,COL 370$: CMP COL,#1 BNE 390$ MOV #1,R2 380$: INC ENDLIN MOV ENDLIN,R0 MOVB #TAB,LINE-1(R0) INC R2 CMP R2,#3 BLOS 380$ 390$: MOV ENDLIN,R1 ADD #LINE,R1 MOV CUR,R3 .ASSUME S.SYM1 EQ 0 ; ADD #S.SYM1,R3 CALL R50AS2 ADD #7,ENDLIN MOV ENDLIN,R0 ADD #,R0 MOVB #TAB,(R0)+ MOV CUR,R1 MOV S.VAL(R1),R1 CLR R2 ADD BIAS,R1 ADC R2 CALL EXTOCT 400$: MOV CUR,R1 MOV S.FLNK(R1),CUR CMP CUR,NULL BEQ 410$ JMP 190$ 410$: CALL FLUSH MOV @UHEAD,CUR CMP CUR,UNULL BEQ 430$ MAPOUT #CRLF MAPOUT #UNDSTR MAPOUT #CRLF 420$: MOV #LINE,R1 MOV CUR,R3 .ASSUME S.SYM1 EQ 0 ; ADD #S.SYM1,R3 CALL R50AS2 MOV #6,ENDLIN CALL FLUSH MOV CUR,R1 MOV S.FLNK(R1),CUR CMP CUR,UNULL BNE 420$ 430$: CALL CLOSE TST HADERR BNE 440$ ;+ ;ERROR Jsr R0,ErrMsg .WORD MSGAOk ;- 440$: JMP MONMRG .DSABL LSB .SBTTL EXTOCT ;+ ; INPUT: ; R0 -> start of 7-byte area to receive 6 octal digits followed by a TAB ; R1 = low 16 bits of number to display in octal ; R2 = high 2 bits of number to display in octal ; ; OUTPUT: ; R3 = 0 ; R0 = R0+6 ; R1 = random ; R2 = random ; ENDLIN = ENDLIN+7 ;- EXTOCT: MOV #7,R3 BR 20$ 10$: ADD #ZERO,R2 MOVB R2,(R0)+ CLR R2 ASL R1 ROL R2 ASL R1 ROL R2 20$: ASL R1 ROL R2 INC ENDLIN SOB R3,10$ MOVB #TAB,@R0 RETURN .SBTTL INISYM .PSECT $CODE .ENABL LSB INISYM:: CLR ASECT CLR ABSSIZ MOV @#50,R0 MOV R0,STEND MOV R0,R5 MOV HNDTOP,R1 SUB R1,R0 BHI 10$ JMP ERRSOV ;Symbol table overflow 10$: MOV #120000,R3 CLR R4 BR 30$ 20$: ROR R3 30$: ASL R4 CMP R0,R3 BLO 40$ INC R4 SUB R3,R0 40$: CLC CMP R3,#12 BNE 20$ ADD R0,R1 BIT #1,R4 BNE 50$ ADD R3,R1 DEC R4 50$: MOV R1,SYMTBL MOV R4,STSIZE SUB R1,R5 MOV R5,STLEN MOV #100000,R2 60$: CMP R2,R4 BLOS 70$ ROR R2 BR 60$ 70$: ASR R2 MOV R2,-(SP) ASL R2 ASL R2 ADD (SP)+,R2 CMP R3,R2 BLOS 80$ MOV R3,R2 80$: MOV R2,STINCR 90$: TST R4 BMI 100$ ASL R4 BR 90$ 100$: MOV R4,STDIV MOV R1,R3 CLC ROR R5 110$: MOV #-1,(R3)+ SOB R5,110$ MOV R1,NULL MOV #-2,(R1)+ MOV #1,(R1)+ CLR (R1)+ MOV R1,TAIL MOV NULL,@R1 MOV (R1)+,@R1 MOV R1,HEAD MOV (R1)+,CUR MOV R1,UNULL MOV #-2,(R1)+ MOV #1,(R1)+ CLR (R1)+ MOV R1,UTAIL MOV UNULL,@R1 MOV (R1)+,@R1 MOV R1,UHEAD RETURN .SBTTL ENTUND .PSECT $CODE .ENABL LSB ENTUND:: CLR R4 ;Search for global symbol MOV 2(R5),R1 ;R1 -> global symbol to search for CALL HASH .ASSUME S.SYM1 EQ 0 CMP @R0,#-1 BNE 10$ .ASSUME S.SYM1 EQ 0 MOV (R1)+,@R0 MOV @R1,S.SYM2(R0) MOV @UTAIL,R1 MOV S.FLNK(R1),R2 MOV R0,S.BLNK(R2) MOV R2,S.FLNK(R0) MOV R0,S.FLNK(R1) MOV R1,S.BLNK(R0) 10$: RETURN .SBTTL ENTSYM .PSECT $VARS HSHVAL: .BLKW 1 .PSECT $CODE .ENABL LSB ENTSYM:: CMP @HEAD,NULL BEQ 50$ CMP CUR,NULL BEQ 50$ CLR R4 ;Search for global symbol MOV 2(R5),R1 ;R1 -> global symbol to search for CALL HASH MOV R0,HSHVAL CLR R4 ;Assume symbol is old .ASSUME S.SYM1 EQ 0 CMP @R0,#-1 ;Is symbol already in hash table? BNE 10$ ;Branch if yes -- symbol is old COM R4 ;Symbol is new .ASSUME S.SYM1 EQ 0 MOV (R1)+,(R0)+ ;Store new global .ASSUME S.SYM2 EQ S.SYM1+2 MOV @R1,(R0)+ ; symbol in hash entry .ASSUME S.VAL EQ S.SYM2+2 MOV @4(R5),@R0 ;Store symbol's value in hash entry BR 20$ 10$: CMP S.VAL(R0),@4(R5) ;Is symbol's value correct in entry? BNE ERRINC ;Branch if not 20$: MOV HSHVAL,R0 TST R4 BNE 30$ TST ASECT BNE 40$ MOV S.BLNK(R0),R3 BIC #1,R3 MOV R3,R1 MOV S.FLNK(R0),R2 MOV R2,S.FLNK(R3) CMP R3,NULL BEQ ERRINC BIC #^C<1>,S.BLNK(R2) BIS R1,S.BLNK(R2) MOV HSHVAL,R0 CMP CUR,R0 BNE 30$ MOV R1,CUR 30$: MOV CUR,R3 MOV R3,S.BLNK(R0) MOV S.FLNK(R3),R1 MOV R1,S.FLNK(R0) MOV CUR,R2 MOV R0,S.FLNK(R2) BIC #^C<1>,S.BLNK(R1) BIS R0,S.BLNK(R1) MOV R0,CUR 40$: RETURN 50$: JMP ERRIFF ;+ ;ERROR ERRINC: MOV #FILSPC+<3.*10.>+<2.*8.>,R3 MOV R3,R4 ADD #8.,R4 Jsr R0,ErrMsg .WORD MsgInc ;- .EXIT .SBTTL ENTSEC .PSECT $VARS HSHVL: .BLKW 1 EXTVL: .BLKW 1 .PSECT $CODE .ENABL LSB ENTSEC:: MOV #1,R4 ;Search for program section MOV 2(R5),R1 ;R1 -> global symbol to search for CALL HASH MOV R0,HSHVL .ASSUME S.SYM1 EQ 0 CMP @R0,#-1 BNE 20$ .ASSUME S.SYM1 EQ 0 MOV #-2,@R0 MOV @TAIL,R3 MOV R0,S.FLNK(R3) INC R3 MOV R3,S.BLNK(R0) MOV R0,@TAIL MOV NULL,S.FLNK(R0) CALL PROBE MOV R0,EXTVL MOV HSHVL,R2 .ASSUME S.SYM1 EQ 0 MOV (R1)+,@R2 MOV @R1,S.SYM2(R2) MOV R0,S.VAL(R2) .ASSUME S.SYM1 EQ 0 MOV #-2,@R0 CLR S.SYM2(R0) MOV @6(R5),S.BLNK(R0) MOV @10(R5),S.FLNK(R0) BR 50$ 20$: MOV S.VAL(R0),R3 MOV R3,EXTVL CMP @10(R5),S.FLNK(R3) BNE ERRINC .ASSUME TV.OVR EQ 0 BIT #TM.OVR,@10(R5) BNE 40$ CMP S.BLNK(R3),@6(R5) BHIS 50$ MOV @6(R5),S.BLNK(R3) BR 50$ 40$: ADD @6(R5),S.BLNK(R3) 50$: MOV HSHVL,R1 MOV EXTVL,R3 MOV @4(R5),S.VAL(R3) MOV R1,CUR CLR ASECT .ASSUME S.SYM1 EQ 0 CMP @R1,#ABSR1 BNE 60$ CMP S.SYM2(R1),#ABSR2 BNE 60$ MOV SP,ASECT MOV S.BLNK(R3),ABSSIZ MOV @6(R5),ABSHOL 60$: RETURN .SBTTL HASH .PSECT $CODE .ENABL LSB ;+ ; INPUT: ; R1 -> 2-word symbol in RAD50 ; R4 = 0 if global symbol ; = 1 if section name ;- HASH:: MOV @R1,R0 ADD 2(R1),R0 MOV STDIV,R2 MOV STSIZE,R3 10$: CMP R0,R2 BLO 20$ SUB R2,R0 20$: CLC ROR R2 CMP R0,R3 BHIS 10$ ASL R0 MOV R0,R2 ASL R0 ASL R0 ADD R2,R0 ADD SYMTBL,R0 PROBE: .ASSUME S.SYM1 EQ 0 30$: CMP @R0,#-1 BEQ 60$ .ASSUME S.SYM1 EQ 0 CMP @R0,@R1 BNE 40$ CMP S.SYM2(R0),2(R1) BNE 40$ MOV S.BLNK(R0),R2 BIC #^C<1>,R2 CMP R2,R4 BEQ 60$ 40$: ADD STINCR,R0 CMP R0,STEND BLO 50$ SUB STLEN,R0 50$: SOB R3,30$ ;+ ;ERROR ERRSOV: Jsr R0,ErrMsg .WORD MsgSOv ;- .EXIT 60$: RETURN .SBTTL GETSYM AND GETUND .PSECT $CODE .ENABL LSB GETSYM:: CALL GETUND BCS 40$ MOV LINPTR,R0 CMP R0,ENDLIN BHI 40$ CMPB LINE-1(R0),#BLANK BNE 40$ MOV 4(R5),R4 CALL GETVAL BCC 50$ LNKIFF: JMP ERRIFF GETUND:: MOV LINPTR,R0 CMP R0,ENDLIN BHI 40$ CMPB LINE-1(R0),#BLANK BNE 10$ INC LINPTR BR GETUND 10$: MOV 2(R5),R3 ;R3 -> 2-word area to store symbol CALL 20$ ;Get first word of RAD50 symbol TST (R3)+ ;R3 -> 2nd word of area for symbol .CALLR 20$ ;Get second word of RAD50 symbol 20$: CLR @R3 ;Clear RAD50 word MOV #3,R1 ;3 characters per RAD50 word 30$: MOV LINPTR,R4 ;Index to current character in line CMP R4,ENDLIN ;At end of line? BHI LNKIFF ;Branch if yes -- invalid file format ADD #LINE-1,R4 ;Point to current character in line CALL RAD50 ;Convert ASCII character to RAD50 ASL @R3 ;Multiply RAD50 so far ASL @R3 ; by 50 (octal) ASL @R3 ; and ADD @R3,R0 ; add in ASL @R3 ; newly converted ASL @R3 ; RAD50 ADD R0,@R3 ; character INC LINPTR ;Bump current character index SOB R1,30$ ;Do 3 characters worth TST (PC)+ ;CLC 40$: SEC 50$: RETURN .SBTTL GETSEC .PSECT $PARAM PRMBK1: .WORD 2 .WORD 0 .WORD 0 .PSECT $CODE .ENABL LSB GETSEC:: MOV R5,-(SP) MOV R5,R4 CMP (R4)+,(R4)+ MOV #PRMBK1+4,R5 MOV @R4,@R5 MOV -(R4),-(R5) TST -(R5) CALL GETSYM MOV (SP)+,R5 BCS LNKIFF MOV 6(R5),R4 CALL GETVAL BCS LNKIFF 10$: MOV LINPTR,R0 CMP R0,ENDLIN BHI LNKIFF CMPB LINE-1(R0),#LPAREN BEQ 20$ INC LINPTR BR 10$ 20$: INC LINPTR CMP LINPTR,ENDLIN BHI LNKIFF CLR @10(R5) 30$: CALL GETATT ROR R1 ADD R0,@10(R5) ;Accumulate attribute value ROL R1 BCC 30$ ;Go get another attribute RETURN LK1IFF: BR LNKIFF .SBTTL GETVAL .PSECT $CODE .ENABL LSB ;+ ; INPUT: ; R4 -> WORD TO RETURN VALUE IN ;- GETVAL:: MOV LINPTR,R0 CMP R0,ENDLIN BHI 40$ CMPB LINE-1(R0),#BLANK BNE 10$ INC LINPTR BR GETVAL 10$: CLR @R4 20$: MOV LINPTR,R0 CMP R0,ENDLIN BHI 30$ MOVB LINE-1(R0),R0 SUB #ZERO,R0 BLO 30$ CMPB R0,# BHI 30$ ASL @R4 ASL @R4 ASL @R4 ADD R0,@R4 INC LINPTR BR 20$ 30$: TST (PC)+ ;CLC 40$: SEC RETURN .SBTTL GETATT .PSECT $VARS SYM: .BLKB 4 .PSECT $CODE .ENABL LSB GETATT:: CLR R4 ;Assume more attributes follow MOV #SYM,R2 10$: MOV LINPTR,R3 CMP R3,ENDLIN BHI LK1IFF CLRB @R2 MOVB LINE-1(R3),R0 CMPB R0,#COMMA ;If "," terminator, yes -- continue BEQ 30$ CMPB R0,#RPAREN ;If not "," or ")" terminator, error BEQ 20$ CMP R2,# BHI LK1IFF MOVB R0,(R2)+ INC LINPTR BR 10$ 20$: DEC R4 ;No more attributes follow 30$: INC LINPTR CLR R0 ;Clear attribute value initially MOV #TOKENS,R3 ;R3 -> token table 40$: TSTB (R3)+ ;Skip past mask byte BEQ LK1IFF ;Error if no token match found 50$: MOVB (R3)+,R1 ;Get value byte CMP R1,#-1 ;Is there a token string following? BEQ 40$ ;Branch if not MOV #SYM,R2 ;Point to start of token to match 60$: CMPB (R2)+,@R3 ;Does character match? BNE 70$ ;Branch if not TSTB (R3)+ ;Have we matched whole string? BNE 60$ ;Branch if not -- match next character BISB R1,R0 ;Store attribute value ROL R4 ;Get carry from sign of R4 RETURN 70$: TSTB (R3)+ ;Eat rest of BNE 70$ ; non-matching string BR 50$ ;Try next string .SBTTL RAD50 .PSECT $CODE .ENABL LSB ;+ ; INPUT: ; R4 -> ASCII byte to convert to RAD50 digit ; ; OUTPUT: ; R0 = RAD50 digit of ASCII byte @R4 ;- RAD50:: MOVB @R4,R0 ;Get ASCII character SUB #BLANK,R0 ;Is it a blank? BEQ 30$ ;Branch if so returning 0 SUB #,R0 ;Assume alphabetic characters BLOS 10$ ;Branch if too low for alphabetic CMP R0,#26. ;Is it alphabetic (A-Z)? BLOS 30$ ;Branch if yes -- return RAD50 code 10$: SUB #,R0 ;Assume numeric character CMP R0,#30. ;Is it at least ASCII zero? BLO 20$ ;Branch if not CMP R0,#39. ;Is it no higher than ASCII nine? BLOS 30$ ;Branch if yes -- return RAD50 code 20$: MOV #27.,R0 ;Assume dollar CMPB @R4,#DOLLAR ;Is it a dollar? BEQ 30$ ;Branch if yes -- return RAD50 code INC R0 ;Assume dot CMPB @R4,#DOT ;Is it a dot? BNE LK1IFF ;Branch if not -- we have error 30$: RETURN .SBTTL GETLIN .PSECT $VARS EOL: .BLKB 1 .EVEN .PSECT $CODE .ENABL LSB GETLIN:: MOV #,R3 10$: MOVB #BLANK,-(R3) CMP R3,#LINE BNE 10$ 20$: CALL GETCHR MOV R0,R4 TSTB EOFHIT BMI 60$ TSTB EOL BMI 50$ ; MOV #LINE,R3 ;The above loop ends with R3->LINE 30$: MOVB R4,(R3)+ CALL GETCHR MOV R0,R4 TSTB EOL BMI 50$ 40$: CMP R3,#LINE+132. BNE 30$ JMP ERRIFF 50$: TST (PC)+ ;CLC 60$: SEC RETURN .SBTTL GETCHR .PSECT $VARS GETC: .BLKB 1 .EVEN .PSECT $CODE .ENABL LSB ; GETCHR(x,x) ; GETCHR:: CLRB GETC MOVB #-1,EOL TSTB EOFHIT BMI 70$ 10$: CMP BUFPTR,#777 BLOS 20$ CLR BUFPTR CALL RDBUF TSTB EOFHIT BMI 70$ 20$: MOV BUFPTR,R0 MOVB BUFF(R0),GETC INC BUFPTR TSTB GETC BEQ 10$ CMPB GETC,#FF BEQ 50$ CMPB GETC,#CR BEQ 10$ CMPB GETC,#LF BEQ 30$ CMPB GETC,#CTRLZ BEQ 40$ CLRB EOL BR 70$ 30$: INC LINLFT BR 70$ 40$: MOVB #-1,EOFHIT 50$: CMP LINLFT,LINPPG BLOS 60$ MOV LINLFT,LINPPG 60$: CLR LINLFT 70$: MOVB GETC,R0 RETURN .SBTTL TABEXP .PSECT $VARS TMPLIN: .BLKB 132. .EVEN .PSECT $CODE .ENABL LSB TABEXP:: CLR ENDLIN MOV #132.,R2 MOV #LINE+132.,R0 10$: CMPB -(R0),#TAB BEQ 20$ CMPB @R0,#BLANK BNE 40$ 20$: SOB R2,10$ 30$: SEC RETURN 40$: MOV R2,ENDLIN MOV #1,R3 MOV R3,R4 CMP R3,R2 BHI 90$ 50$: CMPB LINE-1(R3),#TAB BNE 70$ 60$: CMP R4,#132. BHI 30$ MOVB #BLANK,TMPLIN-1(R4) MOV R4,R0 INC R4 BIC #^C<7>,R0 BNE 60$ BR 80$ 70$: CMP R4,#132. BHI 30$ MOVB LINE-1(R3),TMPLIN-1(R4) INC R4 80$: INC R3 CMP R3,R2 BLOS 50$ 90$: DEC R4 MOV R4,ENDLIN MOV #LINE,R2 MOV #132.,R1 SUB R4,R1 100$: MOVB TMPLIN-LINE(R2),(R2)+ SOB R4,100$ 110$: MOVB #BLANK,(R2)+ SOB R1,110$ CLC RETURN .SBTTL OUTPUT .PSECT $CODE .ENABL LSB ;+ ;ERROR CSISPC:: MOV SP,R5 ;We ignore option info .CSISPC #FILSPC,#DEFEXT,#0,#LINE BCC 10$ ;Branch if valid CSI line Jsr R0,ErrMsg .WORD MsgCSI ;- .EXIT 10$: MOV R5,SP ;Throw away option information TSTB LINE ;Just a ? BNE 20$ ;If not, go process command .PRINT #VERSN ;Display program's version JMP MONMRG ; and restart program 20$: MOV HILIM,R4 MOV #FILSPC,R3 .FETCH R4,R3 BCC 40$ ;+ ;ERROR 30$: Jsr R0,ErrMsg .WORD MsgDev ;- .EXIT 40$: MOV R0,R4 MOV #FILSPC+10.,R3 .FETCH R4,R3 BCS 30$ MOV R0,R4 MOV #FILELN,R1 MOV #3,R2 MOV #FILSPC+<3.*10.>,R3 MOV #4,R5 50$: .FETCH R4,R3 BCS 30$ MOV R0,R4 .LOOKUP #AREA,R2,R3 BCC 60$ ;+ ;ERROR Jsr R0,ErrMsg .WORD MsgFNF ;- .EXIT 60$: .CSTAT #AREA,R2,#CSTBLK BCC 70$ ;+ ;ERROR ERRINT: Jsr R0,ErrMsg ;Internal error .WORD MsgInt ;- .EXIT 70$: MOV CSTBLK+4,(R1)+ ADD #8.,R3 INC R2 CMP R2,#7 BNE 50$ MOV R4,HNDTOP TST FILELN BEQ 80$ TST FILELN+2 BEQ 80$ ADD FILELN+2,FILELN DEC FILELN MOV FILELN,FILSPC+8. 80$: TST FILELN+4 BEQ 100$ TST FILELN+6 BEQ 100$ ADD FILELN+6,FILELN+4 TST FILSPC+18. BEQ 90$ CMP FILELN+4,FILSPC+18. BHIS 100$ 90$: MOV FILELN+4,FILSPC+18. 100$: MOV #FILSPC,R3 .ENTER #AREA,#0,R3,FILSPC+8. BCC 140$ 110$: CMPB @#ERRBYT,#1 BNE 120$ ;+ ;ERROR Jsr R0,ErrMsg .WORD MsgDvF ;- .EXIT 120$: CMPB @#ERRBYT,#3 BNE 130$ ;+ ;ERROR Jsr R0,ErrMsg .WORD MsgPro .EXIT 130$: Jsr R0,ErrMsg .WORD MsgDev ;- .EXIT 140$: MOV #FILSPC+10.,R3 .ENTER #AREA,#1,R3,FILSPC+18. BCS 110$ CLR R2 CLR R4 MOV #FILSPC+<3.*10.>,R3 MOV #3,R1 150$: .READW #AREA,R1,#BUFF,#256.,R2 BCS 170$ .WRITW #AREA,#0,#BUFF,#256.,R4 BCC 160$ ;+ ;ERROR MOV #FILSPC,R3 Jsr R0,ErrMsg .WORD MsgOEr ;- .EXIT 160$: INC R2 INC R4 ADD #8.,R3 BR 150$ 170$: TSTB @#ERRBYT BEQ 180$ ;+ ;ERROR Jsr R0,ErrMsg .WORD MsgIEr ;- .EXIT 180$: .CLOSE R1 INC R1 MOV #1,R2 CMP R1,#5 BNE 150$ .CLOSE #0 BCC 190$ ;+ ;ERROR MOV #FILSPC,R3 Jsr R0,ErrMsg .WORD MsgPFE ;- .EXIT 190$: MOV #5,RDCHAN MOV #FILSPC+<3.*10.>+<2.*8.>,FILPTR CLR BLKNUM MOV #512.,BUFPTR CLRB EOFHIT RETURN .ENABL LSB RDBUF:: MOVB #-1,EOFHIT ;EOFHIT=.TRUE. 10$: .READW #AREA,RDCHAN,#BUFF,#256.,BLKNUM BCS 20$ CLRB EOFHIT ;EOFHIT=.FALSE. INC BLKNUM RETURN 20$: TSTB @#ERRBYT BEQ 40$ MOV #FILSPC+<3.*10.>+<2.*8.>,R3 CMP RDCHAN,#5 BEQ 30$ ADD #8.,R3 ;+ ;ERROR 30$: Jsr R0,ErrMsg .WORD MsgIEr ;- .EXIT 40$: CMP LINLFT,LINPPG BLOS 50$ MOV LINLFT,LINPPG 50$: CLR LINLFT CLR BLKNUM .CLOSE RDCHAN INC RDCHAN ADD #8.,FILPTR CMP RDCHAN,#7 BNE 10$ RETURN .DSABL LSB PUTCHR:: CMP BUFPTR,#512. BLO 20$ MOV R0,-(SP) .WRITW #AREA,#1,#BUFF,#256.,BLKNUM MOV (SP)+,R0 BCC 10$ ;+ ;ERROR MOV #FILSPC+10.,R3 Jsr R0,ErrMsg .WORD MsgOEr ;- .EXIT 10$: INC BLKNUM CLR BUFPTR 20$: MOV R2,-(SP) MOV BUFPTR,R2 MOVB R0,BUFF(R2) MOV (SP)+,R2 INC BUFPTR RETURN CLOSE:: MOV #511.,R1 10$: CLR R2 CALL PUTCHR SOB R1,10$ .CLOSE #1 BCC 20$ ;+ ;ERROR MOV #FILSPC+10.,R3 Jsr R0,ErrMsg .WORD MsgPFE ;- .EXIT 20$: RETURN FLUSH:: TST ENDLIN BEQ 20$ MOV #LINE,R1 10$: MOVB (R1)+,R0 CALL PUTMS1 DEC ENDLIN BNE 10$ MOV #15,R0 CALL PUTMS1 MOV #12,R0 CALL PUTMS1 20$: RETURN PUTMS1: MOV R1,-(SP) MOV #CHRBUF,R1 CLR @R1 BISB R0,@R1 CALL PUTMSG MOV (SP)+,R1 RETURN .SBTTL PUTMSG OUTPUT AN ASCIZ MESSAGE TO MAP ;+ ; INPUT: R1 -> ASCIZ MESSAGE ; ; OUTPUT:R1 -> BEYOND END OF MESSAGE ; CLOBBERS R0 ;- .ENABL LSB 10$: CALL PUTCHR ;OUTPUT THIS CHARACTER CMPB #LF,R0 ;WAS IT A LINE FEED? BNE PUTMSG ;IF NE NO DEC LINLFT ;DECREMENT LINES LEFT COUNTER BNE PUTMSG ;IF EQ WE NEED A NEW PAGE MOVB #FF,R0 ;FORCE A FORM FEED TO BE OUTPUT CALL PUTCHR CALL HEADER ;AND OUTPUT THE HEADER PUTMSG: MOVB (R1)+,R0 ;GET A CHARACTER BNE 10$ ;RETURN IF 0 RETURN .DSABL LSB HEADER: MOV R1,-(SP) ;SAVE MESSAGE POINTER MOV LINPPG,LINLFT ;RESET LINES LEFT COUNTER INC PAGNUM ;BUMP PAGE NUMBER CLR R1 ;SETUP R0 AND R1 FOR DECASC ROUTINE MOV PAGNUM,R0 CLRB DECEND ;MAKE DECIMAL NUMBER TERMINATOR NULL CALL DECASC ;CONVERT TO DECIMAL ASCII MOVB #DOT,DECEND ;RESTORE "." FOR DECIMAL # TERMINATOR MAPOUT #LINE1 MAPOUT #PAGE MAPOUT #ODNB2 MAPOUT #CRLF MAPOUT #LINE2 MAPOUT #CRLF2 MOV (SP)+,R1 ;RESTORE MESSAGE POINTER RETURN .SBTTL R50ASC: RAD50 TO ASCII CONVERSION ;+ ; INPUT: R1 -> ASCII CHAR OUTPUT AREA ; R3 -> RAD50 WORD TO CONVERT ; USAGE: R2 & R0 = TEMPORARY ; R4 -> DIVISION TABLE ; @SP = # OF CHARACTERS TO BE OUTPUT ; OUTPUT:R3 -> WORD FOLLOWING RAD50 WORD CONVERTED ; R1 -> NEXT FREE OUTPUT BYTE ; CLOBBERS R0 ;- .PSECT $CODE .ENABL LSB R50AS2: CALL R50ASC ;CONVERT 2 WORDS OF RAD50 TO ASCII R50ASC: MOV R4,-(SP) ;SAVE R4 & R2 MOV R2,-(SP) MOV #3,-(SP) ;# OF CHARS TO OUTPUT 10$: MOV #DIVTB1,R4 ;R4 -> DIVISION TABLE MOV (R3)+,R2 ;R2 = CURRENT INPUT WORD 20$: TST -(R4) ;NEW WORD REQUIRED YET? BEQ 10$ ;YES CLR R0 ;INITIALIZE QUOTIENT REG 30$: INC R0 ;DIVIDE BY APPROPRIATE POWER OF 50(8) SUB @R4,R2 BCC 30$ DEC R0 ADD @R4,R2 ;RESTORE DIVIDEND TST R0 ;CHARACTER IS A BLANK? BEQ 40$ ;YES CMP #33,R0 ;DOLLAR SIGN, PERIOD, OR DIGIT? BLO 50$ ;PERIOD OR DIGIT BEQ 60$ ;DOLLAR SIGN ADD #40,R0 ;ELSE ALPHA (A-Z) OR QUESTION MARK 40$: ADD #16,R0 50$: ADD #11,R0 60$: ADD #11,R0 70$: MOVB R0,(R1)+ ;STORE CONVERTED CHARACTER IN OUTPUT DEC @SP ;LOOP FOR MORE CHARS BNE 20$ ;YES TST (SP)+ ;POP COUNTER MOV (SP)+,R2 MOV (SP)+,R4 RETURN .DSABL LSB .PSECT $VARS .WORD 0 ;END-OF-TABLE FLAG .WORD 1 .WORD 50 .WORD 3100 DIVTB1: .PSECT $CODE .SBTTL CVT2 - DECIMAL OUTPUT CONVERSION ;+ ; INPUT: R0 = DECIMAL NUMBER ; R1 -> ASCII OUTPUT AREA ; OUTPUT: R0,R3,R4 ARE DESTROYED ; R1 -> NEXT FREE CHARACTER LOCATION ;- CVT2: MOV #DIVTB2,R4 ;SET UP FOR TWO DIGITS 10$: MOVB #ZERO-1,R3 ;FORM DIGIT IN R3 20$: INC R3 SUB @R4,R0 ;SUBTRACT DIVISOR BHIS 20$ ADD (R4)+,R0 ;RE-ADD THE DIVISOR MOVB R3,(R1)+ ;CONVERTED CHARACTER TST @R4 ;DONE? BNE 10$ ;NO, DO NEXT DIGIT RETURN DIVTB2: .WORD 10. .WORD 1 .WORD 0 .SBTTL DOUBLE-PRECISION INTEGER DIVISION FOR TIME OUTPUT ; DIVIDES NUMBER IN (R4,R5) BY R3, RETURNING REMAINDER IN R0. .ENABL LSB DIV50: MOV #50.,R3 ;DIVIDE BY 60 BR 10$ DIV60: MOV #60.,R3 ;DIVIDE BY 60 10$: CLR R0 ;INIT REMAINDER MOV #32.,-(SP) ;SHIFT COUNT (16. FOR S.P.) 20$: ASL R5 ;SHIFT AND SUBTRACT ROL R4 ;(NOT NEEDED FOR S.P.) ROL R0 CMP R0,R3 ;SUB OUT DIVISOR ? BLO 30$ ;NO SUB R3,R0 INC R5 ;ADD IN LOW BIT 30$: DEC @SP ;REPEAT COUNT BNE 20$ TST (SP)+ ;POP SHIFT COUNT RETURN .DSABL LSB .SBTTL DECASC TWO WORD OCTAL TO DECIMAL ASCII CONVERSION ;+ ; INPUT:R0 -> LOW ORDER OF UNSIGNED BINARY NUMBER ; R1 -> HIGH ORDER OF UNSIGNED BINARY NUMBER ; ; OUTPUT:RESULT ALWAYS STORED IN ODNB2 AS 5 DIGIT NUMBER ; R0, R1 AND R4 CLOBBERED ;- DECASC: MOV R2,-(SP) ;SAVE REGISTERS MOV R3,-(SP) ;R2,R3, AND R4 MOV R4,-(SP) MOV #6,R3 ;SET UP 5 ASCII BYTES + DECIMAL POINT MOV #ODNB2+6,R4 ;BLANK ALL 6 CHARS AT START 10$: MOVB #BLANK,-(R4) SOB R3,10$ ;LOOP FOR ALL SIX (R4 -> ODNB2 AT ENDOF LOOP) MOV #5,R3 ;SET UP FOR 5 DECIMAL CHARACTERS CALL CBOMG ;GO TO SET UP ROUTINE MOVB (PC)+,(R4)+ ;PUT IN DECIMAL POINT DECEND: .WORD DOT MOV (SP)+,R4 ;RESTORE REGS MOV (SP)+,R3 MOV (SP)+,R2 RETURN ;RETURN TO MAIN LINE ; FOLLOWING ROUTINES DONATED BY C.G. (CBOMG AND DIV) CBOMG: CALL DIV ;GO TO DIVIDE ROUTINE MOV R2,-(SP) ;SAVE REMAINDER DEC R3 ;ANY DIGITS LEFT? BLE 10$ ;BRANCH IF NOT MOV R0,-(SP) ;TEMP STORE R0 ADD R1,(SP)+ ;ADD TOGETHER, ZERO QUOTIENT? BEQ 10$ ;= -> YES, ZERO CALL CBOMG ;DIVIDE AGAIN 10$: ADD #ZERO,@SP ;MAKE IT ASCII MOVB (SP)+,(R4)+ ;SAVE DIGIT IN MESSAGE (ODNB2:) RETURN ;RETURN DIV: MOV #40,-(SP) ;SET LOOP COUNT MOV #10.,-(SP) ;SAVE RADIX FOR SUBTRACTS CLR R2 ;CLEAR REMAINDER 10$: ASL R0 ;DOUBLE PRECISION LEFT SHIFT ROL R1 ROL R2 CMP R2,@SP ;SUBTRACT OUT DIVISOR BLO 20$ ;LO -> DO NOT SUBT SUB @SP,R2 ;DO IT INC R0 ;ADD IN LOW BIT 20$: DEC 2(SP) ;DECREMENT LOOP COUNT BGT 10$ ;IF GT -> MORE TO DO CMP (SP)+,(SP)+ ;CLEAN STACK RETURN ;RETURN TO SET UP ROUTINE LINE1: .ASCII "RT-11 " .NLCSI TYPE=I,PART=NAME .ASCII " " .NLCSI TYPE=I,PART=RLSVER .ASCII "Monitor Map" DATIME: .BLKB 26. PAGE: .ASCIZ " Page " LINE2: .BLKB 133. CRLF2: .ASCII CRLF: .ASCIZ LINE4: .ASCIZ "Section Addr""Size" MTITL4: .ASCIZ "Global""Value" ODNB2: .BLKB 7. MONTHS: .ASCII /-Jan-Feb-Mar-Apr-May-Jun-Jul-Aug-Sep-Oct-Nov-Dec-/ SAT: .ASCIZ /Satur/ SUN: .ASCIZ /Sun/ MON: .ASCIZ /Mon/ TUE: .ASCIZ /Tues/ WED: .ASCIZ /Wednes/ THU: .ASCIZ /Thurs/ FRI: .ASCIZ /Fri/ DAY: .ASCIZ /day / .EVEN PAGNUM: .BLKW .WORD SAT .WORD SUN .WORD MON .WORD TUE .WORD WED .WORD THU .WORD FRI DAYTAB: MONLEN: .WORD 0-1 ;JANUARY .WORD 31.-1 ;FEBRUARY .WORD 59.-1 ;MARCH .WORD 90.-1 ;APRIL .WORD 120.-1 ;MAY .WORD 151.-1 ;JUNE .WORD 181.-1 ;JULY .WORD 212.-1 ;AUGUST .WORD 243.-1 ;SEPTEMBER .WORD 273.-1 ;OCTOBER .WORD 304.-1 ;NOVEMBER .WORD 334.-1 ;DECEMBER TIME: .BLKW 2 ;HIGH ORDER THEN LOW ORDER LINPPG: .BLKW 1 LINLFT: .BLKW 1 .SBTTL MAPHDR DETERMINE DATE & TIME .PSECT $CODE ;+ ; DATE FORMAT AS RETURNED IN R0 ; 14 10 9 5 4 0 ; +----------------------------------+ ; ! ERA ! MONTH ! DAY !YEAR-72.! ; !(0-3)! 1-12. ! 1-31. ! ! ; +----------------------------------+ ;- MAPHDR:: MOV LINPPG,LINLFT ;INITIALIZE LINES LEFT COUNTER .GTIM #AREA,#TIME ;GET TIME IN TIME AND TIME+2 .DATE ;GET DATE IN R0 MOV #DATIME,R1 ;R1 -> OUTPUT AREA MOV R0,R5 ;COPY IT MOV R0,R2 ;AND AGAIN BEQ 80$ ;WHOOPS! NO DATE! ASL R5 ;ISOLATE DAY IN R5 ASL R5 ASL R5 SWAB R5 BIC #^C<37>,R5 ;R5 = DAY ASR R2 ;ISOLATE MONTH IN R2 SWAB R2 BIC #^C<17*2>,R2 ;R2 = MONTH MOV R0,-(SP) ;SAVE ANOTHER COPY OF DATE WORD SWAB @SP ;GET ERA QUANTITY (0-3) (FROM BITS 14 & 15) ASR @SP ; TIMES 32. BIC #^C140,@SP ; IN @SP BIC #^C<37>,R0 ;GET YEAR IN R0 ADD (SP)+,R0 ;ADD IN ERA*32. SUB #2,R2 ;GET R2= -2 MOV R0,-(SP) ;STACK YEAR ADD #BASEYR,@SP ; FOR DATE CMP @SP,#100. ; PRINTING BLO 10$ ; MODULO SUB #100.,@SP ; 100 10$: MOV R2,-(SP) ;LIKEWISE FOR MONTH MOV R5,-(SP) ;AND DAY ; AT THIS POINT, R0=YEAR - 1972, R5=DAY, R2=-2 ; WE NOW COMPUTE THE DAY-OF-THE-WEEK. MOV R0,-(SP) ;SAVE YEAR DEC R0 ;MAKE LEAP YEAR CORRECTION ASR R0 ASR R0 ADD @SP,R0 INC R0 ADD R0,R5 ;ACCUMULATE DAY BIT #3,(SP)+ ;LEAP YEAR? BNE 20$ ;NOPE - SKIP CORRECTION CMP #2*1,R2 ;AFTER FEBRUARY? ADC R5 ;CORRECT IF SO 20$: ADD MONLEN(R2),R5 ;ADD IN DAYS FROM PREVIOUS MONTHS 30$: SUB #7,R5 ;CHEAPO MODULO 7 BPL 30$ ASL R5 ;MAKE INTO A WORD OFFSET ADD #DAYTAB,R5 ;POINTS INTO TABLE OF PTRS MOV @R5,R5 ;GET PTR TO NAME OF DAY 40$: MOVB (R5)+,(R1)+ ;COPY NAME OF DAY BNE 40$ ;STRING IS TERMINATED BY 0 DEC R1 ;ERASE NULL MOV #DAY,R5 ;POINT TO "DAY " STRING 50$: MOVB (R5)+,(R1)+ ;COPY "DAY " BNE 50$ ;STRING IS TERMINATED BY 0 DEC R1 ;ERASE NULL MOV (SP)+,R0 ;CONVERT DAY CALL CVT2 MOV (SP)+,R0 ;GET -2 ASL R0 ; -4 ADD #MONTHS,R0 MOVB (R0)+,(R1)+ ;MOVE MONTH INTO OUTPUT AREA MOVB (R0)+,(R1)+ MOVB (R0)+,(R1)+ MOVB (R0)+,(R1)+ MOVB (R0)+,(R1)+ MOV (SP)+,R0 ;GET YEAR CALL CVT2 ;AND CONVERT TO ASCII MOVB #BLANK,(R1)+ ;LEAVE A BLANK AFTER DATE MOV TIME,R4 ;(R4,R5) = TIME OF DAY MOV TIME+2,R5 ; IN TICKS PAST MIDNIGHT .GVAL #AREA,#CONFIG ;GET CONFIG WORD TO CHECK ON CLOCK TYPE TST R0 ;KW11L CLOCK PRESENT? BPL 80$ ;NOPE - NO TIME TO OUTPUT BIT #CLK50,R0 ;50 OR 60 CYCLE? BNE 60$ ;IF NE 50 CYCLES CALL DIV60 ;60 CYCLES. DISCARD TICKS BR 70$ 60$: CALL DIV50 ;50 CYCLES. DISCARD TICKS 70$: CALL DIV60 ;DISCARD SECONDS CALL DIV60 ;R0 = MINUTES MOV R0,-(SP) CALL DIV60 ;R0 = HOURS CALL CVT2 ;CONVERT HOURS TO ASCII MOVB #COLON,(R1)+ ;PLUS SEPARATOR MOV (SP)+,R0 ;GET MINUTES CALL CVT2 ;AND CONVERT TO ASCII 80$: CLRB @R1 ;PUT IN NULL STRING TERMINATOR .SBTTL OUTPUT THE HEADERS MOV #LINE2,R1 ;R1 -> ASCII AREA FOR 2ND LINE MOV #FILSPC+2,R3 ;GET BINOUT ADDRESS CALL R50AS2 ;UNPACK FILE NAME MOVB #DOT,(R1)+ ;IND EXTENSION DIVIDER CALL R50ASC ;UNPACK THE EXTENSION MOVB #BLANK,@R1 MOVB (R1)+,@R1 MOVB (R1)+,@R1 90$: CLR PAGNUM ;INIT PAGE NUMBER CALL HEADER MAPOUT #LINE4 MOVB NUMCOL,R4 ;GET #COLUMNS 100$: MAPOUT #MTITL4 ;PRINT ENTRY HDR DEC R4 ;MORE? BGT 100$ ; MAPOUT #CRLF ; MAPOUT #CRLF ; RETURN .SBTTL ERRMSG - PROCESS ERROR MESSAGES ;+ ; ERRMSG ; ; This routine is passed the address of an error message block ; which consists of the following: ; ; .WORD argument routine ; used to change args to ASCII ; [.WORD argument list ; list of address(es) for routine] ; .Byte User Error byte value ; mask for user error byte (level) ; {.Byte 0 ; if no message} ; or ; {.Byte severity letter ; Ascii severity level letter} ; {.ASCIZ message ; message text} ; ; It is called by: ; ; JSR R0,ERRMSG ; .WORD MSGBLK ; address of message block ;- .Enable LSB ErrMsg: Mov SP,HadErr ; indicate error has happened Mov R0,-(SP) ; save "return" address Add #2,@SP ; skip arg word to return address Mov @R0,R0 ; get address of error code/message Call @(R0)+ ; do action routine BisB (R0)+,@#USERRB ; set error byte TstB M.Msg-M.Sev(R0) ; any message? Boff 10$ ; no Mov R0,-(SP) ; save message address .Print #Prefix ; prefix message Mov (SP)+,R0 ; get message address .Print ; print error message 10$: Mov (SP)+,R0 ; restore return address Rts R0 .SBTTL ERROR MESSAGE FORMATTING ROUTINES Device: Mov R1,-(SP) ; and old R1 Mov (R0)+,R1 ; get address of buffer Mov R0,-(SP) ; save new R0 value Mov #ErrBuf+2,R0 ; point to string buffer Clr @R0 ; truncate at device name Mov @R3,-(R0) ; get RAD50 for DEV Br CalFnA ; join common code ErrBuf: .BLKW 2 Files: Call File Mov R1,-(SP) Mov -2(R0),R1 20$: TstB (R1)+ Bne 20$ Dec R1 MovB #BLANK,(R1)+ MovB #'a,(R1)+ MovB #'n,(R1)+ MovB #'d,(R1)+ MovB #BLANK,(R1)+ Mov R4,R3 Br File1 File: Mov R1,-(SP) ; save old R1 Mov (R0)+,R1 ; get address File1: Mov R0,-(SP) ; save new R0 value Mov R3,R0 ; point to RAD50 DBlk CalFnA: Call $FnAsc ; use ULB routine to convert ClrB (R1)+ ; end string with null .Br R01Ret ; restore R0, R1 and return R01Ret: Mov (SP)+,R0 ; restore R0 Mov (SP)+,R1 ; and R1 Nothin: RtsPC: Return ; used by Physical only requests .SBTTL MESSAGES VERSN:: .NLCSI Prefix: .ASCII "?" .NLCSI TYPE=I,PART=NAME .ASCII "-"<200> M.Subr =: 0 ; subroutine in message block M.Out =: 2 ; subr output pointer M.Out2 =: 4 ; subr 2nd output pointer ; any args for subr are skipped ; by subr, leaving pointer at ; M.Num M.Num =: 2 ; message number M.Levl =: 3 ; error level mask M.Sev =: 4 ; severity level M.Msg =: 5 ; message text Sev.I =: 'I ; Info level Sev.W =: 'W ; Warning level Sev.E =: 'E ; Error level Sev.F =: 'F ; Fatal level Sev.U =: 'U ; Unconditional level ;+ ;ERROR .EVEN MsgAOK: .WORD Nothin ; no message processing .ASCIZ "" ; and no message (. is success) ;- ;+ ;ERROR .EVEN MsgCsi: .WORD Nothin ; no message processing .ASCIZ "-Invalid Command" ;+ ;CSI error ;retry after correcting syntax error ;- ;+ ;ERROR .EVEN MsgPFE: .WORD File,ChrPFE .ASCII "-File created; " .ASCII "protected file already exists " ChrPFE: .BLKB 14. ; DEV:FILENA.TYP .ASCIZ "" ;+ ;protected file was created behind our back. created file is not ;protected and has the same name as another file that is protected ;delete one of the duplicate files after unprotecting, if necessary ;retry, if necessary with unique name ;- ;+ ;ERROR .EVEN MsgDev: .WORD Device,ChrDev .ASCII "-Invalid device " ChrDev: .BLKB 4. ; DEV: .ASCIZ "" ;+ ;device name specified has no installed handler ;retry by specifing installed device or installing required device ;- ;+ ;ERROR .EVEN MsgDvF: .WORD File,ChrDvF .ASCII "-Device full " ChrDvF: .BLKB 14. ; DEV:FILENA.TYP .ASCIZ "" ;+ ;device or its directory does not have enough space to create file specified ;retry is to free up space on device or directory or use another device ;- ;+ ;ERROR .EVEN MsgFNF: .WORD File,ChrFNF .ASCII "-File not found " ChrFNF: .BLKB 14. ; DEV:FILENA.TYP .ASCIZ "" ;+ ;input file specified does not exist ;retry is to specify a valid input file ;- ;+ ;ERROR .EVEN MsgIEr: .WORD File,ChrIEr .ASCII "-Input error " ChrIEr: .BLKB 14. ; DEV:FILENA.TYP .ASCIZ "" ;+ ;error reading from specified input file ;retry is to specify a valid input file and to make sure it contains ;no bad blocks ;- ;+ ;ERROR .EVEN MsgInt: .WORD Nothin .ASCIZ "-Internal error" ;+ ;An internal logic error has occurred ;spr ;- ;+ ;ERROR .EVEN MsgPro: .WORD File,ChrPro .ASCII "-Protected file already exists " ChrPro: .BLKB 14. ; DEV:FILENA.TYP .ASCIZ "" ;+ ;protected file already exists ;retry by unprotecting and deleting offending file or specify a unique ;file ;- ;+ ;ERROR .EVEN MsgOEr: .WORD File,ChrOEr .ASCII "-Output error " ChrOEr: .BLKB 4. ; DEV:FILNA.TYP .ASCIZ "" ;+ ;error writing specified output file ;retry is to check output device for bad blocks and specify output file ;on disk having no bad blocks available for file allocation ;- ;+ ;ERROR .EVEN MsgIFF: .WORD File,ChrIFF .ASCII "-Invalid file format " ChrIFF: .BLKB 14. ; DEV:FILNAM.TYP .ASCIZ "" ;+ ;input file data is not formatted correctly ;retry with proper file ;- ;+ ;ERROR .EVEN MsgSOv: .WORD Nothin .ASCIZ "-Insufficient memory" ;+ ;not enough room to handle all of the global symbols in map file ;try freeing up low memory so more is available for symbol table usage ;or run under VBGEXE in XM ;- ;+ ;ERROR .EVEN MsgInc: .WORD Files,ChrIn1 .ASCII "-Incompatible input files " ChrIn1: .BLKB 33. ; DEV:FILNA.TYP and DEV:FILNA.TYP .ASCIZ "" ;+ ;map files are not compatible ;make sure that input files are properly generated by monitor ;build procedure ;- .PSECT LINBUF,RW,D,GBL,REL,OVR LINE:: .BLKB 132. LINPTR::.BLKW 1 ENDLIN::.BLKW 1 CHRBUF::.BLKW 1 .PSECT IOBUFF,RW,D,GBL,REL,OVR BUFF:: .BLKB 512. BUFPTR::.BLKW 1 BLKNUM::.BLKW 1 RDCHAN::.BLKW 1 FILPTR: .BLKW 1 EOFHIT::.BLKB 1 .EVEN .PSECT $VARS DEFEXT::.RAD50 "SYS" .RAD50 "SYS" .RAD50 "MAP" .RAD50 " " HADERR: .BLKW 1 CSTBLK::.BLKW 6. FILSPC::.BLKW 39. FILELN::.BLKW 4. AREA:: .BLKW 10. .PSECT ABSDAT,RW,D,GBL,REL,OVR ASECT:: .BLKW 1 ABSSIZ::.BLKW 1 ABSHOL::.BLKW 1 .PSECT SYMDAT,RW,D,GBL,REL,OVR UNULL:: .BLKW 1 UTAIL:: .BLKW 1 UHEAD:: .BLKW 1 NULL:: .BLKW 1 CUR:: .BLKW 1 TAIL:: .BLKW 1 HEAD:: .BLKW 1 STSIZE::.BLKW 1 STLEN:: .BLKW 1 STDIV:: .BLKW 1 STINCR::.BLKW 1 STEND:: .BLKW 1 SYMTBL: .BLKW 1 HNDTOP: .BLKW 1 LOLIM:: .LIMIT HILIM ==: LOLIM+2 .END MONMRG