Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/libsim/read.mac
There are 5 other files named read.mac in the archive. Click here to see a list.
00100 COMMENT ! SIMULA specification;
00200 OPTIONS(/EXTERNAL:CODE,NOCHECK,read);
00300 PROCEDURE read;
00400
00500 !;! MACRO-10 code !
00600
00700 TITLE read
00800 SUBTTL SIMULA utility, Lars Enderin Nov 1975
00900
01000 ;!*** Copyright 1975 by the Swedish Defence Research Institute. ***
01100 ;!*** Copying is allowed. ***
01200
01300 SEARCH simrpa,simmcr,simmac
01400 sall
01500 macinit
01600 ENTRY read
01700
01800 Comment/
01900 Reads items into successive parameters from the current Infile or Directfile.
02000 The current file is initially Sysin, but may be changed by giving another
02100 Infile or Directfile reference as parameter. The other parameters may be of type
02200 INTEGER, REAL, LONG REAL or CHARACTER. Inint, Inreal or Inchar is used depending
02300 on the parameter type. Since the procedure is specified NOCHECK, all parameters
02400 are passed by name. Arrays of suitable types are allowed as parameters.
02500 /
02600 DEFINE NOTHUNK(X)<JUMPGE X,FALSE>
02700 Xtyp==XWAC10
02800 Xkind==XWAC11
02900 XN==Xkind+1
03000
03100 OPDEF readitem [PUSHJ XPDP,readitem]
03200
03300
03400 read:
03500 PROC
03600 LOWADR
03700 L XWAC2,YSYSIN(XLOW) ;! Default input file
03800 HRLI XWAC1,2 ;! Dynamic addr of ZFL
03900 HRRI XWAC1,(XCB)
04000
04100 WHILE ;! More parameters
04200 CAML XWAC1,[^D32+1,,0]
04300 GOTO FALSE
04400 HLRZ X1,XWAC1
04500 ADDI X1,(XWAC1) ;! abs addr of ZFL
04600 SKIPN (X1) ;! No more if ZFL=0
04700 GOTO FALSE
04800 DO
04900 WLF ,ZFLAKD(X1) ;! 1st ZFL word to X0
05000 LF Xkind,ZFLAKD ;! Kind
05100 LF Xtyp,ZFLATP ;! Type
05200 IF ;! type is REF
05300 CAIE Xtyp,QREF
05400 GOTO FALSE
05500 THEN ;! It has to be NONE, Infile or Directfile
05600 L XWAC2,XWAC1
05700 EXEC PHFV ;! Get file ref
05800 XWD 1,[1B0] ;! preserves ZFL address
05900 IF ;! NONE
06000 CAIE XWAC2,NONE
06100 GOTO FALSE ;! [145]
06200 THEN ;! Assume Sysin
06300 LOWADR
06400 L XWAC2,YSYSIN(XLOW)
06500 ELSE ;! Check qualification
06600 HLRZ X1,XWAC1
06700 ADDI X1,(XWAC1)
06800 LF ,ZFLZQU(X1)
06900 IF ;! Not Infile or Directfile
07000 CAIE IOIN
07100 CAIN IODF
07200 GOTO FALSE
07300 THEN ;! Error!
07400 RTSERR 111 ;! Wrong qualification
07500 FI FI
07600 ELSE ;! Expressions are not allowed
07700 IFONA ZFLVTD
07800 RTSERR 100 ;! Illegal assignment implied
07900 IF
08000 NOTHUNK
08100 THEN ;! Compute parameter address directly
08200 LF XWAC3,ZFLOFS(X1)
08300 ADD XWAC3,OFFSET(ZFLZBI)(X1)
08400 CAIN Xkind,QARRAY
08500 L XWAC3,(XWAC3) ;! Array address
08600 ELSE ;! Evaluate thunk for the address
08700 L XWAC3,XWAC1
08800 LI X1,PHFA ;! For simple items
08900 CAIN Xkind,QARRAY
09000 LI X1,PHFM ;! For arrays
09100 EXEC 0(X1)
09200 XWD 2,[1B0+1B1]
09300 HLRZ XWAC4,XWAC3 ;! Abs address from
09400 ADDI XWAC3,(XWAC4) ;! dynamic address
09500 HLRZ X1,XWAC1 ;! Reload X1, Xtyp
09600 ADDI X1,(XWAC1)
09700 LF Xtyp,ZFLATP(X1)
09800 FI
09900 L XWAC4,XWAC2 ;! Load top ac
10000 LI XTAC,XWAC4 ;! Specify top ac
10100 IF ;! Kind is simple
10200 CAIE Xkind,QSIMPLE
10300 GOTO FALSE
10400 THEN ;! input one item
10500 readitem
10600 ELSE ;! Must be array
10700 CAIE Xkind,QARRAY
10800 RTSERR 113
10900 LF XN,ZARSUB(XWAC3)
11000 IMULI XN,3
11100 LF ,ZARLEN(XWAC3)
11200 SUBI 3(XN)
11300 MOVN ;! Neg count
11400 ADDI XWAC3,3(XN)
11500 HRLM XWAC3 ;! AOBJN word
11600 IF ;! TEXT or LONG REAL
11700 CAIE Xtyp,QTEXT
11800 CAIN Xtyp,QLREAL
11900 GOTO TRUE
12000 GOTO FALSE
12100 THEN ;! 2 words at a time
12200 LOOP
12300 readitem
12400 AS
12500 AOBJP XWAC3,.+1
12600 AOBJN XWAC3,TRUE
12700 SA
12800 ELSE ;! One word
12900 LOOP
13000 readitem
13100 AS
13200 AOBJN XWAC3,TRUE
13300 SA
13400 FI FI
13500 FI
13600 ADD XWAC1,[2,,0]
13700 OD
13800 BRANCH CSES
13900 EPROC
14000 readitem:PROC
14100 L XWAC4,XWAC2 ;! Load top ac
14200 LI XTAC,XWAC4 ;! Specify top ac
14300 IF ;! INTEGER
14400 CAIE Xtyp,QINTEGER
14500 GOTO FALSE
14600 THEN ;! use Inint
14700 EXEC IOII
14800 ELSE
14900 IF ;! REAL or LONG REAL
15000 CAILE Xtyp,QLREAL
15100 GOTO FALSE
15200 THEN ;! use Inreal
15300 EXEC IOIR
15400 CAIN Xtyp,QLREAL
15500 ST 1+XWAC4,1(XWAC3) ;! Store second word
15600 ELSE
15700 IF ;! CHARACTER
15800 CAIE Xtyp,QCHARACTER
15900 GOTO FALSE
16000 THEN ;! use Inchar
16100 EXEC IOIC
16200 ELSE ;! Wrong type
16300 RTSERR 107
16400 FI FI FI
16500 ST XWAC4,(XWAC3) ;! Store (first word of) value
16600 RETURN
16700 EPROC
16800 END;