.TITLE EXR -- Record extractor .Ident -V1.1b- ; ; ; * * ** ** *** ** * * ; ** ** * * * * * * * * ** ** ; * * * **** * *** * * * * ; * * * * * * * * * * * * ; * * * * ** * * ** *** *** ; ; ; ---------------------------------------------------------------- ; A S E A B R O W N B O V E R I I N D U S T R I E B. V. ; ---------------------------------------------------------------- ; ; Copyright (c) Asea Brown Boveri Industrie B.V. ; Alle rechten voorbehouden ; ; Afdeling VUA ; Tel. 010 - 4078911 (centrale) ; ; Adres Marten Meesweg 5 ; 3068 AV ROTTERDAM ; Postadres Postbus 301 ; 3000 AH ROTTERDAM ; . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . . ; ; Filenaam EXR.MAC ; Taal MACRO-11 ; ; Datum originele versie 2-Feb-88 ; Originele versie door J.H. Hamakers ; Tel. intern 631 ; ; ; Assembleren: ; ; EXR,EXR/-SP=EXR ; ; Taskbuilden: ; ; EXR/CP,EXR/-sp=EXR ; / ; TASK=...EXR ; ; Starten: ; ; INS EXR ; ; EXR outfile[.EXR]=]infile[.LST][/SL] ; ; Korte beschrijving: ; ; Extracts records from direct accessfiles ; ; --------------------- ; W I J Z I G I N G E N ; --------------------- ; datum inhoud A.trail versie ; ----- ------ ------ ------ ; 31-Oct-88 Add real format JHA01 1.1a ; 12-Jan-89 Fix error in help display JHA02 1.1b ; .ENABL MCL ; FCSMC$ ; ; Logical units ; INPLUN = 1 OUTLUN = 2 CSILUN = 3 MSGLUN = 4 ; ; Other definitions ; OFFSET = 128. ; Offset in message file MAXDPT = 1 ; Nesting depth @ BUFSIZ = 3072. ; Input buffersize ; CR = 15 LF = 12 TAB = 11 FF = 14 ; ; RECL=INPFDB+F.NRBD ; Record length ; .MACRO ERRMSG NUM,CTRL MOV #MSG'NUM,R1 ; Message address MOV #MSL'NUM,R2 ; Message length .IF B MOV #40,R3 .IFF MOV #'CTRL,R3 .ENDC JMP ERROR ; => ERROR .ENDM ; .MACRO SPACE NUM .IF B MOVB #40,(R0)+ .IFF .REPT NUM MOVB #40,(R0)+ .ENDR .ENDC .ENDM .NLIST BEX ; ; FSRSZ$ 3 ; Max. 3 files open at same time ; GCMBLK: GCMLB$ MAXDPT,EXR,,CSILUN ; CSI$ ; CSIBLK: .BLKB C.SIZE ; SWBLK: ; CSI$SW WO,TP.WOR,TYPE,SET CSI$SW BY,TP.BYT,TYPE,SET CSI$SW OC,TP.OCT,TYPE,SET CSI$SW DC,TP.DEC,TYPE,SET CSI$SW AS,TP.ASC,TYPE,SET CSI$SW RA,TP.RAD,TYPE,SET CSI$SW DO,TP.ODC,TYPE,SET CSI$SW FO,TP.OFO,TYPE,SET CSI$SW HE,TP.HLP,TYPE,SET CSI$SW RE,TP.REA,TYPE,SET ;JHA01 CSI$SW RC, , , ,,SVBLK CSI$ND 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.DEC = 20 ; - /DC decimal TP.OCT = 40 ; - /OC octal TP.ODC = 100 ; - /DO decimal offsets TP.OFO = 200 ; - /FO offsets TP.HLP = 400 ; - /HE Help requested TP.REA = 1000 ; - /RE Real format ;JHA01 ; TP.FRM = 1017 ; - Format bits ;JHA01 TP.RDX = 1074 ; - Radix bits ;JHA01 ; TP.DFT = 42 ; - Defaults TP.SWI = 1777 ; - Switch bits ;JHA01 ; SVBLK: CSI$SV DECIMAL,STRREC,2 CSI$SV DECIMAL,ENDREC,2 ; STRREC: 0 ; Start record ENDREC: 0 ; End record ; ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; ; File control block for output ; OUTFDB: FDBDF$ ; FDAT$A R.VAR,FD.CR ; FDOP$A OUTLUN,OUTDSD,OUTDFB,FO.WRT,FA.ENB!FA.DLK ; ; OUTDFB: NMBLK$ ,EXR,,SY,0 ; Defaults ; OUTDSD: .BLKW 6 ; OUT descriptor ; OUTDV: .ASCII /TI0:/ ; Default device for no filespec. OUTDVL =.-OUTDV ; .EVEN ; ; ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; ; File control block for input ; INPFDB: FDBDF$ ; FDRC$A FD.RAN,INPBUF,BUFSIZ ; FDOP$A INPLUN,INPDSD,INPDFB,FO.RD ; ; INPDFB: NMBLK$ ,DAT,,SY,0 ; Defaults ; INPDSD: .BLKW 6 ; INP descriptor ; ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; ; File control block for error messages ; MSGFDB: FDBDF$ ; FDRC$A FD.RAN ; FDOP$A MSGLUN,MSGDSD,,FO.RD ; ; MSGDSD: MSGDVL,MSGDV,MSGDRL,MSGDR,MSGFLL,MSGFL ; Data set descr. ; MSGDV: .ASCII /LB0:/ ; MSGDVL =.-MSGDV ; .EVEN ; MSGDR: .ASCII /[1,2]/ ; MSGDRL =.-MSGDR ; .EVEN ; MSGFL: .ASCII /QIOSYM.MSG/ ; MSGFLL =.-MSGFL ; .EVEN ; ; ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ; ; Messages ; MSG1: .ASCII /EXR -- Indirect file open or read error/ MSL1 =.-MSG1 ; MSG2: .ASCII /EXR -- Syntax error/ MSL2 =.-MSG2 ; MSG3: .ASCII /EXR -- Illegal switch/ MSL3 =.-MSG3 ; MSG4: .ASCII /EXR -- Too many input specifiers/ MSL4 =.-MSG4 ; MSG5: .ASCII /EXR -- Too many output specifiers/ MSL5 =.-MSG5 ; MSG6: .ASCII /EXR -- No wildcards allowed/ MSL6 =.-MSG6 ; MSG7: .ASCII /EXR -- No input filename specified/ MSL7 =.-MSG7 ; MSG8: .ASCII /EXR -- Switch combination error/ MSL8= .-MSG8 ; MSG9: .ASCII /EXR -- File is not a "Fixed-length-record" file/ MSL9= .-MSG9 ; MSGH: .ASCII ~EXR -- Examine records V1.1a~ ;JHA01 .ASCII .ASCII ~ >EXR [outfile.EXR=]infile.DAT/sw1..../swn~ .ASCII .ASCII ~ /HE Display HELP text~ .ASCII .ASCII ~ /BY /OC,/DC Display Octal/Decimal Bytes~ .ASCII .ASCII ~ /WO /OC,/DC Display Octal/Decimal Words~ .ASCII .ASCII ~ /RA Display RAD50 Words ~ .ASCII .ASCII ~ /AS Display ASCII Bytes~ .ASCII ;JHA01 .ASCII ~ /RE Display Reals~ ;JHA02 .ASCII .ASCII ~ /DO Display Decimal Offsets~ .ASCII .ASCII ~ /FO Use FORTRAN Offsets~ .ASCII .ASCII ~ /RC:n Display only record n~ .ASCII .ASCII ~ /RC:n:m Display only record n..m~ .ASCII .ASCII ~ Default switches : /BY /OC~ .ASCII MSLH=.-MSGH ; MSGE: .ASCII /EXR -- / MSDE: .ASCII / . Record(s) listed/ MSLE =.-MSGE ; MSGT: .ASCII /EXR -- Records extracted from / MSDT: .BLKB 13. MSLT =.-MSGT ; MSGL: .ASCII / Record : / MSD1L: .ASCII / . length : / MSD2L: .ASCII / . byte(s)/ MSLL =.-MSGL .EVEN ; MSGU: .ASCII /EXR -- Error occurded, LB:[1,2]QIOSYM.MSG read error/ MSLU =.-MSGU ; MSGX: .ASCII /EXR -- / MSGXT: .BLKB 64. ; Error text MSLX =.-MSGX .EVEN ; 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 " .ASCII "del" .EVEN ; ELCNT: 0 ; Element counter STACK: 0 ; Initial stack pointer OUTFLG: 0 ; Output Specified NAMFLG: 0 ; OUT Name specified INPSIZ: 0 ; BIT7: 0 ; Bit 7 flag RECCNT: 0 ; EXSTA: EX$SUC ; Exit status INPBUF: .BLKB BUFSIZ ; .EVEN ; OUTBUF: .BLKB 82. ; .EVEN ; ; ; START: FINIT$ ; Init FSR MOV SP,STACK ; Save initial stack value ; ; Clear junk from previous runs ..... ; MOV #6,R1 ; MOV #OUTDSD,R2 ; MOV #INPDSD,R3 ; 10$: CLR (R2)+ ; CLR (R3)+ ; SOB R1,10$ ; ; CLR OUTFLG ; CLR NAMFLG ; CLR TYPE ; Clear old switches CLR STRREC ; Start record CLR ENDREC ; End record ; ; Commandline fetch ..... ; MOV #GCMBLK,R0 ; R0 => Commandlineblock GCML$ R0 ; Get commandline BCC CSISYN ; Ok ? yes: => csisyn CMPB G.ERR(R0),#GE.EOF ; End of file BNE 30$ ; no: => 30$ JMP EXIT ; Exit ; ; Indirect file open or read error ..... ; 30$: MOV #EX$SEV,EXSTA ; Severe error ERRMSG 1 ; ; CSI syntax test ..... ; CSISYN: MOV #EX$SEV,EXSTA ; Assume Severe error MOV G.CMLD+2(R0),R1 ; Copy buffer address MOV G.CMLD (R0),R2 ; Copy buffer length MOV #CSIBLK,R0 ; R0 => CSI block CSI$1 R0,R1,R2 ; Test syntax BCC GETOUT ; Ok ? yes: => GETOUT ; ; Syntax error ..... ; ERRMSG 2 .SBTTL Get OUT specifier ..... ; GETOUT: CSI$2 R0,OUTPUT,#SWBLK ; Get OUT specifier BCC 10$ ; Ok ? yes: => 10$ ; ; Illegal switch ..... ; ERRMSG 3 10$: BIT #TP.HLP,TYPE ; Help requested ? BEQ 20$ ; No => 20$ ; ERRMSG H ; Helptext ; 20$: BITB #CS.MOR,C.STAT(R0) ; More files specified ? BEQ 30$ ; no: => 30$ ; ; Too many output specifiers ..... ; ERRMSG 5 30$: BITB #CS.WLD,C.STAT(R0) ; Wildcards used ? BEQ 40$ ; no: => 40$ ; ; No wildcards allowed ..... ; ERRMSG 6 40$: BITB #CS.NMF!CS.DIF!CS.DVF,C.STAT(R0) ; Something specified ? BNE 60$ ; No : => 60$ 50$: MOV #OUTDV ,OUTDSD+2; Default device MOV #OUTDVL,OUTDSD ; for no filespec BR GETINP ; => GETINP 60$: INC OUTFLG ; Set Output flag BITB #CS.NMF,C.STAT(R0) ; Filename specified ? BEQ 80$ ; No: => 80$ 70$: INC NAMFLG ; Set name flag ; ; Copy address and length of filename ..... MOV C.FILD+2(R0),OUTDSD+12 MOV C.FILD (R0),OUTDSD+10 ; 80$: ; ; Copy address and length of directory ..... MOV C.DIRD+2(R0),OUTDSD+6 MOV C.DIRD (R0),OUTDSD+4 ; ; Copy address and length of device ..... ; MOV C.DEVD+2(R0),OUTDSD+2 MOV C.DEVD (R0),OUTDSD .SBTTL Get INP specifier ; GETINP: CSI$2 R0,INPUT,#SWBLK ; Get INP specifier BCC 10$ ; Ok ? yes: => 10$ ; ; Illegal switch ..... ; ERRMSG 3 10$: BITB #CS.MOR,C.STAT(R0) ; More specifiers ? BEQ 20$ ; no: => 20$ ; ; Too many input specifiers ..... ; ERRMSG 4 20$: BITB #CS.WLD,C.STAT(R0) ; Wildcards used ? BEQ 30$ ; no: => 30$ ; ; No wildcards allowed ..... ; ERRMSG 6 30$: BITB #CS.NMF!CS.DIF!CS.DVF,C.STAT(R0) ; Something specified ? BNE 50$ ; Yes: => 50$ TST OUTFLG ; Output Specified ? BNE 40$ ; Yes: => 40$ ; ; Nothing specified; restart ..... ; MOV #EX$SUC,EXSTA ; Success error JMP START ; Prompt again 40$: ; ; Copy output spec. to input spec. ..... ; ; ; Copy address and length of filename ..... ; MOV OUTDSD+12,INPDSD+12 MOV OUTDSD+10,INPDSD+10 ; ; Copy address and length of directory ..... ; MOV OUTDSD+6 ,INPDSD+6 MOV OUTDSD+4 ,INPDSD+4 ; ; Copy address and length of device ..... ; MOV OUTDSD+2 ,INPDSD+2 MOV OUTDSD ,INPDSD ; ; Take default device for output ..... ; MOV #OUTDV ,OUTDSD+2; Default device OUT MOV #OUTDVL,OUTDSD ; for no filespec CLR OUTFLG ; Clear output flag BR 110$ ; => 110$ 50$: BITB #CS.NMF,C.STAT(R0) ; Filename specified ? BNE 70$ ; Yes: => 70$ TST OUTFLG ; Output specified ? BEQ 60$ ; No : => 60$ TST NAMFLG ; Name specified ? BNE 70$ ; Yes: => 70$ 60$: ; ; No file name specified ..... ; ERRMSG 7 70$: ; ; Copy address and length of filename ..... ; MOV C.FILD+2(R0),INPDSD+12 MOV C.FILD (R0),INPDSD+10 ; ; Copy address and length of directory ..... ; MOV C.DIRD+2(R0),INPDSD+6 MOV C.DIRD (R0),INPDSD+4 ; ; Copy address and length of device ..... ; MOV C.DEVD+2(R0),INPDSD+2 MOV C.DEVD (R0),INPDSD ; ; Skip extension for defaultname ..... ; MOV C.FILD+2(R0),R5 ; Copy address CMPB (R5),#'. ; Is it a "." ? BNE 80$ ; no : => 80$ ; ; No input filename specified ..... ; ERRMSG 7 80$: TST NAMFLG ; Name specified ? BNE 110$ ; Yes: => 110$ MOV C.FILD(R0),R1 ; Length MOV R1,INPSIZ ; of filename CLR R2 ; Clear count 90$: CMPB (R5)+,#'. ; Is it a "." ? BEQ 100$ ; Yes => 100$ INC R2 ; Inc count SOB R1,90$ ; No => 90$ 100$: MOV INPDSD+12,OUTDSD+12 ; Addr of INPfile MOV R2 ,OUTDSD+10 ; Size of INPfile 110$: .SBTTL Preparation for algo ; PREP: ; ; Test switch combinations ..... ; MOV #^C TP.FRM,R0 ; /WO /BY /AS /RA /RE CALL TSTBIT ; More than 1 bit set ? BCS 20$ ; Yes : => 20$ ; BIT #^C TP.RDX,R0 ; /OC /DC /AS /RA /RE CALL TSTBIT ; More than 1 bit set ? BCC 30$ ; No : => 30$ 20$: ; ERRMSG 8 ; ; 30$: ; BIT #TP.SWI,TYPE ; Switches specified ? BNE 40$ ; Yes : => 40$ BIS #TP.DFT,TYPE ; Take default BR 60$ ; => 60$ 40$: BIT #TP.FRM,TYPE ; Any of /WO /BY /AS /RA /RE set ? BNE 50$ ; Yes : => 50$ MOV #TP.DFT,R0 ; Take default BIC #^C TP.FRM,R0 ; Mask format bits BIS R0,TYPE ; Insert form bits 50$: BIT #TP.OCT!TP.DEC,TYPE ; Any of /OC /DC set ? BNE 60$ ; Yes : => 60$ MOV #TP.DFT,R0 ; Take default BIC #^C TP.RDX,R0 ; Mask radix bits BIS R0,TYPE ; Insert radix bits 60$: ; ; Normalize recordnumbers ..... ; TST STRREC ; Startrecord specified ? BNE 70$ ; Yes => 70$ INC STRREC ; Take 1st record DEC ENDREC ; Until max. 70$: TST ENDREC ; Endrecord specified ? BNE 80$ ; Yes => 80$ MOV STRREC,ENDREC ; Take 1st record 80$: ; ; Copy filename ..... ; MOV INPDSD+12,R0 ; R0 => Filename MOV INPDSD+10,R1 ; R1 = Length MOV #MSDT,R2 ; R2 => TITLE MOV #13.,R3 ; R3 = Max length 90$: TST R1 ; + BEQ 100$ ; MOVB (R0)+,(R2)+ ; DEC R1 ; BR 110$ ; Copy file name 100$: ; MOVB #' ,(R2)+ ; 110$: ; SOB R3,90$ ; - ; .SBTTL Open files ; OPEN: OPEN$R #INPFDB,,,,,,FCSER ; Open input file OPEN$W #OUTFDB,,,,,,FCSER ; Open output file MOV #EX$SUC,EXSTA ; Success status ; CMPB INPFDB+F.RTYP,#R.FIX ; Fixed length records ? BEQ 10$ ; Yes : => 10$ ; ERRMSG 9 ; 10$: .SBTTL Algorithm ALGO: MOV #MSLT,R4 ; + MOV #MSGT,R1 ; Output Header line CALL PUT ; - LOOP: CALL GET ; Get record MOV #MSD1L,R0 ; Record MOV STRREC,R1 ; number DEC R1 ; Normalize MOV #27012,R2 ; Convert decimal CALL $CBTA ; Convert MOV #MSD2L,R0 ; Record MOV RECL,R1 ; Length MOV #23012,R2 ; Convert decimal CALL $CBTA ; Convert MOV #MSLL,R4 ; + MOV #MSGL,R1 ; Output Record Header line CALL PUT ; - ; ; Prepare for datalines ..... ; MOV RECL,R4 ; R4 = Recordlength MOV #INPBUF,R3 ; R3 => Input buffer MOV #OUTBUF,R0 ; R0 => Output buffer CLR -(SP) ; Stack = elementpointer CALL OFFS ; Insert offset ; ; Go via conversion routines ..... ; BIT #TP.BYT,TYPE ; Bytes ? BEQ ASCII ; No : => test 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 ; CALL OFFS ; Insert offset 40$: SOB R4,10$ ; Do all JMP DONE ; And done .SBTTL ASCII -- List ASCII ; ASCII: BIT #TP.ASC,TYPE ; Ascii ? BEQ WORD ; No : => test 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 ; "del" ? BNE 30$ ; No : => 30$ MOV #41,R5 ; Replace BR 40$ ; => 40$ 30$: CMP R5,#40 ; Visable ? BHI 80$ ; Yes : => 80$ 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 ; CALL OFFS ; Insert offset 110$: DEC R4 ; Last ? BEQ 120$ ; Yes : => 120$ JMP 10$ ; Loop back 120$: JMP DONE ; Done ; .SBTTL WORD -- List WORDS ; WORD: BIT #TP.REA,TYPE ; Real ? BNE REAL ; Yes : => REAL ASR R4 ; Make word count 10$: ; ; Octal, decimal and RAD50 words ; ============================== ; MOV (R3)+,R1 ; Get data ; 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 SPACE ; 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 ; CALL OFFS ; Insert offset 90$: DEC R4 ; Last ? BEQ 100$ ; Yes : => 100$ JMP 10$ ; Loop back 100$: JMP DONE ; Done .SBTTL REAL -- List REAL ; REAL: ASR R4 ; Make ASR R4 ; Real count MOV #R.DOT!R.TRA,$DSPST ; +TRA, -LEA, -LFT + DOT 10$: MOV R0,-(SP) ; ASCII field address MOV #14.,-(SP) ; Fieldwidth MOV #4.,-(SP) ; D-fraction CLR -(SP) ; Scale factor MOV 2(R3),-(SP) ; Get MOV (R3)+,-(SP) ; data TST (R3)+ ; CALL $FOUTP ; Convert ADD #14.,R0 ; Update R0 SPACE 3 ; Set spaces INC (SP) ; One more CMP (SP),#4. ; Done 4 words ? BNE 30$ ; No : => 30$ CLR (SP) ; Reset counter CALL NEWLIN ; CALL OFFS ; Insert offset 30$: SOB R4,10$ ; Last ? DONE: TST (SP)+ ; Pending output ? BEQ 10$ ; No : => 10$ CALL NEWLIN ; 10$: JMP LOOP ; Next record ; .SBTTL OFFS -- Subroutine offset ; OFFS: SPACE 2 ; Insert 2 spaces MOV R3,R1 ; R1 => Element SUB #INPBUF,R1 ; R1 = Element # BIT #TP.OFO,TYPE ; FORTRAN offsets ? BEQ 10$ ; No : => 10$ INC R1 ; Add one 10$: MOV #21010,R2 ; Asume octal BIT #TP.ODC,TYPE ; Decimal ? BEQ 20$ ; No : => 20$ MOV #21012,R2 ; Convert decimal 20$: CALL $CBTA ; Convert SPACE ; Insert space BIT #TP.ODC,TYPE ; Decimal ? BEQ 30$ ; No : => 30$ MOVB #'.,-1(R0) ; Insert "." 30$: SPACE ; Insert space MOVB #':,(R0)+ ; Insert ":" SPACE 2 ; Insert 2 spaces RETURN ; ; .SBTTL NEWLIN -- Subroutine newline ; NEWLIN: MOV #OUTBUF,R1 ; R1 => OUTBUF SUB R1,R0 ; R0 = Length MOV R4,-(SP) ; Save input record length MOV R0,R4 ; R4 = Length CALL PUT ; Output record MOV (SP)+,R4 ; Restore length MOV #OUTBUF,R0 ; R0 => OUTBUF RETURN ; .SBTTL TSTBIT -- Subroutine testbit ; TSTBIT: MOV TYPE,R1 ; Take type BIC R0,R1 ; Leave bits BEQ 20$ ; None specified : => 20$ 10$: ASR R1 ; Shift right ... BCC 10$ ; until there is a carry BNE 30$ ; Another bit set : => 30$ 20$: CLC ; OK 30$: RETURN ; .SBTTL Finishing ; END: MOV #MSDE,R0 ; R0 => ASCII-buffer MOV RECCNT,R1 ; R1 = Binary value BNE 10$ ; Foud a record ? => 10$ MOV #EX$WAR,EXSTA ; Warning error 10$: MOV #17012,R2 ; R2 = Parameters CALL $CBTA ; Convert ; TST OUTFLG ; Output to file ? BEQ 20$ ; No : => 20$ MOV #MSLE,R4 ; + MOV #MSGE,R1 ; Output Header line CALL PUT ; - 20$: ERRMSG E ; EXIT: EXST$S EXSTA ; Exit with status ; .SBTTL Subroutine GET ; ; Read input file ; GET: ; ; Determine recordnumber ..... ; TST STRREC ; Did we go round ? BEQ 10$ ; Yes : => 10$ CMP STRREC,ENDREC ; Last record done ? BHI 10$ ; Yes : => 10$ ; ; Get record ..... ; GET$R #INPFDB,#INPBUF,#BUFSIZ,STRREC,#0 BCC 30$ ; Ok ? yes: => 30$ CMPB #IE.EOF,INPFDB+F.ERR ; Is it eof ? BNE 20$ ; No: => 20$ 10$: MOV #END,(SP) ; Change endaddress BR 40$ ; 20$: CALLR FCSER ; Other error 30$: INC RECCNT ; One more INC STRREC ; Next record 40$: RETURN ; .SBTTL Subroutine PUT ; ; Write to output file ; PUT: TST R4 ; We don't put empty ones BEQ 10$ ; PUT$ #OUTFDB,R1,R4,FCSER ; There you go 10$: RETURN ; .SBTTL IO/FCS/DIRECTIVE error handling ; DRERR: MOVB (R0),R1 ; Error code MOVB #-1,R2 ; Dsw error BR COMMON ; => COMMON ; FCSER: MOVB F.ERR(R0),R1 ; Error code MOVB F.ERR+1(R0),R2 ; Error ident ; COMMON: OPEN$R #MSGFDB,,,,,,ER ; Open qiosym.msg NEG R1 ; Make it positive TSTB R2 ; I/O - error ? BEQ 10$ ; yes: => 10$ ADD #OFFSET,R1 ; Take offset to dsw - codes 10$: MOV #EX$SEV,EXSTA ; Severe status GET$R #MSGFDB,#MSGXT,#64.,R1,#0,ER ; Get record CLOSE$ #MSGFDB ; Close file ERRMSG X ER: ERRMSG U ERROR: ; ; Close all files even when they were not open to ensure correct handling ; CLOSE$ #INPFDB ; Close input file CLOSE$ #OUTFDB ; Close outputfile ; ; Set stack back to initial value ; MOV STACK,SP ; Reset stack ; ; Message ; TST R1 ; Any message ? BEQ 30$ ; No : => 30$ QIOW$S #IO.WVB,#CSILUN,#1,,,, 30$: JMP START ; ; .END START