TITLE TECOIO,,40,31-DEC-84,MHB/WJS ; ; COPYRIGHT (c) 1974, 1985 BY ; DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. ; ; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED ; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND 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. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY ; TRANSFERRED. ; ; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE ; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT ; CORPORATION. ; ; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS ; SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL. ; .SBTTL MACROS .MACRO CHKERR CODE,SRC=IOSTS .DSABL CRF .GLOBL CODE .ENABL CRF CMPB #CODE,SRC .ENDM CHKERR .MACRO SETERR CODE,DST=IOSTS .DSABL CRF .GLOBL CODE .ENABL CRF MOV #CODE,DST .ENDM SETERR .MACRO ENTRY TAG .SBTTL TECOIO ROUTINE "TAG" TAG:: .ENDM ENTRY .MACRO SENTRY TAG ENTRY TAG CALL SAVREG,R4 .ENDM SENTRY .MACRO SETFQB FUN CALL SETFQB,R0, .ENDM SETFQB .MACRO ERR CODE,TEXT TMPORG TECOIE .EVEN .DSABL CRF $$$$$$ = . .ENABL CRF UNORG CALL ERR,R4,$$$$$$ TMPORG TECOIE .RAD50 /CODE/ .NLIST BEX .ASCIZ TEXT .LIST BEX UNORG .ENDM ERR .MACRO MESAGE TEXT TMPORG TECOIE .DSABL CRF $$$$$$ = . .ENABL CRF UNORG CALL ASCIC,,$$$$$$ TMPORG TECOIE .DSABL CRF $$$$$0 = . .NLIST .ASCII TEXT .LIST $$$$$$ = .-$$$$$0 . = $$$$$0 .ENABL CRF .NLIST BEX .ASCII <$$$$$$>TEXT .LIST BEX UNORG .ENDM MESAGE .MACRO VECTOR AT,TO ORG VE,AT-P.OFF .WORD TO .ENDM VECTOR .SBTTL DEFINITIONS .ENABL LC .PSECT TECORO,RO,I,LCL,REL,CON DEFORG TECORO .PSECT TECOLS,RO,I,GBL,REL,OVR DEFORG TECOLS .PSECT TECOLT,RO,I,GBL,REL,OVR DEFORG TECOLT .PSECT TECOCH,RO,D,GBL,REL,OVR ORG TECOCH .PSECT TECOER,RO,D,LCL,REL,CON DEFORG TECOER .PSECT TECOIE,RO,D,LCL,REL,CON DEFORG TECOIE .PSECT TECOIO,RO,I,LCL,REL,CON DEFORG TECOIO .PSECT EGFUNC,RO,I,GBL,REL,OVR DEFORG EGFUNC .PSECT SCREEN,RO,I,GBL,REL,OVR DEFORG SCREEN .PSECT SCRSEQ,RO,D,GBL,REL,CON DEFORG SCRSEQ .PSECT SCRSUB,RO,I,GBL,REL,CON DEFORG SCRSUB .PSECT SCRINS,RO,I,GBL,REL,OVR DEFORG SCRINS .PSECT CRTRUB,RO,I,GBL,REL,OVR DEFORG CRTRUB .PSECT PATCH, RO,D,GBL,REL,OVR DEFORG PATCH .PSECT VE, RO,D,GBL,REL,OVR DEFORG VE PDLSIZ == 130. ;PDL SIZE SCHSIZ == 130. ;SEARCH BUFFER SIZE FILSIZ == 130. ;FILENAME BUFFER SIZE TAGSIZ == 130. ;TAG BUFFER SIZE SIZERB == 1024.*2 ;EXPAND MEMORY IN 1K (WORD) CHUNKS O.FLAG == 0 ;NO SPECIAL RTS FLAGS NEEDED O.DEXT == ^RTEC ;DEFAULT EXECUTABLE EXTENSION O.MSIZ == 4. ;4K MINIMUM/INITIAL SIZE O.SIZE == 32. ;32K MAXIMUM SIZE (LET RTS ADD WILL FIGURE IT OUT...) B2SPOS = 8. ;DEFAULT /B2 "&" POSITION ; CONSOLE SWITCH REGISTER .PEEK ADDRESS SWR = 177570 ;CONSOLE SWITCH REGISTER ; TERMINAL MODE BITS TTTECO = 2. ;TECO MODE TTCRLF = 4. ;NO AUTOMATIC CR/LF MODE TTTECS = 128. ;TECO SCOPE MODE TTESEQ = 256. ;ESCAPE SEQUENCE MODE ; TERMINAL MODIFIER BITS TI.CND = 8192. ;CONDITIONAL TERMINAL INPUT TO.BIN = 4096. ;BINARY MODE TERMINAL OUTPUT TO.CTL = 16384. ;CLEAN CONTROLS MODE TERMINAL OUTPUT ; DISK MODE BITS TENTAT = 32. ;ENTER A TENTATIVE FILE NSUPER = 128. ;NO SUPERSEDE ON CREATE RONLY = 8192. ;READ-ONLY MODE .SBTTL PARAMETER BLOCK DEFINITIONS .DSECT FO: .BLKW ;FILE STATUS (CH # *2 AND FLAGS) CC: .BLKW ;CURRENT COUNT CP: .BLKW ;CURRENT POINTER RP: .BLKW ;RESET POINTER (BUFFER START) RC: .BLKW ;RESET COUNT (BUFFER SIZE) B2S.AP: .BLKW ;SPECIAL .B2S "&" POSITION B2S.CP: .BLKW ;SPECIAL .B2S CURRENT POSITION CA: .BLKW ;READ/WRITE A BYTE CALL ADDRESS F$FORG: .BLKB ;FILE ORGANIZATION F$RATT: .BLKB ;RECORD ATTRIBUTES F$RSIZ: .BLKW ;(MAXIMUM) RECORD SIZE F$HVBN: .BLKW 2 ;HIGHEST VIRTUAL BLOCK NUMBER ALLOCATED F$HEOF: .BLKW 2 ;END-OF-FILE VIRTUAL BLOCK NUMBER F$FFBY: .BLKW ;FIRST FREE BYTE IN EOF BLOCK F$BKSZ: .BLKB ;BUCKET SIZE F$HDSZ: .BLKB ;FIXED HEADER SIZE (0 => 2) F$MRS: .BLKW ;MAXIMUM RECORD SIZE (0 => UNLIMITED) FQ: .BLKB FQBSIZ-FQJOB ;SAVED FILE (FIRQB) DATA PARMSZ: ;PARAMETER SIZE IN BYTES .SBTTL PARAMETER BLOCK BIT DEFINITIONS .BSECT HIGH ;IN FO DO.FMT: .BLKB . ;DO SPECIAL .BAS/.B2S TYPE FILE PROCESSING DDRLO: .BLKB . ;FILE IS READ LOCKED DDWLO: .BLKB . ;FILE IS WRITE LOCKED ATEOF: .BLKB . ;FILE IS CURRENTLY AT END-OF-FILE DO.MOD: .BLKB . ;W/ DO.FMT => .B2S, W/O DO.FMT => ASCII (NOT BINARY) FLGFRC: .BLKB . ;OUTPUT FILE IS BYTE ORIENTED DOEB: .BLKB . ;DO "EB" RENAMING ON OUTPUT FILCLCLOSE DOREN: .BLKB . ;DO RENAMING ON OUTPUT FILE CLOSE .DSECT ;IN F$FORG R.ANF: ;**ANSI FORMAT "F" RECORDS** R.UDF: .BLKB ;UNDEFINED RECORDS R.FIX: .BLKB ;FIXED LENGTH RECORDS R.VAR: .BLKB ;VARIABLE LENGTH RECORDS R.VFC: .BLKB ;VARIABLE LENGTH WITH FIXED CONTROL RECORDS R.STM: .BLKB ;ASCII STREAM RECORDS R.AND: ;**ANSI FORMAT "D" RECORDS** .BSECT ;IN F$RATT FD.FTN: .BLKB . ;FORTRAN CARRIAGE CONTROL FD.CR: .BLKB . ;IMPLIED BEFORE, AFTER FD.PRN: .BLKB . ;PRINT FORMAT CONTROL FD.BLK: .BLKB . ;RECORDS DO NOT SPAN BLOCK BOUNDARIES .SBTTL "ET" (EDIT TYPEOUT) BITS .BSECT ET$BIN::.BLKB . ; +1., OUTPUT IN BINARY (IMAGE) MODE ET$CRT::.BLKB . ; +2., DO SCOPE TYPE RUBOUT AND CONTROL/U ET$LC:: .BLKB . ; +4., ACCEPT LOWER CASE INPUT ET$NCH::.BLKB . ; +8., NO ECHO DURING INPUT FOR CTRL/T ET$CCO::.BLKB . ; +16., CANCEL CONTROL/O ON OUTPUT ET$CKE::.BLKB . ; +32., RETURN -1 IF ERROR/NO INPUT ON CTRL/T ET$DET::.BLKB . ; +64., DETACH AND DETACHED FLAG ET$XIT::.BLKB . ; +128., "NO PROMPT YET" FLAG ET$TRU::.BLKB . ; +256., TRUNCATE LONG OUTPUT LINES ET$IAS::.BLKB . ; +512., INTERACTIVE SCOPE AVAILABLE FOR "WATCH" ET$RFS::.BLKB . ; +1024., REFRESH SCOPE AVAILABLE FOR "WATCH" .BLKB . ; +2048., RESERVED BY TECO-8 ET$8BT::.BLKB . ; +4096., TERMINAL IS AN 8-BIT TERMINAL ET$GRV::.BLKB . ; +8192., ACCEPT "`" AS ESCAPE DURING COMMAND INPUT .BLKB . ;+16384., UNUSED ET$CC:: .BLKB . ;-32768., ALLOW PROGRAM TO TRAP CONTROL/C .SBTTL "ED" (EDIT MODE) BITS .BSECT ED$CTL::.BLKB . ; +1., DON'T ALLOW "^" AS MEANING CONTROL CHARACTER ED$YNK::.BLKB . ; +2., ALLOW YANKS, ETC. TO CLOBBER TEXT BUFFER ED$EXP::.BLKB . ; +4., DON'T ALLOW ARBITRARY EXPANSION(S) .BLKB . ; +8., RESERVED BY TECO-8 ED$SRH::.BLKB . ; +16., DON'T RESET "DOT" ON SEARCH FAILURE ED$IMD::.BLKB . ; +32., ALLOW IMMEDIATE MODE COMMANDS ED$INC::.BLKB . ; +64., ONLY MOVE "DOT" BY ONE ON ITERATIVE SEARCH FAILURES ED$WCH::.BLKB . ; +128., DON'T DO AUTOMATIC "W" COMMAND BEFORE PROMPT .BLKB . ; +256., UNUSED .BLKB . ; +512., UNUSED .BLKB . ; +1024., UNUSED .BLKB . ; +2048., UNUSED .BLKB . ; +4096., UNUSED .BLKB . ; +8192., UNUSED .BLKB . ;+16384., UNUSED .BLKB . ;-32768., UNUSED .SBTTL STATIC AREA DEFINITIONS .EQUATE TTOBFL, 56 ;DEFAULT TERMINAL OUTPUT BUFFER LENGTH .EQUATE TTIBFL, 200 ;TERMINAL INPUT BUFFER/CORE COMMON LENGTH .DSECT TTOBUF: .BLKB TTOBFL ;DEFAULT TERMINAL OUTPUT BUFFER SPSAVE: .BLKW ;SAVED SP VALUE FOR ERROR RECOVERY .BLKB 32 ;MONITOR'S CONTEXT SAVING AREA ERRBUF: .BLKB 28.+1 ;ERROR MESSAGE BUFFER (28. CHARACTERS AND A NULL) .BLKB 231 ;SP STACK SPACE USRSP: ;SP STACK RESET VALUE KEY: .BLKW ;KEYWORD IOSTS: ;I/O STATUS & ERROR CODE LOCATION FIRQB: .BLKB FQBSIZ ;FIRQB XRB: .BLKB XRBSIZ ;XRB TTIBUF: ;TERMINAL INPUT BUFFER CORCMN: .BLKB TTIBFL ;CCL LINE BUFFER SVNENT: .BLKW ;SAVED 'FQNENT' VALUE CURSIZ: .BLKB ;CURRENT IMAGE SIZE IN K TEROPN: .BLKB ;TERMINAL IS OPEN FLAG TTOBFS: .BLKW ;POINTER TO START OF TERMINAL OUTPUT BUFFER TTOBFE: .BLKW ;POINTER TO LAST BYTE OF TERMINAL OUTPUT BUFFER TTICNT: .BLKW 2 ;CC AND CP FOR TERMINAL INPUT SETPTR: .BLKW ;THE FILENAME/TERMINAL OUTPUT BUFFER POINTER ENSAV: .BLKB FQBSIZ-FQJOB ;SAVE FIRQB DATA FOR "EN" USRPPN: .BLKW ;USER'S ASSIGNED PPN USRPRT: .BLKW ;USER'S ASSIGNED PROT CODE USRLOG: .BLKW 4*4 ;USER'S LOGICAL DEVICE TABLE NSTORG: ;END OF STATIC REGION .SBTTL NON-STATIC AREA DEFINITIONS INPNOR: .BLKB PARMSZ ;NORMAL INPUT PARAMETERS INPALT: .BLKB PARMSZ ;ALTERNATE INPUT PARAMETERS OUPNOR: .BLKB PARMSZ ;NORMAL OUTPUT PARAMETERS OUPALT: .BLKB PARMSZ ;ALTERNATE OUTPUT PARAMETERS CMDPRM: .BLKB PARMSZ ;INDIRECT COMMAND PARAMETERS PDLSRT: .BLKB PDLSIZ ;PDL AREA SCHSRT: .BLKB SCHSIZ ;SEARCH BUFFER AREA FILSRT: .BLKB FILSIZ ;FILENAME BUFFER AREA TAGSRT: .BLKB TAGSIZ ;TAG BUFFER AREA INI8BT: .BLKB ;INITIAL 7/8-BIT SETTING INIDLM: .BLKB ;INITIAL PRIVATE DELIMITER R5SET: ;START OF "TECO"S R5 AREA .SBTTL DO AN I/O BUFFER SHUFFLE ORG TECOIO SHUFLE: MOV R2,-(SP) ;SAVE R2 MOV R1,R2 ;COPY OLD TOP TO HERE AND ADD R0,R2 ; FIND THE NEW TOP 10$: CMP R4,#INPNOR ;DONE WITH CORRECTIONS? BLOS 40$ ;YES SUB #PARMSZ-RP,R4 ;NO, SKIP TO THE RESET POINTER ADD R0,(R4) ;CORRECT RESET POINTER TST -(R4) ;VALID CURRENT POINTER? BEQ 20$ ;NOPE ADD R0,(R4) ;YES, SO CORRECT IT 20$: CMP -(R4),-(R4) ;SKIP TO START OF PARAMETER BLOCK BR 10$ ; AND CONTINUE CORRECTING 30$: MOV -(R1),-(R2) ;MOVE 2 DATA BYTES UP 40$: CMP R2,RP(R4) ;ALL DONE? BHI 30$ ;NOT YET... MOV (SP)+,R2 ;DONE, RESTORE R2 ADD R0,CURFRE(R5) ;UPDATE FREE COUNT RETURN ; AND EXIT GLOBAL .SBTTL SET UP THE FIRQB SETFQB::MOV #FIRQB+FQBSIZ,R4 ;END+2 POINTER TO FIRQB 10$: CLR -(R4) ;CLEAR IT CMP R4,#FIRQB+FQJOB ;DONE? BHI 10$ ;NO, LOOP MOV (R0)+,(R4)+ ;YES, SO SET FUNCTION RETURN R0 ; AND EXIT .ENABL LSB ENTRY ALLERR ;AN ERROR OCCURED IN TECO BIC #ET$CC!ET$CKE!ET$CCO!ET$NCH!ET$BIN,ETYPE(R5) ;CLEAR SOME IN "ET" TSTB ETYPE(R5) ;ANY PROMPT YET? BPL 10$ ;YES, JUST CONTINUE .ASSUME ET$XIT EQ 200 CALL @(SP)+ ;NOPE, CO-ROUTINE RETURN CALLX CRLFNO ;CANCEL ^O AND RESTORE CARRIAGE BR TEXIT ; AND, THEN, EXIT 10$: CALL SAVREG,R4 ;SAVE REGISTERS, ETC. INDCLS: MOV INDIR(R5),R3 ;GET INDIRECT PARAMETER POINTER CLR INDIR(R5) ; THEN CLEAR OUT THE POINTER TST R3 ;IS THERE REALLY AN INDIRECT FILE? BLE 20$ ;NO, JUST EXIT MOV #FIPCHK,-(SP) ;SET A RETURN ADDRESS .SBTTL DEALLOCATE AN I/O BUFFER DEALC: MOV R3,R4 ;COPY THE PARAMETER BLOCK POINTER ADD #RC,R4 ;INDEX TO THE RESET COUNT MOV (R4),R0 ;GET OLD SIZE OF THE BUFFER CLR (R4) ; THEN MAKE BUFFER SIZE ZERO MOV -(R4),R1 ;GET OLD RESET POINTER (TOP) ADD R0,(R4) ; THEN CORRECT THE RESET POINTER CLR -(R4) ;CLEAR THE CURRENT POINTER CLR -(R4) ;CLEAR THE CURRENT COUNT MOV -(R4),R2 ;GET THE CHANNEL # CLR (R4) ; THEN INDICATE NOT OPEN ANYMORE CALL SHUFLE ;NOW SHUFFLE AWAY... CLSFUN: MOV #FIRQB+FQFUN,R4 ;GET A FIRQB POINTER AND CLRB (R4)+ ; SET "CLSFQ" .ASSUME CLSFQ EQ 0 MOVB R2,(R4) ; AND SET THE CHANNEL # 20$: RETURN ;NOW EXIT .DSABL LSB GLOBAL ENTRY NOCTLO ;CANCEL ^O EFFECT TST INDIR(R5) ;IS INDIRECT FILE IN "FUNNY" STATE? BPL NOCCO ;NO CLR INDIR(R5) ;YES, SO REALLY "CLOSE" IT NOCCO: .TTRST ;NOW CANCEL THE CONTROL/O EFFECT BIC #ET$CCO,ETYPE(R5) ; AND SAY WE DID IT BR SETDET ;SET DETACHED IF NOW WE ARE ENTRY XITNOW ;STOP SPECIAL TECO TERMINAL HACKS .TTECH ;ENABLE ECHO IF NEEDED .TTRST ;CANCEL ^O EFFECT IF NEEDED BR OFFTER ;NOW GO CLOSE OFF THE TERMINAL .SBTTL DETACH AND DETACHED CHECKING .ENABL LSB DETACH: MOVB #UU.DET,FIRQB+FQFUN ;SET DETACH FUNCTION MOVB #200,FIRQB+FQERNO ; CLOSING ALL TERMINAL CHANNEL(S) .UUO ;NOW DO IT CHKDET: CLR XRB+XRCI ;TRY SOME HARMLESS OPERATION .POSTN ; ON CHANNEL #0 SETDET: BIC #ET$DET,ETYPE(R5) ;GUESS AT NOT DETACHED NOW CHKERR DETKEY ;ARE WE DETACHED? BNE 10$ ;NOPE, EXIT Z-BIT=0 FOR "NOT DETACHED" BIS #ET$DET,ETYPE(R5) ;YEP, SO INDICATE DETACHEDNESS OFFTER: TSTB TEROPN ;IS THE TERMINAL OPEN? BEQ 10$ ;NO, EXIT Z-BIT=1 FOR "DETACHED" MOV R4,-(SP) ;YES, SAVE R4 CALL CLSFUN ;SETUP THE FIRQB FOR A CLOSE FUNCTION CALL OPNTER ;GO SET CHANNEL #1 AND DO THE CLOSE MOV (SP)+,R4 ;RESTORE R4 CLRB TEROPN ;SAY TERMINAL CLOSED NOW ;SEZ ;Z-BIT=1 FOR "DETACHED" (FROM 'CLRB' ABOVE) 10$: RETURN ;NOW EXIT WITH Z-BIT INDICATION OPNTER: MOV #1*2,(R4) ;SET CHANNEL # TO 1 BR FIPCHK ;GO DO IT AND ERROR CHECK GLOBAL .SBTTL FATAL ERROR ROUTINES ZOTALL::SETFQB RSTFQ ;SET UP FOR ALL CHANNEL RESET .TTECH ;ENABLE ECHO IF NEEDED .TTRST ;CANCEL ^O EFFECT IF NEEDED FIPCHK: CALFIP ;CALL FILE PROCESSOR IOCHK:: TSTB IOSTS ;ERROR? BEQ 10$ ;NO BADXXX: MOV #USRSP,SP ;RESET SP STACK CALL ERRMSG ;NOW GET THE ERROR MESSAGE MOV R2,R3 ; AND PUT POINTER HERE 20$: MOV #R5SET,R5 ;ENSURE VALID R5 POINTER CLR TTOBFS ;(RE-)INITIALIZE TERMINAL OUTPUT START .ASSUME TTOBUF EQ 0 MOV #TTOBUF+TTOBFL-1,TTOBFE ; AND LAST BYTE POINTERS CALLX CRLFNO ;CANCEL ANY ^O AND RESTORE CARRIAGE CALL ASCIZ3 ;NOW PRINT IT CALLX CRLF ;DO A CR/LF BR EXIT ; AND GO AWAY BADONE: MOV #USRSP,SP ;RESET SP STACK JSR R3,20$ ;SET UNKNOWN MESSAGE POINTER, GO PRINT IT .ASCIZ "?Fatal" .EVEN .DSABL LSB .SBTTL EXITS .ENABL LSB ENTRY GEXIT ;EXIT AND GO -OR- SPECIAL FUNCTIONS TST NFLG(R5) ;SPECIAL FUNCTION CALL? BPL 10$ ;NO, IT'S EXIT-AND-GO JMP EGFUNC ;YES, OFF TO SPECIAL FUNCTION PROCESSOR... ENTRY TEXIT ;EXIT FROM TECO CLRB @FILBUF(R5) ;ENSURE NO EXIT-AND-GO ARGUMENT 10$: CLR R0 ;SET ARGUMENT TO TURN OFF ANY ACTIVE SCROLLER MOV #10000.,NWATCH(R5) ; AND ENSURE IT'S NOT THE DEFAULT ARGUMENT CALL WATCH ; THEN GO CALL FOR SCROLLING SHUT OFF CALL SAVFQB ;SAVE AND CLEAR THE FIRQB MOVB #UU.TRM,(R4)+ ;SET "SET TERMINAL" FUNCTION MOV (PC)+,(R4)+ ; AND OUR KB: TERMINAL .BYTE 0,-1 MOVB INI8BT,20-6(R4) ;RESET 7/8-BIT SETTING TO INITIAL SETTING MOVB INIDLM,30-6(R4) ;RESET PRIVATE DELIMITER TO INITIAL SETTING .UUO ;NOW GO DO IT CALL @(SP)+ ; THEN RESTORE THE FIRQB TST (PC)+ ;INDICATE THE NORMAL EXIT WITH C=0 EXIT: SEC ;INDICATE THE ABORT EXIT WITH C=1 MOV #USRSP,SP ;RESET SP STACK ROR -(SP) ; AND SAVE THE C-BIT INDICATION MOV #-1,XRB ;ENSURE ALL FLAGS .CLEAR ; ARE TURNED OFF CALL ZOTALL ;CLOSE ALL FILES TST (SP) ;AN ABORT EXIT? BMI 30$ ;YES, DON'T LOOK FOR A CCL COMMAND MOV FILBUF(R5),R2 ;GET THE CCL SUPPLIED (IF ANY) MOV #XRB+XRLOC,R3 ; AND GET AN XRB POINTER @ XRLOC MOV R2,(R3) ;SET POINTER TO (POSSIBLE) CCL COMMAND 20$: TSTB (R2)+ ;SKIP STRING BNE 20$ ; LOOKING FOR ENDING NULL DEC R2 ;END, BACK UP OVER THE NULL SUB (R3),R2 ; AND FIND LENGTH OF CCL COMMAND BEQ 30$ ;NO LENGTH, JUST GO EXIT MOV R2,-(R3) ;SET LENGTH IN XRB @ XRBC AND MOV R2,-(R3) ; IN XRB @ XRLEN .CCL ;BUT CHECK IT OUT CALL IOCHK ;DO CATCH ERRORS 30$: CLRB CORCMN ;EMPTY CORE COMMON... CLR FIRQB+FQNAM1 ;SIGNAL SWITCH TO PRIVATE DEFAULT .RTS ; AND TRY TO SWITCH TO IT ASL (SP)+ ;CAME BACK, CHECK THE ABORT EXIT FLAG BCS RESTRT ;ABORTING, JUST GO PROMPT MOV @#P.NEW,R0 ;SIMPLE EXIT, GET "NEW" ENTRY POINT ADDRESS CMP R0,#START ;LINKED WITH KEYBOARD MONITOR CODE? BNE 40$ ;YES, SO GO (RE-)CALL IT .EXIT ;NO, EXIT TO THE SYSTEM DEFAULT 40$: JMP (R0) ;OFF TO THAT TECO KEYBOARD MONITOR... .DSABL LSB GLOBAL .SBTTL CONTROL/C HANDLING TECOCC: BIT #ET$CC!ET$XIT,ETYPE+R5SET ;CTRL/C TRAP OR EXIT ON ERROR? BMI 10$ ;JUST CLEAR FLAG IF CONTROL/C TRAP IS ON .ASSUME ET$CC EQ 100000 BNE TEXIT ;EXIT NOW IF SO INDICATED CMP (SP),#TERINP ;WAITING FOR KB: INPUT? BEQ CHKABT ;YES, CHECK FOR ABORT OR RESTART MOVB #-1,TFLG+1+R5SET ;SIGNAL WE WANT TECO TO QUIT SOON 10$: BIC #ET$CC,ETYPE+R5SET ;CLEAR THE TRAP CONTROL/C FLAG RTI ;THEN JUST EXIT CHKABT: CALL INDCLS ;ENSURE ANY INDIRECT FILE IS CLOSED COMB KEY ;REALLY EXIT ON THIS CONTROL/C? BEQ TEXIT ;YES, SO GO EXIT JMP TECOGO ;NO, JUST DO A RESTART GLOBAL .SBTTL NOP STYLE SPECIAL FUNCTION PROCESSING TMPORG EGFUNC EGFUNC: CLR N(R5) ;RETURN FAILURE (0) RETURN ; AND EXIT GLOBAL UNORG .SBTTL SIMPLE VALUE RETURNING ROUTINES .ENABL LSB ENTRY DATE ;GET DATE MOV #XRB,R0 ;XRB+0 FOR DATE BR 10$ ;DO THE EMT ENTRY TIME ;GET TIME MOV #XRB+2,R0 ;XRB+2 FOR TIME 10$: .DATE ;GET DATE/TIME 20$: MOV (R0),R0 ;FETCH DATA ENTRY STOPON ;STOP INDICATOR ON SCRLOD::RETURN ;SIMPLE EXIT ENTRY SWITCH ;GET SWITCH REGISTER VALUE MOV #XRB,R0 ;XRB+0 FOR .PEEK MOV #SWR,(R0) ;SET THE PEEK ADDRESS .PEEK ; AND PEEK AT IT BR 20$ ;GO FETCH DATA AND EXIT .DSABL LSB .SBTTL MAIN STARTUP .ENABL LSB 10$: CMP SP,#USRSP-2 ;.CHAIN, SPECIAL FROM KEYBOARD MONITOR? BHIS 50$ ;YES (NO STACK PUSHES), JUST CALL IT A RUN... CMP (SP)+,(SP)+ ;NO, POP RUN DETERMINATION AND SAVED "FQFLAG" JMP EIDONE ; AND GO SAY "EI" DONE START: BIT #JFNOPR,KEY ;INITIAL ENTRY AND LOGGED OUT? BNE EXIT ;YEP, JUST GET OUT OF HERE RESTRT::MOV #USRSP,SP ;ENSURE A RESET SP STACK CLR FIRQB+FQNENT ;NEVER KEEP BIGNESS, ETC. CLR XRB ;NOT A CCL ENTRY EVER TST (PC)+ ;SET C=0 FOR A NEW TYPE ENTRY RUNIT: SEC ;SET C=1 FOR A RUN TYPE ENTRY ROR -(SP) ;SAVE THE RUN DETERMINATION (C-BIT) MOV @#P.MSIZ,R1 ;GET MINIMUM SIZE (IN K) MOV #R5SET,R5 ;SET THE TECO R5 OFFSET POINTER MOV #FIRQB+FQNENT,R3 ;GET A FIRQB/XRB POINTER @ FIRQB+FQNENT MOV (R3),R2 ;GET THE PARAMETER WORD ASL R2 ; AND DUMP "BIGNESS" FROM IT CMP R2,#30000.*2 ;IS IT BASIC-PLUS MAGIC? BLO 20$ ;NOPE BIC #^C<100000>,(R3) ;YEP, GET RID OF IT 20$: MOV #SVNENT,R0 ;GET POINTER TO STATIC AREA MOV (R3)+,(R0)+ ;SAVE THE 'FQNENT' VALUE MOV (R3),R2 ;SAVE THE CCL DETERMINATION .ASSUME XRB EQ FIRQB+FQNENT+2 CALL IOCHK ;CHECK FOR ALREADY EXISTING ERROR(S) .NAME ;INSTALL THE PROGRAM NAME MOV #-1,(R3) ;NOW SET TO DROP EVERYTHING MOVB -1(R0),R4 ;STACK BIGNESS FLAG AND INITIAL K SIZE BPL 30$ ;NO BIGNESS FLAG, REALLY DROP ALL MOV #^C,(R3) ;YES, SO DROP ALL BUT BIGNESS 30$: .CLEAR ;THIS CLEARS ALMOST EVERYTHING... BICB #200,R4 ;CLEAR POSSIBLE BIGNESS FLAG IN INITIAL K SIZE CMPB R4,R1 ;IS SPECIFIED INITIAL K SIZE > MINIMUM SIZE? BLOS 40$ ;NOPE MOVB R4,R1 ;YEP, SO USE IT INSTEAD 40$: BIT R2,#100001 ;WHAT KIND OF ENTRY? BEQ 50$ ;RUN OR INITIAL (<15>=0; <0>=0) BPL 10$ ;"EI" CHAIN (<15>=0; <0>=1) ;BMI ;CCL (<15>=1; <0>=?) CMPB R2,R1 ;DESIRE A BIGGER SIZE? BLOS 50$ ;NO, LEAVE IT ALONE MOVB R2,R1 ;YES, GET THE NEW SIZE BPL 50$ ;IF >0 THEN ABS NEW SIZE NEG R1 ;IF <0 THEN IS -(INC SIZE) ADD @#P.MSIZ,R1 ;SO DO IT 50$: MOV R1,(R0)+ ;SET "CURSIZ" TO INITIAL K SIZE; "TEROPN"=0 .ASSUME CURSIZ EQ SVNENT+2 .ASSUME TEROPN EQ CURSIZ!1 CLR (R0)+ ;INITIALIZE TERMINAL OUTPUT BUFFER START .ASSUME TTOBUF EQ 0 .ASSUME TTOBFS EQ CURSIZ+2 MOV #TTOBUF+TTOBFL-1,(R0)+ ; AND LAST BYTE POINTERS .ASSUME TTOBFE EQ TTOBFS+2 60$: CLR (R0)+ ;THEN CLEAR UNTIL CMP R0,#USRPPN ; THE END BLO 60$ ;KEEP GOING MOV R1,(R3)+ ;THIS IS THE K SIZE TO ASK FOR INITIALLY .CORE ;PLEASE GIVE US THIS MUCH CALL IOCHK ;THAT REQUEST BETTER NOT FAIL... MOV #NSTORG,R0 ;GET START OF NON-STATIC AREA ASH #11.,R1 ; AND SIZE IN BYTES 70$: CLR (R0)+ ;NOW CLEAR IT CMP R0,R1 ;MORE TO CLEAR? BLO 70$ ;KEEP GOING MOV R1,INPNOR+RP ;SET INITIAL BUFFER POINTERS MOV R1,INPALT+RP MOV R1,OUPNOR+RP MOV R1,OUPALT+RP MOV R1,CMDPRM+RP MOV #USRSP,TECOSP(R5) ;SET TECO'S RESET SP VALUE MOV #PDLSRT,TECOPD(R5) ;SET TECO'S PDL START MOV #PDLSRT,PDL(R5) ; AND INIT THE PDL MOV #SCHSRT,SCHBUF(R5) ;SET TECO'S SEARCH BUFFER COMB SCHSRT+SCHSIZ-1 ; FLAG THAT END MOV #FILSRT,FILBUF(R5) ;SET TECO'S FILENAME BUFFER COMB FILSRT+FILSIZ-1 ; FLAG THAT END MOV #TAGSRT,TAGBUF(R5) ;SET TECO'S TAG BUFFER COMB TAGSRT+TAGSIZ-1 ; FLAG THAT END MOV #INPNOR,INPNTR(R5) ;SET NORMAL INPUT MOV #OUPNOR,OUPNTR(R5) ;SET NORMAL OUTPUT MOV #TECOCH,TECOJP(R5) ;LOAD DEFAULT JUMP DISPATCH TABLE MOV #ET$XIT,ETYPE(R5) ;SET DEFAULT EDIT FLAG(S) COM OUTDNE(R5) ;SAY ALL SORTS OF OUTPUT DONE GLOBAL GLOBAL MOV R5,R0 ;COPY THE R5 READ/WRITE AREA POINTER ADD #RWSIZE,R0 ; AND GO BEYOND TECO'S PRIVATE DATA CALL SAVFQB ;SAVE AND CLEAR THE FIRQB MOVB #UU.TRM,(R4)+ ;SET "READ TERMINAL" FUNCTION MOV (PC)+,(R4)+ ; AND OUR KB: TERMINAL .BYTE 0,-1 .UUO ;SO DO IT TSTB IOSTS ;ANY ERROR?? BNE 100$ ;YES, FORGET ANY TERMINAL SETUP MOVB 36-6(R4),INI8BT ;SAVE INITIAL 7/8-BIT SETTING MOVB 30-6(R4),INIDLM ;SAVE INITIAL PRIVATE DELIMITER BISB #200,INIDLM ; MAKING SURE THAT IT GETS RESET INCB 15-6(R4) ;ALLOWING LOWER CASE INPUT? BNE 80$ ;NO BIS #ET$LC,ETYPE(R5) ;YES, ALLOW LOWER CASE INPUT INCB 11-6(R4) ;ALLOWING LOWER CASE OUTPUT? BEQ 80$ ;NO, LEAVE CASE FLAGING ON COM EUFLAG(R5) ;YES, DISABLE THE CASE FLAGING 80$: CMPB 36-6(R4),#30 ;IS THIS AN 8-BIT TERMINAL? BNE 90$ ;NO BIS #ET$8BT,ETYPE(R5) ;YES, INDICATE AN 8-BIT TERMINAL 90$: INCB 14-6(R4) ;SCOPE TYPE TERMINAL? BNE 100$ ;NO CALL CRTRUB ;YES, GO SET SCOPE TYPE, ETC. ADD R4,R0 ;ADD "WATCH" STATIC READ/WRITE TO POINTER TST R4 ;WAS "WATCH" REALLY SELECTED? BEQ 100$ ;NOPE MOV R0,TTOBFS ;YEP, START LARGER TERMINAL OUTPUT BUFFER HERE ADD #512.-1,R0 ; MAKING ITS SIZE 512. BYTES MOV R0,TTOBFE ;SET LAST BYTE POINTER ALSO INC R0 ; THEN BUMP OVER THAT LAST BYTE 100$: CALL @(SP)+ ;RESTORE THE FIRQB FOR SURE SUB R0,R1 ;NOW HAVE REAL FREE MEMORY MOV R0,TXSTOR(R5) ;TEXT STARTS HERE ;CLC ;C=0 FROM THE 'SUB' ABOVE ROR R1 ;GET 1/2 OF THE FREE SIZE MOV R1,ZMAX(R5) ;TEXT GETS 1/2 ADD R1,R0 ;GO BEYOND TEXT AREA MOV R0,QRSTOR(R5) ;Q-REG STARTS HERE MOV R1,QMAX(R5) ; AND Q-REG GETS OTHER 1/2 GLOBAL CALL CHKDET ;CHECK DETACHED AND FIND CH #0 POSITION TST (R3) ;DOES CARRIAGE NEED RESTORATION? BEQ 110$ ;NO CALLX CRLFNO ;YES, SO RESTORE THE CARRIAGE 110$: MOV #CORCMN,R0 ;GET CCL LINE/CORE COMMON BUFFER POINTER MOV SCHBUF(R5),R1 ;GET SEARCH STRING BUFFER POINTER MOV TXSTOR(R5),R3 ;GET TEXT AREA POINTER ASL R2 ;SET C-BIT=1 IF CCL ENTRY MOVB (R0)+,R4 ;GET SIZE OF THE CCL LINE/CORE COMMON BLE 150$ ;SIZE IS <=0, SO SKIP IT 120$: MOVB (R0)+,(R1) ;MOVE DATA TO SEARCH STRING BUFFER BEQ 140$ ;IGNORE ANY NULL BYTE BPL 130$ ;IT'S A NORMAL CHARACTER INCB (R1) ;IS IT A 377? BEQ 140$ ;YES, WE MUST IGNORE 377'S... DECB (R1) ;NO, FIX CHARACTER BACK UP BITB (R1),#^C<237> ;IS IT A (C1) CONTROL CHARACTER? BEQ 140$ ;YES, WE MUST IGNORE THOSE TOO... 130$: MOVB (R1)+,(R3)+ ;MOVE DATA TO TEXT AREA BCC 140$ ;NOT CCL, SO DON'T COUNT AS TEXT INC ZZ(R5) ;CCL, COUNT AS TEXT AREA DATA 140$: SOB R4,120$ ;LOOP FOR ALL DATA... CLRB (R1) ;NOW MARK END OF THE SEARCH STRING BUFFER 150$: TST (SP)+ ;WAS IT A RUN ENTRY? BMI 160$ ;YES, PROCESS THE "EI" FILE CALL ZOTALL ;ENSURE ALL CHANNELS CLOSED INITIALLY TECOGO: MOV #R5SET,R5 ;RELOAD THE TECO R5 VALUE JMPX TECO ;NOW GO..... 160$: ASL R2 ;IS THIS A CCL ENTRY WITH DETACH? BCC 170$ ;NO, BIT 14 = 0 (NO DETACH) CALL DETACH ;YEP, BIT 14 = 1, DO A DETACH 170$: MOV #FIRQB+FQFUN,R4 ;GET A FIRQB POINTER MOVB #RSTFQ,(R4)+ ;SET THE RESET CHANNEL(S) FUNCTION MOV #-15.*2,(R4) ; AND INDICATE ALL BUT CHANNEL #15. CALL FIPCHK ;DO THE FIP OPERATION AND CHECK FOR ERROR NEG (R4) ;CORRECT TO CH #15. IN THE FIRQB MOV #TECO,-(SP) ;STARTING TECO IS OUR RETURN ADDRESS CALL SAVREG,R4 ;SAVE REGISTERS FOR CORRECT SET UP JMP EIDONE ;NOW CONTINUE .DSABL LSB GLOBAL .ENABL LSB ENTRY FLAGRW ;CATCH TECO FLAG CHANGES/READS TST R2 ;IS IT THE "EJ" CALL? BNE 70$ ;NOPE DEC R0 ;YEP, WHAT'S THE CALLING ARGUMENT? BMI 30$ ;IT WAS -1 OR 0, GO SEE WHICH BEQ 10$ ;IT WAS 1, RETURN USER'S KEYBOARD NUMBER .STAT ;IT WAS 2, READ USER'S STATISTICS MOV XRB+10,R0 ;NOW GET THE USER'S PPN BR 60$ ; AND RETURN THAT 10$: MOVB #UU.ERR,FIRQB+FQFUN ;SET FUNCTION TO ERROR MESSAGE LOOKUP .UUO ; AND GET (ANY) ERROR MESSAGE... MOVB FIRQB+FQFUN,R0 ;GET KEYBOARD NUMBER TIMES 2 BR 40$ ; AND RETURN THAT 20$: MOV #4,R0 ;+4 IS THE OPERATING SYSTEM ID FOR RSTS/E BR 60$ ; AND RETURN THAT 30$: INC R0 ;WAS IT 0? BNE 20$ ;IT WAS -1, RETURN RSTS/E ID (+4) MOVB FIRQB+FQJOB,R0 ;IT WAS 0, GET JOB NUMBER TIMES 2 40$: ASR R0 ;MAKE JOB #/KB # NOT TIMES 2 BCC 50$ ;NOT DETACHED KB NUMBER... COM R0 ;DETACHED, FIX IT UP 50$: BIC #^C<177>,R0 ;ENSURE NO SIGN EXTENSION 60$: RETURN ; AND EXIT 70$: CLR R1 ;SAY NO TTYSET REQUIRED CMP R2,#EEFLAG ;EE BEING REFERRED TO? BNE 80$ ;NO => CONTINUE CMP R3,#-1 ;YES: IS EE BEING SET, THEN? BNE 60$ ;NO (NOTHING TO DO, THEN) => GO EXIT BIC #^C<177>,R0 ;EE BEING SET: CLEAN UP THE NEW VALUE BISB R0,R1 ;SAVE NEW PRIVATE DELIMITER FOR TTYSET BIS #200,R1 ; AND SAY IT'S "REAL" CALL OFFTER ;FORCE AN OPEN SOON BIC #ET$GRV,ETYPE(R5) ;SETTING EE CLEARS "ACCENT GRAVE" ET BIT GLOBAL 80$: CMP R2,#ETYPE ;IS IT THE "ET" FLAG? BNE 140$ ;NOPE => GO CHECK FOR TTYSET CALL CHKDET ;YEP, ENSURE DETACHED FLAG IS CORRECT CMP R3,#-1 ;SETTING IT (-1)?? BNE 150$ ;NO, READING "ET" => NOTHING TO DO MOV ETYPE(R5),-(SP) ;SETTING "ET", GET OLD VALUE XOR R0,(SP) ; AND FIND THE DIFFERENCES BIT (SP),#ET$GRV ;CHANGING "ACCENT GRAVE" ET BIT? BEQ 85$ ;NO => CONTINUE BIT R0,#ET$GRV ;YES: ARE WE SETTING IT? BEQ 84$ ;NO, CLEARING IT => LEAVE LOW R1 BYTE CLEAR BISB #140,R1 ;SETTING, WE WANT ACCENT GRAVE AS PRIV DELIM 84$: MOVB R1,EEFLAG(R5) ;RECORD NEW PRIVATE DELIMITER IN EE FLAG BIS #200,R1 ;SAY R1 TO BE USED FOR PRIV DELIM TTYSET CALL OFFTER ;FORCE AN OPEN SOON 85$: BIT (SP),#ET$8BT ;CHANGING 7/8-BIT TERMINAL MODE? BEQ 90$ ;NOPE BIS #20*400,R1 ;GUESS AT SETTING 7-BIT TERMINAL MODE BIT R0,#ET$8BT ;GOOD GUESS? BEQ 90$ ;YES BIS #30*400,R1 ;NO, CHANGE TO SETTING 8-BIT TERMINAL MODE 90$: BIT (SP)+,#ET$TRU!ET$CRT ;CHANGING TERMINAL HANDLING? BEQ 100$ ;NOPE CALL OFFTER ;YEP, SO FORCE AN OPEN SOON 100$: BIT R0,#ET$NCH ;WHAT IS THE ECHO STATE? BEQ 110$ ;ECHO IS ON, DO NOTHING RIGHT NOW .TTNCH ;ECHO IS OFF, ENSURE IT IS OFF 110$: BIT R0,#ET$CCO ;CANCELING CONTROL/O? BEQ 120$ ;NOPE .TTRST ;YEP, CANCEL IT IMMEDIATELY (LATER ALSO) 120$: BIT R0,#ET$DET ;TRYING TO DETACH?? BEQ 130$ ;NO BIT #ET$DET,ETYPE(R5) ;YES, BUT ALREADY DETACHED? BNE 130$ ;DON'T TRY AGAIN IF SO CALL DETACH ;ELSE GO TRY TO DETACH 130$: BIC #ET$RFS!ET$IAS!ET$DET,R0 ;ENSURE THE NEW "ET" MOV ETYPE(R5),-(SP) ; FLAG WILL BIC #^C,(SP) ; BE CORRECT BIS (SP)+,R0 ; FOR ALL CASES GLOBAL 140$: TST R1 ;ANY TTYSET CHANGES PENDING? BEQ 150$ ;NO => ALL DONE CALL SAVFQB ;SAVE AND CLEAR THE FIRQB MOVB #UU.TRM,(R4)+ ;SET "SET TERMINAL" FUNCTION MOV (PC)+,(R4)+ ; AND OUR KB: TERMINAL .BYTE 0,-1 MOVB R1,30-6(R4) ;SET NEW PRIVATE DELIMITER, IF REQUESTED SWAB R1 ;GET 7-BIT/8-BIT SETTING MOVB R1,20-6(R4) ;SET NEW 7/8-BIT MODE, IF REQUESTED .UUO ;NOW GO DO IT CALL @(SP)+ ; THEN RESTORE THE FIRQB 150$: RETURN ;NOW RETURN .DSABL LSB .ENABL LSB 10$: ERR NFI,<"No file for input"> 20$: BIS #ATEOF,-(R3) ;SET END-OF-FILE FLAG 30$: COM EOFLAG(R5) ;SET END-OF-FILE FLAG FOR "TECO" BR 90$ ; AND GO EXIT SENTRY GETBUF ;GET A BUFFER FULL MOV INPNTR(R5),R3 ;GET INPUT PARAMETERS POINTER MOV R0,R2 ;MOVE BUFFER POINTER TO HERE CLR FFFLAG(R5) ;PRE-CLEAR THE FORM FEED FLAG CLR EOFLAG(R5) ;PRE-CLEAR THE EOF FLAG TSTB (R3)+ ;IS THIS INPUT FILE OPEN? BEQ 10$ ;NOPE BITB #ATEOF/400,(R3)+ ;YES, BUT IS IT AT EOF NOW? BNE 30$ ;AT EOF, RETURN SUCH 40$: DEC R1 ;MORE ROOM IN "TECO"S BUFFER? BLE 90$ ;NO, GO EXIT 50$: CALL @CA-CC(R3) ;ROOM EXISTS, GET A BYTE BCC 20$ ;EOF, SO SET END-OF-FILE FLAG BIT #DO.MOD!DO.FMT,FO-CC(R3) ;IS IT 8-BIT BINARY MODE? BEQ 60$ ;YES TST R0 ;A NULL? BEQ 50$ ;IGNORE 'S CMP R0,#177 ;A RUBOUT? BEQ 50$ ;IGNORE 'S CMP R0,#015 ;IS THIS ? BNE 60$ ;NOPE BIT #DO.FMT,FO-CC(R3) ;YES, SPECIAL .BAS/.B2S INPUT FILE? BNE 50$ ;IGNORE 'S IF .BAS/.B2S TYPE FILE 60$: CMP R0,#014 ;FORM FEED? BEQ 100$ ;YES, ALL DONE MOVB R0,(R2)+ ;ELSE STORE DATA FOR "TECO" INC ZZ(R5) ; AND COUNT IT AS STORED CMP R0,#012 ;DID WE STORE A ? BNE 80$ ;NO, SKIP SPECIAL CHECKING BIT #DO.FMT,FO-CC(R3) ;YES, SPECIAL .BAS/.B2S INPUT FILE? BEQ 70$ ;NOPE CMPB -(R2),-(R1) ;YEP, BACK UP OVER AND 1 LESS FREE CALL 110$ ;CHECK FOR TRAILING //& DELETIONS MOVB #015,(R2)+ ;STORE A INSTEAD OF THE MOVB R0,(R2)+ ; THEN STORE THE INC ZZ(R5) ; AND INDICATE WE DID THAT 70$: CMP R1,R2OFF(SP) ;LESS THAN DESIRED FREE LEFT NOW? BLT 90$ ;YES, GO EXIT 80$: CMP R1,#128. ;UP TO ALMOST FULL NOW? BGT 40$ ;IF >128. THEN CONTINUE 90$: RETURN ;EXIT 100$: CALL 110$ ;CHECK FOR TRAILING //& TRIMMING COM FFFLAG(R5) ;INDICATE A FOUND BR 90$ ; THEN GO EXIT 110$: MOV #DO.MOD!DO.FMT,-(SP) ;SPECIAL .B2S INPUT FILE? BIC FO-CC(R3),(SP)+ ;BOTH BITS WILL CLEAR IF SO BNE 90$ ;NOPE, NO TRAILING //& TRIM 120$: CMP R2,R0OFF+2(SP) ;BACKED UP TOO FAR? BLOS 90$ ;YES, EXIT CMPB -(R2),#040 ;CHECK FOR TRAILING BEQ 130$ ;FOUND, DELETE IT CMPB (R2),#011 ;CHECK FOR TRAILING BEQ 130$ ;FOUND, DELETE IT CMPB (R2)+,#'& ;CHECK FOR TRAILING "&" BNE 90$ ;OTHER, END THE TRAILING DELETION SCAN DEC R2 ;FOUND, DELETE IT 130$: INC R1 ;INCREMENT AMOUNT OF FREE SPACE DEC ZZ(R5) ; AND DECREMENT NUMBER OF CHARACTERS STORED BR 120$ ;NOW TRY FOR ANOTHER TRAILING DELETION .DSABL LSB GLOBAL .ENABL LSB 10$: ERR NYI,<"Not yet implemented"> SENTRY BACKUP ;BACK UP N BUFFERS FULL BR 10$ ;SORRY, NOT YET... .DSABL LSB .ENABL LSB 10$: ERR NFO,<"No file for output"> SENTRY PUTBUF ;PUT OUT A BUFFER FULL MOV OUPNTR(R5),R3 ;GET THE OUTPUT PARAMETERS TST (R3)+ ;IS OUTPUT FILE OPEN? BEQ 10$ ;NOPE 20$: DEC R1 ;MORE TO GO? BMI 180$ ;NO, CHECK FOR TO OUTPUT MOV #20$,-(SP) ;YES, SET TO LOOP AROUND AGAIN MOVB (R0)+,R2 ;GET A CHARACTER BIT #DO.FMT,FO-CC(R3) ;SPECIAL .BAS/.B2S OUTPUT FILE? BEQ 160$ ;NOPE CMP R2,#015 ;YEP, IS IT ? BEQ 170$ ;IGNORE THE 'S CMP R2,#012 ;ELSE IS IT ? BNE 120$ ;NOPE, JUST OUTPUT IT CMPB -3(R0),#'& ;IS IT "&"? BEQ 110$ ;YES, OUTPUT "&" TST R1 ;NO, MORE TO COME? BEQ 100$ ;NO MORE DATA, BUT CHECK FOR COMING CMPB (R0),#'0 ;IS NEXT A DIGIT? BLO 30$ ;NON-DIGIT, DO CMPB (R0),#'9 ;REALLY A DIGIT? BLOS 110$ ;YES, A DIGIT, SO DO 30$: BIT #DO.MOD,FO-CC(R3) ;SPECIAL .B2S OUTPUT FILE? BEQ 90$ ;NO, GO OUTPUT CMP B2S.CP-CC(R3),B2S.AP-CC(R3) ;YES, AT DESIRED POSITION ALREADY? BEQ 70$ ;RIGHT AT IT, GO OUTPUT AT LEAST 1 40$: MOV B2S.CP-CC(R3),R2 ;GET CURRENT POSITION ADD #8.,R2 ; AND FIND WHAT A BIC #8.-1,R2 ; WOULD DO ON OUTPUT CMP R2,B2S.AP-CC(R3) ;WOULD TAKE US BEYOND DESIRED POSITION? BHI 60$ ;YES, SO DON'T DO A MOV #011,R2 ;NO, SO SET A CALL 120$ ; AND OUTPUT IT BR 40$ ; THEN CHECK POSITION AGAIN 50$: MOV #040,R2 ;SET A CALL 120$ ; AND OUTPUT IT 60$: CMP B2S.CP-CC(R3),B2S.AP-CC(R3) ;AT (OR BEYOND) DESIRED POSITION? BLO 50$ ;NOT YET, OUTPUT A AND CHECK AGAIN BEQ 80$ ;RIGHT AT DESIRED POSITION 70$: MOV #040,R2 ;BEYOND DESIRED, SET A CALL 120$ ; AND OUTPUT IT 80$: MOV #'&,R2 ;SET FOR THE CALL 120$ ; OUTPUT OF "&" BR 110$ ;NOW GO OUTPUT 90$: CALL 120$ ;OUTPUT THE MOV #015,R2 ;SET FOR THE CALL 120$ ; OUTPUT OF CLR R2 ;SET FOR THE BR 160$ ; OUTPUT OF 100$: TST R2OFF+2(SP) ;A COMING? BNE 30$ ;YES, SO DO 110$: MOV #015,R2 ;SET FOR THE CALL 120$ ; OUTPUT OF MOV #012,R2 ;SET FOR THE OUTPUT OF 120$: CMP R2,#040 ;A NORMAL GRAPHIC CHARACTER? BLO 130$ ;NOPE INC B2S.CP-CC(R3) ;YEP, BUMP POSITION BY +1 130$: CLR -(SP) ;SET "BIC" MASK TO CLEAR NOTHING INITIALLY CMP R2,#015 ;? BEQ 140$ ;YES, POSITION = 0 ("BIC" WITH -1) CMP R2,#014 ;? BEQ 140$ ;YES, POSITION = 0 ("BIC" WITH -1) CMP R2,#011 ;? BNE 150$ ;NO, OTHER, ALL DONE ADD #8.,B2S.CP-CC(R3) ;ADVANCE POSITION BY 8. MOV #^C<8.-1>,(SP) ; MODULUS 8. 140$: COM (SP) ;SET THE CORRECT "BIC" MASK 150$: BIC (SP)+,B2S.CP-CC(R3) ;DO THE CORRECT "BIC" 160$: CALL @CA-CC(R3) ;OUTPUT THAT BYTE 170$: RETURN ;NOW RETURN 180$: TST R2OFF(SP) ;OUTPUT A ? BEQ 190$ ;NOPE MOV #014,R2 ;YES, SO SET FOR A CALL 120$ ; AND OUTPUT IT 190$: BIT #FLGFRC,-(R3) ;FORCE TYPE OUTPUT DEVICE? BEQ 170$ ;NO, JUST EXIT CMP (R3)+,(R3)+ ;CORRECT TO BE A CP POINTER PUTBLK: TST (R3) ;IS THIS THE FIRST TIME? BEQ 170$ ;YES, JUST EXIT MOV #XRB+XRMOD,R4 ;GET AN XRB POINTER CLR (R4) ;XRMOD <- 0 (NO MODIFIERS) CLR -(R4) ;XRTIME <- 0 (WAIT FOREVER) CLR -(R4) ;XRBLK <- 0 (NEXT SEQUENTIAL) CLRB -(R4) ;XRCI+1 <- 0 (NEXT SEQUENTIAL) MOVB FO-CP(R3),-(R4) ;XRCI <- CHANNEL NUMBER * 2 MOV RP-CP(R3),-(R4) ;XRLOC <- BUFFER START MOV RC-CP(R3),-(R4) ;XRBC <- BUFFER SIZE THEN SUB -(R3),(R4) ;XRBC <- THE REAL COUNT MOV (R4),-(R4) ;XRLEN <- THE REAL COUNT ALSO CLR (R3)+ ;NOW CURRENT COUNT AND CLR (R3) ; CURRENT POINTER GET CLEARED ADD #1,F$HEOF+2-CP(R3) ;COUNT THE NUMBER ADCB F$HEOF-CP(R3) ; OF BLOCKS OUTPUT .WRITE ;DO THE BLOCK OUTPUT BR ERRCHK ; AND ERROR CHECK IT .DSABL LSB GLOBAL .SBTTL CLOSE AND DEALLOCATE CLOSER: CALL DEALC ;DO THE DEALLOCATE FIRST .SBTTL FIP CALLS WITH ERROR CHECKING FIPERC: CALFIP ;CALL THE FILE PROCESSOR .SBTTL ERROR CHECKING .ENABL LSB ERRCHK: TSTB IOSTS ;ANY ERROR? BEQ 30$ ;NO MOV (PC)+,R0 ;YES, LOAD ERROR CODE OF "ERR" .RAD50 /ERR/ CHKERR NOSUCH ;IS IT THE "CAN'T FIND" ERROR? BNE 10$ ;OTHER ERROR, SO CORRECT CODE IS "ERR" MOV (PC)+,R0 ;IT IS "CAN'T FIND", LOAD "FNF" .RAD50 /FNF/ 10$: MOV #ERRIO,-(SP) ;SET ERROR RETURN ADDRESS ERRMSG: SETFQB ERRFQ ;SET FIRQB FOR ERROR MESSAGE LOOKUP MOVB IOSTS,(R4) ; AND SET THE ERROR CODE CALFIP ;NOW GET THE MESSAGE TEXT CLRB 28.(R4) ;LIMIT MSG'S TO 28. BYTES MOV #ERRBUF,R2 ;POINT TO ERROR MESSAGE TEXT BUFFER 20$: MOVB (R4)+,(R2)+ ;MOVE A BYTE INTO BUFFER BNE 20$ ; UNTIL WE MOVED THE NULL BYTE MOV #ERRBUF,R2 ;NOW POINT TO THE TEXT AGAIN 30$: RETURN ;EXIT .DSABL LSB .ENABL LSB SENTRY KILFIL ;STOP AN OUTPUT FILE MOV OUPNTR(R5),R3 ;GET OUTPUT PARAMETERS TST (R3) ;OPEN NOW? BEQ 20$ ;NO MOV (R3),-(SP) ;YES, SAVE DETERMINATION CALL DEALC ;DEALLOCATE BUFFER SPACE MOVB #RSTFQ,-(R4) ;SET FUNCTION AS RESET CLOSE FOR KILL'S CALL FIPERC ; AND GO DO IT AND ERROR CHECK CALL EBGET ;NOW GET OUTPUT NAME (DELETE FUNCTION) TST (SP)+ ;OUTPUT FILE NEED RENAMING? BPL 10$ ;NOPE CALL GETTMP ;YES, SO GET THE .TMP FILE NAME 10$: CALFIP ;DELETE THE FILE CHKERR NOSUCH ;WAS IT THERE TO DELETE? BNE ERRCHK ;YES (OR OTHER ERROR), SO GO ERROR CHECK 20$: RETURN ;NO, JUST EXIT SENTRY CLSFIL ;CLOSE INPUT AND OUTPUT FILES (AND DO "EB") MOV INPNTR(R5),R3 ;GET INPUT PARAMETER POINTER TST (R3) ;IS THE INPUT CLOSED NOW? BEQ 30$ ;YES CALL CLOSER ;NO, SO CLOSE INPUT FILE CLR EOFLAG(R5) ; AND INDCATE NOT EOF-OF-FILE ANYMORE BR 30$ ;NOW CLOSE THE OUTPUT FILE SENTRY CLSOUT ;CLOSE THE OUTPUT FILE (AND DO "EB") 30$: MOV OUPNTR(R5),R3 ;GET OUTPUT PARAMETER POINTER TST (R3) ;ANY OUTPUT CURRENTLY ACTIVE? BEQ 20$ ;NO, JUST EXIT BIT (R3)+,#FLGFRC ;YES, FORCE TYPE DEVICE? BNE 50$ ;NO FINAL FIXUP IF FORCE TYPE DEVICE CMP CA-CC(R3),#PUTBYT ;DOING NORMAL ASCII STREAM OUTPUT? BEQ 40$ ;YES, NO RECORD TO FINISH UP CALL ENDREC ;ELSE FINISH UP THAT FINAL RECORD 40$: CALL ENDBLK ;NOW END THIS FINAL BLOCK 50$: ;GO DO THE REAL CLOSE .DSABL LSB GLOBAL .ENABL LSB MOV -(R3),-(SP) ;SAVE DETERMINATION CALL CLOSER ; THEN CLOSE AND DEALLOCATE IT ASL (SP)+ ;REQUIRED RENAMING AND/OR EB RENAMING? BCC 40$ ;NOPE, NEITHER BPL 20$ ;YES, BUT ONLY NORMAL RENAMING 10$: CALL EBGETR ;YES, EB RENAME, GET ORIGINAL FILE DATA MOV #^RBAK,FQNAM2+4-FQFUN(R4) ;SET NEW EXTENSION CALL 30$ ;CALL FIP FOR THE RENAME (WITH DELETION...) BCS 20$ ;NO ERROR, GO RENAME THE .TMP NOW CALL EBGET ;GET ORIGINAL DATA AGAIN MOV #^RBAK,FQEXT-FQFUN(R4) ; TO DELETE THE .BAK FILE CALL FIPERC ;TRY THE DELETION NOW BR 10$ ; THEN LOOP FOR ANOTHER RENAME... 20$: CALL EBGETR ;GET THE ORIGINAL FILE DATA AGAIN CALL GETTMP ;RENAME .TMP FILE TO ORIGINAL NAME CALL 30$ ;LET FIP DO THE RENAME (WITH DELETION...) BCS 40$ ;NO ERROR, ALL DONE, SO EXIT CALL EBGET ;FILE EXISTS, GET IT AGAIN CALL FIPERC ; AND GO DELETE IT BR 20$ ;LOOP FOR ANOTHER RENAME TRY... 30$: CALFIP ;CALL FILE PROCESSOR CHKERR FIEXST ;IS THE ERROR "FILE EXISTS"? BEQ 40$ ;YES, EXIT WITH C=0 CALL ERRCHK ;NO, CHECK FOR OTHER ERROR(S) SEC ;NO ERROR, EXIT WITH C=1 40$: RETURN ;NOW EXIT .DSABL LSB .SBTTL FILE DATA GETTING SUBROUTINES EBGET: MOV R3,R1 ;COPY THE PARAMETER BLOCK POINTER ADD #PARMSZ,R1 ;NOW INDEX TO END OF PARM BLOCK MOV #FIRQB+FQBSIZ,R4 ; AND GET POINTER TO FIRQB END+2 10$: MOV -(R1),-(R4) ;NOW UNSAVE THE SAVED DATA CMP R4,#FIRQB+FQFIL ;DONE? BHI 10$ ;NOT YET MOVB #DLNFQ,-(R4) ; AND FUNCTION AS DELETE RETURN ;THEN EXIT EBGETT: CALL EBGET ;GET ORIGINAL DATA AND THEN .TMP GETTMP: MOVB FIRQB+FQJOB,R1 ;GET JOB NUMBER (TIMES 2) ASR R1 ;NOW HAVE PLAIN OLD JOB NUMBER CLR R0 ;CLEAR THE HIGH ORDER DIV #10.,R0 ; AND DIVIDE BY 10. MOV R1,-(SP) ;SAVE "UNITS" MUL #50,R0 ; AND MULTIPLY BY 50 FOR RAD50 ADD (SP)+,R1 ;ADD "UNITS" TO "TENS" MOV #^RTEC,FQNAM1-FQFUN(R4) ;LOAD "TEC" ADD #^RO00,R1 ;FORM "ONN" CMP R3,#OUPALT ;IS IT THE ALTERNATE OUTPUT? BNE 10$ ;NO ADD #^RA00-^RO00,R1 ;YES, FORM "ANN" 10$: MOV R1,FQNAM1+2-FQFUN(R4) ;LOAD 2ND PART OF NAME CALL CREFUN ;SET THE CORRECT CREATION FUNCTION MOV #^RTMP,FQEXT-FQFUN(R4) ;LOAD ".TMP" RETURN ; AND EXIT EBGETR: CALL EBGET ;GET THE OLD NAME MOVB #RENFQ,(R4) ;FUNCTION IS RENAME MOV #FIRQB+FQSIZ,R1 ;GET POINTER TO RENAME PARAMETERS MOV #-1,(R1)+ ;SET AUTOMATIC DELETIONS... MOV FQNAM1-FQFUN(R4),(R1)+ ;COPY THE FILE MOV FQNAM1+2-FQFUN(R4),(R1)+ ; NAME AND MOV FQNAM1+4-FQFUN(R4),(R1)+ ; EXTENSION CLR (R1)+ ;BUT NO PROTECTION CODE CHANGES RETURN ; AND EXIT CREFUN: MOV #CREFQ,R0 ;SET NORMAL DATA FILE CREATION FUNCTION TSTB FIRQB+FQFLAG ;IS THIS A DISK FILE CREATION? BNE CREXIT ;NO, DO NORMAL CREATES FOR NON-DISK .ASSUME DSKHND EQ 0 CMP FIRQB+FQEXT,@#P.DEXT ;REALLY CREATING AN EXECUTABLE FILE? BNE CREXIT ;NO, A DATA FILE MOV #CRBFQ,R0 ;YES, OUR EXECUTABLE FILE, CHANGE FUNCTION CREXIT: RETURN ;NOW EXIT .SBTTL FILE STRING SCAN CALL SCAN: MOV #FIRQB+FQFIL,R4 ;GET FIRQB POINTER 10$: CLR (R4)+ ;CLEAR FIRQB AND XRB CMP R4,#XRB+XRBSIZ ;MORE? BLO 10$ ;YES, LOOP MOV #XRB+XRLOC,R1 ;NOW GET XRB POINTER MOV FILBUF(R5),R2 ;GET FILENAME STRING POINTER MOV R2,(R1) ;SET THAT POINTER 20$: TSTB (R2)+ ;END OF STRING? BNE 20$ ;NOT YET... SUB (R1),R2 ;YES, FIND LENGTH +1 DEC R2 ;NOW HAVE LENGTH MOV R2,-(R1) ;SET LENGTH @ XRBC AND MOV R2,-(R1) ; @ XRLEN BEQ CREXIT ;LENGTH = 0 .FSS ;ELSE PARSE THE STRING 30$: CALL ERRCHK ;DIE ON ANY ERROR BIC (PC)+,-(R4) ;TRIM FLAG (@ XRB+14) TO INDEX ONLY .BYTE 0,-1 CMPB (R4),#MTAHND ;MAGTAPE? BNE 50$ ;NOPE MOV FIRQB+FQCLUS,FIRQB+FQSIZ ;YEP, SAY CLUSTER SIZE IS BLOCK SIZE BIC #^C<7000>,FIRQB+FQSIZ ;TRIM BLOCK SIZE TO NICE MULTIPLE BNE 40$ ;BLOCK SIZE SPECIFIED, USE IT MOV #2048.,FIRQB+FQSIZ ;ELSE DEFAULT BLOCK SIZE TO 2048. 40$: MOV FIRQB+FQSIZ,FIRQB+FQCLUS ;USE BLOCK SIZE AS RECORD SIZE BIS #32768.!8192.,FIRQB+FQCLUS ;SAY ANSI "D", IMPLIED CR/LF 50$: MOV (R4),FIRQB+FQFLAG ;SET HANDLER INDEX INTO FIRQB BIT -(R4),#4 ;ANY "/FILESIZE:N" SWITCH? (FROM @ XRB+12) BNE 140$ ;YES, THAT IS AN ERROR SETERR NODEVC ;PRESET THE ILLEGAL DEVICE ERROR CODE TST -(R4) ;CHECK FOR BAD DEV: (FROM @ XRB+10) BMI 30$ ;DEVICE IS BAD, GIVE AN ERROR CMP R2OFF+2(SP),#'N-'R ;IS IT "EN"? BEQ 70$ ;YES BIT (R4),#1546 ;CHECK FOR ALL WILDS BEQ 80$ ;EVERYTHING IS O.K. 60$: SETERR BADNAM ;SET ILLEGAL NAME BR 30$ ; AND ANNOUNCE IT 70$: TSTB FIRQB+FQFLAG ;IS IT DISK? BNE 30$ ;NOPE, THAT IS AN ERROR FOR "EN" .ASSUME DSKHND EQ 0 BIT (R4),#1 ;ANY FILENAME THERE? BEQ 60$ ;NOPE, ERROR 80$: BIT (R4),#10 ;"." FOR EXTENSION? (FROM @ XRB+10) BNE 90$ ;YES, NO DEFAULTING CMP R2OFF+2(SP),#'I-'R ;IS IT ALSO "EI"?? BNE 90$ ;NO MOV @#P.DEXT,FIRQB+FQEXT ;YES, DEFAULT EXTENSION GLOBAL 90$: MOV #B2SPOS,R1 ;DEFAULT "&" POSITION MOV #XRB+XRLOC,R2 ;GET POINTER INTO XRB MOV (R2),R0 ;GET POINTER TO UNSCANNED CHARACTERS MOV -(R2),R2 ;ALL CHARACTERS SCANNED? BEQ 160$ ;YES, GO EXIT SETTING STRING CMPB (R0)+,#'/ ;NO, A SWITCH THERE? BNE 60$ ;NOT A SWITCH, ERROR DEC R2 ;A SWITCH, ONLY THE "/" BEQ 150$ ;YES, THAT IS HISTORICAL .BAS SIGNAL CMPB (R0)+,#'B ;NO, TRY FOR "/B", "/B+", OR "/B2" BEQ 130$ ;IT MIGHT BE "/B", "/B+", OR "/B2" CMPB -(R0),#'B+40 ;ELSE CHECK FOR LOWER CASE BEQ 120$ ;LOWER CASE "B", TRY FOR "/B", /B+", OR "/B2" CLR R1 ;CLEAR THE DESIRED POSITION BUCKET 100$: MOVB (R0)+,R4 ;GET (HOPEFULLY) A DIGIT SUB #'0,R4 ; AND MAKE IT INTO BINARY CMP R4,#9. ;VALID DIGIT? BHI 140$ ;NOPE, THAT IS AN ERROR MUL #10.,R1 ;MULTIPLY OLD NUMBER BY 10. ADD R4,R1 ; AND ADD IN THE NEW CMP R1,#377 ;IS THE VALUE TOO BIG NOW? BHI 140$ ;YES, THAT IS AN ERROR SOB R2,100$ ;LOOP IF MORE TO COME... 110$: BIS #DO.MOD!DO.FMT,FIRQB+FQFLAG ;SET THE SPECIAL .B2S FLAGS BR 170$ ; AND GO EXIT SETTING STRING 120$: INC R0 ;ADVANCE OVER THE LOWER CASE "B" 130$: DEC R2 ;IS IT EXACTLY "/B"? BEQ 170$ ;YES, GO SET SPECIAL 8-BIT BINARY FLAGS DEC R2 ;NO, TRY FOR "/B+" OR "/B2" BNE 140$ ;TOO MANY CHARACTERS, ERROR CMPB (R0),#'+ ;IS IT "/B+"? BEQ 150$ ;YES, GO SET SPECIAL .BAS FLAGS CMPB (R0),#'2 ;IS IT "/B2"? BEQ 110$ ;YES, GO SET SPECIAL .B2S FLAGS 140$: SETERR BADSWT ;SET THE ILLEGAL SWITCH ERROR BR 30$ ; AND ANNOUNCE IT 150$: BIS #DO.FMT,FIRQB+FQFLAG ;SET THE SPECIAL .BAS FLAGS BR 170$ ; AND GO EXIT SETTING STRING 160$: BIS #DO.MOD,FIRQB+FQFLAG ;SIGNAL NORMAL ASCII 170$: MOV R1,FIRQB+FQBUFL ;RETURN THE DESIRED POSITION HERE SETFEQ: MOV #FIRQB+FQDEV,R4 ;SET FIRQB POINTER @ FQDEV MOV FIRQB+FQFLAG,-(SP) ;STACK THE SWITCH BIT(S) MOVB FIRQB+FQBUFL,(SP) ; AND THE "&" POSITION VALUE BR SETFEX ;EXIT SETTING STRING .SBTTL SET SEARCH/FILENAME BUFFER TO CURRENT FILE SPECIFICATION SETSAV: ;MOV R4,-(SP) ;PARAM BLOCK ALREADY SAVE BY 'JSR R4,' MOV R1,SETPTR ;SAVE SEARCH/FILENAME BUFFER POINTER CALL (R4) ;NOW CALL OUR CALLER SETRET: MOV SETPTR,R1 ;RESTORE SEARCH/FILENAME BUFFER POINTER MOV (SP)+,R4 ;RESTORE PARAM BLOCK POINTER RETURN ; AND FINAL RETURN SETNUB: SWAB R0 ;WE WANT THE BYTES SWITCHED ON THIS CALL SETNUM: BIC (PC)+,R0 ;TRIM THE VALUE TO ONLY 8 BITS .BYTE 0,-1 CALL SETSAV,R4 ;SAVE PARAM BLOCK PTR AND BUF PTR MOV N(R5),-(SP) ;SAVE "TECO"S 'N' VALUE MOV R0,N(R5) ; THEN REPLACE IT WITH OUR VALUE MOV NMRBAS(R5),-(SP) ;SAVE "TECO"S CURRENT RADIX CLR NMRBAS(R5) ; THEN SET RADIX TO DECIMAL CALLX ZEROD,R3,SETCHR ;NOW CALL FOR A NUMBER CONVERSION MOV (SP)+,NMRBAS(R5) ;RESTORE "TECO"S RADIX MOV (SP)+,N(R5) ;RESTORE "TECO"S 'N' VALUE RETURN ; AND EXIT TYPEBF::CMP SETPTR,TTOBFE ;OUT OF ROOM IN TERMINAL OUTPUT BUFFER? BLO SETCHR ;NOT YET, BUFFER ANOTHER CHARACTER TYPEBC::MOV R3,-(SP) ;SAVE R3 MOV R4,-(SP) ; AND R4 MOV SETPTR,R4 ;GET CURRENT POINTER TO OUTPUT BUFFER MOV TTOBFS,R3 ;GET POINTER TO OUTPUT BUFFER'S START MOV R3,SETPTR ; THEN RESET THE BUFFERING POINTER SUB R3,R4 ;FIND THE CHARACTER COUNT TO OUTPUT CALL PRINTB ; THEN GO DO THAT OUTPUT MOV (SP)+,R4 ;RESTORE R4 MOV (SP)+,R3 ; AND R3 SETCHR: MOVB R0,@SETPTR ;SET THE CHARACTER IN SEARCH/FILENAME BUFFER INC SETPTR ; THEN BUMP THE POINTER CLRB @SETPTR ; THEN ENSURE STRING IS ASCIZ RETURN ; AND EXIT BACK GLOBAL SETRA2: MOV PC,-(SP) ;DO THE BELOW TWICE... SETRAD: MOV (R4)+,R0 ;GET RAD50 CODE TO CONVERT CALL SETSAV,R4 ;SAVE PARAM BLOCK PTR AND BUF PTR MOV #50,R2 ;THE DIVISOR IS 50 (NATCH) 10$: CALLX DIVD ;NOW DIVIDE MOV R1,-(SP) ;SAVE THE REMAINDER TST R0 ;IS ANSWER ZERO YET? BNE 10$ ;NO, CONTINUE DIVIDING 20$: MOV (SP)+,R0 ;GET A RAD50 CODE (0<=CODE<=47) BMI SETRET ;<0, 'SETSAV'S RETURN ADDRESS, SO RETURN BEQ 20$ ;IGNORE CODE=0 (SPACES) CMP R0,#33 ;WHAT CODE IS IT? BLO 40$ ;ALPHABETIC (1 TO 32) BEQ 30$ ;"$" (33) ADD #'0-36,R0 ;"." (34), "?" (35), OR NUMERIC (36 TO 47) CMP R0,#'/ ;WAS THE CONVERSION REALLY TO "?"? BNE 50$ ;NO, ALL O.K. MOV #'?-'$+33,R0 ;YES, SET CHARACTER TO "?" 30$: ADD #'$-33-'A+1,R0 ;CONVERT TO "$" 40$: ADD #'A-1,R0 ;CONVERT TO "A" TO "Z" 50$: CALL SETCHR ;NOW SET THAT CHARACTER BR 20$ ; AND LOOP .ENABL LSB SETNAM: CLRB @FILBUF(R5) ;FORCE NULL STRING INITIALLY TST (R3) ;OPEN NOW? BEQ 60$ ;NOPE MOV R3,R4 ;COPY THE PARAMETER BLOCK POINTER ADD #FQ+,R4 ;INDEX TO THE DEVICE NAME MOV (R3),-(SP) ;SAVE FILE SWITCHES MOVB B2S.AP(R3),(SP) ; AND THE "&" POSITION VALUE (OUTPUT FILES) CMP R3,#OUPNOR ;REALLY AN OUTPUT FILE? BEQ SETFEX ;YEP CMP R3,#OUPALT ;MIGHT BE?? BEQ SETFEX ;IT IS... MOVB #B2SPOS,(SP) ;INPUT OR COMMAND, FORCE SAYING "/B2" SETFEX: MOV R3,-(SP) ;SAVE PARM BLOCK POINTER MOV FILBUF(R5),R1 ;NOW GET FILENAME BUFFER POINTER TST (R4) ;IS THERE A DEVICE NAME? BEQ 20$ ;NO MOV (R4),(R1)+ ;YES, SET THE DEVICE'S NAME MOV FQDEVN-FQDEV(R4),R0 ;DOES THE DEVICE HAVE A UNIT NUMBER? BEQ 10$ ;NO EXPLICIT UNIT NUMBER CALL SETNUM ;EXPLICIT NUMBER, SO SET IT 10$: MOVB #':,(R1)+ ;NOW SET THE TRAILING ":" 20$: ADD #FQPPN-FQDEV,R4 ;RE-INDEX TO PPN, NAME, EXT MOV (R4)+,R0 ;GET THE PPN BEQ 30$ ;NO PPN MOVB #'[,(R1)+ ;PPN EXISTS, SET LEADING "[" CALL SETNUB ;SWAP BYTES AND SET PROJECT NUMBER MOVB #',,(R1)+ ;SET THE MIDDLE "," MOV FQPPN-FQNAM1(R4),R0 ;NOW GET THE PROGRAMMER NUMBER CALL SETNUM ; AND SET IT ALSO MOVB #'],(R1)+ ;SET THE TRAILING "]" GLOBAL 30$: TST (R4) ;ANY FILENAME? BEQ 40$ ;NO, SKIP NAME.EXT AND PROT CALL SETRA2 ;SET FILENAME AS 2 WORDS OF RAD50 MOVB #'.,(R1)+ ;SET THE "." CALL SETRAD ;NOW SET THE EXTENSION MOV FQPROT-1-(R4),R0 ;GET THE PROTECTION CODE BEQ 40$ ;NONE MOVB #'<,(R1)+ ;ONE, SET LEADING "<" CALL SETNUB ;SWAP BYTES AND SET PROTECTION CODE MOVB #'>,(R1)+ ;SET TRAILING ">" 40$: MOV 2(SP),R0 ;GET SWITCHES AND "&" POSITION ADD #DO.MOD,R0 ; AND COMPLEMENT THE MODIFIER BIT .ASSUME 377 LT DO.MOD .ASSUME DO.FMT LT DO.MOD BIT R0,#DO.MOD!DO.FMT ;ANY SWITCHES? BEQ 50$ ;NO MOVB #'/,(R1)+ ;GUESS AT "/B" MOVB #'B,(R1)+ ; FOR 8-BIT BINARY BIT R0,#DO.FMT ;GOOD GUESS? BEQ 50$ ;YEP MOVB #'+,(R1)+ ;NOW GUESS AT "/B+" BIT R0,#DO.MOD ;GOOD GUESS? BNE 50$ ;YEP MOVB #'2,-1(R1) ;NOPE, CHANGE GUESS TO "/B2" CMPB R0,#B2SPOS ;IS THAT A GOOD GUESS? BEQ 50$ ;YEP CMPB -(R1),-(R1) ;NOPE, TAKE MOST OF IT BACK CALL SETNUM ;GO SET THE ACTUAL "&" POSITION VALUE 50$: MOV (SP)+,R3 ;RESTORE PARM BLOCK POINTER TST (SP)+ ; AND POP THE SWITCHES CLRB (R1) ;FINALLY MARK END OF THE STRING CMP R1,FILBUF(R5) ;DID WE REALLY SET ANYTHING? BNE 60$ ;YES, WE DID MOV (PC)+,(R1) ;NO, SO ENSURE NON-NULL STRING ANYWAY .BYTE 40,0 60$: RETURN ; AND EXIT .DSABL LSB GLOBAL .SBTTL DO "EN" WILD CARDING .ENABL LSB 10$: CALL EBGET ;GET BACK FIRQB DATA AGAIN MOV FIRQB+FQSIZ,FIRQB+FQPPN ;RE-SET THE WILD CARD PPN MOV ENSAV,FIRQB+FQERNO ;SET THE OCCURANCE INDEX MOVB #UU.PPN,(R4) ;FUNCTION IS WILD CARD PPN LOOKUP .UUO ;SO GO DO IT CALL ERRCHK ;CHECK FOR ANY ERROR(S) MOV FIRQB+FQPPN,FQ+(R3) ;SAVE FOUND EXPLICIT PPN INC ENSAV ;BUMP PPN INDEX FOR NEXT OCCURANCE CLR FQ+(R3) ;RESET FILE OCCURANCE FOR FIRST FILE 20$: CALL EBGET ;GET BACK FIRQB DATA CMP FIRQB+FQPPN,#-1 ;SPECIAL FIRST TIME FOR WILD PPN'S? BEQ 10$ ;YES, GO DO THE WILD PPN LOOK UP FIRST MOVB #LOKFQ,(R4) ;ELSE SET FUNCTION AS LOOK UP CALFIP ; AND TRY TO FIND IT CHKERR NOSUCH ;END OF OCCURANCES? BNE 30$ ;NO (OR OTHER ERROR), GO ERROR CHECK IT TST ENSAV ;YES, ARE WE WILDING PPN'S? BPL 10$ ;YEP, SO GO DO SO 30$: CALL ERRCHK ;CHECK FOR ANY ERROR(S) INC FQ+(R3) ;BUMP INDEX FOR NEXT OCCURANCE SETLOK: MOV #FIRQB+FQPROT-1,R4 ;POINT TO PROT FLAG BYTE MOVB #-1,(R4)+ ;SAY PROT CODE IS REAL AND MOVB FQSIZ+2-FQPROT(R4),(R4)+ ; SET THAT PROTECTION CODE MOV #DO.MOD,-(SP) ;INDICATE NO SWITCHES, ETC. JMP SETFEX ;SET THE RETURNED STRING NOW DOWILD: MOV #ENSAV-FQ,R3 ;GET FAKE PARM BLOCK FOR "EN" TSTB @FILBUF(R5) ;NULL STRING? BEQ 20$ ;YES, GET NEXT OCCURANCE CLR FIRQB+FQERNO ;NO, SET INDEX FOR FIRST OCCURANCE MOV FIRQB+FQPPN,R0 ;GET PPN FOR WILDING CHECK MOV R0,FIRQB+FQSIZ ; AND RE-SAVE IT IN CASE WE'RE WILDING IT MOV #-1,ENSAV ;GUESS AT NON-WILD PPN INCB R0 ;IS IT OF THE FORM [X,*]? BEQ 40$ ;YES, IT'S WILD ADD (PC)+,R0 ;IS IT OF THE FORM [*,X]? .BYTE 0,1 BCC 50$ ;NO, NOT WILD AT ALL 40$: COM ENSAV ;SAY WILD CARDED PPN MOV #-1,FIRQB+FQPPN ; AND SIGNAL THE FIRST TIME SPECIAL CASE 50$: CALLR SAVFIL ;NOW SAVE THE FIRQB DATA AND EXIT .DSABL LSB GLOBAL .ENABL LSB SENTRY INPSAV ;SAVE CURRENT INPUT STATUS MOV #INPALT,R3 ;GET ALTERNATE INPUT POINTER 10$: MOV R3,INPNTR(R5) ;SET THE INPUT POINTER CLR EOFLAG(R5) ;GUESS AT NO END-OF-FILE BIT #ATEOF,(R3) ;AT END-OF-FILE? BEQ 20$ ;NOPE COM EOFLAG(R5) ;YES, SET THE FLAG 20$: CALLR SETNAM ;EXIT SETTING UP THE FILE'S NAME SENTRY OUTSAV ;SAVE CURRENT OUTPUT STATUS MOV #OUPALT,R3 ;GET ALTERNATE OUTPUT POINTER 30$: MOV R3,OUPNTR(R5) ; AND SET THAT FOR OUTPUT BR 20$ ;THEN EXIT SETTING UP FILE'S NAME SENTRY GETFLS ;GET FILES CALL SCAN ;SCAN THE FILENAME CMP R2OFF(SP),#'N-'R ;EN? BEQ DOWILD ;YES, DO WILD CARDING TST R2OFF(SP) ;IS IT "EW"? BLE 80$ ;NOT EW MOV #OUPNOR,R3 ;EW, GUESS AT SWITCH TO NORMAL TSTB @FILBUF(R5) ;IS IT THE NULL STRING? BEQ 30$ ;YES, SWITCH TO NORMAL GLOBAL CALL CHKOFO ;CHECK OUTPUT ALREADY OPEN, SAVE, ETC. TSTB FIRQB+FQFLAG ;IS IT DISK? BNE 50$ ;NOPE .ASSUME DSKHND EQ 0 MOV #100000!NSUPER,-(SP) ;YEP, STACK NO SUPERSEDE MODE BIC FIRQB+FQMODE,(SP)+ ;IS USER SAYING NO SUPERSEDE? BEQ 50$ ;YES, GO TRY THE CREATE... CMP FIRQB+FQEXT,#^RTMP ;IS IT A .TMP FILE ALREADY? BEQ 50$ ;DON'T BOTHER WITH .TMP FILES... MOV #FIRQB+FQERNO,R4 ;ELSE GET A FIRQB POINTER AND MOV #-1,(R4) ;SAY THIS WILL BE A SPECIFIC MOVB #LOKFQ,-(R4) ; FILE LOOKUP CALFIP ;TRY TO FIND IT FIP CHKERR NOSUCH ;IS IT NON-EXISTENT NOW? BEQ 40$ ;YES, JUST CONTINUE AND TRY TO CREATE IT CALL ERRCHK ;OTHER, CHECK FOR MISCELLANEOUS ERRORS CALL SETLOK ;NO ERROR, SET THE EXISTENT NAME MOV R3,-(SP) ;SAVE THE PARM BLOCK POINTER CALLX CRLFNO ;CANCEL CONTROL/O AND RESTORE CARRIAGE MESAGE <'%Superseding existing file "'> ;ANNOUNCE MOV FILBUF(R5),R3 ;POINT TO THE EXISTENT NAME CALL ASCIZ3 ; AND PRINT IT MESAGE <'"'<15><12>> ; THEN RESTORE CARRIAGE MOV (SP)+,R3 ;RESTORE PARM BLOCK POINTER CALL EBGET ;GET ORIGINAL DATA CALL SETFEQ ; AND (RE-)SET IT IN FILENAME BUFFER CALL EBGETT ;GET ORIGINAL DATA WITH .TMP FILE NAME CALL DOOPEN ;DO THE OUTPUT OPEN (FUNCTION SET) BIS #DOREN,(R3) ; AND RENAME ON CLOSE RETURN ;NOW EXIT GLOBAL 40$: BIS #100000!NSUPER,FIRQB+FQMODE ;ENSURE NO SUPERSEDING 50$: CALL CREFUN ;SET THE CORRECT CREATION FUNCTION BR DOOPEN ; AND GO DO THE CREATION 60$: MOV #INPNOR,R3 ;GUESS AT SWITCH TO NORMAAL TSTB @FILBUF(R5) ;NULL STRING? BNE 90$ ;NOPE BR 10$ ;YES, DO THE SWITCH 70$: TSTB @FILBUF(R5) ;NULL FILE SPEC WITH "EI"? BNE 100$ ;NO, SO DO IT CALLR INDCLS ;YES, JUST CLOSE INDIRECT AND EXIT 80$: MOV #CMDPRM,R3 ;GUESS AT "EI" POINTER CMP R2OFF(SP),#'I-'R ;IS IT "EI"? BEQ 70$ ;YES, IT IS EI BGT 60$ ;NO, IT IS ER CALL CHKFEB ;CHECK FOR EB ALLOWED, SAVE, ETC. 90$: MOV INPNTR(R5),R3 ;GET INPUT PARAMETERS CLR EOFLAG(R5) ;NOT END-OF-FILE IF NEW FILE 100$: TST (R3) ;OPEN NOW? BEQ 110$ ;NO CALL CLOSER ;YES, CLOSE AND DEALLOCATE 110$: CMP R2OFF(SP),#'I-'R ;IS IT "EI"? BNE 130$ ;NO MOV FIRQB+FQFLAG,-(SP) ;YES, SAVE FLAGS .CHAIN ; AND TRY A CHAIN TST FIRQB+FQFLAG ;FATAL TYPE ERROR? BMI 120$ ;NOPE, SOFT, TRY A 'REAL' OPEN CHKERR NORTS ;IS ERROR WRONG RTS? BEQ 120$ ;YES, IGNORE THAT ERROR CALL ERRCHK ;BUT CHECK FOR OTHER ERROR(S) 120$: MOV (SP)+,FIRQB+FQFLAG ;RESTORE FLAGS 130$: MOV #OPNFQ,R0 ;OPEN IS THE FUNCTION TSTB FIRQB+FQFLAG ;A DISK FILE? BNE 140$ ;NOPE .ASSUME DSKHND EQ 0 BIS #100000!RONLY,FIRQB+FQMODE ;YEP, ENSURE AT LEAST READ-ONLY MODE 140$: CALL DOOPEN ;SO DO IT CALL SETNAM ;SET THE REAL FILENAME GLOBAL CMP R2OFF(SP),#'I-'R ;IS IT "EB", "EI", OR "ER"? BGT 160$ ;IT IS "ER", ALL DONE BEQ 170$ ;IT IS "EI", SET INDIRECT FLAG MOV FQ+(R3),R0 ;GET PROT CODE FROM INPUT FILE MOV OUPNTR(R5),R3 ;NOW GET OUTPUT PARAMETER POINTER TST FQ+(R3) ;SPECIFIC PROT CODE? BNE 150$ ;YES, LEAVE IT ALONE MOV R0,FQ+(R3) ;NO, SET SET INPUT'S CODE 150$: CALL EBGETT ;"EB", GET ORIGINAL AND .TMP NAME CALL DOOPEN ;NOW DO THE CREATION (FUNCTION SET) BIS #DOREN+DOEB,(R3) ;SIGNAL THIS IS "EB" 160$: RETURN ; AND EXIT EIDONE: MOV #OPNFQ,R0 ;SAY THIS WAS AN OPEN MOV #DO.MOD,R2 ;SET NORMAL ASCII MODE FLAGS MOV #CMDPRM,R3 ;USE THE INDIRECT FILE PARAMETER BLOCK MOV #FIRQB+FQFIL,R4 ;GET A FIRQB POINTER CALL EIOPEN ;NOW FINISH UP THIS OPEN CALL SETNAM ;SET THE REAL FILENAME 170$: MOV R3,INDIR(R5) ;SET THE INDIRECT PARM BLOCK PTR CLRB F$BKSZ(R3) ;INDICATE NO PRE-FETCHED BYTE RETURN ; THEN EXIT .DSABL LSB GLOBAL .SBTTL DO THE ACTUAL FILE CREATE/OPEN .ENABL LSB 10$: MOVB #RSTFQ,-(R4) ;SET FUNCTION TO RESET CHANNEL CALL FIPERC ;DO IT AND ERROR CHECK DOOPEN: MOV #FIRQB+FQFUN,R4 ;GET THE FIRQB POINTER MOV FQFLAG-FQFUN(R4),R2 ;GET THE .BAS/.B2S/8-BIT INDICATORS MOVB R0,(R4)+ ;SET THE FUNCTION MOV R3,R1 ;COPY PARAMETER ADDRESS SUB #CMDPRM-<15.*PARMSZ>,R1 ;FIND THE OFFSET CLR R0 ;CLEAR A HIGH ORDER AND DIV #PARMSZ/2,R0 ;DIVIDE FOR CHANNEL # TIMES 2 MOV R0,(R4) ;SET THAT CHANNEL NUMBER MOVB -1(R4),R0 ;RESTORE THE FUNCTION CODE CALFIP ;NOW DO IT CHKERR NOTCLS ;IS ERROR "NOT CLOSED"? BEQ 10$ ;YES, RESET THAT CHANNEL FIRST THEN CALL ERRCHK ;NO, CHECK FOR OTHER ERROR(S) .DSABL LSB EIOPEN: MOV FQFLAG-FQFIL(R4),R1 ;GET FLAGS INTO A REGISTER MOVB #-1,FQPROT-1-FQFIL(R4) ;GUESS PROT CODE IS REAL (DISK ONLY) TSTB R1 ;REALLY A DISK FILE? BEQ 10$ ;YEP, LEAVE PROT CODE AS REAL .ASSUME DSKHND EQ 0 CLR FQPROT-1-FQFIL(R4) ;NOPE, NO PROTECTION CODE 10$: CMPB R1,#TTYHND ;IS IT A TERMINAL? BNE 20$ ;NOPE MOV #OFFTER,-(SP) ;YEP, PLAY IT SAFE AND RE-OPEN OUR TERMINAL 20$: BIT R1,#DDNFS ;NON-FILE STRUCTURED? BEQ 30$ ;NO, FILE STRUCTURED CLR FQPPN-FQFIL(R4) ;ELSE SAY NO PPN 30$: BIC #^C,R1 ;LEAVE ONLY THESE BITS BIC #^C,R2 ;ISOLATE THE .BAS/.B2S/8-BIT INDICATORS BIS R1,R2 ; AND .OR. IT INTO OTHER BITS BISB (R4),R2 ; AND .OR. IN THE CHANNEL NUMBER *2 MOV #DDWLO,R1 ;GUESS AT AN OUTPUT FILE CMPB R0,#OPNFQ ;AN OPEN FOR INPUT? BNE 40$ ;NO, MUST NOT BE WRITE LOCKED ASR R1 ;YES, SO MUST NOT BE READ LOCKED .ASSUME DDRLO EQ DDWLO/2 CALL SAVFIL ;SAVE THE FILE DATA IN PARM BLOCK 40$: CALL GETATT ;READ ATTRIBUTES, SET I/O CALL ADDRESS BIT R2,R1 ;WILL THIS WORK? BNE ILLACS ;NO, ERROR MOV FQBUFL-FQFIL(R4),R0 ;GET THE BUFFER SIZE INC R0 ;NOW ROUND SIZE UP TO AN BIC #1,R0 ; EVEN NUMBER (I.E. WORDS) MOV QZ(R5),R1 ;GET CURRENT Q-REG SIZE-IN-USE ADD R0,R1 ;UPDATE TO SIZE-TO-BE CALLX SIZEQR ;CALL "TECO"S SIZER FOR Q-REGS BCC 100$ ;FAILED, SO ERROR SUB R0,QMAX(R5) ;ELSE TAKE THE SPACE AWAY AGAIN ADD #RC,R3 ;INDEX TO THE RESET COUNT MOV R0,(R3) ;SET RESET COUNT TO THE BUFFER SIZE MOV -(R3),R4 ;SAVE OLD RESET POINTER SUB R0,(R3) ;THEN CORRECT RESET POINTER CLR -(R3) ;CLEAR CURRENT POINTER CLR -(R3) ;CLEAR CURRENT COUNT MOV R2,-(R3) ;PUT FLAG BITS INTO PARM BLOCK MOV R3,-(SP) ;SAVE THE PARAMETER BLOCK POINTER 50$: CMP R3,#INPNOR ;ALL DONE? BLOS 70$ ;YES SUB #PARMSZ-RP,R3 ;NO, SKIP TO THE RESET POINTER SUB R0,(R3) ;CORRECT THE RESET POINTER TST -(R3) ;VALID CURRENT POINTER? BEQ 60$ ;NOPE SUB R0,(R3) ;YES, SO CORRECT IT 60$: CMP -(R3),-(R3) ; AND INDEX BACK BR 50$ ; LOOPING... 70$: MOV RP(R3),R2 ;GET THE NEW BASE RESET POINTER MOV R2,R1 ;COPY IT AND FIND ADD R0,R1 ; THE OLD BASE RESET POINTER 80$: CMP R1,R4 ;DONE SHIFTING THE BUFFERS? BHIS 90$ ;YES MOV (R1)+,(R2)+ ;NO, MOVE 2 DATA BYTES BR 80$ ; AND CONTINUE 90$: MOV (SP)+,R3 ;RESTORE PARAMETER BLOCK POINTER RETURN ; AND EXIT 100$: JMPX $E$MEM ;SAY NOT ENOUGH MEMORY GLOBAL ILLACS: SETERR PRVIOL ;SET PROTECTION VIOLATION JMP ERRCHK ; AND DIE WITH THAT ERROR .ENABL LSB CHKFEB: TSTB FIRQB+FQFLAG ;IT IS EB, IS IT A DISK FILE? BEQ CHKOFO ;YES, O.K. FOR EB THEN .ASSUME DSKHND EQ 0 CMPB FIRQB+FQFLAG,#DTAHND ;NO, IS IT DECTAPE THEN?? BNE ILLACS ;NOT DECTAPE, SO ERROR CHKOFO: MOV OUPNTR(R5),R3 ;GET OUTPUT POINTER TST (R3) ;OUTPUT ACTIVE? BNE 20$ ;YES, ERROR CLR B2S.CP(R3) ;NO, CLEAR CURRENT POSITION MOV FIRQB+FQBUFL,B2S.AP(R3) ; AND SET DESIRED POSITION TSTB FIRQB+FQFLAG ;IS IT A DISK FILE? BNE SAVFIL ;NOT DISK .ASSUME DSKHND EQ 0 BIS #100000!TENTAT,FIRQB+FQMODE ;DISK, USE TENTATIVE FILE MODE SAVFIL: MOV #FIRQB+FQBSIZ,R4 ;GET END OF FIRQB POINTER AND ADD #PARMSZ,R3 ;END OF PARM BLOCK ALSO 10$: MOV -(R4),-(R3) ;SAVE FIRQB DATA CMP R4,#FIRQB+FQFIL ;MORE? BHI 10$ ;YES, LOOP SUB #FQ+,R3 ;NOW CORRECT PARM BLOCK POINTER RETURN ; AND EXIT 20$: CALL SETNAM ;SET THE OLD NAME ERR OFO,<"Output file already open"> .DSABL LSB GLOBAL .ENABL LSB 10$: MOVB (R4)+,R0 ;GET NEXT CHARACTER OF REQUEST BPL 20$ ;IT'S NOT AN 8-BIT CHARACTER, EXIT N=0 ASL R0 ;DOUBLE (NEGATIVE) CHARACTER FOR WORD ADDRESS MOV CNV8BT+400(R0),R0 ;FETCH CHARACTER'S CONVERSION TABLE ENTRY BMI 20$ ;TO BE OUTPUT AS A HEX PAIR, EXIT N=1 BIT #ET$8BT,ETYPE(R5) ;IT TERMINAL AN 8-BIT TERMINAL? BNE 20$ ;YEP, CALL THE CHARACTER NORMAL, EXIT N=0 .ASSUME ET$8BT GE 0 SEN ;NOPE, NEED COMPOSE PAIR, EXIT N=1 20$: RETURN ;EXIT WITH N-BIT DETERMINATION 30$: ;MOV R3,-(SP) ;SAVE R3 (SAVED BY 'JSR R3,') MOV R4,-(SP) ;SAVE R4 MOV R3,-(SP) ;STACK THE CO-ROUTINE RETURN ADDRESS MOV TTOBFE,R3 ;SET THE BUFFER POINTER MOVB R0,(R3) ; TO THE CHARACTER MOV #1,R4 ;SET THE COUNT TO ONE CHARACTER CALL @(SP)+ ;CO-ROUTINE RETURN CALL BACK 40$: MOV (SP)+,R4 ;RESTORE R4 MOV (SP)+,R3 ; AND R3 RETURN ; THEN FINAL RETURN ASCIZ3: MOV R3,-(SP) ;SAVE R3 MOV R4,-(SP) ; AND R4 MOV R3,R4 ;COPY MESSAGE POINTER 50$: TSTB (R4)+ ;UP TO THE NULL BYTE TERMINATION? BNE 50$ ;NOT YET... DEC R4 ;BACK TO THAT NULL BYTE SUB R3,R4 ; AND FIND THE DATA LENGTH BR 60$ ;NOW GO PRINT IT ASCIC: MOV R3,-(SP) ;SAVE R3 MOV @2(SP),R3 ;GET POINTER TO COUNT, MESSAGE TEXT ADD (PC),2(SP) ;BUMP RETURN ADDRESS OVER ARGUMENT MOV R4,-(SP) ;SAVE R4 MOVB (R3)+,R4 ;GET MESSAGE LENGTH, POINT TO MESSAGE TEXT 60$: MOV #40$,-(SP) ;SAVE RETURN TO RESTORE REGISTERS BR 65$ ; THEN GO PRINT IT ENTRY TYPEB ;TYPE WATCHING ET$BIN (R0=CHAR) JSR R3,30$ ;SAVE R3 AND R4, FORM R3=PTR; R4=COUNT ENTRY PRINTB ;PRINT WATCHING ET$BIN (R3=PTR; R4=COUNT) MOV ETYPE(R5),-(SP) ;STACK EDIT TYPEOUT FLAGS ASR (SP)+ ; AND PUT BINARY OUTPUT MODE INTO C-BIT .ASSUME ET$BIN EQ 1 BR 65$ ;NOW CONTINUE CHECKING C-BIT GLOBAL TYPE0: ADD #'0,R0 ;MAKE BINARY DIGIT INTO ASCII DIGIT ENTRY TYPE ;TYPE (R0=CHAR) JSR R3,30$ ;SAVE R3 AND R4, FORM R3=PTR; R4=COUNT ENTRY PRINT ;PRINT (R3=PTR; R4=COUNT) CLC ;NEVER USE BINARY OUTPUT MODE FOR THIS CALL 65$: MOV R0,-(SP) ;GET A WORKING REGISTER BCS 140$ ;SKIP 8-BIT CHECKING IF BINARY MODE (C-BIT=1) MOV R1,-(SP) ;GET ANOTHER WORKING REGISTER MOV R3,-(SP) ;SAVE REQUEST POINTER MOV R4,-(SP) ; AND REQUEST LENGTH BEQ 120$ ;ZERO LENGTH, JUST GO EXIT... MOV R4,R1 ;COPY REQUEST LENGTH TO HERE MOV R3,R4 ; AND COPY REQUEST POINTER 70$: CALL 10$ ;GET AND CHECK NEXT REQUEST CHARACTER BPL 110$ ;IT'S A NORMAL CHARACTER... DEC R4 ;CORRECT POINTER FOR PRECEEDING SEGMENT CALL 130$ ;GO OUTPUT ANY PRECEEDING PART OF REQUEST BMI 120$ ;EXIT EARLY IF A CONTROL/C IS PENDING ADD R3,R4 ;FORM POINTER BACK TO SPECIAL CHARACTER MOV TTOBFS,SETPTR ;INITIALIZE BUFFERED TERMINAL OUTPUT 80$: CALL 10$ ;GET AND CHECK NEXT FOR BEING SPECIAL BPL 100$ ;NOT SPECIAL, GO BACK TO OUTER LOOP... MOV #'<*400+'>,-(SP) ;GUESS AT COMPOSE SEQUENCE PAIR MOV R0,R3 ;SAVE THE CONVERSION TABLE ENTRY BPL 90$ ;IT IS A COMPOSE SEQUENCE PAIR BIC #100000,R3 ;ELSE REMOVE THE HEX PAIR FLAG MOV #'[*400+'],(SP) ; AND SET HEX PAIR SIGNALS 90$: MOVB 1(SP),R0 ;GET LEADING SIGNAL FOR THE PAIR CALL TYPEBF ; AND BUFFER IT MOV R3,R0 ;GET THE CHARACTER PAIR CALL TYPEBF ; AND BUFFER FIRST PART SWAB R0 ;SWITCH FOR SECOND PART CALL TYPEBF ; AND BUFFER IT TOO MOVB (SP)+,R0 ;GET TRAILING SIGNAL FOR THE PAIR CALL TYPEBF ; AND BUFFER THAT MOV R4,R3 ;SET THE OUTER LOOP BASE POINTER SOB R1,80$ ;LOOP FOR ALL REMAINING IN INNER LOOP... INC R1 ;NO MORE, CORRECT COUNT FOR 'SOB' BELOW 100$: CALL TYPEBC ;DONE BUFFERING, FORCE ANY PARTIAL OUT 110$: SOB R1,70$ ;LOOP FOR ALL REMAINING IN REQUEST LENGTH... CALL 130$ ;GO OUTPUT THE FINAL REQUEST REMAINDER 120$: MOV (SP)+,R4 ;RESTORE ORIGINAL REQUEST LENGTH MOV (SP)+,R3 ; AND ORIGINAL REQUEST POINTER MOV (SP)+,R1 ;RESTORE EXTRA WORKING REGISTER BR 170$ ; AND GO EXIT 130$: SUB R3,R4 ;CALCULATE THIS SEGMENT'S LENGTH BEQ 180$ ;LENGTH=0, NOTHING TO OUTPUT... ;CLC ;C=0 FROM 'SUB' ABOVE MOV R0,-(SP) ;GET A WORKING REGISTER 140$: MOV #XRB+XRMOD,R0 ;ADDRESS THE XRB MOV #TO.BIN,(R0) ;XRMOD <- TO.BIN [BINARY MODE OUTPUT] BCS SPCOUT ;BINARY MODE IS CORRECT IF C=1 CLR (R0) ;XRMOD <- 0 [NORMAL MODE OUTPUT] SPCOUT: CLR -(R0) ;XRTIME <- 0 [WAIT FOREVER] CLR -(R0) ;XRBLK <- 0 [SEQUENTIAL] CLR -(R0) ;XRCI <- 0 [CHANNEL #0] MOV R3,-(R0) ;XRLOC <- R3 [BUFFER POINTER] MOV R4,-(R0) ;XRBC <- R4 [COUNT] BEQ 170$ ;SKIP NULL REQUESTS MOV R4,-(R0) ;XRLEN <- R4 [COUNT] BIT #ET$CCO,ETYPE(R5) ;CANCEL OF CONTROL/O REQUESTED? BEQ 160$ ;NO CALL NOCCO ;YES, SO DO IT 160$: BIS #2,OUTDNE(R5) ;INDICATE TERMINAL OUTPUT OCCURED (+2) .WRITE ;OUTPUT TO TERMINAL CALL IOCHK ;CHECK FOR AN ERROR 170$: MOV (SP)+,R0 ;RESTORE WORKING REGISTER 180$: TST TFLG+R5SET ;SET N-BIT=1 IF CONTROL/C IS PENDING 190$: RETURN ; AND EXIT 200$: SUB R3,R4 ;FIND LENGTH OF THIS MESSAGE BNE PRINT ;LENGTH<>0, SO GO REALLY PRINT BR 180$ ;LENGTH=0, SO JUST EXIT GLOBAL ENTRY TYPEF ;TYPE WITH CASE FLAGGING (R0=CHAR) JSR R3,30$ ;SAVE R3 AND R4, FORM R3=PTR; R4=COUNT ENTRY PRINTF ;PRINT WITH CASE FLAGGING (R3=PTR; R4=COUNT) BIT #ET$BIN,ETYPE(R5) ;BINARY MODE OUTPUT? BNE PRINTB ;YES, SO DO IT IN BINARY MODE ALREADY... TST EUFLAG(R5) ;IS CASE FLAGGING DESIRED? BMI PRINT ;NO CALL SAVREG,R4 ;YES, SAVE SOME REGISTERS MOV #177+1,R1 ;GUESS AT L.C. FLAGGING (HIGH=177) TST EUFLAG(R5) ;GOOD GUESS? BEQ 210$ ;YES, 0=>LOWER CASE FLAGGING MOV #137+1,R1 ;NO, >0=>UPPER CASE FLAGGING (HIGH=137) 210$: MOV R4,R2 ;MOVE COUNT INTO A SAFE SPOT MOV R3,R4 ;MOVE PTR TO RUNNING PTR LOCATION 220$: MOV R4,R3 ;REMEMBER THE CURRENT (START) PTR 230$: DEC R2 ;MORE? BMI 200$ ;NO, FINISH UP MOVB (R4)+,R0 ;YES, SO GET A BYTE SUB R1,R0 ;SUBTRACT (HIGH+1) AND ADD #177-140+1,R0 ; ADD (HIGH-LOW+1), C-BIT=1 IF IN RANGE BCC 230$ ;OUT OF RANGE, CONTINUE SCANNING DEC R4 ;IN RANGE, BACKUP PTR CALL 200$ ;NOW PRINT THE PREVIOUS PART BMI 190$ ;EXIT EARLY IF A CONTROL/C IS PENDING ADD R3,R4 ;NOW CORRECT THE RUNNING POINTER MOV TTOBFS,SETPTR ;INITIALIZE BUFFERED TERMINAL OUTPUT 240$: MOV #'',R0 ;SET "'" AS THE FLAGGING CHARACTER CALL TYPEBF ; AND BUFFER IT MOVB (R4)+,R0 ;NOW GET THE REAL CHARACTER BIC #40,R0 ; AND FORCE IT TO UPPER CASE CALL TYPEBF ; THEN BUFFER IT DEC R2 ;MORE TO GO? BMI 250$ ;NOPE MOVB (R4),R0 ;YEP, GET THE NEXT CHARACTER SUB R1,R0 ;SUBTRACT (HIGH+1) AND ADD #177-140+1,R0 ; ADD (HIGH-LOW+1), C-BIT=1 IF IN RANGE BCS 240$ ;MUST FLAG IT, LOOP IN BUFFERING 250$: CALL TYPEBC ;DONE BUFFERING, FORCE ANY PARTIAL OUT INC R2 ;CORRECT THE COUNTER BR 220$ ; AND GO BACK TO NON-FLAGGED CHECKING .DSABL LSB GLOBAL .ENABL LSB ENTRY TLISTN ;GET A CTRL/T CHARACTER MOV ETYPE(R5),R0 ;GET "ET" FLAGS AND ISOLATE BIC #^C,R0 ; CTRL/C, INPUT CHECK, & NO ECHO INC R0 ;ENSURE NON-ZERO FOR SINGLE CHAR MODE .ASSUME ET$CC!ET$CKE!ET$NCH&1 EQ 0 BR 40$ ;NOW CONTINUE 10$: TST (R3)+ ;INDEX TO CURRENT COUNT IN PARAMETERS MOVB F$BKSZ-CC(R3),-(SP) ;SAVE THE PRE-FETCHED BYTE (IF ANY) CALL @CA-CC(R3) ;GET US THE NEXT BYTE BCS 20$ ;NOT END-OF-FILE, PROCEED MOV R2,-(SP) ;SAVE R2 HERE CALL INDCLS ;EOF, SO CLOSE OUT THE INDIRECT FILE MOV (SP)+,R2 ;RESTORE R2 HERE COM INDIR(R5) ;MARK THE INDIRECT FILE AS "FUNNY" CLR R0 ;INDICATE NO PRE-FETCHED BYTE 20$: MOVB R0,F$BKSZ-CC(R3) ;SAVE THE PRE-FETCHED BYTE MOVB (SP)+,R0 ;RESTORE THE REAL DATA BYTE BEQ 50$ ;NOTHING (OR NULL), SO LOOP JMP 210$ ; ELSE EXIT WITH IT 30$: .TTNCH ;TURN OFF THE ECHO BR 90$ ; AND CONTINUE GLOBAL ENTRY LISTEN ;GET A COMMAND CHARACTER TST R0 ;SINGLE CHARACTER MODE? BEQ 40$ ;NOPE, LEAVE A ZERO AS A FLAG MOV #1,R0 ;YEP, SET SINGLE MODE FLAG 40$: MOV #250$,-(SP) ;SET CARRY CHECKING RETURN ADDRESS CALL SAVREG,R4 ;SAVE REGS AND SET 'SPSAVE' CMP (SP)+,(SP)+ ; BUT FORGET CO-RETURN AND SAVED R2 ;MOV R0,(SP) ; LEAVING MODE FLAGS UP TOP 50$: MOV INDIR(R5),R3 ;GET COMMAND POINTER BGT 10$ ;DO AS AN INDIRECT COMMAND FILE CLR INDIR(R5) ;ENSURE NO INDIRECT COMMAND FILE MOV #TTICNT,R3 ;GET COUNT POINTER 60$: TST (R3)+ ;ANYTHING THERE? BNE 190$ ;YES, SO USE IT 70$: TST (SP) ;SINGLE CHARACTER MODE? BEQ 80$ ;NOPE .TTDDT ;YES, GO INTO DDT SUB-MODE 80$: BIT (SP),#ET$NCH ;NO ECHO MODE? BNE 30$ ;YES, SO TURN OFF THE ECHO .TTECH ;NO, ENSURE ECHO IS ON 90$: MOV #-1,R0 ;PRESET THE -1 RETURN VALUE CALL SETDET ;SET DETACHED FLAG IF WE ARE BNE 140$ ;NOT DETACHED, CONTINUE BIT (SP),#ET$CKE ;RETURN -1 ON DETACH? BNE 175$ ;YES, SO DO SO CLR R0 ;NO, SET UP A NULL CALL TYPE ; AND WAIT FOR ATTACHMENT... 100$: SETFQB OPNFQ ;NOW SETUP AN OPEN REQUEST MOV #"KB,FQDEV-FQFIL(R4) ;DEVICE IS "KB:" MOV #100000!TTTECO,FQMODE-FQFIL(R4) ; AND 'TECO' IS THE MODE BIT #ET$TRU,ETYPE(R5) ;TRUNCATE LONG OUTPUT LINES?? BEQ 110$ ;NOPE BIS #TTCRLF,FQMODE-FQFIL(R4) ;YEP, SO DO SO 110$: BIT #ET$CRT,ETYPE(R5) ;USE SCOPE RUBOUT MODE?? BEQ 120$ ;NOPE BIS #TTTECS,FQMODE-FQFIL(R4) ;YEP, SO USE IT 120$: CLR SEQCTL(R5) ;PRESUME NO ESCAPE SEQUENCE MODE TST EEFLAG(R5) ;USING A PRIVATE DELIMITER? BEQ 125$ ;NO => WE DON'T WANT ESCAPE SEQUENCE MODE BIT #ED$IMD,EDIT(R5);YES: IMMEDIATE_MODE_ALLOWED, TOO? BEQ 125$ ;NO => WE DON'T WANT ESCAPE SEQUENCE MODE BIS #TTESEQ,FQMODE-FQFIL(R4) ;YES: ASK FOR ESC SEQ MODE COMB SEQCTL(R5) ; AND RECORD "ESC SEQ MODE IN USE" 125$: CALL OPNTER ;GO OFF AND DO THAT OPEN BISB (PC),TEROPN ; AND SAY WE DID IT .ASSUME TEROPN&1 NE 0 BR 70$ ; THEN FROM THE TOP... GLOBAL 130$: MOV #'C-100,R0 ;SET CHARACTER AS CONTROL/C TST (SP) ;SHOULD WE ABORT OR RETURN CONTROL/C? BMI 210$ ;CTRL/T CALL, RETURN THE CONTROL/C .ASSUME ET$CC EQ 100000 JMP CHKABT ;NORMAL CALL, CHECK FOR ABORT/RESTART 140$: MOV #XRB,R4 ;GET XRB POINTER MOV #TTIBFL,(R4)+ ;XRLEN <- TTIBFL CLR (R4)+ ;XRBC <- 0 MOV #TTIBUF,(R4) ;XRLOC <- TTIBUF MOV (R4)+,(R3) ;RESET THE INPUT BUFFER POINTER MOV #1*2,(R4)+ ;XRCI <- CHANNEL #1 CLR (R4)+ ;XRBLK <- 0 [SEQUENTIAL] CLR (R4)+ ;XRTIME <- 0 [WAIT FOREVER] CLR (R4) ;XRMOD <- 0 [NO MODIFIERS] BIT (SP),#ET$CKE ;CONDITIONAL INPUT MODE? BEQ 150$ ;NO MOV #TI.CND,(R4) ;YES, SO SET THAT MODIFIER AND MOV (R4),XRBLK-XRMOD(R4) ; SET IT HERE ALSO 150$: BIT (SP),#ET$NCH ;WILL WE BE DOING ECHOING? BNE 160$ ;NO, SO NO TERMINAL OUTPUT WILL OCCUR BIS #2,OUTDNE(R5) ;YES, INDICATE SOME TERMINAL OUTPUT DONE (+2) 160$: MOV ETYPE(R5),R4 ;SAVE STARTING CONTROL/C FLAG STATE .READ ;GET THE INPUT TERINP: BIC ETYPE(R5),R4 ;DID CTRL/C FLAG STATE GO FROM 'ON' TO 'OFF'? BMI 130$ ;YEP, A CONTROL/C TRAP OCCURED .ASSUME ET$CC EQ 100000 CHKERR NOTOPN ;THE "NOT OPEN" ERROR? BEQ 100$ ;YES, SO OPEN IT ALREADY CHKERR EOF ;THE "END-OF-FILE" ERROR? BNE 170$ ;NOPE CALL OFFTER ;YEP, NOT TECO MODE!, CLOSE FOR A RE-OPEN 170$: BIT (SP),#ET$CKE ;SPECIAL, POSSIBLE NO INPUT MODE? BEQ 180$ ;NOPE TSTB IOSTS ;YEP, ANY ERROR THEN?? 175$: BNE 210$ ;RETURN A -1 ON ANY ERROR... 180$: CALL IOCHK ;ELSE DIE ON ERROR(S) MOV XRB+XRBC,TTICNT ;LOAD THE NEW INPUT COUNT GLOBAL 190$: MOVB @(R3)+,R0 ;GET A CHARACTER INC -(R3) ; AND BUMP POINTER DEC -(R3) ;LESS 1 IN BUFFER CLRB KEY ;GOT SOMETHING, TURN OFF CTRL/C FLAG TST R0 ;NULL? 195$: BEQ 60$ ;IGNORE NULLS BIT (SP),#ET$NCH ;ARE WE ECHOING (NEED TO CHECK SPECIALS)? BNE 200$ ;NOT ECHOING, SO NO CHECKING NEEDED CMP R0,#007 ;BELL? BNE 200$ ;NOPE MESAGE <"^G"> ;YEP, SO SPECIAL ECHO 200$: TSTB SEQCTL(R5) ;ESCAPE SEQUENCE MODE IN USE? BEQ 205$ ;NO => CONTINUE TSTB SEQCTL+1(R5) ;YES: ARE WE WITHIN A SEQUENCE? BNE 202$ ;YES => GO CHECK FOR SEQUENCE'S END CMPB R0,#200 ;NO: ARE WE ENTERING ONE, THEN? BNE 205$ ;NO => JUST A NORMAL CHARACTER MOVB R0,SEQCTL+1(R5) ;YES: RECORD THAT WE'RE WITHIN ESC SEQUENCE BR 210$ ;NOW GO DUMP SINGLE FLAG AND EXIT 202$: CMPB R0,#233 ;IS THIS THE END OF OUR SEQUENCE? BNE 210$ ;NO, STILL WITHIN IT => CONTINUE CLRB SEQCTL+1(R5) ;YES: SAY "NOT WITHIN ESCAPE SEQUENCE" NOW ;SEZ ; [FOR HOPSCOTCH BRANCH] BR 195$ ; GO EAT THE TERMINATOR 205$: BIT #ET$LC,ETYPE(R5) ;CONVERT LC INTO UC? BNE 210$ ;NO, DO NO CONVERSIONS CMP R0,#'A+40 ;YES, IS IT LC? BLO 210$ ;NOT LOWER CASE CMP R0,#'Z+40 ;REALLY LC? BHI 210$ ;NOT REALLY BIC #40,R0 ;YES, SO CONVERT IT TO UC 210$: TST (SP)+ ;DUMP SINGLE FLAG BR 220$ ; AND EXIT GLOBAL .SBTTL REGISTER SAVE/RESTORE SUBROUTINES SAVREG::;MOV R4,-(SP) ;R4 WAS SAVED BY THE 'JSR R4' MOV R3,-(SP) ;SAVE R3 MOV R1,-(SP) ; AND R1 MOV SP,SPSAVE ;IN CASE OF ERROR(S) MOV R0,-(SP) ;SAVE R0 MOV R2,-(SP) ; AND R2 MOV TTOBFS,SETPTR ;INITIALIZE BUFFERED TERMINAL OUTPUT MOV R4,-(SP) ;STACK THE RETURN ADDRESS MOV 5*2(SP),R4 ;THEN RESTORE R4 TO ITS REAL VALUE CALL @(SP)+ ; AND EXIT (CO-ROUTINE WISE) MOV (SP)+,R2 ;RESTORE R2 MOV (SP)+,R0 ; AND R0 220$: CLC ;INDICATE GOODNESS 230$: MOV (SP)+,R1 ;RESTORE R1 MOV (SP)+,R3 ; AND R3 MOV (SP)+,R4 ; AND R4 MOV #R5SET,R5 ;ENSURE GOOD "TECO" DATA BASE POINTER 240$: RETURN ;FINAL EXIT R0OFF == 2*2 ;OFFSET TO SAVED R0 R2OFF = 1*2 ;OFFSET TO SAVED R2 ERR: MOV (R4)+,R2 ;GET POINTER TO DATA MOV (R2)+,R0 ;R0=CODE, R2=POINTER TO TEXT ERRIO: SEC ;INDICATE BADNESS MOV SPSAVE,SP ;RESTORE THE SP STACK BR 230$ ;RESTORE R1,R3,R4 AND EXIT 250$: BCC 240$ ;NO ERROR, JUST EXIT JMPX IOERR ;ELSE SAY I/O ERROR .DSABL LSB .SBTTL GET A BYTE SUBROUTINE .ENABL LSB 10$: MOV #XRB,R4 ;NO DATA, GET XRB POINTER CMP (R3)+,(R3)+ ;ADVANCE TO THE RESET COUNT MOV (R3),(R4)+ ;XRLEN <- RESET COUNT CLR (R4)+ ;XRBC <- 0 MOV -(R3),(R4)+ ;XRLOC <- RESET POINTER MOVB FO-RP(R3),(R4)+ ;XRCI <- CHANNEL NUMBER * 2 CLRB (R4)+ ;XRCI+1 <- 0 (NEXT SEQUENTIAL) CLR (R4)+ ;XRBLK <- 0 (NEXT SEQUENTIAL) CLR (R4)+ ;XRTIME <- 0 (WAIT FOREVER) CLR (R4)+ ;XRMOD <- 0 (NO MODIFIERS) .READ ;NOW READ SOME DATA CHKERR EOF ;DID WE JUST GET END-OF-FILE? BEQ 30$ ;YES, GO EXIT WITH C-BIT=0 CALL ERRCHK ;ELSE CHECK FOR OTHER ERROR(S) MOV (R3),-(R3) ;SET CURRENT POINTER TO RESET POINTER MOV XRB+XRBC,-(R3) ;SET CURRENT COUNT TO AMOUNT READ SUB #1,F$HEOF+2-CC(R3) ;ONE LESS BLOCK SBCB F$HEOF-CC(R3) ; IN THE BLOCK COUNTER MOV F$FFBY-CC(R3),F$HVBN+2-CC(R3) ;THEN RESET BYTE COUNTER GETBYT: TST (R3)+ ;IS THERE DATA IN BUFFER? BEQ 10$ ;NO, SO READ IN SOME MORE MOVB @(R3)+,R0 ;PICKUP A CHARACTER INC -(R3) ;BUMP THE CURRENT POINTER DEC -(R3) ; AND DECREMENT THE CURRENT COUNT DEC F$HVBN+2-CC(R3) ;ONE LESS BYTE IN BLOCK SEC ;DATA READ, SO EXIT WITH C-BIT=1 20$: RETURN ;C-BIT=0 => EOF, ELSE REAL DATA 30$: CMP -(R3),-(R3) ;CORRECT POINTER BACK TO CURRENT COUNT CLR R0 ;CLEAR RETURN CHARACTER TO NULL BR 20$ ; THEN GO EXIT C=0 (FROM 'CLR' ABOVE) .DSABL LSB .SBTTL PUT A BYTE SUBROUTINE PUTBYT: TST (R3)+ ;ANY ROOM LEFT IN BUFFER? BNE 10$ ;YES CALL PUTBLK ;NO, PUT OUT THE BUFFER CMP (R3)+,(R3)+ ;ADVANCE TO THE RESET COUNT MOV (R3),CC-RC(R3) ;SET CURRENT COUNT TO RESET COUNT MOV -(R3),-(R3) ;SET CURRENT POINTER TO RESET POINTER 10$: MOVB R2,@(R3)+ ;STORE INTO THE BUFFER INC -(R3) ;BUMP THE CURRENT POINTER DEC -(R3) ; AND DECREMENT THE CURRENT COUNT RETURN ;EXIT .SBTTL END A BLOCK SUBROUTINE ENDBLK: MOV R2,-(SP) ;SAVE R2 CLR R2 ;DO PADDING WITH NULLS CMPB F$FORG-CC(R3),#R.AND ;ANSI FORMAT "D"? BNE 10$ ;NO MOV #'^,R2 ;YES, DO PADDING WITH "^" FOR ANSI FORMAT "D" 10$: MOV RC-CC(R3),-(SP) ;PAD THIS MANY (FORCES OUT 1 BLOCK) 20$: CALL PUTBYT ;FILE THAT BUFFER DEC (SP) ;MORE? BGT 20$ ;LOOP UNTIL DONE... TST (SP)+ ;ELSE DUMP THE COUNTER MOV RC-CC(R3),(R3) ;SET CURRENT COUNT TO RESET COUNT MOV RP-CC(R3),CP-CC(R3) ; AND SET CURRENT POINTER TO RESET POINTER MOV (SP)+,R2 ;RESTORE R2 RETURN ; AND EXIT .SBTTL SAVE/RESTORE FIRQB SAVFQB::MOV R3,-(SP) ;SAVE R3 MOV R4,-(SP) ; AND R4 MOV #FIRQB+FQBSIZ,R4 ;GET FIRQB END+1 POINTER 10$: MOV -(R4),-(SP) ;SAVE FIRQB DATA CLR (R4) ; THEN CLEAR FIRQB CMP R4,#FIRQB+FQFIL ; IN A TIGHT BHI 10$ ; LOOP MOV R4,-(SP) ;SAVE POINTER FOR FIRQB RESTORE CLRB -(R4) ; BUT LEAVE POINTER TO FIRQB @ FQFUN CALL @FQBSIZ-FQFIL+6(SP) ;NOW CALL OUR CALLER MOV (SP)+,FQBSIZ-FQFIL+6(SP) ;UPDATE FOR THE REAL RETURN ADDRESS MOV (SP)+,R4 ;RESTORE FIRQB RESTORE POINTER 20$: MOV (SP)+,(R4)+ ;RESTORE FIRQB DATA CMP R4,#FIRQB+FQBSIZ ; IN A TIGHT BLO 20$ ; LOOP MOV (SP)+,R4 ;RESTORE R4 MOV (SP)+,R3 ; AND R3 RETURN ;THEN EXIT .SBTTL READ FILE ATTRIBUTES AND SET INPUT/OUTPUT CALL ADDRESS GETATT: MOV R3,-(SP) ;SAVE THE PARAMETER BLOCK POINTER ADD #CA,R3 ;INDEX TO INPUT/OUTPUT CALL ADDRESS MOV #GETBYT,(R3)+ ;GUESS AT NORMAL ASCII STREAM INPUT PROCESSING CMP R1,#DDWLO ;GOOD GUESS? BNE 10$ ;YES MOV #PUTBYT,CA-F$FORG(R3) ;NO, CHANGE TO NORMAL BYTE OUTPUT .ASSUME F$FORG EQ CA+2 10$: MOV #/2,R0 ;NUMBER OF ATTRIBUTE WORDS TO PRE-CLEAR .ASSUME F$MRS EQ FQ-2 20$: CLR (R3)+ ;CLEAR ATTRIBUTES SOB R0,20$ ; UNTIL DONE... CMPB FIRQB+FQFLAG,#MTAHND ;MAGTAPE FILE? BNE 40$ ;NOPE CALL SAVFQB ;SAVE AND CLEAR THE FIRQB MOV #XRB,R4 ;GET AN XRB POINTER MOV #7,(R4)+ ;SET "RETURN FILE CHARACTERISTICS" FUNCTION CLR (R4)+ ; WITH NO CLR (R4)+ ; ARGUMENTS MOVB R2,(R4)+ ;SET CHANNEL # *2 MOVB #MTAHND,(R4)+ ; AND HANDLER INDEX AS MAGTAPE .SPEC ;NO READ THOSE CHARACTERISTICS TSTB IOSTS ;ANY ERROR? BNE 70$ ;YES, FORGET IT MOV XRB+XRBC,R4 ;ELSE GET RETURNED CHARACTERISITCS WORD ADD #F$RSIZ-,R3 ;INDEX TO RECORD SIZE COMB F$HEOF-F$RSIZ(R3) ;ENSURE THAT THIS IS A "HUGE" FILE MOV R4,(R3) ;STORE (MAXIMUM) RECORD SIZE BIC #^C<7777>,(R3) ; TRIMMING TO ONLY 12 BITS ASH #-12.,R4 ;NOW SHIFT TO PUT MODIFIER BITS IN <1-0> MOVB R4,-(R3) ; AND STORE THEM IN F$RATT .ASSUME F$RATT EQ F$RSIZ-1 BICB #^C<3>,(R3) ; TRIMMING TO ONLY 2 BITS .ASSUME FD.FTN EQ 1 .ASSUME FD.CR EQ 2 BISB #FD.BLK,(R3) ;RECORDS NEVER SPAN BLOCK BOUNDARIES ASH #-2,R4 ;NOW SHIFT TO PUT FORMAT BITS IN <1-0> MOVB R4,-(R3) ; AND STORE THEM IN F$FORG .ASSUME F$FORG EQ F$RATT-1 BICB #^C<3>,(R3) ; TRIMMING TO ONLY 2 BITS BEQ 70$ ;FORMAT "U", SO NORMAL ASCII STREAM PROCESSING CMPB (R3),#2 ;WHAT FORMAT IS IT? BLO 30$ ;FORMAT "F", SO ANSI FIXED LENGTH RECORDS BHI 70$ ;FORMAT "S", FORGET IT MOVB #R.AND+1,(R3) ;FORMAT "D", SO SAY SO... 30$: DECB (R3) ;FORM CORRECT CODE .ASSUME R.ANF EQ 1-1 BR 60$ ; AND GO PROCESS IT 40$: TSTB FIRQB+FQFLAG ;DISK FILE? BNE 80$ ;NOPE .ASSUME DSKHND EQ 0 CALL SAVFQB ;SAVE AND CLEAR THE FIRQB MOVB #UU.ATR,(R4)+ ;SET "READ ATTRIBUTES" FUNCTION MOVB R2,(R4) ;SET CHANNEL # TIMES 2 ASRB (R4) ; AND MAKE IT TIMES 1 ;CLRB 1(R4) ;WE WANT TO READ ATTRIBUTES .UUO ;SO DO THE READ ALREADY TSTB IOSTS ;AN ERROR? BNE 70$ ;YES, FORGET IT MOV #FIRQB+6+,R4 ;ELSE POINT TO ATTRIBUTE END+2 50$: MOV -(R4),-(R3) ;SAVE ATTRIBUTES CMP R4,#FIRQB+6 ; IN A TIGHT BHI 50$ ; LOOP TSTB (R3) ;UNDEFINED RECORDS (OR NO ATTRIBUTES)? BEQ 70$ ;YEP, SO NORMAL STREAM ASCII PROCESSING .ASSUME R.UDF EQ 0 CMPB (R3),#R.STM ;FIXED, VARIABLE, VFC, OR STREAM? BHI 70$ ;NONE OF THE ABOVE, SO NORMAL PROCESSING ALSO .ASSUME R.FIX LT R.STM .ASSUME R.VAR LT R.STM .ASSUME R.VFC LT R.STM BNE 60$ ;IT'S FIXED, VARIABLE, OR VFC CLRB F$RATT-F$FORG(R3) ;IT'S STREAM, IGNORE THE RECORD ATTRIBUTES 60$: MOV #RMSOUT,-(R3) ;SET CALL ADDRESS FOR RMS OUTPUT PROCESSING .ASSUME CA EQ F$FORG-2 CMP R1,#DDWLO ;IS IT REALLY READ? BEQ 70$ ;NOPE, IT'S WRITE MOV #RMSREC,(R3) ;YEP, CHANGE TO RMS INPUT PROCESSING MOV F$FFBY-CA(R3),F$HVBN+2-CA(R3) ;RESET BYTE COUNTER MOVB #1,F$HEOF+1-CA(R3) ; AND SIGNAL FIRST TIME THROUGH MOV #012,-(R3) ;PRE-INDICATE WE ARE AT LEFT MARGIN .ASSUME B2S.CP EQ CA-2 70$: CALL @(SP)+ ;RESTORE THE FIRQB DATA 80$: MOV (SP)+,R3 ;RESTORE PARAMETER BLOCK POINTER RETURN ; AND EXIT .SBTTL RMS TYPE RECORD INPUT .ENABL LSB 10$: CLRB F$HEOF+1-CC(R3) ;ONLY DO THE FINAL ONCE... CALL 400$,R4,<012> ;RETURN , THEN WE'LL EXIT 20$: TSTB F$HEOF+1-CC(R3) ;NEED A AT EOF? BMI 10$ ;YES, GO DO THAT FINAL RETURN ;NO, EXIT C=0 (FROM 'TSTB') 30$: MOV F$RSIZ-CC(R3),F$HVBN-CC(R3) ;FIXED LENGTH, RESET COUNT BITB #FD.BLK,F$RATT-CC(R3) ;CROSSING BLOCKS? BEQ 90$ ;YES, SO JUST DO IT CMP (R3),F$RSIZ-CC(R3) ;NO, IS THERE ANOTHER RECORD IN THIS BLOCK? BHIS 90$ ;STILL MORE, GO GET IT TST (R3) ;NO MORE, BECAUSE BUFFER IS EMPTY?? BEQ 90$ ;START FETCHING BYTES IF BUFFER NOW EMPTY 40$: CLR (R3) ;FORCE SOME PHYSICAL I/O RMSREC: TSTB F$FORG-CC(R3) ;ANSI FORMAT "F"? BEQ 50$ ;YEP, O.K. TO BE ODD .ASSUME R.ANF EQ 0 CMPB F$FORG-CC(R3),#R.STM ;STREAM ASCII OR ANSI FORMAT "D"? BHIS 50$ ;YEP, ODD SPOTS ARE ALL RIGHT... .ASSUME R.AND GT R.STM BIT (R3),#1 ;AT AN ODD SPOT? BEQ 50$ ;NOPE CALL 430$ ;YEP, SO EVEN IT UP 50$: MOVB F$HEOF-CC(R3),R4 ;AT THE EOF BIS F$HEOF+2-CC(R3),R4 ; BLOCK? BNE 60$ ;NOT YET TST F$HVBN+2-CC(R3) ;RIGHT BLOCK, AT EOF BYTE?? BLE 20$ ;TRUE EOF, GO CHECK FOR NEEDING A FINAL 60$: CMPB F$FORG-CC(R3),#R.FIX ;FIXED LENGTH RECORDS? BLOS 30$ ;YEP .ASSUME R.ANF LT R.FIX MOV #1,F$HVBN-CC(R3) ;NOPE, GUESS AT A 1 BYTE "RECORD" CMPB F$FORG-CC(R3),#R.STM ;STREAM ASCII OR ANSI FORMAT "D"? BEQ 90$ ;STREAM ASCII, LEAVE RECORD SIZE AS 1 BYTE BHI 70$ ;ANSI FORMAT "D" .ASSUME R.AND GT R.STM CALL 430$ ;VARIABLE OR VFC, GET LOW BYTE OF LENGTH MOVB R0,F$HVBN-CC(R3) ;SET THAT LOW BYTE CALL 430$ ;GET HIGH BYTE OF LENGTH MOVB R0,F$HVBN+1-CC(R3) ;SET THAT HIGH BYTE CMP F$HVBN-CC(R3),#-1 ;CHECK FOR 'END-OF-BLOCK' BEQ 40$ ;THAT IT IS, FORCE MORE I/O BR 90$ ;ELSE PROCESS THE RECORD 70$: CLR F$HVBN-CC(R3) ;PRE-CLEAR THE RECORD LENGTH MOV #4,R4 ; AND SET 4 DECIMAL BYTES TO BE READ 80$: CALL 430$ ;GET A RECORD LENGTH BYTE CMP R0,#'^ ;IS IT THE "^" PAD? BEQ 40$ ;YES, SO FORCE SOME PHYSICAL I/O SUB #'0,R0 ;ELSE MAKE ASCII DIGIT INTO BINARY ASL F$HVBN-CC(R3) ;FORM OLD RECORD LENGTH *2 ADD F$HVBN-CC(R3),R0 ; AND ADD IT INTO THE NEW DIGIT ASL F$HVBN-CC(R3) ;NOW OLD LENGTH *4 ASL F$HVBN-CC(R3) ; THEN *8. ADD R0,F$HVBN-CC(R3) ;LENGTH = OLD*10. + NEW DIGIT SOB R4,80$ ;LOOP FOR ALL DECIMAL BYTES SUB #4,F$HVBN-CC(R3) ;NOW CORRECT FOR THE 4 DECIMAL BYTES 90$: CMPB F$FORG-CC(R3),#R.VFC ;VARIABLE WITH FIXED CONTROL? BNE 120$ ;NOPE MOVB F$HDSZ-CC(R3),R4 ;YEP, GET THE FIXED BYTE SIZE BNE 100$ ;A REAL SIZE WAS SPECIFIED TST (R4)+ ;ELSE DEFAULT TO A SIZE OF 2 BYTES 100$: CLR F$MRS-CC(R3) ;PRE-CLEAR THE SAVED CONTROL BYTES CALL 420$ ;GET FIRST FIXED CONTROL BYTE BMI 120$ ;NOT THERE??, SKIP FIXED CONTROL STUFF MOVB R0,F$MRS-CC(R3) ;ELSE STORE FIRST CONTROL BYTE DEC R4 ;ANOTHER BYTE OF FIXED CONTROL? BLE 120$ ;NOPE, ALL DONE WITH FIXED CONTROL BYTE(S) CALL 420$ ;GET SECOND FIXED CONTROL BYTE BMI 120$ ;NOT THERE??, SKIP FIXED CONTROL STUFF MOVB R0,F$MRS+1-CC(R3) ;ELSE STORE SECOND CONTROL BYTE 110$: DEC R4 ;ANOTHER BYTE OF FIXED CONTROL? BLE 120$ ;NOPE, ALL DONE WITH FIXED CONTROL BYTE(S) CALL 420$ ;GET FURTHER FIXED CONTROL BYTE(S) BPL 110$ ;GOT ONE, LOOP THROUGH FIXED CONTROL JUNK... 120$: MOVB F$HEOF+1-CC(R3),R4 ;SAVE THE FIRST TIME THROUGH FLAG CLRB F$HEOF+1-CC(R3) ;GUESS AT NO TRAILING (& NO ON EOF) BITB #FD.FTN,F$RATT-CC(R3) ;FORTRAN CARRIAGE CONTROL? BEQ 160$ ;NO CALL 420$ ;YES, GET FORTRAN CARRIAGE CONTROL CHARACTER BMI 220$ ;NOT THERE??, SAY IT'S "OTHER" TST R0 ; => NOTHING LEADING OR TRAILING BEQ 250$ ;IT IS , JUST PROCESS THAT DATA COMB F$HEOF+1-CC(R3) ;CHANGE TO WANTING A TRAILING CMP R0,#'$ ;$ => LEADING BUT NOTHING TRAILING BEQ 220$ ;IT IS $, GO DO A THEN SAY NO TRAILER CMP R0,#'+ ;+ => NOTHING LEADING BUT A TRAILING BEQ 250$ ;IT IS +, ALL SET, JUST PROCESS THE DATA CMP R0,#'1 ;1 => LEADING AND A TRAILING BEQ 140$ ;IT IS 1, GO DO A CLRB F$HEOF+1-CC(R3) ;CHANGE BACK SO THE 'COMB' WILL SET THE FLAG CMP R0,#'0 ;0 => 2 LEADING 'S AND A TRAILING BNE 220$ ;OTHER, DO LEADING AND TRAILING TSTB R4 ;FIRST TIME THROUGH? BGT 130$ ;YES, DO THEN CALL 400$,R4,<012> ;NO, DO THE 2ND HERE 130$: CALL 400$,R4,<015> ;DO THE BR 230$ ; THEN GO AND DO A 140$: TSTB R4 ;DID A TRIALING PRECEED THIS ? BGT 150$ ;NOPE CALL 400$,R4,<012> ;YEP, DO A FOR FREE 150$: CALL 400$,R4,<014> ;DO THAT LEADING BR 250$ ; THEN PROCESS THE DATA 160$: BITB #FD.PRN,F$RATT-CC(R3) ;IS IT PRINT FILE FORMAT? BEQ 210$ ;NO MOVB F$MRS-CC(R3),R0 ;YES, GET FIRST FIXED CONTROL BYTE ("PREFIX") MOVB R0,F$HEOF+1-CC(R3) ;CHECK OUT AND SAVE THE "PREFIX" BLE 190$ ;NO "PREFIX" OR CONTROL CHARACTER "PREFIX" TSTB R4 ;FIRST TIME THROUGH? BLE 180$ ;NOPE 170$: DECB F$HEOF+1-CC(R3) ;MORE TO DO AFTER THIS ? BLE 200$ ;NO, DONE, GO DO THE "POSTFIX" CALL 400$,R4,<015> ;DO A 180$: CALL 400$,R4,<012> ;DO A BR 170$ ; AND LOOP... 190$: BIC #^C<037>,R0 ;TRIM THE "PREFIX" CONTROL CHARACTER BEQ 200$ ;NULL, DON'T USE IT... CALL 410$,R4 ;ELSE RETURN "PREFIX" CHARACTER 200$: MOVB F$MRS+1-CC(R3),F$HEOF+1-CC(R3) ;SAVE THE "POSTFIX" FOR LATER BR 250$ ;NOW GO FETCH THE DATA BYTE(S) 210$: BITB #FD.CR,F$RATT-CC(R3) ;IS IT REALLY IMPLIED LF,...,CR ? BEQ 250$ ;NO, SO NO TRAILING => NO ON EOF TST F$HVBN-CC(R3) ;YES, NULL RECORD? BEQ 350$ ;JUST IF NULL, SO GO DO IT INCB F$HEOF+1-CC(R3) ;ELSE SIGNAL TRAILING NEEDED BR 250$ ; AND GO PROCESS THE DATA 220$: TSTB R4 ;IS THIS THE FIRST TIME THROUGH? BGT 240$ ;FIRST TIME, DON'T DO ANY LEADING 230$: CALL 400$,R4,<012> ;ELSE DO THAT LEADING RIGHT NOW 240$: COMB F$HEOF+1-CC(R3) ;SET TRAILING => NEED ON EOF 250$: MOV #260$,CA-CC(R3) ;SET NEXT CALLING ADDRESS FOR MORE DATA 260$: CALL 420$ ;GET NEXT DATA BYTE IN RECORD BMI 360$ ;END-OF-RECORD, DO TRAILING STUFF 270$: BITB #FD.PRN,F$RATT-CC(R3) ;PRINT FILE FORMAT? BEQ 290$ ;NOPE, SO NO SPECIAL FILTERING CMP R0,#015 ;WHAT KIND OF CHARACTER IS THIS? BHI 280$ ;GREATER THAN IS NORMAL, NO LEFT MARGIN BEQ 300$ ;, GO INDICATE AT LEFT MARGIN CMP R0,#012 ;IS IT , , OR ? BHI 290$ ;IT'S OR , DON'T CHANGE INDICATOR BEQ 320$ ;IT'S , CHECK FOR NEEDING LEADING 280$: MOVB (PC),B2S.CP+1-CC(R3) ;SET NON-ZERO FOR NOT AT LEFT MARGIN .ASSUME B2S.CP+1-CC&377 NE 0 290$: MOVB R0,B2S.CP-CC(R3) ;REMEMBER THE LAST CHARACTER RETURNED SEC ;INDICATE REAL DATA WITH C=1 RETURN ; AND EXIT W/ C=1 300$: TSTB B2S.CP+1-CC(R3) ;HAVE , ALREADY AT LEFT MARGIN? BEQ 310$ ;YES, IGNORE THIS (FOR NOW...) CLRB B2S.CP+1-CC(R3) ;INDICATE LEFT MARGIN FOR BR 290$ ; AND GO EXIT WITH IT 310$: JMP @CA-CC(R3) ;RE-DISPATCH TO IGNORE THE 320$: CMP R0,B2S.CP-CC(R3) ;2 'S AT LEFT MARGIN? BNE 290$ ;NOPE MOV CA-CC(R3),B2S.AP-CC(R3) ;YEP, SAVE THE RE-CALL ADDRESS MOVB (PC),B2S.CP+1-CC(R3) ; AND FORCE THIS TO BE EMITTED .ASSUME B2S.CP+1-CC&377 NE 0 CALL 400$,R4,<015> ;GO EMIT THE MISSING MOV B2S.AP-CC(R3),CA-CC(R3) ;RESTORE THE RE-CALL ADDRESS MOV #012,R0 ; AND THE CHARACTER BR 290$ ;NOW GO RETURN IT 330$: CLRB F$HEOF+1-CC(R3) ;CLEAR THE TRAILING / INDICATOR BITB #FD.PRN,F$RATT-CC(R3) ;IS IT PRINT FILE FORMAT? BNE 340$ ;YES CMPB B2S.CP-CC(R3),#012 ;WAS LAST OF RECORD (OR ABOVE)? BLO 340$ ;NO, DO TRAILING CMPB B2S.CP-CC(R3),#014 ;WAS IT , , OR ? BLOS 390$ ;ONE OF THE ABOVE, ADD NOTHING CMPB B2S.CP-CC(R3),#033 ;WAS IT ? BEQ 390$ ;YES, ADD NOTHING ALSO 340$: TSTB R0 ;CHECK OUT THE "POSTFIX" BLE 370$ ;NO "POSTFIX" OR CONTROL CHARACTER "POSTFIX" DECB R0 ;ELSE DECREMENT COUNT MOVB R0,F$HEOF+1-CC(R3) ; AND RE-STORE IT AS A "POSTFIX" 350$: CALL 400$,R4,<015> ;DO A CALL 400$,R4,<012> ;DO A 360$: MOVB F$HEOF+1-CC(R3),R0 ;GET THE TRAILER ("POSTFIX") INDICATOR BEQ 390$ ;NULL, DO NOTHING, LOOP FOR NEXT RECORD BITB #FD.PRN!FD.CR,F$RATT-CC(R3) ;IS IT PRINT FILE OR /? BNE 330$ ;YES MOV #015,R0 ;NO, RETURN A 370$: BIC #^C<037>,R0 ;TRIM THE "POSTFIX" CONTROL CHARACTER BEQ 390$ ;NULL, DON'T USE IT... CMP R0,#015 ;IS THE "POSTFIX" A ? BNE 380$ ;NOPE MOVB #-1,F$HEOF+1-CC(R3) ;YEP, INDICATE NEEDED ON EOF 380$: CALL 410$,R4 ;ELSE RETURN "POSTFIX" CHARACTER 390$: JMP RMSREC ; THEN DO THE NEXT RECORD 400$: MOV (R4)+,R0 ;PUT CHARACTER INTO R0 410$: MOV R4,CA-CC(R3) ;NOW SET THE NEXT CALLING ADDRESS MOV (SP)+,R4 ;RESTORE THE SAVED R4 BR 270$ ; AND EXIT WITH C=1 FOR VALID CHARACTER 420$: DEC F$HVBN-CC(R3) ;MORE DATA IN RECORD? BMI 470$ ;NOPE, EXIT WITH N=1 430$: MOV R4,-(SP) ;SAVE R4 CALL GETBYT ;TRY TO GET THE NEXT BYTE MOV (SP)+,R4 ;RESTORE R4 CLN ;SET N=0 LEAVING C-BIT FROM CALL BCS 470$ ;NOT EOF, EXIT WITH N=0 MOV #20$,(SP) ;EOF, GUESS AT MAGTAPE END-OF-FILE (O.K.) TSTB F$FORG-CC(R3) ;ANSI FORMAT "F"? BNE 440$ ;NOPE .ASSUME R.ANF EQ 0 INC F$HVBN-CC(R3) ;UNDO THE COUNTING WE DID ABOVE SUB F$RSIZ-CC(R3),F$HVBN-CC(R3) ;STARTING A NEW RECORD? BR 450$ ;GO CHECK IT OUT... 440$: CMPB F$FORG-CC(R3),#R.AND ;ANSI FORMAT "D"? BNE 460$ ;NOPE 450$: TST F$HVBN-CC(R3) ;WERE WE STARTING A NEW RECORD? BEQ 470$ ;YES, EOF O.K. (C=0 FROM 'BEQ') 460$: TST (SP)+ ;ILLEGAL EOF, POP INTERMEDIATE RETURN & C=0 470$: RETURN ;TO CALLER N=1=>EOR; TO CALLER'S CALLER W/ C=0 .DSABL LSB .SBTTL RMS TYPE RECORD OUTPUT .ENABL LSB 10$: CALL ENDREC ;END THE TOO LONG RECORD AND RE-TRY... RMSOUT: CMP (R3),#6 ;ANY ROOM LEFT FOR ANOTHER RECORD? BHIS 20$ ;YES CALL ENDBLK ;NO, SO END THIS BLOCK 20$: MOV R2,-(SP) ;SAVE THE CALLING CHARACTER CLR R2 ;SET INTO SIZE BYTES INITIALLY CALL 40$ ;PRE-SET CALL 40$ ; 4 CALL 40$ ; SIZE CALL 40$ ; BYTES MOV (SP)+,R2 ;RESTORE THE ORIGINAL CHARACTER MOV #30$,CA-CC(R3) ;SAY DOING A RECORD NOW 30$: CMP F$MRS-CC(R3),RC-CC(R3) ;IS THIS RECORD TOO LONG? BHIS 10$ ;FILLS A WHOLE BUFFER, TOO LONG!!! 40$: CALL 110$,R0 ;CO-ROUTINE SAVE OF R0, R1, AND R2 TST (R3)+ ;ROOM LEFT IN THE BUFFER? BNE 70$ ;YES MOV F$MRS-CP(R3),R4 ;NO, GET CURRENT RECORD'S SIZE INC R4 ;ROUND IT UP BIC #1,R4 ; TO A WORD AMOUNT MOV QZ(R5),R1 ;GET CURRENT SIZE OF Q-REG'S ADD R4,R1 ; AND FORM A TOTAL DESIRED SIZE CALLX SIZEQR ;TRY TO GET THAT MUCH BCC 100$ ;FAILED, WE MUST DIE... MOV QRSTOR(R5),R1 ;GET START OF Q-REG AREA ADD QZ(R5),R1 ; AND GO PAST THE ACTIVE STUFF MOV F$MRS-CP(R3),R4 ;GET CURRENT RECORD'S SIZE AGAIN MOV (R3),R0 ;GET THE CURRENT POINTER SUB R4,(R3) ;NOW BACK UP CURRENT POINTER ADD R4,-(R3) ; AND UPDATE THE CURRENT COUNT 50$: MOVB -(R0),(R1)+ ;MOVE FROM ACTIVE RECORD TO HOLDING AREA SOB R4,50$ ; FOR THE RECORD'S WHOLE SIZE CALL ENDBLK ;NOW WE CAN END THIS BLOCK MOV F$MRS-CC(R3),R4 ;GET RECORD'S SIZE ONCE MORE SUB R4,(R3)+ ;UPDATE THE NEW BLOCK'S CURRENT COUNT MOV (R3),R0 ;GET THE START OF BLOCK POINTER ADD R4,(R3) ; THEN UPDATE IT ALSO 60$: MOVB -(R1),(R0)+ ;MOVE FROM HOLDING AREA TO NEW ACTIVE RECORD SOB R4,60$ ; FOR THE RECORD'S WHOLE SIZE... GLOBAL 70$: MOVB R2,@(R3)+ ;STORE THE CHARACTER INC -(R3) ;BUMP THE CURRENT POINTER DEC -(R3) ; AND THE CURRENT COUNT INC F$MRS-CC(R3) ;ONE MORE CHARACTER IN THIS RECORD CMP R2,#033 ;END OF THE RECORD? BEQ 80$ ;YEP, BUT NOT CMP R2,#014 ;OTHER END OF THE RECORD? BHI 90$ ;NOPE, EXIT CMP R2,#012 ;MIGHT BE, CHECK FOR TERMINATION BHI 80$ ;TERMINATED, BUT NOT BLO 90$ ;NOT TERMINATED, EXIT MOV #2,R0 ;GET A HANDY CONSTANT CMP F$MRS-CC(R3),R0 ;IS THERE A PREVIOUS TO THE ? BLO 80$ ;NOPE, SO DON'T REMOVE ANYTHING MOV CP-CC(R3),R4 ;GET THE CURRENT BUFFER POINTER CMPB -2(R4),#015 ;WAS THE PREVIOUS TO A ? BNE 80$ ;NOPE ADD R0,(R3) ;YEP, SO DELETE THE SUB R0,CP-CC(R3) ; FROM THE BUFFER SUB R0,F$MRS-CC(R3) ; AND DON'T COUNT THEM IN THE RECORD 80$: MOV #RMSOUT,CA-CC(R3) ;WE'LL START A NEW RECORD THE NEXT TIME ENDREC: CALL 110$,R0 ;CO-ROUTINE SAVE OF R0, R1, AND R2 MOV F$MRS-CC(R3),R1 ;GET CURRENT RECORD SIZE BEQ 90$ ;NO ACTIVE RECORD, SKIP IT CLR F$MRS-CC(R3) ;CLEAR SIZE SINCE WE'RE FINISHING THIS RECORD MOV CP-CC(R3),R4 ;GET THE CURRENT POINTER SUB R1,R4 ; AND BACK UP TO START OF RECORD MOV #120$,R2 ;GET A POINTER TO THE DIVISOR LIST MOV PC,-(SP) ;DO THE CODE BELOW MOV PC,-(SP) ; 4 TIMES... CLR R0 ;CLEAR A HIGH ORDER DIV (R2)+,R0 ; AND DIVIDE ADD #'0,R0 ;MAKE ANSWER A DECIMAL DIGIT MOVB R0,(R4)+ ; AND STORE IT AWAY 90$: RETURN ;EXIT OR LOOP... 100$: JMPX $E$MEM ;SORRY, OUT OF MEMORY... 110$: ;MOV R0,-(SP) ;R0 WAS SAVED BY THE 'JSR R0,' MOV R1,-(SP) ;SAVE R1 MOV R2,-(SP) ; AND R2 CALL (R0) ;NOW CALL BACK OUR CALLER (R0 CLOBBERED) MOV (SP)+,R2 ;RESTORE R2 MOV (SP)+,R1 ; AND R1 MOV (SP)+,R0 ; AND R0 RETURN ;FINAL EXIT 120$: .WORD 1000., 100., 10., 1. .DSABL LSB .ENABL LSB ENTRY SIZER ;GET ADDITIONAL MEMORY IF POSSIBLE MOV R1,-(SP) ;SAVE ORIGINAL REQUEST AMOUNT MOV R0,-(SP) ; AND SAVE R0 ALSO MOV R4,-(SP) ; AND SAVE R4 ALSO ADD #SIZERB-1,R1 ;ROUND REQUEST AMOUNT TO THE BIC #SIZERB-1,R1 ; NEAREST K TO ADD MOV R1,R0 ;COPY THE AMOUNT WE HOPE TO ADD SWAB R1 ;MAKE BYTE AMOUNT INTO ASH #-11.+8.,R1 ; K AMOUNT WITHOUT SIGN EXTENSION MOVB CURSIZ,R4 ;NOW ADD CURRENT SIZE ADD R4,R1 ; INTO THE NEW AMOUNT MOVB SVNENT,R4 ;GET LIMITING SIZE IF ANY BEQ 10$ ;NO LIMITING SIZE, JUST TRY FOR IT CMP R4,R1 ;A LIMIT, SO CHECK AGAINST REQUEST BLO 40$ ;REQUEST TOO BIG, EXIT C=1 (BLO=BCS) 10$: MOV R1,XRB ;SET THAT AS THE REQUEST AMOUNT .CORE ; AND ASK FOR IT NEGB IOSTS ;DID WE GET IT? BCS 40$ ;NOPE (C=1 ONLY IF IOSTS<>0) MOVB R1,CURSIZ ;YEP, SO SET OUR NEW K SIZE MOV #CMDPRM+RP,R4 ;GET A PARAMETER BLOCK POINTER MOV (R4)+,R1 ;FIND THE LAST RP VALUE ADD (R4),R1 ; NOW HAVE OLD TOP OF MEMORY ADD #PARMSZ-RC,R4 ;POINT TO JUST BEYOND PARM BLOCK CALL SHUFLE ;SO SHUFFLE THE I/O BUFFERS CALL CHKDET ;CHECK FOR DETACHED BIT #ET$XIT!ET$DET,ETYPE(R5) ;SHOULD WE ANNOUNCE NEW SIZE? BNE 30$ ;NOPE GLOBAL MOV #'[,R0 ;YEP, ANNOUNCE THE CALL TYPE ; NEW AMOUNT MOVB CURSIZ,R1 ;SET A LOW ORDER ASL R1 ; DOUBLED FOR BYTES CLR R0 ;CLEAR HIGH ORDER DIV #10.,R0 ; FOR A DIVIDE BY 10. BEQ 20$ ;NO TENS CALL TYPE0 ;YEP, TYPE AS AN ASCII DIGIT 20$: MOV R1,R0 ;PUT UNITS INTO HERE CALL TYPE0 ;TYPE UNITS AS AN ASCII DIGIT MESAGE <"KB memory]"<15><12>> ;ANNOUNCE REST OF MESSAGE BIS #1,OUTDNE(R5) ;INDICATE MEMORY EXPANDED WITH MESSAGE (+1) 30$: CLC ;INDICATE GOODNESS 40$: MOV (SP)+,R4 ;RESTORE R4 MOV (SP)+,R0 ; AND RESTORE R0 MOV (SP)+,R1 ; AND RESTORE ORIGINAL REQUEST AMOUNT RETURN ; THEN EXIT .DSABL LSB GLOBAL .SBTTL SCOPE CHARACTER/LINE DELETION .ENABL LSB ENTRY DELLIN ;CONTROL/U HANDLER BIT #ET$CRT,ETYPE(R5) ;SCOPE MODE? BNE 40$ ;YES, ERASE A LINE CALLRX CRLF ;NO, DO TTY COMPATIBLE WAY ENTRY DELCHR ;RUBOUT HANDLER BIT #ET$CRT,ETYPE(R5) ;SCOPE MODE? BNE 10$ ;YES, HANDLE IT CALLR TYPE ;NO, DO TTY COMPATIBLE WAY 10$: MOVB R0,R0 ;ENSURE SIGN EXTENDED CHARACTER BMI 50$ ;AN 8-BIT CHARACTER, GO CHECK IT OUT... CMP R0,#040 ;NORMAL GRAPHIC? BHIS 80$ ;YES, 1 SEQUENCE CMP R0,#033 ;ESCAPE? BEQ 80$ ;YES, 1 SEQUENCE CMP R0,#016 ;UPARROW CONTROL? BHIS 70$ ;YES, 2 SEQUENCES CMP R0,#006 ;OTHER UPARROW CONTROL? BLOS 70$ ;YES, 2 SEQUENCES CMP R0,#012 ;LINE FEED? BLO 30$ ;NO, LOWER, RE-PRINT BEQ 20$ ;YES, 1 CURSOR UP CMP R0,#014 ;VERTICAL TAB OR FORM FEED? BHI 30$ ;NO, RE-PRINT MOV PC,-(SP) ;YES, DO CURSOR UP MOV PC,-(SP) ; 4 TIMES 20$: MOV CRTCUP,R3 ;SET CURSOR UP SEQUENCE POINTER POINTER BR 90$ ; AND GO DO IT 30$: MOV #PRTLIN,-(SP) ;RE-PRINT AFTER ERASE OF LINE 40$: MOV CRTERL,R3 ;SET SEQUENCE POINTER POINTER BR 90$ ; AND GO DO IT 50$: BIT #ET$8BT,ETYPE(R5) ;IS THE TERMINAL IN 8-BIT MODE? BEQ 60$ ;NO, 4 SEQUENCES ASL R0 ;DOUBLE CHARACTER TST CNV8BT+400(R0) ;GRAPHIC CHARACTER OR HEX PAIR? BPL 80$ ;GRAPHIC, 1 SEQUENCE 60$: MOV PC,-(SP) ;DO ERASE CHARACTER 4 TIMES 70$: MOV PC,-(SP) ;DO ERASE CHARACTER 2 TIMES 80$: MOV CRTERC,R3 ;SET ERASE CHARACTER SEQUENCE POINTER POINTER 90$: ADD CRTYPE(R5),R3 ;FIND THE CORRECT SEQUENCE POINTER MOV (R3),R3 ;GET POINTER TO COUNT, STRING MOVB (R3)+,R4 ;SET THE STRING COUNT LEAVING A POINTER MOV R0,-(SP) ;GET A WORKING REGISTER MOV #XRB+XRMOD,R0 ;ADDRESS THE XRB MOV #TO.CTL,(R0) ;XRMOD <- TO.CTL [CLEAN CONTROLS MODE OUTPUT] JMP SPCOUT ;NOW GO JOIN OUTPUT FLOW AT THE SPECIAL SPOT .DSABL LSB GLOBAL .SBTTL SET UP FOR SCOPE CHARACTER/LINE DELETION ORG CRTRUB CRTRUB: BR CRTSET ;BRANCH TO THE SET UP ROUTINE .ENABL LSB .ASSUME . EQ CRTRUB+2 CRTERC: .WORD 10$ ;ERASE CHARACTER SEQUENCE POINTERS POINTER .ASSUME . EQ CRTRUB+4 CRTCUP: .WORD 10$ ;CURSOR UP SEQUENCE POINTERS POINTER .ASSUME . EQ CRTRUB+6 CRTERL: .WORD 10$ ; SEQUENCE POINTERS POINTER 10$: .WORD 20$ ;SCOPE TYPE #0 SEQUENCE POINTER... 20$: .BYTE 0 ;SEQUENCE AS A BYTE COUNTED STRING... .EVEN .DSABL LSB CRTSET: CLR R4 ;NO "WATCH" STATIC READ/WRITE REGION WANTED RETURN ;NO SCOPE SUPPORT, JUST EXIT .SBTTL SCOPE "WATCH" ROUTINE .GLOBL UU.TRM, .UUO ;FOR TERMINAL WIDTH CHANGES ORG SCREEN ENTRY WATCH ;SCOPE "WATCH" SCREEN: RETURN ;SIMPLE RETURN .SBTTL ASCII REGION .EVEN FIXUP ORG TECOIE .EVEN .SBTTL DEFINE PATCH SPACE ORG PATCH .BLKB 0 .SBTTL VECTOR REGION VECTOR P.FLAG, O.FLAG ;RUN-TIME SYSTEM FLAGS VECTOR P.DEXT, O.DEXT ;DEFAULT RUNNABLE EXTENSION VECTOR P.MSIZ, O.MSIZ ;MINIMUM SIZE VECTOR P.SIZE, O.SIZE ;MAXIMUM SIZE VECTOR P.FIS, BADONE ;ILLEGALS VECTOR P.FPP, BADONE VECTOR P.BPT, BADONE VECTOR P.IOT, BADONE VECTOR P.EMT, BADONE VECTOR P.TRAP, BADONE VECTOR P.BAD, BADXXX VECTOR P.CRAS, START ;START ENTRIES VECTOR P.STRT, START VECTOR P.NEW, START VECTOR P.RUN, RUNIT ;RUN ENTRY (CCL & CHAIN ALSO) VECTOR P.CC, TECOCC ;CONTROL/C ENTRIES VECTOR P.2CC, TEXIT .END