perm filename PONYSY.SAI[PNY,SYS]3 blob
sn#115934 filedate 1974-08-22 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00005 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "PONYSY"
C00005 00003 STRING PROCEDURE CENTS(INTEGER P)
C00010 00004 SIMPLE PROCEDURE NOECHO
C00014 00005 In case you were wondering, as I was, where this starts, you've found it
C00025 ENDMK
C⊗;
BEGIN "PONYSY"
REQUIRE "PHONEY.SAI[1,LES]" SOURCE_FILE;
PRELOAD_WITH "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP",
"OCT","NOV","DEC";
STRING ARRAY MONTH[1:12];
DEFINE ↓ = "'15&'12",
INTTY = "1",
LIM = "10",
TTYUUO = "'051000000000",
TOP = "300",
VMICONO = "'736600000000",
CALLI = "'47000000000";
LABEL START, RETRY0, RETRY, STOP, AGAIN;
INTEGER ARRAY REC,PPN,KEY[1:TOP],CDE,AMOUNT[1:LIM],CHARGF[0:5],DOOR[1:10];
STRING ARRAY NAME[1:TOP];
STRING S, MON, GOODS, AMT, S1, S2, SFOO;
INTEGER I, CNT, BRK, EOF, A, B, INCH, OUCH, C, PASS, DAY, N, FLAG,
NUM, N1, ID, K, NUMT, ZZ, KK, BN, ADR, LNGTH, D, TRY, TOTAL_FLAG;
STRING PROCEDURE CENTS(INTEGER P);
BEGIN STRING S;
IF P = 0 THEN RETURN("0");
S ← IF P < 0 THEN "-" ELSE "";
P ← ABS P;
IF P ≥ 100 THEN S ← S&CVS(P%100);
P ← P MOD 100;
RETURN(S&"."&("0"+P%10)&("0"+P MOD 10));
END;
PROCEDURE CHARGES(INTEGER NME); BEGIN
INTEGER TAMT,ZOT,CMAX,I;
INTEGER ARRAY TEMP[0:127];
LNGTH ← TAMT ← 0;
LOOKUP(OUCH,MON&".PNY[PNY,SYS]",FLAG);
IF ¬FLAG THEN BEGIN
FILEINFO(CHARGF);
LNGTH ← -(CHARGF[3] ROT 18);
END;
WHILE LNGTH>0 DO BEGIN
ARRYIN(OUCH,TEMP[0],128);
CMAX←(128 MIN LNGTH);
LNGTH←LNGTH-128;
FOR I←0 STEP 2 UNTIL CMAX-1 DO
IF NME=TEMP[I] LAND '777777000000 THEN BEGIN
ZOT ← TEMP[I+1];
START_CODE;
HRRE 1,ZOT;
ADDM 1,TAMT;
END;
END;
END;
OUT(INTTY,"TOTAL CHARGES FOR THE MONTH = "&CENTS(TAMT)&↓);
CLOSE(OUCH);
END;
SIMPLE PROCEDURE DATE;
BEGIN INTEGER D;
D ← CALL(0,"DATE");
DAY ← D MOD 31 + 1;
MON ← MONTH[(D←D DIV 31) MOD 12 + 1];
END;
STRING PROCEDURE LEFT(INTEGER L; STRING Z);
BEGIN STRING BLANKS;
BLANKS ← " ";
RETURN(IF LENGTH(Z) < L THEN Z&BLANKS[1 TO L-LENGTH(Z)] ELSE Z[1 TO L]);
END;
INTEGER PROCEDURE PASSWD(STRING P);
BEGIN INTEGER T;
IF (T ← CVSIX(P)) THEN WHILE (T LAND '77) = 0 DO T ← T LSH -6;
RETURN(T*T LAND '777777);
END;
STRING PROCEDURE ERROR(INTEGER E);
BEGIN
IF 0<E<8 THEN CASE E OF BEGIN
[1] OUT(INTTY,"YOU ARE NOT AN AUTHORIZED USER."&↓&↓);
[2] OUT(INTTY,"WRONG CODE ON ITEM "&GOODS&↓&
"ALLOWABLE CODES ARE M,C,D,B,V,S,T AND P "&↓&
"RETYPE CODES AND AMOUNTS = ");
[3] OUT(INTTY,"TYPOGRAPHICAL ERROR IN ITEM "&CDE[ZZ]&AMT&↓&
"RETYPE CODES AND AMOUNTS = ");
[4] OUT(INTTY,"ERROR IN ITEM "&CDE[ZZ]&AMT&↓&
"AMOUNT IS NOT IN NICKEL INCREMENTS. AMOUNT MUST BE IN "&↓&
"5 CENT INCREMENTS."&↓&
"CORRECT CODE AND AMOUNT = ");
[5] OUT(INTTY,"ERROR IN ITEM "&CDE[ZZ]&AMT&↓&
"AMOUNT MUST BE A MULTIPLE OF THE PRICE OF THE GOODS INDICATED."&↓&
"CORRECT CODE AND AMOUNT = ");
[6] OUT(INTTY,"ERROR IN ITEM "&CDE[ZZ]&AMT&↓&
"DONUTS SELL FOR 20 CENTS."&↓&
"CORRECT CODE AND AMOUNT = ");
[7] OUT(INTTY,"ERROR IN ITEM "&CDE[ZZ]&AMT&↓&
"PRICE DOES NOT MATCH ANY VENDING MACHINE PRICE."&↓&
"CORRECT CODE AND AMOUNT = ")
END;
IF 3<E<8 THEN BEGIN
GOODS ← INPUT(INTTY,1);
OUT(INTTY,↓);
ZZ ← ZZ -1;
IF LENGTH(GOODS) THEN GO TO RETRY;
END;
IF 1<E<4 THEN BEGIN
S ← INPUT(INTTY,1);
OUT(INTTY,↓);
IF LENGTH(S) THEN GO TO RETRY0;
END;
GO TO START;
END;
SIMPLE PROCEDURE NOECHO;
Comment Turn off echo;
START_CODE;
GETSTS INTTY,1;
TRO 1,'600;
SETSTS INTTY,(1);
END;
SIMPLE PROCEDURE ECHO;
Comment Turn on echo;
START_CODE;
GETSTS INTTY,1;
TRZ 1,'600;
SETSTS INTTY,(1);
END;
PROCEDURE NEWPASS(INTEGER AA,MAX,NM);
COMMENT AA IS PPN ARRAY PLACE, MAX IS MAX SIZE OF ARRAY, NM IS PPN;
BEGIN INTEGER AP,LINCHR; LABEL SKIP;
NOECHO;
OUT(INTTY,"NEW PASSWORD = ");
PASS ← PASSWD(INPUT(INTTY,1));
ECHO;
OUT(INTTY,↓);
IF (PPN[AA] LAND '777777) THEN BEGIN
AP ← PPN[AA] LAND '777777;
KEY[AP] ← (NM LAND '777777000000) LOR PASS;
END
ELSE IF C < MAX THEN BEGIN
KEY[C←C+1] ← (NM LAND '777777000000) LOR PASS;
PPN[AA] ← PPN[AA] LOR C;
END
ELSE BEGIN OUT(INTTY,"PASSWORD FILE CONTAINS "&CVS(C)&
" ENTRIES. PLEASE NOTIFY THE FRONT OFFICE OF THIS."&↓&
"YOU WILL BE UNABLE TO ENTER A PASSWORD UNTIL THE PROGRAM IS CHANGED"&↓);
GO TO SKIP;
END;
ENTER(INCH,"KEYWD[PNY,SYS]",FLAG);
IF FLAG THEN BEGIN
OUT(INTTY,"CANNOT ENTER FILE KEYWD[PNY,SYS]. PLEASE NOTIFY THE FRONT OFFICE"&↓&
"OF THIS. YOU WILL BE UNABLE TO USE THE TELETYPE TO ENTER CHARGES. SORRY");
GO TO STOP;
END;
ARRYOUT(INCH,KEY[1],C);
CLOSE(INCH);
SKIP:
END;
PROCEDURE FIXKEY; BEGIN
IF (PPN[1] LAND '777777) ≤ 0 THEN NEWPASS(A,TOP,ID)
ELSE BEGIN
OUT(INTTY,"PPN = ");
ID ← CVSIX(LEFT(3,INPUT(INTTY,1)));
OUT(INTTY,↓);
FOR A ← 1 STEP 1 UNTIL C DO
IF ID = KEY[A] LAND ('777777000000) THEN DONE;
IF A > C THEN ERROR(1)
ELSE KEY[A] ← ID;
END;
GO TO START;
END;
PROCEDURE PRICE_DOOR; BEGIN
OUT(INTTY,"NUMBER OF PRICE BAR TO BE SET = ");
K ← CVD(INPUT(INTTY,1));
WHILE 0<K<10 DO BEGIN
OUT(INTTY,"CURRENT PRICE = "&CVS(DOOR[K])&↓);
OUT(INTTY,"PRICE TO BE SET = ");
DOOR[K] ← CVD(INPUT(INTTY,1));
OUT(INTTY,"NUMBER OF PRICE BAR TO BE SET = ");
K ← CVD(INPUT(INTTY,1));
END;
ENTER(INCH,"DOORP[PNY,SYS]",FLAG);
IF FLAG THEN BEGIN
OUT(INTTY,"CANNOT ENTER FILE DOORP[PNY,SYS]."&↓&↓);
GO TO START;
END;
ARRYOUT(INCH,DOOR[1],10);
CLOSE(INCH);
OUT(INTTY,↓);
GO TO START;
END;
COMMENT In case you were wondering, as I was, where this starts, you've found it;
DATE;
C ← 0;
START_CODE;
SETOM D;
TTYUUO 6,D;
END;
Comment If we're attached to a real console, ask if we want to talk to tty4;
IF D≠-1 THEN BEGIN
OUTSTR("Type Y to use TTY4, else use attached tty: ");
SFOO←INCHWL; IF SFOO="Y" OR SFOO="y" THEN D←-1;
END;
Comment INIT the TTY we're using. 400 bit means don't wait for it;
OPEN(INTTY,IF D = -1 THEN "TTY4" ELSE "TTY",'401,1,1,CNT←200,BRK,EOF);
IF EOF THEN GO TO STOP; Comment in case open failed;
Comment Repair TTY IOS;
START_CODE;
SETSTS INTTY,1;
END;
OPEN(INCH←GETCHAN,"DSK",'10,4,4,CNT←200,BRK,EOF);
IF EOF THEN BEGIN
OUT(INTTY,"CANNOT OPEN INPUT DISK FILE");
GO TO STOP;
END;
Comment Zero the keyword array. If keyword file exists, read it into keyword array;
KEY[2]←0; ARRBLT(KEY[3],KEY[2],TOP-2);
LOOKUP(INCH,"KEYWD[PNY,SYS]",FLAG);
IF ¬FLAG THEN BEGIN "SETC"
ARRYIN(INCH,KEY[1],TOP+1);
C ← EOF LAND '777777;
CLOSE(INCH);
END;
FOR N ← 1 STEP 1 UNTIL 10 DO DOOR[N] ← 0;
LOOKUP(INCH,"DOORP[PNY,SYS]",FLAG);
IF ¬FLAG THEN BEGIN
ARRYIN(INCH,DOOR[1],10);
CLOSE(INCH);
END;
OPEN(OUCH←GETCHAN,"DSK",'17,0,0,CNT←200,BRK,EOF);
IF EOF THEN BEGIN
OUT(INTTY,"CANNOT OPEN OUTPUT DISK FILE");
GO TO STOP;
END;
SETBREAK(1,'12,'15,"INS");
SETBREAK(2," ,",NULL,"INS");
SETBREAK(3,"0123456789+-.",NULL,"INS");
SETBREAK(4,"0123456789+-","","XNR");
SETBREAK(5,"0123456789+-.",NULL,"INR");
SETBREAK(18,".",NULL,"INS");
SETBREAK(17,"0123456789",NULL,"XNR");
SETFORMAT(8,6);
I ← 0;
PPN[I←1] ← CVSIX("SYS");
WHILE READ ∧ (I < TOP) DO BEGIN
PPN[I←I+1] ← CVSIX(LEFT(3,PROG));
NAME[I] ← FRIENDLY&" "&LAST;
END;
IF I ≥ TOP THEN OUT(INTTY,"MAXIMUM NUMBER OF USERS IN SYSTEM. PROGRAM"&↓&
"REQUIRES ALTERATION TO ALLOW MORE USER'S."&↓&
"(TOP CURRENTLY = "&CVS(TOP)&") PLEASE NOTIFY"&↓&
"FRONT OFFICE");
COMMENT CHECK KEYWORD FILE TO SEE THAT USERS ARE STILL IN PHONE LIST.
IF NOT DELETE THEM FROM KEYWORD FILE;
FOR B ← 1 STEP 1 UNTIL C DO BEGIN "BLOOP"
FOR A ← 1 STEP 1 UNTIL I DO
IF (KEY[B] LAND ('777777000000)) = PPN[A] THEN DONE;
IF A ≤ I THEN PPN[A] ← PPN[A] LOR B
ELSE BEGIN
ARRBLT(KEY[B],KEY[B+1],C-B);
C ← C-1;
END;
END;
IF DOOR[1] = 0 THEN OUT(INTTY,"VENDING MACHINE PRICES ARE NOT SET. THE FRONT OFFICE"&↓&
"WILL HAVE TO SET THEM BEFORE THE VENDING MACHINE CAN"&↓&
"BE ACTIVATED. PLEASE NOTIFY THEM OF THIS."&↓&↓);
START:
GOODS←S ← ""; ID ← 0; TOTAL_FLAG ← 0;
OUT(INTTY,↓&"NEXT! ");
S ← INPUT(INTTY,1);
IF LENGTH(S)=0 THEN GO TO START; Comment flush null commands;
SFOO ← SCAN(S,2,BRK);
IF LENGTH(SFOO) > 3 THEN ERROR(1); Comment flush PPN's over 3 char. long;
ID ← CVSIX(LEFT(3,SFOO));
FOR A ← 1 STEP 1 UNTIL I DO
IF ID = PPN[A] LAND ('777777000000) THEN DONE;
IF A > I THEN ERROR(1);
IF (PPN[A] LAND '777777) THEN BEGIN
TRY ← 0;
AGAIN:
NOECHO;
OUT(INTTY,"PASSWORD = ");
PASS ← PASSWD(INPUT(INTTY,1));
ECHO;
OUT(INTTY,↓);
K ← PPN[A] LAND '777777;
IF PASS ≠ (KEY[K] LAND '777777) THEN BEGIN
OUT(INTTY,"WRONG PASSWORD"&↓&↓);
TRY ← TRY +1;
IF TRY < 2 THEN GO TO AGAIN;
GO TO START;
END;
END;
IF ID = PPN[1] LAND ('777777000000) THEN BEGIN
IF S = "F" THEN FIXKEY
ELSE IF S = "P" THEN PRICE_DOOR
ELSE BEGIN
OUT(INTTY,"WRONG CODE. CODE MUST BE F OR P."&↓&↓);
GO TO START;
END;
END;
RETRY0:
ZZ ← 0;
WHILE LENGTH(S) DO BEGIN
GOODS ← SCAN(S,2,BRK);
RETRY:
IF(K←GOODS) = "V" ∨
K = "M" ∨
K = "C" ∨
K = "D" ∨
K = "S" ∨
K = "B" THEN BEGIN
IF LENGTH(GOODS) = 1 ∧ LENGTH(S) = 2 THEN
GOODS ← GOODS&SCAN(S,2,BRK);
CDE[ZZ←ZZ+1] ← LOP(GOODS);
AMT ← GOODS;
NUM ← 0;
N1 ← 1;
IF GOODS = "-" THEN N1 ← -1;
IF GOODS = "+" ∨ GOODS = "-" THEN K ← LOP(GOODS)
ELSE IF GOODS = "$" THEN K ← LOP(GOODS);
S1 ← SCAN(GOODS,18,BRK); COMMENT SCAN TO A DECIMAL;
IF BRK = 0 THEN BEGIN
S1 ← SCAN(S1,17,NUM);
IF NUM = 0 THEN NUM ← CVD(S1)
ELSE ERROR(3);
IF NUM < 5 THEN NUM ← NUM*100;
END
ELSE IF LENGTH(S1) THEN BEGIN
S1 ← SCAN(S1,17,NUM);
IF NUM = 0 THEN NUM ← CVD(S1)*100
ELSE ERROR(3);
END;
IF BRK = "." THEN BEGIN
IF LENGTH(GOODS) > 2 THEN ERROR(3);
GOODS ← GOODS&"00";
S2 ← GOODS[1 FOR 2];
S2 ← SCAN(S2,17,BRK); COMMENT SCAN FOR NUMERIC VALUES ONLY;
IF BRK = 0 THEN NUM ← NUM+CVD(S2)
ELSE ERROR(3);
END;
IF NUM > 600 THEN ERROR(3);
IF NUM MOD 5 THEN ERROR(4);
IF (K←CDE[ZZ]) = "S" ∧ NUM < 15
THEN ERROR(5);
IF K = "B" ∧ (NUM < 15 ∨ NUM MOD 15)
THEN ERROR(5);
IF K = "C" ∧ (NUM < 10 ∨ NUM MOD 10) THEN ERROR(5);
IF K = "D" ∧ NUM < 20 THEN ERROR(6);
IF K = "V" THEN BEGIN
FOR D ← 1 STEP 1 UNTIL 9 DO
IF DOOR[D] = NUM THEN DONE;
IF D > 9 THEN ERROR(7);
D ← (D LSH 4) XOR '370;
END;
AMOUNT[ZZ] ← NUM*N1;
END
ELSE IF GOODS = "P" THEN NEWPASS(A,TOP,ID)
ELSE IF GOODS = "T" THEN TOTAL_FLAG ← 1
ELSE ERROR(2);
END;
DATE;
BN←1; LNGTH←0;
LOOKUP(OUCH,MON&".PNY[PNY,SYS]",FLAG);
IF ¬FLAG THEN BEGIN
FILEINFO(CHARGF);
LNGTH ← -(CHARGF[3] ROT 18);
BN ← (LNGTH%128)+1;
LNGTH ← LNGTH MOD 128;
IF LNGTH>0 THEN BEGIN
USETI(OUCH,BN);
ARRYIN(OUCH,REC[1],LNGTH);
END;
Comment Avoid CLOSE(OUCH) because we need to get into r/a mode;
END;
ENTER(OUCH,MON&".PNY[PNY,SYS]",FLAG);
IF FLAG THEN BEGIN
OUT(INTTY,"CANNOT ENTER FILE "&MON&".PNY[PNY,SYS]. PLEASE NOTIFY THE FRONT"&↓&
"OFFICE OF THIS. YOU WILL BE UNABLE TO USE THE TTY TO ENTER"&↓&
"CHARGES. SORRY");
GO TO STOP;
END;
FOR K ← 1 STEP 1 UNTIL ZZ DO BEGIN
NUMT ← NUMT + AMOUNT[K];
IF CDE[K] = "V" ∧ AMOUNT[K] > 0 THEN BEGIN
START_CODE;
CALLI '400005;
VMICONO @D;
CALLI '400006;
END;
OUT(INTTY,"V/M READY"&↓);
END;
IF AMOUNT[K] ≠ 0 THEN BEGIN
REC[LNGTH←LNGTH+1] ← ID LOR DAY;
REC[LNGTH←LNGTH+1] ← CVSIX(CDE[K]) LOR (AMOUNT[K] LAND '777777);
END;
END;
USETO(OUCH,BN);
IF LNGTH > 0 THEN ARRYOUT(OUCH,REC[1],LNGTH);
CLOSE(OUCH); Comment Release accounting file;
IF NUMT ≠ 0 THEN OUT(INTTY,"TOTAL: "&CENTS(NUMT)&↓&↓);
IF TOTAL_FLAG THEN CHARGES(ID);
FOR K ← 1 STEP 1 UNTIL ZZ DO AMOUNT[K] ← 0;
NUMT ← 0;
GO TO START;
STOP:
RELEASE(INTTY);
RELEASE(INCH);
RELEASE(OUCH);
END;