(NUMBER) "PER BRINCH HANSEN INFORMATION SCIENCE CALIFORNIA INSTITUTE OF TECHNOLOGY UTILITY PROGRAMS FOR THE SOLO SYSTEM 18 MAY 1975" "########### # PREFIX # ###########" CONST NL = '(:10:)'; FF = '(:12:)'; CR = '(:13:)'; EM = '(:25:)'; CONST PAGELENGTH = 512; TYPE PAGE = ARRAY (.1..PAGELENGTH.) OF CHAR; CONST LINELENGTH = 132; TYPE LINE = ARRAY (.1..LINELENGTH.) OF CHAR; CONST IDLENGTH = 12; TYPE IDENTIFIER = ARRAY (.1..IDLENGTH.) OF CHAR; TYPE FILE = 1..2; TYPE FILEKIND = (EMPTY, SCRATCH, ASCII, SEQCODE, CONCODE); TYPE FILEATTR = RECORD KIND: FILEKIND; ADDR: INTEGER; PROTECTED: BOOLEAN; NOTUSED: ARRAY (.1..5.) OF INTEGER END; TYPE IODEVICE = (TYPEDEVICE, DISKDEVICE, TAPEDEVICE, PRINTDEVICE, CARDDEVICE); TYPE IOOPERATION = (INPUT, OUTPUT, MOVE, CONTROL); TYPE IOARG = (WRITEEOF, REWIND, UPSPACE, BACKSPACE); TYPE IORESULT = (COMPLETE, INTERVENTION, TRANSMISSION, FAILURE, ENDFILE, ENDMEDIUM, STARTMEDIUM); TYPE IOPARAM = RECORD OPERATION: IOOPERATION; STATUS: IORESULT; ARG: IOARG END; TYPE TASKKIND = (INPUTTASK, JOBTASK, OUTPUTTASK); TYPE ARGTAG = (NILTYPE, BOOLTYPE, INTTYPE, IDTYPE, PTRTYPE); TYPE POINTER = @BOOLEAN; TYPE ARGTYPE = RECORD CASE TAG: ARGTAG OF NILTYPE, BOOLTYPE: (BOOL: BOOLEAN); INTTYPE: (INT: INTEGER); IDTYPE: (ID: IDENTIFIER); PTRTYPE: (PTR: POINTER) END; CONST MAXARG = 10; TYPE ARGLIST = ARRAY (.1..MAXARG.) OF ARGTYPE; TYPE ARGSEQ = (INP, OUT); TYPE PROGRESULT = (TERMINATED, OVERFLOW, POINTERERROR, RANGEERROR, VARIANTERROR, HEAPLIMIT, STACKLIMIT, CODELIMIT, TIMELIMIT, CALLERROR); PROCEDURE READ(VAR C: CHAR); PROCEDURE WRITE(C: CHAR); PROCEDURE OPEN(F: FILE; ID: IDENTIFIER; VAR FOUND: BOOLEAN); PROCEDURE CLOSE(F: FILE); PROCEDURE GET(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); PROCEDURE PUT(F: FILE; P: INTEGER; VAR BLOCK: UNIV PAGE); FUNCTION LENGTH(F: FILE): INTEGER; PROCEDURE MARK(VAR TOP: INTEGER); PROCEDURE RELEASE(TOP: INTEGER); PROCEDURE IDENTIFY(HEADER: LINE); PROCEDURE ACCEPT(VAR C: CHAR); PROCEDURE DISPLAY(C: CHAR); PROCEDURE READPAGE(VAR BLOCK: UNIV PAGE; VAR EOF: BOOLEAN); PROCEDURE WRITEPAGE(BLOCK: UNIV PAGE; EOF: BOOLEAN); PROCEDURE READLINE(VAR TEXT: UNIV LINE); PROCEDURE WRITELINE(TEXT: UNIV LINE); PROCEDURE READARG(S: ARGSEQ; VAR ARG: ARGTYPE); PROCEDURE WRITEARG(S: ARGSEQ; ARG: ARGTYPE); PROCEDURE LOOKUP(ID: IDENTIFIER; VAR ATTR: FILEATTR; VAR FOUND: BOOLEAN); PROCEDURE IOTRANSFER (DEVICE: IODEVICE; VAR PARAM: IOPARAM; VAR BLOCK: UNIV PAGE); PROCEDURE IOMOVE(DEVICE: IODEVICE; VAR PARAM: IOPARAM); FUNCTION TASK: TASKKIND; PROCEDURE RUN(ID: IDENTIFIER; VAR PARAM: ARGLIST; VAR LINE: INTEGER; VAR RESULT: PROGRESULT); PROGRAM P(VAR PARAM: ARGLIST); "############################################ # READ(VAR OK: BOOLEAN; DEST: IDENTIFIER; # # KIND: FILEKIND; PROTECT: BOOLEAN) # ############################################" "INSERT PREFIX HERE" VAR OK, OLDFILE: BOOLEAN; PROCEDURE WRITETEXT(TEXT: LINE); VAR I: INTEGER; C: CHAR; BEGIN I:= 0; REPEAT I:= I + 1; C:= TEXT(.I.); DISPLAY(C); UNTIL C = NL; END; PROCEDURE ERROR(TEXT: LINE); BEGIN WRITETEXT(TEXT); OK:= FALSE; END; PROCEDURE HELP; BEGIN IF OK THEN BEGIN WRITETEXT('TRY AGAIN(:10:)'); WRITETEXT (' READ(FILE: IDENTIFIER; KIND: FILEKIND; PROTECT: BOOLEAN)(:10:)'); WRITETEXT('USING(:10:)'); WRITETEXT (' FILEKIND = (SCRATCH, ASCII, SEQCODE, CONCODE) (:10:)'); OK:= FALSE; END; END; PROCEDURE SAVEFILE(LENGTH: INTEGER); VAR LINE: INTEGER; RESULT: PROGRESULT; LIST: ARGLIST; BEGIN WITH LIST(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= FALSE END; WITH LIST(.2.) DO BEGIN TAG:= IDTYPE; IF OLDFILE THEN ID:= 'REPLACE ' ELSE ID:= 'CREATE '; END; LIST(.3.):= PARAM(.2.); WITH LIST(.4.) DO BEGIN TAG:= INTTYPE; INT:= LENGTH END; LIST(.5.):= PARAM(.3.); LIST(.6.):= PARAM(.4.); RUN('FILE ', LIST, LINE, RESULT); IDENTIFY('READ:(:10:)'); IF (RESULT <> TERMINATED) OR NOT LIST(.1.).BOOL THEN ERROR('DISK FILE LOST (:10:)'); END; PROCEDURE CHECKARG; VAR ATTR: FILEATTR; BEGIN WITH PARAM(.2.) DO IF TAG <> IDTYPE THEN HELP ELSE BEGIN LOOKUP(ID, ATTR, OLDFILE); IF OLDFILE & ATTR.PROTECTED THEN ERROR('FILE PROTECTED (:10:)'); END; WITH PARAM(.3.) DO IF TAG <> IDTYPE THEN HELP ELSE IF (ID <> 'SCRATCH ') & (ID <> 'ASCII ') & (ID <> 'SEQCODE ') & (ID <> 'CONCODE ') THEN HELP; WITH PARAM(.4.) DO IF TAG <> BOOLTYPE THEN HELP; END; PROCEDURE INITIO; VAR ARG: ARGTYPE; BEGIN WITH ARG DO BEGIN TAG:= IDTYPE; ID:= 'TAPE ' END; WRITEARG(INP, ARG); WITH ARG DO BEGIN TAG:= IDTYPE; ID:= 'NEXT ' END; WRITEARG(OUT, ARG); END; PROCEDURE CHECKIO; VAR ARG: ARGTYPE; LENGTH: INTEGER; BEGIN READARG(INP, ARG); IF NOT ARG.BOOL THEN OK:= FALSE; READARG(OUT, ARG); LENGTH:= ARG.INT; READARG(OUT, ARG); IF NOT ARG.BOOL THEN OK:= FALSE; IF OK THEN SAVEFILE(LENGTH); END; PROCEDURE INITIALIZE; BEGIN IDENTIFY('READ:(:10:)'); OK:= TRUE; CHECKARG; END; PROCEDURE COPY; VAR BLOCK: PAGE; EOF: BOOLEAN; BEGIN INITIO; REPEAT READPAGE(BLOCK, EOF); WRITEPAGE(BLOCK, EOF); UNTIL EOF; CHECKIO; END; PROCEDURE TERMINATE; BEGIN WITH PARAM(.1.) DO BEGIN TAG:= BOOLTYPE; BOOL:= OK END; END; BEGIN IF TASK = JOBTASK THEN BEGIN INITIALIZE; IF OK THEN COPY; TERMINATE; END; END.