.NLIST BEX,TTM ;00010 ;00020 ; MACRO SUPPORT SUBROUTINES FOR THE U OF O FLEX TRANSLATOR - FOR THE ;00030 ; THE PDP 11 RSX-11D REAL TIME OPERATING SYSTEM ;00040 ;00050 ; PROGRAMMER: CHRIS MEYERS ;00060 ; LOCATION: EUGENE REGISTER GUARD - EUGENE OREGON ;00070 ;00080 ; DATE: OCT-25-74 ;00090 ; NOTE * THE FOLLOWING ROUTINES ARE NOT IN THIS SET BUT RESIDE IN A ;00100 ; SEPARATE FORTRAN FILE; CATNUM, PUTNUM, CATSTR, CPYSTR, CPYSUB ;01-R 00101 ; HASH, NEWNO ;01-R 00102 ; EDIT HISTORY ;01-I 00103 ; (1) PROPER HANDLING OF BLANK LINES ;01-I 00104 ; (2) PROPER HANDLING OF ( FOLLOWING TAB ;02-I 00105 ; RLB001 3-FEB-77 REID L BROWN CORRECT CSI$1 ERROR (BUFFER ADR) ;00120 .MCALL GCML$,CSI$,CSI$1,CSI$2,GCMLB$,OPEN$W,OPEN$R,DIR$,CLOSE$;00130 .MCALL EXIT$,QIOW$,NMBLK$,FDBDF$,FDAT$A,FDRC$A,FDOP$A ;00140 .MCALL GET$,PUT$ ;00145 ; .TITLE FLXMAC ;01-D 00150 .TITLE RSXMAC ;01-I 00151 ;00160 ; *** LOGICAL FUNCTION STREQ(A,B) ;00170 ;00180 STREQ:: CLR R0 ; SET RETURN VALUE TO FALSE ;00190 MOV 2(R5),R1 ; R1 POINTS TO STRING A ;00200 MOV 4(R5),R2 ; R2 TO B ;00210 MOV (R1),R3 ; GET LENGTH TO R3 ;00220 CMP (R1)+,(R2)+ ; CHECK LENGTHS MATCH ;00230 BNE 2$ ;00240 1$: CMPB (R1)+,(R2)+ ; COMPARE BYTE BY BYTE ;00250 BNE 2$ ;00260 SOB R3,1$ ;00270 DEC R0 ; SET RETURN TRUE ;00280 2$: RTS PC ;00290 ;00300 ; *** LOGICAL FUNCTION STRLT(A,B) ;00310 ;00320 STRLT:: CLR R0 ; SET RETURN VALUE FALSE ;00330 MOV 2(R5),R1 ;00340 MOV 4(R5),R2 ;00350 MOV (R1)+,R3 ; SET LENGTH TO MIN OF THE TWO STRINGS ;00360 CMP R3,(R2)+ ;00370 BLE 1$ ;00380 MOV -2(R2),R3 ;00390 1$: CMPB (R1)+,(R2)+ ; COMPARE BYTE BY BYTE ;00400 BLT 2$ ;00410 BGT 3$ ;00420 SOB R3,1$ ;00430 CMP @2(R5),@4(R5) ; IF EQUAL UP TO MIN LENGTH - ;00440 BGE 3$ ; TRUE IF A SHORTER ;00450 2$: DEC R0 ; SET RETURN VALUE TRUE ;00460 3$: RTS PC ;00470 ;00480 ; *** SUBROUTINE GETCH(WORD,POS,VALUE) ;00490 ;00500 GETCH:: MOV 2(R5),R0 ; MOVE ADDR OF WORD TO R0 ;00510 ADD @4(R5),R0 ; ADD POSITION-1 ;00520 DEC R0 ;00530 CLR @6(R5) ; CLEAR DESTINATION ;00540 MOVB (R0),@6(R5) ; MOV BYTE TO PARM 3 ;00550 RTS PC ;00560 ;00570 ; *** SUBROUTINE PUTCH(WORD,POS,VALUE) ;00580 ;00590 PUTCH:: MOV 2(R5),R0 ;00600 ADD @4(R5),R0 ;00610 DEC R0 ;00620 MOVB @6(R5),(R0) ;00630 RTS PC ;00640 ;00650 ; *** INTEGER FUNCTION CHTYP(CHAR) ;00660 ;00670 CHTYP:: MOV #1,R0 ; SET REUTRN VALUE TO 1 ;00680 MOV @2(R5),R1 ; GET CHAR TO R1 ;00690 CMP R1,#'A ; TYPE=1 IF A-Z ;00700 BLT 1$ ;00710 CMP R1,#'Z ;00720 BLE 9$ ;00730 1$: CMP R1,#141 ; TYPE=1 IF LITTLE A-Z ;00740 BLT 2$ ;00750 CMP R1,#172 ;00760 BLE 9$ ;00770 2$: INC R0 ;00780 CMP R1,#'0 ; TYPE=2 IF 0-9 ;00790 BLT 3$ ;00800 CMP R1,#'9 ;00810 BLE 9$ ;00820 3$: INC R0 ; TYPE=3 IF '-' ;00830 CMP R1,#'- ;00840 BEQ 9$ ;00850 INC R0 ;00860 CMP R1,#'( ; TYPE=4 IF '(' ;00870 BEQ 9$ ;00880 INC R0 ;00890 CMP R1,#') ; TYPE=5 IF')' ;00900 BEQ 9$ ;00910 INC R0 ; TYPE=6 IF BLANK OR TAB ;00920 CMP R1,#40 ;00930 BEQ 9$ ;00940 CMP R1,#11 ;00950 BEQ 9$ ;00960 INC R0 ; ALL ELSE TYPE=7 ;00970 9$: RTS PC ;00980 ;00990 ; *** SUBROUTINE CATSUB(A,B,BSTART,LENGTH) ;01000 ;01010 CATSUB:: MOV 2(R5),R1 ; GET ADDR OF A AND B STRINGS ;01020 MOV 4(R5),R2 ;01030 MOV @10(R5),R3 ; GET LENGTH TO MOVE ;01040 ADD (R1),R1 ; MOV R1 TO END OF STRING A ;01050 ADD #2,R1 ;01060 ADD R3,@2(R5) ; UPDATE LENGTH OF STRING A ;01070 ADD @6(R5),R2 ; MOV R2 TO START CHAR OF B ;01080 INC R2 ;01090 1$: MOVB (R2)+,(R1)+ ; MOVE DATA ;01100 SOB R3,1$ ;01110 BIT #1,R1 ; IF ODD # OF CHARS PAD A BLANK ;01120 BEQ 2$ ;01130 MOVB #40,(R1) ;01140 2$: RTS PC ;01150 ;01160 ; *** SUBROUTINE OPENF(CALLNO,DONE,SVER) ;01170 ;01180 OPENF:: MOV 6(R5),R1 ; COPY OVER SVER TO HEADING ;01190 MOV (R1)+,R3 ;01200 MOV #SVER,R2 ; PICK UP HEADING ADDRESS ;01210 1$: MOVB (R1)+,(R2)+ ; MOVE DATA ;01220 SOB R3,1$ ;01230 MOV #TB,R5 ; GET TIME AND DATE TO HEADING ;01240 JSR PC,TIME ;01250 MOV #DB,R5 ;01260 JSR PC,DATE ;01270 SOPEN: MOV #PAGE,R0 ; RESET PAGE AND LINE COUNTS AND ;01280 CLR (R0)+ ; FORT AND LIST FLAGS ;01290 CLR (R0)+ ;01300 CLR (R0)+ ;01310 CLR (R0)+ ;01320 MOVB #'1,ERNUM ; SET ERROR=1 ;01330 GCML$ #GCBUF,#PSTR,#7 ; GET COMMAND ;01340 BCS EXIT ;01350 CSI$1 #CSIBLK,G.CMLD+2+GCBUF,G.CMLD+GCBUF ;RLB001 01360 BCS TYPERR ;01370 FTOPN: MOVB #'2,ERNUM ; SET ERROR=2 ;01380 CSI$2 #CSIBLK,OUTPUT ;01390 BCS TYPERR ;01400 BITB #5,C.STAT(R0) ; IS EITHER FILNAME OR DEV SPECIFIED ;01410 BEQ FLOPN ; IF NOT NO FORT I/O ;01420 MOV (PC)+,@(PC)+ ; MOVE EXTENSION 'FTN' TO NAME BLOCK ;01430 .RAD50 /FTN/ ;01440 .WORD NAMBLK+14 ;01450 OPEN$W #FTNFDB ;01460 BCS TYPERR ;01470 INC FTNFLG ; SET FORT FLAG ON SHOWING IT IS OPEN ;01480 BITB #CS.MOR,C.STAT+CSIBLK ; MORE FOR OUTPUT ??? ;01490 BEQ FXOPN ;01500 FLOPN: MOVB #'3,ERNUM ; TRY TO PICK UP THE LISTING FILE ;01510 CSI$2 #CSIBLK,OUTPUT ;01520 BCS TYPERR ;01530 MOV (PC)+,@(PC)+ ; 'FLL' EXTENSION TO DEFAULT NAME BLOCK ;01540 .RAD50 /FLL/ ;01550 .WORD NAMBLK+14 ;01560 OPEN$W #FLLFDB ;01570 BCS TYPERR ;01580 INC FLLFLG ;01590 FXOPN: MOVB #'4,ERNUM ;01600 CSI$2 #CSIBLK,INPUT ;01610 BCS TYPERR ;01620 MOV (PC)+,@(PC)+ ; SET DEFAULT TO 'FLX' ;01630 .RAD50 /FLX/ ;01640 .WORD NAMBLK+14 ;01650 OPEN$R #FLXFDB ;01660 BCS TYPERR ;01670 RTS PC ;01680 ;01690 TYPERR: DIR$ #ERMESG ; GIVE ERROR MESSAGE TO 'CO' DEVICE ;01700 CLOSE$ #FTNFDB ; CLOSE FORT AND LIST FILES IF ;01710 CLOSE$ #FLLFDB ; THE WERE OPENED ;01720 BR SOPEN ; START OVER ;01730 ;01740 EXIT: CLOSE$ #GCBUF ; CLOSE OUT COMMAND INPUT ;01750 DIR$ #EXBLK ; AND EXIT ;01760 ;01770 ; *** SUBROUTINE GET(LINENO,STRING,ENDFIL) ;01780 ;01790 GET:: INC @2(R5) ; INCREMENT LINE NUMBER ;01800 CLR @4(R5) ; SET LINE LEN=0 ;01-I 01805 MOV #-1,@6(R5) ; SET ENDFIL=TRUE ;01810 1$: GET$ #FLXFDB ;01820 BCS 9$ ;01830 ; MOV 24(R0),R3 ; GET STRING LENGTH ;01-D 01840 ; BLE 1$ ; IF NULL LINE IGNORE ;01-D 01850 ; MOV 4(R5),R1 ; PICK UP DESTINATION ADDRESS ;01-D 01860 ; TST (R1)+ ;01-D 01870 MOV 4(R5),R1 ; INIT STRING POINTER AND LEN ;01-I 01871 TST (R1)+ ; ADVANCE TO DATA PART OF STRING ;01-I 01872 MOV R1,@4(R5) ;01-I 01873 MOV 24(R0),R3 ; GET STRING LENGTH ;01-I 01874 BLE 7$ ; IF NULL LINE IGNORE ;01-I 01875 MOV #FLXBUF,R0 ;01880 CMP R3,#72. ; TRIM COLUMNS 73 AND BEYOND ;01890 BLE 2$ ;01900 MOV #72.,R3 ;01910 2$: MOVB (R0)+,R2 ;01920 CMP #11,R2 ; TAB ??? ;01930 BNE 5$ ;01940 MOV #40,R2 ; CHANGE TO BLANK ;01950 MOV #6,R4 ;01960 CMPB (R0),#'( ; IF ( FOLLOWS TAB GO TO COL 7 ;02-I 02502 BEQ 10$ ;02-I 02504 CMPB (R0),#'A ; IF CHAR FOLLOWING TAB IS A-Z ;01970 BLT 3$ ; GO TO COL 7 ELSE COL 6 ;01980 CMPB (R0),#'Z ;01990 BGT 3$ ;02000 ; INC R4 ;02-D 02010 10$: INC R4 ;02-I 02011 3$: ADD 4(R5),R4 ; ADD BASE ;02020 SUB R1,R4 ; SUB CURRENT POSITION ;02030 BLE 5$ ; IF BEYOND COL 7 REPLACE TAB WITH BLANK;02040 4$: MOVB R2,(R1)+ ;02050 SOB R4,4$ ;02060 ;02070 5$: MOVB R2,(R1)+ ; MOVE CHAR ;02080 CMP R2,#40 ; BLANK ??? ;02090 BEQ 6$ ;02100 MOV R1,@4(R5) ; NO, UPDATE LEN TO LAST NON-BLANK ;02110 6$: SOB R3,2$ ;02120 ;02130 BIT #1,R1 ; PAD BLANK IF ODD # OF CHARS ;02140 BEQ 7$ ;02150 MOVB #40,(R1) ;02160 7$: SUB 4(R5),@4(R5) ; ADJUST LENGTH TO ACTUAL # OF CHARS ;02170 SUB #2,@4(R5) ;02180 CLR @6(R5) ;02190 9$: RTS PC ;02200 ;02210 ; *** SUBROUTINE PUT(LINENO,STRING,IOCLAS) ;02220 ;02230 PUT:: MOV @2(R5),LINNUM ; PICK UP LINE NUMBER AND STRING ADDR ;02240 MOV 4(R5),STRADR ;02250 CMP #1,@6(R5) ; CHECK IOCLAS - IF 1 GO TO FORT ;02260 BEQ 7$ ;02270 TST FLLFLG ; CHECK LISTING OPEN - IF NOT IGNORE ;02280 BEQ 6$ ;02290 TST LINCNT ; START NEW PAGE ??? ;02300 BNE 3$ ;02310 INC PAGE ; YES - INC PAGE # AND PUT IN HEADING ;02320 MOV #HB,R5 ;02330 JSR PC,PUTNUM ;02340 PUT$ #FLLFDB,#HLINE,#TB-HLINE ;02350 MOV #-56.,LINCNT ;02360 3$: MOV #FLLBUF,R1 ; BLANK FRONT OF LINE ;02370 MOV #4,R2 ;02380 MOV #" ,(R1)+ ;02390 SOB R2,.-4 ;02400 TST LINNUM ;02410 BEQ 5$ ; IF LINENO = 0 LEAVE BLANK ;02420 BGT 4$ ; IF GT 0 USE IT ;02430 NEG LINNUM ; LESS USE IT WITH '*' IN FRONT ;02440 MOVB #'*,FLLBUF+1 ;02450 4$: MOV #JB,R5 ; GO PUT LINE NUMBER FRONT OF LINE ;02460 JSR PC,PUTNUM ;02470 5$: MOV STRADR,R1 ; COPY STRING OVER ;02480 MOV (R1)+,R3 ;02490 MOV R3,R4 ;02500 ADD #12,R4 ;02510 MOV #FLLBUF+12,R2 ;02520 MOVB (R1)+,(R2)+ ; MOVE STRING TO OUTPUT BUFFER ;02530 SOB R3,.-2 ;02540 PUT$ #FLLFDB,#FLLBUF,R4 ;02550 INC LINCNT ;02560 6$: RTS PC ;02570 ;02580 7$: TST FTNFLG ; FORT I/O ACTIVE??? ;02590 BEQ 6$ ; NO - RETURN ;02600 MOV STRADR,R1 ;02610 MOV (R1)+,R3 ; GET LENGTH OF STRING TO R3 ;02620 MOV R3,R4 ;02630 MOV #FTNBUF,R2 ;02640 MOVB (R1)+,(R2)+ ; COPY DATA OVER ;02650 SOB R3,.-2 ;02660 MOV #78.,R3 ;02670 SUB R4,R3 ; FIND OUT HOW MANY BLANKS TO PAD ;02680 BLE 8$ ;02690 MOVB #40,(R2)+ ; MOVE THEM ;02700 SOB R3,.-4 ;02710 8$: MOV #KB,R5 ; MOVE LINE NUMBER TO COL 75-79 ;02720 JSR PC,PUTNUM ;02730 PUT$ #FTNFDB ;02740 RTS PC ;02750 ;02760 ; *** SUBROUTINE CLOSEF(WARN,ERROR) ;02770 ;02780 CLOSEF:: MOV @2(R5),R0 ;02790 MOV @4(R5),R1 ;02800 MOV R0,NERRS ; SAVE # ERRORS AND WARNINGS ;02810 MOV R1,NWRN ;02820 ADD R1,R0 ; IF NO ERRORS OR WARNINGS - SKIP IT ;02830 BEQ 3$ ;02840 MOV #LB,R5 ; USE PUTNUM ON EACH ;02850 JSR PC,PUTNUM ;02860 MOV #MB,R5 ;02870 JSR PC,PUTNUM ;02880 TST FLLFLG ; LISTING OPEN ??? ;02890 BEQ 2$ ;02900 TST R0 ;02910 BEQ 1$ ;02920 PUT$ #FLLFDB,#NER,#NERL-NER ;02930 1$: ADD #2,G.CMLD+GCBUF ; PUT THE COMMAND LINE TO LISTING ;02940 PUT$ #FLLFDB,#CMDOUT,G.CMLD+GCBUF ;02950 BR 3$ ;02960 2$: TST R0 ;02970 BEQ 3$ ;02980 DIR$ #QIOE ; IF NOT - QIO IT TO 'CO' ;02990 ;03000 3$: CLOSE$ #FTNFDB ;03010 CLOSE$ #FLLFDB ;03020 CLOSE$ #FLXFDB ;03030 RTS PC ;03040 ;03050 ; *** DATA *** ;03060 ;03070 PAGE: .WORD 0 ;03080 LINCNT: .WORD 0 ;03090 FTNFLG: .WORD 0 ;03100 FLLFLG: .WORD 0 ;03110 ERBUF: .ASCII /ERROR / ;03120 ERNUM: .ASCII / - COMMAND IGNORED/ ;03130 PSTR: .ASCII <15><12> ;03140 .ASCII /FLEX>/ ;03150 .EVEN ;03160 GCBUF: GCMLB$ 2,,CMDBUF ;03170 CMDOUT: .ASCII <15><12> ;03180 CMDBUF: .BLKB 82. ;03190 EXBLK: EXIT$ ;03200 ERMESG: QIOW$ IO.WLB,2,1,,,, ;03210 CSI$ ;03220 CSIBLK: .BLKB C.SIZE ;03230 NAMBLK: NMBLK$ RSXFLEX,FLX,,SY,0 ;03240 FTNFDB: FDBDF$ ;03250 FDAT$A R.VAR,FD.CR ;03260 FDRC$A 0,FTNBUF,80. ;03270 FDOP$A 3,CSIBLK+C.DSDS,NAMBLK ;03280 ;03290 FLLFDB: FDBDF$ ;03300 FDAT$A R.VAR,FD.CR ;03310 FDRC$A 0,FLLBUF,132. ;03320 FDOP$A 4,CSIBLK+C.DSDS,NAMBLK ;03330 ;03340 FLXFDB: FDBDF$ ;03350 FDRC$A 0,FLXBUF,80. ;03360 FDOP$A 5,CSIBLK+C.DSDS,NAMBLK ;03370 ;03380 FTNBUF: .BLKB 80. ;03390 FLLBUF: .ASCII / / ;03400 .BLKB 122. ;03410 FLXBUF: .BLKB 80. ;03420 ;03430 NERRS: .WORD 0 ;03440 NWRN: .WORD 0 ;03450 LB: .WORD 2,NER+2,NERRS ;03460 MB: .WORD 2,NWR-2,NWRN ;03470 NER: .ASCII <15><12><40><40> ;03480 TNER: .ASCII / ERRORS, / ;03490 NWR: .ASCII / WARNINGS/ ;03500 NERL: ;03510 .EVEN ;03520 QIOE: QIOW$ IO.WLB,2,1,,,, ;03530 HLINE: .ASCII <15><14> ;03540 SVER: .ASCII / / ;03550 DSPOT: .ASCII / / ;03560 TSPOT: .ASCII / / ;03570 .ASCII /PAGE/ ;03580 PSPOT: .ASCII / / ;03590 .ASCII <15><12> ;03600 TB: .WORD 1,TSPOT ;03610 DB: .WORD 1,DSPOT ;03620 HB: .WORD 2,PSPOT,PAGE ;03630 KB: .WORD 2,FTNBUF+72.,LINNUM ;03640 JB: .WORD 2,FLLBUF,LINNUM ;03650 LINNUM: .WORD 0 ;03660 STRADR: .WORD 0 ;03670 .END ;03680 .END ;03680