Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/libsim/tmpin.mac
There is 1 other file named tmpin.mac in the archive. Click here to see a list.
00010 COMMENT * SIMULA specification;
00020 OPTIONS(/E:CODE,tmpin);
00030 TEXT PROCEDURE tmpin(nam,delete);
00040 VALUE nam; TEXT nam; BOOLEAN delete;
00050 COMMENT Uses the TMPCOR UUO to read the core file NAM into a new text object.
00060 If a TMPCOR file is not found, a real file named "jjjnam.TMP" is looked up
00070 and read instead.
00080 If DELETE is TRUE, the file is deleted.
00090 Returns NOTEXT if the file was not found, Blanks(1) if found but empty.
00100 In the latter case Pos=2 also, otherwise 1.
00110 ;
00120
00130 !*;! MACRO-10 code !*;!
00140
00150 TITLE tmpin
00160 ENTRY tmpin
00170 SUBTTL SIMULA utility, Lars Enderin Oct 1976, modified Feb 1977
00180
00190 ;!*** Copyright 1976 by the Swedish Defence Research Institute. ***
00200 ;!*** Copying is allowed. ***
00210
00220
00230 sall
00240 search simmac,simmcr,simrpa
00250 macinit
00260
00270 ;! Local definitions ;!
00280
00290 .TCRRF==1 ;! Read code
00300 .TCRDF==2 ;! Read and delete code
00310 result==2
00320 nam==result+2
00330 delete==nam+2
00340 lng==XWAC5
00350 attempt==XWAC6
00360 cnt==XWAC7
00370 block==XWAC10
00380 buflen==^D120/5
00390
00400 tmpin: PROC
00410 LF lng,ZTVLNG(XCB,nam)
00420 JUMPE lng,L9
00430 LI attempt,1
00440 LI XWAC1,buflen*5 ;! Allocate text as buffer
00450 L1():! EXEC TXBL
00460 XWD 0,0
00470 LF X1,ZTVSP(XCB,nam)
00480 SUBI attempt,1
00490 IF ;! Non-zero offset
00500 JUMPE X1,FALSE
00510 THEN ;! Modify
00520 IDIVI X1,5
00530 ADD X2,nam(XCB)
00540 ELSE ;! Standard byte pointer
00550 LF X2,ZTVZTE(XCB,nam)
00560 FI
00570 HRRZS X2
00580 ADD X2,bp(X1)
00590 CAILE lng,3
00600 LI lng,3
00610 SETZ
00620 LOOP ;! Convert name to SIXBIT
00630 ILDB X1,X2
00640 CAIL X1,"a"
00650 SUBI X1,40
00660 CAIG X1,40
00670 LI X1,40
00680 LSH 6
00690 ADDI -40(X1)
00700 AS
00710 SOJG lng,TRUE
00720 SA
00730 JUMPE L9 ;! Blank name
00740 TRNN 77B23
00750 LSH 6
00760 TRNN 77B23
00770 LSH 6
00780 HRLZM block
00790 LF block+1,ZTELEN(XWAC1)
00800 MOVNI -2(block+1)
00810 HRLM block+1
00820 HRRI block+1,1(XWAC1) ;! IOWD buflen,buffer
00830 MOVSI .TCRRF
00840 HRRI block
00850 TMPCOR
00860 GOTO tmpfil ;! Not found, look for real file
00870 IMULI 5
00880 IF ;! Zero length file
00890 JUMPN FALSE
00900 THEN ;! Return Blanks(1) only
00910 L2():! MOVSI (" "B6)
00920 ST 2(XWAC1)
00930 SETZM result+1(XCB)
00940 MOVSI XWAC2,1
00950 HRRI XWAC2,1 ;! Pos=2
00960 GOTO L3
00970 FI
00980 LF lng,ZTECLN(XWAC1)
00990 IF ;! Buffer was too small
01000 CAIG (lng)
01010 GOTO FALSE
01020 THEN ;! Make a new text
01030 JUMPL attempt,L9 ;! Just two attempts possible
01040 ST XWAC1
01050 GOTO L1
01060 FI
01070 ST lng
01080 L5():! ;! Now clean up the text
01090 L X1,[POINT 7,2(XWAC1)]
01100 L X2,X1
01110 SETZ cnt,
01120 LOOP
01130 ILDB X1
01140 IF ;! Non-zero byte
01150 JUMPE FALSE
01160 THEN ;! Count and store it
01170 AOS cnt
01180 IDPB X2
01190 FI
01200 AS
01210 SOJG lng,TRUE
01220 SA
01230 JUMPE cnt,L2
01240 HRLZ XWAC2,cnt
01250 L3():! ST XWAC1,result(XCB)
01260 EXCH XWAC2,result+1(XCB)
01270 IF ;! delete
01280 SKIPN delete(XCB)
01290 GOTO FALSE
01300 THEN ;! Do another TMPCOR or RENAME (to delete)
01310 IF ;! it was a TMPCOR file
01320 JUMPE block+1,FALSE
01330 THEN ;! Use TMPCOR to delete
01340 SETZM block+1
01350 MOVSI .TCRDF
01360 HRRI block
01370 TMPCOR
01380 NOP ;! Ignore error
01390 ELSE ;! Real file, use RENAME
01400 AND X4,[777,,0]
01410 TLO X4,(RENAME)
01420 SETZB X1
01430 SETZB X2,X3
01440 XCT X4
01450 NOP ;! Ignore error
01460 FI
01470 ELSE ;! Close the file if any
01480 JUMPE block+1,L6
01490 FI
01500 L9():! BRANCH CSEP
01510
01520 bp: POINT 7,2
01530 POINT 7,2,6
01540 POINT 7,2,13
01550 POINT 7,2,20
01560 POINT 7,2,27
01570
01580 tmpfil: ;! Look up and read "jjjnam.TMP"
01590 LI X1,YIOCHT+17(XLOW) ;! Find a free channel
01600 LOOP
01610 SKIPN (X1)
01620 GOTO L7
01630 AS
01640 CAILE X1,YIOCHT(XLOW)
01650 SOJA X1,TRUE
01660 SA
01670 GOTO L9 ;! No free channel
01680 L7():! SUBI X1,YIOCHT(XLOW) ;! Channel number
01690 LSH X1,^D23 ;! into AC position
01700 ST X1,result+1(XCB);! Save channel in correct position
01710 TLO X1,(OPEN) ;! OPEN UUO in X1
01720 ST XWAC1,result(XCB) ;! Save XWAC1
01730 HRRI X1,X3 ;! OPEN block in X3-X5
01740 LI X3,17 ;! Dump mode
01750 MOVSI X4,'DSK' ;! Device DSK
01760 SETZ X5, ;! No buffers
01770 XCT X1 ;! OPEN
01780 GOTO [SETZM result(XCB)
01790 GOTO L9()] ;! Failed
01800
01810 ;! LOOKUP block for "jjjnam.TMP[,]" in X0-X3, UUO in X4
01820 PJOB X1, ;! Job no (jjj)
01830 HLLZ block ;! 'nam',,0
01840 IDIVI X1,^D10 ;! Form 'jjj' in front of 'nam'
01850 ADDI '0'(X2) ;! last digit
01860 ROT -6
01870 IDIVI X1,^D10
01880 ADDI '0'(X2) ;! tens digit
01890 ROT -6
01900 ADDI '0'(X1) ;! first digit
01910 ROT -6 ;! Now we have 'jjjnam' in SIXBIT
01920 MOVSI X1,'TMP' ;! Extension
01930 SETZ X2, ;! Rest of LOOKUP block
01932 GETPPN X3, ;! UFD = [,]
01934 CAI ;! In case of JACCT
01940 L X4,result+1(XCB);! Z channel,
01950 TLO X4,(LOOKUP) ;! LOOKUP channel,X0
01960 XCT X4
01970 GOTO errout
01980
01990 HRR X3,block+1 ;! Same right half for comparison
02000 ;! Set up IOWD n,txt contents, followed by zero, for dump input
02010 IF ;! File is bigger (-words,,xxx in X3 now) than text
02020 CAML X3,block+1
02030 GOTO FALSE
02040 THEN ;! Reallocate text
02050 HRRM X3,block+1
02060 HLRES X3
02070 MOVN XWAC1,X3
02080 IMULI XWAC1,5
02090 EXEC TXBL
02100 Z
02110 HRRI block+1,1(XWAC1)
02120 ST XWAC1,result(XCB)
02130 FI
02140 SETZ block, ;! End of io list
02150 EXCH block,block+1 ;! after swap
02160 L X4,result+1(XCB)
02170 TLO X4,(IN)
02180 HRRI X4,block
02190 XCT X4 ;! IN channel,block
02200 GOTO okin
02210 errout: SETZM result(XCB)
02220 SETZM result+1(XCB)
02230 GOTO L6
02240 okin: L XWAC1,result(XCB)
02250 LF lng,ZTECLN(XWAC1)
02260 GOTO L5 ;! Go clean up the text
02270 L6():! AND X4,[777,,0]
02280 TLO X4,(CLOSE)
02290 XCT X4
02300 GOTO L9
02310 EPROC
02320 LIT
02330 END;