.NLIST BEX,TTM ;00010 ; .TITLE DOSMAC ;01-D 00020 .TITLE DOSMAC ;01-I 00021 ;00030 ; MACRO SUPPORT SUBROUTINES FOR THE U OF O FLEX TRANSLATOR - FOR THE ;00040 ; THE PDP 11 SINGLE USER DISK OPERATING SYSTEM (DOS/BATCH) ;00050 ;00060 ; PROGRAMMER: CHRIS MEYERS ;00070 ;00080 ; LOCATION: EUGENE REGISTER GUARD - EUGENE OREGON ;00090 ;00100 ; DATE: OCT 25 1974 ;00110 ;00120 ; NOTE * THE FOLLOWING ROUTINES ARE NOT IN THIS SET BUT ARE IN FORTRAN ;00130 ; CATNUM, PUTNUM, CATSTR, CPYSTR, CPYSUB, HASH, NEWNO ;00140 ; ;01-I 00141 ; EDIT HISTORY ;01-I 00142 ; (1) PROPER HANDLING OF BLANK LINES ;01-I 00143 ; (2) FIX MULTIPLE TRANSLATIONS IN BATCH ;02-I 00144 ; (3) PREVENT CARRYOVER OF OUTPUT SPECIFICATIONS ;03-I 00145 ; (4) CORRECT TREATMENT OF TAB FOLLOWED BY LEFT PAREN ;04-I 00146 ;00150 R0=%0 ;00160 R1=%1 ;00170 R2=%2 ;00180 R3=%3 ;00190 R4=%4 ;00200 R5=%5 ;00210 SP=%6 ;00220 PC=%7 ;00230 .MCALL .INIT,.OPEN,.READ,.WRITE,.CLOSE,.RLSE,.CSI1,.CSI2 ;00240 .MCALL .DELET,.WAIT,.EXIT ;00250 .GLOBL STREQ,STRLT,GETCH,PUTCH,CHTYP,CATSUB,OPENF,GET,PUT ;00260 .GLOBL CLOSEF,TIME,DATE,PUTNUM ;00270 ;00280 ; *** LOGICAL FUNCTION STREQ(A,B) ;00290 ;00300 STREQ: CLR R0 ; SET RETURN VALUE FALSE ;00310 MOV 2(R5),R1 ; R1 POINTS TO STR A ;00320 MOV 4(R5),R2 ; R2 TO B ;00330 MOV (R1),R3 ; GET LENGTH ;00340 CMP (R1)+,(R2)+ ; CHECK LENGTHS MATCH ;00350 BNE 2$ ;00360 1$: CMPB (R1)+,(R2)+ ; COMPARE CHARS ;00370 BNE 2$ ;00380 SOB R3,1$ ;00390 DEC R0 ; SET RETURN TRUE ;00400 2$: RTS R5 ;00410 ;00420 ; *** LOGICAL FUNCTION STRLT(A,B) ;00430 ;00440 STRLT: CLR R0 ; SET RETURN VALUE FALSE ;00450 MOV 2(R5),R1 ;00460 MOV 4(R5),R2 ;00470 MOV (R1)+,R3 ; SET LENGTH TO THE MIN OF THE 2 STRINGS;00480 CMP R3,(R2)+ ;00490 BLE 1$ ;00500 MOV -2(R2),R3 ;00510 1$: CMPB (R1)+,(R2)+ ; COMPARE DATA ... ;00520 BLT 2$ ;00530 BGT 3$ ;00540 SOB R3,1$ ;00550 CMP @2(R5),@4(R5) ; IF EQUAL TRUE IF A SHORTER ;00560 BGE 3$ ;00570 2$: DEC R0 ; SET TRUE ;00580 3$: RTS R5 ;00590 ;00600 ; *** SUBROUTINE GETCH(WORD,POS,VALUE) ;00610 ;00620 GETCH: MOV 2(R5),R0 ; CALCULATE ADDR OF BYTE TO GET INTO R0 ;00630 ADD @4(R5),R0 ;00640 DEC R0 ;00650 CLR @6(R5) ;00660 MOVB (R0),@6(R5) ; MOVE BYTE TO PARM THREE ;00670 RTS R5 ;00680 ;00690 ; *** SUBROUTINE PUTCH(WORD,POS,VALUE) ;00700 ;00710 PUTCH: MOV 2(R5),R0 ;00720 ADD @4(R5),R0 ;00730 DEC R0 ; R0 NOW POINTS TO BYTE IN QUESTION ;00740 MOVB @6(R5),(R0) ;00750 RTS R5 ;00760 ;00770 ; *** INTEGER FUNCTION CHTYP(CHAR) ;00780 ;00790 CHTYP: MOV #1,R0 ;00800 MOV @2(R5),R1 ; GET CHAR TO R1 ;00810 CMP R1,#'A ; TYPE IS ONE IF A-Z ;00820 BLT 1$ ;00830 CMP R1,#'Z ;00840 BLE 9$ ;00850 1$: INC R0 ;00860 CMP R1,#'0 ; TYPE IS TWO IF 0-9 ;00870 BLT 3$ ;00880 CMP R1,#'9 ;00890 BLE 9$ ;00900 3$: INC R0 ;00910 CMP R1,#'- ; TYPE IS THREE IF '-' ;00920 BEQ 9$ ;00930 INC R0 ;00940 CMP R1,#'( ; TYPE IS FOUR IF '(' ;00950 BEQ 9$ ;00960 INC R0 ;00970 CMP R1,#') ; TYPE IS FIVE IF ')' ;00980 BEQ 9$ ;00990 INC R0 ;01000 CMP R1,#40 ; TYPE IS SIX IF BLANK ;01010 BEQ 9$ ;01020 INC R0 ; ALL ELSE IS SEVEN ;01030 9$: RTS R5 ;01040 ;01050 ; *** SUBROUTINE CATSUB(A,B,BSTART,LENGTH) ;01060 ;01070 CATSUB: MOV 2(R5),R1 ; GET ADDR OF A AND B STRINGS ;01080 MOV 4(R5),R2 ;01090 MOV @10(R5),R3 ; GET LENGTH TO MOVE ;01100 ADD (R1),R1 ; MOV R1 TO END OF STRING A ;01110 ADD #2,R1 ;01120 ADD R3,@2(R5) ; UPDATE LENGTH OF STRING A ;01130 ADD @6(R5),R2 ; MOV R2 TO START CHAR OF B ;01140 INC R2 ;01150 1$: MOVB (R2)+,(R1)+ ;01160 SOB R3,1$ ;01170 BIT #1,R1 ; IF ODD # OF CHARS PAD A BLANK ;01180 BEQ 2$ ;01190 MOVB #40,(R1) ;01200 2$: RTS R5 ;01210 ;01220 EXIT: .RLSE #KBILNK ;01230 .RLSE #KBOLNK ;01240 .EXIT ;01250 ;01260 ; *** SUBROUTINE OPENF(CALLNO,DONE,SVER) ;01270 ;01280 ;OPENF: CMP #1,@2(R5) ; FIRST TIME THRU ??? ;02-D 01290 ; BGT 2$ ;02-D 01300 ; .INIT #KBILNK ; YES - INIT KB: AND COPY SVER ;02-D 01310 OPENF: .INIT #KBILNK ; INIT COMMAND INPUT AND OUTPUT ;02-I 01315 .INIT #KBOLNK ;01320 MOV 6(R5),R1 ;01330 MOV (R1)+,R3 ;01340 MOV #SVER,R2 ; PICK UP ADDR IN HEADING ;01350 1$: MOVB (R1)+,(R2)+ ;01360 SOB R3,1$ ;01370 2$: JSR R5,TIME ; GET TIME AND DATE TO HEADING ;01380 .WORD 401,STIM ;01390 JSR R5,DATE ;01400 .WORD 401,SDAT ;01410 SOPEN: MOV #PAGE,R0 ; RESET PAGE, LINE COUNT, IOFLAG ;01420 CLR (R0)+ ;01430 CLR (R0)+ ;01440 CLR (R0)+ ;01450 CLR FTNLNK+6 ; RESET LINK BLOCKS TO EMPTY ;03-I 01453 CLR FLLLNK+6 ; (JUST THE 2 OUTPUT DATA SETS) ;03-I 01455 MOV #233,R0 ; SET PROTECTIONS TO <233> ;01460 MOV R0,FTNFIL+10 ;01470 MOV R0,FLLFIL+10 ;01480 MOV R0,FLXFIL+10 ;01490 MOVB #'1,ERNUM ; SET ERROR=1 ;01500 .WRITE #KBOLNK,#PROMPT ;01510 .WAIT #KBOLNK ;01520 .READ #KBILNK,#INBUF ;01530 .WAIT #KBILNK ;01540 TST INBUF+2 ; TEST END OF INPUT (BATCH) ;01550 BNE EXIT ;01560 ;01570 .CSI1 #CMDBUF ; PARSE COMMAND STRING ;01580 TST (SP)+ ; BUMP AND CHECK CODE ;01590 BEQ .+6 ;01600 JMP TYPERR ;01610 MOV #2,CMDBUF ; SET UP TO PICK THE OUTPUT FILES ;01620 MOVB #'2,ERNUM ; SET ERROR=2 ;01630 .CSI2 #CSIFTN ; FORT ;01640 BIT #1,(SP)+ ; MORE ??? ;01650 BNE 3$ ;01660 .CSI2 #CSIFLL ; PICK UP LISTING FILE ;01670 BIT #1,(SP)+ ; BUMP AND CHECK MORE ;01680 BEQ TYPERR ; IF YES NO GOOD ;01690 3$: CLR CMDBUF ; SET UP TO GET INPUT FILE(S) ;01700 .CSI2 #CSIFLX ; FLEX INPUT ;01710 MOVB #'3,ERNUM ;01720 BIT #1,(SP)+ ; MAKE SURE ONLY ONE INPUT ;01730 BEQ TYPERR ;01740 TST FTNFIL+4 ; BLANK FORT EXT ?? ;01750 BNE 4$ ;01760 MOV #10414.,FTNFIL+4 ; IF YES MAKE IT 'FTN' ;01770 4$: TST FLLFIL+4 ; SAME FOR LIST MAKE IT 'FLL' ;01780 BNE FTNOPN ;01790 MOV #10092.,FLLFIL+4 ;01800 ;01810 FTNOPN: TST FTNLNK+6 ; IF ZERO NO FILE SPEC GIVEN ;01820 BEQ FLLOPN ;01830 MOVB #'4,ERNUM ;01840 .INIT #FTNLNK ;01850 BIS #1,IOFLAG ;01860 MOV #FTOK,FTNFIL-4 ; DELETE OLD FILE IF THERE BUT IF NOT ;01870 .DELET #FTNLNK,#FTNFIL ; COME BACK FOR THE OPEN ;01880 FTOK: MOV #TYPERR,FTNFIL-4 ;01890 .OPEN #FTNLNK,#FTNFIL ;01900 BIS #2,IOFLAG ;01910 ;01920 FLLOPN: TST FLLLNK+6 ; SAME FOR LISTING FILE ;01930 BEQ FLXOPN ;01940 MOVB #'5,ERNUM ;01950 .INIT #FLLLNK ;01960 BIS #4,IOFLAG ;01970 MOV #FLOK,FLLFIL-4 ; SAME FOR LISTING FILE ;01980 .DELET #FLLLNK,#FLLFIL ;01990 FLOK: MOV #TYPERR,FLLFIL-4 ;02000 .OPEN #FLLLNK,#FLLFIL ;02010 BIS #10,IOFLAG ;02020 MOVB #15,HLINE+7 ; SQUELCH FORM FEED ON FIRST PAGE ;02030 ;02040 FLXOPN: .INIT #FLXLNK ;02050 BIS #20,IOFLAG ;02060 RETRY: .OPEN #FLXLNK,#FLXFIL ;02070 BIS #40,IOFLAG ;02080 FLXB: MOVB #'6,ERNUM ;02090 TSTB FLXFIL-1 ;02100 BEQ 2$ ;02110 CMPB FLXFIL-1,#2 ; IF FAILED BECAUSE BLANK EXTENSION AND ;02120 BNE TYPERR ; NO SUCH FILE TRY EXTENSION 'FLX' ;02130 TST FLXFIL+4 ;02140 BNE TYPERR ;02150 MOV #10104.,FLXFIL+4 ;02160 BR RETRY ;02170 ;02180 2$: .READ #FLXLNK,#INBUF ; START THE READING OF THE FIRST LINE ;02190 RTS R5 ;02200 ;02210 TYPERR: .WRITE #KBOLNK,#ERROR ; GIVE ERROR MESSAGE TO KB: ;02220 .WAIT #KBOLNK ;02230 JSR PC,IODOWN ;02240 JMP SOPEN ;02250 ;02260 ; *** SUBROUTINE GET(LINENO,STRING,ENDFIL) ;02270 ;02280 GET: INC @2(R5) ; INC LINE NUMBER ;02290 MOV #-1,@6(R5) ; SET ENDFIL=TRUE ;02300 1$: .WAIT #FLXLNK ;02310 CMP INBUF+2,#100 ; EOF ??? ;02320 BGE 9$ ;02330 MOV INBUF+4,R3 ; PICK UP LENGTH ;02340 SUB #2,R3 ; CLIP CR/LF ;02350 BGT 11$ ;02360 ; .READ #FLXLNK,#INBUF ; IF NULL LINE READ THE NEXT ;01-D 02370 ; BR 1$ ;01-D 02380 CLR @4(R5) ; IF NULL LINE RETURN 0 LEN ;01-I 02382 BR 8$ ;01-I 02384 11$: MOV 4(R5),R1 ; PICK UP DEST ADDRESS ;02390 TST (R1)+ ;02400 MOV R1,@4(R5) ; SET STRING LEN TO ZERO (REL TO BASE) ;02410 MOV #INBUF+6,R0 ;02420 CMP R3,#72. ; TRIM COLUMNS 73 AND BEYOND ;02430 BLE 2$ ;02440 MOV #72.,R3 ;02450 2$: MOVB (R0)+,R2 ; TAB ?? ;02460 CMP #11,R2 ;02470 BNE 5$ ;02480 MOV #40,R2 ; CHANGE TO BLANK ;02490 MOV #6,R4 ;02500 CMPB (R0),#'( ; IF ( FOLLOWS TAB GO TO COL 7 ;04-I 02502 BEQ 10$ ;04-I 02504 CMPB (R0),#'A ; IF CHAR FOLLOWING TAB IS A-Z GO TO ;02510 BLT 3$ ; COL 7 ELSE COL 6 ;02520 CMPB (R0),#'Z ;02530 BGT 3$ ;02540 ; INC R4 ;04-D 02550 10$: INC R4 ;04-I 02551 3$: ADD 4(R5),R4 ; SUB CURRENT POSITION ;02560 SUB R1,R4 ; SUB CURRENT POSITION ;02570 BLE 5$ ; IF BEYOND 7 REPLACE TAB WITH BLANK ;02580 4$: MOVB R2,(R1)+ ;02590 SOB R4,4$ ;02600 5$: MOVB R2,(R1)+ ; MOVE CHAR ;02610 CMP R2,#40 ; BLANK ;02620 BEQ 6$ ;02630 MOV R1,@4(R5) ; NO UPDATE STRING LEN WITH ;02640 6$: SOB R3,2$ ; LAST NON BLANK ;02650 ;02660 BIT #1,R1 ; PAD BLANK IF ODD NUMBER OF CHARS ;02670 BEQ 7$ ;02680 MOVB #40,(R1) ;02690 7$: SUB 4(R5),@4(R5) ; ADJUST STRING LEN TO ACTUAL ;02700 SUB #2,@4(R5) ;02710 ;8$: .READ #FLXLNK,#INBUF ; START NEXT READ ;01-D 02720 8$: .READ #FLXLNK,#INBUF ; START NEXT READ ;01-I 02725 CLR @6(R5) ; SET ENDFIL=FALSE ;02730 9$: RTS R5 ;02740 ;02750 ; *** SUBROUTINE PUT(LINENO,STRING,IOCLAS) ;02760 ;02770 PUT: MOV @2(R5),LINNUM ; PICK UP LINE NUMBER AND STRING ADDR ;02780 MOV 4(R5),STRADR ;02790 CMP #1,@6(R5) ; CHECK IOCLAS - IF 1 GO TO FORT I/O ;02800 BEQ 7$ ;02810 BIT #10,IOFLAG ;02820 BEQ 6$ ;02830 TST LINCNT ; START NEW PAGE ??? ;02840 BNE 3$ ;02850 INC PAGE ; YES - INC PAGE # AND PUT IN HEADING ;02860 JSR R5,PUTNUM ;02870 .WORD 402,PNUM,PAGE ;02880 .WAIT #FLLLNK ;02890 .WRITE #FLLLNK,#HLINE ;02900 MOV #-56.,LINCNT ;02910 3$: .WAIT #FLLLNK ;02920 MOVB #14,HLINE+7 ; RESTORE FORM FEED FOR SUBSEQUENT PAGES;02930 MOV #FLLBUF+06,R1 ; BLANK FRONT OF LINE ;02940 MOV #4,R2 ;02950 MOV #" ,(R1)+ ;02960 SOB R2,.-4 ;02970 TST LINNUM ;02980 BEQ 5$ ; IF LINE NUMBER IS ZERO LEAVE BLANK ;02990 BGT 4$ ;03000 NEG LINNUM ; IF LT 0 PUT '*' IN FRONT ;03010 MOVB #'*,FLLBUF+7 ;03020 4$: JSR R5,PUTNUM ;03030 .WORD 402,FLLBUF+06,LINNUM ;03040 5$: MOV STRADR,R1 ; COPY STRING OVER ;03050 MOV (R1)+,R3 ;03060 MOV #FLLBUF+16,R2 ;03070 MOVB (R1)+,(R2)+ ; MOVE STRING TO OUTPUT BUFFER ;03080 SOB R3,.-2 ;03090 MOVB #15,(R2)+ ;03100 MOVB #12,(R2)+ ;03110 SUB #FLLBUF+6,R2 ;03120 MOV R2,FLLBUF+4 ;03130 .WRITE #FLLLNK,#FLLBUF ;03140 INC LINCNT ;03150 6$: RTS R5 ;03160 ;03170 7$: BIT #02,IOFLAG ; FORT I/O ACTIVE??? ;03180 BEQ 6$ ; NO RETURN ;03190 .WAIT #FTNLNK ;03200 MOV STRADR,R1 ;03210 MOV (R1)+,R3 ;03220 MOV R3,R4 ; SAVE LENGTH OF STRING IN R4 ;03230 MOV #FTNBUF+06,R2 ;03240 MOVB (R1)+,(R2)+ ; COPY DATA ;03250 SOB R3,.-2 ;03260 MOV #78.,R3 ;03270 SUB R4,R3 ; FIND OUT HOW MANY BLANKS TO PAD ;03280 BLE 8$ ;03290 MOVB #40,(R2)+ ;03300 SOB R3,.-4 ;03310 8$: JSR R5,PUTNUM ;03320 .WORD 402,FTNBUF+78.,LINNUM ;03330 .WRITE #FTNLNK,#FTNBUF ;03340 RTS R5 ;03350 ;03360 ; *** SUBROUTINE CLOSEF(WARN,ERROR) ;03370 ;03380 CLOSEF: MOV @2(R5),R0 ;03390 MOV @4(R5),R1 ;03400 MOV R0,NERRS ; SAVE # ERRORS AND WARNINGS ;03410 MOV R1,NWRN ;03420 ADD R1,R0 ; IF SUM OF THE TWO IS ZERO SKIP IT ;03430 BEQ 3$ ;03440 JSR R5,PUTNUM ;03450 .WORD 402,NER+2,NERRS ;03460 JSR R5,PUTNUM ;03470 .WORD 402,NWR-2,NWRN ;03480 BIT #10,IOFLAG ;03490 BEQ 2$ ;03500 .WAIT #FLLLNK ;03510 .WRITE #FLLLNK,#NERBUF ;03520 BR 3$ ;03530 2$: .WRITE #KBOLNK,#NERBUF ;03540 .WAIT #KBOLNK ;03550 3$: JSR PC,IODOWN ;03560 .RLSE #KBILNK ; RELEASE COMMAND INPUT AND OUTPUT ;02-I 03562 .RLSE #KBOLNK ;02-I 03564 RTS R5 ;03570 ;03580 IODOWN: MOV IOFLAG,R4 ;03590 BIT #2,R4 ;03600 BEQ 1$ ;03610 .CLOSE #FTNLNK ;03620 1$: BIT #10,R4 ;03630 BEQ 2$ ;03640 .CLOSE #FLLLNK ;03650 2$: BIT #40,R4 ;03660 BEQ 3$ ;03670 .CLOSE #FLXLNK ;03680 3$: BIT #1,R4 ;03690 BEQ 4$ ;03700 .RLSE #FTNLNK ;03710 4$: BIT #4,R4 ;03720 BEQ 5$ ;03730 .RLSE #FLLLNK ;03740 5$: BIT #20,R4 ;03750 BEQ 6$ ;03760 .RLSE #FLXLNK ;03770 6$: RTS PC ;03780 ; *** DATA POOL *** ;03790 ;03800 PAGE: .WORD 0 ;03810 LINCNT: .WORD 0 ;03820 IOFLAG: .WORD 0 ;03830 ;03840 .WORD 0 ;03850 KBILNK: .WORD 0 ;03860 .RAD50 /CMI/ ;03870 .WORD 1 ;03880 .RAD50 /KB/ ;03890 ;03900 .WORD 0 ;03910 KBOLNK: .WORD 0 ;03920 .RAD50 /CMO/ ;03930 .WORD 1 ;03940 .RAD50 /KB/ ;03950 ;03960 .WORD TYPERR ;03970 FTNLNK: .WORD 0,0,1,0 ;03980 ;03990 .WORD TYPERR ;04000 FLLLNK: .WORD 0,0,1,0 ;04010 ;04020 .WORD FLXB ;04030 FLXLNK: .WORD 0,0,1,0 ;04040 ;04050 .WORD TYPERR,2 ;04060 FTNFIL: .WORD 0,0,0,0,233 ;04070 ;04080 .WORD TYPERR,2 ;04090 FLLFIL: .WORD 0,0,0,0,233 ;04100 ;04110 .WORD FLXB,4 ;04120 FLXFIL: .WORD 0,0,0,0,233 ;04130 ;04140 PROMPT: .WORD 100,0,2 ;04150 .ASCII <43><13> ;04160 ;04170 ERROR: .WORD 100,0,16 ;04180 .ASCII /OPEN ERROR / ;04190 ERNUM: .ASCII <40><15><12> ;04200 ;04210 CMDBUF: .BLKW 7 ;04220 INBUF: .WORD 84.,0,0 ;04230 .BLKB 84. ;04240 ;04250 FTNBUF: .WORD 82.,0,82. ;04260 .BLKB 80. ;04270 .ASCII <15><12> ;04280 FLLBUF: .WORD 134.,0,0 ;04290 .BLKB 134. ;04300 ;04310 HLINE: .WORD 134.,0,66. ;04320 .ASCII <15><14> ;04330 SVER: .ASCII / / ;04340 SDAT: .ASCII / / ;04350 STIM: .ASCII / PAGE/ ;04360 PNUM: .ASCII / / ;04370 .ASCII <15><12> ;04380 .ASCII <15><12> ;04390 ;04400 CSIFTN: .WORD CMDBUF,FTNLNK,FTNFIL ;04410 CSIFLL: .WORD CMDBUF,FLLLNK,FLLFIL ;04420 CSIFLX: .WORD CMDBUF,FLXLNK,FLXFIL ;04430 NERRS: .WORD 0 ;04440 NWRN: .WORD 0 ;04450 NERBUF: .WORD 100,0,34. ;04460 NER: .ASCII <15><12><40><40> ;04470 TNER: .ASCII / ERRORS / ;04480 NWR: .ASCII / WARNINGS/ ;04490 .ASCII <15><12> ;04500 .EVEN ;04510 LINNUM: .WORD 0 ;04520 STRADR: .WORD 0 ;04530 .END ;04540 .END ;04540