Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/libsim/insngl.mac
There is 1 other file named insngl.mac in the archive. Click here to see a list.
00100 Comment * SIMULA specification;
00200 OPTIONS(/E:QUICK,insngl);
00300 CHARACTER PROCEDURE insngl(ifile); REF(Infile)ifile;
00400
00500 !*;! MACRO-10 code !*;!
00600
00700 TITLE insngl
00800 ENTRY insngl
00900 SUBTTL SIMULA utility, Lars Enderin Mar 1976
01000
01100 ;!*** Copyright 1976 by the Swedish Defence Research Institute. ***
01200 ;!*** Copying is allowed. ***
01300
01400
01500 sall
01600 search simmac,simmcr,simrpa
01700 macinit
01800
01900 ;! Local definitions ;!
02000
02100 ifile==XWAC1
02200 fcode==XWAC10
02300 iondx==XWAC11
02400 OPDEF IONDX. [CALLI 127]
02500
02600 bup==OFFSET(ZBHBUP)
02700 cnt==OFFSET(ZBHCNT)
02800
02900 .TOINC==10 ;! TRMOP code for line mode input of one char
03000
03100 insngl: PROC
03200 EXCH XWAC1,(XTAC)
03300 IF ;! Controlling terminal
03400 CAIN XWAC1,NONE
03500 GOTO TRUE
03600 IFOFF ZFITA(XWAC1)
03700 GOTO FALSE
03800 THEN ; ! Use INCHWL
03900 INCHWL (XTAC)
04000 GOTO L9
04100 FI
04200 SAVE <XBH,iondx,fcode>
04300 IF ; ! Another terminal
04400 IFOFF ZFITU(ifile)
04500 GOTO FALSE
04600 THEN ; ! Use TRMOP
04700 LF iondx,ZFICHN(XWAC1) ; ! Get i/o index corresponding to channel
04800 IONDX. iondx,
04900 SETZ iondx, ; ! Error
05000 JUMPE iondx,L2 ; ! Handle like dsk on error
05100 LI fcode,.TOINC
05200 L XWAC1,[2,,fcode]
05300 TRMOP. XWAC1,
05400 JSP error
05500 GOTO L8
05600 FI
05700 L2():! ;! Ordinary file handling
05800 IF ;! [143] No more data last time
05900 IFOFF ZFIEND(ifile)
06000 GOTO FALSE
06100 THEN ;! Set ENDFILE, return ^Z
06200 SETON ZIFEND(ifile)
06300 L XWAC1,"Z"-"A"+1
06400 GOTO L8
06500 FI
06600 LF XBH,ZFIIBH(XWAC1)
06700 SUBI XBH,1
06800 IF ;! Character available in buffer
06900 SOSGE CNT(XBH)
07000 GOTO FALSE
07100 THEN ;! Get it
07200 ILDB XWAC1,bup(XBH)
07300 ELSE ;! Must get new buffer first
07400 SETON ZFINB(ifile)
07500 EXEC IORB
07600 SETOFF ZFINB(ifile)
07700 IF ;! EOF
07800 IFOFF ZFIEND(ifile)
07900 GOTO FALSE
08000 THEN ;! Return ^Z
08100 LI XWAC1,"Z"-"A"+1
08200 ELSE ;! Return next char
08300 GOTO L2 ;! [143] and count it
08400 FI FI
08500 L8():! RESTORE
08600 L9():! EXCH XWAC1,(XTAC)
08700 POPJ XPDP,
08800 error: OUTSTR [ASCIZ/
08900 ?INSNGL TRMOP error
09000 /]
09100 RTSERR QDSCON,214
09200 SETZ XWAC1, ;! Return null on proceeding
09300 GOTO L8
09400 EPROC
09500 LIT
09600 END;