; FILE: RSX.MAC .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 ; (3) PUTTING OUTPUT LINE NUMBERS ON LISTING ;DD ; (4) MAKING CHANGES FOR RSX-11M SUBSET OF RSX-11D ;GH ; DIRECTIVES ;GH ; (5) FIX COMMAND LINE ECHO AND ERROR LISTING FROM ;GH ; DWIGGINS. ; (6) MATCH LINE NUMBERS TO FOR OR F4P...CONDITIONAL ASSY;GH ; F4P #'S ARE DEFAULT; TO GET FOR #'S, DEFINE FOR=1;GH ; REQUIRES /PA:1 ASSEMBLY OR INSERTION OF CODE-----;GH FOR=1 ;00120 .MCALL GCML$,CSI$,CSI$1,CSI$2,GCMLB$,OPEN$W,OPEN$R,DIR$,CLOSE$ .MCALL EXIT$S,QIO$,WTSE$,NMBLK$FDBDF$,FDAT$A,FDRC$A,FDOP$A ;;GH .MCALL GET$,PUT$,PRINT$,GLUN$,NBOF$L ;GH ;DD .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 MOV #1,FLNUM ;RESET OUTPUT LINE NUMBER ;DD MOVB #'1,ERNUM ; SET ERROR=1 ;01330 GCML$ #GCBUF,#PSTR,#7 ; GET COMMAND ;01340 BCS EXIT ; CONTROL-Z....EXIT CSI$1 #CSIBLK,G.CMLD+2+GCBUF,G.CMLD+GCBUF ;DD 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+N.FTYP ;GH 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+N.FTYP ;GH 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+N.FTYP ;GH OPEN$R #FLXFDB ;01660 BCS TYPERR ;01670 RTS PC ;01680 ;01690 TYPERR: DIR$ #ERMESG ; GIVE ERROR MESSAGE TO 'CO' DEVICE ;01700 DIR$ #WAITSE ;RSX-11M HAS NO QIOW$ ;GH 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 EXIT$S ;& EXIT;RSX-11M FORM AND BETTER ;GH ;01770 ; *** SUBROUTINE GET(LINENO,STRING,ENDFIL) ;01780 ; MODIFIED TO HANDLE CONCATENATED FILES ; LINENO=-1 ON ENTRY MEANS RESET LINE NUMBER SEQUENCE ;01790 GET:: MOV @2(R5),R1 ;CHECK FOR INPUT NUMBER = -1 CMP R1,#-1 ;RESET NUMBERING SEQUENCE IF = -1 BNE 11$ ;FOR CONCATENATED FILES WITHOUT EOF'S MOV #1,FLNUM ;START WITH LINE #1 RTS PC ;AND THAT'S ALL ; 11$: MOV FLNUM,@2(R5) ; INCREMENT LINE NUMBER ;DD 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 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 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,#HLINLN ;DD MOV #-LINPPG,LINCNT ;DD 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 #10,R4 ;GH MOV #FLLBUF+10,R2 ;GH 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 10$ ; NO - RETURN ;DD 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 10$: MOV STRADR,R1 CMPB 2(R1),#'C ;IF NOT A COMMENT BEQ 9$ CMPB 7(R1),#' ;OR A CONTINUATION BNE 9$ INC FLNUM ;INCREMENT OUTPUT LINE NO. .IF DF FOR CMP 8.(R1),#"IF ;FOR INCREMENTS 'IF' LINE #'S TWICE BNE 9$ ;SO WE SEARCH FOR 'IF(' OR 'IF...(' ADD #10.,R1 ;START LOOKING FOR '(' MOV #64.,R4 ;ONLY 64 CHARACTERS LEFT IN LINE 11$: CMPB (R1),#'( ;TAKE '(' OR ' ' BEQ 12$ CMPB (R1)+,#' BNE 9$ SOB R4,11$ 12$: INC FLNUM ;BUMP FOR EXTRA LINE .ENDC 9$: RTS PC ;DD ;02750 ;02760 ; *** SUBROUTINE CLOSEF(WARN,ERROR) ;02770 ;02780 CLOSEF:: MOV @2(R5),R0 ;02790 MOV @4(R5),R1 ;02800 MOV R0,NWRN ; SAVE # ERRORS AND WARNINGS ;02810 MOV R1,NERRS ;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 ;SEND OUT SUMMARY TO TERMINAL ANYWAY BEQ 2$ ;02920 PUT$ #FLLFDB,#NER,#NERL-NER ;02930 2$: DIR$ #QIOE ; IF NOT - QIO IT TO LUN 2 DIR$ #WAITSE ;RSX-11M HAS NO QIOW$ ;GH ;03000 3$: CLOSE$ #FTNFDB ;03010 TST FLLFLG ;LISTING ON? BEQ 4$ PUT$ #FLLFDB,#NER,#2 ;SEND OUT CRLF PUT$ #FLLFDB,G.CMLD+2+GCBUF,G.CMLD+GCBUF ;DD DIR$ #GETLUN BIT #10,FLLBUF+4 ;YES, FILE ON DISK? BEQ 5$ PRINT$ #FLLFDB ;YES, SPOOL IT 5$: CLOSE$ #FLLFDB ;DD 4$: CLOSE$ #FLXFDB ;DD RTS PC ;03040 ;03050 .PSECT FLERSX,D,GBL,OVR ; *** DATA *** ;03060 ;03070 NBOF$L 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 WAITSE: WTSE$ 1 ;RSX11M HAS NO QIOW$ ;GH ERMESG: QIO$ IO.WLB,2,1,,,, ;GH 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 GETLUN: GLUN$ 4,FLLBUF ;DD 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: QIO$ IO.WLB,2,1,,,, ;GH HLINE: .ASCII <14> ;DD SVER: .ASCII / / ;03550 DSPOT: .ASCII / / ;03560 TSPOT: .ASCII / / ;03570 .ASCII /PAGE/ ;03580 PSPOT =.-1 ;DD .ASCII / / ;DD ;03590 .ASCII <15><12> ;03600 HLINLN =.-HLINE ;DD .EVEN ;DD 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 FLNUM: .WORD 0 ;DD STRADR: .WORD 0 ;03670 .END ;03680 .END ;03680