DataMuseum.dk

top - download

    Length: 19968 (0x4e00)
    Types: TextFile
    Names: »ACALL«

└─⟦45bd0f8dd⟧ Bits:30000464 DOMUS disk image
    └─ ⟦this⟧ »/ACALL« 
└─⟦6dbcc9c03⟧ Bits:30000463 DOMUS disk image
    └─ ⟦this⟧ »/ACALL« 
└─⟦a2e222af0⟧ Bits:30001626 DOMUS disk image
    └─ ⟦this⟧ »/ACALL« 

TextFile

**	.NOCON	1
;				AUTHOR:	FRS
;				DATE:	84.05.14
;
;
;
;
;
;
;
;
;
;
;
;
;
;
;
;
;
;
;
;
;		C   A   L   L
;
;		USER SUBROUTINES FOR RC-BASIC
;
;
;
;
;
;
;
;
;
;
;
;
;
;
;
;KEYWORDS: RC3600/RC7000, RCBASIC, DOMUS, DOMAC,
;	CALL ROUTINES,TEKTRONIX,STACK,DOT,DST.
;
;
;
;ABSTRACT: THIS PROGRAM CONTAINS MODULES FOR USING
;	1) TEKTRONIX GRAPHICAL TERMINALS
;	2) THE ADDRESSING FACILITY ON RC 822 TERMINALS
;	3) DOT & DST
;	4) STACK ROUTINES 
;	5) FOR EXAMINATION OF THE CORE
;	6) FOR DEPOSITION IF THE CORE
;	7) IMEDIATE CHR INPUT
«ff»
	; SUBROUTINE PARAMETERS

; IF SUBROUTINE IS WANTED : 1 (ELSE : 0)

RCWRI= 0		; WRITECHANNEL
RCRED=	0		; READCHANNEL



;PROGRAM:	AGRAF (SUBROUTINES FOR RC-BASIC)

;CORE REQUIREMENTS:
;		688 BYTES DEC.

;OTHER REQUIREMENTS:
;		COPS (THE BASIC INTERPRETER) MUST BE PREPARED 
;		FOR CALL-ROUTINES.

;CALLING SEQUENCES :
**	.IFN	RCGRA

;<STN> CALL "GRAPH",<X.COORD>,<Y.COORD>
;
;<STN>		: A STATEMENT NUMBER
;<X.COORD>	: ANY NUMERIC EXPRESSION
;		  0 <= <X.COORD> <= 1023
;<Y.COORD>	: ANY NUMERIC EXPRESSION
;		  0 <= <Y.COORD> <= 779
;SETS THE TERMINAL IN GRAPH MODE AND PLACES A
;DARK VECTOR IN (<X.COORD>,<Y.COORD>).



;<STN> CALL "OUTVECT",<X.COORD>,<Y.COORD>
;
;<STN>		: A STATEMENT NUMBER
;<X.COORD>	: ANY NUMERIC EXPRESSION
;		  0 <= <X.COORD> <= 1023
;<Y.COORD>	: ANY NUMERIC EXPRESSION
;		  0 <= <Y.COORD> <= 779
;DRAWS A VECTOR FROM ACTUAL POSITION 
;TO (<X.COORD>,<Y.COORD>).



