!* MODIFIED 10/08/77 08.00
!*
OWNINTEGER INMARG1=1, INMARG2=72, OUTMARG1=1, OUTMARG2=120
OWNINTEGER CONTROL;! 0 INCLUDE CONTROL CHARS IN LENGTH,1 EXCLUDE
OWNBYTEINTEGERARRAY INPUTBUFF(0:160)
OWNBYTEINTEGERARRAY RCHBUFF(0:160)
OWNINTEGER PTR=1
CONSTBYTEINTEGERARRAY OTRTAB(0:127)=C
26(10),10,26(14),25,26,26(5),
32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,
48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,
64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,
80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,
96,97,98,99,100,101,102,103,104,105,106,107,108,109,
110,111,112,113,114,115,116,117,118,119,
120,121,122,123,124,125,126,26;
CONSTBYTEINTEGERARRAY ITRTAB(0:127)=C
X'80'(10),10,X'80'(14),25,26,X'80'(5),
32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,
48,49,50,51,52,53,54
,55,56,57,58,59,60,61,62,63,
64,65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,
80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,
96,97,98,99,100,101,102,103,104,105,106,107,108,109,
110,111,112,113,114,115,116,117,118,119,
120,121,122,123,124,125,126,X'80';
OWNBYTEINTEGERARRAY OUTPUTBUFF(0:132)=10,0(132)
OWNINTEGER OUTPTR=1
OWNINTEGER NLFLAG=1
OWNINTEGER SUBCHAR=0
OWNINTEGER EMFLAG=0
SYSTEMROUTINESPEC SIM2(INTEGER
EP, R1, R2,INTEGERNAME R3)
ROUTINESPEC OUTPUTRECORD
SYSTEMINTEGERFN IOCP(INTEGER EP, N)
SYSTEMROUTINESPEC SIGNAL(INTEGER EP, WT, EXTRA, INTEGERNAME FLAG)
INTEGER FLAGS, FLAG, I, LENGTH, X, Q, L, CH, F
SWITCH SW(1:20)
UNLESS 1<=EP<=19 THEN SIGNAL(2,148,0,FLAG) AND STOP
->SW(EP)
SW(1): ! READ SYMBOL(X)
IF NLFLAG=1 THEN X=IOCP(6,0) AND NLFLAG=0
UNTIL X#X'80' CYCLE
X=INPUTBUFF(PTR)
P
TR=PTR+1
REPEAT
IF X=NL THEN NLFLAG=1
RESULT =X
SW(2): ! X=NEXT SYMBOL
IF NLFLAG=1 THEN X=IOCP(6,0) AND NLFLAG=0
WHILE INPUTBUFF(PTR)=X'80' THEN PTR=PTR+1
RESULT =INPUTBUFF(PTR)
SW(3): ! PRINT SYMBOL(N)
IF N=10 THEN ->OUTPUT
OUTPUTBUFF(OUTPTR)=OTRTAB(N&X'7F')
OUTPTR=OUTPTR+1
IF OUTPTR>OUTMARG2 THENSTART
OUTPUTBUFF(OUTPTR)=10
OUTPUTRECORD
FINISH
END1: RESULT =0
SW(4): ! READ CH(X)
SW(18): ! NEXT CH (FOR ALGOLE
IF NLFLAG=1 THEN X=IOCP(6,0) AND NLFLAG=0
X=RCHBUFF(PTR)
IF EP=18 THEN RESULT =X
IF X=NL THEN NLFLAG=1
PTR=PTR+1
RESULT =X
SW(5): ! PRINT CH(N)
IF (N=10 OR N=12 OR N=13) T
HEN START
OUTPUT: OUTPUTBUFF(OUTPTR)=N
IF CONTROL=0 THEN OUTPTR=OUTPTR+1
OUTPUTRECORD; OUTPUTBUFF(0)=N
->END2
FINISH
OUTPUTBUFF(OUTPTR)=N
OUTPTR=OUTPTR+1
IF OUTPTR>OUTMARG2 THEN START
OUTPUTBUFF(OUTPTR)=10
OUTPUTRECORD; OUTPUTBUFF(0)=10
FINISH
END2: RESULT =0
SW(6): ! LINE RECONSTRUCTION
PTR=1
I
F EMFLAG=1 THEN START
SIGNAL(2,140,0,FLAG); STOP
FINISH
!******READ A RECORD INTO RCHBUFF******
SIM2(0,ADDR(RCHBUFF(1)),0,L)
!******SET FIRST BYTES OF BUFFERS TO LENGTH OF RECORD******
IF L=0 THEN L=160
RCHBUFF(0)=L
INPUTBUFF(0)=L
!******TEST FOR EM IN INPUT RECORD******
IF RCHBUFF(PTR)=25 THEN START
INPUTBUFF(0)=2; EMFLAG=1
INPUTBUFF(2)=10
INPUTBUFF(1)=25; ->JUMP
FINISH
!******THE FOLLOWING MARKS CHARACTERS NOT CONTAINED IN IMP CHAR SET****
!******WHILST COPYING RECORD FROM RCHBUFF INTO INPUTBUFF******
! %CYCLE I=1,1,INPUTBUFF(0)
! X=RCHBUFF(I)
! %IF X=X'1A' %THEN SUBCHAR=1
! INPUTBUFF(I)=ITRTAB(X)
! %REPEAT
X=X'180000FF'
*LD_INPUTBUFF; *INCA_=1
*LSD_RCHBUFF; *IAD_=1
*LDB_L; *STD_TOS
*MV_L =DR ; ! COPY RCHBUFF TO INPUTBUFF
*LD_TOS ; *LSS_ITRTAB+4; *LUH_X
*STD_TOS ; *SWNE_L =DR ,128,26; ! CHECK FOR SUB
*JCC_8,<NOSUB>
*LB_=1; *STB_SUBCHAR
NOSUB: *LD_TOS ; *TTR_L =DR
IF (SUBCHAR=1 OR L=0) THEN ->JUMP
!******FOLLOWING MARKS TO LEFT & RIGHT OF INMARG1 & INMARG2******
UNLESS INMARG1=1 THEN START
CYCLE I=1,1,INMARG1-1
INPUTBUFF(I)=X'80'
REPEAT
FINISH
IF INMARG2<L-1 THEN START
CY
CLE I=INMARG2+1,1,L-1
INPUTBUFF(I)=X'80'
REPEAT
L=INMARG2
FINISH
!!******THE FOLLOWING CARRIES OUT THE DELETION RULES******
! %CYCLE I=1,1,L
! Q=I
! %IF INPUTBUFF(Q)=34 %THEN %START
! INPUTBUFF(Q)=X'80'
!BACK: %IF (Q-1)<1 %THEN ->NEXT2
! %IF INPUTBUFF(Q-1)=X'80' %THEN Q=Q-1 %AND ->BACK
! INPUTBUFF(Q-1)=X'80'
! %FINISH
!NEXT2: %
REPEAT
!******THE FOLLOWING MARKS TRAILING SPACES BEFORE NEWLINE******
! %CYCLE I=L-1,-1,1
! %IF INPUTBUFF(I)=32 %THEN INPUTBUFF(I)=X'80'
! %EXIT %UNLESS INPUTBUFF(I)=X'80'
! %REPEAT
*LD_INPUTBUFF; *LB_L; *SBB_=1
DTRS: *LSS_(DR +B ); *ICP_=32
*JCC_7,<NOTSP>
*LSS_=128; *ST_(DR +B ); *DEBJ_<DTRS>
NOTSP: *ICP_=128; *JCC_7,<JUMP>; *DEBJ_<DTRS>
!******RECONSTRUCTION NOW COMPLETE******
!******TEST FOR SUB CHAR IN INPUT******
JUMP:
I=ADDR(INPUTBUFF(0))
IF SUBCHAR=1 THEN START
SUBCHAR=0; SIGNAL(2,144,0,FLAG)
STOP
FINISH
RESULT =I
SW(15): ! RESTRICTED PRINTSTRING
! STRING MUST HAVE NO UNPRINTABLES
! OR CONTROLS (XCEPT LAST CHAR)
! AND MAY NOT EXCEED MARGINS
X=X'180000FF'
L=BYTE INTEGER(N)
*
LD_OUTPUTBUFF; *MODD_OUTPTR; ! TO RECEIVE STRING
*LDB_L
*STD_TOS ; *STD_TOS
*LDA_N; *INCA_=1; *CYD_=0
*LD_TOS ; *MV_L =DR
*LD_TOS ; *LSS_OTRTAB+4
*LUH_X; *TTR_L =DR
*INCA_=-1
*LSS_(DR ); *ST_X
OUTPTR=OUTPTR+L
OUTPTR=OUTPTR-1 AND OUTPUT RECORD IF X=10
RESULT =0
!
! CAN DELETE M-C CODE AND ALLOX SW(15) TO DROP THRO TO SW(7)
! IF REQUIRED FOR ALL IMP VERSION
!
SW(7): ! PRIN
T STRING(N) WHERE
! N IS ADDRESS OF STRING
L=BYTEINTEGER(N)
IF L=0 THEN RESULT =0
CYCLE I=1,1,L
CH=BYTEINTEGER(I+N)&X'7F'
IF CH=10 THEN OUTPUT RECORD ELSE START
OUTPUTBUFF(OUTPTR)=OTRTAB(CH)
OUTPTR=OUTPTR+1
IF OUTPTR>OUTMARG2 THEN OUTPUT RECORD
FINISH
REPEAT
RESULT =0
SW(8):
! SELECT INPUT(N)
INPUTBUFF(0)=0
EMFLAG=0; NLFLAG=1
SIM2(15,0,N,FLAGS)
IF FLAGS<0 THEN START
SIGNAL(2,152,0,FLAG)
STOP
FINISH
INMARG1=(FLAGS>>8)&X'FF'
INMARG2=FLAGS&X'FF'
RESULT =0
SW(9): ! SELECT OUTPUT(N)
OUTPUTRECORD UNLESS (OUTPUTBUFF(0)=10 AND OUTPTR=1)
SIM2(15,1,N,FLAGS)
IF FLAGS<0 THEN START
SIGNAL(2,152,0,FLAG)
STOP
FINISH
OUTMARG1=(FLAGS>>8)&X'FF'
OUTMARG2=FLAGS&X'FF'
IF OUTMARG2=0 THENSTART
OUTMARG2=132
CONTROL=0
FINISHELSE CONTROL=1
RESULT =0
SW(10): ! ISOCARD(N) WHERE N IS THE
! ADDRESS OF BUFFER CARD READ INTO
SIM2(0,ADDR(INPUTBUFF(0)),0,LENGTH)
IF INPUTBUFF(
0)=25 THEN START
SIGNAL(2,140,0,FLAG); STOP
FINISH
CYCLE I=0,1,LENGTH-2
BYTEINTEGER(N+I)=INPUTBUFF(I)
REPEAT
INPUTBUFF(0)=0
RESULT =0
SW(11): ! OUTPUT THE CURRENT RECORD
UNLESS N=-2 THENSTART ;! EXCEPT SPECIAL OUTPUT INT CALL
OUTPUTBUFF(OUTPTR)=10
IF CONTROL=0 THEN OUTPTR=OUTPTR+1
IF N>=0 THEN SIM2(1,ADDR(OUTPUTBUFF(0))
,OUTPTR,F)
EMFLAG=0; NLFLAG=1
INMARG1=1; INMARG2=72
FINISHELSE CONTROL=1;! TERMINATING CONTROL CHAR NOT IN LENGTH
OUTMARG1=1; OUTMARG2=132
OUTPTR=1
OUTPUTBUFF(0)=10
RESULT =0
SW(12): ! SET INPUT MARGINS
FLAGS=0
INMARG1=(N>>16)&X'FF'
INMARG2=N&X'FF'
SIM2(16,0,(INMARG1<<8)!INMARG2,FLAGS)
RESULT =0
SW(13):
! SET OUTPUT MARGINS
FLAGS=0
OUTMARG1=(N>>16)&X'FF'
X=IOCP(5,10); ! OUTPUT NEWLINE
OUTMARG2=N&X'FF'
SIM2(16,1,(OUTMARG1<<8)!OUTMARG2,FLAGS)
IF OUTMARG2=0 THENSTART
OUTMARG2=132
CONTROL=0
FINISHELSE CONTROL=1
RESULT =0
SW(14): ! ADDRESS OF RECORD AS READ IN
RESULT =ADDR(RCHBUFF(0))
SW(16):
! CLOSE STREAM(N)
SIM2(17,N,0,FLAGS)
RESULT =0
SW(17): ! REPEATED PRINT SYMBOL
RESULT =0 IF N<0 OR N>>8=0
CYCLE I=1,1,N>>8
X=IOCP(3,N&127)
REPEAT
RESULT =0
SW(19): ! GET CURRNET MARGINS
RESULT =((INMARG1<<8!INMARG2)<<8!OUTMARG1)<<8!OUTMARG2
SW(20): ! GET POSITION OF INPUT OR OUTPUT POINTER
IF N=0 THEN RESULT =PTR;! INPUT POINTER
RESULT =OUTPTR;! OUTPUT POINTER
END
ROUTINE OUTPUTRECORD
INTEGER F, I
SIM2(1,ADDR(OUTPUTBUFF(0)),OUTPTR,F)
OUTPTR=OUTMARG1
OUTPUTBUFF(0)=10
I=1
WHILE I<OUTMARG1 THEN OUTPUTBUFF(I)=' ' AND I=I+1
END
ENDOFFILE