Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/libsim/lookah.mac
There is 1 other file named lookah.mac in the archive. Click here to see a list.
COMMENT * SIMULA specification;
OPTIONS(/E:CODE,NOCHECK,lookahead);
CHARACTER PROCEDURE lookahead;
! INSPECT fileref DO
! BEGIN
! IF Lastitem THEN
! lookahead:=' ' ELSE
! BEGIN
! lookahead:= Inchar;
! Setpos(Pos-1)
! END;
COMMENT * ;! MACRO-10 code * ;!
TITLE lookahead
SUBTTL SIMULA utility, Lars Enderin Sept 1975
;!*** Copyright 1975 by the Swedish Defence Research Institute. ***
;!*** Copying is allowed. ***
ENTRY lookahead
sall
search simmcr,simmac
macinit
IMG==4 ;! Offset of image in file object
DEFINE parvalue(x,par,map)<
L x,par(XCB)
IF ;! No thunk
JUMPGE x,FALSE
THEN ;! Simple access
ADDI x+1,(x)
LD x,(x+1)
ELSE ;! Use PHFV
LI x,(XCB)
HRLI x,par
EXEC PHFV
.n.==x-XWAC1
IFE .n.,<Z>
IFN .n.,<XWD .n.,[map]>
PURGE .n.
FI
>
result==ZBI%S
fileref==result+1
lookahead:
PROC
SKIPN fileref+2(XCB)
SKIPN fileref(XCB)
RTSERR 106 ;! Not exactly one parameter
LF ,ZFLZQU(XCB,fileref)
IF ;! Not infile or directfile
CAIE IOIN
CAIN IODF
GOTO FALSE
THEN ;! Wrong qualification
RTSERR 111
FI
parvalue(XWAC1,fileref)
IF ;! not NONE
CAIN XWAC1,NONE
GOTO FALSE
THEN
L XWAC3,XWAC1
IF ;! Lastitem
LI XTAC,XWAC1
EXEC IOLI
JUMPE XWAC1,FALSE
THEN ;! lookahead:=' '
LI XWAC1," "
ELSE
LD XWAC1,IMG(XWAC3)
SETZ X1,
LF X0,ZTVSP(,XWAC1)
ADDI (XWAC2)
IF JUMPE FALSE
THEN IDIVI 5
ADD XWAC1,X0
FI
HLL XWAC1,ptab+1(X1)
ADDI XWAC1,2
LDB XWAC1,XWAC1
FI FI
ST XWAC1,result(XCB)
BRANCH CSEP
EPROC
ptab: POINT 7,2,-1
POINT 7,2,6
POINT 7,2,13
POINT 7,2,20
POINT 7,2,27
POINT 7,2,34
LIT
END;