File LOGINX.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

/EXTENDED LOGIN ROUTINE
/REVISIONS AND ADDITIONS BY CHARLES L. PERKINS
VERSION=5

	*0
	JMP I	.+1
		START
	*10
LX1,	0
LX2,	0
	*20
CHAR,	0
CT,	0
T1,	0
T2,	0
T3,	0
T4,	0
NUM1,	0
NUM2,	0
JOB,	0
UMONX,	.-.		/GETS POINTER TO XUMON

RMON=	6007
ERROR=	JMS I	.;ERRORX
UMON=	JMS I	.;UMONSB
PRINTC=	JMS I	.;PRINTX
PRINT6=	JMS I	.;STRING
CRLF=	JMS I	.;CRLFX
DATAXS=	JMS I	.;AXDAT
SCALE=	JMS I	.;SCALEX
LOGARG,	0		/MUST BE IN 1ST BLOCK
	1
	-LOGSIZ^400+400
	400
KFUD1,	OS8RTS-1	/POINTER TO OP. SYS. DATA
K7,	7
K40,	40
K77,	77
K177,	177
K200,	200
K212,	212
K215,	215
K240,	240
K260,	260
K7400,	7400
K7700,	7700

	PAGE

START, CLA CLL RMON /NOW EXECUTING ON 'LEVEL 2' TAD I (57 /GET POINTER TO XUMON DCA UMONX UMON /NOW BACK TO 'LEVEL 3' TAD [READW+0 MQL TAD (LOGARG-1 CHANIO /READ IN REST OF LOGIN SZA HLT TAD [CLOSE+0 MQL CHANIO CLA /INCASE CHANNEL 0 NOT OPEN? TAD (JOBNUM MQL SYSCALL DCA JOB DATAXS TAD UACCNT SZA /IF NZ THEN ALREADY LOGGED IN JMP I (XLOGOUT/MUST MEAN LOGOUT XLOGIN, TAD (LOGSTAT SETSTAT KSF /TYPE AHEAD? SKP /YES JMP .+3 /IN CASE OF: LOGIN;P,PN PASSWORD PRINT6; MACCNT /PRINT ACCOUNT MESSAGE JMP I (LOGPA1 /JUMP TO LOGIN PATCH LOGRE1, JMS I [GETPPN /RETURN HERE FROM LOGIN PATCH BSW DCA I [ACCNT /SAVE PROJECT NUMBER TAD CHAR TAD (-", /MUST BE COMMA SZA CLA JMP I [NUMERR JMS I [GETPPN TAD I [ACCNT DCA I [ACCNT /ADD ON PROGRAMMER # CRLF L7775 TAD I [ACCNT SZA /[0,3] OPERATOR? JMP LOGIN1 /NO DATAXS TAD USCON SNA CLA JMP LOGIN2 /ONLY ON CONSOLE 0 JMP I (NOLOGIN
LOGIN1, SZL CLA / > 3? N.B. L7775 LEAVES LINK ON JMP I (NOLOGIN/NO, ERROR LOGIN2, JMS I [PASTST /PASSWORD TEST MQA /PROTECT WORD DATAXS DCA JOBPRV JMS I [LOGIO /LOGIN/LOGOUT L0003 DCA T1 /START AT JOB 3 MQL LOGINC, MQA CIA TAD I [ACCNT SNA CLA ISZ SAMACC /SAME ACCOUNT TAD (DATAPK MQL TAD T1 ISZ T1 BSW TAD (UACCNT SYSCALL /LOOK AT ACCOUNT NUMBER OF JOB(T1) SNA CLA /PASS JOBMAX? JMP LOGINC /NO, CHECK FOR MATCH TAD SAMACC SNA JMP LOGIN3 CLL JMS I (OCTOUT PRINT6; LMES3 LOGIN3, TAD [CLOSE+1 MQL CHANIO TAD [LOOKUP+1 MQL TAD (LOGMES-1 CHANIO JMP I (MESTST SAMACC, 0
UMONSB, 0 DCA UMONAC RIF TAD (CDF 0 /MAKE A CDF 'THIS FIELD' DCA .+1 .-. /BACK TO THIS DATA FIELD TAD UMONAC CIF 0 JMS I UMONX /DO THE 'UMON' FUNCTION JMP I UMONSB UMONAC, 0 LOGSTAT,0011 /^U+RUBOUT 0200 /BREAK ON VT,LF,FF,CR PAGE
MESTST, SZA CLA JMP NOMES CRLF LOOP, IAC /TAD (READW+1 MQL TAD (LOGMRG-1 CHANIO SZA CLA JMP NOMES ISZ LOGMRG+1 TAD (LOGBUF-1 DCA LX1 TAD KM200 /-# OF TRIPLETS DCA CT LOOP2, TAD I LX1 JMS LOGSUB DCA T1 TAD I LX1 JMS LOGSUB CLL RTR RTR TAD T1 JMS LOGSUB KM200, 7600 /(CLA) ISZ CT JMP LOOP2 JMP LOOP LOGMRG, 0 0 -400 LOGBUF LOGSUB, 0 MQL MQA AND K177 TAD (-32 /^Z? SNA CLA JMP NOMES /YES, DONE MQA TLS AND K7400 CLL RTR RTR JMP I LOGSUB
LOGIO, 0 PRINT6; LMES1 TAD JOB CLL /NO LEADING ZEROES JMS I (OCTOUT PRINT6; LMES2 DATAXS TAD UACCNT SZA CLA /CHECK FOR LOGGED IN/OUT TAD (LMESOUT-LMESIN PRINT6; LMESIN /AC OFFSETS PRINT POINTER PRINT6; LMES2B DATAXS TAD USCON CLL JMS I (OCTOUT CRLF JMP I LOGIO
LOGMES, DEVICE SYS 2 TEXT /LOGMESGTXT/;*.-1 NOMES, TAD I [ACCNT DCA LOGMES+2 DCA LOGMRG+1/CLEAR BASE BLOCK NUMBER ISZ LGMSFG /TWO PASS FLAG JMP I (LOGIN3 TAD I [ACCNT DATAXS DCA UACCNT /SET IN ACCOUNT NUMBER TAD (TOD MQL TAD [T1-1 SYSCALL /GET TIME OF DAY TAD T1 DATAXS /STORE LOGIN TIME: DCA USTT1 /-TICKS TILL NEXT MINUTE TAD T2 DATAXS DCA USTT2 /-MINUTES TILL NEXT DAY TAD T3 DATAXS DCA USTT3 /-DAYS TILL NEXT YEAR TAD T4 DATAXS DCA USTT4 /YEARS DATAXS DCA URT1 /CLEAR OUT RUN TIME: DATAXS DCA URT2 JMP I (BOOTOS /BOOTSTRAP OS8 LGMSFG, -2 PAGE
BOOTOS, TAD [CLOSE+0/CLOSE 0 DOUGIE MQL CHANIO SZA /CLOSE OK? HLT /NO. THIS IS IMPOSSIBLE... TAD [LOOKUP+0 MQL TAD [OSSAV-1/OS.SAV IS FOR LATER EXPANSION CHANIO SZA CLA /LOOKUP ALL RIGHT? JMP BOOS8 /NO. OS.SAV NOT FOUND MQA /GET PROTECTION WORD RAL /GET PRIV FILE BIT CLA RTR /INTO TEMP PRIV BIT IN JOBTAB JMP BOOTIT /RUN OS.SAV,PRIV. IF INDICATED BOOS8, TAD JOB /SET UP SCRATCH BLOCKS: CLL RTR /PUT JOB # INTO 'JOBXX.SBK': CLL RAR AND K7 TAD ["B^100+60 DCA I [SBKS+4 TAD JOB AND K7 TAD [60 BSW DCA I [SBKS+5 TAD [CLOSE+1 MQL CHANIO CLA TAD [LOOKUP+1 MQL TAD [SBKS-1 CHANIO /OPEN SCRATCH BLOCKS SZA CLA JMP EROS0 /CANNOT FIND SCRATCH BLOCKS TAD [CLOSE+0 MQL CHANIO TAD [LOOKUP+0 MQL TAD KFUD1 CHANIO SZA CLA JMP EROS1 /CANNOT FIND OS8.RTS
TAD I [ACCNT DCA I [OS8DSK+2 TRYAD, TAD [LOOKUP+2 MQL TAD [OS8DSK-1 CHANIO SNA CLA JMP CONTFA /FOUND IT! L0100 TAD I [OS8DSK+1 DCA I [OS8DSK+1 TAD I [OS8DSK+1 AND [300 SZA CLA JMP TRYAD /TRY ANOTHER DISK JMP EROS2 CONTFA, TAD I [SAMACC SNA CLA / > 1 PERSON IN SAME ACCOUNT? JMP BOOTIT /NO, LEAVE WRITE ENABLED L0001 DATAXS WTAD PCCBP+200 DCA T1 L7776 RMON AND I T1 IAC /WRITE PROTECT CHANNEL 2 DCA I T1 UMON
/***** LAST DATAXS CLEARS UPRIV ***** BOOTIT, TAD K40 /SET UP DEFAULT PRIORITY DATAXS DCA UPRV TAD [READW+0 MQL TAD [OSBOOT-1 CHANIO SZA CLA JMP EROS3 /ERROR BOOTING OS/8 TAD (DATAPK MQL TAD (JOBPRV SYSCALL SZA CLA JMP 0 TAD (22 /CORE FUNCTION SWP RTL RTL AND (3 SNA JMP 0 IAC SYSCALL CLA JMP 0
/?CANNOT FIND SCRATCH BLOCKS EROS0, PRINT6; EROSMS /"?CANNOT FIND " PRINT6; ERSCMS /"SCRATCH BLOCKS" EROSHL, CRLF TAD K40 /SET UP DEFAULT PRIORITY DATAXS /LAST DATAXS CLEAR TEMP. PRIV. DCA UPRV HLT /?CANNOT FIND OS8.RTS EROS1, PRINT6; EROSMS /"?CANNOT FIND" PRINT6; ERRTMS /"OS8.RTS" JMP EROSHL /HALT VM /?CANNOT FIND OS8DISK.DSK EROS2, PRINT6; EROSMS /"?CANNOT FIND " PRINT6; ERDSMS /"OS8DISK.DSK" JMP BOOTIT /BOOT OS/8 ANYWAY /?ERROR BOOTING OS/8 EROS3, PRINT6; EROSM2 /"?ERROR BOOTING OS/8" JMP EROSHL PAGE
OSBOOT, 0 0 -400 0 OS8RTS, DEVICE SYS 2 TEXT /OS8@@@@RTS/;*.-1 SBKS, DEVICE SYS 3 TEXT /JOBXX@@SBK/;*.-1 OS8DSK, DEVICE DK0 .-. /THIS ACCOUNT TEXT /OS8DISKDSK/;*.-1 NOLOGIN,ERROR TEXT "PROTECTION VIOLATION"
GETPPN, 0 JMS I (NUMGET JMP I [NUMERR TAD NUM1 JMP I GETPPN PASTST, 0 TAD [11 /^U+RUBOUT DATAXS /NO DUPL ON PASSWORD INPUT WDCA UKBDDB+STATUS KSF SKP JMP .+3 /IN CASE OF: LOGIN;P,PN PASSWORD PRINT6; MPASS JMS I (NAMGET CRLF TAD [4011 /DUPL+^U+RUBOUT DATAXS WDCA UKBDDB+STATUS TAD [LOOKUP+0 MQL TAD (LOGLST-1 CHANIO /IF THE LOOKUP OF THE PHONEY SNA CLA /'FILENAMEXT' SUCEEDS, THE JMP I PASTST /ACCOUNT IS A VALID ONE LOGERR, ERROR TEXT "ACCOUNT NOT FOUND"
XLOGOUT,CLL RAR /TEST FOR ACCOUNT #1 SNA JMP I (XATTACH/ACCOUNT=1 MEANS 'ATTACH' RAL MQL JMP I (LOGPA2 /JUMP TO LOGOUT PATCH LOGRE2, DCA I (NAMCT /RETURN FROM LOGOUT PATCH TAD [-4 DCA I (DATAP LOGOLP, MQA RTL RAL MQL MQA RAL AND K7 TAD K260 JMS I (STUFF6 /STUFF ACCOUNT # INTO LAST LETTERS NAMCT /OF STATUS FILE 'ACCTIMX.XXX' LOGOPN ISZ I (DATAP JMP LOGOLP JMS I [LOGIO /"JOB X LOGGED OUT ON CONSOLE N" TAD (CLOSE+0 MQL CHANIO JMP I (SYLGO1 LOGMR2, 0 0 -400 LOGBUF PAGE
SYLGO1, L0003 DATAXS DCA UACCNT TAD (ENTER+0 MQL TAD (LOGSTT-1 CHANIO /CREATE ACCOUNT STATUS FILE SNA JMP LGSTOK TAD [-4 SZA CLA /'ACCTIMX.XXX' ALREADY EXIST? JMP I [LGSTIG /FATAL ERROR, IGNORE STATUS TAD [READW+0 MQL /YES, READ IT IN THEN! TAD (LOGMR2-1 CHANIO SZA CLA JMP I [LGSTIG /ERROR, IGNORE STATUS LGSTOK, TAD (TOD MQL TAD (LSTLGO-1 SYSCALL /UPDATE TIME OF LAST LOGOUT DATAXS TAD URT1 /L.O. USER RUN TIME CLL TAD I (TOTRUN /ADD TO TOTAL RUN TIME DCA I (TOTRUN RAL /CARRY DATAXS TAD URT2 TAD I (TOTRUN+1 DCA I (TOTRUN+1 SZL /CHECK FOR CARRY ISZ I (TOTRUN+2 NOP DATAXS TAD USTT1 /GET LAST LOGIN TIME DCA I (LSTLGI DATAXS TAD USTT2 DCA I (LSTLGI+1 DATAXS TAD USTT3 DCA I (LSTLGI+2 DATAXS TAD USTT4 DCA I (LSTLGI+3
DECIMAL TAD I (LSTLGI /CONNECT-TIME CALCULATIONS: CIA TAD I (LSTLGO CLL SPA TAD [600 /600 TICKS = ONE MINUTE MQL /STORE # TICKS USED SZL CLL CMA DCA T1 /-1 IF BORROW MQA TAD I (TOTCON SMA /IF TOTAL TICKS > 0 THEN TAD (-600 /TAKE AWAY 600 AND DCA I (TOTCON RAL /INDICATE CARRY TAD T1 /-BORROW CIA /NEGATE THE WHOLE MESS TAD I (LSTLGI+1 CIA TAD I (LSTLGO+1 CLL SPA TAD [1440 /1440 MINUTES = ONE DAY MQL /STORE # MINUTES USED SZL CLL CMA DCA T1 /-1 IF BORROW MQA TAD I (TOTCON+1 SMA /IF TOTAL MINUTES > 0 THEN TAD (-1440 /TAKE AWAY 1440 AND DCA I (TOTCON+1 RAL /INDICATE CARRY TAD T1 /-BORROW CIA /NEGATE THE WHOLE MESS TAD I (LSTLGI+2 CIA TAD I (LSTLGO+2 CLL SPA TAD [365 /365 DAYS = ONE YEAR MQL /STORE # DAYS USED SZL CLL CMA DCA T1 /-1 IF BORROW
MQA TAD I (TOTCON+2 SMA /IF TOTAL DAYS > 0 THEN TAD (-365 /TAKE AWAY 365 AND OCTAL DCA I (TOTCON+2 JMP I (LGST2 PAGE
LGST2, RAL /INDICATE CARRY TAD T1 /-BORROW SMA SZA CLA /IF AC=-1, # YEARS IS UNCHANGED ISZ I (TOTCON+3 NOP /WOULD YOU BELEVE 4096 YEARS TAD (WRITEW+0 MQL TAD (LOGMR2-1 CHANIO /OUTPUT LOGBUF TO 'ACCTIMX.XXX' CLA LGSTIG, TAD [CLOSE+0 MQL CHANIO /CLOSE ALL CHANNELS! CLA MQA IAC /INCREMENT THE CHANNEL NUMBER AND K7 SZA /DONE ALL 10? JMP LGSTIG /NO, GO CLOSE THE NEXT ONE DATAXS /THIS IS DONE HERE SINCE DCA UACCNT /IT REQUIRES TEMP.PRIV. ON SCALE; DEALP /DEASSIGN LPT: AND CDR: SCALE; DEACD /(TURNS TEMP. PRIV. OFF) JMP I (SYLGO2
NUMGET, 0 JMS NUMCOM NUMGT1, JMS KRBSUB JMS NUMTST JMP NUMGTE /TERMINATOR SZL JMP NUMERR /NONOCTAL DIGIT TAD NUM1 CLL RTL /ROTATE CURRENT NUMBER RAL TAD [-"0 TAD CHAR /ADD IN NEW DIGIT DCA NUM1 ISZ CT /CT COUNTS THE DIGITS L7775 TAD CT SPA CLA JMP NUMGT1 NUMERR, ERROR TEXT /ILLEGAL INPUT/ NUMTST, 0 TAD [-"0 /260 .LE. NUM .LT. 272 CLL TAD ["0-"9-1 SZL JMP NUMTSF /NOT A NUMBER IAC IAC /L = 1 IF 8 OR 9 ISZ NUMTST NUMTSF, CLA /SKIP RETURN & NZ LINK = NON-OCTAL JMP I NUMTST /REGULAR RETURN = NON-NUMERIC
NAMGET, 0 /GET AN 8-CHARACTER NAME DCA NAMCT NAMGLP, JMS KRBSUB TAD [-"U+100/KRBSUB 'OR'S 200 WITH CHAR SNA JMP NAMGET+1/CTRL/U: START OVER! TAD ["U-100-377 SNA JMP NAMGET+1/RUBOUT AS 1ST CHAR. IN BUF. TAD (377-215 SNA CLA JMP I NAMGET /A CR, DONE! TAD CHAR JMS NAMGSB JMP NAMGLP NAMGSB, 0 JMS I (STUFF6 NAMCT /POINTER TO OFFSET PASSWD /TO PASSWORD TAD NAMCT TAD [-10 SZA CLA JMP I NAMGSB KRB /SKIPS OVER THE CR,LF,VT,FF CLA JMP I NAMGET NAMCT, 0
NUMCOM, 0 DCA CT DCA NUM1 DCA NUM2 JMS KRBSUB TAD (-240 SNA CLA JMP .-3 /IGNORE LEADING SPACES TAD CHAR ISZ NUMCOM JMP I NUMCOM NUMGTE, TAD CHAR TAD [-"U+100 SNA JMP NUMGET+1/CTRL/U: START OVER TAD ["U-100-377 SNA CLA JMP NUMGET+1/RUBOUT AS 1ST CHAR. IN BUF. TAD CT SZA CLA ISZ NUMGET JMP I NUMGET KRBSUB, 0 KRB MQL TAD K200 MQA /LOWER CASE ADJUSTED TO UPPER DCA CHAR TAD CHAR JMP I KRBSUB PAGE
XATTACH,KSF SKP JMP .+3 /IN CASE OF: ATTACH;JOB# PASSWORD PRINT6; ATMES1 JMS I [GETPPN DCA ATTJOB /JOB NUMBER TO ATTACH TO L7776 TAD ATTJOB SPA SNA CLA JMP I [NUMERR /[0,0],[0,1],[0,2] OFFLIMITS TAD (DATAPK /FETCH DATA WORD MQL TAD ATTJOB BSW TAD (UACCNT /GET ACCOUNT # OF ATTACHEE SYSCALL SZA CLA JMP I [NUMERR /ATTJOB > MAX. ALLOWED JOB # MQA /RETRIEVE ACCOUNT # SNA JMP I [NUMERR /# = 0, NOT LOGGED IN DCA ACCNT /ACCOUNT # OF JOB TO ATTACH TO JMS I [PASTST /GET AND TEST PASSWORD TAD [CLOSE+0 MQL CHANIO /CLOSE UFD TAD ATTJOB BSW CLL RAR /* 40 TAD (USCON+JOBTAB-40 DCA T1 /POINTER TO USCON OF ATTACHEE TAD JOB BSW CLL RAR /* 40 TAD (USCON+JOBTAB-40 DCA T2 /POINTER TO OUR CONSOLE NUMBER RMON TAD I T1 TAD I (34 /CONSOLE+IOTTAB DCA T3 L7777 /TEST FOR +1 (DETACHED) TAD I T3 SZA CLA /SKIP IF DETACHED JMP ATTERR
IOF /***** TAD I T1 /CON CLL RAL /*2 TAD I (33 /+DDBTAB DCA T3 TAD I T2 CLL RAL TAD I (33 DCA T4 /T3,T4 POINT TO DDB POINTERS TAD I T1 MQL TAD I T2 DCA I T1 /SWITCH CONSOLE NUMBERS MQA DCA I T2 TAD I T3 MQL TAD I T4 DCA I T3 /SWITCH KBDDDB POINTERS MQA DCA I T4 ISZ T3 ISZ T4 TAD I T3 MQL TAD I T4 DCA I T3 /SWITCH TTYDDB POINTERS MQA DCA I T4 ION /***** UMON JMP I (SYLOGO
ATMES1, TEXT "JOB? " ATTJOB, 0 ATTERR, UMON ERROR TEXT "JOB IN USE" LOGLST, DEVICE SYS 1 /MFD IS 0,1 ACCNT, .-. /SUPPLIED BY USER PASSWD, ZBLOCK 4 /ACCNT & PASSWD MAKE UP A PHONEY 'FILENAMEXT' IN THE MFD LOGSTT, DEVICE SYS 3 /OPERATOR ACCOUNT LOGOPN=.+3 TEXT /ACCTIMXXXX/;*.-1 25 /COMPLETELY READ PROTECTED ONLY 0 /NO DATE -1;-1 /FIXED LENGTH OF 1 BLOCK PAGE
PRINTX, 0 TLS CLA JMP I PRINTX CRLFX, 0 TAD K215 PRINTC TAD K212 PRINTC JMP I CRLFX ERRORX, 0 CLA CLL TAD ERRORX /TEXT FOR PRINT6 IS RIGHT PRINT6; 0 /AFTER THE 'ERROR' CALL CRLF SYLOGO, DATAXS DCA UACCNT /CLEAR USER ACCOUNT # SYLGO2, KCLEAR TAD (SCARG SETSTAT /SET KSTAT AND BREAK TAD (LOGOUT MQL SYSCALL /ENTER INEPT SCALE MODE HLT JMP .-1 /WE SHOULDN'T CONTINUE? STRING, 0 /PRINT OUT A 'TEXT' MESSAGE: TAD I STRING DCA T4 ISZ STRING XER1, TAD I T4 BSW JMS CHTP TAD I T4 JMS CHTP ISZ T4 JMP XER1 CHTP, 0 /UNPACK 6-BIT CHAR. & PRINT IT AND K77 SNA JMP I STRING TAD K40 AND K77 TAD K40 PRINTC JMP I CHTP
SCALEX, 0 TAD (XSCALE /PERFORM A 'SCALE' COMMAND MQL L7777 TAD I SCALEX ISZ SCALEX SYSCALL CLA /IGNORE ERRORS JMP I SCALEX STUFF6, 0 AND K77 DCA STUFFC /SAVE CHAR TAD I STUFF6 /FETCH POINTER TO OFFSET ISZ STUFF6 DCA STUFFP TAD I STUFFP /FETCH OFFSET ISZ I STUFFP /ISZ AUTOMATICALLY, WHAT SERVICE! NOP /DON'T FILL MORE THAN 2K!!!!! CLL RAR /LINK = ODD/EVEN WORD SWITCH TAD I STUFF6 /ADD BASE ISZ STUFF6 DCA STUFFP /POINTER TO WORD TAD I STUFFP AND K7700 /SAVE HALF TAD STUFFC SNL BSW /NZ LINK: CHAR. INTO BITS 0-5 DCA I STUFFP JMP I STUFF6
OCTOUT, 0 /TYPE AC AS 4-DIGIT OCTAL # DCA T1 RAL /IF L=0, SUPRESS LEADING ZEROES MQL /IF L=1, PRINT LEADING ZEROES TAD T1 CLL RTL RTL JMS LEZRO TAD T1 BSW JMS LEZRO TAD T1 RAR RTR JMS LEZRO TAD T1 JMS DGTP JMP I OCTOUT LEZRO, 0 /CHECK FOR LEADING ZERO: AND K7 SZA JMP LEZRON MQA SZA CLA LEZRON, JMS DGTP JMP I LEZRO DGTP, 0 /TYPE ONE OCTAL DIGIT AND K7 TAD K260 PRINTC JMP I DGTP STUFFC, 0 STUFFP, 0 PAGE
/ ***** CALL: DATAXS; INSTRUCTION ***** /IF 'INSTRUCTION' IS OF THE FORM: 1XX YYY ZZZ ZZZ, Z IS /A WORD IN THE USER'S DATA SPACE THAT POINTS TO AN 8-WORD /BLOCK AND Y IS THE OFFSET INTO THAT BLOCK OF THE WORD ON /WHICH TO PERFORM THE X FUNCTION. IF NOT, THE X FUNCTION /ACTS DIRECTLY ON THE USER'S DATA SPACE. WAND= 4000 WTAD= 5000 WISZ= 6000 WDCA= 7000 JOBTAB= 200 AXDAT, 0 DCA DATACX RAL DCA DATLNK /PRESERVE LINK TAD I AXDAT DCA AXDATT TAD AXDATT AND K77 DCA DATAP TAD JOB BSW CLL RAR TAD DATAP TAD (JOBTAB-40 DCA DATAP RMON TAD AXDATT SMA JMP AXDATP BSW AND K7 TAD I DATAP DCA DATAP TAD AXDATT AXDATP, AND (3000 TAD (AND I DATAP DCA INSTR TAD DATLNK CLL RAR TAD DATACX INSTR, HLT SKP ISZ AXDAT ISZ AXDAT DCA DATACX TAD DATACX UMON JMP I AXDAT DATLNK, 0 DATAP, 0 DATACX, 0 DATAXX, 0 AXDATT, 0
LMES1, TEXT "JOB " LMES2, TEXT " LOGGED " LMESIN, TEXT "IN" LMESOUT,TEXT "OUT" LMES2B, TEXT " ON CONSOLE " LMES3, TEXT " OTHER JOB(S) USING SAME ACCOUNT"
DEALP, "D;"E;"A;"S;" ;"L;"P;215 DEACD, "D;"E;"A;"S;" ;"C;"D;215 MACCNT, TEXT "ACCOUNT? " MPASS, TEXT "PASSWORD? " SCARG, DUPL+DSCALE+ENCTLV+ENCTLU+ENRUBO 200 /BREAK ON: CR,VT,FF,LF /APPARENTLY LOGIN DOESN'T CARE ABOUT ^P NOR ^C PAGE
/VARIOUS PATCHES TO LOGIN /CHARLES L. PERKINS 1978 LOGPA1, DATAXS /ZERO ETOS/NON-ETOS FLAG WDCA UTTDDB+DDEP2 LOGSO, KSF JMP LOGSO KRS /GET 1ST CHAR. JMS I [LOGCS /CHECK SPECIALS DCA CHAR TAD CHAR JMS I [LOGTA /ALPHA? JMP I [LOGRE1 /NO, RETURN KCC KRB /YES, GET 2ND CHAR. JMS I [LOGCS /CHECK SPECIALS DCA T1 TAD T1 JMS I [LOGTA /ALPHA? JMP I [NUMERR /NO, ILLEGAL INPUT TAD CHAR /1ST CHAR. TAD [-"A+1 /ADJUST TO 1-26 BSW /SHIFT TO BITS 0-5 TAD T1 /2ND CHAR. TAD [-"A+1 /ADJUST TO 1-26 DCA T1 /2 LETTER PASSWORD/CODE DCA T2 DCA T3 /CLEAR STUDENT ACCOUNT # TAD [-6 DCA CT /6 DECIMAL DIGITS LOGGND, KRB /GET NEXT DIGIT JMS I [LOGCS /CHECK SPECIALS TAD [-"0 CLL TAD ["0-"9-1 SZL /NUMERIC? JMP LOGEND /NO, A TERMINATOR TAD ["9+1-"0 DCA CHAR /THE ACTUAL DIGIT TAD [-4 DCA T4 /4 SINGLE SHIFTS LOGSHF, TAD T3 /SHIFT: CLL RAL DCA T3 TAD T2 /DOUBLE PRECISION RAL /LINK THEM TOGETHER (HA,HA) DCA T2 ISZ T4 JMP LOGSHF TAD CHAR TAD T3 DCA T3 /ADD IN NEW DIGIT ISZ CT JMP LOGGND
KRB /SKIPS OVER THE CR,LF,VT,FF SKP CLA LOGEND, TAD ["9+1-215 SZA CLA JMP I [NUMERR /NOT A CR! CRLF TAD [CLOSE+1 MQL CHANIO /CLOSE CHN1: CLA /LATER EXPANSION... TAD [LOOKUP+1 MQL TAD [LOGUAF-1 CHANIO /LOOKUP 'USERACC.NTS' SNA CLA JMP LOGEN1 LOGAE, PRINT6; EROSMS /"?CANNOT FIND " PRINT6; ERRUAF /"USERACC.NTS" JMP I [EROSHL LOGEN1, TAD [READW+1 MQL TAD [LOGURD-1 CDF 10 CHANIO /READ FILE INTO FIELD 1 SNA CLA JMP LOGEN2 PRINT6; LMESRE /"READ ERROR - LOGIN AGAIN" JMP I [EROSHL LOGEN2, CMA DCA LX1 CDF 10 LOGCNA, TAD I LX1 /CHECK NEXT ACCOUNT IAC SZA JMP .+3 CDF 0 /7777 MARKS END OF VALID ENTRIES JMP I [LOGERR /"ACCOUNT NOT FOUND" CIA IAC /GET IT BACK TO -NORMAL TAD T1 /OUR 2 LETTER CODE SZA CLA JMP I [LOGNTO /NO MATCH TAD I LX1 /CHECK STUDENT ACCOUNT #: CIA TAD T2 SZA CLA JMP I [LOGNTO+1 TAD I LX1 CIA TAD T3 SZA CLA JMP I [LOGNTO+2
CDF 0 ISZ LX1 /THIS IS THE ONE! TAD LX1 /STORE ADDR. OF CHARGE WORD DATAXS /IN FREE LOC. IN USER DATA SPACE WDCA UTTDDB+DDEP2 TAD [4011 /DUPL+^U+RUBOUT DATAXS WDCA UKBDDB+STATUS TAD [BASOS-1 DCA KFUD1 /SET UP LOOKUP POINTER DATAXS TAD USCON TAD K7700 /BASIC ACCOUNT: [77,CON#] DCA I [ACCNT TAD ["B-300^100+"S-300 DCA I [PASSWD /PASSWORD IS "BS" (HAHA) TAD [TXTSET MQL TAD [BNAM-1 SYSCALL /NAME: "BASIC . OS" JMP I [LOGIN2+2 LOGNTO, ISZ LX1 /NOT THIS ONE! ISZ LX1 ISZ LX1 JMP I [LOGCNA /TRY NEXT ONE...
LOGPA2, DATAXS /ENTRY FROM LOGOUT WTAD UTTDDB+DDEP2 SNA JMP I [LOGRE2 /ZERO, ETOS USER DCA CHAR /POINTER TO CHARGE WORD TAD [TOD MQL TAD [T1-1 SYSCALL /T1-4: TIME OF DAY DATAXS TAD USTT1 /LOGIN TICK COUNT CIA TAD T1 /PRESENT TICK COUNT CLL SPA DECIMAL TAD [600 /600 TICKS IN A MINUTE DCA T1 SZL CMA /BORROW A MINUTE DCA T4 TAD T1 TAD [-300 SMA CLA ISZ T4 / > = 300 TICKS, ADD A MINUTE NOP
DATAXS TAD USTT2 /LOGIN MINUTE COUNT CIA TAD T2 /PRESENT MINUTE COUNT CLL SPA TAD [1440 /1440 MINUTES IN A DAY DCA T2 SZL CMA /BORROW A DAY DCA T1 TAD T2 TAD T4 /ADJUST # MINUTES USED CLL SPA TAD [1440 DCA T2 SZL CMA /BORROW A DAY TAD T1 DCA T1 DCA T4 DATAXS TAD USTT3 /LOGIN DAY COUNT CIA TAD T3 /PRESENT DAY COUNT SPA /NO CLL, BORROW UNIMPORTANT TAD [365 /365 DAYS IN A YEAR TAD T1 SNA /SHOULD NEVER BE MINUS JMP LOGND /NO DAYS TO ADD ON CIA DCA CT /MAKE -DAYS A COUNTER LOGAAD, TAD [45 /ADD ANOTHER DAY'S WORTH OCTAL /(45*32 MINUTES = 1 DAY) TAD T4 DCA T4 ISZ CT JMP LOGAAD LOGND, TAD T2 AND [3740 /GET # OF (32 MINUTES)S CLL RAL BSW /SHIFT TO BITS 6-11 TAD T4 /ADD IN THE DAYS CLL RAL /2 CENTS PER 32 MINUTES DCA T1 /CONNECT TIME CHARGES
DATAXS TAD URT1 /LOW-ORDER RUN TIME AND [7000 /GET # OF (512/600 MINUTES)S CLL RTL RTL /SHIFT TO BITS 9-11 DCA T3 DATAXS TAD URT2 /HIGH-ORDER RUN TIME AND [777 /PRAY FOR NO MORE THAN THIS! CLL RTL RAL /SHIFT TO BITS 0-8 TAD T3 /1 CENT PER 512/600 MINUTES DCA T3 /CPU RUN TIME CHARGES TAD CHAR /POINTER TO CHARGE WORD AND [7400 /GET BLOCK IT'S IN CLL RTR BSW DCA I [LOGUAD+1 TAD CHAR AND [377 /OFFSET OF CHARGE WORD TAD [LOGBUF /INTO LOGBUF DCA CHAR TAD [CLOSE+1 MQL CHANIO /CLOSE CHN1: CLA TAD [LOOKUP+1 MQL TAD [LOGUAF-1 CHANIO /LOOKUP 'USERACC.NTS' SZA CLA JMP I [NOCHAR /ERROR, FREE COMPUTER TIME TAD [READW+1 MQL TAD [LOGUAD-1 CHANIO /READ BLOCK INTO LOGBUF SZA CLA JMP I [NOCHAR TAD I CHAR /USER'S CURRENT CHARGES TAD T1 /ADD IN CONNECT TIME CHARGES TAD T3 /AND CPU RUN TIME CHARGES DCA I CHAR /WHAT HE OWES US! TAD [WRITEW+1 MQL TAD [LOGUAD-1 CHANIO /WRITE BLOCK FROM LOGBUF SZA CLA JMP I [NOCHAR TAD [CLOSE+1 MQL CHANIO /CLOSE CHN1: JUST IN CASE... CLA
CRLF /WE MADE IT, CHARGE THE BASTARD! CRLF PRINT6; LMESTC /" TERMINAL CONNECT TIME" JMS I [MONEY /": $DD.CC" TAD T3 DCA T1 PRINT6; LMESCT /"CENTRAL PROCESSOR TIME" JMS I [MONEY /": $DD.CC" TAD I CHAR DCA T1 PRINT6; LMESMC /" TOTAL MONTHLY CHARGES" JMS I [MONEY /": $DD.CC" BACKIN, CRLF JMS I [LOGIO /"JOB X LOGGED OUT ON CONSOLE N" JMP I [LGSTIG NOCHAR, PRINT6; LMESNC /"COMPUTER ERROR - NO CHARGE" JMP BACKIN
LOGCS, 0 /CHECK SPECIALS: MQL TAD K200 MQA /TURN ON PARITY BIT TAD [-"U+100 SNA JMP FUDGY /CTRL/U: START OVER TAD ["U-100-377 SNA JMP FUDGY /RUBOUT AS 1ST CHAR. IN BUF. TAD [377 JMP I LOGCS FUDGY, KCC JMP I [LOGSO LOGTA, 0 /TEST FOR ALPHA: TAD [-"A CLL TAD ["A-"Z-1 SNL CLA ISZ LOGTA /SKIP RETURN MEANS ALPHA JMP I LOGTA LMESRE, TEXT "READ ERROR - LOGIN AGAIN"
DECIMAL MONEY, 0 /PRINT ": $DD.CC";CRLF TAD [": PRINTC TAD K240 PRINTC TAD ["$ PRINTC TAD [-1000 JMS DIGIT TAD [-100 JMS DIGIT TAD [". PRINTC TAD [-10 JMS DIGIT TAD T1 /ODD CENTS LEFT-OVER TAD K260 PRINTC CRLF JMP I MONEY OCTAL DIGIT, 0 /OUTPUT ONE DECIMAL DIGIT DCA T2 DCA CT LOOPIT, TAD T1 CLL TAD T2 SNL JMP OUT DCA T1 ISZ CT JMP LOOPIT OUT, CLA TAD CT TAD K260 PRINTC JMP I DIGIT
LOGUAF, DEVICE SYS /USER ACCOUNT FILE 3 TEXT /USERACCNTS/;*.-1 LOGURD, ZBLOCK 4 /USER READ DATA LOGUAD, 0 /USER ACCOUNT DATA .-. /TRANSFER THIS SECTOR (BLOCK) -400 LOGBUF /INTO LOGBUF ERRUAF, TEXT "USERACC.NTS" BASOS, DEVICE SYS /BASIC OPERATING SYSTEM 2 TEXT /BASICOSRTS/;*.-1 BNAM, TEXT /BASIC@OS@@/;*.-1
LMESTC, TEXT " TERMINAL CONNECT CHARGE" LMESCT, TEXT " PROCESSOR TIME CHARGE" LMESMC, TEXT "MONTHLY CHARGES THUS FAR" LMESNC, TEXT "COMPUTER ERROR - NO CHARGE!"
EROSMS, TEXT "?CANNOT FIND " ERSCMS, TEXT "SCRATCH BLOCKS" ERRTMS, TEXT "OS8.RTS" ERDSMS, TEXT "OS8DISK.DSK" EROSM2, TEXT "?ERROR BOOTING OS/8" OSSAV, DEVICE SYS /AN EXPANSION FILE .-. /USER'S ACCOUNT TEXT /OS@@@@@SAV/;*.-1
*.+377&7400 /TO THE NEXT BLOCK LOGBUF, /(FORMAT FOR 'ACCTIMX.XXX') DECIMAL TOTCON, -600 /TOTAL TICKS USED - 600 -1440 /TOTAL MINUTES USED - 1440 -365 /TOTAL DAYS USED - 365 0 /TOTAL YEARS USED OCTAL TOTRUN, ZBLOCK 3 /TOTAL CPU RUN TIME LSTLGI, ZBLOCK 4 /TIME OF LAST LOGIN LSTLGO, ZBLOCK 4 /TIME OF LAST LOGOUT LOGSIZ= .+377&7400%400 /SIZE OF LOGIN.SAV
$
xxx|OM



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search