Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap2_198111 - decus/20-0040/cobstd.old
There is 1 other file named cobstd.old in the archive. Click here to see a list.
	A=1
ST:	CALLI 0
	MOVEI 10,0
	SETZ 14,
	INIT 0,A
	SIXBIT/DSK/;INIT DSK FOR I/P
	XWD IBUF
	JRST ERR1
	INIT 1,A
	SIXBIT/DSK/;INIT DSK FOR O/P
	XWD OBUF,
	JRST ERR1
	CALLI 1,24;P.P.NO. IN ACC1
	MOVEM 1,E+3
TTCALL 3,[ASCIZ "
NAME OF COBOL FILE TO BE STANDARDIZED?"]
	MOVE P1,[POINT 6,E]
	TTCALL 11,;CLEAR TYPEOUT BUFFER
NAME:	TTCALL 0,3
	CAIN 3,15
	JRST .+4
	SUBI 3,40
	IDPB 3,P1
	JRST NAME
TTCALL 3,[ASCIZ "
NAME STANDARDIZED COBOL FILE IS TO BE CALLED?
"]
	MOVE P2,[POINT 6,E1]
	TTCALL 11,
OUTNAM: TTCALL 0,3
	CAIN 3,15
	JRST .+4
	SUBI 3,40
	IDPB 3,P2
	JRST OUTNAM
TTCALL 3,[ASCIZ "
"]
TTCALL 3,[ASCIZ "IF YOU WANT TO KEEP YOUR ORIGINAL
INDENTATIONS TYPE Y ELSE TYPE N
Y OR N?"]
	TTCALL 11,
	TTCALL 0,1
	TTCALL 3,[ASCIZ "
"]
	LOOKUP 0,E;LOOKUP FILE
	JRST ERR2
	ENTER 1,E1;ENTER FILE
	JRST ERR3
	JSR GETLIN
	MOVEI 7,0
	MOVEI 2,IDEN
	JSR COMPAR
	JSR OUTRT;O/P 7 SPACES & LINE
	JSR GETLIN
	CAIE 7,0
	JRST NOTID
DIVENV:	MOVEI 2,ENV;NOW THE ENVIROMENT DIV.
	JSR COMPAR
	CAIE 7,0
	JRST NOTENV
	JSR OUTRT
	JSR GETLIN
DIVDAT:MOVEI 2,DATA
	JSR COMPAR
	CAIE 7,0
	JRST NOTDAT
	JSR OUTRT
	JSR GETLIN
PRODIV:	MOVEI 2,PROCED
	JSR COMPAR
	CAIE 7,0
	JRST NOTPD
	JSR OUTRT
FINAL:JSR GETLIN
	MOVE P1,[POINT 7,WB1]
	MOVE P2,[POINT 7,WB2]
	ILDB 5,P1
	IDPB 5,P2
	CAIE 5,12;SKIP IF L.F.
	JRST FINAL+3
	JSR LABSEC
	JRST FINAL
NOTPD:	SETZ 7,
	MOVEI 2,FILSEC
	JSR COMPAR
	CAIE 7,0
	JRST WSSEC;NOT FILE SEC.
	JSR OUTRT;O/P F.S.
	MOVEI 7,0
	JSR GETLIN
	JRST PRODIV
WSSEC:	MOVEI 2,WORKS
	SETZ 7,
	JSR COMPAR
	CAIE 7,0
	JRST ODDS
	JSR OUTRT
	MOVEI 7,0
	JSR GETLIN
	JRST PRODIV
ODDS:	MOVE P1,[POINT 7,WB2]
	ILDB 5,P1
	CAIN 5,106;SKIP IF NOT F
	JRST FD;IF F TEST FOR FD
	CAIN 5,60;SKIP IF NOT 0
	JRST LEVEL;IF 0 TEST FOR LEVEL
	CAIN 5,123;SKIP IF S
	JRST .+3;IF S TEST FOR SD
	JSR LABSEC
	JRST BACK
	ILDB 5,P1
	CAIE 5,104;SKIP IF D
	JRST .+5;ORDINARY LINE
	JSR OUTRT
BACK:	SETZ 7,
	JSR GETLIN
	JRST PRODIV
	JSR LABSEC
	JRST BACK
FD:	ILDB 5,P1
	CAIE 5,104;SKIP IF FD
	JRST BACK+3
	JRST BACK-1
LEVEL:	ILDB 5,P1
	CAIE 5,61;SKIP IF LEVEL
	JRST BACK+3
	JRST BACK-1
COMPAR:	0;COMPARE WB1
	MOVE P1,[POINT 7,(2)]
	MOVE P2,[POINT 7,WB1]
	MOVE P3,[POINT 7,WB2]
NEXT:	ILDB 5,P2
IDPB 5,P3
	CAIN 5,15;SKIP IF NOT C.R.
	JRST KNOT
	ILDB 6,P1
	CAMN 5,6;SKIP IF NOT =
	JRST MAY;TRY NEXT BYTES
	MOVEI 7,1;SET SWITCH
FLIN:	ILDB 5,P2
	IDPB 5,P3
	CAIE 5,12;SKIP IF L.F.
	JRST FLIN
	JRST @ COMPAR;O/P LINE
CAR:	ILDB 5,P2
	IDPB 5,P3
	JRST @COMPAR
KNOT:	ILDB 5,P2
	IDPB 5,P3
	MOVEI 7,1
	JRST @COMPAR
MAY:	ILDB 5,P2
	CAIE 5,15
	JRST .+3
	IDPB 5,P3
	JRST CAR
	ILDB 6,P1
	CAME 5,6
	JRST .+3;NOT =
	IDPB 5,P3
	JRST MAY
	CAIE 6,0
	JRST FLIN-1;NOT NULL SO NOT =
	ILDB 5,P2
	CAIE 5,15
	JRST .-2;NOT C.R.
	IDPB 5,P3
	JRST CAR
OUTRT:	0
	SETZ 13,
	MOVE P3,[POINT 7,WB2]
	ILDB 5,P3
	CAIN 5,40
	JRST TEST
	MOVEI 7,1
	MOVEI 4,0
	MOVEI 3,40;SPACE
	JSR PUT
	IDPB 3,OBUF+1;O/P SPACE
	ADDI 13,1
ADDI 4,1
	CAIE 4,7;SKIP IF 7 SPACES O/P
	JRST OUTRT+9
	MOVEI 7,0
CHAR:	CAIN 5,15
	JRST .+6
JSR PUT
	IDPB 5,OBUF+1
	ADDI 13,1
	ILDB 5,P3
	JRST CHAR
	JSR PUT
	IDPB 5,OBUF+1
	ADDI 13,1
MOVEI 5,12
	JSR PUT
	IDPB 5,OBUF+1
	ADDI 13,1
	CAIL 13,110
	ADDI 14,1
	JRST @ OUTRT
TEST:	MOVEI 4,1
	ILDB 5,P3;2ND. BYTE
	ADDI 4,1
	CAIE 4,7
	JRST TEST+1
	CAIE 5,52;SKIP IF *
	JRST INDENT
	MOVE P3,[POINT 7,WB2]
	JRST  CHAR
INDENT: JSR OUTORD
	JRST @OUTRT
NOTID:	MOVEI 7,0;RESET COUNT
	JSR COMPAR;TRY AGAIN
	JSR OUTRT
	JSR GETLIN
	CAIN 7,0
	JRST DIVENV
	JRST NOTID
NOTENV:JSR OUTRT
	JSR GETLIN
	MOVEI 7,0
	JSR COMPAR
	CAIE 7,0
	JRST NOTENV
	JSR OUTRT
	JSR GETLIN
	JRST DIVDAT
NOTDAT:	JSR LABSEC
	MOVEI 7,0
	JSR GETLIN
	JRST DIVDAT
LABSEC:0
	MOVE P1,[POINT 7,WB2]
	ILDB 5,P1
	CAIN 5,56;SKIP IF NOT .
	JRST LABEL
	CAIN 5,40
	JRST SPAC;= SPACE SO TEST FOR SECTION
	JRST LABSEC+2;TRY NEXT BYTE
LABEL:	SETZ 7,
	MOVEI 2,EX
	MOVE P1,[POINT 7,WB2]
	MOVE P2,[POINT 7,(2)]
	ILDB 5,P1
	CAIN 5,15
	JRST .+6
	ILDB 6,P2
	CAMN 5,6
	JRST .-5;=
	JSR OUTRT;NOT EXIT SO LABEL
	JRST @LABSEC
	JSR OUTORD
	JRST @LABSEC
SPAC:	MOVEI 2,SECS
	MOVE P2,[POINT 7,(2)]
	ILDB 5,P1
	CAIN 5,15;SKIP IF NOT C.R.
	JRST LABEL
	ILDB 6,P2
	CAMN 5,6;SKIP IF NOT =
	JRST SPAC+2
	CAIE 6,0
	JRST .+3;NOT NULL SO NOT =
	JSR OUTRT
	JRST @LABSEC
	JSR OUTORD
	JRST @LABSEC
OUTORD:0
	SETZ 13,
	MOVE P1,[POINT 7,WB2]
	ILDB 5,P1
	CAIN 5,40;SKIP IF  NOT SPACE
	JRST TEST1
	SETZ 7,
	MOVEI 3,40
POKE:	JSR PUT
	IDPB 3,OBUF+1
	ADDI 13,1
	ADDI 7,1
	CAIE 7,^D11
	JRST POKE
	MOVE P1,[POINT 7,WB2]
CART:	ILDB 5,P1
	JSR PUT
	IDPB 5,OBUF+1
	ADDI 13,1
	CAIE 5,15;SKIP IF C.R.
	JRST CART
	MOVEI 5,12
	JSR PUT
	IDPB 5,OBUF+1
	ADDI 13,1
	CAIL 13,110
	ADDI 14,1
	JRST @OUTORD
TEST1:  MOVEI 4,1
	ILDB 5,P1
	ADDI 4,1
	CAIE 4,7
	JRST TEST1+1
	CAIN 5,52;SKIP IF *
	JRST CART-1;=*
	CAIN 1,131;SKIP IF NOT Y
	JRST POKE-2
	MOVE P1,[POINT 7,WB2];NOT * SO ORD. LINE WITH INDENTS.
	ILDB 5,P1
	CAIN 5,40
	JRST .-2;=SPACE
	SETZ 13,
	SETZ 7,
	MOVEI 3,40
OGRE:	JSR PUT
	IDPB 3,OBUF+1
	ADDI 13,1
	ADDI 7,1
	CAIE 7,^D11
	JRST OGRE
	JSR PUT
	IDPB 5,OBUF+1;NOT SPACE
	ADDI 13,1
	CAIN 5,12;SKIP IF NOT L.F.
	JRST  .+3
	ILDB 5,P1
	JRST .-6
	CAIL 13,110
	ADDI 14,1
	JRST @OUTORD
	E:0
  SIXBIT/CBL/
  0
  0
E1:0
   SIXBIT/CBL/
   0
   0
PUT:	0
	SOSLE OBUF+2
	JRST OK
	OUT 1,
	JRST OK
	JRST OUTERR
OK:	JRST @ PUT
GETLIN:0
	MOVE P2,[POINT 7,WB1]
	SOSLE IBUF+2;DECREMENT BYTE COUNT
	JRST GETOK
	IN 0,;GET NEXT BUF FROM MON.
	JRST GETOK
	STATZ 1,740000
	JRST INERR
	JRST INEOF;ASSUME EOF
GETOK:	ILDB 5,IBUF+1;GET CH. FROM BUF
	JUMPE 5,GETLIN+2
	CAIN 5,52;SKIP IF *
	JRST COM
	CAIN 5,55;SKIP IF -
	JRST COM
LINE:	CAIN 5,12;SKIP IF NOT L.F.
	JRST .+5
	CAIN 5,11
	JRST .+5
	IDPB 5,P2
	JRST INP
	IDPB 5,P2
	JRST @ GETLIN
	JSR HTAB
INP:	SOSLE IBUF+2;DECREMENT BYTE COUNT
	JRST OKY
	IN 0,
	JRST OKY
	STATZ 1,740000
	JRST INERR
	JRST INEOF
OKY:	ILDB 5,IBUF+1
	JRST LINE
HTAB:	0
	SETZ 7,
	MOVEI 5,40
	IDPB 5,P2
	ADDI 7,1
	CAIE 7,4
	JRST HTAB+3
	JRST @HTAB
COM:	MOVEI 3,40
	SETZ 4,
	IDPB 3,P2
	ADDI 4,1
	CAIE 4,6
	JRST COM+2
CONT:	IDPB 5,P2
	CAIN 5,12;SKIP IF L.F.
	JRST @GETLIN
	ILDB 5,IBUF+1
	CAIN 5,11
	SKIPA
	JRST CONT
	JSR HTAB
	JRST CONT+3
ERR1:	TTCALL 3,[ASCIZ "ERR. IN INIT OF DSK"]
	JRST INEOF
ERR2:	TTCALL 3,[ASCIZ "ERR. IN LOOKUP OF FILE"]
	JRST INEOF
ERR3:	TTCALL 3,[ASCIZ "ERR. IN ENTER OF FILE"]
	JRST INEOF
OUTERR: TTCALL 3,[ASCIZ "ERR. IN O/P OF FILE"]
	JRST INEOF
OBUF:BLOCK 3
IBUF:BLOCK 3
WB1:BLOCK 50
WB2:BLOCK 50
IDEN:ASCIZ/IDENTIFICATION DIVISION./
ENV:ASCIZ/ENVIRONMENT DIVISION./
DATA:ASCIZ/DATA DIVISION./
FILSEC:ASCIZ/FILE SECTION./
WORKS:ASCIZ/WORKING-STORAGE SECTION./
PROCED:ASCIZ/PROCEDURE DIVISION./
EX:ASCIZ/EXIT./
SECS:ASCIZ/SECTION./
INERR:	TTCALL 3,[ASCIZ "ERR. IN I/P OF FILE"]
	JRST INEOF
P3=15
P2=17
P1=16
STACK:BLOCK 20
INEOF:TTCALL 3,[ASCIZ "THERE ARE "]
	MOVE 17,[XWD-20,STACK]
	PUSHJ 17,DECPNT
	RELEAS 0,
	RELEAS 1,
	TTCALL 3,[ASCIZ "LINES THAT ARE TOO LONG.PLEASE CORRECT"]
	CALLI 12
DECPNT:IDIVI 14,12
	PUSH 17,15
	SKIPE 14
	PUSHJ 17,DECPNT
DECPN1:POP 17,14
	ADDI 14,60
	TTCALL 1,14
	POPJ 17,
	ENDSTp