;<Y.COORD>	: ANY NUMERIC EXPRESSION
;		  0 <= (Y.COORD> <= 779
;<STATE>	: ANY NUMERIC EXPRESSION
;DRAWS A VECTOR FROM ACTUAL POSITION TO (<X.COORD>,<Y.COORD>).
;IF <STATE>=0 THEN VECTOR IS DARK, ELSE IT IS BRIGHT.

«ff»
;<STN> CALL "ALPHA"
;
;<STN>		: A STATEMENT NUMBER
;SETS TERMINAL IN ALPHA MODE.


**	.ENDC
**	.IFN	RCXY
;<STN> CALL "XYADR",<X.COORD>,<Y.COORD>
;
;<STN>		: A STATEMENT NUMBER
;<X.COORD>	: ANY NUMERIC EXPRESSION
;		  1 <= <X.COORD> <= 80
;<Y.COORD>	: ANY NUMERIC EXPRESSION
;		  1 <= <Y.COORD> <= 24
;PLACES CURSOR ON A RC-822 TERMINAL IN POSITION 
;(<X.COORD>,<Y.COORD>).


;<STN> CALL "XY",<X.COORD>,<Y.COORD>
;
;<STN>          : A STATEMENT NUMBER
;<X.COORD>      : ANY NUMERIC EXPRESSION
;                 1 <= <X.COORD> <= 80
;<Y.COORD>      : ANY NUMERIC EXPRESSION
;                 1 <= <Y.COORD> <= 24
;THE FUNCTION OF THE ROUTINES IS AS DESCRIBED FOR
;XYADR, EXCEPT THAT THE Y-AXIS HAS BEEN TURNED AROUND
;1. ROW HAS GOT Y.COORD=24.

**	.ENDC
**	.IFN	RCWRI
;<STN> CALL "WRITECHANNEL",<CHANNEL>,<VALUE>
;
;<STN>		: A STATEMENT NUMBER
;<CHANNEL>	: ANY NUMERIC EXPRESSION
;<VALUE>	: ANY NUMERIC EXPRESSION
;		  VALUE=0 OR VALUE=1
;<CHANNEL> IS SPECIFYING THE OUTPUT CHANNEL AND
;<VALUE> IS THE VALUE TO BE OUTPUT.


**	.ENDC
**	.IFN	RCRED
;<STN> CALL "READCHANNEL",<CHANNEL>,<RESULT>
;
;<STN>		: A STATEMENT NUMBER
;<CHANNEL>	: ANY NUMERIC EXPRESSION
;<RESULT>	: A NUMERIC VARIABLE (OR ARRAY ELEMENT)
;<CHANNEL> IS SPECIFYING THE INPUT CHANNEL AND
;<RESULT> IS THE VARIABLE TO RECIEVE THE VALUE READ.


**	.ENDC
**	.IFN	RCEX
;<STN> CALL "EXAM",<ADDR>,<RESULT>
;
;<STN>		: A STATEMENT NUMBER
;<ADDR>		: A NUMERIC EXPRESSION
;<RESULT>	: A NUMERIC VARIABLE (OR ARRAY ELEMENT)
;<ADDR> IS A COREADDRESS AND <RESULT> IS THE
;VARIABLE TO RECEIVE THE CONTENTS.
«ff»
**	.ENDC

.IFN	RCDEP
;<STN>	CALL "DEP",<ADDR>,<CONTENS>
;<STN>		: A STATEMENT NUMBER
;<ADDR>		: A NUMERIC EXPRESSION
;<CONTENS>	: A NUMERIC EXPRESSION
;<ADDR> IS A CORE ADDRESS AND 
; <CONTENS> IS THE VARIABLE TO WRITE IN CORE
.ENDC

**	.IFN	RCIN
;<STN>	CALL "IN",CHR
;<STN>		: A STATEMENT NUMBER
;<CHR>		: CHR FROM CONSOLE IF PRESSED
;RETURN A CHAR. IF PRESSED ELSE 0
;
**	.ENDC
**	.IFN	RCSTK
;<STN> CALL "PUSH",<MVAR>,<EXPR>
;<STN> CALL "POP",<MVAR>,<NVAR>
;
;<STN>          : A STATEMENT NUMBER
;<MVAR>         : A NUMERIC ARRAY TO BE USED AS A STACK
;<EXPR>         : A NUMERIC EXPRESSION TO BE
;                 PLACED ON TOP OF THE STACK
;<NVAR>         : A NUMERIC VARIABLE OR A NUMERIC ARRAY
;                 ELEMENT TO RECEIVE THE VALUE ON TOP
;                 OF THE STACK.
;
;THE FIRST ELEMENT OF <MVAR> MUST BE INITIALIZED TO 0.
;
;IF	0010 LOWBOUND=1
;	0020 DIM A(N)
;THEN:
;	0100 CALL "PUSH",A,X+Y
;
;CORRESPONDS TO
;
;	0100 LET A(1)=A(1)+1
;	0110 IF A(1)>N THEN STOP <* ERROR 31 *>
;	0120 LET A(A(1))=X+Y
;AND
;	0200 CALL "POP",A,Z
;
;CORRESPONDS TO
;
;	0200 IF A(1)=0 THEN STOP <* ERROR 31 *>
;	0210 LET Z=A(A(1)); A(1)=A(1)-1
;
«ff»
**	.ENDC

PRDE1 RC
«ff»

	; SUBROUTINE TABLE

**	.IFN	RCEX
	EXAM
	.TXT	"EXAM<0><0><0><0>"
**	.ENDC
	.IFN	RCDEP
	DEP
	.TXT	"DEP<0><0><0><0><0>"
	.ENDC
**	.IFN	RCGRA
	GRAPH
	.TXT	"GRAPH<0><0><0>"
	OUTVE
	.TXT	"OUTVECT<0>"
	VECTO
	.TXT	"VECTOR<0><0>"
	ALPHA
	.TXT	"ALPHA<0><0><0>"
**	.ENDC
**	.IFN	RCXY
	XYADR
	.TXT	"XYADR<0><0><0>"
	XY
	.TXT	"XY<0><0><0><0><0><0>"
**	.ENDC
**	.IFN	RCWRI
	WRI01
	.TXT	"WRITECHA"
**	.ENDC
**	.IFN	RCRED
	RED01
	.TXT	"READCHAN"
**	.ENDC
**	.IFN	RCSTK
	PUSH
	.TXT	"PUSH<0><0><0><0>"
	POP
	.TXT	"POP<0><0><0><0><0>"
**	.ENDC
**	.IFN	RCINP
	INP
	.TXT	"INPUT<0><0><0>"
	OAIND
	.TXT	"OUTANDIN"
**	.ENDC
**	.IFN	RCIN
	IN
	.TXT	"IN<0><0><0><0><0><0>"
**	.ENDC
	0			; END OF TABLE.
«ff»
**	.IFN	RCGRA
OUTVE:	  2			; PROCEDURE OUTVECT
	  REAL			; ( X : REAL;
	  REAL			;   Y : REAL );
				; BEGIN
OUT01:				;
	LDA    0   .96		;
	LDA    2   U.STK,3	;
	LDA    1   +1,2		;
	  EXECUTE		;
	  GRA10			;   GRA10(Y,96);
	JMP	   ERR		;
	LDA    2   U.STK,3 	;
	LDA    1   +0,2		;
	LDA    0   .64		;
	  CALL			;
	  GRA10			;   GRA10(X,64);
	JMP	   ERR		;
	  F.OBLOCK		;   OUTBLOCK;
	JMP	   ERR		;   ERRORRETURN;
	  RET1			; END;
				;
				;
GRAPH:	  2			; PROCEDURE GRAPH
	  REAL			; ( X : REAL;
	  REAL			;   Y : REAL );
				; BEGIN
GRA01:	LDA    2   CUR		;
	LDA    0   COUT,3	;
	LDA    1   GRA02	;
	  F.OCHAR		;   OUTCHAR(GRAPH-SWITCH);
	JMP	   ERR		;   ERROR-RETURN;
	JMP	   OUT01	;   GOTO OUT01;
GRA02:	.TXT	.<0><29>. 	; (* GRAPH-MODE CHARACTER *)
				;
VECTO:	  3			; PROCEDURE VECTOR
	  REAL			; ( X : REAL;
	  REAL			;   Y : REAL;
	  REAL			;   STATE : REAL );
	LDA    2   +2,2		; BEGIN
	LDA    0   +0,2		;
	LDA    1   +1,2		;
	MOV    0,0 SZR		;   IF STATE <> 0 THEN
	JMP	   OUT01	;     GOTO OUT01
	MOV    1,1 SZR		;   ELSE
	JMP	   OUT01	;     GOTO GRA01;
	JMP	   GRA01	;
				;
ALPHA:	  0			; PROCEDURE ALPHA;
	LDA    2   CUR		; BEGIN
	LDA    0   COUT,3	;
	LDA    1   ALP01	;
	  F.OCHAR		;   OUTCHAR(ALPHA-SWITCH);
	JMP	   ERR		;
	  RET1			; END;
ALP01:	.TXT	.<0><31>. 	; (* ALPHA-MODE CHARACTER *)


«ff»
GRA10:	STA    0   U.S03,3	; PROCEDURE GRA10
				; ( Z:REAL;I:INTEGER);
	MOV    1,2		; BEGIN
	.IFN	RCEXP
	LDA    0   +2,2		;
	STA    0   U.WXP,3	;
	.ENDC
	LDA    0   +0,2		;
	LDA    1   +1,2		;   GET(Z);
	BCALL	   FIX		;   FIX(Z);
	STA    1   U.S01,3	;
	LDA    2   .32		;
	BCALL	   IDIV		;
	LDA    0   .31		;   Z.HIGH:=Z DIV 32.+31.
	AND    0,1		;
	ADD    0,1		;
	LDA    0   COUT,3	;
	LDA    2   CUR		;
	INC    1,1		;
	  F.OCHAR		;   OUTCHAR(Z.HIGH);
	  RET0			;   ERRORRETURN;
	LDA    1   U.S01,3	;
	LDA    0   .31		;
	AND    0,1		;
	LDA    0   U.S03,3	;   GET(I);
	ADD    0,1		;   Z.LOW:=Z MOD 32 + I;
	LDA    0   COUT,3	;
	  F.OCHAR		;   OUTCHAR(Z.LOW);
	  RET0			;   ERRORRETURN;
	  RET1			; END;

.31:	  31
**	.ENDC
**	.IFN	RCGRA+RCXY

.96:	  96
ERR:
	BCALL	   IOERR	; I/O-ERROR
	  RET0
«ff»

**	.ENDC
**	.IFN	RCINP
OAIND:	  2			; PROCEDURE OUTANDIN
	  STRING		; ( STR : STRING;
	  STRING+REFERENCE	;   VAR TEXT : STRING);

	LDA    2   +0,2		;
	LDA    1   +0,2		; AC1 := BYTEADR(STR);
	STA    1   U.S03,3	; S03 := BYTEADR
	LDA    0   +1,2		;
	SNZ    0,0		;
	JMP    OAI2		;
	STA    0   U.S01,3	; S01 := NUMBER OF BYTES;
	LDA    0   +2,2		;
	STA    0   U.S02,3	; S02 := SEGMENTNUMBER;
OAI1:	LDA    0   U.S02,3	; AC0 := SEGMENTNUMBER;
	LDA    2   CUR		;
	LDA    1   U.S03,3	;
	  A.GBYTE		; GETBYTE(STR);
	MOV    0,1		;
	LDA    0   PIO,3	;
	  F.OCHAR		; OUTCHAR(BYTE);
	JMP    ERR		; IF ERROR GOTO ERR;
	ISZ        U.S03,3	; INC(BYTEADR);
	DSZ	   U.S01,3	; DECR(S01); IF S01=0 SKIP NXT INSTR;
	JMP	   OAI1		;
	  F.OBLOCK		; OUTBLOCK;
	JMP    ERR		;
OAI2:	LDA    2   U.STK,3	;
	LDA    2   +1,2		;
	JMP   INP01		;


«ff»

INP:	  1			; PROCEDURE INPUT
	  STRING+REFERENCE	; ( VARR TEXT:STRING);

	LDA    2   +0,2		;
INP01:	LDA    0   +0,2		;
	LDA    1   +1,2		;
	STA    0   U.S04,3	; S04 :=
	STA    0   U.S01,3	; S01 := AC0 := ADDR(FIRST BYTE);
	STA    1   U.S02,3	; S02 := AC1 := MAX NUMB OF BYTES;
	LDA    0   +2,2		;
	STA    0   U.S03,3	; S03 := AC0 := ADDR(WORD CONT. CUR NUMB OF BYTES);
	LDA    0   PIO,3	; ZONE := PRIMARY INPUT/OUTPUT;
	LDA    2   CUR		;
	  F.OBLOCK		; OUTBLOCK(PIO);
	JMP    ERR		;
INP02:	LDA    0   PIO,3	;
	  F.ICHAR		; INCHAR(PIO);
	JMP    ERR		;
	MOV    1,0		; AC0 := CHARACTER;
	LDA    1   .ESC		;
	SNE    0,1		; IF CHAR=ESC THEN GOTO INP03;
	JMP    INP03		;
	LDA    1   .CR		;
	SNE    0,1		; IF CHAR=13 THEN GOTO INP03;
	JMP    INP03		;
	LDA    1   U.S01,3	; AC1 := BYTEADR
	  A.PBYTE		;
	  1
	ISZ        U.S01,3	; INCR(BYTE ADR OG NXT ELEMENT)
	DSZ        U.S02,3	; DECR(NUMB OF CHARS STILL AVAIABLE IN TEXT)
				; IF STILL CHARS THEN CONTINUE READING
	JMP    INP02		;
INP03:	LDA    0   U.S01,3	;
	LDA    1   U.S04,3		;
	SUB    1,0		; AC0 := CURR.NUMB OF BYTES IN STRING
	LDA    1   U.S03,3	; AC1 := ADDR(WORD CONTAINING CUR STRINGLENGTH);
	LDA    2   CUR		;
	  A.PWORD		; STORE NEW LENGTH
	  1
	  RET1

.ESC:	  27

«ff»

**	.ENDC
**	.IFN	RCIN
IN:	1			; PROCEDURE IN
	REAL+REFERENCE		; (CHR:REAL);

	.IFN	RCEXP		;
	LDA	0	+2,2	;
	STA	0	U.WXP,3	;
	.ENDC			;
	STA	3	SUSER	; SAVE USER
	LDA	2	MSW	;
	MOV	2,2 SZR		; IF MSW=0 THEN
	JMP	ISTIME		;
	LDA	2	TNAME	; BEGIN
	LDA	1	AMESS	;
	SENDMESSAGE		;   SENDMESSAGE(TTY,1,1,CHR);
	MOVZL#	2,2 SZC		;   IF BUF < 0 THEN
	JMP	IERR		;   ERROR;
	STA	2	MSW	;   MSW:=BUF;
				; END;
ISTIME:	SUB	1,1		; IF BUF.RECEIVER >=0 THEN
	LDA	0	RECEI,2	; BEGIN
	MOVZL#	0,0 SNC		;   CHR:=0;
	JMP	BACK		;   GOTO BACK
				; END;
	WAITANSWER		; WAITANSWER;
	SUB	1,1		;
	STA	1	MSW	; MSW:=0;
	MOV	0,0 SZR		; IF STATUS <> 0 THEN ERROR;
	JMP	IERR		;
	LDA	1	ICHR	; CHR:=READCHR;
	MOVS	1,1		;
BACK:				; BACK:		<*AC1=CHR>
	LDA	3	SUSER	;
	SUB	0,0		;
	BCALL	FLOAT		; FLOAT(CHR);
	.IFN	RCEXP		;
	STA	2	IEX02	;
	.ENDC			;
	LDA	2	U.STK,3	;
	LDA@	2	+0,2	;
	STA	2	IEX01	;
	LDA	2	CUR	;
	.IFE	RCEXP		;
	A.PDOUBLE		;
	.ENDC
	.IFN	RCEXP		;
	A.PTRIPLE		;
	.ENDC			;
	1
IEX01:	0			;
	.IFN	RCEXP		;
IEX02:	0			;
	.ENDC			;
	RET1			;

SUSER:	0
MSW:	0
ICHR:	0
AMESS:	.+1
	1			; MESS0
	1			; MESS1
	ICHR*2			; MESS2
	0			; MESS3

TNAME:	.+1
	.TXT	"TTY<0><0>"

IERR:	ERROR			;
	90.			;
**	.ENDC
«ff»

	**	.IFN	RCXY
XYADR:	  2			; PROCEDURE XYADR
	  REAL			; ( X : REAL;
	  REAL			;   Y : REAL );

	LDA    0   .3		; BEGIN
	STA    0   U.S02,3	;
XY01:	STA    2   U.S00,3 	;
	LDA    0   COUT,3	;
	LDA    1   .134		;
	LDA    2   CUR		;
	  F.OCHAR		;   OUTCHAR(ADR.MODE CHAR);
	JMP	   ERR		;
	LDA    1   .80		; (* 80 COLOUMS *)
	STA    1   U.S01,3	;
	  CALL			;
	  UDSKR			;   UDSKR( X , 80 );
	JMP	   ERR		;
	LDA    1   .24		; (* 24 ROWS *)
	STA    1   U.S01,3	;
	ISZ	   U.S00,3	;
	  CALL			;
	  UDSKR			;   UDSKR( Y , 24 );
	JMP	   ERR		;
	  RET1			; END;

UDSKR:	LDA    2   U.S00,3	; PROCEDURE UDSKR(Z:REAL;
				;         VALUE:INTEGER);
	LDA    2   +0,2		; BEGIN
	.IFN	RCEXP
	LDA    0    +2,2	;
	STA    0    U.WXP,3	;
	.ENDC
	LDA    0   +0,2		;
	LDA    1   +1,2		;   GET(Z);
	BCALL	   FIX		;   FIX(Z);
	NEG    1,1		;   Z:=Z-1;
	COM    1,1		;
	LDA    2   U.S01,3 	;   GET(VALUE);
	BCALL	   IDIV		;   CHAR:=Z MOD VALUE;
	DSZ	   U.S02,3	;   IF Z=<Y.COORD>
	JMP	   UD02		;    AND PROC=XY THEN
	LDA    1   .23		;      Z := 23 - Z;
	SUB    0,1    		;
	MOV    1,0 SKP		;
UD02:	MOV    0,1		;
	LDA    2   .96		;   IF CHAR <= 32. THEN
	ADD    2,1		;     CHAR := CHAR+96.
	AND#   2,0 SNR		;   ELSE
	JMP	   UD01		;
	LDA    2   .64		;   IF CHAR<=64. THEN
	SUB    2,1		;     CHAR := CHAR+32.
	AND#   2,0 SZR		;   ELSE
	SUB    2,1		;   IF CHAR<=80. THEN

«ff»

UD01:	LDA    2   CUR		;     CHAR := CHAR-32.;
	LDA    0   COUT,3	;
	  F.OCHAR		;   OUTCHAR(CHAR);
	  RET0			;   ERRORRETURN;
	  RET1			; END;
.23:      23
.80:	  80
.134:	  134
XY:	  2			; PROCEDURE XY
	  REAL			; ( X : REAL;
	  REAL			;   Y : REAL);

	LDA    0   .2
	STA    0   U.S02,3	;
	JMP        XY01		;
«ff»

**	.ENDC
**	.IFN	RCWRI
DOT=	  57			; DIGITAL OUTPUT TERMINAL

WRI01:	  2			; NUMBER OF PARAMETERS
	  REAL
	  REAL

	LDA    2   +0,2		; BEGIN
	.IFN	RCEXP
	LDA    0   +2,2		;
	STA    0   U.WXP,3	;
	.ENDC
	LDA    0   +0,2
	LDA    1   +1,2
	BCALL	   FIX		;   CHANNEL:=FIX(CHANNEL);
	STA    1   U.S00,3 	;   S00:=CHANNEL;
	LDA    2   U.STK,3
	LDA    2   +1,2
	.IFN	RCEXP
	LDA    0   +2,2		;
	STA    0   U.WXP,3	;
	.ENDC
	LDA    0   +0,2
	LDA    1   +1,2
	BCALL	   FIX		;   VALUE:=FIX(VALUE);
	LDA    0   U.S00,3 	;   AC0:=S00;
	MOVZL  0,0
	MOVR   1,1
	MOVR   0,0		;   AC0:=AC0+1B0*VALUE;
	DOA    0   DOT		;   DOA(AC0,DOT);
	  RET1			; END;
«ff»

**	.ENDC
**	.IFN	RCRED

DST=	  56			; DIGITAL SENSE TERMINAL

RED01:	  2
	  REAL
	  REAL+REFERENCE

	LDA    2   +0,2		; BEGIN
	.IFN	RCEXP
	LDA    0   +2,2		;
	STA    0   U.WXP,3	;
	.ENDC
	LDA    0   +0,2
	LDA    1   +1,2
	BCALL	   FIX		;   CHANNEL:=FIX(CHANNEL);
	DOB    1   DST		;   DOB(CHANNEL,DST);
	DIA    1   DST		;   DIA(AC1,DST);
	MOVR   1,1
	SUBCL  1,1		;   AC1:=AC1B15;
	SUB    0,0		;   AC0:=0;
	BCALL	   FLOAT	;   AC0,AC1:=FLOAT(AC0,AC1);
	LDA    2   U.STK,3
	LDA@   2   +1,2
	STA    2   RCR01	;   ADDR:=ADDRESS(RESULT);
	LDA    2   CUR
	  A.PDOUBLE		;   RESULT:=AC0,AC1;
	  1
RCR01:	  0
	  RET1			; END;
«ff»

**	.ENDC
**	.IFN	RCSTK
PUSH:	  2			; PROCEDURE PUSH
	  ARRAY+REAL		; (VAR A: ARRAY OF REAL;
	  REAL			;      X: REAL);
	SUBZL   1,1		; BEGIN
	  CALL			;
	  PSPOP			;   ADJUST(1,ADDRESS);
	  RET0			;   IF ERROR THEN RETURN0;
	STA    1   PSH01	;
	LDA    0   +3,2		;
	LDA    1   +4,2		;
	.IFN	RCEXP
	LDA    2   +5,2		;
	STA    2   PSH02	;
	LDA    2   CUR		;
	  A.PTRIPLE		;
	  1
PSH01:	  0
PSH02:	  0			;
	.ENDC
	.IFE	RCEXP
	LDA    2   CUR		;
	  A.PDOUBLE		;   A(A(1)):=X
	  1			;
PSH01:	  0			;
	.ENDC
	  RET1			; END;

POP:	  2			; PROCEDURE POP
	  ARRAY+REAL		; ( VAR A: ARRAY OF REAL;
	  REFERENCE+REAL	;   VAR X: REAL);
	ADC    1,1		; BEGIN
	  CALL			;   ADJUST(-1,ADR);
	  PSPOP			;
	  RET0			;   IF ERROR THEN RETURN0;
	SUBZL  0,0		;
	LDA    2   CUR		;
	INC    1,1		;
	INC    1,1		;
	.IFN	RCEXP
	INC    1,1		;
	  A.GTRIPLE		;   VALUE:=A(A(1)+1);
	.ENDC
	.IFE	RCEXP
	  A.GDOUBLE		;   VALUE:=A(A(1)+1);
	.ENDC
	LDA    3   U.STK,3	;
	LDA@   3   +1,3		;   ADDR:=ADDRESS(X);
	STA    3   POP01	;
	.IFN	RCEXP
	STA    2   POP02	;
	LDA    2   CUR		;
	  A.PTRIPLE		;
	  1
POP01:	  0			;
POP02:	  0			;
	.ENDC
	.IFE	RCEXP
	  A.PDOUBLE		;   X:=VALUE
	  1			;
POP01:	  0			;
	.ENDC
	  RET1			; END;
«ff»
;

PSPOP:	LDA    2   +0,2		; PROCEDURE ADJUST(ADD,
				;              ADDRESS);

	STA    1   U.S00,3	; BEGIN
	LDA    1   +0,2		;   S00:=ADD;
	SUBZL  0,0		;
	LDA    2   CUR		;
	.IFN	RCEXP
	  A.GTRIPLE		;   VALUE:=A(1);
	.ENDC
	.IFE	RCEXP
	  A.GDOUBLE		;   VALUE:=A(1);
	.ENDC
	BCALL	   FIX		;   VALUE:=FIX(VALUE);
	LDA    0   U.S00,3	;
	ADD    0,1		;   VALUE:=VALUE+ADD;
	LDA@   2   U.STK,3	;
	LDA    0   +1,2		;
	SGE    1,0		;   IF (VALUE>=A(1)) OR
	MOVZL  1,0 SZC		;      (VALUE<0) THEN
	JMP	   ER31		;        ERROR(31);
	ADD    1,0		;
	LDA    2   +0,2		;        ! INDEX ERROR!
	ADD    2,0		;   ADDRESS:=A.ADR+VALUE*2;
	STA    0   U.S00,3	;
	STA    2   PSP01	;
	SUB    0,0		;
	BCALL	   FLOAT	;   VALUE:=FLOT(VALUE);
	.IFE	RCEXP
	LDA    2   CUR		;
	  A.PDOUBLE		;   A(1):=VALUE
	  1			;
PSP01:	  0			;
	.ENDC
	.IFN	RCEXP
	STA    2   PSP02
	LDA    2   CUR
	  A.PTRIPLE
	  1
PSP01:	  0
PSP02:	  0			;
	.ENDC
	LDA@   2   U.STK,3	;
	LDA    1   U.S00,3	;
	  RET1			; END;

ER31:	  ERROR			; ERROR:  SET ERRORCODE;
	  31.			;         RETURN0;
«ff»

**	.ENDC
**	.IFN	RCEX
EXAM:	  2			; PROCEDURE EXAM
	  REAL			; ( ADDR : REAL;
	  REAL+REFERENCE	;   VAR X : REAL);

				; BEGIN
	LDA    0   U.PRT,3	;   (* PROTECTION MASK *)
	SZ     0,0		;   IF PROTECT SET THEN
	JMP	   ER49		;      ERROR 049
	LDA    2   +0,2		; 
	.IFN	RCEXP
	LDA    0   +2,2		;
	STA    0   U.WXP,3	;
	.ENDC
	LDA    0   +0,2		;   GET(ADDR);
	LDA    1   +1,2		;
	BCALL	   FIX		;   FIX(ADDR);
	SUB    0,0		;
	MOV    1,2		;
	LDA    1   +0,2		;   X:=ADR.ADDR;
	BCALL	   FLOAT	;   FLOAT(X);
	.IFN	RCEXP
	STA    2   EX02
	.ENDC
	LDA    2    U.STK,3	;
	LDA@   2    +1,2	;
	STA    2    EX01	;
	LDA    2    CUR		;
	.IFE	RCEXP
	  A.PDOUBLE		;   STORE(X);
	.ENDC
	.IFN	RCEXP
	  A.PTRIPLE
	.ENDC
	  1			;
EX01:	  0			;
	.IFN	RCEXP
EX02:	  0
	.ENDC
	  RET1			; END;

ER49:	  ERROR			; FACILITY PROTECTED
	  49.
«ff»
	.ENDC
	.IFN	RCDEP
DEP:	2			; PROCEDURE DEPOSIT
	REAL			; ( ADDR	: REAL;
	REAL			;   CONTENS	: REAL);

	STA	2	U.S00,3	; BEGIN
	LDA	0	U.PRT,3	;
	SZ	0,0		; IF PROTECT SET THEN
	JMP	ER49		; ERROR 049;
	LDA	2	+0,2	;
	.IFN	RCEXP		;
	LDA	0	+2,2	;
	STA	0	U.WXP,3	;
	.ENDC			;
	LDA	0	+0,2	;
	LDA	1	+1,2	; GET(ADDR);
	BCALL	FIX		; FIX(ADDR);
	STA	1	U.S01,3	;
	ISZ		U.S00,3	;
	LDA	2	U.S00,3	;
	LDA	2	+0,2	;
	.IFN	RCEXP		;
	LDA	0	+2,2	;
	STA	0	U.WXP,3	;
	.ENDC			;
	LDA	0	+0,2	;
	LDA	1	+1,2	; GET(CONTENS);
	BCALL	FIX		; FIX(CONTENS);
	STA@	1	U.S01,3	; CORE(ADDR):=CONTENS;
	RET1			; RETURN;

**	.ENDC

	PRDE2 RC

«ff»
«nul»