Directory of image this file is from
This file as a plain text file
/USER ACCOUNT UPDATING PROGRAM /CHARLES PERKINS, COPYRIGHT 1978 VERSION=2 /N.B. THIS FILE MUST BE ASSEMBLED WITH EDEFS.PA PAGE 0 T1, 0 T2, 0 T3, 0 FLAG, 0 NOVE, 0 PTEOVE, 0 *10 AIR, 0 AIR2, 0 *20 /EXAMPLE ENTRY: CODE, 0 /---B---D--- (000010 000100) ACCNT1, 0 /-1---5---3- (0001 0101 0011) ACCNT2, 0 /-8---7---9- (1000 0111 1001) /BINARY FOR: $00.00-$40.95 ERROR= JMS I .;XERROR GETACC= JMS I .;XGETAC INPUT= JMS I .;XINPUT PRINTC= JMS I .;XPRINT GOTOCR= JMS I .;XGETCR CRLF= JMS I .;XCRLF PRINTM= JMS I .;XPMESS FINDA= JMS I .;XFINDA PRINTA= JMS I .;XPRINA GETAFM= JMS I .;XGETAFM RIP= JMP I .;REST PAGE
START, TAD [JOBNUM MQL SYSCALL MQL TAD [DATAPK SWP BSW TAD [UPRV SYSCALL MQA SPA CLA JMP OK ERROR TEXT "?NOT PRIVILEDGED" OK, JMS I [CLOSE3 TAD [LOOKUP+3 MQL TAD [UASDB-1 CHANIO SNA CLA JMP FOUND PRINTM; PCFUA /"?CANNOT FIND USERACC.NTS" JMP I [CREATE+1 FOUND, TAD [READW+3 MQL TAD [UATDB-1 CDF 10 CHANIO SNA CLA JMP READOK ERROR TEXT "?READ ERROR"
READOK, JMS I [CLOSE3 DCA FLAG /BUFFER NOT FULL DCA NOVE /-NUMBER OF VALID ENTRIES DCA PTEOVE /POINT TO END OF VALID ENTRIES CDF 10 LOOP, TAD I PTEOVE IAC SNA CLA JMP GETCOM ISZ NOVE TAD [-4 DCA T1 LOOP2, ISZ PTEOVE JMP NOSKIP ISZ FLAG JMP GETCOM NOSKIP, ISZ T1 JMP LOOP2 JMP LOOP GETCOM, CDF 0 TAD NOVE CIA DCA NOVE TAD [STARG SETSTAT REST, CRLF TAD ["> PRINTC TAD [240 PRINTC CDF 0 INPUT DCA T1 TAD [COMLIST-2 DCA AIR CLOOP, ISZ AIR TAD I AIR SNA JMP IC TAD T1 SZA CLA JMP CLOOP TAD I AIR DCA T1 /DISPATCH ADDRESS JMP I T1 /GO! IC, GOTOCR PRINTM; PUK /"?UNKNOWN COMMAND" CRLF RIP
XINPUT, 0 KRB MQL TAD [200 MQA TAD [-377 SNA RIP TAD [377-"U+100 SNA JMP I [REST+1 TAD ["U-100-215 SZA JMP XINP1 TAD [215 JMP I XINPUT XINP1, TAD [215-240 SPA SNA JMP XINPUT+1 /^S,^Q,^O,SPACE, ETC... TAD [240 JMP I XINPUT XPRINT, 0 TLS CLA JMP I XPRINT XCRLF, 0 TAD [215 PRINTC TAD [212 PRINTC JMP I XCRLF PAGE
XFINDA, 0 TAD NOVE DCA T1 CMA DCA AIR CDF 10 LOOPIN, TAD I AIR CIA TAD CODE SZA CLA JMP NTO TAD I AIR CIA TAD ACCNT1 SZA CLA JMP NTO+1 TAD I AIR CIA TAD ACCNT2 SZA CLA JMP NTO+2 CDF 0 L7775 TAD AIR DCA AIR JMP I XFINDA NTO, ISZ AIR ISZ AIR ISZ AIR ISZ T1 JMP LOOPING CDF 0 KSF SKP GOTOCR TAD ["? PRINTC PRINTA PRINTM; PNF /" NOT FOUND" RIP
XPRINA, 0 TAD CODE BSW AND [77 TAD ["A-1 PRINTC TAD CODE AND [77 TAD ["A-1 PRINTC TAD [-6 DCA T1 LOOPIT, TAD ACCNT1 RTR BSW AND [17 TAD ["0 PRINTC JMS SHIFT ISZ T1 JMP LOOPIT JMP I XPRINA SHIFT, 0 TAD [-4 DCA T2 LOOPN, TAD ACCNT2 CLL RAL DCA ACCNT2 TAD ACCNT1 RAL DCA ACCNT1 ISZ T2 JMP LOOPN JMP I SHIFT
XGETAFM,0 CDF 10 TAD I AIR DCA CODE TAD I AIR DCA ACCNT1 TAD I AIR CDF 0 DCA ACCNT2 JMP I XGETAFM DIGIT, 0 /OUTPUT ONE DECIMAL DIGIT DCA T1 DCA T2 LOOPD, MQA CLL TAD T1 SNL JMP OUT MQL ISZ T2 JMP LOOPD OUT, CLA TAD T2 TAD ["0 PRINTC JMP I DIGIT XPMESS, 0 TAD I XPMESS ISZ XPMESS DCA T1 LOOP7, TAD I T1 BSW JMS BARF TAD I T1 JMS BARF ISZ T1 JMP LOOP7 BARF, 0 AND [77 SNA JMP I XPMESS TAD [40 AND [77 TAD [40 PRINTC JMP I BARF PAGE
XGETAC, 0 JMS ALPHA BSW DCA CODE JMS ALPHA TAD CODE DCA CODE DCA ACCNT1 DCA ACCNT2 TAD [-6 DCA T1 LOOP4, JMS TESTN JMP I XGETAC /NON-NUMERIC: DONE DCA T3 JMS I [SHIFT TAD T3 TAD ACCNT2 DCA ACCNT2 ISZ T1 JMP LOOP4 INPUT JMP I XGETAC TESTN, 0 INPUT TAD [-"0 CLL TAD ["0-"9-1 SNL ISZ TESTN /NUMERIC: SKIP RETURN, AC=DIGIT SNL TAD [-"0 TAD ["9+1 /NON-NUMERIC: AC=ORIGINAL CHAR. JMP I TESTN ALPHA, 0 INPUT TAD [-"A CLL TAD ["A-"Z-1 SZL JMP ILLUAC TAD ["Z+1-"A+1 JMP I ALPHA ILLUAC, CDF 0 TAD ["Z+1-215 SZA CLA GOTOCR PRINTM; PIA /"?ILLEGAL ACCOUNT" CRLF RIP
BUCKS, 0 CDF 10 TAD I AIR CDF 0 MQL TAD [240 /PRINT " $DD.CC";CRLF PRINTC TAD [240 PRINTC TAD [240 PRINTC TAD ["$ PRINTC DECIMAL TAD [-1000 JMS I [DIGIT TAD [-100 JMS I [DIGIT TAD [". PRINTC TAD [-10 OCTAL JMS I [DIGIT MQA /ODD CENTS LEFTOVER TAD ["0 PRINTC CRLF JMP I BUCKS XERROR, 0 TAD XERROR PRINTM; 0 CRLF JMS CLOSE3 BOOT, CDF 0 TAD [READW+0 MQL TAD [OSBDB-1 CHANIO SZA CLA HLT KCLEAR JMP 0
CLOSE3, 0 TAD [CLOSE+3 MQL CHANIO CLA JMP I CLOSE3
XGETCR, 0 INPUT TAD [-215 SZA CLA JMP XGETCR+1 CRLF JMP I XGETCR CHECK, 0 GOTOCR PRINTM; PAYS /"ARE YOU SURE? " TAD [CHARG SETSTAT KRB MQL TAD [STARG SETSTAT MQA TAD [-"Y SNA CLA JMP YES CRLF RIP /INDECISION! YES, TAD ["E PRINTC TAD ["S PRINTC CRLF JMP I CHECK PAGE
ZERO, JMS I [CHECK /ZERO ALL CHARGE WORDS TAD NOVE DCA T1 L0002 DCA AIR /1ST CHARGE WORD - 1 CDF 10 LOOPZ, DCA I AIR L0003 TAD AIR DCA AIR ISZ T1 JMP LOOPZ CDF 0 RIP FUDGE, GOTOCR /ONE FUDGY VERSION ROUTINE: PRINTM; PUV /"UACCNT V" TAD ["0+VERSION PRINTC CRLF RIP SAVE, GOTOCR TAD [ENTER+3 MQL TAD [UASDB-1 CHANIO SNA JMP WRITEON TAD [-4 SNA CLA JMP WRITEON WE, ERROR TEXT "?WRITE ERROR" WRITEON,TAD [WRITEW+3 MQL TAD [UATDB-1 CDF 10 CHANIO /WRITE OUT THAT BUFFER! SZA CLA JMP WE JMS I [CLOSE3 JMP I [REST+1
PRINT, GOTOCR /PRINT ALL ACCOUNTS AND CHARGES TAD NOVE DCA T3 CMA DCA AIR PRINTM; PAC /"ACCOUNT: CHARGES:" CRLF CRLF LOOPP, GETAFM /GET NEXT ACCOUNT PRINTA /PRINT IT JMS I [BUCKS /PRINT CHARGE WORD ISZ T3 JMP LOOPP RIP NUMBER, GOTOCR PRINTM; PNOVE /"NUMBER OF VALID ENTRIES: " TAD NOVE CIA MQL DECIMAL TAD [-1000 JMS I [DIGIT TAD [-100 JMS I [DIGIT TAD [-10 OCTAL JMS I [DIGIT MQA /ONES COLUMN LEFTOVER TAD ["0 PRINTC CRLF RIP
MONEY, CRLF /TYPE AND/OR MODIFY MONEY GETACC /GET ACCOUNT DCA T3 FINDA /LOCATE IT L0003 TAD AIR DCA AIR TAD T3 TAD [-"= SZA CLA JMP TOGO DCA T1 /MUST INPUT NEW BALANCE LOOPM, JMS I [TESTN JMP NEWCW /DONE DCA T2 TAD T1 CLL RTL /T1*4 TAD T1 /T1*5 RAL /T1*10 TAD T2 /ADD IN NEW DIGIT DCA T1 JMP LOOPM NEWCW, DCA T3 TAD T1 CDF 10 DCA I AIR CDF 0 CMA TAD AIR DCA AIR /DAMN AUTO-INDEXER! TOGO, JMS I [BUCKS /PRINT THE MONEY... TAD T3 TAD [-", SNA CLA JMP MONEY+1 /DO ANOTHER... RIP PAGE
LIST, GOTOCR /LIST ALL ACCOUNTS TAD NOVE DCA T3 CMA DCA AIR LOOPL, GETAFM PRINTA CRLF ISZ AIR ISZ T3 JMP LOOPL RIP KILL, GETACC /KILL ACCOUNT(S) DCA T3 FINDA TAD AIR TAD [4 DCA AIR2 CDF 10 LOOPK, ISZ T1 /T1 = - # ENTRIES TO MOVE - 1 JMP DOIT TAD AIR IAC DCA PTEOVE /BACK UP THE POINTER TAD [-4 DCA T1 CMA DCA I AIR ISZ T1 JMP .-3 /GET RID OF THE LAST ENTRY TAD NOVE IAC DCA NOVE /1 LESS ENTRY TAD T3 TAD [-", SNA CLA JMP KILL /DO ANOTHER... CDF 0 DCA FLAG /BUFFER CAN'T BE FULL NOW! RIP DOIT, TAD [-4 DCA T2 TAD I AIR2 DCA I AIR ISZ T2 JMP .-3 /MOVE THIS ENTRY... JMP LOOPK
CREATE, JMS I [CHECK /CREATE A NEW BUFFER DCA T1 CDF 10 CMA DCA I T1 ISZ T1 JMP .-3 /CLEAN OUT THE BUFFER... DCA PTEOVE DCA NOVE /NO VALID ENTRIES DCA FLAG /BUFFER NOT FULL CRLF LOOPC, TAD ["& PRINTC GETACC DCA T3 TAD CODE TAD [-"E+300^100-"N+300 SZA CLA JMP NOTEND TAD T3 TAD [-"D SZA CLA JMP NOTEND GOTOCR CDF 0 JMP I [REST+1 /END! NOTEND, TAD FLAG SNA CLA JMP NOTFULL TOOBIG, CDF 0 PRINTM; PTBIF /"?THE BUFFER IS FULL" RIP
NOTFULL,CMA TAD NOVE DCA NOVE /ANOTHER ENTRY... TAD CODE DCA I PTEOVE ISZ PTEOVE TAD ACCNT1 DCA I PTEOVE ISZ PTEOVE TAD ACCNT2 DCA I PTEOVE ISZ PTEOVE DCA I PTEOVE ISZ PTEOVE SKP JMP TOOBIG TAD T3 TAD [-", SNA JMP LOOPC+2 /ON THE SAME LINE... TAD [",-215 SNA CLA JMP LOOPC /NEXT LINE... CDF 0 JMP I [ILLUAC+3 APPEND, GOTOCR /APPEND ACCOUNT(S) TO BUFFER CDF 10 JMP LOOPC /JUMP RIGHT IN!
/THIS COMMAND-DISPATCH TABLE MAY BE EXPANDED, /AS LONG AS '0' IS THE LAST ENTRY IN IT... COMLIST, -"Z ZERO -"V FUDGE -"S SAVE -"P PRINT -"N NUMBER -"M MONEY -"L LIST -"K KILL -"E BOOT -"C CREATE -"A APPEND -215 REST+1 0 STARG, 4337 /DUPL+^C+^O+^S^Q+^U+^V+^P+RUBOUT 0207 /BREAK ON CTRL CHARS REST /TAKE A REST ON ^C^C REST /TAKE A REST ON ^P CHARG, 4337 4000 /BREAK ON ANY REST REST
UASDB, DEVICE SYS 3 TEXT /USERACCNTS/;*.-1 25 0 7777;7760 UATDB, ZBLOCK 4 OSBDB, 0 0 -400 0 PCFUA, TEXT "?CANNOT FIND USERACC.NTS" PUK, TEXT "?UNKNOWN COMMAND" PIL, TEXT "?ILLEGAL SYNTAX"
PANT, TEXT "?ACCOUNT NOT FOUND" PNF= .-6 /" NOT FOUND" PIA, TEXT "?ILLEGAL ACCOUNT" PAC, TEXT "ACCOUNT: CHARGES:" PAYS, TEXT "ARE YOU SURE? " PTBIF, TEXT "?THE BUFFER IS FULL" PUV, TEXT "UACCNT V"
PNOVE, TEXT "NUMBER OF VALID ENTRIES: " $