.TITLE TECOIO - RSX-11D/11M I/O PACKAGE FOR PDP-11 TECO .SBTTL TITLE PAGE .IDENT "R0115" ; ; COPYRIGHT (C) 1975, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. ; COPYRIGHT (C) 1974, DIGITAL EQUIPMENT CORP., MAYNARD, MASS. ; ; THIS SOFTWARE IS FURNISHED TO PURCHASER UNDER A LICENSE FOR USE ; ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED (WITH INCLUSION ; OF DEC'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT ; AS MAY OTHERWISE BE PROVIDED IN WRITING BY DEC. ; ; THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT ; NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL ; EQUIPMENT CORPORATION. ; ; DEC ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY ; OF ITS SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DEC. ; ; ANDREW C. GOLDSTEIN 3 NOV 75 17:24 ; PETER H. LIPMAN 30 AUG 1974 ERRTXT = 1 ; SET TO 0 TO SUPPRESS LONG ERROR MESSAGES R$$11M = 0 ; 0 FOR RSX11D, 1 FOR RSX11M ; .IF EQ,R$$11M $DSW = 0 ; DIRECTIVE STATUS WORD ADDRESS FOR RSX11D RNEPAL = 1 ; READ NO ECHO PASS ALL IS AVAILABLE IN RSX11D R$$DYM = 0 ; RSX11D HAS NO DYNAMIC MEMORY FEATURE YET .IFF RNEPAL = 1 ; NOT AVAILABLE IN RSX11M - REDEFINE WHEN IT IS R$$DYM = 1 ; RSX11M HAS DYNAMIC MEMORY LOGIC .ENDC .SBTTL SYSTEM MACRO CALLS ; CALL FCS MACROS AND GET DATASET POINTER DEFINITIONS. .MCALL FCSMC$,FCSBT$,CSI$,CSI$1,CSI$2 FCSMC$ FCSBT$ CSI$ ; GET OTHER RANDOM MACROS. .MCALL CALL,RETURN,GLUN$C .MCALL OFNB$R,OFNB$W,OFNB$A .MCALL WSIG$S,GMCR$,GTIM$C,GSSW$S,GPRT$C,GTSK$C .MCALL RQST$C,CSI$SW,CSI$ND,DIR$,EXIT$S ; .IF EQ,R$$11M .MCALL QIOW$S,QIOW$C,QIOW$,MOUT$S .IFF .MCALL QIO$S,QIO$C,QIO$,WTSE$ .ENDC .SBTTL INTERNAL MACROS ; MACRO TO SIGNAL AN ERROR EXIT. IT CAUSES TECOIO TO MAKE AN ; ERROR RETURN WITH THE C BIT SET, A 3 CHARACTER RAD-50 ERROR ; CODE IN R1, AND A POINTER TO AN ERROR TEXT STRING IN R2. ; THE STRING AND POINTER ARE SUPPRESSED IF THE SYMBOL "ERRTXT" ; IS DEFINED AS ZERO. THE MACRO OPTIMIZES OUT REDUNDANT ERROR ; STRINGS. .MACRO ERROR CODE,TEXT .IF NDF,$E$'CODE $E$'CODE: .IFF .IF EQ,.-$E$'CODE $E$'CODE: .ENDC .ENDC .IF GE,.-$E$'CODE-400 JMP $E$'CODE .MEXIT .ENDC .IF NE,.-$E$'CODE BR $E$'CODE .MEXIT .ENDC JSR R5,ERRORX .RAD50 "CODE" .IF NE,ERRTXT .ASCIZ TEXT .EVEN .ENDC .ENDM ERROR ; MACRO TO CALL GENERAL REGISTER SAVE ROUTINE. SAVE DOES A COROUTINE ; RETURN SO THAT AN RTS PC WILL DO A PROPER RESTORE AND RETURN. .MACRO SAVE JSR R5,SAVREG .ENDM SAVE ; MACRO TO DO SOB INSTRUCTION WHEN RUNNING ON A MACHINE WITHOUT EIS. .IF GT,R$$11M .MACRO SOB RX,TAG DEC RX BNE TAG .ENDM .ENDC .SBTTL LOCAL SYMBOL DEFINITIONS ; SPECIAL CHARACTERS RECOGNIZED. TAB = 11 ; HORIZONTAL TAB LF = 12 ; LINE FEED VT = 13 ; VERTICAL TAB FF = 14 ; FORM FEED CR = 15 ; CARRIAGE RETURN CTRLZ = 32 ; CONTROL Z AM = 33 ; ALT MODE BELL = 07 ; DING RUB = 177 ; RUBOUT ; OFFSETS TO CALLER'S REGISTERS SAVED ON STACK. ; NOTE THAT THESE ARE SENSITIVE TO THE OPERATION OF THE ; SAVREG ROUTINE! SR0 = 2 ; R0 SR1 = 4 ; R1 SR2 = 6 ; R2 SR3 = 10 ; R3 SR4 = 12 ; R4 SR5 = 14 ; R5 ; INTERFACES WITH TECO. SIZERB == 528. ; DEFAULT CORE SIZE TO ASK FOR LOV = 46556 ; DON'T ASK E = 17500 ; ; NAMES FOR CONTROL BITS IN THE ET FLAG ; ET.IMG = 1 ; IMAGE MODE TYPEOUT ET.WAL = 2 ; USE WRITE PASS ALL MODE ET.LOC = 4 ; ACCEPT LOWER CASE INPUT ; LUN USAGE. INLUN = 4 ; INPUT FILE OUTLUN = 3 ; OUTPUT FILE TTYLUN = 2 ; CONSOLE TTY CMDLUN = 1 ; INDIRECT COMMAND FILE INPUT TTYEFN = 4 MOLUN = 5 ; MO FOR I/O ERROR INTERPRETATION .SBTTL IMPURE DATA AREA ; FCS I/O BUFFER ALLOCATION FOR FILE I/O FSRSZ$ 2 .PSECT IMPURE,D ; ASSORTED INTERNAL VARIABLES AND FLAGS ZBEGIN: ; START OF AREA TO CLEAR ON INIT CSIBLK: .BLKB C.SIZE ; CSI CONTROL BLOCK DATSET= CSIBLK+C.DSDS ; DATASET POINTER BLOCK STACK: .BLKW 1 ; STACK POINTER SAVE TABCNT: .BLKW 1 ; TAB COUNTER FOR TYPE OUT BUFPT: .BLKW 1 ; POINTER INTO TYPE OUT BUFFER INDBUF: .BLKW 1 ; BUFFER ADDRESS FOR INDIRECT FILE OPEN INDBSZ = 512.+S.BFHD ; SIZE OF THE BUFFER FOR INDIRECT FILE OPEN CHAR: .BLKB 1 ; CHARACTER INPUT FROM TTY CRFLAG: .BLKB 1 ; LAST CHAR TYPED WAS CR ; .EVEN ZEND: ; END OF AREA TO CLEAR ON INIT IOSTAT: .BLKW 2 ; I/O STATUS BLOCK STRING: .BLKB 68. ; STRING BUFFER FOR ERROR MESSAGES STRNGL = .-STRING . = STRING TEMP = . ; TOTALLY RANDOM TEMPORARY ; OVERLAP OTHER JUNK TIMBUF: .BLKW 8. ; BUFFER FOR GET TIME PARAMETERS . = STRING+STRNGL GMCR: GMCR$ ; GET MCR COMMAND LINE BUFFER TYOBUF= GMCR+G.MCRB ; WHICH IS ALSO USED AS TYPE OUT BUFFER TYOBL= 80. .EVEN CMDLIN: .BLKB 82. ; RECORD BUFFER FOR CMDFDB CMDSIZ = .-CMDLIN ; FILE DESCRIPTOR BLOCKS FOR INPUT AND OUTPUT FILES. INFDB: FDBDF$ FDRC$A FDAT$A R.VAR,FD.CR FDOP$A INLUN,DATSET,DN OUTFDB: FDBDF$ FDAT$A R.VAR,FD.CR FDOP$A OUTLUN,DATSET,DN CMDFDB: FDBDF$ FDRC$A FD.PLC,CMDLIN,CMDSIZ FDOP$A CMDLUN,DATSET,DN ; DEFAULT FILE NAME BLOCK TO MAKE SY0: DEFAULT DEVICE DN: NMBLK$ ,,,SY,0 ; FILE NAME BLOCKS TO SAVE STATES OF INPUT AND OUTPUT FILES. INSAVE: .BLKB S.FNB+8. ; INPUT FILE STATE SAVE AREA OUSAVE: .BLKB S.FNB ; OUTPUT FILE STATE SAVE AREA TTLNSZ: .BLKW 1 ;LINE SIZE OF TERMINAL ASSSOCIATED WITH TTYLUN .SBTTL PURE DATA AREA .PSECT PURE,D,RW FFRECD: .BYTE FF ; SINGLE FORM FEED RECORD FOR OUTPUT .EVEN ; CSI SWITCH TABLE FOR FILE STRINGS SW.CR = FD.CR ; IMPLIED CARRIAGE CONTROL SW.FT = FD.FTN ; FORTRAN CARRIAGE CONTROL SWTAB: CSI$SW CR,SW.CR,,,NEG ; /CR - FORCE IMPLIED CARRIAGE CONTROL CSI$SW FT,SW.FT ; /FT - FORCE FORTRAN CARRIAGE CONTROL CSI$ND CMDR50 = <<'C-100>*50*50>+<<'M-100>*50>+<'D-100> ; .RAD50 /CMD/ ; SNAPPY ANSWER FOR STUPID QUESTIONS. NWST: .ASCII <15><12>"NOT WAR?"<15><12> NWLN= .-NWST ; ; NOT ENOUGH BUFFER SPACE TO INITIALIZE ; NOBF: .ASCII <15><12>"NOT ENOUGH BUFFER SPACE"<15><12> NOBFLN= .-NOBF ; ; MEMORY EXPANDED SUCCESSFULLY ; EXPDMG: .ASCII <15><12><12>"[528. BYTES MEMORY - INDIRECT (EI) BUFFER USED]" .ASCII <15><12><12> EXPDSZ = .-EXPDMG INDERM: .ASCII <15><12>"EOF OR I/O ERROR READING INDIRECT FILE"<15><12> INDERS = .-INDERM ; .IF GT,R$$11M .EVEN .IFF ; FILENAME OF MESSAGE FILE TO INTERPRET I/O ERROR CODES FILEN: .ASCII "SY:[1,2]QIOSYM.MSG" FILEL= .-FILEN .EVEN MSGFIL: .WORD FILEL ; STRING DESCRIPTOR OF FILE NAME .WORD FILEN .ENDC ; CHARACTER DISPATCH TABLE FOR TYPE OUT ROUTINE. TYTAB: .WORD TAB .WORD LF .WORD VT .WORD FF .WORD CR .WORD AM .WORD BELL TYTABL = .-TYTAB TYDISP: .WORD TOTAB .WORD TOLF .WORD TOVT .WORD TOFF .WORD TOCR .WORD TOAM .WORD TOBELL ; .IF EQ,RNEPAL ECHDSP: .WORD ECHTAB .WORD ECHLF .WORD ECHVT .WORD ECHFF .WORD ECHCR .WORD TOAM .WORD TOCTRL ;ECHO JUST ^G FOR BELL .ENDC ; OFT USED DPB'S FOR ATTACHING AND DETACHING THE TTY .IF EQ,R$$11M ATTACH: QIOW$ IO.ATT,TTYLUN,TTYEFN,,IOSTAT DETACH: QIOW$ IO.DET,TTYLUN,TTYEFN,,IOSTAT ; .IFF ATTACH: QIO$ IO.ATT,TTYLUN,TTYEFN,,IOSTAT DETACH: QIO$ IO.DET,TTYLUN,TTYEFN,,IOSTAT TTWAIT: WTSE$ TTYEFN ; ; LOW AND HIGH LIMITS OF MEMORY USED BY THIS TASK ; LOHI: .LIMIT .ENDC .IF EQ,R$$DYM ; IF NO DYNAMIC MEMORY, EXTEND $$DYB1 .PSECT $$DYB1,D DYB1: .PSECT $$DYB2,D DYB2: .ENDC .SBTTL STARTUP AND INITIALIZATION ;+ ; ; *** - TECOIO PRIMARY ENTRY POINT ; ; THIS IS WHERE TECO ITSELF STARTS TO RUN WHEN CALLED FROM MCR. THIS ; LEG OF CODE SETS UP THE DATA AREAS NEEDED BY TECO, INITIALIZES ; POINTERS AND COUNTS AS NECESSARY, AND THEN TRANSFERS TO TECO PROPER. ; ;- ; .PSECT CODE,RW TECOIO:: FINIT$ ; INITIALIZE THE FILE STORAGE REGION MOV #ZBEGIN,R0 ; POINT TO START OF AREA TO CLEAR MOV #/2,R1 ; GET WORD COUNT 10$: CLR (R0)+ ; AND ZERO IT SOB R1,10$ GLUN$C TTYLUN,STRING,CODE ; GET INFO ABOUT TTYLUN MOV STRING+10.,TTLNSZ ; SAVE THIS TERMINAL'S LINE SIZE MOV #TYOBUF,BUFPT ; INIT TYPE OUT BUFFER POINTER .IF GT,R$$11M CALL TTATT ; ATTACH THE TERMINAL .ENDC .IF GT,R$$DYM ; IF DYNAMIC MEMORY IN USE GPRT$C ,STRING,CODE ; GET PARTITION PARAMETERS MOV @#$DSW,R4 ; IN ORDER TO GET TASK BASE ADDRESS GTSK$C STRING,CODE ; GET TASK PARAMETERS ADD STRING+G.TSTS,R4 ; IN ORDER TO GET "APPARENT" TASK SIZE MOV LOHI+2,R5 ; R5= BOTTOM OF DYNAMIC MEMORY, R4=TOP .IFF ; IF NO DYNAMIC MEMORY MOV #DYB1,R5 ; R5 = BOTTOM OF DYNAMIC MEMORY MOV #DYB2,R4 ; R4 = TOP OF DYNAMIC MEMORY .ENDC MOV R4,R3 SUB R5,R3 ; R3=SIZE OF DYNAMIC MEMORY IN BYTES CMP #RWSIZE+SCHSIZ+PDLSIZ+MBFSIZ,R3 ; IS IT ADEQUATE BHI NOSPAC ; BRANCH IF NO MOV R5,R0 ; R0=BASE OF DYNAMIC MEMORY MOV R3,R1 ; R1=BYTE COUNT CLC ROR R1 ; R1=WORD COUNT 20$: CLR (R0)+ ; ZERO DYNAMIC MEMORY SOB R1,20$ ; ; INITIALIZE TECO'S STATE AREA, BASE ADDRESS IN R5, SIZE = RWSIZE ; R3 = BYTE COUNT OF AVAILABLE MEMORY ; R4 = TOP OF MEMORY ; R5 = BASE OF MEMORY ; MOV SP,TECOSP(R5) ; INIT BASE LEVEL STACK POINTER SUB #RWSIZE+SCHSIZ+PDLSIZ,R3 ; R3=ROOM FOR BUFFER SPACE CMP #MBFSIZ+INDBSZ,R3 ; ENOUGH ROOM FOR INDIRECT BUFFER BHI 30$ ; BRANCH IF NO SUB #INDBSZ,R3 ; YES, RESERVE THE SPACE SUB #INDBSZ,R4 MOV R4,INDBUF ; AND SET THE BUFFER POINTER 30$: MOV R3,R2 ; TAKE ONE HALF OF AVAILABLE BUFFER CLC ROR R2 ; SPACE FOR Q REGISTER STORAGE MOV R2,QMAX(R5) ; SET Q REGISTER AREA SIZE SUB R2,R4 ; ALLOCATE Q REGISTER AREA MOV R4,QRSTOR(R5) ; AND SET POINTER IN STATE AREA SUB R2,R3 ; R3 = SIZE LEFT FOR TEXT MOV R3,ZMAX(R5) ; STORE IN STATE AREA SUB R3,R4 ; R4 = STARTING ADDRESS OF TEXT STORE MOV R4,TXSTOR(R5) ; SET THIS VALUE IN STATE AREA MOV R5,R4 ; R5 = ADDRESS OF STATE AREA ADD #RWSIZE,R4 ; R4 = ADDRESS OF PUSH DOWN LIST MOV R4,PDL(R5) ; SET POINTER IN STATE AREA MOV R4,TECOPD(R5) ; BOTH OF THEM ADD #PDLSIZ,R4 ; FORM ADDRESS OF SEARCH BUFFER MOV R4,SCHBUF(R5) ; STORE SEARCH BUFFER POINTER DEC (R4) ; MAKE INITIAL CONTENTS -1 (WAS 0) MOV #INFDB+F.BDB,INPNTR(R5) ; SET UP INPUT FILE FLAG PTR MOV #OUTFDB+F.BDB,OUPNTR(R5) ; SET UP OUTPUT FILE FLAG PTR ; NOW SEE IF THERE IS A COMMAND STRING TO INTERPRET DIR$ #GMCR ; GET MCR COMMAND LINE BCS GO ; IF NONE, DON'T BOTHER MOV #GMCR+G.MCRB,R0 ; POINT TO STRING MOV @#$DSW,R4 ; GET BYTE COUNT 40$: DEC R4 ; COUNT OFF A CHARACTER BLT GO ; IF WE RUN OUT IGNORE IT MOVB (R0)+,R1 ; CHECK NEXT CHARACTER CMPB #' ,R1 ; LOOK FOR A SPACE BEQ 50$ CMPB #TAB,R1 ; OR A TAB BNE 40$ 50$: DEC R4 ; COUNT OFF A CHARACTER BLT GO ; IF WE RUN OUT IGNORE IT MOVB (R0)+,R1 ; SKIP TO FIRST NON-BLANK, NON-TAB CMPB #' ,R1 ; BLANK? BEQ 50$ ; BRANCH IF YES CMPB #TAB,R1 ; TAB? BEQ 50$ ; BRANCH IF YES ; ; R1 = FIRST NON BLANK CHARACTER AFTER MCR COMMAND NAME, R0 POINTS ; TO THE CHARACTER BEYOND IT ; MOVB #' ,R3 ; ASSUME ER, OR EI MOV #"EI,R2 ; ASSUME EI CMPB #'@,R1 ; INDIRECT FILE DESIRED? BEQ 60$ DEC R0 ; PUT THIS CHAR BACK IN STRING INC R4 MOV #"EW,R2 ; ASSUME EW COMMAND CMPB GMCR+G.MCRB,#'M ; MAKE MCR COMMAND? BEQ 60$ ; BRANCH IF YES MOV #"EB,R2 ; IT'S AN EB COMMAND MOVB #'Y,R3 ; YANK FOR EB 60$: MOV #CMDLIN,R1 ; STORE CCL COMMAND IN RECORD BUFFER MOV R2,(R1)+ ; STORE EW, EB, OR EI 70$: MOVB (R0)+,(R1)+ ; MOVE THE FILE NAME STRING SOB R4,70$ MOVB #AM,(R1)+ ; ALT MODE MOVB R3,(R1)+ ; Y IF EB COMMAND, BLANK IF NOT MOVB #AM,(R1)+ ; ANOTHER ALTMODE, LAST 1 GIVEN BY GETC MOV #CMDFDB,R0 ; MAKE IT LOOK LIKE AN INDIRECT FILE MOV #CMDLIN,R2 MOV R2,F.NRBD+2(R0) ; ADDRESS OF RECORD SUB R2,R1 ; R1 = SIZE OF RECORD MOV R1,F.NRBD(R0) ; STORE THE RECORD SIZE MOV R0,INDIR(R5) ; INDICATE THAT IND FILE IS ACTIVE GO: JMP TECO ; ALL SET UP. ; ; NO BUFFER SPACE TO ALLOCATE MINIMUM TEXT SPACE ; NOSPAC: MOV #NOBF,R3 ; GET MESSAGE MOV #NOBFLN,R4 CALL PRINT ; TELL USER THERE IS NO ROOM JMP TEXIT ; AND EXIT FROM TECO .SBTTL GETFLS -- OPEN REQUESTED FILES ;+ ; ; *** - GETFLS OPEN REQUESTED FILES ; ; THIS ROUTINE OPENS THE REQUESTED FILES AND PREPARES FOR INPUT AND OUTPUT. ; IT IS CALLED IN RESPONSE TO "ER", "EW", AND "EB" COMMANDS. ; ; INPUTS: ; ; R2 = MODE FLAG ; SCHBUF(R5) CONTAINS POINTER TO FILE STRING, TERMINATED WITH -1. ; ; OUTPUTS: ; ; NONE. ; ALL REGISTERS ARE PRESERVED. ; ; INTERPRETATION OF MODE FLAG: ; ; ZERO "ER" OPEN ; POSITIVE "EW" OPEN ; NEGATIVE "EB" OR "EI" OPEN ; = 'B-'R "EB" OPEN ; = 'I-'R "EI" OPEN ; ; IF THE SPECIFIED LENGTH OF THE FILE STRING IS ZERO AND THE MODE IS 0, ; THE FILE AND STATE SAVED BY THE LAST CALL TO INPSAV AND/OR OUTSAV WILL ; BE RESTORED. ; ; CSI IS CALLED TO SCAN THE FILE STRING AND CONSTRUCT A DATASET POINTER ; BLOCK. THEN THE APPROPRIATE OPEN CALL IS MADE. ; ; THE FOLLOWING SWITCHES ARE RECOGNIZED TO FORCE FCS CARRIAGE CONTROL ; ATTRIBUTES ON BOTH INPUT AND OUTPUT FILES: ; ; /-CR USE INTERNAL CARRIAGE CONTROL (I.E., NONE) ; /CR USE IMPLIED CARRIAGE CONTROL (FD.CR) ; /FT USE FORTRAN CARRIAGE CONTROL (FD.FTN) ; ;- .ENABL LSB GETFLS:: SAVE ; SAVE ALL REGISTERS MOV SCHBUF(R5),R0 ; GET ADDRESS OF FILE STRING MOV #STRNGL,R3 ; MAXIMUM BYTE COUNT MOV #STRING,R2 ; POINT TO STRING BUFFER 10$: MOVB (R0)+,R1 ; PICK UP BYTE CMPB R1,#-1 ; CHECK FOR TERMINATOR BEQ 30$ CMPB R1,#'A+40 ; SEE IF THIS IS A LOWER CASE ALPHA BLO 20$ ; NO CMPB R1,#'Z+40 BHI 20$ ; NOT EITHER BIC #40,R1 ; IT IS - CONVERT TO UPPER CASE 20$: MOVB R1,(R2)+ ; COPY CHAR INTO BUFFER SOB R3,10$ ERROR BFS,<"BAD FILE STRING"> ; TERMINATOR DETECTED 30$: NEG R3 ADD #STRNGL,R3 ; COMPUTE STRING'S BYTE COUNT BNE 40$ JMP FILRST ; NULL STRING = FILE RESTORE 40$: CSI$1 #CSIBLK,#STRING,R3 BCC 50$ ; CHECK FOR SYNTAX ERROR ERROR BFS,<"BAD FILE STRING"> 50$: CSI$2 R0,OUTPUT,#SWTAB ; GET A FILE SPEC FROM STRING BCC 60$ ; CHECK FOR FUNNY STUFF ERROR ILS,<"ILLEGAL SWITCHES"> 60$: BITB C.STAT(R0),#CS.WLD!CS.MOR BEQ 70$ ; LOOK FOR WILD CARDS, MULTIPLE FILES ERROR BFS,<"BAD FILE STRING"> 70$: CLR DN+N.FTYP ; SET UP FOR STANDARD DEFAULT MOV SR2(SP),R4 ; TEST SPECIFIED OPEN REQUIREMENTS. BMI EBOPEN ; GO OPEN FOR EDIT BACKUP. BEQ EROPEN ; GO OPEN FOR EDIT READ ; *** BPL EWOPEN ; GO OPEN FOR EDIT WRITE .DSABL LSB ; THE FOLLOWING ROUTINES DO THE ACTUAL FILE MANIPULATION ; APPROPRIATE TO THE CALL. ; HERE WHEN OPEN FOR EDIT WRITE HAS BEEN REQUESTED. ; OPEN AN OUTPUT FILE. EWOPEN: CALL CLOSOF ; CLOSE CURRENTLY OPEN OUTPUT, IF ANY MOV #OUTFDB,R0 CALL PARSE ; PARSE THE FILE NAME BR EWCOMM ; OPEN WITH COMMON CODE ; HERE WHEN EDIT BACKUP HAS BEEN REQUESTED BY CALLER. EBOPEN: CMPB #<'I-'R>,R4 ; "EI" COMMAND? BEQ EIOPEN ; BRANCH IF YES TST OUTFDB+F.BDB ; IS ANY OUTPUT FILE OPEN BEQ EROPEN ; EB IS NOT PERMITTED WITH OUTPUT OPEN ERROR EBO,<"EB - OPEN OUTPUT FILE"> .ENABL LSB ; HERE WHEN EDIT INDIRECT HAS BEEN REQUESTED BY CALLER EIOPEN: TST INDIR(R5) ; INDIRECT FILE ALREADY OPEN? BEQ 10$ ; BRANCH IF NOT ERROR EIO,<"EI - INDIRECT COMMAND FILE ALREADY OPEN"> 10$: MOV INDBUF,R2 ; R2 = BUFFER ADDRESS OF INDIRECT FILES BEQ 20$ ; BRANCH IF NO BUFFER TO RELEASE MOV #INDBSZ,R1 ; R1 = SIZE OF BUFFER MOV @#.FSRPT,R0 ; R0 = FILE STORAGE REGION POINTER CALL $RLCB ; RELEASE THE BUFFER TO THE FSR CLR INDBUF ; SAY THAT THE BUFFER IS NOW IN USE 20$: MOV #CMDR50,DN+N.FTYP ;DEFAULT TO .CMD FOR FILE TYPE MOV #CMDFDB,R0 CALL PARSE ; PARSE THE FILE NAME BCS 30$ OFNB$R R0 ; AND OPEN THE INDIRECT FILE 30$: BCS FILERR MOV R0,INDIR(R5) ; SET INDIRECT FILE OPEN INDICATOR MOV #-1,F.NRBD(R0) ; RECORD BUFFER EMPTY, GET$ NECESSARY BR GFLXIT .DSABL LSB ; HERE FOR EDIT READ REQUEST FROM CALLER. EROPEN: CALL CLOSIF ; CLOSE ANY OPEN INPUT FILE MOV #INFDB,R0 ; FDB ADDRESS TO R0 CALL PARSE ; PARSE THE FILE NAME BCS FILERR ; BRANCH IF ERROR TST R4 ; IF EB COMMAND BPL 50$ MOV #OUTFDB+F.FNB,R2 ; COPY FNB TO OUTPUT FDB MOV #S.FNBW,R3 ; NO. OF WORDS TO MOVE 40$: MOV (R1)+,(R2)+ SOB R3,40$ CLR OUTFDB+F.FVER ; FORCE NEW OUTPUT FILE VERSION 50$: OFNB$R R0 ; AND OPEN THE FILE FOR INPUT BCS FILERR ; FILE NOT FOUND. CALL FSWIT ; APPLY SWITCHES TST R4 ; CHECK OPEN INTENT AGAIN BPL GFLXIT ; IF "ER", THAT'S ALL MOV #OUTFDB,R0 ; R0=OUTPUT FDB ADDRESS EWCOMM: MOVB INFDB+F.RATT,F.RATT(R0) ; DEFAULT RECORD ATTRIBUTES TO INPUT'S BNE 60$ MOVB #FD.CR,F.RATT(R0) ; BUT DEFAULT NONE TO CR 60$: CALL FSWIT ; APPLY SWITCHES OFNB$W R0 ; OPEN THE OUTPUT FILE BCS FILERR ; OUT ON ERROR OUTXIT: GFLXIT: CCC ; LEAVE CLEAR RETURN ; RESTORE REGISTERS AND RETURN TO CALLER ; TO HERE ON ALL FILE SYSTEM ERRORS. FILERR: JMP FCSERR ; ;+ ; ; *** - PARSE PARSE THE FILE NAME INTO THE FDB ; ; THIS ROUTINE TAKES THE NECESSARY INFORMATION OUT OF THE FDB ; AND INVOKES THE FCS PARSE ROUTINE. ; ; INPUTS: ; ; R0=FDB ADDRESS ; ; OUTPUTS: ; ; C=0 IF SUCCESSFUL, C=1 IF ERROR ; R1=R0+F.FNB ; R2=F.DSPT(R0) ; R3=F.DFNB(R0) ; R0,R4,R5 PRESERVED ; ;- PARSE: MOV R0,R1 ADD #F.FNB,R1 ; R1=FILE NAME BLOCK ADDRESS MOV F.DSPT(R0),R2 ; R2=DESCRIPTOR POINTER MOV F.DFNB(R0),R3 ; R3=DEFAULT NAME BLOCK ADDRESS CALL .PARSE ; PARSE THE FILE NAME RETURN ; AND RETURN ; .SBTTL FILE SWITCH SUBROUTINE ;+ ; ; *** - FSWIT APPLY SWITCHES TO FILE IN PROCESS ; ; THIS ROUTINE TAKES THE SWITCH VALUES LEFT BY CSI2 AND STUFFS THE RECORD ; ATTRIBUTES BYTE OF THE FILE IN QUESTION APPROPRIATELY. ; ; INPUTS: ; ; R0 = POINTER TO FDB OF FILE ; ; OUTPUTS: ; ; F.RATT(R0) GETS RECORD ATTRIBUTES ; R3 IS CLOBBERED ; ; OTHER REGISTERS ARE PRESERVED. ; ;- .ENABL LSB FSWIT: TSTB C.MKW1+CSIBLK ; SEE IF ANY SWITCHES WERE SPECIFIED BEQ 20$ ; NO MOVB C.MKW2+CSIBLK,R3 ; GET SWITCH SETTINGS BEQ 10$ ; ALL ZERO IS OK CMPB R3,#SW.CR ; CHECK FOR CR SWITCH BEQ 10$ ; YES CMPB R3,#SW.FT ; CHECK FOR FT SWITCH BEQ 10$ ; YES ERROR ILS,<"ILLEGAL SWITCHES"> 10$: MOVB R3,F.RATT(R0) ; APPLY SWITCHES TO FILE 20$: RETURN .DSABL LSB .SBTTL INPUT FILE SAVE ;+ ; ; *** - INPSAV SAVE STATE OF INPUT FILE ; ; THIS ROUTINE SAVES THE STATE OF THE CURRENT INPUT FILE, ALLOWING IT ; TO BE READ FROM THIS POINT ON AT SOME LATER TIME. ; ; INPUTS: NONE ; ; OUTPUTS: NONE ; ; ALL REGISTERS ARE PRESERVED. ; ;- .ENABL LSB INPSAV:: SAVE MOV #INSAVE,R5 ; POINT TO STATE SAVE AREA MOV #INFDB+F.FNB+N.FID,R1 ; POINT TO FILE ID MOV #S.FNB/2,R4 ; SET UP WORD COUNT TST (R1) ; LOOK AT FILE ID BNE 10$ ; MAKE SURE THERE'S REALLY ONE THERE ERROR NFI,<"NO FILE FOR INPUT"> 10$: MOV (R1)+,(R5)+ ; COPY THE FNB SOB R4,10$ MOV #INFDB,R0 ; POINT TO FDB CALL .MARK ; GET FILE POSITION MOV R1,(R5)+ ; AND STASH IT AWAY MOV R2,(R5)+ MOV R3,(R5)+ MOVB F.RATT(R0),(R5)+ ; SAVE POSSIBLY ALTERED CARRIAGE CONTROL MOV SR5(SP),R5 ; RESTORE R5 CALL CLOSIF ; CLOSE THE INPUT FILE RETURN .DSABL LSB .SBTTL OUTPUT FILE SAVE ;+ ; ; *** - OUTSAV SAVE STATE OF OUTPUT FILE ; ; THIS ROUTINE SAVES THE STATE OF THE CURRENT OUTPUT FILE, ALLOWING IT ; TO BE WRITTEN FROM THIS POINT ON AT SOME LATER TIME. ; ; INPUTS: NONE ; ; OUTPUTS: NONE ; ; ALL REGISTERS ARE PRESERVED. ; ;- .ENABL LSB OUTSAV:: SAVE MOV #OUSAVE,R5 ; POINT TO STATE SAVE AREA MOV #OUTFDB+F.FNB+N.FID,R1 ; POINT TO FILE ID MOV #S.FNB/2,R4 ; SET UP WORD COUNT TST (R1) ; LOOK AT FILE ID BNE 10$ ; MAKE SURE THERE'S REALLY ONE THERE ERROR NFO,<"NO FILE FOR OUTPUT"> 10$: MOV (R1)+,(R5)+ ; COPY THE FNB SOB R4,10$ MOV SR5(SP),R5 ; RESTORE R5 CALL CLOSOF ; CLOSE THE OUTPUT FILE RETURN .DSABL LSB .SBTTL FILE RESTORE ROUTINES ;+ ; ; FILE RESTORE ROUTINE. THIS ROUTINE IS ENTERED ON ANY FILES CALL WITH ; A ZERO LENGTH FILE STRING. THE STATE OF PREVIOUSLY SAVED INPUT AND/OR ; OUTPUT FILES IS RESTORED, DEPENDING ON THE MODE FLAG (SAVED R2). ; ;- .ENABL LSB FILRST: MOV SR2(SP),R1 ; CHECK THE MODE FLAG BEQ INPRST ; 0 = RESTORE INPUT BPL OUTRST ; + = RESTORE OUTPUT CMP #<'I-'R>,R1 ; EI = CLOSE INDIRECT FILE BNE 10$ ; BRANCH IF EB JMP INDCLS ; CLOSE INDIRECT FILE 10$: CALL INPRST ; EB = RESTORE BOTH, FIRST INPUT ; RESTORE OUTPUT FILE STATE OUTRST: CALL CLOSOF ; CLOSE ANY OPEN OUTPUT FILE MOV #OUSAVE,R5 ; POINT TO STATE SAVE AREA MOV #OUTFDB+F.FNB+N.FID,R1 ; POINT TO FILE NAME BLOCK MOV #S.FNB/2,R4 ; SET UP WORD COUNT TST (R5) ; LOOK AT FILE ID BNE 20$ ; MAKE SURE THERE'S REALLY ONE THERE ERROR NFO,<"NO FILE FOR OUTPUT"> 20$: MOV (R5)+,(R1)+ ; COPY BACK FNB SOB R4,20$ OFNB$A #OUTFDB ; RE-OPEN THE FILE FOR APPEND BCS 40$ RETURN ; RESTORE INPUT FILE STATE INPRST: CALL CLOSIF ; CLOSE PRESENT INPUT FILE, IF ANY MOV #INSAVE,R5 ; POINT TO SAVE AREA MOV #INFDB+F.FNB+N.FID,R1 ; POINT TO SAVED FILE ID MOV #S.FNB/2,R4 ; SET UP WORD COUNT TST (R5) ; LOOK AT FILE ID BNE 30$ ; TEST FOR A VALID ID ERROR NFI,<"NO FILE FOR INPUT"> 30$: MOV (R5)+,(R1)+ ; COPY BACK FNB SOB R4,30$ OFNB$R #INFDB ; RE-OPEN THE INPUT FILE BCS 40$ ; OUT ON ERROR MOV (R5)+,R1 ; RESTORE FILE STATE MOV (R5)+,R2 MOV (R5)+,R3 CALL .POINT MOVB (R5)+,F.RATT(R0) ; RESTORE SAVED CARRIAGE CONTROL CCC RETURN ; FILE PROCESSOR ERROR 40$: JMP FCSERR .DSABL LSB .SBTTL CLOSE OUTPUT FILE ;+ ; ; *** - CLSFIL CLOSE OUTPUT FILE ; ; THIS ROUTINE CLOSES THE OUTPUT FILE AND CLEARS THE OUTPUT FILE ; OPEN FLAG. ATTEMPTING TO CLOSE WHEN THERE IS NO OUTPUT FILE ; WILL CAUSE AN ERROR RETURN. ; ; INPUTS: NONE ; ; OUTPUTS: NONE ; ; ALL REGISTERS ARE PRESERVED. ; ;- .ENABL LSB CLSFIL:: SAVE TST OUTFDB+F.BDB ; SEE IF THERE IS A FILE OPEN BNE 10$ ERROR NFO,<"NO FILE FOR OUTPUT"> 10$: CALL CLOSOF ; USE COMMON SUBR TO DO THE CLOSE RETURN .DSABL LSB .SBTTL KILL OUTPUT FILE ;+ ; ; *** KILFIL KILL OUTPUT FILE ; ; THIS ROUTINE DELETES THE CURRENT OUTPUT FILE AND CLEARS THE OUTPUT FILE ; OPEN FLAG. IF THERE IS NO OUTPUT FILE OPEN AN ERROR RETURN IS MADE. ; ; INPUTS: NONE ; ; OUTPUTS: NONE ; ; ALL REGISTERS ARE PRESERVED. ; ;- .ENABL LSB KILFIL:: SAVE TST OUTFDB+F.BDB ; SEE IF THERE IS AN OUTPUT FILE BNE 10$ ; BRANCH IF YES ERROR NFO,<"NO FILE FOR OUTPUT"> 10$: MOV #OUTFDB,R0 ; R0=ADDRESS OF THE OUTPUT FDB CALL .DLFNB ; DELETE THE FILE BCC 20$ JMP CLERR ; ERROR RETURN 20$: RETURN .DSABL LSB .SBTTL CLOSE INDIRECT FILE ;+ ; ; *** INDERR TECO REPORTS ERROR WHILE EXECUTING COMMANDS FROM AN ; INDIRECT FILE. COULD CHOOSE NOT TO ABORT INDIRECT FILE ; MODE BY ALLOWING A /AB, /-AB SWITCH ON THE EI FILE. ; FOR NOW, JUST CLOSE THE INDIRECT FILE. ; ; *** INDCLS CLOSE THE INDIRECT FILE AND RETURN TO TERMINAL INPUT. ; ; *** INDER1 I/O ERROR FROM INDIRECT FILE GET$, GIVE ERROR MESSAGE ; AND CLOSE THE INDIRECT FILE. ; ; INPUTS: NONE ; ; OUTPUTS: ; ; R0 ALTERED ; R3,R4 ALTERED FOR INDER1 ENTRY POINT ONLY ; ALL OTHER REGISTERS PRESERVED ; ;- INDER1: CMPB F.ERR(R0),#IE.EOF ; CHECK FOR EOF BEQ INDCLS ; IF SO, JUST CLOSE QUIETLY MOV #INDERM,R3 ; R3, R4 = ERROR DESCRIPTOR MOV #INDERS,R4 CALL PRINT ; PRINT THE ERROR MESSAGE INDERR:: INDCLS: MOV INDIR(R5),R0 ; CLOSE THE INDIRECT FILE IF IT'S OPEN BEQ 10$ ; BRANCH IF NOT OPEN CLOSE$ R0 ; CLOSE IT 10$: CLR INDIR(R5) ; BACK TO TERMINAL INPUT RETURN .SBTTL GETBUF -- GET BUFFER FROM INPUT ;+ ; ; *** - GETBUF GET BUFFER FROM INPUT ; ; THIS ROUTINE READS THE INPUT FILE INTO THE TEXT BUFFER. WHEN CALLED, ; IT READS UNTIL EITHER: ; ; 1) THE BUFFER IS NEARLY FULL. ; 2) A FORM FEED IS ENCOUNTERED. ; 3) END OF FILE IS ENCOUNTERED. ; ; INPUTS: ; ; R0 = POINTER TO AREA TO READ INTO ; R1 = BUFFER SPACE AVAILABLE (BYTES) ; R2 = AMOUNT OF SPACE TO LEAVE FREE ; ; OUTPUTS: ; ; EOFLAG(R5) = -1 IF END OF FILE WAS REACHED ; = 0 OTHERWISE ; FFFLAG(R5) = -1 IF READ TERMINATED WITH A FORM FEED ; = 0 OTHERWISE ; ZZ(R5) = UPDATED END OF BUFFER ; ; GETBUF READS STANDARD RSX VARIABLE LENGTH RECORDS FROM THE INPUT ; FILE. IF THE FILE HAS EITHER IMPLIED OR FORTRAN CARRIAGE CONTROL, ; CARRIAGE RETURN AND LINE FEED ARE INSERTED INTO THE BUFFER AFTER ; EACH RECORD. THE EXCEPTION TO THIS IS A RECORD CONTAINING A SOLITARY ; FORM FEED. IF IT IS ENCOUNTERED IT IS NOT ENTERED INTO THE BUFFER AND THE ; READ IS TERMINATED. AFTER EACH RECORD HAS BEEN READ, IF THERE ARE ; FEWER THAN R2 CHARACTERS IN THE BUFFER, THE READ IS ALSO TERMINATED. ; ;- .ENABL LSB GETBUF:: SAVE TST INFDB+F.BDB ; TEST FOR OPEN FILE AVAILABLE. BNE 10$ ERROR NFI,<"NO FILE FOR INPUT"> 10$: CLR FFFLAG(R5) ; CLEAR FORM FEED FLAG FOR RETURN MOV R1,R4 ; COPY AVAILABLE SPACE SIZE MOV #INFDB,R0 ; GET FDB POINTER CALL .MARK ; SAVE INPUT FILE POSITION MOV R3,-(SP) ; STASH AWAY R3 MOV SR0+2(SP),R3 ; GET THE WORKING BUFFER POINTER ; HERE TO GET NEXT INPUT RECORD MOVED INTO TECO'S TEXT BUFFER. NEXREC: SUB #2,R4 ; LEAVE ROOM FOR CR/LF GET$ R0,R3,R4 ; GET THE RECORD BCS INERR ; SOME INPUT ERROR. CMPB (R3),#FF ; WAS FIRST CHAR OF RECORD A FF ? BNE 20$ ; IF SO, THIS MIGHT END THE BUFFER. CMP F.NRBD(R0),#1 ; WAS IT A ONE CHARACTER RECORD ? BEQ 50$ ; IF NOT, DON'T TREAT AS FORM FEED. 20$: ADD F.NRBD(R0),R3 ; INCREMENT THE CHARACTER POINTER SUB F.NRBD(R0),R4 ; DECREMENT SPACE COUNT. BITB F.RATT(R0),#FD.CR!FD.FTN ; CHECK FOR IMPLIED OR FORTRAN CCL BEQ 30$ ; NEITHER MOVB #CR,(R3)+ ; INSERT CARRIAGE RETURN MOVB #LF,(R3)+ ; AND LINE FEED BR 40$ 30$: ADD #2,R4 ; CR-LF ALREADY PRESENT - PUT BACK THE SPACE 40$: CMP R4,SR2+2(SP) ; SEE HOW MUCH SPACE IS LEFT BLO IBFDON ; IF LESS THAN THRESHOLD, QUIT BR NEXREC ; GET NEXT RECORD. ; FORM FEED ENCOUNTERED IN INPUT 50$: DEC FFFLAG(R5) ; SET FF FLAG ; END OF INPUT: EITHER WE HIT A FORM FEED OR END OF FILE, OR THE BUFFER ; IS FULL. COMPUTE NUMBER OF CHARACTERS READ AND RETURN. IBFDON: SUB TXSTOR(R5),R3 ; COMPUTE TOTAL BYTE COUNT IN BUFFER MOV R3,ZZ(R5) ; SET NEW END OF BUFFER TST (SP)+ ; CLEAN THE STACK RETURN ; TO HERE ON RANDOM INPUT ERRORS. INERR: MOV F.ERR(R0),R4 ; PICK UP ERROR CODE CMPB R4,#IE.EOF ; SEE IF WE HIT END OF FILE BNE 60$ ; IF NOT, GET OUT MOV #-1,EOFLAG(R5) ; YES - SET END OF FILE FLAG BR IBFDON ; AND EXIT 60$: MOV (SP)+,R3 ; RESTORE R4 FOM MARK CALL .POINT ; RESTORE FILE POSITION TO ALLOW RECOVERY MOV R4,F.ERR(R0) ; RESTORE ERROR CODE JMP FCSERR ; AND REPORT ERROR .DSABL LSB .SBTTL PUTBUF -- PUT BUFFER IN OUTPUT FILE ;+ ; ; *** - PUTBUF PUT BUFFER IN OUTPUT FILE ; ; THIS ROUTINE OUTPUTS THE DESIGNATED PORTION OF THE BUFFER TO ; THE OUTPUT FILE CURRENTLY OPEN. THE BUFFER IS SEARCHED FOR ; CARRIAGE RETURN - LINE FEED PAIRS, WHICH ARE TAKEN TO BE ; RECORD DELIMITERS. IF THE FILE HAS NULL CARRIAGE CONTROL, THE ; CR-LF PAIRS ARE OUTPUT WITH THE RECORDS; OTHERWISE THEY ARE STRIPPED ; OFF. ANY FORM FEEDS ENCOUNTERED IN THE BUFFER ARE OUTPUT AS A SINGLE ; FORM FEED RECORD. ; ; INPUTS: ; ; R0 = POINTER TO START OF BUFFER ; R1 = NUMBER OF CHARACTERS TO OUTPUT ; R2 = -1 IF A FORM FEED IS TO BE APPENDED TO THE OUTPUT ; 0 IF OUTPUT IS TO BE DONE AS IS ; ; OUTPUTS: ; ; NONE ; ; ALL REGISTERS ARE PRESERVED. ; ;- .ENABL LSB PUTBUF:: SAVE TST OUTFDB+F.BDB ; IS THERE OPEN OUTPUT FILE? BNE 10$ ; IF YES, PROCEED ERROR NFO,<"NO FILE FOR OUTPUT"> 10$: MOV R0,R2 ; USE FOR POINTER TO GET CHARACTERS FROM BUFFER MOV R2,R4 ; SETUP INITIAL RECORD STARTING POINT. MOV #OUTFDB,R0 ; GET FDB ADDRESS NOW CHRSCN: TST R1 ; ANY CHARACTERS LEFT IN TECO'S BUFFER ? BLE OBFDON ; NO -- OUTPUT THE LAST THEN MOVB (R2)+,R5 ; GET NEXT CHARACTER FROM CALLER'S BUFFER DEC R1 ; NUMBER LEFT CMPB #FF,R5 ; FORM FEED? BEQ SETFF ; YES -- OUTPUT FORM FEED RECORD. CMPB #LF,R5 ; LINE FEED? BNE CHRSCN ; NO -- KEEP GOING. CMPB #CR,-2(R2) ; IS PREVIOUS CHARACTER A CARRIAGE RETURN? BNE CHRSCN ; NO - KEEP SCANNING ; HERE WHEN CR/LF FOUND IN OUTPUT RECORD. ORCDON: CLR R5 BITB F.RATT(R0),#FD.CR!FD.FTN ; CHECK FOR IMPLIED OR FORTRAN CCL BEQ 20$ ; NEITHER MOV #2,R5 ; SET LINE LENGTH ADJUSTMENT 20$: SUB R5,R2 ; REMOVE CR-LF WHEN APPROPRIATE CALL OUTPUT ; OUTPUT THE RECORD FROM R4 TO R2 ADD R5,R2 ; FIX END OF RECORD POINTER MOV R2,R4 ; SET TO START OF NEXT RECORD BR CHRSCN ; GO LOOK AT NEXT RECORD. ; HERE WHEN FORM FEED ENCOUNTERED IN DATA SETFF: DEC R2 ; PUT END OF RECORD PTR AT FF CMP R2,R4 ; ANYTHING ELSE IN RECORD ? BEQ 30$ ; NO -- THEN DO NOT BOTHER TO OUTPUT THEM CALL OUTPUT ; YES -- THEN OUTPUT THEM BEFORE FF RECORD 30$: INC R2 ; MOVE END OF RECORD POINTER PAST FF CALL OUTPUT ; OUTPUT FF CHARACTER. BR CHRSCN ; KEEP SCANNING CHARACTERS. ; HERE WHEN CALLER'S BUFFER IS COMPLETE OBFDON: CMP R2,R4 ; ANY CHARACTERS IN CURRENT OUTPUT RECORD? BEQ 40$ ; NO -- DO NOT OUTPUT THEN CALL OUTPUT ; YES -- THEN DO OUTPUT 40$: TST SR2(SP) ; SHOULD BUFFER END WITH FF? BEQ 50$ ; NO PUT$ R0,#FFRECD,#1 ; OUTPUT FORM FEED RECORD BCS OUTERR 50$: RETURN ; OK RETURN ; SUBROUTINE TO DO ALL PUTS -- ON RETURN R4 REINITIALIZED. OUTPUT: MOV R2,R3 ; GET POINTER PAST END OF RECORD SUB R4,R3 ; THIS IS THE SIZE OF THE RECORD PUT$ R0,R4,R3 ; PUT IT OUT BCS OUTERR ; WHUPS! ERROR MOV R2,R4 ; SET NEW START OF RECORD. RETURN ; AND RETURN ; TO HERE ON OUTPUT ERRORS OUTERR: JMP FCSERR ; REPORT ERROR AND EXIT .DSABL LSB .SBTTL COMMON SUBROUTINES ; CLOSIF -- CLOSE INPUT FILE IF OPEN ; EDIT BACKUP AND INPUT FILE ALWAYS ENDED BY THIS SUBROUTINE CLOSIF: CLR EOFLAG(R5) ; CLEAR THE END OF FILE FLAG TST INFDB+F.BDB ; WAS THERE AN OPEN INPUT FILE ? BEQ 10$ ; NO, JUST EXIT CLOSE$ #INFDB ; JUST CLOSE INPUT BCS CLERR ; OUT ON ERROR 10$: RETURN ; RETURN TO CALLER ; CLOSOF -- CLOSE OUTPUT FILE IF OPEN CLOSOF: TST OUTFDB+F.BDB ; WAS THERE AN OPEN OUTPUT FILE ? BEQ 20$ ; NO, JUST EXIT CLOSE$ #OUTFDB ; CLOSE IT ALREADY BCS CLERR ; OUT ON ERROR 20$: RETURN ; RETURN TO CALLER ; TO HERE ON ANY ERROR ON A CLOSE CLERR: JMP FCSERR ; AND DEAL WITH I/O ERROR .SBTTL LISTEN - TTY INPUT ;+ ; ; *** - LISTEN TTY INPUT ; ; THIS ROUTINE ACCEPTS INPUT FROM THE CONSOLE TTY AND RETURNS IT ; TO THE CALLER ONE CHARACTER AT A TIME. ; ; INPUTS: ; ; R0 = 0 DELIMITERS ARE ALTMODE, RUBOUT, CTRL/U, CTRL/G ; R0 >< 0 ALL CHARACTERS ARE DELIMITERS. ; ; OUTPUTS: ; ; R0 = CHARACTER (TRIMMED TO 7 BITS, NULLS SUPPRESSED) ; ; ALL OTHER REGISTERS ARE PRESERVED. ; ; NOTE - SINCE THE RSX-11D TTY HANDLER DOES NOT RECOGNIZE THE RELEVANT ; BREAK CHARACTERS, THE INPUT VALUE OF R0 IS IGNORED AND ALL INPUT IS ; DONE ON A CHARACTER BY CHARACTER BASIS. SORRY! ; ;- LISTEN:: SAVE TSTB CRFLAG ; SEE IF CR WAS THE LAST CHARACTER TYPED BEQ GETC ; IF NOT, PROCEED CLRB CRFLAG ; ELSE CLEAR THE FLAG MOV #LF,R0 ; PICK UP A LINE FEED BR LISTNX ; AND RETURN IT GETC: MOV INDIR(R5),R0 ; COMMANDS FROM FILE? BEQ GETC1 ; BRANCH IF COMMANDS FROM TERMINAL 10$: TST F.NRBD(R0) ; YES, SEE IF ANY MORE CHARACTERS IN BUFFER BGE 20$ ; BRANCH IF THERE ARE MORE GET$ R0 ; OTHERWISE GET ANOTHER RECORD BCC 10$ ; BRANCH IF SUCCESSFUL CALL INDER1 ; ERROR FROM INDIRECT FILE BR GETC1 ; GET INPUT FROM TERMINAL 20$: BGT 40$ ; BRANCH IF MORE CHARACTER IN RECORD MOV F.BDB(R0),R2 ; REALLY INDIRECT FILE? BNE 30$ ; BRANCH IF YES, IT'S OPEN MOV #AM,SR0(SP) ; RETURN 1 EXTRA ALTMODE CLR INDIR(R5) ; SHUT OFF CANNED INPUT RETURN 30$: MOV #CR,R1 ; OTHERWISE SEND CR CMP (R2),#IS.ESC ; ALTMODE TERMINATOR INSTEAD? BNE 50$ ; BRANCH IF NO MOV #AM,R1 ; USE AN ALTMODE TERMINATOR BR 50$ 40$: MOVB @F.NRBD+2(R0),R1 ; GET THE NEXT CHARACTER INC F.NRBD+2(R0) ; BUMP THE CHARACTER POINTER 50$: DEC F.NRBD(R0) ; DECREMENT THE CHARACTER COUNT REMAINING MOV R1,R0 ; R0 = CHARACTER BR LISTNX .ENABL LSB GETC1: .IF EQ,R$$11M QIOW$C IO.RNE!IO.RAL,TTYLUN,TTYEFN,,IOSTAT,,,CODE .IFF .IF EQ,RNEPAL QIO$C IO.RVB,TTYLUN,TTYEFN,,IOSTAT,,,CODE .IFF QIO$C IO.RAL,TTYLUN,TTYEFN,,IOSTAT,,,CODE .ENDC BCS 60$ DIR$ #TTWAIT 60$: .ENDC BCC 80$ CMP #IE.UPN,@#$DSW ; OUT OF DYNAMIC STORAGE? BNE 70$ ; BRANCH IF SOME OTHER ERROR WSIG$S ; WAIT FOR A SIGNIFICANT EVENT BR GETC1 ; AND TRY AGAIN 70$: JMP SYSERR ; CHECK OUT DIRECTIVE ERROR 80$: MOVB CHAR,R0 ; PICK UP CHARACTER TSTB IOSTAT ; CHECK FOR ERROR BGE 100$ CMPB IOSTAT,#IE.EOF ; YES - CHECK FOR CONTROL Z BEQ 90$ ; IF NOT ... ERROR TYI,<"TTY HANDLER FAILURE"> 90$: MOVB #CTRLZ,R0 ; EOF STATUS MEANS A CTRL Z WAS TYPED 100$: CMP IOSTAT,#IS.CR ; WAS IT A CARRIAGE RETURN ? BNE 110$ ; NO, A REAL CHARACTER MOV #CR,R0 ; IT WAS A CR, MAKE IT LOOK OK 110$: CMP IOSTAT,#IS.ESC ; WAS IT AN ALT FROM THE MULTI-HANDLER ? BNE 120$ MOV #AM,R0 ; YES, PUT IN THE ALT CODE 120$: BIC #177600,R0 ; USE SEVEN BIT ASCII BEQ GETC ; IGNORE NULLS AND L/T BIT #ET.LOC,ETYPE(R5) ; SEE IF LOWER CASE ACCEPTABLE BNE 130$ ; YES - CHARACTER IS NOW GOOD CMP #173,R0 ; CHECK FOR NON-STANDARD ALTMODES BEQ 130$ ; HERE IS ONE CMP #175,R0 ; THIS IS THE OTHER ONE BEQ 130$ CMP R0,#'A+40 ; CHECK FOR LOWER CASE ALPHAS BLO 130$ ; NO CMP R0,#'Z+40 ; HIGH LIMIT BHI 130$ ; NOT EITHER BIC #40,R0 ; CONVERT LOWER CASE TO UPPER CASE BR 130$ 130$: .IF EQ,RNEPAL CMP #'A-100,R0 ; CONTROL A ? BNE 140$ ; BRANCH IF NO MOV #RUB,R0 ; YES, RUBOUT FOR RSX11M 140$: CMP #'W-100,R0 ; CONTROL W? BNE LISTNX ; BRANCH IF NO MOV #'U-100,R0 ; YES, CONTROL U FOR RSX11M .ENDC LISTNX: CLR R4 ; SET IMMEDIATE TYPE OUT MODE CMP R0,#CR ; SEE IF A CR WAS JUST TYPED BNE 150$ DECB CRFLAG ; SET CR FLAG 150$: MOV R0,SR0(SP) ; PUT CHAR IN CALLER'S R0 TST INDIR(R5) ; NO ECHO IF INDIRECT FILE INPUT BNE 160$ CMP #RUB,R0 ; IF RUBOUT, DON'T ECHO IT .IF GT,RNEPAL BNE TYPEC ; OTHERWISE ECHO THIS CHARACTER 160$: RETURN .IFF BEQ 170$ ; BRANCH IF RUBOUT, DON'T ECHO CMP R0,#40 ; ONLY ECHOING SOME CONTROL CHARACTERS BLO 180$ ; BRANCH IF A CONTROL CHARACTER INC TABCNT ; KEEP TRACK OF TAB POSITION 170$: RETURN 180$: MOV #TYTABL/2,R1 ; GET CHAR TABLE SIZE MOV #TYTAB,R2 ; GET CHAR TABLE ADDRESS 190$: CMP R0,(R2)+ ; IS THIS A SPECIAL CHARACTER BNE 200$ ; BRANCHIF NO JMP @ECHDSP-TYTAB-2(R2) ; HANDLE SPECIAL ECHO 200$: SOB R1,190$ ; CHECK NEXT TABLE ENTRY BR TOCTRL ; ECHO NORMAL CONTROL CHARACTER ; ; ECHO CR ; ECHCR: CLR TABCNT ; RESET THE TAB POSITION ECHLF: ECHFF: ECHVT: RETURN ; ; ECHO TAB ; ECHTAB: ADD #10,TABCNT ; ADVANCE TO NEXT TAB POSITION BIC #7,TABCNT RETURN .ENDC .DSABL LSB .SBTTL PRINT - OUTPUT STRING TO CONSOLE ;+ ; ; *** - PRINT OUTPUT STRING TO CONSOLE ; ; THIS ROUTINE TYPES OUT THE DESIGNATED STRING ON THE CONSOLE TTY. ; ALL CHARACTERS ARE HANDLED AS IN THE TYPE ROUTINE (BELOW). ; ; INPUTS: ; ; R3 = POINTER TO CHARACTER STRING ; R4 = LENGTH OF CHARACTER STRING ; ; OUTPUTS: ; ; NONE ; ; ALL REGISTERS ARE PRESERVED. ; ;- PRINT:: SAVE TST R4 ; CHECK CHAR COUNT TO PROTECT AGAINST ZERO BEQ 20$ .IF EQ,R$$11M CALL TTATT ; ATTACH FOR PRINT DURATION .ENDC 10$: MOVB (R3)+,R0 ; PICK UP NEXT CHARACTER CALL TYPEC ; AND OUTPUT IT SOB R4,10$ ; COUNT CHARS AND LOOP CALL TYOUT ; AND FLUSH THE TYPE OUT BUFFER .IF EQ,R$$11M CALL TTDET ; DETACH AFTER THE PRINT .ENDC 20$: RETURN .SBTTL TYPE - OUTPUT CHARACTER TO CONSOLE ;+ ; ; *** - TYPE OUTPUT CHARACTER TO CONSOLE ; ; THIS ROUTINE OUTPUTS ONE CHARACTER TO THE CONSOLE TTY. SINCE THE ; SMALL RSX TTY HANDLER IS IN USE, ALL SPECIAL CHARACTERS ARE ; CAREFULLY INTERPRETED. TABS AND FORM FEEDS ARE SPACED APPROPRIATELY, ; ALT MODES ARE CONVERTED TO "$", AND ALL OTHER CONTROL CHARACTERS ; ARE OUTPUT AS "^". CHARACTERS ARE BUFFERED AND FED TO THE ; HANDLER MANY AT A TIME TO CUT DOWN ON SYSTEM OVERHEAD. ; ; INPUTS: ; ; R0 = CHARACTER TO BE TYPED. ; ; OUTPUTS: NONE ; ; ALL REGISTERS ARE PRESERVED. ; ;- TYPE:: SAVE CLR R4 ; SET SINGLE CHARACTER MODE TYPEC: ; ENTRY FOR INTERNAL USE BIT #ET.IMG,ETYPE(R5) ; CHECK FOR IMAGE MODE BNE TOCOMM ; BYPASS ALL FILTERING IF SET BIC #^C177,R0 ; MASK GARBAGE OFF CHARACTER MOV #TYTABL/2,R1 ; GET CHAR TABLE SIZE MOV #TYTAB,R2 ; GET CHAR TABLE ADDRESS 10$: CMP R0,(R2)+ ; TEST CHAR AGAINST TABLE ENTRY BNE 20$ JMP @TYDISP-TYTAB-2(R2) ; DISPATCH TO SPECIAL ROUTINE 20$: SOB R1,10$ ; COUNT TABLE ENTRIES AND LOOP CMP R0,#40 ; SEE IF THIS IS A RANDOM CONTROL CHAR BLO TOCTRL ; IF SO MAKE IT VISIBLE ; FOR ALL NORMAL PRINTING CHARACTERS, BUMP THE TAB COUNTER NORMAL: INC TABCNT ; INVISIBLE CHARACTERS ARE HANDLED THROUGH HERE TOLF: ; LINE FEED TOCOMM: CALL PUT ; STUFF CHAR INTO BUFFER TOEXT: TST R4 ; SEE IF THIS IS A TYPE OR PRINT CALL BNE 30$ CALL TYOUT ; TYPE OR ECHO - OUTPUT THE CHARACTER NOW 30$: RETURN ; AND EXIT ; TO HERE TO HANDLE CARRIAGE RETURN TOCR: CLR TABCNT ; ZERO THE TAB COUNTER BR TOCOMM ; AND OUTPUT A REAL CR ; TO HERE TO HANDLE ALT MODE TOAM: MOV #'$,R0 ; CONVERT TO DOLLAR SIGN BR NORMAL ; AND OUTPUT ; TO HERE TO HANDLE BELL TOBELL: CALL PUT ; OUTPUT REAL BELL BR TOCTRL ; THEN OUTPUT "^G" ; TO HERE TO HANDLE FORM FEED TOFF: MOV #8.,R1 ; CONVERT TO 8 LINE FEEDS BR TOFF1 ; TO HERE TO HANDLE VERTICAL TAB TOVT: MOV #4.,R1 ; CONVERT TO 4 LINE FEEDS TOFF1: MOV #LF,R0 ; GET LINE FEED 40$: CALL PUT ; AND PUMP THEM OUT SOB R1,40$ BR TOEXT ; TO HERE TO HANDLE HORIZONTAL TAB TOTAB: MOV #' ,R0 ; OUTPUT SPACES 50$: INC TABCNT ; BUMP THE TAB COUNTER CALL PUT ; OUTPUT A SPACE BIT TABCNT,#7 ; TEST FOR TAB STOP BNE 50$ BR TOEXT ; TO HERE TO HANDLE RANDOM CONTROL CHARACTERS TOCTRL: MOV R0,-(SP) ; SAVE ORIGINAL CHARACTER MOV #'^,R0 ; OUTPUT UP ARROW INC TABCNT CALL PUT MOV (SP)+,R0 ; RECOVER THE CHARACTER BIS #100,R0 ; CONVERT TO EQUIVALENT CHAR BR NORMAL ; AND OUTPUT IT ; THIS ROUTINE STUFFS A CHARACTER INTO THE TYPE OUT BUFFER AND ; OUTPUTS THE BUFFER WHEN IT IS FULL. PUT: MOV R0,-(SP) ; SAVE THE CHAR MOVB R0,@BUFPT ; STASH AWAY THE CHAR INC BUFPT ; BUMP THE POINTER CMP BUFPT,#TYOBUF+TYOBL BLO 60$ ; SEE IF THE BUFFER IS FULL CALL TYOUT ; IF SO, OUTPUT IT 60$: CMP TABCNT,TTLNSZ ; CHECK THE CHARACTER COUNT ON THIS LINE BLT 70$ ; OK IF LESS THAN 72 CLR TABCNT ; OTHERWISE MOV #CR,R0 ; OUTPUT A CR/LF CALL PUT ; TO WRAP THE LINE MOV #LF,R0 ; BECAUSE THE TTY HANDLER CALL PUT ; IS TOO CRETINOUS TO DO IT 70$: MOV (SP)+,R0 ; RESTORE R0 RETURN ; ROUTINE TO OUTPUT CONTENTS OF TYPEOUT BUFFER TO THE TTY. CHARACTERS ARE ; BUFFERED WHEN FEASIBLE TO CUT DOWN ON QIO OVERHEAD. TYOUT: MOV BUFPT,R2 ; GET TYPE OUT BUFFER POINTER SUB #TYOBUF,R2 ; COMPUTE NUMBER OF CHARACTERS PRESENT BLOS 100$ ; IF NONE, SKIP THE CALL MOV #IO.WLB,R0 ; SET UP FOR NORMAL WRITE BIT #ET.IMG!ET.WAL,ETYPE(R0) ; CHECK FOR IMAGE OR PASS ALL BEQ 80$ BIS #10,R0 ; IMAGE OR PASS ALL - SET PASS ALL MODE 80$: ; .IF EQ,R$$11M QIOW$S R0,#TTYLUN,#TTYEFN,,#IOSTAT,,<#TYOBUF,R2,> ; .IFF QIO$S R0,#TTYLUN,#TTYEFN,,#IOSTAT,,<#TYOBUF,R2,> BCS 90$ DIR$ #TTWAIT 90$: .ENDC ; CALL QIOCK MOV #TYOBUF,BUFPT ; RE-INIT BUFFER POINTER 100$: RETURN ; ; ATTACH THE TERMINAL ; TTATT: DIR$ #ATTACH ; .IF GT,R$$11M BR TTWAT ; .IFF RETURN .ENDC ; ; DETACH THE TERMINAL ; TTDET: DIR$ #DETACH ; .IF GT,R$$11M TTWAT: DIR$ #TTWAIT .ENDC ; RETURN .SBTTL SYSTEM DATE ROUTINE ;+ ; ; *** - DATE GET SYSTEM DATE ; ; THIS ROUTINE RETURNS THE DATE FROM THE SYSTEM IN A ONE WORD ; NUMERICALLY USEFUL FORM. BITS 0-4 CONTAIN THE DAY, BITS 5-8 CONTAIN ; THE MONTH, AND BITS 9-15 CONTAIN THE YEAR-1900. ; ; INPUTS: NONE ; ; OUTPUTS: ; ; R0 = DATE WORD ; ; ALL OTHER REGISTERS ARE PRESERVED. ; ;- DATE:: SAVE GTIM$C TIMBUF,CODE ; GET TIME PARAMETERS FROM RSX BCS SYSERR MOV TIMBUF+G.TIYR,R0 ; GET YEAR SWAB R0 ; INTO HIGH ORDER BIS TIMBUF+G.TIMO,R0 ; GET MONTH ASLB R0 ASLB R0 ASLB R0 ASLB R0 ASL R0 ; ALIGN YEAR AND MONTH BIS TIMBUF+G.TIDA,R0 ; AND GET DAY MOV R0,SR0(SP) ; PUT IN CALLER'S R0 RETURN RETURN .SBTTL SYSTEM TIME ROUTINE ;+ ; ; *** - TIME GET SYSTEM TIME ; ; THIS ROUTINE RETURNS THE TIME OF DAY FROM THE SYSTEM IN A ONE ; WORD NUMERICALLY USEFUL FORM. TIME IS RETURNED AS HALF ; THE NUMBER OF SECONDS SINCE MIDNIGHT. TOO BAD IT CAN'T BE JUST SECONDS, ; BUT THE NUMBER OF SECONDS IN A DAY IS GREATER THAN 16 BITS. ; ; INPUTS: NONE ; ; OUTPUTS: ; ; R0 = TIME WORD ; ; ALL OTHER REGISTERS ARE PRESERVED. ; ;- TIME:: SAVE GTIM$C TIMBUF,CODE ; GET TIME FROM RSX SYSTEM BCS SYSERR .IF EQ,R$$11M MOV TIMBUF+G.TIHR,R1 ; GET HOURS MUL #60.,R1 ; MULTIPLY UP BY 60 ADD TIMBUF+G.TIMI,R1 ; GET MINUTES MOV R1,R0 MUL #60.,R0 ; MULT BY 60 TO GET SECONDS ADD TIMBUF+G.TISC,R1 ; GET SECONDS ADC R0 ASHC #-1,R0 ; DIVIDE BY 2 AND RECOVER HIGH BIT .IFF CLR R0 MOV TIMBUF+G.TIHR,R1 ; GET HOURS ASL R1 ; *16 ASL R1 ASL R1 ASL R1 SUB TIMBUF+G.TIHR,R1 ; *15 ASL R1 ; *60 ASL R1 ADD TIMBUF+G.TIMI,R1 ; ADD IN MINUTES MOV R1,-(SP) ASL R1 ; *16 ASL R1 ASL R1 ASL R1 SUB (SP)+,R1 ; *15 ASL R1 ; *60 ASL R1 ROL R0 ; CARRY ADD TIMBUF+G.TISC,R1 ; ADD IN SECONDS ADC R0 ROR R0 ; DIVIDE BY 2 ROR R1 .ENDC MOV R1,SR0(SP) ; PUT IN CALLER'S RETURN REGISTER RETURN .SBTTL GET CONSOLE SWITCHES ROUTINE ;+ ; ; *** - SWITCH GET CONSOLE SWITCHES ; ; THIS ROUTINE RETURNS THE CONSOLE SWITCHES TO THE CALLING PROGRAM. ; ; INPUTS: NONE ; ; OUTPUTS: ; ; R0 = SWITCH WORD ; ; ALL OTHER REGISTERS ARE PRESERVED. ; ;- SWITCH:: SAVE GSSW$S ; GET SWITCH SETTING FROM RSX BCS SYSERR MOV @#$DSW,SR0(SP) ; GET VALUE FROM DSW RETURN .SBTTL NO CONTROL/O .IF GT,R$$11M ;+ ; ; *** - NOCTLO NO CONTROL/O ; ; THIS ROUTINE DISABLES THE AFFECT OF A PREVIOUSLY TYPED CONTROL O ; ; INPUTS: NONE ; ; OUTPUTS: NONE ; ; ALL REGISTERS ARE PRESERVED ; ;- NOCTLO:: CALL TTDET ; DETACH THE TERMINAL CALL TTATT ; AND REATTACH IT RETURN .ENDC .SBTTL SIZER - EXPAND MEMORY IF POSSIBLE ;+ ; ; *** - SIZER EXPAND MEMORY IF POSSIBLE ; ; THIS ROUTINE MAKES THE MEMORY RESERVED FOR THE INDIRECT FILE BUFFER ; AVAILABLE FOR TEXT STORAGE WHEN SUCH ADDITIONAL STORAGE IS NEEDED ; ; INPUTS: ; ; R1 = MINIMUM AMOUNT TO ALLOCATE ; ; OUTPUTS: ; ; C=0 IF SUCCESSFUL, C=1 IF FAILED ; CURFRE(R5) UPDATED IF SUCCESSFUL ; ; ALL REGISTERS PRESERVED ; ;- SIZER:: SAVE CMP #528.,R1 ; SEE IF SIZE NEEDED IS AVAILABLE BLO 10$ ; BRANCH IF NOT - C IS SET SEC MOV INDBUF,R0 ; IS THE INDIRECT BUFFER AVAILABLE? BEQ 10$ ; BRANCH IF NO MOV #EXPDMG,R3 MOV #EXPDSZ,R4 CALL PRINT ; SAY THAT MEMORY WAS EXPANDED ADD #INDBSZ,CURFRE(R5) ; RETURN AVAILABLE SPACE TO TEXT BUFFER CLR INDBUF ; SAY BUFFER NO LONGER AVAILABLE 10$: RETURN .SBTTL NULL ROUTINES ;+ ; ; THESE ARE ENTRIES REQUIRED IN THE TECOIO PACKAGE THAT HAVE NO MEANING ; UNDER RSX-11D. THEY ARE APPROPRIATELY NO-OP'ED. ; ;- .IF EQ,R$$11M NOCTLO:: ; NO CONTROL/O .ENDC WATCH:: ; MAINTAIN DISPLAY XITNOW:: ; DE-CONDITION TTY CLC RETURN .SBTTL EXIT ROUTINES ;+ ; ; *** - GEXIT EXIT AND GO ; ; *** - TEXIT EXIT ; ; THESE TWO ENTRIES ARE CALLED BY TECO TO EXIT. "TEXIT" SIMPLY EXITS ; TO THE MONITOR; "GEXIT" IS AN EXIT AND GO. SINCE ITS FUNCTION IS ; NOT CLEARLY DEFINED IN RSX-11D, IT ALSO JUST EXITS TO THE MONITOR. ; ; NO INPUTS, NO OUTPUTS, NO RETURN. ; ;- GEXIT:: TEXIT:: CALL CLOSIF ; CLOSE THE INPUT FILE IF NECESSARY CALL INDCLS ; CLOSE THE INDIRECT FILE IF OPEN .IF GT,R$$11M CALL TTDET ; DETACH THE TERMINAL .ENDC EXIT$S ; AND GO DOWN THE TUBES. .SBTTL QIO CALL CHECK ROUTINE ;+ ; ; *** - QIOCK CHECK RESULTS OF QIO CALL ; ; THIS ROUTINE TESTS THE RESULTS OF A QIO CALL (MAINLY TO THE TTY ; HANDLER). IF ALL IS WELL, IT RETURNS. IF NOT, IT BRANCHES TO THE ; ERROR EXIT. ; ; INPUTS: ; ; C BIT ; IOSTAT ; ; OUTPUTS: NONE ; ; ALL REGISTERS ARE PRESERVED. ; ;- QIOCK: BCS SYSERR ; TEST FOR DIRECTIVE ERROR TSTB IOSTAT ; CHECK I/O STATUS BLT IOERR ; OUT IF ERROR RETURN .SBTTL ERROR EXIT ROUTINE ;+ ; ; *** - ERRORX ERROR EXIT ; ; THIS ROUTINE IS CALLED BY THE ERROR MACRO TO RETURN A 3 CHAR ; RADIX-50 ERROR CODE AND A POINTER TO AN ERROR MESSAGE STRING. ; ; CALL: JSR R5,ERRORX ; ; ; ; THIS ROUTINE RETURNS TO THE CALLING PROGRAM. ; ;- ERRORX: MOV STACK,SP ; CLEAN OFF THE STACK MOV (R5)+,SR0(SP) ; PUT RAD-50 CODE IN R0 FOR RETURN .IF NE,ERRTXT MOV R5,SR2(SP) ; GET POINTER TO MESSAGE .IFF CLR SR2(SP) ; CLEAR MESSAGE POINTER IF STRINGS ARE NOT PRESENT .ENDC SEC ; INDICATE ERROR RETURN .SBTTL SYSTEM ERROR RETURN HANDLERS ;+ ; ; *** - SYSERR DIRECTIVE ERROR EXIT ; ; *** - IOERR DEVICE HANDLER ERROR EXIT ; ; *** - FCSERR FCS ERROR EXIT ; ; *** - FCSERR FCS FILE PROCESSING ERROR EXIT ; ; THESE ROUTINES INTERPRET ERROR CODES FROM ALL SYSTEM ROUTINES. ; IN GENERAL, A STANDARD RAD-50 ERROR CODE IS PRODUCED BY ; CONVERTING THE ERROR NUMBER TO THREE ASCII DIGITS. ; IF TECOIO IS ASSEMBLED TO INCLUDE MESSAGES, ; MO IS CALLED TO OBTAIN THE SYSTEM'S ERROR MESSAGE. ; ; ENTRY IS MADE WITH BRANCH OR JUMP ; ; ALL ROUTINES RETURN TO THE CALLING PROGRAM. ; ;- SYSERR: MOV @#$DSW,R1 ; GET ERROR CODE SUB #128.,R1 ; CONVERT TO DIRECTIVE ERROR OFFSET BR ERRCOM ; AND RETURN ERROR TO USER ; ENTRY FOR HANDLER ERRORS IOERR: MOVB IOSTAT,R1 ; PICK UP ERROR CODE BR ERRCOM ; ENTRY FOR FCS ERRORS AND COMMON CODE FCSERR: MOVB F.ERR(R0),R1 ; GET ERROR CODE FROM FDB TSTB F.ERR+1(R0) ; CHECK DIRECTIVE ERROR INDICATOR BGE ERRCOM SUB #128.,R1 ; ADJUST ERROR CODE FOR DIRECTIVE ; COMMON I/O ERROR CODE ERRCOM: MOV STACK,SP ; RESTORE THE STACK POINTER ; .IF EQ,R$$11M NEG R1 ; MAKE ERROR CODE POSITIVE MOV R1,R4 ; AND SAVE IT ; .IFF MOV R1,R4 ; SAVE NEGATIVE ERROR CODE NEG R1 ; AND MAKE IT POSITIVE .ENDC ; MOV PC,R2 ; NON-0 TO PRODUCE LEADING ZEROES BIC #^C177,R1 ; REDUCE TO BASIC CODE AGAIN MOV #STRING,R0 ; POINT TO STRING BUFFER CALL $CBDMG ; PUT IN DECIMAL ERROR NUMBER SUB #3,R0 ; BACK UP 3 CHARACTERS WORTH CALL $CAT5 ; CONVERT TO RAD-50 MOV R1,SR0(SP) ; STORE IN R0 SAVE FOR RETURN .IF NE,ERRTXT MOV SR5(SP),R5 ; RESTORE R5 CMP EHELP(R5),#1 ; CHECK THE HELP LEVEL BEQ NOMO ; DON'T BOTHER TO CALL MO ; IF HE'S NOT GOING TO USE IT .IF EQ,R$$11M MOUT$S #MSGFIL,,R4,CONT,USBUF,#STRING,#STRNGL,#IOSTAT,#MOLUN,NOMO2 TSTB IOSTAT ; CHECK FOR MO ERROR BLT NOMO ; RETURN NO STRING ON ERROR MOV STRING+2,R1 ; R1 = NO. OF BYTES IN MESSAGE BEQ NOMO ; BRANCH IF NULL .IFF MOV R4,R1 ; ERROR CODE TO R1 MOV #STRING+4,R0 ; ADDRESS TO STORE TEXT IN R0 CALL .FCSER ; TRANSLATE ERROR CODE TO MESSAGE .IFTF MOV #STRING+4,SR2(SP) ; RETURN ADDRESS OF MESSAGE BR ERRX .IFT NOMO2: TST (SP)+ ; THROW AWAY RETURN FROM ABOVE CALL .ENDC .ENDC NOMO: CLR SR2(SP) ; RETURN NO STRING ADDRESS ERRX: SEC ; INDICATE ERROR RETURN .SBTTL REGISTER SAVE ROUTINE ;+ ; ; *** - SAVREG SAVE ALL REGISTERS ; ; THIS ROUTINE SAVES ALL REGISTERS ON THE STACK AND SETS UP TO ; HAVE THEM RESTORED WHEN THE CALLING ROUTINE EXITS. ; ; CALL: JSR R5,SAVREG ; ;- SAVREG: MOV R4,-(SP) ; SAVE ALL REGISTERS MOV R3,-(SP) MOV R2,-(SP) MOV R1,-(SP) MOV R0,-(SP) MOV R5,-(SP) MOV SR5(SP),R5 ; RESTORE R5 MOV SP,STACK ; SAVE STACK POINTER FOR ERROR UNWIND JSR PC,@(SP)+ ; RETURN TO CALLER ; CO-ROUTINE EXIT CAUSES CONTROL TO RETURN HERE WHEN CALLER EXITS. MOV (SP)+,R0 ; RESTORE REGISTERS MOV (SP)+,R1 MOV (SP)+,R2 MOV (SP)+,R3 MOV (SP)+,R4 MOV (SP)+,R5 RTS PC ; AND RETURN .END TECOIO