Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/libsim/tmpout.mac
There are 2 other files named tmpout.mac in the archive. Click here to see a list.
00010 COMMENT * SIMULA specification;
00020 OPTIONS(/E:CODE,tmpout);
00030 BOOLEAN PROCEDURE tmpout(nam,txt);
00040 NAME nam; TEXT nam,txt;
00050 COMMENT Tries to use the TMPCOR UUO to write the core file NAM from TXT.
00060 On failure, a file with name jjjnam.TMP is written instead (jjj is decimal
00070 job number). If that also fails, FALSE is returned, otherwise TRUE.
00080 No carriage return-line feed will be supplied - must be in TXT if needed.
00090 ;
00100
00110 !*;! MACRO-10 code !*;!
00120
00130 TITLE tmpout
00140 ENTRY tmpout
00150 SUBTTL SIMULA utility, Lars Enderin Oct 1976, modified version Sep 1977
00160
00170 ;!*** Copyright 1977 by the Swedish Defence Research Institute. ***
00180 ;!*** Copying is allowed. ***
00190
00200
00210 sall
00220 search simmac,simmcr,simrpa
00230 macinit
00240
00250 ;! Local definitions ;!
00260
00270 .TCRWF==3 ;! Write code
00280 result==ZBI%S
00290 nam==result+1
00300 txt==nam+2
00310 nm==XWAC1
00320 tx==XWAC1
00330 lng==XWAC5
00340 block==XWAC6
00350
00360 tmpout: PROC
00370 LD nm,nam(XCB)
00380 IF ;! No thunk
00390 JUMPGE nm,FALSE
00400 THEN ;! Simple treatment
00410 ADDI nm+1,(nm)
00420 LD nm,(nm+1)
00430 ELSE ;! Full treatment
00440 LI XWAC1,(XCB)
00450 HRLI XWAC1,nam
00460 XEC PHFV
00470 Z
00480 FI
00490 LF X1,ZTVSP(,nm)
00500 IF ;! Non-zero offset
00510 JUMPE X1,FALSE
00520 THEN ;! Modify
00530 IDIVI X1,5
00540 ADDI X2,(nm)
00550 ELSE ;! Standard byte pointer
00560 LF X2,ZTVZTE(,nm)
00570 FI
00580 ADD X2,bp(X1)
00590 LF lng,ZTVLNG(,nm)
00600 CAILE lng,3 ;! Max 3 characters
00610 LI lng,3
00620 SETZ
00630 LOOP ;! Convert name to SIXBIT
00640 ILDB X1,X2
00650 CAIL X1,"a"
00660 SUBI X1,40
00670 CAIG X1,40
00680 LI X1,40
00690 LSH 6
00700 ADDI -40(X1)
00710 AS
00720 SOJG lng,TRUE
00730 SA
00740 JUMPE CSEP ;! Blank name, RETURN
00750 TRNN 77B23 ;! Shift 1st non-blank into position
00760 LSH 6
00770 TRNN 77B23
00780 LSH 6
00790 HRLZM block ;! XWD nm,0
00800 LD tx,txt(XCB)
00810 LI XTAC,tx
00820 XEC TXST ;! tx:-tx.Strip
00830 LF X2,ZTVSP(,tx)
00840 IF ;! txt not start of main text
00850 JUMPE X2,FALSE
00860 THEN ;! Make Copy
00870 STACK block
00880 XEC TXCY
00890 Z
00900 UNSTK block
00910 SETZ X2,
00920 FI
00930 LI block+1,1(tx) ;! addr(1st text word) - 1
00940 LF X1,ZTVLNG(,tx) ;! Number of characters
00950 IDIVI X1,5 ;! = 5*<number of words>+<number of characters in last word>
00960 SKIPE X2
00970 ADDI X1,1
00980 ADDI tx,1(X1) ;! Address of last word
00990 L tx+1,(tx) ;! Contents of last word
01000 IF ;! Not full
01010 JUMPE X2,FALSE
01020 THEN ;! Make extra characters null temporarily
01030 AND tx+1,nullmask-1(X2)
01040 EXCH tx+1,(tx)
01050 FI
01060 MOVNI X1,(X1) ;! -<number of words>
01070 HRLI block+1,(X1) ;! IOWD <number of words>,<first text word>
01080 MOVSI .TCRWF ;! Code for writing to TMPCOR
01090 HRRI block
01100 TMPCOR
01110 GOTO tmpfil ;! Not enough space, make real file
01120
01130 L9():! SETOM result(XCB)
01140 L8():! EXCH tx+1,(tx) ;! Restore last text word
01150 JSP CSEP ;! RETURN
01160
01170 nullmask:
01180 BYTE (7)177,0,0,0,0(1)0
01190 BYTE (7)177,177,0,0,0(1)0
01200 BYTE (7)177,177,177,0,0(1)0
01210 BYTE (7)177,177,177,177,0(1)0
01220
01230 bp: POINT 7,2
01240 POINT 7,2,6
01250 POINT 7,2,13
01260 POINT 7,2,20
01270 POINT 7,2,27
01280
01290 tmpfil: ;! Make a real file, output txt in dump mode
01300 LOWADR
01310 LI X1,YIOCHT+17(XLOW) ;! Find a free channel
01320 LOOP
01330 SKIPN (X1)
01340 GOTO L7
01350 AS
01360 CAILE X1,YIOCHT(XLOW)
01370 SOJA X1,TRUE
01380 SA
01390 GOTO L8 ;! No free channel
01400 L7():! SUBI X1,YIOCHT(XLOW) ;! Channel number
01410 LSH X1,^D23 ;! into AC position
01420 STACK tx+1
01430 STACK tx
01440 STACK X1
01450 TLO X1,(OPEN) ;! OPEN UUO in X1
01460 HRRI X1,X3 ;! OPEN block in X3-X5
01470 LI X3,17 ;! Dump mode
01480 MOVSI X4,'DSK' ;! Device DSK
01490 SETZ X5, ;! No buffers
01500 XCT X1 ;! OPEN
01510 GOTO [UNSTK X1
01520 GOTO L6] ;! Failed
01530
01540 ;! ENTER block for "jjjnam.TMP[,]" to X0-X3, UUO to X4
01550 PJOB X1, ;! Job no (jjj)
01560 HLLZ block ;! 'nam',,0
01570 IDIVI X1,^D10 ;! Form 'jjj' in front of 'nam'
01580 ADDI '0'(X2) ;! last digit
01590 ROT -6
01600 IDIVI X1,^D10
01610 ADDI '0'(X2) ;! tens digit
01620 ROT -6
01630 ADDI '0'(X1) ;! first digit
01640 ROT -6 ;! Now we have 'jjjnam' in SIXBIT
01650 MOVSI X1,'TMP' ;! Extension
01660 SETZ X2, ;! Rest of ENTER block
01665 GETPPN X3, ;! UFD
01667 CAI ;! In case of JACCT
01670 UNSTK X4 ;! Z channel,
01680 TLO X4,(ENTER) ;! ENTER channel,X0
01690 XCT X4
01700 GOTO errout
01710
01720 ;! Set up IOWD n,txt contents, followed by zero, for dump output
01730 ;! block+1 already has the right IOWD
01740 SETZ block, ;! End of io list
01750 EXCH block,block+1 ;! after swap
01760 TLZ X4,(777B8)
01770 TLO X4,(OUT)
01780 HRRI X4,block
01790 XCT X4 ;! OUT channel,block
01800 SETOM result(XCB) ;! Ok result (TRUE)
01810 ;! Close i/o channel
01820 errout: AND X4,[777,,0]
01830 TLO X4,(CLOSE)
01840 XCT X4
01850 L6():! UNSTK tx ;! Restore final text word
01860 UNSTK (tx)
01870 JSP CSEP ;! RETURN
01880 EPROC
01890 LIT
01900 END;