Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

COMMENT % SIMULA specification;
OPTIONS(/E:QUICK,ptyinimage);
INTEGER PROCEDURE ptyinimage(ptyin); REF(Infile) ptyin;
COMMENT Performs Inimage for a PTY Infile. Does not need a break character to
stop input. The result is the break character combination:
7 (^G), 10 (LF), 11 (VT), 12 (FF), 13 (CR without following LF),
26 (^Z), 27 (ESC).
CRLF is two characters = 128*13+10=1674.
Special codes:
0 - No break character (null found),
-1 for an empty buffer (no input available),
-2 for no more space in Image, without having found break character
-3 for other error (to be elaborated?).

The file must be open and be associated with a pseudo-tty.
NOTE!  Image must be an initial subtext of Image.Main, i.e.
  Image.Main.Sub(1,Image.Length) == Image.
PTYINIMAGE sets Image=Image.Strip, except if Image.Strip==NOTEXT.
In that case Image = " " and Image.Pos=2.
;

!%;! MACRO-10 code !%;!

	TITLE	ptyinimage
	ENTRY	ptyinimage
	SUBTTL	SIMULA utility, Lars Enderin Sept 1977

;!*** Copyright 1977 by the Swedish Defence Research Institute. ***
;!*** Copying is allowed.					***


	sall
	search	simmac,simmcr,simrpa
	macinit

	;! Local definitions ;!

	bup==2	;! Byte ptr offset in buffer header
	cnt==3	;! Counter offset
	img==OFFSET(ZFIIMG)
	res==XWAC3
	ptyin==XWAC1
	xip==X10 ;! Byte ptr for Image
	xcc==X6	;! Count of remaining characters in Image (.Main)

OPDEF	nextchar [XEC .NEXTC]


ptyinimage:
	PROC
	EXCH	ptyin,(XTAC)
	SAVE	<XTAC,XBH,xip,xcc,res>
	SETZ	xcc,
	IFOFF	ZFIOPN(ptyin)
	 GOTO	 error	;! File not OPEN
	LF	X1,ZFICHN(ptyin)
	L	X1
	DEVTYP
	 GOTO	 error	;! Device no good?
	ANDI	TY.DEV
	CAIE	.TYPTY
	 GOTO	 error	;! Not a PTY


	LF XBH,ZFIIBH(ptyin)
	SUBI XBH,1
	IF ;!Current buffer exhausted
	   SKIPLE cnt(XBH)
	   GOTO FALSE
	THEN ;! Check for new input
	  JOBSTS X1,
	   GOTO	 error
	  TLNN	X1,(JB.UOA)
	   GOTO	 noinput
	FI
	LF X1,ZTVZTE(ptyin,img)
	LF xcc,ZTECLN(X1)
	JUMPE xcc,imgend	;! No room in Image
	;! Make byte ptr for image
	WLF xip,ZTVZTE(ptyin,img)
	IF ;! Startpos(Image) NE 0
	   TLZN xip,-1
	   GOTO FALSE
	THEN ;! Error, make it 0
	   OUTSTR [ASCIZ/
%PTYINIMAGE: Image not start of Image.Main
/]
	   RTSERR QDSCON,214
	   WSF xip,ZTVZTE(ptyin,img)
	FI
	ADD xip,[POINT 7,2,]

	;! Scan initial nulls
	LOOP  nextchar
	AS  JUMPE TRUE
	SA

	SETZ res,

	LOOP ;! Until Image full or break char or end of input
	  IF ;! Exceptional character
	    JUMPGE FALSE
	  THEN ;! Error or end of input
	    ST res
	    GOTO finish
	  FI

	  CAIL	40
	   GOTO  deposit

	  JUMPE finish ;! Treat null as break char

	  IF ;!CR
	    CAIE QCR
	    GOTO FALSE
	  THEN ;! Scan past CR's
	    ST res
	    LOOP nextchar
	    AS CAIN QCR
	       GOTO TRUE
	    SA
	  FI
	  JUMPL nomore
	  CAIL 40
	   GOTO deposit
	  IF;!Break character
	    CAIE QLF
	     CAIN QALTMODE
	      GOTO TRUE
	    CAIE QFF
	     CAIN QVT
	      GOTO TRUE
	    CAIE "Z"-100
	     CAIN "G"-100
	      GOTO TRUE
	    JUMPN FALSE
	  THEN;!Compound result
	    SKIPE
	     LSH res,7
	    ORM res
	    GOTO finish
	  FI
deposit:  ;! Non-break character to Image
	  IF ;! Space remains in Image
	    SOJL xcc,FALSE
	  THEN ;! Place character there
	    IDPB xip
	  ELSE ;! We have no break character, but a full image
	    AOS cnt(XBH) ;! Restore byte count and pointer
	    L X1,bup(XBH)
	    IF ;! Not at start of word
		JUMPG X1,FALSE
	    THEN
		ADD X1,[070000,,000000]
	    ELSE
		LI X1,-1(X1)
		HRLI X1,(POINT 7,0,27)
	    FI
	    ST X1,bup(XBH)
	    GOTO imgend
	  FI
	  nextchar
	AS GOTO TRUE
	SA

error:	MOVNI res,3
	GOTO finish

nomore:	JUMPN res,finish
	ST res
	GOTO finish

noinput:SETO res,
	GOTO finish

imgend: MOVNI res,2
;!;!	GOTO finish

finish:	LF X1,ZTVZTE(ptyin,img)
	LF ,ZTECLN(X1)
	SUBI (xcc)
	IF ;! Nothing in image
	   JUMPN FALSE
	THEN ;! Make Image.Length=1, Pos=2
	   AOBJP .+1
	   WSF ,ZTVLNG(ptyin,img)
	   LI " "
	   IDPB xip
	ELSE ;! Pos=1, length only including useful data
	   MOVSM OFFSET(ZTVLNG)+img(ptyin)
	FI
	L ptyin,res
L8():!	RESTORE
	EXCH ptyin,(XTAC)
	RET
	EPROC

.nextc:	PROC
	LOOP
	  IF ;! Byte available
	    SOSGE cnt(XBH)
	    GOTO FALSE
	  THEN ;! Take it
	    ILDB bup(XBH)
	    RET
	  FI
	  LF X1,ZFICHN(ptyin)
	  JOBSTS X1,
	   GOTO  L9
	  TLNN X1,(JB.UOA)
	   GOTO L8	;! No input available
	  XEC IORB
	AS SKIPE cnt(XBH)
	  GOTO  TRUE
	SA
L8():!	SETO
	RET	;! Empty buffer

L9():!	MOVNI 3
	RET
	EPROC
	LIT
	END;